Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

TITLE BIGNUM ARITHMETIC

;AC DEFINITIONS
NIL=0
A=1
B=2
C=3
T=6
TT=7
T10=10
FF=16
AR1=4
F=15
P=14
D=12
S=11
AR2A=5
R=13
SP=17

INUMIN=377777
INUM0=577777
SIGN=400000
MINSGN==10

INTERNAL BIGINI

EXTERNAL CONS,FWCONS,ACONS,NCONS,XCONS,VBASE,VNOPOINT,LAST,NUMVAL
EXTERNAL POSNUM,NEGNUM,NUM1,CTY,EVBIG,REVERSE,BPR
EXTERNAL TRUE,FALSE,NUMV2,FIXNUM,FLONUM,FIX1A,LENGTH,MINUSP
EXTERNAL BPR,NUM3,EVBIG,NUMV4,OPOV,NUMV3,NUMBP2,FIX2,OPR,FLOOV
PAGE
;POWER OF TEN
PWR10:	MOVEM B,BASEX#
	MOVE C,B
	IMUL B,B	;BASE^2
	IMUL B,B	;BASE^4
	IMUL B,C	;BASE^5
	IMUL B,B	;BASE^TEN
	MOVEM B,BASE10#
	POPJ P,

B0CONS:	MOVEI A,0
BNCONS:	MOVEI B,0
BCONS:	PUSHJ P,FWCONS
	JRST CONS

QCONS=ACONS-1
PAGE
;INITIALIZE THE BIGNUM SYSTEM BY CHANGING MAGIC LOCATIONS IN LISP
BIGINI:	MOVE A,[JRST BPRINT]
	MOVEM A,BPR		;PRINT
	HRRI A,BIGEV	
	MOVEM A,EVBIG		;EVAL
	HRRI A,NUMVB
	MOVEM A,NUMV4		;NUMVAL
	HRRI A,BIGDIS	
	MOVEM A,NUMV3		;BIGNUM OPS
	HRRI A,BIGNP
	MOVEM A,NUMBP2		;NUMBERP
	HRRI A,RDBNM
	HRRM A,NUM3		;READ
	HRRI A,FIXOVL
	HRRM A,OPOV		;OVERFLOW
	HRRI A,BFIX
	HRRM A,FIX2		;FIX
	JRST FALSE
PAGE
;BIGNUM PRINT
;BPR IN LISP IS JRST BPRINT
BPRINT:	CAIN B,POSNUM
	JRST BPRIN2
	CAIE B,NEGNUM
	JRST BPR+1
	XCT "-",CTY
BPRIN2:	PUSHJ P,COPY
	PUSHJ P,BPRI
	POPJ P,

BPRI:	MOVE B,VBASE
	SUBI B,INUM0
	PUSHJ P,PWR10
	PUSHJ P,BPRJ
	SKIPE A,VNOPOINT
	POPJ P,
	MOVE A,BASEX
	CAIE A,12
	POPJ P,
	MOVEI A,"."
	JRST (R)	;PARTICULAR TYO

BPRJ:	MOVE B,BASE10
	PUSHJ P,Q1
	JUMPE B,BPR2	;ZERO QUOTIENT
	PUSH P,A	;REMAINDER
	MOVE A,B	;QUOTIENT
	PUSHJ P,BPRJ
	POP P,A		;REMAINDER

BPR1:	MOVEI C,12	;PRINT TEN DIGITS
	SOJL C,CPOPJ
	IDIV A,BASEX
	HRLM B,(P)
	PUSHJ P,BPR1+1
	JRST FP7A1	;PARTICULAR TYO FOR DIGIT

;IGNORE LEADING ZERO DIGITS FOR FIRST WORD
BPR2:	JUMPE A,CPOPJ
	IDIV A,BASEX
	HRLM B,(P)
	PUSHJ P,BPR2
FP7A1:	HLRE A,(P)
	ADDI A,"0"
	JRST (R)	;PARTICULAR TYO FOR DIGIT

PAGE
;DIVIDES BIGNUM IN A BY INTEGER IN B
;DESTROYS ORIGINAL BIGNUM
;RETURNS REMAINDER IN A, QUOTIENT IN B
Q1:	MOVEM B,Y#
	PUSH P,A
	HRRZ A,(A)
	JUMPE A,Q1A
	PUSHJ P,Q1+1
	POP P,C
	HRRM B,(C)
	HLRZ T,(C)
	MOVE B,(T)
	DIV A,Y
Q1B:	MOVEM A,(T)	;REPLACE OLD DIGIT
	MOVE A,B
	MOVE B,C
	POPJ P,

Q1A:	POP P,C
	HLRZ T,(C)
	MOVE A,(T)
	IDIV A,Y
	JUMPN A,Q1B	;NON-ZERO QUOTIENT - KEEP IT
	HRRZM FF,(T)	;RECLAIM FULL WORD
	MOVE FF,T
	HRRZM F,(C)	;RECLAIM FREE WORD
	HRRZ F,C
	MOVEI C,0
	JRST Q1B+1
PAGE
;BIGNUM READ
;NUM3 IN LISP HAS JFCL 10,RDBNM
RDBNM:	PUSH P,[NIL]	;INITIAL VALUE OF BIGNUM
	MOVSI C,700
	HRRI C,(SP)	;BYPE POINTER TO SPEC PDL
	MOVEM T,TSAV#
	MOVEM C,RDPTR#
	HRRZ B,NUM1	;BASE OF NUMBER
	PUSHJ P,PWR10

RDNM1:	MOVEI C,12	;TEN DIGITS AT A TIME
	MOVEI A,0
	ILDB B,RDPTR
	JUMPE B,RDNM2	;END OF BIGNUM
	IMUL A,BASEX
	ADDI A,-"0"(B)
	SOJG C,.-4
	MOVE B,BASE10
	PUSHJ P,RDSUB
	JRST RDNM1

RDNM2:	CAIN C,12	;NO DIGITS IN LAST SUPERDIGIT
	JRST RDNM3
	HRREI C,-12(C)	;NUMBER OF DIGITS IN LAST
	MOVEI B,1
	IMUL B,BASEX
	AOJL C,.-1	;COMPUTE BASEX^(NUMBER OF DIGITS)
	PUSHJ P,RDSUB
RDNM3:	MOVEI B,POSNUM
	MOVE T,TSAV
	TLNE T,MINSGN	;SIGN OF BIGNUM
	MOVEI B,NEGNUM
	POP P,A
	SUB P,[XWD 1,1]
	JRST QCONS

RDSUB:	MOVE C,-1(P)
	PUSHJ P,BTIME1	;BIGNUM(C)*INT(B)+INT(A)
	MOVEM A,-1(P)
	POPJ P,
PAGE
BTIME0:	PUSH P,B
	PUSHJ P,COPY
	MOVE C,A
	POP P,B
	MOVEI A,0

;BIG(C)*INT(B)+INT(A) 
BTIME1:	JUMPE C,BNCONS	;END OF BIGNUM
	MOVEM B,MULR#	;MULTIPLIER
	PUSH P,C	;BIGNUM
BT1B:	MOVEM A,CARRY#
	MOVS T,(C)
	MOVE A,(T)
	MUL A,MULR
	ADD B,CARRY
	TLZE B,SIGN
	ADDI A,1
BT1E:	MOVEM B,(T)	;STORE LOW ORDER PRODUCT+CARRY IN BIGNUM
	HLRZS T		;(CDR BIGNUM)
	JUMPE T,BT1C	;END OF BIGNUM
	MOVE C,T
	JRST BT1B

BT1C:	JUMPE A,POPAJ	;NO HIGH ORDER PART 
	PUSHJ P,BNCONS	;CONSES FOR REMAINING HIGH ORDER PART
	HRRM A,(C)	;RPLACD END OF BIGNUM
POPAJ:	POP P,A
CPOPJ:	POPJ P,
PAGE
;BIGNUM COPY
COPY:	JUMPE A,CPOPJ
	HLRZ B,(A)
	PUSH P,(B)
	HRRZ A,(A)
	PUSHJ P,COPY
	MOVE B,A
	POP P,A
	JRST BCONS


;BIGNUM RECLAIM
RECLAIM:	
	CAILE A,INUMIN
	POPJ P,
	EXCH A,F
	EXCH A,(F)
	HRRZS A
	EXCH A,F
	EXCH A,(F)
	HLRZ B,A	;TYPE
	HRRZS A
	CAIE B,POSNUM
	CAIN B,NEGNUM
	JRST UNCONS
	POPJ P,

;BIGNUM UNCONS
UNCONS:
	JUMPE A,CPOPJ
	HLRZ B,(A)
	MOVEM FF,(B)
	MOVE FF,B
	EXCH A,F
	EXCH A,(F)
	HRRZS A
	JRST UNCONS

;EVBIG IN LISP HAS JRST BIGEV
BIGEV:	CAIE TT,POSNUM
	CAIN TT,NEGNUM
	POPJ P,
	HRRZ AR1,(AR1)
	JRST EVBIG+1
PAGE
;BIGNUM MINUSP
MINSP2:	CAIN B,POSNUM
	JRST FALSE
	JRST TRUE

;BIGNUM MINUS
MINS2:	CAIN B,POSNUM
	SKIPA B,[NEGNUM]
ABS2:	MOVEI B,POSNUM	;BIGNUM ABS
	JRST QCONS

;COMPARE TWO BIGNUMS A<B
BCMPR:	PUSHJ P,BDIF
	PUSH P,A
	PUSHJ P,MINUSP
	EXCH A,(P)
	PUSHJ P,RECLAIM
	JRST POPAJ

BEQUAL:	PUSHJ P,BDIF
	POP P,C
	CAIN A,INUM0
	JRST TRUE
	MOVE P,C
	PUSHJ P,RECLAIM
	JRST FALSE
PAGE
;DIFFERENCE OF TWO BIGNUMS
BDIF:	PUSHJ P,COMPSN	;COMPLEMENT SIGN OF BIGNUM IN B
;SUM OF TWO BIGNUMS
;BIGNUMS IN A AND B; SIGN(A) IN T, SIGN(B) IN TT
BPLUS:	PUSH P,B
	PUSHJ P,COPY
	EXCH A,(P)
	PUSHJ P,COPY
	POP P,C
	MOVE B,A
	MOVEI A,0
	CAME T,TT
	JRST BDIF1	;SIGNS DIFFERENT
	PUSH P,T	;SIGN OF RESULT
	PUSHJ P,BADD
	POP P,B
	JRST QCONS

BDIF1:	CAIN TT,POSNUM
	EXCH B,C
	PUSHJ P,BSUB	;POSNUM IN C, NEGNUM IN B
	JUMPL B,BDIF3
	PUSHJ P,SUPRSS
	MOVEI B,POSNUM
	JRST MAKBIG

BDIF3:	PUSHJ P,COMPLM
	MOVEI B,NEGNUM
	JRST MAKBIG

BSUB:	MOVNI TT,1
	MOVSI T,(SUB TT,(B))
	JRST BAS

BADD:	MOVEI TT,1
	MOVSI T,(ADD TT,(B))
PAGE
;CRY(A)(+ OR -) BIG(B) + BIG(C)  A, SIGN  B.
;DESTROYS BOTH BIGNUMS

BAS:	HRRM TT,BCRY
	PUSH P,B
BP2A:	HRRM B,BTMP
	MOVS B,(B)
	HLRZ TT,(C)
	EXCH TT,FF
	EXCH TT,(FF)	;RECLAIM FULL WORD
	EXCH C,F
	EXCH C,(F)	;RECLAIM FREE WORD
	ADD TT,A
	XCT T		;BIG(C) (+ OR -) BIG (B)
	MOVEI A,0
	TLZE TT,SIGN	;TURN OFF HIGH BIT
BCRY:	HRREI A,.	;SET CARRY IF OVERFLOW OR NEGATIVE
BP2B:	MOVEM TT,(B)
	HLRZS B
	HRRZS C
	JUMPE B,BP2F	;END OF B
	JUMPN C,BP2A
	JRST BP2D	;FINISH WITH CARRY (+ OR -) BIG(B)

BP2F:	JUMPE C,BP2H	;END OF C ALSO
	EXCH B,C
	HRRM B,@BTMP	;RPLACD END OF BIG(B) WITH REST OF C
	MOVSI T,(ADD TT,(B))	;FINISH WITH BIG(C) + CARRY
BP2D:	HRRM B,BTMP
	MOVS B,(B)
	MOVE TT,A
	XCT T		;CARRY (+ OR -) INTEGER
	JUMPL TT,BP2K
	MOVEM TT,(B)
	CAME T,[SUB TT,(B)]
	JRST POSXIT	;CAN QUIT NOW
	MOVEI A,0	;TURN OFF CARRY
	JRST BP2L	;CONTINUE TO NEGATE

BP2K:	HRRE A,BCRY
	TLZ TT,SIGN	;MAKE HIGH BIT ZERO
	MOVEM TT,(B)
BP2L:	HLRZS B
	JUMPN B,BP2D
BP2H:	JUMPLE A,XIT	;NO CARRY
	PUSHJ P,BNCONS
BTMP:	HRRM A,.	;RPLACD END OF BIGNUM WITH CARRY
POSXIT:	MOVEI B,0	;SIGN POSITIVE
	JRST POPAJ

XIT:	MOVE B,A	;SIGN IN B
	JRST POPAJ
PAGE
;SUPPRESS LEADING ZEROS FROM BIGNUM
SUPRSS:	SKIPA C,[JRST COMPL7]
;COMPLEMENT BIGNUM  (2^35 COMPLEMENT)
COMPLM:	MOVSI C,(SUBM T,(B))
	JUMPE A,CPOPJ
	PUSH P,A
	HRLZI T,SIGN
	MOVEI TT,0
COMPL4:	MOVS B,(A)
	SKIPN (B)
	JUMPE TT,COMPL3
	XCT C
	HRLOI T,SIGN-1
COMPL7:	SKIPE (B)
	MOVEM A,TT
COMPL3:	HLRZ A,B
	JUMPN A,COMPL4	;CONTINUE
	JUMPE TT,COMPL5	;ALL ZEROS
	HRRZ A,(TT)
	HLLZS (TT)	;RPLACD HIGH ORDER NON-ZERO WITH NIL
COMPL6:	PUSHJ P,UNCONS	;UNCONS LEADING ZEROS
	JRST POPAJ

COMPL5:	EXCH A,(P)
	JRST COMPL6

;SIGN(TT)SIGN(T)  TT
MQSIGN:	CAIN T,POSNUM
	JRST CPOPJ
;-SIGN(TT)  TT
COMPSN:	CAIN TT,POSNUM
	SKIPA TT,[NEGNUM]
	MOVEI TT,POSNUM
	POPJ P,
PAGE
;BIGNUM MULTIPLY
;BIG (A) * BIG (B)  A, SIGNS IN T,TT
BTIMES:	PUSHJ P,MQSIGN
	PUSH P,TT	;SAVE SIGN OF RESULT
	PUSHJ P,BMUL
	POP P,B
	JRST MAKBIG

;0(P) IS PARTIAL RESULT
;-1(P) IS REMAINING REVERSED MULTIPLIER
;-2(P) IS MULTIPLICAND

BMUL:	PUSH P,B
	PUSHJ P,REVERSE
	PUSH P,A
	MOVEI A,0
	PUSH P,A
BTLOOP:	SKIPN C,-1(P)
	JRST BTEND	;END OF MULTIPLIER
	JUMPE A,BTLP2	;FIRST TIME
	MOVE B,A
	PUSHJ P,FWCONS-1
	PUSHJ P,CONS	;INCREASE LENGTH OF PRODUCT
BTLP2:	MOVEM A,(P)
	MOVE A,-2(P)
	PUSHJ P,COPY
	MOVS B,(C)	;NEXT MULTIPLIER DIGIT
	MOVE C,A
	HLRZM B,-1(P)
	MOVE B,(B)
	MOVEI A,0
	PUSHJ P,BTIME1
	MOVE C,(P)
	JUMPE C,BTLOOP	;NO ADD NEEDED ON FIRST TIME
	MOVE B,A
	MOVEI A,0
	PUSHJ P,BADD
	JRST BTLOOP

BTEND:	SUB P,[XWD 3,3]
	JRST SUPRSS

PAGE
;EXTENSIONS OF INTERPRETER ROUTINES AND TESTS

;ADDITION TO NUMVAL. NUMV4 IN LISP CHANGED TO JRST NUMVB
NUMVB:	CAIE B,POSNUM
	CAIN B,NEGNUM
	JRST NUMVD2
	MOVE A,AR1
	JRST NUMV2	;PRINT ERROR MESSAGE

NUMVD2:	POP P,C		;ADDRESS OF (PUSHJ P,NUMVAL) +1
	HLRZ C,(C)
	CAIN C,(JUMPN A,)	;ZEROP
	JRST FALSE
	CAIN C,(JUMPGE A,)	;MINUSP
	JRST MINSP2
	CAIN C,(MOVNS)		;MINUS
	JRST MINS2
	CAIN C,(MOVMS)		;ABS
	JRST ABS2
	CAIN C,(CAIE B,)	;FIX
	JRST POPAJ
	HALT			;TEMPORARY
;EXTENSION TO NUMBERP.  NUMBRP4 IN LISP CHANGED TO JRST BIGNP
BIGNP:	CAIE A,POSNUM
	CAIN A,NEGNUM
	JRST TRUE
	JRST FALSE
PAGE
;EXTENSION TO OP.  OPOV IN LISP CHANGED TO JFCL 10,FIXOVL
FIXOVL:	HLRZ C,(C)
	CAIN C,(IMUL A,)
	JRST REMUL	;TIMES OVERFLOWED. RECOMPUTE
	TLC A,SIGN	;ALL OTHER CASES JUST OVERFLOWED 1 BIT
	MOVM B,A
	MOVE TT,A
	MOVEI A,1
	PUSHJ P,MKBG
	JRST QCONS

REMUL:	MOVE A,AR1
	MOVEI B,FIXNUM
	MOVEI T,FIXNUM
	PUSHJ P,BIGTST
	JRST BTIMES	;USE THE BIGNUM MULTIPLICATION

;EXTENSION TO OP.  NUMV3 CHANGED TO JRST BIGDIS
;BIGDIS DETERMINES THE BIGNUM OPERATION TO BE PERFORMED
BIGDIS:	CAIE T,FLONUM
	CAIN B,FLONUM
	JRST FLOBIG	;OPERATION WITH FLT PT OPERAND
	PUSHJ P,BIGTST	
	HLRZ C,(C)
	CAIN C,(ADD A,)	;PLUS
	JRST BPLUS
	CAIN C,(SUB A,)	;DIF
	JRST BDIF
	CAIN C,(IMUL A,)	;TIMES
	JRST BTIMES
	CAIN C,(IDIV A,)	;QUOTIENT
	JRST BQUO
	CAIN C,(JRST)		;LESSP OR GREATERP
	JRST BCMPR
	CAIN C,(JUMPN 0,)	;DIVIDE
	JRST BDIV
	CAIN C,(JUMPA)		;GCD
	JRST GCD
	CAIN C,(JUMPL)		;EQUAL
	JRST BEQUAL
	HALT			;TEMPROARY
PAGE
;TRANSFORMS GENERAL NUMBERS IN (A,T),(TT,B)
;INTO BIGNUMS IN (A,T),(B,TT), VALUES IN A,B; SIGNS IN T,TT.
BIGTST:	EXCH B,T	;FUNNY AC USAGE IN LISP
	PUSH P,T
	PUSH P,TT
	PUSHJ P,BIGSUB	;CONVERT NUMBER ORIGINALLY IN A,T
	EXCH B,-1(P)
	EXCH A,(P)
	PUSHJ P,BIGSUB	;CONVERT NUMBER ORIGINALLY IN TT,B
	MOVE TT,B
	MOVE B,A
	POP P,A
	POP P,T
	POPJ P,

BIGSUB:	CAIE B,POSNUM
	CAIN B,NEGNUM
	POPJ P,		;NO CONVERSION NECESSARY
	CAIE B,FIXNUM
	JRST NUMV2	;CHECK FOR FLONUM
	MOVEI B,0
	MOVE TT,A	;GET VALUE OF NUMBER
	MOVM A,TT
	JUMPGE A,BIGSRT	
	MOVEI A,1	;BASTARD CASE OF -2^35
MKBG:	PUSHJ P,MKBIG
	JRST BIGSND

BIGSRT:	PUSHJ P,BCONS
BIGSND:	SKIPGE TT
	SKIPA B,[NEGNUM]
	MOVEI B,POSNUM
	POPJ P,

MKBIG:	PUSH P,B
	PUSHJ P,BNCONS
	MOVE B,A
	POP P,A
	JRST BCONS
PAGE
;MAKE A LISP NUMBER FROM BIGNUM -- A IS LIST, B IS SIGN
MAKBIG:	JUMPE A,FIX1A	;NULL LIST PRODUCES ZERO
	HRRZ C,(A)
	JUMPN C,QCONS		;A REAL BIGNUM
	HLRZ C,(A)		;ONLY ONE WORD OF PRECISION
	MOVE C,(C)
	CAIE B,POSNUM
	MOVNS C			;NEGATIVE 
	PUSHJ P,UNCONS
	MOVE A,C
	JRST FIX1A
PAGE
FLOBIG:	CAIE T,FLONUM
	JRST FLBG2
	MOVE A,(A)
	EXCH A,TT
	EXCH B,T
	PUSHJ P,BFLT
	EXCH A,TT
	JRST OPR

FLBG2:	PUSHJ P,BFLT
	MOVE TT,(TT)
	JRST OPR

;MAKE A FLOATING PT NUMBER OUT OF A BIGNUM
BFLT:	PUSH P,C
	PUSH P,T
	CAIE T,POSNUM
	CAIN T,NEGNUM
	SKIPA T,[-200]
	JRST NUMV2
BFLT2:	MOVE C,B
	HLRZ B,(A)
	HRRZ A,(A)
	ADDI T,43
	JUMPN A,BFLT2	;FIND LAST TWO WORDS OF BIGNUM
	MOVE B,(B)
	MOVE C,(C)
BFLT3:	TLNE B,SIGN/2
	JRST BFLT4
	ASHC B,1
	SOJA T,BFLT3	;NORMALIZE B,C
BFLT4:	JUMPGE T,FLOOV
	ASH B,-10
	DPB T,[POINT 8,B,8]
	MOVE A,B
	POP P,T
	POP P,C
	CAIE T,POSNUM
	MOVNS A
	POPJ P,

;MAKE A BIGNUM FROM A FLT PT NUMBER
BFIX:	MOVE A,(P)
	PUSHJ P,NUMVAL
	MOVMS A
	MULI A,400
	MOVEI C,-243(A)	;#LEFT SHIFTS NEEDED
	IDIVI C,43	;C_#EXTRA WORDS-1, D_#SHIFTS
	MOVEI A,0
	ASHC A,(C+1)
	PUSH P,B
	PUSHJ P,BNCONS
	MOVE B,A
	POP P,A
	PUSHJ P,BCONS
	SOJL C,BFIX2
	MOVE B,A
	MOVEI A,0
	PUSHJ P,BCONS
	SOJGE C,.-3
BFIX2:	POP P,TT
	PUSHJ P,BIGSND
	JRST QCONS

PAGE
;BIGNUM DIVIDE
BDIV:	PUSHJ P,MQSIGN	;COMPLEMENT SIGN OF TT IF T IS NEGNUM
	PUSH P,T	;SIGN OF REMAINDER
	PUSH P,TT	;SIGN OF QUOTIENT
	PUSHJ P,DIVSUB
BDIV2:	EXCH B,(P)
	PUSHJ P,MAKBIG	;QUOTIENT
	MOVE B,-1(P)
	MOVEM A,-1(P)
	POP P,A
	PUSHJ P,MAKBIG	;REMAINDER
	POP P,B
	JRST XCONS

BQUO:	PUSHJ P,MQSIGN
	PUSH P,TT
	PUSHJ P,DIVSUB
	PUSH P,A
	MOVE A,B
	PUSHJ P,UNCONS
	POP P,A
	POP P,B
	JRST MAKBIG

DIVSUB:	HRRZ C,(B)
	JUMPN C,DIV1
;NULL(CDR B) MEANS SINGLE LENGTH DIVISOR
BQUO1:	PUSH P,B
	PUSHJ P,COPY
	POP P,B
	HLRZ B,(B)
	MOVE B,(B)
	PUSHJ P,Q1
	PUSH P,B	;QUOTIENT
	PUSHJ P,BNCONS
	MOVE B,A
	JRST POPAJ

PAGE
;DIV1 DOES LONG DIVISION OF X/Y 
;ENTER WITH X IN A, Y IN B.
DIV1:	PUSH P,A	;X
	PUSH P,B	;Y
	MOVE A,B
	PUSHJ P,HIDIG
	HRLOI A,SIGN/2-1
	IDIV A,(C)	;(BETA/2-1)/Y[N-1]+1
	ADDI A,1
	MOVEM A,SCALE#
	MOVE B,A
	MOVE A,(P)	;Y - DIVISOR
	PUSHJ P,BTIME0	;SCALE*Y
	MOVEM A,V	;SCALED DIVISOR
	MOVEM A,(P)	;PROTECT V FROM GC
	PUSHJ P,HIDIG
	POP C,VH	;V[N-1]
	POP C,VH1	;V[N-2]
	MOVE A,-1(P)	;X - NUMERATOR
	PUSHJ P,COPY
	PUSHJ P,EXTND
	MOVE B,SCALE
	MOVE C,A
	PUSHJ P,BTIME1-1	;SCALE*X  -- SCALED NUMERATOR
	MOVEM A,-1(P)	;U
	PUSH P,[NIL]	
	HRRZM P,QUO#	;POINTER TO QUOTIENT LIST
	PUSHJ P,LENGTH
	PUSH P,A
	MOVE A,V#
	PUSHJ P,LENGTH
	POP P,B
	SUB B,A		;LENGTH(U)-LENGTH(V)
	MOVE A,-2(P)	;U
	JUMPLE B,DIV1X	;SPECIAL CASE OF U<V
	PUSHJ P,DIV2	;CARRY OUT DIVISION WITH PARAMETERS
DIV1X:	PUSHJ P,SUPRSS	;SUPPRESS LEADING ZEROS OF REMAINDER
	JUMPE A,DIV1Y	;ZERO REMAINDER
	MOVE B,SCALE
	PUSHJ P,Q1	;U/SCALE - FINAL REMAINDER IN B
	MOVE A,B
DIV1Y:	EXCH A,(P)
	PUSHJ P,SUPRSS	;SUPPRESS LEADING ZEROS IN QUOTIENT
	POP P,B
	SUB P,[XWD 2,2]
	POPJ P,

;RECURSIVE FUNCTION TO POSITION V PROPERLY WITH RESPECT TO U.
; ON SUCCESSIVE CALLS TO DIV3 WHICH CALCULATES QUOTIENT DIGITS.
;ENTER DIV2 WITH U IN A, N IN B. N= LENGTH(U)-LENGTH(V)-1.

DIV2:	SOJLE B,DIV3
	PUSH P,A	;U
	HRRZ A,(A)
	PUSHJ P,DIV2
	HRRM A,@(P)	;(RPLACD U,(DIV3(CDR U)))
	POP P,A
	JRST DIV3
PAGE
;ENTER WITH U[J] IN A

DIV3:	PUSH P,A	;UJ
	PUSHJ P,HIDIG
	POP C,A		;UH
	CAML A,VH#
	JRST DIVCS1	;STRANGE CASE WHEN UHVH
	POP C,B		;UH1
	DIV A,VH	;(UH*BETA+UH1)/VH
	PUSH P,A	;QUOTIENT DIGIT
L1:	MOVEM B,REM#	;REMAINDER
	MUL A,VH1#
	SUB A,REM	;(VH1*QUO)-BETA*REM
	CAMGE B,(C)	;UH2
	SUBI A,1
	JUMPG A,DIVCS2	;QUOTIENT TOO BIG
L4:	MOVE A,V
	MOVE B,(P)	;QUOTIENT DIGIT
	PUSHJ P,BTIME0	;Q*V
	MOVE C,-1(P)	;UJ
	MOVE B,A
	MOVEI A,0
	PUSHJ P,BSUB	;UJ-Q*V
	JUMPL B,DIVCS3	;QUOTIENT TOO BIG
L3:	MOVEM A,-1(P)	;NEW UJ
	POP P,A		;QUOTIENT DIGIT
	MOVE B,@QUO
	PUSHJ P,BCONS
	MOVEM A,@QUO	;NEW QUOTIENT LIST
	MOVE A,(P)
	PUSHJ P,DIVSRT	;SHORTEN UJ BY ONE DIGIT
	JRST POPAJ
PAGE
;SPECIAL CASE OF UHVH
DIVCS1:	HRLOI A,SIGN-1		;BETA-1
	PUSH P,A
	POP C,B		;UH1
	ADD B,VH	;R_UH1+VH
	JUMPL B,L4
	JRST L1

;SPECIAL CASE CORRECTION FOR QUOTIENT
DIVCS2:	SOS A,(P)		;QUOTIENT_QUOTIENT-1
	MOVE B,REM
	ADD B,VH	;R_R+VH
	JRST L1

;SPECIAL CASE OF QUOTIENT TOO LARGE
DIVCS3:	SOS (P)		;QUOTIENT_QUOTIENT-1
	PUSH P,A
	MOVE A,V
	PUSHJ P,COPY
	MOVE C,A
	POP P,B
	MOVEI A,0
	PUSHJ P,BADD	;U_U+V
	MOVEM A,-1(P)
	PUSHJ P,DIVSRT	;SHORTEN OVERFLOWED DIGIT
	JRST L3+1
PAGE
;PUSHES SUCCESSIVE DIGITS OF LIST IN A ONTO PDL
;RETURNS C POINTING TO PDL LOCATION OF LAST DIGIT
HIDIG:	MOVE C,P
	MOVS B,(A)
	PUSH P,(B)
	HLRZ A,B
	JUMPN A,HIDIG+1
	EXCH C,P
	POPJ P,

;SHORTEN LIST BY ONE
DIVSRT:	MOVE C,A
	HRRZ A,(A)
	HRRZ B,(A)	;CDDR
	JUMPN B,.-3
	HLLZS (C)	;NULL (CDDR C) => RPLACD(C NIL)
	HLRZ B,(A)
	JRST UNCONS

;LENGTHEN LIST BY ONE
EXTND:	PUSH P,A
	PUSHJ P,LAST
	MOVE T,A
	PUSHJ P,B0CONS
	HRRM A,(T)
	JRST POPAJ
PAGE
GA==4
GB==5
GC==6
GD==7
UP==10
VP==11
Q==12
;BIGNUM GCD
GCD:	PUSH P,B
	PUSHJ P,COPY
	EXCH A,(P)	;V
	PUSHJ P,COPY
	PUSH P,A	;U
	PUSHJ P,COPY
	MOVE C,A
	MOVE A,-1(P)	
	PUSHJ P,COPY
	MOVE B,A	;U
	MOVEI A,0
	PUSHJ P,BSUB	;V-U
	PUSH P,B
	PUSHJ P,BSUBND
	JUMPE A,GCDSC1	;U=V
	PUSHJ P,UNCONS
	POP P,B
	JUMPGE B,GCD2	;UV
	MOVE A,(P)
	EXCH A,-1(P)
	MOVEM A,(P)
PAGE
;NOW V<U   V IN -1(P), U IN (P)
GCD2:	MOVE A,-1(P)
	JUMPE A,GCDEND	;V IS ZERO
	HRRZ B,(A)
	JUMPE B,GCDSING	;V IS SINGLE PRECISION
	PUSHJ P,LENGTH	;LENGTH (V)
	MOVE T,A
	MOVE A,(P)	;U
	PUSHJ P,LENGTH
	SUB A,T		;L(U)-L(V)
	JUMPE A,GCD4
	SOJN A,GCD7A	;>1
	MOVE A,-1(P)	;V
	PUSHJ P,EXTND	;LENGTHEN V BY ONE HIGH ORDER ZERO
GCD4:	MOVE A,(P)	;U
	PUSHJ P,HIDIG
	HRLOI A,SIGN/2-1	;BETA/2-1
	IDIV A,(C)	;(BETA/2-1)/U[N-1]+1
	ADDI A,1
	MOVEM A,SCALE
	PUSHJ P,GCSB
	MOVE UP,A	;SCALE*UH
	MOVE A,-1(P)	;V
	PUSHJ P,HIDIG
	PUSHJ P,GCSB
	MOVE VP,A	;SCALE*VH
	MOVEI GA,1
	MOVEI GD,1
	SETZB GC,GB
PAGE
GCD5:	MOVE A,UP
	ADD A,GA
	MOVE B,VP
	ADD B,GC
	JUMPE B,GCD7
	JUMPL A,GCD5X	;OVERFLOW CASE
	IDIV A,B	;(U'+A)/(V'+C)
GCD5A:	MOVE Q,A
	MOVE A,UP
	ADD A,GB
	MOVE B,VP
	ADD B,GD
	JUMPE B,GCD7
	SKIPG B
	TDZA A,A	;SPECIAL CASE OF V'+D = BETA
	IDIV A,B	;(U'+B)/(V'+D)
	CAME A,Q
	JRST GCD7
	MOVE A,GC
	EXCH GA,GC	;A'_C
	IMUL A,Q
	SUB GC,A	;C'_A-Q*C
	MOVE A,GD
	EXCH GB,GD	;B'_D
	IMUL A,Q	
	SUB GD,A	;D'_B-Q*D
	MOVE A,VP
	EXCH UP,VP	;UP'_VP
	IMUL A,Q
	SUB VP,A	;VP'_UP-Q*VP
	JRST GCD5
PAGE
;SPECIAL CASE WHEN U'+A=BETA
GCD5X:	MOVEI A,1
	MOVE C,B
	MOVEI B,0
	DIV A,C
	JRST GCD5A

GCD7:	JUMPE GB,GCD7A
	MOVE A,(P)	;U
	MOVE B,-1(P)	;V
	PUSH P,GC
	PUSH P,GD
	PUSHJ P,GCDSB	;A*U+B*V
	POP P,GB
	POP P,GA
	EXCH A,(P)	;U
	MOVE B,-1(P)
	PUSHJ P,GCDSB	;C*U+D*V
	MOVEM A,-1(P)	;V
	JRST GCD2

GCDSB:	PUSH P,GA
	PUSH P,GB
	PUSH P,B
	MOVM B,GA
	PUSHJ P,BTIME0
	EXCH A,(P)	;B
	MOVM B,-1(P)	;GB
	PUSHJ P,BTIME0
	POP P,B	;A*GA
	POP P,GA
	POP P,GB
	XOR GA,GB
	MOVE C,A
	MOVEI A,0
	JUMPGE GA,BADD	;SIGNS SAME
	PUSHJ P,BSUB	;SIGNS DIFFERENT
BSUBND:	JUMPGE B,SUPRSS
	JRST COMPLM

GCD7A:	MOVE A,-1(P)
	PUSHJ P,SUPRSS
	MOVE B,A
	MOVE A,(P)
	PUSHJ P,DIV1	;U/V
	EXCH B,-1(P)	;V_REMAINDER
	MOVEM B,(P)	;U_V
	PUSHJ P,UNCONS	;DONT NEED QUOTIENT
	JRST GCD2
PAGE
GCDSING:	
	POP P,A	;U
	MOVE B,(P)	;V - SINGLE PRECISION
	HLRZ B,(B)
	MOVE B,(B)
	MOVEM B,(P)
	PUSHJ P,Q1	;U MOD V  A
	POP P,B		;A < B
	JUMPE A,GCDS2
;SINGLE PRECISION GCD
	IDIV B,A
	MOVE B,A
	MOVE A,C
	JUMPN A,.-3
GCDS2:	MOVE A,B
	JRST FIX1A

GCSB:	MOVE A,-1(C)
	MUL A,SCALE
	MOVE B,A
	MOVE A,(C)
	IMUL A,SCALE
	ADD A,B
	POPJ P,
PAGE
GCDSC1:	SUB P,[XWD 2,2]
	POP P,A
	MOVEI B,POSNUM
	JRST MAKBIG

GCDEND:	POP P,A	;U IS RESULT
	SUB P,[XWD 1,1]
	MOVEI B,POSNUM
	JRST MAKBIG

	END