def char_lit_rom_mode():
"""C-LIT - word that reads a byte encoded in the thread, and pushes it to the stack"""
label("forth.internal.C-LIT")
adda(-(cost_of_char_lit_rom_mode // 2))
ld(-(cost_of_char_lit_rom_mode // 2))
C("Store cost")
st([tmp0])
ld([data_stack_pointer])
C("Decrement Data stack pointer and store high byte of 0")
suba(1) # 5
ld(AC, X)
ld(0)
st([X])
ld([data_stack_pointer])
suba(2) # 10
ld(AC, X)
st([data_stack_pointer])
ld([IP_hi], Y)
C("Jump to the code in the thread")
ld(5)
C("We're going to shift the IP by 5")
nop(
) # 15, to meet requirement of move-ip that we must use an even number of cycles
jmp(Y, [IP_lo])
ld(0x00, Y) # 17
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 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 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 next3_rom_head():
"""Start the process of next3"""
label("forth.next3")
label("forth.next3.rom-mode")
adda(-(cost_of_next3_rom // 2)) # 1
ld(-(cost_of_next3_rom // 2)) # 2
st([tmp0]) # 3
ld(W, X) # 4
ld(3) # We're going to shift the IP by 3
ld([IP_hi], Y) # 6
nop() # 7
jmp(Y, [IP_lo]) # 8
ld(0x00, Y) # 9
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 question_branch_rom_mode():
"""Conditional Branch (flag -- )
Branches when the flag at the top of the stack is zero
Naming is per the Forth '83 standard.
"""
label("forth.internal.rom-mode.?BRANCH")
adda(-cost_of_question_branch_rom_mode // 2) # 1
ld([data_stack_pointer], X)
ld([data_stack_pointer])
adda(2)
st([data_stack_pointer]) # 5
ld([X])
bne(".?BRANCH.not-zero1")
ld(-(cost_of_question_branch_rom_mode__first_byte_nonzero // 2)) # 8
ld(data_stack_page, Y) # 9
st([Y, Xpp])
ld([Y, X])
bne(".?BRANCH.not-zero2")
ld(-(cost_of_question_branch_rom_mode__second_byte_nonzero // 2)) # 13
ld(-(cost_of_question_branch_rom_mode__both_bytes_zero // 2)) # 14
C("Store cost")
st([tmp0]) # 15
label(".enter-thread")
ld(W, X) # 16, 20
C("X <- W")
ld([IP_hi], Y)
C("Jump to the code in the thread")
jmp(Y, [IP_lo])
ld(0x00, Y) # 19, 23
label(".?BRANCH.not-zero1")
nop()
label(".?BRANCH.not-zero2")
st([tmp0]) # 10, 14
C("Store cost")
ld(2) # 11, 15
("IP <- IP + 2")
adda([IP_lo])
st([IP_lo])
bra(".enter-thread")
ld(3) # 15, 19
C("IP will move a further 3")
def next1(vTicks):
"""Routine to make continue or abort decisions, and dispatch to the next word"""
# Invariant - on entry the vTicks variable and the accumulator both hold
# an accurate number of cycles until we must be back in the display loop,
# starting from the first instruction of this routine.
# This value will always be greater than the cost of failing continue/abort test. This is true
# whenever we return here from another word, and true when we first enter from the
# display loop.
label("forth.next1")
C(
"Timing point: [vTicks] == AC == accurate number of ticks until we need to be back"
)
suba((cost_of_successful_test + cost_of_failfast) / 2) # 1
ld([W_hi], Y) # 2
jmp(Y, [W_lo]) # 3
bra("forth.restart-or-quit") # 4
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 branch_rom_mode():
"""Unconditional Branch ( -- )"""
label("forth.internal.rom-mode.BRANCH")
adda(-cost_of_branch_rom_mode // 2) # 1
ld(-(cost_of_branch_rom_mode // 2))
C("Store cost")
st([tmp0])
ld(W, X)
C("X <- W")
ld([IP_hi], Y) # 5
C("Jump to the code in the thread")
jmp(Y, [IP_lo])
ld(0x00, Y) # 7
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 lit_rom_mode():
"""LIT - word that reads a number encoded in the thread, and pushes it to the stack"""
label("forth.internal.LIT")
adda(-(cost_of_lit_rom_mode // 2))
ld(-(cost_of_lit_rom_mode // 2))
C("Store cost")
st([tmp0])
ld([data_stack_pointer])
C("Decrement Data stack pointer")
suba(2) # 5
ld(AC, X)
st([data_stack_pointer])
ld([IP_hi], Y)
C("Jump to the code in the thread")
ld(6)
C("We're going to shift the IP by 6")
nop(
) # 10, to meet requirement of move-ip that we must use an even number of cycles
jmp(Y, [IP_lo])
ld(0x00, Y) # 12
# 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
adda(1) # 4
cost_of_absolute = 4
label("table entry")
# Calculate an index into the high-byte table.
# This is basically a matter of subtracting 32, and jumping in if the result >= 0.
# But values greater than 160 have the sign-bit set after subtraction,
# despite being >32.
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])