;;; -*-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) 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 ) 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]