From 251944d43ace5185d0cb13caed5a25b3c2fd4099 Mon Sep 17 00:00:00 2001 From: Klaus2m5 Date: Thu, 29 Oct 2015 20:12:42 +0100 Subject: [PATCH] VTL02C update to VTL02C --- readme.txt | 52 ++- vtl02ba2.65s => vtl02ca2.65s | 837 +++++++++++++++++++---------------- vtl02ba2.a65 => vtl02ca2.a65 | 837 +++++++++++++++++++---------------- vtl02ba2.asm => vtl02ca2.asm | 829 ++++++++++++++++++---------------- 4 files changed, 1389 insertions(+), 1166 deletions(-) rename vtl02ba2.65s => vtl02ca2.65s (66%) rename vtl02ba2.a65 => vtl02ca2.a65 (66%) rename vtl02ba2.asm => vtl02ca2.asm (64%) diff --git a/readme.txt b/readme.txt index 55e48af..8faa4d0 100644 --- a/readme.txt +++ b/readme.txt @@ -1,28 +1,30 @@ ----------------------------------------------------- - VTL-2 for the 6502 (VTL02B) + 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 see source code for copyright notice 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). The basic concepts of VTL-2 (Very Tiny Language): http://www.altair680kit.com/manuals/Altair_680-VTL-2%20Manual-05-Beta_1-Searchable.pdf The files: - VTL02B for the apple II & the sbprojects.com assembler: - vtl02ba2.asm - VTL02B for the Kowalski 6502 simulator: - http://www.exifpro.com/downloads/6502_1.2.12.zip: - vtl02ba2.65s - VTL02B for my emulator & the Kingswood AS65 assembler: - vtl02ba2.a65 + Original source code from Mike: + VTL02C for the apple II & the sbprojects.com assembler + vtl02ca2.asm + Modified versions (Syntax, I/O & user RAM size): + VTL02C for the Kowalski 6502 simulator + http://www.exifpro.com/downloads/6502_1.2.12.zip + vtl02ca2.65s + VTL02C for my emulator & the Kingswood AS65 assembler + vtl02ca2.a65 - New features in Revision B: + 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 @@ -31,13 +33,13 @@ 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. + * 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 @@ -52,3 +54,15 @@ 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. diff --git a/vtl02ba2.65s b/vtl02ca2.65s similarity index 66% rename from vtl02ba2.65s rename to vtl02ca2.65s index fb9f0fe..45373bd 100644 --- a/vtl02ba2.65s +++ b/vtl02ca2.65s @@ -3,7 +3,7 @@ ; In the Kowalski 6502 simulator some of the options ; below must be set manually. ; -; .lf vtl02ba2.lst (set listfile in menu: +; .lf vtl02ca2.lst (set listfile in menu: ; Simulator->Options->Assembler) ; .cr 6502 .opt Proc6502 @@ -16,52 +16,18 @@ ; Simulator->Run [F5] ; View->Input/output [Alt-5] ; -; .tf vtl02ba2.obj,ap1 (optional save output to +; .tf vtl02ca2.obj,ap1 (optional save output to ; file: File->Save Code) ;-----------------------------------------------------; -; VTL-2 for the 6502 (VTL02B) ; +; 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! ; ;-----------------------------------------------------; -; 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 +; Revision C (c) 2015, Michael T. Barry ; All rights reserved. ; ; Redistribution and use in source and binary forms, @@ -92,14 +58,27 @@ ; 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. ; -; Notes concerning this version: +; Differences between the 680b and 6502 versions: ; * {&} and {*} are initialized on entry. -; * Division by zero returns a quotient of 65535 -; (the original 6800 version froze). +; * 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 VTL02B +; 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). @@ -111,53 +90,95 @@ ; 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 +; * 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 VTL02B statement (easily handling the maximum +; 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 is -; similar to the 680b version, but it has been +; * 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). -; * 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 +; * 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. -; * VTL02B is my free gift (?) to the world. It may be +; * 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 VTL02B (nothing). +; limited to the price of VTL02C (nothing). ;-----------------------------------------------------; -; VTL02B variables occupy RAM addresses $0080 to $00ff, +; 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. +;-----------------------------------------------------; +; 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 @@ -166,21 +187,21 @@ ; 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 +; 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 -; VTL02B standard user variable space +; VTL02C 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. +; 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 @@ -210,7 +231,7 @@ nulstk = $01ff ; system stack resides in page 1 ;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 +;vtl02c = $8000 ; interpreter cold entry point ; (warm entry point is startok) ;KBD = $c000 ; 128 + keypress if waiting ;KEYIN = $fd0c ; apple monitor keyin routine @@ -223,15 +244,15 @@ 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 +vtl02c = $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 + .org vtl02c ;-----------------------------------------------------; -; Initialize program area pointers and start VTL02B +; Initialize program area pointers and start VTL02C ; 17 bytes lda # empty program @@ -244,99 +265,97 @@ acia_rx = io_area+4 ;acia rx data register startok: sec ; request "OK" message ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; -; Start/restart VTL02B command line with program intact -; 29 bytes + 3 bytes patch: restore VTL02a behavior +; Start/restart VTL02C command line with program intact +; 32 bytes start: - cld + cld ; a sensible precaution ldx # 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 + lda pound + ora pound+1 ; {#} = 0? + bne skp2 ; no: delete/insert/replace line ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; List program to terminal and restart "OK" prompt ; entry: Carry must be clear -; uses: findln, outch, prnum, prstr, {@ ( )} +; 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 + 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 +; The main program execution loop +; entry: with (cs) via "beq direct" in user: +; exit: to command line via findln: or "beq start" +; 45 bytes +progr: + beq eloop0 ; if {#} = 0 then ignore and + 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) +branch: + inx ; execute a VTL02B branch + bne branch2 + iny +branch2: + stx bang ; {!} = {(} + 1 (return ptr) + sty bang+1 +eloop0: + rol + eor #1 ; complement carry flag + ror +eloop: + jsr findln ; find first/next line >= {#} + iny ; skip over the length byte +direct: + php ; (cc: program, cs: direct) + jsr exec ; execute one VTL02B statement + plp + lda pound ; update Z for {#} + ora pound+1 ; if program mode then continue + bcc progr ; if direct mode, did {#} change? + beq start ; no: restart "OK" prompt + bne eloop0 ; yes: execute program from {#} +;-----------------------------------------------------; +; Delete/insert/replace program line and restart the +; command prompt (no "OK" means success) ; entry: Carry must be clear -; uses: find, start, {@ > # & * (}, linbuf -; 155 bytes +; uses: find:, start:, linbuf, {@ > # & * (} +; 151 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 + eor pound ; if line doesn't already exist bne insrt ; then skip deletion process - lda lparen+1 - eor pound+1 + cpx pound+1 bne insrt tax ; x = 0 lda (at),y @@ -372,7 +391,7 @@ insrt: pha ldy #2 cntln: - inx + inx iny ; determine new line length in y lda linbuf-1,x ; and push statement string on pha ; the system stack @@ -390,7 +409,7 @@ cntln: 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 + sbc star+1 ; so drop the stack and abort bcs jstart ; to the "OK" prompt slide: lda ampr @@ -422,28 +441,27 @@ move2: lda gthan+1 sta ampr+1 jstart: - jmp start ; dump stack, restart cmd prompt + 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) -; 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 +; 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 - lda lparen sta pound ; {#} = {(} - lda lparen+1 - sta pound+1 + stx pound+1 rts ;-----------------------------------------------------; -; {?="...} handler; called from 'exec' -; List line handler; called from 'list_' +; {?="...} handler; called from exec: +; List line handler; called from list_: ; 2 bytes prstr: iny ; skip over the " or length byte @@ -454,12 +472,12 @@ prstr: ; 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" +; 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 +; uses: inch:, inkey:, jstart:, outch:, execrts: ; exit: (normal) @[y] -> null or byte after delimiter -; (ctrl-C) dump the stack & restart "OK" prompt +; (ctrl-C) drop the stack & restart "OK" prompt ; 39 bytes prmsg: txa @@ -487,29 +505,26 @@ outnl: 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 {(} +; 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 {(} ; 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 +; 84 bytes exec: jsr getbyte ; fetch left-side variable name - beq execrts ; do nothing if null statement - iny + beq execrts ; do nothing with a null statement + cmp #')' ; same for a full-line comment + beq execrts + 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 convp ; arg[{0}] -> left-side variable jsr getbyte ; skip over assignment operator jsr skpbyte ; is right-side a literal string? cmp #'"' ; yes: print the string with @@ -517,27 +532,19 @@ exec1: ldx #arg+2 ; point eval to arg[{1}] jsr eval ; evaluate right-side in arg[{1}] 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 - bne exec1a ; low half of arg[{1}] to ({<}) - ldy #0 - sta (lthan),y - rts -exec1a: + 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 #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: + 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 exec3: - ldy #0 sta (arg),y adc tick+1 ; store arg[{1}] in the left-side rol ; variable @@ -551,33 +558,40 @@ exec3: stx tick execrts: rts +usr: + tax ; jump to user ml routine with + lda arg+3 ; arg[{1}] in a:x (MSB:LSB) + jmp (quote) ; {"} must point to valid 6502 code +poke: + sta (lthan),y + rts ;-----------------------------------------------------; -; {?=...} handler; called by 'exec' +; {?=...} 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 +; 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 - lda #0 - pha ; null delimiter for print - sta 3,x ; repeat { + sta 2,x ; repeat { prnum2: jsr div ; divide var[x] by 10 lda remn - ora #'0' ; convert remainder to ascii + ora #'0' ; convert remainder to ASCII pha ; stack digits in ascending - lda 0,x ; order ('0' for zero) + lda 0,x ; order ('0' for zero) ora 1,x bne prnum2 ; } until var[x] is 0 pla @@ -591,9 +605,9 @@ prnum3: 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 +; 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 @@ -602,9 +616,9 @@ prnum3: ; 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 +; entry: @[y] -> expression text, x -> argument +; uses: getval:, oper:, {@}, argument stack area +; exit: arg[x] = result, @[y] -> next text ; 31 bytes eval: lda #0 @@ -684,48 +698,42 @@ getval5: 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 -; +; 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 +; 26 bytes +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 ; form simple variable address + ora #$80 ; mapping function is (a*2)|128 + bmi oper8d ; (always taken) +;-----------------------------------------------------; +; 16-bit unsigned multiply routine: var[x] *= var[x+2] +; exit: overflow is ignored/discarded, var[x+2] and +; {>} are modified, a = 0 +; 40 bytes mul: lda 0,x sta gthan @@ -735,25 +743,155 @@ mul: 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] mul3: asl 2,x - rol 3,x ;left-shift var[x+2] + rol 3,x ; left-shift var[x+2] lda 2,x ora 3,x ; loop until var[x+2] = 0 bne mul2 +mulrts: rts -oper4: +;-----------------------------------------------------; +; 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 +;-----------------------------------------------------; +; 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 +; 37 bytes +oper: + cmp #'+' ; addition operator? + beq plus + cmp #'*' ; multiplication operator? + beq mul cmp #'/' ; division operator? - bne oper5 ; no: next case + beq div + cmp #'[' ; "then" operator? + beq then_ + cmp #']' ; "else" operator? + beq else_ + dex ; (factored from the following ops) + 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), pre-decremented x +; 29 bytes + 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 + lda #0 + beq minus3 ; (always taken) +;-----------------------------------------------------; +; expects: (cs) +; 14 bytes +then_: + lda 0,x + ora 1,x + beq minus4 + lda 2,x + sta 0,x + lda 3,x + bcs minus3 ; (always taken) +;-----------------------------------------------------; +; expects: (cs) +; 10 bytes +else_: + lda 0,x + ora 1,x + beq plus + lda #0 + beq oper8d ; (always taken) +;-----------------------------------------------------; +; var[x] -= var[x+2] +; expects: (cs), pre-decremented x +; 11 bytes +minus: + jsr minus2 + inx +minus2: + lda 1,x + sbc 3,x +minus3: + sta 1,x +minus4: + rts +;-----------------------------------------------------; +; var[x] &= var[x+2] +; expects: (cs), pre-decremented x +; 10 bytes +and_: + jsr and_2 + inx +and_2: + lda 1,x + and 3,x + bcs minus3 ; (always taken) +;-----------------------------------------------------; +; var[x] |= var[x+2] +; expects: (cs), pre-decremented x +; 10 bytes +or_: + jsr or_2 + inx +or_2: + lda 1,x + ora 3,x + bcs minus3 ; (always taken) +;-----------------------------------------------------; +; var[x] ^= var[x+2] +; expects: (cs), pre-decremented x +; 10 bytes +xor_: + jsr xor_2 + inx +xor_2: + lda 1,x + eor 3,x + bcs minus3 ; (always taken) +;-----------------------------------------------------; ; 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 @@ -779,100 +917,19 @@ 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 +; 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 +; 43 bytes cvbin: lda #0 sta 0,x ; var[x] = 0 @@ -882,13 +939,14 @@ cvbin: sty ques ; save pointer cvbin2: lda (at),y ; grab a char - eor #$30 ; if char at @[y] is not a + 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 pla ; retrieve decimal digit sta 2,x jsr plus ; var[x] += digit @@ -900,9 +958,10 @@ cvbin3: ;-----------------------------------------------------; ; 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 +; 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? @@ -934,44 +993,52 @@ inln3: 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 +; 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: - bcs findnxt ; cs: search begins at next line - lda #>prgm ; cc: search begins at first line - sta at+1 - lda # first program line - bcc find1st ; (always taken) + ldx #>prgm + lda #= {&} then the search - bcs findrts ; failed, so return with (cs) lda at - adc (at),y ; {@} += length of current line + 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 - 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 + sta lparen+1 + sbc pound+1 ; if {(} < {#} then try the next + iny ; program line + bcc findnxt lda at ; {@} >= {&} (end of program)? - cmp ampr - lda at+1 ; yes: search failed (cs) - sbc ampr+1 ; no: clear carry + cmp ampr ; yes: search failed (cs) + lda at+1 ; no: search succeeded (cc) + sbc ampr+1 + lda lparen + ldx lparen+1 findrts: rts ;-----------------------------------------------------; @@ -981,9 +1048,10 @@ skpbyte: iny ; skip over current char getbyte: lda (at),y - eor #' ' + beq getbyt2 + cmp #' ' beq skpbyte ; skip over any space char(s) - eor #' ' ; set flags for char loaded +getbyt2: rts ;============ Original I/O subroutines ===============; ;-----------------------------------------------------; @@ -992,12 +1060,12 @@ getbyte: ; and return with (cs). ; 6 bytes ;inkey: -; lda KBD ; Is there a keypress waiting? +; 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 +; drop stack and abort to "OK" prompt if ctrl-C ; 16 bytes ;inch: ; sty dolr ; save y reg @@ -1008,17 +1076,18 @@ getbyte: ; bne outch ; no: echo to terminal ; jmp start ; yes: abort to "OK" prompt ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; -; Print ascii char in a to stdout, (cs) +; Print ASCII char in a to stdout, (cs) ; 9 bytes ;outch: ; pha ; save original char -; ora #$80 ; apples prefer "high" ascii +; 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 ===============; +;-----------------------------------------------------; +;========== 2m5 SBC emulator I/O subroutines ============; ;-----------------------------------------------------; ; Check for user keypress and return if none ; is pending. Otherwise, check for ctrl-C and @@ -1064,4 +1133,4 @@ skip_cr: sec ; (by contract with callers) rts ;-----------------------------------------------------; - .end vtl02b ; set start address + .end vtl02c ; set start address diff --git a/vtl02ba2.a65 b/vtl02ca2.a65 similarity index 66% rename from vtl02ba2.a65 rename to vtl02ca2.a65 index c24a4d7..148b17e 100644 --- a/vtl02ba2.a65 +++ b/vtl02ca2.a65 @@ -3,53 +3,19 @@ ; In the Kingswood AS65 assembler some of the options ; below must be set manually. ; -; .lf vtl02ba2.lst (set -l in commandline) +; .lf vtl02ca2.lst (set -l in commandline) ; .cr 6502 (is default) -; .tf vtl02ba2.obj,ap1 (set -s2 in commandline) +; .tf vtl02ca2.obj,ap1 (set -s2 in commandline) ;-----------------------------------------------------; -; VTL-2 for the 6502 (VTL02B) ; +; 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! ; ;-----------------------------------------------------; -; 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 +; Revision C (c) 2015, Michael T. Barry ; All rights reserved. ; ; Redistribution and use in source and binary forms, @@ -80,14 +46,27 @@ ; 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. ; -; Notes concerning this version: +; Differences between the 680b and 6502 versions: ; * {&} and {*} are initialized on entry. -; * Division by zero returns a quotient of 65535 -; (the original 6800 version froze). +; * 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 VTL02B +; 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). @@ -99,53 +78,95 @@ ; 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 +; * 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 VTL02B statement (easily handling the maximum +; 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 is -; similar to the 680b version, but it has been +; * 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). -; * 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 +; * 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. -; * VTL02B is my free gift (?) to the world. It may be +; * 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 VTL02B (nothing). +; limited to the price of VTL02C (nothing). ;-----------------------------------------------------; -; VTL02B variables occupy RAM addresses $0080 to $00ff, +; 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. +;-----------------------------------------------------; +; 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 @@ -154,21 +175,21 @@ ; 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 +; 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 -; VTL02B standard user variable space +; VTL02C 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. +; 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 @@ -198,7 +219,7 @@ nulstk = $01ff ; system stack resides in page 1 ;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 +;vtl02c = $8000 ; interpreter cold entry point ; (warm entry point is startok) ;KBD = $c000 ; 128 + keypress if waiting ;KEYIN = $fd0c ; apple monitor keyin routine @@ -211,16 +232,16 @@ 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 +vtl02c = $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 + org vtl02c ;-----------------------------------------------------; -; Initialize program area pointers and start VTL02B +; Initialize program area pointers and start VTL02C ; 17 bytes lda #lo(prgm) sta ampr ; {&} -> empty program @@ -233,99 +254,97 @@ acia_st = io_area+$ff ;bit 0 = 10ms tick startok: sec ; request "OK" message ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; -; Start/restart VTL02B command line with program intact -; 29 bytes + 3 bytes patch: restore VTL02a behavior +; Start/restart VTL02C command line with program intact +; 32 bytes start: - cld + cld ; a sensible precaution ldx #lo(nulstk) - txs ; reset the system stack pointer + 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 -; patch to remove extra linefeed on program line entry - jsr outnl ; patch: restore VTL02a behavior + jsr outnl user: - jsr inln ; patch: restore VTL02a behavior -; jsr newln ; input a line from the user + jsr inln ; 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 + beq direct ; 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 + lda pound + ora pound+1 ; {#} = 0? + bne skp2 ; no: delete/insert/replace line ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; List program to terminal and restart "OK" prompt ; entry: Carry must be clear -; uses: findln, outch, prnum, prstr, {@ ( )} +; 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 + 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 +; The main program execution loop +; entry: with (cs) via "beq direct" in user: +; exit: to command line via findln: or "beq start" +; 45 bytes +progr: + beq eloop0 ; if {#} = 0 then ignore and + 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) +branch: + inx ; execute a VTL02B branch + 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 >= {#} + iny ; skip over the length byte +direct: + php ; (cc: program, cs: direct) + jsr exec ; execute one VTL02B statement + plp + lda pound ; update Z for {#} + ora pound+1 ; if program mode then continue + bcc progr ; if direct mode, did {#} change? + beq start ; no: restart "OK" prompt + bne eloop0 ; yes: execute program from {#} +;-----------------------------------------------------; +; Delete/insert/replace program line and restart the +; command prompt (no "OK" means success) ; entry: Carry must be clear -; uses: find, start, {@ > # & * (}, linbuf -; 155 bytes +; uses: find:, start:, linbuf, {@ > # & * (} +; 151 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 + eor pound ; if line doesn't already exist bne insrt ; then skip deletion process - lda lparen+1 - eor pound+1 + cpx pound+1 bne insrt tax ; x = 0 lda (at),y @@ -361,7 +380,7 @@ insrt: pha ldy #2 cntln: - inx + inx iny ; determine new line length in y lda linbuf-1,x ; and push statement string on pha ; the system stack @@ -379,7 +398,7 @@ cntln: 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 + sbc star+1 ; so drop the stack and abort bcs jstart ; to the "OK" prompt slide: lda ampr @@ -411,28 +430,27 @@ move2: lda gthan+1 sta ampr+1 jstart: - jmp start ; dump stack, restart cmd prompt + 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) -; 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 +; 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 - lda lparen sta pound ; {#} = {(} - lda lparen+1 - sta pound+1 + stx pound+1 rts ;-----------------------------------------------------; -; {?="...} handler; called from 'exec' -; List line handler; called from 'list_' +; {?="...} handler; called from exec: +; List line handler; called from list_: ; 2 bytes prstr: iny ; skip over the " or length byte @@ -443,12 +461,12 @@ prstr: ; 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" +; 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 +; uses: inch:, inkey:, jstart:, outch:, execrts: ; exit: (normal) @[y] -> null or byte after delimiter -; (ctrl-C) dump the stack & restart "OK" prompt +; (ctrl-C) drop the stack & restart "OK" prompt ; 39 bytes prmsg: txa @@ -476,29 +494,26 @@ outnl: 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 {(} +; 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 {(} ; 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 +; 84 bytes exec: jsr getbyte ; fetch left-side variable name - beq execrts ; do nothing if null statement - iny + beq execrts ; do nothing with a null statement + cmp #')' ; same for a full-line comment + beq execrts + 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 convp ; arg[{0}] -> left-side variable jsr getbyte ; skip over assignment operator jsr skpbyte ; is right-side a literal string? cmp #'"' ; yes: print the string with @@ -506,27 +521,19 @@ exec1: ldx #arg+2 ; point eval to arg[{1}] jsr eval ; evaluate right-side in arg[{1}] 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 - bne exec1a ; low half of arg[{1}] to ({<}) - ldy #0 - sta (lthan),y - rts -exec1a: + 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 #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: + 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 exec3: - ldy #0 sta (arg),y adc tick+1 ; store arg[{1}] in the left-side rol a ; variable @@ -540,33 +547,40 @@ exec3: stx tick execrts: rts +usr: + tax ; jump to user ml routine with + lda arg+3 ; arg[{1}] in a:x (MSB:LSB) + jmp (quote) ; {"} must point to valid 6502 code +poke: + sta (lthan),y + rts ;-----------------------------------------------------; -; {?=...} handler; called by 'exec' +; {?=...} 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 +; 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 - lda #0 - pha ; null delimiter for print - sta 3,x ; repeat { + sta 2,x ; repeat { prnum2: jsr div ; divide var[x] by 10 lda remn - ora #'0' ; convert remainder to ascii + ora #'0' ; convert remainder to ASCII pha ; stack digits in ascending - lda 0,x ; order ('0' for zero) + lda 0,x ; order ('0' for zero) ora 1,x bne prnum2 ; } until var[x] is 0 pla @@ -580,9 +594,9 @@ prnum3: 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 +; 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 @@ -591,9 +605,9 @@ prnum3: ; 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 +; entry: @[y] -> expression text, x -> argument +; uses: getval:, oper:, {@}, argument stack area +; exit: arg[x] = result, @[y] -> next text ; 31 bytes eval: lda #0 @@ -673,48 +687,42 @@ getval5: 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 -; +; 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 +; 26 bytes +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 + bmi oper8d ; (always taken) +;-----------------------------------------------------; +; 16-bit unsigned multiply routine: var[x] *= var[x+2] +; exit: overflow is ignored/discarded, var[x+2] and +; {>} are modified, a = 0 +; 40 bytes mul: lda 0,x sta gthan @@ -724,25 +732,155 @@ mul: 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] mul3: asl 2,x - rol 3,x ;left-shift var[x+2] + rol 3,x ; left-shift var[x+2] lda 2,x ora 3,x ; loop until var[x+2] = 0 bne mul2 +mulrts: rts -oper4: +;-----------------------------------------------------; +; 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 +;-----------------------------------------------------; +; 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 +; 37 bytes +oper: + cmp #'+' ; addition operator? + beq plus + cmp #'*' ; multiplication operator? + beq mul cmp #'/' ; division operator? - bne oper5 ; no: next case + beq div + cmp #'[' ; "then" operator? + beq then_ + cmp #']' ; "else" operator? + beq else_ + dex ; (factored from the following ops) + 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), pre-decremented x +; 29 bytes + 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 + lda #0 + beq minus3 ; (always taken) +;-----------------------------------------------------; +; expects: (cs) +; 14 bytes +then_: + lda 0,x + ora 1,x + beq minus4 + lda 2,x + sta 0,x + lda 3,x + bcs minus3 ; (always taken) +;-----------------------------------------------------; +; expects: (cs) +; 10 bytes +else_: + lda 0,x + ora 1,x + beq plus + lda #0 + beq oper8d ; (always taken) +;-----------------------------------------------------; +; var[x] -= var[x+2] +; expects: (cs), pre-decremented x +; 11 bytes +minus: + jsr minus2 + inx +minus2: + lda 1,x + sbc 3,x +minus3: + sta 1,x +minus4: + rts +;-----------------------------------------------------; +; var[x] &= var[x+2] +; expects: (cs), pre-decremented x +; 10 bytes +and_: + jsr and_2 + inx +and_2: + lda 1,x + and 3,x + bcs minus3 ; (always taken) +;-----------------------------------------------------; +; var[x] |= var[x+2] +; expects: (cs), pre-decremented x +; 10 bytes +or_: + jsr or_2 + inx +or_2: + lda 1,x + ora 3,x + bcs minus3 ; (always taken) +;-----------------------------------------------------; +; var[x] ^= var[x+2] +; expects: (cs), pre-decremented x +; 10 bytes +xor_: + jsr xor_2 + inx +xor_2: + lda 1,x + eor 3,x + bcs minus3 ; (always taken) +;-----------------------------------------------------; ; 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 @@ -768,100 +906,19 @@ 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 +; 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 +; 43 bytes cvbin: lda #0 sta 0,x ; var[x] = 0 @@ -871,13 +928,14 @@ cvbin: sty ques ; save pointer cvbin2: lda (at),y ; grab a char - eor #$30 ; if char at @[y] is not a + 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 pla ; retrieve decimal digit sta 2,x jsr plus ; var[x] += digit @@ -889,9 +947,10 @@ cvbin3: ;-----------------------------------------------------; ; 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 +; 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? @@ -923,44 +982,52 @@ inln3: 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 +; 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: - 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) + ldx #hi(prgm) + lda #lo(prgm) + bcc find1st ; cc: search begins at first line + ldx at+1 + ldy #2 findnxt: - jsr checkat ; if {@} >= {&} then the search - bcs findrts ; failed, so return with (cs) lda at - adc (at),y ; {@} += length of current line + 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 - 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 + sta lparen+1 + sbc pound+1 ; if {(} < {#} then try the next + iny ; program line + bcc findnxt lda at ; {@} >= {&} (end of program)? - cmp ampr - lda at+1 ; yes: search failed (cs) - sbc ampr+1 ; no: clear carry + cmp ampr ; yes: search failed (cs) + lda at+1 ; no: search succeeded (cc) + sbc ampr+1 + lda lparen + ldx lparen+1 findrts: rts ;-----------------------------------------------------; @@ -970,9 +1037,10 @@ skpbyte: iny ; skip over current char getbyte: lda (at),y - eor #' ' + beq getbyt2 + cmp #' ' beq skpbyte ; skip over any space char(s) - eor #' ' ; set flags for char loaded +getbyt2: rts ;============ Original I/O subroutines ===============; ;-----------------------------------------------------; @@ -981,12 +1049,12 @@ getbyte: ; and return with (cs). ; 6 bytes ;inkey: -; lda KBD ; Is there a keypress waiting? +; 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 +; drop stack and abort to "OK" prompt if ctrl-C ; 16 bytes ;inch: ; sty dolr ; save y reg @@ -997,16 +1065,17 @@ getbyte: ; bne outch ; no: echo to terminal ; jmp start ; yes: abort to "OK" prompt ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; -; Print ascii char in a to stdout, (cs) +; Print ASCII char in a to stdout, (cs) ; 9 bytes ;outch: ; pha ; save original char -; ora #$80 ; apples prefer "high" ascii +; 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 @@ -1088,5 +1157,5 @@ skip_bs: rts ;-----------------------------------------------------; org $fffc - dw vtl02b ; reset vector -> cold start - end vtl02b ; set start address + dw vtl02c ; reset vector -> cold start + end vtl02c ; set start address diff --git a/vtl02ba2.asm b/vtl02ca2.asm similarity index 64% rename from vtl02ba2.asm rename to vtl02ca2.asm index 9461a54..0d8a36a 100644 --- a/vtl02ba2.asm +++ b/vtl02ca2.asm @@ -1,51 +1,17 @@ ;234567890123456789012345678901234567890123456789012345 - .lf vtl02ba2.lst + .lf vtl02ca2.lst .cr 6502 - .tf vtl02ba2.obj,ap1 + .tf vtl02ca2.obj,ap1 ;-----------------------------------------------------; -; VTL-2 for the 6502 (VTL02B) ; +; 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! ; ;-----------------------------------------------------; -; 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 +; Revision C (c) 2015, Michael T. Barry ; All rights reserved. ; ; Redistribution and use in source and binary forms, @@ -76,14 +42,27 @@ ; 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. ; -; Notes concerning this version: +; Differences between the 680b and 6502 versions: ; * {&} and {*} are initialized on entry. -; * Division by zero returns a quotient of 65535 -; (the original 6800 version froze). +; * 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 VTL02B +; 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). @@ -95,53 +74,95 @@ ; 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 +; * 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 VTL02B statement (easily handling the maximum +; 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 is -; similar to the 680b version, but it has been +; * 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). -; * 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 +; * 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. -; * VTL02B is my free gift (?) to the world. It may be +; * 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 VTL02B (nothing). +; limited to the price of VTL02C (nothing). ;-----------------------------------------------------; -; VTL02B variables occupy RAM addresses $0080 to $00ff, +; 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. +;-----------------------------------------------------; +; 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 @@ -150,21 +171,21 @@ ; 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 +; 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 -; VTL02B standard user variable space +; VTL02C 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. +; 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 @@ -194,15 +215,15 @@ 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 +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 ;=====================================================; - .or vtl02b + .or vtl02c ;-----------------------------------------------------; -; Initialize program area pointers and start VTL02B +; Initialize program area pointers and start VTL02C ; 17 bytes lda #prgm sta ampr ; {&} -> empty program @@ -215,96 +236,97 @@ COUT = $fded ; apple monitor charout routine startok: sec ; request "OK" message ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; -; Start/restart VTL02B command line with program intact -; 29 bytes +; Start/restart VTL02C command line with program intact +; 32 bytes start: - cld + cld ; a sensible precaution ldx #nulstk - txs ; reset the system stack pointer + 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: - jsr newln ; input a line from the user + jsr inln ; 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 + beq direct ; 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 + lda pound + ora pound+1 ; {#} = 0? + bne skp2 ; no: delete/insert/replace line ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; List program to terminal and restart "OK" prompt ; entry: Carry must be clear -; uses: findln, outch, prnum, prstr, {@ ( )} +; 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 + 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 +; The main program execution loop +; entry: with (cs) via "beq direct" in user: +; exit: to command line via findln: or "beq start" +; 45 bytes +progr: + beq eloop0 ; if {#} = 0 then ignore and + 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) +branch: + inx ; execute a VTL02B branch + bne branch2 + iny +branch2: + stx bang ; {!} = {(} + 1 (return ptr) + sty bang+1 +eloop0: + rol + eor #1 ; complement carry flag + ror +eloop: + jsr findln ; find first/next line >= {#} + iny ; skip over the length byte +direct: + php ; (cc: program, cs: direct) + jsr exec ; execute one VTL02B statement + plp + lda pound ; update Z for {#} + ora pound+1 ; if program mode then continue + bcc progr ; if direct mode, did {#} change? + beq start ; no: restart "OK" prompt + bne eloop0 ; yes: execute program from {#} +;-----------------------------------------------------; +; Delete/insert/replace program line and restart the +; command prompt (no "OK" means success) ; entry: Carry must be clear -; uses: find, start, {@ > # & * (}, linbuf -; 155 bytes +; uses: find:, start:, linbuf, {@ > # & * (} +; 151 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 + eor pound ; if line doesn't already exist bne insrt ; then skip deletion process - lda lparen+1 - eor pound+1 + cpx pound+1 bne insrt tax ; x = 0 lda (at),y @@ -340,7 +362,7 @@ insrt: pha ldy #2 cntln: - inx + inx iny ; determine new line length in y lda linbuf-1,x ; and push statement string on pha ; the system stack @@ -358,7 +380,7 @@ cntln: 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 + sbc star+1 ; so drop the stack and abort bcs jstart ; to the "OK" prompt slide: lda ampr @@ -390,28 +412,27 @@ move2: lda gthan+1 sta ampr+1 jstart: - jmp start ; dump stack, restart cmd prompt + 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) -; 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 +; 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 - lda lparen sta pound ; {#} = {(} - lda lparen+1 - sta pound+1 + stx pound+1 rts ;-----------------------------------------------------; -; {?="...} handler; called from 'exec' -; List line handler; called from 'list_' +; {?="...} handler; called from exec: +; List line handler; called from list_: ; 2 bytes prstr: iny ; skip over the " or length byte @@ -422,12 +443,12 @@ prstr: ; 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" +; 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 +; uses: inch:, inkey:, jstart:, outch:, execrts: ; exit: (normal) @[y] -> null or byte after delimiter -; (ctrl-C) dump the stack & restart "OK" prompt +; (ctrl-C) drop the stack & restart "OK" prompt ; 39 bytes prmsg: txa @@ -454,29 +475,26 @@ outnl: 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 {(} +; 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 {(} ; 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 +; 84 bytes exec: jsr getbyte ; fetch left-side variable name - beq execrts ; do nothing if null statement - iny + beq execrts ; do nothing with a null statement + cmp #')' ; same for a full-line comment + beq execrts + 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 convp ; arg[{0}] -> left-side variable jsr getbyte ; skip over assignment operator jsr skpbyte ; is right-side a literal string? cmp #'"' ; yes: print the string with @@ -484,27 +502,19 @@ exec1: ldx #arg+2 ; point eval to arg[{1}] jsr eval ; evaluate right-side in arg[{1}] 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 - bne exec1a ; low half of arg[{1}] to ({<}) - ldy #0 - sta (lthan),y - rts -exec1a: + 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 #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: + 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 exec3: - ldy #0 sta (arg),y adc tick+1 ; store arg[{1}] in the left-side rol ; variable @@ -518,33 +528,40 @@ exec3: stx tick execrts: rts +usr: + tax ; jump to user ml routine with + lda arg+3 ; arg[{1}] in a:x (MSB:LSB) + jmp (quote) ; {"} must point to valid 6502 code +poke: + sta (lthan),y + rts ;-----------------------------------------------------; -; {?=...} handler; called by 'exec' +; {?=...} 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 +; 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 - lda #0 - pha ; null delimiter for print - sta 3,x ; repeat { + sta 2,x ; repeat { prnum2: jsr div ; divide var[x] by 10 lda remn - ora #'0' ; convert remainder to ascii + ora #'0' ; convert remainder to ASCII pha ; stack digits in ascending - lda 0,x ; order ('0' for zero) + lda 0,x ; order ('0' for zero) ora 1,x bne prnum2 ; } until var[x] is 0 pla @@ -558,9 +575,9 @@ prnum3: 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 +; 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 @@ -569,9 +586,9 @@ prnum3: ; 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 +; entry: @[y] -> expression text, x -> argument +; uses: getval:, oper:, {@}, argument stack area +; exit: arg[x] = result, @[y] -> next text ; 31 bytes eval: lda #0 @@ -651,48 +668,42 @@ getval5: 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 -; +; 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 +; 26 bytes +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 ; form simple variable address + ora #$80 ; mapping function is (a*2)|128 + bmi oper8d ; (always taken) +;-----------------------------------------------------; +; 16-bit unsigned multiply routine: var[x] *= var[x+2] +; exit: overflow is ignored/discarded, var[x+2] and +; {>} are modified, a = 0 +; 40 bytes mul: lda 0,x sta gthan @@ -702,25 +713,155 @@ mul: 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] mul3: asl 2,x - rol 3,x ;left-shift var[x+2] + rol 3,x ; left-shift var[x+2] lda 2,x ora 3,x ; loop until var[x+2] = 0 bne mul2 +mulrts: rts -oper4: +;-----------------------------------------------------; +; 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 +;-----------------------------------------------------; +; 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 +; 37 bytes +oper: + cmp #'+' ; addition operator? + beq plus + cmp #'*' ; multiplication operator? + beq mul cmp #'/' ; division operator? - bne oper5 ; no: next case + beq div + cmp #'[' ; "then" operator? + beq then_ + cmp #']' ; "else" operator? + beq else_ + dex ; (factored from the following ops) + 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), pre-decremented x +; 29 bytes + 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 + lda #0 + beq minus3 ; (always taken) +;-----------------------------------------------------; +; expects: (cs) +; 14 bytes +then_: + lda 0,x + ora 1,x + beq minus4 + lda 2,x + sta 0,x + lda 3,x + bcs minus3 ; (always taken) +;-----------------------------------------------------; +; expects: (cs) +; 10 bytes +else_: + lda 0,x + ora 1,x + beq plus + lda #0 + beq oper8d ; (always taken) +;-----------------------------------------------------; +; var[x] -= var[x+2] +; expects: (cs), pre-decremented x +; 11 bytes +minus: + jsr minus2 + inx +minus2: + lda 1,x + sbc 3,x +minus3: + sta 1,x +minus4: + rts +;-----------------------------------------------------; +; var[x] &= var[x+2] +; expects: (cs), pre-decremented x +; 10 bytes +and_: + jsr and_2 + inx +and_2: + lda 1,x + and 3,x + bcs minus3 ; (always taken) +;-----------------------------------------------------; +; var[x] |= var[x+2] +; expects: (cs), pre-decremented x +; 10 bytes +or_: + jsr or_2 + inx +or_2: + lda 1,x + ora 3,x + bcs minus3 ; (always taken) +;-----------------------------------------------------; +; var[x] ^= var[x+2] +; expects: (cs), pre-decremented x +; 10 bytes +xor_: + jsr xor_2 + inx +xor_2: + lda 1,x + eor 3,x + bcs minus3 ; (always taken) +;-----------------------------------------------------; ; 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 @@ -746,100 +887,19 @@ 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 +; 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 +; 43 bytes cvbin: lda #0 sta 0,x ; var[x] = 0 @@ -849,13 +909,14 @@ cvbin: sty ques ; save pointer cvbin2: lda (at),y ; grab a char - eor #$30 ; if char at @[y] is not a + 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 pla ; retrieve decimal digit sta 2,x jsr plus ; var[x] += digit @@ -867,9 +928,10 @@ cvbin3: ;-----------------------------------------------------; ; 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 +; 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? @@ -901,44 +963,52 @@ inln3: 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 +; 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: - 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) + ldx /prgm + lda #prgm + bcc find1st ; cc: search begins at first line + ldx at+1 + ldy #2 findnxt: - jsr checkat ; if {@} >= {&} then the search - bcs findrts ; failed, so return with (cs) lda at - adc (at),y ; {@} += length of current line + 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 - 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 + sta lparen+1 + sbc pound+1 ; if {(} < {#} then try the next + iny ; program line + bcc findnxt lda at ; {@} >= {&} (end of program)? - cmp ampr - lda at+1 ; yes: search failed (cs) - sbc ampr+1 ; no: clear carry + cmp ampr ; yes: search failed (cs) + lda at+1 ; no: search succeeded (cc) + sbc ampr+1 + lda lparen + ldx lparen+1 findrts: rts ;-----------------------------------------------------; @@ -948,9 +1018,10 @@ skpbyte: iny ; skip over current char getbyte: lda (at),y - eor #' ' + beq getbyt2 + cmp #' ' beq skpbyte ; skip over any space char(s) - eor #' ' ; set flags for char loaded +getbyt2: rts ;-----------------------------------------------------; ; Check for user keypress and return with (cc) if none @@ -958,12 +1029,12 @@ getbyte: ; and return with (cs). ; 6 bytes inkey: - lda KBD ; Is there a keypress waiting? + 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 +; drop stack and abort to "OK" prompt if ctrl-C ; 16 bytes inch: sty dolr ; save y reg @@ -974,15 +1045,15 @@ inch: bne outch ; no: echo to terminal jmp start ; yes: abort to "OK" prompt ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; -; Print ascii char in a to stdout, (cs) +; Print ASCII char in a to stdout, (cs) ; 9 bytes outch: pha ; save original char - ora #$80 ; apples prefer "high" ascii + ora #$80 ; apples prefer "high" ASCII jsr COUT ; emit char via apple monitor pla ; restore original char sec ; (by contract with callers) outrts: rts ;-----------------------------------------------------; - .en vtl02ba2 + .en vtl02ca2