github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-01-25 19:56:53 +00:00
Code Issues Releases Wiki Activity
Files
5be5d506b97046b100e746f2e62ee716d19dbbdb
PDP-10.its/src/l/bignum.27

1259 lines
27 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
;;; -*-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]
Reference in New Issue View Git Blame Copy Permalink