TP3/Resources/turbopascal3source/TP3/TPSRC2

	OR	AX,AX
	JZ	memin5	;:no std in file
	MOV	stdin,#$0000	;set handle: std in
	MOV.B	stdinfl,#$00	;clear flag
memin5	MOV	stdoutof,DI	;buffer addr std output
	CS:	
	MOV	AX,[SI]$12	;set std out buffer
	MOV	stdoutsz,AX
	OR	AX,AX
	JZ	memin6	;:no std out file
	MOV	stdout,#$0001	;set handle: std out
	MOV.B	stdoutfl,#$00	;clear flag:not open
memin6	ADD	SI,#$14	;set return addr
	PUSH	SI
	XOR	AX,AX	;0 -> ES
	MOV	ES,AX
	ES:		;save div / 0 interrupt
	MOV	AX,div0vec
	MOV	svintv,AX
	ES:	
	MOV	AX,availmem	;div0vec1
	MOV	svintv1,AX
	ES:		;now set own routine
	MOV	div0vec,#div0err
	ES:	
	MOV	availmem,CS	;div0vec1
	TEST	modeflg,#$0008	;set breakpoint int ?
	JZ	memin7	;:no
	ES:	
	MOV	int3vec,#brkint
	ES:	
	MOV	int3vec1,CS
memin7	TEST	modeflg,#$0004	;test for ^C, ^S ?
	JZ	memin8	;:no
	MOV.B	cbreak,#$01	;set flag
memin8	MOV	verror,#$10D0	;set error vec
	XOR	AX,AX
	MOV	errpos2,AX	;clear error pos
	MOV	ovrpnbuf,AL	;clear ovrlay pathname
	MOV	CX,stdinsz	;open std in for read
	PUSH	DS
	MOV	DI,#stdin
	CALL	xresettx
	MOV	CX,stdoutsz	;open std out for write
	PUSH	DS
	MOV	DI,#stdout
	CALL	xrewrttx
	MOV.B	errio,#$00	;clear flag
	CALL	xcrtinit	;CrtInit
	RET		;"
readvers	MOV	AH,#$30	;Read Version Number
	CALL	dos	;do MS-DOS
	OR.B	AL,AL	;Version 0 ?
	JZ	verserr	;yes:error
	RET		;'
verserr	MOV	DX,#msgdos
	JMP.b	writerr	;'
memerr	MOV	DX,#msgmem
writerr	PUSH	CS	;CS -> DS
	POP	DS
	MOV	AH,#$09	;print string
	CALL	dos	;do MS-DOS
	MOV	DX,#msgend
	MOV	AH,#$09	;print string
	CALL	dos	;MS-DOS
	MOV	AH,#$00	;exit program
	CALL	dos	;"do MS-DOS
msgmem	B	"Not enough memory$"
msgdos	B	"Incorrect DOS version$"
msgend	B	$0D,$0A,"Program aborted",$0D,$0A,"$"	;"
progend	PUSH	AX	;End of program
	PUSH	DS	;AX=0:normal
	MOV	DI,#stdin	;close std input
	CALL	xclosetx
	PUSH	DS
	MOV	DI,#stdout	;close std output
	CALL	xclosetx
	XOR	AX,AX	;restore div / 0 int
	MOV	ES,AX
	MOV	AX,svintv
	ES:	
	MOV	div0vec,AX
	MOV	AX,svintv1
	ES:	
	MOV	availmem,AX	;div0int1
	POP	AX	;end flag
	TEST	modeflg,#$0001	;direct mode ?
	JNZ	turbort	;yes: return to Turbo
	MOV	AH,#$4C	;end process
	CALL	dos	;'return to MS-DOS
turbort	MOV	AH,#$80	;close all files
	CALL	dos
	PUSH	turbocs	;set return addr
	MOV	AX,#turboret
	PUSH	AX
	PUSH	DS	;DS -> ES
	POP	ES
	MOV	DS,turbods
	RETF		;"return to Turbo
	;Uncrunch program
	;This routine makes space for overlays, which are not stored
	;in the main code file. It makes use of an inline data structure:
	;+ 0:length of the block to move
	;+ 2:destination addr of this block
	;This makes a list which continues at the end of each block.
uncrunch	POP	BX	;return addr
	CS:	
	MOV	AX,[BX]	;get block length
	OR	AX,AX	;0 ?
	JZ	uncrdone	;yes:end of list
	PUSH	DS	;save DS
	PUSH	CS	;CS -> DS
	POP	DS
	PUSH	CS	;CS -> ES
	POP	ES	;push list on stack
	XOR	DX,DX	;count blocks
uncrlist	MOV	AX,[BX]	;get word
	OR	AX,AX	;end of list ?
	JZ	uncrstrt	;:yes
	PUSH	BX	;push offset
	ADD	BX,AX	;add offset
	INC	DX	;count entry
	JMP	uncrlist	;'continue
uncrstrt	MOV	CX,BX	;last ptr
	POP	BX	;get ptr from stack
	MOV	SI,BX	;+4 -> beginning of block
	ADD	SI,#$04
	MOV	DI,[BX]$02	;get destination addr
	CMP	SI,DI	;the same ?
	JZ	uncrno
	SUB	CX,SI	;block length
	ADD	SI,CX	;ptrs to last byte in block
	ADD	DI,CX
	DEC	SI
	DEC	DI
	STD		;move backwards
	REPZ	
	MOVS.B	
uncrno	DEC	DX	;another block ?
	JNZ	uncrstrt	;:yes
	MOV	[BX],#$0000	;clear the list: uncrunched
	POP	DS	;restore DS
uncrdone	ADD	BX,#$04	;skip inline data
	JMP	BX	;"return
	;Overlay header. Inline parameters:
	;+ 0:currently valid procedure (ptr into file)
	;+ 2:name of the overlay file
	;+ F:start of the procedure code
rdover	POP	SI	;get return addr
	CS:		;DX = file offset of proc wanted
	CMP	DX,[SI]	;is it already there ?
	JNZ	ovrread	;:no
ovrcall	ADD	SI,#$0F	;skip filename
	JMP	SI	;'jump into procedure
ovrread	PUSH	AX	;AX = overlay length
	PUSH	DX	;save overlay pos
	PUSH	SI	;save dest addr
	MOV	DI,#ovrpnbuf	;scan overlay pathname
	XOR.B	AL,AL	;clear char buffer
ovrscan	MOV.B	AH,AL	;buffer:last char
	MOV.B	AL,[DI]	;get char
	OR.B	AL,AL	;end of name ?
	JZ	ovrpne	;:yes
	INC	DI	;next char
	JMP	ovrscan	;'continue scanning
ovrpne	PUSH	DI	;save end pos
	OR.B	AH,AH	;test last char
	JZ	ovrnob	;:no path specified
	CMP.B	AH,#$3A	;: ?
	JZ	ovrnob	;:yes
	CMP.B	AH,#$5C	;\ ?
	JZ	ovrnob	;:yes
	MOV.B	[DI],#$5C	;store a \ at the end
	INC	DI
ovrnob	INC	SI	;set to beg of filename
	INC	SI
ovrcopy	CS:		;get char from filename
	MOV.B	AL,[SI]
	MOV.B	[DI],AL	;store in pathname
	INC	SI
	INC	DI	;next char
	OR.B	AL,AL	;end ?
	JNZ	ovrcopy	;no: continue
	MOV	AX,#$3D00	;open file
	MOV	DX,#ovrpnbuf	;pathname
	PUSH	DS	;DS -> ES
	POP	ES
	CALL	dos	;do it
	MOV	BX,AX	;file handle
	POP	DI	;restore parms
	POP	SI
	POP	DX
	MOV.B	[DI],#$00	;restore overlay pathname
	JB	ovrerr	;:error
	CS:		;store pos as current pos
	MOV	[SI],DX	;in the overlay header
	MOV	AX,#$4200	;seek absolute
	XOR.B	CH,CH	;pos = DX*256
	MOV.B	CL,DH
	MOV.B	DH,DL
	XOR.B	DL,DL
	CALL	dos	;do it
	POP	CX	;restore length
	JB	ovrerr	;:error
	MOV	AH,#$3F	;read byte block
	LEA	DX,[SI]$0F	;destination addr
	PUSH	DS	;save DS
	PUSH	CS	;CS -> DS
	POP	DS
	CALL	dos	;do it
	POP	DS	;restore DS
	JB	ovrerr	;:error
	MOV	AH,#$3E	;close file
	CALL	dos
	JMP	ovrcall	;'jump into procedure
ovrerr	MOV	DL,#$F0	;error: Overlay not found
	PUSH	SI	;return addr
	JMP	runerrrt	;"
xovrpath	POP	BX	;OvrPath
	CALL	getpn	;convert string -> ASCIIZ
	PUSH	BX	;restore ret
	MOV	SI,#pnbuf	;copy into overlay pathname
	MOV	DI,#ovrpnbuf
	PUSH	DS	;DS -> ES
	POP	ES
	MOV	CX,#$0020	;64 bytes
	CLD	
	REPZ	
	MOVS	
	RET		;"
xkeypres	DEC	SP	;KeyPressed
	CALL	[vkbdstat]	;check status
	RET		;"
xgotoxy	POP	BX	;GotoXY
	POP	CX	;column
	PUSH	BX	;restore ret
	MOV.B	DL,AL	;row-1
	MOV.B	DH,CL	;column-1
	DEC.B	DL	;(Turbo uses origin 1,1)
	DEC.B	DH
	JMP	setcpos	;"set position
xparmstr	MOV	DX,AX	;ParamStr: # wanted string
	OR	DX,DX	;0 ?
	JZ	prmstr1
	CALL	prmcnt1	;search in parm line
	XCHG	AX,BX	;string length -> AX
prmstr1	POP	BX	;return addr
	SUB	SP,AX	;allot space for string
	DEC	SP
	MOV	DI,SP	;string dest
	PUSH	DS	;save DS
	PUSH	CS	;CS -> DS
	POP	DS
	PUSH	SS	;SS -> ES
	POP	ES
	CLD		;move string
	STOS.B		;store length
	XCHG	AX,CX	;-> count
	REPZ		;move string
	MOVS.B	
	POP	DS	;restore DS
	JMP	BX	;"return
xparmcnt	XOR	DX,DX	;ParamCount: count string entries
prmcnt1	MOV	DI,#paramlin	;parameter line
	CS:	
	MOV.B	CL,[DI]	;length of param line
	XOR.B	CH,CH
	INC	DI	;beginning of string
	XOR	BX,BX	;clear parm cnt
prmcsep	JCXZ	prmcst	;:end of line
	CS:		;search char <> tab, space
	MOV.B	AL,[DI]	;read char
	CMP	AL,#$20	;space ?
	JZ	prmcsep2	;:continue
	CMP	AL,#$09	;tab ?
	JNZ	prmcst	;no:start of parm
prmcsep2	INC	DI	;next char
	DEC	CX	;count length
	JMP	prmcsep	;'continue
prmcst	MOV	SI,DI	;start of parm string
prmcstl	JCXZ	prmcste	;end of line
	CS:		;search char = tab, space
	MOV.B	AL,[DI]	;get char
	CMP	AL,#$20	;space ?
	JZ	prmcste	;yes: end of parm
	CMP	AL,#$09	;tab ?
	JZ	prmcste	;yes: end of parm
	INC	DI	;next char
	DEC	CX	;count length
	JMP	prmcstl	;'continue searching
prmcste	MOV	AX,DI	;end position - beg position
	SUB	AX,SI
	JZ	prmcrt	;=0:forget it
	INC	BX	;count parm
	DEC	DX	;search another parm ?
	JNZ	prmcsep	;:yes
prmcrt	XCHG	AX,BX	;return count, string length
	RET		;"
xstrint	MOV.B	fmtfield,CL	;Str(Integer): max length
	MOV	fmtsdst,DI	;dest ofs
	POP	BX	;ret addr
	POP	fmtsdst1	;dest seg
	POP	CX	;format
	POP	AX	;number
	PUSH	BX	;restore ret
	PUSH	CX	;save format
	MOV	BX,#pnbuf	;dest buffer
	CALL	intasc	;Integer -> ASCII
	JMP.b	str1	;'store in string
xstrreal	MOV.B	fmtfield,CL	;Str(Real): max length
	MOV	fmtsdst,DI	;dest ofs
	POP	BX	;ret addr
	POP	fmtsdst1	;dest seg
	POP	DX	;format 2
	POP	AX	;format 1
	MOV	DI,#recvbuf	;buffer for real number
	POP	[DI]	;pop real number
	POP	[DI]$02
	POP	[DI]$04
	PUSH	BX	;restore ret
	PUSH	AX	;format 1
	XCHG	AX,CX	;format 2 -> AX
	MOV	BX,#pnbuf	;dest buffer
	CALL	fmtreal	;Real -> ASCII
str1	POP	CX	;format
	LES	DI,fmtsdst	;ptr to dest string
	PUSH	DI	;save begin pos
	MOV.B	DL,fmtfield	;max. field size
	XOR.B	DH,DH
	XCHG	AX,BX	;endposition - buffer pos
	SUB	AX,#pnbuf	;-> length
	SUB	CX,AX	;max len - len
	JBE	strcpy0	;:too long
strpad	INC	DI	;pad with spaces
	ES:	
	MOV.B	[DI],#$20
	INC.B	DH	;count len
	CMP.B	DH,DL	;= max len ?
	JZ	strdone	;yes:done
	LOOP	strpad	;continue padding
strcpy0	XCHG	AX,CX	;num len -> CX
	MOV	BX,#pnbuf	;source ptr
strcopy	MOV.B	AL,[BX]	;get char
	INC	BX	;ptr to next
	INC	DI
	ES:	
	MOV.B	[DI],AL	;store in string
	INC.B	DH	;pos = max len ?
	CMP.B	DH,DL
	JZ	strdone	;yes: end it
	LOOP	strcopy	;continue
strdone	POP	DI	;restore dest ptr
	ES:	
	MOV.B	[DI],DH	;store length
	RET		;"
xvalint	XOR.B	AL,AL	;Val(Integer)
	JMP.b	val1	;'
xvalreal	MOV	AL,#$01	;Val(Real)
val1	MOV	fmttype,AL	;store type
	MOV	fmtpdst,DI	;pos ofs
	POP	BX	;ret addr
	POP	fmtpdst1	;pos seg
	POP	fmtvdst	;dest ofs
	POP	fmtvdst1	;dest seg
	CALL	getstz	;get string from stack
	PUSH	BX	;restore ret
	XOR	AX,AX	;no error
	MOV	BX,#pnbuf
	CMP.B	[BX],AL	;null string ?
	JZ	valrt	;:set pos, no change to dest
	CMP.B	fmttype,AL	;integer ?
	JNZ	val2	;:no
	CALL	ascint	;ASCIIZ -> Integer
	JB	valerr	;:error
	LES	DI,fmtvdst	;dest ptr
	ES:	
	MOV	[DI],AX	;store result
	JMP.b	valend	;'get error pos
val2	MOV	DI,#recvbuf	;real dest
	CALL	ascreal	;ASCIIZ -> Real
	JB	valerr	;:error
	MOV	SI,DI
	LES	DI,fmtvdst	;move real into
	CLD		;dest var
	MOVS	
	MOVS	
	MOVS	
valend	XOR	AX,AX	;no error
	CMP.B	[BX],AL	;end of buffer reached ?
	JZ	valrt	;:yes
valerr	XCHG	AX,BX	;calculate error pos
	SUB	AX,#pnbuf0
valrt	LES	DI,fmtpdst	;store error pos
	ES:	
	MOV	[DI],AX
	RET		;"
getpn	MOV	CX,#$0040	;get string from stack
	JMP.b	gstz1	;'max 64 chars
getstz	MOV	CX,#$007F	;max 127 chars
gstz1	MOV	DI,#pnbuf	;dest buffer (redundant!)
	POP	AX	;ret addr
	MOV	SI,SP	;ptr to string
	SS:	
	MOV.B	DL,[SI]	;get length
	XOR.B	DH,DH
	CMP	CX,DX	;> max length ?
	JBE	gstz2	;yes, limit it
	MOV	CX,DX	;take this length
gstz2	INC	DX
	INC	SI	;skip length
	MOV	DI,#pnbuf	;dest ptr
	PUSH	DS	;DS -> ES
	POP	ES
	PUSH	SS	;SS -> DS
	POP	DS
	CLD	
	REPZ		;move string into buffer
	MOVS.B	
	PUSH	ES	;restore DS
	POP	DS
	MOV.B	[DI],#$00	;store a 0 at the end
	ADD	SP,DX	;remove string from stack
	JMP	AX	;"return
xrndmize	MOV	AH,#$2C	;Randomize: Get time
	CALL	dos
	MOV	rndseed1,CX	;store as random seed
	MOV	rndseed,DX
	RET		;"
xmovevar	POP	BX	;Move var - CX = length
	MOV	DX,DS	;save DS
	MOV	SI,DI	;source ofs
	POP	DS	;source seg
	POP	DI	;dest ofs
	POP	ES	;dest seg
	CLD		;move var
	REPZ	
	MOVS.B	
	MOV	DS,DX	;restore DS
	JMP	BX	;"return
xblkparm	POP	BX	;Copy var -> stack
	MOV	DX,DS	;save DS
	MOV	SI,DI	;source ofs
	POP	DS	;source seg
	SUB	SP,CX	;make space - CX = len
	MOV	DI,SP	;dest ptr
	PUSH	SS	;SS -> ES
	POP	ES
	CLD		;move it
	REPZ	
	MOVS.B	
	MOV	DS,DX	;restore DS
	JMP	BX	;"return
xfillchr	POP	BX	;FillChar
	POP	CX	;number of bytes
	POP	DI	;array ofs
	POP	ES	;array seg
	CLD		;fill it - char in AL
	REPZ	
	STOS.B	
	JMP	BX	;"return
xmove	XCHG	AX,CX	;Move: Count -> CX
	MOV	DX,DS	;save DS
	POP	BX	;ret addr
	POP	DI	;dest ofs
	POP	ES	;dest seg
	POP	SI	;source ofs
	POP	DS	;source seg
	CLD		;forward move
	CMP	SI,DI	;source > dest ?
	JNB	domove	;yes: move forward
	ADD	SI,CX	;set ptr to end of block
	ADD	DI,CX
	DEC	SI
	DEC	DI
	STD		;move backwards
domove	REPZ		;do it
	MOVS.B	
	MOV	DS,DX	;restore DS
	JMP	BX	;"return
xsetregs	POP	BX	;Get parms for MsDos, Intr
	POP	AX	;record seg
	PUSH	BP	;save regs
	PUSH	DS
	PUSH	AX	;save record addr
	PUSH	DI
	PUSH	BX	;restore ret
	MOV	SI,DI	;pointer -> source
	MOV	DS,AX	;source segment
	CLD	
	LODS		;AX value -> stack
	PUSH	AX
	LODS		;BX value
	MOV	BX,AX
	LODS		;CX value
	MOV	CX,AX
	LODS		;DX value
	MOV	DX,AX
	LODS		;BP value
	MOV	BP,AX
	LODS		;SI value -> stack
	PUSH	AX
	LODS		;DI value
	MOV	DI,AX
	LODS		;DS value
	PUSH	AX
	LODS		;ES value
	MOV	ES,AX
	POP	DS	;get DS,SI,AX from stack
	POP	SI
	POP	AX
	RET		;"
xgetregs	PUSHF		;store register values
	PUSH	ES
	PUSH	DI
	PUSH	BP
	MOV	BP,SP	;stack index
	LES	DI,[BP]$0A	;get record ptr
	CLD		;store AX
	STOS	
	MOV	AX,BX	;store BX
	STOS	
	MOV	AX,CX	;store CX
	STOS	
	MOV	AX,DX	;store DX
	STOS	
	POP	AX	;store BP (from stack)
	STOS	
	MOV	AX,SI	;store SI
	STOS	
	POP	AX	;store DI (from stack)
	STOS	
	MOV	AX,DS	;store DS
	STOS	
	POP	AX	;store ES (from stack)
	STOS	
	POP	AX	;store flags (from stack)
	STOS	
	POP	BX	;return addr
	ADD	SP,#$04	;clear stack
	POP	DS	;restore DS,BP
	POP	BP
	JMP	BX	;"return
xindchk	CMP	AX,CX	;array index check
	JNB	chklim1	;AX>=limit CX:error
	RET		;'
chklim1	MOV	DL,#$90	;Index out of range
	JMP.b	runerrrt	;"
	NOP		;Range check CX<=AX<=DX
xrngchk	CMP	AX,CX
	JL	chkrng1	;not enough:error
	CMP	AX,DX
	JG	chkrng1	;too much:error
	RET		;'
chkrng1	MOV	DL,#$91	;Scalar or subrange
	JMP.b	runerrrt	;"out of range
	NOP		;Stack check
xchkstk	MOV	AX,SP	;CX=space required
	SUB	AX,CX	;SP-CX
	JB	chkstk1	;:error
	CMP	AX,#$0200	;getting tight ?
	JB	chkstk1	;:yes
	MOV	CL,#$04	;convert to segment
	SHR	AX,CL
	MOV	CX,SS
	ADD	AX,CX
	CMP	AX,hptop1	;compare with heap top
	JB	chkstk1	;below:error
	RET		;'
chkstk1	MOV	DL,#$FF	;heap / stack collision
	JMP.b	runerrrt	;"
	NOP		;Breakpoint interrupt
brkint	POP	BX	;return addr
	POP	AX	;AX
	POPF		;Flags
	PUSH	BX	;restore ret
	OR.B	cbreak,#$02	;set flag: int test
	DEC	SP
	CALL	kbdstat	;Key pressed ?
	JZ	brkno	;:no
	DEC	SP
	CALL	kbdget	;get that key
brkno	AND.B	cbreak,#$01	;restore flag
	CMP	AL,#$03	;^C ?
	JZ	brkbrk	;:yes
	RET		;'
brkbrk	POP	errpos	;get return addr
	ADD	errpos,#$02	;adjust for length of INT3
brkmsg	MOV	DX,#$0001	;error: break
	JMP.b	error	;"
xiores	XOR	AX,AX	;IOResult: clear AX
	XCHG.B	AL,errnum	;read error, clear it
	RET		;"
xiochk	CMP.B	errnum,#$00	;check for I/O-error
	JNZ	chkioerr
	RET		;'
chkioerr	MOV.B	DL,errnum	;get error number
	MOV	DH,#$01	;I/O-error
	JMP.b	error	;'display message
div0err	POP	BX	;Div/0 interrupt
	POP	AX	;take stuff from stack
	POPF	
	PUSH	BX	;restore ret
	MOV	DL,#$04	;div / 0
runerrrt	POP	errpos	;error pos: return addr
runerr	MOV	DH,#$02	;runtime error
error	PUSH	DX	;save error number
	CALL	reinit1	;reinit files, I/O
	POP	DX	;error number
	MOV	AX,errpos
	SUB	AX,#$0003
	XCHG	AX,errpos2	;store pos of call
	OR	AX,AX	;break ?
	JNZ	errbrk	;:yes
	PUSH	DX	;save error number
	PUSH	DX
	PUSH	errpos2
	CALL	[verror]	;error handler
	POP	DX	;restore err number
errbrk	CMP.B	DH,#$01	;Break ?
	JNB	errrunio	;:no
	CALL	prints
	B	"^C",$0D,$0A,"User Break",$00
	JMP.b	errwpos	;'
errrunio	MOV.B	errio,#$FF	;set flag: real error
	JA	errrun	;:runtime error
	CALL	prints
	B	$0D,$0A,"I/O",$00
	JMP.b	errerr	;'
errrun	CALL	prints
	B	$0D,$0A,"Run-time",$00
errerr	CALL	prints
	B	" error ",$00
	MOV.B	AL,DL	;write error number
	CALL	whexbyte	;(hex)
errwpos	CALL	prints
	B	", PC=",$00
	MOV	AX,errpos2	;display error pos
	CALL	whexword
	CALL	prints
	B	$0D,$0A,"Program aborted",$0D,$0A,$00
	MOV	AL,#$01	;Program end: error
	JMP	progend	;"
	RET	$0004	;"Error handler
iabs	OR	AX,AX	;Abs(Integer):test sign
	JNS	iabspos	;:positive, zero
	NEG	AX	;negate it
iabspos	RET		;"
irandom	PUSH	AX	;Random(Integer):save limit
	CALL	dorandom	;do random
	POP	BX	;get limit
	SHR	AX,1 	;div 2
	CWD	
	DIV	BX	;do modulo
	XCHG	AX,DX	;remainder -> AX
	RET		;"
dorandom	MOV	BX,rndseed1	;do random
	MOV	CX,rndseed	;get seed
	PUSH	BX	;save it
	PUSH	CX
	MOV.B	AL,BH	;permutate it
	MOV.B	BH,BL
	MOV.B	BL,CH
	MOV.B	CH,CL
	XOR.B	CL,CL
	RCR.B	AL,1 
	RCR	BX,1 
	RCR	CX,1 
	POP	AX	;old seed
	ADD	CX,AX	;add it
	POP	AX
	ADC	BX,AX
	MOV	AX,#$62E9	;add constant
	ADD	CX,AX
	MOV	AX,#$3619
	ADC	BX,AX
	MOV	rndseed1,BX	;new seed
	MOV	rndseed,CX
	MOV	AX,BX	;result
	RET		;"
intasc	OR	AX,AX	;Integer -> ASCII
	JNS	iapos	;:positive number
	NEG	AX	;negate it
	MOV.B	[BX],#$2D	;store a -
	INC	BX
iapos	XOR.B	CH,CH	;flag for leading zeroes
	MOV	DX,#$2710	;digit 10000
	CALL	iadigit
	MOV	DX,#$03E8	;digit 1000
	CALL	iadigit
	MOV	DX,#$0064	;digit 100
	CALL	iadigit
	MOV	DL,#$0A	;digit 10
	CALL	iadigit
	MOV.B	CL,AL	;do it direct
	JMP.b	iadput	;'last digit
iadigit	XOR.B	CL,CL	;clear digit
iadsub	INC.B	CL	;do successive subtraction
	SUB	AX,DX	;(faster than DIV)
	JNB	iadsub	;:continue
	ADD	AX,DX	;restore remainder
	INC.B	CH	;flag:now print zeroes
	DEC.B	CL	;dec number
	JNZ	iadput	;:ok, non-zero
	DEC.B	CH	;clear flag
	JZ	iadnoput
iadput	ADD.B	CL,#$30	;convert to ASCII
	MOV.B	[BX],CL	;store
	INC	BX
iadnoput	RET		;"
asccard	XOR	AX,AX	;Read integer number:clear result
	CMP.B	[BX],#$24	;$ ?
	MOV	DX,#$000A	;base 10
	JNZ	acdec	;no:ok
	MOV	DL,#$10	;base 16
acloop	INC	BX	;go to next char
acdec	PUSH	AX	;save previous result
	MOV.B	AL,[BX]	;get char
	CALL	upcase
	MOV.B	CL,AL	;save char
	POP	AX	;restore result
	SUB.B	CL,#$30	;digit < 0 ?
	JB	acend	;:yes, end of number
	CMP.B	CL,#$0A	;> 9 ?
	JB	acdigok	;no:ok
	CMP.B	DL,#$10	;base = 16 ?
	JNZ	acend	;no:end
	SUB.B	CL,#$07	;adjust hex
	CMP.B	CL,#$0A	;< A ?
	JB	acend	;:end
	CMP.B	CL,#$10	;> F ?
	JNB	acend	;:end
acdigok	PUSH	DX	;save base
	MUL	DX	;do multiplication
	POP	DX	;restore base
	JB	acret	;:overflow
	XOR.B	CH,CH	;clear hi byte
	ADD	AX,CX	;add digit to result
	JNB	acloop	;:no overflow, continue
	JMP.b	acret	;'end it - overflow
acend	CMP.B	DL,#$10	;base 16 ?
	JZ	acret	;:yes
	MOV	CX,AX	;CX:=number*2
	ADD	CX,CX
acret	RET		;"
ascint	MOV.B	CL,[BX]	;read integer:test sign
	CMP.B	CL,#$2D	;- ?
	JNZ	aipos	;:no
	INC	BX	;go to next char
aipos	PUSH	CX	;save sign
	CALL	asccard	;read integer
	POP	CX	;restore sign
	JB	aichk	;:might be wrong
	CMP.B	CL,#$2D	;- ?
	JNZ	ainoneg	;:no
	NEG	AX	;negate it
ainoneg	CLC		;no error
	RET		;'
aichk	CMP	AX,#$8000	;$8000 ?
	JNZ	aierr	;no:really error
	CMP.B	CL,#$2D	;negative ?
	JNZ	aierr	;no:overflow
	RET		;'yes:ok
aierr	STC		;return error
	RET		;"
strload	POP	BX	;get string var -> stack
	POP	ES	;source seg
	MOV	SI,DI	;source ofs
	ES:		;get length
	MOV.B	CL,[SI]
	XOR.B	CH,CH	;-> count
	INC	CX	;copy length, too
	SUB	SP,CX	;make space on stack
	MOV	DI,SP	;dest: new stack top
	PUSH	DS	;save DS
	PUSH	ES	;ES -> DS
	POP	DS
	PUSH	SS	;SS -> ES
	POP	ES
	CLD		;move string to stack
	REPZ	
	MOVS.B	
	POP	DS	;restore DS
	JMP	BX	;"return
xstrcn	POP	SI	;inline string -> stack
	CS:		;get length
	MOV.B	CL,[SI]
	XOR.B	CH,CH	;-> count
	INC	CX	;copy length, too
	SUB	SP,CX	;make space on stack
	MOV	DI,SP	;dest: new stack top
	PUSH	DS	;save DS
	PUSH	CS	;CS -> DS
	POP	DS
	PUSH	SS	;SS -> ES
	POP	ES
	CLD		;move string to stack
	REPZ		;puts SI to end of string
	MOVS.B	
	POP	DS	;restore DS
	JMP	SI	;"return
strstore	POP	DX	;store string from stack
	MOV.B	AL,CL	;max. length dest
	MOV	BX,SP	;stack base
	SS:		;get length of source string
	MOV.B	CL,[BX]
	XOR.B	CH,CH
	ADD	BX,CX	;add to stack base
	INC	BX	;+1
	SS:	
	LES	DI,[BX]	;get dest ptr
	MOV	SI,SP	;source ptr:stack
	CMP.B	CL,AL	;too long ?
	JBE	stslenok	;:yes
	MOV.B	CL,AL	;take real length
	SS:	
	MOV.B	[SI],AL	;store length on stack
stslenok	INC	CX	;count
	PUSH	DS	;save DS
	PUSH	SS	;SS -> DS
	POP	DS
	CLD		;move string
	REPZ	
	MOVS.B	
	POP	DS	;restore DS
	LEA	SP,[BX]$04	;remove string, ptr
	JMP	DX	;"return
xldarrch	POP	BX	;store string on stack
	POP	ES	;source seg
	MOV	SI,DI	;source ofs
	XOR.B	CH,CH	;CL=length
	SUB	SP,CX	;make space on stack
	DEC	SP
	MOV	DI,SP	;dest addr
	SS:	
	MOV.B	[DI],CL	;store length
	INC	DI
	PUSH	DS	;save DS
	PUSH	ES	;ES -> DS
	POP	DS
	PUSH	SS	;SS -> ES
	POP	ES
	CLD		;move to stack
	REPZ	
	MOVS.B	
	POP	DS	;restore DS
	JMP	BX	;"return
xstrparm	POP	BX	;String insert / delete
	XOR.B	CH,CH	;CL=length
	MOV	SI,SP	;string pos
	SS:	
	MOV.B	AL,[SI]	;get length
	XOR.B	AH,AH
	SUB	AX,CX	;compare length
	MOV	DI,SI	;dest ptr
	ADD	DI,AX	;+ difference
	OR	AX,AX	;test direction
	JZ	strret	;:same length
	JNS	strins	;:make it shorter
	MOV	SP,DI	;new stack top
	SS:		;insert - make string longer
	MOV.B	CL,[SI]	;get length
	INC	CX	;+1 -> count
	PUSH	DS	;save DS
	PUSH	SS	;SS -> DS
	POP	DS
	PUSH	SS	;SS -> ES
	POP	ES
	CLD		;move it
	REPZ	
	MOVS.B	
	POP	DS	;restore DS
	JMP.b	strret	;'return
strins	SS:		;delete - shorten string
	MOV.B	[SI],CL	;store new length
	ADD	DI,CX	;go to end of string
	ADD	SI,CX
	INC	CX	;count+1
	PUSH	DS	;save DS
	PUSH	SS	;SS -> DS
	POP	DS
	PUSH	SS	;SS -> ES
	POP	ES
	STD		;move it up
	REPZ	
	MOVS.B	
	POP	DS	;restore DS
	INC	DI	;beginning of string
	MOV	SP,DI	;= new stack top
strret	JMP	BX	;"return
csteq	CALL	cmpstr	;Compare strings =
	MOV	AX,#$0001
	JZ	csteq1	;equal:true
	DEC	AX	;false
csteq1	OR	AX,AX	;set flags
	RET		;"
cstne	CALL	cmpstr	;Compare strings <>
	MOV	AX,#$0001
	JNZ	cstne1	;not equal:true
	DEC	AX
cstne1	OR	AX,AX
	RET		;"
cstge	CALL	cmpstr	;Compare strings >=
	MOV	AX,#$0001
	JNB	cstge1	;larger or equal:true
	DEC	AX
cstge1	OR	AX,AX
	RET		;"
cstle	CALL	cmpstr	;Compare strings <=
	MOV	AX,#$0001
	JBE	cstle1	;less or equal:true
	DEC	AX
cstle1	OR	AX,AX
	RET		;"
cstg	CALL	cmpstr	;Compare strings >
	MOV	AX,#$0001
	JA	cstg1	;larger:true
	DEC	AX
cstg1	OR	AX,AX
	RET		;"
cstl	CALL	cmpstr	;Compare strings <
	MOV	AX,#$0001
	JB	cstl1	;less:true
	DEC	AX
cstl1	OR	AX,AX
	RET		;"
cmpstr	MOV	DI,SP	;Compare strings
	ADD	DI,#$04	;ignore 2 ret addr
	SS:	
	MOV.B	CL,[DI]	;get len second string
	XOR.B	CH,CH	;clr hi byte
	INC	DI	;ptr to beg of string
	MOV	SI,DI	;calc pos of first string
	ADD	SI,CX	;add len
	SS:	
	MOV.B	DL,[SI]	;get len first string
	XOR.B	DH,DH	;clr hi byte
	INC	SI
	MOV	BX,SI	;calc end pos of string
	ADD	BX,DX	;for removing it
	MOV.B	AL,CL	;second len
	MOV.B	AH,DL	;first len
	CMP	CX,DX	;compare them
	JBE	csshrt	;:CX already shorter
	XCHG	CX,DX	;shorter len -> CX
csshrt	OR	CX,CX	;null string ?
	JZ	csnull	;:yes
	PUSH	DS	;save DS
	PUSH	SS	;SS -> ES
	POP	ES
	PUSH	SS	;SS -> DS
	POP	DS
	CLD		;compare strings on stack
	REPZ	
	CMPS.B	
	POP	DS	;restore DS
	JNZ	csnoteq	;:not equal - flags are set
csnull	CMP.B	AH,AL	;compare len
csnoteq	POP	DX	;return addr
	POP	CX	;return addr caller
	MOV	SP,BX	;remove strings from stack
	PUSH	CX	;restore ret caller
	JMP	DX	;"return
xconcat	POP	errpos	;Concat: get return addr
	MOV	DI,SP	;pos second string
	SS:	
	MOV.B	DL,[DI]	;len2
	XOR.B	DH,DH
	MOV	SI,DI	;go to start of first string
	INC	SI
	ADD	SI,DX
	SS:	
	MOV.B	CL,[SI]	;len1
	ADD.B	DL,CL	;len1+len2 too long ?
	JB	concerr	;yes:error
	SS:	
	MOV.B	[SI],DL	;store new len
	XOR.B	CH,CH	;put first string in front
	SUB	DI,CX	;of second
	MOV	SP,DI	;get space on stack
	INC	CX	;len1+1; len2 will be overwritten
	PUSH	DS	;save DS
	PUSH	SI	;save SI
	PUSH	SS	;SS -> ES
	POP	ES
	PUSH	SS	;SS -> DS
	POP	DS
	CLD		;move first string
	REPZ	
	MOVS.B	
	MOV	DI,SI	;end addr of string 1
	POP	SI	;end pos of concat string
	DEC	SI
	DEC	DI
	MOV	CX,DX	;resulting length + 1
	INC	CX
	STD	
	REPZ		;copy it up
	MOVS.B	
	POP	DS	;restore DS
	INC	DI
	MOV	SP,DI	;remove garbage from stack
	JMP	[errpos]	;'return
concerr	MOV	DL,#$10	;String too long
	JMP	runerr	;"
xcopy	POP	errpos	;Copy: get return addr
	CALL	limstind	;limit index (length)
	MOV	CX,AX	;-> CX
	POP	AX	;string pos
	CALL	chkstind	;check string index
	DEC	AX	;pos in string
	MOV	SI,SP	;addr of string
	SS:	
	MOV.B	DL,[SI]	;get length
	XOR.B	DH,DH
	MOV	DI,SP	;pos of dest
	ADD	DI,DX	;+ length
	SUB	DX,AX	;length > pos ?
	JBE	copnull	;no - return null string
	ADD	SI,AX	;begin pos of substring
	CMP	DX,CX	;length > num ?
	JBE	copend	;:yes, sub goes to end
	ADD	SI,CX	;pos end of substring
	MOV	DX,CX	;new length
	PUSH	DS	;save DS
	PUSH	SS	;SS -> ES
	POP	ES
	PUSH	SS	;SS -> DS
	POP	DS
	STD		;move string
	REPZ	
	MOVS.B	
	POP	DS	;restore DS
	JMP.b	copmovd	;'return result
copnull	XOR	DX,DX	;length = 0
copmovd	XCHG	SI,DI	;point to beg of new string
copend	SS:	
	MOV.B	[SI],DL	;store length
	MOV	SP,SI	;remove the rest
	JMP	[errpos]	;"return
xlength	POP	BX	;Length
	MOV	DI,SP	;pos of string
	SS:	
	MOV.B	AL,[DI]	;get length
	XOR.B	AH,AH	;clr hi byte
	ADD	SP,AX	;remove string from stack
	INC	SP
	JMP	BX	;"return
xpos	POP	errpos	;Pos (search substring)
	MOV	DI,SP	;pos of string
	SS:	
	MOV.B	DL,[DI]	;length of
	XOR.B	DH,DH
	INC	DI	;begin pos of string
	MOV	SI,DI	;DI:string scanned
	ADD	SI,DX	;go to beg of pattern str
	SS:	
	MOV.B	CL,[SI]	;get pattern len
	XOR.B	CH,CH
	INC	SI	;SI:pattern string
	MOV	BX,SI	;calc stack end pos
	ADD	BX,CX	;to remove strings
	XOR	AX,AX	;find position
	SUB	DX,CX	;DX:length difference
	JB	posend	;pattern too long: not found
	INC	AX	;pos 1
	OR	CX,CX	;pattern = null ?
	JZ	posend	;yes: found
	INC	DX	;number of compares
	PUSH	DS	;save DS
	PUSH	SS	;SS -> ES
	POP	ES
	PUSH	SS	;SS -> DS
	POP	DS
	CLD		;forward compare
posloop	PUSH	CX	;save parms
	PUSH	DI
	PUSH	SI
	REPZ		;compare it
	CMPS.B	
	POP	SI	;restore parms
	POP	DI
	POP	CX
	JZ	posdone	;:found
	INC	AX	;next pos
	INC	DI
	DEC	DX	;another search ?
	JNZ	posloop	;:yes
	XOR	AX,AX	;not found = 0
posdone	POP	DS	;restore DS
posend	MOV	SP,BX	;remove strings
	JMP	[errpos]	;"return
xinsert	MOV.B	strdstln,CL	;Insert: max. dest len
	MOV	strpos,AX	;pos
	POP	BX	;return addr
	POP	strtrgt	;target string ptr
	POP	strtrgt1
	MOV	strobj,SP	;object string - on stack
	MOV	strobj1,SS
	PUSH	BX	;restore ret
	LES	DI,strtrgt	;target string
	PUSH	ES	;save ptr for storing result
	PUSH	DI
	PUSH	ES	;get target string
	CALL	strload	;-> stack
	MOV	AX,#$0001	;Copy(target,1,pos-1)
	PUSH	AX
	MOV	AX,strpos
	DEC	AX
	CALL	xcopy	;do it
	LES	DI,strobj	;get obj string
	PUSH	ES
	CALL	strload	;-> stack
	CALL	xconcat	;concat strings
	LES	DI,strtrgt	;get target string
	PUSH	ES
	CALL	strload	;-> stack
	PUSH	strpos	;Copy(target,pos,255)
	MOV	AX,#$00FF
	CALL	xcopy	;do it
	CALL	xconcat	;concat strings
	MOV.B	CL,strdstln	;max. length
	CALL	strstore	;store string
	JMP	xlength	;"remove strings
xdelete	MOV	strnum,AX	;Delete: number of chars
	POP	BX	;ret addr
	POP	strpos	;pos in string
	POP	strtrgt	;target string
	POP	strtrgt1
	PUSH	BX	;restore ret
	LES	DI,strtrgt	;target string
	PUSH	ES	;save ptr for storing result
	PUSH	DI
	PUSH	ES	;get target
	CALL	strload	;-> stack
	MOV	AX,#$0001	;Copy(target,1,pos-1)
	PUSH	AX
	MOV	AX,strpos
	DEC	AX
	CALL	xcopy	;do it
	MOV	AX,strpos
	ADD	AX,strnum	;pos+num
	OR.B	AH,AH	;test it
	JNZ	delnorem	;too big: nothing left
	LES	DI,strtrgt	;get target
	PUSH	ES
	CALL	strload	;-> stack
	PUSH	AX	;Copy(target,pos+num,255)
	MOV	AX,#$00FF
	CALL	xcopy	;do it
	CALL	xconcat	;concat strings
delnorem	MOV	CL,#$FF	;max len - never a problem
	CALL	strstore	;store string
	RET		;"
xstrch	POP	BX	;String -> char
	POP	AX	;get string
	DEC.B	AL	;test length
	JNZ	stcherr	;<> 1:error
	XCHG.B	AL,AH	;char -> AL
	JMP	BX	;'return
stcherr	MOV	errpos,BX	;store error position
	MOV	DL,#$10	;String too long
	JMP	runerr	;"
xchstr	MOV	SI,SP	;string -> substring
	SS:		;(1 char)
	MOV.B	BL,[SI]$02	;length of string
	XOR.B	BH,BH
	SS:	
	MOV	AX,[BX_SI]$03	;get char
	MOV.B	AH,AL	;char
	MOV	AL,#$01	;length = 1
	SS:	
	MOV	[BX_SI]$03,AX	;store in string
	RET		;"
	POP	BX	;return string as function result
	ADD	SP,DX	;forget DX bytes on stack
	MOV	SI,SP	;pos of string
	SS:	
	MOV.B	AL,[SI]	;get its length
	CMP.B	AL,CL	;= CL (expected length) ?
	JZ	retstrt	;yes: done
	XOR.B	AH,AH
	ADD	SI,AX	;ptr to end of string
	MOV	DI,SP	;destination (must be longer)
	XOR.B	CH,CH
	ADD	DI,CX	;end of destination
	XCHG	AX,CX	;real length -> count
	INC	CX	;copy length, too
	PUSH	DS	;save DS
	PUSH	SS	;SS -> DS
	POP	DS
	PUSH	SS	;SS -> ES
	POP	ES
	STD		;move backwards
	REPZ	
	MOVS.B	
	POP	DS	;restore DS
	INC	DI
	MOV	SP,DI	;new stack top
retstrt	JMP	BX	;"return
chkstind	OR.B	AH,AH	;Check string index
	JNZ	stinderr	;> 255:error
	OR.B	AL,AL
	JZ	stinderr	;0:error
	RET		;'
stinderr	MOV	DL,#$11	;Invalid string index
	JMP	runerr	;"
	;Get set. CL=bytes used, CH=bytes empty at beginning
xldset	POP	BX	;ret addr
	POP	DX	;source seg
	MOV	SI,DI	;source ofs
	SUB	SP,#$20	;make space on stack
	MOV	DI,SP	;dest ptr
	PUSH	CX	;save crunch byte
	PUSH	SS	;SS -> ES
	POP	ES
	CLD		;forward
	OR.B	CH,CH	;empty bytes at beginning
	JZ	sld2	;:none
	XOR.B	AL,AL	;store zeroes
sldclr1	STOS.B	
	DEC.B	CH
	JNZ	sldclr1	;:another
sld2	PUSH	DS	;save DS
	MOV	DS,DX	;DX -> DS
	REPZ	
	MOVS.B		;move set
	POP	DS	;restore DS
	POP	CX	;restore crunch byte
	MOV	AH,#$20	;calculate empty bytes
	SUB.B	AH,CH	;at end
	SUB.B	AH,CL
	JZ	sld3	;:none
	XOR.B	AL,AL	;store zeroes
sldclr2	STOS.B	
	DEC.B	AH
	JNZ	sldclr2	;:another one
sld3	JMP	BX	;"return
sldempty	POP	BX	;Make empty set
	SUB	SP,#$20	;32 bytes on stack
	MOV	DI,SP	;dest addr
	PUSH	SS	;SS -> ES
	POP	ES
	MOV	CX,#$0010	;do 32 bytes
	XOR	AX,AX	;fill with zeroes
	CLD	
	REPZ	
	STOS	
	JMP	BX	;"return
setincl	CALL	setindex	;Include element: calc index
	SS:	
	OR.B	[BX],AL	;include it
	RET		;"
setinrng	XCHG	AX,CX	;Include range in set
	POP	BX	;ret addr
	POP	AX	;lower; upper is in CX
	PUSH	BX	;restore ret
	SUB.B	CL,AL	;upper < lower ?
	JB	srngnil
	XOR.B	CH,CH	;upper-lower -> count
	INC	CX
	MOV.B	AH,CL	;save count
	CALL	setindex	;calc set index (lower)
	MOV.B	CL,AH	;restore count
srngloop	SS:		;include element in set
	OR.B	[BX],AL
	SHL.B	AL,1 	;for next bit
	JNB	srngbit	;:ok
	INC	BX	;go to next byte
	MOV	AL,#$01
srngbit	LOOP	srngloop	;:another element
srngnil	RET		;"
setsto	MOV	SI,SP	;store set. CX as with load
	INC	SI
	INC	SI	;source addr
	SS:	
	MOV	DI,[SI]$20	;get dest ofs
	SS:	
	MOV	ES,[SI]$22	;dest seg
	MOV.B	DL,CH	;# empty bytes
	XOR.B	DH,DH
	ADD	SI,DX	;add to source addr
	XOR.B	CH,CH	;CL = # bytes used
	PUSH	DS	;save DS
	PUSH	SS	;SS -> DS
	POP	DS
	CLD		;move used bytes
	REPZ	
	MOVS.B	
	POP	DS	;restore DS
	RET	$0024	;"remove set, pointer
xsetparm	POP	BX	;Put set as procedure parm
	MOV.B	DL,CH	;bytes empty at beg
	XOR.B	DH,DH
	XOR.B	CH,CH	;bytes used
	MOV	SI,SP	;source addr
	ADD	SI,DX	;calc end pos
	ADD	SI,CX
	MOV	DI,SP	;dest addr
	ADD	DI,#$20
	CMP	SI,DI	;= end pos ?
	JZ	putsetrt
	DEC	SI	;go back one byte
	DEC	DI
	PUSH	DS	;save DS
	PUSH	SS	;SS -> ES
	POP	ES
	PUSH	SS	;SS -> DS
	POP	DS	;set is stored as compressed
	STD		;local var
	REPZ	
	MOVS.B		;do move it
	POP	DS	;restore DS
	INC	DI
	MOV	SP,DI	;remove empty space
putsetrt	JMP	BX	;"return
seteq	MOV	AX,#$0001	;Set comparison =
	JMP.b	setcmp	;'
setne	XOR	AX,AX	;Set comparison <>
setcmp	CALL	setptrs	;set parms
	REPZ		;compare sets
	CMPS	
	MOV	DS,DX	;restore DS
	JZ	setceq	;:equal
	XOR	AX,#$0001	;invert result
setceq	OR	AX,AX	;test result
	RET	$0040	;"remove sets from stack
setge	XOR	AX,AX	;Set comparison >=
	JMP.b	setcmp2	;'
setle	MOV	AX,#$0001	;Set comparison <=
setcmp2	CALL	setptrs	;set parms
	DEC	AX	;'test type of comparison
	JNZ	setc2l	;:<=
	XCHG	DI,SI	;swap set1, set2
setc2l	LODS		;get byte from set2
	OR	AX,[DI]	;include set1
	SCAS		;compare with set1
	JNZ	setc2g	;:not the same
	LOOP	setc2l	;:continue
	MOV	AX,#$0001	;true
	JMP.b	setc2rt	;'end it
setc2g	XOR	AX,AX	;false
setc2rt	MOV	DS,DX	;restore DS
	OR	AX,AX	;test result
	RET	$0040	;"remove sets from stack
sunion	CALL	setptrs	;Set union: set parms
sunion1	LODS		;get byte set 2
	OR	AX,[DI]	;include set 1
	STOS		;store in set 1
	LOOP	sunion1	;:continue
	MOV	DS,DX	;restore DS
	RET	$0020	;"remove set 2 from stack
sdiff	CALL	setptrs	;Set difference: set parms
sdiff1	LODS		;get byte set 2
	NOT	AX	;invert it
	AND	AX,[DI]	;take it from set 1
	STOS		;store in set 1
	LOOP	sdiff1	;:continue
	MOV	DS,DX	;restore DS
	RET	$0020	;"remove set 2 from stack
sinter	CALL	setptrs	;Set intersection: set parms
sinter1	LODS		;get byte set 2
	AND	AX,[DI]	;intersect set 1
	STOS		;store in set 1
	LOOP	sinter1	;:continue
	MOV	DS,DX	;restore DS
	RET	$0020	;"remove set 2 from stack
xsetin	MOV	BX,SP	;Set IN operation
	SS:		;pos of set
	MOV	AX,[BX]$22	;get parm
	OR.B	AH,AH	;> 255 ?
	JZ	setintst	;no: ok
	XOR	AX,AX	;false
	JMP.b	setnotin	;'return result
setintst	CALL	setindex	;calc set index
	SS:	
	AND.B	AL,[BX]	;test set element
	MOV	AX,#$0000	;false
	JZ	setnotin	;not set: false
	INC	AX	;true
setnotin	OR	AX,AX	;test result
	RET	$0022	;"remove set, parm
setindex	MOV.B	BL,AL	;Calculate set index, mask
	XOR.B	BH,BH	;BX = bit number
	MOV	CL,#$03	;bit number DIV 8
	SHR	BX,CL
	ADD	BX,#$04	;+SP+4 -> set ptr
	ADD	BX,SP
	MOV.B	CL,AL	;bit number MOD 8
	AND.B	CL,#$07
	MOV	AL,#$01	;create bit mask
	SHL.B	AL,CL
	RET		;"
setptrs	MOV	SI,SP	;Set parms for set ops
	ADD	SI,#$04	;ptr set 2
	MOV	DI,SP	;skip two ret addrs
	ADD	DI,#$24	;ptr set 1
	MOV	DX,DS	;save DS
	PUSH	SS	;SS -> ES
	POP	ES
	PUSH	SS	;SS -> DS
	POP	DS
	MOV	CX,#$0010	;count: 32 bytes
	CLD	
	RET		;"
ptreq	CMP	AX,BX	;Compare pointers DX:AX = CX:BX
	MOV	AX,#$0000	;false
	JNZ	ptreqno	;:not equal
	CMP	DX,CX
	JNZ	ptreqno	;:not equal
	INC	AX	;true
ptreqno	OR	AX,AX	;set flags
	RET		;"
ptrne	CMP	AX,BX	;Compare pointers <>
	MOV	AX,#$0001	;true
	JNZ	ptrne1	;not equal: true
	CMP	DX,CX
	JNZ	ptrne1	;not equal: true
	DEC	AX	;false
ptrne1	OR	AX,AX	;set flags
	RET		;"
	;*** Real Operations ***
	;#1 #2 register usage
	;AX CX LSB, exponent
	;BX SI mantissa
	;DX DI MSB, sign
resub	MOV	resign,#$8000	;Do real subtraction
	JMP.b	ra1	;'
readd	MOV	resign,#$0000	;Do real addition
ra1	OR.B	CL,CL	;second = 0 ?
	JZ	raret	;:yes, done
	XOR	DI,resign	;change sign2, if sub
	OR.B	AL,AL	;first = 0 ?
	JNZ	ranotriv	;:no
raretn2	MOV	AX,CX	;second -> result
	MOV	BX,SI
	MOV	DX,DI
raret	RET		;'
ranotriv	CMP.B	AL,CL	;compare exponents
	JBE	ranoswap	;AL <= CL !
	XCHG	AX,CX	;otherwhise swap numbers
	XCHG	BX,SI
	XCHG	DX,DI
ranoswap	MOV.B	cvdecexp,CL	;save exp2
	SUB.B	CL,AL	;exponent difference
	CMP.B	CL,#$28	;first number too small ?
	JB	ranoundr	;:no
	MOV.B	CL,cvdecexp	;restore exp2
	JMP	raretn2	;'second -> result
ranoundr	MOV	resign,DI	;save MSB 2
	AND.B	resave,#$80	;mask out mantissa
	MOV	remant,DI	;save MSB 2
	XOR.B	remant1,DH
	OR	DI,#$8000	;remove sign
	OR.B	DH,#$80	;remove sign
raadj16l	CMP.B	CL,#$10	;shift first in 16-bit-steps
	JB	raadj8	;:done
	MOV.B	AH,BH	;do it.
	MOV	BX,DX	;first num is shifted to make
	XOR	DX,DX	;exp1 = exp2
	SUB.B	CL,#$10
	JMP	raadj16l	;'try again
raadj8	CMP.B	CL,#$08	;shift first in 8-bit-steps
	JB	raadj8l	;:done
	MOV.B	AH,BL	;do it
	MOV.B	BL,BH
	MOV.B	BH,DL
	MOV.B	DL,DH
	XOR.B	DH,DH
	SUB.B	CL,#$08	;count down difference
raadj8l	OR.B	CL,CL	;test difference
	JZ	raadjend	;:adjustment done
raadj1l	SHR	DX,1 	;shift right in 1-bit-steps
	RCR	BX,1 
	RCR.B	AH,1 
	DEC.B	CL
	JNZ	raadj1l	;:continue
raadjend	MOV	AL,cvdecexp	;get exp2
	TEST.B	remant1,#$80	;test sign
	JNZ	radosub	;:negative
	ADD.B	AH,CH	;add mantissa
	ADC	BX,SI
	ADC	DX,DI
	JNB	rasign	;:ok
	RCR	DX,1 	;do normalization
	RCR	BX,1 
	RCR.B	AH,1 
	INC.B	AL	;inc exponent
	JNZ	rasign	;:ok
	STC		;overflow error
	RET		;'
radosub	XCHG.B	AH,CH	;exchange numbers
	XCHG	BX,SI
	XCHG	DX,DI
	SUB.B	AH,CH	;subtract numbers
	SBB	BX,SI
	SBB	DX,DI
	JNB	ranoneg	;:no underflow
	XOR.B	resave,#$80	;change sign
	NOT.B	AH	;negate mantissa
	NOT	BX	;= inverted mantissa + 1
	NOT	DX
	ADD.B	AH,#$01
	ADC	BX,#$00
	ADC	DX,#$00
ranoneg	MOV	CL,#$05	;normalize number
ranrm8l	OR.B	DH,DH	;upper byte empty ?
	JNZ	ranrm1l	;:no
	MOV.B	DH,DL	;shift left 8 bits
	MOV.B	DL,BH
	MOV.B	BH,BL
	MOV.B	BL,AH
	XOR.B	AH,AH
	SUB	AL,#$08	;sub 8 from exp
	JB	razero	;:underflow, return 0
	DEC.B	CL	;count down bytes
	JNZ	ranrm8l	;:another one
	JMP.b	razero	;'underflow
ranrm1l	TEST.B	DH,#$80	;Mantissa MSB must be 1
	JNZ	rasign	;:yes, done
	SHL.B	AH,1 	;shift left 1 bit
	RCL	BX,1 
	RCL	DX,1 
	DEC.B	AL	;sub 1 from exp
	JNZ	ranrm1l	;:ok
razero	XOR	AX,AX	;underflow, return zero
	XOR	BX,BX
	XOR	DX,DX
	RET		;'
rasign	AND.B	DH,#$7F	;clear MSB mantissa
	XOR.B	DH,resave	;set correct sign
	RET		;"
remult	OR.B	CL,CL	;Real multiplication: second=0 ?
	JZ	rmzero	;yes: return zero
	OR.B	AL,AL	;first=0 ?
	JZ	rmret	;yes: done
	ADD.B	AL,CL	;add exponents
	CALL	testexp	;test exponent
	MOV	remul11,AX	;save first number
	MOV	remul12,BX
	MOV	remul13,DX
	XOR.B	AH,AH	;clear result
	XOR	BX,BX
	XOR	DX,DX
	MOV	DI,#remul21	;ptr to second mantissa
	MOV	CL,#$05	;do 5 bytes
rmbyt	INC	DI	;get byte from second mantissa
	MOV.B	CH,[DI]
	OR.B	CH,CH	;0 ?
	JNZ	rmdomul	;no: do multiplication
	MOV.B	AH,BL	;just shift result
	MOV.B	BL,BH	;8 bits right
	MOV.B	BH,DL
	MOV.B	DL,DH
	XOR.B	DH,DH
	JMP.b	rmnxtbyt	;'next step
rmdomul	MOV	SI,#$0008	;do 8 bits
rmmul	RCR.B	CH,1 	;get bit
	JNB	rmbit0	;:not set
	ADD.B	AH,remul11a	;add mantissa 1 to result
	ADC	BX,remul12
	ADC	DX,remul13
rmbit0	RCR	DX,1 	;shift result 1 bit right
	RCR	BX,1 
	RCR.B	AH,1 
	DEC	SI	;another bit ?
	JNZ	rmmul	;:yes
rmnxtbyt	DEC.B	CL	;another byte ?
	JNZ	rmbyt	;:yes
	XCHG	AX,CX	;save AX, CL
	LAHF		;save flags
	TEST.B	DH,#$80	;already normalized ?
	JNZ	rmnoadj	;:yes
	SAHF		;restore flags
	RCL.B	CH,1 	;shift 1 bit left
	RCL	BX,1 
	RCL	DX,1 
	OR.B	CL,CL	;check exp
	JZ	rmnoadj	;:underflow
	DEC.B	CL	;sub 1 from exp
rmnoadj	XCHG	AX,CX	;restore AX, CL
	XOR.B	DH,resave	;set sign
	OR.B	AL,AL	;test exponent
	JNZ	rmret	;:ok
rmzero	XOR	AX,AX	;return zero
	XOR	BX,BX
	XOR	DX,DX
rmret	RET		;"
rediv	OR.B	AL,AL	;Real division
	JZ	rmret	;first=0:done
	SUB.B	AL,CL	;sub exponents
	CMC	
	CALL	testexp	;test exponent
	MOV	remul11,AL	;save exponent
	MOV	DI,#remul21b	;ptr to dest
	MOV	CL,#$05	;5 bytes
	MOV	SI,#$0008	;8 bits
rdloop	CMP	DX,remul23	;compare with num2
	JNZ	rdcmp
	CMP	BX,remul22
	JNZ	rdcmp