VTL02/vtl02b_for_Kowalski.asm

;234567890123456789012345678901234567890123456789012345
;
; In the Kowalski 6502 simulator some of the options
; below must be set manually.
;
;    .lf  vtl02ba2.lst  (set listfile in menu:
;                        Simulator->Options->Assembler)
;    .cr  6502
    .opt  Proc6502
;
; to run with I/O set terminal active:
;    Menu                     or   Key
;    Simulator->Options->Simulator [Ctrl-E]
;    Simulator->Assemble           [F7]
;    Simulator->Debugger           [F6]
;    Simulator->Run                [F5]
;    View->Input/output            [Alt-5]
;
;    .tf  vtl02ba2.obj,ap1  (optional save output to
;                             file: File->Save Code)
;-----------------------------------------------------;
;             VTL-2 for the 6502 (VTL02B)             ;
;           Original Altair 680b version by           ;
;          Frank McCoy and Gary Shannon 1977          ;
;    2012: Adapted to the 6502 by Michael T. Barry    ;
; Thanks to sbprojects.com for a very nice assembler! ;
;-----------------------------------------------------;
; 2015: Revision B, with several space optimizations
;   (suggested by dclxvi) and enhancements (suggested
;   by mkl0815 and Klaus2m5).
;
; New features in Revision B:
; * Bit-wise operators & | ^ (and, or, xor)
;   Example:  A=$|128) Get a char and set hi-bit
;
; * Absolute addressed 8-bit memory load and store
;   via the {< @} facility:
;   Example:  <=P) Point to the I/O port at P
;             @=@&254^128) Clear low-bit & flip hi-bit
;
; * The space character is no longer a valid user
;     variable nor a "valid" binary operator.  It is
;     now only significant as a numeric constant
;     terminator, and as a place-holder in strings and
;     program listings, where it may be used to improve
;     human readability, at a slight cost in execution
;     speed and memory consumption.
;   Example:
;   *              (VTL-2)
;       1000 A=1)         Init loop index
;       1010 ?=A)           Print index
;       1020 ?="")          Newline
;       1030 A=A+1)         Update index
;       1040 #=A<10*1010) Loop until done
;
;   *              (VTL02B)
;       1000 A = 1             ) Init loop index
;       1010     ? = A         )   Print index
;       1020     ? = ""        )   Newline
;       1030     A = A + 1     )   Update index
;       1040 # = A < 10 * 1010 ) Loop until done
;-----------------------------------------------------;
;        Copyright (c) 2012, Michael T. Barry
;       Revision B (c) 2015, Michael T. Barry
;               All rights reserved.
;
; Redistribution and use in source and binary forms,
;   with or without modification, are permitted,
;   provided that the following conditions are met: 
;
; 1. Redistributions of source code must retain the
;    above copyright notice, this list of conditions
;    and the following disclaimer. 
; 2. Redistributions in binary form must reproduce the
;    above copyright notice, this list of conditions
;    and the following disclaimer in the documentation
;    and/or other materials provided with the
;    distribution. 
;
; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS
; AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED
; WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT
; SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE
; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
; IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
; ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;
; Notes concerning this version:
; * {&} and {*} are initialized on entry.
; * Division by zero returns a quotient of 65535
;     (the original 6800 version froze).
; * The 6502 has NO 16-bit registers (other than PC)
;     and less overall register space than the 6800,
;     so the interpreter reserves some obscure VTL02B
;     variables {@ $ ( ) 0 1 2 3 4 5 6 7 8 9 < > : ?}
;     for its internal use (the 680b version used a
;     similar tactic, but differed in the details).
;     The deep nesting of parentheses also puts {; < =}
;     in danger of corruption.  For example, executing
;     the statement A=((((((((1)))))))) sets both {A}
;     and {;} to the value 1.
; * Users wishing to call a machine language subroutine
;     via the system variable {>} must first set the
;     system variable {"} to the proper address vector
;     (for example, "=768).
; * The x register is used to point to a simple VTL02B
;     variable (it can't point explicitly to an array
;     element like the 680b version because it's only
;     8-bits).  In the comments, var[x] refers to the
;     16-bit contents of the zero-page variable pointed
;     to by register x (residing at addresses x, x+1).
; * The y register is used as a pointer offset inside
;     a VTL02B statement (easily handling the maximum
;     statement length of about 128 bytes).  In the
;     comments, @[y] refers to the 16-bit address
;     formed by adding register y to the value in {@}.
; * The structure and flow of this interpreter is
;     similar to the 680b version, but it has been
;     reorganized in a more 6502-friendly format (the
;     6502 has no 'bsr' instruction, so the 'stuffing'
;     of subroutines within 128 bytes of the caller is
;     only advantageous for conditional branches).
; * I designed this version to duplicate the OFFICIALLY
;     DOCUMENTED behavior of Frank's 680b version:
;       http://www.altair680kit.com/manuals/Altair_
;       680-VTL-2%20Manual-05-Beta_1-Searchable.pdf
;     Both versions ignore all syntax errors and plow
;     through VTL-2 programs with the assumption that
;     they are "correct", but in their own unique ways,
;     so any claims of compatibility are null and void
;     for VTL-2 code brave (or stupid) enough to stray
;     from the beaten path.
; * This version is wound rather tightly, in a failed
;     attempt to fit it into 768 bytes like the 680b
;     version; many structured programming principles
;     were sacrificed in that effort.  The 6502 simply
;     requires more instructions than the 6800 does to
;     manipulate 16-bit quantities, but the overall
;     execution speed should be comparable due to the
;     6502's slightly lower average clocks/instruction
;     ratio.  As it is now, it fits into 1KB with room
;     to spare.  I coded to emphasize compactness over
;     execution speed at every perceived opportunity,
;     but may have missed some optimizations.  Further
;     suggestions are welcome.
; * VTL02B is my free gift (?) to the world.  It may be
;     freely copied, shared, and/or modified by anyone
;     interested in doing so, with only the stipulation
;     that any liabilities arising from its use are
;     limited to the price of VTL02B (nothing).
;-----------------------------------------------------;
; VTL02B variables occupy RAM addresses $0080 to $00ff,
;   and are little-endian, in the 6502 tradition.
; The use of lower-case and some control characters for
;   variable names is allowed, but not recommended; any
;   attempts to do so would likely result in chaos, due
;   to aliasing with upper-case and system variables.
; Variables tagged with an asterisk are used internally
;   by the interpreter and may change without warning.
;   {@ $ ( ) 0..9 : > ?} are (usually) intercepted by
;   the interpreter, so their internal use by VTL02B is
;   "safe".  The same cannot be said for {; < =}, so be
;   careful!
at       = $80      ; {@}* internal pointer / mem byte
; VTL02B standard user variable space
;                     {A B C .. X Y Z [ \ ] ^ _}
; VTL02B system variable space
space    = $c0      ; { }  New for VTL02B:  the space
                    ;   character is no longer a valid
                    ;   user variable nor a "valid"
                    ;   binary operator.  It is now
                    ;   only significant as a numeric
                    ;   constant terminator, and as a
                    ;   place-holder in strings and
                    ;   program listings. 
bang     = $c2      ; {!}  return line number
quote    = $c4      ; {"}  user ml subroutine vector
pound    = $c6      ; {#}  current line number
dolr     = $c8      ; {$}* temp storage / char i/o
remn     = $ca      ; {%}  remainder of last division
ampr     = $cc      ; {&}  pointer to start of array
tick     = $ce      ; {'}  pseudo-random number
lparen   = $d0      ; {(}* old line # / begin sub-exp
rparen   = $d2      ; {)}* temp storage / end sub-exp
star     = $d4      ; {*}  pointer to end of free mem
;          $d6      ; {+ , - . /}  valid variables
; Interpreter argument stack space
arg      = $e0      ; {0 1 2 3 4 5 6 7 8 9 :}*
; Rarely used variables and argument stack overflow
;          $f6      ; {;}* valid user variable
lthan    = $f8      ; {<}* user memory byte pointer
;        = $fa      ; {=}* valid user variable
gthan    = $fc      ; {>}* temp / call ML subroutine
ques     = $fe      ; {?}* temp / terminal i/o
;
nulstk   = $01ff    ; system stack resides in page 1
;-----------------------------------------------------;
; Equates for a 48K+ Apple 2 (original, +, e, c, gs)
;ESC      = 27       ; "Cancel current input line" key
;BS       = 8        ; "Delete last keypress" key
;OP_OR    = '!'      ; Bit-wise OR operator
;linbuf   = $0200    ; input line buffer
;prgm     = $0800    ; VTL02B program grows from here
;himem    = $8000    ;   ... up to the top of user RAM
;vtl02b   = $8000    ; interpreter cold entry point
;                     (warm entry point is startok)
;KBD      = $c000    ; 128 + keypress if waiting
;KEYIN    = $fd0c    ; apple monitor keyin routine
;COUT     = $fded    ; apple monitor charout routine
;-----------------------------------------------------;
; Equates for the Kowalski 6502 simulator
ESC      = 27       ; "Cancel current input line" key
BS       = 8        ; "Delete last keypress" key
OP_OR    = '|'      ; Bit-wise OR operator
linbuf   = $0200    ; input line buffer
prgm     = $0400    ; VTL02B program grows from here
himem    = $F000    ;   ... up to the top of user RAM
vtl02b   = $FC00    ; interpreter cold entry point
;                     (warm entry point is startok)
io_area  = $f000      ;configure simulator terminal I/O
acia_tx  = io_area+1  ;acia tx data register
acia_rx  = io_area+4  ;acia rx data register
;=====================================================;
    .org vtl02b
;-----------------------------------------------------;
; Initialize program area pointers and start VTL02B
; 17 bytes
    lda  #<prgm
    sta  ampr       ; {&} -> empty program
    lda  #>prgm
    sta  ampr+1
    lda  #<himem
    sta  star       ; {*} -> top of user RAM
    lda  #>himem
    sta  star+1
startok:
    sec             ; request "OK" message
; - - - - - - - - - - - - - - - - - - - - - - - - - - ;
; Start/restart VTL02B command line with program intact
; 29 bytes + 3 bytes patch: restore VTL02a behavior
start:
    cld
    ldx  #<nulstk
    txs             ; reset the system stack pointer
    bcc  user       ; skip "OK" if carry clear
    jsr  outnl
    lda  #'O'       ; output \nOK\n to terminal
    jsr  outch
    lda  #'K'
    jsr  outch
; patch to remove extra linefeed on program line entry
    jsr  outnl      ; patch: restore VTL02a behavior
user:
    jsr  inln       ; patch: restore VTL02a behavior
;    jsr  newln      ; input a line from the user
    ldx  #pound     ; cvbin destination = {#}
    jsr  cvbin      ; does line start with a number?
    bne  stmnt      ;   yes: handle program line
                    ;   no: execute direct statement
; - - - - - - - - - - - - - - - - - - - - - - - - - - ;
; The main program execution loop
; 49 bytes
eloop:
    php             ; (cc: deferred, cs: direct)
    jsr  exec       ; execute one VTL02B statement
    plp
    lda  pound      ; (eq) if {#} = 0
    ora  pound+1
    bcc  eloop2     ; if direct mode and {#} = 0
    beq  start      ; then restart cmd prompt
    clc             ; if direct mode and {#} <> 0
    bne  xloop      ; then start execution @ {#}
eloop2:
    sec             ; if program mode and {#} = 0
    beq  xloop      ; then execute next line
    lda  pound+1    ; (false branch condition)
    cmp  lparen+1
    bne  branch     ; else has {#} changed?
    lda  pound
    cmp  lparen
    beq  xloop      ;   no: execute next line (cs)
branch:
    ldy  lparen+1
    ldx  lparen     ;   yes: execute a VTL02B branch
    inx             ;   (cs: forward, cc: backward)
    bne  branch2    ;   {!} = {(} + 1 (return ptr)
    iny
branch2:
    stx  bang
    sty  bang+1
xloop:
    jsr  findln     ; find first/next line >= {#}
    iny             ; point to left-side of statement
    bne  eloop      ; execute statement at new {#}
;-----------------------------------------------------;
; Delete/insert/replace program line or list program
; 7 bytes
stmnt:
    clc
    lda  pound      ; {#} = 0?
    ora  pound+1    ;   no: delete/insert/replace line
    bne  skp2       ;   yes: list program to terminal
; - - - - - - - - - - - - - - - - - - - - - - - - - - ;
; List program to terminal and restart "OK" prompt
; entry:  Carry must be clear
; uses:   findln, outch, prnum, prstr, {@ ( )}
; 20 bytes
list_:
    jsr  findln     ; find program line >= {#}
    ldx  #lparen    ; line number for prnum
    jsr  prnum      ; print the line number
    lda  #' '       ; print a space instead of the
    jsr  outch      ; line length byte
    lda  #0         ; zero for delimiter
    jsr  prstr      ; print the rest of the line
    bcs  list_      ; (always taken)
;-----------------------------------------------------;
; Delete/insert program line and restart command prompt
; entry:  Carry must be clear
; uses:   find, start, {@ > # & * (}, linbuf
; 155 bytes
skp2:
    tya             ; save linbuf offset pointer
    pha
    jsr  find       ; point {@} to first line >= {#}
    bcs  insrt
    lda  lparen
    cmp  pound      ; if line doesn't already exist
    bne  insrt      ; then skip deletion process
    lda  lparen+1
    eor  pound+1
    bne  insrt
    tax             ; x = 0
    lda  (at),y
    tay             ; y = length of line to delete
    eor  #-1
    adc  ampr       ; {&} = {&} - y
    sta  ampr
    bcs  delt
    dec  ampr+1
delt:
    lda  at
    sta  gthan      ; {>} = {@}
    lda  at+1
    sta  gthan+1
delt2:
    lda  gthan
    cmp  ampr       ; delete the line
    lda  gthan+1
    sbc  ampr+1
    bcs  insrt
    lda  (gthan),y
    sta  (gthan,x)
    inc  gthan
    bne  delt2
    inc  gthan+1
    bcc  delt2      ; (always taken)
insrt:
    pla
    tax             ; x = linbuf offset pointer
    lda  pound
    pha             ; push the new line number on
    lda  pound+1    ;   the system stack
    pha
    ldy  #2
cntln:
    inx
    iny             ; determine new line length in y
    lda  linbuf-1,x ;   and push statement string on
    pha             ;   the system stack
    bne  cntln
    cpy  #4         ; if empty line then skip the
    bcc  jstart     ;   insertion process
    tax             ; x = 0
    tya
    clc
    adc  ampr       ; calculate new program end
    sta  gthan      ; {>} = {&} + y
    txa
    adc  ampr+1
    sta  gthan+1
    lda  gthan
    cmp  star       ; if {>} >= {*} then the program
    lda  gthan+1    ;   won't fit in available RAM,
    sbc  star+1     ;   so dump the stack and abort
    bcs  jstart     ;   to the "OK" prompt
slide:
    lda  ampr
    bne  slide2
    dec  ampr+1
slide2:
    dec  ampr
    lda  ampr
    cmp  at
    lda  ampr+1
    sbc  at+1
    bcc  move       ; slide open a gap inside the
    lda  (ampr,x)   ;   program just big enough to
    sta  (ampr),y   ;   hold the new line
    bcs  slide      ; (always taken)
move:
    tya
    tax             ; x = new line length
move2:
    pla             ; pull the statement string and
    dey             ;   the new line number and store
    sta  (at),y     ;   them in the program gap
    bne  move2
    ldy  #2
    txa
    sta  (at),y     ; store length after line number
    lda  gthan
    sta  ampr       ; {&} = {>}
    lda  gthan+1
    sta  ampr+1
jstart:
    jmp  start      ; dump stack, restart cmd prompt
;-----------------------------------------------------;
; Point @[y] to the first/next program line >= {#}
; entry:  (cc): start search at beginning of program
;         (cs): start search at next line
;         ({@} -> beginning of current line)
; uses:   find, jstart, prgm, {@ # & (}
; exit:   if line not found then abort to "OK" prompt
;         else {@} -> found line, {#} = {(} = actual
;           line number, y = 2, (cc)
; 14 bytes
findln:
    jsr  find       ; find first/next line >= {#}
    bcs  jstart     ; if end then restart "OK" prompt
    lda  lparen
    sta  pound      ; {#} = {(}
    lda  lparen+1
    sta  pound+1
    rts
;-----------------------------------------------------;
; {?="...} handler; called from 'exec'
; List line handler; called from 'list_'
; 2 bytes
prstr:
    iny             ; skip over the " or length byte
    tax             ; x = delimiter, fall through
; - - - - - - - - - - - - - - - - - - - - - - - - - - ;
; Print a string at @[y]
; x holds the delimiter char, which is skipped over,
;   not printed (a null byte is always a delimiter)
; If a key was pressed, it pauses for another keypress
;   before returning.  If either of those keys was a
;   ctrl-C, it dumps the stack and restarts the "OK"
;   prompt with the user program intact
; entry:  @[y] -> string, x = delimiter char
; uses:   inch, inkey, jstart, outch, execrts
; exit:   (normal) @[y] -> null or byte after delimiter
;         (ctrl-C) dump the stack & restart "OK" prompt
; 39 bytes
prmsg:
    txa
    cmp  (at),y     ; found delimiter or null?
    beq  prmsg2     ; yes: finish up
    lda  (at),y
    beq  prmsg2
    jsr  outch      ; no: print char to terminal
    iny             ;   and loop (with safety escape)
    bpl  prmsg
prmsg2:
    tax             ; save closing delimiter
    jsr  inkey      ; any key = pause?
    bcc  prout      ;   no: proceed
    jsr  inch       ;   yes: wait for another key
prout:
    txa             ; retrieve closing delimiter
    beq  outnl      ; always \n after null delimiter
    jsr  skpbyte    ; skip over the delimiter
    cmp  #';'       ; if trailing char is ';' then
    beq  execrts    ;   suppress the \n
outnl:
    lda  #$0d       ; \n to terminal
joutch:
    jmp  outch
;-----------------------------------------------------;
; Execute a (hopefully) valid VTL02B statement at @[y]
; entry:  @[y] -> left-side of statement
; uses:   nearly everything
; exit:   note to machine language subroutine {>=...}
;           users: no registers or variables are
;           required to be preserved except the system
;           stack pointer, the text base pointer {@},
;           and the original line number {(}
; if there is a {"} directly after the assignment
;   operator, the statement will execute as {?="...},
;   regardless of the variable named on the left side
; 90 bytes
exec:
    jsr  getbyte    ; fetch left-side variable name
    beq  execrts    ; do nothing if null statement
    iny  
    ldx  #arg       ; initialize argument pointer
    jsr  convp      ; arg[{0}] = address of left-side
    bne  exec1      ;   variable 
    lda  arg
    cmp  #rparen    ; full line comment?
    beq  execrts    ;   yes: do nothing with the rest
exec1:
    jsr  getbyte    ; skip over assignment operator
    jsr  skpbyte    ; is right-side a literal string?
    cmp  #'"'       ;   yes: print the string with
    beq  prstr      ;     trailing ';' check & return
    ldx  #arg+2     ; point eval to arg[{1}]
    jsr  eval       ; evaluate right-side in arg[{1}]
    lda  arg+2
    ldx  arg+1      ; was left-side an array element?
    bne  exec3      ;   yes: skip to default actions
    ldx  arg
    cpx  #at        ; if (@=...} statement then poke
    bne  exec1a     ;   low half of arg[{1}] to ({<})
    ldy  #0
    sta  (lthan),y
    rts
exec1a:
    cpx  #dolr      ; if {$=...} statement then print
    beq  joutch     ;   arg[{1}] as ascii character
    cpx  #gthan
    bne  exec2      ; if {>=...} statement then call
    tax             ;   user machine language routine
    lda  arg+3      ;   with arg[{1}] in a, x regs
    jmp  (quote)    ;   (MSB, LSB)
exec2:
    cpx  #ques      ; if {?=...} statement then print
    beq  prnum0     ;   arg[{1}] as unsigned decimal
exec3:
    ldy  #0
    sta  (arg),y
    adc  tick+1     ; store arg[{1}] in the left-side
    rol             ;   variable
    tax
    iny
    lda  arg+3
    sta  (arg),y
    adc  tick       ; pseudo-randomize {'}
    rol
    sta  tick+1
    stx  tick
execrts:
    rts
;-----------------------------------------------------;
; {?=...} handler; called by 'exec'
; 2 bytes
prnum0:
    ldx  #arg+2     ; x -> arg[{1}], fall through
; - - - - - - - - - - - - - - - - - - - - - - - - - - ;
; Print an unsigned decimal number (0..65535) in var[x]
; entry:  var[x] = number to print
; uses:   div, outch, var[x+2], preserves original {%}
; exit:   var[x] = 0, var[x+2] = 10
; 43 bytes
prnum:
    lda  remn
    pha             ; save {%}
    lda  remn+1
    pha
    lda  #10        ; divisor = 10
    sta  2,x
    lda  #0
    pha             ; null delimiter for print
    sta  3,x        ; repeat {
prnum2:
    jsr  div        ;   divide var[x] by 10
    lda  remn
    ora  #'0'       ;   convert remainder to ascii
    pha             ;   stack digits in ascending
    lda  0,x        ;   order ('0' for zero)
    ora  1,x
    bne  prnum2     ; } until var[x] is 0
    pla
prnum3:
    jsr  outch      ; print digits in descending
    pla             ;   order until delimiter is
    bne  prnum3     ;   encountered
    pla
    sta  remn+1     ; restore {%}
    pla
    sta  remn
    rts
;-----------------------------------------------------;
; Evaluate a (hopefully) valid VTL02 expression at @[y]
;   and place its calculated value in arg[x]
; A VTL02B expression is defined as a string of one or
;   more terms, separated by operators and terminated
;   with a null or an unmatched right parenthesis
; A term is defined as a variable name, a decimal
;   constant, or a parenthesized sub-expression; terms
;   are evaluated strictly from left to right
; A variable name is defined as a user variable, an
;   array element expression enclosed in {: )}, or a
;   system variable (which may have side-effects)
; entry:  @[y] -> expression text, x -> argument
; uses:   getval, oper, {@}, argument stack area
; exit:   arg[x] = result, @[y] -> next text
; 31 bytes
eval:
    lda  #0
    sta  0,x        ; start evaluation by simulating
    sta  1,x        ;   {0+expression}
    lda  #'+'
notdn:
    pha             ; stack alleged operator
    inx             ; advance the argument stack
    inx             ;   pointer
    jsr  getval     ; arg[x+2] = value of next term
    dex
    dex
    pla             ; retrieve and apply the operator
    jsr  oper       ;   to arg[x], arg[x+2]
    jsr  getbyte    ; end of expression?
    beq  evalrts    ;   (null or right parenthesis)
    iny
    cmp  #')'       ;   no: skip over the operator
    bne  notdn      ;     and continue the evaluation
evalrts:
    rts             ;   yes: return with final result
;-----------------------------------------------------;
; Get numeric value of the term at @[y] into var[x]
; Some examples of valid terms:  123, $, H, (15-:J)/?)
; 83 bytes
getval:
    jsr  cvbin      ; decimal number at @[y]?
    bne  getrts     ;   yes: return with it in var[x]
    jsr  getbyte
    iny
    cmp  #'?'       ; user line input?
    bne  getval2
    tya             ;   yes:
    pha
    lda  at         ;     save @[y]
    pha             ;     (current expression ptr)
    lda  at+1
    pha
    jsr  inln       ; input expression from user
    jsr  eval       ; evaluate, var[x] = result
    pla
    sta  at+1
    pla
    sta  at         ; restore @[y]
    pla
    tay
    rts             ; skip over "?" and return
getval2:
    cmp  #'$'       ; user char input?
    bne  getval2a
    jsr  inch       ;   yes: input one char
    bcs  getval5    ;     (always taken)
getval2a:
    cmp  #'@'       ; memory access?
    bne  getval3
    sty  dolr       ;   yes:
    ldy  #0
    lda  (lthan),y  ;     access memory byte at ({<})
    ldy  dolr
    bne  getval5    ;     (always taken)
getval3:
    cmp  #'('       ; sub-expression?
    beq  eval       ;   yes: evaluate it recursively
    jsr  convp      ;   no: first set var[x] to the
    lda  (0,x)      ;     named variable's address,
    pha             ;     then replace that address
    inc  0,x        ;     with the variable's actual
    bne  getval4    ;     value before returning
    inc  1,x
getval4:
    lda  (0,x)
    sta  1,x        ; store high-byte of term value
    pla
getval5:
    sta  0,x        ; store low-byte of term value
getrts:
    rts
;-----------------------------------------------------;
; Apply the binary operator in a to var[x] and var[x+2]
; Valid VTL02B operators are {+ - * / & | ^ < = >}
; {>} is defined as greater than _or_equal_
; An undefined operator will be interpreted as one of
;   the comparison operators
; 194 bytes
oper:
    cmp  #'+'       ; addition operator?
    bne  oper2      ;   no: next case
; - - - - - - - - - - - - - - - - - - - - - - - - - - ;
plus:
    clc             ; var[x] += var[x+2]
    dex
    jsr  plus2
    inx
plus2:
    lda  1,x
    adc  3,x
    sta  1,x
    rts
oper2:
    cmp  #'-'       ; subtraction operator?
    bne  oper3      ;   no: next case
; - - - - - - - - - - - - - - - - - - - - - - - - - - ;
minus:
    sec             ; var[x] -= var[x+2]
    dex
    jsr  minus2
    inx
minus2:
    lda  1,x
    sbc  3,x
    sta  1,x
    rts
oper3:
    cmp  #'*'       ; multiplication operator?
    bne  oper4      ;   no: next case
; - - - - - - - - - - - - - - - - - - - - - - - - - - ;
; 16-bit unsigned multiply routine
;   overflow is ignored/discarded
;   var[x] *= var[x+2], var[x+2] = 0, {>} is modified
;
mul:
    lda  0,x
    sta  gthan
    lda  1,x        ; {>} = var[x]
    sta  gthan+1
    lda  #0
    sta  0,x        ; var[x] = 0
    sta  1,x
mul2:
    lsr  gthan+1
    ror  gthan      ; {>} /= 2
    bcc  mul3
    jsr  plus       ; form the product in var[x]
mul3:
    asl  2,x
    rol  3,x        ;left-shift var[x+2]
    lda  2,x
    ora  3,x        ; loop until var[x+2] = 0
    bne  mul2
    rts
oper4:
    cmp  #'/'       ; division operator?
    bne  oper5      ;   no: next case
; - - - - - - - - - - - - - - - - - - - - - - - - - - ;
; 16-bit unsigned division routine
;   var[x] /= var[x+2], {%} = remainder, {>} modified
;   var[x] /= 0 produces {%} = var[x], var[x] = 65535
;
div:
    lda  #0
    sta  remn       ; {%} = 0
    sta  remn+1
    lda  #16
    sta  gthan      ; {>} = loop counter
div1:
    asl  0,x        ; var[x] is gradually replaced
    rol  1,x        ;   with the quotient
    rol  remn       ; {%} is gradually replaced
    rol  remn+1     ;   with the remainder
    lda  remn
    cmp  2,x
    lda  remn+1     ; partial remainder >= var[x+2]?
    sbc  3,x
    bcc  div2
    sta  remn+1     ;   yes: update the partial
    lda  remn       ;     remainder and set the
    sbc  2,x        ;     low bit in the partial
    sta  remn       ;     quotient
    inc  0,x
div2:
    dec  gthan
    bne  div1       ; loop 16 times
    rts
oper5:
    cmp  #'&'       ; bit-wise and operator?
    bne  oper6      ;   no: next case
; - - - - - - - - - - - - - - - - - - - - - - - - - - ;
    dex             ; var[x] &= var[x+2]
    jsr  and_2
    inx
and_2:
    lda  1,x
    and  3,x
    bcs  oper8e     ; (always taken)
oper6:
    cmp  #OP_OR     ; bit-wise or operator?
    bne  oper7      ;   no: next case
; - - - - - - - - - - - - - - - - - - - - - - - - - - ;
    dex             ; var[x] |= var[x+2]
    jsr  or_2
    inx
or_2:
    lda  1,x
    ora  3,x
    bcs  oper8e     ; (always taken)
oper7:
    cmp  #'^'       ; bit-wise xor operator?
    bne  oper8      ;   no: next case
; - - - - - - - - - - - - - - - - - - - - - - - - - - ;
    dex             ; var[x] ^= var[x+2]
    jsr  xor_2
    inx
xor_2:
    lda  1,x
    eor  3,x
    bcs  oper8e     ; (always taken)
;-----------------------------------------------------;
; Apply comparison operator in a to var[x] and var[x+2]
;   and place result in var[x] (1: true, 0: false)
;
oper8:
    eor  #'<'       ; 0: '<'  1: '='  2: '>'
    sta  gthan      ; Other values in a are undefined,
    jsr  minus      ;   but _will_ produce some result
    dec  gthan      ; var[x] -= var[x+2]
    bne  oper8b     ; equality test?
    ora  0,x        ;   yes: 'or' high and low bytes
    beq  oper8c     ;     (cs) if 0
    clc             ;     (cc) if not 0
oper8b:
    lda  gthan
    rol
oper8c:
    adc  #0
    and  #1         ; var[x] = 1 (true), 0 (false)
oper8d:
    sta  0,x        ; var[x] -> simple variable
    lda  #0
oper8e:
    sta  1,x
    rts
;-----------------------------------------------------;
; Set var[x] to the address of the variable named in a
; entry:  a holds variable name, @[y] -> text holding
;         array index expression (if a = ':')
; uses:   plus, eval, oper8d, {@ &}
; exit:   (eq): var[x] -> variable, @[y] unchanged
;         (ne): var[x] -> array element,
;               @[y] -> following text
; 27 bytes
convp:
    cmp  #':'       ; array element?
    beq  varray
    asl             ;   no: var[x] -> simple variable
    ora  #$80
    bmi  oper8d     ;     (always taken)
varray:
    jsr  eval       ;   yes: evaluate array index at
    asl  0,x        ;     @[y] and advance y
    rol  1,x
    lda  ampr       ;     var[x] -> array element
    sta  2,x        ;       at address 2*index+&
    lda  ampr+1
    sta  3,x
    jmp  plus
;-----------------------------------------------------;
; If text at @[y] is a decimal constant, translate it
;   into var[x] (discarding any overflow) and update y
; entry:  @[y] -> text containing possible constant
;         Leading space characters are skipped, but
;           any spaces encountered after a conversion
;           has begun will end the conversion.
; uses:   mul, plus, var[x], var[x+2], {@ > ?}
; exit:   (ne): var[x] = constant, @[y] -> next text
;         (eq): var[x] = 0, @[y] unchanged
;         (cs): in all but the truly strangest cases
; 41 bytes
cvbin:
    lda  #0
    sta  0,x        ; var[x] = 0
    sta  1,x
    sta  3,x
    jsr  getbyte    ; skip any leading spaces
    sty  ques       ; save pointer
cvbin2:
    lda  (at),y     ; grab a char
    eor  #$30       ; if char at @[y] is not a
    cmp  #10        ;   decimal digit then stop
    bcs  cvbin3     ;   the conversion
    pha             ; save decimal digit
    lda  #10
    sta  2,x
    jsr  mul        ; var[x] *= 10
    pla             ; retrieve decimal digit
    sta  2,x
    jsr  plus       ; var[x] += digit
    iny             ; loop for more digits
    bpl  cvbin2     ;   (with safety escape)
cvbin3:
    cpy  ques       ; (ne) if valid, (eq) if not
    rts
;-----------------------------------------------------;
; Accept input line from user and store it in linbuf,
;   zero-terminated (allows very primitive edit/cancel)
; entry:  (jsr to inln or newln, not inln6)
; uses:   linbuf, inch, outcr, {@}
; exit:   @[y] -> linbuf
; 42 bytes
inln6:
    cmp  #ESC       ; escape?
    beq  newln      ;   yes: discard entire line
    iny             ; line limit exceeded?
    bpl  inln2      ;   no: keep going
newln:
    jsr  outnl      ;   yes: discard entire line
inln:
    ldy  #<linbuf   ; entry point: start a fresh line
    sty  at         ; {@} -> input line buffer
    ldy  #>linbuf
    sty  at+1
    ldy  #1
inln5:
    dey
    bmi  newln
inln2:
    jsr  inch       ; get (and echo) one key press
    cmp  #BS        ; backspace?
    beq  inln5      ;   yes: delete previous char
    cmp  #$0d       ; cr?
    bne  inln3
    lda  #0         ;   yes: replace with null
inln3:
    sta  (at),y     ; put key in linbuf
    bne  inln6      ; continue if not null
    tay             ; y = 0
    rts
;-----------------------------------------------------;
; Find the first/next stored program line >= {#}
; entry:  (cc): start search at program beginning
;         (cs): start search at next line after {@}
; uses:   prgm, {@ # & (}
; exit:   (cs): {@} >= {&}, {(} = garbage, y = 2
;         (cc): {@} -> found line, {(} = actual line
;               number, y = 2
; 53 bytes
find:
    bcs  findnxt    ; cs: search begins at next line
    lda  #>prgm     ; cc: search begins at first line
    sta  at+1
    lda  #<prgm     ; {@} -> first program line
    bcc  find1st    ; (always taken)
findnxt:
    jsr  checkat    ; if {@} >= {&} then the search
    bcs  findrts    ;   failed, so return with (cs)
    lda  at
    adc  (at),y     ; {@} += length of current line
find1st:
    sta  at
    bcc  getlpar
    inc  at+1
getlpar:
    ldy  #0
    lda  (at),y
    sta  lparen     ; {(} = current line number
    cmp  pound      ;   (invalid if {@} >= {&}, but
    iny             ;   we'll catch that later...)
    lda  (at),y
    sta  lparen+1   ; if {(} < {#} then try the next
    sbc  pound+1    ;   program line
    bcc  findnxt    ; else the search is complete
checkat:
    ldy  #2
    lda  at         ; {@} >= {&} (end of program)?
    cmp  ampr
    lda  at+1       ;   yes: search failed (cs)
    sbc  ampr+1     ;   no: clear carry
findrts:
    rts
;-----------------------------------------------------;
; Fetch a byte at @[y], ignoring space characters
; 10 bytes
skpbyte:
    iny             ; skip over current char
getbyte:
    lda  (at),y
    eor  #' '
    beq  skpbyte    ; skip over any space char(s)
    eor  #' '       ; set flags for char loaded
    rts
;============ Original I/O subroutines ===============;
;-----------------------------------------------------;
; Check for user keypress and return with (cc) if none
;   is pending.  Otherwise, fall through to inch
;   and return with (cs).
; 6 bytes
;inkey:
;    lda  KBD        ; Is there a keypress waiting?
;    asl
;    bcc  outrts     ;   no: return with (cc)
; - - - - - - - - - - - - - - - - - - - - - - - - - - ;
; Read key from stdin into a, echo, (cs)
; Dump stack and abort to "OK" prompt if ctrl-C
; 16 bytes
;inch:
;    sty  dolr       ; save y reg
;    jsr  KEYIN      ; get a char from keyboard
;    ldy  dolr       ; restore y reg
;    and  #$7f       ; strip apple's hi-bit
;    cmp  #$03       ; ctrl-C?
;    bne  outch      ;   no: echo to terminal
;    jmp  start      ;   yes: abort to "OK" prompt
; - - - - - - - - - - - - - - - - - - - - - - - - - - ;
; Print ascii char in a to stdout, (cs)
; 9 bytes
;outch:
;    pha             ; save original char
;    ora  #$80       ; apples prefer "high" ascii
;    jsr  COUT       ; emit char via apple monitor
;    pla             ; restore original char
;    sec             ; (by contract with callers)
;outrts:
;    rts
;============ Kowalski I/O subroutines ===============;
;-----------------------------------------------------;
; Check for user keypress and return with (cc) if none
;   is pending.  Otherwise, check for ctrl-C and
;   return with (cs).
; 7 bytes
inkey:
    lda  acia_rx    ; Is there a character waiting?
    bne  inch2      ;   yes: check CTRL-C 
    clc             ;   no: return with (cc)
    rts
; - - - - - - - - - - - - - - - - - - - - - - - - - - ;
; Read key from stdin into a, echo, (cs)
; Dump stack and abort to "OK" prompt if ctrl-C
; 16 bytes
inch:
    lda  acia_rx    ; get character from rx register
    beq  inch       ; wait for character !=0
    cmp  #10        ; remove line feed to allow paste
    beq  inch       ; in the Kowalski I/O window
inch2:
    cmp  #$03       ; ctrl-C?
    bne  outch      ;   no: echo to terminal
    jmp  start      ;   yes: abort to "OK" prompt
; - - - - - - - - - - - - - - - - - - - - - - - - - - ;
; Print ascii char in a to stdout, (cs)
; 16 bytes
outch:
    cmp  #13        ; add line feed to carriage return
    bne  skip_cr
    lda  #10
    sta  acia_tx
    lda  #13
skip_cr:
    sta  acia_tx    ; emit char via transmit register
    sec             ; (by contract with callers)
    rts
;-----------------------------------------------------;
    .end vtl02b     ; set start address