1086 lines
61 KiB
Plaintext
1086 lines
61 KiB
Plaintext
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 #<prgm
|
|
00021B 1 85 8C sta ampr ; {&} -> empty program
|
|
00021D 1 A9 07 lda #>prgm
|
|
00021F 1 85 8D sta ampr+1
|
|
000221 1 A9 00 lda #<himem
|
|
000223 1 85 94 sta star ; {*} -> 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 #<nulstk
|
|
00022D 1 9A txs ; drop whatever is on the stack
|
|
00022E 1 90 10 bcc user ; skip "OK" if carry clear
|
|
000230 1 20 52 03 jsr outnl
|
|
000233 1 A9 4F lda #'O' ; output \nOK\n to terminal
|
|
000235 1 20 F9 05 jsr outch
|
|
000238 1 A9 4B lda #'K'
|
|
00023A 1 20 F9 05 jsr outch
|
|
00023D 1 20 52 03 jsr outnl
|
|
000240 1 user:
|
|
000240 1 20 7D 05 jsr inln ; input a line from the user
|
|
000243 1 A2 86 ldx #pound ; cvbin destination = {#}
|
|
000245 1 20 48 05 jsr cvbin ; does line start with a number?
|
|
000248 1 F0 39 beq direct ; no: execute direct statement
|
|
00024A 1 ; - - - - - - - - - - - - - - - - - - - - - - - - - - ;
|
|
00024A 1 ; Delete/insert/replace program line or list program
|
|
00024A 1 ; 7 bytes
|
|
00024A 1 stmnt:
|
|
00024A 1 18 clc
|
|
00024B 1 A5 86 lda pound
|
|
00024D 1 05 87 ora pound+1 ; {#} = 0?
|
|
00024F 1 D0 41 bne skp2 ; no: delete/insert/replace line
|
|
000251 1 ; - - - - - - - - - - - - - - - - - - - - - - - - - - ;
|
|
000251 1 ; List program to terminal and restart "OK" prompt
|
|
000251 1 ; entry: Carry must be clear
|
|
000251 1 ; uses: findln:, outch:, prnum:, prstr:, {@ ( )}
|
|
000251 1 ; exit: to command line via findln:
|
|
000251 1 ; 20 bytes
|
|
000251 1 list_:
|
|
000251 1 20 29 03 jsr findln ; find program line >= {#}
|
|
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 #<linbuf ; entry point: start a fresh line
|
|
00057F 1 84 C0 sty at ; {@} -> 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 #<prgm
|
|
0005A1 1 90 15 bcc find1st ; cc: search begins at first line
|
|
0005A3 1 A6 C1 ldx at+1
|
|
0005A5 1 A0 02 ldy #2
|
|
0005A7 1 findnxt:
|
|
0005A7 1 A5 C0 lda at
|
|
0005A9 1 C5 8C cmp ampr
|
|
0005AB 1 A5 C1 lda at+1
|
|
0005AD 1 E5 8D sbc ampr+1 ; {@} >= {&} (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
|