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