RomanRom2/gigatron
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
master
gigatron/rom/Contrib/hsnaves/GtForth/GtForth.vasm.py
Roman Krupnin 90e6151613 init repo
2025-01-28 19:17:01 +03:00

2841 lines
62 KiB
Python
Raw Permalink Blame History

from vasm import *
from vcpu import VirtualCpu
import io
# vCPU register locations in memory
vPC = ADDR("vPC")
vAC = ADDR("vAC")
vLR = ADDR("vLR")
vSP = ADDR("vSP")
# SYS functions
sysFn = ADDR("sysFn")
sysArgs0 = ADDR("sysArgs0")
sysArgs1 = ADDR("sysArgs1")
sysArgs2 = ADDR("sysArgs2")
sysArgs3 = ADDR("sysArgs3")
sysArgs4 = ADDR("sysArgs4")
sysArgs5 = ADDR("sysArgs5")
sysArgs6 = ADDR("sysArgs6")
sysArgs7 = ADDR("sysArgs7")
SYS_VDrawBits_134 = ADDR("SYS_VDrawBits_134")
SYS_Random_34 = ADDR("SYS_Random_34")
# Extra variables in memory
memSize = ADDR("memSize")
romType = ADDR("romType")
romTypeValue_ROMv3 = ADDR("romTypeValue_ROMv2")
videoTable = ADDR("videoTable")
serialRaw = ADDR("serialRaw")
buttonState = ADDR("buttonState")
frameCount = ADDR("frameCount")
# Some constants
F_IMMD = 0x80 # Immediate flag
F_COMP = 0x40 # Compile only flag
F_HIDD = 0x20 # Hidden flag
F_MASK = 0x1F # Mask for the length of the word
rsp_top = 0x05FE # Top of the return stack
dsp_top = 0x06FE # Top of the data stack
buf_base = 0x0200 # Buffer for READ
auxbuf_end = 0x0320 # Buffer for other functions
segment_size = 96
buf_size = 0xF0
init1_base = 0x0200
init2_base = 0x0300
code_base = 0x0800
data_base = None # Automatically resolved
welcome_string = "GtForth v0.1\n"
free_bytes_string = "bytes free\n"
# User variables start from $30 in zero page
zp_base_addr = 0x30
variable_base = zp_base_addr
def zpSkip(nbytes=2):
global zp_base_addr
addr = zp_base_addr
zp_base_addr += nbytes
return addr
buf = zpSkip() # Current buffer position
inp = zpSkip() # The current input position
wlen = zpSkip() # The length of the current word
wbuf = zpSkip() # The current word
w = zpSkip() # Work register
adj1 = zpSkip() # Address adjust register 1
tmp1 = zpSkip() # Temporary 1
tmp2 = zpSkip() # Temporary 2
tmp3 = zpSkip() # Temporary 3
tmp4 = zpSkip() # Temporary 4
tmp5 = zpSkip() # Temporary 5
md1 = zpSkip() # Temporary 1 for multiplication / division
md2 = zpSkip() # Temporary 2 for multiplication / division
md3 = zpSkip() # Temporary 3 for multiplication / division
str1 = zpSkip() # Temporary 1 for find
str2 = zpSkip() # Temporary 2 for find
rsp = zpSkip() # Return stack pointer
dsp = zpSkip() # Data stack pointer
pc = zpSkip() # Program counter (points to the current word)
here = zpSkip() # The value of the memory
latest = zpSkip() # The latest defined word
base = zpSkip() # The base for number parsing / printing
state = zpSkip() # The state of the compiler
scr_pos = zpSkip() # The position on the screen
scr_color = zpSkip() # The current color
assert(zp_base_addr < 0x80)
# Addresses of auxiliary functions
zp_base_addr = 0x82
auxiliary_base = zp_base_addr
auxiliary_functions = []
def defAux(name):
globals()["%s_fn" % name] = zpSkip()
auxiliary_functions.append(name)
defAux("next_word") # The function to compute the next word
defAux("exec") # To jump to some other execution point
defAux("adjust_addr") # To adjust a general address (for packing)
defAux("forward") # Move forward the address by 2 bytes (and adjust)
defAux("cforward") # Move forward the address by 1 byte (and adjust)
defAux("align_addr") # To align a general address
defAux("push_data") # To push value on the data stack
defAux("pop_data") # To pop from the data stack
defAux("push_return") # To push value on the return stack
defAux("pop_return") # To pop from the return stack
defAux("multiply") # To multiply two numbers
defAux("udivide") # To divide two (unsigned) numbers
defAux("divide") # To divide two (signed) numbers
defAux("divide_aux") # Auriliary function to do division
defAux("unsigned_cmp") # Auxiliary function to compare unsigned numbers
defAux("signed_cmp") # Auxiliary function to compare signed numbers
defAux("setup_draw") # To setup for the SYS_VDrawBits_134
defAux("emit") # To print a character onto the screen
defAux("select_font") # To select the character font
defAux("draw_char") # To draw the current character
defAux("update_pos") # To update the current position
defAux("emit_scroll") # To scroll based on the last emit
defAux("clearline") # To clear a line
defAux("scroll") # To scroll the screen
defAux("read") # To read characters from keyboard
defAux("show_cursor") # To show the cursor
defAux("process_key") # To process an input key
defAux("process_bs") # To process the backspace key
defAux("parse_word") # To parse a word
defAux("number") # To parse a number
defAux("unumber") # To parse a unsigned number
defAux("digit") # To parse a single digit
defAux("memcpy") # To copy memory from one place to another
defAux("streq") # To compare two strings
defAux("find") # To find a word in the dictionary
defAux("match") # Auxiliary function to find the word
defAux("flags") # To obtain the flags of a word in the dictionary
defAux("cfa") # To obtain the code of a word in the dictionary
defAux("comma") # To compile a word
defAux("str_comma") # To compile a string
defAux("cv_number") # To convert a number to string
defAux("cv_unumber") # To convert an unsigned number to string
defAux("cv_digit") # To convert a digit to string
assert(zp_base_addr < 0xE0)
current_link = [ 0 ] # Current link for latest (at assembly time)
# ============================
# Auxiliary meta functions
# ============================
def get_link():
"""Get the link to the latest defined word.
Returns
-------
The link to the latest word (to be resolved later).
"""
fn = lambda x : ADDR(x[0])
return (fn, current_link)
def reference(label):
"""Places a reference to a label in the resulting GT1 file.
Parameters
----------
label: str
The label.
"""
# Use little-endian format here
BYTE((LO, label))
BYTE((HI, label))
return 0 # Bogus return value (for unary minus)
def place_string(s, include_length=True):
"""Places a string aligned to 2 bytes.
Parameters
----------
s: str
The string to place.
include_length: bool
To also place the length before the string bytes.
"""
if include_length:
BYTE(len(s))
for c in s:
BYTE(ord(c))
ALIGN(2)
return 0 # Bogus return value (for unary minus)
def define_word(name, flags, label=None, xt="xt_DOCOL"):
"""Defines a new word.
Parameters
----------
name: str
The name of the word.
flags: int
The flags used to create the word.
label: str
The label used for the assembler.
xt: str
The location of the code to execute this word.
"""
if label is None:
label = name
header_label = "word_" + label
L(header_label)
reference(current_link[0])
current_link[0] = header_label
BYTE(flags + len(name))
place_string(name, include_length=False)
L(label)
reference(xt)
def define_constant(name, value, label=None):
"""Defines a new constant word.
Parameters
----------
name: str
The name of the word.
value: int
The constant value.
label: str
The label used for the assembler.
"""
define_word(name, 0, label=label, xt="xt_DOCON")
reference(value)
def resolve_font_address(c):
"""Resolves the font address.
Parameters
----------
c: byte
The character to resolve.
Returns
-------
Tha address of the font for the character.
"""
if ord(c) < 82:
return ADDR("font32up") + 5 * (ord(c) - 32)
else:
return ADDR("font82up") + 5 * (ord(c) - 82)
def extend_callback(gt1, ins):
"""To extend the ORG segments page by page.
Parameters
----------
gt1: list
The list of segments of the GT1 file.
ins: tuple
The tuple of bytes to append.
"""
segment = gt1[-1]
base = segment[0]
size = segment[1]
contents = segment[3]
if len(contents) + len(ins) > size or len(contents) >= size:
new_segment = (base + 256, size, {}, [])
gt1.append(new_segment)
def pack_segments_factory(base, size):
"""To resolve and pack multiple ORG segments.
Parameters
----------
base: int
The base address of the segments.
size: int
The size of each segment (bin).
Returns
-------
A callback to pack the segments (to be used by END()).
"""
def do_packing(gt1, symbols):
cur_base = base
orig_gt1 = list(gt1)
used_pages = set()
gt1.clear()
new_segments = [ ]
for segment in orig_gt1:
seg_base = segment[0]
if seg_base is None:
continue
gt1.append(segment)
used_pages.add(seg_base // 256)
for segment in orig_gt1:
if segment[0] is not None:
continue
seg_size = len(segment[3])
if seg_size > size:
raise RuntimeError("segment too large: %d bytes" %\
seg_size)
selected = None
for s in new_segments:
if s[1] - len(s[3]) >= seg_size:
selected = s
break
if selected is None:
cur_page = cur_base // 256
if cur_page in used_pages:
raise RuntimeError("page overlap at 0x%04X" % cur_base)
new_segments.append([cur_base, size, {}, []])
selected = new_segments[-1]
cur_base += 256
s = selected
d = len(s[3])
# Update the labels within this segment
labels_for_id = []
for lbl, offset in segment[2].items():
if not lbl.startswith("."):
labels_for_id.append(lbl)
s[2][lbl] = d + offset
if seg_size > 55:
print("Section %r is large (%d bytes, resolved to 0x%04X)" %\
(labels_for_id, seg_size, s[0] + d))
s[3].extend(segment[3])
total_bytes = 0
for s in new_segments:
total_bytes += len(s[3])
gt1.append(s)
fraction = float(total_bytes) / (len(new_segments) * size)
print("Packed %d bytes into %d segments of %d bytes each (%.1f%%)" % \
(total_bytes, len(new_segments), size, 100 * fraction))
# Update the symbols
for segment in gt1:
for lbl, offset in segment[2].items():
symbols[lbl] = segment[0] + offset
segment = gt1[-1]
return segment[0]
return do_packing
# ============================
# Initialization
# ============================
# Note: Code in this segment will be destroyed after initialization
# This code occupies the same region of memory for the data and return
# stacks.
ORG(init1_base, size=variable_base)
L("start")
- LDWI("main")
- STW(tmp1)
- CALL(tmp1)
# Data initialization
ORG(init1_base + rsp)
L("init_data")
- reference(rsp_top) # rsp
- reference(dsp_top) # dsp
- reference("cold_start") # pc
- reference("here_loc") # here
- reference(get_link()) # latest
- reference(10) # base
- reference(0) # state
- reference(0x7662) # scr_pos
- reference(0x0B00) # scr_color
ORG(init1_base + 0x80)
BYTE(1)
ORG(init1_base + auxiliary_base)
for name in auxiliary_functions:
reference(name)
L("init_data_end")
ORG(init2_base)
L("main")
# Shift the video to not display the code
- LDWI(videoTable+1)
- STW(tmp1)
- LDI(96)
- POKE(tmp1)
# Copy initialization data
- LDWI("init_data")
- STW(tmp1)
- ANDI(0xFF)
- STW(tmp3)
- LDWI("init_data_end")
- STW(tmp2)
L(".copy_init_loop")
- LDW(tmp1)
- PEEK()
- POKE(tmp3)
- INC(tmp1)
- INC(tmp3)
- LDW(tmp1)
- SUBW(tmp2)
- BNE(".copy_init_loop")
# Start the interpreter
- CALL(next_word_fn)
# ============================
# Auxiliary functions
# ============================
# Processes the next forth word.
ORG(None)
L("next_word")
- LDW(pc)
- DEEK()
- STW(w)
# Increment the pc by 2 and adjust address.
- LDI(pc)
- CALL(forward_fn)
- LDW(w)
# Starts execution at a given address (in vAC)
L("exec")
- STW(w)
- DEEK()
- STW(vLR)
- RET()
# Adjusts the address to be within the valid region of RAM.
# The address of the memory location containing the address
# to adjust is given in vAC.
# Note: vAC must always be even!
ORG(None)
L("adjust_addr")
- STW(adj1)
- ADDI(1)
- PEEK()
- SUBI(8)
- BLT(".adjust_skip")
- LDW(adj1)
- DEEK()
- BLT(".adjust_skip")
- ANDI(0xFF)
- SUBI(segment_size & 0xFF)
- BLT(".adjust_skip")
- POKE(adj1)
- INC(adj1) # Can increment here because adj1 is always even
- LDW(adj1)
- PEEK()
- ADDI(1)
- POKE(adj1)
L(".adjust_skip")
- RET()
# Moves forward by two bytes and adjust the address.
# The input of this function is given in vAC (same as for
# adjust_addr).
ORG(None)
L("forward")
- PUSH()
- STW(adj1)
- DEEK()
- ADDI(2)
L(".forward_writeback")
- DOKE(adj1)
- LDW(adj1)
- CALL(adjust_addr_fn)
- POP()
- RET()
# Moves forward by one byte and adjust the address.
# The input of this function is given in vAC (same as for
# adjust_addr).
L("cforward")
- PUSH()
- STW(adj1)
- DEEK()
- ADDI(1)
- BRA(".forward_writeback")
# Alignes an address to a multiple of two and
# then adjusts the address.
ORG(None)
L("align_addr")
- PUSH()
- STW(adj1)
- DEEK()
- ANDI(1)
- BEQ(".align_skip")
- LDW(adj1)
- DEEK()
- ADDI(1)
- DOKE(adj1)
L(".align_skip")
- LDW(adj1)
- CALL(adjust_addr_fn)
- POP()
- RET()
# Pushes a value on the data stack.
ORG(None)
L("push_data")
- DOKE(dsp)
- LD(dsp)
- SUBI(2)
- ST(dsp)
- RET()
# Pops a value from the data stack.
ORG(None)
L("pop_data")
- INC(dsp) # Can increment because dsp stays in the same page
- INC(dsp)
- LDW(dsp)
- DEEK()
- RET()
# Pushes a value on the return stack.
ORG(None)
L("push_return")
- DOKE(rsp)
- LD(rsp)
- SUBI(2)
- ST(rsp)
- RET()
# Pops a value from the return stack.
ORG(None)
L("pop_return")
- INC(rsp)
- INC(rsp)
- LDW(rsp)
- DEEK()
- RET()
# To multiply two numbers.
# The inputs are given in md1 and md2.
# The result is in md3.
# Uses tmp5 as temporary storage.
ORG(None)
L("multiply")
- LDI(0)
- STW(md3)
- LDI(1)
L(".multiply_loop")
- STW(tmp5)
- ANDW(md2)
- BEQ(".multiply_continue")
- LDW(md1)
- ADDW(md3)
- STW(md3)
L(".multiply_continue")
- LDW(md1)
- LSLW()
- STW(md1)
- LDW(tmp5)
- LSLW()
- BNE(".multiply_loop")
- RET()
# To divide two (unsigned) numbers.
# The inputs are given in md1 and md2 (dividend and divisor).
# The results are in md3 (quotient) and md1 (remainder).
# Note: if the divisor is zero, the quotient will be md1
# and the remainder will also be md1.
# Uses tmp5 as temporary storage.
ORG(None)
L("udivide")
- PUSH()
- LDW(md1)
- STW(md3)
- LDW(md2)
- BEQ(".udivide_end")
- LDI(0)
- STW(md1)
L(".udivide_loop")
- STW(tmp5)
- LDW(md1)
- LSLW()
- STW(md1)
- LDW(md3)
- BGE(".udivide_no_increment1")
- INC(md1)
L(".udivide_no_increment1")
- LSLW()
- STW(md3)
- CALL(unsigned_cmp_fn)
- BLT(".udivide_no_increment2")
- LDW(md1)
- SUBW(md2)
- STW(md1)
- INC(md3)
L(".udivide_no_increment2")
- LDW(tmp5)
- ADDI(1)
- ANDI(15)
- BNE(".udivide_loop")
L(".udivide_end")
- POP()
- RET()
# To divide two (signed) numbers.
# The inputs are given in md1 and md2 (dividend and divisor).
# The results are in md3 (quotient) and md1 (remainder).
# Note: if the divisor is zero, the quotient will be md1
# and the remainder will also be md1.
# Uses tmp4 and tmp5 as temporary storage.
ORG(None)
L("divide")
- PUSH()
- LDI(0)
- SUBW(md1)
- BGT(".divide_neg1")
- CALL(divide_aux_fn)
- BRA(".divide_end")
L(".divide_neg1")
- STW(md1)
- CALL(divide_aux_fn)
- LDI(0)
- SUBW(md3)
- STW(md3)
- LDW(md1)
- BEQ(".divide_end")
- LDW(md2)
- SUBW(md1)
- STW(md1)
- LDW(tmp4)
- BLT(".divide_neg2")
- LDWI(-1)
- BRA(".divide_continue")
L(".divide_neg2")
- LDI(1)
L(".divide_continue")
- ADDW(md3)
- STW(md3)
L(".divide_end")
- POP()
- RET()
# Auxiliary function divide two (signed) numbers.
# The inputs are given in md1 and md2 (dividend and divisor).
# The results are in md3 (quotient) and md1 (remainder).
# Note: This function assumes that md1 is non-negative and
# on the return, md2 is possibly changed in sign so that
# it is positive. In addition tmp4 keeps the original value
# of md2.
# Note: if the divisor is zero, the quotient will be md1
# and the remainder will also be md1.
# Uses tmp5 as temporary storage.
ORG(None)
L("divide_aux")
- PUSH()
- LDW(md2)
- STW(tmp4)
- LDI(0)
- SUBW(md2)
- BLT(".divide_aux_no_adjust")
- STW(md2)
L(".divide_aux_no_adjust")
- CALL(udivide_fn)
- LDW(tmp4)
- BGE(".divide_aux_end")
- LDI(0)
- SUBW(md3)
- STW(md3)
L(".divide_aux_end")
- POP()
- RET()
# Auxiliary function to compare md1 and md2
# as unsigned numbers.
# It returns a negative number if md1 < md2 (unsigned),
# a positive number if md1 > m2 (unsigned) and zero
# if md1 = md2.
ORG(None)
L("unsigned_cmp")
- LDW(md1)
- XORW(md2)
- BLT(".unsigned_cmp_diff")
- LDW(md1)
- SUBW(md2)
- RET()
L(".unsigned_cmp_diff")
- LDW(md2)
- ORI(1)
- RET()
# Auxiliary function to compare md1 and md2
# as signed numbers.
# It returns a negative number if md1 < md2 (signed),
# a positive number if md1 > md2 (signed), and zero
# if md1 = md2.
ORG(None)
L("signed_cmp")
- LDW(md1)
- XORW(md2)
- BLT(".signed_cmp_diff")
- LDW(md1)
- SUBW(md2)
- RET()
L(".signed_cmp_diff")
- LDW(md1)
- ORI(1)
- RET()
# Setup the register for invoking the SYS_VDrawBits_134 function.
ORG(None)
L("setup_draw")
- LDWI(SYS_VDrawBits_134)
- STW(sysFn)
- LDW(scr_color)
- STW(sysArgs0)
- RET()
# Prints a character onto the screen.
# The charater is in register vAC.
# It returns True if the character is printable or newline.
# This functions uses tmp3, tmp4, and tmp5 for temporary storage.
ORG(None)
L("emit")
- PUSH()
- STW(tmp5)
# Handle newline (line-feed)
- XORI(ord('\n'))
- BNE(".emit_no_newline")
# Move position to the new of the line
- LDI(0xF8)
- ST(scr_pos)
- BRA(".emit_update_pos")
L(".emit_no_newline")
- LDW(tmp5)
- CALL(select_font_fn)
- BEQ(".emit_end")
- LDW(scr_pos)
- STW(sysArgs4)
- CALL(draw_char_fn)
L(".emit_update_pos")
- CALL(update_pos_fn)
- CALL(emit_scroll_fn)
- LDI(1)
L(".emit_end")
- POP()
- RET()
# Selects the font and returns True if it is a printable character.
# The charater is in vAC.
# The address of the font is stored in tmp5 on return.
# It uses tmp4 and tmp5 for temporary storage.
ORG(None)
L("select_font")
- SUBI(82)
- BLT(".select_font_32")
- STW(tmp5)
- SUBI(50)
- BGE(".select_font_end") # Skip unprintable characters
- LDWI("font82up")
- BRA(".select_font_continue")
L(".select_font_32")
- ADDI(50)
- BLT(".select_font_end")
- STW(tmp5)
- LDWI("font32up")
L(".select_font_continue")
- STW(tmp4)
- LDW(tmp5)
- LSLW()
- LSLW()
- ADDW(tmp5)
- ADDW(tmp4)
- STW(tmp5)
- LDI(1)
- RET()
L(".select_font_end")
- LDI(0)
- RET()
# Draws a character to screen.
# The address of the character is in tmp5.
# It uses tmp4 and tmp5 for temporary storage.
ORG(None)
L("draw_char")
- LDI(5)
L(".draw_char_loop")
- STW(tmp4)
- LDW(tmp5)
- LUP(0)
- ST(sysArgs2)
- SYS(134) # Call SYS_VDrawBits_134
- INC(tmp5)
- INC(sysArgs4)
- LDW(tmp4)
- SUBI(1)
- BGT(".draw_char_loop")
- RET()
# Updates scr_pos.
ORG(None)
L("update_pos")
- LDW(scr_pos)
- ADDI(6)
- STW(scr_pos)
- LD(scr_pos)
- SUBI(0xFE)
- BLT(".update_pos_end")
- LDWI(0x0964)
- ADDW(scr_pos)
- BGE(".update_pos_continue")
- LDWI(0x0862)
L(".update_pos_continue")
- STW(scr_pos)
L(".update_pos_end")
- RET()
# Checks if there is need to scroll.
# It uses tmp3, tmp4, and tmp5 as temporary storage.
ORG(None)
L("emit_scroll")
- PUSH()
# Check if started a new line
- LD(scr_pos)
- SUBI(0x62)
- BGT(".emit_scroll_end")
- LDW(scr_pos)
# Recall that there is a border of 2 pixels in scr_pos
- SUBI(2)
- CALL(clearline_fn)
# Check if would wrap around the screen
- LDWI(videoTable)
- PEEK()
- STW(tmp5)
- LDI(scr_pos + 1)
- PEEK()
- XORW(tmp5)
- BNE(".emit_scroll_end")
# Scroll by 10 lines to avoid the wrap around
- LDI(10)
- CALL(scroll_fn)
L(".emit_scroll_end")
- POP()
- RET()
# Clears a line (for newline).
# This means that the screen is cleared for the current line.
# It uses tmp3 and tmp5 as temporary storage.
ORG(None)
L("clearline")
- PUSH()
- STW(sysArgs4)
- LDI(32)
L(".clearline_loop")
- STW(tmp3)
- LDWI(resolve_font_address(' '))
- STW(tmp5)
- CALL(draw_char_fn)
- LDW(tmp3)
- SUBI(1)
- BNE(".clearline_loop")
- POP()
- RET()
# Code to implement scrolling.
# It uses tmp3, tmp4, and tmp5 as temporary storage.
ORG(None)
L("scroll")
- STW(tmp5) # The amount to scroll
- LDWI(120)
- STW(tmp3)
- LDWI(videoTable)
- STW(tmp4)
L(".scroll_loop")
- LDW(tmp4)
- PEEK()
- ADDW(tmp5)
- SUBI(8)
- BLT(".scroll_1")
- SUBI(120)
- BGE(".scroll_2")
L(".scroll_1")
- ADDI(120)
L(".scroll_2")
- ADDI(8)
- POKE(tmp4)
- LDW(tmp4)
- ADDI(2)
- STW(tmp4)
- LDW(tmp3)
- SUBI(1)
- STW(tmp3)
- BNE(".scroll_loop")
- RET()
# Code to implement reading from the keyboard.
# Uses tmp3, tmp4, and tmp5 as temporary storage.
ORG(None)
L("read")
- PUSH()
L(".read_loop1")
- LD(serialRaw)
- STW(tmp3)
- LD(frameCount) # Use the frameCount to implement the cursor
- STW(tmp4)
L(".read_loop2")
- LD(serialRaw)
- XORW(tmp3)
- BNE(".read_key")
- LD(frameCount)
- XORW(tmp4)
- BEQ(".read_loop2")
# Show the cursor
- LD(frameCount)
- ANDI(8)
- CALL(show_cursor_fn)
- LD(frameCount)
- STW(tmp4)
- BRA(".read_loop2")
L(".read_key")
- LD(serialRaw)
- CALL(process_key_fn)
- BNE(".read_loop1")
- POP()
- RET()
# Shows the blinking cursor.
# If vAC is zero, shows a space, otherwise shows a full square.
# Uses tmp4 and tmp5 as temporary storage.
ORG(None)
L("show_cursor")
- PUSH()
- BEQ(".show_cursor_space")
- LDWI(resolve_font_address(chr(127)))
- BRA(".show_cursor_continue")
L(".show_cursor_space")
- LDWI(resolve_font_address(' '))
L(".show_cursor_continue")
- STW(tmp5)
- LDW(scr_pos)
- STW(sysArgs4)
- CALL(draw_char_fn)
- POP()
- RET()
# Processes a key input from the keyboard.
# Uses tmp3, tmp4, and tmp5 as temporary storage.
ORG(None)
L("process_key")
- PUSH()
- STW(tmp5)
- LDI(ord('\n')) # Check for newlines
- XORW(tmp5)
- BNE(".process_key_continue")
- LDI(0)
- CALL(show_cursor_fn)
- LDI(0)
- BRA(".process_key_end")
L(".process_key_continue")
- LDI(127) # Now check for backspaces
- XORW(tmp5)
- BNE(".process_key_regular")
- CALL(process_bs_fn)
- BRA(".process_key_return_true")
L(".process_key_regular")
- LD(buf)
- SUBI(buf_size) # Check if the buffer is full
- BEQ(".process_key_return_true")
- LDW(tmp5)
- POKE(buf)
- CALL(emit_fn)
- BEQ(".process_key_return_true")
- INC(buf)
L(".process_key_return_true")
- LDI(1)
L(".process_key_end")
- POP()
- RET()
# Processes the backspace key.
# Uses tmp4 and tmp5 as temporary storage.
ORG(None)
L("process_bs")
- PUSH()
- LD(scr_pos)
- SUBI(0x62)
- BLE(".process_bs_end")
- LD(buf)
- BEQ(".process_bs_end")
- LDI(0)
- CALL(show_cursor_fn)
- LDW(scr_pos)
- SUBI(6)
- STW(scr_pos)
- LDI(0)
- CALL(show_cursor_fn)
- LD(buf)
- SUBI(1)
- ST(buf)
L(".process_bs_end")
- POP()
- RET()
# Processes a word.
# Input: vAC -> the character delimiter
# Uses tmp5 as temporary storage.
ORG(None)
L("parse_word")
- PUSH()
- STW(tmp5)
- LDI(0)
- STW(wlen)
L(".parse_word_loop1")
- LDW(inp)
- XORW(buf)
- BEQ(".parse_word_end")
- LDW(inp)
- INC(inp)
- STW(wbuf)
- PEEK()
- XORW(tmp5)
- BEQ(".parse_word_loop1")
- INC(wlen)
L(".parse_word_loop2")
- LDW(inp)
- XORW(buf)
- BEQ(".parse_word_end")
- LDW(inp)
- PEEK()
- XORW(tmp5)
- INC(inp)
- BEQ(".parse_word_end")
- INC(wlen)
- BRA(".parse_word_loop2")
L(".parse_word_end")
- POP()
- RET()
# To parse a number.
# Input: str1 is the length of the string, and
# str2 is the pointer to the string.
# Output: tmp1 is the parsed number, and vAC
# indicates whether or not the parsing succeeded
# (non-positive number means error).
# This function uses tmp2, tmp3, tmp4 and tmp5 as
# temporary storage.
ORG(None)
L("number")
- PUSH()
- LDW(str2)
- STW(tmp3)
- LDW(str1)
- STW(tmp2)
- BEQ(".number_end")
- LDW(tmp3)
- PEEK()
- XORI(ord('-'))
- BEQ(".number_negative")
- CALL(unumber_fn)
L(".number_end")
- POP()
- RET()
L(".number_negative")
- LDW(tmp2)
- SUBI(1)
- STW(tmp2)
- LDI(tmp3)
- CALL(cforward_fn)
- CALL(unumber_fn)
- STW(tmp2)
- LDI(0)
- SUBW(tmp1)
- STW(tmp1)
- LDW(tmp2)
- BRA(".number_end")
# To parse an unsigned number.
# Input: tmp2 is the length of the string, and
# tmp3 is the pointer to the string.
# Output: tmp1 is the parsed number, and vAC
# indicates whether or not the parsing succeeded
# (non-positive number means error).
# This function uses tmp4 and tmp5 as temporary storage.
ORG(None)
L("unumber")
- PUSH()
- LDI(0)
- STW(tmp1)
- LDW(base)
- STW(md2)
- LDW(tmp2)
- BEQ(".unumber_end")
L(".unumber_loop")
- LDW(tmp3)
- PEEK()
- STW(tmp4)
- LDI(tmp3)
- CALL(cforward_fn)
- CALL(digit_fn)
- BLE(".unumber_end")
- LDW(tmp1)
- STW(md1)
- CALL(multiply_fn)
- LDW(md3)
- ADDW(tmp4)
- STW(tmp1)
- LDW(tmp2)
- SUBI(1)
- STW(tmp2)
- BNE(".unumber_loop")
- LDI(1)
L(".unumber_end")
- POP()
- RET()
# To parse a single digit.
# The input digit is in tmp4 and the output is returned in tmp4 as well.
# On success this function should return a positive number in vAC.
ORG(None)
L("digit")
- LDW(tmp4)
- SUBI(ord('0'))
- BLT(".digit_error")
- SUBI(ord('9') - ord('0'))
- BGT(".digit_letter")
- ADDI(ord('9') - ord('0'))
- STW(tmp4)
- BRA(".digit_check")
L(".digit_letter")
- LDW(tmp4)
- SUBI(ord('A'))
- BLT(".digit_error")
- LDI(ord('Z'))
- SUBW(tmp4)
- BLT(".digit_error")
- LDW(tmp4)
- ADDI(10 - ord('A'))
- STW(tmp4)
L(".digit_check")
- LDW(base)
- SUBW(tmp4)
L(".digit_error")
- RET()
# To copy one memory region to another.
# Input: tmp1 -> number of bytes to copy;
# tmp2 -> source address;
# tmp3 -> destination address;
ORG(None)
L("memcpy")
- PUSH()
L(".memcpy_loop")
- LDW(tmp1)
- BEQ(".memcpy_end")
- SUBI(1)
- STW(tmp1)
- LDW(tmp2)
- PEEK()
- POKE(tmp3)
- LDI(tmp2)
- CALL(cforward_fn)
- LDI(tmp3)
- CALL(cforward_fn)
- BRA(".memcpy_loop")
L(".memcpy_end")
- POP()
- RET()
# To compare two strings.
# Input: tmp1 -> length of the first string;
# tmp2 -> address of the first string;
# tmp3 -> length of the second string;
# tmp4 -> address of the second string;
# Return: Zero if the strings are equal, non-zero otherwise.
ORG(None)
L("streq")
- PUSH()
- LDW(tmp1)
- SUBW(tmp3)
- BNE(".streq_end")
L(".streq_loop")
- LDW(tmp1)
- BEQ(".streq_end")
- SUBI(1)
- STW(tmp1)
- LDW(tmp2)
- PEEK()
- STW(tmp3)
- LDW(tmp4)
- PEEK()
- SUBW(tmp3)
- BNE(".streq_end")
- LDI(tmp2)
- CALL(cforward_fn)
- LDI(tmp4)
- CALL(cforward_fn)
- BRA(".streq_loop")
L(".streq_end")
- POP()
- RET()
# To find one word in the dictionary.
# Input: str1 -> length of the word to search;
# str2 -> address of the string to search;
# Output: vAC contains the address of the word in the dictionary.
# This function uses tmp1, tmp2, tmp3, tmp4, and tmp5
# as temporary storage.
ORG(None)
L("find")
- PUSH()
- LDW(latest)
L(".find_loop")
- STW(tmp5)
- BEQ(".find_end")
- CALL(match_fn)
- BEQ(".find_end")
- LDW(tmp5)
- DEEK()
- BRA(".find_loop")
L(".find_end")
- LDW(tmp5)
- POP()
- RET()
# Auxiliary function to find one word in the dictionary.
# Input: str1 -> length of the word to search;
# str2 -> address of the string to search;
# vAC -> address of the current word;
# Output: vAC is zero if the word was found.
# This function uses tmp1, tmp2, tmp3 and tmp4 as temporary storage.
ORG(None)
L("match")
- PUSH()
- STW(tmp4)
- LDI(tmp4)
- CALL(forward_fn)
- LDW(tmp4)
- PEEK()
- ANDI(F_HIDD)
- BNE(".match_end")
- LDW(tmp4)
- INC(tmp4) # There is no need to adjust as tmp4 is even
- PEEK()
- ANDI(F_MASK)
- STW(tmp3)
- LDW(str1)
- STW(tmp1)
- LDW(str2)
- STW(tmp2)
- CALL(streq_fn)
L(".match_end")
- POP()
- RET()
# Auxiliary function to extract the flags of a word in dictionary.
# Input: tmp1 -> address of the word in dictionary
# Output: vAC -> the flags (including the length)
# tmp1 -> the address of the flags byte.
ORG(None)
L("flags")
- PUSH()
- LDI(tmp1)
- CALL(forward_fn)
- LDW(tmp1)
- PEEK()
- POP()
- RET()
# Auxiliary function to extract the flags of a word in dictionary.
# Input: tmp1 -> address of the flags byte of the word in dictionary.
# Output: tmp1 -> the result;
# tmp2 -> the length of the name;
# tmp3 -> the pointer to the name string;
# Note: one should call "flags" before calling this function.
ORG(None)
L("cfa")
- PUSH()
- LDW(tmp1)
- INC(tmp1) # tmp1 is even here
- PEEK()
- ANDI(F_MASK)
- STW(tmp2)
- LDW(tmp1)
- STW(tmp3)
- ADDW(tmp2)
- STW(tmp1)
- LDI(tmp1)
- CALL(align_addr_fn)
- POP()
- RET()
# Compiles one word.
# Input: vAC -> word to compile.
ORG(None)
L("comma")
- PUSH()
- DOKE(here)
- LDI(here)
- CALL(forward_fn)
- POP()
- RET()
# Compiles one string.
# Input: tmp1 -> length of string;
# tmp2 -> address of string;
# Uses tmp3 as temporary variable.
ORG(None)
L("str_comma")
- PUSH()
- LDW(tmp1)
- POKE(here)
- INC(here)
- LDW(here)
- STW(tmp3)
- CALL(memcpy_fn)
- LDW(tmp3)
- STW(here)
- LDI(here)
- CALL(align_addr_fn)
- POP()
- RET()
# Converts one number to string.
# Input: tmp1 -> number to be converted;
# tmp2 -> address of the buffer to write the number;
ORG(None)
L("cv_number")
- PUSH()
- LDI(0)
- SUBW(tmp1)
- BGT(".cv_number_negative")
- CALL(cv_unumber_fn)
- POP()
- RET()
L(".cv_number_negative")
- STW(tmp1)
- CALL(cv_unumber_fn)
- LDI(ord('-'))
- POKE(tmp2)
- LDW(tmp2)
- SUBI(1)
- STW(tmp2)
- POP()
- RET()
# Converts one unsigned number to string.
# Input: tmp1 -> number to be converted;
# tmp2 -> address of the buffer to write the number;
# Uses tmp5 as temporary storage;
ORG(None)
L("cv_unumber")
- PUSH()
- LDW(base)
- STW(md2)
- LDW(tmp1)
- STW(md3)
- BEQ(".cv_unumber_write")
L(".cv_unumber_loop")
- STW(md1)
- CALL(udivide_fn)
- LDW(md1)
L(".cv_unumber_write")
- CALL(cv_digit_fn)
- POKE(tmp2)
- LDW(tmp2)
- SUBI(1)
- STW(tmp2)
- LDW(md3)
- BNE(".cv_unumber_loop")
- POP()
- RET()
# Converts one digit to string.
# Input: vAC -> digit to be convert;
# Output: vAC -> the ascii code of the digit;
ORG(None)
L("cv_digit")
- SUBI(10)
- BGE(".cv_digit_letter")
- ADDI(ord('0') + 10)
- RET()
L(".cv_digit_letter")
- ADDI(ord('A'))
- RET()
# ============================
# Code of the words
# ============================
# Preamble of colon definitions.
# ( -- )
ORG(None)
L("xt_DOCOL")
- LDW(pc)
- CALL(push_return_fn)
- LDW(w) # Work register contains the pointer to the current word.
- STW(pc)
- LDI(pc)
- CALL(forward_fn)
- CALL(next_word_fn)
# Code used to implement constants.
# ( -- n )
ORG(None)
L("xt_DOCON")
- LDI(w)
- CALL(forward_fn)
- LDW(w)
- DEEK() # Get the literal value
- CALL(push_data_fn)
- CALL(next_word_fn)
# Code for adjusting addresses.
# ( a -- a' )
ORG(None)
L("xt_ADJ")
- CALL(pop_data_fn)
- STW(tmp1)
- LDI(tmp1)
- CALL(adjust_addr_fn)
- LDW(tmp1)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Code for aligning addresses.
# ( a -- a' )
ORG(None)
L("xt_ALIGN")
- CALL(pop_data_fn)
- STW(tmp1)
- LDI(tmp1)
- CALL(align_addr_fn)
- LDW(tmp1)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Code for executing an instruction on the data stack.
# ( w -- )
ORG(None)
L("xt_EXECUTE")
- CALL(pop_data_fn)
- CALL(exec_fn)
# Code for the BRANCH instruction.
# The next cell contains a relative address of the branch.
# ( -- )
ORG(None)
L("xt_BRANCH")
- LDW(pc)
- DEEK() # Value in the slot after branch is the offset for the PC
- STW(pc)
- CALL(next_word_fn)
# Code for the 0BRANCH instruction (used to implement IF word).
# This will execute the branch if the number on top of the data
# stack is zero.
# ( n -- )
L("xt_0BRANCH")
- CALL(pop_data_fn)
- BEQ("xt_BRANCH")
- LDI(pc)
- CALL(forward_fn)
- CALL(next_word_fn)
# Code to return from the current word.
# ( -- )
ORG(None)
L("xt_EXIT")
- CALL(pop_return_fn)
- STW(pc) # Pop pc from return stack
- CALL(next_word_fn)
# Pushes the literal in the next cell to the top of
# the data stack.
# ( -- n )
ORG(None)
L("xt_LIT")
- LDW(pc)
- DEEK() # Get the literal value
- CALL(push_data_fn)
- LDI(pc)
- CALL(forward_fn)
- CALL(next_word_fn)
# Pushes the number of bytes and the address of the
# string onto the data stack.
# ( -- l a )
ORG(None)
L("xt_LITSTR")
- LDW(pc)
- PEEK() # Get the length
- STW(tmp1)
- CALL(push_data_fn)
- INC(pc) # Can increment here because pc is even
- LDW(pc)
- CALL(push_data_fn)
- LDI(tmp1)
- CALL(adjust_addr_fn)
- LDW(pc)
- ADDW(tmp1)
- STW(pc)
- LDI(pc)
- CALL(align_addr_fn)
- CALL(next_word_fn)
# Drops the current value in the data stack.
# ( n -- )
ORG(None)
L("xt_DROP")
- CALL(pop_data_fn)
- CALL(next_word_fn)
# Drops the last two values in the data stack.
# ( n2 n1 -- )
ORG(None)
L("xt_2DROP")
- CALL(pop_data_fn)
- CALL(pop_data_fn)
- CALL(next_word_fn)
# Swaps the last two values in the data stack.
# ( n2 n1 -- n1 n2 )
ORG(None)
L("xt_SWAP")
- CALL(pop_data_fn)
- STW(tmp1)
- CALL(pop_data_fn)
- STW(tmp2)
- LDW(tmp1)
- CALL(push_data_fn)
- LDW(tmp2)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Duplicates the value in the (data) stack.
# ( n1 -- n1 n1 )
ORG(None)
L("xt_DUP")
- CALL(pop_data_fn)
- STW(tmp1)
- CALL(push_data_fn)
- LDW(tmp1)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Duplicates the last two values in the (data) stack.
# ( n2 n1 -- n2 n1 n2 n1 )
ORG(None)
L("xt_2DUP")
- CALL(pop_data_fn)
- STW(tmp1)
- CALL(pop_data_fn)
- STW(tmp2)
- CALL(push_data_fn)
- LDW(tmp1)
- CALL(push_data_fn)
- LDW(tmp2)
- CALL(push_data_fn)
- LDW(tmp1)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Duplicates the value in the (data) stack if the
# value is non-zero
# ( n1 -- n1 | n1 n1 )
ORG(None)
L("xt_?DUP")
- CALL(pop_data_fn)
- STW(tmp1)
- CALL(push_data_fn)
- LDW(tmp1)
- BEQ(".xt_?DUP_end")
- CALL(push_data_fn)
L(".xt_?DUP_end")
- CALL(next_word_fn)
# Pushes the 2nd element from the top to the data stack.
# ( n2 n1 -- n2 n1 n2 )
ORG(None)
L("xt_OVER")
- CALL(pop_data_fn)
- STW(tmp1)
- CALL(pop_data_fn)
- STW(tmp2)
- CALL(push_data_fn)
- LDW(tmp1)
- CALL(push_data_fn)
- LDW(tmp2)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Rotates the last 3 elements of the stack.
# ( n3 n2 n1 -- n2 n1 n3 )
ORG(None)
L("xt_ROT")
- CALL(pop_data_fn)
- STW(tmp1)
- CALL(pop_data_fn)
- STW(tmp2)
- CALL(pop_data_fn)
- STW(tmp3)
- LDW(tmp2)
- CALL(push_data_fn)
- LDW(tmp1)
- CALL(push_data_fn)
- LDW(tmp3)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Rotates the last 3 elements of the stack in reverse order.
# ( n3 n2 n1 -- n1 n3 n2 )
ORG(None)
L("xt_RROT")
- CALL(pop_data_fn)
- STW(tmp1)
- CALL(pop_data_fn)
- STW(tmp2)
- CALL(pop_data_fn)
- STW(tmp3)
- LDW(tmp1)
- CALL(push_data_fn)
- LDW(tmp3)
- CALL(push_data_fn)
- LDW(tmp2)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Transfers a value from the return stack to the data stack.
# ( -- r )
ORG(None)
L("xt_R>")
- CALL(pop_return_fn)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Transfers a value from the return stack to the data stack.
# ( r -- )
ORG(None)
L("xt_>R")
- CALL(pop_data_fn)
- CALL(push_return_fn)
- CALL(next_word_fn)
# Gets the value of the (data) stack pointer (before the push).
# ( -- dsp )
ORG(None)
L("xt_DSP@")
- LDW(dsp)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Sets the value of the (data) stack pointer.
# ( dsp -- )
ORG(None)
L("xt_DSP!")
- CALL(pop_data_fn)
- STW(dsp)
- CALL(next_word_fn)
# Gets the value of the (return) stack pointer.
# ( -- rsp )
ORG(None)
L("xt_RSP@")
- LDW(rsp)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Sets the value of the (return) stack pointer.
# ( rsp -- )
ORG(None)
L("xt_RSP!")
- CALL(pop_data_fn)
- STW(rsp)
- CALL(next_word_fn)
# Stores a value into memory.
# ( n a -- )
ORG(None)
L("xt_!")
- CALL(pop_data_fn)
- STW(tmp1)
- CALL(pop_data_fn)
- DOKE(tmp1)
- CALL(next_word_fn)
# Fetches a value from memory.
# ( a -- n )
ORG(None)
L("xt_@")
- CALL(pop_data_fn)
- DEEK()
- CALL(push_data_fn)
- CALL(next_word_fn)
# Stores a character (byte).
# ( b a -- )
ORG(None)
L("xt_C!")
- CALL(pop_data_fn)
- STW(tmp1)
- CALL(pop_data_fn)
- POKE(tmp1)
- CALL(next_word_fn)
# Fetches a character.
# ( a -- b )
ORG(None)
L("xt_C@")
- CALL(pop_data_fn)
- PEEK()
- CALL(push_data_fn)
- CALL(next_word_fn)
# Replaces the last two values on the data
# stack by their sum.
# ( n2 n1 -- n1+n2 )
ORG(None)
L("xt_+")
- CALL(pop_data_fn)
- STW(tmp1)
- CALL(pop_data_fn)
- ADDW(tmp1)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Replaces the last two values on the data
# stack by their difference.
# ( n2 n1 -- n2-n1 )
ORG(None)
L("xt_-")
- CALL(pop_data_fn)
- STW(tmp1)
- CALL(pop_data_fn)
- SUBW(tmp1)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Replaces the last two values on the data
# stack by their logical AND.
# ( n2 n1 -- n1&n2 )
ORG(None)
L("xt_AND")
- CALL(pop_data_fn)
- STW(tmp1)
- CALL(pop_data_fn)
- ANDW(tmp1)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Replaces the last two values on the data
# stack by their logical OR.
# ( n2 n1 -- n1|n2 )
ORG(None)
L("xt_OR")
- CALL(pop_data_fn)
- STW(tmp1)
- CALL(pop_data_fn)
- ORW(tmp1)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Replaces the last two values on the data
# stack by their logical exclusive OR.
# ( n2 n1 -- n1^n2 )
ORG(None)
L("xt_XOR")
- CALL(pop_data_fn)
- STW(tmp1)
- CALL(pop_data_fn)
- XORW(tmp1)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Replaces the top of the stack with its logical NOT value.
# ( n1 -- ~n1 )
ORG(None)
L("xt_NOT")
- CALL(pop_data_fn)
- STW(tmp1)
- LDWI(-1)
- XORW(tmp1)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Replaces the top of the stack with its negative value.
# ( n1 -- ~n1 )
ORG(None)
L("xt_NEG")
- CALL(pop_data_fn)
- STW(tmp1)
- LDI(0)
- SUBW(tmp1)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Replaces the last two values on the data
# stack by their product.
# ( n2 n1 -- n2*n1 )
ORG(None)
L("xt_*")
- CALL(pop_data_fn)
- STW(md1)
- CALL(pop_data_fn)
- STW(md2)
- CALL(multiply_fn)
- LDW(md3)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Replaces the last two values on the data
# stack by their quotient and remainder.
# The two numbers n1 and n2 are treated as unsigned
# numbers.
# ( n2 n1 -- n2%n1 n2/n1 )
ORG(None)
L("xt_U/MOD")
- CALL(pop_data_fn)
- STW(md2)
- CALL(pop_data_fn)
- STW(md1)
- CALL(udivide_fn)
- LDW(md1)
- CALL(push_data_fn)
- LDW(md3)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Replaces the last two values on the data
# stack by their quotient and remainder.
# The two numbers n1 and n2 are treated as signed
# numbers.
# ( n2 n1 -- n2%n1 n2/n1 )
ORG(None)
L("xt_/MOD")
- CALL(pop_data_fn)
- STW(md2)
- CALL(pop_data_fn)
- STW(md1)
- CALL(divide_fn)
- LDW(md1)
- CALL(push_data_fn)
- LDW(md3)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Tests if the top of the stack equals to zero.
# ( n -- n==0 )
ORG(None)
L("xt_=0")
- CALL(pop_data_fn)
- BEQ(".xt_=0_satisfied")
- LDI(0)
- BRA(".xt_=0_end")
L(".xt_=0_satisfied")
- LDI(1)
L(".xt_=0_end")
- CALL(push_data_fn)
- CALL(next_word_fn)
# Tests if the top of the stack is not zero.
# ( n -- n<>0 )
ORG(None)
L("xt_<>0")
- CALL(pop_data_fn)
- BNE(".xt_<>0_satisfied")
- LDI(0)
- BRA(".xt_<>0_end")
L(".xt_<>0_satisfied")
- LDI(1)
L(".xt_<>0_end")
- CALL(push_data_fn)
- CALL(next_word_fn)
# Tests if the top of the stack is positive.
# ( n -- n>0 )
ORG(None)
L("xt_>0")
- CALL(pop_data_fn)
- BGT(".xt_>0_satisfied")
- LDI(0)
- BRA(".xt_>0_end")
L(".xt_>0_satisfied")
- LDI(1)
L(".xt_>0_end")
- CALL(push_data_fn)
- CALL(next_word_fn)
# Tests if the top of the stack is negative.
# ( n -- n<0 )
ORG(None)
L("xt_<0")
- CALL(pop_data_fn)
- BLT(".xt_<0_satisfied")
- LDI(0)
- BRA(".xt_<0_end")
L(".xt_<0_satisfied")
- LDI(1)
L(".xt_<0_end")
- CALL(push_data_fn)
- CALL(next_word_fn)
# Tests if the top of the stack is non-negative.
# ( n -- n>=0 )
ORG(None)
L("xt_>=0")
- CALL(pop_data_fn)
- BGE(".xt_>=0_satisfied")
- LDI(0)
- BRA(".xt_>=0_end")
L(".xt_>=0_satisfied")
- LDI(1)
L(".xt_>=0_end")
- CALL(push_data_fn)
- CALL(next_word_fn)
# Tests if the top of the stack is non-positive.
# ( n -- n<=0 )
ORG(None)
L("xt_<=0")
- CALL(pop_data_fn)
- BLE(".xt_<=0_satisfied")
- LDI(0)
- BRA(".xt_<=0_end")
L(".xt_<=0_satisfied")
- LDI(1)
L(".xt_<=0_end")
- CALL(push_data_fn)
- CALL(next_word_fn)
# Compares two numbers. That is, returns
# a number with the same sign as "n2 - n1" without the wrap
# around due to the 16-bit limit.
# ( n2 n1 -- cmp )
ORG(None)
L("xt_CMP")
- CALL(pop_data_fn)
- STW(md2)
- CALL(pop_data_fn)
- STW(md1)
- CALL(signed_cmp_fn)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Compares unsignedtwo numbers. That is, returns
# a number with the same sign as "n2 - n1" without the wrap
# around due to the 16-bit limit.
# ( n2 n1 -- ucmp )
ORG(None)
L("xt_UCMP")
- CALL(pop_data_fn)
- STW(md2)
- CALL(pop_data_fn)
- STW(md1)
- CALL(unsigned_cmp_fn)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Pushes a random value on top of the data stack.
# ( -- n )
ORG(None)
L("xt_RAND")
- LDWI(SYS_Random_34)
- STW(sysFn)
- SYS(34) # Call SYS_Random_34
- CALL(push_data_fn)
- CALL(next_word_fn)
# Gets a byte from the serial port.
# ( -- b )
ORG(None)
L("xt_SERIAL")
- LD(serialRaw)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Gets the button state.
# ( -- b )
ORG(None)
L("xt_BUTTON")
- LD(buttonState)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Gets a byte from the keyboard.
# ( -- b )
ORG(None)
L("xt_KEY")
- LD(serialRaw)
- STW(tmp1)
L(".xt_KEY_loop")
- LD(serialRaw)
- XORW(tmp1)
- BEQ(".xt_KEY_loop")
- LD(serialRaw)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Fills the input buffer.
# ( -- )
ORG(None)
L("xt_READ")
- CALL(setup_draw_fn)
- LDWI(buf_base)
- STW(buf)
- STW(inp)
- CALL(read_fn)
- CALL(next_word_fn)
# Scrolls the screen by a specified number of lines.
# ( n -- )
ORG(None)
L("xt_SCROLL")
- CALL(pop_data_fn)
- CALL(scroll_fn)
- CALL(next_word_fn)
# Puts a character onto the screen.
# ( b -- )
ORG(None)
L("xt_EMIT")
- CALL(setup_draw_fn)
- CALL(pop_data_fn)
- CALL(emit_fn)
- CALL(next_word_fn)
# Prints a strings onto the screen.
# ( n addr -- )
ORG(None)
L("xt_TYPE")
- CALL(setup_draw_fn)
- CALL(pop_data_fn)
- STW(tmp1)
- CALL(pop_data_fn)
- STW(tmp2)
L(".xt_TYPE_loop")
- LDW(tmp2)
- BEQ(".xt_TYPE_end")
- SUBI(1)
- STW(tmp2)
- LDW(tmp1)
- PEEK()
- STW(tmp3)
- LDI(tmp1)
- CALL(cforward_fn)
- LDW(tmp3)
- CALL(emit_fn)
- BRA(".xt_TYPE_loop")
L(".xt_TYPE_end")
- CALL(next_word_fn)
# Clears the screen with the background color.
# ( -- )
ORG(None)
L("xt_CLL")
- CALL(setup_draw_fn)
- LDW(scr_pos)
- CALL(clearline_fn)
- CALL(next_word_fn)
# Clears the screen with the background color.
# ( -- )
ORG(None)
L("xt_CLS")
- CALL(setup_draw_fn)
- LDWI(0x0800)
- STW(tmp2)
- LDWI(0x0860)
- STW(tmp1)
L(".xt_CLS_loop")
- CALL(clearline_fn)
- LDW(tmp1)
- ADDW(tmp2)
- STW(tmp1)
- BLT(".xt_CLS_end")
- BRA(".xt_CLS_loop")
L(".xt_CLS_end")
- CALL(next_word_fn)
# Parses the current word.
# ( b -- n addr )
ORG(None)
L("xt_WORD")
- CALL(pop_data_fn)
- CALL(parse_word_fn)
- LD(wlen)
- CALL(push_data_fn)
- LDW(wbuf)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Parses a number.
# ( l a -- n 1 | 0 )
ORG(None)
L("xt_NUMBER")
- CALL(pop_data_fn)
- STW(str2)
- CALL(pop_data_fn)
- STW(str1)
- CALL(number_fn)
- BLE(".xt_NUMBER_fail")
- LDW(tmp1)
- CALL(push_data_fn)
- LDI(1)
L(".xt_NUMBER_end")
- CALL(push_data_fn)
- CALL(next_word_fn)
L(".xt_NUMBER_fail")
- LDI(0)
- BRA(".xt_NUMBER_end")
# Copies memory from one location to another
# (from a2 to a1, l bytes).
# ( l a2 a1 -- )
ORG(None)
L("xt_MEMCPY")
- CALL(pop_data_fn)
- STW(tmp3)
- CALL(pop_data_fn)
- STW(tmp2)
- CALL(pop_data_fn)
- STW(tmp1)
- CALL(memcpy_fn)
- CALL(next_word_fn)
# Checks if two strings are equal.
# ( l2 a2 l1 a1 -- e )
ORG(None)
L("xt_S=")
- CALL(pop_data_fn)
- STW(tmp4)
- CALL(pop_data_fn)
- STW(tmp3)
- CALL(pop_data_fn)
- STW(tmp2)
- CALL(pop_data_fn)
- STW(tmp1)
- CALL(streq_fn)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Finds a word in the dictionary.
# ( l a -- n )
ORG(None)
L("xt_FIND")
- CALL(pop_data_fn)
- STW(str2)
- CALL(pop_data_fn)
- STW(str1)
- CALL(find_fn)
- CALL(push_data_fn)
- CALL(next_word_fn)
# To process the next token (word or number).
# ( b -- l a 0 | w 1 | n 2 )
ORG(None)
L("xt_TOKEN")
- CALL(pop_data_fn)
- CALL(parse_word_fn)
- LD(wlen)
- BEQ(".xt_TOKEN_error")
- STW(str1)
- LDW(wbuf)
- STW(str2)
- CALL(find_fn)
- BEQ(".xt_TOKEN_number")
- CALL(push_data_fn)
- LDI(1)
- BRA(".xt_TOKEN_end")
L(".xt_TOKEN_number")
- CALL(number_fn)
- BLE(".xt_TOKEN_error")
- LDW(tmp1)
- CALL(push_data_fn)
- LDI(2)
- BRA(".xt_TOKEN_end")
L(".xt_TOKEN_error")
- LD(wlen)
- CALL(push_data_fn)
- LDW(wbuf)
- CALL(push_data_fn)
- LDI(0)
L(".xt_TOKEN_end")
- CALL(push_data_fn)
- CALL(next_word_fn)
# Verifies if the word is not compile only
# and we trying to execute it.
# ( a b -- a b | l a 0 )
# where ( a b ) = ( w 1 ) or ( n 2 )
ORG(None)
L("xt_VERIFY")
- LDW(state)
- BNE(".xt_VERIFY_end")
- CALL(pop_data_fn)
- STW(tmp1)
- SUBI(1)
- BEQ(".xt_VERIFY_word")
- LDW(tmp1)
L(".xt_VERIFY_push_end")
- CALL(push_data_fn)
L(".xt_VERIFY_end")
- CALL(next_word_fn)
L(".xt_VERIFY_word")
- CALL(pop_data_fn)
- STW(tmp2)
- STW(tmp1)
- CALL(flags_fn)
- ANDI(F_COMP)
- BNE(".xt_VERIFY_error")
- LDW(tmp2)
- CALL(push_data_fn)
- LDI(1)
- BRA(".xt_VERIFY_push_end")
L(".xt_VERIFY_error")
- CALL(cfa_fn)
- LDW(tmp2)
- CALL(push_data_fn)
- LDW(tmp3)
- CALL(push_data_fn)
- LDI(0)
- BRA(".xt_VERIFY_push_end")
# To execute the token.
# ( w 1 | n 2 -- )
ORG(None)
L("xt_DISPATCH")
- LDW(state)
- BNE(".xt_DISPATCH_compile")
- CALL(pop_data_fn)
- XORI(1)
- BNE(".xt_DISPATCH_end")
- CALL(pop_data_fn)
- STW(tmp1)
- CALL(flags_fn)
L(".xt_DISPATCH_execute_word")
- CALL(cfa_fn)
- LDW(tmp1)
- CALL(exec_fn)
L(".xt_DISPATCH_compile")
- CALL(pop_data_fn)
- XORI(1)
- BEQ(".xt_DISPATCH_compile_word")
- LDWI("LIT")
- CALL(comma_fn)
- CALL(pop_data_fn)
L(".xt_DISPATCH_compile_end")
- CALL(comma_fn)
L(".xt_DISPATCH_end")
- CALL(next_word_fn)
L(".xt_DISPATCH_compile_word")
- CALL(pop_data_fn)
- STW(tmp1)
- CALL(flags_fn)
- ANDI(F_IMMD)
- BNE(".xt_DISPATCH_execute_word")
- CALL(cfa_fn)
- LDW(tmp1)
- BRA(".xt_DISPATCH_compile_end")
# Returns the flags of a word.
# ( w -- flags )
ORG(None)
L("xt_FLAGS")
- CALL(pop_data_fn)
- STW(tmp1)
- CALL(flags_fn)
- LDW(tmp1)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Returns the name of a word.
# ( w -- l a )
ORG(None)
L("xt_NAME")
- CALL(pop_data_fn)
- STW(tmp1)
- CALL(flags_fn)
- CALL(cfa_fn)
- LDW(tmp2)
- CALL(push_data_fn)
- LDW(tmp3)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Returns the CFA of a word.
# ( w -- cfa )
ORG(None)
L("xt_>CFA")
- CALL(pop_data_fn)
- STW(tmp1)
- CALL(flags_fn)
- CALL(cfa_fn)
- LDW(tmp1)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Creates a new word.
# ( l a -- )
ORG(None)
L("xt_CREATE")
- CALL(pop_data_fn)
- STW(tmp2)
- CALL(pop_data_fn)
- STW(tmp1)
- LDI(here)
- CALL(align_addr_fn)
- LDW(latest)
- DOKE(here)
- LDW(here)
- STW(latest)
- LDI(here)
- CALL(forward_fn)
- LDW(here)
- STW(tmp4)
- CALL(str_comma_fn)
#- LDW(tmp4)
#- PEEK()
#- ORI(F_HIDD) # Hide the word
#- POKE(tmp4)
- CALL(next_word_fn)
# Compiles a word.
# ( n -- )
ORG(None)
L("xt_,")
- CALL(pop_data_fn)
- CALL(comma_fn)
- CALL(next_word_fn)
# Compiles a string.
# ( l a -- )
ORG(None)
L("xt_S,")
- CALL(pop_data_fn)
- STW(tmp2)
- CALL(pop_data_fn)
- STW(tmp1)
- CALL(str_comma_fn)
- CALL(next_word_fn)
# Converts a number to string.
# ( n -- l a )
ORG(None)
L("xt_CONVERT")
- CALL(pop_data_fn)
- STW(tmp1)
- LDWI(auxbuf_end)
- STW(tmp2)
- CALL(cv_number_fn)
- LDWI(auxbuf_end)
- SUBW(tmp2)
- CALL(push_data_fn)
- INC(tmp2)
- LDW(tmp2)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Converts an unsigned number to string.
# ( n -- l a )
ORG(None)
L("xt_UCONVERT")
- CALL(pop_data_fn)
- STW(tmp1)
- LDWI(auxbuf_end)
- STW(tmp2)
- CALL(cv_unumber_fn)
- LDWI(auxbuf_end)
- SUBW(tmp2)
- CALL(push_data_fn)
- INC(tmp2)
- LDW(tmp2)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Returns the number of free bytes.
# ( -- n )
ORG(None)
L("xt_FREE")
- LDI(0)
- STW(tmp3)
- LD(memSize)
- BNE(".xt_FREE_not_64k")
- LDWI(0x100)
L(".xt_FREE_not_64k")
- STW(tmp1)
- SUBI(128)
- BLE(".xt_FREE_32k")
- ST(tmp3+1)
- LDI(128)
- STW(tmp1)
L(".xt_FREE_32k")
- LD(here+1)
- STW(tmp2)
- LDW(tmp1)
- SUBW(tmp2)
- SUBI(9) # The first 8 pages are not usable
- STW(md1)
- LDWI(segment_size)
- STW(md2)
- CALL(multiply_fn)
- LD(here)
- STW(tmp2)
- LDW(md2)
- SUBW(tmp2)
- ADDW(md3)
- ADDW(tmp3)
- CALL(push_data_fn)
- CALL(next_word_fn)
# Trigger the callback to resolve the segments.
last_segment_addr = RESOLVE_SEGMENTS(
pack_segments_factory(base=code_base,
size=segment_size)
)
if data_base is None:
data_base = last_segment_addr + 256
print("Resolved data_base = 0x$%04X" % data_base)
# ============================
# Data segment
# ============================
ORG(data_base, size=segment_size, callback=extend_callback)
# The basic words
define_word("ADJ", 0, xt="xt_ADJ")
define_word("ALIGN", 0, xt="xt_ALIGN")
define_word("EXECUTE", 0, xt="xt_EXECUTE")
define_word("BRANCH", F_COMP, xt="xt_BRANCH")
define_word("0BRANCH", F_COMP, xt="xt_0BRANCH")
define_word("EXIT", F_COMP, xt="xt_EXIT")
define_word("LIT", F_COMP, xt="xt_LIT")
define_word("LITSTR", F_COMP, xt="xt_LITSTR")
define_word("DROP", 0, xt="xt_DROP")
define_word("2DROP", 0, xt="xt_2DROP")
define_word("SWAP", 0, xt="xt_SWAP")
define_word("DUP", 0, xt="xt_DUP")
define_word("2DUP", 0, xt="xt_2DUP")
define_word("?DUP", 0, xt="xt_?DUP")
define_word("OVER", 0, xt="xt_OVER")
define_word("ROT", 0, xt="xt_ROT")
define_word("RROT", 0, xt="xt_RROT")
define_word("R>", 0, xt="xt_R>")
define_word(">R", 0, xt="xt_>R")
define_word("DSP@", 0, xt="xt_DSP@")
define_word("DSP!", 0, xt="xt_DSP!")
define_word("RSP@", 0, xt="xt_RSP@")
define_word("RSP!", 0, xt="xt_RSP!")
define_word("!", 0, xt="xt_!")
define_word("@", 0, xt="xt_@")
define_word("C!", 0, xt="xt_C!")
define_word("C@", 0, xt="xt_C@")
define_word("+", 0, xt="xt_+")
define_word("-", 0, xt="xt_-")
define_word("AND", 0, xt="xt_AND")
define_word("OR", 0, xt="xt_OR")
define_word("XOR", 0, xt="xt_XOR")
define_word("NOT", 0, xt="xt_NOT")
define_word("NEG", 0, xt="xt_NEG")
define_word("*", 0, xt="xt_*")
define_word("U/MOD", 0, xt="xt_U/MOD")
define_word("/MOD", 0, xt="xt_/MOD")
define_word("=0", 0, xt="xt_=0")
define_word("<>0", 0, xt="xt_<>0")
define_word(">0", 0, xt="xt_>0")
define_word("<0", 0, xt="xt_<0")
define_word(">=0", 0, xt="xt_>=0")
define_word("<=0", 0, xt="xt_<=0")
define_word("CMP", 0, xt="xt_CMP")
define_word("UCMP", 0, xt="xt_UCMP")
define_word("RAND", 0, xt="xt_RAND")
define_word("SERIAL", 0, xt="xt_SERIAL")
define_word("BUTTON", 0, xt="xt_BUTTON")
define_word("KEY", 0, xt="xt_KEY")
define_word("READ", 0, xt="xt_READ")
define_word("SCROLL", 0, xt="xt_SCROLL")
define_word("EMIT", 0, xt="xt_EMIT")
define_word("TYPE", 0, xt="xt_TYPE")
define_word("CLL", 0, xt="xt_CLL")
define_word("CLS", 0, xt="xt_CLS")
define_word("WORD", 0, xt="xt_WORD")
define_word("NUMBER", 0, xt="xt_NUMBER")
define_word("MEMCPY", 0, xt="xt_MEMCPY")
define_word("S=", 0, xt="xt_S=")
define_word("FIND", 0, xt="xt_FIND")
define_word("TOKEN", 0, xt="xt_TOKEN")
define_word("VERIFY", 0, xt="xt_VERIFY")
define_word("DISPATCH", 0, xt="xt_DISPATCH")
define_word("FLAGS", 0, xt="xt_FLAGS")
define_word("NAME", 0, xt="xt_NAME")
define_word(">CFA", 0, xt="xt_>CFA")
define_word("CREATE", 0, xt="xt_CREATE")
define_word(",", 0, xt="xt_,")
define_word("S,", 0, xt="xt_S,")
define_word("CONVERT", 0, xt="xt_CONVERT")
define_word("UCONVERT", 0, xt="xt_UCONVERT")
define_word("FREE", 0, xt="xt_FREE")
# Some constants
define_constant("HERE", here)
define_constant("LATEST", latest)
define_constant("BASE", base)
define_constant("STATE", state)
define_constant("SCR_POS", scr_pos)
define_constant("SCR_COLOR", scr_color)
define_constant("F_IMMD", F_IMMD)
define_constant("F_COMP", F_COMP)
define_constant("F_HIDD", F_HIDD)
define_constant("F_MASK", F_MASK)
define_constant("DOCOL", "xt_DOCOL")
define_constant("DOCON", "xt_DOCON")
define_constant("RSP0", rsp_top)
define_constant("DSP0", dsp_top)
define_constant("SEGSIZE", segment_size)
define_constant("FALSE", 0)
define_constant("TRUE", 1)
define_constant("BL", ord(' '))
define_constant("\\n", ord('\n'))
define_word("CR", 0)
- reference("\\n")
- reference("EMIT")
- reference("EXIT")
define_word("SPACE", 0)
- reference("BL")
- reference("EMIT")
- reference("EXIT")
define_word(".", 0)
- reference("CONVERT")
- reference("TYPE")
- reference("SPACE")
- reference("EXIT")
define_word("U.", 0)
- reference("UCONVERT")
- reference("TYPE")
- reference("SPACE")
- reference("EXIT")
define_word("RESET", 0)
L("cold_start")
- reference("CLS")
- reference("LITSTR")
- place_string(welcome_string)
- reference("TYPE")
- reference("FREE")
- reference("U.")
- reference("LITSTR")
- place_string(free_bytes_string)
- reference("TYPE")
- reference("INTERPRET")
define_word("INTERPRET", 0)
- reference("RSP0")
- reference("RSP!")
- reference("DSP0")
- reference("DSP!")
L(".interpret_loop1")
- reference("LIT")
- reference(ord('>'))
- reference("STATE")
- reference("@")
- reference("0BRANCH")
- reference(".interpret_prompt")
- reference("DROP")
- reference("BL")
L(".interpret_prompt")
- reference("EMIT")
- reference("READ")
- reference("CR")
L(".interpret_loop2")
- reference("BL")
- reference("TOKEN")
- reference("?DUP")
- reference("0BRANCH")
- reference(".interpret_test_error")
- reference("VERIFY")
- reference("?DUP")
- reference("0BRANCH")
- reference(".interpret_error_compile_only")
- reference("DISPATCH")
- reference("BRANCH")
- reference(".interpret_loop2")
L(".interpret_test_error")
- reference("OVER")
- reference("=0")
- reference("0BRANCH")
- reference(".interpret_error_unknown_word")
- reference("2DROP")
- reference("BRANCH")
- reference(".interpret_loop1")
L(".interpret_error_unknown_word")
- reference("LIT")
- reference(ord('?'))
L(".interpret_continue")
- reference("EMIT")
- reference("SPACE")
- reference("TYPE")
- reference("CR")
- reference("BRANCH")
- reference(".interpret_loop1")
L(".interpret_error_compile_only")
- reference("LIT")
- reference(ord('!'))
- reference("BRANCH")
- reference(".interpret_continue")
define_word("'", F_IMMD)
- reference("BL")
- reference("WORD")
- reference("2DUP")
- reference("FIND")
- reference("?DUP")
- reference("0BRANCH")
- reference(".interpret_error_unknown_word")
- reference(">CFA")
- reference("RROT")
- reference("2DROP")
- reference("EXIT")
define_word("WORDS", 0)
- reference("LATEST")
L(".words_loop")
- reference("@")
- reference("?DUP")
- reference("0BRANCH")
- reference(".words_end")
- reference("DUP")
- reference("FLAGS")
- reference("C@")
- reference("F_HIDD")
- reference("AND")
- reference("=0")
- reference("0BRANCH")
- reference(".words_loop")
- reference("DUP")
- reference("NAME")
- reference("TYPE")
- reference("SPACE")
- reference("BRANCH")
- reference(".words_loop")
L(".words_end")
- reference("EXIT")
L("here_loc")
# ============================
# Emulation
# ============================
gt1_bytes = END("start", filename=None)
vcpu = VirtualCpu()
src_text = """
BL WORD [ CREATE DOCOL , ' FALSE , ' STATE , ' ! , ' EXIT ,
LATEST @ FLAGS DUP C@ F_HIDD NOT AND F_IMMD OR SWAP C!
BL WORD ] CREATE DOCOL , ' TRUE , ' STATE , ' ! , ' EXIT ,
LATEST @ FLAGS DUP C@ F_HIDD NOT AND SWAP C!
BL WORD UNHIDE CREATE DOCOL , ]
LATEST @ FLAGS DUP C@ F_HIDD NOT AND SWAP C! EXIT [
LATEST @ FLAGS DUP C@ F_HIDD NOT AND SWAP C!
BL WORD : CREATE DOCOL , ] BL WORD CREATE DOCOL , ] EXIT [ UNHIDE
: IMMEDIATE LATEST @ FLAGS DUP C@ F_IMMD OR SWAP C! EXIT [ UNHIDE
: ; LIT EXIT , UNHIDE [ ' [ , ] EXIT [ UNHIDE IMMEDIATE
: COMPILE-ONLY LATEST @ FLAGS DUP C@ F_COMP OR SWAP C! ;
: CONSTANT BL WORD CREATE DOCON , , ;
: VARIABLE BL WORD CREATE DOCON , HERE @ 0 , HERE @ SWAP ! 0 , ;
: DECIMAL 10 BASE ! ;
: HEX 16 BASE ! ;
: IF LIT 0BRANCH , HERE @ 0 , ; IMMEDIATE COMPILE-ONLY
: THEN HERE @ SWAP ! ; IMMEDIATE COMPILE-ONLY
: ELSE LIT BRANCH , HERE @ SWAP 0 ,
HERE @ SWAP ! ; IMMEDIATE COMPILE-ONLY
: BEGIN HERE @ ; IMMEDIATE COMPILE-ONLY
: UNTIL LIT 0BRANCH , , ; IMMEDIATE COMPILE-ONLY
: AGAIN LIT BRANCH , , ; IMMEDIATE COMPILE-ONLY
: WHILE LIT 0BRANCH , HERE @ 0 , ; IMMEDIATE COMPILE-ONLY
: REPEAT LIT BRANCH , SWAP , HERE @ SWAP ! ; IMMEDIATE COMPILE-ONLY
: CHAR BL WORD SWAP IF C@ ELSE 0 THEN ;
: ( LIT [ CHAR ) , ] WORD 2DROP ;
( We have comments! Not that I happen to use many comments anyway :-)
: = - =0 ;
: <> - <>0 ;
: > CMP >0 ;
: < CMP <0 ;
: >= CMP >=0 ;
: <= CMP <=0 ;
: / /MOD SWAP DROP ;
: MOD /MOD DROP ;
: S" LIT [ CHAR " , ] WORD STATE @
IF LIT LITSTR , S, THEN
; IMMEDIATE
: ." LIT [ CHAR " , ] WORD STATE @
IF LIT LITSTR , S, LIT TYPE , ELSE TYPE THEN
; IMMEDIATE
: FORGET BL WORD FIND DUP @ LATEST ! HERE ! INTERPRET ;
FREE .
"""
src = io.BytesIO(src_text.encode("ascii"))
out = io.BytesIO()
def emit_breakpoint(vcpu, addr):
c = vcpu.get_vAC()
out.write(bytes(tuple([ c ])))
def read_breakpoint(vcpu, addr):
if addr == ADDR(".read_loop1"):
vcpu.write_byte(serialRaw, 0xFF)
else:
b = src.read(1)
if len(b) == 0:
vcpu.halt()
else:
vcpu.write_byte(serialRaw, b[0])
breakpoints = {}
breakpoints[ADDR("emit")] = emit_breakpoint
breakpoints[ADDR(".read_loop1")] = read_breakpoint
breakpoints[ADDR(".read_loop2")] = read_breakpoint
here_before = ADDR("here_loc")
latest_before = ADDR(current_link[0])
print("\nRunning GtForth in emulated vCPU ...")
vcpu.load_gt1(gt1_bytes=gt1_bytes)
vcpu.write_byte(memSize, 128)
try:
vcpu.run(breakpoints=breakpoints)
finally:
out_text = out.getvalue().decode("ascii")
print(out_text)
here_current = vcpu.read_word(here)
latest_current = vcpu.read_word(latest)
print("HERE (before): 0x%04X" % here_before)
print("HERE (after): 0x%04X" % here_current)
print("LATEST (before): 0x%04X" % latest_before)
print("LATEST (after): 0x%04X\n" % latest_current)
assert(here_current < 0x8000)
# Inject the new code
print("Injecting new code into GT1 file ...")
addr = here_before
while addr < here_current:
b = vcpu.read_byte(addr)
BYTE(b)
addr += 1
if (addr & 0xFF) >= segment_size:
addr = (addr & ~0xFF) + 0x100
def inject_new_values_factory(new_values):
def do_inject(gt1, symbols):
resolved = set()
for segment in gt1:
base = segment[0]
contents = segment[3]
size = len(contents)
for addr, val in new_values.items():
if addr >= base and addr < base + size:
resolved.add(addr)
offset = addr - base
contents[offset] = val & 0xFF
contents[offset + 1] = (val >> 8) & 0xFF
return do_inject
RESOLVE_SEGMENTS(inject_new_values_factory({
(init1_base + here): here_current,
(init1_base + latest): latest_current
}))
# ============================
# GT1 file generation
# ============================
# Execution start address
END("start")
used_bytes = segment_size * (here_current >> 8) \
+ (here_current & 0xFF)
free_bytes = segment_size * (0x80 - 0x08) - used_bytes
print("used bytes = %d" % used_bytes)
print("free bytes for 32K RAM = %d" % free_bytes)
Reference in New Issue View Git Blame Copy Permalink