Google
 

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