/ bas0 -- basic .globl main .globl sin, cos, log, exp, atan, pow .globl atoi, atof, ftoa, ftoo .globl rand, srand one = 40200 main: setd sys time mov r1,r0 mov r0,randx jsr pc,srand sys intr; intrup 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; 14 bes 2f mov r0,tfo sys open; tmpf; 0 bec 1f 2: mov $3f,r0 jsr pc,print sys exit 3: <Tmp file?\n\0>; .even 1: mov r0,tfi jsr pc,isymtab cmp (sp),$2 blt loop mov 4(sp),0f sys open; 0:..; 0 bes 1f mov r0,fi br loop 1: mov $1f,r0 jsr pc,print br loop 1: <Cannot open file\n\0>; .even intrup: mov $'\n,r0 jsr r5,putc jsr r5,error <ready\n\0>; .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; nextc cmp r0,$' / bne 1f 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 <too many lines\n\0>; .even 2: mov r0,(r3)+ mov seeka,(r3)+ mov tfo,r0 sys seek; seeka:..; 0 mov $line,r0 jsr pc,size inc r0 add r0,seeka mov r0,0f mov tfo,r0 sys write; line; 0:.. 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 bne 1b mov (sp)+,r0 rts pc rdline: mov $line,0f 1: mov fi,r0 sys read; 0:..; 1 bes 2f tst r0 beq 2f cmp 0b,$line+99. bhis 2f / bad check, but a check movb *0b,r0 inc 0b cmp r0,$'\n bne 1b clrb *0b 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,putc mov $10,r0 jsr r5,putc 2: movb (r1),r0 jsr r5,putc cmpb (r1)+,$'\n bne 1b jmp loop print: mov r0,0f jsr pc,size mov r0,0f+2 mov $1,r0 sys write; 0:..; .. 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: 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 <out of symbol space\n\0>; .even 1: mov nameb,(r1) mov nameb+2,2(r1) clr 4(r1) clr 14.(r1) rts pc skip: cmp r0,$' / bne 1f movb (r3)+,r0 br skip 1: rts pc putc: tstb drflg beq 1f jsr pc,drput rts r5 1: 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)+,0f mov tfi,r0 sys seek; 0:..; 0 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 <label not found\n\0>; .even 2: rts pc isymtab: mov $symtab,r0 mov $symtnam,r1 clrf fr0 movf $one,fr1 1: mov (r1)+,(r0)+ mov (r1)+,(r0)+ mov $1,(r0)+ subf r1,r0 movf r0,(r0)+ cmp r1,$esymtnam blo 1b clr (r0)+ rts pc