home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
wunderki.zip
/
F48F.ASM
< prev
next >
Wrap
Assembly Source File
|
1993-08-16
|
9KB
|
614 lines
; *******************************************************
; * *
; * Turbo Pascal Run-time Library *
; * Real Standard Functions *
; * *
; * Copyright (c) 1988,92 Borland International *
; * *
; *******************************************************
TITLE F48F
INCLUDE SE.ASM
CODE SEGMENT BYTE PUBLIC
ASSUME CS:CODE
; Externals
EXTRN RealAdd:NEAR,RealSub:NEAR,RealMul:NEAR,RealDiv:NEAR
EXTRN RealCmp:NEAR,RealFloat:NEAR,RealTrunc:NEAR
EXTRN HaltError:NEAR
; Publics
PUBLIC RInt,RFrac,RSqrt,RSin,RCos,RLn,RExp,RArcTan
; All standard functions operate on floating-point register R1
; (DX:BX:AX) and modify floating-point register R2 (DI:SI:CX).
; Save R2 and add
RealAddP:
PUSH DI
PUSH SI
PUSH CX
CALL RealAdd
POP CX
POP SI
POP DI
RET
; Save R2 and subtract
RealSubP:
PUSH DI
PUSH SI
PUSH CX
CALL RealSub
POP CX
POP SI
POP DI
RET
; Save R2 and multiply
RealMulP:
PUSH DI
PUSH SI
PUSH CX
CALL RealMul
POP CX
POP SI
POP DI
RET
; Save R2 and divide
RealDivP:
PUSH DI
PUSH SI
PUSH CX
CALL RealDiv
POP CX
POP SI
POP DI
RET
; Int standard function
RInt:
CMP AL,80H+40
JAE @@7
MOV CX,AX
MOV SI,BX
MOV DI,DX
XOR AH,AH
XOR BX,BX
XOR DX,DX
SUB CL,80H
JBE @@8
@@2: CMP CL,16
JB @@3
MOV AH,BH
MOV BX,DX
MOV DX,0FFFFH
SUB CL,16
JMP @@2
@@3: CMP CL,8
JB @@4
MOV AH,BL
MOV BL,BH
MOV BH,DL
MOV DL,DH
MOV DH,0FFH
SUB CL,8
@@4: OR CL,CL
JZ @@6
@@5: STC
RCR DX,1
RCR BX,1
RCR AH,1
DEC CL
JNZ @@5
@@6: AND DX,DI
AND BX,SI
AND AH,CH
@@7: RETF
@@8: XOR AL,AL
RETF
; Frac standard function
RFrac:
PUSH DX
PUSH BX
PUSH AX
PUSH CS
CALL RInt
MOV CX,AX
MOV SI,BX
MOV DI,DX
POP AX
POP BX
POP DX
CALL RealSub
RETF
; Sqrt standard function
RSqrt:
LOC Expo,BYTE,2
LOC Temp,BYTE,6
ENTRY FAR
MOV CX,AX
MOV SI,BX
MOV DI,DX
OR AL,AL
JZ @@2
TEST DH,80H
JNZ @@3
MOV Temp.w0,AX
MOV Temp.w2,BX
MOV Temp.w4,DX
ADD CL,80H
SAR CL,1
ADD CL,80H
MOV AL,CL
SUB AL,20
MOV Expo,AL
@@1: MOV AX,Temp.w0
MOV BX,Temp.w2
MOV DX,Temp.w4
CALL RealDivP
CALL RealAddP
DEC AL
PUSH DX
PUSH BX
PUSH AX
CALL RealSub
CMP AL,Expo
POP CX
POP SI
POP DI
JAE @@1
@@2: MOV AX,CX
MOV BX,SI
MOV DX,DI
EXIT
@@3: MOV SP,BP
POP BP
MOV AX,207
JMP HaltError
; Cos standard function
RCos:
MOV CX,02181H ;-PI/2
MOV SI,0DAA2H
MOV DI,0C90FH
CALL RealAdd
OR AL,AL
JE RSin
XOR DH,80H
; Sin standard function
RSin:
CMP AL,80H-20
JB @@6
MOV CX,02183H ;PI*2
MOV SI,0DAA2H
MOV DI,0490FH
PUSH DX
AND DH,7FH
CALL RealCmp
POP DX
JB @@1
CALL RealDivP
PUSH DI
PUSH SI
PUSH CX
PUSH CS
CALL RFrac
POP CX
POP SI
POP DI
CALL RealMulP
@@1: TEST DH,80H
JZ @@2
CALL RealAddP
@@2: DEC CL
CALL RealCmp
PUSHF
JB @@3
CALL RealSubP
@@3: DEC CL
CALL RealCmp
JB @@4
INC CL
OR DH,80H
CALL RealAdd
@@4: CMP AL,80H-20
JB @@5
MOV DI,OFFSET CS:SinConst
MOV CX,7
CALL CalcSer2
@@5: POPF
JB @@6
OR AL,AL
JZ @@6
XOR DH,80H
@@6: RETF
; Sin series constants
SinConst:
DB 058H,09DH,039H,09FH,03FH,0D7H
DB 060H,043H,09DH,030H,092H,030H
DB 067H,0AAH,03FH,028H,032H,0D7H
DB 06EH,0B6H,02AH,01DH,0EFH,038H
DB 074H,00DH,0D0H,000H,00DH,0D0H
DB 07AH,088H,088H,088H,088H,008H
DB 07EH,0ABH,0AAH,0AAH,0AAH,0AAH
; Ln standard function
RLn:
OR AL,AL
JE @@1
TEST DH,80H
JE @@2
@@1: MOV AX,207
JMP HaltError
@@2: MOV CL,80H+1
SUB AL,CL
PUSH AX
MOV AL,CL
MOV CX,0FB80H ;1/SQRT(2)
MOV SI,0F333H
MOV DI,03504H
CALL RealMul
MOV CX,AX
MOV SI,BX
MOV DI,DX
MOV AX,81H ;1.0
XOR BX,BX
XOR DX,DX
CALL RealAddP
PUSH DX
PUSH BX
PUSH AX
MOV AX,81H ;-1.0
XOR BX,BX
MOV DX,8000H
CALL RealAdd
POP CX
POP SI
POP DI
CALL RealDiv
MOV DI,OFFSET CS:LnConst
MOV CX,6
CALL CalcSer2
INC AL
MOV CX,0D27FH ;LN(2)/2
MOV SI,017F7H
MOV DI,03172H
CALL RealAdd
POP CX
PUSH DX
PUSH BX
PUSH AX
MOV AL,CL
CBW
CWD
CALL RealFloat
MOV CX,0D280H ;LN(2)
MOV SI,017F7H
MOV DI,03172H
CALL RealMul
POP CX
POP SI
POP DI
CALL RealAdd
CMP AL,80H-25
JAE @@3
XOR AX,AX
XOR BX,BX
XOR DX,DX
@@3: RETF
; Ln series constants
LnConst:
DB 07DH,08AH,09DH,0D8H,089H,01DH
DB 07DH,0E9H,0A2H,08BH,02EH,03AH
DB 07DH,08EH,0E3H,038H,08EH,063H
DB 07EH,049H,092H,024H,049H,012H
DB 07EH,0CDH,0CCH,0CCH,0CCH,04CH
DB 07FH,0ABH,0AAH,0AAH,0AAH,02AH
; Exp standard function
RExp:
TEST DH,80H
PUSHF
AND DH,7FH
MOV CX,0D280H ;LN(2)
MOV SI,017F7H
MOV DI,03172H
CALL RealDiv
CMP AL,80H+8
JAE @@4
PUSH DX
PUSH BX
PUSH AX
INC AL
MOV CH,-1
CALL RealTrunc
POP CX
POP SI
POP DI
PUSH AX
PUSH CX
CALL RealFloat
POP CX
OR AL,AL
JZ @@1
DEC AL
@@1: XCHG AX,CX
XCHG BX,SI
XCHG DX,DI
CALL RealSub
MOV DI,OFFSET CS:ExpConst
MOV CX,8
CALL CalcSer1
POP CX
SHR CX,1
JNC @@2
PUSH CX
MOV CX,0FB81H ;SQRT(2)
MOV SI,0F333H
MOV DI,03504H
CALL RealMul
POP CX
@@2: ADD AL,CL
JC @@4
POPF
JZ @@3
MOV CX,AX
MOV SI,BX
MOV DI,DX
MOV AX,81H
XOR BX,BX
XOR DX,DX
CALL RealDiv
@@3: RETF
@@4: POP AX
MOV AX,205
JMP HaltError
; Exp series constants
ExpConst:
DB 06DH,02EH,01DH,011H,060H,031H
DB 070H,046H,02CH,0FEH,0E5H,07FH
DB 074H,036H,07CH,089H,084H,021H
DB 077H,053H,03CH,0FFH,0C3H,02EH
DB 07AH,0D2H,07DH,05BH,095H,01DH
DB 07CH,025H,0B8H,046H,058H,063H
DB 07EH,016H,0FCH,0EFH,0FDH,075H
DB 080H,0D2H,0F7H,017H,072H,031H
; ArcTan standard function
RArcTan:
LOC Temp,BYTE,6
ENTRY FAR
OR AL,AL
JNZ @@0
JMP @@8
@@0: XOR CX,CX
TEST DH,80H
JZ @@1
INC CX
AND DH,7FH
@@1: PUSH CX
MOV CX,81H
XOR SI,SI
XOR DI,DI
CALL RealCmp
JB @@2
XCHG AX,CX
XCHG BX,SI
XCHG DX,DI
CALL RealDiv
POP CX
INC CX
INC CX
PUSH CX
@@2: MOV CX,04A7EH ;PI/24
MOV SI,0E98EH
MOV DI,00C6FH
CALL RealCmp
JAE @@3
CALL ArcTan
JMP SHORT @@6
@@3: MOV DI,OFFSET CS:ArcTanScale
MOV CX,2
@@4: PUSH CX
PUSH DI
MOV CX,CS:[DI].w0
MOV SI,CS:[DI].w2
MOV DI,CS:[DI].w4
CALL RealCmp
POP DI
POP CX
JB @@5
ADD DI,18
LOOP @@4
SUB DI,6
@@5: ADD DI,6
MOV Temp.w0,AX
MOV Temp.w2,BX
MOV Temp.w4,DX
PUSH DI
MOV CX,CS:[DI].w0
MOV SI,CS:[DI].w2
MOV DI,CS:[DI].w4
CALL RealSubP
PUSH DX
PUSH BX
PUSH AX
MOV AX,Temp.w0
MOV BX,Temp.w2
MOV DX,Temp.w4
CALL RealMul
MOV CX,81H
XOR SI,SI
XOR DI,DI
CALL RealAdd
MOV CX,AX
MOV SI,BX
MOV DI,DX
POP AX
POP BX
POP DX
CALL RealDiv
CALL ArcTan
POP DI
ADD DI,6
MOV CX,CS:[DI].w0
MOV SI,CS:[DI].w2
MOV DI,CS:[DI].w4
CALL RealAdd
@@6: POP CX
TEST CL,2
JZ @@7
PUSH CX
MOV CX,AX
MOV SI,BX
MOV DI,DX
MOV AX,02181H ;PI/2
MOV BX,0DAA2H
MOV DX,0490FH
CALL RealSub
POP CX
@@7: TEST CL,1
JZ @@8
OR DH,80H
@@8: EXIT
; ArcTan scaling constants
ArcTanScale:
DB 07FH,0E7H,0CFH,0CCH,013H,054H
DB 07FH,0F6H,0F4H,0A2H,030H,009H
DB 07FH,06AH,0C1H,091H,00AH,006H
DB 080H,0B5H,09EH,08AH,06FH,044H
DB 080H,082H,02CH,03AH,0CDH,013H
DB 080H,06AH,0C1H,091H,00AH,006H
DB 081H,000H,000H,000H,000H,000H
DB 080H,021H,0A2H,0DAH,00FH,049H
; ArcTan series constants
ArcTanConst:
DB 07DH,0E8H,0A2H,08BH,02EH,0BAH
DB 07DH,08EH,0E3H,038H,08EH,063H
DB 07EH,049H,092H,024H,049H,092H
DB 07EH,0CDH,0CCH,0CCH,0CCH,04CH
DB 07FH,0ABH,0AAH,0AAH,0AAH,0AAH
; Compute fractional ArcTan
ArcTan:
MOV DI,OFFSET CS:ArcTanConst
MOV CX,5
; Evaluate 2nd power series
CalcSer2:
PUSH DX
PUSH BX
PUSH AX
PUSH CX
PUSH DI
MOV CX,AX
MOV SI,BX
MOV DI,DX
CALL RealMul
POP DI
POP CX
CALL CalcSer1
POP CX
POP SI
POP DI
JMP RealMul
; Evaluate 1st power series
; In CX = Number of constants
; CS:DI = Pointer to first constant
; Out R1 = (((C1*R1+C2)*R1+C3)*R1...+Cn)*R1+1
CalcSer1:
LOC Temp,BYTE,6
ENTRY
MOV Temp.w0,AX
MOV Temp.w2,BX
MOV Temp.w4,DX
MOV AX,CS:[DI].w0
MOV BX,CS:[DI].w2
MOV DX,CS:[DI].w4
PUSH CX
PUSH DI
JMP SHORT @@2
@@1: PUSH CX
PUSH DI
MOV CX,CS:[DI].w0
MOV SI,CS:[DI].w2
MOV DI,CS:[DI].w4
CALL RealAdd
@@2: MOV CX,Temp.w0
MOV SI,Temp.w2
MOV DI,Temp.w4
CALL RealMul
POP DI
POP CX
ADD DI,6
LOOP @@1
MOV CX,81H
XOR SI,SI
XOR DI,DI
CALL RealAdd
EXIT
CODE ENDS
END