.TITLE SWRFLT .IDENT /X0.04/ .NLIST TOC,SYM .ENABL LC ; Software floating-point add, subtract, multiply, and divide. ; ; Called as: ; MOV Alo,-(SP) ; MOV Ahi,-(SP) ; MOV Blo,-(SP) ; MOV Bhi,-(SP) ; JSR PC,F$op ; Compute A+B, A-B, A*B, or A/B ; ; returning the result on the top of the stack in place of A, with B deleted. ; ; C.p.u. flags are set on exit as for the 11/40 or LSI-11 FIS instructions. ; ; Developed from the Seved Torstenhahl's Pascal Compiler OTS (DECUS 11-346) ; by C J Doran, Sira Institute Ltd., South Hill, Chislehurst, Kent, England. ; Define stack offsets on entry: .MACRO ESTACK BLO=10 ; B lo word BHI=6 ; B hi word ALO=4 ; A lo word AHI=2 ; A hi word .ENDM ESTACK ; Define stack offsets during internal working (after INIT call). .MACRO ISTACK BLO=16 ; B lo word BHI=14 ; B hi word ALO=12 ; A lo word AHI=10 ; A hi word .ENDM ISTACK ; Record stack pointer change by N bytes. .MACRO USTACK N BLO=BLO+N BHI=BHI+N ALO=ALO+N AHI=AHI+N .ENDM USTACK .GLOBL F$ADD,F$SUB,F$MUL,F$DIV ; Floating-point subtract and add. ESTACK ; Define entry stack offsets F$SUB: TST AHI(SP) ; Is subtrahend 0.0? BEQ ENDRR ; Yes, return B ADD #100000,AHI(SP) ; No, change sign of A ; and add F$ADD: TST AHI(SP) ; Addend=0? BEQ ENDRR ; Yes, return B TST BHI(SP) ; B=0? BNE 1$ ; No, general case MOV ALO(SP),BLO(SP) ; Yes, return A MOV AHI(SP),BHI(SP) BR ENDRR ; Re-adjust stack and exit 1$: JSR %2,INIT ; Call common initialisation ISTACK ; Reset stack offsets CMP %2,%1 ; Exponents equal? BGT 20$ BLT 10$ CMP BHI(SP),AHI(SP) ; Compare fractions BMI 10$ BGT 20$ CMP BLO(SP),ALO(SP) ; Both halves BHIS 20$ 10$: MOV BLO(SP),-(SP) ; Exchange operands USTACK 2 ; via stack MOV ALO(SP),BLO(SP) MOV @SP,ALO(SP) MOV BHI(SP),@SP MOV AHI(SP),BHI(SP) MOV @SP,AHI(SP) MOV %2,@SP ; Exchange exponents too MOV %1,%2 MOV (SP)+,%1 SWAB %0 ; Swap sign bytes 20$: CLR -(SP) ; Clear for carry bits SUB %2,%1 BEQ 40$ ; No shifting NEG %1 ; Shift counter CMP %1,#26. ; Big difference in exponents? BPL 60$ ; Yes, ignore addend 30$: ASR AHI(SP) ; Divide by 2^(exp(A)-exp(B)) ROR ALO(SP) ROR @SP ; Store carry bit DEC %1 BNE 30$ ; Loop 40$: TST %0 ; Both signs + ? BEQ 50$ CMP %0,#401 ; or both - ? BEQ 50$ ; Yes, nothing to do NEG ALO(SP) ADC AHI(SP) NEG AHI(SP) 50$: ADD ALO(SP),BLO(SP) ; Add fractions ADC BHI(SP) ; take care of carry ADD AHI(SP),BHI(SP) 60$: MOV (SP)+,%1 ; Restore %1 BR NORM ; Normalise and exit ; Floating-point multiply. ESTACK ; Set entry stack offsets F$MUL: TST BHI(SP) ; B=0? BEQ ENDRR ; Yes, nothing to do TST AHI(SP) ; A=0? BNE FMUL10 ; No, general case CLR BLO(SP) ; Yes, set result zero CLR BHI(SP) ENDRR: JMP ENDR ; and exit FMUL10: JSR %2,INIT ; Initialise ISTACK ADD %1,%2 ; Compute raw exponent ADD #10,%2 MOV %0,-(SP) ; Save signs MOV #24.,-(SP) ; Save shift count USTACK 4 CLR %0 CLR %1 30$: ASL %0 ; %0 = least significant part ROL %1 ; then %1, ROL BLO(SP) ; BLO, ROL BHI(SP) ; and BHI BIT #400,BHI(SP) ; Most significant bit BEQ 40$ ADD ALO(SP),%0 ADC %1 ADC BLO(SP) ADC BHI(SP) ADD AHI(SP),%1 ADC BLO(SP) ADC BHI(SP) 40$: DEC @SP BGT 30$ ; Go again TST (SP)+ ; Purge count USTACK -2 CLRB BHI+1(SP) MOV (SP)+,%0 ; Restore signs BR SIGNS ; Set signs, normalise and exit ; Floating point divide. ESTACK F$DIV: TST AHI(SP) ; Divisor=0? BNE 10$ ; No, branch MOV %2,-(SP) ; Yes, get the stack right MOV %1,-(SP) MOV %0,-(SP) BR DIVBY0 ; for error exit 10$: TST BHI(SP) ; Dividend=0? BEQ ENDR ; Yes, nothing to do JSR %2,INIT ; Initialise ISTACK MOV %0,-(SP) ; Save signs USTACK 2 SUB %1,%2 MOV BHI(SP),%1 MOV BLO(SP),%0 ; Copy dividend CLR BHI(SP) ; Initialise result CLR BLO(SP) MOV #24.,-(SP) ; Set up count USTACK 2 30$: CMP %1,AHI(SP) ; Possible to subtract? BLO 50$ ; No BHI 40$ ; Yes CMP %0,ALO(SP) ; Check lo order BLO 50$ ; Nothing to do 40$: SUB ALO(SP),%0 ; Subtraction SBC %1 SUB AHI(SP),%1 INC BLO(SP) ; Update quotient 50$: ASL %0 ; Multiple shift ROL %1 ASL BLO(SP) ; Shift quotient ROL BHI(SP) DEC @SP ; Dec count BGT 30$ ; Loop TST (SP)+ ; Purge stack MOV (SP)+,%0 ; Restore sign CLR %1 ; Clear carry ; Exit, setting signs for multiply and divide. ISTACK ; No workspace in use SIGNS: TST %0 ; Test flag word BEQ NORM ; Done if both +ve ASL %0 ; Clear bit 0 in case CMP %0,#1002 ; both - ? BEQ NORM ; Yes, nothing to do MOV #1,%0 ; No, set - flag ; Exit with normalisation (and overflow check). ; Real fraction of result is in BHI,BLO, binary exponent is in %2, ; sign in %0, %1 contains carry bit. ; ; Exit to caller with result hi, result lo on stack. NORM: ADD #200,%2 ; Excess 200 notation TST BHI(SP) ; Fraction 0.0? BNE 10$ ; No, general case TST BLO(SP) BEQ 70$ 10$: CMP BHI(SP),#400 ; Fraction overflow? BPL 30$ ; Yes 20$: CMP BHI(SP),#200 ; Normalised already? BPL 40$ ASL %1 ; Get carry bit ROL BLO(SP) ; Scale ROL BHI(SP) ; left DEC R2 ; Adjust exponent BR 20$ ; Go again 30$: ASR BHI(SP) ; Scale ROR BLO(SP) ; right ROR R1 ; Store carry bit INC %2 BR 10$ 40$: ASL %1 BCC 80$ ADC BLO(SP) ADC BHI(SP) CLR %1 BR 10$ ; Return for next try 80$: CMP %2,#377 ; Exponent overflow? BGT OVFLOW ; Yes, error 50$: TST %2 ; Exponent underflow? BMI UNFLOW ; Yes, take error exit 60$: BICB #200,BHI(SP) ; Remove hidden bit SWAB %2 ASR %0 ; Sign ROR %2 ; Right position BIS %2,BHI(SP) ; Put in exponent 70$: MOV (SP)+,%0 ; Restore registers MOV (SP)+,%1 MOV (SP)+,%2 ENDR: MOV (SP)+,@SP ; Copy the return address MOV (SP)+,@SP ; up 2 words, purging A operand TST 2(SP) ; Set flags on floating result (V clear) RTS PC ; All done ; Error exits. ; ; Set flags: Return: ; N Z V C ; overflow 0 0 1 0 infinity ; underflow 1 0 1 0 zero ; divide by 0 1 0 1 1 infinity OVFLOW: MOV #2,%0 ; Set V flag only BR RETINF ; and return infinity UNFLOW: MOV #12,%0 ; Set V and N CLR %1 ; and return 0 CLR %2 BR EREXIT DIVBY0: MOV #13,%0 ; Set V, N, and C RETINF: MOV #177777,%1 ; and return infinity MOV #077777,%2 EREXIT: MOV %0,ALO(SP) ; Put flags where RTI will load them MOV %1,BLO(SP) ; Set B lo MOV %2,BHI(SP) ; and hi MOV (SP)+,%0 ; Restore registers MOV (SP)+,%1 MOV (SP)+,%2 10$: MOV (SP)+,@SP ; Move up return address RTI ; Back to caller ; Common initialisation code. Save registers 0-2, setting them to contain: ; %1 exponent of A ; %0 hi sign bit of A ; %2 exponent of B ; %0 lo sign bit of B ; Set A and B to contain their mantissae only, replacing sign bits. ; ; Call as: JSR %2,INIT INIT: MOV %1,-(SP) ; Save %1 (%2 was saved on call) MOV %0,-(SP) ; and %0 ISTACK ; Stack now as in subroutines MOV %2,-(SP) ; Push return address USTACK 2 ; Allow for it in offsets CLR %0 ; Clear signs MOV AHI(SP),%1 ; Get A hi ASL %1 ROL %0 ; and put sign in %0 SWAB %0 ; hi CLRB %1 SWAB %1 ; Get exponent of A SUB #200,%1 ; unbiassed CLRB AHI+1(SP) ; Remove exp and sign from value on stack BIS #200,AHI(SP) ; and put back hidden bit ; Similarly for B MOV BHI(SP),%2 ; Copy hi word to B ASL %2 ADC %0 ; Put sign bit in %0 lo CLRB %2 SWAB %2 ; Get exponent SUB #200,%2 ; unbiassed CLRB BHI+1(SP) ; Remove it from stack value BIS #200,BHI(SP) ; Put back hidden bit RTS PC ; Return to caller .END