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 _left_shift_by_n():
"""Fixed cost routine to do a left-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
"""
label("left-shift-by-n")
# Because we do n shift operations, with 0 < n < 8
# we need to balance it with 7 - n nops - so that we always do
# 7 ops in total
adda(lo(".end-of-left-shifts")) # 1
st([tmp0]) # Where we jump in the left-shifts
suba(lo(".end-of-left-shifts") - 7)
xora(0xFF) # ac = -(shift-amount) + 7; Negate it.
adda(lo(".end-of-nops") + 1) # 5; +1 is to finish two's complement
bra(AC) # 6
ld([tmp0]) # 7 ; Shift by 1
nop() # Shift by 2
nop() # Shift by 3
nop() # Shift by 4
nop() # Shift by 5
nop() # Shift by 6
label(".end-of-nops")
bra(AC) # 8;
ld([Y, X]) # 9
adda(AC) # Shift by 7
adda(AC) # Shift by 6
adda(AC) # Shift by 5
adda(AC) # Shift by 4
adda(AC) # Shift by 3
adda(AC) # Shift by 2
bra([continuation]) # 10 # Shift by 1
label(".end-of-left-shifts")
adda(AC) # (counted as one of the 7)
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 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 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_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 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 emit_entry_page(vticks, vreturn):
"""Emit the data for NEXT and some other core routines
The first page does not have the 'restart-or-quit' trampoline at 0x00
So we can't put any Forth word in here.
"""
while pc() & 255 < 255:
nop()
assert _next.INTERPRETER_ENTER_PAGE == pc() >> 8
label("FORTH_ENTER")
C("You are now entering... Forth")
adda(_next.INBOUND_TICK_CORRECTION)
# --- Page boundary ---
align(0x100, 0x100)
st([vticks])
_next.next1(vticks)
_next.next1_reenter(vticks)
_next.next2(vticks)
_next.exit(vticks, vreturn)
_docol_exit.do_docol_rom()
_docol_exit.do_docol_ram()
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
shiftTable = pc()
for ix in range(255):
for n in range(1, 9): # Find first zero
if ~ix & (1 << (n - 1)):
break
pattern = [
"x" if i < n else "1" if ix & (1 << i) else "0" for i in range(8)
]
ld(ix >> n)
C("0b%s >> %d" % ("".join(reversed(pattern)), n))
assert pc() & 255 == 255
bra([continuation]) # Jumps back into next page
align(0x100, size=0x100)
nop() #
label("multiply 7x7")
# The formula is floor(((a + b) ** 2) / 4) - floor(((a - b) ** 2) / 4)
ld(".after-first-lookup") # 1
st([continuation])
ld(hi("Quarter-squares lookup table"), Y)
ld("high-byte action.store")
st([high_byte_action]) # 5
ld([a])
jmp(Y, "table entry") # 7
adda([b]) # 8
cost_to_first_lookup = 8
cost_after_first_lookup = (cost_to_first_lookup +
def _shift_entry(*, offset_to_amount_eq_8, offset_to_amount_gt_8,
offset_to_amount_lt_8):
# Structurally left and right shift are very similar,
# and we can share a lot of code.
# There are five major cases for each (n is the shift amount):
# n == 0 : We don't do anything but adjust stack height.
# 0 < n < 8 : The most complicated case - we need to shift both
# bytes and also transfer bits from one to the other
# n == 8 : Quite simple, one byte takes its value from the other
# which becomes zero
# 8 < n < 16 : Shift one byte, and store into the other.
# Store zero in first byte.
# 16 <= n : Result is zero (technically we could ignore this).
#
# These have very different costs!
# The entry point for both LSHIFT and RSHIFT call a single routine.
# It loads the shift amount, and works out which of the cases we're
# in. n == 0, and n > 16 are both handled immediately, followed by
# NEXT.
# For the other three cases, we dispatch to different routines by
# adjusting W and calling REENTER.
# The code is structured so that the we need to apply to W is the
# same whether we're doing a left or right shift.
# LSHIFT and RSHIFT both begin with the following sequence
# adda(-add_cost_of_next(cost_of_shift_entry) / 2) # 1
# ld(data_stack_page, Y) # 2
# ld([data_stack_pointer], X) # 3
# bra("forth.core.shift.entry") # 4
# ld([data_stack_pointer]) # 5
# (The loads of X and Y technically happen elsewhere, but we count
# them here)
label("forth.core.shift.entry")
adda(2) # 6
st([data_stack_pointer])
# Load amount:
ld([Y, X]) # Load low-byte of amount
st([Y, Xpp])
st([amount]) # 10
ora([Y, X])
beq("forth.core.shift.entry.amount-zero") # 12
# Numbers greater than 16 must have bit 4 or higher set.
# AND with 0xf0 will reveal high bits set.
ld(0xF0) # 13; Test for 16s place or higher being set in low byte
anda([amount])
ora([Y, X]) # 15; Or any bit in high byte
bne("forth.core.shift.entry.amount-gte16") # 16
# We want different values depending on which path we're going to follow
# the n < 8 case wants -(n) and -(8 - n) = n - 8.
# The n > 8 case wants -(n - 8) = 8 - n
# The n = 8 case needs nothing.
# Because the < 8 case has two variables, give it the "default" path
# TODO: I feel very deeply that there must be a nicer way of doing this
# TODO: Probably something todo with XOR.
ld([amount]) # 17
suba(8)
bgt("forth.core.shift.entry.amount-gt8") # 19
beq("forth.core.shift.entry.amount-eq8") # 20
st([transfer_amount]) # 21 # For the n < 8 case
ld(0)
suba([amount])
st([amount])
ld(offset_to_amount_lt_8) # 25
label(".adjust_W")
adda([W_lo]) # 26
st([W_lo]) # 27
REENTER(27)
label("forth.core.shift.entry.amount-eq8")
nop() # 22
nop()
bra(lo(".adjust_W")) # 24
ld(offset_to_amount_eq_8) # 25
label("forth.core.shift.entry.amount-gt8")
ld(8) # 21
suba([amount])
st([amount])
bra(".adjust_W") # 24
ld(offset_to_amount_gt_8) # 25
label("forth.core.shift.entry.amount-zero")
NEXT(13)
label("forth.core.shift.entry.amount-gte16")
st([Y, Xpp]) # 18
ld(0)
st([Y, Xpp]) # 20
st([Y, Xpp]) # 21
NEXT(21)