Research V7 development

Work on file usr/src/cmd/bas/bas.s
Work on file usr/src/cmd/bas/makefile
Work on file usr/src/cmd/plot/makefile
Work on file usr/src/cmd/plot/driver.c
Work on file usr/src/cmd/plot/vplot.c
Work on file usr/src/cmd/plot/chrtab.c

Synthesized-from: v7

diff --git a/usr/src/cmd/bas/bas.s b/usr/src/cmd/bas/bas.s
new file mode 100644 (file)
index 0000000..19c65d0
--- /dev/null
+++ b/usr/src/cmd/bas/bas.s
@@ -0,0 +1,2128 @@
+/
+/
+
+/ 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:
+       <Tmp file?\n\0>; .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:
+       <Cannot open file\n\0>; .even
+
+intrup:
+       sys     signal; 2; intrup
+       mov     $'\n,r0
+       jsr     r5,xputc
+       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
+       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
+               <too many lines\n\0>; .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
+               <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,$' /
+       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
+               <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
+
+/
+/
+
+/ bas1 -- compile
+/
+/    convention:       jsr pc,subrout /test
+/                              br failside
+/                      succeed ...
+
+compile:
+       clr     forp
+       mov     $iflev,ifp /added for if..else..fi
+       mov     $space,r4
+       tst     lineno
+       beq     1f
+       rts     pc
+1:
+       jsr     pc,nextlin
+               br 1f
+       mov     lineno,r0
+       jsr     pc,getloc
+       mov     r4,4(r1)
+       jsr     pc,statement
+               br .+2
+       inc     lineno
+       cmp     r4,$espace+20  / out of code space?
+       blo     1b
+       jsr     r5,error
+               <out of code space\n\0>; .even
+1:
+       tst     forp
+       jne     forer
+       cmp     ifp,$iflev
+       jne     fier   /hanging if..fi
+       mov     $loop,(r4)+
+       rts     pc
+
+singstat:
+       clr     forp
+       mov     $iflev,ifp
+       mov     $exline,r4
+       jsr     pc,statement
+               br 1f
+       cmp     -2(r4),$_asgn
+       beq     1f
+       mov     $_print,(r4)+
+       mov     $_nline,(r4)+
+1:
+       tst     forp
+       jne     forer
+       cmp     r4,$eexline
+       blo     1f
+       jsr     r5,error
+               <out of code space\n\0>; .even
+1:
+       mov     $loop,(r4)+
+       mov     r4,exprloc
+       mov     $exline,r4
+       jmp     execute
+
+statement:
+       mov     $line,r3
+       movb    (r3)+,r0
+       jsr     pc,digit
+               br stat1
+       dec     r3
+       jsr     r5,atoi
+       cmp     r0,$' /
+       beq     1f
+       cmp     r0,$'    /tab
+       beq     1f
+       mov     $line,r3
+       movb    (r3)+,r0
+       br      stat1
+1:
+       mov     $_line,(r4)+
+       mov     r1,(r4)+
+
+stat1:
+       jsr     pc,skip
+       cmp     r0,$'\n
+       bne     .+4
+       rts     pc
+       mov     r3,-(sp)
+       jsr     pc,alpha
+               br 1f
+       jsr     pc,name
+               br 1f
+       tst     (sp)+
+       jsr     pc,skip
+       dec     r3
+       jmp     *2f(r1)
+2:
+       stlist
+       stdone
+       stdone
+       strun
+       stprint
+       stprompt   / prompt is like print except for cr
+       stif
+       stgoto
+       streturn
+       stfor
+       stnext
+       stoctl
+       stsave
+       stdump
+       stfi
+       stelse
+       stedit
+       stcomment
+.if scope    / for plotting on tektronix
+       stdisp
+       stdraw
+       steras
+.endif
+
+1:
+       mov     (sp)+,r3
+       dec     r3
+       jsr     pc,expr
+       cmp     r0,$'\n
+       jne     joe
+       add     $2,(sp)
+       rts     pc
+
+stsave:
+       mov     $_save,func
+       br      1f
+
+stlist:
+       mov     $_list,func
+1:
+       cmp     r0,$'\n
+       bne     1f
+       clrf    r0
+       jsr     pc,const
+       movif   $77777,r0
+       jsr     pc,const
+       br      2f
+1:
+       jsr     pc,expr
+       cmp     r0,$'\n
+       bne     1f
+       mov     $_dup,(r4)+
+       br      2f
+1:
+       dec     r3
+       jsr     pc,expr
+       cmp     r0,$'\n
+       jne     joe
+2:
+       mov     func,(r4)+
+       rts     pc
+
+stdone:
+       cmp     r0,$'\n
+       jne     joe
+       mov     $_done,(r4)+
+       rts     pc
+
+strun:
+       cmp     r0,$'\n
+       jne     joe
+       mov     $_run,(r4)+
+       rts     pc
+
+
+stprompt:
+       clr     -(sp)
+       br      stpr2
+
+stdump:
+       cmp     r0,$'\n
+       jne     joe
+       mov     $_dump,(r4)+
+       rts     pc
+
+stprint:
+       mov     pc,-(sp)
+stpr2:
+       movb    (r3)+,r0
+       jsr     pc,skip
+1:
+       cmp     r0,$'\n
+       beq     2f
+       cmp     r0,$'"
+       beq     1f
+       dec     r3
+       jsr     pc,expr
+       mov     $_print,(r4)+
+       br      1b
+1:
+       mov     $_ascii,(r4)+
+1:
+       movb    (r3)+,(r4)
+       cmpb    (r4),$'"
+       beq     1f
+       cmpb    (r4)+,$'\n
+       bne     1b
+       jbr     joe
+1:
+       add     $2,r4
+       bic     $1,r4
+       br      stpr2
+2:
+       tst     (sp)+
+       beq     1f
+       mov     $_nline,(r4)+
+1:
+       rts     pc
+
+stif:
+       jsr     pc,expr
+       mov     $_if,(r4)+
+       mov     r4,*ifp
+       add     $2,ifp
+       tst     (r4)+
+       jsr     pc,skip
+       cmp     r0,$'\n   / if ... fi
+       beq     1f
+       jsr     pc,stat1
+               br  .+2
+stfi:
+       sub     $2,ifp
+       cmp     ifp,$iflev
+       jlo     fier
+       mov     *ifp,r1  /for jump around if
+       mov     r4,(r1)
+1:
+       rts     pc
+
+fier:
+       jsr     r5,error; <if...else...fi imbalance\n\0>; .even
+
+stelse:
+       mov     $_tra,(r4)+  /jump around else side
+       mov     r4+,-(sp) / save hole
+       tst     (r4)+
+       sub     $2,ifp
+       cmp     ifp,$iflev
+       jlo     fier
+       mov     *ifp,r1
+       mov     r4,(r1)  /fill in jump to else
+       mov     (sp)+,*ifp /save hole for fi
+       add     $2,ifp
+       rts     pc
+
+stedit:  / enter the regular editor <ed>
+       sys fork
+       br      newpr
+       mov     $lintab,r0  / zero out line table during edit
+1:
+       cmp     r0,$elintab  /done
+       beq     1f
+       mov     $0,(r0)+
+       br      1b
+1:
+       sys     unlink; tmpf
+       sys     wait
+       jmp     aftered / start over
+newpr:
+       sys     exec; ed; edarg
+       sys     exit
+ed:    </bin/ed\0> ; .even
+ednm:  <-\n>
+ .even
+edarg: ednm; argname; 0
+
+stcomment:  /comment line
+       cmp     r0,$'\n
+       beq     1f
+       movb    (r3)+,r0
+       br      stcomment
+1:
+       rts     pc
+stgoto:
+       jsr     pc,expr
+       mov     $_goto,(r4)+
+       rts     pc
+
+streturn:
+       cmp     r0,$'\n
+       beq     1f
+       jsr     pc,expr
+       cmp     r0,$'\n
+       bne     joe
+       br      2f
+1:
+       clrf    r0
+       jsr     pc,const
+2:
+       mov     $_return,(r4)+
+       rts     pc
+
+joe:
+       jsr     pc,serror
+
+stfor:
+       mov     r4,-(sp)
+       jsr     pc,e2
+       mov     r4,-(sp)
+       cmp     r0,$'=
+       bne     joe
+       tst     val
+       bne     joe
+       jsr     pc,expr
+       mov     forp,(r4)+      / overlay w _asgn
+       mov     r4,forp
+       cmp     (r4)+,(r4)+     / _tra ..
+       mov     (sp)+,r0
+       mov     (sp)+,r1
+1:
+       mov     (r1)+,(r4)+
+       cmp     r1,r0
+       blo     1b
+       mov     $_fori,(r4)+
+       mov     forp,r1
+       mov     $_tra,(r1)+
+       mov     r4,(r1)+
+       dec     r3
+       jsr     pc,expr
+       mov     $_lesseq,(r4)+
+       mov     $_if,(r4)+
+       mov     forp,(r4)+
+       mov     r4,forp
+       cmp     r0,$'\n
+       beq     1f
+       jsr     pc,stat1
+               br .+2
+       br      stnext
+1:
+       rts     pc
+
+forer:
+       jsr     r5,error; <for/next imbalance\n\0>; .even
+
+stnext:
+       mov     forp,r1
+       beq     forer
+       mov     -(r1),r0
+       mov     -(r0),forp
+       mov     $_ptra,(r4)+
+       mov     $_asgn,(r0)+
+       cmp     (r0)+,(r0)+
+       mov     r0,(r4)+
+       mov     r4,(r1)+
+       rts     pc
+
+stoctl:
+       jsr     pc,expr
+       mov     $_octal,(r4)+
+       rts     pc
+
+.if scope  / for plotting
+stdisp:
+       mov     $_sdisp,(r4)+
+       jsr     pc,stprint
+       mov     $_fdisp,(r4)+
+       rts     pc
+stdraw:
+       jsr     pc,expr
+       dec     r3
+       jsr     pc,expr
+       cmp     r0,$'\n
+       bne     1f
+       movf    $one,r0
+       jsr     pc,const
+       br      2f
+1:
+       dec     r3
+       jsr     pc,expr
+2:
+       mov     $_draw,(r4)+
+       rts     pc
+
+steras:
+       mov     $_erase,(r4)+
+       rts     pc
+.endif
+
+/
+/
+
+/ bas2 -- expression evaluation
+
+expr:
+       jsr     pc,e1
+       jsr     pc,rval
+       rts     pc
+
+/ assignment right to left
+e1:
+       jsr     pc,e2
+       cmp     r0,$'=
+       beq     1f
+       jsr     pc,rval
+       rts     pc
+1:
+       tst     val
+       beq     1f
+       jsr     pc,serror
+1:
+       jsr     pc,e1
+       jsr     r5,op; _asgn
+       rts     pc
+
+/ and or left to right
+e2:
+       jsr     pc,e3
+1:
+       cmp     r0,$'&
+       beq     2f
+       cmp     r0,$'|
+       beq     3f
+       rts     pc
+2:
+       jsr     pc,rval
+       jsr     pc,e3
+       jsr     r5,op; _and
+       br      1b
+3:
+       jsr     pc,rval
+       jsr     pc,e3
+       jsr     r5,op; _or
+       br      1b
+
+/ relation extended relation
+e3:
+       jsr     pc,e4
+       jsr     pc,e3a
+               rts pc
+       clr     -(sp)
+1:
+       mov     r0,-(sp)
+       jsr     pc,e4
+       jsr     pc,rval
+       mov     (sp)+,(r4)+
+       jsr     pc,e3a
+               br 1f
+       mov     $_extr,(r4)+
+       inc     (sp)
+       br      1b
+1:
+       dec     (sp)
+       blt     1f
+       mov     $_and,(r4)+
+       br      1b
+1:
+       tst     (sp)+
+       rts     pc
+
+/ relational operator
+e3a:
+       cmp     r0,$'>
+       beq     1f
+       cmp     r0,$'<
+       beq     2f
+       cmp     r0,$'=
+       beq     3f
+       rts     pc
+1:
+       mov     $_great,r0
+       cmpb    (r3),$'=
+       bne     1f
+       inc     r3
+       mov     $_greateq,r0
+       br      1f
+2:
+       cmpb    (r3),$'>
+       bne     2f
+       inc     r3
+       mov     $_noteq,r0
+       br      1f
+2:
+       mov     $_less,r0
+       cmpb    (r3),$'=
+       bne     1f
+       inc     r3
+       mov     $_lesseq,r0
+       br      1f
+3:
+       cmpb    (r3),$'=
+       beq     2f
+       rts     pc
+2:
+       inc     r3
+       mov     $_equal,r0
+1:
+       jsr     pc,rval
+       add     $2,(sp)
+       rts     pc
+
+/ add subtract
+e4:
+       jsr     pc,e5
+1:
+       cmp     r0,$'+
+       beq     2f
+       cmp     r0,$'-
+       beq     3f
+       rts     pc
+2:
+       jsr     pc,rval
+       jsr     pc,e5
+       jsr     r5,op; _add
+       br      1b
+3:
+       jsr     pc,rval
+       jsr     pc,e5
+       jsr     r5,op; _sub
+       br      1b
+
+/ multiply divide
+e5:
+       jsr     pc,e6
+1:
+       cmp     r0,$'*
+       beq     2f
+       cmp     r0,$'/
+       beq     3f
+       rts     pc
+2:
+       jsr     pc,rval
+       jsr     pc,e6
+       jsr     r5,op; _mult
+       br      1b
+3:
+       jsr     pc,rval
+       jsr     pc,e6
+       jsr     r5,op; _divid
+       br      1b
+
+/ exponential
+e6:
+       jsr     pc,e6a
+1:
+       cmp     r0,$'^
+       beq     2f
+       rts     pc
+2:
+       jsr     pc,rval
+       jsr     pc,e6a
+       jsr     r5,op; _expon
+       br      1b
+
+e6a:
+       movb    (r3)+,r0
+       jsr     pc,skip
+       cmp     r0,$'_
+       bne     1f
+       jsr     pc,e6a
+       jsr     r5,op; _neg
+       rts     pc
+1:
+       dec     r3
+       jsr     pc,e7
+       rts     pc
+/ end of unary -
+
+/ primary
+e7:
+       movb    (r3)+,r0
+       jsr     pc,skip
+       mov     $1,val
+       cmp     r0,$'(
+       bne     1f
+       jsr     pc,e1
+       cmp     r0,$')
+       bne     2f
+       movb    (r3)+,r0
+       br      e7a
+2:
+       jsr     pc,serror
+1:
+       cmp     r0,$'.
+       beq     2f
+       jsr     pc,digit
+               br 1f
+2:
+       dec     r3
+       jsr     r5,atof; nextc
+       jsr     pc,const
+       br      e7a
+1:
+       jsr     pc,alpha
+               br jim
+       jsr     pc,name
+               br 2f
+       jsr     r5,error; <reserved name\n\0>; .even
+2:
+/ try to fix illegal symbol bug:
+       cmp     r4,$eexline
+       bhis    jim
+
+       mov     $_lval,(r4)+
+       mov     r1,(r4)+
+       clr     val
+       br      e7a
+jim:
+       jsr     pc,serror
+
+e7a:
+       jsr     pc,skip
+       cmp     r0,$'(
+       bne     1f
+       jsr     pc,rval
+       jsr     r5,rlist; _funct
+       cmp     r0,$')
+       bne     jim
+       movb    (r3)+,r0
+       br      e7a
+1:
+       cmp     r0,$'[
+       bne     1f
+       tst     val
+       beq     2f
+       jsr     pc,serror
+2:
+       jsr     r5,rlist; _subscr
+       clr     val
+       cmp     r0,$']
+       bne     jim
+       movb    (r3)+,r0
+       br      e7a
+1:
+       rts     pc
+
+op:
+       jsr     pc,rval
+       mov     (r5)+,(r4)+
+       rts     r5
+
+rval:
+       tst     val
+       bne     1f
+       mov     $_rval,(r4)+
+       inc     val
+1:
+       rts     pc
+
+const:
+       mov     r0,-(sp)
+       movf    r1,-(sp)
+       tstf    r0
+       cfcc
+       bne     1f
+       mov     $_con0,(r4)+
+       br      2f
+1:
+       cmpf    $one,r0
+       cfcc
+       bne     1f
+       mov     $_con1,(r4)+
+       br      2f
+1:
+       movfi   r0,r0
+       movif   r0,r1
+       cmpf    r0,r1
+       cfcc
+       bne     1f
+       mov     $_intcon,(r4)+
+       mov     r0,(r4)+
+       br      2f
+1:
+       mov     $_const,(r4)+
+       movf    r0,(r4)+
+2:
+       movf    (sp)+,r1
+       mov     (sp)+,r0
+       rts     pc
+
+rlist:
+       clr     -(sp)
+       cmpb    (r3),$')
+       bne     1f
+       movb    (r3)+,r0
+       br      2f
+1:
+       inc     (sp)
+       jsr     pc,expr
+       cmp     r0,$',
+       beq     1b
+2:
+       mov     (r5)+,(r4)+
+       mov     (sp)+,(r4)+
+       rts     r5
+
+/
+/
+/ bas3 -- execution
+
+execute:
+       mov     $estack,r3
+       mov     r3,sstack
+       jmp     *(r4)+
+
+_if:
+       tstf    (r3)+
+       cfcc
+       beq     _tra
+       tst     (r4)+
+       jmp     *(r4)+
+
+_ptra:
+       mov     sstack,r3
+
+_tra:
+       mov     (r4)+,r4
+       jmp     *(r4)+
+
+_funct:
+       mov     r4,-(r3)
+       mov     sstack,-(r3)
+       mov     r3,sstack
+       inc     sublev
+       clr     r0
+       jsr     pc,arg
+       tstf    r0
+       cfcc
+       bge     1f
+       jmp     builtin
+
+_goto:
+       movf    (r3),r0
+1:
+       movfi   r0,-(sp)
+       jsr     pc,compile
+       mov     (sp)+,r0
+       jsr     pc,getloc
+       mov     4(r1),r4
+       jmp     *(r4)+
+
+_run:
+       jsr     pc,isymtab
+       mov     randx,r0
+       jsr     pc,srand
+       jsr     pc,compile
+       mov     $space,r4
+       jmp     *(r4)+
+
+_save:    / _save is a _list to the file named on the bas command
+       sys     creat; argname; 666
+       bes     1f
+       mov     r0,prfile
+       br      2f
+1:
+       mov     1f,r0
+       mov     $1,prfile
+       jsr     pc,print
+       br      _done
+1:     <Cannot create b.out\n\0>; .even
+
+_list:
+       mov     $1,prfile
+2:
+       movf    (r3)+,r0
+       movfi   r0,-(sp)
+/ probably vistigal??  mov     r3,0f
+       movf    (r3),r0
+       movfi   r0,lineno
+1:
+       jsr     pc,nextlin
+               br 1f
+       cmp     lineno,(sp)
+       bhi     1f
+       mov     $line,r0
+       jsr     pc,print
+       inc     lineno
+       br      1b
+1:
+       cmp     $1,prfile
+       beq     1f
+       mov     prfile,r0
+       sys     close
+       mov     $1,prfile
+1:
+       tst     (sp)+
+       jmp     *(r4)+
+
+_done:
+       sys     unlink; tmpf
+       sys     exit
+
+.if scope  / for plotting
+_sdisp:
+       mov     $2,r0
+       jsr     pc,drput
+       jsr     pc,drxy
+       mov     $1,r0
+       jsr     pc,drput
+       mov     $3,r0
+       jsr     pc,drput
+       incb    drflg
+       jmp     *(r4)+
+
+_fdisp:
+       clr     r0
+       jsr     pc,drput
+       clrb    drflg
+       jmp     *(r4)+
+
+_draw:
+       movf    (r3)+,r2
+       movf    (r3)+,r1
+       movf    (r3)+,r0
+       jsr     r5,draw
+       jmp     *(r4)+
+
+_erase:
+       mov     $1,r0
+       jsr     pc,drput
+       mov     $1,r0
+       jsr     pc,drput
+       jmp     *(r4)+
+.endif
+
+_print:
+       movf    (r3)+,r0
+       jsr     r5,ftoa; xputc
+       jmp     *(r4)+
+
+_octal:
+       movf    (r3)+,r0
+       jsr     r5,ftoo; xputc
+       jmp     *(r4)+
+
+_nline:
+       mov     $'\n,r0
+       jsr     r5,xputc
+       jmp     *(r4)+
+
+_ascii:
+       movb    (r4)+,r0
+       cmp     r0,$'"
+       beq     1f
+       jsr     r5,xputc
+       br      _ascii
+1:
+       inc     r4
+       bic     $1,r4
+       jmp     *(r4)+
+
+_line:
+       mov     sstack,r3
+       cmp     r3,$stack+20.
+       bhi     1f
+       jsr     r5,error
+               <out of space\n\0>; .even
+1:
+       mov     (r4)+,lineno
+       jmp     *(r4)+
+
+_or:
+       tstf    (r3)+
+       cfcc
+       bne     stone
+       tstf    (r3)
+       cfcc
+       bne     stone
+       br      stzero
+
+_and:
+       tstf    (r3)+
+       cfcc
+       beq     stzero
+       tstf    (r3)
+       cfcc
+       beq     stzero
+       br      stone
+
+_great:
+       jsr     pc,bool
+       bgt     stone
+       br      stzero
+
+_greateq:
+       jsr     pc,bool
+       bge     stone
+       br      stzero
+
+_less:
+       jsr     pc,bool
+       blt     stone
+       br      stzero
+
+_lesseq:
+       jsr     pc,bool
+       ble     stone
+       br      stzero
+
+_noteq:
+       jsr     pc,bool
+       bne     stone
+       br      stzero
+
+_equal:
+       jsr     pc,bool
+       beq     stone
+
+stzero:
+       clrf    r0
+       br      advanc
+
+stone:
+       movf    $one,r0
+       br      advanc
+
+_extr:
+       movf    r1,r0           / dup for _and in extended rel
+       br      subadv
+
+_asgn:
+       movf    (r3)+,r0
+       mov     (r3)+,r0
+       add     $4,r0
+       bis     $1,(r0)+
+       movf    r0,(r0)
+       br      subadv
+
+_add:
+       movf    (r3)+,r0
+       addf    (r3),r0
+       br      advanc
+
+_sub:
+       movf    (r3)+,r0
+       negf    r0
+       addf    (r3),r0
+       br      advanc
+
+_mult:
+       movf    (r3)+,r0
+       mulf    (r3),r0
+       br      advanc
+
+_divid:
+       movf    (r3)+,r1
+       movf    (r3),r0
+       divf    r1,r0
+       br      advanc
+
+_expon:
+       movf    (r3)+,fr1
+       movf    (r3),fr0
+       jsr     pc,pow
+       bec     advanc
+       jsr     r5,error
+               <Bad exponentiation\n\0>; .even
+
+_neg:  / unary -
+       negf    r0
+       jbr     advanc
+/ end of _neg
+
+_intcon:
+       movif   (r4)+,r0
+       jbr     subadv
+
+_con0:
+       clrf    r0
+       jbr     subadv
+
+_con1:
+       movf    $one,r0
+       jbr     subadv
+
+_const:
+       movf    (r4)+,r0
+
+subadv:
+       movf    r0,-(r3)
+       jmp     *(r4)+
+
+advanc:
+       movf    r0,(r3)
+       jmp     *(r4)+
+
+_rval:
+       jsr     pc,getlv
+       br      subadv
+
+_fori:
+       jsr     pc,getlv
+       addf    $one,r0
+       movf    r0,(r0)
+       br      subadv
+
+_lval:
+       mov     (r4)+,-(r3)
+       jmp     *(r4)+
+
+_dup:
+       movf    (r3),r0
+       br      subadv
+
+_return:
+       dec     sublev
+       bge     1f
+       jsr     r5,error
+               <bad return\n\0>; .even
+1:
+       movf    (r3),r0
+       mov     sstack,r3
+       mov     (r3)+,sstack
+       mov     (r3)+,r4
+       mov     (r4)+,r0
+1:
+       dec     r0
+       blt     advanc
+       add     $8,r3
+       br      1b
+
+_subscr:
+       mov     (r4),r1
+       mpy     $8.,r1
+       add     r1,r3
+       mov     r3,-(sp)
+       mov     (r3),r0
+       mov     (r4)+,-(sp)
+1:
+       dec     (sp)
+       blt     1f
+       movf    -(r3),r0
+       movfi   r0,r2
+       com     r2
+       blt     2f
+       jsr     r5,error
+               <subscript out of range\n\0>; .even
+2:
+       mov     r0,r1
+       mov     4(r0),r0
+       bic     $1,r0
+2:
+       beq     2f
+       cmp     r2,(r0)+
+       bne     3f
+       tst     -(r0)
+       br      1b
+3:
+       mov     (r0),r0
+       br      2b
+2:
+       mov     $symtab,r0
+2:
+       tst     (r0)
+       beq     2f
+       add     $14.,r0
+       br      2b
+2:
+       cmp     r0,$esymtab-28.
+       blo     2f
+       jsr     r5,error
+               <out of symbol space\n\0>; .even
+2:
+       cmp     (r1)+,(r1)+
+       mov     r0,-(sp)
+       clr     14.(r0)
+       mov     r2,(r0)+
+       mov     (r1),r2
+       bic     $1,r2
+       mov     r2,(r0)+
+       clr     (r0)+
+       mov     (sp)+,r0
+       bic     $!1,(r1)
+       bis     r0,(r1)
+       br      1b
+1:
+       tst     (sp)+
+       mov     (sp)+,r3
+       mov     r0,(r3)
+       jmp     *(r4)+
+
+bool:
+       movf    (r3)+,r1        / r1 used in extended rel
+       cmpf    (r3),r1
+       cfcc
+       rts     pc
+
+getlv:
+       mov     (r3)+,r0
+       add     $4,r0
+       bit     $1,(r0)+
+       bne     1f
+       jsr     r5,error;<used before set\n\0>; .even
+1:
+       movf    (r0),r0
+       rts     pc
+
+/
+/
+
+/ bas4 -- builtin functions
+
+builtin:
+       dec     sublev
+       mov     (r3)+,sstack
+       mov     (r3)+,r4
+       movfi   r0,r0
+       com     r0
+       asl     r0
+       cmp     r0,$2f-1f
+       bhis    2f
+       jmp     *1f(r0)
+1:
+       fnarg
+       fnexp
+       fnlog
+       fnsin
+       fncos
+       fnatan
+       fnrand
+       fnexpr
+       fnint
+       fnabs
+       fnsqr
+       fnlast
+2:
+       mov     $-1,r0
+       jsr     pc,getloc               / label not found diagnostic
+
+fnarg:
+       cmp     (r4)+,$1
+       jne     narg
+       movf    (r3),r0
+       movfi   r0,r0
+       jsr     pc,arg
+       br      fnadvanc
+
+fnexp:
+       jsr     r5,fnfn; exp
+       br      fnadvanc
+
+fnlog:
+       jsr     r5,fnfn; log
+       bec     fnadvanc
+       jsr     r5,error
+               <Bad log\n\0>; .even
+
+fnsin:
+       jsr     r5,fnfn; sin
+       bec     fnadvanc
+       jsr     r5,error
+               <Bad sine\n\0>; .even
+
+fncos:
+       jsr     r5,fnfn; cos
+       bec     fnadvanc
+       jsr     r5,error
+               <Bad cosine\n\0>; .even
+
+fnatan:
+       jsr     r5,fnfn; atan
+       bec     fnadvanc
+       jsr     r5,error
+               <Bad arctangent\n\0>; .even
+
+fnrand:
+       tst     (r4)+
+       bne     narg
+       jsr     pc,rand
+       movif   r0,r0
+       divf    $44000,r0
+       jmp     advanc
+
+fnexpr:
+       tst     (r4)+
+       bne     narg
+       mov     r3,-(sp)
+       mov     r4,-(sp)
+       jsr     pc,rdline
+       mov     exprloc,r4
+       mov     $line,r3
+       jsr     pc,expr
+       mov     $_tra,(r4)+
+       mov     (sp)+,(r4)+
+       mov     (sp)+,r3
+       mov     exprloc,r4
+       add     $8,r3
+       jmp     *(r4)+
+
+fnint:
+       cmp     (r4)+,$1
+       bne     narg
+       movf    (r3),r0
+       modf    $one,r0
+       movf    r1,r0
+       br      fnadvanc
+
+fnabs:
+       cmp     (r4)+,$1
+       bne     narg
+       movf    (r3),r0
+       cfcc
+       bge     fnadvanc
+       negf    r0
+       br      fnadvanc
+
+fnlast:
+       tst     (r4)+
+       bne     narg
+       movf    lastpr,fr0
+       jbr     advanc
+
+fnsqr:
+       jsr     r5,fnfn; sqrt
+       bec     fnadvanc
+       jsr     r5,error
+       <Bad square root arg\n\0>; .even
+fnadvanc:
+       add     $8,r3
+       jmp     advanc
+
+narg:
+       jsr     r5,error
+               <arg count\n\0>; .even
+
+arg:
+       tst     sublev
+       beq     1f
+       mov     sstack,r1
+       sub     *2(r1),r0
+       bhi     1f
+2:
+       inc     r0
+       bgt     2f
+       add     $8,r1
+       br      2b
+2:
+       movf    4(r1),r0
+       rts     pc
+1:
+       jsr     r5,error
+               <bad arg\n\0>; .even
+
+fnfn:
+       cmp     (r4)+,$1
+       bne     narg
+       movf    (r3),r0
+       jsr     pc,*(r5)+
+       rts     r5
+
+.if scope / for plotting
+draw:
+       tstf    r2
+       cfcc
+       bne     1f
+       movf    r0,drx
+       movf    r1,dry
+       rts     r5
+1:
+       movf    r0,-(sp)
+       movf    r1,-(sp)
+       mov     $3,r0
+       jsr     pc,drput
+       jsr     pc,drxy
+       movf    (sp)+,r0
+       movf    r0,dry
+       movf    (sp)+,r0
+       movf    r0,drx
+       jsr     pc,drxy
+       rts     r5
+
+drxy:
+       movf    drx,r0
+       jsr     pc,drco
+       movf    dry,r0
+
+drco:
+       tstf    r0
+       cfcc
+       bge     1f
+       clrf    r0
+1:
+       cmpf    $40200,r0               / 1.0
+       cfcc
+       bgt     1f
+       movf    $40177,r0               / 1.0-eps
+1:
+       subf    $40000,r0               / .5
+       mulf    $43200,r0               / 4096
+       movfi   r0,r0
+       mov     r0,-(sp)
+       jsr     pc,drput
+       mov     (sp)+,r0
+       swab    r0
+
+drput:
+       movb    r0,ch
+       mov     drfo,r0
+       bne     1f
+       sys     open; vt; 1
+       bec     2f
+       4
+2:
+       mov     r0,drfo
+1:
+       sys     write; ch; 1
+       rts     pc
+
+.endif
+/ bas4 -- old library routines
+atoi:
+       clr     r1
+       jsr     r5,nextc
+       clr     -(sp)
+       cmp     r0,$'-
+       bne     2f
+       inc     (sp)
+1:
+       jsr     r5,nextc
+2:
+       sub     $'0,r0
+       cmp     r0,$9
+       bhi     1f
+       mpy     $10.,r1
+       bcs     3f / >32k
+       add     r0,r1
+       bcs     3f / >32k
+       br      1b
+1:
+       add     $'0,r0
+       tst     (sp)+
+       beq     1f
+       neg     r1
+1:
+       rts     r5
+3:
+       tst     (sp)+
+       mov     $'.,r0  / faking overflow
+       br      1b
+
+ldfps = 170100^tst
+stfps = 170200^tst
+atof:
+       stfps   -(sp)
+       ldfps   $200
+       movf    fr1,-(sp)
+       mov     r1,-(sp)
+       mov     r2,-(sp)
+       clr     -(sp)
+       clrf    fr0
+       clr     r2
+       jsr     r5,*(r5)
+       cmpb    r0,$'-
+       bne     2f
+       inc     (sp)
+1:
+       jsr     r5,*(r5)
+2:
+       sub     $'0,r0
+       cmp     r0,$9.
+       bhi     2f
+       jsr     pc,dig
+               br      1b
+       inc     r2
+       br      1b
+2:
+       cmpb    r0,$'.-'0
+       bne     2f
+1:
+       jsr     r5,*(r5)
+       sub     $'0,r0
+       cmp     r0,$9.
+       bhi     2f
+       jsr     pc,dig
+               dec r2
+       br      1b
+2:
+       cmpb    r0,$'e-'0
+       bne     1f
+       jsr     r5,atoi
+       sub     $'0,r0
+       add     r1,r2
+1:
+       movf    $one,fr1
+       mov     r2,-(sp)
+       beq     2f
+       bgt     1f
+       neg     r2
+1:
+       cmp     r2,$38.
+       blos    1f
+       clrf    fr0
+       tst     (sp)+
+       bmi     out
+       movf    $huge,fr0
+       br      out
+1:
+       mulf    $ten,fr1
+       sob     r2,1b
+2:
+       tst     (sp)+
+       bge     1f
+       divf    fr1,fr0
+       br      2f
+1:
+       mulf    fr1,fr0
+       cfcc
+       bvc     2f
+       movf    $huge,fr0
+2:
+out:
+       tst     (sp)+
+       beq     1f
+       negf    fr0
+1:
+       add     $'0,r0
+       mov     (sp)+,r2
+       mov     (sp)+,r1
+       movf    (sp)+,fr1
+       ldfps   (sp)+
+       tst     (r5)+
+       rts     r5
+
+dig:
+       cmpf    $big,fr0
+       cfcc
+       blt     1f
+       mulf    $ten,fr0
+       movif   r0,fr1
+       addf    fr1,fr0
+       rts     pc
+1:
+       add     $2,(sp)
+       rts     pc
+
+one    = 40200
+ten    = 41040
+big    = 56200
+huge   = 77777
+
+.globl _ndigits
+.globl ecvt
+.globl fcvt
+
+ftoa:
+       movf    fr0,lastpr
+       jsr     pc,ecvt
+       mov     r0,bufptr
+       tstb    r1
+       beq     1f
+       mov     $'-,r0
+       jsr     r5,*(r5)
+1:
+       cmp     r3,$-2
+       blt     econ
+       cmp     r2,$-5
+       ble     econ
+       cmp     r2,$6
+       bgt     econ
+       jsr     pc,cout
+       tst     (r5)+
+       rts     r5
+
+econ:
+       mov     r2,-(sp)
+       mov     $1,r2
+       jsr     pc,cout
+       mov     $'e,r0
+       jsr     r5,*(r5)
+       mov     (sp)+,r0
+       dec     r0
+       jmp     itoa
+
+cout:
+       mov     bufptr,r1
+       add     _ndigits,r1
+       mov     r2,-(sp)
+       add     bufptr,r2
+1:
+       cmp     r1,r2
+       blos    1f
+       cmpb    -(r1),$'0
+       beq     1b
+       inc     r1
+1:
+       mov     (sp)+,r2
+       bge     2f
+       mov     $'.,r0
+       jsr     r5,*(r5)
+1:
+       mov     $'0,r0
+       jsr     r5,*(r5)
+       inc     r2
+       blt     1b
+       dec     r2
+2:
+       mov     r2,-(sp)
+       mov     bufptr,r2
+1:
+       cmp     r2,r1
+       bhis    1f
+       tst     (sp)
+       bne     2f
+       mov     $'.,r0
+       jsr     r5,*(r5)
+2:
+       dec     (sp)
+       movb    (r2)+,r0
+       jsr     r5,*(r5)
+       br      1b
+1:
+       tst     (sp)+
+       rts     pc
+
+.bss
+bufptr:        .=.+2
+.text
+
+ftoo:
+       stfps   -(sp)
+       ldfps   $200
+       mov     r1,-(sp)
+       mov     r2,-(sp)
+       mov     $buf,r1
+       movf    fr0,(r1)+
+       mov     $buf,r2
+       br      2f
+1:
+       cmp     r2,r1
+       bhis    1f
+       mov     $';,r0
+       jsr     r5,*(r5)
+2:
+       mov     (r2)+,r0
+       jsr     pc,oct
+       br      1b
+1:
+       mov     $'\n,r0
+       jsr     pc,*(r5)+
+       ldfps   (sp)+
+       rts     r5
+
+oct:
+       mov     r0,x+2
+       setl
+       movif   x,fr0
+       mulf    $small,fr0
+       seti
+       mov     $6.,-(sp)
+1:
+       modf    $eight,fr0
+       movfi   fr1,r0
+       add     $'0,r0
+       jsr     r5,*(r5)
+       dec     (sp)
+       bne     1b
+       tst     (sp)+
+       rts     pc
+
+eight  = 41000
+small  = 33600
+.bss
+buf:   .=.+8
+x:     .=.+4
+.text
+
+itoa:
+       mov     r1,-(sp)
+       mov     r0,r1
+       bge     1f
+       neg     r1
+       mov     $'-,r0
+       jsr     r5,*(r5)
+1:
+       jsr     pc,1f
+       mov     (sp)+,r1
+       tst     (r5)+
+       rts     r5
+
+1:
+       clr     r0
+       dvd     $10.,r0
+       mov     r1,-(sp)
+       mov     r0,r1
+       beq     1f
+       jsr     pc,1b
+1:
+       mov     (sp)+,r0
+       add     $'0,r0
+       jsr     r5,*(r5)
+       rts     pc
+/ bas -- BASIC
+/ new command "dump" which dumps symbol table values by name
+/              R. Haight
+/
+_dump:
+       mov     r4,-(sp)
+       mov     $12.*14.+symtab-14.,r4
+1:
+       add     $14.,r4
+       tst     (r4)
+       beq     1f
+       bit     $1,4(r4)
+       beq     1b
+       jsr     pc,dmp1
+       mov     $'=,r0
+       jsr     r5,xputc
+       movf    6(r4),r0
+       jsr     r5,ftoa; xputc
+       mov     $'\n,r0
+       jsr     r5,xputc
+       br      1b
+1:
+       mov     (sp)+,r4
+       jmp     *(r4)+
+
+dmp1:
+       tst     (r4)
+       blt     1f
+       mov     (r4),nameb
+       mov     2(r4),nameb+2
+       mov     $nameb,r0
+       jsr     pc,print
+       rts     pc
+1:
+       mov     r4,-(sp)
+       mov     $symtab-14.,r4
+1:
+       add     $14.,r4
+       tst     (r4)
+       beq     1f
+       mov     4(r4),r0
+       bic     $1,r0
+2:
+       beq     1b
+       cmp     r0,(sp)
+       beq     2f
+       mov     2(r0),r0
+       br      2b
+2:
+       jsr     pc,dmp1
+       mov     $'[,r0
+       jsr     r5,xputc
+       mov     *(sp),r0
+       com     r0
+       movif   r0,r0
+       jsr     r5,ftoa; xputc
+       mov     $'],r0
+       jsr     r5,xputc
+1:
+       mov     (sp)+,r4
+       rts     pc
+/
+/
+
+/ basx -- data
+
+one = 40200
+
+.data
+
+_ndigits:10.
+tmpf:  </tmp/btma\0>
+argname: <b.out\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0>
+vt:    </dev/vt0\0>
+.even
+pname: <\0\0\0\0\0\0>
+       .even
+
+resnam:
+       <list>
+       <done>
+       <q\0\0\0>
+       <run\0>
+       <prin>
+       <prom>   / prompt is like print without \n (cr)
+       <if\0\0>
+       <goto>
+       <retu>
+       <for\0>
+       <next>
+       <octa>
+       <save>
+       <dump>
+       <fi\0\0>
+       <else>
+       <edit>
+       <comm>  / comment
+.if scope / for plotting
+       <disp>
+       <draw>
+       <eras>
+.endif
+eresnam:
+
+symtnam:
+       <arg\0>
+       <exp\0>
+       <log\0>
+       <sin\0>
+       <cos\0>
+       <atn\0>
+       <rnd\0>
+       <expr>
+       <int\0>
+       <abs\0>
+       <sqr\0>
+       <last>
+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??

diff --git a/usr/src/cmd/bas/makefile b/usr/src/cmd/bas/makefile
new file mode 100644 (file)
index 0000000..4fc8b3e
--- /dev/null
+++ b/usr/src/cmd/bas/makefile
@@ -0,0 +1,5 @@
+bas cp cmp:
+       @echo Sorry, the bas source will not compile
+       @echo the object because it calls for old-style
+       @echo library routines.
+       @echo It\'s here just in case you want to play.

diff --git a/usr/src/cmd/plot/chrtab.c b/usr/src/cmd/plot/chrtab.c
new file mode 100644 (file)
index 0000000..4d8a81a
--- /dev/null
+++ b/usr/src/cmd/plot/chrtab.c
@@ -0,0 +1,98 @@
+char   chrtab[][16] = {
+0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000, /*, sp, */
+0010,0010,0010,0010,0010,0010,0010,0010,0000,0000,0010,0000,0000,0000,0000,0000, /*, !, */
+0024,0024,0024,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000, /*, ", */
+0000,0000,0000,0044,0044,0176,0044,0044,0176,0044,0044,0000,0000,0000,0000,0000, /*, #, */
+0000,0010,0010,0010,0076,0101,0100,0076,0001,0101,0076,0010,0010,0000,0000,0000, /*, $, */
+0000,0000,0000,0141,0142,0004,0010,0010,0020,0043,0103,0000,0000,0000,0000,0000, /*, %, */
+0000,0000,0070,0104,0110,0060,0060,0111,0106,0106,0071,0000,0000,0000,0000,0000, /*, &, */
+0004,0010,0020,0040,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000, /*, ', */
+0000,0004,0010,0020,0040,0040,0040,0040,0040,0040,0020,0010,0004,0000,0000,0000, /*, (, */
+0000,0040,0020,0010,0004,0004,0004,0004,0004,0004,0010,0020,0040,0000,0000,0000, /*, ), */
+0000,0000,0000,0010,0111,0052,0034,0177,0034,0052,0111,0010,0000,0000,0000,0000, /*, *, */
+0000,0000,0000,0000,0010,0010,0010,0177,0010,0010,0010,0000,0000,0000,0000,0000, /*, +, */
+0000,0000,0000,0000,0000,0000,0000,0000,0000,0030,0030,0010,0020,0000,0000,0000, /*, ,, */
+0000,0000,0000,0000,0000,0000,0000,0176,0000,0000,0000,0000,0000,0000,0000,0000, /*, -, */
+0000,0000,0000,0000,0000,0000,0000,0000,0000,0030,0030,0000,0000,0000,0000,0000, /*, ., */
+0000,0000,0001,0002,0004,0010,0010,0010,0020,0040,0100,0000,0000,0000,0000,0000, /*, /, */
+0000,0030,0044,0102,0102,0102,0102,0102,0102,0044,0030,0000,0000,0000,0000,0000, /*, 0, */
+0000,0010,0030,0010,0010,0010,0010,0010,0010,0010,0034,0000,0000,0000,0000,0000, /*, 1, */
+0000,0070,0104,0004,0004,0010,0020,0040,0100,0100,0174,0000,0000,0000,0000,0000, /*, 2, */
+0000,0176,0004,0004,0010,0014,0002,0002,0002,0104,0070,0000,0000,0000,0000,0000, /*, 3, */
+0000,0004,0014,0024,0044,0104,0176,0004,0004,0004,0004,0000,0000,0000,0000,0000, /*, 4, */
+0000,0174,0100,0100,0130,0144,0002,0002,0102,0044,0030,0000,0000,0000,0000,0000, /*, 5, */
+0000,0074,0102,0100,0130,0144,0102,0102,0102,0044,0030,0000,0000,0000,0000,0000, /*, 6, */
+0000,0176,0004,0004,0010,0010,0020,0020,0040,0040,0040,0000,0000,0000,0000,0000, /*, 7, */
+0000,0034,0042,0101,0042,0076,0101,0101,0101,0101,0076,0000,0000,0000,0000,0000, /*, 8, */
+0000,0034,0042,0101,0101,0101,0043,0036,0004,0010,0020,0040,0000,0000,0000,0000, /*, 9, */
+0000,0000,0000,0000,0000,0000,0030,0030,0000,0030,0030,0000,0000,0000,0000,0000, /*, :, */
+0000,0000,0000,0000,0000,0000,0030,0030,0000,0030,0030,0020,0040,0000,0000,0000, /*, ;, */
+0002,0004,0010,0020,0040,0100,0040,0020,0010,0004,0002,0000,0000,0000,0000,0000, /*, <, */
+0000,0000,0000,0000,0177,0000,0177,0000,0000,0000,0000,0000,0000,0000,0000,0000, /*, =, */
+0100,0040,0020,0010,0004,0002,0004,0010,0020,0040,0100,0000,0000,0000,0000,0000, /*, >, */
+0000,0030,0044,0102,0001,0002,0004,0010,0010,0000,0010,0000,0000,0000,0000,0000, /*, ?, */
+0000,0074,0102,0101,0115,0123,0121,0121,0121,0111,0046,0000,0000,0000,0000,0000, /*, @, */
+0000,0010,0024,0042,0101,0101,0177,0101,0101,0101,0101,0000,0000,0000,0000,0000, /*, A, */
+0000,0176,0101,0101,0101,0176,0101,0101,0101,0101,0176,0000,0000,0000,0000,0000, /*, B, */
+0000,0076,0101,0100,0100,0100,0100,0100,0100,0101,0076,0000,0000,0000,0000,0000, /*, C, */
+0000,0176,0101,0101,0101,0101,0101,0101,0101,0101,0176,0000,0000,0000,0000,0000, /*, D, */
+0000,0176,0100,0100,0100,0170,0100,0100,0100,0100,0177,0000,0000,0000,0000,0000, /*, E, */
+0000,0177,0100,0100,0100,0174,0100,0100,0100,0100,0100,0000,0000,0000,0000,0000, /*, F, */
+0000,0076,0101,0100,0100,0117,0101,0101,0101,0101,0076,0000,0000,0000,0000,0000, /*, G, */
+0000,0101,0101,0101,0101,0176,0101,0101,0101,0101,0101,0000,0000,0000,0000,0000, /*, H, */
+0000,0034,0010,0010,0010,0010,0010,0010,0010,0010,0034,0000,0000,0000,0000,0000, /*, I, */
+0000,0016,0004,0004,0004,0004,0004,0004,0104,0104,0070,0000,0000,0000,0000,0000, /*, J, */
+0000,0101,0102,0104,0110,0120,0160,0110,0104,0102,0101,0000,0000,0000,0000,0000, /*, K, */
+0000,0100,0100,0100,0100,0100,0100,0100,0100,0100,0177,0000,0000,0000,0000,0000, /*, L, */
+0000,0101,0143,0125,0111,0101,0101,0101,0101,0101,0101,0000,0000,0000,0000,0000, /*, M, */
+0000,0101,0141,0121,0111,0105,0103,0101,0101,0101,0101,0000,0000,0000,0000,0000, /*, N, */
+0000,0076,0101,0101,0101,0101,0101,0101,0101,0101,0076,0000,0000,0000,0000,0000, /*, O, */
+0000,0176,0101,0101,0101,0176,0100,0100,0100,0100,0100,0000,0000,0000,0000,0000, /*, P, */
+0000,0076,0101,0101,0101,0101,0101,0101,0131,0105,0076,0002,0001,0000,0000,0000, /*, Q, */
+0000,0176,0101,0101,0101,0176,0104,0102,0101,0101,0101,0000,0000,0000,0000,0000, /*, R, */
+0000,0076,0101,0100,0100,0076,0001,0001,0001,0101,0076,0000,0000,0000,0000,0000, /*, S, */
+0000,0177,0010,0010,0010,0010,0010,0010,0010,0010,0010,0000,0000,0000,0000,0000, /*, T, */
+0000,0101,0101,0101,0101,0101,0101,0101,0101,0101,0076,0000,0000,0000,0000,0000, /*, U, */
+0000,0101,0101,0101,0101,0101,0101,0101,0042,0024,0010,0000,0000,0000,0000,0000, /*, V, */
+0000,0101,0101,0101,0101,0111,0111,0125,0143,0101,0101,0000,0000,0000,0000,0000, /*, W, */
+0000,0101,0101,0042,0024,0010,0024,0042,0101,0101,0101,0000,0000,0000,0000,0000, /*, X, */
+0000,0101,0042,0024,0010,0010,0010,0010,0010,0010,0010,0000,0000,0000,0000,0000, /*, Y, */
+0000,0177,0001,0002,0004,0010,0020,0040,0100,0100,0177,0000,0000,0000,0000,0000, /*, Z, */
+0000,0034,0020,0020,0020,0020,0020,0020,0020,0020,0020,0034,0000,0000,0000,0000, /*, [, */
+0000,0000,0100,0040,0020,0010,0010,0010,0004,0002,0001,0000,0000,0000,0000,0000, /*, , \, */
+0000,0070,0010,0010,0010,0010,0010,0010,0010,0010,0010,0070,0000,0000,0000,0000, /*, ], */
+0010,0024,0042,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000, /*, ^, */
+0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0377,0000,0000, /*, _, */
+0040,0020,0010,0004,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000, /*, `, */
+0000,0000,0000,0000,0000,0074,0002,0076,0102,0102,0076,0000,0000,0000,0000,0000, /*, a, */
+0000,0100,0100,0100,0100,0174,0102,0102,0102,0102,0174,0000,0000,0000,0000,0000, /*, b, */
+0000,0000,0000,0000,0000,0074,0102,0100,0100,0102,0074,0000,0000,0000,0000,0000, /*, c, */
+0002,0002,0002,0002,0002,0076,0102,0102,0102,0102,0076,0000,0000,0000,0000,0000, /*, d, */
+0000,0000,0000,0000,0000,0074,0102,0174,0100,0102,0074,0000,0000,0000,0000,0000, /*, e, */
+0000,0016,0020,0020,0020,0176,0020,0020,0020,0020,0020,0000,0000,0000,0000,0000, /*, f, */
+0000,0000,0000,0000,0000,0076,0102,0102,0102,0102,0076,0002,0002,0102,0076,0000, /*, g, */
+0000,0100,0100,0100,0100,0174,0102,0102,0102,0102,0102,0000,0000,0000,0000,0000, /*, h, */
+0000,0000,0000,0010,0000,0030,0010,0010,0010,0010,0034,0000,0000,0000,0000,0000, /*, i, */
+0000,0000,0000,0010,0000,0030,0010,0010,0010,0010,0010,0010,0010,0050,0020,0000, /*, j, */
+0000,0100,0100,0100,0100,0106,0110,0120,0160,0110,0106,0000,0000,0000,0000,0000, /*, k, */
+0000,0030,0010,0010,0010,0010,0010,0010,0010,0010,0034,0000,0000,0000,0000,0000, /*, l, */
+0000,0000,0000,0000,0000,0166,0111,0111,0111,0111,0111,0000,0000,0000,0000,0000, /*, m, */
+0000,0000,0000,0000,0100,0174,0102,0102,0102,0102,0102,0000,0000,0000,0000,0000, /*, n, */
+0000,0000,0000,0000,0000,0074,0102,0102,0102,0102,0074,0000,0000,0000,0000,0000, /*, o, */
+0000,0000,0000,0000,0000,0174,0102,0102,0102,0102,0174,0100,0100,0100,0100,0000, /*, p, */
+0000,0000,0000,0000,0000,0076,0102,0102,0102,0102,0076,0002,0002,0002,0002,0000, /*, q, */
+0000,0000,0000,0000,0000,0134,0142,0100,0100,0100,0100,0000,0000,0000,0000,0000, /*, r, */
+0000,0000,0000,0000,0000,0076,0100,0074,0002,0102,0074,0000,0000,0000,0000,0000, /*, s, */
+0000,0020,0020,0020,0020,0176,0020,0020,0020,0020,0014,0000,0000,0000,0000,0000, /*, t, */
+0000,0000,0000,0000,0000,0102,0102,0102,0102,0102,0075,0000,0000,0000,0000,0000, /*, u, */
+0000,0000,0000,0000,0000,0101,0101,0101,0042,0024,0010,0000,0000,0000,0000,0000, /*, v, */
+0000,0000,0000,0000,0000,0111,0111,0111,0111,0111,0066,0000,0000,0000,0000,0000, /*, w, */
+0000,0000,0000,0000,0000,0102,0044,0030,0030,0044,0102,0000,0000,0000,0000,0000, /*, x, */
+0000,0000,0000,0000,0000,0102,0102,0102,0042,0024,0010,0020,0040,0100,0000,0000, /*, y, */
+0000,0000,0000,0000,0000,0176,0004,0010,0020,0040,0176,0000,0000,0000,0000,0000, /*, z, */
+0000,0014,0020,0020,0020,0020,0040,0020,0020,0020,0020,0014,0000,0000,0000,0000, /*, {, */
+0000,0010,0010,0010,0010,0000,0000,0010,0010,0010,0010,0000,0000,0000,0000,0000, /*, |, */
+0000,0030,0010,0010,0010,0010,0004,0010,0010,0010,0010,0030,0000,0000,0000,0000, /*, }, */
+0020,0052,0004,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000,0000, /*, ~, */
+0000,0176,0176,0176,0176,0176,0176,0176,0176,0176,0176,0000,0000,0000,0000,0000, /*, del, */
+};

diff --git a/usr/src/cmd/plot/driver.c b/usr/src/cmd/plot/driver.c
new file mode 100644 (file)
index 0000000..52d0b1f
--- /dev/null
+++ b/usr/src/cmd/plot/driver.c
@@ -0,0 +1,128 @@
+#include <stdio.h>
+
+float deltx;
+float delty;
+
+main(argc,argv)  char **argv; {
+       int std=1;
+       FILE *fin;
+
+       while(argc-- > 1) {
+               if(*argv[1] == '-')
+                       switch(argv[1][1]) {
+                               case 'l':
+                                       deltx = atoi(&argv[1][2]) - 1;
+                                       break;
+                               case 'w':
+                                       delty = atoi(&argv[1][2]) - 1;
+                                       break;
+                               }
+
+               else {
+                       std = 0;
+                       if ((fin = fopen(argv[1], "r")) == NULL) {
+                               fprintf(stderr, "can't open %s\n", argv[1]);
+                               exit(1);
+                               }
+                       fplt(fin);
+                       }
+               argv++;
+               }
+       if (std)
+               fplt( stdin );
+       exit(0);
+       }
+
+
+fplt(fin)  FILE *fin; {
+       int c;
+       char s[256];
+       int xi,yi,x0,y0,x1,y1,r,dx,n,i;
+       int pat[256];
+
+       openpl();
+       while((c=getc(fin)) != EOF){
+               switch(c){
+               case 'm':
+                       xi = getsi(fin);
+                       yi = getsi(fin);
+                       move(xi,yi);
+                       break;
+               case 'l':
+                       x0 = getsi(fin);
+                       y0 = getsi(fin);
+                       x1 = getsi(fin);
+                       y1 = getsi(fin);
+                       line(x0,y0,x1,y1);
+                       break;
+               case 't':
+                       gets(s,fin);
+                       label(s);
+                       break;
+               case 'e':
+                       erase();
+                       break;
+               case 'p':
+                       xi = getsi(fin);
+                       yi = getsi(fin);
+                       point(xi,yi);
+                       break;
+               case 'n':
+                       xi = getsi(fin);
+                       yi = getsi(fin);
+                       cont(xi,yi);
+                       break;
+               case 's':
+                       x0 = getsi(fin);
+                       y0 = getsi(fin);
+                       x1 = getsi(fin);
+                       y1 = getsi(fin);
+                       space(x0,y0,x1,y1);
+                       break;
+               case 'a':
+                       xi = getsi(fin);
+                       yi = getsi(fin);
+                       x0 = getsi(fin);
+                       y0 = getsi(fin);
+                       x1 = getsi(fin);
+                       y1 = getsi(fin);
+                       arc(xi,yi,x0,y0,x1,y1);
+                       break;
+               case 'c':
+                       xi = getsi(fin);
+                       yi = getsi(fin);
+                       r = getsi(fin);
+                       circle(xi,yi,r);
+                       break;
+               case 'f':
+                       gets(s,fin);
+                       linemod(s);
+                       break;
+               case 'd':
+                       xi = getsi(fin);
+                       yi = getsi(fin);
+                       dx = getsi(fin);
+                       n = getsi(fin);
+                       for(i=0; i<n; i++)pat[i] = getsi(fin);
+                       dot(xi,yi,dx,n,pat);
+                       break;
+                       }
+               }
+       closepl();
+       }
+getsi(fin)  FILE *fin; {       /* get an integer stored in 2 ascii bytes. */
+       short a, b;
+       if((b = getc(fin)) == EOF)
+               return(EOF);
+       if((a = getc(fin)) == EOF)
+               return(EOF);
+       a = a<<8;
+       return(a|b);
+}
+gets(s,fin)  char *s;  FILE *fin; {
+       for( ; *s = getc(fin); s++)
+               if(*s == '\n')
+                       break;
+       *s = '\0';
+       return;
+}

diff --git a/usr/src/cmd/plot/makefile b/usr/src/cmd/plot/makefile
new file mode 100644 (file)
index 0000000..ff7c70b
--- /dev/null
+++ b/usr/src/cmd/plot/makefile
@@ -0,0 +1,34 @@
+CFLAGS = -n -O -s
+
+all:   tek t300 t300s t450 vplot
+       :
+
+cp:    all
+       cp tek t300 t300s t450 vplot /bin
+       rm tek t300 t300s t450 vplot driver.o
+
+cmp:   all
+       cmp tek /bin/tek
+       rm tek
+       cmp t300 /bin/t300
+       rm t300
+       cmp t300s /bin/t300s
+       rm t300s
+       cmp t450 /bin/t450
+       rm t450
+       cmp vplot /bin/vplot
+       rm vplot
+       rm -f driver.o
+
+tek:   driver.o
+       cc -n -s -o tek  driver.o -lt4014 -lm
+t300:  driver.o 
+       cc -n -s -o t300 driver.o -lt300 -lm
+t300s: driver.o 
+       cc -n -s -o t300s driver.o -lt300s -lm
+t450:  driver.o 
+       cc -n -s -o t450 driver.o -lt450 -lm
+
+vplot: chrtab.o vplot.o
+       cc -n -s -o vplot vplot.o chrtab.o
+       rm vplot.o chrtab.o

diff --git a/usr/src/cmd/plot/vplot.c b/usr/src/cmd/plot/vplot.c
new file mode 100644 (file)
index 0000000..5a96cc6
--- /dev/null
+++ b/usr/src/cmd/plot/vplot.c
@@ -0,0 +1,376 @@
+/*
+ * Reads standard graphics input
+ * Makes a plot on a 200 dot-per-inch 11" wide
+ * Versatek plotter.
+ *
+ * Creates and leaves /usr/tmp/raster (1000 blocks)
+ * which is the bitmap
+ */
+#include "stdio.h"
+#include <signal.h>
+
+#define        NB      88
+#define BSIZ   512
+#define        mapx(x) ((1536*((x)-botx)/del)+centx)
+#define        mapy(y) ((1536*(del-(y)+boty)/del)-centy)
+#define SOLID -1
+#define DOTTED 014
+#define SHORTDASHED 034
+#define DOTDASHED 054
+#define LONGDASHED 074
+#define        SETSTATE        (('v'<<8)+1)
+
+int    linmod  = SOLID;
+int    again;
+int    done1;
+char   chrtab[][16];
+int    plotcom[]       { 0200, 0, 0};
+int    eotcom[]                { 0210, 0, 0};
+char   blocks  [NB][BSIZ];
+int    obuf[264];
+int    lastx;
+int    lasty;
+double topx    = 1536;
+double topy    = 1536;
+double botx    = 0;
+double boty    = 0;
+int    centx;
+int    centy;
+double delx    = 1536;
+double dely    = 1536;
+double del     = 1536;
+
+struct buf {
+       int     bno;
+       char    *block;
+};
+struct buf     bufs[NB];
+
+int    in, out;
+char *picture = "/usr/tmp/raster";
+
+main(argc, argv)
+char **argv;
+{
+       extern int onintr();
+       register i;
+
+       if (argc>1) {
+               in = open(argv[1], 0);
+               putpict();
+               exit(0);
+       }
+       signal(SIGTERM, onintr);
+       if (signal(SIGINT, SIG_IGN) != SIG_IGN)
+               signal(SIGINT, onintr);
+another:
+       for (i=0; i<NB; i++) {
+               bufs[i].bno = -1;
+               bufs[i].block = blocks[i];
+       }
+       out = creat(picture, 0666);
+       in = open(picture, 0);
+       zseek(out, 32*32);
+       write(out, blocks[0], BSIZ);
+/*delete following code when filsys deals properly with
+holes in files*/
+       for(i=0;i<512;i++)
+               blocks[0][i] = 0;
+       zseek(out, 0);
+       for(i=0;i<32*32;i++)
+               write(out,blocks[0],512);
+/**/
+       getpict();
+       for (i=0; i<NB; i++)
+               if (bufs[i].bno != -1) {
+                       zseek(out, bufs[i].bno);
+                       write(out, bufs[i].block, BSIZ);
+               }
+       putpict();
+       if (again) {
+               close(in);
+               close(out);
+               goto another;
+       }
+       exit(0);
+}
+
+getpict()
+{
+       register x1, y1;
+
+       again = 0;
+       for (;;) switch (x1 = getc(stdin)) {
+
+       case 's':
+               botx = getw(stdin);
+               boty = getw(stdin);
+               topx = getw(stdin);
+               topy = getw(stdin);
+               delx = topx-botx;
+               dely = topy-boty;
+               if (dely/delx > 1536./2048.)
+                       del = dely;
+               else
+                       del = delx * (1566./2048.);
+               centx = 0;
+               centx = (2048 - mapx(topx)) / 2;
+               centy = 0;
+               centy = mapy(topy) / 2;
+               continue;
+
+       case 'l':
+               done1 |= 01;
+               x1 = mapx(getw(stdin));
+               y1 = mapy(getw(stdin));
+               lastx = mapx(getw(stdin));
+               lasty = mapy(getw(stdin));
+               line(x1, y1, lastx, lasty);
+               continue;
+
+       case 'm':
+               lastx = mapx(getw(stdin));
+               lasty = mapy(getw(stdin));
+               continue;
+
+       case 't':
+               done1 |= 01;
+               while ((x1 = getc(stdin)) != '\n')
+                       plotch(x1);
+               continue;
+
+       case 'e':
+               if (done1) {
+                       again++;
+                       return;
+               }
+               continue;
+
+       case 'p':
+               done1 |= 01;
+               lastx = mapx(getw(stdin));
+               lasty = mapy(getw(stdin));
+               point(lastx, lasty);
+               point(lastx+1, lasty);
+               point(lastx, lasty+1);
+               point(lastx+1, lasty+1);
+               continue;
+
+       case 'n':
+               done1 |= 01;
+               x1 = mapx(getw(stdin));
+               y1 = mapy(getw(stdin));
+               line(lastx, lasty, x1, y1);
+               lastx = x1;
+               lasty = y1;
+               continue;
+
+       case 'f':
+               getw(stdin);
+               getc(stdin);
+               switch(getc(stdin)) {
+               case 't':
+                       linmod = DOTTED;
+                       break;
+               default:
+               case 'i':
+                       linmod = SOLID;
+                       break;
+               case 'g':
+                       linmod = LONGDASHED;
+                       break;
+               case 'r':
+                       linmod = SHORTDASHED;
+                       break;
+               case 'd':
+                       linmod = DOTDASHED;
+                       break;
+               }
+               while((x1=getc(stdin))!='\n')
+                       if(x1==-1) return;
+               continue;
+
+       case 'd':
+               getw(stdin);
+               getw(stdin);
+               getw(stdin);
+               x1 = getw(stdin);
+               while (--x1 >= 0)
+                       getw(stdin);
+               continue;
+
+       case -1:
+               return;
+
+       default:
+               printf("Botch\n");
+               return;
+       }
+}
+
+plotch(c)
+register c;
+{
+       register j;
+       register char *cp;
+       int i;
+
+       if (c<' ' || c >0177)
+               return;
+       cp = chrtab[c-' '];
+       for (i = -16; i<16; i += 2) {
+               c = *cp++;
+               for (j=7; j>=0; --j)
+                       if ((c>>j)&1) {
+                               point(lastx+6-j*2, lasty+i);
+                               point(lastx+7-j*2, lasty+i);
+                               point(lastx+6-j*2, lasty+i+1);
+                               point(lastx+7-j*2, lasty+i+1);
+                       }
+       }
+       lastx += 16;
+}
+
+int    f; /* versatec file number */
+putpict()
+{
+       register x, *ip, *op;
+       int y;
+
+       if (f==0){
+               f = open("/dev/vp0", 1);
+               if (f < 0) {
+                       printf("Cannot open vp\n");
+                       exit(1);
+               }
+               ioctl(f, SETSTATE, plotcom);
+       }
+       op = obuf;
+       lseek(in, 0L, 0);
+       for (y=0; y<2048; y++) {
+               if ((y&077) == 0)
+                       read(in, blocks[0], 32*BSIZ);
+               for (x=0; x<32; x++)  {
+                       ip = (int *)&blocks[x][(y&077)<<3];
+                       *op++ = *ip++;
+                       *op++ = *ip++;
+                       *op++ = *ip++;
+                       *op++ = *ip++;
+               }
+               *op++ = 0;
+               *op++ = 0;
+               *op++ = 0;
+               *op++ = 0;
+               if (y&1) {
+                       write(f, (char *)obuf, sizeof(obuf));
+                       op = obuf;
+               }
+       }
+}
+
+line(x0, y0, x1, y1)
+register x0, y0;
+{
+       int dx, dy;
+       int xinc, yinc;
+       register res1;
+       int res2;
+       int slope;
+
+       xinc = 1;
+       yinc = 1;
+       if ((dx = x1-x0) < 0) {
+               xinc = -1;
+               dx = -dx;
+       }
+       if ((dy = y1-y0) < 0) {
+               yinc = -1;
+               dy = -dy;
+       }
+       slope = xinc*yinc;
+       res1 = 0;
+       res2 = 0;
+       if (dx >= dy) while (x0 != x1) {
+       if((x0+slope*y0)&linmod)
+       if (((x0>>6) + ((y0&~077)>>1)) == bufs[0].bno)
+               bufs[0].block[((y0&077)<<3)+((x0>>3)&07)] |= 1 << (7-(x0&07));
+       else
+               point(x0, y0);
+               if (res1 > res2) {
+                       res2 += dx - res1;
+                       res1 = 0;
+                       y0 += yinc;
+               }
+               res1 += dy;
+               x0 += xinc;
+       } else while (y0 != y1) {
+       if((x0+slope*y0)&linmod)
+       if (((x0>>6) + ((y0&~077)>>1)) == bufs[0].bno)
+               bufs[0].block[((y0&077)<<3)+((x0>>3)&07)] |= 1 << (7-(x0&07));
+       else
+               point(x0, y0);
+               if (res1 > res2) {
+                       res2 += dy - res1;
+                       res1 = 0;
+                       x0 += xinc;
+               }
+               res1 += dx;
+               y0 += yinc;
+       }
+       if((x1+slope*y1)&linmod)
+       if (((x1>>6) + ((y1&~077)>>1)) == bufs[0].bno)
+               bufs[0].block[((y1&077)<<3)+((x1>>3)&07)] |= 1 << (7-(x1&07));
+       else
+               point(x1, y1);
+}
+
+point(x, y)
+register x, y;
+{
+       register bno;
+
+       bno = ((x&03700)>>6) + ((y&03700)>>1);
+       if (bno != bufs[0].bno) {
+               if (bno < 0 || bno >= 1024)
+                       return;
+               getblk(bno);
+       }
+       bufs[0].block[((y&077)<<3)+((x>>3)&07)] |= 1 << (7-(x&07));
+}
+
+getblk(b)
+register b;
+{
+       register struct buf *bp1, *bp2;
+       register char *tp;
+
+loop:
+       for (bp1 = bufs; bp1 < &bufs[NB]; bp1++) {
+               if (bp1->bno == b || bp1->bno == -1) {
+                       tp = bp1->block;
+                       for (bp2 = bp1; bp2>bufs; --bp2) {
+                               bp2->bno = (bp2-1)->bno;
+                               bp2->block = (bp2-1)->block;
+                       }
+                       bufs[0].bno = b;
+                       bufs[0].block = tp;
+                       return;
+               }
+       }
+       zseek(out, bufs[NB-1].bno);
+       write(out, bufs[NB-1].block, BSIZ);
+       zseek(in, b);
+       read(in, bufs[NB-1].block, BSIZ);
+       bufs[NB-1].bno = b;
+       goto loop;
+}
+
+onintr()
+{
+       exit(1);
+}
+
+zseek(a, b)
+{
+       return(lseek(a, (long)b*512, 0));
+}