home *** CD-ROM | disk | FTP | other *** search
-
- ; *******************************************************
- ; * *
- ; * Turbo Pascal Runtime Library *
- ; * Real Kernel Routines *
- ; * *
- ; * Copyright (C) 1988,90 Borland International *
- ; * *
- ; *******************************************************
-
- TITLE FP48
-
- INCLUDE SE.ASM
-
- CODE SEGMENT BYTE PUBLIC
-
- ASSUME CS:CODE
-
- ; Publics
-
- PUBLIC RealAdd,RealSub,RealMul,RealDiv,RealCmp
- PUBLIC RealFloat,RealTrunc
-
- ; The 6-byte real kernel routines operate on two floating point
- ; pseudo-registers, referred to as R1 and R2. Each pseudo-register
- ; is the concatenation of three 8086 registers. R1 is DX:BX:AX,
- ; and R2 is DI:SI:CX.
-
- ; Real subtraction
- ; In R1 = 1st operand
- ; R2 = 2nd operand
- ; Out R1 = Result
- ; CF = 1 if overflow
- ; Uses CX,SI,DI
-
- RealSub:
-
- XOR DI,8000H
-
- ; Real addition
- ; In R1 = 1st operand
- ; R2 = 2nd operand
- ; Out R1 = Result
- ; CF = 1 if overflow
- ; Uses CX,SI,DI
-
- RealAdd:
-
- OR CL,CL
- JE @@8
- OR AL,AL
- JE @@9
- CMP AL,CL
- JBE @@1
- XCHG AX,CX
- XCHG BX,SI
- XCHG DX,DI
- @@1: SUB AL,CL
- NEG AL
- CMP AL,41
- JAE @@9
- XCHG AL,CL
- PUSH BP
- PUSH AX
- MOV AH,DH
- AND AH,80H
- MOV BP,AX
- XOR AX,DI
- POP AX
- PUSHF
- MOV AL,0
- OR DH,80H
- OR DI,8000H
- @@2: CMP CL,8
- JB @@3
- MOV AL,AH
- MOV AH,BL
- MOV BL,BH
- MOV BH,DL
- MOV DL,DH
- XOR DH,DH
- SUB CL,8
- JMP @@2
- @@3: OR CL,CL
- JE @@5
- @@4: SHR DX,1
- RCR BX,1
- RCR AX,1
- DEC CL
- JNE @@4
- @@5: POPF
- JS @@12
- ADD AX,CX
- ADC BX,SI
- ADC DX,DI
- MOV CX,BP
- POP BP
- JNC @@6
- RCR DX,1
- RCR BX,1
- RCR AX,1
- INC CL
- JE @@11
- @@6: ADD AX,80H
- ADC BX,0
- ADC DX,0
- JC @@10
- @@7: MOV AL,CL
- AND DH,7FH
- OR DH,CH
- @@8: RET
- @@9: MOV AX,CX
- MOV BX,SI
- MOV DX,DI
- RET
- @@10: RCR DX,1
- INC CL
- JNE @@7
- @@11: STC
- RET
- @@12: SUB AX,CX
- SBB BX,SI
- SBB DX,DI
- MOV CX,BP
- POP BP
- JNC @@13
- NOT DX
- NOT BX
- NEG AX
- CMC
- ADC BX,0
- ADC DX,0
- XOR CH,80H
- @@13: MOV DI,DX
- OR DI,BX
- OR DI,AX
- JE @@8
- @@14: OR DH,DH
- JS @@6
- SHL AX,1
- RCL BX,1
- RCL DX,1
- DEC CL
- JNE @@14
-
- ; Return zero
-
- ExitZero1:
-
- JMP ExitZero
-
- ; Real multiplication
- ; In R1 = 1st operand
- ; R2 = 2nd operand
- ; Out R1 = Result
- ; CF = 1 if overflow
- ; Uses CX,SI,DI
-
- RealMul:
-
- OR AL,AL
- JE ExitZero1
- OR CL,CL
- JE ExitZero1
- PUSH BP
- MOV BP,DX
- XOR DX,DI
- AND DX,8000H
- XCHG DL,AL
- ADD DL,CL
- ADC DH,AL
- MOV CL,AL
- OR BP,8000H
- OR DI,8000H
- PUSH DX
- OR AH,AH
- JNE @@1
- OR BX,BX
- JE @@2
- @@1: OR CH,CH
- JNE @@3
- OR SI,SI
- JNE @@3
- XCHG AX,CX
- XCHG BX,SI
- XCHG BP,DI
- @@2: MOV AX,CX
- MUL BP
- MOV BX,DX
- MOV AX,SI
- MUL BP
- ADD BX,AX
- ADC DX,0
- MOV CX,DX
- MOV AX,DI
- MUL BP
- ADD AX,CX
- ADC DX,0
- JMP @@4
- @@3: PUSH DI
- PUSH SI
- PUSH CX
- PUSH BP
- PUSH BX
- PUSH AX
- MOV BP,SP
- XOR CX,CX
- MOV AL,[BP].b1 ;1
- MUL [BP+6].b1
- MOV SI,AX
- MOV DI,CX
- MOV BX,CX
- MOV AX,[BP].w0 ;2
- MUL [BP+6].w2
- ADD SI,AX
- ADC DI,DX
- ADC BX,CX
- MOV AX,[BP].w2
- MUL [BP+6].w0
- ADD SI,AX
- ADC DI,DX
- ADC BX,CX
- MOV SI,CX
- MOV AX,[BP].w0 ;3
- MUL [BP+6].w4
- ADD DI,AX
- ADC BX,DX
- ADC SI,CX
- MOV AX,[BP].w2
- MUL [BP+6].w2
- ADD DI,AX
- ADC BX,DX
- ADC SI,CX
- MOV AX,[BP].w4
- MUL [BP+6].w0
- ADD DI,AX
- ADC BX,DX
- ADC SI,CX
- MOV DI,CX
- MOV AX,[BP].w2 ;4
- MUL [BP+6].w4
- ADD BX,AX
- ADC SI,DX
- ADC DI,CX
- MOV AX,[BP].w4
- MUL [BP+6].w2
- ADD BX,AX
- ADC SI,DX
- ADC DI,CX
- MOV AX,[BP].w4 ;5
- MUL [BP+6].w4
- ADD AX,SI
- ADC DX,DI
- ADD SP,12
- @@4: XCHG AX,BX
- POP CX
- POP BP
- OR DH,DH
- JS @@5
- SHL AX,1
- RCL BX,1
- RCL DX,1
- DEC CX
- @@5: SUB CX,8081H
-
- ; Common exit from multiply and divide
-
- ExitMulDiv:
-
- ADD AX,80H
- ADC BX,0
- ADC DX,0
- JNC @@1
- RCR DX,1
- INC CX
- @@1: TEST CH,40H
- JNE ExitZero
- INC CX
- MOV AL,CL
- XOR DH,CH
- SHR CH,1
- RET
-
- ; Return zero
-
- ExitZero:
-
- XOR AX,AX
- MOV BX,AX
- MOV DX,AX
- RET
-
- ; Real division
- ; In R1 = 1st operand
- ; R2 = 2nd operand
- ; Out R1 = Result
- ; CF = 1 if overflow
- ; Uses CX,SI,DI
-
- RealDiv:
-
- OR AL,AL
- JE ExitZero
- PUSH BP
- MOV BP,DX
- XOR DX,DI
- OR DI,8000H
- OR BP,8000H
- AND DX,8000H
- XCHG AL,DL
- SUB DL,CL
- SBB DH,AL
- PUSH DX
- MOV AL,2
- MOV DX,1
- @@1: CMP BP,DI
- JNE @@2
- CMP BX,SI
- JNE @@2
- CMP AH,CH
- @@2: JC @@3
- SUB AH,CH
- SBB BX,SI
- SBB BP,DI
- @@3: RCL DX,1
- JC @@5
- @@4: SHL AH,1
- RCL BX,1
- RCL BP,1
- JNC @@1
- SUB AH,CH
- SBB BX,SI
- SBB BP,DI
- CLC
- JMP @@3
- @@5: DEC AL
- JS @@6
- PUSH DX
- MOV DX,1
- JNE @@4
- MOV DL,40H
- JMP @@4
- @@6: MOV AX,DX
- MOV CL,6
- SHL AX,CL
- POP BX
- POP DX
- POP CX
- POP BP
- NOT AX
- NOT BX
- XOR DX,0FFFFH
- JS @@7
- RCL AX,1
- RCL BX,1
- RCL DX,1
- DEC CX
- @@7: ADD CX,8080H
- JMP ExitMulDiv
-
- ; Real compare
- ; In R1 = 1st operand
- ; R2 = 2nd operand
- ; Out ZF = Set if R1=R2
- ; CF = Set if R1<R2
- ; Uses None
-
- RealCmp:
-
- PUSH DX
- XOR DX,DI
- POP DX
- JNS @@1
- PUSH DX
- RCL DX,1
- POP DX
- RET
- @@1: TEST DH,80H
- JZ @@2
- CALL @@2
- JE @@3
- CMC
- RET
- @@2: CMP AL,CL
- JNE @@3
- OR AL,AL
- JZ @@3
- CMP DX,DI
- JNE @@3
- CMP BX,SI
- JNE @@3
- CMP AH,CH
- @@3: RET
-
- ; Convert integer to real
- ; In DX:AX = Integer value
- ; Out R1 = Real value
- ; Uses CX
-
- RealFloat:
-
- MOV BX,AX
- OR BX,DX
- JE @@5
- MOV CH,DH
- OR DX,DX
- JNS @@1
- NEG DX
- NEG AX
- SBB DX,0
- @@1: MOV BX,AX
- MOV AX,0A0H
- OR DX,DX
- JNZ @@2
- XCHG DX,BX
- MOV AL,90H
- OR DH,DH
- JNZ @@2
- XCHG DH,DL
- MOV AL,88H
- @@2: OR DX,DX
- JS @@4
- @@3: DEC AL
- ADD BX,BX
- ADC DX,DX
- JNS @@3
- @@4: OR CH,CH
- JS @@5
- AND DH,7FH
- @@5: RET
-
- ; Convert real to integer
- ; In R1 = real value
- ; CH = Non-zero for round
- ; Out DX:AX = Integer value
- ; CF = 1 if overflow
- ; Uses BX,CX
-
- RealTrunc:
-
- XCHG AX,BX
- MOV CL,80H+32
- SUB CL,BL
- JC @@7
- MOV BL,DH
- OR DH,80H
- CMP CL,32
- JAE @@8
- CMP CL,16
- JB @@1
- MOV BH,AH
- MOV AX,DX
- XOR DX,DX
- SUB CL,16
- @@1: CMP CL,8
- JB @@2
- MOV BH,AL
- MOV AL,AH
- MOV AH,DL
- MOV DL,DH
- XOR DH,DH
- SUB CL,8
- @@2: OR CL,CL
- JE @@4
- @@3: SHR DX,1
- RCR AX,1
- RCR BH,1
- DEC CL
- JNE @@3
- @@4: OR CH,CH
- JE @@5
- ADD BH,BH
- ADC AX,0
- ADC DX,0
- JC @@7
- @@5: MOV CX,AX
- OR CX,DX
- JE @@7
- OR BL,BL
- JNS @@6
- NEG DX
- NEG AX
- SBB DX,0
- @@6: XOR BL,DH
- ADD BL,BL
- @@7: RET
- @@8: MOV BH,DH
- MOV AX,0
- MOV DX,0
- JE @@4
- RET
-
- CODE ENDS
-
- END
-