Research V2 development

[unix-history] / cmd / bas0.s

/ 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

       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