TP3/Resources/turbopascal3source/TP3/TPSRC3

	CMP.B	AH,remul21a
rdcmp	JB	rdshft	;below:no subtraction
	SUB.B	AH,remul21a	;do subtraction
	SBB	BX,remul22
	SBB	DX,remul23
rdshft	CMC		;invert carry
	RCL.B	CH,1 	;shift into result
	DEC	SI	;another bit ?
	JNZ	rdbit	;:yes
	MOV.B	[DI],CH	;store result byte
	DEC.B	CL	;another byte ?
	JZ	rdlast	;:no
	DEC	DI	;next one
	MOV	SI,#$0008	;8 bits again
rdbit	SHL.B	AH,1 	;shift left mantissa
	RCL	BX,1 
	RCL	DX,1 
	JNB	rdloop	;:normal step
	SUB.B	AH,remul21a	;carry: no comparison necessary
	SBB	BX,remul22	;do subtraction
	SBB	DX,remul23
	CLC	
	JMP	rdshft	;'shift in result
rdlast	SHL.B	AH,1 	;do last shift
	RCL	BX,1 
	RCL	DX,1 
	JB	rdshft2	;:ok
	CMP	DX,remul23	;test last step
	JNZ	rdcmp2
	CMP	BX,remul22
	JNZ	rdcmp2
	CMP.B	AH,remul21a
rdcmp2	CMC	
rdshft2	MOV	CX,remul11	;get result
	MOV	BX,remul12
	MOV	DX,remul13
	LAHF		;save flags
	TEST.B	DH,#$80	;normalized ?
	JNZ	rdnrm	;:yes
	SAHF		;get flags
	RCL.B	CH,1 	;shift left mantissa
	RCL	BX,1 
	RCL	DX,1 
	JMP.b	rdok	;'get sign, test exponent
rdnrm	INC.B	CL	;inc exponent
	JNZ	rdok	;:ok
	STC		;overflow error
	RET		;'
rdok	JMP	rmnoadj	;"set sign, test exponent
testexp	JB	texovr	;test exponent: overflow ?
	ADD	AL,#$80	;set offset again
	JB	texok	;:ok
	POP	BX	;forget return addr
	XOR	AX,AX	;return zero: underflow
	XOR	BX,BX
	XOR	DX,DX
	RET		;'
texovr	ADD	AL,#$80	;set offset again
	JNB	texok	;:no error
	POP	BX	;forget return addr
	STC		;overflow error
	RET		;'
texok	MOV	remul21,CX	;save LSB2
	MOV	CX,DX	;get sign
	XOR	CX,DI
	NOT.B	CH	;invert it
	AND.B	CH,#$80	;mask sign
	MOV.B	resave,CH	;save sign
	OR.B	DH,#$80	;set mantissa MSB
	OR	DI,#$8000
	MOV	remul22,SI	;store mantissa 2
	MOV	remul23,DI
	RET		;"
readd2	PUSH	DI	;add, keep second number
	PUSH	SI
	PUSH	CX
	CALL	readd	;do addition
	POP	CX
	POP	SI
	POP	DI
	RET		;"
resub2	PUSH	DI	;subtract, keep second number
	PUSH	SI
	PUSH	CX
	CALL	resub	;do subtraction
	POP	CX
	POP	SI
	POP	DI
	RET		;"
remult2	PUSH	DI	;multiply, keep second number
	PUSH	SI
	PUSH	CX
	CALL	remult	;do multiplication
	POP	CX
	POP	SI
	POP	DI
	RET		;"
rediv2	PUSH	DI	;divide, keep second number
	PUSH	SI
	PUSH	CX
	CALL	rediv	;do division
	POP	CX
	POP	SI
	POP	DI
	RET		;"
recmp	PUSH	DX	;Real comparison
	XOR	DX,DI	;compare signs
	POP	DX	;restore
	JNS	rcsign	;:signs are the same
	PUSH	DX	;different signs: get flag
	RCL	DX,1 
	POP	DX
	RET		;'
rcsign	TEST.B	DH,#$80	;sign ?
	JZ	rcnum	;:positive
	CALL	rcnum	;compare
	JZ	rcdiff	;equal: don't invert
	CMC		;invert flags
	RET		;'
rcnum	CMP.B	AL,CL	;compare exponents
	JNZ	rcdiff
	OR.B	AL,AL	;zero ?
	JZ	rcdiff	;yes:equal
	CMP	DX,DI	;compare mantissa MSB
	JNZ	rcdiff
	CMP	BX,SI
	JNZ	rcdiff
	CMP.B	AH,CH	;compare mantissa LSB
rcdiff	RET		;"
intreal	OR	AX,AX	;Int(Integer) -> Real
	JNZ	irnot0	;:not zero
	XOR	BX,BX	;return zero
	XOR	DX,DX
	RET		;'
irnot0	MOV.B	BH,AH	;put sign
	MOV	DX,AX
	OR	DX,DX	;test sign
	JNS	irpos	;:positive
	NEG	DX	;negate number
irpos	MOV	AX,#$0090	;exp, cleared LSB mantissa
	OR.B	DH,DH	;test high byte
	JNZ	ir16bits	;:not zero
	MOV	AL,#$88	;speed it up...
	XCHG.B	DL,DH	;shift 8 bits
ir16bits	OR	DX,DX	;test mantissa MSB
	JS	irdone	;:ok, normalized
irnrm	DEC.B	AL	;count down exponent
	SHL	DX,1 	;shift it left
	JNS	irnrm	;:continue
irdone	OR.B	BH,BH	;negative ?
	JS	irpos2	;:yes
	AND.B	DH,#$7F	;set positive flag
irpos2	XOR	BX,BX	;clear rest of mantissa
	RET		;"
reint	CMP	AL,#$A8	;Int(Real) - inefficient !
	JNB	riret	;exponent too big - done
	MOV	CX,AX	;save number
	MOV	SI,BX
	MOV	DI,DX
	XOR.B	AH,AH	;clear mask
	XOR	BX,BX
	XOR	DX,DX
	SUB.B	CL,#$80	;exponent-offset
	JBE	rizero	;:underflow, return zero
rim16l	CMP.B	CL,#$10	;shift 16 bit ?
	JB	rim8	;:done
	MOV.B	AH,BH	;shift right 16 bit
	MOV	BX,DX
	MOV	DX,#$FFFF	;put into mask
	SUB.B	CL,#$10	;count down
	JMP	rim16l	;'try again
rim8	CMP.B	CL,#$08	;shift 8 bit ?
	JB	rim1	;:done
	MOV.B	AH,BL	;shift right 8 bit
	MOV.B	BL,BH
	MOV.B	BH,DL
	MOV.B	DL,DH
	MOV	DH,#$FF	;put into mask
	SUB.B	CL,#$08	;count down
rim1	OR.B	CL,CL	;shift single bits ?
	JZ	riand	;:done
rim1l	STC		;shift in a 1
	RCR	DX,1 	;shift right 1 bit
	RCR	BX,1 
	RCR.B	AH,1 
	DEC.B	CL	;count down
	JNZ	rim1l	;:continue shifting
riand	AND	DX,DI	;get result:
	AND	BX,SI	;mask away the fraction
	AND.B	AH,CH
riret	RET		;'
rizero	XOR.B	AL,AL	;return zero
	RET		;"
refrac	PUSH	DX	;Frac - inefficient !
	PUSH	BX	;save original number
	PUSH	AX
	CALL	reint	;Int
	MOV	CX,AX	;result -> second number
	MOV	SI,BX
	MOV	DI,DX
	POP	AX	;restore number
	POP	BX
	POP	DX
	JMP	resub	;"do subtraction
xldreal	POP	BX	;Load real number onto stack
	POP	ES	;ptr
	ES:	
	PUSH	[DI]$04	;push that number
	ES:	
	PUSH	[DI]$02
	ES:	
	PUSH	[DI]
	JMP	BX	;"return
xrealcn	POP	BX	;Get real constant (inline)
	CS:		;get return addr
	PUSH	[BX]$04	;push that number
	CS:	
	PUSH	[BX]$02
	CS:	
	PUSH	[BX]
	ADD	BX,#$06	;skip constant
	JMP	BX	;"return
xstoreal	POP	BX	;Store real number
	POP	AX	;get number
	POP	CX
	POP	DX
	POP	DI	;get dest ptr
	POP	ES
	ES:		;store number
	MOV	[DI],AX
	ES:	
	MOV	[DI]$02,CX
	ES:	
	MOV	[DI]$04,DX
	JMP	BX	;"return
xadd	POP	errpos	;Add real numbers
	POP	CX	;second number
	POP	SI
	POP	DI
	POP	AX	;first number
	POP	BX
	POP	DX
	CALL	readd	;do addition
retest	JB	reovrerr	;:error
repush	PUSH	DX	;store result on stack
	PUSH	BX
	PUSH	AX
	JMP	[errpos]	;'return
reovrerr	MOV	DL,#$01	;Floating point overflow
	JMP	runerr	;"
xsub	POP	errpos	;Subtract real numbers
	POP	CX	;second number
	POP	SI
	POP	DI
	POP	AX	;first number
	POP	BX
	POP	DX
	CALL	resub	;do subtraction
	JMP	retest	;"put result, return
xmul	POP	errpos	;Multiply real numbers
	POP	CX	;second number
	POP	SI
	POP	DI
	POP	AX	;first number
	POP	BX
	POP	DX
xmul2	CALL	remult	;do multiplication
	JMP	retest	;"put result, return
xdiv	POP	errpos	;Divide real numbers
	POP	CX	;second number
	POP	SI
	POP	DI
	POP	AX	;first number
	POP	BX
	POP	DX
	OR.B	CL,CL	;second = 0 ?
	JZ	xdiverr	;yes: div / 0 error
	CALL	rediv	;divide
	JMP	retest	;'put result, return
xdiverr	MOV	DL,#$02	;Division by zero attempted
	JMP	runerr	;"
xneg	MOV	BX,SP	;Neg real: get addr of number
	SS:	
	CMP.B	[BX]$02,#$00	;zero ?
	JZ	xnegzer	;:don't negate
	SS:	
	XOR.B	[BX]$07,#$80	;invert sign
xnegzer	RET		;"
xabs	MOV	BX,SP	;Abs real: get addr of number
	SS:	
	AND.B	[BX]$07,#$7F	;make positive
	RET		;"
realeq	POP	errpos	;Real =
	POP	CX	;second number
	POP	SI
	POP	DI
	POP	AX	;first number
	POP	BX
	POP	DX
	CALL	recmp	;compare real
	PUSH	errpos	;restore ret
	MOV	AX,#$0001	;true
	JZ	realeq1	;equal: true
	DEC	AX	;false
realeq1	OR	AX,AX	;set flags
	RET		;"
realne	POP	errpos	;Real <>
	POP	CX	;second number
	POP	SI
	POP	DI
	POP	AX	;first number
	POP	BX
	POP	DX
	CALL	recmp	;compare real
	PUSH	errpos	;restore ret
	MOV	AX,#$0001	;true
	JNZ	realne1	;not equal: true
	DEC	AX	;false
realne1	OR	AX,AX	;set flags
	RET		;"
realge	POP	errpos	;Real >=
	POP	CX	;second number
	POP	SI
	POP	DI
	POP	AX	;first number
	POP	BX
	POP	DX
	CALL	recmp	;compare real
	PUSH	errpos	;restore ret
	MOV	AX,#$0001	;true
	JNB	realge1	;larger or equal: true
	DEC	AX	;false
realge1	OR	AX,AX	;set flags
	RET		;"
realle	POP	errpos	;Real <=
	POP	CX	;second number
	POP	SI
	POP	DI
	POP	AX	;first number
	POP	BX
	POP	DX
	CALL	recmp	;compare real
	PUSH	errpos	;restore ret
	MOV	AX,#$0001	;true
	JBE	realle1	;smaller or equal: true
	DEC	AX	;false
realle1	OR	AX,AX	;set flags
	RET		;"
realg	POP	errpos	;Real >
	POP	CX	;second number
	POP	SI
	POP	DI
	POP	AX	;first number
	POP	BX
	POP	DX
	CALL	recmp	;compare real
	PUSH	errpos	;restore ret
	MOV	AX,#$0001	;true
	JA	realg1	;larger: true
	DEC	AX	;false
realg1	OR	AX,AX	;set flags
	RET		;"
reall	POP	errpos	;Real <
	POP	CX	;second number
	POP	SI
	POP	DI
	POP	AX	;first number
	POP	BX
	POP	DX
	CALL	recmp	;compare real
	PUSH	errpos	;restore ret
	MOV	AX,#$0001	;true
	JB	reall1	;smaller: true
	DEC	AX	;false
reall1	OR	AX,AX	;set flags
	RET		;"
xsqr	POP	errpos	;Sqr real: save ret addr
	POP	AX	;get number
	POP	BX
	POP	DX
	MOV	CX,AX	;-> second number
	MOV	SI,BX
	MOV	DI,DX
	JMP	xmul2	;"do real multiplication
xint	POP	errpos	;Int real: save ret addr
	POP	AX	;get number
	POP	BX
	POP	DX
	CALL	reint	;do Int
	JMP	repush	;"push result
xfrac	POP	errpos	;Frac real: save ret addr
	POP	AX	;get number
	POP	BX
	POP	DX
	CALL	refrac	;do Frac
	JMP	repush	;"push result
xrandom	CALL	dorandom	;Random real
	MOV	DX,#$0080	;original exponent
	MOV	AL,#$20	;max. count
rrndnrm	TEST.B	BH,#$80	;normalized ?
	JNZ	rrndok	;:yes
	SHL	CX,1 	;shift left 1 bit
	RCL	BX,1 
	DEC.B	DL	;count down exponent
	DEC.B	AL	;another bit ?
	JNZ	rrndnrm	;:yes
	XOR.B	DL,DL	;return zero
rrndok	AND.B	BH,#$7F	;clear mantissa MSB
	POP	AX	;ret addr
	PUSH	BX	;push result
	PUSH	CX
	PUSH	DX
	JMP	AX	;"return
xround	MOV	CH,#$FF	;Round
	JMP.b	trunc1	;'
xtrunc	XOR.B	CH,CH	;Trunc
trunc1	POP	BX	;ret addr
	POP	AX	;get number
	POP	DX
	POP	DX
	PUSH	BX	;restore ret
trunc2	XCHG	AX,DX	;put exp
	MOV	CL,#$8F	;subtract exponent
	SUB.B	CL,DL	;too big ?
	JB	truncerr	;:overflow error
	CMP.B	CL,#$0F	;too many shifts ?
	JA	trunczer	;yes: 0
	INC.B	CL
	MOV.B	BH,AH	;save sign
	OR.B	AH,#$80	;set mantissa MSB
	SHR	AX,CL	;shift right
	JNB	trunc3	;:nothing to round
	OR.B	CH,CH	;round up ?
	JZ	trunc3	;:no
	INC	AX	;round it up
	JS	truncerr	;overflow: error
trunc3	TEST.B	BH,#$80	;sign ?
	JZ	truncrt	;:no
	NEG	AX	;negate it
truncrt	RET		;'
trunczer	XOR	AX,AX	;return 0
	RET		;'
truncerr	MOV	DL,#$92	;Out of integer range
	JMP	runerrrt	;"
xintreal	CALL	intreal	;Integer -> Real
	POP	CX	;get ret
	PUSH	DX	;push number
	PUSH	BX
	PUSH	AX
	JMP	CX	;"return
xintre2	POP	errpos	;Int -> Real
	POP	CX	;keep second number
	POP	SI
	POP	DI
	POP	AX	;integer number
	CALL	intreal	;do conversion
	PUSH	DX	;push result
	PUSH	BX
	PUSH	AX
	PUSH	DI	;push second number
	PUSH	SI
	PUSH	CX
	JMP	[errpos]	;"return
	;Square root. Algorithm: Newton
	;x[n+1]:=0.5*(x[n]+c/x[n]) -> Sqrt(c)
xsqrt	POP	errpos	;Sqrt: save ret addr
	POP	AX	;get number
	POP	BX
	POP	DX
	MOV	CX,AX	;-> second number
	MOV	SI,BX
	MOV	DI,DX
	OR.B	AL,AL	;zero ?
	JZ	sqrtdone	;yes: return
	TEST.B	DH,#$80	;test sign
	JNZ	sqrterr	;negative: error
	MOV	retrc1,AX	;store number
	MOV	retrc2,BX
	MOV	retrc3,DX
	ADD.B	CL,#$80	;make a guess for the
	SAR.B	CL,1 	;exponent
	ADD.B	CL,#$80
	MOV.B	AL,CL
	SUB	AL,#$14	;end condition: difference
	MOV	cvexpcnt,AL	;smaller than this
sqrtloop	MOV	AX,retrc1	;get original number
	MOV	BX,retrc2
	MOV	DX,retrc3
	CALL	rediv2	;real division /x[n]
	CALL	readd2	;real addition +x[n]
	DEC.B	AL	;* 0.5 = dec exponent
	PUSH	DX	;save x[n+1]
	PUSH	BX
	PUSH	AX	;test: end reached ?
	CALL	resub	;real subtraction
	CMP.B	AL,cvexpcnt	;test exponent
	POP	CX	;restore x[n+1]
	POP	SI
	POP	DI
	JNB	sqrtloop	;:not yet done
sqrtdone	PUSH	DI	;return result
	PUSH	SI
	PUSH	CX
	JMP	[errpos]	;'return
sqrterr	MOV	DL,#$03	;Sqrt argument error
	JMP	runerr	;"
	;*** Transcendental functions ***
	;The algorithms used can be looked up in any formulary (!!!)
xcos	POP	errpos	;Cos: save ret addr
	POP	CX	;get number
	POP	SI
	POP	DI
	MOV	AX,#$2181	;-pi/2
	MOV	BX,#$DAA2
	MOV	DX,#$490F
	CALL	resub	;real subtraction
	JMP.b	sin1	;'
xsin	POP	errpos	;Sin: save ret addr
	POP	AX	;get number
	POP	BX
	POP	DX
sin1	CMP	AL,#$6C	;small number ?
	JB	sinpush	;yes: return immediately
	MOV	CX,#$2183	;2*pi
	MOV	SI,#$DAA2	;bring into range 0..2*pi
	MOV	DI,#$490F
	PUSH	DX	;save sign
	AND.B	DH,#$7F	;make positive
	CALL	recmp	;real comparison
	POP	DX	;restore sign
	JB	sinl2pi	;:ok
	CALL	rediv2	;real division, keep 2*pi
	PUSH	DI	;save 2*pi
	PUSH	SI
	PUSH	CX
	CALL	refrac	;Frac
	POP	CX	;restore 2*pi
	POP	SI
	POP	DI
	CALL	remult2	;real mult, keep 2*pi
sinl2pi	TEST.B	DH,#$80	;negative ?
	JZ	sinpos	;:no
	CALL	readd2	;add 2*pi
sinpos	DEC.B	CL	;change to pi
	CALL	recmp	;real comparison
	PUSHF		;save result
	JB	sinlpi	;:below
	CALL	resub2	;subtract pi
sinlpi	DEC.B	CL	;change to pi/2
	CALL	recmp	;real comparison
	JB	sinlpi2	;:less
	INC.B	CL
	OR.B	DH,#$80	;add -pi
	CALL	readd
sinlpi2	CMP	AL,#$6C	;small number ?
	JB	sinsmall	;yes:return
	MOV	DI,#fltsin	;pointer to constants
	MOV	CX,#$0007	;7 numbers
	CALL	poly1	;do polynome
sinsmall	POPF		;flag: >pi
	JB	sinpush	;:ok
	OR.B	AL,AL	;neg, if not zero
	JZ	sinpush	;:zero
	XOR.B	DH,#$80	;negate
sinpush	JMP	repush	;"push result
fltsin	W	$9D58,$9F39,$D73F	;-7.6471637318E-13	;-1/15! constants for sin,cos
	W	$4360,$309D,$3092	; 1.6059043837E-10	; 1/13!
	W	$AA67,$283F,$D732	;-2.5052103056E-08	;-1/11!
	W	$B66E,$1D2A,$38EF	; 2.7557319224E-06	; 1/ 9!
	W	$0D74,$00D0,$D00D	;-1.9841269841E-04	;-1/ 7!
	W	$887A,$8888,$0888	; 8.3333333333E-03	; 1/ 5!
	W	$AB7E,$AAAA,$AAAA	;-1.6666666667E-01	;"-1/ 3!
xln	POP	errpos	;Ln (Logarithm)
	POP	AX	;get number
	POP	BX
	POP	DX
	OR.B	AL,AL	;zero ?
	JZ	lnerr	;yes:error
	TEST.B	DH,#$80	;negative ?
	JZ	lnok	;:no
lnerr	MOV	DL,#$04	;Ln argument error
	JMP	runerr	;'
lnok	MOV.B	CH,AH	;sign, LSB
	MOV	CL,#$81	;bring into range 1..2
	SUB.B	AL,CL	;modify exponent
	CBW	
	PUSH	AX	;integer: exponent
	XCHG	AX,CX	;set new exponent
	MOV	CX,#$FB80	;multiply *Sqrt(2)/2
	MOV	SI,#$F333
	MOV	DI,#$3504
	CALL	remult	;multiplication
	MOV	CX,AX	;first -> second number
	MOV	SI,BX
	MOV	DI,DX
	MOV	AX,#$0081	;first number = 1
	XOR	BX,BX
	XOR	DX,DX
	CALL	readd2	;addition +1
	PUSH	DX	;save result
	PUSH	BX
	PUSH	AX
	MOV	AX,#$0081	;first = -1
	XOR	BX,BX
	MOV	DX,#$8000
	CALL	readd	;addition -1
	POP	CX	;restore result
	POP	SI
	POP	DI
	CALL	rediv	;division (c-1)/(c+1)
	MOV	DI,#fltln	;pointer to constants
	MOV	CX,#$0006	;6 numbers
	CALL	poly1	;do polynome
	INC.B	AL	;result *2
	MOV	CX,#$D27F	;+ ln(sqrt(2))
	MOV	SI,#$17F7
	MOV	DI,#$3172
	CALL	readd	;addition
	POP	CX	;get int exponent
	PUSH	DX	;save result
	PUSH	BX
	PUSH	AX
	XCHG	AX,CX	;exponent
	CALL	intreal	;-> real
	MOV	CX,#$D280	;* ln(2)
	MOV	SI,#$17F7
	MOV	DI,#$3172
	CALL	remult	;multiplication
	POP	CX	;restore result
	POP	SI
	POP	DI
	CALL	readd	;add
	CMP	AL,#$67	;do a cosmetic round-off (!!!)
	JNB	lnround	;:no
	XOR	AX,AX	;return zero
	XOR	BX,BX
	XOR	DX,DX
lnround	JMP	repush	;"push result
fltln	W	$8A7D,$D89D,$1D89	; 7.6923076923E-02	;1/13 Constants for Ln
	W	$E97D,$8BA2,$3A2E	; 9.0909090909E-02	;1/11
	W	$8E7D,$38E3,$638E	; 1.1111111111E-01	;1/ 9
	W	$497E,$2492,$1249	; 1.4285714286E-01	;1/ 7
	W	$CD7E,$CCCC,$4CCC	; 2.0000000000E-01	;1/ 5
	W	$AB7F,$AAAA,$2AAA	; 3.3333333333E-01	;"1/ 3
xexp	POP	errpos	;Exp: get return addr
	POP	AX	;get number
	POP	BX
	POP	DX
	TEST.B	DH,#$80	;negative ?
	PUSHF		;remember flag
	AND.B	DH,#$7F	;make it positive
	MOV	CX,#$D280	;/ln(2)
	MOV	SI,#$17F7
	MOV	DI,#$3172	;(would be faster to use mult !)
	CALL	rediv	;division
	CMP	AL,#$88	;too much ?
	JNB	experr	;:yes, overflow
	PUSH	DX	;save number
	PUSH	BX
	PUSH	AX
	INC.B	AL	;* 2
	MOV	CH,#$FF
	CALL	trunc2	;do Round
	POP	CX	;restore number
	POP	SI
	POP	DI
	PUSH	AX	;save integer part
	CALL	intreal	;convert -> real
	OR.B	AL,AL	;zero ?
	JZ	expzer	;:yes
	DEC.B	AL	;/ 2
expzer	XCHG	AX,CX	;swap them
	XCHG	BX,SI
	XCHG	DX,DI
	CALL	resub	;subtraction -> frac
	MOV	DI,#fltexp	;ptr to constants
	MOV	CX,#$0008	;8 numbers
	CALL	poly2	;do polynome
	POP	CX	;get exponent
	SHR	CX,1 	;/ 2
	JNB	expeven	;:even
	PUSH	CX	;save it
	MOV	CX,#$FB81	;* Sqrt(2)
	MOV	SI,#$F333
	MOV	DI,#$3504
	CALL	remult	;multiplication
	POP	CX	;restore exponent
expeven	ADD.B	AL,CL	;add exponents
	JB	experr	;:overflow error
	POPF		;restore sign
	JZ	exppush	;pos: store result
	MOV	CX,AX	;negative: do 1/x -> x
	MOV	SI,BX	;first -> second
	MOV	DI,DX
	MOV	AX,#$0081	;first = 1
	XOR	BX,BX
	XOR	DX,DX
	CALL	rediv	;division
exppush	JMP	repush	;'push result
experr	POP	AX	;clear stack
	MOV	DL,#$01	;Floating point overflow
	JMP	runerr	;"
fltexp	W	$2E6D,$111D,$3160	; 1.3215486790E-06	;ln(2)**8/8! Constants for Exp
	W	$4670,$FE2C,$7FE5	; 1.5252733804E-05	;ln(2)**7/7!
	W	$3674,$897C,$2184	; 1.5403530393E-04	;ln(2)**6/6!
	W	$5377,$FF3C,$2EC3	; 1.3333558146E-03	;ln(2)**5/5!
	W	$D27A,$5B7D,$1D95	; 9.6181291076E-03	;ln(2)**4/4!
	W	$257C,$46B8,$6358	; 5.5504108665E-02	;ln(2)**3/3!
	W	$167E,$EFFC,$75FD	; 2.4022650696E-01	;ln(2)**2/2!
	W	$D280,$17F7,$3172	; 6.9314718056E-01	;"ln(2)
xarctan	POP	errpos	;ArcTan: get ret addr
	POP	AX	;get number
	POP	BX
	POP	DX
	OR.B	AL,AL	;zero ?
	JZ	exppush	;yes: return
	XOR	CX,CX	;clear neg flag
	TEST.B	DH,#$80	;negative ?
	JZ	atnpos	;:no
	INC	CX	;set neg flag
	AND.B	DH,#$7F	;make positive
atnpos	PUSH	CX	;save neg flag
	MOV	CX,#$0081	;second = 1
	XOR	SI,SI
	XOR	DI,DI
	CALL	recmp	;real comparison
	JB	atnsmall	;:x < 1
	XCHG	AX,CX	;swap numbers
	XCHG	BX,SI
	XCHG	DX,DI
	CALL	rediv	;division x -> 1/x
	POP	CX	;restore neg flag
	INC	CX	;set bits: large number
	INC	CX
	PUSH	CX	;push it again
atnsmall	MOV	CX,#$4A7E	;> 0.1371 ?
	MOV	SI,#$E98E
	MOV	DI,#$0C6F
	CALL	recmp	;real comparison
	JNB	atnrng	;:yes
	CALL	atnpoly	;do polynome
	JMP.b	atndone	;'complete result
atnrng	MOV	DI,#fltatnrg	;pointer into table
	MOV	CX,#$0002
atnrlp	PUSH	CX	;save index
	PUSH	DI	;save ptr
	CS:		;test different ranges
	MOV	CX,[DI]	;get table entry
	CS:	
	MOV	SI,[DI]$02
	CS:	
	MOV	DI,[DI]$04
	CALL	recmp	;real comparison
	POP	DI	;restore
	POP	CX
	JB	atnrfnd	;:smaller than that
	ADD	DI,#$12	;go to next entry
	LOOP	atnrlp	;:another one
	SUB	DI,#$06	;save space in table
atnrfnd	ADD	DI,#$06	;go to associated number
	MOV	retrc1,AX	;save number
	MOV	retrc2,BX
	MOV	retrc3,DX
	PUSH	DI	;save ptr
	CS:		;get number from table
	MOV	CX,[DI]
	CS:	
	MOV	SI,[DI]$02
	CS:	
	MOV	DI,[DI]$04
	CALL	resub2	;subtraction x-t
	PUSH	DX	;save number
	PUSH	BX
	PUSH	AX
	MOV	AX,retrc1	;restore x
	MOV	BX,retrc2
	MOV	DX,retrc3
	CALL	remult	;x*t
	MOV	CX,#$0081	;second = 1
	XOR	SI,SI
	XOR	DI,DI
	CALL	readd	;addition
	MOV	CX,AX	;first -> second
	MOV	SI,BX
	MOV	DI,DX
	POP	AX	;restore x-t
	POP	BX
	POP	DX
	CALL	rediv	;division -> (x-t)/(x*t+1)
	CALL	atnpoly	;do polynome
	POP	DI	;restore ptr
	ADD	DI,#$06
	CS:	
	MOV	CX,[DI]	;get number
	CS:	
	MOV	SI,[DI]$02
	CS:	
	MOV	DI,[DI]$04
	CALL	readd	;add it
atndone	POP	CX	;get flag
	TEST.B	CL,#$02	;done 1/x ?
	JZ	atnnorcp	;:no
	PUSH	CX	;save flag
	MOV	CX,AX	;first -> second
	MOV	SI,BX
	MOV	DI,DX
	MOV	AX,#$2181	;first = pi/2
	MOV	BX,#$DAA2
	MOV	DX,#$490F
	CALL	resub	;subtraction pi/2-y
	POP	CX	;restore flag
atnnorcp	TEST.B	CL,#$01	;negative ?
	JZ	atnpos2	;:no
	OR.B	DH,#$80	;set sign
atnpos2	JMP	repush	;"push result
fltatnrg	W	$E77F,$CCCF,$5413	; 4.1421356237E-01	;1. tan(22.5) range table
	W	$F67F,$A2F4,$0930	; 2.6794919243E-01	;   tan(15)   for ArcTan
	W	$6A7F,$91C1,$060A	; 2.6179938780E-01	;   15
	W	$B580,$8A9E,$446F	; 7.6732698798E-01	;2. tan(37.5)
	W	$8280,$3A2C,$13CD	; 5.7735026919E-01	;   tan(30)
	W	$6A80,$91C1,$060A	; 5.2359877560E-01	;   30
	W	$0081,$0000,$0000	; 1.0000000000E+00	;3. tan(45)
	W	$2180,$DAA2,$490F	; 7.8539816340E-01	;"   45
fltatn	W	$E87D,$8BA2,$BA2E	;-9.0909090909E-02	;-1/11 constants for ArcTan
	W	$8E7D,$38E3,$638E	; 1.1111111111E-01	; 1/ 9
	W	$497E,$2492,$9249	;-1.4285714286E-01	;-1/ 7
	W	$CD7E,$CCCC,$4CCC	; 2.0000000000E-01	; 1/ 5
	W	$AB7F,$AAAA,$AAAA	;-3.3333333333E-01	;" 1/ 3
atnpoly	MOV	DI,#fltatn	;ptr to ArcTan constants
	MOV	CX,#$0005	;5 of them
poly1	PUSH	DX	;do polynome: store number
	PUSH	BX	;y:=x+c*x**3+b*x**5+a*x**7...
	PUSH	AX
	PUSH	CX	;save cnt
	PUSH	DI	;save ptr
	MOV	CX,AX	;first -> second
	MOV	SI,BX
	MOV	DI,DX
	CALL	remult	;multiplication -> square
	POP	DI	;restore cnt,ptr
	POP	CX
	CALL	poly2	;do polynome 2
	POP	CX	;get number -> second
	POP	SI
	POP	DI
	JMP	remult	;"multiplication
poly2	MOV	retrc1,AX	;do polynome 2: store number
	MOV	retrc2,BX	;y:=1+c*x+b*x**2+a*x**3...
	MOV	retrc3,DX
	CS:		;get number from table
	MOV	AX,[DI]
	CS:	
	MOV	BX,[DI]$02
	CS:	
	MOV	DX,[DI]$04
	PUSH	CX	;save ptr, cnt
	PUSH	DI
	JMP.b	polystrt	;'start it
polyloop	PUSH	CX	;save ptr, cnt
	PUSH	DI
	CS:	
	MOV	CX,[DI]	;get number from table
	CS:	
	MOV	SI,[DI]$02
	CS:	
	MOV	DI,[DI]$04
	CALL	readd	;add it
polystrt	MOV	CX,retrc1	;get x -> second
	MOV	SI,retrc2
	MOV	DI,retrc3
	CALL	remult	;multiplication *x
	POP	DI	;restore ptr, cnt
	POP	CX
	ADD	DI,#$06	;go to next number
	LOOP	polyloop	;:another one
	MOV	CX,#$0081	;second = 1
	XOR	SI,SI
	XOR	DI,DI
	JMP	readd	;"add 1
fmtreal	PUSH	BX	;Format real number
	CMP	DX,#$19	;number of fraction chars
	JB	frnolim2	;< 25:ok
	MOV	AX,CX	;field width
	CALL	limstind	;limit it
	MOV	DL,#$07
	TEST.B	[DI]$05,#$80	;negative (DI:ptr to num)
	JZ	frpos	;:no
	INC.B	DL	;one char more
frpos	SUB.B	AL,DL
	JNB	frnound	;:no underflow
	XOR.B	AL,AL	;negative: make zero
frnound	CMP	AL,#$09	;limit to 9
	JB	frnolim
	MOV	AL,#$09
frnolim	INC.B	AL	;-> number of fraction chars
	MOV.B	DL,AL
	MOV.B	DH,AL
frnolim2	PUSH	DX	;save # fraction chars
	CALL	realdec	;convert to decimal
	POP	DX	;restore
	MOV.B	AL,DL
	INC.B	AL	;number of mantissa chars
	OR.B	DH,DH
	JNZ	frround
	ADD.B	AL,CL
	JNS	frlimprc
	MOV.B	cvoutbuf,#$00	;mark end of buffer
	JMP.b	frfmtit	;'
frlimprc	CMP	AL,#$0C	;max 11 digits shown
	JB	frround	;:ok
	MOV	AL,#$0B	;limit it
frround	CALL	decround	;round up number
frfmtit	POP	BX	;dest ptr
	MOV	SI,#cvoutbuf	;source: dec buffer
	TEST.B	CH,#$80	;test sign
	JZ	frpos2	;:no
	MOV	AL,#$2D	;put a -
	CALL	frdigsto
frpos2	MOV.B	CH,CL	;exponent: number of int digs
	OR.B	DH,DH	;size of number
	JZ	frzer	;:zero
	MOV	CH,#$00
frzer	OR.B	CH,CH	;neg exponent ?
	JNS	frint	;:no
	CALL	frdig0	;store 0 - no int part
	JMP.b	frfrac0	;'do fraction part
frint	CALL	frdig	;put char from source
	DEC.B	CH	;another one ?
	JNS	frint	;:yes
frfrac0	OR.B	DL,DL	;test fraction len
	JZ	frexp	;:nothing
	MOV	AL,#$2E	;put a .
	CALL	frdigsto
frfill0	INC.B	CH	;put zeroes as necessary
	JZ	frfrac	;:exponent ok
	CALL	frdig0	;put a 0
	DEC.B	DL	;field filled ?
	JNZ	frfill0	;:no
frfrac	DEC.B	DL	;another fraction digit ?
	JS	frexp	;:no
	CALL	frdig	;do digit
	JMP	frfrac	;'next one
frexp	OR.B	DH,DH	;do exponent ?
	JNZ	frputexp	;:yes
	RET		;'
frputexp	MOV	AL,#$45	;put an E
	CALL	frdigsto
	MOV	AL,#$2B	;+
	OR.B	CL,CL	;test sign
	JNS	frposexp	;:positive
	NEG.B	CL	;negate exponent
	MOV	AL,#$2D	;-
frposexp	CALL	frdigsto	;store sign
	MOV	AL,#$2F	;do DIV 10 / MOD 10
frexpsub	INC.B	AL	;count up digit
	SUB.B	CL,#$0A	;successive subtraction
	JNB	frexpsub	;:continue
	CALL	frdigsto	;put digit
	ADD.B	CL,#$3A	;restore second digit
	MOV.B	AL,CL	;put digit
	JMP.b	frdigsto	;"
frdig	MOV.B	AL,[SI]	;get digit from source
	OR.B	AL,AL	;end ?
	JZ	frdig0	;:yes
	INC	SI	;ptr to next char
	JMP.b	frdigsto	;'store digit
frdig0	MOV	AL,#$30	;store a 0
frdigsto	MOV.B	[BX],AL	;store digit
	INC	BX	;ptr to next dest char
	RET		;"
realdec	MOV	AX,[DI]	;Real -> Decimal
	MOV	BX,[DI]$02	;get real number (in CS !)
	MOV	DX,[DI]$04
	OR.B	AL,AL	;zero ?
	JNZ	rdno0	;:no
	MOV	SI,#cvoutbuf	;fill buffer with zeroes
rdfill	MOV	[SI],#$3030
	INC	SI
	INC	SI
	CMP	SI,#currfil	;end reached ?
	JNZ	rdfill	;:no
	MOV	CX,#$0000	;exponent 0
	RET		;'
rdno0	MOV.B	CH,DH	;get sign
	AND.B	DH,#$7F	;clear sign in mantissa
	PUSH	AX	;save exp
	PUSH	DX	;save mantissa
	SUB	AL,#$80	;exponent
	CBW	
	MOV	DX,#$004D	;* 77
	IMUL	DX	;77/256 is about ln(2)/ln(10) !
	ADD	AX,#$0005	;+5
	MOV.B	CL,AH	;this is approx. dec exponent
	POP	DX	;restore
	POP	AX
	CMP.B	CL,#$D9	;correct error
	JNZ	rdnocomp	;:ok
	INC.B	CL
rdnocomp	PUSH	CX	;save exponent, sign
	NEG.B	CL	;negate exponent
	CALL	realrang	;bring into range
	POP	CX	;restore
	CMP	AL,#$81	;exp ok ?
	JNB	rdnoadj	;:yes
	CALL	mult10	;mult * 10
	DEC.B	CL	;count down dec exp
rdnoadj	PUSH	CX	;save exp, sign
	OR.B	DH,#$80	;set mantissa MSB
	MOV	CL,#$84	;offset for exponent
	SUB.B	CL,AL
	MOV	AL,#$00	;LSB = 0
	JZ	rdnosh	;:no shift
rdshift	SHR	DX,1 	;convert to 6-byte-card
	RCR	BX,1 
	RCR	AX,1 
	DEC.B	CL	;shift again ?
	JNZ	rdshift	;:yes
rdnosh	MOV	SI,#cvoutbuf	;ptr to output buffer
rdconv	MOV.B	CH,DH	;get upper 4 bits
	MOV	CL,#$04
	SHR.B	CH,CL
	ADD.B	CH,#$30	;-> digit
	MOV.B	[SI],CH	;store digit
	AND.B	DH,#$0F	;clear that digit
	PUSH	DX	;card * 10 -> card
	PUSH	BX	;save number
	PUSH	AX
	SHL	AX,1 	;card * 4
	RCL	BX,1 
	RCL	DX,1 
	SHL	AX,1 
	RCL	BX,1 
	RCL	DX,1 
	POP	CX	;+ card
	ADD	AX,CX
	POP	CX
	ADC	BX,CX
	POP	CX
	ADC	DX,CX
	SHL	AX,1 	;* 2 = card * 10
	RCL	BX,1 
	RCL	DX,1 
	INC	SI	;next buffer pos
	CMP	SI,#currfil	;done ?
	JNZ	rdconv	;:no
	POP	CX	;restore exp, sign
	RET		;"
decround	XOR.B	AH,AH	;Round up decimal number
	MOV	BX,#cvoutbuf	;ptr to buffer
	ADD	BX,AX	;add digit index
	CMP.B	[BX],#$35	;5 ?
	MOV.B	[BX],#$00	;store 0: end mark
	JB	drdone	;below: no round up
drloop	DEC.B	AL	;go back one digit
	JS	drincexp	;:beg of buffer reached
	DEC	BX	;go back one pos
	INC.B	[BX]	;inc that digit
	CMP.B	[BX],#$3A	;carry ?
	JB	drdone	;no: done
	MOV.B	[BX],#$00	;mark as end
	JMP	drloop	;'continue
drincexp	MOV.B	[BX],#$31	;store a 1
	MOV.B	[BX]$01,#$00	;end mark
	INC.B	CL	;inc exponent
drdone	RET		;"
ascreal	MOV.B	CL,[BX]	;String -> Real
	CMP.B	CL,#$2D	;- ?
	JNZ	arpos	;:no
	INC	BX	;next char
arpos	PUSH	CX	;save sign
	CALL	ascreal2	;convert unsigned real
	POP	CX	;restore sign
	JB	arerr	;:error
	CMP.B	CL,#$2D	;- ?
	JNZ	arpos1	;:no
	CMP.B	[DI],#$00	;result = 0 ?
	JZ	arpos1
	XOR.B	[DI]$05,#$80	;negate it
arpos1	CLC		;no error
arerr	RET		;"
ascreal2	MOV	SI,BX	;source ptr
	XOR	AX,AX	;ASCII -> unsigned real
	XOR	BX,BX	;clear result
	XOR	DX,DX
	XOR	CX,CX
	MOV.B	cvexpcnt,#$00	;exponent
arloop	MOV.B	CL,[SI]	;get char
	CMP.B	CL,#$61	;lower case ?
	JB	arupc	;:no
	CMP.B	CL,#$7A
	JA	arupc	;:no
	SUB.B	CL,#$20	;convert to upper case
arupc	CALL	ardigit2	;do a digit
	JB	arnodig	;:no digit
	CALL	mult10	;result * 10
	JB	arover	;:overflow
	PUSH	DI	;save ptrs
	PUSH	SI
	PUSH	CX
	PUSH	DX	;save result
	PUSH	BX
	PUSH	AX
	MOV.B	AL,CL	;get digit
	XOR.B	AH,AH	;clear hi byte
	CALL	intreal	;convert to real
	POP	CX	;restore result
	POP	SI
	POP	DI
	CALL	readd	;add digit to result
	POP	CX	;restore ptrs
	POP	SI
	POP	DI
	TEST.B	CH,#$40	;after decimal point ?
	JZ	arnext	;:yes
	DEC.B	cvexpcnt	;count down exponent
	JMP.b	arnext	;'next digit
arnodig	CMP.B	CL,#$2E	;decimal point ?
	JNZ	arexp	;:no, test exponent
	TEST.B	CH,#$40	;. already done ?
	STC		;error
	JNZ	arover	;yes: error
	OR.B	CH,#$40	;set flag
arnext	INC	SI	;next char
	JMP	arloop	;'continue
arover	MOV	BX,SI	;pointer: end pos
	RET		;'
arexp	CMP.B	CL,#$45	;E ?
	MOV.B	CL,cvexpcnt	;exponent
	JNZ	arexp3	;:no
	CALL	realrng	;bring into range
	JB	arover	;:error
	INC	SI	;go to next char
	MOV.B	CL,[SI]	;get it
	CMP.B	CL,#$2B	;+ ?
	JZ	arposexp	;:yes
	CMP.B	CL,#$2D	;- ?
	JNZ	arexp2	;no: digit
	OR.B	CH,#$20	;set flag: neg exponent
arposexp	INC	SI	;next char
arexp2	CALL	ardigit	;do digit
	JB	arover	;:error
	PUSH	AX	;save
	MOV.B	AL,CL	;first digit
	INC	SI	;next char
	CALL	ardigit	;do digit
	JB	aronedig	;:no second digit
	MOV.B	AH,AL	;AL*10 -> AL
	SHL.B	AL,1 
	SHL.B	AL,1 
	ADD.B	AL,AH
	SHL.B	AL,1 
	ADD.B	AL,CL
	INC	SI	;next char
aronedig	MOV.B	CL,AL	;new exponent
	POP	AX	;restore
	TEST.B	CH,#$20	;negative exponent ?
	JZ	arexp3	;:no
	NEG.B	CL	;negate it
arexp3	CALL	realrng	;real number*10**exp
	MOV	[DI],AX	;store the result
	MOV	[DI]$02,BX
	MOV	[DI]$04,DX
	JMP	arover	;"set pointer to end
realrng	CMP.B	CL,#$DA	;outside a reasonable range ?
	JL	rrerr	;:yes
	CMP.B	CL,#$26
	JG	rrerr	;:yes
	PUSH	CX	;save pointers
	PUSH	SI
	PUSH	DI
	CALL	realrang	;bring into range
	POP	DI
	POP	SI
	POP	CX
	RET		;'
rrerr	STC		;error
	RET		;"
ardigit	MOV.B	CL,[SI]	;get digit
ardigit2	CMP.B	CL,#$30	;< 0 ?
	JB	ardret	;:yes
	CMP.B	CL,#$3A	;> 9 ?
	CMC		;change to error flag
	JB	ardret	;:yes
	SUB.B	CL,#$30	;convert to number
ardret	RET		;"
realrang	PUSH	DX	;bring into range:
	PUSH	BX	;number*10**CL
	PUSH	AX	;save number
	MOV.B	cvdecexp,CL	;save exponent
	OR.B	CL,CL	;negative ?
	JNS	rrpos	;:no
	NEG.B	CL	;make it positive
rrpos	MOV.B	BL,CL	;(exponent DIV 4)*6
	AND.B	BL,#$FC
	MOV.B	BH,BL
	SHR.B	BL,1 
	ADD.B	BL,BH	;-> pointer into table
	XOR.B	BH,BH	;clear hi
	LEA	DI,[BX]fltdec	;factor table
	CS:	
	MOV	AX,[DI]	;get factor
	CS:	
	MOV	BX,[DI]$02
	CS:	
	MOV	DX,[DI]$04
	AND.B	CL,#$03	;exponent MOD 4
	JZ	rrdone	;:ok
rrmul	CALL	mult10	;do successive multiplications
	DEC.B	CL	;another ?
	JNZ	rrmul	;:yes
rrdone	MOV	CX,AX	;factor -> second
	MOV	SI,BX
	MOV	DI,DX
	POP	AX	;restore number
	POP	BX
	POP	DX
	TEST.B	cvdecexp,#$80	;positive exponent ?
	JNZ	rrdiv	;:no
	JMP	remult	;'multiply num*factor
rrdiv	JMP	rediv	;"divide num/factor
fltdec	W	$0081,$0000,$0000	; 1.0000000000E+00	;decimal factor table
	W	$008E,$0000,$1C40	; 1.0000000000E+04
	W	$009B,$2000,$3EBC	; 1.0000000000E+08
	W	$00A8,$A510,$68D4	; 1.0000000000E+12
	W	$04B6,$C9BF,$0E1B	; 1.0000000000E+16
	W	$ACC3,$EBC5,$2D78	; 1.0000000000E+20
	W	$CDD0,$1BCE,$53C2	; 1.0000000000E+24
	W	$F9DE,$3978,$013F	; 1.0000000000E+28
	W	$2BEB,$ADA8,$1DC5	; 1.0000000000E+32
	W	$C9F8,$CE7B,$4097	; 1.0000000000E+36	;"
mult10	OR.B	AL,AL	;Real multiplication * 10
	JNZ	m10not0	;:not zero
	RET		;'zero - return
m10not0	OR.B	DH,#$80	;set mantissa MSB
	PUSH	CX	;save CX
	PUSH	DX	;save number
	PUSH	BX
	PUSH	AX
	SHR	DX,1 	;mantissa / 4
	RCR	BX,1 
	RCR.B	AH,1 
	SHR	DX,1 
	RCR	BX,1 
	RCR.B	AH,1 
	POP	CX	;add mantissa
	ADD.B	AH,CH	;why no ADC (rounding !) ?
	POP	CX
	ADC	BX,CX
	POP	CX
	ADC	DX,CX
	POP	CX	;restore CX
	JNB	m10nrm
	RCR	DX,1 	;shift right
	RCR	BX,1 
	RCR.B	AH,1 
	INC.B	AL	;exponent+1
	JNZ	m10nrm	;:ok
	STC		;overflow...
	RET		;'
m10nrm	AND.B	DH,#$7F	;make positive
	ADD	AL,#$03	;exponent+3
	RET		;"
realcard	POP	SI	;Real -> long cardinal
	POP	DI	;2 ret addrs
	POP	DX	;get real
	POP	CX
	POP	BX
	PUSH	DI	;restore rets
	PUSH	SI
	TEST.B	BH,#$80	;negative ?
	JNZ	rczero	;yes:return zero
	OR.B	BH,#$80	;set mantissa MSB
	MOV	AL,#$A0	;exponent offset
	SUB.B	AL,DL	;calc number of shifts
	JB	rcover	;:too much
	CMP	AL,#$20	;too small ?
	JNB	rczero	;:return zero
rcdenorm	OR.B	AL,AL	;another shift ?
	JZ	rcdone	;:done
	SHR	BX,1 	;shift right: denormalize
	RCR	CX,1 
	DEC.B	AL
	JMP	rcdenorm	;'next one
rcdone	MOV	AX,CX	;return number in DX:AX
	MOV	DX,BX
	RET		;'
rczero	XOR	AX,AX	;return zero
	XOR	DX,DX
	RET		;'
rcover	MOV	AX,#$FFFF	;return maxcard
	MOV	DX,#$FFFF
	RET		;"
cardreal	MOV	BX,DX	;long cardinal -> real
	MOV	CX,AX
	OR	AX,DX	;0 ?
	JZ	crzero	;yes: return 0
	MOV	DX,#$00A0	;exponent, LSB mantissa
crnorm	TEST.B	BH,#$80	;normalized ?
	JNZ	crstore	;:yes
	SHL	CX,1 	;shift left
	RCL	BX,1 
	DEC.B	DL	;count down exponent
	JMP	crnorm	;'continue
crstore	AND.B	BH,#$7F	;make positive
crzero	POP	AX	;return addr
	PUSH	BX	;push result
	PUSH	CX
	PUSH	DX
	JMP	AX	;"return
xassgntx	MOV	AL,#$01	;text file
doassign	MOV	filfunc,AL	;do assign: store func code
	POP	BX	;ret addr
	CALL	getpn	;string -> ASCIIZ
	POP	DI	;ptr to file var
	POP	ES
	PUSH	BX	;restore ret
	MOV	AX,ES	;file var in DS ?
	MOV	DX,DS
	CMP	AX,DX
	JNZ	asnostd
	CMP	DI,#stdout	;std in / out file ?
	JBE	asgnerr	;:yes, error
asnostd	PUSH	DI	;save var ofs
	MOV	SI,#pnbuf	;path name buffer
	LEA	DI,[DI]$0C	;path name in file var
	MOV	CX,#$0020	;copy 64 chars
	CLD	
	REPZ	
	MOVS		;do it
	POP	DI	;restore file var ofs
	CALL	devtest	;test if device
	JNB	asnodev	;:yes
	MOV	AL,#$00	;flag: not open
	MOV	BX,#$FFFF	;no handle
asnodev	ES:	
	MOV	[DI],BX	;store file handle
	CMP.B	filfunc,#$00	;text file ?
	JZ	asnotxt	;:no
	ES:	
	MOV.B	[DI]$02,AL	;set file flag
	LEA	AX,[DI]$4C	;set buffer ofs
	ES:	
	MOV	[DI]$04,AX	;store in file var
	RET		;'
asnotxt	ES:		;set file var:
	MOV	[DI]$02,#$0000	;record length
	RET		;'
asgnerr	MOV.B	errnum,#$22	;Assign to std files
	RET		;"not allowed
xresettx	XOR.B	AL,AL	;Reset text file
	JMP.b	opentxt	;'
xrewrttx	MOV	AL,#$01	;Rewrite text file
	JMP.b	opentxt	;'
xappndtx	MOV	AL,#$02	;Append text file
opentxt	MOV	filfunc,AL	;store function code
	POP	errpos	;get ret addr
	POP	ES	;file var ptr
	PUSH	errpos	;restore ret
	ES:	
	MOV.B	AL,[DI]$02	;test flag
	AND	AL,#$0F	;device ?
	JZ	otnodev	;:no
	ES:	
	AND.B	[DI]$02,#$DF	;clear flag: char preread
otret	RET		;'
otnodev	ES:	
	MOV	[DI]$06,CX	;store buffer size
	CALL	close1	;close file
	CMP.B	errnum,#$00	;error ?
	JNZ	otret	;yes:ret
	CALL	openfile	;do open file
	CMP.B	errnum,#$00	;error ?
	JNZ	otret	;yes:ret
	TEST	modeflg,#$0002	;do device checking ?
	JZ	otnodev2	;:no
	MOV	AX,#$4400	;test device status
	ES:	
	MOV	BX,[DI]	;get file handle
	CALL	dos	;do it
	TEST	DX,#$0080	;device ?
	JZ	otnodev2	;:no
	ES:	
	MOV	[DI]$06,#$0001	;buffer len: 1 char
otnodev2	CMP.B	filfunc,#$01	;read ?
	JNB	otappend	;:no
	ES:	
	MOV.B	[DI]$02,#$80	;open for input
	ES:	
	MOV	BX,[DI]$04	;buffer pos
	ES:	
	MOV	[DI]$08,BX	;-> buffer ptr
	ES:	
	MOV	[DI]$0A,BX	;-> buffer end
	RET		;'
otappend	JZ	prepout	;write: prepare for output
	MOV	AX,#$4202	;seek relative to EOF
	ES:	
	MOV	BX,[DI]	;file handle
	XOR	CX,CX	;offset 0
	XOR	DX,DX
	CALL	dos	;do it: get file length
	ES:	
	MOV	CX,[DI]$06	;buffer size
	CMP	CX,#$0080	;< 128 ?
	JB	otsmall	;yes: ok
	MOV	CX,#$0080	;go back up to 128 bytes
otsmall	SUB	AX,CX	;sub from file pos
	SBB	DX,#$00
	JNB	otnotbeg	;:ok
	ADD	AX,CX	;beyond beg of file -
	MOV	CX,AX	;go to beg of file
	XOR	AX,AX
	XOR	DX,DX
otnotbeg	PUSH	CX	;save char count
	MOV	CX,DX	;dest pos
	MOV	DX,AX
	MOV	AX,#$4200	;seek absolute
	ES:	
	MOV	BX,[DI]	;file handle
	CALL	dos	;do seek
	CALL	gbrdbuf	;read from buffer
	POP	DX	;counter
	NEG	DX
	ES:	
	MOV	SI,[DI]$08	;buffer ptr
otsearch	ES:	
	CMP.B	[SI],#$1A	;search ^Z
	JZ	oteof	;:found
	INC	SI	;next char
	INC	DX
	JNZ	otsearch	;:continue
	JMP.b	prepout	;'EOF not found
oteof	MOV	AX,#$4202	;seek from end
	ES:		;DX = offset from end
	MOV	BX,[DI]	;file handle
	MOV	CX,#$FFFF	;backwards
	CALL	dos	;do seek
prepout	ES:		;prepare for subsequent output
	MOV.B	[DI]$02,#$40	;open for output
	ES:	
	MOV	AX,[DI]$04	;buffer offset
	ES:	
	MOV	[DI]$08,AX	;-> buffer ptr
	ES:	
	ADD	AX,[DI]$06	;+ buffer size
	ES:	
	MOV	[DI]$0A,AX	;-> buffer end
poret	RET		;"
xtrunctx	POP	errpos	;Truncate text file
	POP	ES	;file var ptr
	PUSH	errpos	;restore ret
	ES:	
	CMP.B	[DI]$02,#$80	;open for input ?
	JNZ	poret	;:no - ret
	ES:	
	MOV	DX,[DI]$08	;buffer ptr
	ES:	
	SUB	DX,[DI]$0A	;- buffer end
	JZ	trend	;equal: ok
	MOV	AX,#$4201	;seek relative
	ES:	
	MOV	BX,[DI]	;file handle
	MOV	CX,#$FFFF	;backwards
	CALL	dos	;do it
trend	MOV	AH,#$40	;write
	ES:	
	MOV	BX,[DI]	;file handle
	XOR	CX,CX	;len = 0 -> truncate
	CALL	dos	;do it
	JMP	prepout	;"prepare for output
xflush	POP	errpos	;Flush
	POP	ES	;file var ptr
	PUSH	errpos	;restore ret
flush	ES:	
	CMP.B	[DI]$02,#$40	;output file ?
	JNZ	flushret	;no: ret
	JMP	pbflush	;'flush buffer
flushret	RET		;"
xclosetx	POP	errpos	;Close text file
	POP	ES	;get file var pt
	PUSH	errpos	;restore ret
close1	ES:	
	MOV.B	AL,[DI]$02	;get flags
	AND	AL,#$0F	;device ?
	JNZ	closeret	;yes: ret
	CALL	flush	;flush the buffer
	ES:	
	MOV.B	[DI]$02,#$00	;clear flag
close2	ES:	
	MOV	BX,[DI]	;file handle
	CMP	BX,#$02	;standard file ?
	JBE	closeret	;:ret
	CMP	BX,#-$01	;not open ?
	JZ	closeret	;yes:ret
	ES:	
	MOV	[DI],#$FFFF	;clear file handle
	MOV	AH,#$3E	;close file
	CALL	dos	;do it
	JNB	closeret	;:ok, no error
	MOV.B	errnum,#$FF	;file disappeared
closeret	RET		;"
devtest	MOV	CX,#$0009	;Test filename for device
	MOV	BX,#devtable
devloop	PUSH	CX	;save cnt, ptr
	PUSH	BX
	MOV	SI,#pnbuf	;file name
	MOV	CX,#$0003	;3 chars
devcloop	MOV.B	AL,[SI]	;get char
	CALL	upcase	;ignore upper / lower
	CS:	
	CMP.B	AL,[BX]	;compare
	JZ	devnextc	;:ok
	POP	BX	;restore cnt, ptr
	POP	CX
	ADD	BX,#$06	;next device
	LOOP	devloop	;another one ?
devnone	STC		;not found
	RET		;'
devnextc	INC	SI	;next char
	INC	BX
	LOOP	devcloop	;:another char
	POP	CX	;remove
	POP	CX
	CMP.B	[SI],#$3A	;next char = : ?
	JNZ	devnone	;:no device
	CS:	
	MOV.B	AL,[BX]	;get flag
	CS:	
	MOV	BX,[BX]$01	;get file handle
	RET		;"
devtable	B	"CON"	;Device table
	B	$C1,$FF,$FF	;input, output, dev 1
	B	"TRM"
	B	$C1,$FF,$FF	;input, output, dev 1
	B	"KBD"
	B	$82,$FF,$FF	;input, dev 2
	B	"LST"
	B	$43,$FF,$FF	;output, dev 3
	B	"AUX"
	B	$C4,$FF,$FF	;input, output, dev 4
	B	"USR"
	B	$C5,$FF,$FF	;input, output, dev 5
	B	"INP"	;std MS-DOS input-file
	B	$00,$00,$00	;not open, handle 0
	B	"OUT"	;std MS-DOS output-file
	B	$00,$01,$00	;not open, handle 1
	B	"ERR"	;std MS-DOS error file
	B	$00,$02,$00	;"not open, handle 2
openfile	ES:		;do open file
	CMP	[DI],#-$01	;handle <> $ffff ?
	JNZ	opret	;yes: already open
	MOV	AX,#$3D02	;open for input / output
	MOV	DL,#$01	;error number
	TEST.B	filfunc,#$01	;create file ?
	JZ	opnotnew	;:no
	MOV	AH,#$3C	;create
	XOR	CX,CX	;clear attribute
	MOV	DL,#$F1	;error (dir full)
opnotnew	PUSH	DX	;save error number
	LEA	DX,[DI]$0C	;ptr to path name
	CALL	dos	;do it
	POP	DX	;restore error number
	JB	operr	;:error
	ES:	
	MOV	[DI],AX	;store file handle
	RET		;'
operr	MOV.B	errnum,DL	;store error number
	CMP	AL,#$04	;too many open files ?
	JNZ	opret	;:no
	MOV.B	errnum,#$F3	;set that error
opret	RET		;"
xstdin	POP	errpos	;Set standard input
	MOV	currfil,#stdin	;ptr to file var
	MOV	currfil1,DS
	JMP	[errpos]	;"return - error pos set
xrdfil	POP	errpos	;prepare for read
	POP	ES	;get file var ptr
	MOV	currfil,DI	;-> current file
	MOV	currfil1,ES
	ES:	
	TEST.B	[DI]$02,#$80	;open for input ?
	JNZ	prret	;:yes
	MOV.B	errnum,#$02	;error: not open for input
prret	JMP	[errpos]	;"return
xstdout	POP	errpos	;Set standard output
	MOV	currfil,#stdout	;ptr to file var
	MOV	currfil1,DS
	JMP	[errpos]	;"return
xwrfil	POP	errpos	;prepare for write
	POP	ES	;get file var ptr
	MOV	currfil,DI	;-> current file
	MOV	currfil1,ES
	ES:	
	TEST.B	[DI]$02,#$40	;open for output ?
	JNZ	pwret	;:no
	MOV.B	errnum,#$03	;error: not open for output
pwret	JMP	[errpos]	;"return
xrd	MOV	AL,#$FF	;Readln string
	JMP.b	readst	;'
xrdln	XOR.B	AL,AL	;Read string