title pimid ram

.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:	reset
	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
	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:
	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:
	pushj p,iopen
toi:	push p,1
	pbin
	move c,1
	pop p,1
	caig c,"9
	caige c,"0
popj1:	aos (p)
	popj p,

iopen:
	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: haltf

BCLOSE:
	POPJ P,

STOP:	PUSHJ P,BCLOSE
	MOVEM 17,ACS+17
	MOVEI 17,ACS
	BLT 17,ACS+16
	haltf
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:
	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:
	push p,1
	move 1,g
	pbout
	pop p,1
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:	haltf
	jrst 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

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