mirror of
https://github.com/piotr-wiszowaty/foco65.git
synced 2024-12-17 20:30:12 +00:00
1948 lines
33 KiB
Python
Executable File
1948 lines
33 KiB
Python
Executable File
#!/usr/bin/env python
|
|
|
|
# foco65
|
|
# Copyright (C) 2014 Piotr Wiszowaty
|
|
#
|
|
# This program is free software: you can redistribute it and/or modify
|
|
# it under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation, either version 3 of the License, or
|
|
# (at your option) any later version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with this program. If not, see {http://www.gnu.org/licenses/}.
|
|
|
|
import argparse
|
|
import re
|
|
import sys
|
|
|
|
#####
|
|
|
|
class StackUnderflow(Exception):
|
|
def __init__(self, text, line, column):
|
|
self.text = text
|
|
self.line = line
|
|
self.column = column
|
|
|
|
def __str__(self):
|
|
return "stack underflow (%d,%d): %s" % (self.line, self.column, self.text)
|
|
|
|
|
|
class StackNotEmpty(Exception):
|
|
def __init__(self, line, column):
|
|
self.line = line
|
|
self.column = column
|
|
|
|
def __str__(self):
|
|
return "stack not empty (%d,%d)" % (self.line, self.column)
|
|
|
|
|
|
class ParseError(Exception):
|
|
def __init__(self, message, line, column):
|
|
self.message = message
|
|
self.line = line
|
|
self.column = column
|
|
|
|
def __str__(self):
|
|
return "%s at line %d column %d" % (self.message, self.line, self.column)
|
|
|
|
|
|
class UnknownWord(ParseError):
|
|
def __init__(self, token):
|
|
ParseError.__init__(self, "unknown word '%s'" % token.text, token.line, token.column)
|
|
|
|
|
|
class UnexpectedEndOfStream(ParseError):
|
|
def __init__(self, line, column):
|
|
ParseError.__init__(self, "unexpected end of input", line, column)
|
|
|
|
#####
|
|
|
|
class Token:
|
|
def __init__(self, text, line, column):
|
|
self.text = text
|
|
self.line = line
|
|
self.column = column
|
|
|
|
def __eq__(self, other):
|
|
return self.text == other
|
|
|
|
def __str__(self):
|
|
return "'%s' %d,%d" % (self.text, self.line, self.column)
|
|
|
|
def endswith(self, s):
|
|
return self.text.endswith(s)
|
|
|
|
def replace(self, s_from, s_to):
|
|
return self.text.replace(s_from, s_to)
|
|
|
|
def canon(self):
|
|
return self.text.replace("-", "_").replace("?", "_is_")
|
|
|
|
#####
|
|
|
|
class Input:
|
|
WHITESPACE = " \t\n"
|
|
EOL = "\n"
|
|
|
|
def __init__(self, text):
|
|
self.text = text
|
|
self.offset = 0
|
|
self.line = 1
|
|
self.column = 1
|
|
|
|
def __iter__(self):
|
|
return self
|
|
|
|
def mark_start(self):
|
|
self._mark_start = self.offset
|
|
|
|
def mark_end(self):
|
|
self._mark_end = self.offset
|
|
|
|
def marked(self):
|
|
return self.text[self._mark_start:self._mark_end]
|
|
|
|
def end(self):
|
|
return self.offset >= len(self.text)
|
|
|
|
def current_char(self):
|
|
if self.end(): return None
|
|
return self.text[self.offset]
|
|
|
|
def next_char(self):
|
|
if self.end():
|
|
raise UnexpectedEndOfStream(self.line, self.column)
|
|
c = self.text[self.offset]
|
|
self.offset += 1
|
|
if c in self.EOL:
|
|
self.line += 1
|
|
self.column = 1
|
|
else:
|
|
self.column += 1
|
|
return c
|
|
|
|
def skip_to_eol(self):
|
|
while self.current_char() != "\n":
|
|
self.next_char()
|
|
|
|
def next(self):
|
|
while self.current_char() in self.WHITESPACE:
|
|
self.next_char()
|
|
if self.end(): return None
|
|
if self.end(): raise StopIteration
|
|
line, column, start = self.line, self.column, self.offset
|
|
while self.current_char() not in self.WHITESPACE:
|
|
self.next_char()
|
|
return Token(self.text[start:self.offset], line, column)
|
|
|
|
#####
|
|
|
|
class Code:
|
|
def __init__(self, code, section):
|
|
self.code = code
|
|
self.section = section
|
|
|
|
def output(self, section):
|
|
if section == self.section:
|
|
return self.code[1:] + "\n"
|
|
else:
|
|
return ""
|
|
|
|
#####
|
|
|
|
class Word:
|
|
def __init__(self, name, section, code="", label=None):
|
|
self.name = name
|
|
self.section = section
|
|
self.thread = ["enter"]
|
|
self.names = []
|
|
self.code = code
|
|
if label:
|
|
self.label = label
|
|
else:
|
|
self.label = name
|
|
self.recursive = False
|
|
self.used = False
|
|
|
|
def output(self, section):
|
|
if self.used and self.section == section:
|
|
if self.code:
|
|
cout = self.code.output(section)
|
|
return "%s\n dta a(*+2)\n%s\n" % (self.label, cout)
|
|
else:
|
|
s = "\n".join(map(lambda l: " dta a(%s)" % l, self.thread))
|
|
return "%s\n%s\n\n" % (self.label, s)
|
|
else:
|
|
return ""
|
|
|
|
def __iter__(self):
|
|
return iter(self.names)
|
|
|
|
def add(self, label, name=None):
|
|
self.thread.append(label)
|
|
if name is not None:
|
|
self.names.append(name)
|
|
|
|
def ip(self):
|
|
return len(self.thread)
|
|
|
|
#####
|
|
|
|
class RefBase:
|
|
def __init__(self, name, label, value, text_section, data_section):
|
|
self.name = name
|
|
self.value = value
|
|
self.text_section = text_section
|
|
self.data_section = data_section
|
|
self.used = False
|
|
|
|
def output(self, section):
|
|
if self.used:
|
|
if section == self.text_section:
|
|
return self.text_output
|
|
elif section == self.data_section:
|
|
return self.data_output
|
|
else:
|
|
return ""
|
|
else:
|
|
return ""
|
|
|
|
def __iter__(self):
|
|
return iter([])
|
|
|
|
|
|
class Constant(RefBase):
|
|
def __init__(self, name, label, value, text_section, data_section):
|
|
RefBase.__init__(self, name, label, value, text_section, data_section)
|
|
self.label = "const_" + label
|
|
self.text_output = "%s\n dta a(const),a(%s)\n" % (self.label, label)
|
|
self.data_output = "%s equ %s\n" % (label, self.value)
|
|
|
|
|
|
class Variable(RefBase):
|
|
def __init__(self, name, label, size, text_section, data_section):
|
|
RefBase.__init__(self, name, label, None, text_section, data_section)
|
|
self.label = "var_" + label
|
|
self.text_output = "%s\n dta a(const),a(%s)\n" % (self.label, label)
|
|
if size:
|
|
self.data_output = "%s equ *\n org *+%d\n" % (label, 2*size)
|
|
else:
|
|
self.data_output = "%s equ *\n" % label
|
|
|
|
#####
|
|
|
|
class BranchTarget:
|
|
def __init__(self, ip):
|
|
self.ip = ip
|
|
self.label = None
|
|
|
|
def update(self, ip):
|
|
if ip > self.ip:
|
|
self.label = "*+%d" % (2 * (ip - self.ip))
|
|
elif ip < self.ip:
|
|
self.label = "*-%d" % (2 * (self.ip - ip))
|
|
|
|
def __str__(self):
|
|
return self.label
|
|
|
|
#####
|
|
|
|
class Words:
|
|
def __init__(self):
|
|
self.lst = []
|
|
self.aliases = {"cells": "2*", "cell": "2*", "not": "0="}
|
|
|
|
def __iter__(self):
|
|
return iter(self.lst)
|
|
|
|
def find(self, name):
|
|
if self.aliases.has_key(name):
|
|
name = self.aliases[name]
|
|
for word in self.lst:
|
|
if word.name == name:
|
|
return word
|
|
return None
|
|
|
|
def add(self, word):
|
|
self.lst.insert(0, word)
|
|
|
|
#####
|
|
|
|
class Forth:
|
|
def __init__(self, sections):
|
|
self.words = Words()
|
|
self.items = []
|
|
self.sections = sections
|
|
self.text_section = "text"
|
|
self.data_section = "data"
|
|
self.stack = []
|
|
self.do_loop_stack = []
|
|
self.int_prog = re.compile("-?[0-9]+")
|
|
self.hex_prog = re.compile("\$[0-9A-Fa-f]+")
|
|
self.state = None
|
|
|
|
def push(self, item):
|
|
self.stack.append(item)
|
|
|
|
def pop(self, token):
|
|
if not self.stack:
|
|
raise StackUnderflow(token.text, token.line, token.column)
|
|
else:
|
|
return self.stack.pop()
|
|
|
|
def push_do_loop(self):
|
|
self.do_loop_stack.append([])
|
|
|
|
def push_do_loop_leave(self, branch_target):
|
|
self.do_loop_stack[-1].append(branch_target)
|
|
|
|
def pop_do_loop(self, token):
|
|
if not self.do_loop_stack:
|
|
raise StackUnderflow(token.text, token.line, token.column)
|
|
else:
|
|
return self.do_loop_stack.pop()
|
|
|
|
def add_word(self, word):
|
|
self.words.add(word)
|
|
self.items.append(word)
|
|
|
|
def isnumber(self, token):
|
|
return token is not None and \
|
|
(self.int_prog.match(token.text) or \
|
|
self.hex_prog.match(token.text))
|
|
|
|
def tonumber(self, x):
|
|
if type(x) == int:
|
|
return x
|
|
elif self.hex_prog.match(x):
|
|
return int(x[1:], 16)
|
|
else:
|
|
return int(x)
|
|
|
|
def next(self):
|
|
token = self.input.next()
|
|
if token == "\\":
|
|
self.input.skip_to_eol()
|
|
return self.next()
|
|
elif token == "(":
|
|
while not token.endswith(")"):
|
|
token = self.input.next()
|
|
return self.next()
|
|
else:
|
|
return token
|
|
|
|
def set_state(self, state):
|
|
self.state = state
|
|
|
|
def parse_input(self, input):
|
|
self.input = input
|
|
self.set_state("interpret")
|
|
while not self.input.end():
|
|
if self.state == "interpret":
|
|
self.interpret()
|
|
elif self.state == "compile":
|
|
self.compile(self.word)
|
|
|
|
def interpret(self):
|
|
token = self.next()
|
|
if token == ":":
|
|
token = self.next()
|
|
self.word = Word(token.text, self.text_section, label=token.canon())
|
|
self.set_state("compile")
|
|
elif token == "[code]":
|
|
self.items.append(self.parse_code())
|
|
elif token == "[text-section]":
|
|
self.text_section = self.parse_section()
|
|
elif token == "[data-section]":
|
|
self.data_section = self.parse_section()
|
|
elif token == "variable":
|
|
self.parse_variable(1)
|
|
elif token == "2variable":
|
|
self.parse_variable(2)
|
|
elif token == "constant":
|
|
self.parse_constant(token)
|
|
elif token == "create":
|
|
self.parse_create()
|
|
elif token == ",":
|
|
self.parse_comma(token)
|
|
elif token == "c,":
|
|
self.parse_c_comma(token)
|
|
elif token == ',"':
|
|
self.parse_comma_doublequote()
|
|
elif token == ",'":
|
|
self.parse_comma_quote(True)
|
|
elif token == "'":
|
|
self.parse_comma_quote(False)
|
|
elif token == "allot":
|
|
self.parse_allot(token)
|
|
elif token == "+":
|
|
x2 = self.pop(token)
|
|
x1 = self.pop(token)
|
|
self.push(x1 + x2)
|
|
elif token == "-":
|
|
x2 = self.pop(token)
|
|
x1 = self.pop(token)
|
|
self.push(x1 - x2)
|
|
elif token == "*":
|
|
x2 = self.pop(token)
|
|
x1 = self.pop(token)
|
|
self.push(x1 * x2)
|
|
elif token == "cells":
|
|
x = self.pop(token)
|
|
self.push(2 * x)
|
|
elif token == "/":
|
|
x2 = self.pop(token)
|
|
x1 = self.pop(token)
|
|
self.push(x1 / x2)
|
|
elif token == "]":
|
|
self.set_state("compile")
|
|
elif self.isnumber(token):
|
|
self.push(self.tonumber(token.text))
|
|
elif token is not None:
|
|
word = self.words.find(token.text)
|
|
if word is not None:
|
|
word.used = True
|
|
if isinstance(word, Constant):
|
|
self.push(self.tonumber(word.value))
|
|
else:
|
|
self.push(word.name)
|
|
else:
|
|
raise UnknownWord(token)
|
|
|
|
def compile(self, word):
|
|
if self.input.end():
|
|
raise UnexpectedEndOfStream(self.input.line, self.input.column)
|
|
token = self.next()
|
|
if token == ";":
|
|
word.add("exit")
|
|
self.add_word(word)
|
|
self.set_state("interpret")
|
|
elif token == "recursive":
|
|
word.recursive = True
|
|
elif token == "[label]":
|
|
token = self.next()
|
|
word.label = token.text
|
|
elif token == "[code]":
|
|
word.code = self.parse_code()
|
|
elif token == "begin":
|
|
self.push(word.ip())
|
|
elif token == "again":
|
|
word.add("branch")
|
|
begin_ip = self.pop(token)
|
|
target = BranchTarget(word.ip())
|
|
target.update(begin_ip)
|
|
word.add(target)
|
|
elif token == "until":
|
|
word.add("until")
|
|
begin_ip = self.pop(token)
|
|
target = BranchTarget(word.ip())
|
|
target.update(begin_ip)
|
|
word.add(target)
|
|
elif token == "if":
|
|
word.add("_if")
|
|
target = BranchTarget(word.ip())
|
|
word.add(target)
|
|
self.push(target)
|
|
elif token == "else":
|
|
word.add("branch")
|
|
target1 = BranchTarget(word.ip())
|
|
word.add(target1)
|
|
target0 = self.pop(token)
|
|
target0.update(word.ip())
|
|
self.push(target1)
|
|
elif token == "then":
|
|
target = self.pop(token)
|
|
target.update(word.ip())
|
|
elif token == "while":
|
|
word.add("while", "while")
|
|
target = BranchTarget(word.ip())
|
|
word.add(target)
|
|
self.push(target)
|
|
elif token == "repeat":
|
|
word.add("branch")
|
|
target1 = self.pop(token)
|
|
begin_ip = self.pop(token)
|
|
target0 = BranchTarget(word.ip())
|
|
target0.update(begin_ip)
|
|
word.add(target0)
|
|
target1.update(word.ip())
|
|
elif token == "[":
|
|
self.set_state("interpret")
|
|
elif token == "literal":
|
|
self.word.add("lit")
|
|
tos = self.pop(token)
|
|
if isinstance(tos, int):
|
|
txt = str(tos)
|
|
elif isinstance(tos, str):
|
|
txt = tos
|
|
else:
|
|
txt = tos.output(self.text_section)
|
|
self.word.add(txt)
|
|
elif token == "do":
|
|
word.add("do", "do")
|
|
self.push(word.ip())
|
|
self.push_do_loop()
|
|
elif token == "loop" or token == "+loop":
|
|
word.add(token.text.replace("+", "plus_"), token.text)
|
|
do_ip = self.pop(token)
|
|
target = BranchTarget(word.ip())
|
|
target.update(do_ip)
|
|
word.add(target)
|
|
for leave in self.pop_do_loop(token):
|
|
leave.update(word.ip())
|
|
elif token == "leave":
|
|
word.add("unloop", "unloop")
|
|
word.add("branch")
|
|
target = BranchTarget(word.ip())
|
|
word.add(target)
|
|
self.push_do_loop_leave(target)
|
|
elif token == "lit":
|
|
word.add("lit")
|
|
token = self.next()
|
|
word.add(token.text, token.text)
|
|
else:
|
|
if word.recursive and token == word.name:
|
|
subword = word
|
|
else:
|
|
subword = self.words.find(token.text)
|
|
if subword is not None:
|
|
word.add(subword.label, subword.name)
|
|
else:
|
|
if self.isnumber(token):
|
|
word.add("lit")
|
|
word.add(token.text)
|
|
else:
|
|
raise UnknownWord(token)
|
|
|
|
def parse_code(self):
|
|
self.input.mark_start()
|
|
while True:
|
|
self.input.mark_end()
|
|
token = self.next()
|
|
if token == "[end-code]":
|
|
return Code(self.input.marked(), self.text_section)
|
|
|
|
def parse_section(self):
|
|
token = self.next()
|
|
return token.text
|
|
|
|
def parse_variable(self, size):
|
|
token = self.next()
|
|
name = token.text
|
|
label = token.canon()
|
|
word = Variable(name, label, size, self.text_section, self.data_section)
|
|
self.add_word(word)
|
|
|
|
def parse_constant(self, token):
|
|
token = self.next()
|
|
num = self.pop(token)
|
|
word = Constant(token.text, token.canon(), num, self.text_section, self.data_section)
|
|
self.add_word(word)
|
|
|
|
def parse_create(self):
|
|
token = self.next()
|
|
name = token.text
|
|
label = token.canon()
|
|
word = Variable(name, label, 0, self.text_section, self.data_section)
|
|
self.add_word(word)
|
|
|
|
def parse_allot(self, token):
|
|
count = self.pop(token)
|
|
self.items.append(Code("\n org *+%d" % count, self.data_section))
|
|
|
|
def parse_comma(self, token):
|
|
item = Code("\n dta a(%s)" % self.pop(token), self.data_section)
|
|
self.items.append(item)
|
|
|
|
def parse_c_comma(self, token):
|
|
item = Code("\n dta %d" % self.pop(token), self.data_section)
|
|
self.items.append(item)
|
|
|
|
def parse_comma_doublequote(self, counted):
|
|
# allocate ASCII string
|
|
self.input.mark_start()
|
|
while True:
|
|
token = self.next()
|
|
if token.endswith('"'):
|
|
self.input.mark_end()
|
|
text = self.input.marked()[1:-1]
|
|
if counted:
|
|
count = "%d," % len(text)
|
|
else:
|
|
count = ""
|
|
item = Code("\n dta %sc'%s'" % (count, text), self.data_section)
|
|
self.items.append(item)
|
|
break
|
|
|
|
def parse_comma_quote(self, counted):
|
|
# allocate ANTIC string
|
|
self.input.mark_start()
|
|
while True:
|
|
token = self.next()
|
|
if token.endswith("'") or token.endswith("'*"):
|
|
self.input.mark_end()
|
|
if token.endswith("*"):
|
|
text = self.input.marked()[1:-2]
|
|
inverse = "*"
|
|
else:
|
|
text = self.input.marked()[1:-1]
|
|
inverse = ""
|
|
if counted:
|
|
count = "%d," % len(text)
|
|
else:
|
|
count = ""
|
|
item = Code("\n dta %sd'%s'%s" % (count, text, inverse), self.data_section)
|
|
self.items.append(item)
|
|
break
|
|
|
|
def filter_used_words(self, name):
|
|
word = self.words.find(name)
|
|
if word is not None:
|
|
if not word.used:
|
|
word.used = True
|
|
for name in word:
|
|
self.filter_used_words(name)
|
|
|
|
def generate_output(self):
|
|
self.filter_used_words("main")
|
|
if self.stack:
|
|
raise StackNotEmpty(self.input.line, self.input.column)
|
|
section_outputs = []
|
|
for section in self.sections:
|
|
section_outputs.append("; section %s\n" % section)
|
|
item_outputs = map(lambda i: i.output(section), self.items)
|
|
section_outputs.append("".join(item_outputs))
|
|
return "\n".join(section_outputs)
|
|
|
|
#####
|
|
|
|
boot_text = """
|
|
[text-section] boot
|
|
|
|
[code]
|
|
ip equ $18
|
|
w equ $1A
|
|
z equ $1C
|
|
cntr equ $1E
|
|
tmp equ $15
|
|
tmp2 equ $3D
|
|
pstack equ %(pstack_bottom)s
|
|
|
|
boot
|
|
ldx #%(pstack_size)d
|
|
lda #<[main+2]
|
|
sta ip
|
|
lda #>[main+2]
|
|
sta ip+1
|
|
jmp next
|
|
|
|
; push ip
|
|
; ip := w+2
|
|
; jmp next
|
|
enter
|
|
lda ip
|
|
pha
|
|
lda ip+1
|
|
pha
|
|
lda #2
|
|
clc
|
|
adc w
|
|
sta ip
|
|
lda #0
|
|
adc w+1
|
|
sta ip+1
|
|
jmp next
|
|
|
|
; pop ip
|
|
; jmp next
|
|
exit
|
|
dta a(*+2)
|
|
pla
|
|
sta ip+1
|
|
pla
|
|
sta ip
|
|
;jmp next
|
|
|
|
; w := (ip)
|
|
; ip := ip+2
|
|
; z := (w)
|
|
; jmp (z)
|
|
next
|
|
ldy #0
|
|
lda (ip),y
|
|
sta w
|
|
iny
|
|
lda (ip),y
|
|
sta w+1
|
|
lda #2
|
|
clc
|
|
adc ip
|
|
sta ip
|
|
lda #0
|
|
adc ip+1
|
|
sta ip+1
|
|
ldy #0
|
|
lda (w),y
|
|
sta z
|
|
iny
|
|
lda (w),y
|
|
sta z+1
|
|
jmp (z)
|
|
|
|
; push (ip)
|
|
; ip := ip+2
|
|
lit
|
|
dta a(*+2)
|
|
ldy #1
|
|
lda (ip),y
|
|
dey
|
|
dex
|
|
sta pstack,x
|
|
lda (ip),y
|
|
dex
|
|
sta pstack,x
|
|
lda #2
|
|
clc
|
|
adc ip
|
|
sta ip
|
|
lda #0
|
|
adc ip+1
|
|
sta ip+1
|
|
jmp next
|
|
|
|
const
|
|
ldy #3
|
|
lda (w),y
|
|
dey
|
|
dex
|
|
sta pstack,x
|
|
lda (w),y
|
|
dex
|
|
sta pstack,x
|
|
jmp next
|
|
|
|
_if
|
|
dta a(*+2)
|
|
lda pstack,x
|
|
inx
|
|
ora pstack,x
|
|
bne _if_t
|
|
_if_f
|
|
ldy #0
|
|
lda (ip),y
|
|
sta w
|
|
iny
|
|
lda (ip),y
|
|
sta ip+1
|
|
lda w
|
|
sta ip
|
|
inx
|
|
jmp next
|
|
_if_t
|
|
lda #2
|
|
clc
|
|
adc ip
|
|
sta ip
|
|
lda #0
|
|
adc ip+1
|
|
sta ip+1
|
|
inx
|
|
jmp next
|
|
|
|
branch
|
|
dta a(*+2)
|
|
ldy #0
|
|
lda (ip),y
|
|
sta w
|
|
iny
|
|
lda (ip),y
|
|
sta ip+1
|
|
lda w
|
|
sta ip
|
|
jmp next
|
|
|
|
until
|
|
dta a(*+2)
|
|
lda pstack,x
|
|
inx
|
|
ora pstack,x
|
|
bne until_end
|
|
until_repeat
|
|
inx
|
|
; ip := (ip)
|
|
ldy #0
|
|
lda (ip),y
|
|
iny
|
|
sta w
|
|
lda (ip),y
|
|
sta ip+1
|
|
lda w
|
|
sta ip
|
|
jmp next
|
|
until_end
|
|
inx
|
|
; ip := ip+2
|
|
clc
|
|
lda #2
|
|
adc ip
|
|
sta ip
|
|
lda #0
|
|
adc ip+1
|
|
sta ip+1
|
|
jmp next
|
|
|
|
[end-code]
|
|
"""
|
|
|
|
basewords_text = """
|
|
[text-section] text
|
|
|
|
: drop
|
|
[code]
|
|
inx
|
|
inx
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: nip
|
|
[code]
|
|
lda pstack,x
|
|
sta pstack+2,x
|
|
inx
|
|
lda pstack,x
|
|
sta pstack+2,x
|
|
inx
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: while
|
|
[code]
|
|
lda pstack,x
|
|
inx
|
|
ora pstack,x
|
|
beq while_end
|
|
inx
|
|
lda #2
|
|
clc
|
|
adc ip
|
|
sta ip
|
|
lda #0
|
|
adc ip+1
|
|
sta ip+1
|
|
jmp next
|
|
while_end
|
|
inx
|
|
ldy #0
|
|
lda (ip),y
|
|
iny
|
|
sta w
|
|
lda (ip),y
|
|
sta ip+1
|
|
lda w
|
|
sta ip
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: @
|
|
[label] fetch
|
|
[code]
|
|
lda pstack,x
|
|
inx
|
|
sta w
|
|
lda pstack,x
|
|
sta w+1
|
|
ldy #1
|
|
lda (w),y
|
|
sta pstack,x
|
|
dey
|
|
lda (w),y
|
|
dex
|
|
sta pstack,x
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: c@
|
|
[label] c_fetch
|
|
[code]
|
|
lda pstack,x
|
|
inx
|
|
sta w
|
|
lda pstack,x
|
|
sta w+1
|
|
lda #0
|
|
sta pstack,x
|
|
ldy #0
|
|
lda (w),y
|
|
dex
|
|
sta pstack,x
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: ! ( x addr -- )
|
|
[label] store
|
|
[code]
|
|
lda pstack,x
|
|
inx
|
|
sta w
|
|
lda pstack,x
|
|
inx
|
|
sta w+1
|
|
lda pstack,x
|
|
inx
|
|
ldy #0
|
|
sta (w),y
|
|
iny
|
|
lda pstack,x
|
|
inx
|
|
sta (w),y
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: c!
|
|
[label] c_store
|
|
[code]
|
|
lda pstack,x
|
|
inx
|
|
sta w
|
|
lda pstack,x
|
|
inx
|
|
sta w+1
|
|
lda pstack,x
|
|
inx
|
|
inx
|
|
ldy #0
|
|
sta (w),y
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: + ( n1|u1 n2|u2 -- n3|u3 )
|
|
[label] plus
|
|
[code]
|
|
lda pstack,x
|
|
inx
|
|
ldy pstack,x
|
|
inx
|
|
clc
|
|
adc pstack,x
|
|
sta pstack,x
|
|
tya
|
|
adc pstack+1,x
|
|
sta pstack+1,x
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
\ n1|u1 - n2|u2
|
|
|
|
: - ( n1|u1 n2|u2 -- n3|u3 )
|
|
[label] minus
|
|
[code]
|
|
sec
|
|
lda pstack+2,x
|
|
sbc pstack+0,x
|
|
sta pstack+2,x
|
|
inx
|
|
lda pstack+2,x
|
|
sbc pstack+0,x
|
|
sta pstack+2,x
|
|
inx
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: 1+
|
|
[label] one_plus
|
|
[code]
|
|
clc
|
|
lda #1
|
|
adc pstack,x
|
|
sta pstack,x
|
|
lda #0
|
|
adc pstack+1,x
|
|
sta pstack+1,x
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: 1-
|
|
[label] one_minus
|
|
[code]
|
|
sec
|
|
lda pstack,x
|
|
sbc #1
|
|
sta pstack,x
|
|
lda pstack+1,x
|
|
sbc #0
|
|
sta pstack+1,x
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: count ( addr1 -- addr2 u )
|
|
[code]
|
|
lda pstack,x
|
|
sta w
|
|
clc
|
|
adc #1
|
|
sta pstack,x
|
|
lda pstack+1,x
|
|
sta w+1
|
|
adc #0
|
|
sta pstack+1,x
|
|
lda #0
|
|
dex
|
|
sta pstack,x
|
|
ldy #0
|
|
lda (w),y
|
|
dex
|
|
sta pstack,x
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: cmove ( c-addr1 c-addr2 u -- )
|
|
[code]
|
|
lda pstack,x
|
|
inx
|
|
sta cntr
|
|
lda pstack,x
|
|
inx
|
|
sta cntr+1
|
|
lda pstack,x
|
|
inx
|
|
sta w
|
|
lda pstack,x
|
|
inx
|
|
sta w+1
|
|
lda pstack,x
|
|
inx
|
|
sta z
|
|
lda pstack,x
|
|
inx
|
|
sta z+1
|
|
ldy #0
|
|
lda cntr+1
|
|
beq cmove_tail
|
|
cmove_loop_1
|
|
lda (z),y
|
|
sta (w),y
|
|
iny
|
|
bne cmove_loop_1
|
|
inc z+1
|
|
inc w+1
|
|
dec cntr+1
|
|
bne cmove_loop_1
|
|
cmove_tail
|
|
lda cntr
|
|
beq cmove_done
|
|
cmove_loop_2
|
|
lda (z),y
|
|
sta (w),y
|
|
iny
|
|
cpy cntr
|
|
bne cmove_loop_2
|
|
cmove_done
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: fill ( c-addr u c -- )
|
|
[code]
|
|
lda pstack,x
|
|
inx
|
|
sta w
|
|
inx
|
|
lda pstack,x
|
|
inx
|
|
sta cntr
|
|
lda pstack,x
|
|
inx
|
|
sta cntr+1
|
|
lda pstack,x
|
|
inx
|
|
sta z
|
|
lda pstack,x
|
|
inx
|
|
sta z+1
|
|
ldy #0
|
|
lda cntr+1
|
|
beq fill_tail
|
|
lda w
|
|
fill_loop_1
|
|
sta (z),y
|
|
iny
|
|
bne fill_loop_1
|
|
inc z+1
|
|
dec cntr+1
|
|
bne fill_loop_1
|
|
fill_tail
|
|
lda cntr
|
|
beq fill_done
|
|
lda w
|
|
fill_loop_2
|
|
sta (z),y
|
|
iny
|
|
dec cntr
|
|
bne fill_loop_2
|
|
fill_done
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: dup ( x -- x x )
|
|
[code]
|
|
ldy pstack,x
|
|
lda pstack+1,x
|
|
dex
|
|
sta pstack,x
|
|
tya
|
|
dex
|
|
sta pstack,x
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: swap
|
|
[code]
|
|
ldy pstack,x
|
|
lda pstack+2,x
|
|
sta pstack,x
|
|
tya
|
|
sta pstack+2,x
|
|
ldy pstack+1,x
|
|
lda pstack+3,x
|
|
sta pstack+1,x
|
|
tya
|
|
sta pstack+3,x
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: over ( x1 x2 -- x1 x2 x1 )
|
|
[code]
|
|
lda pstack+3,x
|
|
dex
|
|
sta pstack,x
|
|
lda pstack+3,x
|
|
dex
|
|
sta pstack,x
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: and ( x1 x2 -- x3 )
|
|
[code]
|
|
lda pstack,x
|
|
inx
|
|
ldy pstack,x
|
|
inx
|
|
and pstack,x
|
|
sta pstack,x
|
|
tya
|
|
and pstack+1,x
|
|
sta pstack+1,x
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: or ( x1 x2 -- x3 )
|
|
[code]
|
|
lda pstack,x
|
|
inx
|
|
ldy pstack,x
|
|
inx
|
|
ora pstack,x
|
|
sta pstack,x
|
|
tya
|
|
ora pstack+1,x
|
|
sta pstack+1,x
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: rshift ( x1 u -- x2 )
|
|
[code]
|
|
ldy pstack,x
|
|
inx
|
|
inx
|
|
lda pstack,x
|
|
rshift_loop
|
|
cpy #0
|
|
beq rshift_end
|
|
dey
|
|
lsr pstack+1,x
|
|
ror @
|
|
jmp rshift_loop
|
|
rshift_end
|
|
sta pstack,x
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: lshift ( x1 u -- x2 )
|
|
[code]
|
|
ldy pstack,x
|
|
inx
|
|
inx
|
|
lda pstack,x
|
|
lshift_loop
|
|
cpy #0
|
|
beq lshift_end
|
|
dey
|
|
asl @
|
|
rol pstack+1,x
|
|
jmp lshift_loop
|
|
lshift_end
|
|
sta pstack,x
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
\ n2-n1 : n2<n1 => N eor V = 1
|
|
\ n2>=n1 => N eor V = 0
|
|
|
|
: > ( n1 n2 -- flag )
|
|
[label] greater_than
|
|
[code]
|
|
sec
|
|
lda pstack,x
|
|
inx
|
|
sbc pstack+1,x
|
|
lda pstack,x
|
|
inx
|
|
sbc pstack+1,x
|
|
bvc gt_v
|
|
eor #$80
|
|
gt_v
|
|
bpl gt_f
|
|
gt_t
|
|
lda #$FF
|
|
sta pstack,x
|
|
sta pstack+1,x
|
|
jmp next
|
|
gt_f
|
|
lda #$00
|
|
sta pstack,x
|
|
sta pstack+1,x
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
\ n2-n1 : n2<n1 => N eor V = 1
|
|
\ n2>=n1 => N eor V = 0
|
|
|
|
: <= ( n1 n2 -- flag )
|
|
[label] less_than_or_equal
|
|
[code]
|
|
sec
|
|
lda pstack,x
|
|
inx
|
|
sbc pstack+1,x
|
|
lda pstack,x
|
|
inx
|
|
sbc pstack+1,x
|
|
bvc lteq_v
|
|
eor #$80
|
|
lteq_v
|
|
bmi lteq_f
|
|
lteq_t
|
|
lda #$FF
|
|
sta pstack,x
|
|
sta pstack+1,x
|
|
jmp next
|
|
lteq_f
|
|
lda #$00
|
|
sta pstack,x
|
|
sta pstack+1,x
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
\ n1-n2 : n1<n2 => N eor V = 1
|
|
\ n1>=n2 => N eor V = 0
|
|
|
|
: < ( n1 n2 -- flag )
|
|
[label] less_than
|
|
[code]
|
|
sec
|
|
lda pstack+2,x
|
|
sbc pstack+0,x
|
|
lda pstack+3,x
|
|
sbc pstack+1,x
|
|
bvc lt_v
|
|
eor #$80
|
|
lt_v
|
|
bpl lt_f
|
|
lt_t
|
|
lda #$FF
|
|
lt_set
|
|
inx
|
|
inx
|
|
sta pstack,x
|
|
sta pstack+1,x
|
|
jmp next
|
|
lt_f
|
|
lda #$00
|
|
beq lt_set
|
|
[end-code] ;
|
|
|
|
\ n1-n2 : n1<n2 => N eor V = 1
|
|
\ n1>=n2 => N eor V = 0
|
|
|
|
: >= ( n1 n2 -- flag )
|
|
[label] greater_than_or_equal
|
|
[code]
|
|
sec
|
|
lda pstack+2,x
|
|
sbc pstack+0,x
|
|
lda pstack+3,x
|
|
sbc pstack+1,x
|
|
bvc gteq_v
|
|
eor #$80
|
|
gteq_v
|
|
bmi gteq_f
|
|
gteq_t
|
|
lda #$FF
|
|
gteq_set
|
|
inx
|
|
inx
|
|
sta pstack,x
|
|
sta pstack+1,x
|
|
jmp next
|
|
gteq_f
|
|
lda #$00
|
|
beq gteq_set
|
|
[end-code] ;
|
|
|
|
\ u2-u1 : u2<u1 => C = 0
|
|
\ u2>=u1 => C = 1
|
|
|
|
: u> ( u1 u2 -- flag )
|
|
[label] unsigned_greater_than
|
|
[code]
|
|
sec
|
|
lda pstack+0,x
|
|
sbc pstack+2,x
|
|
inx
|
|
lda pstack+0,x
|
|
sbc pstack+2,x
|
|
inx
|
|
bcc ugt_t
|
|
lda #$00
|
|
ugt_set
|
|
sta pstack+0,x
|
|
sta pstack+1,x
|
|
jmp next
|
|
ugt_t
|
|
lda #$FF
|
|
bne ugt_set
|
|
[end-code] ;
|
|
|
|
\ u1-u2 : u1<u2 => C = 0
|
|
\ u1>=u2 => C = 1
|
|
|
|
: u< ( u1 u2 -- flag )
|
|
[label] unsigned_less_than
|
|
[code]
|
|
sec
|
|
lda pstack+2,x
|
|
sbc pstack+0,x
|
|
inx
|
|
lda pstack+2,x
|
|
sbc pstack+0,x
|
|
inx
|
|
bcc ult_t
|
|
lda #$00
|
|
ult_set
|
|
sta pstack+0,x
|
|
sta pstack+1,x
|
|
jmp next
|
|
ult_t
|
|
lda #$FF
|
|
bne ult_set
|
|
[end-code] ;
|
|
|
|
: = ( x1 x2 -- flag )
|
|
[label] equals
|
|
[code]
|
|
lda pstack,x
|
|
cmp pstack+2,x
|
|
bne eq_f
|
|
lda pstack+1,x
|
|
cmp pstack+3,x
|
|
bne eq_f
|
|
eq_t
|
|
lda #$FF
|
|
bne eq_end
|
|
eq_f
|
|
lda #0
|
|
eq_end
|
|
inx
|
|
inx
|
|
sta pstack,x
|
|
sta pstack+1,x
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: <> ( x1 x2 -- flag )
|
|
[label] not_equals
|
|
[code]
|
|
lda pstack,x
|
|
cmp pstack+2,x
|
|
bne neq_t
|
|
lda pstack+1,x
|
|
cmp pstack+3,x
|
|
bne neq_t
|
|
neq_f
|
|
lda #$00
|
|
beq neq_end
|
|
neq_t
|
|
lda #$FF
|
|
neq_end
|
|
inx
|
|
inx
|
|
sta pstack,x
|
|
sta pstack+1,x
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: 2! ( x1 x2 addr -- )
|
|
[label] two_store
|
|
[code]
|
|
lda pstack,x
|
|
inx
|
|
sta w
|
|
lda pstack,x
|
|
inx
|
|
sta w+1
|
|
ldy #0
|
|
lda pstack,x
|
|
inx
|
|
sta (w),y
|
|
iny
|
|
lda pstack,x
|
|
inx
|
|
sta (w),y
|
|
iny
|
|
lda pstack,x
|
|
inx
|
|
sta (w),y
|
|
iny
|
|
lda pstack,x
|
|
inx
|
|
sta (w),y
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: 2@ ( addr -- x1 x2 )
|
|
[label] two_fetch
|
|
[code]
|
|
lda pstack,x
|
|
inx
|
|
sta w
|
|
lda pstack,x
|
|
sta w+1
|
|
ldy #3
|
|
lda (w),y
|
|
dey
|
|
sta pstack,x
|
|
lda (w),y
|
|
dey
|
|
dex
|
|
sta pstack,x
|
|
lda (w),y
|
|
dey
|
|
dex
|
|
sta pstack,x
|
|
lda (w),y
|
|
dex
|
|
sta pstack,x
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: d= ( d1 d2 -- flag )
|
|
[label] d_equ
|
|
[code]
|
|
lda pstack+0,x
|
|
cmp pstack+4,x
|
|
bne d_equ_f
|
|
lda pstack+1,x
|
|
cmp pstack+5,x
|
|
bne d_equ_f
|
|
lda pstack+2,x
|
|
cmp pstack+6,x
|
|
bne d_equ_f
|
|
lda pstack+3,x
|
|
cmp pstack+7,x
|
|
bne d_equ_f
|
|
lda #$FF
|
|
d_equ_end
|
|
inx
|
|
inx
|
|
inx
|
|
inx
|
|
inx
|
|
inx
|
|
sta pstack+0,x
|
|
sta pstack+1,x
|
|
jmp next
|
|
d_equ_f
|
|
lda #$00
|
|
jmp d_equ_end
|
|
[end-code] ;
|
|
|
|
: d+ ( d1 d2 -- d3 )
|
|
[label] d_plus
|
|
[code]
|
|
clc
|
|
lda pstack+2,x
|
|
adc pstack+6,x
|
|
sta pstack+6,x
|
|
lda pstack+3,x
|
|
adc pstack+7,x
|
|
sta pstack+7,x
|
|
lda pstack+0,x
|
|
adc pstack+4,x
|
|
sta pstack+4,x
|
|
lda pstack+1,x
|
|
adc pstack+5,x
|
|
sta pstack+5,x
|
|
inx
|
|
inx
|
|
inx
|
|
inx
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: d- ( d1 d2 -- d3 )
|
|
[label] d_minus
|
|
[code]
|
|
sec
|
|
lda pstack+6,x
|
|
sbc pstack+2,x
|
|
sta pstack+6,x
|
|
lda pstack+7,x
|
|
sbc pstack+3,x
|
|
sta pstack+7,x
|
|
lda pstack+4,x
|
|
sbc pstack+0,x
|
|
sta pstack+4,x
|
|
lda pstack+5,x
|
|
sbc pstack+1,x
|
|
sta pstack+5,x
|
|
inx
|
|
inx
|
|
inx
|
|
inx
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: 2drop
|
|
[label] two_drop
|
|
[code]
|
|
inx
|
|
inx
|
|
inx
|
|
inx
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: 2dup
|
|
[label] two_dup
|
|
[code]
|
|
lda pstack+3,x
|
|
dex
|
|
sta pstack,x
|
|
lda pstack+3,x
|
|
dex
|
|
sta pstack,x
|
|
lda pstack+3,x
|
|
dex
|
|
sta pstack,x
|
|
lda pstack+3,x
|
|
dex
|
|
sta pstack,x
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: 2swap
|
|
[label] two_stap
|
|
[code]
|
|
ldy pstack+3,x
|
|
lda pstack+1,x
|
|
sta pstack+3,x
|
|
tya
|
|
sta pstack+1,x
|
|
ldy pstack+2,x
|
|
lda pstack+0,x
|
|
sta pstack+2,x
|
|
tya
|
|
sta pstack+0,x
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: sp
|
|
[code]
|
|
txa
|
|
tay
|
|
lda #0
|
|
dex
|
|
sta pstack,x
|
|
tya
|
|
dex
|
|
sta pstack,x
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: rsp
|
|
[code]
|
|
txa
|
|
tay
|
|
lda #0
|
|
dey
|
|
sta pstack,y
|
|
tsx
|
|
txa
|
|
dey
|
|
sta pstack,y
|
|
tya
|
|
tax
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: 0=
|
|
[label] zero_eq
|
|
[code]
|
|
lda pstack,x
|
|
ora pstack+1,x
|
|
beq zero_eq_t
|
|
zero_eq_f
|
|
lda #$00
|
|
zero_eq_set
|
|
sta pstack+1,x
|
|
sta pstack,x
|
|
jmp next
|
|
zero_eq_t
|
|
lda #$FF
|
|
bne zero_eq_set
|
|
[end-code] ;
|
|
|
|
: do
|
|
[code]
|
|
lda pstack,x ; index:lo
|
|
inx
|
|
pha
|
|
lda pstack,x ; index:hi
|
|
inx
|
|
pha
|
|
lda pstack,x ; limit:lo
|
|
inx
|
|
pha
|
|
lda pstack,x ; limit:hi
|
|
inx
|
|
pha
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: loop
|
|
[code]
|
|
pla
|
|
sta z+1 ; limit:hi
|
|
pla
|
|
sta z ; limit:lo
|
|
pla
|
|
sta w+1 ; index:hi
|
|
pla
|
|
sta w ; index:lo
|
|
; index := index+1
|
|
clc
|
|
lda #1
|
|
adc w
|
|
sta w
|
|
lda #0
|
|
adc w+1
|
|
sta w+1
|
|
; limit=index?
|
|
lda w
|
|
cmp z
|
|
bne loop_again
|
|
lda w+1
|
|
cmp z+1
|
|
beq loop_end
|
|
loop_again
|
|
lda w ; index:lo
|
|
pha
|
|
lda w+1 ; index:hi
|
|
pha
|
|
lda z ; limit:lo
|
|
pha
|
|
lda z+1 ; limit:hi
|
|
pha
|
|
; ip := (ip)
|
|
ldy #0
|
|
lda (ip),y
|
|
sta w
|
|
iny
|
|
lda (ip),y
|
|
sta ip+1
|
|
lda w
|
|
sta ip
|
|
jmp next
|
|
loop_end
|
|
; ip := ip+2
|
|
clc
|
|
lda #2
|
|
adc ip
|
|
sta ip
|
|
lda #0
|
|
adc ip+1
|
|
sta ip+1
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: +loop
|
|
[label] plus_loop
|
|
[code]
|
|
pla
|
|
sta z+1 ; limit:hi
|
|
pla
|
|
sta z ; limit:lo
|
|
pla
|
|
sta w+1 ; index:hi
|
|
pla
|
|
sta w ; index:lo
|
|
; tmp := index - limit
|
|
sec
|
|
sbc z
|
|
sta tmp
|
|
lda w+1
|
|
sbc z+1
|
|
sta tmp+1
|
|
; tmp2 := index - limit + n
|
|
clc
|
|
lda tmp
|
|
adc pstack,x
|
|
sta tmp2
|
|
lda tmp+1
|
|
adc pstack+1,x
|
|
sta tmp2+1
|
|
; index := index+n
|
|
clc
|
|
lda pstack,x
|
|
inx
|
|
adc w
|
|
sta w
|
|
lda pstack,x
|
|
inx
|
|
adc w+1
|
|
sta w+1
|
|
; sgn(index-limit) <> sgn(index-limit+n) ?
|
|
lda tmp+1
|
|
eor tmp2+1
|
|
bmi plus_loop_end
|
|
plus_loop_again
|
|
lda w ; index:lo
|
|
pha
|
|
lda w+1 ; index:hi
|
|
pha
|
|
lda z ; limit:lo
|
|
pha
|
|
lda z+1 ; limit:hi
|
|
pha
|
|
; ip := (ip)
|
|
ldy #0
|
|
lda (ip),y
|
|
sta w
|
|
iny
|
|
lda (ip),y
|
|
sta ip+1
|
|
lda w
|
|
sta ip
|
|
jmp next
|
|
plus_loop_end
|
|
; ip := ip+2
|
|
clc
|
|
lda #2
|
|
adc ip
|
|
sta ip
|
|
lda #0
|
|
adc ip+1
|
|
sta ip+1
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: i
|
|
[code]
|
|
txa
|
|
tay
|
|
tsx
|
|
lda $100+3,x ; index:hi
|
|
dey
|
|
sta pstack,y
|
|
lda $100+4,x ; index:lo
|
|
dey
|
|
sta pstack,y
|
|
tya
|
|
tax
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: j
|
|
[code]
|
|
txa
|
|
tay
|
|
tsx
|
|
lda $100+7,x ; index:hi
|
|
dey
|
|
sta pstack,y
|
|
lda $100+8,x ; index:lo
|
|
dey
|
|
sta pstack,y
|
|
tya
|
|
tax
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: unloop
|
|
[code]
|
|
pla
|
|
pla
|
|
pla
|
|
pla
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: 2*
|
|
[label] two_star
|
|
[code]
|
|
asl pstack,x
|
|
rol pstack+1,x
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: 2/
|
|
[label] two_slash
|
|
[code]
|
|
lda pstack+1,x
|
|
cmp #$80
|
|
ror pstack+1,x
|
|
ror pstack,x
|
|
jmp next
|
|
[end-code] ;
|
|
|
|
: m* ( n1 n2 -- d-prod )
|
|
[label] m_star
|
|
[code]
|
|
; z := n2
|
|
lda pstack,x
|
|
sta z
|
|
lda pstack+1,x
|
|
sta z+1
|
|
; w := n1
|
|
lda pstack+2,x
|
|
sta w
|
|
lda pstack+3,x
|
|
sta w+1
|
|
; save sign
|
|
eor z+1
|
|
sta cntr+1
|
|
; abs(n1)
|
|
lda w+1
|
|
bpl m_star_n1_plus
|
|
lda w
|
|
eor #$FF
|
|
clc
|
|
adc #1
|
|
sta w
|
|
lda w+1
|
|
eor #$FF
|
|
adc #0
|
|
sta w+1
|
|
m_star_n1_plus
|
|
; abs(n2)
|
|
lda z+1
|
|
bpl m_star_n2_plus
|
|
lda z
|
|
eor #$FF
|
|
clc
|
|
adc #1
|
|
sta z
|
|
lda z+1
|
|
eor #$FF
|
|
adc #0
|
|
sta z+1
|
|
m_star_n2_plus
|
|
; clear result
|
|
lda #0
|
|
sta tmp+0
|
|
sta tmp+1
|
|
sta tmp+2
|
|
sta tmp+3
|
|
; tmp := w * z
|
|
ldy #16
|
|
m_star_loop
|
|
lsr w+1
|
|
ror w
|
|
bcc m_star_next
|
|
lda z
|
|
clc
|
|
adc tmp+2
|
|
sta tmp+2
|
|
lda z+1
|
|
adc tmp+3
|
|
sta tmp+3
|
|
m_star_next
|
|
clc
|
|
ror tmp+3
|
|
ror tmp+2
|
|
ror tmp+1
|
|
ror tmp+0
|
|
dey
|
|
bne m_star_loop
|
|
; apply sign
|
|
lda cntr+1
|
|
bpl m_star_done
|
|
lda tmp+0
|
|
eor #$FF
|
|
clc
|
|
adc #1
|
|
sta tmp+0
|
|
lda tmp+1
|
|
eor #$FF
|
|
adc #0
|
|
sta tmp+1
|
|
lda tmp+2
|
|
eor #$FF
|
|
adc #0
|
|
sta tmp+2
|
|
lda tmp+3
|
|
eor #$FF
|
|
adc #0
|
|
sta tmp+3
|
|
m_star_done
|
|
; push result on the stack
|
|
lda tmp+0
|
|
sta pstack+2,x
|
|
lda tmp+1
|
|
sta pstack+3,x
|
|
lda tmp+2
|
|
sta pstack+0,x
|
|
lda tmp+3
|
|
sta pstack+1,x
|
|
jmp next
|
|
[end-code] ;
|
|
"""
|
|
|
|
parser = argparse.ArgumentParser()
|
|
parser.add_argument("--sections", "-s", metavar="STR", default="init,boot,data,text")
|
|
parser.add_argument("--pstack-bottom", "-p", metavar="ADDR", default="$600")
|
|
parser.add_argument("--pstack-size", "-S", metavar="NUM", default=256, type=int)
|
|
parser.add_argument("file", metavar="FILE")
|
|
args = parser.parse_args()
|
|
|
|
boot_params = {"pstack_bottom": args.pstack_bottom,
|
|
"pstack_size": args.pstack_size & 0xff}
|
|
|
|
with open(args.file, "rt") as f:
|
|
text = f.read()
|
|
|
|
f = Forth(args.sections.split(","))
|
|
|
|
try:
|
|
f.parse_input(Input(boot_text % boot_params))
|
|
f.parse_input(Input(basewords_text))
|
|
f.parse_input(Input(text))
|
|
print f.generate_output()
|
|
except (ParseError, StackUnderflow, StackNotEmpty) as e:
|
|
sys.stderr.write("error: %s\n" % str(e))
|
|
sys.exit(1)
|