ca65 V2.18 - Git N/A Main file : Apps/VTL02/vtl02ca2.s Current file: Apps/VTL02/vtl02ca2.s 000000r 1 ;-----------------------------------------------------; 000000r 1 ; VTL-2 for the 6502 (VTL02C) ; 000000r 1 ; Original Altair 680b version by ; 000000r 1 ; Frank McCoy and Gary Shannon 1977 ; 000000r 1 ; 2012: Adapted to the 6502 by Michael T. Barry ; 000000r 1 ; Thanks to sbprojects.com for a very nice assembler! ; 000000r 1 ;-----------------------------------------------------; 000000r 1 ; Copyright (c) 2012, Michael T. Barry 000000r 1 ; Revision B (c) 2015, Michael T. Barry 000000r 1 ; Revision C (c) 2015, Michael T. Barry 000000r 1 ; All rights reserved. 000000r 1 ; 000000r 1 ; 2019-07-31 (marcelk) Adapted for as65 assembler 000000r 1 ; and Gigatron TTL computer 000000r 1 ; 000000r 1 ; Redistribution and use in source and binary forms, 000000r 1 ; with or without modification, are permitted, 000000r 1 ; provided that the following conditions are met: 000000r 1 ; 000000r 1 ; 1. Redistributions of source code must retain the 000000r 1 ; above copyright notice, this list of conditions 000000r 1 ; and the following disclaimer. 000000r 1 ; 2. Redistributions in binary form must reproduce the 000000r 1 ; above copyright notice, this list of conditions 000000r 1 ; and the following disclaimer in the documentation 000000r 1 ; and/or other materials provided with the 000000r 1 ; distribution. 000000r 1 ; 000000r 1 ; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS 000000r 1 ; AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED 000000r 1 ; WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 000000r 1 ; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 000000r 1 ; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT 000000r 1 ; SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE 000000r 1 ; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 000000r 1 ; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 000000r 1 ; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 000000r 1 ; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 000000r 1 ; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 000000r 1 ; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 000000r 1 ; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING 000000r 1 ; IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF 000000r 1 ; ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 000000r 1 ;-----------------------------------------------------; 000000r 1 ; Except for the differences discussed below, VTL02 was 000000r 1 ; designed to duplicate the OFFICIALLY DOCUMENTED 000000r 1 ; behavior of Frank's 680b version, detailed here: 000000r 1 ; http://www.altair680kit.com/manuals/Altair_ 000000r 1 ; 680-VTL-2%20Manual-05-Beta_1-Searchable.pdf 000000r 1 ; These versions ignore all syntax errors and plow 000000r 1 ; through VTL-2 programs with the assumption that 000000r 1 ; they are "correct", but in their own unique ways, 000000r 1 ; so any claims of compatibility are null and void 000000r 1 ; for VTL-2 code brave (or stupid) enough to stray 000000r 1 ; from the beaten path. 000000r 1 ; 000000r 1 ; Differences between the 680b and 6502 versions: 000000r 1 ; * {&} and {*} are initialized on entry. 000000r 1 ; * Division by zero returns 65535 for the quotient and 000000r 1 ; the dividend for the remainder (the original 6800 000000r 1 ; version froze). 000000r 1 ; * The 6502 has NO 16-bit registers (other than PC) 000000r 1 ; and less overall register space than the 6800, 000000r 1 ; so the interpreter reserves some obscure VTL02C 000000r 1 ; variables {@ $ ( ) 0 1 2 3 4 5 6 7 8 9 < > : ?} 000000r 1 ; for its internal use (the 680b version used a 000000r 1 ; similar tactic, but differed in the details). 000000r 1 ; The deep nesting of parentheses also puts {; < =} 000000r 1 ; in danger of corruption. For example, executing 000000r 1 ; the statement A=((((((((1)))))))) sets both {A} 000000r 1 ; and {;} to the value 1. 000000r 1 ; * Users wishing to call a machine language subroutine 000000r 1 ; via the system variable {>} must first set the 000000r 1 ; system variable {"} to the proper address vector 000000r 1 ; (for example, "=768). 000000r 1 ; * The x register is used to point to a simple VTL02C 000000r 1 ; variable (it can't point explicitly to an array 000000r 1 ; element like the 680b version because it's only 000000r 1 ; 8-bits). In the comments, var[x] refers to the 000000r 1 ; 16-bit contents of the zero-page variable pointed 000000r 1 ; to by register x (residing at addresses x, x+1). 000000r 1 ; * The y register is used as a pointer offset inside 000000r 1 ; a VTL02C statement (easily handling the maximum 000000r 1 ; statement length of about 128 bytes). In the 000000r 1 ; comments, @[y] refers to the 16-bit address 000000r 1 ; formed by adding register y to the value in {@}. 000000r 1 ; * The structure and flow of this interpreter are 000000r 1 ; similar to the 680b version, but have been 000000r 1 ; reorganized in a more 6502-friendly format (the 000000r 1 ; 6502 has no 'bsr' instruction, so the 'stuffing' 000000r 1 ; of subroutines within 128 bytes of the caller is 000000r 1 ; only advantageous for conditional branches). 000000r 1 ; * This version is based on the original port, which 000000r 1 ; was wound rather tightly, in a failed attempt to 000000r 1 ; fit it into 768 bytes like the 680b version; many 000000r 1 ; structured programming principles were sacrificed 000000r 1 ; in that effort. The 6502 simply requires more 000000r 1 ; instructions than the 6800 does to manipulate 16- 000000r 1 ; bit quantities, but the overall execution speed 000000r 1 ; should be comparable due to the 6502's slightly 000000r 1 ; lower average clocks/instruction ratio. As it is 000000r 1 ; now, it fits into 1KB with just a few bytes to 000000r 1 ; spare, but is more feature-laden than the 680b 000000r 1 ; interpreter whence it came. Beginning with 000000r 1 ; Revision C, I tried to strike a tasteful balance 000000r 1 ; between execution speed and code size, but I 000000r 1 ; stubbornly kept it under 1024 ROMable bytes and 000000r 1 ; used only documented op-codes that were supported 000000r 1 ; by the original NMOS 6502 (without the ROR bug). 000000r 1 ; I may have missed a few optimizations -- further 000000r 1 ; suggestions are welcome. 000000r 1 ; * VTL02C is my free gift (?) to the world. It may be 000000r 1 ; freely copied, shared, and/or modified by anyone 000000r 1 ; interested in doing so, with only the stipulation 000000r 1 ; that any liabilities arising from its use are 000000r 1 ; limited to the price of VTL02C (nothing). 000000r 1 ;-----------------------------------------------------; 000000r 1 ; 2015: Revision B included some space optimizations 000000r 1 ; (suggested by dclxvi) and enhancements 000000r 1 ; (suggested by mkl0815 and Klaus2m5): 000000r 1 ; 000000r 1 ; * Bit-wise operators & | ^ (and, or, xor) 000000r 1 ; Example: A=$|128) Get a char and set hi-bit 000000r 1 ; 000000r 1 ; * Absolute addressed 8-bit memory load and store 000000r 1 ; via the {< @} facility: 000000r 1 ; Example: <=P) Point to the I/O port at P 000000r 1 ; @=@&254^128) Clear low-bit & flip hi-bit 000000r 1 ; 000000r 1 ; * Starting with VTL02B, the space character is no 000000r 1 ; longer a valid user variable nor a "valid" binary 000000r 1 ; operator. It's now only significant as a numeric 000000r 1 ; constant terminator and as a place-holder in 000000r 1 ; strings and program listings, where it may be 000000r 1 ; used to improve human readability (at a slight 000000r 1 ; cost in execution speed and memory consumption). 000000r 1 ; Example: 000000r 1 ; * (VTL-2) 000000r 1 ; 1000 A=1) Init loop index 000000r 1 ; 1010 ?=A) Print index 000000r 1 ; 1020 ?="") Newline 000000r 1 ; 1030 A=A+1) Update index 000000r 1 ; 1040 #=A<10*1010) Loop until done 000000r 1 ; 000000r 1 ; * (VTL02B) 000000r 1 ; 1000 A = 1 ) Init loop index 000000r 1 ; 1010 ? = A ) Print index 000000r 1 ; 1020 ? = "" ) Newline 000000r 1 ; 1030 A = A + 1 ) Update index 000000r 1 ; 1040 # = A < 10 * 1010 ) Loop until done 000000r 1 ; 000000r 1 ; 2015: Revision C includes further enhancements 000000r 1 ; (suggested by Klaus2m5): 000000r 1 ; 000000r 1 ; * "THEN" and "ELSE" operators [ ] 000000r 1 ; A[B returns 0 if A is 0, otherwise returns B. 000000r 1 ; A]B returns B if A is 0, otherwise returns 0. 000000r 1 ; 000000r 1 ; * Some effort was made to balance interpreter code 000000r 1 ; density with interpreter performance, while 000000r 1 ; remaining within the 1KB constraint. Structured 000000r 1 ; programming principles remained at low priority. 000000r 1 ;-----------------------------------------------------; 000000r 1 ; VTL02C variables occupy RAM addresses $0080 to $00ff, 000000r 1 ; and are little-endian, in the 6502 tradition. 000000r 1 ; The use of lower-case and some control characters for 000000r 1 ; variable names is allowed, but not recommended; any 000000r 1 ; attempts to do so would likely result in chaos, due 000000r 1 ; to aliasing with upper-case and system variables. 000000r 1 ; Variables tagged with an asterisk are used internally 000000r 1 ; by the interpreter and may change without warning. 000000r 1 ; {@ $ ( ) 0..9 : > ?} are (usually) intercepted by 000000r 1 ; the interpreter, so their internal use by VTL02C is 000000r 1 ; "safe". The same cannot be said for {; < =}, so be 000000r 1 ; careful! 000000r 1 at = $c0 ; {@}* internal pointer / mem byte 000000r 1 ; VTL02C standard user variable space 000000r 1 ; {A B C .. X Y Z [ \ ] ^ _} 000000r 1 ; VTL02C system variable space 000000r 1 ;space = $80 ; { } Starting with VTL02B: the 000000r 1 ; space character is no longer a 000000r 1 ; valid user variable nor a 000000r 1 ; "valid" binary operator. 000000r 1 ; It is now only significant as a 000000r 1 ; numeric constant terminator and 000000r 1 ; as a place-holder in strings 000000r 1 ; and program listings. 000000r 1 bang = $82 ; {!} return line number 000000r 1 quote = $84 ; {"} user ml subroutine vector 000000r 1 pound = $86 ; {#} current line number 000000r 1 dolr = $88 ; {$}* temp storage / char i/o 000000r 1 remn = $8a ; {%} remainder of last division 000000r 1 ampr = $8c ; {&} pointer to start of array 000000r 1 tick = $8e ; {'} pseudo-random number 000000r 1 lparen = $90 ; {(}* old line # / begin sub-exp 000000r 1 rparen = $92 ; {)}* temp storage / end sub-exp 000000r 1 star = $94 ; {*} pointer to end of free mem 000000r 1 ; $96 ; {+ , - . /} valid variables 000000r 1 ; Interpreter argument stack space 000000r 1 arg = $a0 ; {0 1 2 3 4 5 6 7 8 9 :}* 000000r 1 ; Rarely used variables and argument stack overflow 000000r 1 ; $b6 ; {;}* valid user variable 000000r 1 lthan = $b8 ; {<}* user memory byte pointer 000000r 1 ; = $ba ; {=}* valid user variable 000000r 1 gthan = $bc ; {>}* temp / call ML subroutine 000000r 1 ques = $be ; {?}* temp / terminal i/o 000000r 1 ; 000000r 1 nulstk = $007f ; [Gigatron] v6502 stack in page 0 000000r 1 ;-----------------------------------------------------; 000000r 1 ; Equates for a 48K+ Apple 2 (original, +, e, c, gs) 000000r 1 ESC = 27 ; "Cancel current input line" key 000000r 1 BS = $5f ; "Delete last keypress" key [Gigatron] 000000r 1 OP_OR = '!' ; Bit-wise OR operator 000000r 1 linbuf = $0200 ; input line buffer 000000r 1 prgm = $0700 ; VTL02B program grows from here 000000r 1 himem = $0800 ; ... up to the top of user RAM 000000r 1 vtl02c = $0219 ; interpreter cold entry point [Gigatron] 000000r 1 ; (warm entry point is startok) 000000r 1 ;KBD = $c000 ; 128 + keypress if waiting 000000r 1 serialRaw = $0f 000000r 1 ;KEYIN = $fd0c ; apple monitor keyin routine 000000r 1 ;COUT = $fded ; apple monitor charout routine 000000r 1 ;=====================================================; 000000r 1 000000r 1 .org $200 000200 1 00 00 00 00 .byte 0,0,0,0,0,0,0,0 000204 1 00 00 00 00 000208 1 00 00 00 00 .byte 0,0,0,0,0,0,0,0 00020C 1 00 00 00 00 000210 1 00 00 00 00 .byte 0,0,0,0,0,0,0,0 000214 1 00 00 00 00 000218 1 00 .byte 0 000219 1 ; [Gigatron] line buffer can go 16 bytes into 000219 1 ; vtl02c for 41 bytes total 000219 1 .org vtl02c 000219 1 ;-----------------------------------------------------; 000219 1 ; Initialize program area pointers and start VTL02C 000219 1 ; 17 bytes 000219 1 A9 00 lda # empty program 00021D 1 A9 07 lda #>prgm 00021F 1 85 8D sta ampr+1 000221 1 A9 00 lda # top of user RAM 000225 1 A9 08 lda #>himem 000227 1 85 95 sta star+1 000229 1 startok: 000229 1 38 sec ; request "OK" message 00022A 1 ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; 00022A 1 ; Start/restart VTL02C command line with program intact 00022A 1 ; 32 bytes 00022A 1 start: 00022A 1 D8 cld ; a sensible precaution 00022B 1 A2 7F ldx #= {#} 000254 1 A2 90 ldx #lparen ; line number for prnum 000256 1 20 AD 03 jsr prnum ; print the line number 000259 1 A9 20 lda #' ' ; print a space instead of the 00025B 1 20 F9 05 jsr outch ; line length byte 00025E 1 A9 00 lda #0 ; zero for delimiter 000260 1 20 33 03 jsr prstr ; print the rest of the line 000263 1 B0 EC bcs list_ ; (always taken) 000265 1 ;-----------------------------------------------------; 000265 1 ; The main program execution loop 000265 1 ; entry: with (cs) via "beq direct" in user: 000265 1 ; exit: to command line via findln: or "beq start" 000265 1 ; 45 bytes 000265 1 progr: 000265 1 F0 14 beq eloop0 ; if {#} = 0 then ignore and 000267 1 A4 91 ldy lparen+1 ; continue (false branch) 000269 1 A6 90 ldx lparen ; else did {#} change? 00026B 1 C4 87 cpy pound+1 ; yes: perform a branch, with 00026D 1 D0 04 bne branch ; carry flag conditioned for 00026F 1 E4 86 cpx pound ; the appropriate direction. 000271 1 F0 0C beq eloop ; no: execute next line (cs) 000273 1 branch: 000273 1 E8 inx ; execute a VTL02B branch 000274 1 D0 01 bne branch2 000276 1 C8 iny 000277 1 branch2: 000277 1 86 82 stx bang ; {!} = {(} + 1 (return ptr) 000279 1 84 83 sty bang+1 00027B 1 eloop0: 00027B 1 2A rol 00027C 1 49 01 eor #1 ; complement carry flag 00027E 1 6A ror 00027F 1 eloop: 00027F 1 20 29 03 jsr findln ; find first/next line >= {#} 000282 1 C8 iny ; skip over the length byte 000283 1 direct: 000283 1 08 php ; (cc: program, cs: direct) 000284 1 20 57 03 jsr exec ; execute one VTL02B statement 000287 1 28 plp 000288 1 A5 86 lda pound ; update Z for {#} 00028A 1 05 87 ora pound+1 ; if program mode then continue 00028C 1 90 D7 bcc progr ; if direct mode, did {#} change? 00028E 1 F0 9A beq start ; no: restart "OK" prompt 000290 1 D0 E9 bne eloop0 ; yes: execute program from {#} 000292 1 ;-----------------------------------------------------; 000292 1 ; Delete/insert/replace program line and restart the 000292 1 ; command prompt (no "OK" means success) 000292 1 ; entry: Carry must be clear 000292 1 ; uses: find:, start:, linbuf, {@ > # & * (} 000292 1 ; 151 bytes 000292 1 skp2: 000292 1 98 tya ; save linbuf offset pointer 000293 1 48 pha 000294 1 20 9D 05 jsr find ; point {@} to first line >= {#} 000297 1 B0 34 bcs insrt 000299 1 45 86 eor pound ; if line doesn't already exist 00029B 1 D0 30 bne insrt ; then skip deletion process 00029D 1 E4 87 cpx pound+1 00029F 1 D0 2C bne insrt 0002A1 1 AA tax ; x = 0 0002A2 1 B1 C0 lda (at),y 0002A4 1 A8 tay ; y = length of line to delete 0002A5 1 49 FF eor #255 0002A7 1 65 8C adc ampr ; {&} = {&} - y 0002A9 1 85 8C sta ampr 0002AB 1 B0 02 bcs delt 0002AD 1 C6 8D dec ampr+1 0002AF 1 delt: 0002AF 1 A5 C0 lda at 0002B1 1 85 BC sta gthan ; {>} = {@} 0002B3 1 A5 C1 lda at+1 0002B5 1 85 BD sta gthan+1 0002B7 1 delt2: 0002B7 1 A5 BC lda gthan 0002B9 1 C5 8C cmp ampr ; delete the line 0002BB 1 A5 BD lda gthan+1 0002BD 1 E5 8D sbc ampr+1 0002BF 1 B0 0C bcs insrt 0002C1 1 B1 BC lda (gthan),y 0002C3 1 81 BC sta (gthan,x) 0002C5 1 E6 BC inc gthan 0002C7 1 D0 EE bne delt2 0002C9 1 E6 BD inc gthan+1 0002CB 1 90 EA bcc delt2 ; (always taken) 0002CD 1 insrt: 0002CD 1 68 pla 0002CE 1 AA tax ; x = linbuf offset pointer 0002CF 1 A5 86 lda pound 0002D1 1 48 pha ; push the new line number on 0002D2 1 A5 87 lda pound+1 ; the system stack 0002D4 1 48 pha 0002D5 1 A0 02 ldy #2 0002D7 1 cntln: 0002D7 1 E8 inx 0002D8 1 C8 iny ; determine new line length in y 0002D9 1 BD FF 01 lda linbuf-1,x ; and push statement string on 0002DC 1 48 pha ; the system stack 0002DD 1 D0 F8 bne cntln 0002DF 1 C0 04 cpy #4 ; if empty line then skip the 0002E1 1 90 43 bcc jstart ; insertion process 0002E3 1 AA tax ; x = 0 0002E4 1 98 tya 0002E5 1 18 clc 0002E6 1 65 8C adc ampr ; calculate new program end 0002E8 1 85 BC sta gthan ; {>} = {&} + y 0002EA 1 8A txa 0002EB 1 65 8D adc ampr+1 0002ED 1 85 BD sta gthan+1 0002EF 1 A5 BC lda gthan 0002F1 1 C5 94 cmp star ; if {>} >= {*} then the program 0002F3 1 A5 BD lda gthan+1 ; won't fit in available RAM, 0002F5 1 E5 95 sbc star+1 ; so drop the stack and abort 0002F7 1 B0 2D bcs jstart ; to the "OK" prompt 0002F9 1 slide: 0002F9 1 A5 8C lda ampr 0002FB 1 D0 02 bne slide2 0002FD 1 C6 8D dec ampr+1 0002FF 1 slide2: 0002FF 1 C6 8C dec ampr 000301 1 A5 8C lda ampr 000303 1 C5 C0 cmp at 000305 1 A5 8D lda ampr+1 000307 1 E5 C1 sbc at+1 000309 1 90 06 bcc move ; slide open a gap inside the 00030B 1 A1 8C lda (ampr,x) ; program just big enough to 00030D 1 91 8C sta (ampr),y ; hold the new line 00030F 1 B0 E8 bcs slide ; (always taken) 000311 1 move: 000311 1 98 tya 000312 1 AA tax ; x = new line length 000313 1 move2: 000313 1 68 pla ; pull the statement string and 000314 1 88 dey ; the new line number and store 000315 1 91 C0 sta (at),y ; them in the program gap 000317 1 D0 FA bne move2 000319 1 A0 02 ldy #2 00031B 1 8A txa 00031C 1 91 C0 sta (at),y ; store length after line number 00031E 1 A5 BC lda gthan 000320 1 85 8C sta ampr ; {&} = {>} 000322 1 A5 BD lda gthan+1 000324 1 85 8D sta ampr+1 000326 1 jstart: 000326 1 4C 2A 02 jmp start ; drop stack, restart cmd prompt 000329 1 ;-----------------------------------------------------; 000329 1 ; Point @[y] to the first/next program line >= {#} 000329 1 ; entry: (cc): start search at beginning of program 000329 1 ; (cs): start search at next line 000329 1 ; ({@} -> beginning of current line) 000329 1 ; used by: list_:, progr: 000329 1 ; uses: find:, jstart:, prgm, {@ # & (} 000329 1 ; exit: if line not found then abort to "OK" prompt 000329 1 ; else {@} -> found line, x:a = {#} = {(} = 000329 1 ; actual line number, y = 2, (cc) 000329 1 ; 10 bytes 000329 1 findln: 000329 1 20 9D 05 jsr find ; find first/next line >= {#} 00032C 1 B0 F8 bcs jstart ; if end then restart "OK" prompt 00032E 1 85 86 sta pound ; {#} = {(} 000330 1 86 87 stx pound+1 000332 1 60 rts 000333 1 ;-----------------------------------------------------; 000333 1 ; {?="...} handler; called from exec: 000333 1 ; List line handler; called from list_: 000333 1 ; 2 bytes 000333 1 prstr: 000333 1 C8 iny ; skip over the " or length byte 000334 1 AA tax ; x = delimiter, fall through 000335 1 ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; 000335 1 ; Print a string at @[y] 000335 1 ; x holds the delimiter char, which is skipped over, 000335 1 ; not printed (a null byte is always a delimiter) 000335 1 ; If a key was pressed, it pauses for another keypress 000335 1 ; before returning. If either of those keys was a 000335 1 ; ctrl-C, it drops the stack and restarts the "OK" 000335 1 ; prompt with the user program intact 000335 1 ; entry: @[y] -> string, x = delimiter char 000335 1 ; uses: inch:, inkey:, jstart:, outch:, execrts: 000335 1 ; exit: (normal) @[y] -> null or byte after delimiter 000335 1 ; (ctrl-C) drop the stack & restart "OK" prompt 000335 1 ; 39 bytes 000335 1 prmsg: 000335 1 8A txa 000336 1 D1 C0 cmp (at),y ; found delimiter or null? 000338 1 F0 0A beq prmsg2 ; yes: finish up 00033A 1 B1 C0 lda (at),y 00033C 1 F0 06 beq prmsg2 00033E 1 20 F9 05 jsr outch ; no: print char to terminal 000341 1 C8 iny ; and loop (with safety escape) 000342 1 10 F1 bpl prmsg 000344 1 prmsg2: 000344 1 AA tax ; save closing delimiter 000345 1 20 E5 05 jsr inkey ; any key = pause? 000348 1 ; [Gigatron] inkey handles the second key already 000348 1 ;beq prout ; no: proceed 000348 1 ;jsr inch ; yes: wait for another key 000348 1 prout: 000348 1 8A txa ; retrieve closing delimiter 000349 1 F0 07 beq outnl ; always \n after null delimiter 00034B 1 20 DB 05 jsr skpbyte ; skip over the delimiter 00034E 1 C9 3B cmp #';' ; if trailing char is ';' then 000350 1 F0 4F beq execrts ; suppress the \n 000352 1 outnl: 000352 1 A9 0D lda #$0d ; \n to terminal 000354 1 joutch: 000354 1 4C F9 05 jmp outch 000357 1 ;-----------------------------------------------------; 000357 1 ; Execute a (hopefully) valid VTL02C statement at @[y] 000357 1 ; entry: @[y] -> left-side of statement 000357 1 ; uses: nearly everything 000357 1 ; exit: note to machine language subroutine {>=...} 000357 1 ; users: no registers or variables are 000357 1 ; required to be preserved except the system 000357 1 ; stack pointer, the text base pointer {@}, 000357 1 ; and the original line number {(} 000357 1 ; if there is a {"} directly after the assignment 000357 1 ; operator, the statement will execute as {?="...}, 000357 1 ; regardless of the variable named on the left side 000357 1 ; 84 bytes 000357 1 exec: 000357 1 20 DC 05 jsr getbyte ; fetch left-side variable name 00035A 1 F0 45 beq execrts ; do nothing with a null statement 00035C 1 C9 29 cmp #')' ; same for a full-line comment 00035E 1 F0 41 beq execrts 000360 1 C8 iny 000361 1 A2 A0 ldx #arg ; initialize argument pointer 000363 1 20 4A 04 jsr convp ; arg[{0}] -> left-side variable 000366 1 20 DC 05 jsr getbyte ; skip over assignment operator 000369 1 20 DB 05 jsr skpbyte ; is right-side a literal string? 00036C 1 C9 22 cmp #'"' ; yes: print the string with 00036E 1 F0 C3 beq prstr ; trailing ';' check & return 000370 1 A2 A2 ldx #arg+2 ; point eval to arg[{1}] 000372 1 20 D8 03 jsr eval ; evaluate right-side in arg[{1}] 000375 1 A5 A2 lda arg+2 000377 1 A0 00 ldy #0 000379 1 A6 A1 ldx arg+1 ; was left-side an array element? 00037B 1 D0 12 bne exec3 ; yes: skip to default actions 00037D 1 A6 A0 ldx arg 00037F 1 E0 C0 cpx #at ; if {@=...} statement then poke 000381 1 F0 25 beq poke ; low half of arg[{1}] to ({<}) 000383 1 E0 88 cpx #dolr ; if {$=...} statement then print 000385 1 F0 CD beq joutch ; arg[{1}] as ASCII character 000387 1 E0 BE cpx #ques ; if {?=...} statement then print 000389 1 F0 20 beq prnum0 ; arg[{1}] as unsigned decimal 00038B 1 E0 BC cpx #gthan ; if {>=...} statement then call 00038D 1 F0 13 beq usr ; user-defined ml routine 00038F 1 exec3: 00038F 1 91 A0 sta (arg),y 000391 1 65 8F adc tick+1 ; store arg[{1}] in the left-side 000393 1 2A rol ; variable 000394 1 AA tax 000395 1 C8 iny 000396 1 A5 A3 lda arg+3 000398 1 91 A0 sta (arg),y 00039A 1 65 8E adc tick ; pseudo-randomize {'} 00039C 1 2A rol 00039D 1 85 8F sta tick+1 00039F 1 86 8E stx tick 0003A1 1 execrts: 0003A1 1 60 rts 0003A2 1 usr: 0003A2 1 AA tax ; jump to user ml routine with 0003A3 1 A5 A3 lda arg+3 ; arg[{1}] in a:x (MSB:LSB) 0003A5 1 6C 84 00 jmp (quote) ; {"} must point to valid 6502 code 0003A8 1 poke: 0003A8 1 91 B8 sta (lthan),y 0003AA 1 60 rts 0003AB 1 ;-----------------------------------------------------; 0003AB 1 ; {?=...} handler; called by exec: 0003AB 1 ; 2 bytes 0003AB 1 prnum0: 0003AB 1 A2 A2 ldx #arg+2 ; x -> arg[{1}], fall through 0003AD 1 ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; 0003AD 1 ; Print an unsigned decimal number (0..65535) in var[x] 0003AD 1 ; entry: var[x] = number to print 0003AD 1 ; uses: div:, outch:, var[x+2], saves original {%} 0003AD 1 ; exit: var[x] = 0, var[x+2] = 10 0003AD 1 ; 43 bytes 0003AD 1 prnum: 0003AD 1 A5 8A lda remn 0003AF 1 48 pha ; save {%} 0003B0 1 A5 8B lda remn+1 0003B2 1 48 pha 0003B3 1 A9 00 lda #0 ; null delimiter for print 0003B5 1 48 pha 0003B6 1 95 03 sta 3,x 0003B8 1 A9 0A lda #10 ; divisor = 10 0003BA 1 95 02 sta 2,x ; repeat { 0003BC 1 prnum2: 0003BC 1 20 1D 05 jsr div ; divide var[x] by 10 0003BF 1 A5 8A lda remn 0003C1 1 09 30 ora #'0' ; convert remainder to ASCII 0003C3 1 48 pha ; stack digits in ascending 0003C4 1 B5 00 lda 0,x ; order ('0' for zero) 0003C6 1 15 01 ora 1,x 0003C8 1 D0 F2 bne prnum2 ; } until var[x] is 0 0003CA 1 68 pla 0003CB 1 prnum3: 0003CB 1 20 F9 05 jsr outch ; print digits in descending 0003CE 1 68 pla ; order until delimiter is 0003CF 1 D0 FA bne prnum3 ; encountered 0003D1 1 68 pla 0003D2 1 85 8B sta remn+1 ; restore {%} 0003D4 1 68 pla 0003D5 1 85 8A sta remn 0003D7 1 60 rts 0003D8 1 ;-----------------------------------------------------; 0003D8 1 ; Evaluate a (hopefully) valid VTL02C expression at 0003D8 1 ; @[y] and place its calculated value in arg[x] 0003D8 1 ; A VTL02C expression is defined as a string of one or 0003D8 1 ; more terms, separated by operators and terminated 0003D8 1 ; with a null or an unmatched right parenthesis 0003D8 1 ; A term is defined as a variable name, a decimal 0003D8 1 ; constant, or a parenthesized sub-expression; terms 0003D8 1 ; are evaluated strictly from left to right 0003D8 1 ; A variable name is defined as a user variable, an 0003D8 1 ; array element expression enclosed in {: )}, or a 0003D8 1 ; system variable (which may have side-effects) 0003D8 1 ; entry: @[y] -> expression text, x -> argument 0003D8 1 ; uses: getval:, oper:, {@}, argument stack area 0003D8 1 ; exit: arg[x] = result, @[y] -> next text 0003D8 1 ; 31 bytes 0003D8 1 eval: 0003D8 1 A9 00 lda #0 0003DA 1 95 00 sta 0,x ; start evaluation by simulating 0003DC 1 95 01 sta 1,x ; {0+expression} 0003DE 1 A9 2B lda #'+' 0003E0 1 notdn: 0003E0 1 48 pha ; stack alleged operator 0003E1 1 E8 inx ; advance the argument stack 0003E2 1 E8 inx ; pointer 0003E3 1 20 F7 03 jsr getval ; arg[x+2] = value of next term 0003E6 1 CA dex 0003E7 1 CA dex 0003E8 1 68 pla ; retrieve and apply the operator 0003E9 1 20 9A 04 jsr oper ; to arg[x], arg[x+2] 0003EC 1 20 DC 05 jsr getbyte ; end of expression? 0003EF 1 F0 05 beq evalrts ; (null or right parenthesis) 0003F1 1 C8 iny 0003F2 1 C9 29 cmp #')' ; no: skip over the operator 0003F4 1 D0 EA bne notdn ; and continue the evaluation 0003F6 1 evalrts: 0003F6 1 60 rts ; yes: return with final result 0003F7 1 ;-----------------------------------------------------; 0003F7 1 ; Get numeric value of the term at @[y] into var[x] 0003F7 1 ; Some examples of valid terms: 123, $, H, (15-:J)/?) 0003F7 1 ; 83 bytes 0003F7 1 getval: 0003F7 1 20 48 05 jsr cvbin ; decimal number at @[y]? 0003FA 1 D0 4D bne getrts ; yes: return with it in var[x] 0003FC 1 20 DC 05 jsr getbyte 0003FF 1 C8 iny 000400 1 C9 3F cmp #'?' ; user line input? 000402 1 D0 17 bne getval2 000404 1 98 tya ; yes: 000405 1 48 pha 000406 1 A5 C0 lda at ; save @[y] 000408 1 48 pha ; (current expression ptr) 000409 1 A5 C1 lda at+1 00040B 1 48 pha 00040C 1 20 7D 05 jsr inln ; input expression from user 00040F 1 20 D8 03 jsr eval ; evaluate, var[x] = result 000412 1 68 pla 000413 1 85 C1 sta at+1 000415 1 68 pla 000416 1 85 C0 sta at ; restore @[y] 000418 1 68 pla 000419 1 A8 tay 00041A 1 60 rts ; skip over "?" and return 00041B 1 getval2: 00041B 1 C9 24 cmp #'$' ; user char input? 00041D 1 D0 05 bne getval2a 00041F 1 20 EB 05 jsr inch ; yes: input one char 000422 1 B0 23 bcs getval5 ; (always taken) 000424 1 getval2a: 000424 1 C9 40 cmp #'@' ; memory access? 000426 1 D0 0A bne getval3 000428 1 84 88 sty dolr ; yes: 00042A 1 A0 00 ldy #0 00042C 1 B1 B8 lda (lthan),y ; access memory byte at ({<}) 00042E 1 A4 88 ldy dolr 000430 1 D0 15 bne getval5 ; (always taken) 000432 1 getval3: 000432 1 C9 28 cmp #'(' ; sub-expression? 000434 1 F0 A2 beq eval ; yes: evaluate it recursively 000436 1 20 4A 04 jsr convp ; no: first set var[x] to the 000439 1 A1 00 lda (0,x) ; named variable's address, 00043B 1 48 pha ; then replace that address 00043C 1 F6 00 inc 0,x ; with the variable's actual 00043E 1 D0 02 bne getval4 ; value before returning 000440 1 F6 01 inc 1,x 000442 1 getval4: 000442 1 A1 00 lda (0,x) 000444 1 95 01 sta 1,x ; store high-byte of term value 000446 1 68 pla 000447 1 getval5: 000447 1 95 00 sta 0,x ; store low-byte of term value 000449 1 getrts: 000449 1 60 rts 00044A 1 ;-----------------------------------------------------; 00044A 1 ; Set var[x] to the address of the variable named in a 00044A 1 ; entry: a holds variable name, @[y] -> text holding 00044A 1 ; array index expression (if a = ':') 00044A 1 ; uses: plus, eval, oper8d, {@ &} 00044A 1 ; exit: (eq): var[x] -> variable, @[y] unchanged 00044A 1 ; (ne): var[x] -> array element, 00044A 1 ; @[y] -> following text 00044A 1 ; 26 bytes 00044A 1 convp: 00044A 1 C9 3A cmp #':' ; array element? 00044C 1 D0 11 bne simple ; no: var[x] -> simple variable 00044E 1 20 D8 03 jsr eval ; yes: evaluate array index at 000451 1 16 00 asl 0,x ; @[y] and advance y 000453 1 36 01 rol 1,x 000455 1 A5 8C lda ampr ; var[x] -> array element 000457 1 95 02 sta 2,x ; at address 2*index+& 000459 1 A5 8D lda ampr+1 00045B 1 95 03 sta 3,x 00045D 1 D0 2D bne plus ; (always taken) 00045F 1 ; The following section is designed to translate the 00045F 1 ; named simple variable from its ASCII value to its 00045F 1 ; zero-page address. In this case, 'A' translates 00045F 1 ; to $82, '!' translates to $c2, etc. The method 00045F 1 ; employed must correspond to the zero-page equates 00045F 1 ; above, or strange and not-so-wonderful bugs will 00045F 1 ; befall the weary traveller on his or her porting 00045F 1 ; journey. 00045F 1 simple: 00045F 1 0A asl ; form simple variable address 000460 1 ;ora #$80 ; mapping function is (a*2)|128 000460 1 ;bmi oper8d ; (always taken) 000460 1 69 40 adc #$40 ; [Gigatron] sp..'_' -> $80..$fe 000462 1 D0 72 bne oper8d ; [Gigatron] (always taken) 000464 1 000464 1 ;-----------------------------------------------------; 000464 1 ; 16-bit unsigned multiply routine: var[x] *= var[x+2] 000464 1 ; exit: overflow is ignored/discarded, var[x+2] and 000464 1 ; {>} are modified, a = 0 000464 1 ; 40 bytes 000464 1 mul: 000464 1 B5 00 lda 0,x 000466 1 85 BC sta gthan 000468 1 B5 01 lda 1,x ; {>} = var[x] 00046A 1 85 BD sta gthan+1 00046C 1 A9 00 lda #0 00046E 1 95 00 sta 0,x ; var[x] = 0 000470 1 95 01 sta 1,x 000472 1 mul2: 000472 1 A5 BC lda gthan 000474 1 05 BD ora gthan+1 000476 1 F0 13 beq mulrts ; exit early if {>} = 0 000478 1 46 BD lsr gthan+1 00047A 1 66 BC ror gthan ; {>} /= 2 00047C 1 90 03 bcc mul3 00047E 1 20 8C 04 jsr plus ; form the product in var[x] 000481 1 mul3: 000481 1 16 02 asl 2,x 000483 1 36 03 rol 3,x ; left-shift var[x+2] 000485 1 B5 02 lda 2,x 000487 1 15 03 ora 3,x ; loop until var[x+2] = 0 000489 1 D0 E7 bne mul2 00048B 1 mulrts: 00048B 1 60 rts 00048C 1 ;-----------------------------------------------------; 00048C 1 ; var[x] += var[x+2] 00048C 1 ; 14 bytes 00048C 1 plus: 00048C 1 18 clc 00048D 1 B5 00 lda 0,x 00048F 1 75 02 adc 2,x 000491 1 95 00 sta 0,x 000493 1 B5 01 lda 1,x 000495 1 75 03 adc 3,x 000497 1 95 01 sta 1,x 000499 1 60 rts 00049A 1 ;-----------------------------------------------------; 00049A 1 ; Apply the binary operator in a to var[x] and var[x+2] 00049A 1 ; Valid VTL02C operators are {* + / [ ] - | ^ & < = >} 00049A 1 ; {>} is defined as greater than _or_equal_ 00049A 1 ; An undefined operator will be interpreted as one of 00049A 1 ; the three comparison operators 00049A 1 ; 37 bytes 00049A 1 oper: 00049A 1 C9 2B cmp #'+' ; addition operator? 00049C 1 F0 EE beq plus 00049E 1 C9 2A cmp #'*' ; multiplication operator? 0004A0 1 F0 C2 beq mul 0004A2 1 C9 2F cmp #'/' ; division operator? 0004A4 1 F0 77 beq div 0004A6 1 C9 5B cmp #'[' ; "then" operator? 0004A8 1 F0 32 beq then_ 0004AA 1 C9 5D cmp #']' ; "else" operator? 0004AC 1 F0 3C beq else_ 0004AE 1 CA dex ; (factored from the following ops) 0004AF 1 C9 2D cmp #'-' ; subtraction operator? 0004B1 1 F0 41 beq minus 0004B3 1 C9 21 cmp #OP_OR ; bit-wise or operator? 0004B5 1 F0 52 beq or_ 0004B7 1 C9 5E cmp #'^' ; bit-wise xor operator? 0004B9 1 F0 58 beq xor_ 0004BB 1 C9 26 cmp #'&' ; bit-wise and operator? 0004BD 1 F0 40 beq and_ 0004BF 1 ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; 0004BF 1 ; Apply comparison operator in a to var[x] and var[x+2] 0004BF 1 ; and place result in var[x] (1: true, 0: false) 0004BF 1 ; expects: (cs), pre-decremented x 0004BF 1 ; 29 bytes 0004BF 1 49 3C eor #'<' ; 0: '<' 1: '=' 2: '>' 0004C1 1 85 BC sta gthan ; other values in a are undefined, 0004C3 1 20 F4 04 jsr minus ; but _will_ produce some result 0004C6 1 C6 BC dec gthan ; var[x] -= var[x+2] 0004C8 1 D0 05 bne oper8b ; equality test? 0004CA 1 15 00 ora 0,x ; yes: 'or' high and low bytes 0004CC 1 F0 04 beq oper8c ; (cs) if 0 0004CE 1 18 clc ; (cc) if not 0 0004CF 1 oper8b: 0004CF 1 A5 BC lda gthan 0004D1 1 2A rol 0004D2 1 oper8c: 0004D2 1 69 00 adc #0 0004D4 1 29 01 and #1 ; var[x] = 1 (true), 0 (false) 0004D6 1 oper8d: 0004D6 1 95 00 sta 0,x 0004D8 1 A9 00 lda #0 0004DA 1 F0 20 beq minus3 ; (always taken) 0004DC 1 ;-----------------------------------------------------; 0004DC 1 ; expects: (cs) 0004DC 1 ; 14 bytes 0004DC 1 then_: 0004DC 1 B5 00 lda 0,x 0004DE 1 15 01 ora 1,x 0004E0 1 F0 1C beq minus4 0004E2 1 B5 02 lda 2,x 0004E4 1 95 00 sta 0,x 0004E6 1 B5 03 lda 3,x 0004E8 1 B0 12 bcs minus3 ; (always taken) 0004EA 1 ;-----------------------------------------------------; 0004EA 1 ; expects: (cs) 0004EA 1 ; 10 bytes 0004EA 1 else_: 0004EA 1 B5 00 lda 0,x 0004EC 1 15 01 ora 1,x 0004EE 1 F0 9C beq plus 0004F0 1 A9 00 lda #0 0004F2 1 F0 E2 beq oper8d ; (always taken) 0004F4 1 ;-----------------------------------------------------; 0004F4 1 ; var[x] -= var[x+2] 0004F4 1 ; expects: (cs), pre-decremented x 0004F4 1 ; 11 bytes 0004F4 1 minus: 0004F4 1 20 F8 04 jsr minus2 0004F7 1 E8 inx 0004F8 1 minus2: 0004F8 1 B5 01 lda 1,x 0004FA 1 F5 03 sbc 3,x 0004FC 1 minus3: 0004FC 1 95 01 sta 1,x 0004FE 1 minus4: 0004FE 1 60 rts 0004FF 1 ;-----------------------------------------------------; 0004FF 1 ; var[x] &= var[x+2] 0004FF 1 ; expects: (cs), pre-decremented x 0004FF 1 ; 10 bytes 0004FF 1 and_: 0004FF 1 20 03 05 jsr and_2 000502 1 E8 inx 000503 1 and_2: 000503 1 B5 01 lda 1,x 000505 1 35 03 and 3,x 000507 1 B0 F3 bcs minus3 ; (always taken) 000509 1 ;-----------------------------------------------------; 000509 1 ; var[x] |= var[x+2] 000509 1 ; expects: (cs), pre-decremented x 000509 1 ; 10 bytes 000509 1 or_: 000509 1 20 0D 05 jsr or_2 00050C 1 E8 inx 00050D 1 or_2: 00050D 1 B5 01 lda 1,x 00050F 1 15 03 ora 3,x 000511 1 B0 E9 bcs minus3 ; (always taken) 000513 1 ;-----------------------------------------------------; 000513 1 ; var[x] ^= var[x+2] 000513 1 ; expects: (cs), pre-decremented x 000513 1 ; 10 bytes 000513 1 xor_: 000513 1 20 17 05 jsr xor_2 000516 1 E8 inx 000517 1 xor_2: 000517 1 B5 01 lda 1,x 000519 1 55 03 eor 3,x 00051B 1 B0 DF bcs minus3 ; (always taken) 00051D 1 ;-----------------------------------------------------; 00051D 1 ; 16-bit unsigned division routine 00051D 1 ; var[x] /= var[x+2], {%} = remainder, {>} modified 00051D 1 ; var[x] /= 0 produces {%} = var[x], var[x] = 65535 00051D 1 ; 43 bytes 00051D 1 div: 00051D 1 A9 00 lda #0 00051F 1 85 8A sta remn ; {%} = 0 000521 1 85 8B sta remn+1 000523 1 A9 10 lda #16 000525 1 85 BC sta gthan ; {>} = loop counter 000527 1 div1: 000527 1 16 00 asl 0,x ; var[x] is gradually replaced 000529 1 36 01 rol 1,x ; with the quotient 00052B 1 26 8A rol remn ; {%} is gradually replaced 00052D 1 26 8B rol remn+1 ; with the remainder 00052F 1 A5 8A lda remn 000531 1 D5 02 cmp 2,x 000533 1 A5 8B lda remn+1 ; partial remainder >= var[x+2]? 000535 1 F5 03 sbc 3,x 000537 1 90 0A bcc div2 000539 1 85 8B sta remn+1 ; yes: update the partial 00053B 1 A5 8A lda remn ; remainder and set the 00053D 1 F5 02 sbc 2,x ; low bit in the partial 00053F 1 85 8A sta remn ; quotient 000541 1 F6 00 inc 0,x 000543 1 div2: 000543 1 C6 BC dec gthan 000545 1 D0 E0 bne div1 ; loop 16 times 000547 1 60 rts 000548 1 ;-----------------------------------------------------; 000548 1 ; If text at @[y] is a decimal constant, translate it 000548 1 ; into var[x] (discarding any overflow) and update y 000548 1 ; entry: @[y] -> text containing possible constant; 000548 1 ; leading space characters are skipped, but 000548 1 ; any spaces encountered after a conversion 000548 1 ; has begun will end the conversion. 000548 1 ; used by: user:, getval: 000548 1 ; uses: mul:, plus:, var[x], var[x+2], {@ > ?} 000548 1 ; exit: (ne): var[x] = constant, @[y] -> next text 000548 1 ; (eq): var[x] = 0, @[y] unchanged 000548 1 ; (cs): in all but the truly strangest cases 000548 1 ; 43 bytes 000548 1 cvbin: 000548 1 A9 00 lda #0 00054A 1 95 00 sta 0,x ; var[x] = 0 00054C 1 95 01 sta 1,x 00054E 1 95 03 sta 3,x 000550 1 20 DC 05 jsr getbyte ; skip any leading spaces 000553 1 84 BE sty ques ; save pointer 000555 1 cvbin2: 000555 1 B1 C0 lda (at),y ; grab a char 000557 1 49 30 eor #'0' ; if char at @[y] is not a 000559 1 C9 0A cmp #10 ; decimal digit then stop 00055B 1 B0 13 bcs cvbin3 ; the conversion 00055D 1 48 pha ; save decimal digit 00055E 1 A9 0A lda #10 000560 1 95 02 sta 2,x 000562 1 20 64 04 jsr mul ; var[x] *= 10 000565 1 95 03 sta 3,x 000567 1 68 pla ; retrieve decimal digit 000568 1 95 02 sta 2,x 00056A 1 20 8C 04 jsr plus ; var[x] += digit 00056D 1 C8 iny ; loop for more digits 00056E 1 10 E5 bpl cvbin2 ; (with safety escape) 000570 1 cvbin3: 000570 1 C4 BE cpy ques ; (ne) if valid, (eq) if not 000572 1 60 rts 000573 1 ;-----------------------------------------------------; 000573 1 ; Accept input line from user and store it in linbuf, 000573 1 ; zero-terminated (allows very primitive edit/cancel) 000573 1 ; entry: (jsr to inln or newln, not inln6) 000573 1 ; used by: user:, getval: 000573 1 ; uses: inch:, outnl:, linbuf, {@} 000573 1 ; exit: @[y] -> linbuf 000573 1 ; 42 bytes 000573 1 inln6: 000573 1 C9 1B cmp #ESC ; escape? 000575 1 F0 03 beq newln ; yes: discard entire line 000577 1 C8 iny ; line limit exceeded? 000578 1 10 10 bpl inln2 ; no: keep going 00057A 1 newln: 00057A 1 20 52 03 jsr outnl ; yes: discard entire line 00057D 1 inln: 00057D 1 A0 00 ldy # input line buffer 000581 1 A0 02 ldy #>linbuf 000583 1 84 C1 sty at+1 000585 1 A0 01 ldy #1 000587 1 inln5: 000587 1 88 dey 000588 1 30 F0 bmi newln 00058A 1 inln2: 00058A 1 20 EB 05 jsr inch ; get (and echo) one key press 00058D 1 C9 5F cmp #BS ; backspace? 00058F 1 F0 F6 beq inln5 ; yes: delete previous char 000591 1 C9 0D cmp #$0d ; cr? 000593 1 D0 02 bne inln3 000595 1 A9 00 lda #0 ; yes: replace with null 000597 1 inln3: 000597 1 91 C0 sta (at),y ; put key in linbuf 000599 1 D0 D8 bne inln6 ; continue if not null 00059B 1 A8 tay ; y = 0 00059C 1 60 rts 00059D 1 ;-----------------------------------------------------; 00059D 1 ; Find the first/next stored program line >= {#} 00059D 1 ; entry: (cc): start search at program beginning 00059D 1 ; (cs): start search at next line 00059D 1 ; ({@} -> beginning of current line) 00059D 1 ; used by: skp2:, findln: 00059D 1 ; uses: prgm, {@ # & (} 00059D 1 ; exit: (cs): {@}, x:a and {(} undefined, y = 2 00059D 1 ; (cc): {@} -> beginning of found line, y = 2, 00059D 1 ; x:a = {(} = actual found line number 00059D 1 ; 62 bytes 00059D 1 find: 00059D 1 A2 07 ldx #>prgm 00059F 1 A9 00 lda #= {&} (end of program)? 0005AF 1 B0 29 bcs findrts ; yes: search failed (cs) 0005B1 1 find3: 0005B1 1 A5 C0 lda at 0005B3 1 71 C0 adc (at),y ; no: {@} -> next line 0005B5 1 90 03 bcc find5 0005B7 1 E8 inx 0005B8 1 find1st: 0005B8 1 86 C1 stx at+1 0005BA 1 find5: 0005BA 1 85 C0 sta at 0005BC 1 A0 00 ldy #0 0005BE 1 B1 C0 lda (at),y 0005C0 1 85 90 sta lparen ; {(} = current line number 0005C2 1 C5 86 cmp pound ; (invalid if {@} >= {&}, but 0005C4 1 C8 iny ; we'll catch that later...) 0005C5 1 B1 C0 lda (at),y 0005C7 1 85 91 sta lparen+1 0005C9 1 E5 87 sbc pound+1 ; if {(} < {#} then try the next 0005CB 1 C8 iny ; program line 0005CC 1 90 D9 bcc findnxt 0005CE 1 A5 C0 lda at ; {@} >= {&} (end of program)? 0005D0 1 C5 8C cmp ampr ; yes: search failed (cs) 0005D2 1 A5 C1 lda at+1 ; no: search succeeded (cc) 0005D4 1 E5 8D sbc ampr+1 0005D6 1 A5 90 lda lparen 0005D8 1 A6 91 ldx lparen+1 0005DA 1 findrts: 0005DA 1 60 rts 0005DB 1 ;-----------------------------------------------------; 0005DB 1 ; Fetch a byte at @[y], ignoring space characters 0005DB 1 ; 10 bytes 0005DB 1 skpbyte: 0005DB 1 C8 iny ; skip over current char 0005DC 1 getbyte: 0005DC 1 B1 C0 lda (at),y 0005DE 1 F0 04 beq getbyt2 0005E0 1 C9 20 cmp #' ' 0005E2 1 F0 F7 beq skpbyte ; skip over any space char(s) 0005E4 1 getbyt2: 0005E4 1 60 rts 0005E5 1 ;-----------------------------------------------------; 0005E5 1 ; Check for user keypress and return with (cc) if none 0005E5 1 ; is pending. Otherwise, fall through to inch 0005E5 1 ; and return with (cs). 0005E5 1 ; 6 bytes 0005E5 1 inkey: 0005E5 1 ;lda KBD ; is there a keypress waiting? 0005E5 1 ;asl 0005E5 1 ;bcc outrts ; no: return with (cc) 0005E5 1 A5 0F lda serialRaw ; [Gigatron] is there a keypress? 0005E7 1 C9 FF cmp #255 ; [Gigatron] 0005E9 1 F0 14 beq outrts ; [Gigatron] no: return with (eq) 0005EB 1 ; [Gigatron] fall into inch and wait for a *second* key 0005EB 1 ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; 0005EB 1 ; Read key from stdin into a, echo, (cs) 0005EB 1 ; drop stack and abort to "OK" prompt if ctrl-C 0005EB 1 ; 16 bytes 0005EB 1 inch: 0005EB 1 84 88 sty dolr ; save y reg 0005ED 1 ;jsr KEYIN ; get a char from keyboard 0005ED 1 A9 00 lda #0 ; [Gigatron] 0005EF 1 00 brk ; [Gigatron] get char from keyboard 0005F0 1 A4 88 ldy dolr ; restore y reg 0005F2 1 ;and #$7f ; strip apple's hi-bit 0005F2 1 C9 03 cmp #$03 ; ctrl-C? 0005F4 1 D0 03 bne outch ; no: echo to terminal 0005F6 1 4C 2A 02 jmp start ; yes: abort to "OK" prompt 0005F9 1 ; - - - - - - - - - - - - - - - - - - - - - - - - - - ; 0005F9 1 ; Print ASCII char in a to stdout, (cs) 0005F9 1 ; 9 bytes 0005F9 1 outch: 0005F9 1 48 pha ; save original char 0005FA 1 09 80 ora #$80 ; apples prefer "high" ASCII 0005FC 1 ;jsr COUT ; emit char via apple monitor 0005FC 1 00 brk ; [Gigatron] system call for output 0005FD 1 68 pla ; restore original char 0005FE 1 38 sec ; (by contract with callers) 0005FF 1 outrts: 0005FF 1 60 rts 000600 1 ;-----------------------------------------------------; 000600 1