PI - print pi.

build/misc.tcl

@@ -459,6 +459,10 @@ expect ":KILL"
 respond "*" ":midas sys2;ts munch_sysen2;munch\r"
 expect ":KILL"
 
+# PI
+respond "*" ":midas sys3;ts pi_rwg; ran\r"
+expect ":KILL"
+
 # Hunt the Wumpus
 respond "*" ":midas sys1;ts wumpus_games; wumpus\r"
 expect ":KILL"

doc/programs.md

@@ -186,6 +186,7 @@
 - PEEK, system monitoring.
 - PFTHMG, Puff the magic dragon.
 - PHOTO, capture STY session output.
+- PI, print pi.
 - PLAN, creates a PLAN file in your home directory from console input.
 - PORTS, display free network ports.
 - PR, print out various system documentation.

src/rwg/ran.36

@@ -0,0 +1,646 @@
+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,ZET3	;OR ATAN 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