diff --git a/readme.txt b/readme.txt index 1228b22..55e48af 100644 --- a/readme.txt +++ b/readme.txt @@ -16,9 +16,11 @@ The files: VTL02B for the apple II & the sbprojects.com assembler: vtl02ba2.asm - VTL02B for the Kowalski 6502 simulator + VTL02B for the Kowalski 6502 simulator: http://www.exifpro.com/downloads/6502_1.2.12.zip: - vtl02b_for_Kowalski.asm + vtl02ba2.65s + VTL02B for my emulator & the Kingswood AS65 assembler: + vtl02ba2.a65 New features in Revision B: * Bit-wise operators & | ^ (and, or, xor) diff --git a/vtl02b_for_Kowalski.asm b/vtl02ba2.65s similarity index 98% rename from vtl02b_for_Kowalski.asm rename to vtl02ba2.65s index 0e39215..fb9f0fe 100644 --- a/vtl02b_for_Kowalski.asm +++ b/vtl02ba2.65s @@ -473,9 +473,10 @@ prmsg: prmsg2: tax ; save closing delimiter jsr inkey ; any key = pause? - bcc prout ; no: proceed - jsr inch ; yes: wait for another key -prout: +; patch - remove garbage output when halting print +; 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 @@ -1019,14 +1020,21 @@ getbyte: ; rts ;============ Kowalski I/O subroutines ===============; ;-----------------------------------------------------; -; Check for user keypress and return with (cc) if none +; Check for user keypress and return if none ; is pending. Otherwise, check for ctrl-C and -; return with (cs). -; 7 bytes +; return after next keypress. +; inkey: lda acia_rx ; Is there a character waiting? - bne inch2 ; yes: check CTRL-C - clc ; no: return with (cc) + beq inkeyr ; no: return + cmp #3 ; is ctrl-c + beq istart ; yes: abort to OK prompt +inkeyp: + lda acia_rx ; pause until next key + beq inkeyp + cmp #3 ; is ctrl-c + beq istart ; yes: abort to OK prompt +inkeyr: rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; Read key from stdin into a, echo, (cs) @@ -1040,6 +1048,7 @@ inch: inch2: cmp #$03 ; ctrl-C? bne outch ; no: echo to terminal +istart: jmp start ; yes: abort to "OK" prompt ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; Print ascii char in a to stdout, (cs) diff --git a/vtl02ba2.a65 b/vtl02ba2.a65 new file mode 100644 index 0000000..c24a4d7 --- /dev/null +++ b/vtl02ba2.a65 @@ -0,0 +1,1092 @@ +;234567890123456789012345678901234567890123456789012345 +; +; In the Kingswood AS65 assembler some of the options +; below must be set manually. +; +; .lf vtl02ba2.lst (set -l in commandline) +; .cr 6502 (is default) +; .tf vtl02ba2.obj,ap1 (set -s2 in commandline) +;-----------------------------------------------------; +; 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 2m5 SBC emulator +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 = $7b00 ; ... up to the top of user RAM +vtl02b = $fb00 ; interpreter cold entry point +; (warm entry point is startok) +io_area = $bf00 ;configure emulator terminal I/O +acia_tx = io_area+$f0 ;acia tx data register +acia_rx = io_area+$f0 ;acia rx data register +acia_st = io_area+$ff ;bit 0 = 10ms tick +;=====================================================; + org vtl02b +;-----------------------------------------------------; +; Initialize program area pointers and start VTL02B +; 17 bytes + lda #lo(prgm) + sta ampr ; {&} -> empty program + lda #hi(prgm) + sta ampr+1 + lda #lo(himem) + sta star ; {*} -> top of user RAM + lda #hi(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 #lo(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? +; patch - remove garbage output when halting print +; 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 a ; variable + tax + iny + lda arg+3 + sta (arg),y + adc tick ; pseudo-randomize {'} + rol a + 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 a +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 a ; 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 #lo(linbuf); entry point: start a fresh line + sty at ; {@} -> input line buffer + ldy #hi(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 #hi(prgm) ; cc: search begins at first line + sta at+1 + lda #lo(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 +;========== 2m5 SBC emulator I/O subroutines ============; +;-----------------------------------------------------; +; Check for user keypress and return if none +; is pending. Otherwise, check for ctrl-C and +; return after next keypress. +; +inkey: + lda acia_rx ; Is there a character waiting? + beq inkeyr ; no: return + cmp #3 ; is ctrl-c + beq istart ; yes: abort to OK prompt +inkeyp: + lda acia_rx ; pause until next key + beq inkeyp + cmp #3 ; is ctrl-c + beq istart ; yes: abort to OK prompt +inkeyr: + rts +; - - - - - - - - - - - - - - - - - - - - - - - - - - ; +; Read key from stdin into a, echo, (cs) +; Dump stack and abort to "OK" prompt if ctrl-C +; +inch: + lda acia_rx ; get character from rx register + beq inch ; wait for character !=0 + sty dolr ; save y reg + cmp #127 ; convert delete to backspace + bne conv_bs2del + lda #8 +conv_bs2del: + cmp #27 ; escape? + bne skip_esc_no + ldy #5 ; timer loop - 5*10ms +skip_esc_next: + lda #1 ; ack last tick + sta acia_st +skip_esc_wait: + lda acia_st + and #1 ; next tick + beq skip_esc_wait + dey + bne skip_esc_next +skip_esc_discard: + iny ; any data = y > 1 + lda acia_rx + bne skip_esc_discard + cpy #1 + bne inch +skip_esc_esc: ; escape only - send to vtl + lda #27 + rts +skip_esc_no + ldy dolr ; restore y reg +inch2: + and #$7f ; ensure char is positive ascii + cmp #$03 ; ctrl-C? + bne outch ; no: echo to terminal +istart: + jmp start ; yes: abort to "OK" prompt +; - - - - - - - - - - - - - - - - - - - - - - - - - - ; +; Print ascii char in a to stdout, (cs) +; +outch: + cmp #13 ; add line feed to carriage return + bne skip_cr + lda #10 + sta acia_tx + lda #13 +skip_cr: + cmp #8 ; backspace? + bne skip_bs + sta acia_tx ; make erasing backspace + lda #' ' + sta acia_tx + lda #8 +skip_bs: + sta acia_tx ; emit char via transmit register + sec ; (by contract with callers) + rts +;-----------------------------------------------------; + org $fffc + dw vtl02b ; reset vector -> cold start + end vtl02b ; set start address