TITLE ARITH V.021 12-MAR-79 SUBTTL DEFNS FOR ARITHMETIC ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ; ;COPYRIGHT (C) 1970,1979 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. HISEG ; SOME UNIVERSAL DEFINITIONS RADIX 10 RA=1 RB=2 RC=3 RD=4 RE=5 RF=6 RG=7 RH=8 RI=9 RJ=0 AMAG=RA ASGN=RB ASF=RC BMAG=RD BSGN=RE BSF=RF INTERN S80A INTERNAL S76A,S83A,S84A,P92A,P93A INTERNAL S86A,P75A,P78A,P82A,P77A,P81A,P80A,S87A INTERNAL S75A,S82A,P76A,S5450A,P8530A,S5455A,S79A,SR1A EXTERNAL S86,P75,P78,P82,P77,P81,P80 INTERNAL P83A,S78A,P94A,P84A,S77A,P85A,P91A,S81A,P90A EXTERNAL P75.08 EXTERNAL S79.01,P84.97,P90.04,P90.05,P91.06,P91.03 EXTERNAL S83.96,S83.95,S84.99,S84.98,S84.97,S54.97 EXTERNAL P92,P93,S83.99,S83.98,S83.97,AS EXTERNAL P79,P83,P84,P85,P90,P91,P94 EXTERNAL S76,S77,S78,S80,S81,S83,S84 EXTERNAL S87,S75,S82,P76,S54.50,P85.30,S54.55,S79,SR1 EXTERNAL P79.90,P79.91,P79.92,P79.89,P79.85,P79.86 EXTERNAL P79.87,P79.88,P80.97,P80.98,P80.99,P81.80 EXTERNAL P81.81,P81.82,P81.99,P82.80,P82.81,P82.82 EXTERNAL P82.90,P82.91,P82.92,P82.84,P83.94,P83.95 EXTERNAL P83.96,P83.97,P83.98,P83.99,P85.99,P85.98 EXTERNAL S75.93,S54.60,S54.98,S54.99,S80.98,S80.99 EXTERNAL S81.98,S85,S85.80,S85.81,S85.90,S85.95 EXTERNAL S85B,S85C,S85A,S85Y,S85M EXTERNAL S86,P75,P78,P82,P77,P81,P80 EXTERNAL S87,S75,S82,P76,S54.50,P85.30,S54.55,S79,SR1 SUBTTL MACROS FOR ARITH DEFINE RETURN (NAME,N) < IFE N-1, < AOS NAME > IFG N-1, < EXCH RA,NAME ADDI RA,N EXCH RA,NAME > JRST 2,@NAME > DEFINE PUT (P,Q) < MOVE Q'MAG,P'MAG MOVE Q'SGN,P'SGN MOVE Q'SF,P'SF > DEFINE PUTM (P,Q) < MOVEM P'MAG,Q'MAG MOVEM P'SGN,Q'SGN MOVEM P'SF,Q'SF > DEFINE NRMLZ < CAML AMAG,T80.08 JRST .+3 IMULI AMAG,^D10 SOJA ASF,.-3 > DEFINE UNPK (P) < SETZM P'SGN TLZE P'MAG,^O400000 TLO P'SGN,^O400000 > DEFINE RENTRY (NAME,N) < IFE N-2, < JSR S86 > IFE N-1, < JSR S87 > > DEFINE PACK (N) < OR AMAG,ASGN IFE N-2, < OR BMAG,BSGN > > DEFINE JADD < PACK 2 JSR P75 > DEFINE JSUB < PACK 2 JSR P76 > DEFINE JMPY < PACK 2 JSR P77 > DEFINE JDIV (ZERO) < PACK 2 JSR P78 JRST ZERO > DEFINE JSQRT (NEG) < PACK 1 JSR P80 JRST NEG > DEFINE JEXP (OFLOW) < PACK 1 JSR P81 JRST OFLOW > DEFINE JLOG (ERR) < PACK 1 JSR P82 JRST ERR > SUBTTL ROUTINE P75...A=A+B ; CALLED BY: ; JSR P75; ; RETURN PWR=BSF MAX=^D10; QUOT=AMAG; REM=ASGN; NORM=0; P75A: RENTRY Q75,2; DATA SWITCH 1 JUMPE BMAG,P75.10; EXIT IF B=0 JUMPG AMAG,P75.01; PUT (B,A); ; SET A=B AND EXIT IF A=0. P75.10: RETURN (P75,NORM); P75.01: CAMG ASF,BSF; SKIP IF A>B JRST P75.50; TO INTERCHANGE TEST P75.02: CAME ASGN,BSGN; SKIP IF SIGNS AGREE MOVNS BMAG; COMPLEMENT SMALLER SUBM ASF,BSF; PWR=ASF-BSF CAILE PWR,MAX; SKIP IF SHIFT LE MAX JRST P75.10; TO EXIT IF A+B=A HLRM ASGN,P75.08; SAVE ASGN ASH BMAG,1; ASH AMAG,1; MUL AMAG,T80(PWR); 2.A.10*PWR JOV .+1; ADD ASGN,BMAG; 2.A.10*PWR+2.B JOV P75.53; TO.53 IF LEAST SIG. OFLOW TLZE ASGN,^O400000; SKIP IF LSH IS POS SUBI AMAG,1 P75.03: DIV AMAG,T80(PWR); (2.A.10*P+2.B)/10*P JUMPE QUOT,P75.55; TO .55 IF QUOT=0 P75.04: CAML QUOT,P75.90; SKIP IF QUOT<2.10*8 JRST P75.06; MOVE BMAG,REM; MULI BMAG,^D10; 10.R/10*P DIV BMAG,T80(PWR); IMULI QUOT,^D10; ADD QUOT,BMAG; 10.Q+10.R/10*P P75.05: SOS ASF; CAML QUOT,P75.90; SKIP IF Q<2.10*8 JRST P75.06; IMULI QUOT,^D10; 10.Q TO Q JRST P75.05; CONTINUE NORMALIZE P75.06: CAMGE QUOT,P75.91; SKIP IF Q GE (2.10*9-1) JRST P75.07; AOS ASF; IDIVI QUOT,^D10; Q/10 TO Q P75.07: AOS QUOT; ROUND: Q=(Q+1)/2 ASH QUOT,-1; XCT P75.08 RETURN (P75,NORM); P75.50: CAML ASF,BSF; SKIP IF ABS(ASF) LE ABS(BSF) JRST P75.52; ASF=BSF P75.51: EXCH ASGN,BSGN; EXCH ASF,BSF; EXCH AMAG,BMAG; JRST P75.02; P75.52: CAMGE AMAG,BMAG; SKIP IF ABS(A) GE ABS(B) JRST P75.51; JRST P75.02; TO ARITH P75.53: TLZ ASGN,^O400000; SET SIGN OF L.S. PLUS AOJA AMAG,P75.03; INCREMENT MS HALF P75.55: JUMPN REM,P75.04; SETZB AMAG,ASF; MOVEI ASGN,0; JRST P75.10; A=0 AND EXIT P75.90: DEC 200000000; P75.91: DEC 1999999999; SUBTTL P76.....SUBTRACT....A=A-B ; ROUTINE P76..A=A-B ; CALLED BY: ; JSR P76; ; RETURN NORM=0; P76A: JUMPE BMAG,P76.02; A-B=A IF B=0 TLC BMAG,^O400000; CHANGE SIGN JSR P75 RETURN P76,NORM P76.02: UNPK A P76.01: RETURN (P76,NORM); EXIT SUBTTL P77.....MULTIPLY.....A=A.B ;ROUTINE P77..A=A.B ;CALLED BY: ; JSR P77; ; RETURN PWR=BSF; PROD=BMAG; NORM=0; P77A: RENTRY Q77,2; DATA SWITCH 3 JUMPN BMAG,P77.02; JUMP IF B NE 0 MOVEI AMAG,0; SET ANS=0 IF B=0 SETZB ASGN,ASF P77.01: RETURN (P77,NORM); EXIT P77.02: JUMPE AMAG,P77.01; TO EXIT IF A=0 XOR ASGN,BSGN; SIGN OF RESULT TO ASGN ADD ASF,BSF; SCALE FACTOR..TO BE ADJUSTED ASH BMAG,1; 2.B MUL BMAG,AMAG; 2.A.B ; ; IF 2.A.B<2.10*17-10*8, DIV BY 10*8 ; OTHERWISE INCREMENT ASF AND DIV BY 10*9 HRRI PWR,^D8; SET FOR 10*8 CAML PROD,P77.90; SKIP IF LESS JRST P77.50; G.E. P77.03: DIV PROD,T80(PWR); 2.A.B/10*PWR ADDI PROD,1; ROUND: PROD=(PROD+1)/2 ASH PROD,-1; MOVE AMAG,PROD; RESULT TO A JRST P77.01; TO EXIT ; ; 2.A.B GE 2.10*17-10*8 ; P77.50: CAME PROD,P77.90; SKIP IF MOST SIG. HALF IS EQUAL JRST P77.51; GREATER CAMGE PROD+1,P77.91; SKIP IF L.S.HALF IS GE JRST P77.03; LSH IS LESS; TO DIVIDE BY 10*8 P77.51: HRRI PWR,^D9; SET FOR 10*9 AOJA ASF,P77.03; INCREMENT SF; TO DIVIDE BY 10*9 P77.90: DEC 5820766; Q[(2.10*17-10*8)/2*35] P77.91: DEC 3038650112; R[ ] SUBTTL ROUTINE P78A: A=A/B SUBTTL ROUTINE P78A: A=A/B ; CALLED BY: ; JSR P78; ; ERROR: DIVISION BY ZERO ; NORMAL ERR=0; NORM=1; P78A: RENTRY Q78,2; DATA SWITCH 4 JUMPN BMAG,P78.02; ERROR IF B=0 P78.06: RETURN P78,ERR; ERROR EXIT P78.02: JUMPN AMAG,P78.08; EXIT IF A=0 P78.04: RETURN (P78,NORM); NORMAL EXIT P78.08: XOR ASGN,BSGN; SIGN OF ANSWER SUB ASF,BSF; SF (TO BE ADJUSTED) MOVEI BSGN,^D8; SET P=8 CAMGE AMAG,BMAG; SKIP IF AMAG GE BMAG JRST P78.50; P78.10: MOVE BSGN,T80(BSGN); 10*P (P=8 OR P=9) ASH AMAG,1; 2A MUL BSGN,AMAG; 2A.10*P DIV BSGN,BMAG; 2A.10*P/B ADDI BSGN,1; ROUND ASH BSGN,-1; MOVE AMAG,BSGN; STORE IN A JRST P78.04; TO EXIT P78.50: HRRI BSGN,^D9; SET P=9 SOJA ASF,P78.10; DECREMENT SF .. BACK TO COMPUTE SUBTTL ROUTINE P79:A*B SUBTTL ROUTINE P79:A*B ; CALLED BY: ; JSR P79; ; ERR 1: NEG NO. TO FRACT. PWR. ; ERR 2: A*B>2*36-1 ; ERR 3: ZERO TO NEGATIVE PWR. ; NORMAL RETURN INTERN P79A NEG=0; OFLO=1; ERR=2; NORM=3; YMAG=RG; YSGN=RH; YSF=RI; TBMAG=RJ; DEFINE EXIT (N) < IFE N-1, < AOS P79 > IFG N-1, < EXCH RA,P79 ADDI RA,N EXCH RA,P79 > JRST P79.06 > TAMAG=P79.90 TASGN=P79.91 TASF=P79.92 EXTERN S68 P79A: JSR S86 JRST P79.10; P79.01: EXIT (NORM); P79.02: EXIT (ERR); ZERO TO NEGATIVE P79.03: EXIT (OFLO); A*B>2*36-1 P79.04: EXIT (NEG); NEG A TO FRACT B P79.06: MOVE RG,P79.85; MOVE RH,P79.86; MOVE RI,P79.87; MOVE RJ,P79.88; JRST 2,@P79; P79.10: MOVEM RG,P79.85; SAVE RG THRU RJ MOVEM RH,P79.86; MOVEM RI,P79.87; MOVEM RJ,P79.88; JUMPN BMAG,P79.12; TO .12 IF B NE 0 SETZB ASGN,ASF; SET Y=1 IF B=0 MOVE AMAG,T80.08 JRST P79.01; TO EXIT ; B NE 0 P79.12: JUMPN AMAG,P79.20; TO .20 IF A NE 0 JUMPN BSGN,P79.02; ERROR IF A=0 AND B<0 JRST P79.01; SET Y=0 IF A=0 AND B>00 ; A NE 0 AND B NE0 ; TEST FOR B INTEGRAL P79.13: MOVEM ASGN,P79.89; SAVE SIGN OF A JUMPL BSF,P79.18; TO .18 IF ABS(B)<1 CAILE BSF,^D8; JRST P79.22; TO .22 IF ABS(B)>10*9 PUTM (B,TA); SAVE B IN TA MOVNI BSF,-^D8(BSF); P=8-SF(B) IDIV BMAG,T80(BSF); !B!/10*(8-SF(B)) JUMPN BSGN,P79.16; TO .16 IF REMAINDER NE 0 ; B IS INTEGRAL CAIE BMAG,1; JRST P79.15; TO .15 IF !B! NE 1 ; !B!=1 SKIPN TASGN; JRST P79.01; SET Y=A IF B=1 MOVE BMAG,T80.08 SETZB BSGN,BSF; SET Y=1/A IF B=-1 EXCH AMAG,BMAG; EXCH ASGN,BSGN; EXCH ASF,BSF; JDIV (P79.03); JRST P79.01; TO EXIT ; B INTEGRAL AND !B! NE 1 P79.15: CAMN AMAG,T80.08; SKIP IF A NE PWR(10) JRST P79.30; CAIG BMAG,^D29; JRST P79.24; TO .24 IF !B! LE 29 ; B INTEGRAL AND !B!>29 TLZN ASGN,^O400000; SET FOR LOG(ABS(A)) JRST P79.16; TO .16 IF A WAS POSITIVE ; A<0 TRNN BMAG,1; SET SGN(Y=(-1)*B MOVEM ASGN,P79.89; P79.16: PUT (TA,B); RESTORE B P79.17: JLOG (P79.04); LOG(A), TO ERROR IF A<0 ; B.LOG JMPY JEXP (P79.03); WXP(B.LOG(A)); TO ERROR IF OFLO MOVE ASGN,P79.89; Y=EXP(B.LOG(A)).SGN JRST P79.01; TO EXIT ; !B!<1 P79.18: JUMPN ASGN,P79.04; TO ERROR IF A<0 CAME BSF,P79.95; JRST P79.17; TO .17 IF !B! NE1/2 CAME BMAG,P79.96; JRST P79.17; TO .17 IF !B! NE 1/2 ; !B!=1/2 JSQRT (P79.04); JUMPE BSGN,P79.01; Y=SQRT(A) IF B>0 MOVE BMAG,T80.08 SETZB BSGN,BSF; Y=1/SQRT(A) IF B<0 EXCH AMAG,BMAG; BOTH SIGNS ARE 0 EXCH ASF,BSF; JDIV (P79.03); JRST P79.01; TO EXIT ; TEST FOR A=1 P79.20: JUMPN ASGN,P79.13; TO .13 IF A<0 JUMPN ASF,P79.13; TO .13 IF A NE X.X (10*0) CAME AMAG,T80.08 JRST P79.13; TO .13 IF A NE 1 JRST P79.01; SET Y=1 IF A=1 ; ~ B>10*9; TREAT LIKE INTEFER P79.22: MOVEI ASGN,0; RET FOR LOG(!A!) MOVEM ASGN,P79.89; SET SGN(Y) + JRST P79.17; TO Y=EXP(B.LOG(A)) ; A=PWR(10); B INTEGRAL P79.30: TRNN BMAG,1; SKIP IF B IS ODD MOVEI ASGN,0; IF B IS EVEN, ANS IS + SKIPE TASGN; RESTORE SIGN OF B MOVNS BMAG; IMUL ASF,BMAG; 10*P)*B=10*(PB) JRST P79.01; TO EXIT ; B INTEGRAL AND !B! LE 29 P79.24: MOVE BSGN,TASGN ; B INTEGRAL ; 11 CAIGE DEL,1 JRST P80.20; NOT GREATER CAIG DEL,1; SKIP IF GREATER JUMPE RE,P80.20; JUMP IF REMAINDER=0 AOS ROOT; ROUND UP P80.20: PUT TB,B RETURN (P80,NORM); RESTORE B AND EXIT P80.50: MOVE ROOT,P80.90; 10*8.SQRT(10)+EPSILON TO GUESS JRST P80.01; P80.90: DEC 316227800; 10*8.SQRT(10)+24 SUBTTL P81A: A=EXP(A) ; JSR P81; ; OVERFLOW RETURN ; NORMAL RETURN X=BMAG; Y=BSGN; I=AMAG; NORM=1; OFLO=0; TBMAG=P81.80 TBSGN=P81.81 TBSF=P81.82 P81A: RENTRY Q81,1; DATA SWITCH 7 JUMPN AMAG,P81.01; MOVE AMAG,T80.08; SET Y=1 IF A=0 P81.20: RETURN (P81,NORM); EXIT P81.01: PUTM (B,TB); SAVE B SETZM P81.99; SET FOR +ARG CAIL ASF,3; JRST P81.60; SF GE 3 CAIN ASF,2; SF LS3 JRST P81.61; SF=2 CAMGE ASF,P81.90; SF LS2 JRST P81.62; SF LS -5 P81.05: TLZE ASGN,^O400000; SF GE -5..SET SIGN +,SKIP IF + AOS P81.99; SET FOR - ARG MOVE X,AMAG; POSITION FOR DOUBLE LENGTH OPERATIONS MOVEI Y,0; JUMPL ASF,P81.50; ASH X,4; X B31 MUL X,P81.95(ASF); XB31.10*SFXB32 DIV X,P81.91; XB63/10*8LN(10)B28 MOVEI BSF,0 DIV Y,P81.91; REMAINDER DIVEDED AGAIN ;IP IN X...FP IN Y MOVE ASF,X; SFX=IP(X.10*SFX) MUL Y,P81.92; FP( ).LN(10)B3 ASHC Y,1; .25X B0 MOVE X,Y; P81.10: HRLZI I,^O300000; SERIES...I=12B4 HRLZI Y,^O200000; Y=1B1 P81.11: MUL Y,X; X(B0).Y(B1) ASHC Y,-4; X.Y(B5) DIV Y,I; X.Y(B5)/I(B4) ADD Y,P81.97; Y=X.Y/I+1 B1 SUB I,P81.98; I=I-1 B4 CAMLE I,[OCT 040000000000]; SKIP IF I LE 2B4 JRST P81.11; MUL Y,X; X.Y B1 JUMPL Y,.+2; AOSA Y; SOS Y; ROUND ASH Y,-1; ADD Y,P81.97; Y=X.Y/2+1 B1 MUL Y,X; ASHC Y,1; X.Y B0...ROUND AND SCALE AT B1 JUMPL Y,.+2; AOSA Y; SOS Y; ASH Y,-1; ADD Y,P81.97; Y=X.Y+1 B1 ROUNDED P81.12: MUL Y,Y; Y*2 B2 TLNE BSF,^O200000; ROUND AOS Y; MUL Y,Y; Y*4 B4 TLNE BSF,^O200000; ROUND AOS Y; MOVE AMAG,Y; SETUP FOR S75, B=4 SOSN P81.99; SKIP IF ARG WAS PLUS JRST P81.14; COMPUTE 1/Y P81.40: MOVEI ASGN,4 JSR S75; MOVEI ASGN,0; SET SIGN + P81.13: PUT TB,B JRST P81.20 P81.14: HRLZI AMAG,^O001000; 1 B4 MOVEI ASGN,0; CLEAR ASGN DIV AMAG,Y; 1/E*X MOVNS ASF; ADJUST SCALE FACTOR JRST P81.40; TO NORMALIZE AN D EXIT P81.50: MOVMS ASF; ASF<0;ABS(ASF) TO ASF ASHC X,-^D11; X B11 DIV X,P81.96-1(ASF); XB46/10*(7+SFX)B44 MOVEI ASF,0; X/4 B0; SFX=0 JRST P81.10; TO SERIES P81.60: JUMPL ASGN,P81.65; RETURN (P81,OFLO); SF(X) GE 3; OFLO IF + P81.65: MOVEI AMAG,0; EXP(X)=0 IF - SETZB ASGN,ASF; JRST P81.20; P81.61: CAMLE AMAG,P81.93; SFX=2; COMPARE MAG VS 10*8 LN 10 JRST P81.60; X>10*9.LN(10) JRST P81.05; X LE 10*9.LN(10) P81.62: SETZB BSGN,BSF; SF(X) LS -5 MOVE BMAG,T80.08; B=1 ; EXP(X)=1+X JADD P81.63: PUT (TB,B); RESTORE B JRST P81.20; TO EXIT ; TEMP STORE FOR B P81.90: DEC -5; P81.91: OCT 333456723246; 10*8LN(10)B28 P81.92: OCT 111535433567; LN(10) B3 P81.93: DEC 230258509; 10*8 LN (10) P81.95: DEC 8,80,800; 1,10,100 B32 P81.96: DEC 1953125,19531250,195312500,1953125000,19531250000; ; 10*9 THRU 10*13 B44 P81.97: OCT 200000000000; 1 B1 P81.98: OCT 020000000000; 1 B4 SUBTTL ROUTINE P82A: A=LN(A) SUBTTL ROUTINE P82A: A=LN(A) ; CALLED BY ; JSR P82; ; ERROR: A LE 0 ; NORMAL Q=BSF; ERR=0; A LE 0 EXIT NORM=1; NORMAL EXIT TBMAG=P82.80 TBSGN=P82.81 TBSF=P82.82 TAMAG=P82.90 TASGN=P82.91 TASF=P82.92 P82A: RENTRY Q82,1; DATA SWITCH 8 P82.20: JUMPL ASGN,P82.24; ERROR IF A LE 0 JUMPG AMAG,P82.25 P82.24: RETURN (P82,ERR); ERROR EXIT P82.25: PUTM B,TB; SAVE B ; TEST FOR X CLOSE TO 1 JUMPG ASF,P82.26; NO CAML ASF,[DEC -1] JRST P82.50; MAYBE P82.26: MOVEI Q,3 P82.01: CAML AMAG,P82.83 JRST P82.02 ASH AMAG,1; X LS 10*8.2*3.SQRT(2)/2 SOJA Q,P82.01; X=2.X; Q= Q-1 P82.02: MOVE BMAG,P82.87; X GE 10*8.2*3.SQRT(2)/2 ADD BMAG,AMAG; X+8 SUB AMAG,P82.87; X-8 ; ASGN IS ALREADY 0 ASH AMAG,2; (X-8)B33 DIV AMAG,BMAG; X=(X-8)/(X+8) B-2 MOVEM AMAG,P82.84; SAVE X MUL AMAG,AMAG; Z=X*2 B-4 ADDI AMAG,^O10; ASH AMAG,-4; Z B0 ROUNDED MOVE BMAG,P82.94; S= 1/13 B-1 HRREI ASGN,-5; N=-5 P82.03: MUL BMAG,AMAG; S.Z(B-1) ADD BMAG,P82.95+5(ASGN); S=S.Z+ 1/I (I=11,9,7,5,3) AOJL ASGN,P82.03; MUL AMAG,BMAG; Z=S.Z B-1 MUL AMAG,P82.84; X=S.Z.X B-3 JUMPL AMAG,.+2; AOSA AMAG; SOS AMAG; ASH AMAG,-1; ROUND AND SCALE AT B-2 ADD AMAG,P82.84;X=(S.Z.X+X)B-2=LN(X) B-1 MOVE BSGN,P82.96; LN(2) B0 MUL BSGN,Q; Q.LN(2) TO BSGN, BSF B35 ASH ASF,2; SF(X)B33 MUL ASF,P82.97; SF(X).LN(10) TO ASF,BMAG B35 ;IF ABS(P.LN(10)) LE 1,SCALE AT B=2 ;OTHERWISE SCALE AT B=8 JSR S82 P82.07: MOVEI ASF,2; SF(X)=2 CAIGE BSGN,^D100; ASH ASF,-1; SF(X) = 1 IF XLS 100 CAIGE BSGN,^D10; ASH ASF,-1; SF(X)=0 IF XLS 10 CAIG BSGN,0; HRREI ASF,-1; SF(X) = -1 IF X =0 P82.15: DIV BSGN,T80.01(ASF); X=X/10*(SF+1) B0 AOS ASF MOVE AMAG,BSGN; SET FOR S75 MOVEI ASGN,0; B=0 JSR S75; JUMPE AMAG,.+2; TO EXIT IF ANS =0 MOVE ASGN,BMAG; RESTORE SIGN P82.21: PUT TB,B P82.22: RETURN (P82,NORM); EXIT ; SF IS 0 OR -1; TEST # P82.50: JUMPE ASF,P82.52; SF=0 CAMGE AMAG,[DEC 997885258] JRST P82.26; 1-X>EPSILON JRST P82.54; TO "JOSS EVALUATION" P82.52: CAMN AMAG,T80.08 JRST P82.56; LOG(1)=0 CAMLE AMAG,[DEC 100211474] JRST P82.26; X-1>EPSILON ; X IS CLOSE TO 1 P82.54: MOVE BMAG,T80.08; COMPUTE X-1 SETZB BSGN,BSF JSUB PUTM A,TA; SAVE Z=X-1 MUL AMAG,AMAG; Z*2.10*16 B70 DIV AMAG,T80.09; Z*2/10 10*8 B35 ASH ASF,1; AOS ASF; 2.SF+1 MOVE BMAG,AMAG MOVE BSF,ASF ADD BSF,TASF; SF(Z*2)+SF(Z)=SF(Z*3) MUL BMAG,TAMAG; Z*3 DIV BMAG,T80.08 AOS AMAG ASH AMAG,-1; Z*2/2 ROUNDED MUL BMAG,[DEC 33333333]; Z*3/3 (EIGHT DIGITS IN 3) DIV BMAG,T80.08; CAML AMAG,T80.08 JRST .+3 IMULI AMAG,^D10; NORMALIZE BY 1 SOS ASF CAML BMAG,T80.08 JRST .+3 IMULI BMAG,^D10 SOS BSF HRLZI ASGN,^O400000; -Z*2/2 MOVE BSGN,TASGN; Z*3/3 WITH SIGN OF Z ; COMPUTE LN(X)=Z-Z*2/2+Z*3/3 JADD PUT TA,B JADD JRST P82.21; TO EXIT P82.56: SETZM AMAG; LOG(1)=0 JRST P82.21; TO EXIT P82.83: DEC 565685425; 10*8.2*3. SQRT (2)/2 P82.87: DEC 800000000; 10*8.2*3 P82.94: OCT 047304730473; 1/13 = .07692307692 B(-1) P82.95: OCT 056427213506; 1/11 = .09090909091 B(-1) OCT 070707070707; 1/9 = .11111111111 B(-1) OCT 111111111111; 1/7 = .1428571429 B(-1) OCT 146314631463; 1/5=.2 B(-1) OCT 252525252525; 1/3 = .33333 B(-1) P82.96: OCT 261344137676; LN(2)=.6931471806 B0 (-EPSILON) P82.97: OCT 223273067355; LN(10)=2.3025850930 B2 SUBTTL DOUBLE PRECISION FOR LOG S82A: ASH AMAG,-1; SCALE LN(X) AT 0 JUMPE BMAG,S82.02; JUMPGE ASF,S82.02; IF P.LN(10) IS 1 COMP,MAKE IT 2 COMP AOS ASF S82.02: JOV .+1 ADD BSF,AMAG; LN(X)+Q.LN(2) (LSH) JOV .+2 JRST .+3 TLC BSF,^O400000; OFLOW MUST BE+; ADJUST SIGN AOS BSGN; OF LSH; INCREMENT MSH ADD BSF,BMAG; ADD LSH(P.LN(10)) JOV .+2 JRST S82.05 TLCE BSF,^O400000; ADJUST SIGN OF LSH AOSA BSGN; OVERFLOW WAS + SOS BSGN; OVERFLOW WAS - S82.05: ADD BSGN,ASF; MSH S82.20: MOVEI BMAG,0; SET FOR + ANS JUMPN BSGN,S82.30 JUMPGE BSF,@S82; MSH=0; EXIT IF LSH GE 0 TLC BMAG,^O400000; LSH<0; SET ANS - MOVNS BSF; COMPLEMENT LSH JRST @S82; EXIT S82.30: JUMPG BSGN,S82.50; MSH NE 0 TLC BMAG,^O400000; MSH <0; SET ANS - MOVNS BSGN; COMPLEMENT MSH MOVNS BSF; COMPLEMENT LSH JUMPL BSF,S82.40; IF LSH WAS+,DECREMENT MSH JRST @S82; AND EXIT S82.40: SOJA BSGN,@S82; LSH>0; DECREMENT MSH S82.50: JUMPGE BSF,@S82; MSH>0; EXIT IF LSH GE0 SOJA BSGN,@S82; DECREMENT MSH AND EXIT SUBTTL P83,P84: SIN/COS ; CALLED BY: ; JSR (P83,P84) ; ERROR: A GE 100 ; NORMAL TAMAG=P83.94 TASGN=P83.95 TASF=P83.96 TBMAG=P83.97 TBSGN=P83.98 TBSF=P83.99 ERR=0; NORM=1; N=BSF; SIGN=BSGN; P83A: RENTRY Q83,1; DATA SWITCH 9 PUTM (B,TB); SAVE B MOVE BMAG,P83; MOVEM BMAG,P84; SET RETURN IN P84 JUMPE AMAG,P83.10; SIN(0)=0 MOVE SIGN,ASGN; SINE: SET N=11, SIGN=SGN HRRZI N,^D11; JRST P84.01; P83.10: PUT (TB,B); NORMAL EXIT P83.11: RETURN (P84,NORM); P83.20: PUT (TB,B); ERROR EXIT RETURN P84,ERR PAGE P84A: RENTRY Q84,1; DATA SWITCH 10 JUMPN AMAG,P84.03; MOVE AMAG,T80.08; COS(0)=1 JRST P83.11; TO EXIT P84.03: PUTM (B,TB); MOVEI N,^D10; COS, SET N=10 MOVEI SIGN,0; COS, SET SGN PLUS P84.01: CAIL ASF,2; JRST P83.20; ERROR, ARG GE 100 P84.02: JUMPG ASF,P84.30; CAIN N,^D10; IF COS, IGNORE CROSSOVER TEST JRST P84.05 CAMG ASF,P84.99; TES AGAINST CROSSOVER JRST P84.60; TO 60 IF LESS P84.05: MOVEI ASGN,0; CROSSOVER LS A LS 10 ASHC AMAG,-4; (AMAG)B39/(10*8)B35 DIV AMAG,T80.08; YB4 JUMPE ASF,P84.07; SF(A)=0 MOVNS ASF; ABS(SF(A)) MOVEI ASGN,0; CLEAR AMAG + 1 ASHC AMAG,-^D32; YB36 DIV AMAG,T80(ASF); YB1=BY36/10*ABS(SF)B35 P84.04: CAMLE AMAG,P84.84; Y VS PI/4 JRST P84.06; GR ASH AMAG,1 ;SCALE Y AT BO JRST P84.50; TO SERIES EVALUATION P84.06: MOVNS AMAG; ADD AMAG,P84.83; PI/2-Y ASH AMAG,1; SCALE AT B0 CAIE N,^D11; SET TO COMPUTE OPPOSITE FUNCTION AOJA N,P84.50; TO SERIES SOJA N,P84.50; TO SERIES P84.07: MOVEI ASGN,0; CLEAR AMAG+1 ASHC AMAG,-^D34; YB38 DIV AMAG,P84.83; (Y)B38/(2PI)B3 P84.08: MOVE AMAG,ASGN; REMAINDER TO YB3 CAMG AMAG,P84.84; YB3 VS (PI)B3 JRST P84.10; MOVNS AMAG; ADD AMAG,P84.83; (2PI)B3-Y(B3) CAIN N,^D11; TLC SIGN,^O400000; CHANGE SIGN IF SINE P84.10: ASH AMAG,1; YB2 CAMG AMAG,P84.84; (Y)B2 VS (PI/2)B2 JRST P84.12; MOVNS AMAG; ADD AMAG,P84.83; (PI-Y)B2 CAIE N,^D11; TLC SIGN,^O400000; CHANGE SIGN IF COS P84.12: ASH AMAG,1; YB1 JRST P84.04; P84.30: IMULI AMAG,^D10; MOVEI ASGN,0; CLEAR AMAG + 1 ASHC AMAG,-7; 10.A.B42 DIV AMAG,T80.08; (10A/10*8)B7 MOVEI ASGN,0; ASHC AMAG,-^D31; YB38 DIV AMAG,P84.83; (Y)B38/(2PI)B3 JRST P84.08; ; EVALUATE SERIES ; YB0 IN AMAG ; ASGN, ASF, BMAG AVAILABLE ; SIGN IN BSG ; N IN BSF P84.50: MOVE ASGN,AMAG; Y MUL ASGN,AMAG; Z IN ASGN TLNE ASF,^O200000; ROUND AOS ASGN; MOVNS ASGN; -Z IN ASGN MOVE ASF,T1(N); S=1/N P84.51: SUBI N,2; N=N-2 MUL ASF,ASGN; S=-S.Z.1/(N.(N+1))+1/N MUL ASF,T2(N); ADD ASF,T1(N); CAILE N,2; JRST P84.51; N GR 2 CAIE N,2; JRST P84.56; N=1 MUL ASF,ASGN; N=2 ADD ASF,P84.90; S=1-Z.S MOVE AMAG,ASF; P84.52: SETZB ASGN,ASF; SET SCALE AND B=0 FOR S75 P84.53: JSR S75 JUMPE AMAG,P83.10; TO EXIT IF 0 MOVE ASGN,SIGN; JRST P83.10; TO EXIT P84.56: MUL AMAG,ASF; S.Y JRST P84.52; P84.60: CAME ASF,P84.99; IF SF LS SPECIAL COMPUTE JRST .+3 CAMLE AMAG,P84.97; SF=; CHECK MAG JRST P84.05; GREATER PUTM A,TA; SAVE A MUL AMAG,AMAG; X*2.10*16 DIV AMAG,[DEC 600000000]; X*2/6 10*8 ASH ASF,1; DOUBLE SF FOR X*2 HRLZI ASGN,^O400000; -X*2/6 MOVE BMAG,T80.08; COMPUTE 1-X*2/6 SETZB BSGN,BSF JADD PUT TA,B; X.(1-X*2/6) JMPY JRST P83.10; TO EXIT P84.83: OCT 311037552421; (2PI)B3=(PI)B2=(PI/2)B1 P84.84: OCT 144417665211; (PI)B3=(PI/2)B2=(PI/4)B1 P84.90: OCT 377777777777; 1-EPSILON OCT 200000000000; 1/2 OCT 125252525253; 1/3 OCT 100000000000; 1/4 OCT 063146314632; 1/5 OCT 052525252525; 1/6 OCT 044444444445; 1/7 OCT 040000000000; 1/8 OCT 034343434344; 1/9 P84.92: OCT 031463146315; 1/10 OCT 027213505643; 1/11 T1=P84.90-1; P84.91: OCT 200000000000; 1/2 OCT 052525252525; 1/6 3.2 OCT 025252525253; 1/12 4.3 OCT 014631463146; 1/20 5.4 OCT 010421042104; 1/30 6.5 OCT 006060606061; 1/42 7.6 OCT 004444444445; 1/56 8.7 OCT 003434343434; 1/72 9.8 OCT 002660266027; 1/90 10.9 T2=P84.91-1; P84.99: DEC -2; CROSSOVER IS AT SUBTTL P85: ARG(A,B) NORM=0 QUAD1=0 QUAD2=1 QUAD3=2 QUAD4=3 P85A: RENTRY Q85,2; DATA SWITCH 11 JRST P85.56 P85.50: RETURN (P85,NORM); P85.56: JUMPN AMAG,P85.01; TO .01 IF X NE 0 JUMPE BMAG,P85.50; ARG(0,0)=0 EXIT MOVE AMAG,P85.95; ARG(0.Y)=PI/2.SGN(Y) MOVEI ASF,0; MOVE ASGN,BSGN; JRST P85.50; EXIT P85.01: JUMPN BMAG,P85.02; TO .02 IF Y NE 0 SETZB ASF,AMAG; ARG(X,0)=0 IF X>0 JUMPE ASGN,P85.50; MOVEI ASGN,0; ARG(X,0)=PI IF X>0 MOVE AMAG,P85.97; JRST P85.50; ; DETERMINE QUADRANT P85.02: XOR ASGN,BSGN; JUMPE ASGN,P85.03; SIGNS ARE SAME - 1 OR 3 ; SIGNS ARE DIFF - 2 OR 4 JUMPE BSGN,.+3; Y POSITIVE - 2 MOVEI BSGN,QUAD4; Y NEGATIVE - 4 JRST P85.04; MOVEI BSGN,QUAD2; JRST P85.04; P85.03: JUMPE BSGN,P85.04; Y POSITIVE - 1 MOVEI BSGN,QUAD3; Y NEGATIVE - 3 ; DETERMINE IF Z < 10*(-5) P85.04: MOVEM ASF,P85.99; SAVE ASF SUB ASF,BSF; CAIGE ASF,6; SKIP IF ABS(Y/X) < 10*(-5) JRST P85.08; MOVEM BSGN,P85.98; SAVE QUADRANT MOVE ASF,BSF; EXCHANGE X AND Y MOVE BSF,P85.99; EXCH AMAG,BMAG; P85.05: SETZB BSGN,ASGN; SET SIGNS JDIV (P85.06); Z=ABS(Y/X) P85.06: MOVE BSGN,P85.98; GET QUADRANT XCT P85.72(BSGN); ARG=M.Z+C XCT P85.73(BSGN); JUMPE BMAG,P85.50; EXIT IF C=0 SETZB BSF,BSGN; JUMPG BMAG,.+3; IF C LS 0, COMPLEMENT HRLZI BSGN,^O400000; AND CHANGE SIGN MOVNS BMAG; JADD P85.07: JRST P85.50; P85.08: MOVNS ASF; CAIGE ASF,6; SKIP IF ABS(X/Y) < 10*(-5) JRST P85.09; MOVE ASF,P85.99; RESTORE ASF ADDI BSGN,^D8; ADJUST QUADRANT MOVEM BSGN,P85.98; SAVE QUADRANT JRST P85.05; ; ABS(Z) GE 10*(-5) P85.09: MOVE ASF,P85.99; RESTORE ASF CAMLE ASF,BSF; JRST P85.20; SF(X) > SF(Y) CAME ASF,BSF; SF(X) LE SF(Y) JRST P85.13; SF(X) L SF(Y) CAMLE AMAG,BMAG; SF(X) = SF(Y) JRST P85.20; X > Y IN MAG CAME AMAG,BMAG; MAG(X) LE MAG(Y) JRST P85.13; X < Y IN MAG ; X = Y IN MAG MOVE AMAG,P85.93; SET A=PI/4 B2 P85.10: XCT P85.70(BSGN); COMPUTE C(Q)+MCQ.A XCT P85.71(BSGN); WHERE Q IS A FCN OF QUADRANT MOVEI BSGN,0; SET SIGN PLUS JUMPGE AMAG,P85.12; MOVN AMAG,AMAG; COMPLEMENT AND CHANGE SIGN TLC BSGN,^O400000; IF NEGATIVE P85.12: MOVEI ASGN,2; BINARY SCALE = 2 MOVEI ASF,0; SET SF=0 FOR S75 JSR S75; CONVERT JUMPE AMAG,P85.50; EXIT IF 0 MOVE ASGN,BSGN; GET SIGN JRST P85.50; ; XY P85.20: EXCH AMAG,BMAG; EXCH ABS(X) AND ABS(Y) EXCH ASF,BSF; JRST P85.14; P8530A: SUB BSF,ASF; DIFF OF PWRS (Y>X) MOVEI ASGN,0; CLEAR LOW ORDER ASHC AMAG,-3; ADD ASGN,BMAG; ASHC AMAG,-1; (XB39 + YB71)/YB35 DIV AMAG,BMAG; X/Y B4 ROUNDED IDIV AMAG,T80(BSF) IDIV ASGN,T80(BSF) ASHC AMAG,4; (X/Y B4)?10*(SFY-SFX) ; ISOLATE IN PI/16 INTERVAL MOVEI BSF,0; I=1 CAMLE AMAG,P85.89(BSF); SKIP IF ISOLATED AOJA BSF,.-1; MOVN BMAG,P85.89-1(BSF); K(I-1) MOVE BSGN,P85.89(BSF); K(I) ADD BMAG,AMAG; Z-K(I-1) SUB BSGN,AMAG; K(I)-Z CAMLE BMAG,BSGN; JRST P85.40; P85.31: MUL AMAG,P85.89-1(BSF); Z.K(J) ASH AMAG,-1; TLO AMAG,^O200000; 1+Z.K(J) B1 MOVEI BSGN,0; DIV BMAG,AMAG; (Z-K(J))/(1+Z.K(J)) B -1 ASH BMAG,-1; WBO MOVE AMAG,P85.90(BSF); THETA(J) MOVN BSGN,BMAG; MUL BSGN,BMAG; Q=-W*2 MOVEI BSF,4; N=4 MOVE ASGN,P85.87; S=1/11 P85.33: MUL ASGN,BSGN ADD ASGN,P85.88(BSF); S.Q+1/(2N+1) SOJGE BSF,P85.33; MUL ASGN,BMAG; BETA=W.S ADD AMAG,ASGN; ALPHA=THETA + BETA ASH AMAG,-1; COULD OFLO IF ROUNDED FIRST AOS AMAG; ASH AMAG,-1; ALPHA(B2), ROUNDED JRST @P85.30; EXIT P85.40: MOVN BMAG,BSGN; -(K(I)-Z) AOJA BSF,P85.31; COMPUTE W(I+1) ; TABLES FOR X > Y P85.70: HRLI BSGN,0; NOOP M=1 MOVNS AMAG; M=-1 HRLI BSGN,0; M=1 MOVNS AMAG; M=-1 P85.71: HRLI BSGN,0; C=0 ADD AMAG,P85.92; C=PI SUB AMAG,P85.92; C=-PI HRLI BSGN,0; C=0 ; TABLES FOR X < Y MOVNS AMAG; M=-1 HRLI BSGN,0; M=1 MOVNS AMAG; M=-1 HRLI BSGN,0; M=1 ADD AMAG,P85.91; C=PI/2 B2 ADD AMAG,P85.91; C=PI/2 B2 SUB AMAG,P85.91; C=-PI/2 B2 SUB AMAG,P85.91;} C=-PI/2 B2 P85.72: HRLZI ASGN,0; M-1 HRLZI ASGN,^O400000; M=-1 HRLZI ASGN,0; M=1 HRLZI ASGN,^O400000; M=-1 P85.73: HRLZI BMAG,0; C=0 MOVE BMAG,P85.97; C=PI MOVN BMAG,P85.97; C=-PI HRLZI BMAG,0; C=0 ; HRLZI ASGN,^O400000; M=-1 HRLZI ASGN,0; M=1 HRLZI ASGN,^O400000; M=-1 HRLZI ASGN,0; M=1 MOVE BMAG,P85.95; C=PI/2 MOVE BMAG,P85.95; C=PI/2 MOVN BMAG,P85.95; C=-PI/2 MOVN BMAG,P85.95; C=-PI/2 P85.90: OCT 0; 0 P85.93: OCT 062207732504; 1/16.PI BO = PI/4 B2 P85.91: OCT 144417665211; 2/16.PI BO = PI/2 B2 OCT 226627617715; 3/16.PI BO P85.92: OCT 311037552421; 4/16.PI BO = PI B2 OCT 0; TAN(0) P85.89: OCT 062727657005; TAN(PI/16) OCT 152023631500; TAN(PI/8) OCT 253033405256; TAN(3.PI/16) P85.88: OCT 377777777777; TAN(PI/4) OCT 125252525253; 1/3 OCT 063146314632; 1/5 OCT 044444444445; 1/7 OCT 034343434344; 1/9 P85.87: OCT 027213505643; 1/11 P85.97: DEC 314159265; 10*8.PI P85.96: DEC 235619449; 10*8.(3PI/4) P85.95: DEC 157079633; 10*8.PI/2 P85.94: DEC 785398163; 10*9.PI/4 SUBTTL ROUTINE P90...A=IP(A) ; CALLED BY: ; JSR P90; ; RETURN NORM=0; P90A: UNPK A JUMPE AMAG,P90.06; EXIT IF A=0 P90.01: JUMPGE ASF,P90.02; TO .02 IF SF GE 0 MOVEI ASGN,0; SET A=0 AND EXIT IF NO INTEGER PART SETZB AMAG,ASF; RETURN (P90,NORM); P90.02: CAIL ASF,^D8; IF SF GE 8 IP(A)=A JRST P90.06; TO EXIT HLRM ASGN,P90.05; SAVE SIGN HRRM ASF,P90.04; SAVE SF (0 LE SF<8) MOVNI ASF,-^D8(ASF); P=8-SF IDIV AMAG,T80(ASF); IMUL AMAG,T80(ASF); A=IP(A/10*P).10*P XCT P90.04 XCT P90.05 P90.06: RETURN (P90,NORM); SUBTTL P91: A=FP(A) ; CALLED BY: ; JSR P91; ; RETURN REM=ASGN; NORM=0; P91A: UNPK A JUMPE AMAG,P91.04; EXIT IF A=0 JUMPL ASF,P91.04; EXIT IF SF<0 CAIGE ASF,^D8; JRST P91.02; MOVEI AMAG,0; SET A=0 AND EXIT P91.05: SETZB ASGN,ASF; JRST P91.04; P91.02: HLRM ASGN,P91.03; 0 LE SF<8,SAVE SIGN HRRM ASF,P91.06; SAVE SF MOVNI ASF,-^D8(ASF); P=8-SF IDIV AMAG,T80(ASF); MAG/10*(8-SF) XCT P91.06 AOS ASF; SF+1 IMUL REM,T80(ASF); MOVE AMAG,REM; R(MAG/10*(8-SF)).10*(SF+1) JUMPE AMAG,P91.05; EXIT IF ZERO XCT P91.03 HRREI ASF,-1; SET SF=-1 NRMLZ ; P91.04: RETURN (P91,NORM); EXIT SUBTTL DIGIT PART......A=DP(A) ;ROUTINE P92 .. DP(A) ;CALLED BY: ; JSR P92; ; RETURN NORM=0; P92A: UNPK A MOVEI ASF,0; RETURN (P92,NORM); SUBTTL EXPONENT PART.......A=XP(A) ; ROUTINE P93...XP(A) ; CALLED BY: ; JSR P93; ; RETURN NORM=0; P93A: JUMPN AMAG,.+3; A NE 0 MOVEI ASGN,0; CLEAR SIGN IF A=0 RETURN P93,NORM; EXIT IF A=0 JUMPGE ASF,P93.02; HRLZI ASGN,^O400000; IF SF<0 SET SIGN - AND MOVN AMAG,ASF; PUT COMPLEMENT OF SF IN MAG JRST P93.04; P93.02: MOVEI ASGN,0; IF SF GE 0, SET + AND MOVE AMAG,ASF; PUT SF IN MAG P93.04:HRRZI ASF,0; ZERO TO SF CAIL AMAG,^D10; IF MAG GE 10 AOJA ASF,P93.06; ADD 1 TO SF; SET P=10*7 IMUL AMAG,T80.08; P=10*8 IF MAG < 10 JRST P93.07; TO EXIT P93.06:IMUL AMAG,T80.07; ASF.10*P TO AMAG P93.07:RETURN (P93,NORM); EXIT SUBTTL SIGN .......A=SGN(A) ; ROUTINE P94...SGN(A) ; CALLED BY: ; JSR P94; ; RETURN NORM=0; P94A: UNPK A JUMPE AMAG,P94.01; TO EXIT IF A=0 MOVE AMAG,T80.08; SET SGN(A)=1.SIGN(A) MOVEI ASF,0; P94.01: RETURN (P94,NORM); SUBTTL T80 TBL OF PWRS OF 10 ENTRY T80; INTERN T80,T80.01,T80.02,T80.03,T80.04,T80.05,T80.06; INTERN T80.07,T80.08,T80.09,T80.10,T80.99; T80: DEC 1; T80.01: DEC 10; T80.02: DEC 100; T80.03: DEC 1000; T80.04: DEC 10000; T80.05: DEC 100000; T80.06: DEC 1000000; T80.07: DEC 10000000; T80.08: DEC 100000000; T80.09: DEC 1000000000; T80.10: DEC 10000000000; T80.99=T80-1; INTERFACE WITH ED SUBTTL ROUTINE S75A: CONVERT AND NORMALIZE ; INPUT: ; RA=X (FRACTION) ; RB=N -3 LE N LE 4 ; RC=EXISTING SF OR ZERO; ; WHERE: X IS SCALED AT BN ; CALLED BY: ; JSR S75 ; RETURN (RA=RB=RC=0 IF X=0) ; OUTPUT: ; RA=X (INTEGER) ; RB=HASH ; RC=SF(X) RA=1 RB=2 RC=3 S75A: JUMPE RA,S75.04; JUMP IF INPUT=0 SOS RC; SET SF=SF-1 HRRM RB,AS; SET SHIFT OF N MUL RA,S75.90; 2.X.10*9...B=35+N XCT AS CAML RA,S75.91; JRST S75.02; MOVEM RC,S75.93; IF LS 2.10*8 IMULI RA,^D10; NORMALIZE--BRING IN ONE MORE DIGIT MULI RB,^D10; ADD RA,RB; MOVE RC,S75.93; SOS RC; ADJUST SF JUMPE RA,S75.04; JUMP IF ANS IS 0 S75.01: CAML RA,S75.91; JRST S75.02; IMULI RA,^D10; CONTINUE NORMALIZE SOJA RC,S75.01; BRING IN ZEROES S75.02: CAMGE RA,S75.92; JRST S75.03; IDIVI RA,^D10; IF > 2.10*9-1 AOJA RC,S75.02; SCALE DOWN S75.03: AOS RA; ROUND ASH RA,-1; JRST 2,@S75; EXIT S75.04: SETZB RB,RC; X=0 JRST 2,@S75; S75.90: DEC 2000000000; 2.10*9 S75.91: DEC 200000000; 2.10*8 S75.92: DEC 1999999999; 2.10*9-1 SUBTTL THE RETURN MACRO DEFINE RETURN (NAME,N) < IFE N-1, < AOS NAME > IFG N-1, < EXCH 0,NAME ADDI 0,N EXCH 0,NAME > JRST 2,@NAME > SUBTTL ROUTINE S76: COMPARE A TO B ;A IS IN REGISTERS EX1 AND N1 ;B IS IN REGISTERS EX2 AND N2 ; THESE ARE LEFT IN-TACT ;EXI CONTAINS EXP, 2'S COMP. IF NEG ;NI(0) CONTAINS SIGN OF NUMBER ;NI(1-35) CONTAINS MAGNITUDE OF NUMBER ;ON EXIT, REGISTER "ANS" WILL CONTAIN ;-1 IF AB ;CALLED BY: ;JSR S76 ;-RETURN ANS=2 EX1=3 N1=1 EX2=6 N2=4 NORM=0; S76A: MOVEI ANS,0; SET FOR A=B JUMPE N1,S76.40; A=0 JUMPE N2,S76.50; B=0 MOVE ANS,N1; XOR ANS,N2; COMPARE SIGNS JUMPL ANS,S76.30 ;TO .30 IF SIGNS DISAGREE MOVEI ANS,0; SIGNS AGREE; SET ANS FOR A=B CAMGE EX1,EX2; COMPARE EXPONENTS SOJA ANS,S76.20; ABS(A)ABS(B), SET ANS=+1 ; EXPONENTS EQUAL CAMGE N1,N2; SOJA ANS,S76.20; CAME N1,N2; AOJA ANS,S76.20; S76.11: RETURN (S76,NORM); S76.30: MOVEI ANS,1; SET ANS FOR A POSITIVE S76.20: JUMPGE N1,S76.11; TO EXIT IF POSITIVE ARGS MOVNS ANS; INVERT ANS IF NEGATIVE ARGS JRST S76.11; S76.40: JUMPE N2,S76.11; EXIT IF B=0 SKIPL N2 SOJA ANS,S76.11; A0 AOJA ANS,S76.11; A>B IF B<0 S76.50: SKIPL N1; B=0,A NE 0 AOJA ANS,S76.11; A>B IF A>0 SOJA ANS,S76.11; A250 CAMGE N2,[DEC -250] JRST S77.02; TO ERROR IF INDEX<-250 S77.06: RETURN (S77,NORM); NORMAL EXIT S77.02: RETURN (S77,ERR1); ERROR EXIT SUBTTL ROUTINE S78: CONVERT JNF TO PART, ;STEP NUMBER ; JNF IN REGS. EX1 AND N1 ; EX1 CONTAINS S.F (2'S COMP.) ; N1(0) CONTAINS SIGN OF NUMBER ; N1(1-35) CONTAINS MAGNITUDE ; CALLED BY: ; JSR S78; ; EXIT 1: ILLEGAL STEP # ; EXIT 2: PART # IN N1 AS AN INTEGER ; STEP # IN N1+1 AS AN INTEGER ; PART # + STEP # = 9 DIGITS ERR=0; ERROR EXIT NORM=1; NORMAL EXIT EX1=3 N1=1 EX2=3 N2=1 S78A: JUMPG N1,S78.04; ERROR IF STEP LE 0 S78.02: RETURN (S78,ERR); S78.04: JUMPL EX1,S78.02; ERROR IF S.F.<0 CAILE EX1,^D8; JRST S78.02; ERROR IF SF>8 MOVNI EX2,-^D8(EX2); P=8-SF IDIV N2,T80(EX2); N/10*P: Q TO EX1; R TO N1 RETURN S78,NORM SUBTTL ROUTINE S79A: TYPE A VALUE ; JNF OF NUMBER IS IN REGISTERS EX1 AND N1 ; EX1 CONTAINS EXP, 2'S COMP ; N1(0) CONTAINS SIGN OF NUMBER ; N1(1-35) CONTAIN, MAGNITUDE ; PTR CONTAINS BYTE PTR FOR NEXT OUTPUT CHAR ; CALLED BY ; JSR S79 ; RETURN - POINTER UPDATED TO LAST CHAR EX1=3 N1=1 PTR=2 PWR=4; SAVED AND RESTORED RADIX 8; MINUS=141; POINT=160; MULT=142; AST=144; OPEN=120; CLOSE=121; DEFINE OUT (CHAR) < MOVEI PTR,CHAR IDPB PTR,S54.99 > S79A: JUMPN N1,S54.01; TO .01 IF NOT ZERO IDPB N1,PTR; OUTPUT ZERO JRST 2,@S79; EXIT S54.01: MOVEM PTR,S54.99; PTR TO STORAGE MOVEI PTR,MINUS; TLZE N1,^O400000; SET NUMBER +; SKIP IF + IDPB PTR,S54.99; OUTPUT MINUS SIGN MOVE PWR,S54.98; SAVE REGISTER MOVEI PWR,^D8; INITIALIZE P TO 8 FOR S54.50 JUMPL EX1,S54.30; TO .30 IF EXPONENT IS NEGATIVE CAMLE EX1,S54.97; TEST FOR MAX EXPONENT JRST S54.20; TO .20 IF EXPONENT > MAXX ; 0 LE EXPONENT LE MAX ; GENERATE (EXPONENT+1) DIGITS S54.02: JSR S54.50; SOJGE EX1,S54.02; JSR S54.55; GET DEC PT AND REMAINING DIGITS ; EXIT S54.10: MOVE PWR,S54.98; RESTORE REGISTER MOVE PTR,S54.99; RESTORE POINTER. JRST 2,@S79; ; EXPONENT MAX? JRST S80.10; YES-UPDATE SUB PTR,EX1; COUNT-EXPONENT ; UPDATE POINTER S80.10: SUB PTR,OFFSET; DECREMENT COUNT BY OFFSET JUMPLE PTR,S80.20; TO EXIT IF COUNT LE 0 EXCH N1,S80.98; SAVE N1 S80.12: MOVEI N1,SPACE CAILE PTR,^D8; MORE THAN EIGHT SPACES? JRST S80.30; YES ADD N1,PTR; NO-GENERATE JWS SPACES IDPB N1,S80.99 EXCH N1,S80.98; RESTORE N1 S80.20: MOVE PTR,S80.99; RESTORE POINTER JSR S79; TO OUTPUT MOVEI N1,^D8; MOVEM N1,S79.01; RESTORE MAX VALUE TO 8 JRST 2,@S80; EXIT S80.30: ADDI N1,^D8; GENERATE JWS 8 SPACES SUBI PTR,^D8; REDUCE SPACE COUNT IDPB N1,S80.99 JRST S80.12; CONTINUE ;CALLED BY: ;JSR S81 ;RETURN ;INPUT PART IN REG 1 ; STEP IN REG 3 ;OUTPUT JNF IN 1 AND 3; 2 IS CLOBBERRED RA=1 RB=2 RC=3 S81A: MOVEI RB,0; CHOOSE P SUCH THAT CAML RA,T80(RB); 10*(P+1)>PART # AOJA RB,.-1; NEW SF =P SOS RB MOVEM RB,S81.98; SAVE SF MOVNI RB,-^D8(RB); 8-SF IMUL RA,T80(RB); PART.10*(8-SF) ADD RA,RC; +STEP MOVE RC,S81.98; RESTORE SF JRST 2,@S81; EXIT SUBTTL ROUTINE S83: TYPE IN FORM - UNDERSCORES ; CALLED BY ; JSR S83 ; ERROR ; NORMAL ; INPUT: ; REGISTER 1 AND 3 JNF OF NUMBER ; REGISTER 2 BYTE POINTER (0 LEVEL) ; REGISTER 4: NUMBER OF WHOLE DIGITS :W ; REGISTER 5: NUMBER OF DECIMAL DIGITS :D ; IF D=0, REGISTER 6 = 0 IF NO DECIMAL POINT ; 1 IF DECIMAL POINT ; OUTPUT: ; RESULT IN STRING (INTERPRETER INTERNAL FORM) ; BYTE POINTER UPDATED IN REGISTER 2 ; REGISTERS 1,3,4,5,6 CLOBBERED A=1 PTR=2 S=3 W=4 D=5 PT=6 ; INTERPRETER INTERNAL FORM RADIX 8 SPACE=170 POINT=160 MINUS=141 DEFINE OUT (CHAR) < MOVEI PTR,CHAR IDPB PTR,S83.99 > S83A: MOVEM PTR,S83.99; SAVE POINTER MOVEM PT, S83.98; DECIMAL POINT INDICATOR SETZM S83.97; STORE SIGN AS 0 OR 1 TLZE A,^O400000; SET SIGN +, SKIP IF + AOS S83.97; STORE SIGN AS 1 JUMPN A,S83.20; TO .20 IF A NE 0 ; A=0 S83.03: JUMPE D,S83.10; TO .10 MOVE PT,W; A = ZERO, IF D=0 MOVEI PTR, SPACE; JSR SR1; OUTPUT W SPACES OUT POINT; OUTPUT DEC PT MOVEI PTR,0; MOVE PT,D; JSR SR1; OUTPUT D ZEROES S83.05: MOVE PTR,S83.99; RESTORE PTR AOS S83; NORMAL RETURN JRST 2,@S83; S83.10: MOVE PT,W ;A=0, D=0 SOS PT MOVEI PTR,SPACE JSR SR1; OUTPUT W-1 SPACES OUT 0; OUTPUT A ZERO SKIPN S83.98; SKIP IF DEC POINT REQUIRED JRST S83.05; EXIT OUT POINT; OUTPUT POINT JRST S83.05; EXIT ; A NE 0 S83.20: MOVEI PTR,2; COMPUTE P = D+S+2 ADD PTR,D ADD PTR,S CAILE PTR,^D9; JRST S83.25; IF P>9, NO ROUNDING CAIGE PTR,1; JRST S83.03; IF P<1, ANSWER IS ZERO ; ROUND MOVNI PTR,-^D9(PTR); 9-P ADD A,S83.80(PTR); A+5.10*(9-P) CAML A,T80.09; CARRY PROPAGATED? JRST S83.75 ;YES S83.25: MOVEI PTR,^D8; NO MOVEM PTR,S83.96; P=8 JUMPGE S,S83.45 ;IF SF >0, OUTPUT WHOLE DIGITS MOVNS S; ABS(S) TO S CAMLE S,D; OUTPUT ZERO IF LEAD 0'S = D JRST S83.03; MOVE PT,W MOVEI PTR,SPACE SKIPN S83.97; MINUS SIGN JRST S83.40; NO JUMPG W,S83.30; YES - JUMP IF THERE'S A WHOLE # EEXIT: MOVE PTR,S83.99; ERROR EXIT IF NO ROOM JRST 2,@S83; S83.30: SOS PT JSR SR1; OUTPUT W-1 SPACES OUT MINUS S83.35: OUT POINT MOVE PT,S SOS PT SUB D,PT; D=D-(ABS(SF)-1) MOVEI PTR,0 JSR SR1; OUTPUT (ABS(SF)-1) ZEROES JRST S83.57; TO OUTPUT DEC. DIGITS S83.40: JSR SR1; OUTPUT W SPACES JRST S83.35; TO OUTPUT DEC. POINT ; SF >0 S83.45: MOVEM S,S83.95; AOS S83.95; I=S+1 SKIPE S83.97; AOS S83.95; INCREMENT I IF MINUS SIGN CAMGE W,S83.95 JRST EEXIT; TO ERROR EXIT IF FIELD SMALL SUB W,S83.95; W-I MOVE PT,W MOVE W,S AOS W; W=S+1 MOVEI PTR,SPACE JSR SR1; OUTPUT W-1 SPACES SKIPN S83.97; OUTPUT A MINUS IF NECESSARY JRST S83.47; OUT MINUS S83.47: JUMPE W,S83.50 SKIPGE S83.96; MORE DIGITS JRST S83.49; ZEROES MOVE PTR,S83.96; P IDIV A,T80(PTR) ;X/10*P EXCH A,PTR; PTR=QUOT; A=REMAINDER SOS S83.96; P=P-1 IDPB PTR,S83.99; OUTPUT NUMBER SOJA W,S83.47; DECREMENT W AND LOOP S83.49: OUT 0 SOJA W,S83.47; S83.50: JUMPN D,S83.55; SKIPN S83.98; D=0; SKIP IF DEC. PT JRST S83.05; EXIT OUT POINT JRST S83.05; EXIT ; DECIMAL DIGITS TO OUTPUT S83.55: OUT POINT S83.57: MOVE W,D; NUMBER OF DECIMAL DIGITS TO W MOVEI D,0; CLEAR D AND DEC PT INDIC. SETZM S83.98; JRST S83.47; TO OUTPUT ; CARRY PROPAGATED FROM ROUND S83.75: IDIVI A,^D10; A/10 AOJA S,S83.25; SF+1 ; PTR IN S83.99 ; CHARACTER IN PTR ; K IN PT SR1A:SR1.1: JUMPLE PT,@SR1; EXIT IF K LE 0 IDPB PTR,S83.99; SOJA PT,SR1.1; S83.80: DEC 5 DEC 50 DEC 500 DEC 5000 DEC 50000 DEC 500000 DEC 5000000 DEC 50000000 DEC 500000000 SUBTTL ROUTINE S84: TYPE IN FORM (PERIODS) ; CALLED BY : ; JSR S84 ; ERROR ; NORMAL ; INPUT: ; 1 AND 3: JNF ; 2: BYTE PTR (0 LEVEL) ; 4: N=NUMBER OF PERIODS ; OUTPUT: ; 2: UPDATED POINTER ; 1,3,4: CLOBBERRED ; CONVERTED NUMBER IN STRING, INTERP. FORM A=1 PTR=2 S=3 N=4 RADIX 8 MINUS=141 POINT=160 SPACE=170 DEFINE OUT (N) < MOVEI PTR, N IDPB PTR, S84.99 > S84A: CAIGE N,7 JRST 2,@S84; ERROR IF N<7 MOVEM PTR,S84.99; SAVE POINTER JUMPN A,S84.10 OUT SPACE; A=0 OUT 0 SUBI N,2 MOVEI PTR,SPACE; OUTPUT N-2 SPACES IDPB PTR,S84.99 SOJG N,.-1 MOVE PTR,S84.99; RESTORE POINTER S84.05: AOS S84; BUMP FOR NORMAL JRST 2,@S84; S84.10: SETZM S84.98; SET 0 OR 1 AS SIGN TLZE A,^O400000; IS + OR - AOS S84.98; CAIL N,^D14; IF N GE 14 NO ROUND JRST S84.12; N=14; NO ROUNDING MOVEI PTR,^D13; SUB PTR,N; 13-N ADD A,S84.80(PTR); ROUND: A=A+5.10*(13-N) CAMGE A,T80.09; JRST S84.12 IDIVI A,^D10; ADJUST FOR OFLOW AOS S S84.12: SKIPN S84.98; SKIP IF MINUS NEEDED JRST S84.14; OUT MINUS JRST S84.15 S84.14: OUT SPACE S84.15: MOVEM S,P84.97; SAVE SF MOVEI S,^D8; SET P=8 IDIV A,T80(S); A/10*P EXCH A,PTR ;PTR=QUOT. A=REM IDPB PTR,S84.99; OUTPUT X. OUT POINT SUBI N,6; N=N-6 (S,X.,S,XX) S84.20: SOS S; P=P-1 IDIV A,T80(S) EXCH A,PTR; PTR=Q(A/10*P); A=REMAINDER IDPB PTR,S84.99; OUTPUT DECIMAL DIGITS SOJG N,S84.20; LOOP ON N MOVE A,P84.97; SCALE FACTOR JUMPGE A,S84.25 MOVNS A; NEGATIVE SF OUT MINUS JRST S84.30 S84.25: OUT SPACE S84.30: IDIVI A,^D10; TENS IN A; UNITS IN PTR IDPB A,S84.99; OUTPUT SF IDPB PTR,S84.99; MOVE PTR,S84.99; RESTORE POINTER JRST S84.05; EXIT S84.80: DEC 5 DEC 50 DEC 500 DEC 5000 DEC 50000 DEC 500000 DEC 5000000 SUBTTL S86A:UNPACK 2 S86A: UNPK B JSR S87 JRST 2,@S86 SUBTTL S87A:UNPACK 1 S87A: EXTERN T7.9 AOS T7.9; ED'S ARITH COUNTER UNPK A JRST 2,@S87 END