;FPBCD 11/19/80 ;XYBASIC Interpreter Source Module ;Copyright (C) 1980 by Mark Williams Company, Chicago ;BCD floating point package if float and fpbcd ; ; FORMAT: 6 BYTES ; BYTE 0 ; BITS 0-6: EXCESS-64 EXPONENT ; BIT 7: SIGN ; BYTES 1-5: 10-DIGIT BCD FRACTION ; N = (-1)^S * 10^(E - 64) * 0.DDDDDDDDDD ; BIAS EQU 64 ;EXPONENT BIAS ; ; CONSTANT DATA (ROMABLE) ; EMAX DB 043H,014H,073H,0,0,0 ;MAX. EXP. ARGUMENT FPMAX DB 07FH,099H,099H,099H,099H,099H INTMX DB 045H,032H,076H,070H,0,0 INTMN DB 0C5H,032H,076H,080H,0,0 ; ; CONSTANTS FOR USE IN FUNCTIONS ATAN1 DB 040H ;ARCTAN(1) DB 078H,053H,098H,016H,033H D12PI DB 040H ;1/(2PI) DB 015H,091H,054H,094H,031H D1LE4 DB 040H ;1/(LOG E 4) DB 057H,056H,046H,027H,031H D1L10 DB 040H ;1/LN(10) DB 043H,042H,094H,048H,019H D4PI DB 041H ;4/PI DB 012H,073H,023H,095H,045H DPI2 DB 041H ;PI/2 DB 015H,070H,079H,063H,027H DPI4 DB 040H ;PI/4 DB 078H,053H,098H,016H,034H DSR22 DB 040H ;SQR(2)/2 DB 070H,071H,6,078H,010H HALF DB 040H,050H,0,0,0,0 LN10 DB 041H ;LN(10) DB 023H,2,058H,050H,093H LN2 DB 040H ;LN(2) DB 069H,031H,047H,018H,6 PI DB 041H,031H,041H,059H,026H,054H SR2M1 DB 040H ;SQR(2) - 1 DB 041H,042H,013H,056H,020H SR2P1 DB 041H ;SQR(2) + 1 DB 024H,014H,021H,035H,062H SQR10 DB 041H ;SQR(10) DB 031H,062H,027H,076H,060H THIRD DB 040H,033H,033H ;1/3 DB 033H,033H,033H TWO DB 041H,020H,0 DB 0,0,0 TWOPI DB 041H,062H,083H ;2 PI DB 018H,053H,7 ; ; COEFFICIENTS FOR FUNCTION EXPANSIONS ; ; TANGENT TB3 DB 0C2H,015H,078H DB 030H,032H,084H DB 0C4H,014H,9 DB 063H,024H,018H DB 0C2H,040H,098H DB 017H,8,075H DB 0C3H,015H,069H DB 020H,4,022H DB 0C2H,055H,020H DB 040H,041H,071H DB 0C1H,094H,038H DB 016H,055H,098H TC0 DB 03FH,035H,091H DB 010H,014H,097H ; COSINE FPONE DB 041H,010H,0 DB 0,0,0 DB 0C0H,030H,084H DB 025H,013H,075H DB 03FH,015H,085H DB 043H,044H,020H DB 0BDH,032H,059H DB 091H,089H,0 DB 03BH,035H,090H DB 086H,0,0 CP05 DB 0B9H,024H,061H DB 0,0,0 DB 040H,078H,053H DB 098H,016H,034H DB 0BFH,080H,074H DB 055H,012H,019H DB 03EH,024H,090H DB 039H,045H,070H DB 0BCH,036H,057H DB 062H,0,0 CP14 DB 03AH,031H,033H DB 0,0,0 ; ARCTAN DB 043H,021H,060H DB 062H,030H,079H DB 043H,032H,026H DB 062H,7,0 DB 043H,013H,027H DB 2,039H,082H FATP3 DB 042H,012H,088H DB 083H,083H,3 DB 043H,021H,060H DB 062H,030H,079H DB 043H,039H,046H DB 082H,083H,093H DB 043H,022H,010H DB 050H,088H,030H FATQ3 DB 042H,038H,050H DB 014H,086H,051H ; EXP EB2 DB 042H,090H,0 DB 0,0,0 DB 042H,028H,0 DB 0,0,0 DB 043H,033H,0 DB 0,0,0 DB 0C5H,014H,058H DB 0,0,0 ; NATURAL LOG LB3 DB 0C1H,013H,012H DB 082H,059H,017H DB 0C1H,033H,050H DB 025H,024H,081H DB 0C1H,025H,084H DB 017H,087H,055H DB 0C0H,012H,087H DB 020H,099H,053H DB 0C1H,051H,002H DB 099H,053H,028H DB 0C1H,059H,041H DB 022H,044H,090H LC0 DB 040H,041H,079H DB 059H,018H,037H ; SQUARE ROOT DB 040H,014H,053H DB 043H,0,051H DB 041H,018H,046H DB 072H,073H,095H DB 0C1H,018H,078H DB 050H,038H,016H SR3 DB 040H,090H,010H DB 015H,056H,4 ; SQUARE ROOT (X >= .25) DB 040H,025H,092H DB 080H,058H,067H DB 041H,010H,052H DB 3,026H,060H SR6 DB 0C0H,031H,063H DB 024H,089H,045H ; ; BINARY-DECIMAL CONVERSION TABLE BDTAB DB 0,0,1 DB 0,0,2 DB 0,0,4 DB 0,0,8 DB 0,0,016H DB 0,0,032H DB 0,0,064H DB 0,1,028H DB 0,2,056H DB 0,5,012H DB 0,010H,024H DB 0,020H,048H DB 0,040H,096H DB 0,081H,092H DB 1,063H,084H DB 3,027H,068H ; ; ADDITION (FACC) <== (FACC) + (H,L) FADT2 LXI H,FTMP2 FADD MOV A,M ORA A RZ ;OP-2 = 0 LXI D,FACC LDAX D ORA A JZ FLOAD ;OP-1 = 0 FADD0 XRA M PUSH PSW ;(SF) ==> SUBTRACT LDAX D ANI 080H STA SIGN ;STORE SIGN OF OP-1 MVI A,6 STA FLEN ;DEFAULT LENGTH = 6 MOV A,M ANI 07FH ;FORM EXP-2 STA EXP2 CALL UPAC2 LXI H,EXP1 MOV M,A INX H SUB M ;A <== EXP1 - EXP2 MOV C,A LXI H,FACC+5 SHLD RSLT ;SUM LOCATION CPI -10 JNC FAD1 ;-10 <= DIFF < 0 CPI 11 JC FAD1 ;0 <= DIFF <= 10 ORA A JP FAD9 ;DONE IF DIFF > 10 ; DIFF < -10 CALL FZACC ;FACC <== 0 LDA EXP2 STA EXP1 ;EXP1 <== EXP2 FAD1 MVI B,0 PUSH B XCHG ;(H,L) <== OP-2 INX H ;POINT TO FRACTION MVI C,5 LXI D,ACALT+6 CALL FMOVE ;ACALT+6 <== OP-2 FRACTION MOV H,D ;(H,L) = (D,E) = OP-2 MOV L,E POP B MOV A,C ORA A JZ FAD8 ;DIFF = 0 JM FAD4 ;DIFF < 0 ; DIFF > 0 ANI 1 JZ FAD2 ;EVEN ; DIFF > 0 AND ODD INX D PUSH B LXI B,6 CALL FD10 ;DIV. OP-2 BY 10 LHLD RSLT ;DESTINATION INX H ;INCR. IT POP B JMP FAD3 FAD2 LHLD RSLT FAD3 MOV A,C RAR MOV C,A ;HALF OF DIFF DAD B ;ADD BYTE SHIFT TO DEST. SHLD RSLT LXI H,FLEN ADD M MOV M,A ;TOTAL FIELD LENGTH JMP FAD8 ; DIFF < 0 FAD4 LXI H,FACC+1 ANI 1 JZ FAD5 ;EVEN ; ODD AND < 0 PUSH B LXI B,6 CALL FD10 ;FACC <== FACC/10 POP B FAD5 XRA A MOV B,A ;B=0 SUB C ;A = -DIFF RAR ;A = BYTE SHIFT ANI 07FH JZ FAD7 ;NO BYTE SHIFT MOV C,A ;(B,C) <== -DIFF/2 DAD B DCX H PUSH D CALL FSTOR ;SHIFT FACC RIGHT POP D FAD6 DCX H MOV M,B ;CLEAR START OF FIELD DCR C JNZ FAD6 FAD7 LDA EXP2 STA EXP1 ;EXP1 <== LARGER EXP FAD8 XCHG ;(H,L) <== OP-2 LXI B,4 DAD B XCHG ;(D,E) <== LOW END OP-2 LHLD RSLT INR C ;LOOP COUNTER = 6 INR C POP PSW ;XOR OF SIGNS JM FSUB1 ;SUBTRACT CALL FADDL ;ADD LOOP CALL FRNRM JMP FRND ;ROUND FAD9 POP PSW JMP FRND0 ; ADD LOOP FADDL XRA A ;CLEAR CARRY FADL1 LDAX D ADC M DAA MOV M,A DCX D DCX H DCR C JNZ FADL1 RNC ;DONE IF NO CARRY FADL0 MOV A,M ;CARRY 1 ADI 1 DAA MOV M,A DCX H JC FADL0 RET ; ; ABSOLUTE VALUE FABS LXI H,FACC MOV A,M ANI 07FH MOV M,A RET ; ; ARCTAN ; IF ABS(X) > 10 E 10 THEN FATAN(X) = SGN(X) * PI/2 ; IF ABS(X) <= 5 E -4 THEN FATAN(X) = X - X^3/3 ; ELSE ABS(X) <= SQR(2) -1 : X0=0, Y=X ; ABS(X) > SQR(2) + 1 : X0=INFINITY, Y = -1/X ; SQR(2) - 1 < ABS(X) < SQR(2)+1: X0=1, Y=(X-1)/(X+1) ; FATAN(X) = FATAN(X0) + FATAN(Y) WHERE ; FATAN(Y) = Y * P(Y^2)/Q(Y^2) FATAN LXI H,FACC MOV A,M ANI 080H STA SIGN1 ;SAVE SIGN MOV A,M ANI 07FH MOV M,A ;X <== ABS(X) CPI BIAS+11 JNC FAT97 ;EXP > 10 CPI BIAS-4 JC FAT98 ;EXP < -4 JNZ FAT0 ;EXP > -4 INX H ;EXP = -4 MOV A,M DCX H CPI 6 JC FAT98 ;Z <= 5 E (-4) ; 5 E (-4) < X < E 10 FAT0 LXI H,SR2M1 ;SQR(2) - 1 CALL FCMP JNC FAT1 ;X > SQR(2) -1 ; X <= SQR(2) -1 LXI H,FTMP2 MVI C,6 CALL FZERO ;X0 = 0 = ARCTAN(0) JMP FAT4 FAT1 LXI H,SR2P1 CALL FCMP JC FAT2 ; X > SQR(2) + 1 LXI H,DPI2 LXI D,FTMP2 CALL FLOD1 ;X0 = PI/2 = ARCTAN(INFINITY) CALL FLINV ;FACC <== 1/X CALL FCHS ;FACC <== -1/X JMP FAT4 ; SQR(2) - 1 < X < SQR(2) + 1 FAT2 LXI H,ATAN1 LXI D,FTMP2 CALL FLOD1 ;X0 = ARCTAN(1) LXI H,FPONE CALL FADD ;FACC <== X+1 CALL FSTT1 ;SAVE IN FTMP1 LXI H,TWO CALL FSUB ;FACC <== X-1 LXI H,FTMP1 CALL FDIV ;FACC <== (X-1)/(X+1) FAT4 CALL FSTT3 ;FTMP3 <== Y CALL FCO35 ;FTMP1 <== Y^2 ; RATIONAL FUNCTION ; DENOMINATOR LXI H,FATQ3 MVI C,3 CALL FPLY0 CALL FSTT4 ;STORE DENOM. IN FTMP4 ; NUMERATOR LXI H,FTMP1 CALL FLOAD LXI H,FATP3 MVI C,3 CALL FPOLY LXI H,FTMP3 CALL FMUL ; *Y LXI H,FTMP4 CALL FDIV ;P/Q CALL FADT2 ;+ARCTAN(X0) FAT6 LXI H,FACC LDA SIGN1 ORA M ;APPEND SIGN MOV M,A RET ; IF X > 1 E 10 THEN FATAN(X) = SGN(X) * PI/2 FAT97 LXI H,DPI2 CALL FLOAD JMP FAT6 ; IF X < 5 E (-4) THEN FATAN(X) = X - X^3/3 FAT98 CALL FSTT1 ;STORE IN FTMP1 CALL FMUL ;SQUARE X LXI H,FTMP1 CALL FMUL ;CUBE X LXI H,THIRD CALL FMUL LXI H,FTMP1 CALL FSUB JMP FAT6 ; ; FLOATING POINT A TO X POWER FATOX XCHG INX H LDA FACC ORA A JZ FATX1 ;0 TO POWER JM FATX2 ;NEG TO POWER PUSH H FATX0 CALL FLN POP H CALL FMUL JMP FEXP ;A^X = EXP (X * LN (A)) ; 0 TO POWER FATX1 ORA M JM FOVER ;0 TO NEGATIVE RET ; NEGATIVE TO POWER FATX2 PUSH H CALL FSTT1 ;SAVE A IN FTMP1 POP H PUSH H CALL FLOAD ;LOAD POWER CALL FSTT2 ;AND SAVE IN FTMP2 CALL FFIX ;GET INTEGER PART OF POWER POP H PUSH B ;AND SAVE INTEGER PART PUSH H CALL FCMP POP H JNZ FATX4 ;NEGATIVE A TO NONINTEGER X CALL FLONE ;LOAD 1 = A^0 POP D ;INTEGER POWER TO DE LDA FTMP2 ORA A RZ ;DONE IF POWER IS 0 CM CPLDE ;COMPLEMENT POWER IF NEGATIVE MOV A,D ORA A JNZ FOVER ;POWER TOO HIGH FATX3 LXI H,FTMP1 PUSH D CALL FMUL POP D DCR E JNZ FATX3 LDA FTMP2 ORA A RP ;POSITIVE POWER, DONE ;FACC <== 1/FACC FLINV CALL FSTT1 ;STORE FACC IN FTMP1 CALL FLONE ;LOAD 1 LXI H,FTMP1 JMP FDIV ;INVERT FATX4 XTHL ;POP SAVED POWER, PUSH POWER ADDRESS CALL FCERN ;NONFATAL FC ERROR LXI H,FTMP1 CALL FLOAD ;RELOAD A CALL FCHS ;AND FORCE POSITIVE JMP FATX0 ;RETURN -A ^ X AS RESULT ; ; CHANGE SIGN FCHS LXI H,FACC MOV A,M XRI 080H MOV M,A RET ; ; COMPARE FACC WITH (H,L) ; EXIT: (CF) ==> FACC <= (H,L); (ZF) ==> EQUAL; ELSE > FCMP LXI D,FACC LDAX D ORA A JP FCM0 ;FACC >= 0 XRA M STC RM ;SIGNS DIFFER XCHG ;BOTH NEGATIVE JMP FCM1 FCM0 ORA M RM ;(H,L) <0 FCM1 MVI C,6 FCM2 LDAX D SUB M RC RNZ INX H INX D DCR C JNZ FCM2 STC RET ; ; COSINE ; X <== ABS (X) SINCE COS(-X) = COS(X) ; X > 10 E 10 NOT PERMITTED ; IF X > 2 * PI THEN X <== X MOD 2*PI ; IF X > PI THEN X <== 2*PI - X ; IF X > PI/2 THEN X <== PI -X AND SIGN FLAG IS SET ; (I.E., COS(X) = - COS (PI - X) ) ; IF X <= PI/4 THEN Y = 4X/PI, COS(X) = POLYNOMIAL(Y^2) ; IF PI/4 < X <= PI/2 THEN X1 = PI/2 - X, Y = 4*X1/PI, ; COS(X) = SIN(X1) = Y * POLYNOMIAL(Y^2) FCOS XRA A STA SIGN1 ;SET POSITIVE CALL FABS ;COS(X) = COS(-X) CPI BIAS+11 JNC FCERN ;EXP >= 10 NOT VALID LXI H,TWOPI CALL FCMP JC FCO1 ;X <= 2 PI ; IF X > 2 PI THEN X <== X (MOD 2 PI) CALL FSTT1 ;STORE IN FTMP1 LXI H,D12PI CALL FMUL ;DIV BY 2 PI CALL FINT ;INTEGER PART LXI H,TWOPI CALL FMUL LXI H,FTMP1 CALL FSUB ;MINUS X CALL FCHS FCO1 LXI H,PI CALL FCMP JC FCO2 ; IF X > PI THEN X <== 2 PI - X CALL FCHS LXI H,TWOPI CALL FADD FCO2 LXI H,DPI2 CALL FCMP JC FCO3 ; IF X > PI/2 THEN X <== PI - X AND SIGN = NEGATIVE CALL FCHS LXI H,PI CALL FADD LXI H,SIGN1 MOV A,M XRI 080H MOV M,A FCO3 LXI H,DPI4 CALL FCMP JC FCO5 ;X <= PI/4 ; PI/4 < X < PI/2 ; X0 = PI/2 - X; Y = (X0 * 4/PI)^2 CALL FCHS LXI H,DPI2 CALL FADD ;PI/2 -X CALL FCO34 CALL FCO35 ; EVAL. POLYNOMIAL LXI H,CP14 MVI C,4 CALL FPOLY LXI H,FTMP2 ;Y CALL FMUL FCO4 LXI H,FACC LDA SIGN1 XRA M ;SET SIGN MOV M,A RET ; X <= PI/4 ; Y = (4X/PI)^2 FCO5 LXI H,D4PI CALL FMUL CALL FCO35 ; EVAL POLYNOMIAL LXI H,CP05 MVI C,5 CALL FPOLY JMP FCO4 ; DIVIDE VARIABLE BY PI/4 FCO34 LXI H,D4PI FC34A CALL FMUL JMP FSTT2 ;FTMP2 = 4X/PI ; SQUARE FACC AND STORE AT FTMP1 FCO35 CALL FSTT1 CALL FMUL JMP FSTT1 ; ; FLOATING POINT DIVISION ; FACC <== FACC / (H,L) FDIVD XCHG INX H FDIV MOV A,M ORA A JZ FOVER ;DIV BY 0 CALL UPAC1 ADI BIAS+1 SUB B ;GET RESULT EXPONENT JC FZACC ;UNDERFLOW JZ FZACC JM FOVER ;OVERFLOW STA EXP1 LXI H,FTEMP LXI B,5 MOV M,B ;FTEMP 1ST BYTE = 0 INX H INX D XCHG CALL FMOVE ;FTEMP <== DIVISOR FRACTION LXI H,FACC+1 LXI D,ACALT+2 MVI C,5 FD0 MOV A,M ;ACALT+2 <== DIVIDEND FRACTION MOV M,B ;CLEAR FACC TO 0 STAX D INX H INX D DCR C JNZ FD0 PUSH H ;SAVE ACALT LOCATION MVI B,11 ;NO. OF QUOTIENT DIGITS ; DIVIDE LOOP FD1 LXI H,FTEMP LXI D,ACALT+1 ;QUOTIENT LOCATION MVI C,6 FD2 LDAX D CMP M JC FD5 ;DIVIDEND < DIVISOR JNZ FD3 ;DIVISOR < DIVIDEND INX D INX H DCR C JNZ FD2 FD3 MVI C,6 ;DIVIDEND >= DIVISOR LXI H,FTEMP+5 LXI D,ACALT+6 STC ; SUBTRACT LOOP FD4 MVI A,099H ACI 0 SUB M XCHG ADD M DAA MOV M,A XCHG DCX H DCX D DCR C JNZ FD4 POP H PUSH H INR M ;QUOTIENT DIGIT JMP FD1 FD5 LXI H,FACC+1 DCR B JNZ FD6 ; NEXT DIGIT MOV A,M ;END OF DIVISION LOOP ORA A JNZ FD7 ;DONE MVI B,1 ;LEADING 0 - DO ONE MORE DIGIT LXI H,EXP1 DCR M ;ADJUST EXP LXI H,FACC+1 FD6 MVI C,12 CALL FM10 ;SHIFT RESULT INTO FACC JMP FD1 FD7 MVI C,6 CALL FM10 ;SHIFT RESULT INTO PLACE POP H ;CLEAR STACK JMP FRND ; DIVIDE FLOATING POINT FIELD AT (H,L) BY 10 ; ENTRY: (B,C) = NO OF BYTES ; EXIT; (H,L) = START OF FIELD FD10 DAD B ;(H,L) = LOW ORDER END FD11 DCX H MOV A,M RRC RRC RRC RRC ANI 0FH MOV B,A ;STORE ONE DIGIT DCX H MOV A,M RLC RLC RLC RLC ANI 0F0H ORA B ;APPEND DIGIT INX H MOV M,A DCR C JNZ FD11 MOV M,B ;MAKE FIRST DIGIT 0 RET ; ; EXP FUNCTION ; IF X = 0 THEN EXP(X) = 1 ; IF X < 0 THEN EXP(X) = 1 / EXP(-X) ; ELSE Z = INT (.5 + X/ LN(10)) ; Y = X / LN(10) - Z ; B = Y / (4 LOG10 E) I.E., 0 <= B < .3 ; A = 2 + B^2 * (P1/Q1) ; EXP(B) = (A + B) / (A - B) ; EXP(X) = 10^Z * (EXP(B))^4 FEXP LXI H,EMAX CALL FCMP JNC FEX31 ;> MAX XRA A STA EXP4 ;CLEAR INVERT FLAG AND SIGN STA SIGN1 LXI H,FACC ORA M JZ FLONE ;EXP(0) = 1 JP FEXP1 STA EXP4 ;FLAG NEGATIVE ARGUMENT ANI 07FH MOV M,A ;MAKE ABS VALUE FEXP1 LXI H,D1L10 CALL FMUL ;T = X / LN(10) CALL FSTT2 ;FTMP2 <== T LXI H,HALF CALL FADD CALL FFIX ;A = INT(.5 + T) PUSH B ;SAVE INT PART CALL FCHS CALL FADT2 ;FRAC PART LXI H,D1LE4 ;DIVIDE BY 4 LOG E CALL FC34A ;FTMP2 <== Y CALL FCO35 ;FTMP1 = T = Y^2 ; EVALUATE CONTINUED FRACTION LXI H,EB2 CALL FTAN6 LXI H,FTMP4 CALL FLOAD ;LOAD P1 LXI H,FTMP3 CALL FDIV ;P1/Q1 LXI H,FTMP1 CALL FMUL ; *T LXI H,TWO CALL FADD ; +2 CALL FSTT3 ;FTMP3 = A = 2 + T(P1/Q1) LXI H,FTMP2 ;Y CALL FSUB CALL FSTT4 ;FTMP4 = A - Y LXI H,FTMP3 CALL FLOAD ;Y LXI H,FTMP2 CALL FADD ;FACC = A + Y LXI H,FTMP4 CALL FDIV ; (A+Y) / (A - Y) CALL FCO35 ;SQUARE CALL FCO35 ;4TH POWER CALL FLONE ;LOAD 1 POP B ;GET POWER OF 10 INR C MOV A,C ADI BIAS STA FACC ;FACC = 10 TO POWER LXI H,FTMP1 CALL FMUL ;MULT BY E TO POWER JMP FTAN5 ;SEE WHETHER TO INVERT FEX31 CALL FCERN ; > MAX LXI H,FPMAX JMP FLOAD ; CONVERT FACC TO 16-BIT BINARY INTEGER IN (B,C) FFIX LXI H,INTMX IINT EQU FFIX ;IINT IS SAME AS FFIX IF FPBCD CALL FCMP JNC FFIX1 ;OVERFLOW LXI H,INTMN CALL FCMP JZ FF0 ;-32768 JC FFIX2 ;UNDERFLOW ; RANGE OK FF0 LXI H,FACC MOV A,M ORA A JNZ FF1 LXI B,0 ;ZERO VALUE RET FF1 PUSH PSW ;SAVE SIGN CALL FINT MOV A,C ORA A JNZ FF3 ;NONZERO INTEGER PART ; INTEGER PART 0 POP PSW RP ;RETURN IF POSITIVE DCX B ;NEGATIVE FRACTION JMP FF6 FF3 POP PSW ;REMOVE SAVED SIGN MOV D,C ;D = NO. OF INTEGER DIGITS LXI H,0 ;(H,L) = BINARY ACCUMULATOR LXI B,FACC+1 ;(B,C) = LOC OF FRACTION FF4 LDAX B ;CONVERSION LOOP RAR RAR RAR RAR CALL FF7 ;LEFT DIGIT JZ FF5 ;END OF INTEGER DIGITS LDAX B CALL FF7 ;RIGHT DIGIT INX B ;NEXT BYTE JNZ FF4 ;LOOP FF5 MOV B,H MOV C,L ;(B,C) <== VALUE LDA FACC ORA A RP ;NOT NEGATIVE DAD D ;IF NEGATIVE ROUND DOWN MOV B,H MOV C,L XRA A ;2'S COMPLEMENT SUB C MOV C,A MVI A,0 SBB B MOV B,A FF6 PUSH B CALL FFLOT ;FACC <== INTEGER PART POP B ;VALUE XRA A ;CLEAR CARRY RET FF7 PUSH D ;ADD CURRENT DIGIT TO BINARY TOTAL DAD H ;(H,L) <== (H,L) * 10 MOV E,L MOV D,H DAD H DAD H DAD D ANI 0FH ;GET DIGIT MOV E,A MVI D,0 DAD D ;ADD NEW DIGIT POP D DCR D RET FFIX1 LXI B,32767 ;OVERFLOW JMP FF8 FFIX2 LXI B,-32768 ;UNDERFLOW FF8 CALL FF6 STC RET ; ; FLOAT BINARY VALUE IN (B,C) ; RESULT IN FACC FFLOT PUSH B MVI C,11 LXI H,FACC CALL FZERO POP B STA SIGN ;POSITIVE LXI D,BDTAB-3 ;CONVERSION TABLE ORA B JM FFL0 ;VALUE <0 JNZ FFL1 ;>0 CMP C RZ JMP FFL1 FFL0 ANI 080H STA SIGN ;NEGATIVE XRA A ;NEGATE (B,C) SUB C MOV C,A MVI A,0 SBB B MOV B,A ; SHIFT (B,C) RIGHT FFL1 MOV A,B ORA A ;TEST FOR 0 AND CLEAR CARRY JNZ FFL2 ;B IS NOT 0 MOV A,C ;B=0 ORA A JNZ FFL3 ; DONE WHEN (B,C) = 0 LXI H,EXP1 MVI M,BIAS+6 JMP FNORM ;NORMALIZE FFL2 RAR ;B <== B/10 MOV B,A MOV A,C FFL3 RAR ;C <== C/10 MOV C,A INX D ;NEXT PLACE IN TABLE INX D INX D JNC FFL1 ;0-BIT ; ON 1-BIT ADD VALUE FROM TABLE PUSH D PUSH B INX D INX D LXI H,FACC+3 MVI C,3 CALL FADDL ;ADD DECIMAL VALUE POP B POP D JMP FFL1 ; ; INPUT FLOATING POINT VALUE FROM STRING ; RESULT IN FACC FINP SHLD TEXTP ;SAVE STRING POINTER CALL FINP0 LHLD TEXTP JMP BAKUP ;BACK UP THE TEXT POINTER FINP0 LXI H,FACC MVI C,12 CALL FZERO MOV B,A ;B = 0 = EXPONENT MOV E,A ;E = 0 = SIG DIGIT FLAG STA SIGN INR A MOV D,A ;D = DEC. POINT FLAG = 1 FIN00 CALL FINC ;GET CHARACTER JC FIN1B ;NON NUMERIC FIN0 CPI '0' JNZ FIN2 ;NONZERO DIGIT JMP FIN00 ;SKIP A LEADING 0 FIN1 CALL FINC FIN1A JNC FIN2 ;DIGIT FIN1B CPI '9'+1 JNC FIN3 ;>9 CPI '.' JNZ FIN7 ; END OF STRING XRA A CMP D JZ FIN7 ; 2 DEC. POINTS MOV D,A ;FLAG FOR DEC. POINT JMP FIN1 ; PROCESS DIGIT FIN2 SUI '0' ;MAKE NUMERIC MOV C,A LDA FACC+2 ANI 0F0H JNZ FIN22 ;10 DIGITS ALREADY IN PUSH B LXI H,FACC+1 MVI C,6 CALL FM10 ;FACC <== FACC * 10 POP B MOV A,C ;NEW DIGIT ADD M ;ADD IN NEW DIGIT MOV M,A MOV A,C ;RECOVER NEW DIGIT ORA E MOV E,A ;SIG FLAG NONZERO IF SIG DIGIT SEEN MOV A,D ;FETCH DEC PT FLAG ORA A JZ FIN21 ;DEC PT SEEN INR B ;DEC PT NOT SEEN YET, BUMP EXPONENT FIN21 MOV A,E ;FETCH SIG DIGIT FLAG ORA A JNZ FIN1 ;TRY NEXT DIGIT DCR B ;PAST DEC PT AND NO SIG DIGIT, DCR EXPONENT JMP FIN1 ;MORE THAN 10 SIGNIFICANT DIGITS FIN22 MOV A,D ;FETCH DECIMAL POINT FLAG DCR A JNZ FIN23 ;PAST DECIMAL POINT, LEAVE EXPONENT UNCHANGED INR B ;BUMP EXPONENT FOR DIGIT FIN23 CALL FINC ;FETCH ANOTHER CHAR JC FIN1B ;NONDIGIT JMP FIN22 ;ANOTHER DIGIT FIN3 CPI 'E' JZ FIN4 CPI 'E'+20H ;LOWER CASE E JNZ FIN7 ;NOT VALID CHARACTER ; PROCESS EXPONENT FIN4 MVI C,0 ;EXP. DIGIT COUNT MOV E,C ;BUILD EXPONENT IN E CALL FINC ;GET CHAR JNC FIN4C ;DIGIT CPI MINT JZ FIN4A ;TOKENIZED MINUS SIGN CPI PLUST JZ FIN4B ;TOKENIZED PLUS SIGN CPI '+' JZ FIN4B ;PLUS SIGN CPI '-' JNZ SNERR ;NOT DIGIT, PLUS, MINUS -- SYNTAX ERROR FIN4A MVI A,080H ;MINUS STA SIGN FIN4B CALL FINC JC SNERR ;SYNTAX ERROR IF NONDIGIT FOLLOWS SIGN FIN4C CPI '0' JNZ FIN5 CALL FINC ;GET CHAR AFTER LEADING EXPONENT 0 JC FIN6 ;EXPONENT IS 0 JMP FIN4C ;CHECK FOR ANOTHER LEADING 0 FIN5 INR C SUI '0' ADD E ;ADD TO EXPONENT MOV E,A CALL FINC JC FIN6 ;END PUSH PSW ;ANOTHER EXP. DIGIT MOV A,C CPI 3 JZ FIN5A ;TOO MANY DIGITS MOV A,E ;E <== E * 10 ADD A MOV E,A ADD A ADD A ADD E MOV E,A POP PSW JMP FIN5 FIN5A POP PSW FIN6 LDA SIGN ORA A JZ FIN7A ;EXP >= 0 MOV A,B ;NEGATE EXPONENT SUB E ADI BIAS JM FZACC ;UNDERFLOW JZ FZACC JMP FIN8 FIN7 MVI E,0 FIN7A MOV A,B ;FORM TOTAL EXPONENT ADD E ADI BIAS JM FOVER ;OVERFLOW FIN8 STA EXP1 LXI H,FACC MVI C,6 FIN9 INX H ;FIND NONZERO BYTE MOV A,M ORA A JNZ FIN10 DCR C RZ ;ZERO RESULT JMP FIN9 FIN10 LXI D,FACC+1 ;NORMALIZE CALL FLOD1 ;MOVE OVER TO START OF FACC LDAX D CPI 010H JNC FIN11 LXI H,FACC+1 MVI C,6 CALL FM10 ;HALF BYTE SHIFT FIN11 LXI H,EXP1 LDA TEMP ;SIGN ANI 080H ORA M ;APPEND EXP. STA FACC XRA A RET ; GET CHARACTER FROM STRING ; CF = 1 ==> NOT NUMERIC FINC LHLD TEXTP MOV A,M INX H SHLD TEXTP ;NEW TEXT POINTER CPI '0' RC ;<0 CPI '9'+1 CMC RET ; ; FACC <== INTEGER PART (TRUNCATED) ; EXIT: (D,E) = 1 IFF NONZERO DIGITS WERE TRUNCATED ; (B,C) = NO. OF INTEGER DIGITS FINT XRA A MOV E,A MOV D,A MOV B,A LXI H,FACC ORA M RZ ;ZERO MVI E,1 ;FRACTION FLAG ANI 07FH ;GET EXPONENT SUI BIAS JZ FZACC ;PURE FRACTION JM FZACC MVI E,0 CPI 10 RNC ;ALREADY INTEGER PUSH PSW ;SAVE NO. OF DIGITS ORA A RAR PUSH PSW ;(CF) = 1 IF ODD MOV C,A DAD B INX H ;(H,L)= LOW END OF INTEGER PART MVI A,5 SUB C MOV C,A ;C = NO OF BYTES TO CLEAR POP PSW JNC FINT2 ;EVEN MOV A,M ;CLEAR RIGHT DIGIT OF BYTE ANI 0FH JZ FINT3 ;NO FRACTION DIGIT MVI E,1 MOV A,M ANI 0F0H MOV M,A JMP FINT3 FINT2 MOV A,M ORA A JZ FINT3 ;ALREADY 0 MVI E,1 ;FLAG NONZERO FRACTION MVI M,0 ;CLEAR BYTE FINT3 INX H DCR C JNZ FINT2 POP PSW ;NO. OF DIGITS MOV C,A RET ; ; NATURAL LOG ; X = 10^A * Y WHERE .1 <= Y < 1 ; Y = 2^M * Z WHERE 1/2 <= Z < 1, M=0,-1,-2,-3 ; V = T * T ; LN (V) = LN (1+T)/(1-T) = T * P2(V) / Q2(V) ; LN (X) = A * LN (10) + (M - 1/2) * LN (2) + LN (1+T)/(1-T) FLN LXI H,FPONE CALL FCMP JZ FZACC ;LN(1) = 0 LXI H,FACC MOV A,M ORA A JM FL94 ;LOG OF NEGATIVE JZ FCERN ;LOG OF 0 MVI M,BIAS ;MAKE PURE FRACTION SUI BIAS STA EXP3 ;STORE UNBIASED EXP MVI C,0 FL0 INX H MOV A,M CPI 050H JNC FL1 ;FRAC >= .5 PUSH B DCX H PUSH H LXI H,FTEMP CALL FSTOR CALL FADD ;X <== 2*X POP H POP B INR C ;COUNT JMP FL0 FL1 LXI H,EXP4 MOV M,C ;SAVE SCALE FACTOR CALL FSTT1 ;FTMP1 = SCALED FRACTION LXI H,DSR22 CALL FADD ;ADD SQR(2)/2 CALL FSTT2 LXI H,FTMP1 CALL FLOAD LXI H,DSR22 CALL FSUB LXI H,FTMP2 CALL FDIV ;T = (Y - SQR(2)/2) /(Y + ...) CALL FSTT2 ;FTMP2 = T CALL FCO35 ;FTMP1 = T^2 ; LOG ((1+T)/(1-T)) = CONTINUED FRACTION LXI H,LB3 CALL FTAN7 LXI H,LC0 CALL FADD LXI H,FTMP2 CALL FMUL ;T * P/Q CALL FSTT1 LDA EXP3 MOV C,A MVI B,0 ;(B,C) = EXP ORA A JP FL2 DCR B ;SIGN EXTEND FL2 CALL FFLOT LXI H,LN10 CALL FMUL ;FACC <== EXP * LN(10) CALL FSTT2 LDA EXP4 ;M MOV C,A MVI B,0 CALL FFLOT LXI H,HALF CALL FADD LXI H,LN2 CALL FMUL ;FACC <== -(M - 1/2) * LN(2) CALL FCHS CALL FADT2 LXI H,FTMP1 JMP FADD FL94 ANI 07FH ;LOG OF NEGATIVE MOV M,A ;MAKE POSTIVE CALL FCERN JMP FLN ; ; LOAD FACC FROM (H,L) ; EXIT: (D,E) = FACC FLONE LXI H,FPONE ;LOAD 1 FLOAD LXI D,FACC FLOD1 MVI C,6 ; MOVE FIELD FROM (H,L) TO (D,E) FMOVE PUSH D FMOV1 MOV A,M STAX D INX H INX D DCR C JNZ FMOV1 POP D RET ; ; F.P . MULTIPLY FACC <== FACC * (H,L) FMUL MOV A,M ORA A JZ FZACC ;OP-2 = 0 CALL UPAC1 ADD B ;GET RESULT EXP SUI BIAS-1 JZ FZACC ;UNDERFLOW STA EXP1 ;STORE EXP XCHG LXI D,FTEMP MVI C,6 CALL FMOVE ;MOVE OP-2 TO FTEMP XCHG MVI M,0 LXI B,5 DAD B ;(H,L) = LOW END OF OP-2 PUSH H LXI H,HOLD4 CALL FSTOR ;HOLD4 <== OP-1 DCX H ;(H,L) = END OF HOLD3 MVI B,3 XCHG FM2 LXI H,6 DAD D ;(H,L) <== END OF HOLD(I+1) MVI C,6 ORA A ;CLEAR CARRY FM3 MOV A,M ;HOLD(I) <== 2 * HOLD(I+1) ADC A ;DOUBLE IT DAA STAX D DCX D DCX H DCR C JNZ FM3 DCR B JNZ FM2 CALL FZACC ;CLEAR FACC POP H ;(H,L) <== OP-2 PUSH H CALL FMLOP ;MULT LOOP FOR RIGHT DIGITS LXI H,FACC+1 MVI C,10 CALL FD10 ;FACC <== FACC/10 LXI H,FTEMP+1 MVI C,5 CALL FD10 POP H CALL FMLOP ;MULT LOOP FOR LEFT DIGITS JMP FNORM ;NORMALIZE ; MULTIPLY LOOP ; FACC <== HOLD1 * RIGHT DIGITS OF FTEMP FMLOP MVI C,5 ;OUTER LOOP COUNTER LXI D,FACC+11 ;PRODUCT LOCATION PUSH D PUSH H ;END OF MULTIPLIER FML1 POP D LDAX D ;GET MULTIPLIER DIGIT DCX D ;NEXT DIGIT POP H ;SUM LOCATION DCX H PUSH H ;NEXT SUM LOCATION PUSH D ;NEXT MPR. DIGIT LXI D,HOLD1+5 ANI 0FH ;DIGIT RLC ;PUT IN LEFT NIBBLE RLC RLC RLC FML2 ORA A JZ FML4 ;SKIP LOOP ON ZERO DIGIT PUSH H ;ACCUM LOCATION ADD A ;DOUBLE DIGIT MOV B,A JNC FML3 ;NO ADD ON 0 BIT PUSH B PUSH D MVI C,6 CALL FADDL ;ACCUMULATE PRODUCT POP D POP B FML3 LXI H,6 DAD D ;NEXT HOLD BUFFER XCHG POP H ;ACCUM. LOCATION MOV A,B ;GET DIGIT JMP FML2 ;INNER LOOP FML4 DCR C JNZ FML1 ;OUTER LOOP (NEXT DIGIT) POP H POP H ;CLEAR STACK RET ; MULTIPLY FLOATING POINT VALUE AT (H,L) BY 10 ; ENTRY: C = NO OF BYTES IN FIELD FM10 MOV A,M ANI 0FH RAL RAL RAL RAL MOV M,A INX H MOV A,M RAR RAR RAR RAR ANI 0FH DCX H ORA M MOV M,A ;STORE DIGIT PAIR INX H DCR C JNZ FM10 DCX H ANI 0F0H ;LAST DIGIT = 0 MOV M,A RET ; ; NORMALIZE FNORM LXI H,FACC+1 MVI C,0 FN0 MOV A,M ;FIND HIGHEST NON-0 DIGIT ORA A JNZ FN1 INR C ;COUNT ZEROS INR C INX H JMP FN0 FN1 XRA A CMP C JZ FN2 ;FIRST BYTE NON-0 DCX H PUSH B CALL FLOAD ;MOVE FRACTION LEFT POP B LXI H,FACC+1 FN2 MOV A,M ANI 0F0H JNZ FN3 ;DONE INR C PUSH B LXI B,6 CALL FM10 ;SHIFT LEFT 1/2 BYTE POP B FN3 LXI H,EXP1 MOV A,M SUB C ;ADJUST EXP. JZ FZACC ;UNDERFLOW TO 0 JC FZACC JM FOVER ;OVERFLOW MOV M,A JMP FRND ; ; OUTPUT FROM FLOATING POINT TO STRING FOUT LXI H,BUFAD ;RESULT ADDRESS PUSH H ;SAVE ORIG. BUFAD PUSH H ;CURRENT CHAR. POINTER LXI H,FACC MOV A,M ORA A JNZ FOU1 POP H ;ZERO VALUE MVI M,' ' ;OUTPUT ' 0' INX H MVI M,'0' MVI C,2 POP D RET FOU1 ANI 080H ;SIGN STA SIGN MOV A,M ANI 07FH STA EXP1 ;STORE EXP. MVI M,0 ;MAKE FACC PURE FRACTION LXI H,FACC+5 CALL FRND1 ;ROUND TO 8 PLACES POP H MVI B,' ' ;OUTPUT LEADING ' ' OR '-' LDA SIGN ORA A JP FOU2 MVI B,'-' FOU2 MOV M,B MVI C,1 ;CHAR. COUNT INX H LDA EXP1 SUI BIAS ;UNBIASED EXPONENT MOV E,A ;E = EXP MOV B,A ;B = INTEGER DIGIT COUNTER JM FOU3 ;EXP < 0 JZ FOU3 ;EXP = 0 CPI 9 JC FOU4 ;EXP <= 8 FOU3 MVI M,'.' ;LEADING POINT INR C INX H CPI -7 JC FOU4 ;LARGE NEG EXPONENT, USE E NOTATION FOU3A MVI M,'0' ;ELSE STORE 0 AFTER . INR C INX H INR A JNZ FOU3A MVI E,0 ;RESET EXPONENT TO 0 FOU4 PUSH H ;SAVE OUTPUT POINTER LXI H,FACC MVI D,4 ;BYTE COUNTER ; OUTPUT DIGITS FOU5 INX H ;(H,L) = POINTER TO FACC MOV A,M RAR ;LEFT DIGIT RAR RAR RAR ANI 0FH XTHL ;(H,L) <== OUTPUT POINTER CALL FOUT1 ;OUTPUT DIGIT XTHL MOV A,M XTHL ANI 0FH ;RIGHT DIGIT CALL FOUT1 XTHL DCR D JNZ FOU5 POP H ;CHAR POINTER FOU6 DCX H ;BACK UP TO LAST CHAR DCR C MOV A,M CPI '.' JZ FOU7 ;DELETE TRAILING POINT CPI '0' JZ FOU6 ;BACK UP TO NONZERO INX H INR C ; SEE IF 'E' NOTATION NEEDED FOU7 MOV A,E ORA A JM FOU8 CPI 9 JC FOU12 ;0 <= EXP <= 8 ; OUTPUT 'E' AND EXPONENT FOU8 MVI M,'E' INX H INR C ORA A JP FOU9 MVI M,'-' ;NEGATIVE EXP INX H INR C XRA A SUB E ;MAKE EXP POSITIVE FOU9 CPI 10 JC FOU11 ;ONE-DIGIT EXP ; GET FIRST DIGIT OF EXP MVI D,0 ;D <== EXP/10 FOU10 SUI 10 INR D CPI 10 JNC FOU10 MOV E,A ;E <== REMAINDER MOV A,D ADI '0' MOV M,A ;OUTPUT FIRST DIGIT INX H INR C MOV A,E FOU11 ADI '0' MOV M,A INR C FOU12 POP D ;(D,E) = BUFAD RET ; OUTPUT DIGIT FOUT1 ADI '0' ;MAKE CHARACTER MOV M,A INR C ;CHAR COUNT INX H DCR B ;INTEGER COUNT RNZ MVI M,'.' ;DECIMAL POINT INR C INX H RET ; OVERFLOW FOVER ERROR N,O,V LXI H,FPMAX CALL FLOAD ;LOAD MAX VALUE LXI H,FACC LDA SIGN ORA M ;APPEND SIGN MOV M,A RET ; ; EVALUATE POLYNOMIAL ; ENTRY: FTMP1 = VARIABLE, (C) = DEGREE, (H,L) = HIGHEST ORDER COEFFICIENT ; P(Y) = (...(Y*CN+ C(N-1)) * Y + ...) * Y + C0 FPOLY PUSH B PUSH H CALL FMUL ;MULT BY HIGHEST COEFFICIENT JMP FPLY1 FPLY0 PUSH B PUSH H CALL FADD LXI H,FTMP1 CALL FMUL ;MULT BY VARIABLE FPLY1 POP H POP B LXI D,-6 DAD D ;NEXT COEFFICIENT DCR C ;DEGREE COUNT JNZ FPLY0 JMP FADD ;ADD LAST COEFFICIENT ; RENORMALIZE FRNRM LXI H,FACC MOV A,M ORA A RZ ;NO RENORM NEEDED LXI B,7 CALL FD10 ;SHIFT RIGHT 1/2 BYTE LXI H,EXP1 ;INCR. EXP INR M JM FOVER ;OVERFLOW RET ; ; ROUND FLOATING POINT VALUE FRND LXI H,ACALT CALL FRND1 FRND0 LXI H,SIGN LDA EXP1 ORA M ;REPACK RESULT STA FACC RET FRND1 MOV A,M ADI 050H DAA RNC ;DONE IF NO CARRY DCX H CALL FADL0 ;CARRY ONE JMP FRNRM ;RENORMALIZE ; ; SINE FUNCTION ; IF ABS(X) < 4 E (-7) RETURN X ; ELSE SIN (X) = COS (X - PI/2) FSIN LXI H,FACC MOV A,M ANI 07FH ;GET EXP CPI 039H ; IF ABS(X) < 4 E (-7) THEN RETURN X RC ;EXP < -7 JNZ FS0 INX H MOV A,M CPI 040H RC ; ELSE SIN(X) = COS (X - PI/2) FS0 LXI H,DPI2 CALL FSUB JMP FCOS ; ; SQUARE ROOT ; X = Y * 10^A WHERE .1 <= Y < 1 ; B <== INT (A/2) ; C <== (A - 2*B) * SQR(10) ; Z0 <== POLYNOMIAL(Y) ; Z1 <== 1/2 (Z0 + Y/Z0), ETC. ; SQR(X) = Z * 10^B * SQR(10) IF C=1 ; = Z * 10^B IF C = 0 FSQR LXI H,FACC MOV A,M ORA A CM FCERN ;SQR OF NEGATIVE ANI 7FH MOV M,A ;FORCE POSITIVE SUI BIAS ;UNBIAS EXP RAR ;A <== EXP/2 PUSH PSW ;SAVE EVEN/ODD FLAG STA SIGN1 ;STORE EXP/2 MVI M,BIAS ;SET EXP TO 0 CALL FSTT1 ;SAVE X INX H MOV A,M CPI 025H JNC FSQ4 ;X > .25 ; X <= .25 LXI H,SR3 MVI C,3 FSQ0 CALL FPOLY ;POLYNOMIAL ; 2 NEWTON-RAPHSON ITERATIONS CALL FSQ2 CALL FSQ2 POP PSW ;EVEN/ODD FLAG JNC FSQ1 ;EVEN LXI H,SQR10 CALL FMUL ;IF ODD MULT BY SQR(10) FSQ1 LXI H,FACC LDA SIGN1 ;GET EXP/2 ADD M MOV M,A ; SET RESULT EXP RET ; NEWTON-RAPHSON ITERATION ; Z1 = (X/Z0 + Z0) * .5 FSQ2 CALL FSTT2 ;STORE Z LXI H,FTMP1 CALL FLOAD LXI H,FTMP2 CALL FDIV ;X/Z0 LXI H,FTMP2 CALL FADD LXI H,HALF JMP FMUL ; X > .25 FSQ4 LXI H,SR6 MVI C,2 JMP FSQ0 ; ; STORE FACC AT (H,L) ; EXIT: (H,L) = DESTINATION FIELD FSTT4 LXI H,FTMP4 JMP FSTOR FSTT3 LXI H,FTMP3 JMP FSTOR FSTT2 LXI H,FTMP2 JMP FSTOR FSTT1 LXI H,FTMP1 FSTOR PUSH B LXI B,5 DAD B ;(H,L) = LOW END OF FIELD INX B LXI D,FACC+5 FST0 LDAX D MOV M,A DCX D DCX H DCR C JNZ FST0 INX H POP B RET ; ; FLOATING POINT SUBTRACTION FACC <== FACC - (H,L) FSUB MOV A,M ORA A RZ ;OP - 2 = 0 LXI D,FACC LDAX D ORA A JZ FSUB0 ;SUBTRACT FROM 0 XRI 080H ;REVERSE SIGN JMP FADD0 FSUB0 CALL FLOAD ;LOAD OP-2 JMP FCHS ; SUBTRACT LOOP FSUB1 LDA FLEN MOV C,A ;LENGTH OF LOOP STC FSU2 XCHG MVI A,099H ACI 0 SUB M XCHG ADD M DAA MOV M,A DCX H DCX D DCR C JNZ FSU2 JC FSU4 ;FORM CORRECT LHLD RSLT LDA FLEN MOV C,A STC FSU3 MVI A,099H ;RECOMPLEMENT ACI 0 SUB M ORA A ;CLEAR ACY DAA MOV M,A DCX H DCR C JNZ FSU3 LXI H,SIGN MOV A,M XRI 080H ;REVERSE SIGN ON RECOMPLEMENT MOV M,A FSU4 LXI H,FACC+1 MVI C,7 FSU5 MOV A,M ;CHECK FOR 0 RESULT ORA A JNZ FNORM ;NORMALIZE NON-0 INX H DCR C JNZ FSU5 RET ;RETURN 0 ; ; TANGENT ; STORE SIGN AND MAKE ABS VALUE ; Y <== 4X/PI ; R <== FRAC(Y) ; A <== INT(Y) (MOD 4) ; IF A > 2 THEN REVERSE SIGN ; IF A IS ODD, R <== 1-R ; IF A = 1 OR 2 (MOD 4) SET COTAN FLAG ; Y <== R * PI/4 ; T <== Y * Y ; TAN (X) = X * (C0 + P2(T)/Q2(T)) ; IF FLAG IS SET, TAKE COTAN I.E. 1/TAN ; APPEND SIGN FTAN XRA A STA EXP4 ;CLEAR COTAN FLAG LXI H,FACC MOV A,M ANI 080H ;GET SIGN STA SIGN1 MOV A,M ANI 07FH ;GET EXP MOV M,A ;MAKE ABS. VALUE CALL FCO34 ;FTMP2 <== 4X/PI LXI H,INTMX CALL FCMP JNC FCERN ;VALUE TOO LARGE CALL FFIX ;GET INTEGER PART PUSH B ;SAVE INT PART CALL FCHS ;GET FRAC PART CALL FADT2 ;R = FRAC PART POP B MOV A,C ANI 3 ;A <== INT PART (MOD 4) CPI 2 JC FTAN2 LXI H,SIGN1 ;IF > 2 (MOD 4) REVERSE SIGN PUSH PSW MOV A,M XRI 080H MOV M,A POP PSW FTAN2 PUSH PSW RAR JNC FTAN3 ;EVEN CALL FCHS ;IF ODD, R = 1 - R LXI H,FPONE CALL FADD FTAN3 POP PSW INR A ANI 2 JZ FTAN4 ;A WAS 0 OR 3 (MOD 4) STA EXP4 ;IF 1 OR 2 (MOD 4) SET COTAN FLAG FTAN4 LXI H,DPI4 CALL FC34A ;FTMP2 = Y = R * PI/4 CALL FCO35 ;FTMP1 = Y^2 LXI H,TB3 CALL FTAN7 ;EVAL. CONTINUED FRAC. LXI H,TC0 CALL FADD LXI H,FTMP2 CALL FMUL ;*Y FTAN5 LDA EXP4 ;GET INVERT FLAG ORA A CNZ FLINV ;INVERT IF DESIRED JMP FAT6 ;APPEND SIGN ; EVALUATE CONTINUED FRACTION ; P1 <== C2 (X + B3) ; Q1 <== (X + B2) (X + B3) + C3 ; P2 <== C1 * Q1 ; Q2 <== (X + B1) * Q1 + P1 FTAN6 PUSH H CALL FADD ;X + B3 CALL FSTT3 ;FTMP3 = X + B3 POP H LXI D,6 DAD D ;NEXT COEFFICIENT PUSH H CALL FMUL ;* C3 CALL FSTT4 ;FTMP4 = P1 LXI H,FTMP1 CALL FLOAD ;X POP H LXI D,6 DAD D PUSH H CALL FADD ;+ B2 LXI H,FTMP3 CALL FMUL ; * (X + B3) POP H LXI D,6 DAD D PUSH H CALL FADD ; + C3 CALL FSTT3 ;FTMP3 = Q1 POP H RET FTAN7 CALL FTAN6 PUSH H LXI H,FTMP1 CALL FLOAD ;X POP H LXI D,6 DAD D PUSH H CALL FADD ; + B1 LXI H,FTMP3 CALL FMUL ; * Q1 LXI H,FTMP4 CALL FADD ; + P1 CALL FSTT4 ; FTMP4 = Q2 LXI H,FTMP3 CALL FLOAD ; Q1 POP H LXI D,6 DAD D CALL FMUL ; * C1 = P2 LXI H,FTMP4 ; P2/Q2 JMP FDIV ; ; ZERO OUT FACC FZACC MVI C,6 LXI H,FACC ; ZERO OUT FLOATING POINT FIELD AT (H,L) FZERO XRA A FZER1 MOV M,A INX H DCR C JNZ FZER1 RET ; ; UNPACK FLOATING POINT OPERANDS FOR DIV. AND MULT. UPAC1 ANI 07FH ;GET EXP-2 MOV B,A ;SAVE EXP-2 IN B LXI D,FACC LDAX D ORA A JNZ UNP1 ; OP-1 = 0 INX SP ;EXIT FROM CALL INX SP RET ;RETURN 0 UNP1 XRA M ;GET RESULT SIGN ANI 080H STA SIGN UPAC2 XCHG ;(D,E) = OP-2 MOV A,M PUSH PSW ;SAVE EXP-1 MVI M,0 ;FACC <== PURE FRACTION LXI H,ACALT MVI C,7 CALL FZERO ;CLEAR ACALT POP PSW ANI 07FH ;EXP-1 RET endif ;end of module FPBCD