def make_thread(*words):
"""Build a thread from a sequence of words (using their asm symbols)"""
docol()
for word in words:
st(lo(word), [Y, Xpp])
jmp(Y, "forth.move-ip")
st(hi(word), [Y, Xpp])
st(lo("forth.core.EXIT"), [Y, Xpp])
jmp(Y, "forth.move-ip")
st(hi("forth.core.EXIT"), [Y, Xpp])
def docol():
"Code that should be inlined at the start of each core word"
adda(-add_cost_of_next(cost_of_docol_ram) / 2)
ld(hi("forth.DO-DOCOL-RAM"), Y)
jmp(Y, "forth.DO-DOCOL-RAM")
ld(return_stack_page, Y) # 4
docol_rom_only() # 4 + 4
def restart_or_quit():
assert pc() & 0xFF == 0, "restart_or_quit must be placed at the start of a page"
label("forth.restart-or-quit")
bra([W_lo]) # 6
ble(pc() + 1) # 7
# 8 happens in start of thread again
label(".quit")
ld(hi("forth.exit"), Y) # 9
C("jmp forth.exit.from-failed-test")
jmp(Y, lo("forth.exit.from-failed-test")) # 10
def reenter(cycles_so_far):
"""Dispatch to the word in W"""
cost = cycles_so_far + cost_of_reenter
if cost % 2 == 0:
target = "forth.next1.reenter.even"
else:
target = "forth.next1.reenter.odd"
cost -= 1 # We're skipping a nop
ld(hi("forth.next1.reenter"), Y) # 1
C("REENTER")
jmp(Y, lo(target)) # 2
ld(-cost / 2) # 3
def exit(vTicks, vReturn):
label("forth.exit") # Counting down
label("forth.exit.from-failed-test")
ld(-(cost_of_failed_next1 + 1) / 2) # 7
label("forth.exit.from-next1-reenter")
label("forth.exit.from-next2")
adda([vTicks]) # 6
ld(hi("vBlankStart"), Y) # 5
bgt(pc() & 0xFF) # 4
suba(1) # 3
jmp(Y, [vReturn]) # 2
nop() # 1
def next(cycles_so_far):
"""Jump to the next instruction"""
cost = cycles_so_far + cost_of_next
if cost % 2 == 0:
target = "forth.next2.even"
else:
target = "forth.next2.odd"
cost += 1 # We're gaining a nop
ld(hi("forth.next2"), Y) # 1
C("NEXT")
jmp(Y, lo(target)) # 2
ld(-(cost / 2)) # 3
def shift(vtmp):
"""Place all of the code required for 2*, LSHIFT, RSHIFT and 2/
Needs a page to itself.
"""
# Customized restart or quit trampoline which loads Y and X so that
# they point at the data stack. This saves space at no runtime cost.
assert pc(
) & 0xFF == 0, "restart_or_quit must be placed at the start of a page"
label("forth.restart-or-quit")
ble(pc() + 3) # 6
ld(data_stack_page, Y) # 7
bra([W_lo])
ld([data_stack_pointer], X) # 8; nop for purposes of .quit
label(".quit")
ld(hi("forth.exit"), Y) # 9
C("jmp forth.exit.from-failed-test")
jmp(Y, lo("forth.exit.from-failed-test")) # 10
# 11, overlap with whatever comes next - hopefully not a branch or jump!
_two_times()
offset_start = pc()
_lshift()
offset_of_shift_by_8 = pc() - offset_start
_lshift__amount_eq_8()
offset_of_shift_by_gt_8 = pc() - offset_start
_lshift__amount_gt_8()
offset_of_shift_by_lt_8 = pc() - offset_start
_lshift__amount_lt_8()
rshift_offset_start = pc()
_rshift()
assert pc() - rshift_offset_start <= offset_of_shift_by_8
fillers(until=(rshift_offset_start + offset_of_shift_by_8) & 255)
_rshift__amount_eq_8()
assert pc() - rshift_offset_start <= offset_of_shift_by_gt_8
fillers(until=(rshift_offset_start + offset_of_shift_by_gt_8) & 255)
_rshift__amount_gt_8()
assert pc() - rshift_offset_start <= offset_of_shift_by_lt_8
fillers(until=(rshift_offset_start + offset_of_shift_by_lt_8) & 255)
_rshift__amount_lt_8()
_shift_entry(
offset_to_amount_eq_8=offset_of_shift_by_8,
offset_to_amount_gt_8=offset_of_shift_by_gt_8,
offset_to_amount_lt_8=offset_of_shift_by_lt_8,
)
_left_shift_by_n()
_right_shift_by_n(vtmp)
_two_div(vtmp)
def do_restore_mode():
label("forth.DO-RESTORE-MODE")
adda(-add_cost_of_reenter(cost_of_do_restore_mode) / 2)
ld(return_stack_page, Y)
ld([return_stack_pointer], X)
ld([return_stack_pointer])
adda(1)
st([return_stack_pointer])
ld([Y, X])
st([mode])
ld(0, Y)
ld(W, X)
st(lo("forth.core.EXIT"), [Y, Xpp])
st(hi("forth.core.EXIT"), [Y, Xpp]) # 12
REENTER(cost_of_do_restore_mode)
def move_ip():
"""Page-Zero code to move the IP by the amount contained in AC
This routine is used by the ROM mode next3, and also by literal, branch and zero_branch.
As these routines all have different lengths, it uses a variable (tmp0) to tell it what length to return
It always jumps to forth.next1.reenter.odd, and it has an odd length itself code calling it must have an even length
"""
assert pc() >> 8 == 0
label("forth.move-ip")
adda([IP_lo]) # 1
st([IP_lo]) # 2
ld(hi("forth.next1.reenter"), Y) # 3
C("REENTER")
jmp(Y, lo("forth.next1.reenter.odd")) # 4
ld([tmp0]) # 5
def _right_shift_by_n(vtmp):
"""
Fixed cost routine to do a right-shift by 1-7 places
Shift amount is passed in NEGATED in ac, value is loaded from [y, x].
Control is returned to address in continuation.
In the case of a right-shift by between 1 and 7 places, this needs to
be called twice. in which case we can jump to right-shift-by-n.second-time
with mask in ac.
"""
label("right-shift-by-n")
st([tmp0]) # 1
adda(".end-of-set_bits_table")
bra(AC) # 3
bra(lo(".end-of-set_bits_table")) # 4
ld(0b0011_1111) # Shift by 7
ld(0b0001_1111) # Shift by 6
ld(0b0000_1111) # Shift by 5
ld(0b0000_0111) # Shift by 4
ld(0b0000_0011) # Shift by 3
ld(0b0000_0001) # Shift by 2
ld(0b0000_0000) # Shift by 1
label(".end-of-set_bits_table")
st([set_bits]) # 6
# Take the opportunity to set vTmp
ld(lo("forth.right-shift-return-point"))
st([vtmp])
ld([tmp0])
adda(".end-of-mask-table")
bra(AC) # 11
bra(lo(".end-of-mask-table")) # 12
ld(0b1000_0000) # Shift by 7
ld(0b1100_0000) # Shift by 6
ld(0b1110_0000) # Shift by 5
ld(0b1111_0000) # Shift by 4
ld(0b1111_1000) # Shift by 3
ld(0b1111_1100) # Shift by 2
ld(0b1111_1110) # Shift by 1
label(".end-of-mask-table")
st([mask]) # 14
label("right-shift-by-n.second-time")
anda([Y, X]) # 15, 1
ora([set_bits])
ld(hi("shiftTable"), Y)
jmp(Y, AC) # 18, 4
bra(0xFF) # 19, 5
def _two_div(vtmp):
"""Implementation of 2/ (arithmetic shift right)
2/ ( x1 -- x2 )
"""
label("forth.core.2/")
adda(-add_cost_of_next(cost_of_two_div) / 2) # 1
# ld(data_stack_page, Y) # Happen in head of page, but still counted
# ld([data_stack_pointer], X)
ld(lo("forth.core.2/.continuation1"))
st([continuation]) # 5
ld(lo("forth.right-shift-return-point"))
st([vtmp])
label("forth.core.2/.do-shift")
ld([Y, X]) # 8, 30
anda(0b1111_1110)
ld(hi("shiftTable"), Y) # 10
jmp(Y, AC) # 11, 33
bra(255) # 12, 34
# ld # 13, 35
# bra [vTmp] # 14, 36
# nop # 15, 37
# ld $thisPage, Y # 16, 38
# jmp Y, [sysArgs + 4] # 17, 39
# ld $0, y # 18, 40
label("forth.core.2/.continuation1")
st([Y, Xpp]) # 19; Store shifted low-byte
ld([Y, X]) # 20; Calculate bit to copy from high to low
anda(0b0000_0001)
adda(127)
anda(0b1000_0000)
ld([data_stack_pointer], X)
ora([Y, X]) # 25
st([Y, Xpp])
ld(lo("forth.core.2/.continuation2")) # Continue to high-byte
bra("forth.core.2/.do-shift") # 28
st([continuation]) # 29
label("forth.core.2/.continuation2")
st([Y, X]) # 41
adda(AC) # Shift back to get sign-bit
anda(0b1000_0000)
ora([Y, X])
st([Y, X]) # 45
NEXT(cost_of_two_div)
def do_docol_ram():
label("forth.DO-DOCOL-RAM")
# Upon exit from this thread, we need to restore the mode
# So the return stack needs to look like:
# TOP-> [restore_mode, mode, IP]
ld([return_stack_pointer]) # 1
suba(5)
st([return_stack_pointer], X)
st(lo("forth.RESTORE-MODE"), [Y, Xpp])
st(hi("forth.RESTORE-MODE"), [Y, Xpp]) # 5
ld([mode])
st([Y, Xpp])
ld([IP_lo])
st([Y, Xpp])
ld([IP_hi]) # 10
st([Y, X])
ld(lo("forth.next3.rom-mode"))
st([mode]) # 13
_copy_W_to_IP(increment_by=8)
NEXT(cost_of_docol_ram)
def next2(vTicks):
label("forth.next2")
label("forth.next2.odd")
nop()
label("forth.next2.even")
# On entry AC holds the negative of the number of ticks taken by the just executed instruction
# To have entered the instruction we must have also had a successful test,
suba((cost_of_successful_test + cost_of_next2_success) / 2) # 1
adda([vTicks]) # 2
st([vTicks]) # 3; If we exit successfully we'll be ready for next1
ld([mode]) # 4
st([W_lo]) # 5
ld(hi("forth.next3")) # 6 # TODO
st([W_hi]) # 7
ld([vTicks]) # 8
suba((cost_of_failed_test) / 2) # 9
blt(lo("forth.exit.from-next2")) # 10
tick_correction = cost_of_next2_success - cost_of_next2_failure
ld(tick_correction / 2) # 11; Restore
bra(lo("forth.next1")) # 12
ld([vTicks]) # 13
def docol_rom_only():
"""Code that should be inlined in each word that is only accessible in ROM mode"""
adda(-add_cost_of_next(cost_of_docol_rom) / 2)
ld(hi("forth.DO-DOCOL-ROM"), Y)
jmp(Y, "forth.DO-DOCOL-ROM")
ld(return_stack_page, Y) # 4
def restore_mode():
label("forth.RESTORE-MODE")
# Hand compiled thread with no exit
st(lo("forth.DO-RESTORE-MODE"), [Y, Xpp])
jmp(Y, "forth.move-ip")
st(hi("forth.DO-RESTORE-MODE"), [Y, Xpp])
continuation = zpByte()
# Used for the action to take with the high byte.
high_byte_action = zpByte()
# The following code implements a lookup table of floored quarter squares,
# for values up to 255.
# This is supposed to enable a fast multiplication for 7-bit numbers.
# First the high-bytes.
# The table is shifted down by 32 places, as the first 32 high-bytes are all zero
# This allows us to have code later in the page which we can branch back to.
align(0x100, size=0x100)
label("Quarter-squares lookup table")
for i in range(32, 256):
val = math.floor(i**2 / 4)
ld(hi(val))
C(f"${val:04x} = {val} = floor({i} ** 2 / 4); ${val:04x} >> 8 = ${val >> 8:02x}"
)
# We jump back here after looking up the low-byte of the result.
label("low-byte return point")
ld(hi("multiply 7x7"), Y)
jmp(Y, [continuation])
ld(hi(pc()), Y) # Make it easy to get back here!
cost_of_low_byte_return = 3
label("table entry.possibly-negative")
# AC is negative, if b > a. Find absolute value
blt(pc() + 3) # 1
bra(pc() + 3) # 2
suba(1) # 3; if >= 0
xora(0xFF) # 3; if < 0
def _switch_to_ram_ram():
ld(hi("forth.next3.ram-rom-mode"))
st([mode])