; FPN_ASM on H144 ; ; 15th December 1996 ; ; FPN LRESPRs to the function FPNO$(address,[places]). ; This takes one or two parameters,
, obligatory ; and , optional. ; ;
points to an extended foramt (X) fp number and ; gives the number of places to be printed of the ; mantissa (1 to 17). If is not given the number ; of places defaults to 8. ; ; If the address is odd, the FP number not a true one or ; the number of places is outside the range 1 to 17 a bad ; parameter is signalled. ; ; If there is no FPU, FPN returns "not implemented". ; IN WIN1_SYS_EQUBAS_ASM SYS_FPU EQU $D0 ; ; Check that FPU is present and save/restore is in operation ; MOVEQ #MT_INF,D0 TRAP #1 MOVE.B SYS_FPU(A0),D0 Type FPU byte ANDI.B #$18,D0 BEQ UNIMP Don't know CMPI.B #$18,D0 BEQ UNIMP no FPU ; ; Link in FPN$ ; LEA DEFINE,A1 MOVEA.W BP_INIT,A2 JMP (A2) ; DEFINE DC.W 0,0 no procs DC.W 1 1 function DC.W FPP-* DC.B 5,"FPNO$" DC.W 0 mark end ; ; Bring in the first parameter (address) ; FPP CMPA.L A3,A5 BEQ BADPAR ----> MOVEA.L A5,A4 LEA 8(A3),A5 arrange to get 1 parameter MOVE.L A5,D5 keep start of next parameter MOVEA.W CA_GTLIN,A2 JSR (A2) BNE BADPAR ----> MOVEA.L A4,A5 replace old A5 MOVE.L (A6,A1.L),D0 address to D0 ADDQ.L #4,BV_RIP(A6) tidy arith stack BTST #0,D0 even? . . . BNE BADPAR . . . no MOVEA.L D0,A4 OK address ; ; Now get ; MOVEQ #8,D7 default value CMP.L A5,D5 is there a parameter? . . BEQ FPP_1 . . no ; MOVEA.L D5,A3 pointer to LEA 8(A3),A2 CMPA.L A2,A5 BNE BADPAR ----> MOVEA.W CA_GTINT,A2 JSR (A2) BNE BADPAR ----> MOVE.W (A6,A1.L),D7 set in D7 ADDQ.L #2,BV_RIP(A6) tidy stack CMPI.W #1,D7 BLT BADPAR ----> CMPI.W #17,D7 BGT BADPAR ----> ; ; Set FP number to BASIC buffer in packed decimal form ; FPP_1 MOVEQ #29,D0 ADD.W D7,D0 places required (-1) ADD.L (A6),D0 SUB.L 8(A6),D0 shortfall BPL BUFFUL ----> ; ; We switch off exceptions and clear the FPSR ; FMOVEM.L FPSR/FPCR,-(A7) FMOVEM.L #0:0,FPSR/FPCR FMOVE.X (A4),FP0 FMOVE.P FP0,([A6],A6.L){17} FMOVE.L FPSR,D0 has an error occurred? . . FMOVEM.L (A7)+,FPSR/FPCR replace the control regs ANDI.W #$E0,D0 BNE BADPAR . . .yes ; ; The FP number is now unpacked in the BASIC buffer ; ; Packed: ; byte 0 1 2 3 4 11 ; _____________________________________________ ; | 'E2|E1'E0| | 'M16|M15'M14| . . .|M1'M0| ; ¾ ; S1 S2 x x ; ; Unpacked: ; byte 0 1 2 3 4 5 6 22 21 ; ___________________________________ ; |s1|s2|e2|e1|e0|m16|m15| . . .|m1|m0| ; ; Ex and Mx are BCD. They are unpacked to ASCII ex and mx ; Si are sign bits translated to si (bytes). ; LEA ([A6],12),A1 end of FP number LEA 10(A1),A2 end of ASCII number MOVEQ #8,D0 count BSR UNP unpack mantissa SUBQ.L #1,A1 set A1 to end of exponent MOVEQ #1,D0 count for exp BSR UNP unpack exponent MOVEQ #1,D2 count for signs MOVEQ #6,D3 bit-place of sign FFP_2 MOVEQ #0,D0 prepare for + SUBQ.L #1,A2 step down A2 BTST D3,([A6],A6.L) sign of exponent/number BEQ FPP_3 + MOVEQ #1,D0 mark - FPP_3 MOVE.B D0,(A6,A2.L) set sign byte ADDQ.B #1,D3 point to number sign DBF D2,FFP_2 go back for number sign ; ; A1 = A2 -> start of BASIC buffer ; ; Now set the string for printing in the BASIC buffer byte 22 -> ; LEA 22(A2),A2 point to start of 'print' buffer TST.B (A6,A1.L) number sign BEQ FPP_4 + MOVE.B #'-',(A6,A2.L) set minus ADDQ.L #1,A2 step A2 FPP_4 MOVE.B 5(A6,A1.L),(A6,A2.L) 1st digit of mantissa (m16) ADDQ.L #1,A2 SUBQ.W #2,D7 -1 to 15 BMI DO_EXP no more mantissa LEA 6(A1,D7.W),A0 point to last place wanted FPP_5 CMPI.B #'0',(A6,A0.L) SUBQ.L #1,A0 move backwards to byte 6 DBNE D7,FPP_5 look for first non-zero digit BEQ DO_EXP none found - do exponent MOVE.B #'.',(A6,A2.L) decimal point ADDQ.L #1,A2 step A2 LEA 6(A1),A0 set A0 to 2nd digit of mantissa FPP_6 MOVE.B (A6,A0.L),(A6,A2.L) ADDQ.L #1,A0 ADDQ.L #1,A2 DBF D7,FPP_6 count remaining ; ; Now do the exponent ; DO_EXP MOVEQ #2,D0 count MOVEA.L A1,A0 to start of FP DO_EXP1 CMPI.B #'0',2(A6,A0.L) skip . . . ADDQ.L #1,A0 . leading . DBNE D0,DO_EXP1 . . . zeros BEQ EXP_DONE MOVE.B #'E',(A6,A2.L) ADDQ.L #1,A2 TST.B 1(A6,A1.L) negative exponent? .. BEQ DO_EXP2 .. no MOVE.B #'-',(A6,A2.L) ADDQ.L #1,A2 DO_EXP2 MOVE.B 1(A6,A0.L),(A6,A2.L) ADDQ.L #1,A0 ADDQ.L #1,A2 DBF D0,DO_EXP2 ; ; The ASCII number is now at BASIC buffer+22. ; We know its length so we: ; 1. make sure that there is space on the arithmetic stack, and ; 2. copy it there as a string ; EXP_DONE MOVEQ #-22,D4 ADD.L A2,D4 SUB.L A1,D4 length of string MOVE.L D4,D1 ADDQ.L #3,D1 allow space for length and .. BCLR #0,D1 .. round up to even MOVE.L D1,D5 MOVEA.W BV_CHRIX,A1 JSR (A1) MOVEA.L BV_RIP(A6),A1 new value of maths stack pointer SUBA.L D5,A1 set to start of FP string MOVE.L A1,BV_RIP(A6) set it in BASIC VARS MOVE.W D4,(A6,A1.L) set count of string LSR.W #1,D5 count in words LEA ([A6],22),A2 point to start of string BRA END END_1 MOVE.W (A6,A2.L),(A6,A1.L) ADDQ.L #2,A2 END ADDQ.L #2,A1 DBF D5,END_1 ; MOVEQ #1,D4 mark 'string' MOVEQ #0,D0 good exit RTS back to BASIC ; BADPAR MOVEQ #-15,D0 RTS BUFFUL MOVEQ #-5,D0 RTS UNIMP MOVEQ #-19,D0 RTS ; ; UNPKs D0-1 BCD digits backwards from A1 to A2 in the BASIC buffer ; UNP SUBQ.L #1,A1 SUBQ.L #2,A2 MOVE.B (A6,A1.L),D1 get 2 BCD digits to D1.B UNPK D1,D2,#$3030 MOVE.W D2,(A6,A2.L) set 2 ASCII words to buffer DBF D0,UNP ADDQ.L #1,A2 reset A2 slightly RTS