2543 lines
28 KiB
ArmAsm
2543 lines
28 KiB
ArmAsm
.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
|