;234567890123456789012345678901234567890123456789012345 ; ; In the Kingswood AS65 assembler some of the options ; below must be set manually. ; ; .lf vtl02ca2.lst (set -l in commandline) ; .cr 6502 (is default) ; .tf vtl02ca2.obj,ap1 (set -s2 in commandline) ;-----------------------------------------------------; ; VTL-2 for the 6502 (VTL02C) ; ; Original Altair 680b version by ; ; Frank McCoy and Gary Shannon 1977 ; ; 2012: Adapted to the 6502 by Michael T. Barry ; ; Thanks to sbprojects.com for a very nice assembler! ; ;-----------------------------------------------------; ; Copyright (c) 2012, Michael T. Barry ; Revision B (c) 2015, Michael T. Barry ; Revision C (c) 2015, Michael T. Barry ; All rights reserved. ; ; Redistribution and use in source and binary forms, ; with or without modification, are permitted, ; provided that the following conditions are met: ; ; 1. Redistributions of source code must retain the ; above copyright notice, this list of conditions ; and the following disclaimer. ; 2. Redistributions in binary form must reproduce the ; above copyright notice, this list of conditions ; and the following disclaimer in the documentation ; and/or other materials provided with the ; distribution. ; ; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS ; AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED ; WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE ; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS ; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT ; SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE ; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, ; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT ; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR ; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS ; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, ; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING ; IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ; ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ;-----------------------------------------------------; ; Except for the differences discussed below, VTL02 was ; designed to duplicate the OFFICIALLY DOCUMENTED ; behavior of Frank's 680b version, detailed here: ; http://www.altair680kit.com/manuals/Altair_ ; 680-VTL-2%20Manual-05-Beta_1-Searchable.pdf ; These versions ignore all syntax errors and plow ; through VTL-2 programs with the assumption that ; they are "correct", but in their own unique ways, ; so any claims of compatibility are null and void ; for VTL-2 code brave (or stupid) enough to stray ; from the beaten path. ; ; Differences between the 680b and 6502 versions: ; * {&} and {*} are initialized on entry. ; * Division by zero returns 65535 for the quotient and ; the dividend for the remainder (the original 6800 ; version froze). ; * The 6502 has NO 16-bit registers (other than PC) ; and less overall register space than the 6800, ; so the interpreter reserves some obscure VTL02C ; variables {@ $ ( ) 0 1 2 3 4 5 6 7 8 9 < > : ?} ; for its internal use (the 680b version used a ; similar tactic, but differed in the details). ; The deep nesting of parentheses also puts {; < =} ; in danger of corruption. For example, executing ; the statement A=((((((((1)))))))) sets both {A} ; and {;} to the value 1. ; * Users wishing to call a machine language subroutine ; via the system variable {>} must first set the ; system variable {"} to the proper address vector ; (for example, "=768). ; * The x register is used to point to a simple VTL02C ; variable (it can't point explicitly to an array ; element like the 680b version because it's only ; 8-bits). In the comments, var[x] refers to the ; 16-bit contents of the zero-page variable pointed ; to by register x (residing at addresses x, x+1). ; * The y register is used as a pointer offset inside ; a VTL02C statement (easily handling the maximum ; statement length of about 128 bytes). In the ; comments, @[y] refers to the 16-bit address ; formed by adding register y to the value in {@}. ; * The structure and flow of this interpreter are ; similar to the 680b version, but have been ; reorganized in a more 6502-friendly format (the ; 6502 has no 'bsr' instruction, so the 'stuffing' ; of subroutines within 128 bytes of the caller is ; only advantageous for conditional branches). ; * This version is based on the original port, which ; was wound rather tightly, in a failed attempt to ; fit it into 768 bytes like the 680b version; many ; structured programming principles were sacrificed ; in that effort. The 6502 simply requires more ; instructions than the 6800 does to manipulate 16- ; bit quantities, but the overall execution speed ; should be comparable due to the 6502's slightly ; lower average clocks/instruction ratio. As it is ; now, it fits into 1KB with just a few bytes to ; spare, but is more feature-laden than the 680b ; interpreter whence it came. Beginning with ; Revision C, I tried to strike a tasteful balance ; between execution speed and code size, but I ; stubbornly kept it under 1024 ROMable bytes and ; used only documented op-codes that were supported ; by the original NMOS 6502 (without the ROR bug). ; I may have missed a few optimizations -- further ; suggestions are welcome. ; * VTL02C is my free gift (?) to the world. It may be ; freely copied, shared, and/or modified by anyone ; interested in doing so, with only the stipulation ; that any liabilities arising from its use are ; limited to the price of VTL02C (nothing). ;-----------------------------------------------------; ; 2015: Revision B included some space optimizations ; (suggested by dclxvi) and enhancements ; (suggested by mkl0815 and Klaus2m5): ; ; * Bit-wise operators & | ^ (and, or, xor) ; Example: A=$|128) Get a char and set hi-bit ; ; * Absolute addressed 8-bit memory load and store ; via the {< @} facility: ; Example: <=P) Point to the I/O port at P ; @=@&254^128) Clear low-bit & flip hi-bit ; ; * Starting with VTL02B, the space character is no ; longer a valid user variable nor a "valid" binary ; operator. It's now only significant as a numeric ; constant terminator and as a place-holder in ; strings and program listings, where it may be ; used to improve human readability (at a slight ; cost in execution speed and memory consumption). ; Example: ; * (VTL-2) ; 1000 A=1) Init loop index ; 1010 ?=A) Print index ; 1020 ?="") Newline ; 1030 A=A+1) Update index ; 1040 #=A<10*1010) Loop until done ; ; * (VTL02B) ; 1000 A = 1 ) Init loop index ; 1010 ? = A ) Print index ; 1020 ? = "" ) Newline ; 1030 A = A + 1 ) Update index ; 1040 # = A < 10 * 1010 ) Loop until done ; ; 2015: Revision C includes further enhancements ; (suggested by Klaus2m5): ; ; * "THEN" and "ELSE" operators [ ] ; A[B returns 0 if A is 0, otherwise returns B. ; A]B returns B if A is 0, otherwise returns 0. ; ; * Some effort was made to balance interpreter code ; density with interpreter performance, while ; remaining within the 1KB constraint. Structured ; programming principles remained at low priority. ; ;-----------------------------------------------------; ; VTL02 for the 2m5 emulated 6502 SBC ; - released: 10-dec-2015 ; - codename: speedy Gonzales ; - based on VTL02C, changes by Klaus2m5 ; ; spaces in expressions are allowed on input but are ; removed from the stored program and listing. ; ; added a timer variable {/} with 10ms increments. ; ; the {?} input variable no longer accepts an ; expression as input. Only a number is accepted. ; ; added braces as shift operators. ; A}B shifts A by B bits to the right. ; A{B shifts A by B bits to the left. ; result is unpredictable if B > 16 ; ; an expression missing the initial {=} operator ; is converted by duplicating the leftmost variable ; and inserting a {=}. {N+1} becomes {N=N+1}. ; ; added a statement delimiter {;} allowing multi ; statement lines. ; branch to same line is now allowed. ; {?="..."} & unmatched {)} (used for comments) can ; not be continued. ; ; added load and save facility to user call {>} ; "=0;>=13 loads program 13 from EEPROM ; "=1;>=42 saves current program to EEPROM as 42 ; requires emulator version >= 0.83c ; ; line numbers >= 65280 are now reserved for the ; following fast return & goto features. ; added a gosub stack, depth = 16 address words. ; {==...} is a gosub and pushes the return address ; of the next line. ; {#==} is a return and pops the address when the ; result is the special line numer asigned to {=}. ; added a 31 line addresses acronym label array. ; lowercase characters and symbols in the $60-$7e ; range are used to address the array. the array ; is populated with the address of a line when a ; character in the allowed range preceeds the line ; number. ; ; example (prints the first 1000 prime numbers): ; 10 /=0;Q=d;V=5;U=25;X=1000 ; 20 N=2;==b ; 30 N+1;==b ; 40 N+2;==b ; a100 N+2;==b ; 120 N+4;==b ; 150 #=a ; b200 #=NV[d ; 320 A=N/D;#=%]=;D+4;#=D10[465;?=0 ; 465 ?=%;?=" seconds" ; ; added message service including error messages ; runtime errors: ; 233 EEPROM file corrupted ; 234 EEPROM file has incompatible format ; 237 EEPROM not responding ; 238 EEPROM full - file not saved ; 239 EEPROM file not found ; 240 array pointer exceeds reserved VTL RAM ; 241 user call pointer inside reserved VTL RAM ; 248 duplicate label ; 249 undefined label or empty return stack ; errors during program line input: ; 242 invalid or missing operator ; 243 invalid or missing target variable ; 244 value or variable missing after operator ; 245 missing closing parenthesis ; 246 out of memory (*-&) ; 247 overlap in input buffer, split program line ; ; internal changes: ; added required atomic variable fetch & store. ; replaced some jsr calls with inline code ; for skpbyte:, getbyte:, plus:, minus:. ; replaced cvbin calls to mul: & plus: with custom ; inline multiply by 10 & digit adder. ; removed simulation from startup of eval:. ; mainloop uses inline code to advance to next ; sequential program line. ; find: is now only used for true branches. ; added decimal to binary conversion on line entry ; avoiding the runtime conversion. ; abbreviated getting a simple variable in getval:. ; bypassed setting a simple variable in exec:. ; added inline divide by 10 to prnum:. ; fixed statement delimiter not overriding mismatched ; parentheses. ; merged oper: into getval: and progr: into exec: ; added a check for ctrl-c & ctrl-z during goto to ; allow user escape from a loop. ; ;-----------------------------------------------------; ; VTL02C variables occupy RAM addresses $0080 to $00ff, ; and are little-endian, in the 6502 tradition. ; The use of lower-case and some control characters for ; variable names is allowed, but not recommended; any ; attempts to do so would likely result in chaos, due ; to aliasing with upper-case and system variables. ; Variables tagged with an asterisk are used internally ; by the interpreter and may change without warning. ; {@ $ ( ) 0..9 : > ?} are (usually) intercepted by ; the interpreter, so their internal use by VTL02C is ; "safe". The same cannot be said for {; < =}, so be ; careful! at = $80 ; {@}* internal pointer / mem byte ; VTL02C standard user variable space ; {A B C .. X Y Z [ \ ] ^ _} ; VTL02C system variable space space = $c0 ; { }* gosub & return stack pointer ; Starting with VTL02B: ; the space character is no longer a valid user ; variable nor a "valid" binary operator. It is ; now only significant as a numeric constant ; terminator and as a place-holder in strings ; and program listings. bang = $c2 ; {!} return line number quote = $c4 ; {"} user ml subroutine vector pound = $c6 ; {#} current line number dolr = $c8 ; {$}* temp storage / char i/o remn = $ca ; {%} remainder of last division ampr = $cc ; {&} pointer to start of array tick = $ce ; {'} pseudo-random number lparen = $d0 ; {(}* temp line # / begin sub-exp rparen = $d2 ; {)}* temp storage / end sub-exp star = $d4 ; {*} pointer to end of free mem ; $d6 ; {+ , - .} valid variables ; (1) $fe ; {/} 10ms count up timer ; Interpreter argument stack space arg = $e0 ; {0 1 2 3 4 5 6 7 8 9}* ; Rarely used variables and argument stack overflow ; = $f4 ; {:}* array variable header semico = $f6 ; {;}* statement delimiter lthan = $f8 ; {<}* user memory byte pointer equal = $fa ; {=}* temp / gosub & return stack gthan = $fc ; {>}* temp / call ML subroutine ques = $fe ; {?}* temp / terminal i/o ; nulstk = $01ff ; system stack resides in page 1 ; (1) additional configurable variables and operators timr_var = '/' ; 10 ms count up variable timr_adr = timr_var*2|$80 ;-----------------------------------------------------; ; Equates for a 48K+ Apple 2 (original, +, e, c, gs) ;ESC = 27 ; "Cancel current input line" key ;BS = 8 ; "Delete last keypress" key ;OP_OR = '!' ; Bit-wise OR operator ;linbuf = $0200 ; input line buffer ;prgm = $0800 ; VTL02C program grows from here ;himem = $8000 ; ... up to the top of user RAM ;vtl02c = $8000 ; interpreter cold entry point ; (warm entry point is startok) ;KBD = $c000 ; 128 + keypress if waiting ;KEYIN = $fd0c ; apple monitor keyin routine ;COUT = $fded ; apple monitor charout routine ;-----------------------------------------------------; ; Equates for the 2m5 SBC emulator ESC = 27 ; "Cancel current input line" key BS = 8 ; "Delete last keypress" key OP_OR = '|' ; Bit-wise OR operator lblary = $0100 ; array with goto labels, 64 bytes vtlstck = $0140 ; gosub stack space, 32 bytes ; the following spaces overlap by $20 bytes to allow ; statement expansion by 2 for max 16 statements prgbuf = $0200 ; program line buffer, 128 bytes linbuf = $0220 ; input line buffer, 128 bytes prgm = $02a0 ; VTL02C program grows from here himem = $7600 ; ... up to the top of user RAM vtl02c = $f600 ; interpreter cold entry point ; (warm entry point is startok) io_area = $bf00 ;configure emulator I/O acia_tx = io_area+$f0 ;acia tx data register acia_rx = io_area+$f0 ;acia rx data register timr_ie = io_area+$fe ;timer interrupt enable bit 0 timr_fl = io_area+$ff ;timer flags, bit 0 = 10ms tick diag = io_area+$fc ;diag reg, bit 7 = exit to mon dma_cmd = io_area+$f7 ;dma command register dma_sta = io_area+$f7 ;dma status register dma_dat = io_area+$f8 ;dma data register ;=====================================================; org vtl02c ;-----------------------------------------------------; ; Initialize program area pointers and start VTL02C ; lda #lo(prgm) sta ampr ; {&} -> empty program lda #hi(prgm) sta ampr+1 lda #lo(himem) sta star ; {*} -> top of user RAM lda #hi(himem) sta star+1 ldx #msgvtl ; identify VTL jsr vmsg startok: sec ; request "OK" message reset: lda #0 ; clear label array & gosub stack ldx #$5f reset1: sta lblary,x dex bpl reset1 sta space ; clear pointer to user stack ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; Start/restart VTL02C command line with program intact ; start: cld ; a sensible precaution ldx #lo(nulstk) txs ; drop whatever is on the stack bcc user ; skip "OK" if carry clear ldx #msgok jsr vmsg user: lda #0 ; last line # = direct mode sta pound sta pound+1 jsr inln ; input a line from the user lda linbuf ; check for line label char cmp #$60 bcc user1 iny ; skip label char user1: ldx #pound ; cvbin destination = {#} jsr cvbin ; skip line number if exists bne stmnt ; insert line ldy #0 ; no line label jsr syntax ; check syntax & convert numbers user2: ldy #4 lda #lo(prgbuf); direct mode sta at ; {@} -> input line buffer lda #hi(prgbuf) sta at+1 jmp exec ; execute a direct mode statement ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; Delete/insert/replace program line or list program ; stmnt: jsr syntax ; check syntax & convert numbers clc lda pound ora pound+1 ; {#} = 0? bne jskp2 ; no: delete/insert/replace line ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; List program to terminal and restart "OK" prompt ; entry: Carry must be clear ; uses: findln:, outch:, prnum:, prstr:, {@ ( )} ; exit: to command line via findln: ; list_: jsr findln ; find program line >= {#} ldx #0 lda (at,x) ; print label bpl list1 lda #' ' ; previous syntax error in line list1: jsr outch 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 lda (at,x) ; check for syntax error bpl list_ ldx #msgerr+1 ; without cr jsr verrs ; print syntax error jmp list_ jskp2: lda lblary+62 ; label array clear ? beq skp2 ; then skip clearing it lda #0 ; clear label array & gosub stack ldx #$5f clr_ls: sta lblary,x dex bpl clr_ls sta space ; clear pointer to user stack ;-----------------------------------------------------; ; Delete/insert/replace program line and restart the ; command prompt (no "OK" means success) ; entry: Carry must be clear ; uses: find:, start:, linbuf, {@ > # & * (} ; skp2: jsr find ; point {@} to first line >= {#} bcs insrt eor pound ; if line doesn't already exist bne insrt ; then skip deletion process cpx pound+1 bne insrt tax ; x = 0 lda (at),y tay ; y = length of line to delete eor #-1 adc ampr ; {&} = {&} - y sta ampr bcs delt dec ampr+1 delt: lda at sta gthan ; {>} = {@} lda at+1 sta gthan+1 delt2: lda gthan cmp ampr ; delete the line lda gthan+1 sbc ampr+1 bcs insrt lda (gthan),y sta (gthan,x) inc gthan bne delt2 inc gthan+1 bcc delt2 ; (always taken) insrt: ldx #0 lda prgbuf+3 ; get line size cmp #5 ; empty line ? beq jstart ; yes: end after delete tay clc adc ampr ; calculate new program end sta gthan ; {>} = {&} + length txa adc ampr+1 sta gthan+1 lda gthan cmp star ; if {>} >= {*} then the program lda gthan+1 ; won't fit in available RAM, sbc star+1 ; so drop the stack and abort bcc slide lda #$f6 ; report out of memory sta prgm ; flag program incomplete jmp verr 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: ldy prgbuf+3 ; move line to program move2: dey lda prgbuf,y sta (at),y cpy #0 bne move2 lda gthan sta ampr ; {&} = {>} lda gthan+1 sta ampr+1 jstart: clc jmp start ; drop stack, restart cmd prompt ;-----------------------------------------------------; ; Point @[y] to the first/next program line >= {#} ; entry: (cc): start search at beginning of program ; (cs): start search at next line ; ({@} -> beginning of current line) ; used by: list_:, progr: ; uses: find:, jstart:, prgm, {@ # & (} ; exit: if line not found then abort to "OK" prompt ; else {@} -> found line, x:a = {#} = {(} = ; actual line number, y = 2, (cc) ; 10 bytes findln: jsr find ; find first/next line >= {#} bcs jstart ; if end then restart "OK" prompt sta pound ; {#} = {(} stx pound+1 rts ;-----------------------------------------------------; ; {?="...} handler; called from exec: ; List line handler; called from list_: ; 2 bytes prstr: iny ; skip over the " or length byte tax ; x = delimiter, fall through ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; Print a string at @[y] ; x holds the delimiter char, which is skipped over, ; not printed (a null byte is always a delimiter) ; If a key was pressed, it pauses for another keypress ; before returning. If either of those keys was a ; ctrl-C, it drops the stack and restarts the "OK" ; prompt with the user program intact ; entry: @[y] -> string, x = delimiter char ; uses: inch:, inkey:, jstart:, outch:, execrts: ; exit: (normal) @[y] -> null or byte after delimiter ; (ctrl-C) drop the stack & restart "OK" prompt ; prmsg: lda #0 sta arg sta arg+1 txa cmp (at),y ; found delimiter or null? beq prmsg2 ; yes: finish up lda (at),y beq prmsg2 ; insert to decode packed constant bpl prmsg1 iny ; is binary constant cmp #$fd bcs prmsg3 and #$7f ; is single byte sta arg jmp prmsg4 prmsg3: ; is word lsr a ; $00 bytes low->N, high->C ror a bpl prmsg5 ; skip low byte lda (at),y sta arg iny prmsg5: bcc prmsg4 ; skip high byte lda (at),y sta arg+1 iny prmsg4: txa pha ldx #arg ; print constant jsr prnum pla tax bpl prmsg ; end decode constant prmsg1: jsr outch ; no: print char to terminal iny ; and loop (with safety escape) bpl prmsg prmsg2: tax ; save closing delimiter jsr inkey ; any key = pause/resume? txa ; retrieve closing delimiter beq outnl ; always \n after null delimiter pro_skp: ; inline skpbyte iny lda (at),y cmp #' ' beq pro_skp ; end inline cmp #';' ; if trailing char is not ';' bne outnl ; print \n rts ; else suppress the \n outnl: lda #$0d ; \n to terminal jmp outch ;-----------------------------------------------------; ; Execute (hopefully) valid VTL02C statements at @[y] ; exec: will continue until drop to direct mode ; entry: @[y] -> left-side of statement ; uses: nearly everything ; exit: note to machine language subroutine {>=...} ; users: no registers or variables are ; required to be preserved except the system ; stack pointer, the text base pointer {@}, ; and the original line number {(} ; {>=...;..} requires {$} to be preserved ; if there is a {"} directly after the assignment ; operator, the statement will execute as {?="...}, ; regardless of the variable named on the left side ; exec: lda (at),y ; inline getbyte beq execend1 ; do nothing with a null statement cmp #')' ; same for a full-line comment beq execend1 iny cmp #'A' ; variables < {A} ? bcc exec_byp ; simple variable asl a ; form simple variable address ora #$80 ; mapping function is (a*2)|128 sta arg lda #0 sta arg+1 lda (at),y ; '=' is next iny ; skip space +1 ldx #arg+2 jsr eval pha sty dolr+1 lda arg+2 ldy #0 exec3: sei ; force timer consistency sta (arg),y adc tick+1 ; store arg[{1}] in the left-side rol a ; variable tax iny lda arg+3 sta (arg),y cli ; force timer consistency end adc tick ; pseudo-randomize {'} rol a sta tick+1 stx tick execend: ldy dolr+1 ; restore line index pla iny cmp #';' ; statement delimiter ? beq exec ; continue with next statement execend1: lda pound ; direct mode ? ora pound+1 beq jstart4 prog_nxt: ldy #3 ; point {@} to next line address ldx at+1 ; current line address lda at clc adc (at),y ; {@} low + offset bcc prg_n1 inx ; {@} high + carry prg_n1: cpx ampr+1 ; exceeds end of program? bcc prg_n2 ; no bne jstart4 ; yes - exit to direct mode cmp ampr bcs jstart4 prg_n2: ; (cc) stx at+1 ; next line address valid! sta at ldy #1 lda (at),y sta pound ; {#} = current line number iny lda (at),y sta pound+1 ldy #4 jmp exec ; loop next line jstart4: sec jmp start ; special variables including array exec_byp: ldx #arg ; initialize argument pointer jsr convp ; arg[{0}] -> left-side variable exec_gb3: ; inline getbyte + skpbyte lda (at),y iny ; skip space +1 lda (at),y cmp #'"' ; yes: print the string with beq exec2 ldx #arg+2 ; point eval to arg[{1}] jsr eval ; evaluate right-side in arg[{1}] pha sty dolr+1 ; save to continue same line lda arg+2 ldy #0 ldx arg+1 ; was left-side an array element? bne exec3 ; yes: skip to default actions ldx arg cpx #at ; if {@=...} statement then poke beq poke ; low half of arg[{1}] to ({<}) cpx #dolr ; if {$=...} statement then print beq joutch ; arg[{1}] as ASCII character cpx #ques ; if {?=...} statement then print beq prnum0 ; arg[{1}] as unsigned decimal cpx #gthan ; if {>=...} statement then call beq usr ; user-defined ml routine cpx #pound ; if {#=...} statement then goto beq goto ; arg[{1}] as line number cpx #equal ; if {==...} statement then gosub beq gosub ; arg[{1}] as line number jmp exec3 ; defaults to store variable exec2: jsr prstr ; trailing ';' check & return jmp execend1 gosub: lda pound ; is direct mode ? ora pound+1 beq gosub3 ; return to commandline lda at ; calculate next line address ldy #3 clc adc (at),y ; add to offset tax lda #0 adc at+1 cmp ampr+1 ; address beyond end of program ? bcc gosub2 bne gosub3 cpx ampr bcc gosub2 gosub3: lda #0 ; then return ends program tax gosub2: ldy space ; load VTL user stack pointer sta vtlstck,y ; push high txa sta vtlstck+1,y ; push low iny iny tya and #$1f ; wrap around upper linimt sta space ; save VTL user stack pointer lda #pound ; point to standard line # sta arg ldy #0 ; restore Y lda arg+2 goto: tax ; save line # low ora arg+3 ; fall through ? bne goto1 jmp execend poke: sta (lthan),y ; store low byte jmp execend joutch: jsr outch ; print character jmp execend prnum0: ldx #arg+2 ; x -> arg[{1}], fall through jsr prnum jmp execend usr: tax ; jump to user ml routine with lda quote+1 ; load/save vector? bne usr1 lda quote beq usr_load cmp #1 beq usr_save usr1: lda quote+1 cmp star+1 bcc usr_err bne usr2 lda quote cmp star bcc usr_err usr2: lda arg+3 ; arg[{1}] in a:x (MSB:LSB) jsr usrq jmp execend usr_load: jmp load usr_save: jmp save usrq: jmp (quote) ; {"} must point to valid 6502 code usr_err: lda #$f1 jmp verrcr goto_abort: jsr test_abort ; check for ctrl-c or ctrl-z goto1: lda acia_rx ; allow user abort bne goto_abort lda pound ; set {!} as return line # sta bang lda pound+1 sta bang+1 inc bang ; + 1 bne goto11 inc bang+1 goto11: pla ; true goto lda lblary+62 ; label array populated ? beq ldaray ; no: populate now ! ldarayx: ldy arg+3 ; is physical address pointer ? cpy #$ff beq goto3 ora pound ; direct mode ? beq goto12 cpy pound+1 ; set carry flag for find bne goto2 cpx pound bne goto2 ldy #4 ; same line - start over jmp exec goto5: txa ; build address to label array and #$1f asl a tay lda lblary,y ; load address from array sta at iny lda lblary,y ; load address from array sta at+1 bne goto7 ; if initialized goto_err: lda #$f9 ; undefined label or empty stack jmp verrcr jstart3: sec ; print OK jmp start goto12: clc ; from start of prog goto2: stx pound ; line # goto - store target sty pound+1 jsr find bcs jstart3 ; end of program sta pound stx pound+1 iny ; y = 3 jmp exec goto3: cpx #'=' ; from stack ? bne goto5 ; else is label ldy space ; load stack pointer bne goto4 ldy #$20 ; wrap around goto4: dey ; load new address from stack lda vtlstck,y sta at dey lda vtlstck,y beq goto_err ; if not initialized sta at+1 sty space ; save stack pointer goto7: ldy #1 ; load line # lda (at),y sta pound iny lda (at),y sta pound+1 ldy #4 jmp exec ; populate the acronym label array ldaray: txa pha lda #hi(prgm) tax lda #lo(prgm) jmp ldaray2 ldaraylp: ldy #0 lda (gthan),y ; is label ? bmi ldaray_mis cmp #$60 bcc ldaray1 ; no: skip load and #$1f ; make index to label array asl a tax lda lblary+1,x ; duplicate label ? bne ldaray_dup lda gthan ; line address -> array sta lblary,x lda gthan+1 sta lblary+1,x ldaray1: ldy #3 ; add offset to next line lda gthan ldx gthan+1 clc adc (gthan),y ; add offset bcc ldaray2 inx ldaray2: sta gthan stx gthan+1 cpx ampr+1 ; end of program ? bcc ldaraylp ; no: loop next line bne ldaray3 cmp ampr bcc ldaraylp ldaray3: sty lblary+62 ; mark populated pla tax lda pound+1 jmp ldarayx ldaray_dup: lda #$f8 ; duplicate label ! ldaray_mis: pha ldy #1 lda (gthan),y ; line number sta pound iny lda (gthan),y ; line number sta pound+1 lda #0 ; clear label array & gosub stack ldx #$5f ldaray_clr: sta lblary,x dex bpl ldaray_clr pla ; post error code jmp verr ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; Print an unsigned decimal number (0..65535) in var[x] ; entry: var[x] = number to print ; uses: outch:, gthan ; exit: var[x] = 0 ; prnum: lda #0 ; null delimiter for print pha prnum2: ; divide var[x] by 10 lda #0 sta gthan+1 ; clr BCD lda #16 sta gthan ; {>} = loop counter prdiv1: asl 0,x ; var[x] is gradually replaced rol 1,x ; with the quotient rol gthan+1 ; BCD result is gradually replaced lda gthan+1 ; with the remainder sec sbc #10 ; partial BCD >= 10 ? bcc prdiv2 sta gthan+1 ; yes: update the partial result inc 0,x ; set low bit in partial quotient prdiv2: dec gthan bne prdiv1 ; loop 16 times lda gthan+1 ora #'0' ; convert BCD result 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 rts ;-----------------------------------------------------; ; Evaluate a (hopefully) valid VTL02C expression at ; @[y] and place its calculated value in arg[x] ; A VTL02C expression is defined as a string of one or ; more terms, separated by operators and terminated ; with a null or an unmatched right parenthesis ; A term is defined as a variable name, a decimal ; constant, or a parenthesized sub-expression; terms ; are evaluated strictly from left to right ; A variable name is defined as a user variable, an ; array element expression enclosed in {: )}, or a ; system variable (which may have side-effects) ; entry: @[y] -> expression text, x -> argument ; uses: getval:, {@}, argument stack area ; exit: arg[x] = result, @[y] -> next text ; eval: jsr getval ; arg[x] = value of first term jmp eval_gb ; startup skipping simulation ;-----------------------------------------------------; ; Get numeric value of the term at @[y] into var[x] ; Some examples of valid terms: 123, $, H, (15-:J)/?) ; getval: lda (at),y ; get variable or constant bpl getvar iny ; get constant cmp #$fd ; constant type ? bcs getword and #$7f ; is single byte sta 0,x lda #0 sta 1,x rts getword: ; is word lsr a ; restore null bytes ror a bpl clrlow ; low byte = 0 lda (at),y ; copy constant low sta 0,x iny bcc clrhigh ; high byte = 0 gethigh: lda (at),y ; copy constant low sta 1,x iny rts clrlow: lda #0 sta 0,x beq gethigh clrhigh: lda #0 sta 1,x rts ; get variable getvar: beq getrts ; safety exit - end of banana cmp ';' beq getrts iny cmp #'@' ; peek? bcs getv_byp ; bypass variables >= @ cmp #':' ; array element? beq getary cmp #'(' ; sub-expression? beq eval ; yes: evaluate it recursively cmp #'=' ; return after gosub beq gotomark cmp #'$' ; user char input? beq in_chr cmp #'?' ; user line input? beq in_val getv_byp: beq peek cmp #$60 ; line # variable bcs gotomark sty dolr ; get simple variable asl a ora #$80 tay sei ; force timer consistency lda 0,y sta 0,x lda 1,y sta 1,x cli ; force timer consistency end ldy dolr rts getary: ; get array variable jsr convp_array lda (0,x) pha inc 0,x bne getval4 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 peek: ; memory access? sty dolr ldy #0 lda (lthan),y ; access memory byte at ({<}) ldy dolr sta 0,x lda #0 sta 1,x rts gotomark: ; special line # 65280 + sta 0,x ; low = stack/label lda #$ff sta 1,x ; 65280 rts in_chr: ; user char input? jsr inch ; input one char sta 0,x lda #0 sta 1,x rts in_val: ; user line input tya pha jsr inln ; input value from user jsr cvbin pla tay rts ; skip over "?" and return ;-----------------------------------------------------; ; Set var[x] to the address of the variable named in a ; entry: a holds variable name, @[y] -> text holding ; array index expression (if a = ':') ; uses: eval, {@ &} ; exit: (eq): var[x] -> variable, @[y] unchanged ; (ne): var[x] -> array element, ; @[y] -> following text ; convp: cmp #':' ; array element? bne simple ; no: var[x] -> simple variable convp_array: jsr eval ; yes: evaluate array index at asl 0,x ; @[y] and advance y rol 1,x bcs cverr ; pointer exceeds address range lda ampr ; var[x] -> array element adc 0,x ; at address 2*index+& sta 0,x lda ampr+1 adc 1,x sta 1,x bcs cverr ; pointer wrap around cmp star+1 ; pointer within array RAM ? bcs cverr bne cvend lda 0,x cmp star bcs cverr cvend: rts cverr: ; array variable outside & to * lda #$f0 jmp verrcr ; The following section is designed to translate the ; named simple variable from its ASCII value to its ; zero-page address. In this case, 'A' translates ; to $82, '!' translates to $c2, etc. The method ; employed must correspond to the zero-page equates ; above, or strange and not-so-wonderful bugs will ; befall the weary traveller on his or her porting ; journey. simple: asl a ; form simple variable address ora #$80 ; mapping function is (a*2)|128 sta 0,x lda #0 sta 1,x rts ;-----------------------------------------------------; ; 16-bit unsigned multiply routine: var[x] *= var[x+2] ; exit: overflow is ignored/discarded, var[x+2] and ; {>} are modified, a = 0 ; op_mul: lda 0,x sta gthan lda 1,x ; {>} = var[x] sta gthan+1 lda #0 sta 0,x ; var[x] = 0 sta 1,x mul2: lda gthan ora gthan+1 beq mulrts ; exit early if {>} = 0 lsr gthan+1 ror gthan ; {>} /= 2 bcc mul3 clc ; inline plus lda 0,x adc 2,x sta 0,x lda 1,x adc 3,x sta 1,x ; end inline mul3: asl 2,x rol 3,x ; left-shift var[x+2] lda 2,x ora 3,x ; loop until var[x+2] = 0 bne mul2 mulrts: jmp eval_gb ;-----------------------------------------------------; ; var[x] += var[x+2] ; op_plus: clc lda 0,x adc 2,x sta 0,x lda 1,x adc 3,x jmp op_ret ;-----------------------------------------------------; ; var[x] -= var[x+2] ; expects: (cs) ; op_minus: lda 0,x sbc 2,x sta 0,x lda 1,x sbc 3,x jmp op_ret ;-----------------------------------------------------; ; var[x] &= var[x+2] ; expects: - ; op_and: lda 0,x and 2,x sta 0,x lda 1,x and 3,x jmp op_ret ;-----------------------------------------------------; ; if var[x] > 0 then var[x] = var[x+2] ; op_then: lda 0,x ora 1,x beq eval_gb else_true: lda 2,x sta 0,x lda 3,x jmp op_ret ;-----------------------------------------------------; ; 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 ; 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 oper: cmp #'/' ; division operator? bcs op_byp1 cmp #'+' ; addition operator? beq op_plus cmp #'*' ; multiplication operator? beq op_mul cmp #'-' ; subtraction operator? beq op_minus cmp #'&' ; bit-wise and operator? beq op_and if OP_OR < '/' cmp #OP_OR ; bit-wise or operator? beq op_or endif op_byp1: beq op_div cmp #'[' ; "then" operator? bcc op_byp2 beq op_then cmp #']' ; "else" operator? bne op_ext ;-----------------------------------------------------; ; if var[x] = 0 then var[x] = var[x+2] else var[x] = 0 ; op_else: lda 0,x ora 1,x beq else_true lda #0 sta 0,x jmp op_ret op_byp2: ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; Apply comparison operator in a to var[x] and var[x+2] ; and place result in var[x] (1: true, 0: false) ; expects: (cs) ; eor #'<' ; 0: '<' 1: '=' 2: '>' sta gthan ; other values in a are undefined, sec lda 0,x ; inline minus sbc 2,x sta 0,x lda 1,x sbc 3,x sta 1,x ; end inline dec gthan ; var[x] -= var[x+2] bne oper8b ; equality test? ora 0,x ; yes: 'or' high and low bytes beq oper8c ; (cs) if 0 clc ; (cc) if not 0 oper8b: lda gthan rol a oper8c: adc #0 and #1 ; var[x] = 1 (true), 0 (false) sta 0,x lda #0 op_ret sta 1,x ; store result high eval_gb: lda (at),y ; get next operator beq evalrts cmp #';' ; statement delimiter ? beq evalrts iny ; skip over any space char(s) cmp #')' ; no: skip over the operator bne notdn ; and continue the evaluation evalrts: rts ; yes: return with final result ;-----------------------------------------------------; ; var[x] |= var[x+2] ; expects: - ; op_or: lda 0,x ora 2,x sta 0,x lda 1,x ora 3,x jmp op_ret ;-----------------------------------------------------; ; continue shift & logic ops op_ext: if OP_OR > '/' cmp #OP_OR ; bit-wise or operator? beq op_or endif cmp #'^' ; bit-wise xor operator? beq op_xor cmp #'}' ; shift right operator? beq op_shr cmp #'{' ; shift left operator ? beq op_shl bne op_byp2 ; continue with default comparison ;-----------------------------------------------------; ; 16-bit unsigned division routine ; var[x] /= var[x+2], {%} = remainder, {>} modified ; var[x] /= 0 produces {%} = var[x], var[x] = 65535 ; op_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 sop_ret jmp eval_gb ;-----------------------------------------------------; ; var[x] shifted right by var[x+2] bits ; op_shr1: lsr 1,x ror 0,x op_shr: dec 2,x bpl op_shr1 bmi eval_gb ;-----------------------------------------------------; ; var[x] shifted left by var[x+2] bits ; op_shl1: asl 0,x rol 1,x op_shl: dec 2,x bpl op_shl1 bmi eval_gb ;-----------------------------------------------------; ; var[x] ^= var[x+2] ; expects: - ; op_xor: lda 0,x eor 2,x sta 0,x lda 1,x eor 3,x jmp op_ret ;-----------------------------------------------------; ; If text at @[y] is a decimal constant, translate it ; into var[x] (discarding any overflow) and update y ; entry: @[y] -> text containing possible constant; ; leading space characters are skipped, but ; any spaces encountered after a conversion ; has begun will end the conversion. ; used by: user:, synval: ; uses: var[x], var[x+2], linbuf[y], {> ?} ; exit: (ne): var[x] = constant, y -> next char ; (eq): var[x] = 0, y unchanged ; (cs): in all but the truly strangest cases ; cvbin: lda #0 sta 0,x ; var[x] = 0 sta 1,x cvb_gb1: ; inline getbyte sty ques ; save pointer lda linbuf,y iny ; skip over any space char(s) cmp #' ' ; is space? beq cvb_gb1 ; end inline cvb_gb2: ; skip multiply & add for 1st digit eor #'0' ; if char at @[y] is not a cmp #10 ; decimal digit then stop bcs cvbin1 ; the conversion sta 0,x cvbin2: lda linbuf,y ; grab a char eor #'0' ; if char at @[y] is not a cmp #10 ; decimal digit then stop bcs cvbin3 ; the conversion pha ; save decimal digit lda 1,x ; inline multiply by 10 sta gthan+1 lda 0,x sta gthan asl a rol 1,x asl a rol 1,x clc adc gthan sta 0,x lda 1,x adc gthan+1 asl 0,x rol a sta 1,x ; end inline pla ; retrieve decimal digit clc ; inline add digit adc 0,x sta 0,x bcc cvbin4 inc 1,x cvbin4: ; end inline iny ; loop for more digits bpl cvbin2 ; (with safety escape) cvbin1: dey 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) ; used by: user:, usr: ; uses: inch:, outch:, linbuf ; exit: y = 0 ; inln: ldy #0 inlnlp: ; main loop jsr inch ; get (and echo) one key press cmp #BS ; backspace? beq inlnbs ; yes: delete previous char cmp #ESC ; escape? beq inlnesc ; yes: discard entire line cmp #$0d ; cr? beq inlncr cmp #' ' ; do not store ctrl keys bcc inlnlp sta linbuf,y ; put key in linbuf iny bpl inlnlp ; loop if < len(linbuf) lda #BS ; hold at end of buffer jsr outch inlnbs: dey ; backspace bpl inlnlp lda #13 ; hold at begin of buffer jsr outch iny bpl inlnlp inlncr: lda #0 ; cr - mark end of line sta linbuf,y tay ; y = 0 rts inlnesc: cpy #0 ; escape - reverse all input beq inlnlp lda #BS inlnesc1: jsr outch dey bne inlnesc1 beq inlnlp ;-----------------------------------------------------; ; Find the first/next stored program line >= {#} ; entry: (cc): start search at program beginning ; (cs): start search at next line ; ({@} -> beginning of current line) ; used by: skp2:, findln: ; uses: prgm, {@ # & (} ; exit: (cs): {@}, x:a and {(} undefined, y = 3 ; (cc): {@} -> beginning of found line, y = 3, ; x:a = {(} = actual found line number ; find: ldx #hi(prgm) lda #lo(prgm) bcc find1st ; cc: search begins at first line ldx at+1 ldy #3 findnxt: lda at cmp ampr lda at+1 sbc ampr+1 ; {@} >= {&} (end of program)? bcs findrts ; yes: search failed (cs) find3: lda at adc (at),y ; no: {@} -> next line bcc find5 inx find1st: stx at+1 find5: sta at ldy #1 lda (at),y sta lparen ; {(} = current line number cmp pound ; (invalid if {@} >= {&}, but iny ; we'll catch that later...) lda (at),y sta lparen+1 sbc pound+1 ; if {(} < {#} then try the next iny ; program line bcc findnxt lda at ; {@} >= {&} (end of program)? cmp ampr ; yes: search failed (cs) lda at+1 ; no: search succeeded (cc) sbc ampr+1 lda lparen ldx lparen+1 findrts: rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; pre-process and check new program lines ; while moving linbuf,y -> prgbuf,x create header, ; strip blanks, convert numbers, check syntax ; uses: argument stack ; syntax: php lda linbuf ; initialize label cmp #$60 ; is label ? bcs syntx1 ; yes: store label lda #' ' ; no: store space syntx1: sta prgbuf lda pound ; store line number sta prgbuf+1 lda pound+1 sta prgbuf+2 lda #0 ; clear sta arg ; error number sta arg+3 ; parenthesis match count ldx #4 ; initialize prgbuf text index synlp1: sty arg+4 ; save pointer to left side var lda linbuf,y ; check left side of equation beq synend1 cmp #')' ; is full line comment ? beq synend1 cmp #';' ; no statement delimiter beq synerr1 cmp #'(' ; no left parenthesis beq synerr1 cmp #'0' ; is numeric bcc synvlr ; valid range if lower cmp #'9'+1 bcc synerr1 cmp #$60 ; is lower case ? bcc synvlr ; valid range if upper case synerr1: lda #$f3 ; invalid or missing target var jsr syn_err lda linbuf,y synvlr: iny cmp #' ' ; discard space beq synlp1 sta prgbuf,x ; is valid left side inx cmp #':' ; is array var bne synaray jsr syn_evalp ; evaluate array index lda arg+3 ; test parenthesis matched beq synaray jsr syn_errp ; missing closing parenthesis lda #0 ; clear parenthesis match count sta arg+3 synaray: synlp2: lda linbuf,y ; equation or implied ? beq synerr3 cmp #'=' bne syndbl sta prgbuf,x inx synlp3: iny lda linbuf,y ; check for string cmp #' ' beq synlp3 cmp #'"' synend1: beq synend syndbl1: jsr syn_eval cmp #';' bne syndbl2 sta prgbuf,x iny inx syndbl2: lda arg+3 ; matching parenthesis beq synlp1 bmi synend ; extra closing p. = comment jsr syn_errp ; missing closing parenthesis lda #0 ; clear parenthesis match count sta arg+3 beq synlp1 ; doubles variable & operator A+B -> A=A+B syndbl: iny cmp #' ' ; discard space beq synlp2 lda #'=' ; insert equal sta prgbuf,x inx ldy arg+4 ; repeat variable & operator tya clc ; test buffer will not overlap adc #$20 sta arg+4 cpx arg+4 bcc syndbl1 lda #$f7 ; buffers overlap error jmp verr synerr3: lda #$f2 ; invalid or missing operator jsr syn_err synend: dex ; copy string, comment or null dey synendlp: inx iny lda linbuf,y sta prgbuf,x bne synendlp ; loop for remaining line inx stx prgbuf+3 ; store line length lda arg ; any syntax error ? beq synexit ldy arg+2 ; show error pointer synerptr: cpy #0 beq synerrp1 lda #' ' jsr outch dey bne synerptr synerrp1: lda #'^' jsr outch lda arg ; show error message sta prgbuf ldx #msgerr jsr verrs lda prgbuf+1 ; restore line number sta pound lda prgbuf+2 sta pound+1 plp ; direct mode ? bne synexit1 ; no: store line clc ; yes: do not execute jmp reset synexit: plp synexit1: rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; Replaces decimal with binary constants in linbuf ; to avoid runtime conversion. ; < 125 = 1 byte $80-$FC ($80 + binary number) ; > 124 = 3 bytes $FF $0101-$FFFF ; if low byte is $00 then 2 bytes $FE $01-$FF ; if high byte is $00 then 2 bytes $FD $01-$FF ; syn_val: txa ; expects value or variable pha ldx #equal ; cvbin converts to equal var jsr cvbin ; convert if decimal beq syn_var ; not a value pla ; convert to constant tax lda equal+1 bne syn_val1 ; is > 256 lda equal cmp #125 bcs syn_val1 ; is > 125 ora #$80 ; is one byte constant sta prgbuf,x inx rts syn_val1: lda #$ff ; preset 3 byte constant sta prgbuf,x inx lda equal bne syn_val2 dec prgbuf-1,x ; mark low byte is null lda equal+1 ; store high byte syn_val3: sta prgbuf,x inx rts syn_val2: sta prgbuf,x ; store low byte inx lda equal+1 bne syn_val3 dec prgbuf-2,x ; mark high byte is null dec prgbuf-2,x rts syn_var: pla tax lda linbuf,y beq syn_varx ; unexpected end of line cmp #';' ; " " of statement beq syn_varx cmp #')' ; " " of subexpression beq syn_varx sta prgbuf,x inx iny cmp #'(' ; sub expression ? beq syn_evalp cmp #':' ; array variable ? beq syn_evalp rts syn_varx: lda #$f4 ; value or variable missing syn_err: pha ; set syntax error lda arg bne syn_err1 ; skip if already set pla sta arg sty arg+2 rts syn_err1: pla rts syn_evalp: lda arg+3 ; is 1st opening parenthesis ? bne syn_evalp1 sty arg+1 ; save pointer syn_evalp1: inc arg+3 ; +1 open parenthesis syn_eval: jsr syn_val syn_eval1: lda linbuf,y beq syn_evalx ; if end of line cmp #';' ; end of statement ? beq syn_evalx iny cmp #' ' ; skip over space beq syn_eval1 sta prgbuf,x inx cmp #')' ; end of sub expression ? beq syn_evalx2 stx arg+5 ldx #vld_ops_x ; valid operator ? syn_oper: cmp vld_ops,x beq syn_operok ; operator found dex bpl syn_oper ; loop until end of valid ops dey lda #$f2 ; invalid operator jsr syn_err iny syn_operok: ldx arg+5 ; next value or variable bne syn_eval syn_evalx2: dec arg+3 ; -1 open parenthesis syn_evalx: rts syn_errp: lda arg ; set open parenthesis error bne syn_errp1 ; skip if already set lda #$f5 sta arg dec arg+1 ; pointer to opening parenthesis lda arg+1 sta arg+2 syn_errp1: rts vld_ops: db "+-*/<=>[]{}&^",OP_OR vld_ops_x = * - vld_ops - 1 ;-----------------------------------------------------; ; VTL message service & error messages ; verr: expects a = error number ; vmsg: expects x = message vmsg: lda msg,x ; print message at x beq vmsgx ; end if 0 jsr outch inx bne vmsg vmsgx: rts verrs: sta arg ; print error with number jsr vmsg sta arg+1 ldx #arg jsr prnum lda pound ; test direct mode ora pound+1 beq verrx ldx #msgiln ; print line number jsr vmsg ldx #pound jsr prnum verrx: jmp outnl verrcr: ldx #msgerr bne verr1 verr: ldx #msgerr+1 verr1: jsr verrs ; print error & stop clc jmp reset msg: msgvtl = 0 db 13,"VTL02sg",0 msgok = *-msg db 13,"OK",13,0 msgerr = *-msg db 13,"Error ",0 msgiln = *-msg db " in line ",0 ;============ Original I/O subroutines ===============; ;-----------------------------------------------------; ; Check for user keypress and return with (cc) if none ; is pending. Otherwise, fall through to inch ; and return with (cs). ; 6 bytes ;inkey: ; lda KBD ; is there a keypress waiting? ; asl ; bcc outrts ; no: return with (cc) ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; Read key from stdin into a, echo, (cs) ; drop stack and abort to "OK" prompt if ctrl-C ; 16 bytes ;inch: ; sty dolr ; save y reg ; jsr KEYIN ; get a char from keyboard ; ldy dolr ; restore y reg ; and #$7f ; strip apple's hi-bit ; cmp #$03 ; ctrl-C? ; bne outch ; no: echo to terminal ; jmp start ; yes: abort to "OK" prompt ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; Print ASCII char in a to stdout, (cs) ; 9 bytes ;outch: ; pha ; save original char ; ora #$80 ; apples prefer "high" ASCII ; jsr COUT ; emit char via apple monitor ; pla ; restore original char ; sec ; (by contract with callers) ;outrts: ; rts ;-----------------------------------------------------; ;======== 2m5 SBC emulator I/O subroutines ===========; timr_adr = timr_var*2|$80 ;-----------------------------------------------------; ; 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 jsr test_abort inkeyp: lda acia_rx ; pause until next key beq inkeyp jsr test_abort inkeyr: rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; Read key from stdin into a, echo, (cs) ; Dump stack and abort to "OK" prompt if ctrl-C ; inch: lda acia_rx ; get character from rx register beq inch ; wait for character !=0 sty dolr ; save y reg cmp #127 ; convert delete to backspace bne conv_bs2del lda #8 conv_bs2del: cmp #27 ; escape? bne skip_esc_no lda timr_adr ; wait 5*10ms clc adc #5 skip_esc_wait: cmp timr_adr ; wait loop bne skip_esc_wait ldy #0 skip_esc_discard: iny ; any data = y > 1 lda acia_rx bne skip_esc_discard cpy #1 bne inch ; discard escape sequence lda #27 ; escape only - send to vtl skip_esc_no ldy dolr ; restore y reg inch2: and #$7f ; ensure char is positive ascii jsr test_abort cmp #BS ; only echo printable, bs & cr beq outch cmp #13 beq outch cmp #' ' bcs outch sec rts test_abort: cmp #3 ; is ctrl-c beq istart ; yes: abort to OK prompt cmp #$1a ; is ctrl-z beq abort ; yes: exit to monitor rts abort: jsr outcr lda #$80 ; exit to monitor sta diag lda #ESC ; escape after continue rts istart: jmp start ; yes: abort to "OK" prompt ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; Print ascii char in a to stdout, (cs) ; outch: cmp #13 ; add line feed to carriage return bne skip_cr lda #10 sta acia_tx outcr: lda #13 skip_cr: cmp #8 ; backspace? bne skip_bs sta acia_tx ; make erasing backspace lda #' ' sta acia_tx lda #8 skip_bs: sta acia_tx ; emit char via transmit register sec ; (by contract with callers) rts ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; Load a program from EEPROM by number in x ; load: lda #0 ; setup dma control block sta dma_cmd stx dma_dat ; program # lda #lo(prgm) ; from sta dma_dat sta ampr ; & new lda #hi(prgm) sta dma_dat sta ampr+1 lda #7 ; load eep command sta dma_cmd lda dma_sta ; get status cmp #$17 bne ldsv_fail lda dma_dat ; get end of program address sta ampr lda dma_dat sta ampr+1 jmp reset ; clear label array and gosub stack ldsv_fail: jmp verrcr ; error message ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; Save a program to EEPROM by number in x ; save: lda #0 ; setup dma control block sta dma_cmd stx dma_dat ; program # lda #lo(prgm) ; from sta dma_dat lda #hi(prgm) sta dma_dat lda ampr ; to sta dma_dat lda ampr+1 sta dma_dat lda #6 ; save eep command sta dma_cmd lda dma_sta ; get status cmp #$16 bne ldsv_fail jmp start ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; ; Update a variable with the 10ms timer ; IRQ_10ms: pha inc timr_adr ; increment the variable {/} bne IRQ_exit inc timr_adr+1 IRQ_exit: lda #1 ; clear interrupt flag sta timr_fl pla rti ; Start the timer prior to VTL IRQ_start: lda #1 ; set bit 0 (10ms tick) sta timr_ie ; -> interrupt enable cli jmp vtl02c ; continue cold start ;-----------------------------------------------------; org $fffc dw IRQ_start ; reset vector -> cold start dw IRQ_10ms ; interrupt vector -> 10ms update end IRQ_start ; set start address