/
/
/ bas0 -- basic
scope = 1
.globl main
.globl sin, cos, log, exp, atan, pow, sqrt
.globl rand, srand
.globl fptrap
.globl fopen, getc
indir = 0 /for indirect sys calls. (not in as)
one = 40200
main:
mov $1,prfile /initial print file
sys signal; 4; fptrap
setd
sys time
mov r1,r0
mov r0,randx
jsr pc,srand
sys signal; 1; _done
sys signal; 2; intrup
tst r0
jeq 1f
sys signal; 2; 1
1:
mov sp,gsp
clr seeka
mov $'a,r1
1:
movb r1,tmpf+8
sys stat; tmpf; line
bes 1f
inc r1
cmp r1,$'z
blos 1b
br 2f
1:
sys creat; tmpf; 600
bes 2f
mov r0,tfo
sys open; tmpf; 0
bec 1f
2:
mov $3f,r0
jsr pc,print
sys exit
3:
; .even
1:
mov r0,tfi
mov gsp,sp
cmp (sp),$2 /is there a file argument
blt noarg
mov 4(sp),r0
mov $argname,r1
1:
movb (r0)+,(r1)+
bne 1b
aftered: / after edit
mov $argname,r0
jsr r5,fopen; iobuf
bes 1f
noarg:
jsr pc,isymtab
br loop
1:
mov $1f,r0
jsr pc,print
br loop
1:
; .even
intrup:
sys signal; 2; intrup
mov $'\n,r0
jsr r5,xputc
jsr r5,error
; .even
loop:
mov gsp,sp
clr lineno
jsr pc,rdline
mov $line,r3
1:
movb (r3),r0
jsr pc,digit
br 1f
jsr r5,atoi
cmp r0,$' /
beq 3f
cmp r0,$' /tab
bne 1f
3:
mov $lintab,r3
mov r1,r0
bgt 2f
jsr pc,serror
2:
cmp r0,(r3)
beq 2f
tst (r3)
beq 2f
add $6,r3
br 2b
2:
cmp r3,$elintab-12.
blo 2f
jsr r5,error
; .even
2:
mov r0,(r3)+
mov seeka,(r3)+
mov tfo,r0
mov seeka,seekx
sys indir; sysseek
mov $line,r0
jsr pc,size
inc r0
add r0,seeka
mov r0,wlen
mov tfo,r0
mov $line,wbuf
sys indir;syswrit
br loop
1:
mov $line,r3
jsr pc,singstat
br loop
nextc:
movb (r3)+,r0
rts r5
size:
clr -(sp)
1:
inc (sp)
cmpb (r0),$'\n
beq 1f
cmpb (r0),$0
beq 1f
inc r0
br 1b
1:
mov (sp)+,r0
rts pc
rdline: / read input (file or tty) to carr. ret.
mov $line,r1
1:
jsr r5,getc; iobuf
bes 2f
tst r0
beq 2f
cmp r1,$line+99.
bhis 2f / bad check, but a check
movb r0,(r1)+
cmpb r0,$'\n
bne 1b
clrb (r1)
rts pc
2:
mov fi,r0
beq 1f
sys close
clr fi
br 1b
1:
jmp _done
error:
tst fi
beq 1f
sys close
clr fi
1:
tst lineno
beq 1f
jsr pc,nextlin
br 1f
mov $line,r0
jsr pc,print
1:
mov r5,r0
jsr pc,print
jmp loop
serror:
dec r3
tst fi
beq 1f
sys close
clr fi
1:
mov $line,r1
1:
cmp r1,r3
bne 2f
mov $'_,r0
jsr r5,xputc
mov $10,r0
jsr r5,xputc
2:
movb (r1),r0
jsr r5,xputc
cmpb (r1)+,$'\n
bne 1b
jmp loop
print:
mov r0,wbuf
jsr pc,size
mov r0,wlen
mov prfile,r0
sys indir; syswrit
rts pc
digit:
cmp r0,$'0
blo 1f
cmp r0,$'9
bhi 1f
add $2,(sp)
1:
rts pc
alpha:
cmp r0,$'a
blo 1f
cmp r0,$'z
bhi 1f
add $2,(sp)
1:
cmp r0,$'A
blo 1f
cmp r0,$'Z
bhi 1f
add $2,(sp)
1:
rts pc
name:
mov $nameb,r1
clr (r1)
clr 2(r1)
1:
cmp r1,$nameb+4
bhis 2f
movb r0,(r1)+
2:
movb (r3)+,r0
jsr pc,alpha
br 2f
br 1b
2:
jsr pc,digit
br 2f
br 1b
2:
mov $resnam,r1
1:
cmp nameb,(r1)
bne 2f
cmp nameb+2,2(r1)
bne 2f
sub $resnam,r1
asr r1
add $2,(sp)
rts pc
2:
add $4,r1
cmp r1,$eresnam
blo 1b
mov $symtab,r1
1:
tst (r1)
beq 1f
cmp nameb,(r1)
bne 2f
cmp nameb+2,2(r1)
bne 2f
rts pc
2:
add $14.,r1
br 1b
1:
cmp r1,$esymtab-28.
blo 1f
jsr r5,error
; .even
1:
mov nameb,(r1)
mov nameb+2,2(r1)
clr 4(r1)
clr 14.(r1)
rts pc
skip:
cmp r0,$' /
beq 1f
cmp r0,$' / tab
bne 2f
1:
movb (r3)+,r0
br skip
2:
rts pc
xputc:
.if scope / for plotting
tstb drflg
beq 1f
jsr pc,drput
rts r5
1:
.endif
mov r0,ch
mov $1,r0
sys write; ch; 1
rts r5
nextlin:
clr -(sp)
mov $lintab,r1
1:
tst (r1)
beq 1f
cmp lineno,(r1)
bhi 2f
mov (sp),r0
beq 3f
cmp (r0),(r1)
blos 2f
3:
mov r1,(sp)
2:
add $6,r1
br 1b
1:
mov (sp)+,r1
beq 1f
mov (r1)+,lineno
mov (r1)+,seekx
mov tfi,r0
sys indir; sysseek
mov tfi,r0
sys read; line; 100.
add $2,(sp)
1:
rts pc
getloc:
mov $lintab,r1
1:
tst (r1)
beq 1f
cmp r0,(r1)
beq 2f
add $6,r1
br 1b
1:
jsr r5,error
argname:
vt:
.even
pname: <\0\0\0\0\0\0>
.even
resnam:
/ prompt is like print without \n (cr)
/ comment
.if scope / for plotting
.endif
eresnam:
symtnam:
esymtnam:
/ indirect sys calls:
sysseek: sys lseek; 0; seekx: 0; 0
syswrit: sys write; wbuf: 0; wlen: 0
sysread: sys read; rbuf: 0; rlen: 0
sysopen: sys open; ofile: 0 ; omode: 0
syscreat: sys creat; cfile: 0; cmode: 0
.bss
drx: .=.+8
dry: .=.+8
drfo: .=.+2
ch: .=.+2
drflg: .=.+2
randx: .=.+2
gsp: .=.+2
forp: .=.+2
exprloc:.=.+2
sstack: .=.+2
sublev: .=.+2
val: .=.+2
splimit: .=.+2 / statement size limit
iflev: .=.+20. / nested if compile stack: 10 deep
ifp: .=.+2 / current pointer to iflev
line: .=.+100.
prfile: .=.+2 / output from _list or _save
tfi: .=.+2 / input file
lastpr: .=.+8 / last printed number
func: .=.+2 / alternate functions, eg: _list or _save
seeka: .=.+2 / seek offset 1
lineno: .=.+2
nameb: .=.+4
tfo: .=.+2
symtab: .=.+2800.; esymtab: / symbol=7wds; symtab for 200
space: .=.+8000.; espace: / code space
exline: .=.+1000.; eexline: / line execute space
lintab: .=.+1800.; elintab: / 3wds per statement = 300 stmts
stack: .=.+800.; estack:
iobuf: fi: .=.+518. / should be acquired??