github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-02-27 01:09:49 +00:00
Code Issues Releases Wiki Activity
Files
19dfa40b9ec657d65aa21fa88f4d7e5120ac5712
PDP-10.its/src/rat/ratlap.10
Eric Swenson 19dfa40b9e Adds LIBMAX AND MAXTUL FASL files. These are prerequisites for 
building and running Macsyma.  Resolves #710 and #711.
2018-03-09 07:47:00 +01:00

431 lines
6.4 KiB
Plaintext
Executable File
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.
; ** (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
Reference in New Issue View Git Blame Copy Permalink