; ** (c) Copyright 1981 Massachusetts Institute of Technology ** TITLE RATLAP .FASL .INSRT SYS:.FASL DEFS ; ALL ROUTINES EXPECT MODULUS TO BE EITHER NIL OR 2 ; OR AN ODD NUMBER ; ALL ROUTINES EXCEPT CMOD EXPECT THEIR ARGUMENTS TO BE ; BETWEEN PLUS AND MINUS HMODULUS INCLUSIVE. .BEGIN G9001 .ENTRY CMOD SUBR 0 SKIPN C,.SPECIAL MODULUS POPJ P, EXCH A,C JSP T,NVSKIP JRST MDBIGP EXCH A,C MOVE R,TT JSP T,NVSKIP JRST BIGMOD CAIN R,2 JRST MOD2 IDIV TT,R MODRET: MOVE F,R LSH F,-1 MOVM TT,D CAMLE TT,F SUB TT,R JUMPGE D,FIX1 MOVNS TT JRST FIX1 BIGMOD: CAIN R,2 JRST MOD2A PUSH FXP,R MOVE B,C CALL 2,.FUNCTION REMAINDER MOVE TT,(A) MOVE D,TT POP FXP,R JRST MODRET MOD2A: HLRZ TT,(TT) MOVE TT,(TT) MOD2: ANDI TT,A JRST FIX1 .ENTRY CPLUS SUBR 0 SKIPN C,.SPECIAL MODULUS JCALL 2,.FUNCTION *PLUS EXCH A,C JSP T,NVSKIP JRST CPLBIG MOVE D,(B) MOVE R,(C) EXCH TT,R CAIN R,2 JRST MOD2P ADD D,TT JRST MODRET MOD2P: XOR TT,D JRST MOD2 CPLBIG: EXCH A,C CALL 2,.FUNCTION *PLUS JRST MDBIG1 .ENTRY CTIMES SUBR 0 SKIPN C,.SPECIAL MODULUS JCALL 2,.FUNCTION *TIMES EXCH A,C JSP T,NVSKIP JRST BIGCTM MOVE D,(B) MOVE R,(C) EXCH TT,R CAIN R,2 JRST MOD2T MUL TT,D DIV TT,R JRST MODRET MOD2T: AND TT,D JRST MOD2 BIGCTM: EXCH A,C CALL 2,.FUNCTION *TIMES JRST MDBIG1 .ENTRY CEXPT SUBR 0 SKIPN C,.SPECIAL MODULUS JCALL 2,.FUNCTION EXPT EXCH A,C JSP T,NVSKIP JRST BGCEXP MOVE R,TT EXCH A,B JSP T,NVSKIP JRST BGCEX2 MOVE D,TT EXCH A,C MOVE TT,(A) TDNN TT,[-2 ] POPJ P, CAIN R,2 JRST MOD2 PUSH FXP,R MOVE T,TT MOVE F,D MOVEI D,A TRNE F,A MOVE D,T EXLOOP: LSH F,-1 JUMPE F,XRET MUL T,T DIV T,(FXP) MOVE T,TT TRNN F,A JRST EXLOOP MUL D,T DIV D,(FXP) MOVE D,R JRST EXLOOP XRET: POP FXP,R JRST MODRET BGCEX2: MOVE B,A BGCEXP: MOVE A,C CALL 2,.FUNCTION CBEXPT JRST MDBIG1 .ENTRY CRECIP SUBR 0 MOVE B,.SPECIAL MODULUS EXCH A,B JSP T,NVSKIP JRST INVBIG MOVE D,(B) EXCH TT,D SKIPG TT ADD TT,D MOVEI T, MOVEI F,A PUSH FXP,D LOOP: CAIN TT,A JRST INVRET JUMPE TT,ERR IDIV D,TT IMUL D,F SUB T,D EXCH T,F MOVE D,TT MOVE TT,R JRST LOOP INVRET: MOVE D,F POP FXP,R JRST MODRET ERR: CALL 0,.FUNCTION TERPRI MOVEI A,.ATOM INVERSE/ OF/ ZERO/ DIVISOR? JCALL 1,.FUNCTION MERROR MDBIGP: MOVE A,C MDBIG1: MOVE B,.SPECIAL MODULUS CALL 2,.FUNCTION REMAINDER PUSH P,A CALL 1,.FUNCTION ABS MOVEI B,.ATOM #2 CALL 2,.FUNCTION *TIMES MOVE B,.SPECIAL MODULUS CALL 2,.FUNCTION *GREAT JUMPE A,POPAJ POP P,A MOVE B,.SPECIAL MODULUS SKIPL (A) JCALL 2,.FUNCTION *DIF JCALL 2,.FUNCTION *PLUS INVBIG: EXCH A,B PUSH P,A PUSH P,B SKIPGE (A) CALL 2,.FUNCTION *PLUS MOVEM A,-1(P) INVB2: PUSH P,(P) PUSH P,-2(P) PUSH P,[.ATOM #0 ] PUSH P,[.ATOM #1 ] JSP T,NPUSH+-3 MOVEM A,-10(P) JRST G0035 G0034: MOVE A,-5(P) CALL 1,.FUNCTION ZEROP JUMPN A,ERR MOVE B,-5(P) MOVE A,-6(P) CALL 2,.FUNCTION *QUO MOVE B,-5(P) MOVEM A,-2(P) CALL 2,.FUNCTION *TIMES MOVE B,A MOVE A,-6(P) CALL 2,.FUNCTION *DIF MOVE B,-2(P) MOVEM A,(P) MOVE A,-3(P) CALL 2,.FUNCTION *TIMES MOVE B,A MOVE A,-4(P) CALL 2,.FUNCTION *DIF MOVE AR2A,-5(P) MOVE AR1,(P) MOVE C,-3(P) MOVEM A,-1(P) MOVEM A,-3(P) MOVEM C,-4(P) MOVEM AR1,-5(P) MOVEM AR2A,-6(P) G0035: MOVEI B,.ATOM #1 MOVE A,-5(P) CALL 2,.FUNCTION EQUAL JUMPE A,G0034 MOVE A,-3(P) CALL 1,.FUNCTION CMOD G0048: SUB P,[11,,11] POPJ P, .END G9001 .SXEVAL (AND (NCONC (SETQ PRD19 (QUOTE (#1 #2 #2 #4 #2 #4 #2 #4 #6 #2 #6 ))) (CDDDR PRD19 )) (QUOTE (THIS WAS THE LAP FOR RAT3D /34 DSK RJ F ))) .BEGIN G9002 .ENTRY CFACTOR SUBR 0 PUSH P,A JSP T,SPECBIND .SPECIAL ANS .SPECIAL K PUSH P,[.ATOM #0 ] PUSH P,[.ATOM #2 ] SKIPE .SPECIAL $FACTORFLAG JRST G3216 MOVEI A,.ATOM #1 CALL 1,.FUNCTION NCONS MOVE B,-2(P) CALL 2,.FUNCTION XCONS JRST G3219 G3216: CALL 1,.FUNCTION FLOATP JUMPE A,G3220 MOVEI A,.ATOM FACTOR/ GIVEN/ FLOATING/ ARG CALL 1,.FUNCTION ERROR JRST G3215 G3220: MOVE B,-2(P) MOVEI A,.ATOM #0 CALL 2,.FUNCTION EQUAL JUMPE A,G3222 MOVEI A,.ATOM #1 CALL 1,.FUNCTION NCONS MOVEI B,.ATOM #0 CALL 2,.FUNCTION XCONS JRST G3219 G3222: MOVEI B,.ATOM #-1 MOVE A,-2(P) CALL 2,.FUNCTION EQUAL JUMPE A,G3226 MOVEI A,.ATOM #1 CALL 1,.FUNCTION NCONS MOVEI B,.ATOM #-1 CALL 2,.FUNCTION XCONS JRST G3219 G3226: MOVE A,-2(P) CALL 1,.FUNCTION MINUSP JUMPE A,G3230 MOVE A,-2(P) CALL 1,.FUNCTION MINUS CALL 1,.FUNCTION CFACTOR MOVEI B,.ATOM #1 CALL 2,.FUNCTION XCONS MOVEI B,.ATOM #-1 CALL 2,.FUNCTION XCONS JRST G3219 G3230: MOVEI B,.ATOM #2 MOVE A,-2(P) CALL 2,.FUNCTION *LESS JUMPE A,G3215 MOVEI A,.ATOM #1 CALL 1,.FUNCTION NCONS MOVE B,-2(P) CALL 2,.FUNCTION XCONS JRST G3219 G3215: MOVE AR2A,.SPECIAL PRD19 MOVEM AR2A,.SPECIAL K G3214: MOVE B,(P) MOVE A,-2(P) CALL 2,.FUNCTION REMAINDER MOVE T,(A) JUMPE T,WON MOVE B,(P) CAIN B,.ATOM #5 JRST G005 G3245: HLRZ A,@.SPECIAL K CALL 2,.FUNCTION *PLUS MOVEM A,(P) SKIPE B,.SPECIAL $INTFACLIM CALL 2,.FUNCTION *LESS JUMPE A,FDONE MOVE A,(P) HRRZ B,@.SPECIAL K MOVEM B,.SPECIAL K MOVE B,A CALL 2,.FUNCTION *TIMES MOVE B,-2(P) CALL 2,.FUNCTION *GREAT JUMPE A,G3214 FDONE: MOVEI B,.ATOM #1 MOVE A,-2(P) CALL 2,.FUNCTION *GREAT JUMPE A,G3255 MOVE B,.SPECIAL ANS MOVEI A,.ATOM #1 CALL 2,.FUNCTION CONS MOVE B,-2(P) CALL 2,.FUNCTION XCONS JRST G3219 G3255: MOVE A,.SPECIAL ANS G3219: SUB P,[3,,3] JRST UNBIND WON: MOVE A,-1(P) CALL 1,.FUNCTION ADD1 MOVE B,(P) MOVEM A,-1(P) MOVE A,-2(P) CALL 2,.FUNCTION *QUO MOVEM A,-2(P) MOVE B,(P) CALL 2,.FUNCTION REMAINDER MOVE T,(A) JUMPE T,WON GOTIN: MOVE B,.SPECIAL ANS MOVEI A,.ATOM #0 EXCH A,-1(P) CALL 2,.FUNCTION CONS MOVE B,(P) CALL 2,.FUNCTION XCONS MOVEM A,.SPECIAL ANS MOVE B,(P) G005: MOVE A,-2(P) CAIL B,.ATOM #5 JSP T,NVSKIP JRST G3245 JRST GFAST JRST G3245 GFAST: MOVE D,(B) IDIVI D,36 IMULI D,36 GFASL: MOVE R,TT IDIVI R,7(D) SKIPN F JSP B,GOT1 MOVE R,TT IDIVI R,13(D) SKIPN F JSP B,GOT1 MOVE R,TT IDIVI R,15(D) SKIPN F JSP B,GOT1 MOVE R,TT IDIVI R,21(D) SKIPN F JSP B,GOT1 MOVE R,TT IDIVI R,23(D) SKIPN F JSP B,GOT1 MOVE R,TT IDIVI R,27(D) SKIPN F JSP B,GOT1 MOVE R,TT IDIVI R,35(D) SKIPN F JSP B,GOT1 MOVE R,TT IDIVI R,37(D) SKIPN F JSP B,GOT1 CAIG R,52(D) JRST FDONE ADDI D,36 JRST GFASL GOT1: AOS -1(P) MOVE TT,R IDIVI R,@-3(B) JUMPE F,GOT1 JSP T,FXCONS MOVEM A,-2(P) MOVEI TT,@-3(B) JSP T,FXCONS MOVEM A,(P) JRST GOTIN .END G9002 FASEND