Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Cannot retrieve contributors at this time

919 lines (807 sloc) 21.095 kb
;; Copyright (c) 2012, Nick Meharry
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions are met:
;; * Redistributions of source code must retain the above copyright
;; notice, this list of conditions and the following disclaimer.
;; * 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.
;; * Neither the name of the <organization> nor the
;; names of its contributors may be used to endorse or promote products
;; derived from this software without specific prior written permission.
;;
;; 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 <COPYRIGHT HOLDER> 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.
define(`__VERSION__', `1')
include(`forth-macros.m4')
;; This file was created by following the jonesforth tutorial.
;; See jonesforth.S and .f at http://git.annexia.org/?p=jonesforth.git;a=tree
; Stack diagrams are read as follows:
; BEFORE AFTER
; ( bottom middle top -- bottom middle top )
set pc, _start
:DOCOL
PUSHRSP(i)
add z, 1 ; Move skip the DOCOL word
set i, z ; Save in i to prepare for `NEXT'
NEXT
:_start
jsr init_hardware
set [var_SZ], sp ; Save the current TOS as absolute TOS
set j, [var_RZ] ; Reset the return stack
set i, cold_start ; Initalize the interpreter
NEXT ; Run the interpreter!
:cold_start
dat QUIT
; Stack manipulation
DEFCODE(drop) ; Drop the top of stack
set y, pop ; ( a -- )
NEXT
DEFCODE(swap) ; Swap the top two elements of the stack
set a, y ; ( a b -- b a )
set y, pop
set push, a
NEXT
DEFCODE(dup) ; Duplicate the top of stack
set push, y ; ( a -- a a )
NEXT
DEFCODE(over) ; Duplicate the second to top element to the top of stack
set a, peek ; ( a b -- a b a )
set push, y
set y, a
NEXT
DEFCODE(rot) ; Move the third from top to the top
set a, pop ; ( a b c -- b c a )
set b, pop
set push, a
set push, y
set y, b
DEFCODE(`-rot',nrot) ; Moves the top of stack behind the next two
set a, pop ; ( a b c -- c a b )
set b, pop
set push, y
set push, b
set y, a
NEXT
DEFCODE(2drop,twodrop) ; Drop the top two items on the stack
add sp, 1 ; ( a b -- )
set y, pop
NEXT
DEFCODE(2swap,twoswap) ; Swap the top two pairs of elements
set c, pop ; ( a b c d -- c d a b )
set b, pop
set a, pop
set push, c
set push, y
set push, a
set y, b
NEXT
DEFCODE(`?dup',qdup) ; Duplicate the top of stack if it's not zero
ife y, 0
set push, y
NEXT
; Math operators
; By default, all operations are unsigned.
; Where the results differ, there should be a signed S-OP for every OP.
DEFCODE(`1+',incr) ; Increment top of stack
add y, 1
NEXT
DEFCODE(`1-',decr) ; Decrement top of stack
sub a, 1
NEXT
DEFCODE(`+',add) ; Addition
add y, pop
NEXT
DEFCODE(`-',sub) ; Subtraction
sub y, pop
NEXT
DEFCODE(`*',mul) ; Multiplication (ignoring overflow)
mul y, pop
NEXT
DEFCODE(`/',div) ; Division
div y, pop
NEXT
DEFCODE(`s-/',`s-div') ; Division (signed)
dvi y, pop
NEXT
DEFCODE(`%',mod) ; Modulus
mod y, pop
NEXT
DEFCODE(`s-%',`s-mod') ; Modulus (signed)
mdi y, pop
NEXT
define(`TRUE', `0xFFFF')dnl
define(`FALSE',`0x0000')dnl
; Comparisons
; These are all ( a b -- bool ).
; A bool is `TRUE' = TRUE, `FALSE' = FALSE.
; Like the math ops, default is unsigned.
DEFCODE(`=',equ) ; Equals
set a, FALSE
ife y, pop
set a, TRUE
set y, a
NEXT
DEFCODE(`<>',nequ) ; Not Equals
set a, FALSE
ifn y, pop
set a, TRUE
set y, a
NEXT
DEFCODE(`<',lt) ; Less Than
set a, FALSE
ifl y, pop
set a, TRUE
set y, a
NEXT
DEFCODE(`s-<',`s-lt') ; Less Than (signed)
set a, FALSE
ifu y, pop
set a, TRUE
set y, a
NEXT
DEFCODE(`>',gt) ; Greater Than
set a, FALSE
ifg y, pop
set a, TRUE
set y, a
NEXT
DEFCODE(`s->',`s-gt') ; Greater Than (signed)
set a, FALSE
ifa y, pop
set a, TRUE
set y, a
NEXT
DEFCODE(`<=',le) ; Less Than or Equal
set a, TRUE
set b, pop
ifg b, y
set a, FALSE
set y, a
NEXT
DEFCODE(`s-<=',`s-le') ; Less Than or Equal (signed)
set a, TRUE
set b, pop
ifa b, y
set a, FALSE
set y, a
NEXT
DEFCODE(`>=',ge) ; Greater Than or Equal
set a, TRUE
set b, pop
ifl b, y
set a, FALSE
set y, a
NEXT
DEFCODE(`s->=',`s-ge') ; Greater Than or Equal (signed)
set a, TRUE
set b, pop
ifu b, y
set a, FALSE
set y, a
NEXT
; Comparisons with zero
; These are all ( a -- bool )
DEFCODE(`0=',zequ) ; Is zero?
set a, FALSE
ife y, 0
set a, TRUE
set y, a
NEXT
DEFCODE(`0<>',znequ) ; Is not zero?
set a, FALSE
ifn y, 0
set a, TRUE
set y, a
NEXT
DEFCODE(`0<',zlt) ; Less Than zero?
set y, FALSE ; Really only makes sense as signed.
NEXT
DEFCODE(`s-0<',`s-zlt') ; Less Than zero? (signed)
set a, FALSE
ifu y, 0
set a, TRUE
set y, a
NEXT
DEFCODE(`0>',zgt) ; Greater Than zero?
set y, TRUE ; Again, only makes sense as signed.
NEXT
DEFCODE(`s-0>',`s-zgt') ; Greater Than zero? (signed)
set a, FALSE
ifa y, 0
set a, TRUE
set y, a
NEXT
DEFCODE(`0<=',zle) ; Less Than or Equal to zero?
set a, FALSE
ife y, 0
set a, TRUE
set y, a
NEXT
DEFCODE(`s-0<=',`s-zle') ; Less Than or Equal to zero? (signed)
set a, TRUE
ifa y, 0
set a, FALSE
set y, a
NEXT
DEFCODE(`0>=',zge) ; Greater Than or Equal to zero?
set y, TRUE
NEXT
DEFCODE(`s-0>=',`s-zge') ; Greater Than or Equal to zero? (signed)
set a, TRUE
ifu y, 0
set a, FALSE
set y, a
NEXT
; Bitwise operators
DEFCODE(and) ; Binary and (&)
and y, pop ; ( a b -- c )
NEXT
DEFCODE(or) ; Binary or (|)
bor y, pop ; ( a b -- c )
NEXT
DEFCODE(xor) ; Binary xor (^)
xor y, pop ; ( a b -- c )
NEXT
DEFCODE(lshr) ; Logical shift right
shr y, pop ; ( a b -- c )
NEXT
DEFCODE(ashr) ; Arithmetic shift right
asr y, pop ; ( a b -- c )
NEXT
DEFCODE(lshl) ; Logical shift left
shl y, pop ; ( a b -- c )
NEXT
DEFCODE(ashl) ; Arithmetic shift left (same as logical shift left)
shl y, pop ; ( a b -- c )
NEXT
DEFCODE(invert) ; Invert all bits
xor y, TRUE ; ( a -- b )
NEXT
; Special words
DEFCODE(exit) ; This goes at the end of all Forth level words,
POPRSP(i) ; like `NEXT' is to assembly level words.
NEXT
DEFCODE(lit) ; Literal values
set push, [i] ; Remember that i contains the next instruction.
add i, 1 ; Push its value to the stack, and skip over it.
; Direct memory access
DEFCODE(`!',store)
set [y], pop
set y, pop
NEXT
DEFCODE(`@',fetch)
set y, [y]
NEXT
DEFCODE(`+!',addstore)
add [y], pop
set y, pop
NEXT
DEFCODE(`-!',substore)
sub [y], pop
set y, pop
NEXT
; Variables and constants
DEFVAR(state) ; Is the interpreter executing code (zero) or compiling a word (non-zero)
DEFVAR(latest) ; Pointer to the last defined word
DEFVAR(s0,sz,,SPTOP) ; Pointer to the top of the parameter stack
DEFVAR(r0,rz,,RSPTOP) ; Pointer to the top of the return stack
DEFVAR(base,,,10) ; The current base for reading and printing numbers (2=binary, 16=hex, etc)
DEFVAR(keyboard,,,0xFFFF) ; The identifier for the keyboard
DEFVAR(monitor,,,0xFFFF) ; The identifier for the monitor
DEFVAR(`monitor-base',,,0x8000) ; The base location for the monitor
DEFCONST(version,,,__VERSION__) ; The current version of this Forth
DEFCONST(docol,__docol,,DOCOL) ; Pointer to DOCOL
DEFCONST(f_immed,__f_immed,,F_IMMED) ; The IMMEDIATE flag's actual value
DEFCONST(f_hidden,__f_hidden,,F_HIDDEN) ; The HIDDEN flag's actual value
DEFCONST(f_lenmask,__f_lenmask,,F_LENMASK) ; The length mask in the flags/length word
; Return stack -- [j] is the top of the return stack
DEFCODE(`>r',tor) ; Add item to return stack
PUSHRSP(y) ; ( r -- )
set y, pop
NEXT
DEFCODE(`r>',fromr) ; Remove item from return stack
set push, y ; ( -- r )
POPRSP(y)
NEXT
DEFCODE(`rsp@',rspfetch) ; Copy top of return stack
set push, y ; ( -- r )
set y, [j]
NEXT
DEFCODE(`rsp!',rspstore) ; Overwrite top of return stack
set [j], y ; ( r -- )
set y, pop
NEXT
; Hardware
; There's a bit of a register sqeeze to deal with when querying for hardware.
; The HWQ instruction sets registers A, B, C, X, and Y.
; Register Y (top of stack) must be saved, and the other registers, Z, I, and J,
; are all in use by the Forth VM, meaning a lot of shuffling has to happen.
; Since hotplugging hardware is not defined on the DCPU, this isn't a callable word.
; Hardware info is stored similarly to the word dictionary, like so:
; ^
; +-----|-----+------------+-----------+-------------+------------+---------+------+
; | prev-link | hw-id-high | hw-id-low | man-id-high | man-id-low | version | slot |
; +-----------+------------+-----------+-------------+------------+---------+------+
;
; init_hardware sets up this dictionary and sets the assembly-level variable var_HW_LAST
; Forth words shouldn't touch this directly.
:var_HW_LAST
dat 0
:init_hardware
set push, j
set push, i
set push, z
set push, y ; All registers are clear to use
hwn i
:init_hardware_loop
set z, [var_HERE]
hwq i
set [z], [var_HW_LAST] ; Set pointer to previous
set [var_HW_LAST], z ; Mark current as previous
add z, 1
set [z], b ; Set hw-id-high
add z, 1
set [z], a ; Set hw-id-low
add z, 1
set [z], y ; Set man-id-high
add z, 1
set [z], x ; Set man-id-low
add z, 1
set [z], c ; Set version
add z, 1
set [z], i ; Set hardware slot for later queries
add z, 1
set [var_HERE], z ; Set new start of free zone
:init_hardware_try_kb
ifn b, 0x30CF
set pc, init_hardware_try_monitor
ifn a, 0x7406
set pc, init_hardware_try_monitor
ifn c, 1
set pc, init_hardware_try_monitor
set [var_KEYBOARD], i
set pc, init_hardware_loop_end
:init_hardware_try_monitor
ifn b, 0x7349
set pc, init_hardware_loop_end
ifn a, 0xF615
set pc, init_hardware_loop_end
ifn c, 0x1802
set pc, init_hardware_loop_end
set [var_MONITOR], i
:init_hardware_loop_end
sub i, 1
ifn i, 0
set pc, init_hardware_loop
:init_hardware_cleanup
set y, pop
set z, pop
set i, pop
set j, pop
set pc, pop ; Return
; Error messages
DEFCODE(panic) ; Dump a message to the screen
set a, pop ; and then crash, hanging forever :(
set b, pop ; ( address length -- *no-return* )
set x, [var_MONITOR_BASE] ; Register usage: a = lenth, b = address+a/2, x=MONITOR_BASE+a
add x, a ; c = current character (cleaned), i = odd flag
div a, 2
add b, a
set i, 0
ife [var_MONITOR], 0xFFFF ; All hope is lost, no video connected to show panic message
set pc, panic_message_crash
:panic_message_loop
ife a, 0 ; End of message
set pc, panic_message_crash
set c, [b] ; Currently, c is packed with two bytes
ife i, 0 ; If even, skip odd handling
set pc, panic_message_even
shr c, 8 ; Clear out the odd flag
:panic_message_even
and c, 0x7f
set [x], c ; Show the now cleaned character on screen
sub a, 1
sub x, 1
add b, 2
add [var_MONITOR_BASE], 1
xor i, 1 ; Toggle odd flag
set pc, panic_message_loop
:panic_message_crash
set pc, panic_message_crash
; Basic I/O
DEFCODE(key) ; Reads the next byte and pushes it to the stack
ife var_KEYBOARD, 0xFFFF ; Keyboard not found
set pc, key_crash_no_input ; Usually means hardware has not been scanned for, just crash :(
jsr key_input_loop
set push, y
set y, a
NEXT
:key_input
:key_input_loop
hwi [var_KEYBOARD] ; Read key input into register C
ife c, 0
set pc, key_input_loop ; Keep polling the keyboard until input
set a, c
set pc, pop
:key_crash_no_input
set push, key_crash_no_input_msg
set push, 27
set pc, code_PANIC
:key_crash_no_input_msg
PACKSTR(`ERROR: No keyboard detected')
DEFCODE(word) ; Read a single word of input
set push, y ; ( -- address length )
jsr word_main
set push, a
set y, b
NEXT
:word_main
jsr key_input ; Leaves character in A
ife a, 0x5c ; Backslash character, a line comment
set pc, word_skip_to_eol
ife a, 0x20 ; A space, keep looking for the start of a word
set pc, word_main
set b, word_buffer ; B will be the address,
set c, word_buffer ; and C the length.
sub c, 1
:word_copy_char
add c, 1
set [c], a
jsr key_input
ifn a, 0x20 ; If not a blank, keep recording letters
set pc, word_copy_char
set a, b
set b, c
set pc, pop
:word_skip_to_eol
jsr key_input ; Leaves character in A
ifn a, 0x11 ; If not a newline, keep looking
set pc, word_skip_to_eol
set pc, word_main
:word_buffer ; Two 16 word boundries
.BOUNDARY
.BOUNDARY
DEFCODE(number) ; atoi
set a, pop ; ( str-addr str-len -- n errors )
set b, y
jsr number
set push, a
set y, b
NEXT
:number ; A = address to string, B = length of string
set push, i
set push, j
set push, y
set push, z ; C, I, J, X, Y, and Z are safe to use
xor i, i ; I = loop index
xor x, x ; X = number parsed
xor y, y ; Y = errors
xor z, z ; Z = scratch
; C = current character
:number_mainloop
set z, b
sub z, i
sub z, 1
add z, a
set c, [z] ; c = string[length-i-1]
set z, [var_BASE]
add i, 1
ifg i, b
set pc, number_end
sub i, 1
ifg c, 0x60
set pc, number_lowercase
ifg c, 0x40
set pc, number_uppercase
ifg c, 0x2F
set pc, number_numeral
ife c, 0x2D
set pc, number_minus
set pc, number_error
:number_numeral
ifg c, 0x39
set pc, number_error
sub c, 0x30
add c, 1
ifg c, [var_BASE]
set pc, number_error
set pc, number_exp
:number_lowercase
ifg c, 0x7A
set pc, number_error
sub c, 0x61
add c, 1
ifg c, [var_BASE]
set pc, number_error
set pc, number_exp
:number_uppercase
ifg c, 0x5A
set pc, number_error
sub c, 0x41
add c, 1
ifg c, [var_BASE]
set pc, number_error
set pc, number_exp
:number_minus
sub b, 1
ifn i, b
set pc, number_minus_error
mul x, -1
sub y, 1 ; No need to jump, I think this is faster
:number_minus_error
add b, 1 ; Undo the damage caused a few lines above
:number_error
add y, 1
set pc, number_loop_end
:number_exp
sub c, 1
ife i, 0
set pc, number_good
set push, i
sub i, y
:number_exp_loop
ife i, 0
set pc, number_exp_loop_end
set j, [var_BASE]
ife i, 1
set j, 1
mul z, j
sub i, 1
set pc, number_exp_loop
:number_exp_loop_end
set i, pop
mul c, z
:number_good
add x, c
:number_loop_end
add i, 1
set pc, number_mainloop
:number_end ; A = number parsed, B = count of error chars
set a, x
set b, y
set z, pop
set y, pop
set j, pop
set i, pop
set pc, pop ; Return from subroutine
DEFCODE(emit) ; Writes a character to the screen
set a, [var_MONITOR_BASE] ; ( char -- )
add a, [_emit_monitor_offset]
ife [_emit_monitor_offset], 32*16 ; Writing past the end of the screen, scroll up
jsr monitor_scroll_line
set [a], y
set y, pop
NEXT
:_emit_monitor_offset
dat 0
:monitor_scroll_line
set push, a ; Copy all cells of video memory back 32 (0x20) words.
set push, b ; Save the context of the registers we'll be clobbering.
set push, c
set a, [var_MONITOR_BASE]
set b, 32*11 ; Don't run the loop on the last line, we clear that one specially
set c, a
add c, 32
:monitor_scroll_line_char_loop
set [a], [c] ; Copy the char 32 words ahead (directly below it)
sub b, 1
add a, 1
add c, 1
ifn b, 0
set pc, monitor_scroll_line_char_loop
:monitor_scroll_line_last
set b, 32
:monitor_scroll_line_last_loop
set [a], 0 ; Blank out the last line
sub b, 1
add a, 1
ifn b, 0
set pc, monitor_scroll_line_last_loop
:monitor_scroll_line_cleanup
sub [_emit_monitor_offset], 32
set c, pop ; Restore context
set b, pop
set a, pop
set pc, pop ; Come back from JSR
; Dictionary handling
DEFCODE(find) ; Find a word in the dictionary
set b, y ; ( str-addr str-len -- entry-addr )
set a, pop
jsr find
set y, a
NEXT
:find ; A = string address, B = string length
set push, y ; Returns address to entry in A
set c, [var_LATEST]
:find_loop
ife c, 0
set pc, find_end
set y, eval(F_HIDDEN | F_LENMASK) ; y = c->len & (`F_HIDDEN' | `F_LENMASK')
add c, 1
and y, [c]
sub c, 1
ifn y, b
set pc, find_badmatch
xor x, x
:find_inner_loop
ife x, b
set pc, find_end
set y, c
add y, 2 ; First char in current name
add y, x ; Move forward x chars
add a, x ; for both current and goal
set y, [y]
xor y, [a] ; Comparison
sub a, x ; Reset goal address
ifn y, 0
set pc, find_badmatch
add x, 1
set pc, find_inner_loop
:find_badmatch
set c, [c]
set pc, find_loop
:find_end
set y, pop
set a, c
set pc, pop
DEFCODE(`>cfa', `tcfa') ; Get pointer to code word of word at address
set a, y ; ( word-addr -- cf-addr )
jsr to_cfa
set y, a
NEXT
:to_cfa ; Takes a word address in A, returns the codefield in A
add a, 1 ; Skip the prev pointer
set b, F_LENMASK ; Only skip the length, not the flags
and b, [a] ; Get the length of the word
add a, b ; Skip that many characters
add a, 1 ; Move past the word to the code field
set pc, pop ; Return
DEFWORD(`>dfa', `tdfa') ; Get the pointer to the first "real" word of the word at address
dat TCFA
dat INCR
dat EXIT
; Compilation
DEFCODE(create) ; Create the dictionary header from a string
set a, pop ; ( str-addr str-len -- )
set b, [var_HERE] ; A = str-addr, Y = str-len, B = HERE pointer,
set c, [var_LATEST] ; C = LATEST pointer
set [b], c ; Store link to previous word
set [var_LATEST], b ; Update LATEST
add b, 1 ; Move to strlen
set [b], y ; Store strlen
add b, 1 ; Move to beginning of string
:create_loop
ife y, 0
set pc, create_end
set [b], [a] ; Copy a character
add b, 1 ; Move along
add a, 1
sub y, 1
set pc, create_loop
:create_end
set [var_HERE], b
set y, pop
NEXT
DEFCODE(```,''',comma) ; Add an address to the base of user memory
set a, y ; ( addr -- )
jsr comma
set y, pop
NEXT
:comma
set b, [var_HERE]
set [b], a
add [var_HERE], 1
set pc, pop
DEFCODE(`[',lbrac,F_IMMED) ; Switch to immediate mode
set [var_STATE], 0
NEXT
DEFCODE(`]',rbrac) ; Switch to compile mode
set [var_STATE], 1
NEXT
DEFWORD(`:',colon)
dat WORD
dat CREATE
dat LIT ; The "LIT word COMMA" pattern appends word to user memory
dat DOCOL
dat COMMA
dat LATEST
dat FETCH
dat HIDDEN
dat RBRAC ; Go to compile mode
dat EXIT ; Return
DEFWORD(`;',semicolon,F_IMMED)
dat LIT
dat EXIT
dat COMMA
dat LATEST ; Make the word hidden
dat FETCH
dat HIDDEN
dat LBRAC ; Go back to immediate mode
dat EXIT ; Return
DEFCODE(hidden) ; Toggle the hidden bit of a dictionary entry
add y, 1
xor [y], F_HIDDEN ; Toggle the flag
set y, pop
NEXT
DEFWORD(hide)
dat WORD
dat FIND
dat HIDDEN
dat EXIT
; Fundamental branching
DEFCODE(branch) ; Takes an offset and adds it to the instruction pointer
add i, [i]
NEXT
DEFCODE(`0branch',zbranch) ; Same thing, but skip the offset if TOS == 0
set a, y
set y, pop
ife a, 0 ; If TOS is zero, branch
set pc, code_BRANCH
add i, 1 ; Otherwise, skip the offset
NEXT
; REPL
DEFWORD(quit) ; This is actually what starts the REPL
dat RZ
dat RSPSTORE ; Clear the return stack
dat INTERPRET ; Interpret the next word
dat BRANCH ; Jump back to interpret the next word
dat -2
DEFCODE(interpret) ; This is the higher level interpreter
jsr word_main ; Leaves address in A and length in B
jsr find ; Dictionary lookup, leaves address in A (0 if not found)
ife a, 0
set pc, interpret_litnum
set push, a ; Save A
jsr to_cfa ; Get codeword address in A
set c, a ; Save it in C
set a, pop ; Restore A
set b, a
add b, 1
set b, [b]
set [interpret_is_lit], 0 ; Reset literal flag
ifb b, F_IMMED ; If the immediate bit is set, go straight to exec
set pc, interpret_exec
set pc, interpret_check_for_compile
:interpret_litnum
add [interpret_is_lit], 1
jsr number ; Leaves number in A, C > 0 if error
set b, a
set a, LIT
:interpret_check_for_compile
ife [var_STATE], 0
set pc, interpret_exec
jsr comma
ife [interpret_is_lit], 0 ; Not a literal
set pc, interpret_nolit
set a, b ; LIT has already been COMMA'd
jsr comma ; so it's COMMA the number
:interpret_nolit
NEXT
:interpret_exec
ifn [interpret_is_lit], 0
set pc, interpret_exec_number
set a, [a]
set pc, [a] ; Double indirection, doesn't return
:interpret_exec_number
set push, y
set y, a
NEXT
:interpret_is_lit
dat 0
; Skip parse error messages for now
DEFVAR(here,,,0x800) ; Pointer to the next free word of memory
; HERE should be the last thing, as anything after will be overwritten
; by HW info and user words.
; The magic number 0x800 is the length of this binary, rounded up to the
; nearest 0x100. Adjust as necessary.
Jump to Line
Something went wrong with that request. Please try again.