github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-02-11 10:44:41 +00:00
Code Issues Releases Wiki Activity
Files
6b0673669bcc7486ea4b53a1d858ab07de11ee23
PDP-10.its/src/rwg/ran.37
Lars Brinkhoff f6eb78090e Fix "PI RAM" to print pi rather than Z(3).
2018-10-02 13:12:53 +02:00

646 lines
9.1 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.
TITLE PI RAM
ifdef decsw,[.decrepitude
.insrt sys:dec defs
.decdf]
.MLLIT==1
A=1
B=2
C=3
D=4
E=5
F=6
G=7
H=8
N=9
J=16
P=17
;MEMTOP==66600
GO: IFDEF DECSW,[RESET ? MOVE A,[SIXBIT /DAAAAA/] ? MOVEM A,E2
MOVEI A,[SETOM STOPF ? JRST 2,@.JBOPC]
HRRM A,.JBREN]
.ELSE DSKO=[SIXBIT / !DSKDAAAAA>/]
MOVEI P,PDL
MOVE A,[zero,,zero+1]
BLT A,T+PREC-1
SETZB N,A
SETCAM A,MAXL'
SETCAM A,TCT'
AOS B,Q
MOVEM B,T
func: MOVEI J,ATAN ;OR ZET3 OR LOGX1
DOPEN: PUSHJ P,AOPEN
AG1: PUSHJ P,4FLT
JFCL 8,AGAIN ;OV
CAME E,C
JRST AGAIN
MULI E,400
TSC E,E
ASH F,-243(E)
MOVE D,F
ADDB F,TERM
JUMPE D,FLAVOR
PUSHJ P,BSUB
tlne d,-1
JRST AG1
move f,term
FLAVOR: PUSHJ P,dcout ;OR CfOUT or pfout
SETZM TERM
skipe c,tct
idivi c,2000.
aose wrencf
jumpn d,ag1
pushj p,bclose
jrst dopen
.else JRST AG1
AGAIN: AOSN STOPF ? PUSHJ P,STOP
JFCL 8,.+1
JSP J,(J)
JFCL 8,ACLOSE ;OV
PUSHJ P,TRACE2
MOVMM B,GCN
MOVEI C,Q
PUSHJ P,T1
MOVEI C,S
PUSHJ P,T1
PUSHJ P,RED
jumpe a,again
JRST AG1
T1: HRRM C,T1C ;AQ+R, BQ
JFCL 17,.+1
SETZM CRQ'
SETZM CRR'
HRL C,MAXL
CAIN B,1
JRST TB1
JUMPE A,TA0
HOZFAT: MOVE D,A
MUL D,(C)
TLZ E,400000
ADD E,PREC(C)
JFCL 8,T1O
T1A: ADD E,CRQ
JFCL 8,T1OV
TLZE E,400000
T1B: SUBI D,1
T1K: EXCH E,(C)
MUL E,B
TLZ F,400000
ADD F,CRR
JFCL 8,T1OW
TLZE F,400000
T1D: SUBI E,1
T1E: MOVEM F,PREC(C)
MOVEM D,CRQ
MOVEM E,CRR
AOBJN C,HOZFAT
SKIPE -1(C) ;DUE TO CRETIN MUL BUG
CAME D,[-1]
JUMPN D,HOZFAT
SKIPE F ;MASS ESCHEW SETZ
CAME E,[-1]
JUMPN E,HOZFAT
DPB E,[430100,,PREC-1(C)]
T1G: DPB D,[430100,,-1(C)]
FATHOZ: HLRZ D,C
MOVNS D
ADDB D,MAXL
CAMG D,[-PREC]
MPV: PUSHJ P,ACLOSE
MOVE D,GCN
SOJLE D,CPOPJ
MOVEI C,-1(C)
MOVEI D,0
T1M: SKIPGE E,(C)
SOS D
DIV D,GCN
SKIPGE D,E
ADD D,GCN
T1C: CAIE C,.
SOJA C,T1M
T1N: JUMPE D,CPOPJ
EXCH D,GCN
IDIV D,GCN
MOVE D,E
JRST T1N
T1O: TLCE E,400000
AOJA D,T1A
SOJA D,[jrst 4,T1A]
T1OV: TLZE E,400000
AOJA D,T1K
SOJA D,T1B
T1OW: TLZE F,400000
AOJA E,T1E
SOJA E,T1D
TA0: MOVE E,PREC(C)
EXCH E,(C)
MUL E,B
TLZ F,400000
ADD F,CRR
JFCL 8,TAOW
TLZE F,400000
TAD: SUBI E,1
TAE: MOVEM F,PREC(C)
MOVEM E,CRR
AOBJN C,TA0
SKIPE F
CAME E,[-1]
JUMPN E,TA0
DPB E,[430100,,PREC-1(C)]
JRST FATHOZ
TAOW: TLZE F,400000
AOJA E,TAE
SOJA E,TAD
TB1: MOVE D,A ;AQ+R, Q
MUL D,(C)
TLZ E,400000
ADD E,PREC(C)
JFCL 8,TBO
TBA: ADD E,CRQ
JFCL 8,TBOV
TLZE E,400000
TBB: SUBI D,1
TBK: EXCH E,(C)
MOVEM E,PREC(C)
MOVEM D,CRQ
AOBJN C,TB1
SKIPE -1(C)
CAME D,[-1]
JUMPN D,TB1
JRST T1G
TBO: TLCE E,400000
AOJA D,TBA
SOJA D,TBA
TBOV: TLZE E,400000
AOJA D,TBK
SOJA D,TBB
ran: movei b,4*882.
ranl: jsp j,(j)
move a,n
ash a,2
setcm b,n
sub b,n
imuli b,1(a) ;-(2n+1)(4n+1)
imuli a,21460./4
addi a,1123. ;21460n+1123
jsp j,(j)
movei a,1(n)
muli a,27.
imuli b,1(n) ;kl10 ov bug?
jsp j,(j)
move b,n
ash b,2
addi b,3
jsp j,(j)
move b,[921984.]
imuli b,1(n)
aoja n,ranl
ATAN: MOVEI B,4
JSP J,(J)
MOVEI A,1
MOVEI B,1
ATAL: JSP J,(J)
ADDI A,2
ADD B,A
JRST ATAL
LOGX1: MOVEI B,1 ;X
JSP J,(J)
LOGL: AOS A,N
JSP J,(J)
MOVEI A,2
JSP J,(J)
ADDI B,@LOGX1
AOJA N,LOGL
EXP: MOVEI B,1 ;NUM
MOVEI A,1
JSP J,(J)
EXPD: MOVEI A,1 ;DEN
ADDB A,N
MOVNS B
JSP J,(J)
MOVEI A,2
MOVNS B
JSP J,(J)
ADDI N,@EXPD
JRST EXPD
rdfil: move a,[sixbit /204103/]
movem a,l1+IFNDEF DECSW,2
pushj p,iopen
inp0: pushj p,numg
jsp j,(j)
cain n,101268.
setom wrencf
aoja n,inp0
inp1: cain c,"(
pushj p,.+1
numg: pushj p,toi
tdza a,a
jrst inp1
inp2: imuli a,10.
addi a,-"0(c)
pushj p,toi
jrst inp2
popj p,
toiw:ifdef decsw,close 2, ? releas 2,
aos l1
pushj p,iopen
toi:ifdef decsw,[sosge c,ibuf+2
jrst [in 2, ? jrst .-1 ? jrst toiw]
ildb c,ibuf+1]
ifndef decsw, .iot 2,c ? jumpl c,toiw
caig c,"9
caige c,"0
popj1: aos (p)
popj p,
iopen:ifdef decsw,[open 2,[1 ? sixbit /dsk/ ? ibuf]
jrst 4,.
lookup 2,l1]
ifndef decsw,.open 2,l1
jrst aclose
popj p,
PIF: MOVEI B,8
JSP J,(J)
MOVEI B,15.
PIFL: JSP J,(J)
MOVEI A,7
IMUL A,N
ADDI A,6
MOVEI B,1(N)
ASH B,1
IMULI B,-1(B)
MOVNS B
JSP J,(J)
MOVE A,N
IMULI A,6
ADDI A,7
MULI A,4(A)
IMULI B,3
AOJA N,PIFL
;PIF: MOVEI B,24.
; MOVEM B,R
; MOVNI B,5
; MOVEM B,Q
; MOVEI A,6
; EXCH A,T
;PIFL: MOVE B,N
; ADDI B,1(N)
; IMULI B,3(N) ;(2n+1)(n+3)
; JSP J,(J)
; AOS A,N
; MULI A,27.
; IMULI B,2(N)
; ADDI B,24. ;3(3n+4)(3n+2)
; JSP J,(J)
; AOJA A,PIFL
ZET3: MOVEI B,5 ;ZETA(3)
JSP J,(J)
MOVEI B,4
ZETL: JSP J,(J)
MOVEI A,1
MOVNI B,1(N)
IMULI B,1(N)
IMULI B,1(N)
JSP J,(J)
MOVEI A,1(N)
ADDI A,1(A)
MULI A,2(N)
IMULI B,2(N)
ASH B,1
AOJA N,ZETL
POW: MOVE B,POWD ;(N/D)^(A/B)
IMUL B,POWB
JSP J,(J)
MOVE A,B
ASH B,1
MOVEM B,POWBD'
MOVN B,POWN
ADD B,POWD
MOVEM B,POWM'
IMUL B,POWA
MOVEM B,POWAM'
ADDM B,POWAM
JSP J,(J)
MOVN A,POWB
IMUL A,POWM
SUB A,POWAM
MOVEM A,POWM
POWL: AOS A,N
ADDI A,-1(N)
ADD B,POWM
JSP J,(J)
MOVE A,POWBD
ADD B,POWAM
JSP J,(J)
JRST POWL
POWN: 3
POWD: 4
POWA: 1
POWB: 3 ;RADIUS OF SPHERE OF VOLUME PI
ROOTS: MOVEI N,ROOT2 ;OR ROOT3 OR 7
JSP J,(J)
MOVm B,(N)
JSP J,(J)
MOVE A,1(N)
MOVE N,(N)
IDIVM N,B ;+OR- 1
JSP J,(J)
ASH A,1
JSP J,(J)
AOJA N,.-1
ROOT2: 7645370045.
10812186007.
ROOT3: -5694626340.
9863382151.
ROOT7: -786554688.
2081028097.
ACLOSE: IFDEF DECSW,CLOSE 1, ? RELEAS 1, ? EXIT
.ELSE .CLOSE 1, ? .VALUE [ASCIZ \P/\]
BCLOSE: IFDEF DECSW,CLOSE 1, ? RELEAS 1, ? AOS E2
.ELSE .CLOSE 1,
POPJ P,
STOP: PUSHJ P,BCLOSE
MOVEM 17,ACS+17
MOVEI 17,ACS
BLT 17,ACS+16
ifdef decsw,MOVEI 17,RESUM ? HRRM 17,.JBSA ? EXIT
.else .value
RESUM: MOVSI 17,ACS ? BLT 17,17
HRRZ C,FUNC
CAIE C,RDFIL
JRST AOPEN
MOVEI N,0
MOVEI J,RDFIL
JSP J,(J)
CAME N,ACS+N
JRST .-2
SETZM WRENCF
AOPEN: IFNDEF DECSW,.OPEN 1,.+1 ? SIXBIT / !TTY/
.ELSE [ OPEN 1,[1 ? SIXBIT /DSK/ ? OBUF,,]
JRST 4,.
ENTER 1,E2
JRST 4,.]
POPJ P,
ACS: BLOCK 20
TRACE2: PUSHJ P,PARE
MOVE F,A
MOVE D,B
PUSHJ P,DPT
PUSHJ P,SPACE
JRST TRACEA
PARE: SKIPE TRACEF'
JRST PAREN
POPGJ: POP P,G
POPJ P,
TRACE: PUSHJ P,PARE
TRACEA: PUSHJ P,DPD
NERAP: MOVEI G,")
JRST TYO
PAREN: MOVEI G,"(
JRST TYO
CRLF: PUSH P,G
MOVEI G,^M
PUSHJ P,IOT
SEToM CCT
setzm tol
MOVEI G,^J
PUSHJ P,TYO
JRST POPGJ
DPD: MOVE F,D
DPT: TDZA H,H
DPF: MOVE H,DPL
MOVEM H,DCT'
AOS H,CCT
DPV: IDIV F,BASE
TRC G,"0
HRLM G,(P)
AOSL DCT
JUMPE F,DPW
PUSHJ P,[AOJA H,DPV]
DPU: HLRE G,(P)
MOVMS G
TYO: AOS H,CCT
LINEL: CAILE H,81.
PUSHJ P,CRLF
IOT: IFDEF DECSW,SOSG OBUF+2 ? JRST [OUT 1, ? JRST .+1 ? JRST 4,.] ? IDPB G,OBUF+1
.ELSE .IOT 1,G
CDPU: POPJ P,DPU
DPW: JUMPGE G,LINEL ;-0069 BUG!*********************************
MOVEI G,"-
PUSH P,CDPU
AOJA H,LINEL
4FLT: JFCL 8,.+1
MOVEI C,Q
MOVSI H,-4
4FLP: PUSHJ P,FLT
MOVEM F,FQ(H)
ADDI C,PREC
AOBJN H,4FLP
SKIPN FQ+2
JUMPE F,DONE
FADR F,FQ+2
MOVE C,FQ+1
FADR C,FQ
FDVR C,F
MOVE E,FQ
FDVR E,FQ+2
fad c,cush
fsb c,cush
fad e,cush
fsb e,cush
POPJ P,
cush: 233400,, ;0 or 233400,, for safety or speed
FLT: SETCM D,MAXL
ADD D,C
MOVEI E,377000
SETZM CRY'
FLP: MOVE F,(D)
IDIVI F,400000
TLC F,(E)
TLC G,-21000(E)
FADR F,CRY
FADR F,G ;MUST BE IN THIS ORDER!
SKIPE F
CAME F,CRY
CAIG E,115000
POPJ P,
MOVEM F,CRY
SUBI E,43000
SOJA D,FLP
DONE: IFDEF DECSW,EXIT
.ELSE [.VALUE [ASCIZ /DONEî/]]
DCOUT: AOSN TCT
JRST DCOU1
PUSHJ P,DPF
PUSHJ P,SPACE
MOVE D,BBASE
DCOU2: MOVMM D,GCN
MOVEI C,Q
PUSHJ P,BBMUL
MOVEI C,R
PUSHJ P,BBMUL
RED: SKIPE D,GCN
CAIN D,1
CPOPJ: POPJ P,
PUSHJ P,TRACE
MOVE C,[-4,,Q]
MOVEI E,0
REG: MOVEI G,-1(C)
SUB G,MAXL
HRRM C,REC
REF: SKIPGE F,(G)
SOS E
DIV E,D
JUMPGE F,REM
SOS E
ADD F,D
REM: MOVEM E,(G)
MOVE E,F
REC: CAIE G,.
SOJA G,REF
REE: ADDI C,PREC-1
AOBJN C,REG
JUMPE E,CPOPJ
GCN: 0
DCOU1: PUSHJ P,DPT
HRLZ C,DPL
MOVMM C,CCT
MOVEI D,1
IMUL D,BASE
AOBJN C,.-1
MOVEM D,BBASE'
JRST DCOU2
SPACE: MOVEI G,40
AOS CCT
JRST IOT
BBMUL: HRL C,MAXL
JFCL 17,.+1
SETZM CRR'
MOVEI E,2*PREC(C)
HRRM E,T1C
T2C: MOVE E,(C)
MUL E,BBASE
TLZ F,400000
ADD F,CRR
JFCL 8,T2OW
TLZE F,400000
T2D: SUBI E,1
T2E: MOVEM F,(C)
MOVEM E,CRR
AOBJN C,T2C
SKIPE -1(C)
CAME E,[-1]
JUMPN E,T2C
DPB E,[430100,,-1(C)]
ADDI C,2*PREC
JRST FATHOZ
T2OW: TLZE F,400000
AOJA E,T2E
SOJA E,T2D
IFDEF DECSW,[E2: REPEAT 4,0
OBUF: BLOCK 3
l1: repeat 4,0
]ibuf: block 1+IFDEF DECSW,2
ifndef decsw,l1: sixbit / DSKMERICA204103/
BSUB: JFCL 17,.+1 ;Q-DS
MOVEI C,Q
PUSHJ P,BSB1
MOVEI C,R
BSB1: HRL C,MAXL
SETZM CRQ'
T3L: MOVN E,2*PREC(C)
MUL E,D
TLZ F,400000
ADD F,CRQ
JFCL 8,T3O
T3A: ADD F,(C)
JFCL 8,T3OV
TLZE F,400000
T3B: SUBI E,1
T3C: MOVEM F,(C)
MOVEM E,CRQ
AOBJN C,T3L
JUMPE E,CPOPJ
SKIPN F
(SETZ)
DPB E,[430100,,-1(C)]
AOJE E,CPOPJ
BASE: 10.
DPL: -10.
pfou1: pushj p,crlf
pfout: aos c,tol
caile c,25.
jrst pfou1
caig f,9
skipge f
jrst cfout
imuli c,3
sub c,cct
subi c,3
jumpl c,cfout
pushj p,space
CFOUT: AOS TCT
PUSHJ P,DPT
PUSHJ P,SPACE
MOVEI C,Q
HRL C,MAXL
BEXCH: MOVE D,(C)
EXCH D,2*PREC(C)
MOVEM D,(C)
MOVE D,PREC(C)
EXCH D,3*PREC(C)
MOVEM D,PREC(C)
AOBJN C,BEXCH
POPJ P,
T3O: TLCE F,400000
AOJA E,T3A
SOJA E,T3A
T3OV: TLZE F,400000
AOJA E,T3C
SOJA E,T3B
PAT: BLOCK 77
PDL: OFLO
BLOCK 55
FQ: ASCIZ /DIMENSION FQ(4)/
CONSTA?VARIAB
zero: 0
cct: 0
tol: 0
STOPF: 0
wrencf: 0
TERM: 0
;PREC==<MEMTOP-1-.>/4
PREC==11111.
OFLO: 0
IRPC QRST,,QRST
QRST: BLOCK PREC
TERMIN
-1 ;CRETIN DDT & MIDAS
END GO
Reference in New Issue View Git Blame Copy Permalink