home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
C!T ROM 2
/
ctrom_ii_b.zip
/
ctrom_ii_b
/
PROGRAM
/
PASCAL
/
TPL60N19
/
ARISOURC
/
FP48KER.ASM
< prev
next >
Wrap
Assembly Source File
|
1993-01-25
|
41KB
|
899 lines
; *******************************************************
; * *
; * Turbo Pascal Runtime Library Version 6.0 *
; * Real Kernel Routines (Add,Sub,Mul,Div,Sqr) *
; * *
; * Copyright (C) 1989-1992 Norbert Juffa *
; * *
; *******************************************************
TITLE FP48KER
INCLUDE SE.ASM
;-------------------------------------------------------------------------------
;
; Turbo Pascal REAL floating-point format
;
; 47 46 8 7 0
; +--+------------------------------+--------+
; |S | Mantissa |Exponent|
; +--+------------------------------+--------+
;
; 47 31 15 7 0
; +-------------+------------+------+--------+
; | DX | BX | AH | AL |
; +-------------+------------+------+--------+
;
; 47 31 15 7 0
; +-------------+------------+------+--------+
; | DI | SI | CH | CL |
; +-------------+------------+------+--------+
;
; value = 1^(-S) * Mantissa/2^40 * 2^(Exponent - 129)
;
;-------------------------------------------------------------------------------
CODE SEGMENT BYTE PUBLIC
ASSUME CS:CODE
; Externals
EXTRN HaltError:NEAR
; Publics
PUBLIC RealAdd,RealSub,RealMul,RealDiv
PUBLIC RealSqr,RealSqrNoChk,RealDivRev
PUBLIC RealMulNoChk,RealMulNChk2
PUBLIC RAdd,RSub,RMul,RDiv,RSqr,ROverflow
;-------------------------------------------------------------------------------
; RealAdd and RealSub are the routines for adding and subtracting two numbers
; in the Turbo Pascal 6 byte floating point format. They are practically ident-
; ical, since subtraction is implemented as an addition with a negated second
; addend. If underflow occurs, zero is returned. On overflow the carry flag
; will be set. The rounding of these routines complies with the IEEE "round to
; nearest or even" mode. Guard and sticky flags are therefore fully implemented.
;
; INPUT: DX:BX:AX first addend
; DI:SI:CX second addend
;
; OUTPUT: DX:BX:AX sum
; CF set if overflow occured, else cleared
;
; DESTROYS: AX,BX,CX,DX,SI,DI,Flags
;-------------------------------------------------------------------------------
AddExt PROC NEAR
$ret_second: XCHG AX, CX ; load second addend
MOV BX, SI ; into DX:BX:AX (DX currently loaded)
RET ; done
AddExt ENDP
RealSub PROC NEAR
XOR DI, 8000h ; negate second argument
RealSub ENDP
RealAdd PROC NEAR
CMP CL, AL ; second addend bigger ?
JAE $bigger ; yes
XCHG AX, CX ; no,
XCHG BX, SI ; exchange
XCHG DX, DI ; addends
$bigger: XCHG DX, DI ; DX = msb of second addend
NEG AL ; smaller addend zero ?
JZ $ret_second ; yes, return other addend
ADD AL, CL ; compute difference of exponents
CMP AL, 41 ; difference too big ?
JA $ret_second ; yes, add/sub will not change bigger arg
PUSH BP ; save TURBO-Pascal frame pointer
MOV BP, 0FF00h ; load mask for msb
AND BP, CX ; save msb of second addend
MOV CH, 80h ; mask for sign bit
AND CH, DH ; sign bit of second addend
PUSH CX ; save sign and exponent
XOR CX, DI ; test if operands have different sign
PUSHF ; save sign indicator
OR DH, 80h ; set implicit bit in second addend
XCHG DX, DI ; DX = msb of first addend
OR DH, 80h ; set implicit bit in first addend
XOR CX, CX ; set guard and sticky bytes to 0
IFDEF USE386
.386
XCHG CL, AL ; shift counter in CX
SHL EDX, 16
MOV DX, BX
XOR EBX, EBX
SHRD EBX, EAX, 16
XOR EAX, EAX ; mantissa in EDX:EBX:EAX
CMP CX, 32
JB $do_32
XCHG EAX, EDX
XCHG EAX, EBX
$do_32: SHRD EAX, EBX, CL
SHRD EBX, EDX, CL
SHR EDX, CL
NEG EAX
SBB CX, CX
OR CX, BX
MOV BX, DX
SHR EDX, 16
SHLD EAX, EBX, 16
.8086
ELSE
comment #
XCHG CL, AL
$try_16: CMP CL, 16
JB $try_1
OR CH, AL
OR CH, AH
MOV AX, BX
MOV BX, DX
XOR DX, DX
SUB CL, 16
JMP $try_16
$try_1: PUSH SI
NEG CH
SBB SI, SI
SHRD SI, AX, CL
SHRD AX, BX, CL
SHRD BX, DX, CL
SHR DX, CL
NEG SI
SBB CH, CH
POP SI
MOV CL, CH
ELSE
#
XCHG AL, CH ; DX:BX:AX = mantissa, CH = shift counter
$test_shift: CMP CH, 4 ; less than 4 bit shifts necessary ?
JB $bit_shift ; yes, do it one bit at a time
CMP CH, 8 ; between 4 and 7 bit shifts necessary ?
JB $4bit_shift ; yes, do 4 bit shift first
CMP CH, 16 ; between 8 and 15 bit shifts necessary ?
JB $byte_shift ; yes, do byte shift first
OR CL, AL ; accumulate
OR CL, AH ; sticky byte
XCHG AX, DX ; shift
XCHG AX, BX ; mantissa 16 bits
XOR DX, DX ; to the right
SUB CH, 16 ; decrement shift counter by 16
JMP $test_shift ; test remaining shifts
$byte_shift: OR CL, AL ; accumulate sticky byte
MOV AL, AH ; shift
MOV AH, BL ; mantissa
MOV BL, BH ; eight
MOV BH, DL ; bits
MOV DL, DH ; to the
XOR DH, DH ; right
TEST CH, 4 ; 4 bit shift possible ?
JZ $bit_shift ; no, try single bit shifts
$4bit_shift: NEG CL ; set sticky flag = FFh
SBB CL, CL ; if <> 0 before
OR CL, AL ; accumulate
AND CL, 0Fh ; sticky flag
SHR DX, 1 ; shift
RCR BX, 1 ; mantissa
RCR AX, 1 ; 1 bit to the right
SHR DX, 1 ; shift
RCR BX, 1 ; mantissa
RCR AX, 1 ; 1 bit to the right
SHR DX, 1 ; shift
RCR BX, 1 ; mantissa
RCR AX, 1 ; 1 bit to the right
SHR DX, 1 ; shift
RCR BX, 1 ; mantissa
RCR AX, 1 ; 1 bit to the right
$bit_shift: AND CH, 3 ; compute number of single bit shifts
JZ $shift_done ; no shifts necessary, mantissas aligned
NEG CL ; set sticky flag to FFh
SBB CL, CL ; if <> 0 before
ALIGN 4
$bit_loop: SHR DX, 1 ; shift
RCR BX, 1 ; mantissa
RCR AX, 1 ; 1 bit to the right
ADC CL, CL ; accumulate sticky byte
DEC CH ; decrement shift counter
JNZ $bit_loop ; until shift counter zero
ENDIF
$shift_done: POPF ; signs of addends different ?
JS $subtract ; sign of addends differ
ADD AX, BP ; add
ADC BX, SI ; mantissas
ADC DX, DI ; of two addends
MOV BP, CX ; get sticky byte
POP CX ; get exponent and sign
JNC $no_overf ; no mantissa overflow
SHR DX, 1 ; divide
RCR BX, 1 ; mantissa
RCR AX, 1 ; by two
INC CX ; adjust exponent
$no_overf: DEC CX ; exponent-1
JMP $add_sub_end ; do rounding
$ret_first: POP BP ; restore TURBO-Pascal frame pointer
RET ; done
$subtract: XCHG AX, BP ; exchange
XCHG BX, SI ; addends
XCHG DX, DI ; for correct order
NEG CX ; set carry if sticky byte <> 0
SBB AX, BP ; subtract
SBB BX, SI ; the two
SBB DX, DI ; mantissas
MOV BP, CX ; get sticky byte
POP CX ; get exponent and sign of result
JNC $no_negate ; no negative result
XOR CH, 80h ; result has other sign than 2. addend
NOT DX ; negate
NOT BX ; number
NEG AX ; in
SBB BX, -1 ; DX:BX:AX
SBB DX, -1 ; "
$no_negate: JS $no_overf ; mantissa normalized
JZ $test_z1 ; first mantissa word is zero
ALIGN 4
$shift_l: DEC CX ; adjust exponent
ADD AX, AX ; multiply
ADC BX, BX ; mantissa
ADC DX, DX ; by two
JNS $shift_l ; normalized? no
DEC CX ; exponent-1
JMP $add_sub_end ; do rounding
$test_z1: XCHG BX, AX ; do a 16-bit
XCHG DX, AX ; left shift of the mantissa
SUB CX, 16 ; adjust exponent
OR DX, DX ; first mantissa word zero?
JG $shift_l ; not zero, no sign
JS $no_overf ; mantissa normalized
XCHG DX, BX ; shift mantissa 16 bits left (AX=0)
SUB CX, 16 ; adjust exponent
OR DX, DX ; first mantissa word zero ?
JG $shift_l ; not zero, no sign
JS $no_overf ; mantissa normalized
POP BP ; mantissa zero, return DX:BX:AX=0
RET ; done
RealAdd ENDP
;-------------------------------------------------------------------------------
; RealMul multiplies two numbers in the Turbo Pascal 6 byte floating point
; format. If underflow occurs, zero is returned. On overflow the carry flag
; will be set. The routine multiplies the mantissas by computing nine partial
; products using the 80x86 MUL instruction. RealMulNoChk is the same routine
; as RealMul but does not check the operand in DI:SI:CX for zero. The fastest
; multiplication routine, RealMulNChk2, does not check either operand for zero.
; The rounding of this routine complies with IEEE "round to nearest or even"
; mode. For this purpose, guard and sticky flags are implemented.
;
; INPUT: DX:BX:AX multiplicand
; DI:SI:CX multiplicator
;
; OUTPUT: DX:BX:AX product
; CF set if overflow occured, else cleared
;
; DESTROYS: AX,BX,CX,DX,SI,DI,Flags
;-------------------------------------------------------------------------------
ALIGN 4
RealMul PROC NEAR
OR CL, CL ; multiplicator = 0 ?
JZ $zero_res ; result will be 0
RealMulNoChk PROC NEAR
OR AL, AL ; multiplicand = 0 ?
JZ $zero_res ; result is zero
RealMulNChk2 PROC NEAR
PUSH BP ; save TURBO-framepointer
XCHG BX, DI ; BX = b1, DI = a2
MOV BP, DX ; get sign of multiplicant
XOR BP, BX ; compute sign of result
AND BP, 8000h ; mask out sign bit
XCHG AL, CH ; save b3
ADD CL, CH ; sum of biased exponents
SBB CH, CH ; clear msb
NEG CH ; and put possible overflow in CH
OR CX, BP ; zap in sign bit
PUSH CX ; save new exponent and sign bit
XOR CX, CX ; clear lo-bytes of a3 and b3
OR DH, 80h ; set implicit bit of multipicand
OR BH, 80h ; set implicit bit of multiplicator
OR SI, SI ; b2 = 0 ?
JZ $test_short ; yes, test if b3 = 0
OR DI, DI ; a2 = 0 ?
JNZ $full_mult ; no, use full multiplication
OR AH, AH ; a3 = 0 ?
JNZ $full_mult ; no, use full multiplication
XCHG AH, AL ; swap a3 and b3
XCHG DI, SI ; swap a2 and b2
XCHG DX, BX ; swap a1 and b1
$test_short: OR AL, AL ; b3 = 0 ?
JNZ $full_mult ; no, use full multiplication
MOV SI, DX ; save a1
MUL BX ; b1 * a3
MOV BP, AX ; generate sticky byte = 0
XCHG AX, DX ; AX = msw of product
XCHG AX, DI ; save msw of product, get a2
MUL BX ; b1 * a2
XCHG AX, BX ; save lsw of product, get b1
XCHG DX, SI ; save msw of product, get a1
ADD BX, DI ; add product
ADC SI, CX ; to FPA
MUL DX ; b1 * a1
ADD AX, SI ; add product
ADC DX, CX ; result in DX:AX:BX
JMP $end_mantiss ; handle exponent
$zero_res: JMP $zero_prod2 ; result is 0
ALIGN 4
IFDEF USE386
.386
$full_mult: XCHG AL, CH ; CH = b3, AL = 0
; b1 = BX
; b2 = SI
; b3 = CX
; a1 = DX
; a2 = DI
; a3 = AX
SHL ESI, 16
SHRD ESI, EBX, 16 ; b1:b2 in ESI
SHL EDI, 16
SHRD EDI, EDX, 16 ; a1:a2 in EDI
MOV BX, AX ;
MUL CX ; a3*b3
SHL EBX, 16 ; a3
SHL ECX, 16 ; b3
SHL EAX, 16
SHRD EAX, EDX, 16 ; result in EAX
XCHG EAX, EBX ; save a3*b3
MUL ESI ; a3*(b1:b2)
ADD EBX, EAX
XCHG EAX, ECX ; get b3
MOV ECX, 0
ADC ECX, EDX ; ECX:EBX
MUL EDI ; b3*(a1:a2)
ADD EBX, EAX
MOV EAX, 0
ADC ECX, EDX
XCHG EAX, EDI
ADC EDI, EDI
MUL ESI
ADD EAX, ECX
ADC EDX, EDI ; EDX:EAX:EBX
NEG EBX
SBB BP, BP
OR BP, AX
SHLD EBX, EAX, 16
XCHG AX, DX
SHR EDX, 16
JMPS $end_mantiss
$sqr_end: ADC DI, DX ; to SI:DI:BX
ADC SI, 0 ; FPA
MUL CX ; a1 * b1
ADD AX, DI
ADC DX, SI ; result in DX:AX:BX
.8086
ELSEIFDEF FASTOPS
ALIGN 4
$full_mult: XCHG AL, CH ; CH = b3, AL = 0
PUSH BX ; save b1
PUSH DX ; save a1
MOV BP, DX ; save a1
; b1 = BX
; b2 = SI
; b3 = CX
; a1 = DX
; a2 = DI
; a3 = AX
MUL BX ; b1 * a3
XOR BX, BX ; clear FPA
XCHG AX, CX ; get b3, save LSW (b1*a3)
XCHG DX, BP ; get a1, save MSW (b1*a3)
MUL DX ; a1 * b3
ADD CX, AX ; add
ADC BP, DX ; result
ADC BX, BX ; to FPA
MOV AX, SI ; b2
MUL DI ; a2 * b2
ADC CX, AX
ADC BP, DX
ADC BX, 0
XOR CX, CX ; FPA = CX:BX:BP
XCHG AX, SI ; get b2
POP SI ; get a1
MUL SI ; a1 * b2
ADD BP, AX ; add
ADC BX, DX ; result
ADC CX, CX ; to FPA
XCHG AX, DI ; get a2
POP DI ; get b1
MUL DI ; a2 * b1
ADD BP, AX ; add result
XCHG AX, DI ; get a1
XCHG CX, SI ; CX = b1
MOV DI, BX ; FPA = SI:DI:BX
MOV BX, BP ;
$sqr_end: ADC DI, DX ; to SI:DI:BX
ADC SI, 0 ; FPA
MUL CX ; a1 * b1
ADD AX, DI
ADC DX, SI ; result in DX:AX:BX
ELSE
$full_mult: PUSH BX ; save b1
PUSH DI ; save a2
PUSH SI ; save b2
PUSH DX ; save a1
PUSH BX ; save b1
MOV BX, CX ; clear most significant word of FPA
XCHG AL, CH ; CH = b3, AL = 0
MOV BP, AX ; a3
MOV AL, CH ; b3
MUL AH ; a3 * b3
XCHG AX, DI ; store to FPA, get a2
MUL CX ; a2 * b3
ADD DI, AX ; add result
ADC DX, BX ; to FPA
XCHG AX, DX ; and
XCHG AX, SI ; get b2
MUL BP ; a3 * b2
ADD DI, AX ; add result
ADC SI, DX ; to
ADC BX, BX ; FPA
XCHG AX, BP ; get a3
MOV BP, DI ; generate sticky flag
XOR DI, DI ; FPA = DI:BX:SI
POP DX ; get b1
MUL DX ; a3 * b1
ADD SI, AX ; add result to
ADC BX, DX ; FPA, no overflow possible
XCHG AX, CX ; b3
POP CX ; a1
MUL CX ; a1 * b3
ADD SI, AX ; add
ADC BX, DX ; result to
ADC DI, DI ; FPA
POP AX ; b2
POP DX ; a2
PUSH DX ; save a2
PUSH AX ; save b2
MUL DX ; a2 * b2
ADD SI, AX ; add
ADC BX, DX ; result
ADC DI, 0 ; to FPA
OR BP, SI ; accumulate sticky flag
XOR SI, SI ; FPA = SI:DI:BX
POP AX ; b2
MUL CX ; a1 * b2
ADD BX, AX ; add
ADC DI, DX ; result
ADC SI, SI ; to FPA
POP AX ; a2
POP DX ; get b1
PUSH DX ; save b1
MUL DX ; a2 * b1
ADD BX, AX ; add -------+
POP AX ; get b1 !
$sqr_end: ADC DI, DX ; result <-+
ADC SI, 0 ; to FPA
MUL CX ; a1 * b1
ADD AX, DI ; add result to FPA
ADC DX, SI ; DX:AX:BX = result
ENDIF
$end_mantiss:POP CX ; CH = exponent CL = sign
XCHG AX, BX ; DX:BX:AX = result
; SUB CX, 81h ; compute new exponent-1
$div_end: ; OR DX, DX ; is mantissa normalized ?
; JS $add_sub_end ; yes
js $$1
ADD AX, AX ; no, shift
ADC BX, BX ; FPA 1 bit
ADC DX, DX ; to the left
DEC CX ; adjust exponent
$$1: sub cx, 81h
$add_sub_end:ADD AX, 80h ; round
ADC BX, 0 ; up
ADC DX, 0 ; mantissa
ADC CX, 0 ; increment exponent if mantissa overfl.
IFNDEF FASTOPS
OR AL, AL ; tie case ?
JZ $tie_case ; tie case possible if sticky = 0, too
ENDIF
$round_done: POP BP ; restore caller's frame pointer
TEST CH, 40H ; test if (exponent-1) negative
JNZ $zero_prod2 ; yes, underflow, return zero
INC CX ; new exponent
MOV AL, CL ; store exponent
AND DH, 7Fh ; force MSB of mantissa to 0
OR DH, CH ; fill in sign bit
IFDEF NOOVERFLOW
ROR CH, 1 ; test if exponent overflow
ROL CH, 1 ; restore sign flag
ELSE
SHR CH, 1 ; test if exponent overflow (> FFh)
ENDIF
RET ; done
$zero_prod2: XOR AX, AX ; load
MOV BX, AX ; a
CWD ; zero
RET ; done
$tie_case: OR BP, BP ; sticky flag = 0 (tie case) ?
JNZ $round_done ; no, round up was correct
AND AH, 0FEh ; tie case, make mantissa even
JMP $round_done ; IEEE rounding done
RealMulNChk2 ENDP
RealMulNoChk ENDP
RealMul ENDP
;-------------------------------------------------------------------------------
; RealSqr computes the square of a number in the Turbo Pascal 6-byte floating
; point format. If underflow occurs, zero is returned. On overflow the carry
; flag will be set. Since squaring allows for some optimizations in code when
; compared with normal multiplication, RealSqr is implemented as a self con-
; tained routine and not as a call to RealMul. The routine exits thru RealMul.
; RealSqrNoChk does not check the argument for zero before squaring. Rounding
; complies with the IEEE "round to nearest or even" mode, so guard and sticky
; flags are provided.
;
; INPUT: DX:BX:AX argument
;
; OUTPUT: DX:BX:AX square of argument
; CF set if overflow occured, else cleared
;
; DESTROYS: AX,BX,CX,DX,SI,DI,Flags
;-------------------------------------------------------------------------------
RealSqr PROC NEAR
OR AL, AL ; argument = 0 ?
JZ $zero_prod2 ; result is zero
RealSqrNoChk PROC NEAR
XOR CX, CX ; clear register
XCHG CL, AL ; exponent in CL, AL = 0
ADD CX, CX ; new exponent, sign always positive (0)
PUSH BP ; save TURBO-Pascal frame pointer
PUSH CX ; save sign and exponent
OR DH, 80h ; set implicit bit of argument
MOV SI, AX ; a2 and
OR SI, BX ; a3 = 0 ?
JNZ $full_sqr ; no, do full multiplication
MOV AX, DX ; load a1
MUL DX ; a1 * a1
or dx, dx
JMPS $end_mantiss ; result in DX:AX:BX
ALIGN 2
$full_sqr: PUSH BX ; save a2
XOR DI, DI ; load zero
MOV CX, DX ; save a1
MOV BP, AX ; save a3
MOV AL, AH ; load a3
MUL AL ; a3 * a3
XCHG AX, BX ; save product, get a2
MUL BP ; a2 * a3
XCHG AX, BP ; get a3, BP = save lo-word a2*a3
MOV SI, DX ; save hi-word a2*a3
ADD BX, BP ; add a3*a3 to
ADC SI, DI ; a2*a3 (result in SI:BX, no overflow)
ADD BP, BX ; add a2*a3 lo-word to result
MOV BX, DI ; BX = 0
ADC SI, DX ; add a2*a3 hi-word
ADC DI, DI ; to result (DI:SI:BP)
XCHG DI, BX ; FPA = DI:BX:SI, BP = sticky byte
MUL CX ; a1 * a3
ADD SI, AX ; add product
ADC BX, DX ; to FPA (no overflow possible)
ADD SI, AX ; add
ADC BX, DX ; product to
ADC DI, DI ; FPA another time
POP AX ; get a2
PUSH AX ; save a2
MUL AX ; a2 * a2
ADD SI, AX ; add
ADC BX, DX ; product to
ADC DI, 0 ; FPA
OR BP, SI ; accumulate sticky byte
XOR SI, SI ; FPA = SI:DI:BX
POP AX ; get a2
MUL CX ; a1 * a2
ADD BX, AX ; add
ADC DI, DX ; resulting
ADC SI, SI ; product
ADD BX, AX ; to FPA twice
MOV AX, CX ; AX = CX = a1
JMP $sqr_end ; exit thru REAL_MUL
RealSqrNoChk ENDP
RealSqr ENDP
;-------------------------------------------------------------------------------
; RealDiv divides two numbers in the Turbo Pascal 6 byte floating point
; format. If underflow occurs, zero is returned. On overflow the carry flag
; will be set. The routine exits through the REAL_MUL routine. It makes use
; of the 80x86 DIV instruction in an estimate and correct algorithm. In each
; of the three steps, an estimation of a part of the quotient is produced by
; dividing the first 32 bits of the current remainder by the first 16 bits of
; the divisor using a machine instruction. Then the divisor is multiplied by
; the result and this product subtracted from the current remainder. If the sum
; is negative, the partial quotient must be decremented until the new remainder
; is positive. RealDivRev is an additional routine which exchanges the operands
; before performing the division. The rounding provided complies with IEEE
; "round to nearest or even" mode. For this purpose, guard and sticky flags
; are implemented.
;
; INPUT: DX:BX:AX dividend
; DI:SI:CX divisor
;
; OUTPUT: DX:BX:AX quotient
; CF set if overflow occured, else cleared
;
; DESTROYS: AX,BX,CX,DX,SI,DI,Flags
;-------------------------------------------------------------------------------
RealDivRev PROC NEAR
XCHG AX, CX ; exchange
XCHG BX, SI ; divisor and
XCHG DX, DI ; dividend
RealDivRev ENDP
RealDiv PROC NEAR
OR AL, AL ; dividend = 0 ?
JZ $zero_prod2 ; result is zero
PUSH BP ; save TURBO-Pascal framepointer
MOV BP, DX ; get msw of dividend
XOR BP, DI ; xor with msw of divisor to make sign
AND BP, 8000h ; isolate sign bit of result
OR DH, 80h ; set implicit bit in dividend
XCHG DX, DI ; DX = divisor msw, DI = dividend msw
OR DH, 80h ; set implicit bit in divisor
SUB AL, CL ; subtract exponents ----------+
MOV CL, 0 ; clear lsb of divisor lsw |
PUSH SI ; save divisor middle word |
PUSH CX ; and lsw on stack |
MOV CX, BP ; get sign |
XCHG AL, CL ; AL = 0, CL = new exponent |
SBB CH, AL ; put carry here <-------------+
add cx,101h
MOV BP, SP ; access divisor on stack via BP
SUB BP, 6 ; leave room for three pushes
SHR DI, 1 ; divide dividend
RCR BX, 1 ; by 2 to prevent
RCR AX, 1 ; an overflow condition
IFDEF FASTOPS ; di:bx:ax = dividend
; dx:[bp+8]:[bp+6] = divisor
PUSH CX ; save sign and exponent
XCHG AX, BX ; di:ax:bx = dividend
XCHG DX, DI ; dx:ax:bx = dividend, di:[bp+8]:[bp+6]
DIV DI ; AX = quotient1, DX = remainder msw
MOV CX, AX ; save quotient 1
MOV SI, DX ; save remainder = SI:BX
MUL WORD PTR [BP+8] ; quotient1 * divisor middle word
SUB BX, AX ;
SBB SI, DX ;
SBB DX, DX ; DX:SI:BX = remainder
PUSH DX ; save msw of divisor
MOV AX, [BP+6] ; divisor msw
MUL CX ;
NEG AX ;
SBB BX, DX ;
SBB SI, 0 ;
POP DX ;
SBB DX, 0 ; DX:SI:BX:AX = remainder, CX = quot 1
MOV DX, [BP+6]
MOV BP, [BP+8]
JZ $sub_ok ;
$add_twice: DEC CX ;
ADD AX, DX ;
ADC BX, BP ;
ADC SI, DI ;
JNC $add_twice ; until remainder positive
$sub_ok: MOV DX, SI ; SI:BX:AX = remainder
XCHG AX, BX ; DX:AX:BX = remainder
PUSH CX ; save quotient 1
XOR SI, SI
CMP DI, DX ; division overflow ?
JE $div_overfl
DIV DI ;
$cont: PUSH AX ; save quot2
MOV CX, DX ; CX:BX = remainder
MUL BP ;
SUB BX, AX
SBB CX, DX
SBB SI, 0
POP SI ; quot2
JNC $sub_ok2 ;
$add_twice2: DEC SI
ADD BX, BP
ADC CX, DI
JNC $add_twice2
$sub_ok2: MOV DX, CX
MOV AX, BX
CMP DX, DI
JE $div_overfl2
DIV DI
$cont2: POP DX ; get quotient 1
MOV BX, SI ; quotient = DX:BX:AX
ELSE
ALIGN 4
$divide_loop:PUSH CX ; save sign & exponent resp. part. quot.
MOV CX, DX ; get msw of divisor
XCHG AX, BX ; create new dividend
XCHG AX, DI ; by shifting remainder
XCHG AX, SI ; 16 bits to the left
CMP CX, SI ; overflow possible on division ?
JE $div_overfl ; yes
MOV DX, SI ; get msw of dividend
XCHG AX, DI ; second word of dividend
DIV CX ; compute partial quotient
XOR SI, SI ; subtract product of divisor high word
MOV DI, DX ; and partial quotient from dividend
$comp_rem: XCHG AX, CX ; AX = divisor high word, CX = quotient
PUSH AX ; save divisor high word
MOV AX, [BP+8] ; get middle word of divisor
MUL CX ; multiply by partial quotient
SUB BX, AX ; subtract the product of
SBB DI, DX ; divisor middle word and partial
SBB SI, 0 ; quotient from dividend
MOV AX, [BP+6] ; get lsw of divisor
MUL CX ; multiply by partial quotient
NEG AX ; subtract the product
SBB BX, DX ; of divisor LSW
SBB DI, 0 ; and partial
SBB SI, 0 ; quotient from dividend
POP DX ; get back msw of divisor
JZ $sub_ok ; remainder must be positive
$add_twice: DEC CX ; quotient to high, decrement it
ADD AX, [BP+6] ; adjust
ADC BX, [BP+8] ; quotient and
ADC DI, DX ; remainder
JNC $add_twice ; until remainder positive
$sub_ok: CMP BP, SP ; two partial quotients saved already ?
JNE $divide_loop ; no, continue (carry set !!!)
MOV BP, AX ; accumulate
OR BP, BX ; sticky
OR BP, DI ; byte
XCHG AX, CX ; get last partial quotient
POP BX ; get other
POP DX ; partial quotients
ENDIF
POP CX ; get sign and exponent
ADD SP, 4 ; remove saved divisor from stack
; ADD CX, 80h ; adjust new exponent for bias
; add cx, 101h
or dx, dx
JMP $div_end ; normalize mantissa and round
IFDEF FASTOPS
$div_overfl: MOV DX, AX
ADD DX, DI
ADC SI, SI
MOV AX, -1
JMP $cont
$div_overfl2:
MOV AX, -1
JMP $cont2
ELSE
$div_overfl: XOR SI, SI ; remainder - 10000h * divisor
ADD DI, CX ; remainder -
ADC SI, SI ; FFFFh * divisor
MOV AX, -1 ; quotient = FFFFh
JMP $comp_rem ; continue computation of remainder
ENDIF
RealDiv ENDP
ALIGN 4
RAdd PROC FAR
CALL RealAdd ; perform addition
JC ROverflow ; overflow error
RET ; done
RAdd ENDP
ALIGN 4
RSub PROC FAR
CALL RealSub ; perform subtraction
JC ROverflow ; overflow error
RET ; done
RSub ENDP
ALIGN 4
RSqr PROC FAR
CALL RealSqr ; perform squaring
JC ROverflow ; overflow error
RET ; done
RSqr ENDP
ALIGN 4
RMul PROC FAR
CALL RealMul ; perform multiplication
JC ROverflow ; overflow error
RET ; done
RMul ENDP
ALIGN 4
RDiv PROC FAR
OR CL, CL ; divisor zero ?
JZ RDivZero ; yes, error
CALL RealDiv ; perform division
JC ROverflow ; overflow error
RET ; done
RDiv ENDP
IFDEF NOOVERFLOW
ROverflow: MOV AX, 0FFFFh ; load
MOV BX, 0FFFFh ; largest
MOV DX, 07FFFh ; REAL number
OR DH, CH ; stuff in sign bit
RETF ; done
RDivZero: MOV CH, DH ; get dividend's sign
XOR CX, DI ; make sign of result
JMP ROverflow ; return largest REAL number
ELSE
ROverflow: MOV AX, 0CDh ; error code 205 (fp overflow)
JMP HaltError ; execute error handler
RDivZero: MOV AX, 0C8h ; error code 200 (division by zero)
JMP HaltError ; execute error handler
ENDIF
ALIGN 4
CODE ENDS
END
