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 _rshift__amount_lt_8():
label("forth.core.RSHIFT.n<8")
adda(-add_cost_of_next(cost_of_rshift__amount_lt_8) / 2) # 1
# ld(data_stack_page, Y) # Happen in head of page, but still counted
# ld([data_stack_pointer], X)
ld(lo("forth.core.RSHIFT.n<8.continuation1"))
st([continuation]) # 5
bra("right-shift-by-n")
ld([amount])
label("forth.core.RSHIFT.n<8.continuation1")
st([Y, Xpp])
ld(lo("forth.core.RSHIFT.n<8.continuation2"))
st([continuation]) # 10
bra("left-shift-by-n")
ld([transfer_amount])
label("forth.core.RSHIFT.n<8.continuation2")
ld([data_stack_pointer], X)
ora([Y, X])
st([Y, Xpp]) # 15
ld(lo("forth.core.RSHIFT.n<8.continuation3"))
st([continuation])
bra("right-shift-by-n.second-time")
ld([mask])
label("forth.core.RSHIFT.n<8.continuation3")
st([Y, X]) # 20
NEXT(cost_of_rshift__amount_lt_8)
def _copy_W_to_IP(*, increment_by):
ld([W_hi])
C(f"Copy [W] to [IP], incrementing it by {increment_by}")
st([IP_hi])
ld([W_lo])
adda(increment_by)
st([IP_lo])
def set():
"""Write a call value at an aligned address ( x a-addr -- )"""
label("forth.core.!")
adda(-add_cost_of_next(cost_of_set) / 2) # 1
ld(data_stack_page, Y)
C("Remove 4 bytes from stack (SP moves by 4)")
ld([data_stack_pointer])
ld(AC, X)
adda(4) # 5
st([data_stack_pointer]) # 6
address_low, address_high, data_low, data_high = tmp0, tmp1, tmp2, tmp3
C("Copy stack data and low part of address to temporary")
for dest in [address_low, address_high, data_low]:
ld([Y, X]) # 1
st([dest])
st([Y, Xpp]) # 3
ld([Y, X]) # 1
st([data_high])
C("Load address")
ld([address_low], X)
ld([address_high], Y)
C("Write data")
ld([data_low]) # 5
st([Y, Xpp])
ld([data_high])
st([Y, X]) # 8
NEXT(cost_of_set)
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 drop():
label("forth.core." + name)
adda(-add_cost_of_next(cost_of_drop) / 2)
ld([data_stack_pointer])
adda(size)
st([data_stack_pointer])
NEXT(cost_of_drop)
def _lshift__amount_lt_8():
"""LSHIFT (x1 u -- x2)
Special case where u < 8
"""
label("forth.core.LSHIFT.n<8")
adda(-add_cost_of_next(cost_of_lshift__amount_lt_8) / 2) # 1
# ld(data_stack_page, Y)
# ld([data_stack_pointer], X)
ld(lo("forth.core.LSHIFT.n<8.continuation1"))
st([continuation]) # 5
bra("right-shift-by-n")
ld([transfer_amount])
label("forth.core.LSHIFT.n<8.continuation1")
st([high_byte_temp])
ld(lo("forth.core.LSHIFT.n<8.continuation2"))
st([continuation]) # 10
bra("left-shift-by-n")
ld([amount])
label("forth.core.LSHIFT.n<8.continuation2")
st([Y, Xpp])
ld(lo("forth.core.LSHIFT.n<8.continuation3"))
st([continuation]) # 15
bra("left-shift-by-n")
ld([amount])
label("forth.core.LSHIFT.n<8.continuation3")
ora([high_byte_temp])
st([Y, X]) # 19
NEXT(cost_of_lshift__amount_lt_8)
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 invert():
label("forth.core.INVERT")
adda(-add_cost_of_next(cost_of_invert) / 2) # 1
ld(data_stack_page, Y)
ld([data_stack_pointer], X)
ld([Y, X])
xora(0xFF) # 5
st([Y, Xpp])
ld([Y, X])
xora(0xFF)
st([Y, X]) # 9
NEXT(cost_of_invert)
def _rshift__amount_eq_8():
# Offset to n==8 case = 3
label("forth.core.RSHIFT.n==8")
adda(-add_cost_of_next(cost_of_rshift__amount_eq_8) / 2) # 1
# ld(data_stack_page, Y) # Happen in head of page, but still counted
# ld([data_stack_pointer], X)
st([Y, Xpp]) # Blat low byte
ld([Y, X]) # 5
ld([data_stack_pointer], X)
st([Y, Xpp])
ld(0)
st([Y, X]) # 9
NEXT(cost_of_rshift__amount_eq_8)
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 _two_times():
"""Implements a left-shift by one which is used for two words
2* ( x1 -- x2 )
CELLS ( n1 -- n2 )
"""
label("forth.core.2*")
label("forth.core.CELLS")
adda(-add_cost_of_next(cost_of_two_times) / 2) # 1
# ld(data_stack_page, Y) # Implemented in page header, but still counted here.
# ld([data_stack_pointer], X)
C("Load low-byte")
ld([X])
anda(0b1000_0000, X) # 5
C("Calculate bit to shift in to the high-byte")
ld([X])
st([tmp0])
ld([data_stack_pointer], X)
C("Reload and left-shift")
ld([X])
adda(AC) # 10
st([Y, Xpp])
ld([Y, X])
C("Load high byte and left-shift")
adda(AC)
adda([tmp0])
st([Y, X]) # 15
NEXT(cost_of_two_times)
def next3_ram_rom():
"""NEXT3 to use when in RAM->ROM mode"""
label("forth.next3.ram-rom-mode")
adda(-(cost_of_next3_ram_rom / 2)) # 1
ld([IP_hi], Y) # 2
C("W <- [IP]")
ld([IP_lo], X) # 3
ld([Y, X]) # 4
st([W_lo]) # 5
ld([IP_lo]) # 6
adda(1) # 7
ld(AC, X) # 8
ld([Y, X]) # 9
# Increment IP
st([W_hi]) # 10
C("IP <- IP + 2")
ld([IP_lo]) # 11
adda(2) # 12
beq(pc() + 5) # 13
st([IP_lo]) # 14
REENTER(14)
label(".page-boundary")
ld([IP_hi]) # 15
adda(1) # 16
st([IP_hi]) # 17
REENTER(17)
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 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 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 two_dup():
label("forth.core.2DUP")
adda(-add_cost_of_next(cost_of_2dup) / 2) # 1
ld(data_stack_page, Y)
ld([data_stack_pointer], X) # 3
for tmp in [tmp0, tmp1, tmp2, tmp3]:
ld([Y, X])
st([tmp])
st([Y, Xpp]) # 15 = 3 + 4 * 3
ld([data_stack_pointer])
suba(4)
st([data_stack_pointer], X) # 18
for tmp in [tmp0, tmp1, tmp2, tmp3]:
ld([tmp])
st([Y, Xpp]) # 26 = 18 + 4 * 2
NEXT(cost_of_2dup)
def _lshift__amount_eq_8():
"""LSHIFT (x1 u -- x2)
Special case where u = 8
"""
label("forth.core.LSHIFT.n==8")
adda(-add_cost_of_next(cost_of_lshift__amount_eq_8) / 2) # 1
# ld(data_stack_page, Y)
# ld([data_stack_pointer], X)
ld([Y, X])
st([tmp0]) # 5
ld(0)
st([Y, Xpp])
ld([tmp0])
st([Y, X]) # 9
NEXT(cost_of_lshift__amount_eq_8)
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 _rshift__amount_gt_8():
# offset to n > 8 case
label("forth.core.RSHIFT.n>8")
adda(-add_cost_of_next(cost_of_rshift__amount_gt_8) / 2) # 1
# ld(data_stack_page, Y) # Happen in head of page, but still counted
# ld([data_stack_pointer], X)
ld(lo("forth.core.RSHIFT.n>8.continuation"))
st([continuation]) # 5
bra("right-shift-by-n")
ld([amount])
label("forth.core.RSHIFT.n>8.continuation")
st([Y, Xpp])
st([Y, Xpp])
ld([data_stack_pointer], X) # 10
ld(0)
st([Y, X]) # 12
NEXT(cost_of_rshift__amount_gt_8)
def next1_reenter(vTicks):
label("forth.next1.reenter")
label(
"forth.next1.reenter.even"
) # When a word took an even number of cycles, enter here
nop() # 1
label(
"forth.next1.reenter.odd"
) # Inbound code should round down ticks, because counting is from .even
suba((cost_of_successful_test + cost_of_next1_reenter_success) / 2) # 2
adda([vTicks]) # 3
st([vTicks]) # 4; If we exit successfully we'll be ready for next1
suba(cost_of_failed_test / 2) # 5
blt(lo("forth.exit.from-next1-reenter")) # 6
vticks_error = cost_of_next1_reenter_success - cost_of_next1_reenter_failure
ld((vticks_error / 2)) # 7 ; load vTicks wrongness into A
bra(lo("forth.next1")) # 8
ld([vTicks]) # 9
def char_at():
label("forth.core.C@")
adda(-add_cost_of_next(cost_of_char_at) / 2) # 1
ld(data_stack_page, Y)
ld([data_stack_pointer], X)
ld([Y, X])
st([tmp0]) # 5
st([Y, Xpp])
ld([Y, X])
ld(AC, Y)
ld([tmp0], X)
ld([Y, X]) # 10
ld(data_stack_page, Y)
ld([data_stack_pointer], X)
st([Y, Xpp])
ld(0)
st([Y, X]) # 15
NEXT(cost_of_char_at)
def decrement():
"Subtract one from the top of the stack (n -- n)"
label("forth.core.1-")
adda(-add_cost_of_next(cost_of_decrement) / 2) # 1
ld(data_stack_page, Y)
ld([data_stack_pointer], X)
ld([Y, X])
beq(lo(".low-byte-was-zero")) # 5
suba(1) # 6
st([Y, X]) # 7
NEXT(cost_of_decrement__one_word_written)
label(".low-byte-was-zero")
st([Y, Xpp]) # 7
ld([Y, X])
suba(1)
st([Y, X]) # 10
NEXT(cost_of_decrement__two_words_written)
def dup():
label("forth.core.DUP")
adda(-add_cost_of_next(cost_of_dup) / 2)
ld([data_stack_pointer], X)
ld([X])
st([tmp0])
ld([data_stack_pointer]) # 5
adda(1, X)
ld([X])
st([tmp1])
ld(data_stack_page, Y)
ld([data_stack_pointer]) # 10
suba(2)
st([data_stack_pointer], X)
ld([tmp0])
st([Y, Xpp])
ld([tmp1]) # 15
st([Y, X]) # 16
NEXT(cost_of_dup)
def zero_equal():
"""Logical not ( x -- flag )
flag is true if and only if x is equal to zero.
"""
label("forth.core.0=")
adda(-add_cost_of_next(cost_of_zero_equal) / 2) # 1
ld(data_stack_page, Y)
ld([data_stack_pointer], X)
ld([Y, X])
st([Y, Xpp]) # 5
ora([Y, X])
beq(pc() + 3) # 7
bra(pc() + 3) # 8
ld(0x00) # 9 - If any bits were non-zero
ld(0xFF) # 9 - Otherwise
ld([data_stack_pointer], X) # 10
st([Y, Xpp])
st([Y, X]) # 12
NEXT(cost_of_zero_equal)
def _lshift__amount_gt_8():
"""LSHIFT (x1 u -- x2)
Special case where u > 8
"""
label("forth.core.LSHIFT.n>8")
adda(-add_cost_of_next(cost_of_lshift__amount_gt_8) / 2) # 1
# ld(data_stack_page, Y)
# ld([data_stack_pointer], X)
ld(lo("forth.core.LSHIFT.n>8.continuation"))
st([continuation]) # 5
bra("left-shift-by-n") # 6
ld([amount]) # 7
label("forth.core.LSHIFT.n>8.continuation")
st([Y, Xpp]) # 1
st([Y, Xpp]) # 2
ld([data_stack_pointer], X) # 3
ld(0) # 4
st([Y, Xpp]) # 5
NEXT(cost_of_lshift__amount_gt_8)
def swap():
label("forth.core.SWAP")
adda(-add_cost_of_next(cost_of_swap) / 2)
C("Copy top 4 bytes of stack to tmp")
ld([data_stack_pointer], X)
ld([X])
st([tmp0]) # 4
# TODO: should this loop be in the assembly, or is unrolled better?
for i, location in enumerate([tmp1, tmp2, tmp3], start=1):
ld([data_stack_pointer])
adda(i)
ld(AC, X)
ld([X])
st([location]) # 5
ld(data_stack_page, Y)
C("Copy back to stack in order")
ld([data_stack_pointer], X) # 2
for location in [tmp2, tmp3, tmp0, tmp1]:
ld([location])
st([Y, Xpp]) # 2
NEXT(cost_of_swap)
def rot():
label("forth.core.ROT")
adda(-add_cost_of_next(cost_of_rot) / 2)
ld(data_stack_page, Y) # 2
# copy 3OS -> tmp{0,1}
for offset, dest in enumerate([tmp0, tmp1], start=4):
ld([data_stack_pointer])
adda(offset, X)
ld([X])
st([dest])
# Shift Everything down, Filling with tmp{0,1}
ld([data_stack_pointer], X) # 11 = 2 + 2 * 4 + 1
for to, from_ in zip([tmp2, tmp0, tmp1, tmp2], [tmp0, tmp1, tmp2, tmp0]):
ld([X])
st([to])
ld([from_])
st([Y, Xpp])
for src in [tmp1, tmp2]: # 27 = 11 + 16
ld([src])
st([Y, Xpp])
NEXT(cost_of_rot)
def char_set():
"""Write a character at an address ( char c-addr -- )"""
label("forth.core.C!")
adda(-add_cost_of_next(cost_of_char_set) / 2) # 1
ld(data_stack_page, Y)
C("Pop 2 byte address to temp (SP moves by 4)")
ld([data_stack_pointer])
ld(AC, X)
adda(4) # 5
st([data_stack_pointer]) # 6
for dest in [tmp0, tmp1]:
ld([Y, X])
st([dest])
st([Y, Xpp])
ld([Y, X])
C("Load low-byte of char - top byte ignored")
ld([tmp0], X)
ld([tmp1], Y)
st([Y, X])
C("Write")
NEXT(cost_of_char_set)
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
