diff --git a/readme.txt b/readme.txt index 8faa4d0..164c027 100644 --- a/readme.txt +++ b/readme.txt @@ -20,8 +20,12 @@ vtl02ca2.65s VTL02C for my emulator & the Kingswood AS65 assembler vtl02ca2.a65 - - 2015: Revision B included some space optimizations + VTL02C codename "Speedy Gonzales" + vtl02sg.a65 + this is a work in progress version and is my attempt + to trade performance versus codesize + + 2015: Revision B included some space optimizations (suggested by dclxvi) and enhancements (suggested by mkl0815 and Klaus2m5): diff --git a/vtl02sg.a65 b/vtl02sg.a65 new file mode 100644 index 0000000..22444b5 --- /dev/null +++ b/vtl02sg.a65 @@ -0,0 +1,1418 @@ +;234567890123456789012345678901234567890123456789012345 +; +; In the Kingswood AS65 assembler some of the options +; below must be set manually. +; +; .lf vtl02ca2.lst (set -l in commandline) +; .cr 6502 (is default) +; .tf vtl02ca2.obj,ap1 (set -s2 in commandline) +;-----------------------------------------------------; +; VTL-2 for the 6502 (VTL02C) ; +; 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! ; +;-----------------------------------------------------; +; Copyright (c) 2012, Michael T. Barry +; Revision B (c) 2015, Michael T. Barry +; Revision C (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. +;-----------------------------------------------------; +; Except for the differences discussed below, VTL02 was +; designed to duplicate the OFFICIALLY DOCUMENTED +; behavior of Frank's 680b version, detailed here: +; http://www.altair680kit.com/manuals/Altair_ +; 680-VTL-2%20Manual-05-Beta_1-Searchable.pdf +; These 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. +; +; Differences between the 680b and 6502 versions: +; * {&} and {*} are initialized on entry. +; * Division by zero returns 65535 for the quotient and +; the dividend for the remainder (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 VTL02C +; 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 VTL02C +; 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 VTL02C 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 are +; similar to the 680b version, but have 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). +; * This version is based on the original port, which +; was 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 just a few bytes to +; spare, but is more feature-laden than the 680b +; interpreter whence it came. Beginning with +; Revision C, I tried to strike a tasteful balance +; between execution speed and code size, but I +; stubbornly kept it under 1024 ROMable bytes and +; used only documented op-codes that were supported +; by the original NMOS 6502 (without the ROR bug). +; I may have missed a few optimizations -- further +; suggestions are welcome. +; * VTL02C 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 VTL02C (nothing). +;-----------------------------------------------------; +; 2015: Revision B included some space optimizations +; (suggested by dclxvi) and enhancements +; (suggested by mkl0815 and Klaus2m5): +; +; * 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 +; +; * Starting with VTL02B, the space character is no +; longer a valid user variable nor a "valid" binary +; operator. It's 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 +; +; 2015: Revision C includes further enhancements +; (suggested by Klaus2m5): +; +; * "THEN" and "ELSE" operators [ ] +; A[B returns 0 if A is 0, otherwise returns B. +; A]B returns B if A is 0, otherwise returns 0. +; +; * Some effort was made to balance interpreter code +; density with interpreter performance, while +; remaining within the 1KB constraint. Structured +; programming principles remained at low priority. +; +; VTL02 for the 2m5 emulated 6502 SBC +; - codename: speedy Gonzales +; - based on VTL02C, changes by Klaus2m5 +; +; added a timer variable {/} with 10ms increments +; required atomic variable fetch & store. +; replaced some jsr calls with inline code +; for skpbyte:, getbyte:, plus:, minus:. +; replaced cvbin calls to mul: & plus: with custom +; inline multiply by 10 & digit adder. +; removed simulation from startup of eval:. +; mainloop uses inline code to advance to next +; sequential program line. +; find: is now only used for true branches. +; added statement delimiter allowing multi statement +; lines. branch to same line is now allowed. +; +;-----------------------------------------------------; +; VTL02C 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 VTL02C is +; "safe". The same cannot be said for {; < =}, so be +; careful! +at = $80 ; {@}* internal pointer / mem byte +; VTL02C standard user variable space +; {A B C .. X Y Z [ \ ] ^ _} +; VTL02C system variable space +space = $c0 ; { } Starting with 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 +; $fe ; {/} counting 10ms tick timer +; 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 / + ; statement separator +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 +; additional configurable variables and operators +timr_var = '/' ; 10 ms count up variable +stmntdlm = ';' ; statement delimiter +;-----------------------------------------------------; +; 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 ; VTL02C program grows from here +;himem = $8000 ; ... up to the top of user RAM +;vtl02c = $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 +timr_var = '/' ; 10 ms count up variable +linbuf = $0200 ; input line buffer +prgm = $0400 ; VTL02C program grows from here +himem = $7a00 ; ... up to the top of user RAM +vtl02c = $fa00 ; 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 +timr_ie = io_area+$fe ;timer interrupt enable bit 0 +timr_fl = io_area+$ff ;timer flags, bit 0 = 10ms tick +;=====================================================; + org vtl02c +;-----------------------------------------------------; +; Initialize program area pointers and start VTL02C +; 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 VTL02C command line with program intact +; 32 bytes +start: + cld ; a sensible precaution + ldx #lo(nulstk) + txs ; drop whatever is on the stack + bcc user ; skip "OK" if carry clear + jsr outnl + lda #'O' ; output \nOK\n to terminal + jsr outch + lda #'K' + jsr outch + jsr outnl +user: + lda #0 ; last line # = direct mode + sta lparen + sta lparen+1 + jsr inln ; input a line from the user + ldx #pound ; cvbin destination = {#} + jsr cvbin ; does line start with a number? + beq direct ; no: execute direct statement +; - - - - - - - - - - - - - - - - - - - - - - - - - - ; +; Delete/insert/replace program line or list program +; 7 bytes +stmnt: + clc + lda pound + ora pound+1 ; {#} = 0? + bne jskp2 ; no: delete/insert/replace line +; - - - - - - - - - - - - - - - - - - - - - - - - - - ; +; List program to terminal and restart "OK" prompt +; entry: Carry must be clear +; uses: findln:, outch:, prnum:, prstr:, {@ ( )} +; exit: to command line via findln: +; 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) + +jskp2: + jmp skp2 + +;-----------------------------------------------------; +; The main program execution loop +; entry: with (cs) via "beq direct" in user: +; exit: to command line via findln: or "beq start" +; +progr: +; beq eloop0 ; if {#} = 0 then ignore and +; beq prog_nxt ; no branch - next line + lda arg ; left side of last eval was {#}? + cmp #pound + bne prog_nxt + lda arg+1 + beq branch +; ldy lparen+1 ; continue (false branch) +; ldx lparen ; else did {#} change? +; cpy pound+1 ; yes: perform a branch, with +; bne branch ; carry flag conditioned for +; cpx pound ; the appropriate direction. +;; beq eloop ; no: execute next line (cs) +; bne branch + +prog_nxt: + ldy #2 ; point {@} to next line address + ldx at+1 ; current line address + lda at + clc + adc (at),y ; {@} low + offset + bcc prg_n1 + inx ; {@} high + carry +prg_n1: + cpx ampr+1 ; exceeds end of program? + bcc prg_n2 ; no + bne start ; yes - exit to direct mode + cmp ampr + bcs start +prg_n2: ; (cc) + stx at+1 ; next line address valid! + sta at + ldy #0 + lda (at),y + sta lparen ; {(} = {#} = current line number + sta pound + iny + lda (at),y + sta lparen+1 + sta pound+1 +;prg_same: ; from branch to same line + ldy #3 + +direct: + php ; (cc: program, cs: direct) + jsr exec ; execute one VTL02C line + plp + bcc progr ; if program mode then continue + lda pound ; if direct mode, did {#} change? + ora pound+1 + beq jstart2 ; no: restart "OK" prompt + bne eloop0 ; yes: execute program from {#} + +branch: + ldy lparen+1 ; execute a VTL02C branch + ldx lparen + cpy pound+1 ; perform a branch, with + bne branch1 ; carry flag conditioned for + cpx pound ; the appropriate direction. +; beq prg_same ; is the same line again +branch1: + inx ; leave a return address + bne branch2 + iny +branch2: + stx bang ; {!} = {(} + 1 (return ptr) + sty bang+1 +eloop0: + rol a + eor #1 ; complement carry flag + ror a +eloop: +; jsr findln ; find first/next line >= {#} + jsr find ; inline findln + bcs jstart2 ; if end then restart "OK" prompt + sta pound ; {#} = {(} + stx pound+1 ; end inline + + iny ; skip over the length byte + bne direct + +jstart2: + jmp start + +;-----------------------------------------------------; +; Delete/insert/replace program line and restart the +; command prompt (no "OK" means success) +; entry: Carry must be clear +; uses: find:, start:, linbuf, {@ > # & * (} +; 151 bytes +skp2: + tya ; save linbuf offset pointer + pha + jsr find ; point {@} to first line >= {#} + bcs insrt + eor pound ; if line doesn't already exist + bne insrt ; then skip deletion process + cpx 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 drop 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 ; drop 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) +; used by: list_:, progr: +; uses: find:, jstart:, prgm, {@ # & (} +; exit: if line not found then abort to "OK" prompt +; else {@} -> found line, x:a = {#} = {(} = +; actual line number, y = 2, (cc) +; 10 bytes +findln: + jsr find ; find first/next line >= {#} + bcs jstart ; if end then restart "OK" prompt + sta pound ; {#} = {(} + stx 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 drops 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) drop the stack & restart "OK" prompt +; +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/resume? +; 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 +pro_skp: ; inline skpbyte + iny + lda (at),y + cmp #' ' + beq pro_skp ; end inline + + cmp #';' ; if trailing char is ';' then + beq execrts ; suppress the \n +outnl: + lda #$0d ; \n to terminal + jmp outch +;-----------------------------------------------------; +; Execute a (hopefully) valid VTL02C 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 {(} +; {>=...;..} requires {$} to be preserved +; if there is a {"} directly after the assignment +; operator, the statement will execute as {?="...}, +; regardless of the variable named on the left side +; +;execrts1: +; rts +exec: +; jsr getbyte ; fetch left-side variable name +; beq execrts ; do nothing with a null statement +; cmp #')' ; same for a full-line comment +; beq execrts +; iny + lda (at),y ; inline getbyte + beq execrts ; do nothing with a null statement + cmp #')' ; same for a full-line comment + beq execrts +; sty dolr+1 ; save index if arg[{1}] = arg[{0}] + iny + cmp #' ' ; is space? + beq exec ; end inline + ldx #arg ; initialize argument pointer + jsr convp ; arg[{0}] -> left-side variable +; jsr getbyte ; skip over assignment operator +; jsr skpbyte ; is right-side a literal string? +exec_gb3: ; inline getbyte + skpbyte + lda (at),y + iny ; skip space +1 + cmp #' ' ; is space? + beq exec_gb3 +; cmp #'=' ; not '=' implies assigning +; beq exec_gb4 ; variable as target & 1st source +; ldy dolr+1 ; back up to arg[{1}] = arg[{0}] +; lda (at),y +; bne exec_gb5 +exec_gb4: + lda (at),y + cmp #' ' ; is space? + bne exec_gb5 + iny ; skip over any space char(s) + bne exec_gb4 +exec_gb5: ; end inline + + 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}] + pha + sty dolr+1 ; save to continue same line + lda arg+2 + ldy #0 + ldx arg+1 ; was left-side an array element? + bne exec3 ; yes: skip to default actions + ldx arg + cpx #at ; if {@=...} statement then poke + beq poke ; low half of arg[{1}] to ({<}) + cpx #dolr ; if {$=...} statement then print + beq joutch ; arg[{1}] as ASCII character + cpx #ques ; if {?=...} statement then print + beq prnum0 ; arg[{1}] as unsigned decimal + cpx #gthan ; if {>=...} statement then call + beq usr ; user-defined ml routine + cpx #pound ; if {#=...} statement then goto + beq goto ; arg[{1}] as line number +exec3: + sei ; force timer consistency + sta (arg),y + adc tick+1 ; store arg[{1}] in the left-side + rol a ; variable + tax + iny + lda arg+3 + sta (arg),y + cli ; force timer consistency end + adc tick ; pseudo-randomize {'} + rol a + sta tick+1 + stx tick +execend: + ldy dolr+1 ; restore line index + pla + cmp #stmntdlm ; statement delimiter ? + beq exec ; continue with next statement +execrts: + rts ; end of line +goto: + tax ; save line # low + ora arg+3 ; fall through ? + bne goto1 + sta arg ; invalidate goto {#} + beq execend +goto1: + pla ; true goto + cpx lparen ; is same line ? + bne goto2 + lda arg+3 + cmp lparen+1 + bne goto2 + ldy #3 ; start over + jmp exec +goto2: + tya ; different line + pha ; invalidate {;} + txa ; restore line # low + jmp exec3 ; store new line in {#} +usr: + tax ; jump to user ml routine with + lda arg+3 ; arg[{1}] in a:x (MSB:LSB) + jsr usrq + jmp execend +usrq: + jmp (quote) ; {"} must point to valid 6502 code +poke: + sta (lthan),y ; store low byte + jmp execend +joutch: + jsr outch ; print character + jmp execend +;-----------------------------------------------------; +; {?=...} handler; called by exec: +; 2 bytes +prnum0: + ldx #arg+2 ; x -> arg[{1}], fall through + jsr prnum + jmp execend +; - - - - - - - - - - - - - - - - - - - - - - - - - - ; +; Print an unsigned decimal number (0..65535) in var[x] +; entry: var[x] = number to print +; uses: div:, outch:, var[x+2], saves original {%} +; exit: var[x] = 0, var[x+2] = 10 +; 43 bytes +prnum: + lda remn + pha ; save {%} + lda remn+1 + pha + lda #0 ; null delimiter for print + pha + sta 3,x + lda #10 ; divisor = 10 + sta 2,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 VTL02C expression at +; @[y] and place its calculated value in arg[x] +; A VTL02C 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 +; +eval: +; lda #0 +; sta 0,x ; start evaluation by simulating +; sta 1,x ; {0+expression} +; lda #'+' + jsr getval ; arg[x] = value of first term + jmp eval_gb ; startup skipping simulation +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 +eval_gb: ; inline getbyte + lda (at),y + beq evalrts + iny ; skip over any space char(s) + cmp #stmntdlm ; statement delimiter ? + beq evalrts + cmp #' ' ; is space? + beq eval_gb ; end inline + + 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)/?) +; +getval: + jsr cvbin ; decimal number at @[y]? + bne getrts ; yes: return with it in var[x] +; jsr getbyte + lda (at),y ; inline getbyte + iny ; skip space +1 + cmp #'@' ; peek? + beq peek + bcs getv_byp ; bypass variables > @ + cmp #'(' ; sub-expression? + beq eval ; yes: evaluate it recursively + cmp #'$' ; user char input? + beq in_chr + cmp #'?' ; user line input? + beq in_val +getv_byp: +; first set var[x] to the named variable's address, +; then replace that address with the variable's actual +; value before returning + jsr convp + sei ; force timer consistency + lda (0,x) + pha + inc 0,x + bne getval4 + inc 1,x +getval4: + lda (0,x) + cli ; force timer consistency end + sta 1,x ; store high-byte of term value + pla +getval5: + sta 0,x ; store low-byte of term value +getrts: + rts + +peek: ; memory access? + sty dolr + ldy #0 + lda (lthan),y ; access memory byte at ({<}) + ldy dolr + sta 0,x + rts + +in_chr: ; user char input? + jsr inch ; input one char + sta 0,x + rts + +in_val: ; user line input + tya + 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 + +;-----------------------------------------------------; +; 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 +; +convp: + cmp #':' ; array element? + bne simple ; no: var[x] -> simple variable + 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 + bne plus ; (always taken) +; The following section is designed to translate the +; named simple variable from its ASCII value to its +; zero-page address. In this case, 'A' translates +; to $82, '!' translates to $c2, etc. The method +; employed must correspond to the zero-page equates +; above, or strange and not-so-wonderful bugs will +; befall the weary traveller on his or her porting +; journey. +simple: + asl a ; form simple variable address + ora #$80 ; mapping function is (a*2)|128 + sta 0,x + lda #0 + sta 1,x + rts +;-----------------------------------------------------; +; 16-bit unsigned multiply routine: var[x] *= var[x+2] +; exit: overflow is ignored/discarded, var[x+2] and +; {>} are modified, a = 0 +; +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: + lda gthan + ora gthan+1 + beq mulrts ; exit early if {>} = 0 + lsr gthan+1 + ror gthan ; {>} /= 2 + bcc mul3 +; jsr plus ; form the product in var[x] + clc ; inline plus + lda 0,x + adc 2,x + sta 0,x + lda 1,x + adc 3,x + sta 1,x ; end inline +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 +mulrts: + rts +;-----------------------------------------------------; +; var[x] += var[x+2] +; 14 bytes +plus: + clc + lda 0,x + adc 2,x + sta 0,x + lda 1,x + adc 3,x + sta 1,x + rts +;-----------------------------------------------------; +; expects: - +; +then_: + lda 0,x + ora 1,x + beq then_exit +else_true: + lda 2,x + sta 0,x + lda 3,x + sta 1,x +then_exit: + rts +;-----------------------------------------------------; +; expects: - +; +else_: + lda 0,x + ora 1,x + beq else_true + lda #0 + sta 0,x + sta 1,x + rts +;-----------------------------------------------------; +; Apply the binary operator in a to var[x] and var[x+2] +; Valid VTL02C operators are {* + / [ ] - | ^ & < = >} +; {>} is defined as greater than _or_equal_ +; An undefined operator will be interpreted as one of +; the three comparison operators +; +oper: + cmp #'+' ; addition operator? + beq plus + cmp #'*' ; multiplication operator? + beq mul + cmp #'/' ; division operator? + beq div + cmp #'[' ; "then" operator? + beq then_ + cmp #']' ; "else" operator? + beq else_ + cmp #'-' ; subtraction operator? + beq minus + cmp #OP_OR ; bit-wise or operator? + beq or_ + cmp #'^' ; bit-wise xor operator? + beq xor_ + cmp #'&' ; bit-wise and operator? + beq and_ +; - - - - - - - - - - - - - - - - - - - - - - - - - - ; +; Apply comparison operator in a to var[x] and var[x+2] +; and place result in var[x] (1: true, 0: false) +; expects: (cs) +; + eor #'<' ; 0: '<' 1: '=' 2: '>' + sta gthan ; other values in a are undefined, +; jsr minus ; but _will_ produce some result + lda 0,x ; inline minus + sbc 2,x + sta 0,x + lda 1,x + sbc 3,x + sta 1,x ; end inline + 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) + sta 0,x + lda #0 + sta 1,x + rts +;-----------------------------------------------------; +; var[x] -= var[x+2] +; expects: (cs) +; 13 bytes +minus: + lda 0,x + sbc 2,x + sta 0,x + lda 1,x + sbc 3,x + sta 1,x + rts +;-----------------------------------------------------; +; var[x] &= var[x+2] +; expects: - +; 13 bytes +and_: + lda 0,x + and 2,x + sta 0,x + lda 1,x + and 3,x + sta 1,x + rts +;-----------------------------------------------------; +; var[x] |= var[x+2] +; expects: - +; 13 bytes +or_: + lda 0,x + ora 2,x + sta 0,x + lda 1,x + ora 3,x + sta 1,x + rts +;-----------------------------------------------------; +; var[x] ^= var[x+2] +; expects: - +; 13 bytes +xor_: + lda 0,x + eor 2,x + sta 0,x + lda 1,x + eor 3,x + sta 1,x + rts +;-----------------------------------------------------; +; 16-bit unsigned division routine +; var[x] /= var[x+2], {%} = remainder, {>} modified +; var[x] /= 0 produces {%} = var[x], var[x] = 65535 +; 43 bytes +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 +;-----------------------------------------------------; +; 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. +; used by: user:, getval: +; 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 +; +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 +cvb_gb1: ; inline getbyte + sty ques ; save pointer + lda (at),y + cmp #' ' ; is space? + bne cvb_gb2 + iny ; skip over any space char(s) + bne cvb_gb1 ; end inline + +cvbin2: + lda (at),y ; grab a char +cvb_gb2: + eor #'0' ; 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 +; sta 3,x + lda 1,x ; inline multiply by 10 + sta gthan+1 + lda 0,x + sta gthan + asl a + rol 1,x + asl a + rol 1,x + clc + adc gthan + sta 0,x + lda 1,x + adc gthan+1 + asl 0,x + rol a + sta 1,x ; end inline + pla ; retrieve decimal digit +; sta 2,x +; jsr plus ; var[x] += digit + clc ; inline add digit + adc 0,x + sta 0,x + bcc cvbin4 + inc 1,x +cvbin4: ; end inline + 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) +; used by: user:, getval: +; uses: inch:, outnl:, linbuf, {@} +; 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 +; ({@} -> beginning of current line) +; used by: skp2:, findln: +; uses: prgm, {@ # & (} +; exit: (cs): {@}, x:a and {(} undefined, y = 2 +; (cc): {@} -> beginning of found line, y = 2, +; x:a = {(} = actual found line number +; 62 bytes +find: + ldx #hi(prgm) + lda #lo(prgm) + bcc find1st ; cc: search begins at first line + ldx at+1 + ldy #2 +findnxt: + lda at + cmp ampr + lda at+1 + sbc ampr+1 ; {@} >= {&} (end of program)? + bcs findrts ; yes: search failed (cs) +find3: + lda at + adc (at),y ; no: {@} -> next line + bcc find5 + inx +find1st: + stx at+1 +find5: + sta at + 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 + sbc pound+1 ; if {(} < {#} then try the next + iny ; program line + bcc findnxt + lda at ; {@} >= {&} (end of program)? + cmp ampr ; yes: search failed (cs) + lda at+1 ; no: search succeeded (cc) + sbc ampr+1 + lda lparen + ldx lparen+1 +findrts: + rts +;-----------------------------------------------------; +; Fetch a byte at @[y], ignoring space characters +; 10 bytes +;skpbyte: +; iny ; skip over current char +;getbyte: +; lda (at),y +; beq getbyt2 +; cmp #' ' +; beq skpbyte ; skip over any space char(s) +;getbyt2: +; 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) +; drop 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 timr_fl +skip_esc_wait: + lda timr_fl + 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 +; - - - - - - - - - - - - - - - - - - - - - - - - - - ; +; Update a variable with the 10ms timer +; +timr_adr = timr_var*2|$80 +IRQ_10ms: + pha + inc timr_adr ; increment the variable {/} + bne IRQ_exit + inc timr_adr+1 +IRQ_exit: + lda #1 ; clear interrupt flag + sta timr_fl + pla + rti +; Start the timer prior to VTL +IRQ_start: + lda #1 ; set bit 0 (10ms tick) + sta timr_ie ; -> interrupt enable + cli + jmp vtl02c ; continue cold start +;-----------------------------------------------------; + org $fffc + dw IRQ_start ; reset vector -> cold start + dw IRQ_10ms ; interrupt vector -> 10ms update + end IRQ_start ; set start address