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