Trailing-Edge
-
PDP-10 Archives
-
scratch
-
10,7/unscsp/aid/arith.mac
There are 20 other files named arith.mac in the archive. Click here to see a list.
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
; 1<ABS(B) LE 29
; ~BMAG CONTAINS INTEGRAL ABS(B)
P79.70: MOVE YMAG,T80.08; Y=1:MAG=10*8
SETZB YSF,YSGN; SF=SGN=0
MOVE TBMAG,BMAG; SAVE MAG(B) FOR LATER USE
JUMPL BSGN,P79.80; COMPUTE 1/A IF B<0
P79.72: PUTM (A,TA); SAVE A
TRNN TBMAG,1; SKIP IF NEXT PWR(2) IS PRERENT
JRST P79.75;
PUT (Y,B);
JMPY
PUT A,Y
ASH TBMAG,-1; B=IP(B/2)
JUMPE TBMAG,P79.01; DONE IF B=0
PUT (TA,A); RESTORE A
P79.74: PUT (A,B);
JMPY
JRST P79.72; LOOP
P79.75: ASH TBMAG,-1; B=IP(B/2)
JRST P79.74; TO SQUARE A
; B<0; SET A=1/A
P79.80: PUT A,B
PUT (Y,A); Y=1
JDIV (P79.03); A=1/A
JRST P79.72;
P79.94: DEC 230258509; 10*8.LN(10)
P79.95: OCT 777777777777; -1
P79.96: DEC 500000000; 1/2 . 10*9
SUBTTL P80A: A=SQRT(A)
; CALLED BY:
; JSR P80;
; ERROR: A<0
; NORMAL
ERR=0;
NORM=1;
ROOT=AMAG;
ARG=RF;
DEL=RD;
TBMAG=P80.97
TBSGN=P80.98
TBSF=P80.99
P80A: RENTRY Q80,1; DATA SWITCH 6
JUMPN AMAG,P80.11; EXIT IF A = 0
P80.10: RETURN (P80,NORM);
P80.11: JUMPE ASGN,P80.14;
RETURN (P80,ERR); ERROR EXIT: A<0
P80.14: PUTM (B,TB); SAVE B
MOVE ARG,AMAG; A TO ARG
TRNN ASF,1; SKIP IF SF IS ODD
JRST P80.50; SF IS EVEN
IMULI ARG,^D10; 10.A TO A
MOVE ROOT,T80.09; 10*9 TO GUESS
P80.01: ASH ASF,-1; SF=SF/2
P80.02: MOVE DEL,ARG; BEGIN LOOP
MUL DEL,T80.08; 10*8.A
DIV DEL,ROOT;
SUBM ROOT,DEL; D=X-10*8.A/X
ASH ROOT,1;
SUB ROOT,DEL;
ASH ROOT,-1; X=(2.X-D)/2
CAIL DEL,^D10000; SKIP IF D<10*4
JRST P80.02; ITERATE
MOVE DEL,ARG;
MUL DEL,T80.08;
DIV DEL,ROOT;
SUB DEL,ROOT;
; ROUND IF 10*8A/X-X>1
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;
; X<Y
P85.13: ADDI BSGN,^D8; ADJUST QUADRANT FOR X<Y
P85.14: MOVEM BSGN,P85.98; STORE QUADRANT TEMPORARILY
P85.15: JSR P85.30; OBTAIN ARCTAN (Z), B2, IN AMAG
MOVE BSGN,P85.98; GET QUADRANT INDEX
JRST P85.10;
; X>Y
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 A<B
;0 IF A=B
;1 IF A>B
;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
CAME EX1,EX2;
AOJA 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; A<B IF B>0
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; A<B IF A<0
SUBTTL ROUTINE S77: CHECK INDEX VALUE
; JNF OF INDEX VALUE IS IN REGISTERS EX1 AND N1
; EX1 CONTAINS EXP., 2'S COMP. IF NEG.
; N1(0) CONTAINS SIGN
; N1(1-35) CONTAINS MAGNITUDE
; CALLING SEQUENCE:
; JSR S77;
; EXIT 1: ABS(INDEX) GE 250 OR NOT INTEGRAL
; EXIT 2: INDEX VALUE IN N1 AS AN INTEGER,
; NEG. IS 2'S COMP.
; NOTE EX1,EX1+1,AND N1 ARE CLOBBERRED
ERR1=0;
NORM=1;
EX1=3
N1=1
EX2=3
N2=1
S77A:
S77.10: JUMPE N1,S77.06; EXIT IF INDEX=O
JUMPL EX1,S77.02; FRACTION NOT 0 IF EX<0
CAIL EX1,3
JRST S77.02; TO ERROR IF ABS(INDEX) GE 1000
TLZE N1,^O400000; SET N +, SKIP IF +
MOVNS N1; COMPLEMENT IF <0
MOVNI EX2,-^D8(EX2); P=8-EX
IDIV N2,T80(EX2); N1/10*P
JUMPN N2+1,S77.02; TO ERR IF FRACT NE 0
CAILE N2,^D250
JRST S77.02; TO ERROR IF INDEX>250
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 <MIN OR <MAX
S54.20: JSR S54.50; GENERATE FIRST DIGIT
JSR S54.55; DECIMAL POINT AND REMAINING DIGITS
OUT (MULT);
OUT (1); .10*
OUT (0);
OUT (AST);
JUMPL EX1,S54.25; TO .25 IF EXPONENT IS NEGATIVE
; EXPONENT POSITIVE
JSR S54.60; OUTPUT EXPONENT DIGITS
JRST S54.10; TO EXIT
; EXPONENT NEGATIVE
S54.25: MOVNS EX1; COMPLEMENT
OUT (OPEN);
OUT (MINUS);
JSR S54.60; OUTPUT EXPONENT DIGITS
OUT (CLOSE)
JRST S54.10; TO EXIT
; EXPONENT <0
S54.30: CAMGE EX1,S54.96;
JRST S54.20; O .20 IF EXP<MIN
OUT (POINT);
S54.32: AOJE EX1,S54.34; GENERATE (EXPONENT+1) ZEROES
OUT (0);
JRST S54.32;
S54.34: JSR S54.50; GENERATE DIGITS
JUMPN N1,S54.34; UNTIL EXHAUSTED
JRST S54.10; TO EXIT
S5450A: IDIV N1,T80(PWR); N/10*P (P=8(-1)?)
EXCH N1,PTR; PTR=QUOT; N1=REMAINDER
IDPB PTR,S54.99; PLACE IN OUTPUT BUFFER
SOJA PWR,@S54.50; DECREMENT P AND EXIT
; GENERATE DECIMAL POINT AND REMAINING
S5455A: JUMPE N1,@S54.55; EXIT IF NO MORE DIGITS
OUT (POINT);
S54.56: JSR S54.50; GENERATE ANOTHER DIGIT
JUMPN N1,S54.56; CONTINUE IF MORE DIGITS
JRST @S54.55; EXIT IF NO MORE DIGITS
; OUTPUT EXPONENT DIGITS
INTERN S5460A
S5460A: IDIVI EX1,^D10; TENS TO EX1; UNITS TO PWR
JUMPE EX1,S54.62; TO .62 IF TENS DIGIT IS ZERO
IDPB EX1,S54.99; OUTPUT TENS DIGIT
S54.62: IDPB PWR,S54.99; OUTPUT UNITS DIGIT
JRST @S54.60;
; PARAMETERS FOR EXP RANGE
; (FIXED POINT)
S54.96: DEC -3; MIN
SYN S54.96,S79.02;
SUBTTL ROUTINE S80:
;TYPE A VALUE WITH LINED UP DECIMAL POINTS
; JNF OF NUMBER IS IN REGISTERS EX1 AND N1
; EX1 CONTAINS EXP, 2'S COMP
; N1(0) CONTAINS SIGN OF NUMBER
; N1(1-35) CONTAINS MAGNITUDE
; PTR CONTAINS BYTE PTR FOR NEXT OUTPUT CHAR
; REG."OFFSET" CONTAINS OFFSET OF =
; CALLED BY
; JSR S80
; RETURN - POINTER UPDATED TO LAST CHAR
; NOTE S80 USES S79
SPACE=^O167; JOES SPACE-1
EX1=3
N1=1
PTR=2
OFFSET=4
S80A: MOVEM PTR,S80.99; SAVE POINTER
MOVEI PTR,5; SET MAX VALUE OF EXPONENT
MOVEM PTR,S79.01; STORE IN S79
AOS PTR; DEC PT TO BE (MAX+4) OVER
TLNN N1,^O400000; SKIP IF NEG.
AOS PTR; ADD TO COUNT IF POSITIVE
JUMPE N1,S80.10; TO UPDATE IF ZERO
CAMGE EX1,S79.02; EXPONENT <MIN?
JRST S80.10; YES-UPDATE
CAIGE EX1,0; IF FIXED POINT AND NO WHOLE DIGIT
AOJA PTR,S80.10; ADD ONE TO COUNT AND UPDATE
CAMLE EX1,S79.01; 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