.globl log2
.globl	getchar
.globl	lookchar
.globl	fsfile
.globl	seekchar
.globl	backspace
.globl	putchar
.globl	alterchar
.globl	move
.globl	rewind
.globl	create
.globl	zero
.globl	allocate
.globl	release
.globl	collect
.globl	w, r, a, l
/
	cmp	(sp)+,$2
	blo	1f
	tst	(sp)+
	mov	(sp)+,0f
	cmpb	*0f,$'-
	beq	8f
	sys	0; 9f
.data
9:
	sys	open; 0:.=.+2; 0
.text
	bec	2f
	mov	$1,r0
	sys	write; 4f; 5f-4f
	sys	exit

/
4:	<Input file.\n>
5:	.even
/
2:
	mov	r0,source
1:
	sys	signal; 2; 1
	ror	r0
	bcs	1f
	sys	signal; 2; case177
1:
8:
	clr	delflag
	mov	$pdl,r5
/
	mov	$10.,r0
	jsr	pc,log2
	mov	r0,log10
	mov	$1,r0
	jsr	pc,allocate
	mov	r1,scalptr
	clr	r0
	jsr	pc,putchar
	clr	r0
	jsr	pc,allocate
	mov	r1,basptr
	mov	$10.,r0
	jsr	pc,putchar
	mov	$1,r0
	jsr	pc,allocate
	mov	r1,inbas
	mov	$10.,r0
	jsr	pc,putchar
	mov	$1,r0
	jsr	pc,allocate
	mov	$10.,r0
	jsr	pc,putchar
	mov	r1,tenptr
	clr	r0
	jsr	pc,allocate
	mov	r1,chptr
	clr	r0
	jsr	pc,allocate
	mov	r1,strptr
	mov	$1,r0
	jsr	pc,allocate
	mov	$2,r0
	jsr	pc,putchar
	mov	r1,sqtemp
	clr	r0
	jsr	pc,allocate
	mov	r1,divxyz
loop:
	tst	delflag
	bne	in177
	mov	sp,errstack
	jsr	pc,readc
	mov	$casetab,r1
1:	tst	(r1)+
	beq	2f
	cmp	r0,(r1)+
	bne	1b
	jmp	*-4(r1)
2:	jmp	eh
/
/
/	case for new line (which is special for apl box)
/
case012:
	br	loop
/
/
/	case q for quit
/
case161:
	cmp	readptr,$readstack+2
	blos	1f
	mov	*readptr,r1
	beq	2f
	jsr	pc,release
2:
	sub	$2,readptr
	mov	*readptr,r1
	beq	2f
	jsr	pc,release
2:
	sub	$2,readptr
	jmp	loop
1:
	sys	exit
/
/
/	case Q for controlled quit
/
case121:
	jsr	pc,pop
	jes	eh
	jsr	pc,length
	cmp	r0,$2
	jhi	eh1
	jsr	pc,rewind
	jsr	pc,getchar
	jmi	eh1
	jsr	pc,release
1:
	cmp	readptr,$readstack
	jlos	eh
	mov	*readptr,r1
	beq	2f
	jsr	pc,release
2:
	sub	$2,readptr
	sob	r0,1b
	jbr	loop
/
/
/	case of delete character
/
case177:
	sys	signal; 2; case177
	mov	$1,delflag
	mov	r0,-(sp)
	mov	2(sp),r0
	cmp	-6(r0),$sys+read
	bne	1f
	sub	$6,2(sp)
	clr	delflag
1:
	mov	(sp)+,r0
	2			/rti
/
in177:
	mov	$' ,ch
	mov	$1,r0
	sys	write; 1f; 1
	clr delflag
	jmp	eh
/
.bss
delflag: .=.+2
.text
1:	<\n>
	.even
/
/
/	case digit
/
case060:
	movb	r0,savec
	jsr	pc,readin
	jsr	pc,push
	br	loop
/
/
/	case _ for negative numbers
/
case137:
	jsr	pc,readin
	jsr	pc,fsfile
	jsr	pc,backspace
	mov	r0,savk
	dec	w(r1)
	jsr	pc,chsign
	mov	savk,r0
	jsr	pc,putchar
	jsr	pc,push
	jbr	loop
/
/
/	case screamer
/
case041:
	jsr	pc,in041
	jbr	loop
/
in041:
	jsr	pc,readc
	cmp	r0,$'<
	jeq	in74a
	cmp	r0,$'=
	jeq	in75a
	cmp	r0,$'>
	jeq	in76a
/
	mov	$field,r1
	movb	r0,(r1)+
1:
	jsr	pc,readc
	movb	r0,(r1)+
	cmpb	r0,$'\n
	bne	1b
	clrb	(r1)+
/
	sys	fork
		br	9f
	sys	wait
	mov	$1,r0
	sys	write; screamer; 2
	rts	pc
9:	sys	exec; 6f; 8f
	sys	exit
.data
8:	6f; 7f; field; 0
6:	</bin/sh\0>
7:	<-c\0>
screamer: <!\n>
	.even
.bss
field:	.=.+70.
.text
/
/
/	case d for duplicate
/
case144:
	cmp	r5,$pdl
	jeq	eh
	clr	r0
	jsr	pc,allocate
	mov	-2(r5),r0
	jsr	pc,move
	jsr	pc,push
	jmp	loop
/
/
/	case z for stack size
/
case172:
	clr	r0
	jsr	pc,allocate
	mov	r5,r3
	sub	$pdl,r3
	asr	r3
2:
	beq	2f
	clr	r2
	dvd	$100.,r2
	mov	r3,r0
	jsr	pc,putchar
	mov	r2,r3
	br	2b
2:
	clr	r0
	jsr	pc,putchar
	jsr	pc,push
	jmp	loop
/
/
/	case c for flush
/
case143:
2:	jsr	pc,pop
	jes	loop
	jsr	pc,release
	br	2b
/
/	case s for save
/
case163:
	tst	sfree
	bne	1f
	jsr	pc,sinit
1:
	jsr	pc,readc
	cmp	r5,$pdl
	bne	2f
	movb	$'s,ch
	jmp	eh
2:
	clr	r2
	cmpb	r0,$128.	/ check for array
	blo	1f
	inc	r2
1:
	asl	r0
	mov	stable(r0),r1
	beq	2f
	mov	r1,r0
	mov	2(r0),r1
	tst	r2
	beq	4f
	mov	r1,-(sp)	/ have array - release elements
	jsr	pc,rewind
1:
	mov	(sp),r1
3:
	jsr	pc,getword
	bes	1f
	tst	r0
	beq	3b
	mov	r0,r1
	jsr	pc,release
	br	1b
1:
	mov	(sp)+,r1
4:
	jsr	pc,release
	jsr	pc,pop
	mov	r1,2(r0)
	jbr	loop
2:
	mov	sfree,stable(r0)
	mov	stable(r0),r0
	mov	(r0),sfree
	beq	symout
	clr	(r0)
	jsr	pc,pop
	mov	r1,2(r0)
	jmp	loop
/
symout:
	mov	$1,r0
	sys	write; 7f; 8f-7f
	jmp	reset
/
7:	<Symbol table overflow.\n>
8:	.even
/
/
sinit:
	mov	$sfree+4,r0
1:
	mov	r0,-4(r0)
	clr	-2(r0)
	add	$4,r0
	cmp	r0,$sfend
	blos	1b
	clr	sfend-4
	rts	pc
/
/
.bss
sfree:	.=.+512.
sfend:
.text
/
/
/	case S for save
/
case123:
	tst	sfree
	bne	1f
	jsr	pc,sinit
1:
	jsr	pc,readc
	cmp	r5,$pdl
	bne	2f
	movb	$'S,ch
	jbr	eh
2:
	clr	r3
	cmp	r0,$128.	/ check for array
	blo	1f
	inc	r3
1:
	asl	r0
	mov	stable(r0),r1
	beq	2f
	mov	sfree,r2
	mov	(r2),sfree
	beq	symout
	mov	stable(r0),(r2)
	mov	r2,stable(r0)
	jsr	pc,pop
	tst	r3
	beq	1f
	jsr	pc,length	/ to make auto arrays work
	cmp	r0,$1
	bhi	1f
	jsr	pc,zero
1:
	mov	r1,2(r2)
	jbr	loop
2:
	mov	sfree,stable(r0)
	mov	stable(r0),r2
	mov	(r2),sfree
	beq	symout
	clr	(r2)
	jsr	pc,pop
	tst	r3
	beq	1f
	jsr	pc,length
	cmp	r0,$1
	bhi	1f
	jsr	pc,zero
1:
	mov	r1,2(r2)
	jbr	loop
/
/
/	case l for load
/
case154:
	jsr	pc,in154
	jmp	loop
/
in154:
	jsr	pc,readc
	clr	r2
	cmp	r0,$128.	/ check for array
	blo	1f
	inc	r2
1:
	asl	r0
	mov	stable(r0),r1
	beq	1f
	mov	2(r1),r1
	mov	r1,-(sp)
	jsr	pc,length
	jsr	pc,allocate
	tst	r2
	beq	2f
	mov	r1,-(sp)	/ have array - copy elements
	mov	2(sp),r1
	jsr	pc,rewind
3:
	mov	2(sp),r1
	jsr	pc,getword
	bes	3f
	tst	r0
	beq	4f
	mov	r0,-(sp)
	mov	r0,r1
	jsr	pc,length
	jsr	pc,allocate
	mov	(sp)+,r0
	jsr	pc,move
	mov	r1,r0
	mov	(sp),r1
	jsr	pc,putword
	br	3b
4:
	clr	r0
	mov	(sp),r1
	jsr	pc,putword
	br	3b
3:
	mov	(sp)+,r1
	jsr	pc,push
	tst	(sp)+
	rts	pc
2:
	mov	(sp)+,r0
	jsr	pc,move
	jsr	pc,push
	rts	pc
1:
	clr	r0
	jsr	pc,allocate
	jsr	pc,putword
	jsr	pc,push
	rts	pc
/
/	case : for save array
/
case072:
	tst	sfree
	bne	1f
	jsr	pc,sinit
1:
	jsr	pc,pop
	jes	eh
	jsr	pc,scalint
	jsr	pc,fsfile
	jsr	pc,backspace
	tst	r0
	jmi	eh1	/ neg. index
	jsr	pc,length
	cmp	r0,$2
	jhi	eh1	/ index too high
	jsr	pc,fsfile
	clr	r3
	cmp	r0,$1
	blo	1f
	beq	2f
	jsr	pc,backspace
	mov	r0,r3
	mul	$100.,r3
2:
	jsr	pc,backspace
	add	r0,r3
	cmp	r3,$2048.
	jhis	eh1	/ index too high
	asl	r3
1:
	jsr	pc,release
	jsr	pc,readc
	cmp	r5,$pdl
	bne	2f
	movb	$':,ch
	jmp	eh
2:
	asl	r0
	mov	stable(r0),r1
	beq	2f
	mov	r1,-(sp)
	mov	2(r1),r1
	mov	l(r1),r0
	sub	a(r1),r0
	sub	$2,r0
	cmp	r3,r0
	blos	1f
	mov	r1,-(sp)	/ need more space
	mov	r3,r0
	add	$2,r0
	jsr	pc,allocate
	jsr	pc,zero
	mov	(sp)+,r0
	jsr	pc,move
	mov	r1,-(sp)
	mov	r0,r1
	jsr	pc,release
	mov	(sp)+,r1
1:
	mov	r1,-(sp)
	mov	r3,r0
	jsr	pc,seekchar
	jsr	pc,getword
	bes	1f
	sub	$2,r(r1)
	tst	r0
	beq	1f
	mov	r0,r1
	jsr	pc,release
1:
	jsr	pc,pop
	jes	eh
	mov	r1,r0
	mov	(sp)+,r1
	jsr	pc,alterchar
	swab	r0
	jsr	pc,alterchar
	mov	(sp)+,r0
	mov	r1,2(r0)
	jmp	loop
2:
	mov	sfree,stable(r0)
	mov	stable(r0),r0
	mov	(r0),sfree
	jeq	symout
	clr	(r0)
	mov	r0,-(sp)
	mov	r3,r0
	add	$2,r0
	jsr	pc,allocate
	jsr	pc,zero
	sub	$2,r0
	jsr	pc,seekchar
	mov	r1,-(sp)
	br	1b
/
/	case ; for load array
/
case073:
	tst	sfree
	bne	1f
	jsr	pc,sinit
1:
	jsr	pc,pop
	jes	eh
	jsr	pc,scalint
	jsr	pc,fsfile
	jsr	pc,backspace
	tst	r0
	jmi	eh1	/ neg. index
	jsr	pc,length
	cmp	r0,$2
	jhi	eh1
	jsr	pc,fsfile
	clr	r3
	cmp	r0,$1
	blo	1f
	beq	2f
	jsr	pc,backspace
	mov	r0,r3
	mul	$100.,r3
2:
	jsr	pc,backspace
	add	r0,r3
	cmp	r3,$2048.
	jhis	eh1	/ index too high
	asl	r3
1:
	jsr	pc,release
	jsr	pc,readc
	asl	r0
	mov	stable(r0),r1
	beq	1f
	mov	2(r1),r1
	jsr	pc,length
	sub	$2,r0
	cmp	r3,r0
	bhi	1f	/ element not here
	mov	r3,r0
	jsr	pc,seekchar
	jsr	pc,getword
	tst	r0
	beq	1f
	mov	r0,r1
	mov	r1,-(sp)
	jsr	pc,length
	jsr	pc,allocate
	mov	(sp)+,r0
	jsr	pc,move
	jsr	pc,push
	jmp	loop
1:
	clr	r0
	jsr	pc,allocate
	jsr	pc,putword
	jsr	pc,push
	jmp	loop
/
/
/	case L for load
/
case114:
	jsr	pc,readc
	clr	r2
	cmp	r0,$128.	/ check for array
	blo	1f
	inc	r2
1:
	asl	r0
	mov	stable(r0),r1
	beq	4f
	mov	(r1),stable(r0)
	mov	sfree,(r1)
	mov	r1,sfree
	mov	2(r1),r1
	tst	r2
	beq	2f
	mov	r1,-(sp)	/ have array - assume a throw away
	jsr	pc,rewind
1:
	mov	(sp),r1
3:
	jsr	pc,getword
	bes	1f
	tst	r0
	beq	3b
	mov	r0,r1
	jsr	pc,release
	br	1b
1:
	mov	(sp)+,r1
2:
	jsr	pc,push
	jbr	loop
4:
	movb	$'L,ch
	jbr	eh
/
/
/	case - for subtract
/
case055:
	jsr	pc,in055
	jmp	loop
/
in055:
	jsr	pc,pop
	jes	eh
	jsr	pc,fsfile
	jsr	pc,backspace
	mov	r0,savk
	dec	w(r1)
	jsr	pc,chsign
	mov	savk,r0
	jsr	pc,putchar
	jsr	pc,push
	br	in053
/
/
/	case + for add
/
case053:
	jsr	pc,in053
	jmp	loop
/
in053:
	jsr	pc,eqk
	mov	$add3,r0
	jsr	pc,binop
	jsr	pc,pop
	mov	savk,r0
	jsr	pc,putchar
	jsr	pc,push
	rts	pc
/
/
/	case * for multiply
/
case052:
	jsr	pc,pop
	jes	eh
	mov	r1,-(sp)
	jsr	pc,pop
	jec	1f
	mov	(sp)+,r1
	jsr	pc,push
	jbr	eh
1:
	jsr	pc,fsfile
	jsr	pc,backspace
	mov	r0,savk2
	dec	w(r1)
	mov	r1,r2
	mov	(sp)+,r1
	jsr	pc,fsfile
	jsr	pc,backspace
	mov	r0,savk1
	dec	w(r1)
	mov	r1,r3
	mov	$mul3,r0
	jsr	pc,binop
	jsr	pc,pop
	cmp	savk1,savk2
	blo	1f
	mov	savk1,r2
	br	2f
1:
	mov	savk2,r2
2:
	cmp	r2,k
	bhis	1f
	mov	k,r2
1:
	add	savk2,savk1
	cmp	r2,savk1
	bhis	1f
	mov	r2,-(sp)
	neg	r2
	add	savk1,r2
	jsr	pc,removc
	mov	(sp)+,r0
2:
	jsr	pc,putchar
	jsr	pc,push
	jmp	loop
1:
	mov	savk1,r0
	br	2b
/
/	r1 = string
/	r2 = count
/	result returned in r1 (old r1 released)
/
removc:
	mov	r1,-(sp)
	jsr	pc,rewind
1:
	cmp	r2,$1
	blos	1f
	jsr	pc,getchar
	sub	$2,r2
	br	1b
1:
	mov	$2,r0
	jsr	pc,allocate
	mov	r1,-(sp)
1:
	mov	2(sp),r1
	jsr	pc,getchar
	bes	1f
	mov	(sp),r1
	jsr	pc,putchar
	mov	r1,(sp)
	br	1b
1:
	cmp	r2,$1
	bne	1f
	mov	(sp),r3
	mov	tenptr,r2
	jsr	pc,div3
	mov	r1,(sp)
	mov	r3,r1
	jsr	pc,release
	mov	r4,r1
	jsr	pc,release
1:
	mov	2(sp),r1
	jsr	pc,release
	mov	(sp)+,r1
	tst	(sp)+
	rts	pc
/
/	case / for divide
/
case057:
	jsr	pc,dscale
	mov	$div3,r0
	jsr	pc,binop
	mov	r4,r1
	jsr	pc,release
	jsr	pc,pop
	mov	savk,r0
	jsr	pc,putchar
	jsr	pc,push
	jmp	loop
/
/
dscale:
	jsr	pc,pop
	jes	eh
	mov	r1,-(sp)
	jsr	pc,pop
	bec	1f
	mov	(sp)+,r1
	jsr	pc,push
	jmp	eh
1:
	mov	r1,-(sp)
	jsr	pc,fsfile
	jsr	pc,backspace
	mov	r0,savk1
	dec	w(r1)
	jsr	pc,rewind
	mov	2(sp),r1
	jsr	pc,fsfile
	jsr	pc,backspace
	mov	r0,savk2
	dec	w(r1)
	mov	k,r2
	sub	savk1,r2
	add	savk2,r2
	mov	k,savk
	mov	(sp)+,r1
	tst	r2
	bmi	1f
	jsr	pc,add0
	br	2f
1:
	neg	r2
	jsr	pc,removc
2:
	mov	r1,r3
	mov	(sp)+,r2
	rts	pc
/
/
/	case % for remaindering
/
case045:
	jsr	pc,dscale
	mov	$div3,r0
	jsr	pc,binop
	jsr	pc,pop
	jsr	pc,release
	mov	r4,r1
	mov	savk1,r0
	add	k,r0
	jsr	pc,putchar
	jsr	pc,push
	jmp	loop
/
/
binop:
	jsr	pc,(r0)
	jsr	pc,push
	mov	r2,r1
	jsr	pc,release
	mov	r3,r1
	jsr	pc,release
	rts	pc
/
eqk:
	jsr	pc,pop
	jes	eh
	mov	r1,-(sp)
	jsr	pc,pop
	bec	1f
	mov	(sp)+,r1
	jsr	pc,push
	jbr	eh
1:
	mov	r1,-(sp)
	mov	2(sp),r1
	jsr	pc,fsfile
	jsr	pc,backspace
	mov	r0,savk1
	dec	w(r1)
	mov	(sp),r1
	jsr	pc,fsfile
	jsr	pc,backspace
	mov	r0,savk2
	dec	w(r1)
	cmp	r0,savk1
	beq	1f
	blo	2f
	mov	savk2,savk
	mov	r0,r2
	sub	savk1,r2
	mov	2(sp),r1
	jsr	pc,add0
	mov	r1,2(sp)
	br	4f
2:
	mov	savk1,r2
	sub	savk2,r2
	mov	(sp),r1
	jsr	pc,add0
	mov	r1,(sp)
1:
	mov	savk1,savk
4:
	mov	2(sp),r3
	mov	(sp)+,r2
	tst	(sp)+
	rts	pc
.bss
savk1:	.=.+2
savk2:	.=.+2
savk:	.=.+2
.text
/
/
/	r2 = count
/	r1 = ptr
/	returns ptr in r1
add0:
	mov	r1,-(sp)
	jsr	pc,length
	jsr	pc,allocate
	clr	r0
1:
	cmp	r2,$1
	blos	1f
	jsr	pc,putchar
	sub	$2,r2
	br	1b
1:
	mov	r1,-(sp)
	mov	2(sp),r1
	jsr	pc,rewind
1:
	jsr	pc,getchar
	bes	1f
	mov	(sp),r1
	jsr	pc,putchar
	mov	r1,(sp)
	mov	2(sp),r1
	br	1b
1:
	cmp	r2,$1
	bne	1f
	mov	(sp),r3
	mov	tenptr,r2
	jsr	pc,mul3
	mov	r1,(sp)
	mov	r3,r1
	jsr	pc,release
1:
	mov	2(sp),r1
	jsr	pc,release
	mov	(sp)+,r1
	tst	(sp)+
	rts	pc
/	case i for input base
/
case151:
	jsr	pc,in151
	jmp	loop
/
in151:
	jsr	pc,pop
	jes	eh
	jsr	pc,scalint
	mov	r1,-(sp)
	mov	inbas,r1
	mov	(sp)+,inbas
	jsr	pc,release
	rts	pc
case111:
	mov	inbas,r1
	jsr	pc,length
	inc	r0
	jsr	pc,allocate
	mov	inbas,r0
	jsr	pc,move
	clr	r0
	jsr	pc,putchar	/scale
	jsr	pc,push
	jmp	loop
/
.bss
inbas:	.=.+2
.data
/
/
/	case o for output base
/
case157:
	jsr	pc,in157
	jmp	loop
/
in157:
	jsr	pc,pop
	jes	eh
	jsr	pc,scalint
	mov	r1,-(sp)
	jsr	pc,length
	jsr	pc,allocate
	mov	(sp),r0
	jsr	pc,move
	jsr	pc,fsfile
	jsr	pc,length
1:
	cmp	r0,$1
	beq	1f
	jsr	pc,backspace
	bpl	2f
	jsr	pc,chsign
	jsr	pc,length
	br	1b
2:
	clr	sav
	mov	r0,-(sp)
2:
	jsr	pc,backspace
	bes	2f
	mov	(sp),r2
	clr	r3
	mul	$100.,r2
	add	r0,r3
	mov	r3,(sp)
	tst	sav
	beq	3f
	mov	r2,r0
	clr	r3
	mov	sav,r2
	mul	$100.,r2
	mov	r3,sav
	add	r0,sav
	br	2b
3:
	mov	r2,sav
	br	2b
2:
	mov	(sp)+,r0
	tst	sav
	beq	2f
	mov	sav,r0
	jsr	pc,log2
	add	$16.,r0
	mov	r0,logo
	br	3f
1:
	jsr	pc,backspace
2:
	tst	r0
	bpl	1f
	mov	$15.,logo
	br	3f
1:
	jsr	pc,log2
	mov	r0,logo
3:
	jsr	pc,release
	mov	basptr,r1
	jsr	pc,release
	mov	(sp),basptr
/
/	set field widths for output
/	and set output digit handling routines
/
	mov	(sp),r1
	mov	$bigout,outdit
	jsr	pc,length
	cmp	r0,$1.
	bne	2f
	jsr	pc,fsfile
	jsr	pc,backspace
	cmp	r0,$16.
	bhi	2f
	mov	$hexout,outdit
2:
	jsr	pc,length
	jsr	pc,allocate
	mov	(sp),r0
	jsr	pc,move
	clr	(sp)
	jsr	pc,fsfile
	jsr	pc,backspace
	bpl	2f
	add	$1.,(sp)
	jsr	pc,chsign
2:
	mov	r1,r2
	mov	$1,r0
	jsr	pc,allocate
	mov	$-1,r0
	jsr	pc,putchar
	mov	r1,r3
	jsr	pc,add3
	jsr	pc,length
	asl	r0
	add	r0,(sp)
	jsr	pc,fsfile
	jsr	pc,backspace
	cmp	r0,$9.
	blos	2f
	add	$1,(sp)
2:
	jsr	pc,release
	mov	r2,r1
	jsr	pc,release
	mov	r3,r1
	jsr	pc,release
	mov	(sp)+,fw
	mov	fw,fw1
	dec	fw1
	cmp	outdit,$hexout
	bne	2f
	mov	$1,fw
	clr	fw1
2:
	mov	$70.,ll
	cmp	fw,$70.
	blo 9f; rts pc; 9:
	mov	$70.,r1
	clr	r0
	dvd	fw,r0
	mov	r0,r1
	mpy	fw,r1
	mov	r1,ll
	rts	pc
case117:
	mov	basptr,r1
	jsr	pc,length
	inc	r0
	jsr	pc,allocate
	mov	basptr,r0
	jsr	pc,move
	clr	r0
	jsr	pc,putchar	/scale
	jsr	pc,push
	jmp	loop
/
.data
fw:	1			/field width for digits
fw1:	0
ll:	70.			/line length
.text
/
/
/	case k for skale factor
/
case153:
	jsr	pc,pop
	jes	eh
	jsr	pc,scalint
	mov	w(r1),r0
	sub	a(r1),r0
	cmp	r0,$1
	jhi	eh1
	jsr	pc,rewind
	jsr	pc,getchar
	jmi	eh1
	mov	r0,k
	mov	r1,-(sp)
	mov	scalptr,r1
	jsr	pc,release
	mov	(sp)+,scalptr
	jmp	loop
/
case113:
	mov	scalptr,r1
	jsr	pc,length
	inc	r0
	jsr	pc,allocate
	mov	scalptr,r0
	jsr	pc,move
	clr	r0
	jsr	pc,putchar
	jsr	pc,push
	jmp	loop
scalint:
	jsr	pc,fsfile
	jsr	pc,backspace
	dec	w(r1)
	mov	r0,r2
	jsr	pc,removc
	rts	pc
/
/	case ^ for exponentiation
/
case136:
	jsr	pc,pop
	jes	eh
	jsr	pc,scalint
	jsr	pc,fsfile
	jsr	pc,backspace
	tst	r0
	bge	1f
	inc	negexp
	jsr	pc,chsign
1:
	jsr	pc,length
	cmp	r0,$3
	jhis	eh1
	mov	r1,r3
	jsr	pc,pop
	jes	eh
	jsr	pc,fsfile
	jsr	pc,backspace
	mov	r0,savk
	dec	w(r1)
	mov	r1,r2
	jsr	pc,exp3
	mov	r1,-(sp)
	mov	r2,r1
	jsr	pc,release
	mov	r3,r1
	jsr	pc,rewind
	jsr	pc,getchar
	mov	r0,-(sp)
	jsr	pc,getchar
	bes	2f
	mov	r0,r1
	mul	$100.,r1
	add	(sp)+,r1
	br	3f
2:
	mov	(sp)+,r1
3:
	mul	savk,r1
	mov	r1,r2
	mov	r3,r1
	jsr	pc,release
	tst	negexp
	bne	4f
	cmp	k,savk
	blo	1f
	mov	k,r3
	br	2f
1:
	mov	savk,r3
2:
	cmp	r3,r2
	bhis	4f
	sub	r3,r2
	mov	(sp)+,r1
	mov	r3,-(sp)
	jsr	pc,removc
	mov	(sp)+,r0
	jsr	pc,putchar
	jsr	pc,push
	br	3f
4:
	mov	(sp)+,r1
	mov	r2,r0
	jsr	pc,putchar
	jsr	pc,push
3:
	tst	negexp
	jeq	loop
	clr	negexp
	jsr	pc,pop
	mov	r1,-(sp)
	mov	$2,r0
	jsr	pc,allocate
	mov	$1,r0
	jsr	pc,putchar
	clr	r0
	jsr	pc,putchar
	jsr	pc,push
	mov	(sp)+,r1
	jsr	pc,push
	jmp	case057
/
.bss
sav:	.=.+2
negexp:	.=.+2
.text
/
/	case v for square root
/
case166:
	jsr	pc,pop
	jes	eh
/
	jsr	pc,fsfile
	jsr	pc,backspace
	mov	r0,savk
	dec	w(r1)
	mov	w(r1),r2
	sub	a(r1),r2
	tst	r2
	beq	sqz
	jsr	pc,backspace
	tst	r0
	jmi	eh1
	mov	k,r2
	asl	r2
	sub	savk,r2
	beq	1f
	blo	2f
	jsr	pc,add0
	br	1f
2:
	neg	r2
	jsr	pc,removc
1:
	jsr	pc,sqrt
	mov	k,r0
	jsr	pc,putchar
	jsr	pc,push
	jmp	loop
/
/
sqz:
	mov	savk,r0
	jsr	pc,putchar
	jsr	pc,push
	jmp	loop
.bss
sqtemp:	.=.+2
.text
/
/
/	case [ for subroutine definition
/
case133:
	clr	-(sp)
	clr	r0
	jsr	pc,allocate
	jsr	pc,push
1:	jsr	pc,readc
	cmp	r0,$']
	bne	3f
	tst	(sp)
	beq	1f
	dec	(sp)
	br	2f
3:
	cmp	r0,$'[
	bne	2f
	inc	(sp)
2:
	jsr	pc,putchar
	br	1b
/
1:	tst	(sp)+
	jmp	loop
/
/
/	case x for execute top of stack
/
case170:
	jsr	pc,in170
	jmp	loop
/
in170:
	jsr	pc,pop
	jes	eh
	mov	r1,-(sp)
	tst	*readptr
	beq	1f
	mov	*readptr,r1
	cmp	r(r1),w(r1)
	bne	1f
	jsr	pc,release
	br	2f
1:
	add	$2,readptr
	cmp	readptr,$readtop
	bhis	1f
2:	mov	(sp)+,r1
	mov	r1,*readptr
	beq	2f
	jsr	pc,rewind
	rts	pc
2:
	jsr	pc,readc
	cmp	r0,$'\n
	beq	3f
	mov	r0,savec
3:
	rts	pc
1:
nderr:
	mov	$1,r0
	sys	write; 1f; 2f-1f
	jmp	reset
1:	<Nesting depth.\n>
2:	.even
/
.data
readptr: readstack
.bss
readstack: .=.+100.
readtop:
.text
/
/	case ? for apl box function
/
case077:
	add	$2,readptr
	cmp	readptr,$readtop
	bhis	nderr
	clr	*readptr
in077:
	mov	source,-(sp)
	clr	source
	jsr	pc,readc
	cmp	r0,$'!
	bne	1f
	jsr	pc,in041
	mov	(sp)+,source
	br	in077
1:
	mov	r0,savec
	clr	r0
	jsr	pc,allocate
2:
	jsr	pc,readc
	jsr	pc,putchar
1:
	jsr	pc,readc
	jsr	pc,putchar
	cmp	r0,$'\\
	beq	2b
	cmp	r0,$'\n
	bne	1b
	mov	(sp)+,source
	mov	r1,*readptr
	jmp	loop
/
/
/	case < for conditional execution
/
case074:
	jsr	pc,in074
	ble	neg074
	jmp	aff074
/
/
/	case !< for conditional execution
/
in74a:
	jsr	pc,in074
	bgt	inneg
	jmp	inaff
/
in074:
	jsr	pc,in055	/go subtract
	jsr	pc,pop
	jsr	pc,length
	tst	r0
	beq	1f
	jsr	pc,fsfile
	jsr	pc,backspace
	jsr	pc,backspace
	tst	r0
1:
	rts	pc
/
aff074:
	jsr	pc,release
	jsr	pc,in154	/load from register
	jmp	case170
/
neg074:
	jsr	pc,release
	jsr	pc,readc
	jmp	loop
/
/
/	case = for conditional execution
/
case075:
	jsr	pc,in074
	beq	aff074
	jmp	neg074
/
/
/	case != for conditional execution
/
in75a:
	jsr	pc,in074
	bne	inaff
	jmp	inneg
/
/
/	case > for conditional execution
/
case076:
	jsr	pc,in074
	bge	neg074
	jmp	aff074
/
/
/	case !> for conditional execution
/
in76a:
	jsr	pc,in074
	blt	inneg
	jmp	inaff
/
inaff:
	jsr	pc,release
	jsr	pc,in154
	jsr	pc,in170
	rts	pc
/
inneg:
	jsr	pc,release
	jsr	pc,readc
	rts	pc
/
err:
	mov	$1,r0
	sys	write; 1f; 2f-1f
	jmp	reset
1:	<Fatal error\n>; 2: .even
/
eh1:
	jsr	pc,release
eh:
	movb	ch,1f+2
	mov	$1,r0
	sys	write; 1f; 2f-1f
	mov	$readstack,readptr
	mov	errstack,sp
	jmp	loop
.data
1:	<(  ) ?\n>
2:	.even
.text
/
/
/	routine to read and convert a number from the
/	input stream.  Numbers beginnig with 0 are
/	converted as octal.  Routine converts
/	up to next nonnumeric.
/
/
readin:
	clr	dp
	clr	dpt
	clr	r0
	jsr	pc,allocate
	mov	r1,-(sp)
	mov	strptr,r1
	jsr	pc,create
	jsr	pc,readc
1:
	cmpb	ch,$'0
	blt	3f
	cmpb	ch,$'9
	bgt	3f
	mov	ch,r0
	sub	$'0,r0
4:
	tst	dp
	beq	8f
	cmp	dpt,$99.
	beq	5f
	inc	dpt
8:
	mov	chptr,r1
	jsr	pc,create
	tst	r0
	beq	2f
	jsr	pc,putchar
2:	mov	r1,chptr
	mov	(sp),r3
	mov	inbas,r2
	jsr	pc,mul3
	mov	r1,(sp)
	mov	r3,r1
	jsr	pc,release
	mov	(sp),r3
	mov	chptr,r2
	jsr	pc,add3
	mov	r1,(sp)
	mov	r3,r1
	jsr	pc,release
5:
	jsr	pc,readc
	mov	r0,ch
	br	1b
3:
	cmpb	ch,$'A
	blt	1f
	cmpb	ch,$'F
	bgt	1f
	mov	ch,r0
	sub	$67,r0
	br	4b
1:
	cmpb	ch,$134		/backslash
	bne	1f
	jsr	pc,readc
	br	5b
1:
	cmpb	ch,$'.
	bne	1f
	tst	dp
	bne	1f
	inc	dp
	clr	dpt
	br	5b
1:
	mov	r0,savec
/
/	scale up or down
2:
	tst	dp
	bne	1f
	mov	(sp)+,r1
	clr	r0
	jsr	pc,putchar
	rts	pc
1:
	mov	(sp),r1
	jsr	pc,scale
	mov	dpt,r0
	jsr	pc,putchar
	tst	(sp)+
	rts	pc
/
.bss
dp:	.=.+2
dpt:	.=.+2
.text
/
scale:
	mov	dpt,r2
	jsr	pc,add0
	mov	r1,-(sp)
	mov	$1,r0
	jsr	pc,allocate
	mov	dpt,r0
	jsr	pc,putchar
	mov	r1,r3
	mov	inbas,r2
	jsr	pc,exp3
	mov	r1,-(sp)
	mov	r3,r1
	jsr	pc,release
	mov	(sp)+,r2
	mov	(sp)+,r3
	jsr	pc,div3
	mov	r1,-(sp)
	mov	r2,r1
	jsr	pc,release
	mov	r3,r1
	jsr	pc,release
	mov	r4,r1
	jsr	pc,release
	mov	(sp)+,r1
	rts	pc
/
/	routine to read another character from the input
/	stream.  If the caller does not want the character,
/	it is to be placed in the cell savec.
/	The routine exits to the system on end of file.
/	Character is returned in r0.
/
/	jsr	pc,readc
/	movb	r0,...
/
/
readc:
	tst	savec
	beq	1f
	movb	savec,r0
	bic	$177400,r0
	clr	savec
	rts	pc
1:
	tst	*readptr
	bne	1f
2:	mov	source,r0
	sys	read; ch; 1
	bes	eof
	tst	r0
	beq	eof
	movb	ch,r0
	bic	$177400,r0
	rts	pc
1:
	mov	r1,-(sp)
	mov	*readptr,r1
	jsr	pc,getchar
	bes	eof1
	bic	$177400,r0
	mov	r0,ch
	mov	(sp)+,r1
	rts	pc
/
eof:
	tst	source
	beq	1f
	clr	source
	br	2b
1:
	sys	exit
/
eof1:
	mov	*readptr,r1
	beq	2f
	jsr	pc,release
2:
	sub	$2,readptr
	mov	(sp)+,r1
	jmp	readc
/
/
/	case p for print
/
case160:
	cmp	r5,$pdl
	jeq	eh
	jsr	pc,in160
	jmp	loop
/
/
in160:
/	mov	$1,r0
/	sys	write; sphdr; 4
	br	1f
/
sphdr:	<    >
	.even
/
1:	cmp	r5,$pdl
	bne	1f
	mov	$1,r0
	sys	write; qm; 1
	mov	$1,r0
	sys	write; nl; 1
	rts	pc
/
/	do the conversion
/
1:
	mov	-2(r5),r1
	jsr	pc,printf
	rts	pc
/
/
/	case f for print the stack
/
case146:
	mov	r5,-(sp)
1:
	cmp	r5,$pdl
	beq	2f
1:
	jsr	pc,in160
	jsr	pc,pop
	cmp	r5,$pdl
	bne	1b
2:
	mov	$stable-2,r2
1:
	tst	(r2)+
	cmp	r2,$stable+254.
	bhi	1f
/
	mov	(r2),r3
	beq	1b
	movb	$'0,7f+3
	mov	r2,r0
	sub	$stable,r0
	asr	r0
	movb	r0,7f+1
3:
	mov	$1,r0
	sys	write; 7f; 8f-7f
.data
7:	<" (0)">
8:	.even
.text
	mov	2(r3),r1
	jsr	pc,printf
	tst	(r3)
	beq	1b
	incb	7b+3
	mov	(r3),r3
	br	3b
1:
	mov	(sp)+,r5
	jbr	loop
/
/
/	routine to convert to decimal and print the
/	top element of the stack.
/
/	jsr	pc,printf
/
/
printf:
	mov	r4,-(sp)
	mov	r3,-(sp)
	mov	r2,-(sp)
	mov	r1,-(sp)
	mov	r0,-(sp)
	clr	-(sp)
	jsr	pc,rewind
2:
	jsr	pc,getchar
	bes	2f
	cmp	r0,$143
	blos	2b
	cmp	r0,$-1
	beq	2b
	bis	$1,(sp)
	br	2b
2:
	tst	(sp)+
	beq	2f
	jsr	pc,length
	mov	r0,0f
	mov	a(r1),3f
	mov	$1,r0
	sys	0; 9f
.data
9:
	sys	write; 3:.=.+2; 0:.=.+2
.text
	jbr	prout
2:
	jsr	pc,fsfile
	jsr	pc,backspace
	bec	1f
	mov	$1,r0
	sys	write; asczero; 1
	jbr	prout
1:
	jsr	pc,length
	mov	r1,-(sp)
	jsr	pc,allocate
	mov	(sp),r0
	mov	r1,(sp)
	jsr	pc,move
	mov	ll,count
/	inc	count
	jsr	pc,fsfile
	jsr	pc,backspace
	mov	r0,savk
	dec	w(r1)
	jsr	pc,backspace
	cmpb	r0,$-1
	bne	2f
	mov	basptr,r1
	jsr	pc,fsfile
	jsr	pc,backspace
	cmp	r0,$-1
	beq	2f
	mov	(sp),r1
	jsr	pc,chsign
	mov	$'-,ch
	jsr	pc,wrchar
	br	1f
2:
/	mov	$' ,ch
/	jsr	pc,wrchar
1:
	mov	strptr,r1
	jsr	pc,create
	mov	basptr,r1
	jsr	pc,length
	cmp	r0,$1
	jlo	dingout
	bne	1f
	jsr	pc,rewind
	jsr	pc,getchar
	cmp	r0,$1.
	jeq	unout
	cmp	r0,$-1
	jeq	dingout
	cmp	r0,$10.
	jeq	tenout
1:
	mov	log10,r1
	mul	savk,r1
	clr	r0
	div	logo,r0
	mov	r0,dout
	clr	ct
1:
	mov	(sp),r3
	mov	savk,r2
	jsr	pc,getdec
	mov	r1,decimal
	clr	dflg
	mov	(sp),r1
	mov	savk,r2
	jsr	pc,removc
	mov	r1,(sp)
1:
	mov	(sp),r3
	mov	basptr,r2
	jsr	pc,div3
	mov	r1,r2
	mov	(sp),r1
	jsr	pc,release
	mov	r2,(sp)
	mov	r4,r1
	jsr	pc,*outdit
	mov	(sp),r1
	jsr	pc,length
	bne	1b
/
	mov	strptr,r1
	jsr	pc,fsfile
1:
	jsr	pc,backspace
	bes	1f
	mov	r0,ch
	jsr	pc,wrchar
	br	1b
1:
	mov	(sp)+,r1
	jsr	pc,release
	tst	savk
	bne	1f
	mov	decimal,r1
	jsr	pc,release
	br	prout
1:
	mov	dot,ch
	jsr	pc,wrchar
	mov	strptr,r1
	jsr	pc,create
	mov	decimal,-(sp)
	inc	dflg
1:
	mov	(sp),r3
	mov	basptr,r2
	jsr	pc,mul3
	mov	r1,(sp)
	mov	r3,r1
	jsr	pc,release
	mov	(sp),r3
	mov	savk,r2
	jsr	pc,getdec
	mov	r1,(sp)
	mov	r3,r1
	mov	savk,r2
	jsr	pc,removc
	jsr	pc,*outdit
	mov	strptr,r1
	inc	ct
	cmp	ct,dout
	blo	1b
	mov	(sp)+,r1
	jsr	pc,release
	mov	strptr,r1
	jsr	pc,rewind
1:
	jsr	pc,getchar
	bes	1f
	mov	r0,ch
	jsr	pc,wrchar
	br	1b
1:
/
/	cleanup, print new line and return
/
prout:	mov	$1,r0
	sys	write; nl; 1
	mov	(sp)+,r0
	mov	(sp)+,r1
	mov	(sp)+,r2
	mov	(sp)+,r3
	mov	(sp)+,r4
	rts	pc
/
/
/
/	r2 = count
/	r3 = pointer (not released)
/
.bss
dflg:	.=.+2
dout:	.=.+2
logo:	.=.+2
log10:	.=.+2
decimal:	.=.+2
.text
getdec:
	mov	r3,-(sp)
	mov	r3,r1
	jsr	pc,rewind
	jsr	pc,length
	jsr	pc,allocate
	mov	r1,-(sp)
1:
	cmp	r2,$1
	blt	1f
	mov	2(sp),r1
	jsr	pc,getchar
	mov	(sp),r1
	jsr	pc,putchar
	mov	r1,(sp)
	sub	$2,r2
	br	1b
1:
	tst	r2
	beq	1f
	mov	tenptr,r2
	mov	(sp),r3
	jsr	pc,mul3
	mov	r1,(sp)
	mov	r3,r1
	jsr	pc,length
	jsr	pc,release
	mov	r0,r3
	jsr	pc,allocate
	mov	r1,-(sp)
	mov	2(sp),r1
	jsr	pc,rewind
2:
	tst	r3
	beq	2f
	jsr	pc,getchar
	mov	(sp),r1
	jsr	pc,putchar
	mov	r1,(sp)
	dec	r3
	mov	2(sp),r1
	br	2b
2:
	clr	r0
	mov	(sp),r1
	jsr	pc,putchar
	mov	2(sp),r1
	jsr	pc,release
	mov	(sp),r3
	mov	tenptr,r2
	jsr	pc,div3
	mov	r1,(sp)
	mov	r3,r1
	jsr	pc,release
	mov	r4,r1
	jsr	pc,release
	mov	(sp)+,r1
	tst	(sp)+
	mov	(sp)+,r3
	rts	pc
1:
	mov	(sp)+,r1
	mov	(sp)+,r3
	rts	pc
tenout:
	mov	savk,ct
	mov	$2,r0
	jsr	pc,allocate
	mov	r1,-(sp)
	mov	2(sp),r1
	jsr	pc,fsfile
	jsr	pc,backspace
	mov	r0,r3
	clr	r2
	dvd	$10.,r2
	beq	1f
3:
	add	$60,r2
	mov	r2,r0
	mov	(sp),r1
	jsr	pc,putchar
	mov	r1,(sp)
1:
	mov	(sp),r1
	add	$60,r3
	mov	r3,r0
	jsr	pc,putchar
	mov	2(sp),r1
1:
	jsr	pc,backspace
	bec	2f
	mov	(sp),r1
	jsr	pc,length
	cmp	r0,ct
	beq	4f
	blo	5f
	sub	ct,r0
	mov	r0,ct
1:
	jsr	pc,getchar
	mov	r0,ch
	jsr	pc,wrchar
	dec	ct
	bne	1b
	jsr	pc,getchar
	bes	6f
	jsr	pc,backspace
4:
	movb	dot,ch
	jsr	pc,wrchar
1:
	jsr	pc,getchar
	bes	1f
	mov	r0,ch
	jsr	pc,wrchar
	br	1b
5:
	sub	r0,ct
	movb	dot,ch
	jsr	pc,wrchar
	mov	$60,ch
5:
	jsr	pc,wrchar
	dec	ct
	bne	5b
	br	1b
1:
6:
	mov	(sp)+,r1
	jsr	pc,release
	mov	(sp)+,r1
	jsr	pc,release
	jbr	prout
2:
	mov	r0,r3
	clr	r2
	dvd	$10.,r2
	br	3b
dot:	<.>
	.even
ct:	.=.+2
/
/
dingout:
	clr	-(sp)
	br	1f
unout:
	mov	$1,-(sp)
1:
	mov	2(sp),r1
	mov	savk,r2
	jsr	pc,removc
	mov	r1,2(sp)
	mov	strptr,r1
	jsr	pc,create
	mov	$-1,r0
	jsr	pc,putchar
	mov	r1,r3
1:
	mov	2(sp),r1
	jsr	pc,length
	beq	1f
	mov	r1,r2
	jsr	pc,add3
	mov	r1,2(sp)
	mov	r2,r1
	jsr	pc,release
	mov	$1,r0
	tst	(sp)
	beq	2f
	mov	$'1,ch
	jsr	pc,wrchar
	br	1b
2:
	tst	delflag
	jne	in177
	sys	write; ding; 3
	br	1b
1:
	tst	(sp)+
	mov	(sp)+,r1
	jsr	pc,release
	jmp	prout
/
ding:	<>			/<bell prefix form feed>
sp5:	<\\\n     >
minus:	<->
one:	<1>
	.even
.bss
count:	.=.+2
.text
/
bigout:
	mov	r1,-(sp)	/big digit
	tst	dflg
	beq	1f
	clr	r0
	jsr	pc,allocate
	mov	r1,tptr
1:
	mov	strptr,r1
	jsr	pc,length
	add	fw,r0
	dec	r0
	mov	r0,-(sp)	/end of field
	clr	-(sp)		/negative
	mov	4(sp),r1
	jsr	pc,length
	bne	2f
	mov	$'0,r0
	tst	dflg
	beq	3f
	mov	tptr,r1
	jsr	pc,putchar
	mov	r1,tptr
	br	1f
3:
	mov	strptr,r1
	jsr	pc,putchar
	br	1f
2:
	mov	4(sp),r1	/digit
	jsr	pc,fsfile
	jsr	pc,backspace
	bpl	2f
	mov	$1,(sp)		/negative
	jsr	pc,chsign
2:
	mov	4(sp),r3	/digit
	mov	r3,r1
	jsr	pc,length
	beq	1f
	mov	tenptr,r2
	jsr	pc,div3
	mov	r1,4(sp)	/digit
	mov	r3,r1
	jsr	pc,release
	mov	r4,r1
	jsr	pc,rewind
	jsr	pc,getchar
	jsr	pc,release
	add	$'0,r0
	tst	dflg
	beq	3f
	mov	tptr,r1
	jsr	pc,putchar
	mov	r1,tptr
	br	2b
3:
	mov	strptr,r1
	jsr	pc,putchar
	br	2b
1:
	tst	dflg
	beq	4f
	mov	tptr,r1
	jsr	pc,length
	cmp	r0,fw1
	bhis	2f
	mov	fw1,r1
	sub	r0,r1
	mov	r1,-(sp)
	mov	strptr,r1
3:
	mov	$'0,r0
	jsr	pc,putchar
	dec	(sp)
	bne	3b
	tst	(sp)+
2:
	mov	tptr,r1
	jsr	pc,fsfile
2:
	mov	tptr,r1
	jsr	pc,backspace
	bes	2f
	mov	strptr,r1
	jsr	pc,putchar
	br	2b
2:
	mov	tptr,r1
	jsr	pc,release
	br	1f
4:
	mov	strptr,r1
	jsr	pc,length
	cmp	r0,2(sp)	/end of field
	bhis	1f
	mov	$'0,r0
	jsr	pc,putchar
	br	1b
1:
	tst	(sp)		/negative
	beq	1f
	mov	$'-,r0
	mov	strptr,r1
	dec	w(r1)
	jsr	pc,putchar
1:
	mov	strptr,r1
	mov	$' ,r0
	jsr	pc,putchar
	tst	(sp)+
	tst	(sp)+
	mov	(sp)+,r1
	jsr	pc,release
	rts	pc
/
.bss
tptr:	.=.+2
tenptr:	.=.+2
.text
/
/
/
hexout:
	mov	r1,-(sp)
	jsr	pc,rewind
	jsr	pc,getchar
	cmp	r0,$16.
	blo	1f
	jmp	err
1:
	add	$60,r0
	cmp	r0,$'9
	blos	2f
	add	$'A-'9-1,r0
2:
	mov	strptr,r1
	jsr	pc,putchar
	mov	(sp)+,r1
	jsr	pc,release
	rts	pc
/
/
wrchar:
	tst	delflag
	jne	in177
	mov	$1,r0
	tst	count
	bne	7f
	sys	write; sp5; 2
	mov	ll,count
	mov	$1,r0
7:
	dec	count
	sys	write; ch; 1
	rts	pc
/
/
/	case P for print an ascii string
/
/
case120:
	jsr	pc,pop
	jes	eh
	jsr	pc,length
	mov	r0,0f
	mov	a(r1),3f
	mov	$1,r0
	sys	0; 9f
	jsr	pc,release
	jmp	loop
.data
9:	sys	write; 3:.=.+2; 0:.=.+2
.text
/
/
/	here for unimplemented stuff
/
junk:
	movb	r0,1f
	mov	$1,r0
	sys	write; 1f; 2f-1f
	jmp	loop
.data
1:	<0 not in switch.\n>
2:	.even
.text
/
/
/
/	routine to place one word onto the pushdown list
/	Error exit to system on overflow.
/
/
push:
	mov	r1,(r5)+
	cmp	r5,$pdltop
	bhis	pdlout
	rts	pc
/
pdlout:
	mov	$1,r0
	sys	write; 1f; 2f-1f
	jmp	reset
1:	<Out of pushdown.\n>
2:	.even
/
/
/	routine to remove one word from the pushdown list
/	carry bit set on empty stack
/
/
/	jsr	pc,pop
/
pop:
	cmp	r5,$pdl
	bhi	1f
	clr	r1
	sec
	rts	pc
1:	mov	-(r5),r1
	clc
	rts	pc
/
/
/
/
.data
outdit:	hexout
.bss
source: .=.+2
savec:	.=.+2
ch:	.=.+2
.text
nl:	<\n>
asczero:	<0>
qm:	<?\n>
	.even
/
.bss
chptr:	.=.+2
strptr:	.=.+2
basptr:	.=.+2
scalptr:	.=.+2
errstack:.=.+2
/
stable:	.=.+512.
.text
casetab:
	case012; 012	/nl
	loop;    040	/sp
	case041; 041	/!
	case045; 045	/%
	case052; 052	/*
	case053; 053	/+
	case055; 055	/-
	case060; 056	/.
	case057; 057	//
	case060; 060	/0
	case060; 061	/1
	case060; 062	/2
	case060; 063	/3
	case060; 064	/4
	case060; 065	/5
	case060; 066	/6
	case060; 067	/7
	case060; 070	/8
	case060; 071	/9
	case072; 072	/:
	case073; 073	/;
	case074; 074	/<
	case075; 075	/=
	case076; 076	/>
	case077; 077	/?
	case060; 101	/A
	case060; 102	/B
	case060; 103	/C
	case060; 104	/D
	case060; 105	/E
	case060; 106	/F
	case111; 111	/I
	case113; 113	/K
	case114; 114	/L
	case117; 117	/O
	case120; 120	/P
	case121; 121	/Q
	case123; 123	/S
	case166;  126	/V
	case170; 130	/X
	case172; 132	/Z
	case133; 133	/[
	case136; 136	/^
	case137; 137	/_
	case143; 143	/c
	case144; 144	/d
	case146; 146	/f
	case151; 151	/i
	case153; 153	/k
	case154; 154	/l
	case157; 157	/o
	case160; 160	/p
	case161; 161	/q
	case163; 163	/s
	case166; 166	/v
	case170; 170	/x
	case172; 172	/z
	0;0
/
.bss
pdl:	.=.+100.
pdltop:
.text

reset:
	clr	r0
	sys	seek; 0; 2
1:
	clr	r0
	sys	read; rathole; 1
	bes	1f
	tst	r0
	beq	1f
	cmpb	rathole,$'q
	bne	1b
1:
	sys	exit
.bss
rathole:	.=.+2
.text