;;;   -*-MIDAS-*-
;;;   **************************************************************
;;;   ***** MACLISP ******  BIGNUM ARITHMETIC PACKAGE **************
;;;   **************************************************************
;;;   ** (C) COPYRIGHT 1980 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;;   ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;;   **************************************************************



PGBOT BIG


SUBTTL	BIGNUM PACKAGE - RANDOM ROUTINES

;THE BIGNUM ARITHMETIC PAGE - SPECIAL STUFF FOR BIGNUM OPERATIONS ONLY

YPOCB:	PUSH P,[NREVERSE]
BCOPY:	HRRZ C,A	;COPIES A BIGNUM IN ACCUMULATOR A [INTERNAL FORMAT]
	PUSH P,A
	MOVEI AR1,(P)	;CLOBBERS C AR1 TT D
BCOP1:	JUMPE C,POPAJ
	HLRZ TT,(C)
	MOVE TT,(TT)
	PUSHJ P,C1CONS
	HRRM A,(AR1)
	HRRZ AR1,(AR1)	;UPDATE POINTER TO END OF LIST
	HRRZ C,(C)	;GET NEXT OF LIST TO BE COPIED
	JRST BCOP1


BNARSV:	PUSH P,C	;SAVE ACCUMULATORS
	PUSH P,AR1
	PUSH P,AR2A
	MOVEM F,FACD
	MOVEM R,FACF
	JRST (T)

BNARRS:	POP P,AR2A	;RESTORE ACCUMULATORS
	POP P,AR1
	POP P,C
	MOVE F,FACD
	MOVE R,FACF
	JRST (T)


PLOV:	PUSH P,AR1	;OVERFLO WHILE ADDING OR SUBBING TWO FIXNUMS
	SKIPN TT,D
	JRST PLOV2
	TLNN TT,400000
	MOVNS TT
	TLZ TT,400000
	PUSH FXP,TT
	PUSHJ P,ABSOV
	MOVE A,(A)
	HLR B,(A)
	POP FXP,(B)
	SKIPL D
	TLC A,-1
	SKIPA D,A
PLOV2:	MOVE D,BNM236
	POP P,AR1
	JRST T13

PL1BN:	EXCH D,TT		;FIXNUM SUM MEETS BIGNUM ARG
	PUSHJ P,BNCVTM
	EXCH D,TT
	JRST T11

TIMOV:	MOVEM T,AGDBT	;OVERFLO WHILE MULING TWO FIXNUMS
	PUSHJ P,BNCV
	MOVE D,A
	MOVE TT,AGDBT
	PUSHJ P,BNCVTM
	JRST BNTIM

TIM1BN:	JUMPE D,T14EX		;FIXNUM PRODUCT MEETS BIGNUM NEXT ARG
	EXCH D,TT
	PUSHJ P,BNCVTM
	EXCH D,TT
	JRST T11

T2:	MOVE D,TT
T12:	MOVE A,(F)		;BIGNUM ARITHMETIC LOOP
	JSP T,NVSKIP
	XCT 4(R)	;OPERATE ON TWO BIGNUMS
	JRST 2(R)	;DISPATCH TO OPERATE ON BIGNUM SUM WITH FIXED
	EXCH D,TT	;CONVERT BIGNUM SUM TO FLOATING
	PUSHJ P,FLBIG
	EXCH D,TT
	JRST T7		;AND ENTER FLOATING POINT LOOP

PL2BN:	PUSHJ P,BNCVTM	;BIGNUM SUM MEETS FIXNUM NEXT ARG
	JRST T11


TIM2BN:	JUMPE TT,T14EX1		;BIGNUM PRODUCT MEETS FIXNUM NEXT ARG
	PUSHJ P,BNCVTM
	EXCH D,TT
T11:	XCT 4(R)	;TRANSFERS TO BNTIM
T13:	AOBJN F,T12
T13X:	MOVE A,D
	SUB P,PLUS8
	JRST BNCONS

BNDF:	JSP A,BNPL1	;DIFFERENCE OF TWO BIGNUMS
BNPL:	JSP A,BNPL1	;PLUS OF TWO BIGNUMS
BNPL1:	EXCH A,D
	MOVE B,TT
	JSP T,BNARSV
	PUSHJ P,BNADD(D)-BNPL1
T19A:	PUSHJ P,BNTRSZ	;SKIPS 2 IF ALL RIGHT
	MOVE D,[1_43]
	JRST T19B
	MOVE D,A
	HRRZ B,(A)	;WHAT IF OPERATE RESULTS IN SCRUNCHING
	JUMPN B,T19C	;ACCUMULATED VALUE INTO ONE WORD?
	HLRZ D,(A)
	MOVE D,(D)
	JUMPGE A,.+2
	MOVNS D
T19B:	JSP T,BNARRS
	JRST 2,@[T14E]

T19C:	JSP T,BNARRS
	JRST T13

BNXTIM:	JUMPE TT,0POPJ		;FIXNUM IN TT TIMES ABS(BIGNUM IN A)
	HRRZ D,(A)
	SETOM REMFL
	PUSHJ P,BNCVTM		;CONVERT FIXNUM TO BIGNUM FOR BNMUL
BNTIM:	JSP T,BNARSV		;PRODUCT OF TWO BIGNUMS
	MOVE A,D
	MOVE B,TT
	PUSHJ P,BNMUL
	JSP T,BNARRS
	MOVE D,A
	SKIPN REMFL
	JRST T13
	SETZM REMFL
	JRST BNCONS		;FOR BNXTIM, CONS UP A REAL BIGNUM

DIVSEZ:	SKIPA D,BNM235		;DIVISION BY 1_43 [-2E35.]
REM2BN:	JUMPE TT,BPDLNKJ
DV2BN:	JSP T,BNARSV		;BIGNUM DIVIDEND GETS FIXNUM DIVISOR
	MOVE A,D
	JUMPN TT,DV2BN1
	SKIPN RWG
	JRST OVFLER
	MOVEI TT,1		;ON ATTEMPT TO DIVIDE BY ZERO [WHEN RWG NOT ZERO]
	JUMPGE A,.+2
	MOVNS TT
	MOVEM TT,BNV1
	MOVE B,BNV2
	PUSHJ P,BNADD
	JRST T19A

DV1BN:	CAME D,[400000,,]	;FIXNUM DIVIDEND, BIGNUM DIVISOR
	TDZA TT,TT		;ORDINARILY ZERO
	SKIPA D,BNM235		;BUT -4_41/4_41 => 1, NOT 0
	JRST T14EX1
BNDV:	MOVE B,TT		;BIGNUM QUOTIENT, BIGNUM DIVEND
	MOVE A,D
	JSP T,BNARSV
	PUSHJ P,BNQUO
	SKIPE REMFL
	CAMN TT,XC-1
	JRST T19A
	SETZM REMFL
	JSP T,BNARRS
	MOVE D,A	;DIVIDE OUT NORMALIZATION
	JRST DV2BN

DV2BN1:	MOVEM A,NORMF		;SO DIVIDE A BIGNUM BY A REGULAR FIXNUM
	PUSHJ P,REVERSE
	MOVE AR1,NORMF		;AR1 HAS SIGN OF ORIGINAL ARG IN LH
	HRR AR2A,A		;AR2A HAS SIGN OF PRODUCT ON COPY
	HLL AR2A,AR1
	JUMPGE TT,DV2BN2
	MOVNS TT
	JUMPL TT,DV2BN3		;FOO! LOUSY SETZ CASE - PRODUCT WILL BE NEGATIVE
	TLC AR2A,-1
DV2BN2:	HRRZ C,(A)
	MOVE D,TT
	HLRZ F,(A)
	MOVE F,(F)
	MOVEI R,0
	DIV R,D
	MOVE TT,R
	PUSHJ P,C1CONS
BNFXLP:	MOVE B,A
	JUMPE C,D1FIN
	MOVE R,F
	HLRZ F,(C)
	MOVE F,(F)
	DIV R,D
	MOVE TT,R
	PUSHJ P,C1CONS
	HRRM B,(A)
	HRRZ C,(C)
	JRST BNFXLP

DV2BN3:	MOVE TT,BNM235
	JSP T,BNARRS
	JRST BNDV

D1FIN:	HLL A,AR2A
	PUSHJ P,BNTRUN
	EXCH A,AR2A
	MOVEI B,NIL
	PUSHJ P,RECLAIM	;RECLAIM ONLY FREE STORAGE
	EXCH A,AR2A
	SKIPN REMFL
	JRST T19A
	MOVE D,F
	JUMPGE AR1,.+2
	MOVNS D
	JSP T,BNARRS
	MOVEI B,TRUTH
	PUSHJ P,RECLAIM	;RECLAIM QUOTIENT SPACE, SINCE ONLY REMAINDER NEEDED
	JRST T14EX

SUBTTL	GENERAL UTILITY ROUTINES FOR BIGNUM ARITHMETIC

BNTRUN:	HRR AR1,A	;TRUNCATE OFF LEADING ZEROS FROM BIGNUM
	HRRZ B,(AR1)	;PRESERVE LH OF AR1
	JUMPE B,CPOPJ
BNTR4:	MOVS C,(B)
	SKIPE (C)
	HRR AR1,B
	HLRZ B,C
	JUMPN B,BNTR4
	HRRZ C,(AR1)
	HLRM C,(AR1)
	JUMPE C,CPOPJ		;EXIT IF THERE WERE NO LEADING ZEROS
	EXCH A,C
	PUSHJ P,RECLAIM		;OTHERWISE, RECLAIM SPACE OCCUPIED
	EXCH A,C		; BY LIST HOLDING THEM (B IS ZERO)
	POPJ P,


BNTRSZ:	JUMPGE A,BNPJ2		;SKIPS 2 IF NOT -1_43 IN BIGNUM FORMAT.  ELSE NO SKIP
BNTRS1:	HRRZ AR1,(A)		;MUNGS ONLY AR1
	JUMPE AR1,BNPJ2
	MOVS AR1,(AR1)
	TLNE AR1,-1
	JRST BNPJ2
	HLL AR1,(AR1)		;ALL THIS KLUDGERY SO THAT RANDOM
	TLNE AR1,-1		; NUMERIC QUANTITIES WILL NOT GET
	JRST BNPJ2		; IN THE RIGHT HALF OF AR1
	HRLZ AR1,(AR1)
	TLC AR1,1
	JUMPN AR1,BNPJ2
	HLRZ AR1,(A)
	SKIPN (AR1)
	POPJ P,
BNPJ2:	POP P,AR1
	JRST 2(AR1)

BNCV:	PUSH FXP,D
	PUSHJ FXP,SAV5M1
	PUSHJ P,BNCVTM
	MOVE A,TT
	PUSHJ P,BCOPY
	JRST UUOSE1

BNCVTM:	JUMPL TT,T16		;CONVERT NUMBER IN TT TO INTERNAL BIGNUM
T17:	MOVEM TT,BNV1
	MOVE TT,BNV2
	POPJ P,
T16:	MOVNS TT
	JUMPL TT,T23	;400000,,
	PUSHJ P,T17
	TLCA TT,-1
T23:	MOVE TT,BNM235	;CONVERTED TO BIGNUM -2E35.
	POPJ P,

SUBTTL	BIGNUM ADDITION SUBROUTINE

BNSUB:	TLC B,-1	;CHANGE SIGN OF 2ND ARG
BNADD:	MOVE C,A	;FIRST ARGUMENT TO C
	HLLZ A,C	;SET UP NULL BIGNUM WITH SIGN OF FIRST ARG
	PUSH P,A
	HLLZ F,B	;DITTO SECOND ARG
	MOVEI R,BNADD2	;SET UP FOR REAL ADD
	CAME A,F	;CHECK FOR SAME SIGNS
	MOVEI R,BNSUB2	;CHANGE TO SUBTRACT
	MOVE F,P	;F POINTS TO BOTTOM WORD OF ANSWER
	MOVEI TT,0	;ARITHMETIC DONE IN TT
BN4:	MOVE AR2A,C
	MOVE C,(C)	;CDR C
	MOVE B,(B)	;CDR B
BN15:	MOVEI D,0	;CLEAR CARRY
	HLRZ AR1,C
	ADD TT,(AR1)
	HLRZ AR1,B
	XCT -1(R)	;ADD/SUB TT,(AR1)
	TLZE TT,400000	;CARRY OR BORROW
	MOVE D,-2(R)	;PLUS OR MINUS 1
	JSP T,FWCONS
	MOVE AR1,A
	PUSHJ P,ACONS
	HRRM A,(F)	;NCONC ONTO ANSWER
	MOVE F,A	;UPDATE POINTER TO LAST WORD
BN20:	TRNN B,-1	;END OF SECOND ARG?
	JRST @-3(R)
BN7:	TRNN C,-1	;END OF FIRST ARG?
	JRST (R)
BN9:	MOVE TT,D	;MOVE CARRY TO TT
	JRST BN4


	BN5
	1	;CARRY
	ADD TT,(AR1)
BNADD2:	JUMPN D,BN8	;FIRST ARG DONE; IF CARRY, SIMULATE A ZERO
BN14:	HRRM B,(F)	;USE REST OF SECOND ARG
	JRST POPAJ
BN8:	MOVEI C,[R70,,]
	JRST BN9

BN5:	JUMPN D,BN6	;2ND ARG EXHAUSTED; IF CARRY, SIMULATE A ZERO
BN13:	HRRM C,(F)
	JRST POPAJ
BN6:	MOVEI B,[R70,,]
	JRST BN7


	BN12
	-1	;BORROW
	SUB TT,(AR1)
BNSUB2:	
			;COME HERE ONLY IF ABS(1)<ABS(2)
			;FIRST ARG DONE, AND (2ND IS NOT DONE, OR THERE IS A BORROW)
			;IT IS NECESSARY TO TAKE THE TWOS COMPLEMENT OF THE PARTIAL ANSWER
	MOVE A,(P)
	TLC A,-1
	MOVEM A,(P)
	MOVSI TT,400000	;TT IS INITIALIZED TO 400000000000
			;AND UNCHANGED WHILE THE PARTIAL ANSWER IS ZEROS
			;AFTER A NONZERO WORD, TT IS RESET TO 377777777777 AFTER EACH SUBTRACT
	SKIPA C,(A)	;SCAN DOWN NUMBER; LEFT HALF OF C NOW POINTS AT LOW ORDER WORD
BN10:	MOVE C,(C)
	HLRZ AR1,C
	SUBB TT,(AR1)
	SKIPL TT		;IFF TT IS STILL SETZ, (AR1) WAS ZERO AND MUST BE FIXED
	SKIPA TT,[377777777777]
	SETZM (AR1)
	TRNE C,-1
	JRST BN10
	JUMPL D,BN11	;IF BORROW: THE PARTIAL ANSWER WAS NONZERO TO GENERATE THE BORROW
			;A RECOMPLEMENT BORROW OCCURED. TT IS 377777777777.
			;SHOULD USE REST OF 2ND ARGUMENT
	JUMPL TT,BN14	;TT<0: THE PARTIAL ANSWER WAS ZERO; 1ST ARG IS PROPER INITIAL SEGMENT OF 2ND ARG
			;USE REST OF 2ND ARG, GUARANTEED TO BE NONZERO
	MOVNI TT,1	;RECOMPLEMENT BORROW BUT NO ORIGINAL BORROW; USE REST OF 2ND ARG WITH BORROW
	MOVE C,(B)	;SWAP ARGS
	MOVSI B,[0]
	JRST BN15	;CONTINUE AS A SUBTRACT IN WHICH "2ND" ARG IS EXHAUSTED, AND A BORROW PROPAGATED
			;CURIOUS THINGS HAPPEN IF THE REST OF "1ST" ARG IS ZERO(AN IMPROPER FORMAT)

BN11:	TLNE B,-1	;TRY TO AVOID USING THE TRUNCATE ROUTINE
	JRST BN14	;REST OF 2ND ARG IS NOT NULL, SO USE IT
BN11A:	POP P,A
	SKIPE (AR1)	;AR1 POINTS AT HIGH WORD OF DIFFERENCE 
	POPJ P,
	JRST BNTRUN

BN12:	JUMPN D,BN6	;2ND ARG EXHAUSTED; IF BORROW, INVENT A ZERO
	TRNE C,-1	;IF 1ST ARG IS NOT EXHAUSTED, USE REST OF IT
	JRST BN13
	JRST BN11A	;BOTH ARGS EXHAUSTED

BNM1:	JUMPE D,POPAJ	;SWAP OUT ONLY A NONZERO CARRY
	PUSH P,CPOPAJ	;FOR MULTIPLICATION ROUTINE
BNM2:	EXCH D,TT
	JSP T,FWCONS
	PUSHJ P,ACONS
	EXCH D,TT
	HRRM A,(R)	;NCONC CARRY WORD TO ANSWER BIGNUM
	POPJ P,


SUBTTL	BIGNUM MULTIPLICATION SUBROUTINE

;MULTIPLY IS DONE IN TWO PARTS: (1) MULTIPLY FIRST ARG BY FIRST WORD OF SECOND ARG
;(2) MULTIPLY [AND ADD IN TO TOTAL] FIRST ARG BY EACH REMAINING WORD OF THE SECOND ARG
;SLIGHTLY FASTER IF SECOND ARG IS SHORTER
BNMUL:	MOVE C,A
	HLLZ A,C	;CREATE NULL BIGNUM WITH SIGN OF FIRST ARG
	XOR A,B		;SKIP IF 2ND ARG POSITIVE.  CHANGE SIGN OF ANSWER
	PUSH P,A
	MOVE R,P	;R POINTS AT LAST WORD OF ANSWER BIGNUM DURING PART ONE OF MULTIPLY
	MOVE B,(B)	;GET FIRST WORD OF SECOND ARG
	HLRZ F,B
	MOVE F,(F)
	MOVEI D,0	;ZERO CARRY WORD
	SKIPA AR2A,(C)	;PREPARE TO GOBBLE FIRST ARG
BNM5:	MOVE AR2A,(AR2A)
	HLRZ T,AR2A	;GOBBLE A WORD OF FIRST ARG
	MOVE T,(T)
	MUL T,F	;AFTER MULTIPLY, T<377777777777
	ADD TT,D	;CARRY<400000000000; SUM<777777777777
	MOVE D,T
	TLZE TT,400000	;CLEAR SIGN BIT AND PROPAGATE
	AOS D		;NEW CARRY<400000000000
	PUSHJ P,C1CONS
	HRRM A,(R)
	MOVE R,A	;UPDATE POINTER TO LAST WORD
	TRNE AR2A,-1	;END OF FIRST ARG?
	JRST BNM5
	MOVE A,(P)
	HRRM A,BNMSV
BNM4:	TRNN B,-1	;END OF SECOND ARGUMENT?
	JRST BNM1	;YES; SWAP OUT CARRY IF NOT ZERO
	PUSHJ P,BNM2
	MOVE B,(B)	;GET NEXT WORD OF SECOND ARG
	HLRZ F,B
	MOVE F,(F)
	MOVE R,@BNMSV
	HRRM R,BNMSV
	MOVE AR2A,(C)	;RESET FIRST ARGUMENT
	MOVEI D,0	;CLEAR OUT CARRY
BNM3:	HLRZ T,AR2A	;GET A WORD OF FIRST ARG
	MOVE T,(T)
	MUL T,F	;AFTER MULTIPLY, T<377777777777
	ADD TT,D	;CRY<400000000001, SUM<1000000000000
	TLZE TT,400000	;CLEAR SIGN BIT AND PROPAGATE
	AOS T		;NEW T<400000000000
	HLRZ D,(R)	;GET WORD OF ACCUMULATOR
	ADD TT,(D)	;SUM<777777777777
	TLZE TT,400000	;CLEAR SIGN BIT AND PROPAGATE
	AOS T		;NEW T<400000000001
	MOVEM TT,(D)	;STORE WORD OF ACCUMULATOR
	MOVE D,T
	TRNN AR2A,-1	;SKIP IF NOT END OF FIRST ARG
	JRST BNM4
	MOVE AR2A,(AR2A)	;ADVANCE TO NEXT WORD OF FIRST ARG
	MOVE R,(R)	;ADVANCE TO NEXT WORD OF ACCUMULATOR
	JRST BNM3

SUBTTL	BIGNUM DIVISION SUBROUTINE

BNQUO:	SETZM NORMF	;INITIALIZE NORMALIZATION FACTOR
	SETZM VETBL0	;INITIALIZE "FIRST TIME THRU" FLAG
	PUSH P,B	;SETS UP TO TEST FIRST DIVISOR WORD
	PUSH P,A
BNQUO1:	MOVEI D,1
	MOVE C,B
	MOVE C,(C)
	MOVE AR1,(C)
	AOS D
	TRNE AR1,-1
	JRST .-4
	HLRZS AR1
	MOVE F,(AR1)
	CAMGE F,[200000,,0]	;NORMALIZATION TEST
	JRST BQNORM
	SKIPN NORMF
	JRST BQCOPY
	MOVSS C		;GET TOP TWO DIVISOR WORDS
	MOVE C,(C)
	MOVEM F,DVS1
	MOVEM C,DVS2
	MOVEM D,DVSL
	MOVEI C,(A)	;SET UP QUOTIENT
	JUMPGE B,.+2
	TLC A,-1
	HLLZS A
	TLZ B,-1	;PROB. UNNECESSARY, BUT WHY TAKE CHANCES?
	PUSH P,A
BQ1:	MOVEI R,3	;THIS GETS DVD WORDS FOR THE QUOTIENT ESTIMATE
	MOVE AR2A,C
BQ2:	MOVE AR2A,(AR2A)
	TRNN AR2A,-1
	JRST BQSRRM	;PARTIAL REMAINDER IS ONLY ONE WORD LONG
	MOVE T,(AR2A)
	TRNN T,-1
	JRST BQSHRM	;PARTIAL REM OR DVD IS 2 WORDS LONG
	MOVE TT,(T)
	TRNE TT,-1
	AOJA R,BQ2
	JRST BQCC


BQCC:	MOVSS AR2A	
	MOVE AR2A,(AR2A)
	MOVEM AR2A,DD3
	MOVSS T
	MOVE T,(T)
	MOVEM T,DD2
	MOVSS TT
	MOVE TT,(TT)
	MOVEM TT,DD1
	SKIPN VETBL0
	JRST BQVET
	MOVEM R,DDL
BQGEST:	SUB R,DVSL	;CHECKS FOR PARTIAL REMAINDER<DIVISOR
	JUMPL R,BQZQ
	JUMPN R,BQGESS
	EXCH R,DD1	;SINCE R WAS 0, NOW DD1 IS 0
	exch r,dd2		;I just fixed this code to move DD2 into DD3
	MOVEM R,DD3		; as well as 0 -> DD1 -> DD2.  I must admit
	JRST BQGESS		; to not understanding why this shift is
BQZQ:	SETZM QHAT		; necessary, but it was clearly wrong the way
	JRST BQ8		; it was!  -Alan 8/6/83


BQCOPY:	SETOM NORMF	;COPIES DIVIDEND TO GET WORK SPACE
	PUSHJ P,BCOPY	;CLOBBERS T TT D B C AR1
	MOVEM A,(P)
	MOVE B,-1(P)
	JRST BNQUO1

BQNORM:	ADDI F,1	;THIS SECTION MULTIPLIES DVD AND DIV BY NORMF
	MOVEI T,1
	SETZ TT,
	DIV T,F
	MOVEM T,NORMF
	MOVE A,B
	MOVEM T,BNV1
	MOVE B,BNV2
	PUSHJ P,BNMUL
	EXCH A,(P)
	MOVE B,BNV2
	PUSHJ P,BNMUL
	MOVE B,A
	EXCH B,(P)
	MOVEM B,-1(P)
	JRST BNQUO1


BQ6:
BQSRRM:	SETZM QHAT	;COME HERE IF PARTIAL REM IS ONE WORD
	JRST BQ8	;MEANS QUOTIENT AT THIS STEP IS ZERO

BQSHRM:	MOVEI R,2	;COME HERE IF PARTIAL REMAINDER IS 2 WORDS LONG
	MOVSS AR2A
	MOVSS T
	MOVE T,(T)
	MOVE AR2A,(AR2A)
	MOVEM T,DD2
	MOVEM AR2A,DD3
	SETZM DD1
	SKIPE VETBL0
	JRST BQGESS
	JRST BQ10

BQVET:	MOVEM TT,DD2
	MOVEM T,DD3
	SETZM DD1
	JRST BQ10


BQSHRT:	MOVE A,-1(P)
	JUMPE R,BQSH0
	SKIPE REMFL
	JRST REMFIN
	HLLZS R
	HRRM R,-1(P)
	JRST BQ6

REMFIN:	HLL A,-1(P)
	TRNN A,-1
	MOVE A,-1(P)	;IN CASE DIVIDEND IS REMAINDER
	PUSHJ P,BNTRUN
	MOVE TT,NORMF
	SUB P,R70+3
	POPJ P,


BQ10:	SUB R,DVSL	;SETS UP INITIAL ZERO FOR FIRST GUESS
	SKIPG R
	JRST BQSHRT
	SOSN R
	JRST BQ1DF
	MOVEM R,DDL
	MOVE F,C
BQDD:	MOVE F,(F)
	MOVE TT,(F)	
	SOJLE R,BQ11
	JRST BQDD
BQ11:	MOVEI A,(TT)
	MOVEI R,0
	HRRM R,(F)
	MOVE C,A
	JRST BQGESS

BQ5:	MOVE AR2A,[377777777777]
BQ7:	MOVE A,C	;MULTIPLY,SUBTRACT,AND ADD BACK LOOP
	MOVEM AR2A,QHAT
	SETZB AR2A,AR1
	MOVE B,-2(P)
	MOVE D,QHAT
	PUSHJ P,BQSUB
	HLLZS (AR2A)
	TRZ AR2A,777777
	PUSHJ P,BNTRUN
BQ8:	SETOM VETBL0	;QUOTIENT STORING LOOP
	SKIPE REMFL
	JRST BQ9
	MOVE AR1,A
	EXCH TT,AGDBT
	MOVE TT,QHAT
	PUSHJ P,C1CONS
	MOVE F,(P)
	HRRM F,(A)
	HRRM A,(P)
	MOVE A,AR1
	EXCH TT,AGDBT
BQ9:	MOVE B,-1(P)	;BRING DOWN A NEW DVD WORD
	TRNN B,-1
	JRST BQFIN
	MOVE C,(B)
	TRNN C,-1
	JRST BQEFIN
BQ9A:	MOVE AR1,(C)
	TRNN AR1,-1
	JRST BQ9B
	MOVE B,(B)
	MOVE C,(B)
	JRST BQ9A

BQ9B:	MOVEI AR1,0
	HRRM AR1,(B)
	HRRM A,(C)
	HRR A,C
	PUSHJ P,BNTRUN
	MOVE C,A
	JRST BQ1


BQEFIN:	MOVEI  C,0
	HRRM C,-1(P)
	MOVE C,B
	JRST BQ9B

BQSH0:	HLLZS R
	HRRM R,-1(P)
	JRST BQGESS

BQ1DF:	HRRZ A,(C)
	MOVEI R,0
	HRRM R,(C)
	MOVE C,A
BQGESS:	JRST 2,@[.+1]
	MOVE D,DVS1	;CLEARS NO DIVIDE FLAG 
	MOVE T,DD1
	MOVE TT,DD2
	DIV T,D		;Computes Q^ into T
	JSP R,.+1
	TLNE R,40	;If overflow, then Q^ = B-1
	JRST BQ5
	JUMPE T,BQ6	;If Q^ = 0, then no chek, also skip the whole
			;multiply and subtract loop.
	MOVE AR2A,T	;AR2A is the final home for Q^.
	move r,tt	;Place R^ in R
	move f,dd3	;(R,F) is doubleword for left half of inequality
bqchek:	mul t,dvs2	;(T,TT) is doubleword right half of inequality
	camg t,r
	 jrst bqc1
bqc2:	add r,d		;inequality was true, adjust Q^ down and R^ up.
	tlne r,400000	;If R^ overflows then test will fail,
	 soja ar2a,bq7	; and new Q^ is good.
	sosle t,ar2a
	 jrst bqchek
	jrst bq6	;I don't know if this ever happens.  -Alan

bqc1:	caml t,r
	 camg tt,f
	  jrst bq7
	jrst bqc2

;;; I've commented out the following code.  Unlike JonL, I understand what
;;; is supposed to be happening here, and this code was
;;; obviously broken.  I replaced it with the (I believe) correct code
;;; above.  Interested hackers are refered to Volume II of Knuth for the
;;; explanation. 
;;;		-Alan 6/1/83
;;;
;;; BQCHEK:	MUL T,D
;;; 	MOVE R,DD1
;;; 	MOVE F,DD2
;;; 	SUB F,TT
;;; 	TLZ F,400000
;;; 	MOVE R,F
;;; 	MOVE F,DD3
;;; 	MOVE T,DVS2
;;; 	MUL T,AR2A
;;; 	CAMG T,R
;;; 	 JRST BQC1
;;; BQC2:	SOJA AR2A,BQ7
;;; BQC1:	
;;; ;I've commentted out the following code.
;;; ; not that I claim to understand this, but if the quotient is a number of
;;; ; the form 1+2^N for N > 36., then the jump to BQC2 seems to be wrong.
;;; ; also as far as I can tell, no other case gets to that jump instruction.
;;; ; 	- JONL - 12/13/79
;;; 
;;; ;;;	CAMN T,R
;;; ;;;	CAMG TT,F
;;; ;;;	JRST BQ7
;;; ;;;	JRST BQC2
;;; 
;;; 	JRST BQ7

BQFIN:	SKIPE REMFL
	JRST REMFIN
	SETZB A,B
	EXCH A,-1(P)
	PUSHJ P,RECLAIM
	EXCH A,-2(P)	;NOTE: RECLAIM RETURNED NIL
	AOSE NORMF
	PUSHJ P,RECLAIM
	POP P,A
	SUB P,R70+2
	JRST BNTRUN

BQSUB:	MOVEI R,0		;THIS MULTIPLIES DIVISOR BY PARTIAL QUOTIENT ESTIMATE
BQSUB0:	MOVE AR2A,A		;AND SUBTRACTS FROM THE PARTIAL REMAINDER
	MOVE A,(A)		;AND ADDS BACK IF THE ESTIMATE WAS TOO LARGE
	MOVE B,(B)		;THE NEW PARTIAL REMAINDER IS STORED IN
	HLRZ T,B		;THE SAME WORDS AS THE OLD PART. REM.
	MOVE T,(T)
	MUL T,D
	MOVS AR1,A
	ADD TT,R
	TLZE TT,400000
	AOS T
	EXCH TT,(AR1)
	SUBB TT,(AR1)
	TLZE TT,400000
	AOS T
	MOVEM TT,(AR1)
	TRNN B,-1
	JRST BQSUB1
BQSUB7:	TRNN A,-1
	JRST BQSUB3
	MOVE R,T
	JRST BQSUB0

BQSUB1:	JUMPN T,BQSUB6
	MOVE A,C
	POPJ P,

BQSUB6:	MOVEI B,[R70,,NIL]
	JRST BQSUB7

;;; KNUTH SAYS THE FOLLOWING PIECE OF CODE (ADDING BACK) IS
;;; NEEDED IN ONLY ABOUT 3 OR 4 CASES IN 34 BILLION. HERE
;;; ARE TWO NUMBERS ACCIDENTALLY DISCOVERED BY GOSPER WHICH
;;; WILL CAUSE THIS ADDING BACK TO HAPPEN:
;;; THE DIVIDEND IS:
;;;	2791789817939938387128631852330682768655711099796886
;;;		76652915704481188064205113686384821261582354
;;;		6679451522036433421137784129286923496509.
;;; THE DIVISOR IS:
;;;	888654299197548479101428655285643704385285845048283
;;;		973585973531.
;;; TO SEE WHY HE DISCOVERED IT, TRY LOOKING AT THE QUOTIENT!
;;;Unfortunately for this comment, the improved code at BQCHEK now detects
;;;this case early (the case below still causes an addback).  Actually it
;;;is absurdly easy to force the execution of this code.  Pick any two
;;;random bignums A and B and compute (*QUO (SUB1 (TIMES A B)) A).  This
;;;code will almost certainly run (but not always).  -Alan 6/1/83
;;;
;;; HERE ARE TWO MORE NUMBERS WHICH EXCUTE THIS CODE; FURTHERMORE,
;;; THEY CAUSE THE OVER-SUBTRACTED DIVIDEND TO BE SHORTER THAN
;;; THE DIVISOR; THIS IS THE REASON FOR THE COPYING BELOW.
;;; (GOSPER ALSO DISCOVERED THESE NUMBERS!)
;;; THE DIVIDEND IS:
;;;	814814390533794434507378275363751264420699600792121
;;;		5135985742227369051304412442580926595072.
;;; THE DIVISOR IS:
;;;	10889035741470030830827987437816582766593.

;;;This commented out code finally proved totally buggious.  The following
;;;two numbers violate its assumptions about the length of the bignum in C
;;;at this point.  Not being completely in tune with whatever invariants
;;;the original writer of this code knew about the lengths of things, I
;;;have replaced this routine with one that makes less assumptions.  That
;;;should prove more robust in the long run, as well as fixing the present
;;;bug.		-Alan 6/2/83
;;;Dividend:
;;; 561665555565638329055562814312908972367440508802928593356325213525.
;;;Divisor: 432691404877902302377541360768341.
;;;
;;; BQSUB3:	HLLZS (AR2A)		;CHOP OFF END OF ANSWER STORAGE
;;; 	TRZ AR2A,777777
;;; 	MOVE A,C
;;; 	PUSHJ P,BNTRUN		;TRUNCATE ANSWER, WHICH IS A NEGATIVE NUMBER IN POSITIVE FORM
;;; 	PUSH P,A
;;; 	HRRZ A,-4(P)		;GET (ABSOLUTE VALUE OF) DIVISOR
;;; 	PUSHJ P,BCOPY		;MUST COPY IT, OR ELSE CARRY
;;; 	POP P,B			; TRUNCATION MIGHT CLOBBER IT!
;;; 	PUSHJ P,BNADD		;SET UP ANSWER FOR ADD BACK
;;; 	SKIPA B,A
;;; BQSUB4:	MOVE B,(B)		;CHOP OFF CARRY
;;; 	MOVE C,(B)
;;; 	HRRZ AR1,(C)
;;; 	JUMPN AR1,BQSUB4
;;; 	MOVE AR2A,B		;CARRY WILL BE CHOPPED OFF WHEN THIS POPJ'S
;;; 	SOS QHAT		;CORRECT QUOTIENT GUESS
;;; 	POPJ P,

;;;New version:
bqsub3:	sos qhat		;Q^ was one two large, so decrement it
	move a,c		; and add back.
	move b,-3(p)
	setzi r,		;R contains the carry from previous round.
bqsub4:	move ar2a,a		;We perform the same kludge with AR2A that
	move a,(a)		; the main BQSUB0 loop does.
	move b,(b)
	hlrz t,b
	add r,(t)
	hlrz t,a
	add r,(t)
	setzi tt,		;TT contains proposed cary for next round.
	tlze r,400000		;Test for carry.
	 movei tt,1
	movem r,(t)		;smash it in
	move r,tt
	trnn a,-1
	 jrst bqsubz
	trnn b,-1		;Can this happen?  A should never be
	 movei b,[r70,,nil]	; longer than B as I understand things.
	jrst bqsub4		; I don't think it can hurt to do this.

bqsubz:	move a,c
	popj p,

SUBTTL	BIGNUM TO FLONUM CONVERSION

FLBIGF:	JUMPN R,FLBIG
	PUSH P,CFLOAT1
FLBIG:	PUSHJ P,SAVX5	;RECEIVES BIGNUM HEADER IN TT,
	HLRZ A,TT	;LEAVES SIGN BIT IN AC A
	HRRZ T,(TT)	;LEAVES RESULT AS NUMERIC IN TT
	JUMPE T,FLTB1	;SAVES ALL OTHER ACS
	PUSHJ P,FLBIGZ
	FADR TT,D	;ROUND UP
	SKIPE RWG
	JFCL 8.,FLBIGX
	JFCL 8.,FLBIGO
FLBIGX:	JUMPE A,.+2
	MOVNS TT
	MOVEM TT,-3(FXP)
	JRST RSTX5


FLBIGZ:	PUSHJ P,1HAU		;MUST BE > 27. BITS, OR ELSE WOULDN'T BE HERE
	MOVEI T,(TT)
	MOVEI D,27.
	PUSHJ P,1HAI1		;1HAI1 LEAVES TRAILING BITS IN TT+1
	ASH TT+1,-8.
	TLO TT,200000		;INSTALL EXPONENTS
	TLO TT+1,145000
	JFCL 8.,.+1
	TRNE T,-1#377		;INSURE OVERFLOW IF EXPONENT IS TOO LARGE
	TRO T,377
	FSC TT,(T)
	FSC TT+1,(T)
	POPJ P,

FLTB1:	HLRZ TT,(TT)
	MOVE TT,(TT)	;ONE-WORD BIGNUM?
	JSP T,IFLOAT
	MOVE D,TT
	JRST FLBIGX

FLBIGQ:	HRROS (P)	;HACK SO THAT (*QUO <FLONUM> <HUGE-BIGNUM>)
	JRST FLBIG	; WILL CAUSE UNDERFLOW, NOT OVERFLOW

FLBIGO:	PUSHJ P,RSTX5
	POP P,T
	TLNN T,1	;IF BIT 3.1 IS SET, SO IS 4.7 (SEE T7O0)
	JRST OVFLER
	AOJA T,T7O0

SUBTTL	FLONUM TO BIGNUM CONVERSION

FIXBIG:	MOVE TT,T
	MULI TT,400
	JSP T,BNARSV
	MOVE AR1,A
	MOVE F,D
	SUBI TT,200
	IDIVI TT,43
	SETZ R,
	ASHC R,(D)
	MOVE D,TT
	JUMPE R,FXBFQ
	MOVE TT,R
	JSP T,FWCONS
	PUSHJ P,NCONS
	MOVE TT,F
	MOVE C,A
FXBFV:	JSP T,FWCONS
	PUSHJ P,NCONS
	HRRM C,(A)
	MOVEI C,(A)
FXBFZ:	SOJLE D,FBFIN
	MOVEI TT,0
	PUSHJ P,C1CONS
	HRRM C,(A)
	MOVEI C,(A)
	JRST FXBFZ
FBFIN:	SKIPG (AR1)
	TLC A,-1
	JSP T,BNARRS
	JRST BNCONS

FXBFQ:	MOVEI C,0
	MOVE TT,F
	JRST FXBFV

MNSBG:	TLC TT,-1		;MINUS, FOR BIGNUM
	MOVE A,TT
	PUSH P,AR1
	PUSH P,[POP4J]
	PUSHJ P,BNTRSZ		;FOR 100000000000, CONVERT
	MOVE TT,[1_43]		; TO FIXNUM SETZ, ELSE
	JRST FIX1
	JRST BNCONS		; TO A REGULAR BIGNUM
POP4J:	POP P,AR1
	POPJ P,


SUBTTL	ABS AND REMAINDER FOR BIGNUMS

ABSBG0:	MOVE TT,(A)
ABSBG:	JUMPGE TT,CPOPJ		;ABS FOR BIGNUM
	HRRZ A,TT
	JRST BGNMAK

REMBIG:	EXCH A,B
	MOVE D,TT	;REMAINDER FOR BIGNUM
	SETZM PLUS8	;SO THAT ARITHMETIC LOOP WILL RESTORE TO HERE
	SETOM REMFL
	JSP T,NVSKIP
	JRST BNDV	;REMFL WILL STOP ARITHMETIC LOOP
	JRST REM2BN
	JSP T,REMAIR	;FOO! FLONUM ARG NOT COMPREHENSIBLE!

GRBB:	SETZM NORMF	;GREATERP FOR BIGNUM WITH BIGNUM
	MOVE A,D
	MOVE B,TT
	MOVE AR1,D
	MOVE AR2A,TT
	ASH TT,-43
	ASH D,-43
	CAME D,TT
	JRST GRB13
	SETO C,
GRBBL:	TRNN AR1,-1
	JRST GRB1
	TRNN AR2A,-1
	JRST GRB2
	MOVS AR1,(AR1)
	MOVS AR2A,(AR2A)
	MOVE D,(AR1)
	MOVE TT,(AR2A)
	JUMPGE A,.+3
	MOVNS D
	MOVNS TT
	XCT GRESS0
	JRST GRBF
	SETZ C,
GRBR:	MOVSS AR1
	MOVSS AR2A
	JRST GRBBL

SUBTTL	GREATERP AND LESSP FOR BIGNUMS

GRFXB:	SETZM NORMF		;GREATERP FOR FIXNUM WITH BIGNUM
	PUSH FXP,D
	MOVE B,TT
	MOVEI AR2A,QBIGNUM
	MOVEI AR1,QFIXNUM
	TLNE D,400000
	SKIPA D,XC-1
	MOVEI D,1
	JRST GRB14

GRBFX:	SETZM NORMF		;GREATERP FOR BIGNUM WITH FIXNUM
	PUSH FXP,TT
	MOVE A,D
	MOVEI AR1,QBIGNUM
	MOVEI AR2A,QFIXNUM
	TLNE TT,400000
	SKIPA TT,XC-1
	MOVEI TT,1
	JRST GRB14


GRBF:	CAMN D,TT
	JRST GRBR
	SETO C,
	JRST GRBR

GRB1:	TRNN AR2A,-1
	JRST GRBBEL
	MOVEI D,2
	MOVEI TT,4
GRB12:	TLNE A,1
	EXCH D,TT
GRB13:	MOVEI AR1,QBIGNUM
	MOVEI AR2A,QBIGNUM
GRB14:	XCT GRESS0
	SKIPA C,[-1]
	MOVEI C,0
	JRST GRBBE2

GRB2:	SETOM NORMF
	MOVEI D,4
	MOVEI TT,2
	JRST GRB12

GRBBEL:	MOVEI AR1,QBIGNUM
	MOVEI AR2A,QBIGNUM
GRBBE2:	MOVE D,A
	MOVE TT,B
	CAIN AR2A,QFIXNUM
	POP FXP,TT
	CAIN AR1,QFIXNUM
	POP FXP,D
	SKIPE NORMF
	MOVNS C
	SKIPN C
	XCT CSUCE
	XCT CFAIL

SUBTTL	HAIPART FOR BIGNUMS

IFN USELESS,[
1HAI:	JSP T,FXNV2
	JUMPLE D,3HAI
	PUSH FXP,D
	PUSHJ P,1HAU
	POP FXP,D
	CAILE D,35.	
	 JRST 2HAI
	PUSH P,CFIX1
]		;END OF IFN USELESS
				;IN USELESS VERSION, 1HAI CALLED ONLY BY FLBIG
1HAI1:	ADDI R,-35.-1(D)	;FINAL ANSWER FITS IN ONE WORD
	HLRZ D,(F)		;SPREAD OUT HIGH WORD AND
	MOVE D,(D)		;NEXT-TO-HIGH WORD INTO TT,D
	HRRZ TT,(F)
	HLRZ TT,(TT)
	MOVE TT,(TT)
	ASHC TT,(R)
	POPJ P,

IFN USELESS,[
2HAI:	SUBI TT,(D)
	 JUMPLE TT,ABS
	PUSHJ FXP,SAV3	;COPY BIGNUM, BUT TOSS OUT LOW ORDER BITS
	IDIVI TT,35.	;HOW MANY BITS TO THROW AWAY
	MOVEI F,(A)
	HRRZ F,(F)
	SOJGE TT,.-1
	MOVN C,D
	SUBI D,35.
	HLRZ TT,(F)
	MOVE TT,(TT)
	HRRZ F,(F)	;F IS CDR'ING DOWN INPUT
	JUMPE F,2HAI0
	HLRZ T,(F)
	MOVE T,(T)	;C HOLDS AMNT TO SHIFT RIGHT BY
	ASHC T,(C)
	PUSHJ P,C1CONS
	MOVEI B,(A)
2HAI2:	MOVEI R,(A)	;R HAS PTR TO LAST OF FORMING LIST
	HRRZ F,(F)
	JUMPE F,2HAI3
	ASHC T,(D)	;MOVE T INTO TT
	HLRZ T,(F)
	MOVE T,(T)
	ASHC T,(C)
	PUSHJ P,C1CONS
	HRRM A,(R)
	JRST 2HAI2

2HAI0:	ASH TT,(C)	;DEFINITELY A BUG TO COME HERE,SINCE WE
	JSP R,RSTR3
	JRST FIX1	;THINK WE ARE RETURNING A BIGNUM

2HAI3:	JUMPE T,2HAI4
	MOVE TT,T
	PUSHJ P,C1CONS
	HRRM A,(R)
2HAI4:	MOVEI A,(B)
	PUSHJ P,BGNMAK
	POP P,C
	JRST POP2J
]		;END OF IFN USELESS


;;; THE CODE FOR 3HAI IS PUTCODED.


IFN USELESS,[

SUBTTL	GCD FOR BIGNUMS

GCDBG:	MOVEI F,1	;INITIALIZE SMALLNUM MATRIX
	MOVEM F,GCD.A
	MOVEM F,GCD.D
	SETZM GCD.B
	SETZM GCD.C
	HLRZ R,(TT)	;GET LOW ORDER WDS OF ARGS
	MOVE R,(R)
	HLRZ F,(D)
	MOVE T,R	;LOW WD OF U
	IOR R,(F)
	PUSH FXP,R
	JUMPE R,GCDBG4	;BOTH LOW WDS 0
	MOVN R,R
	ANDM R,(FXP)	;GRTST COMMON PWR OF 2 OR 0 IF > 2^35.
	PUSH FXP,(F)	;LOW WD OF V.
	JUMPN T,GCDBG0	;IF T=0 AND (F) EVEN, XTRA PWR OF 2 WILL
	EXCH A,B	; COME BACK FROM RECURSION, SO SWAP TO
	EXCH TT,D	; UNZERO T, THUS GUARANTEEING RECURSION WITH
	EXCH T,(FXP)	; AT LEAST 1 ODD ARG.
GCDBG0:	MOVEI R,(TT)	;GET HI WDS IF SAME LENGTH.
	MOVEI F,(D)
	HRRZ D,(D)
	HRRZ TT,(TT)
	JUMPE D,GCDBG2
	JUMPN TT,GCDBG0
	EXCH A,B		;B IS LONGER THAN A
GCDBG1:	SUB FXP,R70+2
	PUSH P,B		;A IS LONGER THAN B
	PUSHJ P,REMAINDER	;SO GCD(A,B) = GCD(REMAINDER(A,B),B)
	POP P,B
	JRST GCD

GCDBG2:	JUMPN TT,GCDBG1	;U,V UNEQUALLY LONG
	HLRZ R,(R)	;U,V EQUALLY LONG,
	HLRZ F,(F)	; GET ACTUAL HI WDS.
	MOVE TT,(R)
	MOVE D,(F)
	POP FXP,R	;TT,D HAVE HI WDS (OR 0 AND NON0 IF UNEQUAL LENGTH)
	MOVEI F,35.	;T,R HAVE LO WDS
	MOVEM F,GCD.UH	;SHFT CTR
GCDBGU:	TRNE T,1
	JRST GCDBGV	;U IS ODD
GCDBHU:	LSH T,-1
	LSH D,1	;TT RIGHT 1 REL TO D
	JUMPGE D,.+3
	LSH D,-1
	LSH TT,-1
	MOVE F,GCD.C	;HALVING A, B EQUIV TO DOUBLING C,D
	ADDM F,GCD.C
	MOVE F,GCD.D
	ADDM F,GCD.D
	SOSE GCD.UH
	JRST GCDBGU
GCDBG4:	PUSH P,A
	PUSH P,B
	MOVE TT,GCD.A
	PUSHJ P,BNXTIM
	PUSH P,A		;T <- A*U
	MOVE A,-1(P)
	MOVE TT,GCD.B
	PUSHJ P,BNXTIM
	POP P,B
	PUSHJ P,.PLUS		;T <- T+B*V
	PUSHJ P,BNLWFL
	EXCH A,-1(P)
	MOVE TT,GCD.C
	PUSHJ P,BNXTIM
	EXCH A,(P)		;W <- C*U
	MOVE TT,GCD.D
	PUSHJ P,BNXTIM
	POP P,B
	PUSHJ P,.PLUS		;W <- W+D*V
	PUSHJ P,BNLWFL
	POP P,B			;U <- T
	POP FXP,TT
	CAIN TT,1
	JRST GCD
	PUSH FXP,TT
	PUSHJ P,GCD
	MOVEI B,(FXP)
	SKIPN (B)
	MOVEI B,BN235	;CAN ONLY HAPPEN WHEN BOTH LO WDS 0
	PUSHJ P,.TIMES
	SUB FXP,R70+1
	POPJ P,

GCDBGV:	TRNE R,1
	JRST GCDBGO	;BOTH U,V ODD
GCDBHV:	LSH R,-1
	LSH TT,1
	JUMPGE TT,.+3
	LSH TT,-1
	LSH D,-1
	MOVE F,GCD.A
	ADDM F,GCD.A
	MOVE F,GCD.B
	ADDM F,GCD.B
	SOSE GCD.UH
	JRST GCDBGV
	JRST GCDBG4

BNLWFL:	HRRZ B,(A)		;FLUSH LOW 35. ZEROS OF A
	JUMPE B,BNLWXX
	HRRZ B,(B)
	HRRZ TT,(B)		;GCD only permitted to clobber A,B
	JUMPE TT,BNLWFX		;IF BIGNUM BECOMES FIXNUM
	HRRM B,(A)
	POPJ P,

BNLWFX:	HLRZ A,(B)
	POPJ P,

BNLWXX:	SKIPE (A)
	 MOVEI A,IN0-1
	POPJ P,

GCDBGO:	CAML TT,D
	JRST GCDBGT
	SUB D,TT
	SUB R,T
	MOVN F,GCD.A
	ADDM F,GCD.C
	MOVN F,GCD.B
	ADDM F,GCD.D
	JRST GCDBHV

GCDBGT:	SUB TT,D
	SUB T,R
	MOVN F,GCD.C
	ADDM F,GCD.A
	MOVN F,GCD.D
	ADDM F,GCD.B
	JRST GCDBHU


GCDBX:	SKIPN D,(B)		;FIXNUM IS ZERO - RETURN BIGNUM
	JRST ABSBG0		;MAYBE NEED TO TAKE ABS VALUE
	CAMN D,[400000,,]	;CHECK FOR NASTY -400000000000 CASE
	JRST GCDOV
	PUSH P,B		;ELSE TAKE A REMAINDER
	PUSHJ P,REMAINDER
	POP P,B
	JRST .GCD		;GUARANTEED TO HAVE TWO FIXNUMS NOW

GCDOV:	MOVEI B,(A)		;HANDLE NASTY -400000000000 CASES
GCDOV1:	PUSHJ P,ABSOV
	JRST GCD

]		;END OF IFN USELESS


PGTOP BIG,[BIGNUM-ONLY ARITHMETICS]
