diff --git a/README.md b/README.md
index 727aa35..ebe3449 100755
--- a/README.md
+++ b/README.md
@@ -1,8 +1,8 @@
-
# The PLASMA Programming Language
-
+
+
image credit: Luc Viatour / www.Lucnix.be
-
+
PLASMA: **P**roto **L**anguage **A**s**S**e**M**bler for **A**pple
@@ -17,83 +17,83 @@ Different projects have led to the architecture of PLASMA, most notably Apple Pa
- [Build Environment](#build-environment)
- - [acme Cross-Assembler](#acme-cross-assembler)
- - [PLASMA Source](#plasma-source)
- - [Portable VM](#portable-vm)
- - [Target VM](#target-vm)
+ - [acme Cross-Assembler](#acme-cross-assembler)
+ - [PLASMA Source](#plasma-source)
+ - [Portable VM](#portable-vm)
+ - [Target VM](#target-vm)
- [Tutorial](#tutorial)
- - [PLASMA Compiler/Assembler](#plasma-compilerassembler)
- - [PLASMA Modules](#plasma-modules)
- - [Data Types](#data-types)
- - [Obligatory 'Hello World'](#obligatory-hello-world)
- - [Character Case](#character-case)
- - [Comments](#comments)
- - [Numbers](#numbers)
- - [Characters](#characters)
- - [Strings](#strings)
- - [Organization of a PLASMA Source File](#organization-of-a-plasma-source-file)
- - [Module Dependencies](#module-dependencies)
- - [File Inclusion](#file-inclusion)
- - [Predefined Functions](#predefined-functions)
- - [Constant Declarations](#constant-declarations)
- - [Structure Declarations](#structure-declarations)
- - [Global Data & Variables Declarations](#global-data-variables-declarations)
- - [Function Definitions](#function-definitions)
- - [Statements and Expressions](#statements-and-expressions)
- - [Exported Declarations](#exported-declarations)
- - [Module Main Initialization Function](#module-main-initialization-function)
- - [Module Done](#module-done)
- - [Runtime](#runtime)
+ - [PLASMA Compiler/Assembler](#plasma-compilerassembler)
+ - [PLASMA Modules](#plasma-modules)
+ - [Data Types](#data-types)
+ - [Obligatory 'Hello World'](#obligatory-hello-world)
+ - [Character Case](#character-case)
+ - [Comments](#comments)
+ - [Numbers](#numbers)
+ - [Characters](#characters)
+ - [Strings](#strings)
+ - [Organization of a PLASMA Source File](#organization-of-a-plasma-source-file)
+ - [Module Dependencies](#module-dependencies)
+ - [File Inclusion](#file-inclusion)
+ - [Predefined Functions](#predefined-functions)
+ - [Constant Declarations](#constant-declarations)
+ - [Structure Declarations](#structure-declarations)
+ - [Global Data & Variables Declarations](#global-data-variables-declarations)
+ - [Function Definitions](#function-definitions)
+ - [Statements and Expressions](#statements-and-expressions)
+ - [Exported Declarations](#exported-declarations)
+ - [Module Main Initialization Function](#module-main-initialization-function)
+ - [Module Done](#module-done)
+ - [Runtime](#runtime)
- [Reference](#reference)
- - [Decimal and Hexadecimal Numbers](#decimal-and-hexadecimal-numbers)
- - [Character and String Literals](#character-and-string-literals)
- - [In-line String Literals](#in-line-string-literals)
- - [Words](#words)
- - [Bytes](#bytes)
- - [Addresses](#addresses)
- - [Arrays](#arrays)
- - [Type Overrides](#type-overrides)
- - [Multi-Dimensional Arrays](#multi-dimensional-arrays)
- - [Offsets (Structure Elements)](#offsets-structure-elements)
- - [Defining Structures](#defining-structures)
- - [Pointers](#pointers)
- - [Pointer Dereferencing](#pointer-dereferencing)
- - [Addresses of Data/Code](#addresses-of-datacode)
- - [Function Pointers](#function-pointers)
- - [Function Definitions](#function-definitions)
- - [Expressions and Statements](#expressions-and-statements)
- - [Address Operators](#address-operators)
- - [Arithmetic, Bitwise, and Logical Operators](#arithmetic-bitwise-and-logical-operators)
- - [Assignment](#assignment)
- - [Empty Assignments](#empty-assignments)
- - [Increment and Decrement](#increment-and-decrement)
- - [Control Flow](#control-flow)
- - [CALL](#call)
- - [RETURN](#return)
- - [IF/[ELSIF]/[ELSE]/FIN](#ifelsifelsefin)
- - [WHEN/IS/[OTHERWISE]/WEND](#whenisotherwisewend)
- - [FOR \ [STEP]/NEXT](#for-todownto-stepnext)
- - [WHILE/LOOP](#whileloop)
- - [REPEAT/UNTIL](#repeatuntil)
- - [CONTINUE](#continue)
- - [BREAK](#break)
+ - [Decimal and Hexadecimal Numbers](#decimal-and-hexadecimal-numbers)
+ - [Character and String Literals](#character-and-string-literals)
+ - [In-line String Literals](#in-line-string-literals)
+ - [Words](#words)
+ - [Bytes](#bytes)
+ - [Addresses](#addresses)
+ - [Arrays](#arrays)
+ - [Type Overrides](#type-overrides)
+ - [Multi-Dimensional Arrays](#multi-dimensional-arrays)
+ - [Offsets (Structure Elements)](#offsets-structure-elements)
+ - [Defining Structures](#defining-structures)
+ - [Pointers](#pointers)
+ - [Pointer Dereferencing](#pointer-dereferencing)
+ - [Addresses of Data/Code](#addresses-of-datacode)
+ - [Function Pointers](#function-pointers)
+ - [Function Definitions](#function-definitions)
+ - [Expressions and Statements](#expressions-and-statements)
+ - [Address Operators](#address-operators)
+ - [Arithmetic, Bitwise, and Logical Operators](#arithmetic-bitwise-and-logical-operators)
+ - [Assignment](#assignment)
+ - [Empty Assignments](#empty-assignments)
+ - [Increment and Decrement](#increment-and-decrement)
+ - [Control Flow](#control-flow)
+ - [CALL](#call)
+ - [RETURN](#return)
+ - [IF/[ELSIF]/[ELSE]/FIN](#ifelsifelsefin)
+ - [WHEN/IS/[OTHERWISE]/WEND](#whenisotherwisewend)
+ - [FOR \ [STEP]/NEXT](#for-todownto-stepnext)
+ - [WHILE/LOOP](#whileloop)
+ - [REPEAT/UNTIL](#repeatuntil)
+ - [CONTINUE](#continue)
+ - [BREAK](#break)
- [Advanced Topics](#advanced-topics)
- - [Code Optimizations](#code-optimizations)
- - [Functions Without Parameters Or Local Variables](#functions-without-parameters-or-local-variables)
- - [Return Values](#return-values)
- - [Native Assembly Functions](#native-assembly-functions)
+ - [Code Optimizations](#code-optimizations)
+ - [Functions Without Parameters Or Local Variables](#functions-without-parameters-or-local-variables)
+ - [Return Values](#return-values)
+ - [Native Assembly Functions](#native-assembly-functions)
- [Implementation](#implementation)
- - [A New Approach](#a-new-approach)
- - [The Virtual Machine](#the-virtual-machine)
- - [The Stacks](#the-stacks)
- - [Evaluation Stack](#evaluation-stack)
- - [Call Stack](#call-stack)
- - [Local Frame Stack](#local-frame-stack)
- - [Local String Pool](#local-string-pool)
- - [The Bytecodes](#the-bytecodes)
- - [Apple I PLASMA](#apple-i-plasma)
- - [Apple II PLASMA](#apple-ii-plasma)
- - [Apple III PLASMA](#apple-iii-plasma)
+ - [A New Approach](#a-new-approach)
+ - [The Virtual Machine](#the-virtual-machine)
+ - [The Stacks](#the-stacks)
+ - [Evaluation Stack](#evaluation-stack)
+ - [Call Stack](#call-stack)
+ - [Local Frame Stack](#local-frame-stack)
+ - [Local String Pool](#local-string-pool)
+ - [The Bytecodes](#the-bytecodes)
+ - [Apple I PLASMA](#apple-i-plasma)
+ - [Apple II PLASMA](#apple-ii-plasma)
+ - [Apple III PLASMA](#apple-iii-plasma)
- [Links](#links)
@@ -365,9 +365,29 @@ byte[64] txtfile = "UNTITLED"
### Function Definitions
-Functions are defined after all constants, variables and data. Function definitions can be `export`ed for inclusion in other modules and can be forward declared with a `predef` type in the constant and variable declarations. Functions can take parameters, passed on the evaluation stack, then copied to the local frame for easy access. They can have their own variable declarations, however, unlike the global declarations, no data can be predeclared - only storage space. A local frame is built for every function invocation and there is also a limit of 254 bytes of local storage. Each parameter takes two bytes of local storage, plus two bytes for the previous frame pointer. If a function has no parameters or local variables, no local frame will be created, improving performance. Functions always return a value; a function can specify a value to return or, if no return value is specified, a default of 0 will be returned.
+Functions are defined after all constants, variables and data. Function definitions can be `export`ed for inclusion in other modules and can be forward declared with a `predef` type in the constant and variable declarations. Functions can take parameters, passed on the evaluation stack, then copied to the local frame for easy access. They can have their own variable declarations, however, unlike the global declarations, no data can be predeclared - only storage space. A local frame is built for every function invocation and there is also a limit of 254 bytes of local storage. Each parameter takes two bytes of local storage, plus two bytes for the previous frame pointer. If a function has no parameters or local variables, no local frame will be created, improving performance. Functions always return a single value by default.
+```
+def myfunc(a, b) // Two parameters and defaults to one returned value
+```
+The number of values to return can be set by appending the number of values after the function definition with the '#' syntax, such as:
-Note: there is no mechanism to ensure caller and callee agree on the number of parameters. Historically, programmers have used Hungarian Notation (http://en.wikipedia.org/wiki/Hungarian_notation) to embed the parameter number and type in the function name itself. This is a notational aid; the compiler enforces nothing.
+```
+def myfuncA(a, b)#3 // Two parameters and three returned values
+```
+A definition with no parameters but with return values can be written as:
+```
+def myfuncB#2 // No parameters and two returned values
+```
+A pre-defined definition should include the same number of parameters and return values as the definition:
+```
+predef myfuncA(a, b)#3
+```
+A value used as a function pointer doesn't have the parameter/return value count associated with it. It can be overridden in-line:
+```
+word funcptr = @myfuncA
+funcptr(2, 4)#3
+```
+If fewer values are returned, the remaining values will be padded with zero. It is an error to return more values than specified. Definitions returning zero values are ok and can save some stack clean-up if the definitions are called stand-alone (i.e. as a procedure).
After functions are defined, the main code for the module follows. The main code will be executed as soon as the module is loaded. For library modules, this is a good place to do any runtime initialization, before any of the exported functions are called. The last statement in the module must be done, or else a compile error is issued.
@@ -394,6 +414,23 @@ byte numchars
numchars = 0
```
+Multi-value assignments are written with lvalues separated by commas, and the same number of rvalues separated by commas:
+```
+a, b, c = 2, 4, 6
+```
+Definitions can return values that contribute to the rvalue count:
+```
+def myfuncC(p1, p2)#2
+ return p1+p2, p1-p2
+end
+
+a, b, c = 2, myfuncC(6, 7) // Note: myfuncC returns 2 values
+```
+A quick way to swap variables could be written:
+```
+a, b = b, a
+```
+
Expressions can be built up with constants, variables, function calls, addresses, and pointers/arrays. Comparison operators evaluate to 0 or -1 instead of the more traditional 0 or 1. The use of -1 allows binary operations to be applied to other non-zero values and still retain a non-zero result. Any conditional tests check only for zero and non-zero values.
There are four basic types of data that can be manipulated: constants, variables, addresses, and functions. Memory can only be read or written as either a byte or a word. Bytes are unsigned 8-bit quantities, words are signed 16-bit quantities. Everything on the evaluation stack is treated as a word. Other than that, any value can be treated as a pointer, address, function, character, integer, etc. There are convenience operations in PLASMA to easily manipulate addresses and expressions as pointers, arrays, structures, functions, or combinations thereof. If a variable is declared as a byte, it can be accessed as a simple, single dimension byte array by using brackets to indicate the offset. Any expression can calculate the indexed offset. A word variable can be accessed as a word array in the same fashion. In order to access expressions or constants as arrays, a type identifier has to be inserted before the brackets. a `.` character denotes a byte type, a `:` character denotes a word type. Along with brackets to calculate an indexed offset, a constant can be used after the `.` or `:` and will be added to the base address. The constant can be a defined const to allow for structure style syntax. If the offset is a known constant, using the constant offset is a much more efficient way to address the elements over an array index. Multidimensional arrays are treated as arrays of array pointers.
@@ -611,7 +648,7 @@ Numbers can be represented in either decimal (base 10), or hexadecimal (base 16)
## Character and String Literals
-A character literal, represented by a single character or an escaped character enclosed in single quotes `'`, can be used wherever a number is used. String literals, a character sequence enclosed in double quotes `"`, can only appear in a data definition. A length byte will be calculated and prepended to the character data. This is the Pascal style of string definition used throughout PLASMA and ProDOS. When referencing the string, its address is used:
+A character literal, represented by a single character or an escaped character enclosed in single quotes `'`, can be used wherever a number is used. A length byte will be calculated and prepended to the character data. This is the Pascal style of string definition used throughout PLASMA and ProDOS. When referencing the string, its address is used:
```
char mystring[] = "This is my string; I am very proud of it."
@@ -640,55 +677,7 @@ Strings can be used as literals inside expression or as parameters. The above pu
puts("This is my string; I am very proud of it.")
```
-just like any proper language. This makes coding a much simpler task when it comes to spitting out strings to the screen. However (there always has to be a 'However'), nothing comes for free. Since PLASMA doesn't have garbage collection, memory is allocated on the stack frame for the string every time it is encountered. Translation: you can easily chew up many K of memory if you aren't careful. The memory is recovered when the function exits, just like the rest of the local variables.
-
-Don't do this:
-
-```
-word i
-
-for i = 0 to 10000
- puts("I am eating all your memory!")
-next
-```
-
-That string will be allocated anew every time through the loop. Instead, you could put the string in initialized memory, create a pointer to it before the loop, or put all the string handling in a function that gets called from inside the loop:
-
-```
-byte nicestr = "This is a nice string"
-word i
-
-for i = 0 to 10000
- puts(@nicestr)
-next
-```
-
-or:
-
-```
-word i, nicestr
-
-nicerstr = "This is a nicer string"
-for i = 0 to 10000
- puts(nicestr)
-next
-```
-
-or:
-
-```
-word i
-
-def putstr
- puts("This is a nice string, too")
-end
-
-for i = 0 to 10000
- putstr
-next
-```
-
-If you are curious as to why in-line strings behave this way, it is due to putting the string constant right into the bytecode stream, which makes it easy to compile and interpret. Also, when bytecode is placed in AUX memory (or extended memory in the Apple ///), it relieves the pressure of keeping all the in-line strings in precious main memory all the time. A normal compiler would move in-line strings into anonymous data memory and reference it from there. PLASMA now has a string pool associated with each function invocation, just like the local variable frame. It grows dynamically as strings are encountered and gives them an address in main memory until the function exits, freeing the string pool for that function. PLASMA is too dumb (and I'm too lazy) to implement a real string manager inside the compiler/VM. That would make for a nice library module, though.
+just like any proper language. This makes coding a much simpler task when it comes to spitting out strings to the screen.
## Words
@@ -769,13 +758,13 @@ word = $2080,$2480,$2880,$2C80,$3080,$3480,$3880,$3C80
```
def hgrfill(val)
- byte yscan, xscan
+ byte yscan, xscan
- for yscan = 0 to 191
- for xscan = 0 to 19
- hgrscan:[yscan, xscan] = val
- next
- next
+ for yscan = 0 to 191
+ for xscan = 0 to 19
+ hgrscan:[yscan, xscan] = val
+ next
+ next
end
```
@@ -783,13 +772,13 @@ Every array dimension except the last is a pointer to another array of pointers,
```
def hgrfill(val)
- byte yscan, xscan
+ byte yscan, xscan
- for yscan = 0 to 191
- for xscan = 0 to 39
- hgrscan.[yscan, xscan] = val
- next
- next
+ for yscan = 0 to 191
+ for xscan = 0 to 39
+ hgrscan.[yscan, xscan] = val
+ next
+ next
end
```
diff --git a/ROGUE.PO b/ROGUE.PO
index a1de91d..9603468 100644
Binary files a/ROGUE.PO and b/ROGUE.PO differ
diff --git a/SANDBOX.PO b/SANDBOX.PO
old mode 100644
new mode 100755
index be7c9a5..30f66ef
Binary files a/SANDBOX.PO and b/SANDBOX.PO differ
diff --git a/SDFAT.PO b/SDFAT.PO
index 9996f26..8118fbb 100755
Binary files a/SDFAT.PO and b/SDFAT.PO differ
diff --git a/doc/Rogue Instructions.rtf b/doc/Rogue Instructions.rtf
new file mode 100755
index 0000000..161d81f
--- /dev/null
+++ b/doc/Rogue Instructions.rtf
@@ -0,0 +1,178 @@
+{\rtf1\ansi\ansicpg1252\cocoartf1343\cocoasubrtf160
+{\fonttbl\f0\froman\fcharset0 TimesNewRomanPSMT;\f1\fmodern\fcharset0 Courier;\f2\fswiss\fcharset0 Helvetica;
+}
+{\colortbl;\red255\green255\blue255;}
+{\info
+{\author David Schmenk}}\margl1440\margr1440\vieww12540\viewh16140\viewkind1
+\deftab720
+\pard\pardeftab720\qc
+
+\f0\b\fs36 \cf0 \expnd0\expndtw0\kerning0
+PLASMA goes ROGUE\
+\pard\pardeftab720
+
+\fs28 \cf0 \expnd0\expndtw0\kerning0
+\ul \ulc0 Introduction\
+\pard\pardeftab720
+
+\b0\fs24 \cf0 \expnd0\expndtw0\kerning0
+\ulnone This version of ROGUE is somewhat different than others. It is very simple in most ways, but I have developed a (I think) unique visibility algorithm that runs extremely fast. Fast enough to run interpreted by the PLASMA VM on a 1 MHz 6502, and space efficient enough to allow for large (in the future) dungeons. The unique feature of this ROGUE is that lighting becomes critical and strategic. You are in dark catacombs, after all. You enter with a lit lamp, throwing off a circle of light. There are also torches throughout the catacombs that light up a small surrounding circle of light. Other items in the catacombs are mana (health+energy increase), a key, a raft, and gold. You will also encounter a number of enemies that will track you down to try and kill you. You will also encounter doors, locked doors, windows, water, and crevasses.\
+\
+\pard\pardeftab720
+
+\b\fs28 \cf0 \expnd0\expndtw0\kerning0
+\ul \ulc0 Strategy\
+\pard\pardeftab720
+
+\b0\fs24 \cf0 \expnd0\expndtw0\kerning0
+\ulnone As you travel through the catacombs, you must watch your health, energy, and lamp oil levels. Once health reaches zero, you are dead. As energy reaches zero, your vision will narrow and you will no longer be able to run. When the lamp oil runs out, you will be cast into darkness. If you see any torches in your field of vision, you can navigate to them. Taking the torch will extinguish the torch and replenish some of your lamp oil. Note that as you travel through the catacombs, your map of what you have seen will automatically fill in. But, if you are in the dark, you cannot read your map. You must turn on your lamp or get next to a torch before you can read the map again. If you are in the dark and can\'92t see any torches in your field of vision, you are in complete darkness. It is easy to lose your bearings. As such, the absolute direction movements no longer work (NSEW) - you will end up in a random direction if you try. However, the relative turns, left/right and forward/backward controls continue to work (
+\b \expnd0\expndtw0\kerning0
+that
+\b0 \expnd0\expndtw0\kerning0
+ you can do in the dark).\
+\
+Being in the dark can be advantageous, however. All the enemies in the catacombs can see you if you are in light, just as you can see them. If you are in darkness, they can't see you, and you can move around without being tracked. Don't run into them! Also, don't fall off a crevasse. You will hear certain noises giving you feedback on what is going on. A simple beep when you run into walls. A groan when an enemy moves towards you. A bleep when you pick an item up. Other noises when you fall over an edge or win a battle. These can be used strategically when moving in the dark.\
+\
+Health will slowly improve as you move around. However, energy is depleted as you move. Mana will increase both health and energy. If health is already at 100, it won\'92t go any higher. Same for energy, but it is important to keep both high. When energy goes low, you can no longer move quickly and your field-of-vision narrows. When health goes to zero, you are dead.\
+\
+\pard\pardeftab720
+
+\b\fs28 \cf0 \expnd0\expndtw0\kerning0
+\ul \ulc0 Tile Description\
+\pard\pardeftab720
+
+\b0\fs24 \cf0 \expnd0\expndtw0\kerning0
+\ulnone As ROGUE uses the text screen for display, a little creativity is required to interpret the map. These are the characters you will see and what the represent. Once you get the hang of it, it will be just like looking at the unencoded Matrix.\
+\
+\pard\pardeftab720
+
+\f1 \cf0 \expnd0\expndtw0\kerning0
+\ul \ulc0 Screen Character\expnd0\expndtw0\kerning0
+\ulnone \'a0 \'a0 \'a0\expnd0\expndtw0\kerning0
+\ul Represents\
+\pard\pardeftab720
+\cf0 \expnd0\expndtw0\kerning0
+\ulnone \'a0\'a0\'a0# \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0Wall\
+\'a0\'a0\'a0. \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0Floor\
+\'a0\'a0\'a0: \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0Window (barred opening)\
+\'a0 \'a0+ \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0Door\
+\'a0 \'a0% \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 Locked Door (need key to open)\
+\'a0\'a0\'a0' ' space \'a0 \'a0 \'a0 \'a0 \'a0 \'a0Crevasse (pit - don't fall in)\
+\'a0\'a0\'a0= \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0Exit\
+\'a0\'a0\'a0- \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0Entrance\
+\'a0\'a0\'a0* \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0Torch\
+\'a0\'a0\'a0& \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0Mana\
+\'a0\'a0\'a0, \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0Key (yep, hard to spot)\
+\'a0 \'a0@ \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0Raft (need to cross water)\
+ <<< Water\
+\'a0 \'a0>>> \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0Water (you will drown without raft)\
+\'a0\'a0\'a0$ \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0Gold\
+\
+\pard\pardeftab720
+\cf0 \expnd0\expndtw0\kerning0
+\ul \ulc0 Flashing\expnd0\expndtw0\kerning0
+\ulnone \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \expnd0\expndtw0\kerning0
+\ul Entity\
+\pard\pardeftab720
+\cf0 \expnd0\expndtw0\kerning0
+\ulnone \'a0\'a0\'a0T \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0Thief\
+\'a0\'a0\'a0O \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0Ogre\
+\'a0\'a0\'a0Z \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0Zombie\
+\'a0\'a0\'a0R \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0Rogue\
+\
+\'a0\expnd0\expndtw0\kerning0
+\ul Player\expnd0\expndtw0\kerning0
+\ulnone \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \expnd0\expndtw0\kerning0
+\ul Facing Direction\expnd0\expndtw0\kerning0
+\ulnone \
+\'a0\'a0\'a0^ \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0North\
+\'a0\'a0\'a0\\ \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0NE\
+\'a0\'a0\'a0> \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0East\
+\'a0\'a0\'a0/ \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0SE\
+\'a0\'a0\'a0v \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0South\
+\'a0\'a0\'a0\\ \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0SW\
+\'a0\'a0\'a0< \'a0\'a0\'a0\'a0\'a0\'a0\'a0\'a0\'a0\'a0\'a0\'a0\'a0\'a0\'a0\'a0\'a0\'a0\'a0West\
+\'a0\'a0\'a0/ \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0NW\
+\
+\pard\pardeftab720
+
+\f0 \cf0 \expnd0\expndtw0\kerning0
+Tiles in light are inverse. Entities are displayed only when lit and in field of view. The map is only visible when lit, i.e lamp is on or standing next to a torch.\
+\
+\pard\pardeftab720
+
+\b\fs28 \cf0 \expnd0\expndtw0\kerning0
+\ul \ulc0 Interaction\
+\pard\pardeftab720
+
+\f1\b0\fs24 \cf0 \expnd0\expndtw0\kerning0
+\ulc0 Keyboard commands\expnd0\expndtw0\kerning0
+\ulnone \'a0\'a0\'a0\'a0 \expnd0\expndtw0\kerning0
+\ul Action\
+\pard\pardeftab720
+\cf0 \expnd0\expndtw0\kerning0
+\ulnone \'a0\'a0\'a0Q \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 Run (Quick)\
+\'a0\'a0\'a0W up-arrow \'a0 \'a0 \'a0 \'a0 \'a0 Forward\
+\'a0\'a0\'a0S down-arrow \'a0 \'a0 \'a0 \'a0 Backward\
+\'a0\'a0\'a0A left-arrow \'a0 \'a0 \'a0 \'a0 Turn left\
+\'a0\'a0\'a0D right-arrow \'a0 \'a0 \'a0 Turn right\
+\'a0\'a0\'a0I \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 Move N\
+\'a0\'a0\'a0J \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 Move W\
+\'a0\'a0\'a0K \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 Move E\
+\'a0\'a0\'a0M \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 Move S\
+\'a0\'a0\'a0< , \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 Turn lamp down\
+\'a0\'a0\'a0> . \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 Turn lamp up/on\
+\'a0\'a0\'a0O \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 Turn lamp off\
+\'a0\'a0\'a0Space-bar \'a0 \'a0 \'a0 \'a0 \'a0 \'a0Open door\
+\'a0\'a0\'a0Return \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 Pick up item\
+\'a0\'a0\'a0X \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 \'a0 Exit (die)\
+\pard\pardeftab720
+
+\f0 \cf0 \expnd0\expndtw0\kerning0
+\
+Whenever you and an enemy end up on the same tile, battle commences. As you win fights, your skill increases, improving your attack effectiveness. As you advance through the catacombs, the enemies become more powerful. You will need to replenish health and energy with mana. Don't forget, the alternative to fighting is stealth in the darkness. During battle, you have the option to run. If you have low energy, you won't get very far. Also, when fighting, you get turned around so you can't depend on the direction you were facing before fighting. Running ('Q'uick) will get you away from enemies but will use much more energy.\
+\
+If you should die, restart the game by typing:\
+\pard\pardeftab720
+
+\f1 \cf0 \expnd0\expndtw0\kerning0
++rogue
+\f2 \
+\pard\pardeftab720
+
+\f0 \cf0 \expnd0\expndtw0\kerning0
+\
+\pard\pardeftab720
+
+\b\fs28 \cf0 \expnd0\expndtw0\kerning0
+\ul \ulc0 Map Levels\
+\pard\pardeftab720
+
+\b0\fs24 \cf0 \expnd0\expndtw0\kerning0
+\ulnone Level maps are up to 62x62 in size (plus a wall boundary for an effective 64x64 map size). They can be smaller than this. The game will end when it tries to load an non-existent level. Levels start at file name \'93LEVEL0\'93 and can go all the way to \'93LEVEL9\'93, but must be sequential.\
+\
+There are two levels included on the disk, and an empty level for you to use as a template.\'a0You\'a0can edit the map levels, and add your own. They are simple ASCII text files. The included sandbox editor can edit the maps right on the disk. type:\
+\
+\pard\pardeftab720
+
+\f1 \cf0 \expnd0\expndtw0\kerning0
+-sandbox level.empty
+\f2 \
+\pard\pardeftab720
+
+\f0 \cf0 \expnd0\expndtw0\kerning0
+\
+after exiting from ROGUE. Make your changes and save it as LEVEL0" to "LEVEL9". The next free level is currently "LEVEL2". You may also edit an existing level:\
+\
+\pard\pardeftab720
+
+\f1 \cf0 \expnd0\expndtw0\kerning0
+-sandbox level0
+\f2 \
+\pard\pardeftab720
+
+\f0 \cf0 \expnd0\expndtw0\kerning0
+\
+for instance.\
+\
+}
\ No newline at end of file
diff --git a/src/libsrc/portio.pla b/src/libsrc/portio.pla
index 6f7efda..57088e6 100644
--- a/src/libsrc/portio.pla
+++ b/src/libsrc/portio.pla
@@ -32,7 +32,7 @@ export def portRead
end
def digitalWrite(pin, val)
- return ^ANN0[pin&3+val&1]
+ return ^ANN0[((pin&3)<<1)+val&1]
end
export def portWrite(val)
diff --git a/src/libsrc/spiport.pla b/src/libsrc/spiport.pla
index 1a6bfa5..405034f 100644
--- a/src/libsrc/spiport.pla
+++ b/src/libsrc/spiport.pla
@@ -8,11 +8,16 @@ const SPI_SLAVE_READY = '@'
const SPI_SLAVE_ERROR = '!'
const SPI_SLAVE_BUSY = $FF
+word spiReadWriteByte, spiWriteBytes, spiReadBytes
+
asm spiInc
-!SOURCE "vmsrc/plvmzp.inc"
+!SOURCE "vmsrc/plvmzp.inc"
+!CPU 65C02
end
-export asm spiXferByte(outbyte)
+asm spiXferByteStd(outbyte)
+ PHP ; DISABLE INTS
+ SEI
STA $C05A ; ENABLE SLAVE
LDY #0 ; ASSUME MSB IS ZERO
LDA ESTKL,X ; GET ARGUMENT
@@ -20,7 +25,7 @@ export asm spiXferByte(outbyte)
INY ; IT'S A ONE
+ STA $C058,Y ; WRITE BIT 7
STA $C040 ; CLOCK
- LDY #0 ; DOING THIS HERE GIVES TIME FOR OUTPUT TO BECOME STABLE - NOT REALLY NEEDEDd
+ LDY #0 ; DOING THIS HERE GIVES TIME FOR OUTPUT TO BECOME STABLE - NOT REALLY NEEDED
ASL $C061 ; READ BIT 7 INTO CARRY
ROL ; ROTATE INTO ACC
BPL + ; REPEAT FOR ALL BITS
@@ -74,10 +79,93 @@ export asm spiXferByte(outbyte)
STA $C05B ; DISABLE SLAVE
ROL
STA ESTKL,X ; SAVE RETURN PARAMETER
+ PLP
RTS
end
-asm spiReadBytes(buf, len)
+asm spiXferByteGS(outbyte)
+ PHP ; DISABLE INTS
+ SEI
+ LDA $C036 ; SET 1 MHZ
+ PHA
+ AND #$7F
+ STA $C036
+ STA $C05A ; ENABLE SLAVE
+ LDY #0 ; ASSUME MSB IS ZERO
+ LDA ESTKL,X ; GET ARGUMENT
+ BPL + ; CHECK MSB
+ INY ; IT'S A ONE
++ STA $C058,Y ; WRITE BIT 7
+ STA $C05C ; CLOCK FALLING EDGE
+ LDY #0 ; DOING THIS HERE GIVES TIME FOR OUTPUT TO BECOME STABLE - NOT REALLY NEEDED
+ STA $C05D ; CLOCK RISING EDGE
+ ASL $C061 ; READ BIT 7 INTO CARRY
+ ROL ; ROTATE INTO ACC
+ BPL + ; REPEAT FOR ALL BITS
+ INY
++ STA $C058,Y
+ STA $C05C ; CLOCK FALLING EDGE
+ LDY #0
+ STA $C05D ; CLOCK RISING EDGE
+ ASL $C061
+ ROL
+ BPL +
+ INY
++ STA $C058,Y
+ STA $C05C ; CLOCK FALLING EDGE
+ LDY #0
+ STA $C05D ; CLOCK RISING EDGE
+ ASL $C061
+ ROL
+ BPL +
+ INY
++ STA $C058,Y
+ STA $C05C ; CLOCK FALLING EDGE
+ LDY #0
+ STA $C05D ; CLOCK RISING EDGE
+ ASL $C061
+ ROL
+ BPL +
+ INY
++ STA $C058,Y
+ STA $C05C ; CLOCK FALLING EDGE
+ LDY #0
+ STA $C05D ; CLOCK RISING EDGE
+ ASL $C061
+ ROL
+ BPL +
+ INY
++ STA $C058,Y
+ STA $C05C ; CLOCK FALLING EDGE
+ LDY #0
+ STA $C05D ; CLOCK RISING EDGE
+ ASL $C061
+ ROL
+ BPL +
+ INY
++ STA $C058,Y
+ STA $C05C ; CLOCK FALLING EDGE
+ LDY #0
+ STA $C05D ; CLOCK RISING EDGE
+ ASL $C061
+ ROL
+ BPL +
+ INY
++ STA $C058,Y
+ STA $C05C ; CLOCK FALLING EDGE
+ STA $C05D ; CLOCK RISING EDGE
+ ASL $C061
+ STA $C05B ; DISABLE SLAVE
+ ROL
+ STA ESTKL,X ; SAVE RETURN PARAMETER
+ PLA
+ STA $C036
+ PLP
+ RTS
+end
+asm spiReadBytesStd(buf, len)
+ PHP ; DISABLE INTS
+ SEI
LDA ESTKL+1,X
STA DSTL
LDA ESTKH+1,X
@@ -122,10 +210,77 @@ asm spiReadBytes(buf, len)
DEC ESTKH,X
BNE -
INX ; REMOVE AN ARGUMENT
+ PLP
RTS
end
-asm spiWriteBytes(buf, len)
+asm spiReadBytesGS(buf, len)
+ PHP ; DISABLE INTS
+ SEI
+ LDA $C036 ; SET 1 MHZ
+ PHA
+ AND #$7F
+ STA $C036
+ LDA ESTKL+1,X
+ STA DSTL
+ LDA ESTKH+1,X
+ STA DSTH
+ LDA ESTKL,X
+ BEQ +
+ INC ESTKH,X
++ LDY #$00
+- STA $C05A ; ENABLE SLAVE
+ STA $C05C ; CLOCK FALLING EDGE
+ STA $C05D ; CLOCK RISING EDGE
+ ASL $C061 ; SHIFT IN ALL BITS STARTING WITH MSB
+ ROL
+ STA $C05C ; CLOCK FALLING EDGE
+ STA $C05D ; CLOCK RISING EDGE
+ ASL $C061
+ ROL
+ STA $C05C ; CLOCK FALLING EDGE
+ STA $C05D ; CLOCK RISING EDGE
+ ASL $C061
+ ROL
+ STA $C05C ; CLOCK FALLING EDGE
+ STA $C05D ; CLOCK RISING EDGE
+ ASL $C061
+ ROL
+ STA $C05C ; CLOCK FALLING EDGE
+ STA $C05D ; CLOCK RISING EDGE
+ ASL $C061
+ ROL
+ STA $C05C ; CLOCK FALLING EDGE
+ STA $C05D ; CLOCK RISING EDGE
+ ASL $C061
+ ROL
+ STA $C05C ; CLOCK FALLING EDGE
+ STA $C05D ; CLOCK RISING EDGE
+ ASL $C061
+ ROL
+ STA $C05C ; CLOCK FALLING EDGE
+ STA $C05D ; CLOCK RISING EDGE
+ ASL $C061
+ STA $C05B ; DISABLE SLAVE
+ ROL
+ STA (DST),Y ; SAVE TO BUFFER
+ INY
+ BNE +
+ INC DSTH
++ DEC ESTKL,X
+ BNE -
+ DEC ESTKH,X
+ BNE -
+ INX ; REMOVE AN ARGUMENT
+ PLA
+ STA $C036
+ PLP
+ RTS
+end
+
+asm spiWriteBytesStd(buf, len)
+ PHP ; DISABLE INTS
+ SEI
LDA ESTKL+1,X
STA SRCL
LDA ESTKH+1,X
@@ -142,49 +297,49 @@ asm spiWriteBytes(buf, len)
+ STA $C058,Y ; WRITE BIT 7
STA $C040 ; CLOCK
LDY #0 ; DOING THIS HERE GIVES TIME FOR OUTPUT TO BECOME STABLE
- ROL ; ROTATE NEXT BIT TO SEND
+ ASL ; ROTATE NEXT BIT TO SEND
BPL + ; REPEAT FOR ALL BITS
INY
+ STA $C058,Y
STA $C040
LDY #0
- ROL
+ ASL
BPL +
INY
+ STA $C058,Y
STA $C040
LDY #0
- ROL
+ ASL
BPL +
INY
+ STA $C058,Y
STA $C040
LDY #0
- ROL
+ ASL
BPL +
INY
+ STA $C058,Y
STA $C040
LDY #0
- ROL
+ ASL
BPL +
INY
+ STA $C058,Y
STA $C040
LDY #0
- ROL
+ ASL
BPL +
INY
+ STA $C058,Y
STA $C040
LDY #0
- ROL
+ ASL
BPL +
INY
+ STA $C058,Y
STA $C040
STA $C05B ; DISABLE SLAVE
- INC SRCL
+ INC SRCL
BNE +
INC SRCH
+ DEC ESTKL,X
@@ -192,9 +347,59 @@ asm spiWriteBytes(buf, len)
DEC ESTKH,X
BNE -
INX ; REMOVE AN ARGUMENT
+ PLP
RTS
end
+asm spiWriteBytesGS(buf, len)
+ PHP ; DISABLE INTS
+ SEI
+ LDA $C036 ; SET 1 MHZ
+ PHA
+ AND #$7F
+ STA $C036
+ LDA ESTKL+1,X
+ STA SRCL
+ LDA ESTKH+1,X
+ STA SRCH
+ LDA ESTKL,X
+ BEQ +
+ INC ESTKH,X
++
+-- STA $C05A ; ENABLE SLAVE
+ PHX
+ LDX #8
+ LDY #0 ; ASSUME MSB IS ZERO
+ LDA (SRC),Y ; GET BYTE
+- ASL
+ BCC + ; CHECK MSB
+ INY ; IT'S A ONE
++ STA $C058,Y ; WRITE BIT 7
+ STA $C05C ; CLOCK FALLING EDGE
+ STA $C05D ; CLOCK RISING EDGE
+ LDY #0
+ DEX
+ BNE -
+ STA $C05B ; DISABLE SLAVE
+ INC SRCL
+ BNE +
+ INC SRCH
++ PLX
+ DEC ESTKL,X
+ BNE --
+ DEC ESTKH,X
+ BNE --
+ INX ; REMOVE AN ARGUMENT
+ PLA
+ STA $C036
+ PLP
+ RTS
+end
+
+export def spiXferByte(outbyte)
+ return (spiReadWriteByte)(outbyte)
+end
+
export def spiDelay(time)
return call($FCA8, time, 0, 0, 0) // DELAY
end
@@ -203,7 +408,7 @@ export def spiSend(data)
byte timeout, status
for timeout = 1 to 100 step 10
- status = spiXferByte(data)
+ status = (spiReadWriteByte)(data)
if status <> SPI_SLAVE_BUSY
return status
fin
@@ -220,20 +425,20 @@ end
export def spiWriteBuf(buf, len)
spiSend(13) // CMD_BUF_WRITE
spiSend(len >> 8); spiSend(len)
- return spiWriteBytes(buf, len)
+ return (spiWriteBytes)(buf, len)
end
export def spiReadBuf(buf, len)
spiSend(12) // CMD_BUF_READ
spiSend(len >> 8); spiSend(len)
- return spiReadBytes(buf, len)
+ return (spiReadBytes)(buf, len)
end
export def spiReady
byte timeout
timeout = 0xFF
- while spiXferByte(0) <> SPI_SLAVE_READY and timeout // WAIT FOR READY
+ while (spiReadWriteByte)(0) <> SPI_SLAVE_READY and timeout // WAIT FOR READY
timeout--
spiDelay(10)
loop
@@ -241,9 +446,19 @@ export def spiReady
end
export def spiReset
- ^$C05B
+ ^$C05B // DISABLE SLAVE SELECT
+ ^$C05D // CLOCK RAISE (GS ONLY)
return spiReady
end
+if call($FE1F, 0, 0, 0, 1).3 & 1 // GS ID ROUTINE
+ spiReadWriteByte = @spiXferByteStd
+ spiReadBytes = @spiReadBytesStd
+ spiWriteBytes = @spiWriteBytesStd
+else
+ spiReadWriteByte = @spiXferByteGS
+ spiReadBytes = @spiReadBytesGS
+ spiWriteBytes = @spiWriteBytesGS
+fin
return spiReset <> 0
done
diff --git a/src/makefile b/src/makefile
old mode 100644
new mode 100755
index 36ec4bb..c739677
--- a/src/makefile
+++ b/src/makefile
@@ -44,8 +44,8 @@ MEMMGR = MEMMGR\#FE1000
MEMTEST = MEMTEST\#FE1000
FIBER = FIBER\#FE1000
PLASM = plasm
-INCS = toolsrc/tokens.h toolsrc/symbols.h toolsrc/lex.h toolsrc/parse.h toolsrc/codegen.h
-OBJS = toolsrc/plasm.c toolsrc/parse.o toolsrc/lex.o toolsrc/codegen.o
+INCS = toolsrc/plasm.h toolsrc/tokens.h toolsrc/symbols.h toolsrc/lex.h toolsrc/parse.h toolsrc/codegen.h
+OBJS = toolsrc/plasm.c toolsrc/parse.c toolsrc/lex.c toolsrc/codegen.c
#
# Image filetypes for Virtual ][
#
@@ -83,20 +83,20 @@ $(PLVM): vmsrc/plvm.c
cc vmsrc/plvm.c -o $(PLVM)
vmsrc/a1cmd.a: vmsrc/a1cmd.pla $(PLASM)
- ./$(PLASM) -A < vmsrc/a1cmd.pla > vmsrc/a1cmd.a
+ ./$(PLASM) -AO < vmsrc/a1cmd.pla > vmsrc/a1cmd.a
$(PLVM01): vmsrc/plvm01.s vmsrc/a1cmd.a
acme -o $(PLVM01) -l vmsrc/plvm01.sym vmsrc/plvm01.s
$(CMD): vmsrc/cmd.pla vmsrc/cmdstub.s $(PLVM02) $(PLASM)
- ./$(PLASM) -A < vmsrc/cmd.pla > vmsrc/cmd.a
+ ./$(PLASM) -AO < vmsrc/cmd.pla > vmsrc/cmd.a
acme --setpc 8192 -o $(CMD) vmsrc/cmdstub.s
$(PLVM02): vmsrc/plvm02.s
acme -o $(PLVM02) -l vmsrc/plvm02.sym vmsrc/plvm02.s
vmsrc/soscmd.a: vmsrc/soscmd.pla $(PLASM)
- ./$(PLASM) -A < vmsrc/soscmd.pla > vmsrc/soscmd.a
+ ./$(PLASM) -AO < vmsrc/soscmd.pla > vmsrc/soscmd.a
$(PLVM03): vmsrc/plvm03.s vmsrc/soscmd.a
acme -o $(PLVM03) -l vmsrc/plvm03.sym vmsrc/plvm03.s
@@ -105,118 +105,118 @@ $(PLVM03): vmsrc/plvm03.s vmsrc/soscmd.a
# Sample code
#
test: samplesrc/test.pla samplesrc/testlib.pla $(PLVM) $(PLASM)
- ./$(PLASM) -AM < samplesrc/test.pla > samplesrc/test.a
+ ./$(PLASM) -AMO < samplesrc/test.pla > samplesrc/test.a
acme --setpc 4094 -o $(TEST) samplesrc/test.a
- ./$(PLASM) -AM < samplesrc/testlib.pla > samplesrc/testlib.a
+ ./$(PLASM) -AMO < samplesrc/testlib.pla > samplesrc/testlib.a
acme --setpc 4094 -o $(TESTLIB) samplesrc/testlib.a
./$(PLVM) TEST
$(ED): toolsrc/ed.pla $(PLVM02) $(PLASM) toolsrc/ed.pla
- ./$(PLASM) -A < toolsrc/ed.pla > toolsrc/ed.a
+ ./$(PLASM) -AO < toolsrc/ed.pla > toolsrc/ed.a
acme --setpc 8192 -o $(ED) toolsrc/ed.a
$(SB): toolsrc/sb.pla $(PLVM02) $(PLASM) toolsrc/sb.pla
- ./$(PLASM) -A < toolsrc/sb.pla > toolsrc/sb.a
+ ./$(PLASM) -AO < toolsrc/sb.pla > toolsrc/sb.a
acme --setpc 8192 -o $(SB) toolsrc/sb.a
$(ARGS): libsrc/args.pla $(PLVM02) $(PLASM)
- ./$(PLASM) -AM < libsrc/args.pla > libsrc/args.a
+ ./$(PLASM) -AMO < libsrc/args.pla > libsrc/args.a
acme --setpc 4094 -o $(ARGS) libsrc/args.a
$(MEMMGR): libsrc/memmgr.pla $(PLVM02) $(PLASM)
- ./$(PLASM) -AM < libsrc/memmgr.pla > libsrc/memmgr.a
+ ./$(PLASM) -AMO < libsrc/memmgr.pla > libsrc/memmgr.a
acme --setpc 4094 -o $(MEMMGR) libsrc/memmgr.a
$(MEMTEST): samplesrc/memtest.pla $(PLVM02) $(PLASM)
- ./$(PLASM) -AM < samplesrc/memtest.pla > samplesrc/memtest.a
+ ./$(PLASM) -AMO < samplesrc/memtest.pla > samplesrc/memtest.a
acme --setpc 4094 -o $(MEMTEST) samplesrc/memtest.a
$(FIBER): libsrc/fiber.pla $(PLVM02) $(PLASM)
- ./$(PLASM) -AM < libsrc/fiber.pla > libsrc/fiber.a
+ ./$(PLASM) -AMO < libsrc/fiber.pla > libsrc/fiber.a
acme --setpc 4094 -o $(FIBER) libsrc/fiber.a
$(MON): samplesrc/mon.pla $(PLVM02) $(PLASM)
- ./$(PLASM) -AM < samplesrc/mon.pla > samplesrc/mon.a
+ ./$(PLASM) -AMO < samplesrc/mon.pla > samplesrc/mon.a
acme --setpc 4094 -o $(MON) samplesrc/mon.a
$(ROD): samplesrc/rod.pla $(PLVM02) $(PLASM)
- ./$(PLASM) -AM < samplesrc/rod.pla > samplesrc/rod.a
+ ./$(PLASM) -AMOW < samplesrc/rod.pla > samplesrc/rod.a
acme --setpc 4094 -o $(ROD) samplesrc/rod.a
$(SIEVE): samplesrc/sieve.pla $(PLVM02) $(PLASM)
- ./$(PLASM) -AM < samplesrc/sieve.pla > samplesrc/sieve.a
+ ./$(PLASM) -AMO < samplesrc/sieve.pla > samplesrc/sieve.a
acme --setpc 4094 -o $(SIEVE) samplesrc/sieve.a
$(UTHERNET): libsrc/uthernet.pla $(PLVM02) $(PLASM)
- ./$(PLASM) -AM < libsrc/uthernet.pla > libsrc/uthernet.a
+ ./$(PLASM) -AMO < libsrc/uthernet.pla > libsrc/uthernet.a
acme --setpc 4094 -o $(UTHERNET) libsrc/uthernet.a
$(UTHERNET2): libsrc/uthernet2.pla $(PLVM02) $(PLASM)
- ./$(PLASM) -AM < libsrc/uthernet2.pla > libsrc/uthernet2.a
+ ./$(PLASM) -AMO < libsrc/uthernet2.pla > libsrc/uthernet2.a
acme --setpc 4094 -o $(UTHERNET2) libsrc/uthernet2.a
$(ETHERIP): libsrc/etherip.pla $(PLVM02) $(PLASM)
- ./$(PLASM) -AM < libsrc/etherip.pla > libsrc/etherip.a
+ ./$(PLASM) -AMO < libsrc/etherip.pla > libsrc/etherip.a
acme --setpc 4094 -o $(ETHERIP) libsrc/etherip.a
$(INET): libsrc/inet.pla $(PLVM02) $(PLASM)
- ./$(PLASM) -AM < libsrc/inet.pla > libsrc/inet.a
+ ./$(PLASM) -AMO < libsrc/inet.pla > libsrc/inet.a
acme --setpc 4094 -o $(INET) libsrc/inet.a
$(DHCP): libsrc/dhcp.pla $(PLVM02) $(PLASM)
- ./$(PLASM) -AM < libsrc/dhcp.pla > libsrc/dhcp.a
+ ./$(PLASM) -AMO < libsrc/dhcp.pla > libsrc/dhcp.a
acme --setpc 4094 -o $(DHCP) libsrc/dhcp.a
$(HTTPD): samplesrc/httpd.pla $(PLVM02) $(PLASM)
- ./$(PLASM) -AM < samplesrc/httpd.pla > samplesrc/httpd.a
+ ./$(PLASM) -AMO < samplesrc/httpd.pla > samplesrc/httpd.a
acme --setpc 4094 -o $(HTTPD) samplesrc/httpd.a
$(FILEIO): libsrc/fileio.pla $(PLVM02) $(PLASM)
- ./$(PLASM) -AM < libsrc/fileio.pla > libsrc/fileio.a
+ ./$(PLASM) -AMO < libsrc/fileio.pla > libsrc/fileio.a
acme --setpc 4094 -o $(FILEIO) libsrc/fileio.a
$(TONE): libsrc/tone.pla $(PLVM02) $(PLASM)
- ./$(PLASM) -AM < libsrc/tone.pla > libsrc/tone.a
+ ./$(PLASM) -AMO < libsrc/tone.pla > libsrc/tone.a
acme --setpc 4094 -o $(TONE) libsrc/tone.a
$(FATCAT): samplesrc/fatcat.pla $(PLVM02) $(PLASM)
- ./$(PLASM) -AM < samplesrc/fatcat.pla > samplesrc/fatcat.a
+ ./$(PLASM) -AMO < samplesrc/fatcat.pla > samplesrc/fatcat.a
acme --setpc 4094 -o $(FATCAT) samplesrc/fatcat.a
$(FATGET): samplesrc/fatget.pla $(PLVM02) $(PLASM)
- ./$(PLASM) -AM < samplesrc/fatget.pla > samplesrc/fatget.a
+ ./$(PLASM) -AMO < samplesrc/fatget.pla > samplesrc/fatget.a
acme --setpc 4094 -o $(FATGET) samplesrc/fatget.a
$(FATPUT): samplesrc/fatput.pla $(PLVM02) $(PLASM)
- ./$(PLASM) -AM < samplesrc/fatput.pla > samplesrc/fatput.a
+ ./$(PLASM) -AMO < samplesrc/fatput.pla > samplesrc/fatput.a
acme --setpc 4094 -o $(FATPUT) samplesrc/fatput.a
$(FATWDSK): samplesrc/fatwritedsk.pla $(PLVM02) $(PLASM)
- ./$(PLASM) -AM < samplesrc/fatwritedsk.pla > samplesrc/fatwritedsk.a
+ ./$(PLASM) -AMO < samplesrc/fatwritedsk.pla > samplesrc/fatwritedsk.a
acme --setpc 4094 -o $(FATWDSK) samplesrc/fatwritedsk.a
$(FATRDSK): samplesrc/fatreaddsk.pla $(PLVM02) $(PLASM)
- ./$(PLASM) -AM < samplesrc/fatreaddsk.pla > samplesrc/fatreaddsk.a
+ ./$(PLASM) -AMO < samplesrc/fatreaddsk.pla > samplesrc/fatreaddsk.a
acme --setpc 4094 -o $(FATRDSK) samplesrc/fatreaddsk.a
$(SDFAT): libsrc/sdfat.pla $(PLVM02) $(PLASM)
- ./$(PLASM) -AM < libsrc/sdfat.pla > libsrc/sdfat.a
+ ./$(PLASM) -AMO < libsrc/sdfat.pla > libsrc/sdfat.a
acme --setpc 4094 -o $(SDFAT) libsrc/sdfat.a
$(SPIPORT): libsrc/spiport.pla $(PLVM02) $(PLASM)
- ./$(PLASM) -AM < libsrc/spiport.pla > libsrc/spiport.a
+ ./$(PLASM) -AMO < libsrc/spiport.pla > libsrc/spiport.a
acme --setpc 4094 -o $(SPIPORT) libsrc/spiport.a
$(PORTIO): libsrc/portio.pla $(PLVM02) $(PLASM)
- ./$(PLASM) -AM < libsrc/portio.pla > libsrc/portio.a
+ ./$(PLASM) -AMO < libsrc/portio.pla > libsrc/portio.a
acme --setpc 4094 -o $(PORTIO) libsrc/portio.a
$(DGR): libsrc/dgr.pla $(PLVM02) $(PLASM)
- ./$(PLASM) -AM < libsrc/dgr.pla > libsrc/dgr.a
+ ./$(PLASM) -AMO < libsrc/dgr.pla > libsrc/dgr.a
acme --setpc 4094 -o $(DGR) libsrc/dgr.a
$(DGRTEST): samplesrc/dgrtest.pla $(PLVM02) $(PLASM)
- ./$(PLASM) -AM < samplesrc/dgrtest.pla > samplesrc/dgrtest.a
+ ./$(PLASM) -AMO < samplesrc/dgrtest.pla > samplesrc/dgrtest.a
acme --setpc 4094 -o $(DGRTEST) samplesrc/dgrtest.a
$(ROGUE): samplesrc/rogue.pla $(PLVM02) $(PLASM)
@@ -236,12 +236,12 @@ $(ROGUEMAP): samplesrc/rogue.map.pla $(PLVM02) $(PLASM)
acme --setpc 4094 -o $(ROGUEMAP) samplesrc/rogue.map.a
$(HGR1): samplesrc/hgr1.pla samplesrc/hgr1test.pla $(PLVM02) $(PLASM)
- ./$(PLASM) -AM < samplesrc/hgr1test.pla > samplesrc/hgr1test.a
+ ./$(PLASM) -AMO < samplesrc/hgr1test.pla > samplesrc/hgr1test.a
acme --setpc 4094 -o $(HGR1TEST) samplesrc/hgr1test.a
- ./$(PLASM) -AM < samplesrc/hgr1.pla > samplesrc/hgr1.a
+ ./$(PLASM) -AMO < samplesrc/hgr1.pla > samplesrc/hgr1.a
acme --setpc 4094 -o $(HGR1) samplesrc/hgr1.a
hello: samplesrc/hello.pla $(PLVM) $(PLASM)
- ./$(PLASM) -AM < samplesrc/hello.pla > samplesrc/hello.a
+ ./$(PLASM) -AMO < samplesrc/hello.pla > samplesrc/hello.a
acme --setpc 4094 -o $(HELLO) samplesrc/hello.a
./$(PLVM) HELLO
diff --git a/src/samplesrc/a2pwm/a2pwm.s b/src/samplesrc/a2pwm/a2pwm.s
new file mode 100755
index 0000000..11f766b
--- /dev/null
+++ b/src/samplesrc/a2pwm/a2pwm.s
@@ -0,0 +1,395 @@
+;****************************************************************
+;*
+;* PWM SOUND ROUTINES
+;*
+;****************************************************************
+;*
+;* PWM ZERO PAGE LOCATIONS
+;*
+SPEAKER = $C030
+HFO = $08
+LFO = $09
+LFOINDEX= $0A ; IF LFOUSRH == 0
+LFOUSRL = $0A
+LFOUSRH = $0B
+ATK = $0C
+DCY = $0D
+SUS = $0E
+RLS = $0F
+ATKINCL = $10
+ATKINCH = $11
+DCYINCL = $12
+DCYINCH = $13
+RLSINCL = $14
+RLSINCH = $15
+ADSRL = $16
+ADSRH = $17
+ADSRINCL= $18
+ADSRINCH= $19
+TONELEN = $1B
+LPCNT = $1C
+HFOCNT = $1D
+LFOPOSL = $1E
+LFOPOSH = $1F
+LFOPTR = $00
+LFOPTRL = LFOPTR
+LFOPTRH = LFOPTRL+1
+;*
+;* PWM ENTRY POINT
+;*
+HILOPWM LDA LFOUSRL
+ LDX LFOUSRH
+ BNE + ; USER SUPPLIED WAVEFORM
+ LDX #>LFOTBL
+ ASL
+ ASL
+ ASL
+ ASL
+ ASL
++ STA LFOPTRL
+ STX LFOPTRH
+ PHP
+ SEI
+ LDY #$00
+ STY LFOPOSL
+; STY LFOPOSH
+ STY LPCNT
+ STY ADSRL
+; STY ADSRH
+ LDA #$02
+ STA HFOCNT
+ATTACK LDX #$0F
+ LDA ATK
+ BEQ DECAY
+ LDX #$00
+ STA TONELEN
+ LDA ATKINCL
+ STA ADSRINCL
+ LDA ATKINCH
+ STA ADSRINCH
+ JSR HILOSND
+DECAY LDA DCY
+ BEQ SUSTAIN
+ STA TONELEN
+ LDA #$00 ; REVERSE ATTACK RATE
+ SEC
+ SBC DCYINCL
+ STA ADSRINCL
+ LDA #$00
+ SBC DCYINCH
+ STA ADSRINCH
+ JSR HILOSND
+SUSTAIN LDA SUS
+ BEQ RELEASE
+ STA TONELEN
+ LDA #$00 ; SUSTAIN DOESN'T ALTER VOLUME
+ STA ADSRINCL
+ STA ADSRINCH
+ JSR HILOSND
+RELEASE LDA RLS
+ BEQ PWMEXIT
+ STA TONELEN
+ LDA #$00 ; REVERSE RELEASE RATE
+ SEC
+ SBC RLSINCL
+ STA ADSRINCL
+ LDA #$00
+ SBC RLSINCH
+ STA ADSRINCH
+ JSR HILOSND
+PWMEXIT PLP
+ RTS
+PWMSND CLC ; 1, 2
+ LDA ADSRL ; 2, 3
+ ADC ADSRINCL ; 2, 3
+ STA TMP ; 2, 3
+ TXA ; 1, 2
+ ADC ADSRINCH ; 2, 3
+ DEC LPCNT ; 2, 5
+ ;------
+ ;12,21
+
+ BNE HILOSND ; 2, 2
+ AND #$0F ; 2, 2
+ TAX ; 1, 2
+ LDA TMP ; 2, 3
+ STA ADSRL ; 2, 3
+ DEC TONELEN ; 2, 5
+ BEQ PWMRET ; 2, 2
+ DEC HFOCNT ; 2, 5
+ BEQ SPKRON ; 2, 2
+ CLC ; 1, 2
+ LDA LFOPOSL ; 2, 3
+ ADC LFO ; 2, 3
+ STA LFOPOSL ; 2, 3
+ TYA ; 1, 2
+ ADC #$00 ; 2, 2
+ AND #$1F ; 2, 2
+ TAY ; 1, 2
+ TXA ; 1, 2
+ ORA (LFOPTR),Y ; 2, 5
+ STA *+4 ; 3, 4
+ LDA MUL4X4 ; 3, 4
+ ASL ; 1, 2
+ STA SPKRPWM+1 ; 3, 4
+ LDA #>PWM1 ; 2, 2
+ ADC #$00 ; 2, 2
+ STA SPKRPWM+2 ; 3, 4
+ NOP ; 1, 2
+ JMP PWMSND ; 3, 3
+ ;------
+ ;55,79
+
+; BNE HILOSND ; , 3
+HILOSND DEC HFOCNT ; 2, 5
+ BNE + ; 2, 2
+SPKRON BIT SPEAKER ; 3, 4
+SPKRPWM JMP PWM1 ; 3, 3+62
+ ;------
+ ;10,79
+
+; BNE HILOSND ; , 3
+; DEC HFOCNT ; , 5
+; BNE + ; , 3
++ BNE ++ ; 2, 3
+++ NOP ; 1, 2
+ NOP ; 1, 2
+ NOP ; 1, 2
+ NOP ; 1, 2
+ NOP ; 1, 2
+ NOP ; 1, 2
+ NOP ; 1, 2
+ CLC ; 1, 2
+ LDA LFOPOSL ; 2, 3
+ ADC LFO ; 2, 3
+ STA LFOPOSL ; 2, 3
+ TYA ; 1, 2
+ ADC #$00 ; 2, 2
+ AND #$1F ; 2, 2
+ TAY ; 1, 2
+ TXA ; 1, 2
+ ORA (LFOPTR),Y ; 2, 5
+ STA *+4 ; 3, 4
+ LDA MUL4X4 ; 3, 4
+ ASL ; 1, 2
+ STA SPKRPWM+1 ; 3, 4
+ LDA #>PWM1 ; 2, 2
+ ADC #$00 ; 2, 2
+ STA SPKRPWM+2 ; 3, 4
+ JMP PWMSND ; 3, 3
+ ;------
+ ;44,79
+PWMRET RTS
+;*
+;* 4 BIT x 4 BIT TO 3.5 BIT MULTIPLY TABLE
+;*
+ !ALIGN 255,0
+MUL4X4 !BYTE $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00
+ !BYTE $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00
+ !BYTE $00, $00, $00, $00, $00, $00, $00, $00, $20, $20, $20, $20, $20, $20, $20, $20
+ !BYTE $00, $00, $00, $00, $00, $00, $20, $20, $20, $20, $20, $20, $20, $20, $20, $20
+ !BYTE $00, $00, $00, $00, $20, $20, $20, $20, $20, $20, $20, $20, $40, $40, $40, $40
+ !BYTE $00, $00, $00, $00, $20, $20, $20, $20, $20, $20, $40, $40, $40, $40, $40, $40
+ !BYTE $00, $00, $00, $20, $20, $20, $20, $20, $40, $40, $40, $40, $40, $40, $60, $60
+ !BYTE $00, $00, $00, $20, $20, $20, $20, $40, $40, $40, $40, $40, $60, $60, $60, $60
+ !BYTE $00, $00, $20, $20, $20, $20, $40, $40, $40, $40, $60, $60, $60, $60, $80, $80
+ !BYTE $00, $00, $20, $20, $20, $20, $40, $40, $40, $60, $60, $60, $60, $80, $80, $80
+ !BYTE $00, $00, $20, $20, $20, $40, $40, $40, $60, $60, $60, $60, $80, $80, $80, $A0
+ !BYTE $00, $00, $20, $20, $20, $40, $40, $40, $60, $60, $60, $80, $80, $80, $A0, $A0
+ !BYTE $00, $00, $20, $20, $40, $40, $40, $60, $60, $60, $80, $80, $A0, $A0, $A0, $C0
+ !BYTE $00, $00, $20, $20, $40, $40, $40, $60, $60, $80, $80, $80, $A0, $A0, $C0, $C0
+ !BYTE $00, $00, $20, $20, $40, $40, $60, $60, $80, $80, $80, $A0, $A0, $C0, $C0, $E0
+ !BYTE $00, $00, $20, $20, $40, $40, $60, $60, $80, $80, $A0, $A0, $C0, $C0, $E0, $E0
+LFOTBL !SOURCE "lfotbl.s"
+ !ALIGN 63,0
+PWM1 BIT SPEAKER ; 3, 4
+ CLC ; 1, 2
+ LDA LFOPOSL ; 2, 3
+ ADC LFO ; 2, 3
+ STA LFOPOSL ; 2, 3
+ TYA ; 1, 2
+ ADC #$00 ; 2, 2
+ AND #$1F ; 2, 2
+ TAY ; 1, 2
+ TXA ; 1, 2
+ ORA (LFOPTR),Y ; 2, 5
+ STA *+4 ; 3, 4
+ LDA MUL4X4 ; 3, 4
+ ASL ; 1, 2
+ STA SPKRPWM+1 ; 3, 4
+ LDA #>PWM1 ; 2, 2
+ ADC #$00 ; 2, 2
+ STA SPKRPWM+2 ; 3, 4
+ LDA HFO ; 2, 3
+ STA HFOCNT ; 2, 3
+ JMP PWMSND ; 3, 3
+ ;------
+ ;43,61
+ !ALIGN 63,0
+PWM2 CLC ; 1, 2
+ LDA LFOPOSL ; 2, 3
+ BIT SPEAKER ; 3, 4
+ ADC LFO ; 2, 3
+ STA LFOPOSL ; 2, 3
+ TYA ; 1, 2
+ ADC #$00 ; 2, 2
+ AND #$1F ; 2, 2
+ TAY ; 1, 2
+ TXA ; 1, 2
+ ORA (LFOPTR),Y ; 2, 5
+ STA *+4 ; 3, 4
+ LDA MUL4X4 ; 3, 4
+ ASL ; 1, 2
+ STA SPKRPWM+1 ; 3, 4
+ LDA #>PWM1 ; 2, 2
+ ADC #$00 ; 2, 2
+ STA SPKRPWM+2 ; 3, 4
+ LDA HFO ; 2, 3
+ STA HFOCNT ; 2, 3
+ JMP PWMSND ; 3, 3
+ ;------
+ ;43,62
+ !ALIGN 63,0
+PWM3 CLC ; 1, 2
+ LDA LFOPOSL ; 2, 3
+ ADC LFO ; 2, 3
+ STA LFOPOSL ; 2, 3
+ BIT SPEAKER ; 3, 4
+ TYA ; 1, 2
+ ADC #$00 ; 2, 2
+ AND #$1F ; 2, 2
+ TAY ; 1, 2
+ TXA ; 1, 2
+ ORA (LFOPTR),Y ; 2, 5
+ STA *+4 ; 3, 4
+ LDA MUL4X4 ; 3, 4
+ ASL ; 1, 2
+ STA SPKRPWM+1 ; 3, 4
+ LDA #>PWM1 ; 2, 2
+ ADC #$00 ; 2, 2
+ STA SPKRPWM+2 ; 3, 4
+ LDA HFO ; 2, 3
+ STA HFOCNT ; 2, 3
+ JMP PWMSND ; 3, 3
+ ;------
+ ;43,61
+ !ALIGN 63,0
+PWM4 CLC ; 1, 2
+ LDA LFOPOSL ; 2, 3
+ ADC LFO ; 2, 3
+ STA LFOPOSL ; 2, 3
+ TYA ; 1, 2
+ ADC #$00 ; 2, 2
+ AND #$1F ; 2, 2
+ TAY ; 1, 2
+ BIT SPEAKER ; 3, 4
+ TXA ; 1, 2
+ ORA (LFOPTR),Y ; 2, 5
+ STA *+4 ; 3, 4
+ LDA MUL4X4 ; 3, 4
+ ASL ; 1, 2
+ STA SPKRPWM+1 ; 3, 4
+ LDA #>PWM1 ; 2, 2
+ ADC #$00 ; 2, 2
+ STA SPKRPWM+2 ; 3, 4
+ LDA HFO ; 2, 3
+ STA HFOCNT ; 2, 3
+ JMP PWMSND ; 3, 3
+ ;------
+ ;43,61
+ !ALIGN 63,0
+PWM5 CLC ; 1, 2
+ LDA LFOPOSL ; 2, 3
+ ADC LFO ; 2, 3
+ STA LFOPOSL ; 2, 3
+ TYA ; 1, 2
+ ADC #$00 ; 2, 2
+ AND #$1F ; 2, 2
+ TAY ; 1, 2
+ TXA ; 1, 2
+ ORA (LFOPTR),Y ; 2, 5
+ BIT SPEAKER ; 3, 4
+ STA *+4 ; 3, 4
+ LDA MUL4X4 ; 3, 4
+ ASL ; 1, 2
+ STA SPKRPWM+1 ; 3, 4
+ LDA #>PWM1 ; 2, 2
+ ADC #$00 ; 2, 2
+ STA SPKRPWM+2 ; 3, 4
+ LDA HFO ; 2, 3
+ STA HFOCNT ; 2, 3
+ JMP PWMSND ; 3, 3
+ ;------
+ ;43,61
+ !ALIGN 63,0
+PWM6 CLC ; 1, 2
+ LDA LFOPOSL ; 2, 3
+ ADC LFO ; 2, 3
+ STA LFOPOSL ; 2, 3
+ TYA ; 1, 2
+ ADC #$00 ; 2, 2
+ AND #$1F ; 2, 2
+ TAY ; 1, 2
+ TXA ; 1, 2
+ ORA (LFOPTR),Y ; 2, 5
+ STA *+4 ; 3, 4
+ LDA MUL4X4 ; 3, 4
+ BIT SPEAKER ; 3, 4
+ ASL ; 1, 2
+ STA SPKRPWM+1 ; 3, 4
+ LDA #>PWM1 ; 2, 2
+ ADC #$00 ; 2, 2
+ STA SPKRPWM+2 ; 3, 4
+ LDA HFO ; 2, 3
+ STA HFOCNT ; 2, 3
+ JMP PWMSND ; 3, 3
+ ;------
+ ;43,61
+ !ALIGN 63,0
+PWM7 CLC ; 1, 2
+ LDA LFOPOSL ; 2, 3
+ ADC LFO ; 2, 3
+ STA LFOPOSL ; 2, 3
+ TYA ; 1, 2
+ ADC #$00 ; 2, 2
+ AND #$1F ; 2, 2
+ TAY ; 1, 2
+ TXA ; 1, 2
+ ORA (LFOPTR),Y ; 2, 5
+ STA *+4 ; 3, 4
+ LDA MUL4X4 ; 3, 4
+ ASL ; 1, 2
+ STA SPKRPWM+1 ; 3, 4
+ LDA #>PWM1 ; 2, 2
+ ADC #$00 ; 2, 2
+ BIT SPEAKER ; 3, 4
+ STA SPKRPWM+2 ; 3, 4
+ LDA HFO ; 2, 3
+ STA HFOCNT ; 2, 3
+ JMP PWMSND ; 3, 3
+ ;------
+ ;43,61
+ !ALIGN 63,0
+PWM8 CLC ; 1, 2
+ LDA LFOPOSL ; 2, 3
+ ADC LFO ; 2, 3
+ STA LFOPOSL ; 2, 3
+ TYA ; 1, 2
+ ADC #$00 ; 2, 2
+ AND #$1F ; 2, 2
+ TAY ; 1, 2
+ TXA ; 1, 2
+ ORA (LFOPTR),Y ; 2, 5
+ STA *+4 ; 3, 4
+ LDA MUL4X4 ; 3, 4
+ ASL ; 1, 2
+ STA SPKRPWM+1 ; 3, 4
+ LDA #>PWM1 ; 2, 2
+ ADC #$00 ; 2, 2
+ STA SPKRPWM+2 ; 3, 4
+ LDA HFO ; 2, 3
+ STA HFOCNT ; 2, 3
+ BIT SPEAKER ; 3, 4
+ JMP PWMSND ; 3, 3
+ ;------
+ ;43,61
diff --git a/src/samplesrc/a2pwm/hilopwm.pla b/src/samplesrc/a2pwm/hilopwm.pla
new file mode 100755
index 0000000..623b008
--- /dev/null
+++ b/src/samplesrc/a2pwm/hilopwm.pla
@@ -0,0 +1,608 @@
+const inbuff = $200
+const freemem = $0002
+const iobuffer = $1C00
+const NMACROS = 7
+const FALSE = 0
+const TRUE = !FALSE
+//
+// Sequence values
+//
+const SEQ_MACRO = 0
+const SEQ_NOTE = 7
+const SEQ_LFO = 21
+const SEQ_LFO_INC = 29
+const SEQ_LFO_DEC = 30
+const SEQ_OCT_INC = 31
+const SEQ_OCT_DEC = 32
+const SEQ_DUR_INC = 33
+const SEQ_DUR_DEC = 34
+const SEQ_REST = 35
+//
+// Predefine replay functions
+//
+predef playback, replaynote, replayrest
+predef replaylfo, replaylfoinc, replaylfodec
+predef replayoctinc, replayoctdec, replaydurinc, replaydurdec
+//
+// Replay function pointers
+//
+word replay[] = @playback, @playback, @playback, @playback, @playback, @playback
+word = @playback
+word = @replaynote, @replaynote, @replaynote, @replaynote, @replaynote, @replaynote
+word = @replaynote, @replaynote, @replaynote, @replaynote, @replaynote, @replaynote
+word = @replaynote, @replaynote
+word = @replaylfo, @replaylfo, @replaylfo, @replaylfo, @replaylfo, @replaylfo
+word = @replaylfo, @replaylfo
+word = @replaylfoinc, @replaylfodec
+word = @replayoctinc, @replayoctdec
+word = @replaydurinc, @replaydurdec
+word = @replayrest
+
+//
+// Patch state
+//
+struc t_state
+ byte durAtk
+ byte durDcy
+ byte durSus
+ byte durRel
+ word rateAtk
+ word rateDcy
+ word rateRel
+ byte octave
+ byte LFO
+ byte idxLFO
+end
+//
+// Macro sequence structure
+//
+struc t_macro
+ byte absStart
+ byte stateStart[t_state]
+ byte sequence[256]
+end
+byte current[t_state] // Current state
+word macros // Pointer to macros
+byte record[t_macro] // Recording buffer
+word recording = FALSE // Recording key/flag
+byte playing = 0 // Keep track of active macros
+byte recalc = FALSE // Recalc envelope flag
+//
+// System variables.
+//
+word heap
+//
+// Periods of scale in second octave
+//
+byte scale0[] = 163, 154, 146, 137, 130, 122, 116, 109, 103, 97, 92, 87, 82, 77
+byte scale1[] = 82, 77, 73, 69, 65, 61, 58, 55, 52, 49, 46, 43, 41, 39
+byte scale2[] = 41, 39, 37, 34, 33, 31, 29, 27, 26, 24, 23, 22, 21, 19
+byte scale3[] = 21, 19, 18, 17, 16, 15, 14, 14, 13, 12, 11, 11, 10, 10
+word scale[] = @scale0, @scale1, @scale2, @scale3
+//
+// Key mapping to note
+//
+byte keytone[] = 'A','S','E','D','R','F','G','Y','H','U','J','I','K','L'
+//
+// Macro sequence keys
+//
+byte keymacro[] = 'Z', 'X', 'C', 'V', 'B', 'N', 'M'
+//
+// Macro record keys
+//
+byte keyrecord[] = $1A, $18, $03, $16, $02, $0E, $0D
+//
+// Note duration
+//
+byte duration = 16
+//
+// Patch filename
+//
+byte patch = "PATCH"
+byte modPatch = FALSE
+//
+// Import utility routines
+//
+include "util.pla"
+//
+// Load/Save PATCH
+//
+def loadPatch
+ byte refnum
+
+ refnum = open(@patch, iobuffer)
+ if refnum
+ read(refnum, macros, t_macro * NMACROS) // Macros
+ read(refnum, @current, t_state) // Initial values
+ close(refnum)
+ fin
+ return refnum <> 0
+end
+def savePatch
+ byte refnum
+
+ destroy(@patch)
+ create(@patch, $C3, $06, $00) // full access, BIN file
+ refnum = open(@patch, iobuffer)
+ if refnum
+ write(refnum, macros, t_macro * NMACROS) // Macros
+ write(refnum, @current, t_state) // Initial values
+ close(refnum)
+ modPatch = FALSE
+ fin
+ return refnum <> 0
+end
+//
+// Query routines
+//
+def query(str)
+ byte c
+
+ inverse
+ clearview
+ putsxy(20 - ^str / 2, 2, str)
+ c = toupper(getc)
+ return c == 'Y'
+end
+//
+// Display LFO bar
+//
+def showLFO
+ grcolor(WHITE)
+ rect(33, 39, 6, 39, FALSE)
+ if current.LFO < 32
+ grcolor(ORANGE)
+ rect(34, 38, 7, 38-current.LFO, TRUE)
+ fin
+ if current.LFO
+ grcolor(DRKBLU)
+ rect(34, 38, 39-current.LFO, 38, TRUE)
+ fin
+ //
+ //Show actual value
+ //
+ putsxy(35, 0, " ")
+ gotoxy(35, 0)
+ return puti(current.LFO)
+end
+//
+// Display LFO waveform
+//
+def showWaveform
+ byte i, mapBar
+ word mapPtr
+ //
+ // Get pointer to LFO waveform by calling PWM with zero note
+ //
+ envelope(0, 0, 0, 0, current:rateAtk, current:rateDcy, current:rateRel)
+ hilopwm(0, current.LFO, current.idxLFO)
+ mapPtr = *0 // Pointer at address 0
+ grcolor(WHITE)
+ rect(0, 33, 6, 39, FALSE)
+ for i = 0 to 31
+ mapBar = ^(mapPtr + i) >> 3
+ grcolor(BLACK)
+ vlin(7, 38-mapBar, i + 1)
+ grcolor(MAGENTA)
+ vlin(38 - mapBar, 38, i + 1)
+ grcolor(PURPLE)
+ vlin(37-mapBar, 38-mapBar, i + 1)
+ next
+ //
+ // Restore envelope
+ //
+ return envelope(current.durAtk, current.durDcy, current.durSus, current.durRel, current:rateAtk, current:rateDcy, current:rateRel)
+end
+//
+// Display duration
+//
+def showDuration
+ byte left, right
+
+ if duration == 40
+ left = 0
+ right = 39
+ else
+ left = 19-duration/2
+ right = left + duration
+ fin
+ grcolor(BLACK)
+ if left > 0
+ rect(0, left-1, 0, 5, TRUE)
+ fin
+ if right < 39
+ rect(right+1, 39, 0, 5, TRUE)
+ fin
+ grcolor(AQUA)
+ rect(left, right, 0, 5, TRUE)
+ //
+ // Show actual value
+ //
+ putsxy(4, 3, " ")
+ gotoxy(4, 3)
+ return puti(duration)
+end
+//
+// Display octave
+//
+def showOctave
+ inverse
+ putsxy(0, 1, "----------------------------------------")
+ normal
+ putsxy(current.octave*10, 1, "----------")
+ return inverse
+end
+def showMainPanel
+ inverse
+ clearview
+ showDuration
+ showWaveform
+ showLFO
+ putsxy(5, 0, "OSCILLATION OVERTHRUSTER 1.3")
+ normal
+ putsxy(1, 0, "1-8")
+ gotoxy(34, 0); putc('<')
+ gotoxy(38, 0); putc('>')
+ gotoxy(3, 3); putc('-')
+ gotoxy(6, 3); putc('+')
+ inverse
+ showOctave
+ normal
+ putsxy(0, 2, "<-")
+ putsxy(38, 2, "->")
+ inverse
+ putsxy(11, 3, "A S D F G H J K L")
+ normal
+ gotoxy(14, 2); putc('E')
+ gotoxy(16, 2); putc('R')
+ gotoxy(20, 2); putc('Y')
+ gotoxy(22, 2); putc('U')
+ gotoxy(24, 2); putc('I')
+ return inverse
+end
+def showHelp
+ normal
+ home
+ putsxy(15, 0, "HELP")
+ putsxy(0, 1, "=======================================")
+ putsxy(2, 3, "KEY COMMAND")
+ putsxy(2, 4, "-------------- --------------------")
+ putsxy(2, 5, "ESC HELP/CANCEL RECORD")
+ putsxy(2, 6, "CTRL-Q QUIT")
+ putsxy(2, 7, "1..8 LFO WAVEFORM")
+ putsxy(2, 8, "< , INCREASE LFO")
+ putsxy(2, 9, "> . DECREASE LFO")
+ putsxy(2, 10, "LEFT-ARROW PREV OCTAVE")
+ putsxy(2, 11, "RIGHT-ARROW NEXT OCTAVE")
+ putsxy(2, 12, "+ UP-ARROW INCREASE DURATION")
+ putsxy(2, 13, "- DOWN-ARROW DECREASE DURATION")
+ putsxy(2, 14, "CTRL-Z..M RECORD MACRO")
+ putsxy(2, 15, "/ SAVE ABS MACRO")
+ putsxy(2, 16, "? SAVE REL MACRO")
+ putsxy(2, 17, "P PERSISTANT STATE")
+ putsxy(2, 18, "0 TOGGLE PHASE")
+ putsxy(8, 23, "PRESS A KEY TO RETURN")
+ return getc
+end
+//
+// Recalc envelope parameters
+//
+def recalcEnv
+ current.durAtk = duration/8
+ current.durDcy = 0
+ current.durRel = duration/2
+ current.durSus = duration - current.durAtk - current.durRel
+ current:rateAtk = $0FFF/current.durAtk
+ current:rateDcy = 0
+ current:rateRel = $0FFF/current.durRel
+ recalc = FALSE
+ return envelope(current.durAtk, current.durDcy, current.durSus, current.durRel, current:rateAtk, current:rateDcy, current:rateRel)
+end
+//
+// Playback a sequence
+//
+def playback(idx)
+ word macro
+ byte seq, i
+ byte save[t_state]
+
+ //
+ // Check for recursive playback
+ //
+ if playing & (1 << idx)
+ return
+ fin
+ playing = playing | (1 << idx)
+ macro = macros + t_macro * idx
+ //
+ // Save current state
+ //
+ memcpy(@save, @current, t_state)
+ //
+ // Start off with initial conditions
+ //
+ if macro->absStart
+ memcpy(@current, macro + stateStart, t_state)
+ duration = current.durAtk + current.durDcy + current.durSus + current.durRel
+ envelope(current.durAtk, current.durDcy, current.durSus, current.durRel, current:rateAtk, current:rateDcy, current:rateRel)
+ recalc = FALSE
+ fin
+ //
+ // Run throught the sequence
+ //
+ for i = 1 to macro->sequence
+ seq = macro->sequence[i]
+ (replay[seq])(seq)
+ next
+ //
+ // Restore state
+ //
+ memcpy(@current, @save, t_state)
+ duration = current.durAtk + current.durDcy + current.durSus + current.durRel
+ envelope(current.durAtk, current.durDcy, current.durSus, current.durRel, current:rateAtk, current:rateDcy, current:rateRel)
+ playing = playing & ~(1 << idx)
+ return recalcEnv
+end
+//
+// Replay rest
+//
+def replayrest(idx)
+ byte d
+
+ for d = duration downto 1
+ call($FCA8, $6A, 0, 0, 0)
+ next
+end
+//
+// Replay note
+//
+def replaynote(idx)
+ if recalc
+ recalcEnv
+ fin
+ if current.LFO == 0
+ hilopwm(scale.[current.octave, idx - SEQ_NOTE], 0, 0)
+ else
+ hilopwm(scale.[current.octave, idx - SEQ_NOTE], current.LFO, current.idxLFO)
+ fin
+end
+//
+// Replay duration
+//
+def replaydurinc(idx)
+ if duration < 40
+ duration++
+ recalc = TRUE;
+ fin
+end
+def replaydurdec(idx)
+ if duration > 1
+ duration--
+ recalc = TRUE;
+ fin
+end
+//
+// Replay octave
+//
+def replayoctinc(idx)
+ if current.octave < 3
+ current.octave++
+ fin
+end
+def replayoctdec(idx)
+ if current.octave > 0
+ current.octave--
+ fin
+end
+//
+// Replay LFO
+//
+def replaylfoinc(idx)
+ if current.LFO > 0
+ current.LFO--
+ fin
+end
+def replaylfodec(idx)
+ if current.LFO < 32
+ current.LFO++
+ fin
+end
+def replaylfo(idx)
+ current.idxLFO = idx - SEQ_LFO
+end
+//
+// Main loop
+//
+def main
+ byte quit, key, i
+ word seq
+
+ quit = FALSE
+ repeat
+ if keypressed
+ key = toupper(getc)
+ seq = -1
+ //
+ // Check for tone keys
+ //
+ for i = 0 to 13
+ if keytone[i] == key
+ if current.LFO == 0
+ hilopwm(scale.[current.octave, i], 0, 0)
+ else
+ hilopwm(scale.[current.octave, i], current.LFO, current.idxLFO)
+ fin
+ seq = SEQ_NOTE + i
+ break
+ fin
+ next
+ //
+ // Check for macro keys
+ //
+ if i > 13
+ for i = 0 to 6
+ if keymacro[i] == key
+ playback(i)
+ seq = SEQ_MACRO + i
+ break
+ fin
+ next
+ if i > 6
+ if not recording
+ for i = 0 to 6
+ if keyrecord[i] == key
+ recording = (key << 8) | i
+ //
+ // Save current state
+ //
+ memcpy(@record.stateStart, @current, t_state)
+ record.absStart = TRUE
+ record.sequence = 0
+ normal
+ putsxy(29, 3, "RECORDING")
+ inverse
+ break
+ fin
+ next
+ fin
+ if i > 6
+ when key
+ is $1B // ESC
+ if recording // Cancel recording
+ recording = FALSE
+ putsxy(29, 3, " ")
+ else
+ textmode
+ showHelp
+ grmode
+ showMainPanel
+ fin
+ break
+ is $11 // CTRL-Q
+ quit = query("QUIT (Y/N)?")
+ if not quit
+ showMainPanel
+ fin
+ break
+ is '?'
+ record.absStart = FALSE
+ is '/'
+ if recording // Copy recorded macro to key macro
+ memcpy(macros + t_macro * (recording & $FF), @record, t_macro)
+ recording = FALSE
+ modPatch = TRUE
+ putsxy(29, 3, " ")
+ fin
+ break
+ is '+'
+ is $0B // UP
+ if duration < 40
+ duration++
+ recalcEnv
+ showDuration
+ fin
+ seq = SEQ_DUR_INC
+ break
+ is '-'
+ is $0A // DOWN
+ if duration > 1
+ duration--
+ recalcEnv
+ showDuration
+ fin
+ seq = SEQ_DUR_DEC
+ break
+ is $15 // ->
+ if current.octave < 3
+ current.octave++
+ showOctave
+ fin
+ seq = SEQ_OCT_INC
+ break
+ is $08 // <-
+ if current.octave > 0
+ current.octave--
+ showOctave
+ fin
+ seq = SEQ_OCT_DEC
+ break
+ is '1'
+ is '2'
+ is '3'
+ is '4'
+ is '5'
+ is '6'
+ is '7'
+ is '8'
+ current.idxLFO = key - '1'
+ showWaveform
+ seq = SEQ_LFO + current.idxLFO
+ break
+ is '>'
+ is '.'
+ if current.LFO < 32
+ current.LFO++
+ fin
+ showLFO
+ seq = SEQ_LFO_INC
+ break
+ is '<'
+ is ','
+ if current.LFO > 0
+ current.LFO--
+ fin
+ showLFO
+ seq = SEQ_LFO_DEC
+ break
+ is 'P'
+ if modPatch
+ savePatch
+ fin
+ break
+ is '0' // Toggle speaker phase
+ ^$C030
+ break
+ wend
+ fin
+ fin
+ fin
+ if recording and seq >= 0
+ if record.sequence < 255
+ record.sequence++
+ record.sequence[record.sequence] = seq
+ else
+ beep
+ fin
+ fin
+ fin
+ until quit
+end
+//
+// Get us into a standard 40 column video mode
+//
+call($FDED, $8D, 0, 0, 0)
+call($FDED, $91, 0, 0, 0)// CTRL-Q = turn off 80 column
+call($FDED, $8D, 0, 0, 0)
+^$C000 = 0 // Turn off 80STORE
+//
+// Get heap start.
+//
+macros = *freemem
+heap = macros + t_macro * NMACROS
+memset(macros, 0, t_macro * NMACROS)
+if not loadPatch
+ showHelp
+fin
+recalcEnv
+envelope(current.durAtk, current.durDcy, current.durSus, current.durRel, current:rateAtk, current:rateDcy, current:rateRel)
+grmode
+showMainPanel
+main // Main program
+if modPatch
+ if query("SAVE PATCH (Y/N)?")
+ savePatch
+ fin
+fin
+normal
+textmode
+done
diff --git a/src/samplesrc/a2pwm/lfo.po b/src/samplesrc/a2pwm/lfo.po
new file mode 100755
index 0000000..1ef9ec7
Binary files /dev/null and b/src/samplesrc/a2pwm/lfo.po differ
diff --git a/src/samplesrc/a2pwm/lfotbl.s b/src/samplesrc/a2pwm/lfotbl.s
new file mode 100755
index 0000000..c0ab320
--- /dev/null
+++ b/src/samplesrc/a2pwm/lfotbl.s
@@ -0,0 +1,32 @@
+LFODWN !BYTE $F0 , $F0 , $E0 , $E0 , $D0 , $D0 , $C0 , $C0
+ !BYTE $B0 , $B0 , $A0 , $A0 , $90 , $90 , $80 , $80
+ !BYTE $70 , $70 , $60 , $60 , $50 , $50 , $40 , $40
+ !BYTE $30 , $30 , $20 , $20 , $10 , $10 , $00 , $00
+LFOUP !BYTE $00 , $00 , $10 , $10 , $20 , $20 , $30 , $30
+ !BYTE $40 , $40 , $50 , $50 , $60 , $60 , $70 , $70
+ !BYTE $80 , $80 , $90 , $90 , $A0 , $A0 , $B0 , $B0
+ !BYTE $C0 , $C0 , $D0 , $D0 , $E0 , $E0 , $F0 , $F0
+LFOREXP !BYTE $F0 , $D0 , $C0 , $B0 , $A0 , $90 , $90 , $80
+ !BYTE $70 , $60 , $60 , $50 , $50 , $40 , $40 , $40
+ !BYTE $30 , $30 , $30 , $20 , $20 , $20 , $20 , $10
+ !BYTE $10 , $10 , $10 , $10 , $10 , $00 , $00 , $00
+LFOEXP !BYTE $00 , $00 , $00 , $10 , $10 , $10 , $10 , $10
+ !BYTE $10 , $20 , $20 , $20 , $20 , $30 , $30 , $30
+ !BYTE $40 , $40 , $40 , $50 , $50 , $60 , $60 , $70
+ !BYTE $80 , $90 , $90 , $A0 , $B0 , $C0 , $D0 , $F0
+LFSAW !BYTE $00 , $10 , $20 , $30 , $40 , $50 , $60 , $70
+ !BYTE $80 , $90 , $A0 , $B0 , $C0 , $D0 , $E0 , $F0
+ !BYTE $F0 , $E0 , $D0 , $C0 , $B0 , $A0 , $90 , $80
+ !BYTE $70 , $60 , $50 , $40 , $30 , $20 , $10 , $00
+LFOCOS !BYTE $00 , $10 , $10 , $20 , $30 , $40 , $50 , $60
+ !BYTE $80 , $90 , $B0 , $C0 , $D0 , $E0 , $F0 , $F0
+ !BYTE $F0 , $F0 , $F0 , $E0 , $D0 , $C0 , $B0 , $90
+ !BYTE $80 , $60 , $50 , $40 , $30 , $20 , $10 , $10
+LFOSIN !BYTE $00 , $20 , $30 , $50 , $60 , $80 , $90 , $A0
+ !BYTE $B0 , $C0 , $D0 , $E0 , $E0 , $F0 , $F0 , $F0
+ !BYTE $F0 , $F0 , $F0 , $F0 , $E0 , $E0 , $D0 , $C0
+ !BYTE $B0 , $A0 , $90 , $80 , $60 , $50 , $30 , $20
+LFOOCOS !BYTE $F0 , $F0 , $F0 , $E0 , $E0 , $E0 , $D0 , $C0
+ !BYTE $C0 , $B0 , $A0 , $90 , $90 , $90 , $80 , $80
+ !BYTE $80 , $80 , $80 , $90 , $90 , $90 , $A0 , $B0
+ !BYTE $C0 , $C0 , $D0 , $E0 , $E0 , $E0 , $F0 , $F0
diff --git a/src/samplesrc/a2pwm/makefile b/src/samplesrc/a2pwm/makefile
new file mode 100755
index 0000000..d5080af
--- /dev/null
+++ b/src/samplesrc/a2pwm/makefile
@@ -0,0 +1,28 @@
+.SUFFIXES =
+AFLAGS = -o $@
+HILOPWM = hilopwm.bin
+PLASM = ../../plasm
+#
+# Image filetypes for Virtual ][
+#
+PLATYPE = .\$$ED
+BINTYPE = .BIN
+SYSTYPE = .SYS
+TXTTYPE = .TXT
+#
+# Image filetypes for CiderPress
+#
+#RELTYPE = \#FE1000
+#INTERPTYPE = \#050000
+#BINTYPE = \#060000
+#SYSTYPE = \#FF2000
+#TXTTYPE = \#040000
+
+all: $(HILOPWM)
+
+clean:
+ -rm *.o *~ *.a *.bin
+
+$(HILOPWM): a2pwm.s util.pla hilopwm.pla pwmvm.s $(PLASM)
+ $(PLASM) -A < hilopwm.pla > hilopwm.a
+ acme -o $(HILOPWM) pwmvm.s
diff --git a/src/samplesrc/a2pwm/pwmvm.s b/src/samplesrc/a2pwm/pwmvm.s
new file mode 100755
index 0000000..b23e653
--- /dev/null
+++ b/src/samplesrc/a2pwm/pwmvm.s
@@ -0,0 +1,987 @@
+;**********************************************************
+;*
+;* STAND-ALONE PLASMA INTERPETER
+;*
+;* SYSTEM ROUTINES AND LOCATIONS
+;*
+;**********************************************************
+;*
+;* VM ZERO PAGE LOCATIONS
+;*
+SRC = $02
+SRCL = SRC
+SRCH = SRC+1
+DST = SRC+2
+DSTL = DST
+DSTH = DST+1
+ESTKSZ = $20
+ESTK = $C0
+ESTKL = ESTK
+ESTKH = ESTK+ESTKSZ/2
+VMZP = ESTK+ESTKSZ
+ESP = VMZP
+DVSIGN = VMZP
+IFP = ESP+1
+IFPL = IFP
+IFPH = IFP+1
+PP = IFP+2
+PPL = PP
+PPH = PP+1
+IPY = PP+2
+TMP = IPY+1
+TMPL = TMP
+TMPH = TMP+1
+NPARMS = TMPL
+FRMSZ = TMPH
+DROP = $EF
+NEXTOP = $F0
+FETCHOP = NEXTOP+3
+IP = FETCHOP+1
+IPL = IP
+IPH = IPL+1
+OPIDX = FETCHOP+6
+OPPAGE = OPIDX+1
+;*
+;* BASIC.SYSTEM ZERO PAGE LOCATIONS
+;*
+HIMEM = $73
+;*
+;* INTERPRETER INSTRUCTION POINTER INCREMENT MACRO
+;*
+ !MACRO INC_IP {
+ INY
+ BNE *+4
+ INC IPH
+ }
+;*
+;* INTERPRETER HEADER+INITIALIZATION
+;*
+ *= $2000
+ LDX #$FE
+ TXS
+ JSR VMINIT
+ JSR $BF00
+ !BYTE $65
+ !WORD EXITTBL
+EXITTBL:
+ !BYTE 4
+ !BYTE 0
+;*
+;* SYSTEM INTERPRETER ENTRYPOINT
+;*
+INTERP PLA
+ CLC
+ ADC #$01
+ STA IPL
+ PLA
+ ADC #$00
+ STA IPH
+ LDY #$00
+ JMP FETCHOP
+;*
+;* ENTER INTO USER BYTECODE INTERPRETER
+;*
+IINTERP PLA
+ STA TMPL
+ PLA
+ STA TMPH
+ LDY #$02
+ LDA (TMP),Y
+ STA IPH
+ DEY
+ LDA (TMP),Y
+ STA IPL
+ DEY
+ JMP FETCHOP
+;*
+;* MUL TOS-1 BY TOS
+;*
+MUL STY IPY
+ LDY #$10
+ LDA ESTKL+1,X
+ EOR #$FF
+ STA TMPL
+ LDA ESTKH+1,X
+ EOR #$FF
+ STA TMPH
+ LDA #$00
+ STA ESTKL+1,X ; PRODL
+; STA ESTKH+1,X ; PRODH
+MULLP LSR TMPH ; MULTPLRH
+ ROR TMPL ; MULTPLRL
+ BCS +
+ STA ESTKH+1,X ; PRODH
+ LDA ESTKL,X ; MULTPLNDL
+ ADC ESTKL+1,X ; PRODL
+ STA ESTKL+1,X
+ LDA ESTKH,X ; MULTPLNDH
+ ADC ESTKH+1,X ; PRODH
++ ASL ESTKL,X ; MULTPLNDL
+ ROL ESTKH,X ; MULTPLNDH
+ DEY
+ BNE MULLP
+ STA ESTKH+1,X ; PRODH
+ LDY IPY
+; INX
+; JMP NEXTOP
+ JMP DROP
+;*
+;* INCREMENT TOS
+;*
+INCR INC ESTKL,X
+ BNE INCR1
+ INC ESTKH,X
+INCR1 JMP NEXTOP
+;*
+;* DECREMENT TOS
+;*
+DECR LDA ESTKL,X
+ BNE DECR1
+ DEC ESTKH,X
+DECR1 DEC ESTKL,X
+ JMP NEXTOP
+;*
+;* BITWISE COMPLIMENT TOS
+;*
+COMP LDA #$FF
+ EOR ESTKL,X
+ STA ESTKL,X
+ LDA #$FF
+ EOR ESTKH,X
+ STA ESTKH,X
+ JMP NEXTOP
+;*
+;* DIV TOS-1 BY TOS
+;*
+DIV JSR _DIV
+ LSR DVSIGN ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1
+ BCS NEG
+ JMP NEXTOP
+;*
+;* MOD TOS-1 BY TOS
+;*
+MOD JSR _DIV
+ LDA TMPL ; REMNDRL
+ STA ESTKL,X
+ LDA TMPH ; REMNDRH
+ STA ESTKH,X
+ LDA DVSIGN ; REMAINDER IS SIGN OF DIVIDEND
+ BMI NEG
+ JMP NEXTOP
+;*
+;* NEGATE TOS
+;*
+NEG LDA #$00
+ SEC
+ SBC ESTKL,X
+ STA ESTKL,X
+ LDA #$00
+ SBC ESTKH,X
+ STA ESTKH,X
+ JMP NEXTOP
+;*
+;* INTERNAL DIVIDE ALGORITHM
+;*
+_NEG LDA #$00
+ SEC
+ SBC ESTKL,X
+ STA ESTKL,X
+ LDA #$00
+ SBC ESTKH,X
+ STA ESTKH,X
+ RTS
+_DIV STY IPY
+ LDY #$11 ; #BITS+1
+ LDA #$00
+ STA TMPL ; REMNDRL
+ STA TMPH ; REMNDRH
+ LDA ESTKH,X
+ AND #$80
+ STA DVSIGN
+ BPL +
+ JSR _NEG
+ INC DVSIGN
++ LDA ESTKH+1,X
+ BPL +
+ INX
+ JSR _NEG
+ DEX
+ INC DVSIGN
+ BNE _DIV1
++ ORA ESTKL+1,X ; DVDNDL
+ BEQ _DIVEX
+_DIV1 ASL ESTKL+1,X ; DVDNDL
+ ROL ESTKH+1,X ; DVDNDH
+ DEY
+ BCC _DIV1
+_DIVLP ROL TMPL ; REMNDRL
+ ROL TMPH ; REMNDRH
+ LDA TMPL ; REMNDRL
+ CMP ESTKL,X ; DVSRL
+ LDA TMPH ; REMNDRH
+ SBC ESTKH,X ; DVSRH
+ BCC +
+ STA TMPH ; REMNDRH
+ LDA TMPL ; REMNDRL
+ SBC ESTKL,X ; DVSRL
+ STA TMPL ; REMNDRL
+ SEC
++ ROL ESTKL+1,X ; DVDNDL
+ ROL ESTKH+1,X ; DVDNDH
+ DEY
+ BNE _DIVLP
+_DIVEX INX
+ LDY IPY
+ RTS
+;*
+;* ADD TOS TO TOS-1
+;*
+ADD LDA ESTKL,X
+ CLC
+ ADC ESTKL+1,X
+ STA ESTKL+1,X
+ LDA ESTKH,X
+ ADC ESTKH+1,X
+ STA ESTKH+1,X
+; INX
+; JMP NEXTOP
+ JMP DROP
+;*
+;* SUB TOS FROM TOS-1
+;*
+SUB LDA ESTKL+1,X
+ SEC
+ SBC ESTKL,X
+ STA ESTKL+1,X
+ LDA ESTKH+1,X
+ SBC ESTKH,X
+ STA ESTKH+1,X
+; INX
+; JMP NEXTOP
+ JMP DROP
+;
+;*
+;* SHIFT TOS LEFT BY 1, ADD TO TOS-1
+;*
+IDXW LDA ESTKL,X
+ ASL
+ ROL ESTKH,X
+ CLC
+ ADC ESTKL+1,X
+ STA ESTKL+1,X
+ LDA ESTKH,X
+ ADC ESTKH+1,X
+ STA ESTKH+1,X
+; INX
+; JMP NEXTOP
+ JMP DROP
+;*
+;* BITWISE AND TOS TO TOS-1
+;*
+BAND LDA ESTKL+1,X
+ AND ESTKL,X
+ STA ESTKL+1,X
+ LDA ESTKH+1,X
+ AND ESTKH,X
+ STA ESTKH+1,X
+; INX
+; JMP NEXTOP
+ JMP DROP
+;*
+;* INCLUSIVE OR TOS TO TOS-1
+;*
+IOR LDA ESTKL+1,X
+ ORA ESTKL,X
+ STA ESTKL+1,X
+ LDA ESTKH+1,X
+ ORA ESTKH,X
+ STA ESTKH+1,X
+; INX
+; JMP NEXTOP
+ JMP DROP
+;*
+;* EXLUSIVE OR TOS TO TOS-1
+;*
+XOR LDA ESTKL+1,X
+ EOR ESTKL,X
+ STA ESTKL+1,X
+ LDA ESTKH+1,X
+ EOR ESTKH,X
+ STA ESTKH+1,X
+; INX
+; JMP NEXTOP
+ JMP DROP
+;*
+;* SHIFT TOS-1 LEFT BY TOS
+;*
+SHL STY IPY
+ LDA ESTKL,X
+ CMP #$08
+ BCC SHL1
+ LDY ESTKL+1,X
+ STY ESTKH+1,X
+ LDY #$00
+ STY ESTKL+1,X
+ SBC #$08
+SHL1 TAY
+ BEQ SHL3
+SHL2 ASL ESTKL+1,X
+ ROL ESTKH+1,X
+ DEY
+ BNE SHL2
+SHL3 LDY IPY
+; INX
+; JMP NEXTOP
+ JMP DROP
+;*
+;* SHIFT TOS-1 RIGHT BY TOS
+;*
+SHR STY IPY
+ LDA ESTKL,X
+ CMP #$08
+ BCC SHR2
+ LDY ESTKH+1,X
+ STY ESTKL+1,X
+ CPY #$80
+ LDY #$00
+ BCC SHR1
+ DEY
+SHR1 STY ESTKH+1,X
+ SEC
+ SBC #$08
+SHR2 TAY
+ BEQ SHR4
+ LDA ESTKH+1,X
+SHR3 CMP #$80
+ ROR
+ ROR ESTKL+1,X
+ DEY
+ BNE SHR3
+ STA ESTKH+1,X
+SHR4 LDY IPY
+; INX
+; JMP NEXTOP
+ JMP DROP
+;*
+;* LOGICAL NOT
+;*
+LNOT LDA ESTKL,X
+ ORA ESTKH,X
+ BEQ LNOT1
+ LDA #$FF
+LNOT1 EOR #$FF
+ STA ESTKL,X
+ STA ESTKH,X
+ JMP NEXTOP
+;*
+;* LOGICAL AND
+;*
+LAND LDA ESTKL+1,X
+ ORA ESTKH+1,X
+ BEQ LAND2
+ LDA ESTKL,X
+ ORA ESTKH,X
+ BEQ LAND1
+ LDA #$FF
+LAND1 STA ESTKL+1,X
+ STA ESTKH+1,X
+;LAND2 INX
+; JMP NEXTOP
+LAND2 JMP DROP
+;*
+;* LOGICAL OR
+;*
+LOR LDA ESTKL,X
+ ORA ESTKH,X
+ ORA ESTKL+1,X
+ ORA ESTKH+1,X
+ BEQ LOR1
+ LDA #$FF
+ STA ESTKL+1,X
+ STA ESTKH+1,X
+;LOR1 INX
+; JMP NEXTOP
+LOR1 JMP DROP
+;*
+;* DUPLICATE TOS
+;*
+DUP DEX
+ LDA ESTKL+1,X
+ STA ESTKL,X
+ LDA ESTKH+1,X
+ STA ESTKH,X
+ JMP NEXTOP
+;*
+;* PUSH FROM EVAL STACK TO CALL STACK
+;*
+PUSH LDA ESTKL,X
+ PHA
+ LDA ESTKH,X
+ PHA
+; INX
+; JMP NEXTOP
+ JMP DROP
+;*
+;* PULL FROM CALL STACK TO EVAL STACK
+;*
+PULL DEX
+ PLA
+ STA ESTKH,X
+ PLA
+ STA ESTKL,X
+ JMP NEXTOP
+;*
+;* CONSTANT
+;*
+ZERO DEX
+ LDA #$00
+ STA ESTKL,X
+ STA ESTKH,X
+ JMP NEXTOP
+CB DEX
+ +INC_IP
+ LDA (IP),Y
+ STA ESTKL,X
+ LDA #$00
+ STA ESTKH,X
+ JMP NEXTOP
+;*
+;* LOAD ADDRESS & LOAD CONSTANT WORD (SAME THING, WITH OR WITHOUT FIXUP)
+;*
+LA = *
+CW DEX
+ +INC_IP
+ LDA (IP),Y
+ STA ESTKL,X
+ +INC_IP
+ LDA (IP),Y
+ STA ESTKH,X
+ JMP NEXTOP
+;*
+;* CONSTANT STRING
+;*
+CS DEX
+ +INC_IP
+ TYA ; NORMALIZE IP AND SAVE STRING ADDR ON ESTK
+ CLC
+ ADC IPL
+ STA IPL
+ STA ESTKL,X
+ LDA #$00
+ TAY
+ ADC IPH
+ STA IPH
+ STA ESTKH,X
+ LDA (IP),Y
+ TAY
+ JMP NEXTOP
+;*
+;* LOAD VALUE FROM ADDRESS TAG
+;*
+LB LDA ESTKL,X
+ STA TMPL
+ LDA ESTKH,X
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA (TMP),Y
+ STA ESTKL,X
+ STY ESTKH,X
+ LDY IPY
+ JMP NEXTOP
+LW LDA ESTKL,X
+ STA TMPL
+ LDA ESTKH,X
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA (TMP),Y
+ STA ESTKL,X
+ INY
+ LDA (TMP),Y
+ STA ESTKH,X
+ LDY IPY
+ JMP NEXTOP
+;*
+;* LOAD ADDRESS OF LOCAL FRAME OFFSET
+;*
+LLA +INC_IP
+ LDA (IP),Y
+ DEX
+ CLC
+ ADC IFPL
+ STA ESTKL,X
+ LDA #$00
+ ADC IFPH
+ STA ESTKH,X
+ JMP NEXTOP
+;*
+;* LOAD VALUE FROM LOCAL FRAME OFFSET
+;*
+LLB +INC_IP
+ LDA (IP),Y
+ STY IPY
+ TAY
+ DEX
+ LDA (IFP),Y
+ STA ESTKL,X
+ LDA #$00
+ STA ESTKH,X
+ LDY IPY
+ JMP NEXTOP
+LLW +INC_IP
+ LDA (IP),Y
+ STY IPY
+ TAY
+ DEX
+ LDA (IFP),Y
+ STA ESTKL,X
+ INY
+ LDA (IFP),Y
+ STA ESTKH,X
+ LDY IPY
+ JMP NEXTOP
+;*
+;* LOAD VALUE FROM ABSOLUTE ADDRESS
+;*
+LAB +INC_IP
+ LDA (IP),Y
+ STA TMPL
+ +INC_IP
+ LDA (IP),Y
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA (TMP),Y
+ DEX
+ STA ESTKL,X
+ STY ESTKH,X
+ LDY IPY
+ JMP NEXTOP
+LAW +INC_IP
+ LDA (IP),Y
+ STA TMPL
+ +INC_IP
+ LDA (IP),Y
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA (TMP),Y
+ DEX
+ STA ESTKL,X
+ INY
+ LDA (TMP),Y
+ STA ESTKH,X
+ LDY IPY
+ JMP NEXTOP
+;*
+;* STORE VALUE TO ADDRESS
+;*
+SB LDA ESTKL+1,X
+ STA TMPL
+ LDA ESTKH+1,X
+ STA TMPH
+ LDA ESTKL,X
+ STY IPY
+ LDY #$00
+ STA (TMP),Y
+ LDY IPY
+ INX
+; INX
+; JMP NEXTOP
+ JMP DROP
+SW LDA ESTKL+1,X
+ STA TMPL
+ LDA ESTKH+1,X
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA ESTKL,X
+ STA (TMP),Y
+ INY
+ LDA ESTKH,X
+ STA (TMP),Y
+ LDY IPY
+ INX
+; INX
+; JMP NEXTOP
+ JMP DROP
+;*
+;* STORE VALUE TO LOCAL FRAME OFFSET
+;*
+SLB +INC_IP
+ LDA (IP),Y
+ STY IPY
+ TAY
+ LDA ESTKL,X
+ STA (IFP),Y
+ LDY IPY
+; INX
+; JMP NEXTOP
+ JMP DROP
+SLW +INC_IP
+ LDA (IP),Y
+ STY IPY
+ TAY
+ LDA ESTKL,X
+ STA (IFP),Y
+ INY
+ LDA ESTKH,X
+ STA (IFP),Y
+ LDY IPY
+; INX
+; JMP NEXTOP
+ JMP DROP
+;*
+;* STORE VALUE TO LOCAL FRAME OFFSET WITHOUT POPPING STACK
+;*
+DLB +INC_IP
+ LDA (IP),Y
+ STY IPY
+ TAY
+ LDA ESTKL,X
+ STA (IFP),Y
+ LDY IPY
+ JMP NEXTOP
+DLW +INC_IP
+ LDA (IP),Y
+ STY IPY
+ TAY
+ LDA ESTKL,X
+ STA (IFP),Y
+ INY
+ LDA ESTKH,X
+ STA (IFP),Y
+ LDY IPY
+ JMP NEXTOP
+;*
+;* STORE VALUE TO ABSOLUTE ADDRESS
+;*
+SAB +INC_IP
+ LDA (IP),Y
+ STA TMPL
+ +INC_IP
+ LDA (IP),Y
+ STA TMPH
+ LDA ESTKL,X
+ STY IPY
+ LDY #$00
+ STA (TMP),Y
+ LDY IPY
+; INX
+; JMP NEXTOP
+ JMP DROP
+SAW +INC_IP
+ LDA (IP),Y
+ STA TMPL
+ +INC_IP
+ LDA (IP),Y
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA ESTKL,X
+ STA (TMP),Y
+ INY
+ LDA ESTKH,X
+ STA (TMP),Y
+ LDY IPY
+; INX
+; JMP NEXTOP
+ JMP DROP
+;*
+;* STORE VALUE TO ABSOLUTE ADDRESS WITHOUT POPPING STACK
+;*
+DAB +INC_IP
+ LDA (IP),Y
+ STA TMPL
+ +INC_IP
+ LDA (IP),Y
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA ESTKL,X
+ STA (TMP),Y
+ LDY IPY
+ JMP NEXTOP
+DAW +INC_IP
+ LDA (IP),Y
+ STA TMPL
+ +INC_IP
+ LDA (IP),Y
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA ESTKL,X
+ STA (TMP),Y
+ INY
+ LDA ESTKH,X
+ STA (TMP),Y
+ LDY IPY
+ JMP NEXTOP
+;*
+;* COMPARES
+;*
+ISEQ LDA ESTKL,X
+ CMP ESTKL+1,X
+ BNE ISFLS
+ LDA ESTKH,X
+ CMP ESTKH+1,X
+ BNE ISFLS
+ISTRU LDA #$FF
+ STA ESTKL+1,X
+ STA ESTKH+1,X
+; INX
+; JMP NEXTOP
+ JMP DROP
+;
+ISNE LDA ESTKL,X
+ CMP ESTKL+1,X
+ BNE ISTRU
+ LDA ESTKH,X
+ CMP ESTKH+1,X
+ BNE ISTRU
+ISFLS LDA #$00
+ STA ESTKL+1,X
+ STA ESTKH+1,X
+; INX
+; JMP NEXTOP
+ JMP DROP
+;
+ISGE LDA ESTKL+1,X
+ CMP ESTKL,X
+ LDA ESTKH+1,X
+ SBC ESTKH,X
+ BVC ISGE1
+ EOR #$80
+ISGE1 BPL ISTRU
+ BMI ISFLS
+;
+ISGT LDA ESTKL,X
+ CMP ESTKL+1,X
+ LDA ESTKH,X
+ SBC ESTKH+1,X
+ BVC ISGT1
+ EOR #$80
+ISGT1 BMI ISTRU
+ BPL ISFLS
+;
+ISLE LDA ESTKL,X
+ CMP ESTKL+1,X
+ LDA ESTKH,X
+ SBC ESTKH+1,X
+ BVC ISLE1
+ EOR #$80
+ISLE1 BPL ISTRU
+ BMI ISFLS
+;
+ISLT LDA ESTKL+1,X
+ CMP ESTKL,X
+ LDA ESTKH+1,X
+ SBC ESTKH,X
+ BVC ISLT1
+ EOR #$80
+ISLT1 BMI ISTRU
+ BPL ISFLS
+;*
+;* BRANCHES
+;*
+BRTRU INX
+ LDA ESTKH-1,X
+ ORA ESTKL-1,X
+ BNE BRNCH
+NOBRNCH +INC_IP
+ +INC_IP
+ JMP NEXTOP
+BRFLS INX
+ LDA ESTKH-1,X
+ ORA ESTKL-1,X
+ BNE NOBRNCH
+BRNCH LDA IPH
+ STA TMPH
+ LDA IPL
+ +INC_IP
+ CLC
+ ADC (IP),Y
+ STA TMPL
+ LDA TMPH
+ +INC_IP
+ ADC (IP),Y
+ STA IPH
+ LDA TMPL
+ STA IPL
+ DEY
+ DEY
+ JMP NEXTOP
+BREQ INX
+ LDA ESTKL-1,X
+ CMP ESTKL,X
+ BNE NOBRNCH
+ LDA ESTKH-1,X
+ CMP ESTKH,X
+ BEQ BRNCH
+ BNE NOBRNCH
+BRNE INX
+ LDA ESTKL-1,X
+ CMP ESTKL,X
+ BNE BRNCH
+ LDA ESTKH-1,X
+ CMP ESTKH,X
+ BEQ NOBRNCH
+ BNE BRNCH
+BRGT INX
+ LDA ESTKL-1,X
+ CMP ESTKL,X
+ LDA ESTKH-1,X
+ SBC ESTKH,X
+ BMI BRNCH
+ BPL NOBRNCH
+BRLT INX
+ LDA ESTKL,X
+ CMP ESTKL-1,X
+ LDA ESTKH,X
+ SBC ESTKH-1,X
+ BMI BRNCH
+ BPL NOBRNCH
+IBRNCH LDA IPL
+ CLC
+ ADC ESTKL,X
+ STA IPL
+ LDA IPH
+ ADC ESTKH,X
+ STA IPH
+; INX
+; JMP NEXTOP
+ JMP DROP
+;*
+;* CALL INTO ABSOLUTE ADDRESS (NATIVE CODE)
+;*
+CALL +INC_IP
+ LDA (IP),Y
+ STA CALLADR+1
+ +INC_IP
+ LDA (IP),Y
+ STA CALLADR+2
+ LDA IPH
+ PHA
+ LDA IPL
+ PHA
+ TYA
+ PHA
+CALLADR JSR $FFFF
+ PLA
+ TAY
+ PLA
+ STA IPL
+ PLA
+ STA IPH
+ JMP NEXTOP
+;*
+;* INDIRECT CALL TO ADDRESS (NATIVE CODE)
+;*
+ICAL LDA ESTKL,X
+ STA ICALADR+1
+ LDA ESTKH,X
+ STA ICALADR+2
+ INX
+ LDA IPH
+ PHA
+ LDA IPL
+ PHA
+ TYA
+ PHA
+ICALADR JSR $FFFF
+ PLA
+ TAY
+ PLA
+ STA IPL
+ PLA
+ STA IPH
+ JMP NEXTOP
+;*
+;* ENTER FUNCTION WITH FRAME SIZE AND PARAM COUNT
+;*
+ENTER INY
+ LDA (IP),Y
+ PHA ; SAVE ON STACK FOR LEAVE
+ EOR #$FF
+ SEC
+ ADC IFPL
+ STA IFPL
+ BCS +
+ DEC IFPH
++ INY
+ LDA (IP),Y
+ ASL
+ TAY
+ BEQ +
+- LDA ESTKH,X
+ DEY
+ STA (IFP),Y
+ LDA ESTKL,X
+ INX
+ DEY
+ STA (IFP),Y
+ BNE -
++ LDY #$02
+ JMP NEXTOP
+;*
+;* LEAVE FUNCTION
+;*
+LEAVE PLA
+ CLC
+ ADC IFPL
+ STA IFPL
+ BCS LIFPH
+ RTS
+LIFPH INC IFPH
+RET RTS
+;*
+;* OPCODE TABLE
+;*
+ !ALIGN 255,0
+OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E
+ !WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E
+ !WORD LNOT,LOR,LAND,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E
+ !WORD DROP,DUP,PUSH,PULL,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E
+ !WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E
+ !WORD BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,NEXTOP ; 50 52 54 56 58 5A 5C 5E
+ !WORD LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E
+ !WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E
+;*
+;*SAVED ZERO PAGE
+;*
+ZPSAVE !FILL 256
+;*
+;* SOURCE PWM ASM/PLASMA PROGRAM
+;*
+ !SOURCE "a2pwm.s"
+START !SOURCE "hilopwm.a"
+SEGEND = *
+VMINIT LDY #$10 ; INSTALL PAGE 0 FETCHOP ROUTINE
+- LDA PAGE0-1,Y
+ STA DROP-1,Y
+ DEY
+ BNE -
+ STY IFPL ; INIT FRAME POINTER
+ LDA #$BF
+ STA IFPH
+ LDA #SEGEND
+ STA SRCH
+ LDA #$4C
+ JMP START
+PAGE0 = *
+ !PSEUDOPC $00EF {
+;*
+;* INTERP BYTECODE INNER LOOP
+;*
+ INX ; DROP
+ INY ; NEXTOP
+ BEQ NEXTOPH
+ LDA $FFFF,Y ; FETCHOP @ $F3, IP MAPS OVER $FFFF @ $F4
+ STA OPIDX
+ JMP (OPTBL)
+NEXTOPH INC IPH
+ BNE FETCHOP
+}
diff --git a/src/samplesrc/a2pwm/readme.md b/src/samplesrc/a2pwm/readme.md
new file mode 100644
index 0000000..412576f
--- /dev/null
+++ b/src/samplesrc/a2pwm/readme.md
@@ -0,0 +1,51 @@
+# Oscillation Overthruster
+## Intro
+Oscillation Overthruster (HiLoPWM) is a synthesizer/sequencer for playing around with the Apple II and its limited sound capability. A High Frequency Oscillator (HFO) samples the waveform of a Low Frequency Oscillator (LFO) and applies an Attack/Decay/Sustain/Release envelope to the resulting value which is output as a Pulse Width Modulated (PWM) value. This can create some interesting effects and tones.
+## Running
+The HILOPWM.SYSTEM file can be launched by booting the lfo.po disk image. The first time, the help screen will be presented with a list of the available commands. Once a PATCH file has been saved, the help screen will only show up by pressing the ESCape key. The main screen displays a graphical representation of the LFO waveform, LFO period and tone duration. The lower panel displays the textual representation of the LFO period, duration, and octave. The Apple II keyboard keys that map a piano keyboard octave is shown in the middle. Macros can be recorded and played back along with playing tones and changing parameters. The macros and parameters can be made persistent by saving them to disk. The next time HILOPWM.SYSTEM is run, the help screen will be skipped and the macros and settings from the previous session will be present. When quitting (CTRL-Q), you will be prompted if want to quit in case it was an accidental keypress, then optionally prompted to save the current state if it has changed since the last save.
+## Playing Tones
+The Apple II keyboard is mapped to a one octave piano keyboard, from Bn-1 to Cn+1.
+
+ KEY NOTE ('n' is current octave)
+ --- ----
+ A Bn-1
+ S Cn
+ E C#n
+ D Dn
+ R D#n
+ F En
+ G Fn
+ Y F#n
+ H Gn
+ U G#n
+ J An
+ I A#n
+ K Bn
+ L Cn+1
+
+The duration of the note is in increments of 0.0255 seconds (the PWM loop is 100 cycles and runs 255 times at ~1.022 MHz). The maximum note length is slight longer than 1 second.
+
+## Command keys
+ KEY COMMAND
+ -------------- --------------------
+ ESC HELP/CANCEL RECORD
+ CTRL-Q QUIT
+ 1..8 LFO WAVEFORM
+ < , INCREASE LFO
+ > . DECREASE LFO
+ LEFT-ARROW PREV OCTAVE
+ RIGHT-ARROW NEXT OCTAVE
+ + UP-ARROW INCREASE DURATION
+ - DOWN-ARROW DECREASE DURATION
+ CTRL-Z..M RECORD MACRO
+ / SAVE ABS MACRO
+ ? SAVE REL MACRO
+ P PERSISTANT STATE
+ 0 TOGGLE SPEAKER PHASE
+
+Command keys and note keys can be interspersed together.
+### Recording Macros
+One of the most powerful features of the Oscillation Overthruster is macro recording. There are seven macros that can be assigned to the lower row of keys, Z ... M. To record one of the macros, type the key along with the CONTROL key to begin recording. The RECORDING text will show up to the right of the text panel during recording. When recording, other macros can be called, allowing nested calls. However, recursive macros cannot be made, i.e. macro Z calling macro X calling macro Z. If, during recording, you want to cancel the macro, press ESCape. Their are two ways to save the macro: absolute and relative. An absolute macro will retain the state settings at the time the macro is recorded. Octave, duration, and LFO settings are restored before the macro is played, then restored when it is done. A relative macro will use the current settings when playing back. To record a rest, the spacebar will insert a pause for the length of the current duration. You can make the current macros persistent by pressing 'P' to write the macros and current settings to disk for the next time.
+
+## A note about speaker phase
+I discovered that the Apple ][ and Apple //e are affected by the initial phase of the speaker when implementing volume control with PWM. Interestingly, the Apple //c and emulators aren't impacted by the speaker phase. The hack was to add a command to flip the speaker phase (the '0' key). If you notice diminished volume when you run Oscillation Overthruster, press '0' to see if it doesn't clear up the problem. I hope to find a solid solution to this someday, but this is the fix for now.
diff --git a/src/samplesrc/a2pwm/util.pla b/src/samplesrc/a2pwm/util.pla
new file mode 100644
index 0000000..89a31c1
--- /dev/null
+++ b/src/samplesrc/a2pwm/util.pla
@@ -0,0 +1,496 @@
+//
+// Colors
+//
+const BLACK = 0
+const MAGENTA = 1
+const DRKBLU = 2
+const PURPLE = 3
+const DRKGRN = 4
+const GREY = 5
+const MEDBLU = 6
+const LGTBLU = 7
+const BROWN = 8
+const ORANGE = 9
+const GRAY = 10
+const PINK = 11
+const LGTGRN = 12
+const YELLOW = 13
+const AQUA = 14
+const WHITE = 15
+
+word txt1scrn[] = $0400,$0480,$0500,$0580,$0600,$0680,$0700,$0780
+word = $0428,$04A8,$0528,$05A8,$0628,$06A8,$0728,$07A8
+word = $0450,$04D0,$0550,$05D0,$0650,$06D0,$0750,$07D0
+//
+// ProDOS error
+//
+byte perr
+//
+// CALL 6502 ROUTINE
+// CALL(ADDR, AREG, XREG, YREG, STATUS)
+//
+asm call
+ PHP
+ LDA ESTKL+4,X
+ STA CALL6502+1
+ LDA ESTKH+4,X
+ STA CALL6502+2
+ LDA ESTKL,X
+ PHA
+ LDA ESTKL+1,X
+ TAY
+ LDA ESTKL+3,X
+ PHA
+ LDA ESTKL+2,X
+ INX
+ INX
+ INX
+ INX
+ STX ESP
+ TAX
+ PLA
+ PLP
+CALL6502 JSR $FFFF
+ PHP
+ STA REGVALS+0
+ STX REGVALS+1
+ STY REGVALS+2
+ PLA
+ STA REGVALS+3
+ LDX ESP
+ LDA #REGVALS
+ STA ESTKL,X
+ STY ESTKH,X
+ PLP
+ RTS
+REGVALS !FILL 4
+end
+//
+// CALL PRODOS
+// SYSCALL(CMD, PARAMS)
+//
+asm syscall
+ LDA ESTKL,X
+ LDY ESTKH,X
+ STA PARAMS
+ STY PARAMS+1
+ INX
+ LDA ESTKL,X
+ STA CMD
+ JSR $BF00
+CMD: !BYTE 00
+PARAMS: !WORD 0000
+ LDY #$00
+ STA ESTKL,X
+ STY ESTKH,X
+ RTS
+end
+//
+// SET MEMORY TO VALUE
+// MEMSET(ADDR, VALUE, SIZE)
+// With optimizations from Peter Ferrie
+//
+asm memset
+ LDA ESTKL+2,X
+ STA DSTL
+ LDA ESTKH+2,X
+ STA DSTH
+ LDY ESTKL,X
+ BEQ +
+ INC ESTKH,X
+ LDY #$00
++ LDA ESTKH,X
+ BEQ SETMEX
+SETMLPL CLC
+ LDA ESTKL+1,X
+SETMLPH STA (DST),Y
+ DEC ESTKL,X
+ BEQ ++
+- INY
+ BEQ +
+-- BCS SETMLPL
+ SEC
+ LDA ESTKH+1,X
+ BCS SETMLPH
++ INC DSTH
+ BNE --
+++ DEC ESTKH,X
+ BNE -
+SETMEX INX
+ INX
+ RTS
+end
+//
+// COPY MEMORY
+// MEMCPY(DSTADDR, SRCADDR, SIZE)
+//
+asm memcpy
+ INX
+ INX
+ LDA ESTKL-2,X
+ ORA ESTKH-2,X
+ BEQ CPYMEX
+ LDA ESTKL-1,X
+ CMP ESTKL,X
+ LDA ESTKH-1,X
+ SBC ESTKH,X
+ BCC REVCPY
+;
+; FORWARD COPY
+;
+ LDA ESTKL,X
+ STA DSTL
+ LDA ESTKH,X
+ STA DSTH
+ LDA ESTKL-1,X
+ STA SRCL
+ LDA ESTKH-1,X
+ STA SRCH
+ LDY ESTKL-2,X
+ BEQ FORCPYLP
+ INC ESTKH-2,X
+ LDY #$00
+FORCPYLP LDA (SRC),Y
+ STA (DST),Y
+ INY
+ BNE +
+ INC DSTH
+ INC SRCH
++ DEC ESTKL-2,X
+ BNE FORCPYLP
+ DEC ESTKH-2,X
+ BNE FORCPYLP
+ RTS
+;
+; REVERSE COPY
+;
+REVCPY ;CLC
+ LDA ESTKL-2,X
+ ADC ESTKL,X
+ STA DSTL
+ LDA ESTKH-2,X
+ ADC ESTKH,X
+ STA DSTH
+ CLC
+ LDA ESTKL-2,X
+ ADC ESTKL-1,X
+ STA SRCL
+ LDA ESTKH-2,X
+ ADC ESTKH-1,X
+ STA SRCH
+ DEC DSTH
+ DEC SRCH
+ LDY #$FF
+ LDA ESTKL-2,X
+ BEQ REVCPYLP
+ INC ESTKH-2,X
+REVCPYLP LDA (SRC),Y
+ STA (DST),Y
+ DEY
+ CPY #$FF
+ BNE +
+ DEC DSTH
+ DEC SRCH
++ DEC ESTKL-2,X
+ BNE REVCPYLP
+ DEC ESTKH-2,X
+ BNE REVCPYLP
+CPYMEX RTS
+end
+//
+// Unsigned word comparisons.
+//
+asm uword_isge
+ LDA ESTKL+1,X
+ CMP ESTKL,X
+ LDA ESTKH+1,X
+ SBC ESTKH,X
+ LDA #$FF
+ ADC #$00
+ EOR #$FF
+ STA ESTKL+1,X
+ STA ESTKH+1,X
+ INX
+ RTS
+end
+asm uword_isle
+ LDA ESTKL,X
+ CMP ESTKL+1,X
+ LDA ESTKH,X
+ SBC ESTKH+1,X
+ LDA #$FF
+ ADC #$00
+ EOR #$FF
+ STA ESTKL+1,X
+ STA ESTKH+1,X
+ INX
+ RTS
+end
+asm uword_isgt
+ LDA ESTKL,X
+ CMP ESTKL+1,X
+ LDA ESTKH,X
+ SBC ESTKH+1,X
+ LDA #$FF
+ ADC #$00
+ STA ESTKL+1,X
+ STA ESTKH+1,X
+ INX
+ RTS
+end
+asm uword_islt
+ LDA ESTKL+1,X
+ CMP ESTKL,X
+ LDA ESTKH+1,X
+ SBC ESTKH,X
+ LDA #$FF
+ ADC #$00
+ STA ESTKL+1,X
+ STA ESTKH+1,X
+ INX
+ RTS
+end
+//
+// Addresses of internal routines.
+//
+asm _hilopwm
+ TXA
+ PHA
+ JSR HILOPWM
+ PLA
+ TAX
+ DEX
+ RTS
+end
+asm toupper
+ LDA ESTKL,X
+TOUPR AND #$7F
+ CMP #'a'
+ BCC +
+ CMP #'z'+1
+ BCS +
+ SBC #$1F
++ STA ESTKL,X
+ RTS
+end
+//
+// CONSOLE I/O
+//
+asm putc
+ LDA ESTKL,X
+; JSR TOUPR
+ ORA #$80
+ JMP $FDF0
+end
+asm getc
+ DEX
+- LDA $C000
+ BPL -
+ BIT $C010
+ AND #$7F
+ STA ESTKL,X
+ LDA #$00
+ STA ESTKH,X
+ RTS
+end
+def keypressed
+ return ^$C000 >= 128
+end
+def pdl(num)
+ return call($FB1E, 0, num, 0, 0)->2
+end
+def bttn(num)
+ return (^$C061+num) >= 128
+end
+def putln
+ return putc($0D)
+end
+def beep
+ return putc($07)
+end
+def puts(str)
+ byte i
+
+ for i = 1 to ^str
+ putc(^(str+i))
+ next
+end
+def puti(i)
+ byte numstr[7]
+ byte place, sign
+
+ place = 6
+ if i < 0
+ sign = 1
+ i = -i
+ else
+ sign = 0
+ fin
+ while i >= 10
+ numstr[place] = i % 10 + '0'
+ i = i / 10
+ place--
+ loop
+ numstr[place] = i + '0'
+ place--
+ if sign
+ numstr[place] = '-'
+ place--
+ fin
+ numstr[place] = 6 - place
+ return puts(@numstr[place])
+end
+def normal
+ ^$32 = $FF
+end
+def inverse
+ ^$32 = $3F
+end
+def gotoxy(x, y)
+ ^$24 = x + ^$20
+ return call($FB5B, y + ^$22, 0, 0, 0)
+end
+def home
+ return call($FC58, 0, 0, 0, 0)
+end
+def putsxy(x, y, str)
+ gotoxy(x, y)
+ return puts(str)
+end
+def textmode
+ call($FB39, 0, 0, 0, 0) // textmode()
+ return home
+end
+//
+// Clear viewport to white
+//
+def clearview
+ byte i
+ word c
+
+ c = ' ' | $80 & ^$32
+ c = c | (c << 8)
+ for i = ^$22 to ^$23
+ memset(txt1scrn[i] + ^$20, c, ^$21)
+ next
+ return gotoxy(0,0)
+end
+def grmode
+ call($FB2F, 0, 0, 0, 0) // initmode()
+ call($FB40, 0, 0, 0, 0) // grmode()
+ return home
+end
+def grcolor(color)
+ return call($F864, color, 0, 0, 0)
+end
+def plot(x, y)
+ return call($F800, y, 0, x, 0)
+end
+def hlin(left, right, y)
+ ^$2C = right;
+ return call($F819, y, 0, left, 0)
+end
+def vlin(top, bottom, x)
+ ^$2D = bottom;
+ return call($F828, top, 0, x, 0)
+end
+def rect(left, right, top, bottom, fill)
+ byte y
+
+ hlin(left, right, top)
+ hlin(left, right, bottom)
+ top++
+ bottom--
+ if fill
+ for y = top to bottom
+ hlin(left, right, y)
+ next
+ else
+ vlin(top, bottom, left)
+ vlin(top, bottom, right)
+ fin
+end
+//
+// ProDOS routines
+//
+def open(path, buff)
+ byte params[6]
+
+ params.0 = 3
+ params:1 = path
+ params:3 = buff
+ params.5 = 0
+ perr = syscall($C8, @params)
+ return params.5
+end
+def close(refnum)
+ byte params[2]
+
+ params.0 = 1
+ params.1 = refnum
+ perr = syscall($CC, @params)
+ return perr
+end
+def read(refnum, buff, len)
+ byte params[8]
+
+ params.0 = 4
+ params.1 = refnum
+ params:2 = buff
+ params:4 = len
+ params:6 = 0
+ perr = syscall($CA, @params)
+ return params:6
+end
+def write(refnum, buff, len)
+ byte params[8]
+
+ params.0 = 4
+ params.1 = refnum
+ params:2 = buff
+ params:4 = len
+ params:6 = 0
+ perr = syscall($CB, @params)
+ return params:6
+end
+def create(path, access, type, aux)
+ byte params[12]
+
+ params.0 = 7
+ params:1 = path
+ params.3 = access
+ params.4 = type
+ params:5 = aux
+ params.7 = $1
+ params:8 = 0
+ params:10 = 0
+ perr = syscall($C0, @params)
+ return perr
+end
+def destroy(path)
+ byte params[3]
+
+ params.0 = 1
+ params:1 = path
+ perr = syscall($C1, @params)
+ return perr
+end
+//
+// HFO/LFO PWM sound routines
+//
+def envelope(attack, decay, sustain, release, ainc, dinc, rinc)
+ ^$0C = attack
+ ^$0D = decay
+ ^$0E = sustain
+ ^$0F = release
+ *$10 = ainc
+ *$12 = dinc
+ *$14 = rinc
+end
+def hilopwm(hfo, lfo, usr)
+ ^$08 = hfo
+ ^$09 = lfo
+ *$0A = usr
+ return _hilopwm
+end
diff --git a/src/samplesrc/rod.pla b/src/samplesrc/rod.pla
index a7d11e1..3582751 100644
--- a/src/samplesrc/rod.pla
+++ b/src/samplesrc/rod.pla
@@ -1,5 +1,5 @@
import cmdsys
- predef syscall, call, memset, getc, putc, puts, modaddr
+ predef syscall(f,p)#1, call(adr,a,x,y,p)#1, memset(d,s,l)#1, getc#1, putc(c)#1, puts(s)#1, modaddr(a)#1
byte MACHID
end
//
@@ -30,7 +30,7 @@ const page2 = 1
//
// Predefined functions.
//
-predef a2keypressed, a2gotoxy, a2grmode, a2textmode
+predef a2keypressed#1, a2gotoxy(x,y)#0, a2grmode(m)#0, a2textmode#0
//
// String data.
//
@@ -71,7 +71,7 @@ end
//
// def grscrn(rowaddrs)
//
-asm grscrn
+asm grscrn(rowaddrs)#0
GRSCRN = $26
GRSCRNL = GRSCRN
GRSCRNH = GRSCRNL+1
@@ -79,12 +79,13 @@ GRSCRNH = GRSCRNL+1
STA GRSCRNL
LDA ESTKH,X
STA GRSCRNH
+ INX
RTS
end
//
// def grcolor(color)
//
-asm grcolor
+asm grcolor(color)#0
GRCLR = $30
LDA #$0F
AND ESTKL,X
@@ -95,12 +96,13 @@ GRCLR = $30
ASL
ORA GRCLR
STA GRCLR
+ INX
RTS
end
//
// def grplot(x, y)
//
-asm grplot
+asm grplot(x, y)#0
STY IPY
LDA ESTKL,X
AND #$FE
@@ -125,56 +127,57 @@ asm grplot
STA (DST),Y
LDY IPY
INX
+ INX
RTS
end
//
// Apple II routines.
//
-def a2keypressed
+def a2keypressed#1
if ^keyboard >= 128
return ^keystrobe
fin
return FALSE
end
-def a2gotoxy(x, y)
+def a2gotoxy(x, y)#0
^$24 = x + ^$20
- return call($FB5B, y + ^$22, 0, 0, 0)
+ call($FB5B, y + ^$22, 0, 0, 0)
end
-def a2grmode(mix)
+def a2grmode(mix)#0
call($FB2F, 0, 0, 0, 0) // initmode()
call($FB40, 0, 0, 0, 0) // grmode()
if !mix
^showfull
fin
call($FC58, 0, 0, 0, 0) // home()
- return grscrn(@txt1scrn) // point to lo-res screen
+ grscrn(@txt1scrn) // point to lo-res screen
end
-def a2textmode
+def a2textmode#0
call($FB39, 0, 0, 0, 0) // textmode()
- return call($FC58, 0, 0, 0, 0) // home()
+ call($FC58, 0, 0, 0, 0) // home()
end
//
// Apple III routines.
//
-def dev_control(devnum, code, list)
+def dev_control(devnum, code, list)#1
byte params[5]
-
+
params.0 = 3
params.1 = devnum
params.2 = code
params:3 = list
return syscall($83, @params)
end
-def dev_status(devnum, code, list)
+def dev_status(devnum, code, list)#1
byte params[5]
-
+
params.0 = 3
params.1 = devnum
params.2 = code
params:3 = list
return syscall($82, @params)
end
-def a3keypressed
+def a3keypressed#1
byte count
dev_status(devcons, 5, @count)
if count
@@ -182,13 +185,13 @@ def a3keypressed
fin
return FALSE
end
-def a3gotoxy(x, y)
+def a3gotoxy(x, y)#0
putc(24)
putc(x)
putc(25)
- return putc(y)
+ putc(y)
end
-def a3viewport(left, top, width, height)
+def a3viewport(left, top, width, height)#0
putc(1) // Reset viewport
putc(26)
putc(left)
@@ -198,9 +201,9 @@ def a3viewport(left, top, width, height)
putc(left + width - 1)
putc(top + height - 1)
putc(3)
- return a3gotoxy(0, 0)
+ a3gotoxy(0, 0)
end
-def a3grmode(mix)
+def a3grmode(mix)#0
byte i
if mix
mix = 19
@@ -214,17 +217,17 @@ def a3grmode(mix)
memset(txt1scrn[i], $0000, 40) // text screen
memset(txt2scrn[i], $0000, 40) // color screen
next
- return grscrn(@txt2scrn) // point to color screen
+ grscrn(@txt2scrn) // point to color screen
end
-def a3textmode
+def a3textmode#0
puts(@textbwmode)
a3viewport(0, 0, 40, 24)
- return putc(28)
+ putc(28)
end
//
// Rod's Colors.
//
-def rod
+def rod#0
byte i, j, k, w, fmi, fmk, color
while TRUE
for w = 3 to 50
@@ -234,16 +237,16 @@ def rod
color = (j * 3) / (i + 3) + i * w / 12
fmi = 40 - i
fmk = 40 - k
- grcolor(color)
- grplot(i, k)
- grplot(k, i)
- grplot(fmi, fmk)
- grplot(fmk, fmi)
- grplot(k, fmi)
- grplot(fmi, k)
- grplot(i, fmk)
- grplot(fmk, i)
- if keypressed()
+ grcolor(color)#0
+ grplot(i, k)#0
+ grplot(k, i)#0
+ grplot(fmi, fmk)#0
+ grplot(fmk, fmi)#0
+ grplot(k, fmi)#0
+ grplot(fmi, k)#0
+ grplot(i, fmk)#0
+ grplot(fmk, i)#0
+ if keypressed()#1
return
fin
next
@@ -271,10 +274,10 @@ when MACHID & $C8
fin
otherwise // Apple ][
wend
-grmode(MIXMODE)
-gotoxy(11, 1)
+grmode(MIXMODE)#0
+gotoxy(11, 1)#0
puts(@exitmsg)
rod
-textmode()
+textmode()#0
puts(@goodbye)
-done
\ No newline at end of file
+done
diff --git a/src/samplesrc/rogue.combat.pla b/src/samplesrc/rogue.combat.pla
index fea5868..5af63cf 100644
--- a/src/samplesrc/rogue.combat.pla
+++ b/src/samplesrc/rogue.combat.pla
@@ -119,7 +119,6 @@ word ascii_entity = @ascii_thief, @ascii_ogre, @ascii_zombie, @ascii_rogue
//
// Monster types
//
-
byte thief = "Thief", 5
byte ogre = "Ogre", 20
byte zombie = "Zombie", 40
@@ -127,17 +126,6 @@ byte rogue = "Rogue", 80
export word entity = @thief, @ogre, @zombie, @rogue
export word entities = 0
-//
-// Combat status strings
-//
-
-byte skillstr = "Skill :"
-byte healthstr = "Health :"
-byte energystr = "Energy :"
-byte powerstr = "Power :"
-byte lifestr = "Life :"
-byte fightstr = "F)ight or R)un?"
-
//
// Combat Return 1 if running away, 0 if end of fight
//
@@ -157,24 +145,24 @@ export def fight(player, enemy)
gotoxy(0, 0)
puts(player+name)
gotoxy(1, 2)
- puts(@skillstr); puti(player->skill)
+ puts("Skill :"); puti(player->skill)
gotoxy(1, 3)
- puts(@healthstr); puti(player->health)
+ puts("Health :"); puti(player->health)
gotoxy(1, 4)
- puts(@energystr); puti(player->energy)
+ puts("Energy :"); puti(player->energy)
gotoxy(20, 0)
puts(entity[enemy->kind])
gotoxy(21, 2)
- puts(@powerstr); puti(enemy->power)
+ puts("Power :"); puti(enemy->power)
gotoxy(21, 3)
- puts(@lifestr); puti(enemy->life)
+ puts("Life :"); puti(enemy->life)
for e_atck = 0 to 9
gotoxy(0, 10 + e_atck)
puts(@ascii_warrior + e_atck * 11)
gotoxy(20, 10 + e_atck)
puts(ascii_entity[enemy->kind] + e_atck * 11)
next
- gotoxy(12, 8); puts(@fightstr)
+ gotoxy(12, 8); puts("F)ight or R)un?")
if toupper(getkb()) == 'R'
return 1
else
@@ -204,10 +192,10 @@ export def fight(player, enemy)
entities = enemy=>next_other
fin
if enemy=>next_other
- enemy=>next_other=>prev_other = enemy=>prev_other
+ enemy=>next_other=>prev_other = enemy=>prev_other
fin
if enemy=>prev_other
- enemy=>prev_other=>next_other = enemy=>next_other
+ enemy=>prev_other=>next_other = enemy=>next_other
fin
fin
if player->health > e_atck
@@ -224,4 +212,4 @@ export def fight(player, enemy)
return 0
end
-done
\ No newline at end of file
+done
diff --git a/src/samplesrc/test.pla b/src/samplesrc/test.pla
index 7a76576..92fedc7 100755
--- a/src/samplesrc/test.pla
+++ b/src/samplesrc/test.pla
@@ -32,17 +32,18 @@ byte constr = "Constant expression = "
byte[] offsets = "Structure offsets:"
word array[] = 1, 10, 100, 1000, 10000
word ptr
-byte spaces = " "
//
// Define functions.
//
def tens(start)
- word i
+ word i, pptr
+
i = start
+ pptr = @print
repeat
print:hex(i)
- print:str(@spaces)
- print:dec(i)
+ print:str(" ")
+ pptr=>dec(i)
print:newln()
i = i / 10
until i == 0
@@ -76,10 +77,15 @@ def nums(range)
puti(array[1]);putln
end
export def main(range)
+ byte a
+ a = 10
+
nums(*range)
tens(*range*10)
ascii
putln
+ puts("10 * 8 = "); puti(a * 8); putln
+ puts("10 / 2 = "); puti(a / 2); putln
puts(@hello)
when MACHID & $C8
is $08
diff --git a/src/toolsrc/codegen.c b/src/toolsrc/codegen.c
index 78d93c2..46ccba5 100755
--- a/src/toolsrc/codegen.c
+++ b/src/toolsrc/codegen.c
@@ -1,13 +1,11 @@
+#include
#include
#include
-#include "tokens.h"
-#include "lex.h"
-#include "symbols.h"
-#include "codegen.h"
+#include "plasm.h"
/*
* Symbol table and fixup information.
*/
-#define ID_LEN 32
+#define ID_LEN 32
static int consts = 0;
static int externs = 0;
static int globals = 0;
@@ -29,8 +27,10 @@ static int idlocal_offset[128];
static char fixup_size[2048];
static int fixup_type[2048];
static int fixup_tag[2048];
-#define FIXUP_BYTE 0x00
-#define FIXUP_WORD 0x80
+static t_opseq optbl[256];
+static t_opseq *freeop_lst = &optbl[0];
+#define FIXUP_BYTE 0x00
+#define FIXUP_WORD 0x80
int id_match(char *name, int len, char *id)
{
if (len == id[0])
@@ -147,13 +147,13 @@ int idglobal_add(char *name, int len, int type, int size)
if (!(type & EXTERN_TYPE))
{
emit_idglobal(globals, size, name);
- idglobal_tag[globals] = globals;
- globals++;
+ idglobal_tag[globals] = globals;
+ globals++;
}
else
{
printf("\t\t\t\t\t; %s -> X%03d\n", &idglobal_name[globals][1], externs);
- idglobal_tag[globals++] = externs++;
+ idglobal_tag[globals++] = externs++;
}
return (1);
}
@@ -161,6 +161,11 @@ int id_add(char *name, int len, int type, int size)
{
return ((type & LOCAL_TYPE) ? idlocal_add(name, len, type, size) : idglobal_add(name, len, type, size));
}
+void idlocal_reset(void)
+{
+ locals = 0;
+ localsize = 0;
+}
int idfunc_add(char *name, int len, int type, int tag)
{
if (globals > 1024)
@@ -254,10 +259,6 @@ int fixup_new(int tag, int type, int size)
/*
* Emit assembly code.
*/
-#define BYTECODE_SEG 8
-#define INIT 16
-#define SYSFLAGS 32
-static int outflags = 0;
static const char *DB = ".BYTE";
static const char *DW = ".WORD";
static const char *DS = ".RES";
@@ -304,8 +305,7 @@ void emit_dci(char *str, int len)
}
void emit_flags(int flags)
{
- outflags = flags;
- if (outflags & ACME)
+ if (flags & ACME)
{
DB = "!BYTE";
DW = "!WORD";
@@ -315,6 +315,8 @@ void emit_flags(int flags)
}
void emit_header(void)
{
+ int i;
+
if (outflags & ACME)
printf("; ACME COMPATIBLE OUTPUT\n");
else
@@ -323,7 +325,7 @@ void emit_header(void)
{
printf("\t%s\t_SEGEND-_SEGBEGIN\t; LENGTH OF HEADER + CODE/DATA + BYTECODE SEGMENT\n", DW);
printf("_SEGBEGIN%c\n", LBL);
- printf("\t%s\t$DA7E\t\t\t; MAGIC #\n", DW);
+ printf("\t%s\t$DA7F\t\t\t; MAGIC #\n", DW);
printf("\t%s\t_SYSFLAGS\t\t\t; SYSTEM FLAGS\n", DW);
printf("\t%s\t_SUBSEG\t\t\t; BYTECODE SUB-SEGMENT\n", DW);
printf("\t%s\t_DEFCNT\t\t\t; BYTECODE DEF COUNT\n", DW);
@@ -333,6 +335,12 @@ void emit_header(void)
{
printf("\tJMP\t_INIT\t\t\t; MODULE INITIALIZATION ROUTINE\n");
}
+ /*
+ * Init free op sequence table
+ */
+ for (i = 0; i < sizeof(optbl)/sizeof(t_opseq)-1; i++)
+ optbl[i].nextop = &optbl[i+1];
+ optbl[i].nextop = NULL;
}
void emit_rld(void)
{
@@ -447,9 +455,16 @@ void emit_idglobal(int tag, int size, char *name)
else
printf("_D%03d%c\t%s\t%d\t\t\t; %s\n", tag, LBL, DS, size, name);
}
-void emit_idfunc(int tag, int type, char *name)
+void emit_idfunc(int tag, int type, char *name, int is_bytecode)
{
- printf("%s%c\t\t\t\t\t; %s()\n", tag_string(tag, type), LBL, name);
+ if (name)
+ printf("%s%c\t\t\t\t\t; %s()\n", tag_string(tag, type), LBL, name);
+ if (!(outflags & MODULE))
+ {
+ //printf("%s%c\n", name, LBL);
+ if (is_bytecode)
+ printf("\tJSR\tINTERP\n");
+ }
}
void emit_idconst(char *name, int value)
{
@@ -458,7 +473,7 @@ void emit_idconst(char *name, int value)
int emit_data(int vartype, int consttype, long constval, int constsize)
{
int datasize, i;
- char *str;
+ unsigned char *str;
if (consttype == 0)
{
datasize = constsize;
@@ -466,9 +481,10 @@ int emit_data(int vartype, int consttype, long constval, int constsize)
}
else if (consttype & STRING_TYPE)
{
- datasize = constsize;
- str = (char *)(uintptr_t)constval;
- printf("\t%s\t$%02X\n", DB, --constsize);
+ str = (unsigned char *)constval;
+ constsize = *str++;
+ datasize = constsize + 1;
+ printf("\t%s\t$%02X\n", DB, constsize);
while (constsize-- > 0)
{
printf("\t%s\t$%02X", DB, *str++);
@@ -518,17 +534,6 @@ int emit_data(int vartype, int consttype, long constval, int constsize)
}
return (datasize);
}
-void emit_def(const char *name, int is_bytecode)
-{
- if (!(outflags & MODULE))
- {
- //printf("%s%c\n", name, LBL);
- if (is_bytecode)
- printf("\tJSR\tINTERP\n");
- }
- locals = 0;
- localsize = 0;
-}
void emit_codetag(int tag)
{
printf("_B%03d%c\n", tag, LBL);
@@ -542,10 +547,10 @@ void emit_const(int cval)
else
printf("\t%s\t$2C,$%02X,$%02X\t\t; CW\t%d\n", DB, cval&0xFF,(cval>>8)&0xFF, cval);
}
-void emit_conststr(long conststr, int strsize)
+void emit_conststr(long conststr)
{
printf("\t%s\t$2E\t\t\t; CS\n", DB);
- emit_data(0, STRING_TYPE, conststr, strsize);
+ emit_data(0, STRING_TYPE, conststr, 0);
}
void emit_lb(void)
{
@@ -565,17 +570,31 @@ void emit_llw(int index)
}
void emit_lab(int tag, int offset, int type)
{
- int fixup = fixup_new(tag, type, FIXUP_WORD);
- char *taglbl = tag_string(tag, type);
- printf("\t%s\t$68\t\t\t; LAB\t%s+%d\n", DB, taglbl, offset);
- printf("_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl, offset);
+ if (type)
+ {
+ int fixup = fixup_new(tag, type, FIXUP_WORD);
+ char *taglbl = tag_string(tag, type);
+ printf("\t%s\t$68\t\t\t; LAB\t%s+%d\n", DB, taglbl, offset);
+ printf("_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl, offset);
+ }
+ else
+ {
+ printf("\t%s\t$68,$%02X,$%02X\t\t; LAB\t%d\n", DB, offset&0xFF,(offset>>8)&0xFF, offset);
+ }
}
void emit_law(int tag, int offset, int type)
{
- int fixup = fixup_new(tag, type, FIXUP_WORD);
- char *taglbl = tag_string(tag, type);
- printf("\t%s\t$6A\t\t\t; LAW\t%s+%d\n", DB, taglbl, offset);
- printf("_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl, offset);
+ if (type)
+ {
+ int fixup = fixup_new(tag, type, FIXUP_WORD);
+ char *taglbl = tag_string(tag, type);
+ printf("\t%s\t$6A\t\t\t; LAW\t%s+%d\n", DB, taglbl, offset);
+ printf("_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl, offset);
+ }
+ else
+ {
+ printf("\t%s\t$6A,$%02X,$%02X\t\t; LAW\t%d\n", DB, offset&0xFF,(offset>>8)&0xFF, offset);
+ }
}
void emit_sb(void)
{
@@ -603,31 +622,45 @@ void emit_dlw(int index)
}
void emit_sab(int tag, int offset, int type)
{
- int fixup = fixup_new(tag, type, FIXUP_WORD);
- char *taglbl = tag_string(tag, type);
- printf("\t%s\t$78\t\t\t; SAB\t%s+%d\n", DB, taglbl, offset);
- printf("_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl, offset);
+ if (type)
+ {
+ int fixup = fixup_new(tag, type, FIXUP_WORD);
+ char *taglbl = tag_string(tag, type);
+ printf("\t%s\t$78\t\t\t; SAB\t%s+%d\n", DB, taglbl, offset);
+ printf("_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl, offset);
+ }
+ else
+ {
+ printf("\t%s\t$78,$%02X,$%02X\t\t; SAB\t%d\n", DB, offset&0xFF,(offset>>8)&0xFF, offset);
+ }
}
void emit_saw(int tag, int offset, int type)
+{
+ if (type)
+ {
+ int fixup = fixup_new(tag, type, FIXUP_WORD);
+ char *taglbl = tag_string(tag, type);
+ printf("\t%s\t$7A\t\t\t; SAW\t%s+%d\n", DB, taglbl, offset);
+ printf("_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl, offset);
+ }
+ else
+ {
+ printf("\t%s\t$7A,$%02X,$%02X\t\t; SAW\t%d\n", DB, offset&0xFF,(offset>>8)&0xFF, offset);
+ }
+}
+void emit_dab(int tag, int offset, int type)
{
int fixup = fixup_new(tag, type, FIXUP_WORD);
char *taglbl = tag_string(tag, type);
- printf("\t%s\t$7A\t\t\t; SAW\t%s+%d\n", DB, taglbl, offset);
+ printf("\t%s\t$7C\t\t\t; DAB\t%s+%d\n", DB, taglbl, offset);
printf("_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl, offset);
}
-void emit_dab(int tag, int type)
+void emit_daw(int tag, int offset, int type)
{
int fixup = fixup_new(tag, type, FIXUP_WORD);
char *taglbl = tag_string(tag, type);
- printf("\t%s\t$7C\t\t\t; DAB\t%s\n", DB, taglbl);
- printf("_F%03d%c\t%s\t%s\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl);
-}
-void emit_daw(int tag, int type)
-{
- int fixup = fixup_new(tag, type, FIXUP_WORD);
- char *taglbl = tag_string(tag, type);
- printf("\t%s\t$7E\t\t\t; DAW\t%s\n", DB, taglbl);
- printf("_F%03d%c\t%s\t%s\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl);
+ printf("\t%s\t$7E\t\t\t; DAW\t%s+%d\n", DB, taglbl, offset);
+ printf("_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl, offset);
}
void emit_localaddr(int index)
{
@@ -724,27 +757,23 @@ void emit_start(void)
outflags |= INIT;
defs++;
}
-void emit_dup(void)
+void emit_push_exp(void)
{
- printf("\t%s\t$32\t\t\t; DUP\n", DB);
+ printf("\t%s\t$34\t\t\t; PUSH EXP\n", DB);
}
-void emit_push(void)
+void emit_pull_exp(void)
{
- printf("\t%s\t$34\t\t\t; PUSH\n", DB);
-}
-void emit_pull(void)
-{
- printf("\t%s\t$36\t\t\t; PULL\n", DB);
-}
-void emit_swap(void)
-{
- printf("\t%s\t$2E\t\t\t; SWAP\n", DB);
+ printf("\t%s\t$36\t\t\t; PULL EXP\n", DB);
}
void emit_drop(void)
{
printf("\t%s\t$30\t\t\t; DROP\n", DB);
}
-int emit_unaryop(int op)
+void emit_dup(void)
+{
+ printf("\t%s\t$32\t\t\t; DUP\n", DB);
+}
+int emit_unaryop(t_token op)
{
switch (op)
{
@@ -840,3 +869,543 @@ int emit_op(t_token op)
}
return (1);
}
+/*
+ * New/release sequence ops
+ */
+t_opseq *new_op(void)
+{
+ t_opseq* op = freeop_lst;
+ if (!op)
+ {
+ fprintf(stderr, "Compiler out of sequence ops!\n");
+ return (NULL);
+ }
+ freeop_lst = freeop_lst->nextop;
+ op->nextop = NULL;
+ return (op);
+}
+void release_op(t_opseq *op)
+{
+ if (op)
+ {
+ op->nextop = freeop_lst;
+ freeop_lst = op;
+ }
+}
+void release_seq(t_opseq *seq)
+{
+ t_opseq *op;
+ while (seq)
+ {
+ op = seq;
+ seq = seq->nextop;
+ /*
+ * Free this op
+ */
+ op->nextop = freeop_lst;
+ freeop_lst = op;
+ }
+}
+/*
+ * Crunch sequence (peephole optimize)
+ */
+int crunch_seq(t_opseq **seq)
+{
+ t_opseq *opnext, *opnextnext;
+ t_opseq *op = *seq;
+ int crunched = 0;
+ int freeops = 0;
+ int shiftcnt;
+
+ while (op && (opnext = op->nextop))
+ {
+ switch (op->code)
+ {
+ case CONST_CODE:
+ if (op->val == 1)
+ {
+ if (opnext->code == BINARY_CODE(ADD_TOKEN))
+ {
+ op->code = INC_CODE;
+ freeops = 1;
+ break;
+ }
+ if (opnext->code == BINARY_CODE(SUB_TOKEN))
+ {
+ op->code = DEC_CODE;
+ freeops = 1;
+ break;
+ }
+ }
+ switch (opnext->code)
+ {
+ case NEG_CODE:
+ op->val = -(op->val);
+ freeops = 1;
+ break;
+ case COMP_CODE:
+ op->val = ~(op->val);
+ freeops = 1;
+ break;
+ case LOGIC_NOT_CODE:
+ op->val = op->val ? 0 : 1;
+ freeops = 1;
+ break;
+ case UNARY_CODE(BPTR_TOKEN):
+ case LB_CODE:
+ op->offsz = op->val;
+ op->code = LAB_CODE;
+ freeops = 1;
+ break;
+ case UNARY_CODE(WPTR_TOKEN):
+ case LW_CODE:
+ op->offsz = op->val;
+ op->code = LAW_CODE;
+ freeops = 1;
+ break;
+ case SB_CODE:
+ op->offsz = op->val;
+ op->code = SAB_CODE;
+ freeops = 1;
+ break;
+ case SW_CODE:
+ op->offsz = op->val;
+ op->code = SAW_CODE;
+ freeops = 1;
+ break;
+ case BRFALSE_CODE:
+ if (op->val)
+ {
+ opnextnext = opnext->nextop; // Remove never taken branch
+ if (op == *seq)
+ *seq = opnextnext;
+ opnext->nextop = NULL;
+ release_seq(op);
+ opnext = opnextnext;
+ crunched = 1;
+ }
+ else
+ {
+ op->code = BRNCH_CODE; // Always taken branch
+ op->tag = opnext->tag;
+ freeops = 1;
+ }
+ break;
+ case BRTRUE_CODE:
+ if (!op->val)
+ {
+ opnextnext = opnext->nextop; // Remove never taken branch
+ if (op == *seq)
+ *seq = opnextnext;
+ opnext->nextop = NULL;
+ release_seq(op);
+ opnext = opnextnext;
+ crunched = 1;
+ }
+ else
+ {
+ op->code = BRNCH_CODE; // Always taken branch
+ op->tag = opnext->tag;
+ freeops = 1;
+ }
+ break;
+ case CONST_CODE: // Collapse constant operation
+ if ((opnextnext = opnext->nextop))
+ switch (opnextnext->code)
+ {
+ case BINARY_CODE(MUL_TOKEN):
+ op->val *= opnext->val;
+ freeops = 2;
+ break;
+ case BINARY_CODE(DIV_TOKEN):
+ op->val /= opnext->val;
+ freeops = 2;
+ break;
+ case BINARY_CODE(MOD_TOKEN):
+ op->val %= opnext->val;
+ freeops = 2;
+ break;
+ case BINARY_CODE(ADD_TOKEN):
+ op->val += opnext->val;
+ freeops = 2;
+ break;
+ case BINARY_CODE(SUB_TOKEN):
+ op->val -= opnext->val;
+ freeops = 2;
+ break;
+ case BINARY_CODE(SHL_TOKEN):
+ op->val <<= opnext->val;
+ freeops = 2;
+ break;
+ case BINARY_CODE(SHR_TOKEN):
+ op->val >>= opnext->val;
+ freeops = 2;
+ break;
+ case BINARY_CODE(AND_TOKEN):
+ op->val &= opnext->val;
+ freeops = 2;
+ break;
+ case BINARY_CODE(OR_TOKEN):
+ op->val |= opnext->val;
+ freeops = 2;
+ break;
+ case BINARY_CODE(EOR_TOKEN):
+ op->val ^= opnext->val;
+ freeops = 2;
+ break;
+ case BINARY_CODE(EQ_TOKEN):
+ op->val = op->val == opnext->val ? 1 : 0;
+ freeops = 2;
+ break;
+ case BINARY_CODE(NE_TOKEN):
+ op->val = op->val != opnext->val ? 1 : 0;
+ freeops = 2;
+ break;
+ case BINARY_CODE(GE_TOKEN):
+ op->val = op->val >= opnext->val ? 1 : 0;
+ freeops = 2;
+ break;
+ case BINARY_CODE(LT_TOKEN):
+ op->val = op->val < opnext->val ? 1 : 0;
+ freeops = 2;
+ break;
+ case BINARY_CODE(GT_TOKEN):
+ op->val = op->val > opnext->val ? 1 : 0;
+ freeops = 2;
+ break;
+ case BINARY_CODE(LE_TOKEN):
+ op->val = op->val <= opnext->val ? 1 : 0;
+ freeops = 2;
+ break;
+ case BINARY_CODE(LOGIC_OR_TOKEN):
+ op->val = op->val || opnext->val ? 1 : 0;
+ freeops = 2;
+ break;
+ case BINARY_CODE(LOGIC_AND_TOKEN):
+ op->val = op->val && opnext->val ? 1 : 0;
+ freeops = 2;
+ break;
+ }
+ break; // CONST_CODE
+ case BINARY_CODE(MUL_TOKEN):
+ for (shiftcnt = 0; shiftcnt < 16; shiftcnt++)
+ {
+ if (op->val == (1 << shiftcnt))
+ {
+ op->val = shiftcnt;
+ opnext->code = BINARY_CODE(SHL_TOKEN);
+ break;
+ }
+ }
+ break;
+ case BINARY_CODE(DIV_TOKEN):
+ for (shiftcnt = 0; shiftcnt < 16; shiftcnt++)
+ {
+ if (op->val == (1 << shiftcnt))
+ {
+ op->val = shiftcnt;
+ opnext->code = BINARY_CODE(SHR_TOKEN);
+ break;
+ }
+ }
+ break;
+ }
+ break; // CONST_CODE
+ case LADDR_CODE:
+ switch (opnext->code)
+ {
+ case CONST_CODE:
+ if ((opnextnext = opnext->nextop))
+ switch (opnextnext->code)
+ {
+ case ADD_CODE:
+ case INDEXB_CODE:
+ op->offsz += opnext->val;
+ freeops = 2;
+ break;
+ case INDEXW_CODE:
+ op->offsz += opnext->val * 2;
+ freeops = 2;
+ break;
+ }
+ break;
+ case LB_CODE:
+ op->code = LLB_CODE;
+ freeops = 1;
+ break;
+ case LW_CODE:
+ op->code = LLW_CODE;
+ freeops = 1;
+ break;
+ case SB_CODE:
+ op->code = SLB_CODE;
+ freeops = 1;
+ break;
+ case SW_CODE:
+ op->code = SLW_CODE;
+ freeops = 1;
+ break;
+ }
+ break; // LADDR_CODE
+ case GADDR_CODE:
+ switch (opnext->code)
+ {
+ case CONST_CODE:
+ if ((opnextnext = opnext->nextop))
+ switch (opnextnext->code)
+ {
+ case ADD_CODE:
+ case INDEXB_CODE:
+ op->offsz += opnext->val;
+ freeops = 2;
+ break;
+ case INDEXW_CODE:
+ op->offsz += opnext->val * 2;
+ freeops = 2;
+ break;
+ }
+ break;
+ case LB_CODE:
+ op->code = LAB_CODE;
+ freeops = 1;
+ break;
+ case LW_CODE:
+ op->code = LAW_CODE;
+ freeops = 1;
+ break;
+ case SB_CODE:
+ op->code = SAB_CODE;
+ freeops = 1;
+ break;
+ case SW_CODE:
+ op->code = SAW_CODE;
+ freeops = 1;
+ break;
+ case ICAL_CODE:
+ op->code = CALL_CODE;
+ freeops = 1;
+ break;
+ }
+ break; // GADDR_CODE
+ case LOGIC_NOT_CODE:
+ switch (opnext->code)
+ {
+ case BRFALSE_CODE:
+ op->code = BRTRUE_CODE;
+ op->tag = opnext->tag;
+ freeops = 1;
+ break;
+ case BRTRUE_CODE:
+ op->code = BRFALSE_CODE;
+ op->tag = opnext->tag;
+ freeops = 1;
+ break;
+ }
+ break; // LOGIC_NOT_CODE
+ }
+ //
+ // Free up crunched ops
+ //
+ while (freeops)
+ {
+ op->nextop = opnext->nextop;
+ opnext->nextop = freeop_lst;
+ freeop_lst = opnext;
+ opnext = op->nextop;
+ crunched = 1;
+ freeops--;
+ }
+ op = opnext;
+ }
+ return (crunched);
+}
+/*
+ * Generate a sequence of code
+ */
+t_opseq *gen_seq(t_opseq *seq, int opcode, long cval, int tag, int offsz, int type)
+{
+ t_opseq *op;
+
+ if (!seq)
+ {
+ op = seq = new_op();
+ }
+ else
+ {
+ op = seq;
+ while (op->nextop)
+ op = op->nextop;
+ op->nextop = new_op();
+ op = op->nextop;
+ }
+ op->code = opcode;
+ op->val = cval;
+ op->tag = tag;
+ op->offsz = offsz;
+ op->type = type;
+ return (seq);
+}
+/*
+ * Append one sequence to the end of another
+ */
+t_opseq *cat_seq(t_opseq *seq1, t_opseq *seq2)
+{
+ t_opseq *op;
+
+ if (!seq1)
+ return (seq2);
+ for (op = seq1; op->nextop; op = op->nextop);
+ op->nextop = seq2;
+ return (seq1);
+}
+/*
+ * Emit a sequence of ops
+ */
+int emit_seq(t_opseq *seq)
+{
+ t_opseq *op;
+ int emitted = 0;
+
+ if (outflags & OPTIMIZE)
+ while (crunch_seq(&seq));
+ while (seq)
+ {
+ op = seq;
+ switch (op->code)
+ {
+ case NEG_CODE:
+ case COMP_CODE:
+ case LOGIC_NOT_CODE:
+ case INC_CODE:
+ case DEC_CODE:
+ case BPTR_CODE:
+ case WPTR_CODE:
+ emit_unaryop(op->code);
+ break;
+ case MUL_CODE:
+ case DIV_CODE:
+ case MOD_CODE:
+ case ADD_CODE:
+ case SUB_CODE:
+ case SHL_CODE:
+ case SHR_CODE:
+ case AND_CODE:
+ case OR_CODE:
+ case EOR_CODE:
+ case EQ_CODE:
+ case NE_CODE:
+ case GE_CODE:
+ case LT_CODE:
+ case GT_CODE:
+ case LE_CODE:
+ case LOGIC_OR_CODE:
+ case LOGIC_AND_CODE:
+ emit_op(op->code);
+ break;
+ case CONST_CODE:
+ emit_const(op->val);
+ break;
+ case STR_CODE:
+ emit_conststr(op->val);
+ break;
+ case LB_CODE:
+ emit_lb();
+ break;
+ case LW_CODE:
+ emit_lw();
+ break;
+ case LLB_CODE:
+ emit_llb(op->offsz);
+ break;
+ case LLW_CODE:
+ emit_llw(op->offsz);
+ break;
+ case LAB_CODE:
+ emit_lab(op->tag, op->offsz, op->type);
+ break;
+ case LAW_CODE:
+ emit_law(op->tag, op->offsz, op->type);
+ break;
+ case SB_CODE:
+ emit_sb();
+ break;
+ case SW_CODE:
+ emit_sw();
+ break;
+ case SLB_CODE:
+ emit_slb(op->offsz);
+ break;
+ case SLW_CODE:
+ emit_slw(op->offsz);
+ break;
+ case DLB_CODE:
+ emit_dlb(op->offsz);
+ break;
+ case DLW_CODE:
+ emit_dlw(op->offsz);
+ break;
+ case SAB_CODE:
+ emit_sab(op->tag, op->offsz, op->type);
+ break;
+ case SAW_CODE:
+ emit_saw(op->tag, op->offsz, op->type);
+ break;
+ case DAB_CODE:
+ emit_dab(op->tag, op->offsz, op->type);
+ break;
+ case DAW_CODE:
+ emit_daw(op->tag, op->offsz, op->type);
+ break;
+ case CALL_CODE:
+ emit_call(op->tag, op->type);
+ break;
+ case ICAL_CODE:
+ emit_ical();
+ break;
+ case LADDR_CODE:
+ emit_localaddr(op->offsz);
+ break;
+ case GADDR_CODE:
+ emit_globaladdr(op->tag, op->offsz, op->type);
+ break;
+ case INDEXB_CODE:
+ emit_indexbyte();
+ break;
+ case INDEXW_CODE:
+ emit_indexword();
+ break;
+ case DROP_CODE:
+ emit_drop();
+ break;
+ case DUP_CODE:
+ emit_dup();
+ break;
+ break;
+ case PUSH_EXP_CODE:
+ emit_push_exp();
+ break;
+ case PULL_EXP_CODE:
+ emit_pull_exp();
+ break;
+ case BRNCH_CODE:
+ emit_brnch(op->tag);
+ break;
+ case BRFALSE_CODE:
+ emit_brfls(op->tag);
+ break;
+ case BRTRUE_CODE:
+ emit_brtru(op->tag);
+ break;
+ default:
+ return (0);
+ }
+ emitted++;
+ seq = seq->nextop;
+ /*
+ * Free this op
+ */
+ op->nextop = freeop_lst;
+ freeop_lst = op;
+ }
+ return (emitted);
+}
diff --git a/src/toolsrc/codegen.h b/src/toolsrc/codegen.h
index d05d11c..b25f0b4 100755
--- a/src/toolsrc/codegen.h
+++ b/src/toolsrc/codegen.h
@@ -1,5 +1,89 @@
-#define ACME 1
-#define MODULE 2
+typedef struct _opseq {
+ int code;
+ long val;
+ int tag;
+ int offsz;
+ int type;
+ struct _opseq *nextop;
+} t_opseq;
+#define UNARY_CODE(tkn) ((tkn)|0x0100)
+#define BINARY_CODE(tkn) ((tkn)|0x0200)
+#define NEG_CODE 0x0100|NEG_TOKEN
+#define COMP_CODE 0x0100|COMP_TOKEN
+#define LOGIC_NOT_CODE 0x0100|LOGIC_NOT_TOKEN
+#define INC_CODE 0x0100|INC_TOKEN
+#define DEC_CODE 0x0100|DEC_TOKEN
+#define BPTR_CODE 0x0100|BPTR_TOKEN
+#define WPTR_CODE 0x0100|WPTR_TOKEN
+#define MUL_CODE 0x0200|MUL_TOKEN
+#define DIV_CODE 0x0200|DIV_TOKEN
+#define MOD_CODE 0x0200|MOD_TOKEN
+#define ADD_CODE 0x0200|ADD_TOKEN
+#define SUB_CODE 0x0200|SUB_TOKEN
+#define SHL_CODE 0x0200|SHL_TOKEN
+#define SHR_CODE 0x0200|SHR_TOKEN
+#define AND_CODE 0x0200|AND_TOKEN
+#define OR_CODE 0x0200|OR_TOKEN
+#define EOR_CODE 0x0200|EOR_TOKEN
+#define EQ_CODE 0x0200|EQ_TOKEN
+#define NE_CODE 0x0200|NE_TOKEN
+#define GE_CODE 0x0200|GE_TOKEN
+#define LT_CODE 0x0200|LT_TOKEN
+#define GT_CODE 0x0200|GT_TOKEN
+#define LE_CODE 0x0200|LE_TOKEN
+#define LOGIC_OR_CODE 0x0200|LOGIC_OR_TOKEN
+#define LOGIC_AND_CODE 0x0200|LOGIC_AND_TOKEN
+#define CONST_CODE 0x0300
+#define STR_CODE 0x0301
+#define LB_CODE 0x0302
+#define LW_CODE 0x0303
+#define LLB_CODE 0x0304
+#define LLW_CODE 0x0305
+#define LAB_CODE 0x0306
+#define LAW_CODE 0x0307
+#define SB_CODE 0x0308
+#define SW_CODE 0x0309
+#define SLB_CODE 0x030A
+#define SLW_CODE 0x030B
+#define DLB_CODE 0x030C
+#define DLW_CODE 0x030D
+#define SAB_CODE 0x030E
+#define SAW_CODE 0x030F
+#define DAB_CODE 0x0310
+#define DAW_CODE 0x0311
+#define CALL_CODE 0x0312
+#define ICAL_CODE 0x0313
+#define LADDR_CODE 0x0314
+#define GADDR_CODE 0x0315
+#define INDEXB_CODE 0x0316
+#define INDEXW_CODE 0x0317
+#define DROP_CODE 0x0318
+#define DUP_CODE 0x0319
+#define PUSH_EXP_CODE 0x031A
+#define PULL_EXP_CODE 0x031B
+#define BRNCH_CODE 0x031C
+#define BRFALSE_CODE 0x031D
+#define BRTRUE_CODE 0x031E
+
+#define gen_uop(seq,op) gen_seq(seq,UNARY_CODE(op),0,0,0,0)
+#define gen_op(seq,op) gen_seq(seq,BINARY_CODE(op),0,0,0,0)
+#define gen_const(seq,val) gen_seq(seq,CONST_CODE,val,0,0,0)
+#define gen_str(seq,str) gen_seq(seq,STR_CODE,str,0,0,0)
+#define gen_lcladr(seq,idx) gen_seq(seq,LADDR_CODE,0,0,idx,0)
+#define gen_gbladr(seq,tag,typ) gen_seq(seq,GADDR_CODE,0,tag,0,typ)
+#define gen_idxb(seq) gen_seq(seq,ADD_CODE,0,0,0,0)
+#define gen_idxw(seq) gen_seq(seq,INDEXW_CODE,0,0,0,0)
+#define gen_lb(seq) gen_seq(seq,LB_CODE,0,0,0,0)
+#define gen_lw(seq) gen_seq(seq,LW_CODE,0,0,0,0)
+#define gen_sb(seq) gen_seq(seq,SB_CODE,0,0,0,0)
+#define gen_sw(seq) gen_seq(seq,SW_CODE,0,0,0,0)
+#define gen_icall(seq) gen_seq(seq,ICAL_CODE,0,0,0,0)
+#define gen_pushexp(seq) gen_seq(seq,PUSH_EXP_CODE,0,0,0,0)
+#define gen_pullexp(seq) gen_seq(seq,PULL_EXP_CODE,0,0,0,0)
+#define gen_drop(seq) gen_seq(seq,DROP_CODE,0,0,0,0)
+#define gen_brfls(seq,tag) gen_seq(seq,BRFALSE_CODE,0,tag,0,0)
+#define gen_brtru(seq,tag) gen_seq(seq,BRTRUE_CODE,0,tag,0,0)
+
void emit_flags(int flags);
void emit_header(void);
void emit_trailer(void);
@@ -10,13 +94,12 @@ void emit_comment(char *s);
void emit_asm(char *s);
void emit_idlocal(char *name, int value);
void emit_idglobal(int value, int size, char *name);
-void emit_idfunc(int tag, int type, char *name);
+void emit_idfunc(int tag, int type, char *name, int is_bytecode);
void emit_idconst(char *name, int value);
-void emit_def(const char *name, int is_bytecode);
int emit_data(int vartype, int consttype, long constval, int constsize);
void emit_codetag(int tag);
void emit_const(int cval);
-void emit_conststr(long conststr, int strsize);
+void emit_conststr(long conststr);
void emit_lb(void);
void emit_lw(void);
void emit_llb(int index);
@@ -30,16 +113,16 @@ void emit_slw(int index);
void emit_dlb(int index);
void emit_dlw(int index);
void emit_sab(int tag, int offset, int type);
-void emit_saw(int tag, int ofset, int type);
-void emit_dab(int tag, int type);
-void emit_daw(int tag, int type);
+void emit_saw(int tag, int offset, int type);
+void emit_dab(int tag, int offset, int type);
+void emit_daw(int tag, int offset, int type);
void emit_call(int tag, int type);
void emit_ical(void);
void emit_localaddr(int index);
void emit_globaladdr(int tag, int offset, int type);
void emit_indexbyte(void);
void emit_indexword(void);
-int emit_unaryop(int op);
+int emit_unaryop(t_token op);
int emit_op(t_token op);
void emit_brtru(int tag);
void emit_brfls(int tag);
@@ -47,14 +130,19 @@ void emit_brgt(int tag);
void emit_brlt(int tag);
void emit_brne(int tag);
void emit_brnch(int tag);
-void emit_swap(void);
-void emit_dup(void);
-void emit_push(void);
-void emit_pull(void);
+void emit_empty(void);
+void emit_push_exp(void);
+void emit_pull_exp(void);
void emit_drop(void);
+void emit_dup(void);
void emit_leave(void);
void emit_ret(void);
void emit_enter(int cparams);
void emit_start(void);
void emit_rld(void);
void emit_esd(void);
+void release_seq(t_opseq *seq);
+int crunch_seq(t_opseq **seq);
+t_opseq *gen_seq(t_opseq *seq, int opcode, long cval, int tag, int offsz, int type);
+t_opseq *cat_seq(t_opseq *seq1, t_opseq *seq2);
+int emit_seq(t_opseq *seq);
diff --git a/src/toolsrc/lex.c b/src/toolsrc/lex.c
index 36bb711..06d87e4 100755
--- a/src/toolsrc/lex.c
+++ b/src/toolsrc/lex.c
@@ -1,21 +1,11 @@
-/*
- * Copyright (C) 2015 The 8-Bit Bunch. Licensed under the Apache License, Version 1.1
- * (the "License"); you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at .
- * Unless required by applicable law or agreed to in writing, software distributed under
- * the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF
- * ANY KIND, either express or implied. See the License for the specific language
- * governing permissions and limitations under the License.
- */
-
+#include
#include
#include
-#include
#include
-#include "tokens.h"
-#include "symbols.h"
+#include
+#include "plasm.h"
-char *statement, *tokenstr, *scanpos = (char*) "";
+char *statement, *tokenstr, *scanpos = "", *strpos = "";
t_token scantoken, prevtoken;
int tokenlen;
long constval;
@@ -37,34 +27,36 @@ t_token keywords[] = {
DEFAULT_TOKEN, 'O', 'T', 'H', 'E', 'R', 'W', 'I', 'S', 'E',
ENDCASE_TOKEN, 'W', 'E', 'N', 'D',
FOR_TOKEN, 'F', 'O', 'R',
- TO_TOKEN, 'T', 'O',
- DOWNTO_TOKEN, 'D', 'O', 'W', 'N', 'T', 'O',
- STEP_TOKEN, 'S', 'T', 'E', 'P',
+ TO_TOKEN, 'T', 'O',
+ DOWNTO_TOKEN, 'D', 'O', 'W', 'N', 'T', 'O',
+ STEP_TOKEN, 'S', 'T', 'E', 'P',
NEXT_TOKEN, 'N', 'E', 'X', 'T',
REPEAT_TOKEN, 'R', 'E', 'P', 'E', 'A', 'T',
- UNTIL_TOKEN, 'U', 'N', 'T', 'I', 'L',
- BREAK_TOKEN, 'B', 'R', 'E', 'A', 'K',
- CONTINUE_TOKEN, 'C', 'O', 'N', 'T', 'I', 'N', 'U', 'E',
- ASM_TOKEN, 'A', 'S', 'M',
- DEF_TOKEN, 'D', 'E', 'F',
- EXPORT_TOKEN, 'E', 'X', 'P', 'O', 'R', 'T',
- IMPORT_TOKEN, 'I', 'M', 'P', 'O', 'R', 'T',
+ UNTIL_TOKEN, 'U', 'N', 'T', 'I', 'L',
+ BREAK_TOKEN, 'B', 'R', 'E', 'A', 'K',
+ CONTINUE_TOKEN, 'C', 'O', 'N', 'T', 'I', 'N', 'U', 'E',
+ ASM_TOKEN, 'A', 'S', 'M',
+ DEF_TOKEN, 'D', 'E', 'F',
+ EXPORT_TOKEN, 'E', 'X', 'P', 'O', 'R', 'T',
+ IMPORT_TOKEN, 'I', 'M', 'P', 'O', 'R', 'T',
INCLUDE_TOKEN, 'I', 'N', 'C', 'L', 'U', 'D', 'E',
RETURN_TOKEN, 'R', 'E', 'T', 'U', 'R', 'N',
END_TOKEN, 'E', 'N', 'D',
- DONE_TOKEN, 'D', 'O', 'N', 'E',
+ DONE_TOKEN, 'D', 'O', 'N', 'E',
LOGIC_NOT_TOKEN, 'N', 'O', 'T',
LOGIC_AND_TOKEN, 'A', 'N', 'D',
- LOGIC_OR_TOKEN, 'O', 'R',
+ LOGIC_OR_TOKEN, 'O', 'R',
BYTE_TOKEN, 'B', 'Y', 'T', 'E',
- WORD_TOKEN, 'W', 'O', 'R', 'D',
+ WORD_TOKEN, 'W', 'O', 'R', 'D',
CONST_TOKEN, 'C', 'O', 'N', 'S', 'T',
STRUC_TOKEN, 'S', 'T', 'R', 'U', 'C',
PREDEF_TOKEN, 'P', 'R', 'E', 'D', 'E', 'F',
- SYSFLAGS_TOKEN, 'S', 'Y', 'S', 'F', 'L', 'A', 'G', 'S',
+ SYSFLAGS_TOKEN, 'S', 'Y', 'S', 'F', 'L', 'A', 'G', 'S',
EOL_TOKEN
};
+extern int outflags;
+
void parse_error(const char *errormsg)
{
char *error_carrot = statement;
@@ -75,7 +67,18 @@ void parse_error(const char *errormsg)
fprintf(stderr, "^\nError: %s\n", errormsg);
exit(1);
}
+void parse_warn(const char *warnmsg)
+{
+ if (outflags & WARNINGS)
+ {
+ char *error_carrot = statement;
+ fprintf(stderr, "\n%s %4d: %s\n%*s ", filename, lineno, statement, (int)strlen(filename), "");
+ for (error_carrot = statement; error_carrot != tokenstr; error_carrot++)
+ putc(*error_carrot == '\t' ? '\t' : ' ', stderr);
+ fprintf(stderr, "^\nWarning: %s\n", warnmsg);
+ }
+}
int hexdigit(char ch)
{
ch = toupper(ch);
@@ -103,8 +106,8 @@ t_token scan(void)
else if (*scanpos == '\0' || *scanpos == '\n' || *scanpos == ';')
scantoken = EOL_TOKEN;
else if ((scanpos[0] >= 'a' && scanpos[0] <= 'z')
- || (scanpos[0] >= 'A' && scanpos[0] <= 'Z')
- || (scanpos[0] == '_'))
+ || (scanpos[0] >= 'A' && scanpos[0] <= 'Z')
+ || (scanpos[0] == '_'))
{
/*
* ID, either variable name or reserved word.
@@ -116,9 +119,9 @@ t_token scan(void)
scanpos++;
}
while ((*scanpos >= 'a' && *scanpos <= 'z')
- || (*scanpos >= 'A' && *scanpos <= 'Z')
- || (*scanpos == '_')
- || (*scanpos >= '0' && *scanpos <= '9'));
+ || (*scanpos >= 'A' && *scanpos <= 'Z')
+ || (*scanpos == '_')
+ || (*scanpos >= '0' && *scanpos <= '9'));
scantoken = ID_TOKEN;
tokenlen = scanpos - tokenstr;
/*
@@ -221,65 +224,68 @@ t_token scan(void)
scanpos += 4;
}
}
- else if (scanpos[0] == '\"')
+ else if (scanpos[0] == '\"') // Hack for string quote char in case we have to rewind later
{
- char *scanshift;
int scanoffset;
/*
* String constant.
*/
- scantoken = STRING_TOKEN;
- constval = (long)(uintptr_t)(++scanpos);
+ scantoken = STRING_TOKEN;
+ constval = (long)strpos++;
+ scanpos++;
while (*scanpos && *scanpos != '\"')
{
if (*scanpos == '\\')
{
- scanoffset = 1;
+ scanoffset = 2;
switch (scanpos[1])
{
case 'n':
- *scanpos = 0x0D;
+ *strpos++ = 0x0D;
break;
case 'r':
- *scanpos = 0x0A;
+ *strpos++ = 0x0A;
break;
case 't':
- *scanpos = '\t';
+ *strpos++ = '\t';
break;
case '\'':
- *scanpos = '\'';
+ *strpos++ = '\'';
break;
case '\"':
- *scanpos = '\"';
+ *strpos++ = '\"';
break;
case '\\':
- *scanpos = '\\';
+ *strpos++ = '\\';
break;
case '0':
- *scanpos = '\0';
+ *strpos++ = '\0';
break;
case '$':
if (hexdigit(scanpos[2]) < 0 || hexdigit(scanpos[3]) < 0) {
parse_error("Bad string constant");
return (-1);
}
- *scanpos = hexdigit(scanpos[2]) * 16 + hexdigit(scanpos[3]);
- scanoffset = 3;
+ *strpos++ = hexdigit(scanpos[2]) * 16 + hexdigit(scanpos[3]);
+ scanoffset = 4;
break;
default:
parse_error("Bad string constant");
return (-1);
}
- for (scanshift = scanpos + 1; *scanshift; scanshift++)
- scanshift[0] = scanshift[scanoffset];
+ scanpos += scanoffset;
}
- scanpos++;
+ else
+ *strpos++ = *scanpos++;
}
- if (!*scanpos++)
+ if (!*scanpos)
{
parse_error("Unterminated string");
return (-1);
}
+ *((unsigned char *)constval) = (long)strpos - constval - 1;
+ *strpos++ = '\0';
+ scanpos++;
}
else
{
@@ -398,27 +404,34 @@ void scan_rewind(char *backptr)
}
int scan_lookahead(void)
{
- char *backpos = scanpos;
- char *backstr = tokenstr;
+ char *backscan = scanpos;
+ char *backtkn = tokenstr;
+ char *backstr = strpos;
int prevtoken = scantoken;
- int prevlen = tokenlen;
+ int prevlen = tokenlen;
int look = scan();
- scanpos = backpos;
- tokenstr = backstr;
+ scanpos = backscan;
+ tokenstr = backtkn;
+ strpos = backstr;
scantoken = prevtoken;
tokenlen = prevlen;
return (look);
}
char inputline[512];
+char conststr[1024];
int next_line(void)
{
int len;
t_token token;
char* new_filename;
- if (inputfile == NULL) {
- // First-time init
+ strpos = conststr;
+ if (inputfile == NULL)
+ {
+ /*
+ * First-time init
+ */
inputfile = stdin;
- filename = (char*) "";
+ filename = "";
}
if (*scanpos == ';')
{
@@ -429,11 +442,17 @@ int next_line(void)
{
statement = inputline;
scanpos = inputline;
- // Read next line from the current file, and strip newline from the end.
- if (fgets(inputline, 512, inputfile) == NULL) {
+ /*
+ * Read next line from the current file, and strip newline from the end.
+ */
+ if (fgets(inputline, 512, inputfile) == NULL)
+ {
inputline[0] = 0;
- // At end of file, return to previous file if any, else return EOF_TOKEN
- if (outer_inputfile != NULL) {
+ /*
+ * At end of file, return to previous file if any, else return EOF_TOKEN
+ */
+ if (outer_inputfile != NULL)
+ {
fclose(inputfile);
free(filename);
inputfile = outer_inputfile;
@@ -441,7 +460,8 @@ int next_line(void)
lineno = outer_lineno - 1; // -1 because we're about to incr again
outer_inputfile = NULL;
}
- else {
+ else
+ {
scantoken = EOF_TOKEN;
return EOF_TOKEN;
}
@@ -454,15 +474,20 @@ int next_line(void)
printf("; %s: %04d: %s\n", filename, lineno, inputline);
}
token = scan();
- // Handle single level of file inclusion
- if (token == INCLUDE_TOKEN) {
+ /*
+ * Handle single level of file inclusion
+ */
+ if (token == INCLUDE_TOKEN)
+ {
token = scan();
- if (token != STRING_TOKEN) {
+ if (token != STRING_TOKEN)
+ {
parse_error("Missing include filename");
scantoken = EOF_TOKEN;
return EOF_TOKEN;
}
- if (outer_inputfile != NULL) {
+ if (outer_inputfile != NULL)
+ {
parse_error("Only one level of includes allowed");
scantoken = EOF_TOKEN;
return EOF_TOKEN;
@@ -470,11 +495,11 @@ int next_line(void)
outer_inputfile = inputfile;
outer_filename = filename;
outer_lineno = lineno;
- new_filename = (char*) malloc(tokenlen-1);
- strncpy(new_filename, (char*)(uintptr_t)constval, tokenlen-2);
- new_filename[tokenlen-2] = 0;
+ new_filename = (char *) malloc(*((unsigned char *)constval) + 1);
+ strncpy(new_filename, (char *)(constval + 1), *((unsigned char *)constval) + 1);
inputfile = fopen(new_filename, "r");
- if (inputfile == NULL) {
+ if (inputfile == NULL)
+ {
parse_error("Error opening include file");
scantoken = EOF_TOKEN;
return EOF_TOKEN;
diff --git a/src/toolsrc/lex.h b/src/toolsrc/lex.h
index cf12a95..07033b5 100755
--- a/src/toolsrc/lex.h
+++ b/src/toolsrc/lex.h
@@ -4,6 +4,7 @@ extern int tokenlen;
extern long constval;
extern char inputline[];
void parse_error(const char *errormsg);
+void parse_warn(const char *warnmsg);
int next_line(void);
void scan_rewind(char *backptr);
int scan_lookahead(void);
diff --git a/src/toolsrc/parse.c b/src/toolsrc/parse.c
index a04986a..645242f 100755
--- a/src/toolsrc/parse.c
+++ b/src/toolsrc/parse.c
@@ -1,11 +1,9 @@
#include
-#include "tokens.h"
-#include "symbols.h"
-#include "lex.h"
-#include "codegen.h"
-#include "parse.h"
-
+#include "plasm.h"
+#define LVALUE 0
+#define RVALUE 1
int infunc = 0, break_tag = 0, cont_tag = 0, stack_loop = 0;
+long infuncvals = 0;
t_token prevstmnt;
t_token binary_ops_table[] = {
@@ -221,8 +219,8 @@ int parse_constval(void)
{
case CLOSE_PAREN_TOKEN:
break;
- case STRING_TOKEN:
- size = tokenlen - 1;
+ case STRING_TOKEN:
+ size = 1;
value = constval;
type = STRING_TYPE;
if (mod)
@@ -340,406 +338,347 @@ int parse_const(long *value)
/*
* Normal expression parsing
*/
-int parse_expr(void);
-int parse_term(void)
+t_opseq *parse_expr(t_opseq *codeseq, int *stackdepth);
+t_opseq *parse_list(t_opseq *codeseq, int *stackdepth)
{
- /*
- * Parse terminal tokens.
- */
- switch (scan())
+ int parmdepth;
+ t_opseq *parmseq;
+ if (stackdepth)
+ *stackdepth = 0;
+ while ((parmseq = parse_expr(codeseq, &parmdepth)))
{
- case CHAR_TOKEN:
- case INT_TOKEN:
- case ID_TOKEN:
- case STRING_TOKEN:
+ codeseq = parmseq;
+ if (stackdepth)
+ *stackdepth += parmdepth;
+ if (scantoken != COMMA_TOKEN)
break;
- case OPEN_PAREN_TOKEN:
- if (!parse_expr())
- {
- parse_error("Bad expression in parenthesis");
- return (0);
- }
- if (scantoken != CLOSE_PAREN_TOKEN)
- {
- parse_error("Missing closing parenthesis");
- return (0);
- }
- break;
- default:
- /*
- * Non-terminal token.
- */
- return (0);
}
- return (1);
+ return (codeseq);
}
-int parse_value(int rvalue)
+t_opseq *parse_value(t_opseq *codeseq, int rvalue, int *stackdepth)
{
- int cparams;
int deref = rvalue;
- int optos = opsptr;
- int type = 0, value = 0, emit_value = 0;
- int ref_type, const_size;
- long ref_offset, const_offset;
+ int type = 0, value = 0;
+ int cfnparms = 0;
+ long cfnvals = 1;
+ long const_offset;
+ t_opseq *uopseq = NULL;
+ t_opseq *valseq = NULL;
+ t_opseq *idxseq = NULL;
+
+ if (stackdepth)
+ *stackdepth = 1;
/*
- * Parse pre operand operators.
+ * Parse pre operators.
*/
- while (!parse_term())
+ while (scan())
{
- switch (scantoken)
+ if (scantoken == ADD_TOKEN)
{
- case ADD_TOKEN:
- /*
- * Just ignore unary plus, it is a no-op.
- */
- break;
- case BPTR_TOKEN:
- if (deref)
- push_op(scantoken, 0);
- else
- {
- deref++;
- type |= BPTR_TYPE;
- }
- break;
- case WPTR_TOKEN:
- if (deref)
- push_op(scantoken, 0);
- else
- {
- deref++;
- type |= WPTR_TYPE;
- }
- break;
- case AT_TOKEN:
- deref--;
- break;
- case NEG_TOKEN:
- case COMP_TOKEN:
- case LOGIC_NOT_TOKEN:
- push_op(scantoken, 0);
- break;
- default:
- return (0);
+ /*
+ * Just ignore unary plus, it is a no-op.
+ */
+ }
+ else if (scantoken == AT_TOKEN)
+ {
+ if (deref-- == 0)
+ {
+ parse_error("Invalid ADDRESS-OF op");
+ return (NULL);
+ }
+ }
+ else if (scantoken == BPTR_TOKEN || scantoken == WPTR_TOKEN)
+ {
+ deref++;
+ type |= scantoken == BPTR_TOKEN ? BPTR_TYPE : WPTR_TYPE;
+ }
+ else if (scantoken == NEG_TOKEN || scantoken == COMP_TOKEN || scantoken == LOGIC_NOT_TOKEN)
+ {
+ if (!rvalue)
+ {
+ parse_error("Invalid op for LVALUE");
+ return (NULL);
+ }
+ uopseq = gen_uop(uopseq, scantoken);
}
- }
- /*
- * Determine which terminal type.
- */
- if (scantoken == INT_TOKEN || scantoken == CHAR_TOKEN)
- {
- value = constval;
- type |= CONST_TYPE;
- }
- else if (scantoken == ID_TOKEN)
- {
- if ((type |= id_type(tokenstr, tokenlen)) & CONST_TYPE)
- value = id_const(tokenstr, tokenlen);
- else if (type & VAR_TYPE)
- value = id_tag(tokenstr, tokenlen);
- else if (type & FUNC_TYPE)
- value = id_tag(tokenstr, tokenlen);
else
- {
- printf("Bad ID type\n");
- return (0);
- }
+ break;
}
- else if (scantoken == CLOSE_PAREN_TOKEN)
- {
- // type |= WORD_TYPE;
- emit_value = 1;
- }
- else if (scantoken == STRING_TOKEN)
+ /*
+ * Determine which value type.
+ */
+ if (scantoken == STRING_TOKEN)
{
/*
* This is a special case. Just emit the string and return
*/
- emit_conststr(constval, tokenlen - 1);
+ codeseq = gen_str(codeseq, constval);
scan();
- return WORD_TYPE;
+ return (codeseq);
}
- else
- return (0);
- if (type & CONST_TYPE)
+ if (scantoken == INT_TOKEN || scantoken == CHAR_TOKEN)
{
- /*
- * Quick optimizations
- */
- while ((optos < opsptr)
- && ((tos_op() == NEG_TOKEN) || (tos_op() == COMP_TOKEN) || (tos_op() == LOGIC_NOT_TOKEN)))
+ value = constval;
+ type |= CONST_TYPE;
+ valseq = gen_const(NULL, value);
+ }
+ else if (scantoken == ID_TOKEN)
+ {
+ if ((type |= id_type(tokenstr, tokenlen)) & CONST_TYPE)
{
- switch (pop_op())
- {
- case NEG_TOKEN:
- value = -value;
- break;
- case COMP_TOKEN:
- value = ~value;
- break;
- case LOGIC_NOT_TOKEN:
- value = value ? 0 : -1;
- break;
- }
+ value = id_const(tokenstr, tokenlen);
+ valseq = gen_const(NULL, value);
+ }
+ else //if (type & (VAR_TYPE | FUNC_TYPE))
+ {
+ value = id_tag(tokenstr, tokenlen);
+ if (type & LOCAL_TYPE)
+ valseq = gen_lcladr(NULL, value);
+ else
+ valseq = gen_gbladr(NULL, value, type);
+ }
+ if (type & FUNC_TYPE)
+ {
+ cfnparms = funcparms_cnt(type);
+ cfnvals = funcvals_cnt(type);
}
}
- /*
- * Parse post operand operators.
- */
- ref_type = type & ~PTR_TYPE;
- ref_offset = 0;
- while (scan() == OPEN_PAREN_TOKEN
- || scantoken == OPEN_BRACKET_TOKEN
- || scantoken == PTRB_TOKEN
- || scantoken == PTRW_TOKEN
- || scantoken == DOT_TOKEN
- || scantoken == COLON_TOKEN)
+ else if (scantoken == OPEN_PAREN_TOKEN)
{
- switch (scantoken)
+ if (!(valseq = parse_expr(NULL, stackdepth)))
{
- case OPEN_PAREN_TOKEN:
+ parse_error("Bad expression in parenthesis");
+ return (NULL);
+ }
+ if (scantoken != CLOSE_PAREN_TOKEN)
+ {
+ parse_error("Missing closing parenthesis");
+ return (NULL);
+ }
+ }
+ else
+ return (NULL);
+ /*
+ * Parse post operators.
+ */
+ while (scan())
+ {
+ if (scantoken == OPEN_PAREN_TOKEN)
+ {
+ /*
+ * Function call - parameters generate before call address
+ */
+ valseq = cat_seq(parse_list(NULL, &value), valseq);
+ if (scantoken != CLOSE_PAREN_TOKEN)
+ {
+ parse_error("Missing closing parenthesis");
+ return (NULL);
+ }
+ if (scan() == POUND_TOKEN)
+ {
/*
- * Function call
+ * Override return vals count
*/
- if (emit_value)
+ if (!parse_const(&cfnvals))
{
- if (ref_offset != 0)
- {
- emit_const(ref_offset);
- emit_op(ADD_TOKEN);
- ref_offset = 0;
- }
- if (ref_type & PTR_TYPE)
- (ref_type & BPTR_TYPE) ? emit_lb() : emit_lw();
- if (scan_lookahead() != CLOSE_PAREN_TOKEN)
- emit_push();
- }
- cparams = 0;
- while (parse_expr())
- {
- cparams++;
- if (scantoken != COMMA_TOKEN)
- break;
- }
- if (scantoken != CLOSE_PAREN_TOKEN)
- {
- parse_error("Missing closing parenthesis");
+ parse_error("Invalid def return value count");
return (0);
}
- if (ref_type & (FUNC_TYPE | CONST_TYPE))
- emit_call(value, ref_type);
- else
- {
- if (!emit_value)
- {
- if (type & CONST_TYPE)
- emit_const(value);
- else if (type & VAR_TYPE)
- {
- if (type & LOCAL_TYPE)
- emit_llw(value + ref_offset);
- else
- emit_law(value, ref_offset, type);
- ref_offset = 0;
- }
- }
- else
- if (cparams)
- emit_pull();
- emit_ical();
- }
- emit_value = 1;
- ref_type = 0;
- break;
- case OPEN_BRACKET_TOKEN:
+ }
+ else
+ scan_rewind(tokenstr);
+ if ((type & FUNC_TYPE) && (cfnparms != value))
+ parse_warn("Parameter count mismatch");
+ if (stackdepth)
+ *stackdepth = cfnvals + cfnparms - value;
+ if (type & (VAR_TYPE | PTR_TYPE)) //!(type & (FUNC_TYPE | CONST_TYPE)))
+ {
+ valseq = gen_lw(valseq);
+ if (deref)
+ deref--;
+ }
+ valseq = gen_icall(valseq);
+ if (stackdepth)
+ *stackdepth = cfnvals;
+ cfnvals = 1;
+ type &= ~(FUNC_TYPE | VAR_TYPE);
+ }
+ else if (scantoken == OPEN_BRACKET_TOKEN)
+ {
+ /*
+ * Array of arrays
+ */
+ if (type & FUNC_TYPE)
+ {
/*
- * Array of arrays
+ * Function call dereference
*/
- if (!emit_value)
- {
- if (type & CONST_TYPE)
- emit_const(value);
- else if (type & ADDR_TYPE)
- {
- if (type & LOCAL_TYPE)
- emit_localaddr(value + ref_offset);
- else
- emit_globaladdr(value, ref_offset, type);
- ref_offset = 0;
- }
- else
- {
- parse_error("Bad index reference");
- return (0);
- }
- emit_value = 1;
- }
- else
- {
- if (ref_offset != 0)
- {
- emit_const(ref_offset);
- emit_op(ADD_TOKEN);
- ref_offset = 0;
- }
- }
- while (parse_expr())
- {
- if (scantoken != COMMA_TOKEN)
- break;
- emit_indexword();
- emit_lw();
- }
- if (scantoken != CLOSE_BRACKET_TOKEN)
- {
- parse_error("Missing closing bracket");
- return (0);
- }
- if (ref_type & (WPTR_TYPE | WORD_TYPE))
- {
- emit_indexword();
- ref_type = WPTR_TYPE;
- }
- else
- {
- emit_indexbyte();
- ref_type = BPTR_TYPE;
- }
- break;
- case PTRB_TOKEN:
- case PTRW_TOKEN:
+ valseq = gen_icall(valseq);
+ if (stackdepth)
+ *stackdepth = cfnvals;
+ }
+ while ((idxseq = parse_expr(NULL, stackdepth)))
+ {
+ valseq = cat_seq(valseq, idxseq);
+ if (scantoken != COMMA_TOKEN)
+ break;
+ valseq = gen_idxw(valseq);
+ valseq = gen_lw(valseq);
+ }
+ if (scantoken != CLOSE_BRACKET_TOKEN)
+ {
+ parse_error("Missing closing bracket");
+ return (NULL);
+ }
+ if (type & (WPTR_TYPE | WORD_TYPE))
+ {
+ valseq = gen_idxw(valseq);
+ type = WPTR_TYPE;
+ }
+ else
+ {
+ valseq = gen_idxb(valseq);
+ type = BPTR_TYPE;
+ }
+ }
+ else if (scantoken == PTRB_TOKEN || scantoken == PTRW_TOKEN)
+ {
+ /*
+ * Pointer to structure/array
+ */
+ if (type & FUNC_TYPE)
+ {
+ /*
+ * Function call dereference
+ */
+ valseq = gen_icall(valseq);
+ if (stackdepth)
+ *stackdepth = cfnvals;
+ type &= ~FUNC_TYPE;
+ }
+ else if (type & (VAR_TYPE | PTR_TYPE))
+ {
+ /*
+ * Pointer dereference
+ */
+ valseq = gen_lw(valseq);
+ }
+ type = (scantoken == PTRB_TOKEN) ? BPTR_TYPE : WPTR_TYPE;
+ if (!parse_const(&const_offset))
+ {
+ /*
+ * Setting type override for following operations
+ */
+ scan_rewind(tokenstr);
+ }
+ else if (const_offset != 0)
+ {
/*
* Structure member pointer
*/
- if (!emit_value)
- {
- if (type & CONST_TYPE)
- emit_const(value);
- else if (type & ADDR_TYPE)
- {
- if (type & LOCAL_TYPE)
- (ref_type & BYTE_TYPE) ? emit_llb(value + ref_offset) : emit_llw(value + ref_offset);
- else
- (ref_type & BYTE_TYPE) ? emit_lab(value, ref_offset, type) : emit_law(value, ref_offset, type);
- }
- emit_value = 1;
- }
- else
- {
- if (ref_offset != 0)
- {
- emit_const(ref_offset);
- emit_op(ADD_TOKEN);
- }
- if (ref_type & PTR_TYPE)
- (ref_type & BPTR_TYPE) ? emit_lb() : emit_lw();
- }
- ref_offset = 0;
- ref_type = (scantoken == PTRB_TOKEN) ? BPTR_TYPE : WPTR_TYPE;
- if (!parse_const(&ref_offset))
- scan_rewind(tokenstr);
- if (ref_offset != 0)
- {
- emit_const(ref_offset);
- emit_op(ADD_TOKEN);
- ref_offset = 0;
- }
- break;
- case DOT_TOKEN:
- case COLON_TOKEN:
+ valseq = gen_const(valseq, const_offset);
+ valseq = gen_op(valseq, ADD_TOKEN);
+ }
+ }
+ else if (scantoken == DOT_TOKEN || scantoken == COLON_TOKEN)
+ {
+ /*
+ * Structure/array offset
+ */
+ if (type & FUNC_TYPE)
+ {
+ /*
+ * Function call dereference
+ */
+ valseq = gen_icall(valseq);
+ if (stackdepth)
+ *stackdepth = cfnvals;
+ type &= ~FUNC_TYPE;
+ }
+ type = (type & (VAR_TYPE | CONST_TYPE))
+ ? ((scantoken == DOT_TOKEN) ? BYTE_TYPE : WORD_TYPE)
+ : ((scantoken == DOT_TOKEN) ? BPTR_TYPE : WPTR_TYPE);
+ if (!parse_const(&const_offset))
+ {
+ /*
+ * Setting type override for following operations
+ */
+ scan_rewind(tokenstr);
+ }
+ else if (const_offset != 0)
+ {
/*
* Structure member offset
*/
- ref_type = (ref_type & (VAR_TYPE | CONST_TYPE))
- ? ((scantoken == DOT_TOKEN) ? BYTE_TYPE : WORD_TYPE)
- : ((scantoken == DOT_TOKEN) ? BPTR_TYPE : WPTR_TYPE);
- if (parse_const(&const_offset))
- ref_offset += const_offset;
- else
- scan_rewind(tokenstr);
- if (!emit_value)
- {
- if (type & CONST_TYPE)
- {
- value += ref_offset;
- ref_offset = 0;
- }
- else if (type & FUNC_TYPE)
- {
- emit_globaladdr(value, ref_offset, type);
- ref_offset = 0;
- emit_value = 1;
- }
- }
- break;
- }
- }
- if (emit_value)
- {
- if (ref_offset != 0)
- {
- emit_const(ref_offset);
- emit_op(ADD_TOKEN);
- ref_offset = 0;
- }
- if (deref)
- {
- if (ref_type & BPTR_TYPE) emit_lb();
- else if (ref_type & WPTR_TYPE) emit_lw();
- }
- }
- else
- {
- if (deref)
- {
- if (type & CONST_TYPE)
- {
- emit_const(value);
- if (ref_type & VAR_TYPE)
- (ref_type & BYTE_TYPE) ? emit_lb() : emit_lw();
- }
- else if (type & FUNC_TYPE)
- emit_call(value, ref_type);
- else if (type & VAR_TYPE)
- {
- if (type & LOCAL_TYPE)
- (ref_type & BYTE_TYPE) ? emit_llb(value + ref_offset) : emit_llw(value + ref_offset);
- else
- (ref_type & BYTE_TYPE) ? emit_lab(value, ref_offset, ref_type) : emit_law(value, ref_offset, ref_type);
+ valseq = gen_const(valseq, const_offset);
+ valseq = gen_op(valseq, ADD_TOKEN);
}
}
else
- {
- if (type & CONST_TYPE)
- emit_const(value);
- else if (type & ADDR_TYPE)
- {
- if (type & LOCAL_TYPE)
- emit_localaddr(value + ref_offset);
- else
- emit_globaladdr(value, ref_offset, ref_type);
- }
- }
+ break;
}
- while (optos < opsptr)
+ /*
+ * Resolve outstanding dereference pointer loads
+ */
+ while (deref > rvalue)
{
- if (!emit_unaryop(pop_op()))
+ deref--;
+ if (type & FUNC_TYPE)
{
- parse_error(": Invalid unary operation");
- return (0);
+ valseq = gen_icall(valseq);
+ if (stackdepth)
+ *stackdepth = cfnvals;
+ type &= ~FUNC_TYPE;
+ }
+ else if (type & VAR_TYPE)
+ valseq = gen_lw(valseq);
+ }
+ if (deref)
+ {
+ if (type & FUNC_TYPE)
+ {
+ valseq = gen_icall(valseq);
+ if (stackdepth)
+ *stackdepth = cfnvals;
+ type &= ~FUNC_TYPE;
+ }
+ else if (type & (BYTE_TYPE | BPTR_TYPE))
+ valseq = gen_lb(valseq);
+ else if (type & (WORD_TYPE | WPTR_TYPE))
+ valseq = gen_lw(valseq);
+ }
+ /*
+ * Output pre-operations
+ */
+ valseq = cat_seq(valseq, uopseq);
+ /*
+ * Wrap up LVALUE store
+ */
+ if (!rvalue)
+ {
+ if (type & (BYTE_TYPE | BPTR_TYPE))
+ valseq = gen_sb(valseq);
+ else if (type & (WORD_TYPE | WPTR_TYPE))
+ valseq = gen_sw(valseq);
+ else
+ {
+ release_seq(valseq);
+ return (NULL); // Function or const cannot be LVALUE, must be RVALUE
}
}
- if (type & PTR_TYPE)
- ref_type = type;
- return (ref_type ? ref_type : WORD_TYPE);
+ return (cat_seq(codeseq, valseq));
}
-int parse_expr()
+t_opseq *parse_expr(t_opseq *codeseq, int *stackdepth)
{
int prevmatch;
int matchop = 0;
int optos = opsptr;
- int i;
+ int i, valdepth;
int prevtype, type = 0;
+ t_opseq *valseq;
+
+ if (stackdepth)
+ *stackdepth = 0;
do
{
/*
@@ -747,43 +686,87 @@ int parse_expr()
*/
prevmatch = matchop;
matchop = 0;
- if (parse_value(1))
+ if ((valseq = parse_value(NULL, RVALUE, &valdepth)))
{
+ codeseq = cat_seq(codeseq, valseq);
matchop = 1;
+ if (stackdepth)
+ *stackdepth += valdepth;
for (i = 0; i < sizeof(binary_ops_table); i++)
if (scantoken == binary_ops_table[i])
{
matchop = 2;
if (binary_ops_precedence[i] >= tos_op_prec(optos))
- if (!emit_op(pop_op()))
- {
- parse_error(": Invalid binary operation");
- return (0);
- }
+ {
+ codeseq = gen_op(codeseq, pop_op());
+ if (stackdepth)
+ (*stackdepth)--;
+ }
push_op(scantoken, binary_ops_precedence[i]);
break;
}
}
- }
- while (matchop == 2);
+ } while (matchop == 2);
if (matchop == 0 && prevmatch == 2)
{
parse_error("Missing operand");
- return (0);
+ return (NULL);
}
while (optos < opsptr)
- if (!emit_op(pop_op()))
- {
- parse_error(": Invalid binary operation");
- return (0);
- }
- return (matchop || prevmatch);
+ {
+ codeseq = gen_op(codeseq, pop_op());
+ if (stackdepth)
+ (*stackdepth)--;
+ }
+ return (codeseq);
+}
+t_opseq *parse_set(t_opseq *codeseq)
+{
+ char *setptr = tokenstr;
+ int lparms = 0, rparms = 0;
+ int i;
+ t_opseq *setseq[16], *rseq = NULL;
+
+ while ((setseq[lparms] = parse_value(NULL, LVALUE, NULL)))
+ {
+ lparms++;
+ if (scantoken != COMMA_TOKEN)
+ break;
+ }
+ if (lparms == 0 || scantoken != SET_TOKEN)
+ {
+ tokenstr = setptr;
+ scan_rewind(tokenstr);
+ while (lparms--)
+ release_seq(setseq[lparms]);
+ return (NULL);
+ }
+ rseq = parse_list(NULL, &rparms);
+ if (lparms > rparms)
+ {
+ parse_error("Set value list underflow");
+ return (NULL);
+ }
+ if ((lparms != rparms) && (rparms - lparms != 1))
+ codeseq = gen_pushexp(codeseq);
+ codeseq = cat_seq(codeseq, rseq);
+ for (i = lparms - 1; i >= 0; i--)
+ codeseq = cat_seq(codeseq, setseq[i]);
+ if (lparms != rparms)
+ {
+ if (rparms - lparms == 1)
+ codeseq = gen_drop(codeseq);
+ else
+ codeseq = gen_pullexp(codeseq);
+ }
+ return (codeseq);
}
int parse_stmnt(void)
{
int tag_prevbrk, tag_prevcnt, tag_else, tag_endif, tag_while, tag_wend, tag_repeat, tag_for, tag_choice, tag_of;
- int type, addr, step;
+ int type, addr, step, cfnvals;
char *idptr;
+ t_opseq *seq;
/*
* Optimization for last function LEAVE and OF clause.
@@ -793,30 +776,32 @@ int parse_stmnt(void)
switch (scantoken)
{
case IF_TOKEN:
- if (!parse_expr())
+ if (!(seq = parse_expr(NULL, NULL)))
{
parse_error("Bad expression");
return (0);
}
tag_else = tag_new(BRANCH_TYPE);
tag_endif = tag_new(BRANCH_TYPE);
- emit_brfls(tag_else);
+ seq = gen_brfls(seq, tag_else);
+ emit_seq(seq);
scan();
- do {
+ do
+ {
while (parse_stmnt()) next_line();
if (scantoken != ELSEIF_TOKEN)
break;
emit_brnch(tag_endif);
emit_codetag(tag_else);
- if (!parse_expr())
+ if (!(seq = parse_expr(NULL, NULL)))
{
parse_error("Bad expression");
return (0);
}
tag_else = tag_new(BRANCH_TYPE);
- emit_brfls(tag_else);
- }
- while (1);
+ seq = gen_brfls(seq, tag_else);
+ emit_seq(seq);
+ } while (1);
if (scantoken == ELSE_TOKEN)
{
emit_brnch(tag_endif);
@@ -844,13 +829,14 @@ int parse_stmnt(void)
tag_prevbrk = break_tag;
break_tag = tag_wend;
emit_codetag(tag_while);
- if (!parse_expr())
+ if (!(seq = parse_expr(NULL, NULL)))
{
parse_error("Bad expression");
return (0);
}
- emit_brfls(tag_wend);
- while (parse_stmnt()) next_line();
+ seq = gen_brfls(seq, tag_wend);
+ emit_seq(seq);
+ while (parse_stmnt()) next_line();
if (scantoken != LOOP_TOKEN)
{
parse_error("Missing WHILE/END");
@@ -877,12 +863,13 @@ int parse_stmnt(void)
}
emit_codetag(cont_tag);
cont_tag = tag_prevcnt;
- if (!parse_expr())
+ if (!(seq = parse_expr(NULL, NULL)))
{
parse_error("Bad expression");
return (0);
}
- emit_brfls(tag_repeat);
+ seq = gen_brfls(seq, tag_repeat);
+ emit_seq(seq);
emit_codetag(break_tag);
break_tag = tag_prevbrk;
break;
@@ -905,7 +892,7 @@ int parse_stmnt(void)
parse_error("Missing FOR =");
return (0);
}
- if (!parse_expr())
+ if (!emit_seq(parse_expr(NULL, NULL)))
{
parse_error("Bad FOR expression");
return (0);
@@ -914,7 +901,7 @@ int parse_stmnt(void)
if (type & LOCAL_TYPE)
type & BYTE_TYPE ? emit_dlb(addr) : emit_dlw(addr);
else
- type & BYTE_TYPE ? emit_dab(addr, type) : emit_daw(addr, type);
+ type & BYTE_TYPE ? emit_dab(addr, 0, type) : emit_daw(addr, 0, type);
if (scantoken == TO_TOKEN)
step = 1;
else if (scantoken == DOWNTO_TOKEN)
@@ -924,7 +911,7 @@ int parse_stmnt(void)
parse_error("Missing FOR TO");
return (0);
}
- if (!parse_expr())
+ if (!emit_seq(parse_expr(NULL, NULL)))
{
parse_error("Bad FOR TO expression");
return (0);
@@ -932,7 +919,7 @@ int parse_stmnt(void)
step > 0 ? emit_brgt(break_tag) : emit_brlt(break_tag);
if (scantoken == STEP_TOKEN)
{
- if (!parse_expr())
+ if (!emit_seq(parse_expr(NULL, NULL)))
{
parse_error("Bad FOR STEP expression");
return (0);
@@ -960,7 +947,7 @@ int parse_stmnt(void)
break_tag = tag_new(BRANCH_TYPE);
tag_choice = tag_new(BRANCH_TYPE);
tag_of = tag_new(BRANCH_TYPE);
- if (!parse_expr())
+ if (!emit_seq(parse_expr(NULL, NULL)))
{
parse_error("Bad CASE expression");
return (0);
@@ -970,7 +957,7 @@ int parse_stmnt(void)
{
if (scantoken == OF_TOKEN)
{
- if (!parse_expr())
+ if (!emit_seq(parse_expr(NULL, NULL)))
{
parse_error("Bad CASE OF expression");
return (0);
@@ -1037,13 +1024,17 @@ int parse_stmnt(void)
int i;
for (i = 0; i < stack_loop; i++)
emit_drop();
- if (!parse_expr())
+ cfnvals = 0;
+ emit_seq(parse_list(NULL, &cfnvals));
+ if (cfnvals != infuncvals)
+ parse_warn("Inconsistent return value count");
+ while (cfnvals++ < infuncvals)
emit_const(0);
emit_leave();
}
else
{
- if (!parse_expr())
+ if (!emit_seq(parse_expr(NULL, NULL)))
emit_const(0);
emit_ret();
}
@@ -1064,123 +1055,46 @@ int parse_stmnt(void)
case DONE_TOKEN:
case DEF_TOKEN:
return (0);
- case ID_TOKEN:
- idptr = tokenstr;
- type = id_type(tokenstr, tokenlen);
- addr = id_tag(tokenstr, tokenlen);
- if (type & VAR_TYPE)
- {
- int elem_type = type;
- long elem_offset = 0;
- if (scan() == DOT_TOKEN || scantoken == COLON_TOKEN)
- {
- /*
- * Structure member offset
- */
- int elem_size;
- elem_type = (scantoken == DOT_TOKEN) ? BYTE_TYPE : WORD_TYPE;
- if (!parse_const(&elem_offset))
- scantoken = ID_TOKEN;
- else
- scan();
- }
- if (scantoken == SET_TOKEN)
- {
- if (!parse_expr())
- {
- parse_error("Bad expression");
- return (0);
- }
- if (type & LOCAL_TYPE)
- (elem_type & BYTE_TYPE) ? emit_slb(addr + elem_offset) : emit_slw(addr + elem_offset);
- else
- (elem_type & BYTE_TYPE) ? emit_sab(addr, elem_offset, type) : emit_saw(addr, elem_offset, type);
- break;
- }
- else if (scantoken == INC_TOKEN || scantoken == DEC_TOKEN)
- {
- if (type & LOCAL_TYPE)
- {
- if (elem_type & BYTE_TYPE)
- {
- emit_llb(addr + elem_offset); emit_unaryop(scantoken); emit_slb(addr + elem_offset);
- }
- else
- {
- emit_llw(addr + elem_offset); emit_unaryop(scantoken); emit_slw(addr + elem_offset);
- }
- }
- else
- {
- if (elem_type & BYTE_TYPE)
- {
- emit_lab(addr, elem_offset, type); emit_unaryop(scantoken); emit_sab(addr, elem_offset, type);
- }
- else
- {
- emit_law(addr, elem_offset, type); emit_unaryop(scantoken); emit_saw(addr, elem_offset, type);
- }
- }
- break;
- }
- }
- else if (type & FUNC_TYPE)
- {
- if (scan() == EOL_TOKEN)
- {
- emit_call(addr, type);
- emit_drop();
- break;
- }
- }
- tokenstr = idptr;
default:
scan_rewind(tokenstr);
- if ((type = parse_value(0)) != 0)
+ if (!emit_seq(parse_set(NULL)))
{
- if (scantoken == SET_TOKEN)
+ t_opseq *rseq;
+ int stackdepth = 0;
+ idptr = tokenstr;
+ if ((rseq = parse_value(NULL, RVALUE, &stackdepth)))
{
- if (!parse_expr())
+ if (scantoken == INC_TOKEN || scantoken == DEC_TOKEN)
{
- parse_error("Bad expression");
+ emit_seq(rseq);
+ emit_unaryop(scantoken);
+ tokenstr = idptr;
+ scan_rewind(tokenstr);
+ emit_seq(parse_value(NULL, LVALUE, NULL));
+ }
+ else if (scantoken != SET_TOKEN)
+ {
+ if (stackdepth > 1)
+ {
+ rseq = cat_seq(gen_pushexp(NULL), rseq);
+ rseq = cat_seq(rseq, gen_pullexp(NULL));
+ }
+ else if (stackdepth == 1)
+ rseq = cat_seq(rseq, gen_drop(NULL));
+ emit_seq(rseq);
+ }
+ else
+ {
+ parse_error("Invalid LVALUE");
return (0);
}
- if (type & LOCAL_TYPE)
- (type & (BYTE_TYPE | BPTR_TYPE)) ? emit_sb() : emit_sw();
- else
- (type & (BYTE_TYPE | BPTR_TYPE)) ? emit_sb() : emit_sw();
- }
- else if (scantoken == INC_TOKEN || scantoken == DEC_TOKEN)
- {
- if (type & (BYTE_TYPE | BPTR_TYPE))
- {
- emit_dup();
- emit_lb();
- emit_unaryop(scantoken);
- emit_sb();
- }
- else
- {
- emit_dup();
- emit_lw();
- emit_unaryop(scantoken);
- emit_sw();
- }
}
else
{
- if (type & BPTR_TYPE)
- emit_lb();
- else if (type & WPTR_TYPE)
- emit_lw();
- emit_drop();
+ parse_error("Syntax error");
+ return (0);
}
}
- else
- {
- parse_error("Syntax error");
- return (0);
- }
}
if (scan() != EOL_TOKEN && scantoken != COMMENT_TOKEN)
{
@@ -1327,7 +1241,8 @@ int parse_struc(void)
int parse_vars(int type)
{
long value;
- int idlen, size;
+ int idlen, size, cfnparms;
+ long cfnvals;
char *idstr;
switch (scantoken)
@@ -1412,20 +1327,80 @@ int parse_vars(int type)
type |= PREDEF_TYPE;
idstr = tokenstr;
idlen = tokenlen;
- idfunc_add(tokenstr, tokenlen, type, tag_new(type));
- while (scan() == COMMA_TOKEN)
+ cfnparms = 0;
+ cfnvals = 1; // Default to one return value for compatibility
+ if (scan() == OPEN_PAREN_TOKEN)
+ {
+ do
+ {
+ if (scan() == ID_TOKEN)
+ {
+ cfnparms++;
+ scan();
+ }
+ } while (scantoken == COMMA_TOKEN);
+ if (scantoken != CLOSE_PAREN_TOKEN)
+ {
+ parse_error("Bad function parameter list");
+ return (0);
+ }
+ scan();
+ }
+ if (scantoken == POUND_TOKEN)
+ {
+ if (!parse_const(&cfnvals))
+ {
+ parse_error("Invalid def return value count");
+ return (0);
+ }
+ scan();
+ }
+ type |= funcparms_type(cfnparms) | funcvals_type(cfnvals);
+ idfunc_add(idstr, idlen, type, tag_new(type));
+ while (scantoken == COMMA_TOKEN)
{
if (scan() == ID_TOKEN)
{
idstr = tokenstr;
idlen = tokenlen;
- idfunc_add(tokenstr, tokenlen, type, tag_new(type));
+ type &= ~FUNC_PARMVALS;
+ cfnparms = 0;
+ cfnvals = 1; // Default to one return value for compatibility
+ if (scan() == OPEN_PAREN_TOKEN)
+ {
+ do
+ {
+ if (scan() == ID_TOKEN)
+ {
+ cfnparms++;
+ scan();
+ }
+ } while (scantoken == COMMA_TOKEN);
+ if (scantoken != CLOSE_PAREN_TOKEN)
+ {
+ parse_error("Bad function parameter list");
+ return (0);
+ }
+ scan();
+ }
+ if (scantoken == POUND_TOKEN)
+ {
+ if (!parse_const(&cfnvals))
+ {
+ parse_error("Invalid def return value count");
+ return (0);
+ }
+ scan();
+ }
+ type |= funcparms_type(cfnparms) | funcvals_type(cfnvals);
+ idfunc_add(idstr, idlen, type, tag_new(type));
}
else
{
parse_error("Bad function pre-declaration");
return (0);
}
+ //scan();
}
}
else
@@ -1471,8 +1446,8 @@ int parse_mods(void)
}
int parse_defs(void)
{
- char c;
- int func_tag, cfnparms, type = GLOBAL_TYPE;
+ char c, *idstr;
+ int idlen, func_tag, cfnparms, cfnvals, type = GLOBAL_TYPE, pretype;
static char bytecode = 0;
if (scantoken == EXPORT_TOKEN)
{
@@ -1493,29 +1468,15 @@ int parse_defs(void)
emit_bytecode_seg();
bytecode = 1;
cfnparms = 0;
+ infuncvals = 1; // Defaut to one return value for compatibility
infunc = 1;
type |= DEF_TYPE;
- if (idglobal_lookup(tokenstr, tokenlen) >= 0)
- {
- if (!(id_type(tokenstr, tokenlen) & PREDEF_TYPE))
- {
- parse_error("Mismatch function type");
- return (0);
- }
- emit_idfunc(id_tag(tokenstr, tokenlen), PREDEF_TYPE, tokenstr);
- func_tag = tag_new(type);
- idfunc_set(tokenstr, tokenlen, type, func_tag); // Override any predef type & tag
- }
- else
- {
- func_tag = tag_new(type);
- idfunc_add(tokenstr, tokenlen, type, func_tag);
- }
- c = tokenstr[tokenlen];
- tokenstr[tokenlen] = '\0';
- emit_idfunc(func_tag, type, tokenstr);
- emit_def(tokenstr, 1);
- tokenstr[tokenlen] = c;
+ idstr = tokenstr;
+ idlen = tokenlen;
+ idlocal_reset();
+ /*
+ * Parse parameters and return value count
+ */
if (scan() == OPEN_PAREN_TOKEN)
{
do
@@ -1534,6 +1495,42 @@ int parse_defs(void)
}
scan();
}
+ if (scantoken == POUND_TOKEN)
+ {
+ if (!parse_const(&infuncvals))
+ {
+ parse_error("Invalid def return value count");
+ return (0);
+ }
+ scan();
+ }
+ type |= funcparms_type(cfnparms) | funcvals_type(infuncvals);
+ if (idglobal_lookup(idstr, idlen) >= 0)
+ {
+ pretype = id_type(idstr, idlen);
+ if (!(pretype & PREDEF_TYPE))
+ {
+ parse_error("Mismatch function type");
+ return (0);
+ }
+ if ((pretype & FUNC_PARMVALS) != (type & FUNC_PARMVALS))
+ parse_warn("Mismatch function params/return values");
+ emit_idfunc(id_tag(idstr, idlen), PREDEF_TYPE, idstr, 0);
+ func_tag = tag_new(type);
+ idfunc_set(idstr, idlen, type, func_tag); // Override any predef type & tag
+ }
+ else
+ {
+ func_tag = tag_new(type);
+ idfunc_add(idstr, idlen, type, func_tag);
+ }
+ c = idstr[idlen];
+ idstr[idlen] = '\0';
+ emit_idfunc(func_tag, type, idstr, 1);
+ idstr[idlen] = c;
+ /*
+ * Parse local vars
+ */
while (parse_vars(LOCAL_TYPE)) next_line();
emit_enter(cfnparms);
prevstmnt = 0;
@@ -1551,7 +1548,10 @@ int parse_defs(void)
}
if (prevstmnt != RETURN_TOKEN)
{
- emit_const(0);
+ if (infuncvals)
+ parse_warn("Inconsistent return value count");
+ for (cfnvals = 0; cfnvals < infuncvals; cfnvals++)
+ emit_const(0);
emit_leave();
}
return (1);
@@ -1569,29 +1569,12 @@ int parse_defs(void)
return (0);
}
cfnparms = 0;
+ infuncvals = 1; // Defaut to one return value for compatibility
infunc = 1;
type |= ASM_TYPE;
- if (idglobal_lookup(tokenstr, tokenlen) >= 0)
- {
- if (!(id_type(tokenstr, tokenlen) & PREDEF_TYPE))
- {
- parse_error("Mismatch function type");
- return (0);
- }
- emit_idfunc(id_tag(tokenstr, tokenlen), PREDEF_TYPE, tokenstr);
- func_tag = tag_new(type);
- idfunc_set(tokenstr, tokenlen, type, func_tag); // Override any predef type & tag
- }
- else
- {
- func_tag = tag_new(type);
- idfunc_add(tokenstr, tokenlen, type, func_tag);
- }
- c = tokenstr[tokenlen];
- tokenstr[tokenlen] = '\0';
- emit_idfunc(func_tag, type, tokenstr);
- emit_def(tokenstr, 0);
- tokenstr[tokenlen] = c;
+ idstr = tokenstr;
+ idlen = tokenlen;
+ idlocal_reset();
if (scan() == OPEN_PAREN_TOKEN)
{
do
@@ -1599,7 +1582,6 @@ int parse_defs(void)
if (scan() == ID_TOKEN)
{
cfnparms++;
- idlocal_add(tokenstr, tokenlen, WORD_TYPE, 2);
scan();
}
}
@@ -1611,6 +1593,39 @@ int parse_defs(void)
}
scan();
}
+ if (scantoken == POUND_TOKEN)
+ {
+ if (!parse_const(&infuncvals))
+ {
+ parse_error("Invalid def return value count");
+ return (0);
+ }
+ scan();
+ }
+ type |= funcparms_type(cfnparms) | funcvals_type(infuncvals);
+ if (idglobal_lookup(idstr, idlen) >= 0)
+ {
+ pretype = id_type(idstr, idlen);
+ if (!(pretype & PREDEF_TYPE))
+ {
+ parse_error("Mismatch function type");
+ return (0);
+ }
+ if ((pretype & FUNC_PARMVALS) != (type & FUNC_PARMVALS))
+ parse_warn("Mismatch function params/return values");
+ emit_idfunc(id_tag(idstr, idlen), PREDEF_TYPE, idstr, 0);
+ func_tag = tag_new(type);
+ idfunc_set(idstr, idlen, type, func_tag); // Override any predef type & tag
+ }
+ else
+ {
+ func_tag = tag_new(type);
+ idfunc_add(idstr, idlen, type, func_tag);
+ }
+ c = idstr[idlen];
+ idstr[idlen] = '\0';
+ emit_idfunc(func_tag, type, idstr, 0);
+ idstr[idlen] = c;
do
{
if (scantoken == EOL_TOKEN || scantoken == COMMENT_TOKEN)
@@ -1640,7 +1655,8 @@ int parse_module(void)
{
emit_bytecode_seg();
emit_start();
- emit_def("_INIT", 1);
+ idlocal_reset();
+ emit_idfunc(0, 0, NULL, 1);
prevstmnt = 0;
while (parse_stmnt()) next_line();
if (scantoken != DONE_TOKEN)
diff --git a/src/toolsrc/plasm.c b/src/toolsrc/plasm.c
index 2416456..d111694 100755
--- a/src/toolsrc/plasm.c
+++ b/src/toolsrc/plasm.c
@@ -1,8 +1,7 @@
#include
-#include "tokens.h"
-#include "lex.h"
-#include "codegen.h"
-#include "parse.h"
+#include "plasm.h"
+
+int outflags = 0;
int main(int argc, char **argv)
{
@@ -10,23 +9,28 @@ int main(int argc, char **argv)
for (i = 1; i < argc; i++)
{
if (argv[i][0] == '-')
- {
+ {
j = 1;
while (argv[i][j])
{
switch(argv[i][j++])
{
case 'A':
- flags |= ACME;
+ outflags |= ACME;
break;
case 'M':
- flags |= MODULE;
+ outflags |= MODULE;
break;
+ case 'O':
+ outflags |= OPTIMIZE;
+ break;
+ case 'W':
+ outflags |= WARNINGS;
}
}
}
}
- emit_flags(flags);
+ emit_flags(outflags);
if (parse_module())
{
fprintf(stderr, "Compilation complete.\n");
diff --git a/src/toolsrc/plasm.h b/src/toolsrc/plasm.h
new file mode 100755
index 0000000..f3c4432
--- /dev/null
+++ b/src/toolsrc/plasm.h
@@ -0,0 +1,16 @@
+/*
+ * Global flags.
+ */
+#define ACME (1<<0)
+#define MODULE (1<<1)
+#define OPTIMIZE (1<<2)
+#define BYTECODE_SEG (1<<3)
+#define INIT (1<<4)
+#define SYSFLAGS (1<<5)
+#define WARNINGS (1<<6)
+extern int outflags;
+#include "tokens.h"
+#include "lex.h"
+#include "symbols.h"
+#include "parse.h"
+#include "codegen.h"
diff --git a/src/toolsrc/sb.pla b/src/toolsrc/sb.pla
index 360e10b..34a76e6 100644
--- a/src/toolsrc/sb.pla
+++ b/src/toolsrc/sb.pla
@@ -90,7 +90,7 @@ word = $0450,$04D0,$0550,$05D0,$0650,$06D0,$0750,$07D0
// Editor variables
//
byte nullstr = ""
-byte version = "PLASMA ][ SANDBOX VERSION 00.95"
+byte version = "PLASMA ][ SANDBOX VERSION 00.96"
byte errorstr = "ERROR: $"
byte okstr = "OK"
byte outofmem = "OUT OF MEMORY!"
diff --git a/src/toolsrc/symbols.h b/src/toolsrc/symbols.h
index 4fd5251..5828901 100755
--- a/src/toolsrc/symbols.h
+++ b/src/toolsrc/symbols.h
@@ -10,7 +10,7 @@
#define DEF_TYPE (1 << 4)
#define BRANCH_TYPE (1 << 5)
#define LOCAL_TYPE (1 << 6)
-#define EXTERN_TYPE (1 << 7)
+#define EXTERN_TYPE (1 << 7)
#define ADDR_TYPE (VAR_TYPE | FUNC_TYPE | EXTERN_TYPE)
#define WPTR_TYPE (1 << 8)
#define BPTR_TYPE (1 << 9)
@@ -18,8 +18,16 @@
#define STRING_TYPE (1 << 10)
#define TAG_TYPE (1 << 11)
#define EXPORT_TYPE (1 << 12)
-#define PREDEF_TYPE (1 << 13)
+#define PREDEF_TYPE (1 << 13)
#define FUNC_TYPE (ASM_TYPE | DEF_TYPE | PREDEF_TYPE)
+#define FUNC_PARMS (0x0F << 16)
+#define FUNC_VALS (0x0F << 20)
+#define FUNC_PARMVALS (FUNC_PARMS|FUNC_VALS)
+#define funcparms_type(p) (((p)&0x0F)<<16)
+#define funcparms_cnt(t) (((t)>>16)&0x0F)
+#define funcvals_type(v) (((v)&0x0F)<<20)
+#define funcvals_cnt(t) (((t)>>20)&0x0F)
+
int id_match(char *name, int len, char *id);
int idlocal_lookup(char *name, int len);
int idglobal_lookup(char *name, int len);
@@ -27,6 +35,7 @@ int idconst_lookup(char *name, int len);
int idlocal_add(char *name, int len, int type, int size);
int idglobal_add(char *name, int len, int type, int size);
int id_add(char *name, int len, int type, int size);
+void idlocal_reset(void);
int idfunc_set(char *name, int len, int type, int tag);
int idfunc_add(char *name, int len, int type, int tag);
int idconst_add(char *name, int len, int value);
diff --git a/src/vmsrc/a1cmd.pla b/src/vmsrc/a1cmd.pla
old mode 100644
new mode 100755
index 2c90ca4..ed61cb1
--- a/src/vmsrc/a1cmd.pla
+++ b/src/vmsrc/a1cmd.pla
@@ -39,7 +39,7 @@ predef loadmod, execmod, lookupstrmod
//
// System variables.
//
-word version = $0092 // 00.92
+word version = $0099 // 00.99
word systemflags = 0
word heap
word symtbl, lastsym
@@ -89,19 +89,19 @@ byte loadstr[] = "MODLOAD"
byte execstr[] = "MODEXEC"
byte modadrstr[] = "MODADDR"
byte argstr[] = "ARGS"
-word exports[] = @sysstr, @syscall
-word = @callstr, @call
-word = @putcstr, @cout
+word exports[] = @sysstr, @syscall
+word = @callstr, @call
+word = @putcstr, @cout
word = @putlnstr, @crout
-word = @putsstr, @prstr
-word = @getcstr, @cin
-word = @getsstr, @rdstr
-word = @hpmarkstr, @markheap
-word = @hpallocstr,@allocheap
-word = @hpalignstr,@allocalignheap
-word = @hprelstr, @releaseheap
-word = @memsetstr, @memset
-word = @memcpystr, @memcpy
+word = @putsstr, @prstr
+word = @getcstr, @cin
+word = @getsstr, @rdstr
+word = @hpmarkstr, @markheap
+word = @hpallocstr,@allocheap
+word = @hpalignstr,@allocalignheap
+word = @hprelstr, @releaseheap
+word = @memsetstr, @memset
+word = @memcpystr, @memcpy
word = @uisgtstr, @uword_isgt
word = @uisgestr, @uword_isge
word = @uisltstr, @uword_islt
@@ -112,48 +112,48 @@ word = @modadrstr, @lookupstrmod
word = @machidstr, @machid
word = @argstr, @cmdptr
word = 0
-word syslibsym = @exports
+word syslibsym = @exports
//
// CALL CFFA1 API ENTRYPOINT
// SYSCALL(CMD)
//
asm syscall
- LDA ESTKL,X
- STX ESP
- TAX
- JSR $900C
- LDX ESP
- LDY #$00
- STA ESTKL,X
- STY ESTKH,X
- RTS
+ LDA ESTKL,X
+ STX ESP
+ TAX
+ JSR $900C
+ LDX ESP
+ LDY #$00
+ STA ESTKL,X
+ STY ESTKH,X
+ RTS
end
//
// CALL 6502 ROUTINE
-// CALL(AREG, XREG, YREG, STATUS, ADDR)
+// CALL(ADDR, AREG, XREG, YREG, STATUS)
//
asm call
-REGVALS = SRC
PHP
- LDA ESTKL,X
- STA TMPL
- LDA ESTKH,X
- STA TMPH
- INX
+ LDA ESTKL+4,X
+ STA CALL6502+1
+ LDA ESTKH+4,X
+ STA CALL6502+2
LDA ESTKL,X
PHA
- INX
- LDY ESTKL,X
- INX
LDA ESTKL+1,X
+ TAY
+ LDA ESTKL+3,X
PHA
- LDA ESTKL,X
+ LDA ESTKL+2,X
+ INX
+ INX
+ INX
INX
STX ESP
TAX
PLA
PLP
- JSR JMPTMP
+CALL6502 JSR $FFFF
PHP
STA REGVALS+0
STX REGVALS+1
@@ -167,13 +167,13 @@ REGVALS = SRC
STY ESTKH,X
PLP
RTS
-JMPTMP JMP (TMP)
+REGVALS !FILL 4
end
//
// QUIT TO MONITOR
//
asm quit
- JMP $9000
+ JMP $9000
end
//
// SET MEMORY TO VALUE
@@ -181,177 +181,177 @@ end
// With optimizations from Peter Ferrie
//
asm memset
- LDA ESTKL+2,X
- STA DSTL
- LDA ESTKH+2,X
- STA DSTH
- LDY ESTKL,X
- BEQ +
- INC ESTKH,X
- LDY #$00
-+ LDA ESTKH,X
- BEQ SETMEX
-SETMLPL CLC
- LDA ESTKL+1,X
-SETMLPH STA (DST),Y
- DEC ESTKL,X
- BEQ ++
-- INY
- BEQ +
--- BCS SETMLPL
- SEC
- LDA ESTKH+1,X
- BCS SETMLPH
-+ INC DSTH
- BNE --
-++ DEC ESTKH,X
- BNE -
-SETMEX INX
- INX
- RTS
+ LDA ESTKL+2,X
+ STA DSTL
+ LDA ESTKH+2,X
+ STA DSTH
+ LDY ESTKL,X
+ BEQ +
+ INC ESTKH,X
+ LDY #$00
++ LDA ESTKH,X
+ BEQ SETMEX
+SETMLPL CLC
+ LDA ESTKL+1,X
+SETMLPH STA (DST),Y
+ DEC ESTKL,X
+ BEQ ++
+- INY
+ BEQ +
+-- BCS SETMLPL
+ SEC
+ LDA ESTKH+1,X
+ BCS SETMLPH
++ INC DSTH
+ BNE --
+++ DEC ESTKH,X
+ BNE -
+SETMEX INX
+ INX
+ RTS
end
//
// COPY MEMORY
// MEMCPY(DSTADDR, SRCADDR, SIZE)
//
asm memcpy
- INX
- INX
- LDA ESTKL-2,X
- ORA ESTKH-2,X
- BEQ CPYMEX
- LDA ESTKL-1,X
- CMP ESTKL,X
- LDA ESTKH-1,X
- SBC ESTKH,X
- BCC REVCPY
+ INX
+ INX
+ LDA ESTKL-2,X
+ ORA ESTKH-2,X
+ BEQ CPYMEX
+ LDA ESTKL-1,X
+ CMP ESTKL,X
+ LDA ESTKH-1,X
+ SBC ESTKH,X
+ BCC REVCPY
;
; FORWARD COPY
;
- LDA ESTKL,X
- STA DSTL
- LDA ESTKH,X
- STA DSTH
- LDA ESTKL-1,X
- STA SRCL
- LDA ESTKH-1,X
- STA SRCH
- LDY ESTKL-2,X
- BEQ FORCPYLP
- INC ESTKH-2,X
- LDY #$00
-FORCPYLP LDA (SRC),Y
- STA (DST),Y
- INY
- BNE +
- INC DSTH
- INC SRCH
-+ DEC ESTKL-2,X
- BNE FORCPYLP
- DEC ESTKH-2,X
- BNE FORCPYLP
- RTS
+ LDA ESTKL,X
+ STA DSTL
+ LDA ESTKH,X
+ STA DSTH
+ LDA ESTKL-1,X
+ STA SRCL
+ LDA ESTKH-1,X
+ STA SRCH
+ LDY ESTKL-2,X
+ BEQ FORCPYLP
+ INC ESTKH-2,X
+ LDY #$00
+FORCPYLP LDA (SRC),Y
+ STA (DST),Y
+ INY
+ BNE +
+ INC DSTH
+ INC SRCH
++ DEC ESTKL-2,X
+ BNE FORCPYLP
+ DEC ESTKH-2,X
+ BNE FORCPYLP
+ RTS
;
; REVERSE COPY
;
-REVCPY ;CLC
- LDA ESTKL-2,X
- ADC ESTKL,X
- STA DSTL
- LDA ESTKH-2,X
- ADC ESTKH,X
- STA DSTH
- CLC
- LDA ESTKL-2,X
- ADC ESTKL-1,X
- STA SRCL
- LDA ESTKH-2,X
- ADC ESTKH-1,X
- STA SRCH
- DEC DSTH
- DEC SRCH
- LDY #$FF
- LDA ESTKL-2,X
- BEQ REVCPYLP
- INC ESTKH-2,X
-REVCPYLP LDA (SRC),Y
- STA (DST),Y
- DEY
- CPY #$FF
- BNE +
- DEC DSTH
- DEC SRCH
-+ DEC ESTKL-2,X
- BNE REVCPYLP
- DEC ESTKH-2,X
- BNE REVCPYLP
-CPYMEX RTS
+REVCPY ;CLC
+ LDA ESTKL-2,X
+ ADC ESTKL,X
+ STA DSTL
+ LDA ESTKH-2,X
+ ADC ESTKH,X
+ STA DSTH
+ CLC
+ LDA ESTKL-2,X
+ ADC ESTKL-1,X
+ STA SRCL
+ LDA ESTKH-2,X
+ ADC ESTKH-1,X
+ STA SRCH
+ DEC DSTH
+ DEC SRCH
+ LDY #$FF
+ LDA ESTKL-2,X
+ BEQ REVCPYLP
+ INC ESTKH-2,X
+REVCPYLP LDA (SRC),Y
+ STA (DST),Y
+ DEY
+ CPY #$FF
+ BNE +
+ DEC DSTH
+ DEC SRCH
++ DEC ESTKL-2,X
+ BNE REVCPYLP
+ DEC ESTKH-2,X
+ BNE REVCPYLP
+CPYMEX RTS
end
//
// Unsigned word comparisons.
//
asm uword_isge
- LDA ESTKL+1,X
- CMP ESTKL,X
- LDA ESTKH+1,X
- SBC ESTKH,X
- LDA #$FF
- ADC #$00
- EOR #$FF
- STA ESTKL+1,X
- STA ESTKH+1,X
- INX
- RTS
+ LDA ESTKL+1,X
+ CMP ESTKL,X
+ LDA ESTKH+1,X
+ SBC ESTKH,X
+ LDA #$FF
+ ADC #$00
+ EOR #$FF
+ STA ESTKL+1,X
+ STA ESTKH+1,X
+ INX
+ RTS
end
asm uword_isle
- LDA ESTKL,X
- CMP ESTKL+1,X
- LDA ESTKH,X
- SBC ESTKH+1,X
- LDA #$FF
- ADC #$00
- EOR #$FF
- STA ESTKL+1,X
- STA ESTKH+1,X
- INX
- RTS
+ LDA ESTKL,X
+ CMP ESTKL+1,X
+ LDA ESTKH,X
+ SBC ESTKH+1,X
+ LDA #$FF
+ ADC #$00
+ EOR #$FF
+ STA ESTKL+1,X
+ STA ESTKH+1,X
+ INX
+ RTS
end
asm uword_isgt
- LDA ESTKL,X
- CMP ESTKL+1,X
- LDA ESTKH,X
- SBC ESTKH+1,X
- LDA #$FF
- ADC #$00
- STA ESTKL+1,X
- STA ESTKH+1,X
- INX
- RTS
+ LDA ESTKL,X
+ CMP ESTKL+1,X
+ LDA ESTKH,X
+ SBC ESTKH+1,X
+ LDA #$FF
+ ADC #$00
+ STA ESTKL+1,X
+ STA ESTKH+1,X
+ INX
+ RTS
end
asm uword_islt
- LDA ESTKL+1,X
- CMP ESTKL,X
- LDA ESTKH+1,X
- SBC ESTKH,X
- LDA #$FF
- ADC #$00
- STA ESTKL+1,X
- STA ESTKH+1,X
- INX
- RTS
+ LDA ESTKL+1,X
+ CMP ESTKL,X
+ LDA ESTKH+1,X
+ SBC ESTKH,X
+ LDA #$FF
+ ADC #$00
+ STA ESTKL+1,X
+ STA ESTKH+1,X
+ INX
+ RTS
end
//
// Addresses of internal routines.
//
asm interp
- DEX
- LDA #IINTERP
- STA ESTKH,X
- RTS
+ DEX
+ LDA #IINTERP
+ STA ESTKH,X
+ RTS
end
-//
+//
// A DCI string is one that has the high bit set for every character except the last.
// More efficient than C or Pascal strings.
//
@@ -367,28 +367,28 @@ end
// return len
//end
asm dcitos
- LDA ESTKL,X
- STA DSTL
- LDA ESTKH,X
- STA DSTH
- LDA ESTKL+1,X
- STA SRCL
- LDA ESTKH+1,X
- STA SRCH
- LDY #$00
-- LDA (SRC),Y
- CMP #$80
- AND #$7F
- INY
- STA (DST),Y
- BCS -
- TYA
- LDY #$00
- STA (DST),Y
- INX
- STA ESTKL,X
- STY ESTKH,X
- RTS
+ LDA ESTKL,X
+ STA DSTL
+ LDA ESTKH,X
+ STA DSTH
+ LDA ESTKL+1,X
+ STA SRCL
+ LDA ESTKH+1,X
+ STA SRCH
+ LDY #$00
+- LDA (SRC),Y
+ CMP #$80
+ AND #$7F
+ INY
+ STA (DST),Y
+ BCS -
+ TYA
+ LDY #$00
+ STA (DST),Y
+ INX
+ STA ESTKL,X
+ STY ESTKH,X
+ RTS
end
//def stodci(str, dci)
// byte len, c
@@ -400,50 +400,50 @@ end
// len = len - 1
// (dci).[len] = c
// while len
-// c = toupper((str).[len]) | $80
-// len = len - 1
-// (dci).[len] = c
+// c = toupper((str).[len]) | $80
+// len = len - 1
+// (dci).[len] = c
// loop
// return ^str
//end
asm stodci
- LDA ESTKL,X
- STA DSTL
- LDA ESTKH,X
- STA DSTH
- LDA ESTKL+1,X
- STA SRCL
- LDA ESTKH+1,X
- STA SRCH
- INX
- LDY #$00
- LDA (SRC),Y
- BEQ ++
- TAY
- LDA (SRC),Y
- JSR TOUPR
- BNE +
-- LDA (SRC),Y
- JSR TOUPR
- ORA #$80
-+ DEY
- STA (DST),Y
- BNE -
- LDA (SRC),Y
-++ STA ESTKL,X
- STY ESTKH,X
- RTS
+ LDA ESTKL,X
+ STA DSTL
+ LDA ESTKH,X
+ STA DSTH
+ LDA ESTKL+1,X
+ STA SRCL
+ LDA ESTKH+1,X
+ STA SRCH
+ INX
+ LDY #$00
+ LDA (SRC),Y
+ BEQ ++
+ TAY
+ LDA (SRC),Y
+ JSR TOUPR
+ BNE +
+- LDA (SRC),Y
+ JSR TOUPR
+ ORA #$80
++ DEY
+ STA (DST),Y
+ BNE -
+ LDA (SRC),Y
+++ STA ESTKL,X
+ STY ESTKH,X
+ RTS
end
asm toupper
- LDA ESTKL,X
-TOUPR AND #$7F
- CMP #'a'
- BCC +
- CMP #'z'+1
- BCS +
- SBC #$1F
-+ STA ESTKL,X
- RTS
+ LDA ESTKL,X
+TOUPR AND #$7F
+ CMP #'a'
+ BCC +
+ CMP #'z'+1
+ BCS +
+ SBC #$1F
++ STA ESTKL,X
+ RTS
end
//
// Module symbols are entered into the symbol table
@@ -462,25 +462,25 @@ end
// return dci
//end
asm modtosym
- LDA ESTKL+1,X
- STA SRCL
- LDA ESTKH+1,X
- STA SRCH
- LDA ESTKL,X
- STA ESTKL+1,X
- STA DSTL
- LDA ESTKH,X
- STA ESTKH+1,X
- STA DSTH
- INX
- LDY #$00
- LDA #'#'+$80
-- STA (DST),Y
- ASL
- LDA (SRC),Y
- INY
- BCS -
- RTS
+ LDA ESTKL+1,X
+ STA SRCL
+ LDA ESTKH+1,X
+ STA SRCH
+ LDA ESTKL,X
+ STA ESTKL+1,X
+ STA DSTL
+ LDA ESTKH,X
+ STA ESTKH+1,X
+ STA DSTH
+ INX
+ LDY #$00
+ LDA #'#'+$80
+- STA (DST),Y
+ ASL
+ LDA (SRC),Y
+ INY
+ BCS -
+ RTS
end
//
// Lookup routines.
@@ -503,66 +503,66 @@ end
// loop
// return 0
asm lookuptbl
- LDA ESTKL,X
- STA DSTL
- LDA ESTKH,X
- STA DSTH
- LDA ESTKL+1,X
- STA SRCL
- LDA ESTKH+1,X
- STA SRCH
- LDY #$00
-- LDA (DST),Y
- BEQ +
- CMP (SRC),Y
- BNE ++
- INY
- ASL
- BCS -
- LDA (DST),Y
- PHA
- INY
- LDA (DST),Y
- TAY
- PLA
-+ INX
- STA ESTKL,X
- STY ESTKH,X
- RTS
-++ LDY #$00
--- LDA (DST),Y
- INC DSTL
- BEQ +
---- ASL
- BCS --
- LDA #$02
- ADC DSTL
- STA DSTL
- BCC -
- INC DSTH
- BCS -
-+ INC DSTH
- BNE ---
+ LDA ESTKL,X
+ STA DSTL
+ LDA ESTKH,X
+ STA DSTH
+ LDA ESTKL+1,X
+ STA SRCL
+ LDA ESTKH+1,X
+ STA SRCH
+ LDY #$00
+- LDA (DST),Y
+ BEQ +
+ CMP (SRC),Y
+ BNE ++
+ INY
+ ASL
+ BCS -
+ LDA (DST),Y
+ PHA
+ INY
+ LDA (DST),Y
+ TAY
+ PLA
++ INX
+ STA ESTKL,X
+ STY ESTKH,X
+ RTS
+++ LDY #$00
+-- LDA (DST),Y
+ INC DSTL
+ BEQ +
+--- ASL
+ BCS --
+ LDA #$02
+ ADC DSTL
+ STA DSTL
+ BCC -
+ INC DSTH
+ BCS -
++ INC DSTH
+ BNE ---
end
//
// CONSOLE I/O
//
asm cout
- LDA ESTKL,X
- JSR TOUPR
- ORA #$80
- JMP $FFEF
+ LDA ESTKL,X
+ JSR TOUPR
+ ORA #$80
+ JMP $FFEF
end
asm cin
- DEX
-- LDA $D011
- BPL -
- LDA $D010
- AND #$7F
- STA ESTKL,X
- LDA #$00
- STA ESTKH,X
- RTS
+ DEX
+- LDA $D011
+ BPL -
+ LDA $D010
+ AND #$7F
+ STA ESTKL,X
+ LDA #$00
+ STA ESTKH,X
+ RTS
end
def crout
return cout($0D)
@@ -572,7 +572,7 @@ def prstr(str)
i = 1
while i <= ^str
cout((str)[i])
- i = i + 1
+ i = i + 1
loop
end
def rdstr(prompt)
@@ -582,47 +582,47 @@ def rdstr(prompt)
cout(prompt)
repeat
ch = cin
- when ch
- is $15 // right arrow
- if inbuff.0 < maxlen
- inbuff.0 = inbuff.0 + 1
- ch = inbuff[inbuff.0]
- cout(ch)
- fin
- is $08 // left arrow
- if inbuff.0
- cout('\\')
- cout(inbuff[inbuff.0])
- inbuff.0 = inbuff.0 - 1
- fin
- is $04 // ctrl-d
- if inbuff.0
- cout('#')
- cout(inbuff[inbuff.0])
- memcpy(inbuff + inbuff.0, inbuff + inbuff.0 + 1, maxlen - inbuff.0)
- maxlen = maxlen - 1
- inbuff.0 = inbuff.0 - 1
- fin
- is $0C // ctrl-l
- crout
- prstr(inbuff)
- is $0D // return
- is $18 // ctrl-x
- crout
- inbuff.0 = 0
- is $9B // escape
- inbuff.0 = 0
- ch = $0D
- otherwise
- if ch >= ' '
- cout(ch)
- inbuff.0 = inbuff.0 + 1
- inbuff[inbuff.0] = ch
- if inbuff.0 > maxlen
- maxlen = inbuff.0
- fin
- fin
- wend
+ when ch
+ is $15 // right arrow
+ if inbuff.0 < maxlen
+ inbuff.0 = inbuff.0 + 1
+ ch = inbuff[inbuff.0]
+ cout(ch)
+ fin
+ is $08 // left arrow
+ if inbuff.0
+ cout('\\')
+ cout(inbuff[inbuff.0])
+ inbuff.0 = inbuff.0 - 1
+ fin
+ is $04 // ctrl-d
+ if inbuff.0
+ cout('#')
+ cout(inbuff[inbuff.0])
+ memcpy(inbuff + inbuff.0, inbuff + inbuff.0 + 1, maxlen - inbuff.0)
+ maxlen = maxlen - 1
+ inbuff.0 = inbuff.0 - 1
+ fin
+ is $0C // ctrl-l
+ crout
+ prstr(inbuff)
+ is $0D // return
+ is $18 // ctrl-x
+ crout
+ inbuff.0 = 0
+ is $9B // escape
+ inbuff.0 = 0
+ ch = $0D
+ otherwise
+ if ch >= ' '
+ cout(ch)
+ inbuff.0 = inbuff.0 + 1
+ inbuff[inbuff.0] = ch
+ if inbuff.0 > maxlen
+ maxlen = inbuff.0
+ fin
+ fin
+ wend
until ch == $0D or inbuff.0 == $7F
cout($0D)
return inbuff
@@ -650,7 +650,7 @@ end
def finddirentry(filename)
*CFFAFileName = filename
perr = syscall($14)
- return *CFFAEntryPtr
+ return *CFFAEntryPtr
end
def readfile(filename, buffer)
*CFFADest = buffer
@@ -735,12 +735,12 @@ def lookupextern(esd, index)
esd = esd + dcitos(esd, @str)
if esd->0 & $10 and esd->1 == index
addr = lookupsym(sym)
- if !addr
+ if !addr
perr = $81
- cout('?')
- prstr(@str)
- crout
- fin
+ cout('?')
+ prstr(@str)
+ crout
+ fin
return addr
fin
esd = esd + 3
@@ -783,12 +783,12 @@ def loadmod(mod)
fin
if rdlen > 0
readfile(@filename, heap)
- memcpy(@header, heap, 128)
- modsize = header:0
- moddep = @header.1
- defofst = modsize
+ memcpy(@header, heap, 128)
+ modsize = header:0
+ moddep = @header.1
+ defofst = modsize
init = 0
- if rdlen > 4 and heap=>2 == $DA7E // DAVE = magic number :-)
+ if rdlen > 4 and heap=>2 == $DA7F // DAVE+1 = magic number :-)
//
// This is an EXTended RELocatable (data+bytecode) module.
//
@@ -796,44 +796,46 @@ def loadmod(mod)
defcnt = header:8
init = header:10
moddep = @header.12
- //
- // Load module dependencies.
- //
+ //
+ // Load module dependencies.
+ //
while ^moddep
if !lookupmod(moddep)
if loadmod(moddep) < 0
- return -perr
- fin
+ return -perr
+ fin
fin
moddep = moddep + dcitos(moddep, @str)
loop
- //
- // Init def table.
- //
- deftbl = allocheap(defcnt * 5 + 1)
- deflast = deftbl
- ^deflast = 0
- //
- // Re-read file
- //
- readfile(@filename, heap)
+ //
+ // Init def table.
+ //
+ deftbl = allocheap(defcnt * 5 + 1)
+ deflast = deftbl
+ ^deflast = 0
+ //
+ // Re-read file
+ //
+ readfile(@filename, heap)
+ else
+ return -69
fin
- //
- // Alloc heap space for relocated module (data + bytecode).
- //
- moddep = moddep + 1 - @header + heap
- modfix = moddep - (heap + 2) // Adjust to skip header
- modsize = modsize - modfix
- rdlen = rdlen - modfix - 2
- modaddr = allocheap(modsize)
- memcpy(modaddr, moddep, rdlen)
- //
- // Add module to symbol table.
- //
- addmod(mod, modaddr)
- //
- // Apply all fixups and symbol import/export.
- //
+ //
+ // Alloc heap space for relocated module (data + bytecode).
+ //
+ moddep = moddep + 1 - @header + heap
+ modfix = moddep - (heap + 2) // Adjust to skip header
+ modsize = modsize - modfix
+ rdlen = rdlen - modfix - 2
+ modaddr = allocheap(modsize)
+ memcpy(modaddr, moddep, rdlen)
+ //
+ // Add module to symbol table.
+ //
+ addmod(mod, modaddr)
+ //
+ // Apply all fixups and symbol import/export.
+ //
modfix = modaddr - modfix
bytecode = defofst + modfix - MODADDR
modend = modaddr + modsize
@@ -841,28 +843,28 @@ def loadmod(mod)
esd = rld // Extern+Entry Symbol Directory
while ^esd // Scan to end of ESD
esd = esd + 4
- loop
+ loop
esd = esd + 1
//
// Run through the Re-Location Dictionary.
//
while ^rld
if ^rld == $02
- //
- // This is a bytcode def entry - add it to the def directory.
- //
+ //
+ // This is a bytcode def entry - add it to the def directory.
+ //
adddef(rld=>1 - defofst + bytecode, @deflast)
else
addr = rld=>1 + modfix
if uword_isge(addr, modaddr) // Skip fixups to header
if ^rld & $80 // WORD sized fixup.
fixup = *addr
- else // BYTE sized fixup.
+ else // BYTE sized fixup.
fixup = ^addr
fin
if ^rld & $10 // EXTERN reference.
fixup = fixup + lookupextern(esd, rld->3)
- else // INTERN fixup.
+ else // INTERN fixup.
fixup = fixup + modfix - MODADDR
if uword_isge(fixup, bytecode)
//
@@ -873,28 +875,28 @@ def loadmod(mod)
fin
if ^rld & $80 // WORD sized fixup.
*addr = fixup
- else // BYTE sized fixup.
+ else // BYTE sized fixup.
^addr = fixup
fin
fin
fin
rld = rld + 4
loop
- //
+ //
// Run through the External/Entry Symbol Directory.
- //
+ //
while ^esd
sym = esd
esd = esd + dcitos(esd, @str)
if ^esd & $08
- //
+ //
// EXPORT symbol - add it to the global symbol table.
- //
+ //
addr = esd=>1 + modfix - MODADDR
if uword_isge(addr, bytecode)
- //
- // Use the def directory address for bytecode.
- //
+ //
+ // Use the def directory address for bytecode.
+ //
addr = lookupdef(addr - bytecode + bytecode, deftbl)
fin
addsym(sym, addr)
@@ -910,13 +912,13 @@ def loadmod(mod)
//
fixup = 0
if init
- fixup = adddef(init - defofst + bytecode, @deflast)()
- if fixup < 0
- perr = -fixup
- fin
- if !(systemflags & modinitkeep)
+ fixup = adddef(init - defofst + bytecode, @deflast)()
+ if fixup < 0
+ perr = -fixup
+ fin
+ if !(systemflags & modinitkeep)
modend = init - defofst + bytecode
- fin
+ fin
fin
//
// Free up the end-of-module in main memory.
@@ -948,9 +950,9 @@ def striptrail(strptr)
for i = 1 to ^strptr
if (strptr)[i] == ' '
- ^strptr = i - 1
- return
- fin
+ ^strptr = i - 1
+ return
+ fin
next
end
def parsecmd(strptr)
@@ -973,14 +975,14 @@ def execmod(modfile)
perr = 1
if stodci(modfile, @moddci)
saveheap = heap
- savesym = lastsym
- saveflags = systemflags
- if loadmod(@moddci) < modkeep
- lastsym = savesym
- heap = saveheap
- fin
- ^lastsym = 0
- systemflags = saveflags
+ savesym = lastsym
+ saveflags = systemflags
+ if loadmod(@moddci) < modkeep
+ lastsym = savesym
+ heap = saveheap
+ fin
+ ^lastsym = 0
+ systemflags = saveflags
fin
return -perr
end
@@ -1031,24 +1033,24 @@ while 1
if ^cmdptr
when toupper(parsecmd(cmdptr))
is 'Q'
- quit
- is 'M'
- syscall($02)
- break
- is '+'
- execmod(cmdptr)
- break
- otherwise
- prstr(@huhstr)
+ quit
+ is 'M'
+ syscall($02)
+ break
+ is '+'
+ execmod(cmdptr)
+ break
+ otherwise
+ prstr(@huhstr)
wend
if perr
prstr(@errorstr)
- prbyte(perr)
- perr = 0
+ prbyte(perr)
+ perr = 0
else
prstr(@okstr)
fin
- crout()
+ crout()
fin
prstr(@prompt)
cmdptr = rdstr($BA)
diff --git a/src/vmsrc/cmd.pla b/src/vmsrc/cmd.pla
old mode 100644
new mode 100755
index 89b1969..14c9201
--- a/src/vmsrc/cmd.pla
+++ b/src/vmsrc/cmd.pla
@@ -33,7 +33,7 @@ predef loadmod, execmod, lookupstrmod
//
// System variable.
//
-word version = $0093 // 00.93
+word version = $0099 // 00.99
word systemflags = 0
word heap
word xheap = $0800
@@ -68,19 +68,19 @@ byte modadrstr = "MODADDR"
byte argstr = "ARGS"
byte autorun = "AUTORUN"
byte prefix[] // overlay with exported symbols table
-word exports = @sysstr, @syscall
-word = @callstr, @call
-word = @putcstr, @cout
+word exports = @sysstr, @syscall
+word = @callstr, @call
+word = @putcstr, @cout
word = @putlnstr, @crout
-word = @putsstr, @prstr
-word = @getcstr, @cin
-word = @getsstr, @rdstr
-word = @hpmarkstr, @markheap
-word = @hpallocstr,@allocheap
-word = @hpalignstr,@allocalignheap
-word = @hprelstr, @releaseheap
-word = @memsetstr, @memset
-word = @memcpystr, @memcpy
+word = @putsstr, @prstr
+word = @getcstr, @cin
+word = @getsstr, @rdstr
+word = @hpmarkstr, @markheap
+word = @hpallocstr,@allocheap
+word = @hpalignstr,@allocalignheap
+word = @hprelstr, @releaseheap
+word = @memsetstr, @memset
+word = @memcpystr, @memcpy
word = @uisgtstr, @uword_isgt
word = @uisgestr, @uword_isge
word = @uisltstr, @uword_islt
@@ -101,27 +101,27 @@ word syslibsym = @exports
// SYSCALL(CMD, PARAMS)
//
asm syscall
- LDA ESTKL,X
- LDY ESTKH,X
- STA PARAMS
- STY PARAMS+1
- INX
- LDA ESTKL,X
- STA CMD
- JSR $BF00
-CMD: !BYTE 00
-PARAMS: !WORD 0000
- LDY #$00
- STA ESTKL,X
- STY ESTKH,X
- RTS
+ LDA ESTKL,X
+ LDY ESTKH,X
+ STA PARAMS
+ STY PARAMS+1
+ INX
+ LDA ESTKL,X
+ STA CMD
+ JSR $BF00
+CMD: !BYTE 00
+PARAMS: !WORD 0000
+ LDY #$00
+ STA ESTKL,X
+ STY ESTKH,X
+ RTS
end
//
// CALL 6502 ROUTINE
// CALL(ADDR, AREG, XREG, YREG, STATUS)
//
asm call
-REGVALS = SRC
+REGVALS = SRC
PHP
LDA ESTKL+4,X
STA TMPL
@@ -137,7 +137,7 @@ REGVALS = SRC
INX
INX
INX
- INX
+ INX
STX ESP
TAX
PLA
@@ -158,29 +158,29 @@ REGVALS = SRC
STY ESTKH,X
PLP
RTS
-JMPTMP JMP (TMP)
+JMPTMP JMP (TMP)
end
//
// CALL LOADED SYSTEM PROGRAM
//
asm exec
- LDX #$00
- STX IFPL
- LDA #$BF
- STA IFPH
- LDX #$FE
- TXS
- LDX #ESTKSZ/2
- BIT ROMEN
- JMP $2000
+ LDX #$00
+ STX IFPL
+ LDA #$BF
+ STA IFPH
+ LDX #$FE
+ TXS
+ LDX #ESTKSZ/2
+ BIT ROMEN
+ JMP $2000
end
//
// EXIT
//
asm reboot
- BIT ROMEN
- DEC $03F4 ; INVALIDATE POWER-UP BYTE
- JMP ($FFFC) ; RESET
+ BIT ROMEN
+ DEC $03F4 ; INVALIDATE POWER-UP BYTE
+ JMP ($FFFC) ; RESET
end
//
// SET MEMORY TO VALUE
@@ -188,111 +188,111 @@ end
// With optimizations from Peter Ferrie
//
asm memset
- LDA ESTKL+2,X
- STA DSTL
- LDA ESTKH+2,X
- STA DSTH
- LDY ESTKL,X
- BEQ +
- INC ESTKH,X
- LDY #$00
-+ LDA ESTKH,X
- BEQ SETMEX
-SETMLPL CLC
- LDA ESTKL+1,X
-SETMLPH STA (DST),Y
- DEC ESTKL,X
- BEQ ++
-- INY
- BEQ +
--- BCS SETMLPL
- SEC
- LDA ESTKH+1,X
- BCS SETMLPH
-+ INC DSTH
- BNE --
-++ DEC ESTKH,X
- BNE -
-SETMEX INX
- INX
- RTS
+ LDA ESTKL+2,X
+ STA DSTL
+ LDA ESTKH+2,X
+ STA DSTH
+ LDY ESTKL,X
+ BEQ +
+ INC ESTKH,X
+ LDY #$00
++ LDA ESTKH,X
+ BEQ SETMEX
+SETMLPL CLC
+ LDA ESTKL+1,X
+SETMLPH STA (DST),Y
+ DEC ESTKL,X
+ BEQ ++
+- INY
+ BEQ +
+-- BCS SETMLPL
+ SEC
+ LDA ESTKH+1,X
+ BCS SETMLPH
++ INC DSTH
+ BNE --
+++ DEC ESTKH,X
+ BNE -
+SETMEX INX
+ INX
+ RTS
end
//
// COPY MEMORY
// MEMCPY(DSTADDR, SRCADDR, SIZE)
//
asm memcpy
- INX
- INX
- LDA ESTKL-2,X
- ORA ESTKH-2,X
- BEQ CPYMEX
- LDA ESTKL-1,X
- CMP ESTKL,X
- LDA ESTKH-1,X
- SBC ESTKH,X
- BCC REVCPY
+ INX
+ INX
+ LDA ESTKL-2,X
+ ORA ESTKH-2,X
+ BEQ CPYMEX
+ LDA ESTKL-1,X
+ CMP ESTKL,X
+ LDA ESTKH-1,X
+ SBC ESTKH,X
+ BCC REVCPY
;
; FORWARD COPY
;
- LDA ESTKL,X
- STA DSTL
- LDA ESTKH,X
- STA DSTH
- LDA ESTKL-1,X
- STA SRCL
- LDA ESTKH-1,X
- STA SRCH
- LDY ESTKL-2,X
- BEQ FORCPYLP
- INC ESTKH-2,X
- LDY #$00
-FORCPYLP LDA (SRC),Y
- STA (DST),Y
- INY
- BNE +
- INC DSTH
- INC SRCH
-+ DEC ESTKL-2,X
- BNE FORCPYLP
- DEC ESTKH-2,X
- BNE FORCPYLP
- RTS
+ LDA ESTKL,X
+ STA DSTL
+ LDA ESTKH,X
+ STA DSTH
+ LDA ESTKL-1,X
+ STA SRCL
+ LDA ESTKH-1,X
+ STA SRCH
+ LDY ESTKL-2,X
+ BEQ FORCPYLP
+ INC ESTKH-2,X
+ LDY #$00
+FORCPYLP LDA (SRC),Y
+ STA (DST),Y
+ INY
+ BNE +
+ INC DSTH
+ INC SRCH
++ DEC ESTKL-2,X
+ BNE FORCPYLP
+ DEC ESTKH-2,X
+ BNE FORCPYLP
+ RTS
;
; REVERSE COPY
;
-REVCPY ;CLC
- LDA ESTKL-2,X
- ADC ESTKL,X
- STA DSTL
- LDA ESTKH-2,X
- ADC ESTKH,X
- STA DSTH
- CLC
- LDA ESTKL-2,X
- ADC ESTKL-1,X
- STA SRCL
- LDA ESTKH-2,X
- ADC ESTKH-1,X
- STA SRCH
- DEC DSTH
- DEC SRCH
- LDY #$FF
- LDA ESTKL-2,X
- BEQ REVCPYLP
- INC ESTKH-2,X
-REVCPYLP LDA (SRC),Y
- STA (DST),Y
- DEY
- CPY #$FF
- BNE +
- DEC DSTH
- DEC SRCH
-+ DEC ESTKL-2,X
- BNE REVCPYLP
- DEC ESTKH-2,X
- BNE REVCPYLP
-CPYMEX RTS
+REVCPY ;CLC
+ LDA ESTKL-2,X
+ ADC ESTKL,X
+ STA DSTL
+ LDA ESTKH-2,X
+ ADC ESTKH,X
+ STA DSTH
+ CLC
+ LDA ESTKL-2,X
+ ADC ESTKL-1,X
+ STA SRCL
+ LDA ESTKH-2,X
+ ADC ESTKH-1,X
+ STA SRCH
+ DEC DSTH
+ DEC SRCH
+ LDY #$FF
+ LDA ESTKL-2,X
+ BEQ REVCPYLP
+ INC ESTKH-2,X
+REVCPYLP LDA (SRC),Y
+ STA (DST),Y
+ DEY
+ CPY #$FF
+ BNE +
+ DEC DSTH
+ DEC SRCH
++ DEC ESTKL-2,X
+ BNE REVCPYLP
+ DEC ESTKH-2,X
+ BNE REVCPYLP
+CPYMEX RTS
end
//
// COPY FROM MAIN MEM TO AUX MEM.
@@ -300,191 +300,191 @@ end
// MEMXCPY(DST, SRC, SIZE)
//
asm memxcpy
- LDA ESTKL+1,X
- STA $3C
- CLC
- ADC ESTKL,X
- STA $3E
- LDA ESTKH+1,X
- STA $3D
- ADC ESTKH,X
- STA $3F
- LDA ESTKL+2,X
- STA $42
- LDA ESTKH+2,X
- STA $43
- STX ESP
- BIT ROMEN
- SEC
- JSR $C311
- BIT LCRDEN+LCBNK2
- LDX ESP
- INX
- INX
- RTS
+ LDA ESTKL+1,X
+ STA $3C
+ CLC
+ ADC ESTKL,X
+ STA $3E
+ LDA ESTKH+1,X
+ STA $3D
+ ADC ESTKH,X
+ STA $3F
+ LDA ESTKL+2,X
+ STA $42
+ LDA ESTKH+2,X
+ STA $43
+ STX ESP
+ BIT ROMEN
+ SEC
+ JSR $C311
+ BIT LCRDEN+LCBNK2
+ LDX ESP
+ INX
+ INX
+ RTS
end
asm crout
- DEX
- LDA #$0D
- BNE +
- ; FALL THROUGH TO COUT
+ DEX
+ LDA #$0D
+ BNE +
+ ; FALL THROUGH TO COUT
end
//
// CHAR OUT
// COUT(CHAR)
//
asm cout
- LDA ESTKL,X
- BIT $BF98
- BMI +
- JSR TOUPR
-+ ORA #$80
- BIT ROMEN
- JSR $FDED
- BIT LCRDEN+LCBNK2
- RTS
+ LDA ESTKL,X
+ BIT $BF98
+ BMI +
+ JSR TOUPR
++ ORA #$80
+ BIT ROMEN
+ JSR $FDED
+ BIT LCRDEN+LCBNK2
+ RTS
end
//
// CHAR IN
// RDKEY()
//
asm cin
- BIT ROMEN
- JSR $FD0C
- BIT LCRDEN+LCBNK2
- DEX
- LDY #$00
- AND #$7F
- STA ESTKL,X
- STY ESTKH,X
- RTS
+ BIT ROMEN
+ JSR $FD0C
+ BIT LCRDEN+LCBNK2
+ DEX
+ LDY #$00
+ AND #$7F
+ STA ESTKL,X
+ STY ESTKH,X
+ RTS
end
//
// PRINT STRING
// PRSTR(STR)
//
asm prstr
- LDY #$00
- LDA ESTKL,X
- STA SRCL
- LDA ESTKH,X
- STA SRCH
- LDA (SRC),Y
- BEQ ++
- STA TMP
- BIT ROMEN
-- INY
- LDA (SRC),Y
- BIT $BF98
- BMI +
- JSR TOUPR
-+ ORA #$80
- JSR $FDED
- CPY TMP
- BNE -
- BIT LCRDEN+LCBNK2
-++ RTS
+ LDY #$00
+ LDA ESTKL,X
+ STA SRCL
+ LDA ESTKH,X
+ STA SRCH
+ LDA (SRC),Y
+ BEQ ++
+ STA TMP
+ BIT ROMEN
+- INY
+ LDA (SRC),Y
+ BIT $BF98
+ BMI +
+ JSR TOUPR
++ ORA #$80
+ JSR $FDED
+ CPY TMP
+ BNE -
+ BIT LCRDEN+LCBNK2
+++ RTS
end
//
// PRINT BYTE
//
asm prbyte
- LDA ESTKL,X
- STX ESP
- BIT ROMEN
- JSR $FDDA
- LDX ESP
- BIT LCRDEN+LCBNK2
- RTS
+ LDA ESTKL,X
+ STX ESP
+ BIT ROMEN
+ JSR $FDDA
+ LDX ESP
+ BIT LCRDEN+LCBNK2
+ RTS
end
//
// PRINT WORD
//
asm prword
- STX ESP
- TXA
- TAY
- LDA ESTKH,Y
- LDX ESTKL,Y
- BIT ROMEN
- JSR $F941
- LDX ESP
- BIT LCRDEN+LCBNK2
- RTS
+ STX ESP
+ TXA
+ TAY
+ LDA ESTKH,Y
+ LDX ESTKL,Y
+ BIT ROMEN
+ JSR $F941
+ LDX ESP
+ BIT LCRDEN+LCBNK2
+ RTS
end
//
// READ STRING
// STR = RDSTR(PROMPTCHAR)
//
asm rdstr
- LDA ESTKL,X
- STA $33
- STX ESP
- BIT ROMEN
- JSR $FD6A
- STX $01FF
-- LDA $01FF,X
- AND #$7F
- STA $01FF,X
- DEX
- BPL -
- TXA
- LDX ESP
- STA ESTKL,X
- LDA #$01
- STA ESTKH,X
- BIT LCRDEN+LCBNK2
- RTS
+ LDA ESTKL,X
+ STA $33
+ STX ESP
+ BIT ROMEN
+ JSR $FD6A
+ STX $01FF
+- LDA $01FF,X
+ AND #$7F
+ STA $01FF,X
+ DEX
+ BPL -
+ TXA
+ LDX ESP
+ STA ESTKL,X
+ LDA #$01
+ STA ESTKH,X
+ BIT LCRDEN+LCBNK2
+ RTS
end
asm uword_isge
- LDA ESTKL+1,X
- CMP ESTKL,X
- LDA ESTKH+1,X
- SBC ESTKH,X
- LDA #$FF
- ADC #$00
- EOR #$FF
- STA ESTKL+1,X
- STA ESTKH+1,X
- INX
- RTS
+ LDA ESTKL+1,X
+ CMP ESTKL,X
+ LDA ESTKH+1,X
+ SBC ESTKH,X
+ LDA #$FF
+ ADC #$00
+ EOR #$FF
+ STA ESTKL+1,X
+ STA ESTKH+1,X
+ INX
+ RTS
end
asm uword_isle
- LDA ESTKL,X
- CMP ESTKL+1,X
- LDA ESTKH,X
- SBC ESTKH+1,X
- LDA #$FF
- ADC #$00
- EOR #$FF
- STA ESTKL+1,X
- STA ESTKH+1,X
- INX
- RTS
+ LDA ESTKL,X
+ CMP ESTKL+1,X
+ LDA ESTKH,X
+ SBC ESTKH+1,X
+ LDA #$FF
+ ADC #$00
+ EOR #$FF
+ STA ESTKL+1,X
+ STA ESTKH+1,X
+ INX
+ RTS
end
asm uword_isgt
- LDA ESTKL,X
- CMP ESTKL+1,X
- LDA ESTKH,X
- SBC ESTKH+1,X
- LDA #$FF
- ADC #$00
- STA ESTKL+1,X
- STA ESTKH+1,X
- INX
- RTS
+ LDA ESTKL,X
+ CMP ESTKL+1,X
+ LDA ESTKH,X
+ SBC ESTKH+1,X
+ LDA #$FF
+ ADC #$00
+ STA ESTKL+1,X
+ STA ESTKH+1,X
+ INX
+ RTS
end
asm uword_islt
- LDA ESTKL+1,X
- CMP ESTKL,X
- LDA ESTKH+1,X
- SBC ESTKH,X
- LDA #$FF
- ADC #$00
- STA ESTKL+1,X
- STA ESTKH+1,X
- INX
- RTS
+ LDA ESTKL+1,X
+ CMP ESTKL,X
+ LDA ESTKH+1,X
+ SBC ESTKH,X
+ LDA #$FF
+ ADC #$00
+ STA ESTKL+1,X
+ STA ESTKH+1,X
+ INX
+ RTS
end
//
// Utility routines.
@@ -504,28 +504,28 @@ end
// return len
//end
asm dcitos
- LDA ESTKL,X
- STA DSTL
- LDA ESTKH,X
- STA DSTH
- LDA ESTKL+1,X
- STA SRCL
- LDA ESTKH+1,X
- STA SRCH
- LDY #$00
-- LDA (SRC),Y
- CMP #$80
- AND #$7F
- INY
- STA (DST),Y
- BCS -
- TYA
- LDY #$00
- STA (DST),Y
- INX
- STA ESTKL,X
- STY ESTKH,X
- RTS
+ LDA ESTKL,X
+ STA DSTL
+ LDA ESTKH,X
+ STA DSTH
+ LDA ESTKL+1,X
+ STA SRCL
+ LDA ESTKH+1,X
+ STA SRCH
+ LDY #$00
+- LDA (SRC),Y
+ CMP #$80
+ AND #$7F
+ INY
+ STA (DST),Y
+ BCS -
+ TYA
+ LDY #$00
+ STA (DST),Y
+ INX
+ STA ESTKL,X
+ STY ESTKH,X
+ RTS
end
//def stodci(str, dci)
// byte len, c
@@ -537,50 +537,50 @@ end
// len = len - 1
// (dci).[len] = c
// while len
-// c = toupper((str).[len]) | $80
-// len = len - 1
-// (dci).[len] = c
+// c = toupper((str).[len]) | $80
+// len = len - 1
+// (dci).[len] = c
// loop
// return ^str
//end
asm stodci
- LDA ESTKL,X
- STA DSTL
- LDA ESTKH,X
- STA DSTH
- LDA ESTKL+1,X
- STA SRCL
- LDA ESTKH+1,X
- STA SRCH
- INX
- LDY #$00
- LDA (SRC),Y
- BEQ ++
- TAY
- LDA (SRC),Y
- JSR TOUPR
- BNE +
-- LDA (SRC),Y
- JSR TOUPR
- ORA #$80
-+ DEY
- STA (DST),Y
- BNE -
- LDA (SRC),Y
-++ STA ESTKL,X
- STY ESTKH,X
- RTS
+ LDA ESTKL,X
+ STA DSTL
+ LDA ESTKH,X
+ STA DSTH
+ LDA ESTKL+1,X
+ STA SRCL
+ LDA ESTKH+1,X
+ STA SRCH
+ INX
+ LDY #$00
+ LDA (SRC),Y
+ BEQ ++
+ TAY
+ LDA (SRC),Y
+ JSR TOUPR
+ BNE +
+- LDA (SRC),Y
+ JSR TOUPR
+ ORA #$80
++ DEY
+ STA (DST),Y
+ BNE -
+ LDA (SRC),Y
+++ STA ESTKL,X
+ STY ESTKH,X
+ RTS
end
asm toupper
- LDA ESTKL,X
-TOUPR AND #$7F
- CMP #'a'
- BCC +
- CMP #'z'+1
- BCS +
- SBC #$1F
-+ STA ESTKL,X
- RTS
+ LDA ESTKL,X
+TOUPR AND #$7F
+ CMP #'a'
+ BCC +
+ CMP #'z'+1
+ BCS +
+ SBC #$1F
++ STA ESTKL,X
+ RTS
end
//
// Module symbols are entered into the symbol table
@@ -599,25 +599,25 @@ end
// return dci
//end
asm modtosym
- LDA ESTKL+1,X
- STA SRCL
- LDA ESTKH+1,X
- STA SRCH
- LDA ESTKL,X
- STA ESTKL+1,X
- STA DSTL
- LDA ESTKH,X
- STA ESTKH+1,X
- STA DSTH
- INX
- LDY #$00
- LDA #'#'+$80
-- STA (DST),Y
- ASL
- LDA (SRC),Y
- INY
- BCS -
- RTS
+ LDA ESTKL+1,X
+ STA SRCL
+ LDA ESTKH+1,X
+ STA SRCH
+ LDA ESTKL,X
+ STA ESTKL+1,X
+ STA DSTL
+ LDA ESTKH,X
+ STA ESTKH+1,X
+ STA DSTH
+ INX
+ LDY #$00
+ LDA #'#'+$80
+- STA (DST),Y
+ ASL
+ LDA (SRC),Y
+ INY
+ BCS -
+ RTS
end
//
// Lookup routines.
@@ -640,46 +640,46 @@ end
// loop
// return 0
asm lookuptbl
- LDA ESTKL,X
- STA DSTL
- LDA ESTKH,X
- STA DSTH
- LDA ESTKL+1,X
- STA SRCL
- LDA ESTKH+1,X
- STA SRCH
- LDY #$00
-- LDA (DST),Y
- BEQ +
- CMP (SRC),Y
- BNE ++
- INY
- ASL
- BCS -
- LDA (DST),Y
- PHA
- INY
- LDA (DST),Y
- TAY
- PLA
-+ INX
- STA ESTKL,X
- STY ESTKH,X
- RTS
-++ LDY #$00
--- LDA (DST),Y
- INC DSTL
- BEQ +
---- ASL
- BCS --
- LDA #$02
- ADC DSTL
- STA DSTL
- BCC -
- INC DSTH
- BCS -
-+ INC DSTH
- BNE ---
+ LDA ESTKL,X
+ STA DSTL
+ LDA ESTKH,X
+ STA DSTH
+ LDA ESTKL+1,X
+ STA SRCL
+ LDA ESTKH+1,X
+ STA SRCH
+ LDY #$00
+- LDA (DST),Y
+ BEQ +
+ CMP (SRC),Y
+ BNE ++
+ INY
+ ASL
+ BCS -
+ LDA (DST),Y
+ PHA
+ INY
+ LDA (DST),Y
+ TAY
+ PLA
++ INX
+ STA ESTKL,X
+ STY ESTKH,X
+ RTS
+++ LDY #$00
+-- LDA (DST),Y
+ INC DSTL
+ BEQ +
+--- ASL
+ BCS --
+ LDA #$02
+ ADC DSTL
+ STA DSTL
+ BCC -
+ INC DSTH
+ BCS -
++ INC DSTH
+ BNE ---
end
//
// ProDOS routines
@@ -743,15 +743,15 @@ def allocheap(size)
heap = heap + size
if systemflags & reshgr1
if uword_islt(addr, $4000) and uword_isgt(heap, $2000)
- addr = $4000
- heap = addr + size
- fin
+ addr = $4000
+ heap = addr + size
+ fin
fin
if systemflags & reshgr2
if uword_islt(addr, $6000) and uword_isgt(heap, $4000)
- addr = $6000
- heap = addr + size
- fin
+ addr = $6000
+ heap = addr + size
+ fin
fin
if uword_isge(heap, @addr)
return 0
@@ -784,27 +784,27 @@ def allocxheap(size)
xheap = xheap + size
if systemflags & restxt1
if uword_isle(xaddr, $0800) and uword_isgt(xheap, $0400)
- xaddr = $0800
- xheap = xaddr + size
- fin
+ xaddr = $0800
+ xheap = xaddr + size
+ fin
fin
if systemflags & restxt2
if uword_isle(xaddr, $0C00) and uword_isgt(xheap, $0800)
- xaddr = $0C00
- xheap = xaddr + size
- fin
+ xaddr = $0C00
+ xheap = xaddr + size
+ fin
fin
if systemflags & resxhgr1
if uword_isle(xaddr, $4000) and uword_isgt(xheap, $2000)
- xaddr = $4000
- xheap = xaddr + size
- fin
+ xaddr = $4000
+ xheap = xaddr + size
+ fin
fin
if systemflags & resxhgr2
if uword_isle(xaddr, $6000) and uword_isgt(xheap, $4000)
- xaddr = $6000
- xheap = xaddr + size
- fin
+ xaddr = $6000
+ xheap = xaddr + size
+ fin
fin
if uword_isge(xheap, $BF00)
return 0
@@ -852,12 +852,12 @@ def lookupextern(esd, index)
esd = esd + dcitos(esd, @str)
if esd->0 & $10 and esd->1 == index
addr = lookupsym(sym)
- if !addr
+ if !addr
perr = $81
- cout('?')
- prstr(@str)
- crout
- fin
+ cout('?')
+ prstr(@str)
+ crout
+ fin
return addr
fin
esd = esd + 3
@@ -901,71 +901,73 @@ def loadmod(mod)
refnum = open(@filename, iobuffer)
if refnum > 0
rdlen = read(refnum, @header, 128)
- modsize = header:0
- moddep = @header.1
- defofst = modsize
+ modsize = header:0
+ moddep = @header.1
+ defofst = modsize
init = 0
- if rdlen > 4 and header:2 == $DA7E // DAVE = magic number :-)
+ if rdlen > 4 and header:2 == $DA7F // DAVE+1 = magic number :-)
//
// This is an EXTended RELocatable (data+bytecode) module.
//
- systemflags = header:4 | systemflags
+ systemflags = header:4 | systemflags
defofst = header:6
defcnt = header:8
init = header:10
moddep = @header.12
- //
- // Load module dependencies.
- //
+ //
+ // Load module dependencies.
+ //
while ^moddep
if !lookupmod(moddep)
- close(refnum)
- refnum = 0
+ close(refnum)
+ refnum = 0
if loadmod(moddep) < 0
- return -perr
- fin
+ return -perr
+ fin
fin
moddep = moddep + dcitos(moddep, @str)
loop
- //
- // Init def table.
- //
- deftbl = allocheap(defcnt * 5 + 1)
- deflast = deftbl
- ^deflast = 0
- if !refnum
- //
- // Reset read pointer.
- //
- refnum = open(@filename, iobuffer)
- rdlen = read(refnum, @header, 128)
- fin
+ //
+ // Init def table.
+ //
+ deftbl = allocheap(defcnt * 5 + 1)
+ deflast = deftbl
+ ^deflast = 0
+ if !refnum
+ //
+ // Reset read pointer.
+ //
+ refnum = open(@filename, iobuffer)
+ rdlen = read(refnum, @header, 128)
+ fin
+ else
+ return -69
fin
- //
- // Alloc heap space for relocated module (data + bytecode).
- //
- moddep = moddep + 1
- modfix = moddep - @header.2 // Adjust to skip header
- modsize = modsize - modfix
- rdlen = rdlen - modfix - 2
- modaddr = allocheap(modsize)
- memcpy(modaddr, moddep, rdlen)
- //
- // Read in remainder of module into memory for fixups.
- //
- addr = modaddr//
+ //
+ // Alloc heap space for relocated module (data + bytecode).
+ //
+ moddep = moddep + 1
+ modfix = moddep - @header.2 // Adjust to skip header
+ modsize = modsize - modfix
+ rdlen = rdlen - modfix - 2
+ modaddr = allocheap(modsize)
+ memcpy(modaddr, moddep, rdlen)
+ //
+ // Read in remainder of module into memory for fixups.
+ //
+ addr = modaddr//
repeat
addr = addr + rdlen
rdlen = read(refnum, addr, 4096)
until rdlen <= 0
close(refnum)
- //
- // Add module to symbol table.
- //
- addmod(mod, modaddr)
- //
- // Apply all fixups and symbol import/export.
- //
+ //
+ // Add module to symbol table.
+ //
+ addmod(mod, modaddr)
+ //
+ // Apply all fixups and symbol import/export.
+ //
modfix = modaddr - modfix
bytecode = defofst + modfix - MODADDR
modend = modaddr + modsize
@@ -973,39 +975,39 @@ def loadmod(mod)
esd = rld // Extern+Entry Symbol Directory
while ^esd // Scan to end of ESD
esd = esd + 4
- loop
+ loop
esd = esd + 1
- //
- // Locate bytecode defs in appropriate bank.
- //
- if ^MACHID & $30 == $30
- defbank = 1
- defaddr = allocxheap(rld - bytecode)
- modend = bytecode
- else
- defbank = 0
- defaddr = bytecode
- fin
+ //
+ // Locate bytecode defs in appropriate bank.
+ //
+ if ^MACHID & $30 == $30
+ defbank = 1
+ defaddr = allocxheap(rld - bytecode)
+ modend = bytecode
+ else
+ defbank = 0
+ defaddr = bytecode
+ fin
//
// Run through the Re-Location Dictionary.
//
while ^rld
if ^rld == $02
- //
- // This is a bytcode def entry - add it to the def directory.
- //
- adddef(defbank, rld=>1 - defofst + defaddr, @deflast)
+ //
+ // This is a bytcode def entry - add it to the def directory.
+ //
+ adddef(defbank, rld=>1 - defofst + defaddr, @deflast)
else
addr = rld=>1 + modfix
if uword_isge(addr, modaddr) // Skip fixups to header
if ^rld & $80 // WORD sized fixup.
fixup = *addr
- else // BYTE sized fixup.
+ else // BYTE sized fixup.
fixup = ^addr
fin
if ^rld & $10 // EXTERN reference.
fixup = fixup + lookupextern(esd, rld->3)
- else // INTERN fixup.
+ else // INTERN fixup.
fixup = fixup + modfix - MODADDR
if uword_isge(fixup, bytecode)
//
@@ -1016,40 +1018,40 @@ def loadmod(mod)
fin
if ^rld & $80 // WORD sized fixup.
*addr = fixup
- else // BYTE sized fixup.
+ else // BYTE sized fixup.
^addr = fixup
fin
fin
fin
rld = rld + 4
loop
- //
+ //
// Run through the External/Entry Symbol Directory.
- //
+ //
while ^esd
sym = esd
esd = esd + dcitos(esd, @str)
if ^esd & $08
- //
+ //
// EXPORT symbol - add it to the global symbol table.
- //
+ //
addr = esd=>1 + modfix - MODADDR
if uword_isge(addr, bytecode)
- //
- // Use the def directory address for bytecode.
- //
+ //
+ // Use the def directory address for bytecode.
+ //
addr = lookupdef(addr - bytecode + defaddr, deftbl)
fin
addsym(sym, addr)
fin
esd = esd + 3
loop
- if defbank
- //
- // Move bytecode to AUX bank.
- //
- memxcpy(defaddr, bytecode, modsize - (bytecode - modaddr))
- fin
+ if defbank
+ //
+ // Move bytecode to AUX bank.
+ //
+ memxcpy(defaddr, bytecode, modsize - (bytecode - modaddr))
+ fin
fin
if perr
return -perr
@@ -1060,21 +1062,21 @@ def loadmod(mod)
fixup = 0 // This is repurposed for the return code
if init
fixup = adddef(defbank, init - defofst + defaddr, @deflast)()
- if fixup < modinitkeep
- //
- // Free init routine unless initkeep
- //
- if defbank
- xheap = init - defofst + defaddr
- else
- modend = init - defofst + defaddr
- fin
- if fixup < 0
+ if fixup < modinitkeep
+ //
+ // Free init routine unless initkeep
+ //
+ if defbank
+ xheap = init - defofst + defaddr
+ else
+ modend = init - defofst + defaddr
+ fin
+ if fixup < 0
perr = -fixup
- fin
- else
- fixup = fixup & ~modinitkeep
- fin
+ fin
+ else
+ fixup = fixup & ~modinitkeep
+ fin
fin
//
// Free up the end-of-module in main memory.
@@ -1097,12 +1099,12 @@ def volumes
strbuf = databuff
for i = 0 to 15
^strbuf = ^strbuf & $0F
- if ^strbuf
- cout('/')
- prstr(strbuf)
- crout()
- fin
- strbuf = strbuf + 16
+ if ^strbuf
+ cout('/')
+ prstr(strbuf)
+ crout()
+ fin
+ strbuf = strbuf + 16
next
end
def catalog(optpath)
@@ -1143,12 +1145,12 @@ def catalog(optpath)
if type & $F0 == $D0 // Is it a directory?
cout('/')
len = len + 1
- elsif entry->$10 == $FF
- cout('-')
- len = len + 1
- elsif entry->$10 == $FE
- cout('+')
- len = len + 1
+ elsif entry->$10 == $FF
+ cout('-')
+ len = len + 1
+ elsif entry->$10 == $FE
+ cout('+')
+ len = len + 1
fin
for len = 19 - len downto 0
cout(' ')
@@ -1187,9 +1189,9 @@ def striptrail(strptr)
for i = 1 to ^strptr
if ^(strptr + i) <= ' '
- ^strptr = i - 1
- return strptr
- fin
+ ^strptr = i - 1
+ return strptr
+ fin
next
return strptr
end
@@ -1225,23 +1227,23 @@ def execsys(sysfile)
if ^sysfile
memcpy($280, sysfile, ^sysfile + 1)
- striptrail(sysfile)
- refnum = open(sysfile, iobuffer)
- if refnum
- len = read(refnum, databuff, $FFFF)
- resetmemfiles()
- if len
- memcpy(sysfile, $280, ^$280 + 1)
- if stripchars(sysfile) and ^$2000 == $4C and *$2003 == $EEEE
- stripspaces(sysfile)
- if ^$2005 >= ^sysfile + 1
- memcpy($2006, sysfile, ^sysfile + 1)
- fin
- fin
- striptrail($280)
- exec()
- fin
- fin
+ striptrail(sysfile)
+ refnum = open(sysfile, iobuffer)
+ if refnum
+ len = read(refnum, databuff, $FFFF)
+ resetmemfiles()
+ if len
+ memcpy(sysfile, $280, ^$280 + 1)
+ if stripchars(sysfile) and ^$2000 == $4C and *$2003 == $EEEE
+ stripspaces(sysfile)
+ if ^$2005 >= ^sysfile + 1
+ memcpy($2006, sysfile, ^sysfile + 1)
+ fin
+ fin
+ striptrail($280)
+ exec()
+ fin
+ fin
fin
end
def execmod(modfile)
@@ -1251,16 +1253,16 @@ def execmod(modfile)
perr = 1
if stodci(modfile, @moddci)
saveheap = heap
- savexheap = xheap
- savesym = lastsym
- saveflags = systemflags
- if loadmod(@moddci) < modkeep
- lastsym = savesym
- xheap = savexheap
- heap = saveheap
- fin
- ^lastsym = 0
- systemflags = saveflags
+ savexheap = xheap
+ savesym = lastsym
+ saveflags = systemflags
+ if loadmod(@moddci) < modkeep
+ lastsym = savesym
+ xheap = savexheap
+ heap = saveheap
+ fin
+ ^lastsym = 0
+ systemflags = saveflags
fin
return -perr
end
@@ -1303,34 +1305,34 @@ while 1
if cmdln
when toupper(parsecmd(@cmdln))
is 'Q'
- reboot()
- break
- is 'C'
- catalog(@cmdln)
- break
- is 'P'
- setpfx(@cmdln)
- break
- is 'V'
- volumes()
- break
- is '-'
- execsys(@cmdln)
- break
- is '+'
- execmod(striptrail(@cmdln))
- break
- otherwise
- cout('?')
+ reboot()
+ break
+ is 'C'
+ catalog(@cmdln)
+ break
+ is 'P'
+ setpfx(@cmdln)
+ break
+ is 'V'
+ volumes()
+ break
+ is '-'
+ execsys(@cmdln)
+ break
+ is '+'
+ execmod(striptrail(@cmdln))
+ break
+ otherwise
+ cout('?')
wend
if perr
prstr("ERR:$")
- prbyte(perr)
- perr = 0
+ prbyte(perr)
+ perr = 0
else
prstr("OK")
fin
- crout()
+ crout()
fin
prstr(getpfx(@prefix))
memcpy(@cmdln, rdstr($BA), 128)
diff --git a/src/vmsrc/plvm.c b/src/vmsrc/plvm.c
index fbeb538..f05e305 100755
--- a/src/vmsrc/plvm.c
+++ b/src/vmsrc/plvm.c
@@ -17,32 +17,32 @@ int show_state = 0;
/*
* Bytecode memory
*/
-#define BYTE_PTR(bp) ((byte)((bp)[0]))
-#define WORD_PTR(bp) ((word)((bp)[0] | ((bp)[1] << 8)))
-#define UWORD_PTR(bp) ((uword)((bp)[0] | ((bp)[1] << 8)))
-#define TO_UWORD(w) ((uword)((w)))
-#define MOD_ADDR 0x1000
-#define DEF_CALL 0x0800
-#define DEF_CALLSZ 0x0800
-#define DEF_ENTRYSZ 6
-#define MEM_SIZE 65536
+#define BYTE_PTR(bp) ((byte)((bp)[0]))
+#define WORD_PTR(bp) ((word)((bp)[0] | ((bp)[1] << 8)))
+#define UWORD_PTR(bp) ((uword)((bp)[0] | ((bp)[1] << 8)))
+#define TO_UWORD(w) ((uword)((w)))
+#define MOD_ADDR 0x1000
+#define DEF_CALL 0x0800
+#define DEF_CALLSZ 0x0800
+#define DEF_ENTRYSZ 6
+#define MEM_SIZE 65536
byte mem_data[MEM_SIZE];
uword sp = 0x01FE, fp = 0xFFFF, heap = 0x0200, deftbl = DEF_CALL, lastdef = DEF_CALL;
-#define PHA(b) (mem_data[sp--]=(b))
-#define PLA() (mem_data[++sp])
-#define EVAL_STACKSZ 16
-#define PUSH(v) (*(--esp))=(v)
-#define POP ((word)(*(esp++)))
-#define UPOP ((uword)(*(esp++)))
-#define TOS (esp[0])
+#define PHA(b) (mem_data[sp--]=(b))
+#define PLA (mem_data[++sp])
+#define EVAL_STACKSZ 16
+#define PUSH(v) (*(--esp))=(v)
+#define POP ((word)(*(esp++)))
+#define UPOP ((uword)(*(esp++)))
+#define TOS (esp[0])
word eval_stack[EVAL_STACKSZ];
word *esp = eval_stack + EVAL_STACKSZ;
-#define SYMTBLSZ 1024
-#define SYMSZ 16
-#define MODTBLSZ 128
-#define MODSZ 16
-#define MODLSTSZ 32
+#define SYMTBLSZ 1024
+#define SYMSZ 16
+#define MODTBLSZ 128
+#define MODSZ 16
+#define MODLSTSZ 32
byte symtbl[SYMTBLSZ];
byte *lastsym = symtbl;
byte modtbl[MODTBLSZ];
@@ -53,7 +53,7 @@ byte *lastmod = modtbl;
void interp(code *ip);
/*
* Utility routines.
- *
+ *
* A DCI string is one that has the high bit set for every character except the last.
* More efficient than C or Pascal strings.
*/
@@ -126,7 +126,7 @@ void dump_tbl(byte *tbl)
putchar(':');
while (len++ < 15)
putchar(' ');
- printf("$%04X\n", tbl[0] | (tbl[1] << 8));
+ printf("$%04X\n", tbl[0] | (tbl[1] << 8));
tbl += 2;
}
}
@@ -248,7 +248,7 @@ int load_mod(byte *mod)
moddep = header + 1;
modsize = header[0] | (header[1] << 8);
magic = header[2] | (header[3] << 8);
- if (magic == 0xDA7E)
+ if (magic == 0xDA7F)
{
/*
* This is a relocatable bytecode module.
@@ -282,7 +282,7 @@ int load_mod(byte *mod)
}
/*
* Alloc heap space for relocated module (data + bytecode).
- */
+ */
moddep += 1;
hdrlen = moddep - header;
len -= hdrlen;
@@ -381,7 +381,7 @@ int load_mod(byte *mod)
{
if (show_state) printf("BYTE");
mem_data[addr] = fixup;
- }
+ }
}
else
{
@@ -502,18 +502,18 @@ void call(uword pc)
exit(1);
}
}
-
+
/*
* OPCODE TABLE
*
-OPTBL: DW ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E
- DW NEG,COMP,AND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E
- DW NOT,LOR,LAND,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E
- DW DROP,DUP,PUSH,PULL,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E
- DW ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E
- DW BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,??? ; 50 52 54 56 58 5A 5C 5E
- DW LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E
- DW SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E
+OPTBL: DW ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E
+ DW NEG,COMP,AND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E
+ DW NOT,LOR,LAND,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E
+ DW DROP,DUP,PUSH,PULL,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E
+ DW ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E
+ DW BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,??? ; 50 52 54 56 58 5A 5C 5E
+ DW LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E
+ DW SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E
*/
void interp(code *ip)
{
@@ -533,9 +533,9 @@ void interp(code *ip)
}
switch (*ip++)
{
- /*
- * 0x00-0x0F
- */
+ /*
+ * 0x00-0x0F
+ */
case 0x00: // ZERO : TOS = 0
PUSH(0);
break;
@@ -656,13 +656,11 @@ void interp(code *ip)
PUSH(val);
break;
case 0x34: // PUSH : TOSP = TOS
- val = POP;
- PHA(val >> 8);
+ val = esp - eval_stack;
PHA(val);
break;
case 0x36: // PULL : TOS = TOSP
- PUSH(mem_data[sp] | (mem_data[sp + 1] << 8));
- sp += 2;
+ esp = eval_stack + PLA;
break;
case 0x38: // BRGT : TOS-1 > TOS ? IP += (IP)
val = POP;
@@ -775,7 +773,7 @@ void interp(code *ip)
printf("\n");
break;
case 0x5A: // LEAVE : DEL FRAME, IP = TOFP
- fp += PLA();
+ fp += PLA;
case 0x5C: // RET : IP = TOFP
return;
case 0x5E: // ???
@@ -822,14 +820,14 @@ void interp(code *ip)
/*
* 0x70-0x7F
*/
- case 0x70: // SB : BYTE (TOS) = TOS-1
- val = POP;
+ case 0x70: // SB : BYTE (TOS-1) = TOS
ea = UPOP;
+ val = POP;
mem_data[ea] = val;
break;
- case 0x72: // SW : WORD (TOS) = TOS-1
- val = POP;
+ case 0x72: // SW : WORD (TOS-1) = TOS
ea = UPOP;
+ val = POP;
mem_data[ea] = val;
mem_data[ea + 1] = val >> 8;
break;
@@ -889,7 +887,7 @@ int main(int argc, char **argv)
{
byte dci[32];
int i;
-
+
if (--argc)
{
argv++;
diff --git a/src/vmsrc/plvm01.s b/src/vmsrc/plvm01.s
index 31c685f..787c59c 100644
--- a/src/vmsrc/plvm01.s
+++ b/src/vmsrc/plvm01.s
@@ -8,907 +8,921 @@
;*
;* VM ZERO PAGE LOCATIONS
;*
- !SOURCE "vmsrc/plvmzp.inc"
+ !SOURCE "vmsrc/plvmzp.inc"
;*
;* INTERPRETER INSTRUCTION POINTER INCREMENT MACRO
;*
- !MACRO INC_IP {
- INY
- BNE *+4
- INC IPH
- }
+ !MACRO INC_IP {
+ INY
+ BNE *+4
+ INC IPH
+ }
;*
;* INTERPRETER HEADER+INITIALIZATION
;*
- *= $0280
-SEGBEGIN JMP VMINIT
+ *= $0280
+SEGBEGIN JMP VMINIT
;*
;* SYSTEM INTERPRETER ENTRYPOINT
;*
-INTERP PLA
- CLC
- ADC #$01
+INTERP PLA
+ CLC
+ ADC #$01
STA IPL
PLA
- ADC #$00
+ ADC #$00
STA IPH
- LDY #$00
- JMP FETCHOP
+ LDY #$00
+ JMP FETCHOP
;*
;* ENTER INTO USER BYTECODE INTERPRETER
;*
-IINTERP PLA
+IINTERP PLA
STA TMPL
PLA
STA TMPH
- LDY #$02
- LDA (TMP),Y
- STA IPH
- DEY
- LDA (TMP),Y
- STA IPL
+ LDY #$02
+ LDA (TMP),Y
+ STA IPH
+ DEY
+ LDA (TMP),Y
+ STA IPL
DEY
- JMP FETCHOP
+ JMP FETCHOP
;*
;* MUL TOS-1 BY TOS
;*
-MUL STY IPY
- LDY #$10
- LDA ESTKL+1,X
- EOR #$FF
- STA TMPL
- LDA ESTKH+1,X
- EOR #$FF
- STA TMPH
- LDA #$00
- STA ESTKL+1,X ; PRODL
-; STA ESTKH+1,X ; PRODH
-MULLP LSR TMPH ; MULTPLRH
- ROR TMPL ; MULTPLRL
- BCS +
- STA ESTKH+1,X ; PRODH
- LDA ESTKL,X ; MULTPLNDL
- ADC ESTKL+1,X ; PRODL
- STA ESTKL+1,X
- LDA ESTKH,X ; MULTPLNDH
- ADC ESTKH+1,X ; PRODH
-+ ASL ESTKL,X ; MULTPLNDL
- ROL ESTKH,X ; MULTPLNDH
- DEY
- BNE MULLP
- STA ESTKH+1,X ; PRODH
- INX
- LDY IPY
- JMP NEXTOP
+MUL STY IPY
+ LDY #$10
+ LDA ESTKL+1,X
+ EOR #$FF
+ STA TMPL
+ LDA ESTKH+1,X
+ EOR #$FF
+ STA TMPH
+ LDA #$00
+ STA ESTKL+1,X ; PRODL
+; STA ESTKH+1,X ; PRODH
+MULLP LSR TMPH ; MULTPLRH
+ ROR TMPL ; MULTPLRL
+ BCS +
+ STA ESTKH+1,X ; PRODH
+ LDA ESTKL,X ; MULTPLNDL
+ ADC ESTKL+1,X ; PRODL
+ STA ESTKL+1,X
+ LDA ESTKH,X ; MULTPLNDH
+ ADC ESTKH+1,X ; PRODH
++ ASL ESTKL,X ; MULTPLNDL
+ ROL ESTKH,X ; MULTPLNDH
+ DEY
+ BNE MULLP
+ STA ESTKH+1,X ; PRODH
+ LDY IPY
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* INCREMENT TOS
;*
-INCR INC ESTKL,X
- BNE INCR1
- INC ESTKH,X
-INCR1 JMP NEXTOP
+INCR INC ESTKL,X
+ BNE INCR1
+ INC ESTKH,X
+INCR1 JMP NEXTOP
;*
;* DECREMENT TOS
;*
-DECR LDA ESTKL,X
- BNE DECR1
- DEC ESTKH,X
-DECR1 DEC ESTKL,X
- JMP NEXTOP
+DECR LDA ESTKL,X
+ BNE DECR1
+ DEC ESTKH,X
+DECR1 DEC ESTKL,X
+ JMP NEXTOP
;*
;* BITWISE COMPLIMENT TOS
;*
-COMP LDA #$FF
- EOR ESTKL,X
- STA ESTKL,X
- LDA #$FF
- EOR ESTKH,X
- STA ESTKH,X
- JMP NEXTOP
+COMP LDA #$FF
+ EOR ESTKL,X
+ STA ESTKL,X
+ LDA #$FF
+ EOR ESTKH,X
+ STA ESTKH,X
+ JMP NEXTOP
;*
;* OPCODE TABLE
;*
- !ALIGN 255,0
-OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E
- !WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E
- !WORD LNOT,LOR,LAND,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E
- !WORD DROP,DUP,PUSH,PULL,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E
- !WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E
- !WORD BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,NEXTOP ; 50 52 54 56 58 5A 5C 5E
- !WORD LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E
- !WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E
+ !ALIGN 255,0
+OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E
+ !WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E
+ !WORD LNOT,LOR,LAND,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E
+ !WORD DROP,DUP,PUSHEP,PULLEP,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E
+ !WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E
+ !WORD BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,NEXTOP ; 50 52 54 56 58 5A 5C 5E
+ !WORD LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E
+ !WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E
;*
;* DIV TOS-1 BY TOS
;*
-DIV JSR _DIV
- LSR DVSIGN ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1
- BCS NEG
- JMP NEXTOP
+DIV JSR _DIV
+ LSR DVSIGN ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1
+ BCS NEG
+ JMP NEXTOP
;*
;* MOD TOS-1 BY TOS
;*
-MOD JSR _DIV
- LDA TMPL ; REMNDRL
- STA ESTKL,X
- LDA TMPH ; REMNDRH
- STA ESTKH,X
- LDA DVSIGN ; REMAINDER IS SIGN OF DIVIDEND
- BMI NEG
- JMP NEXTOP
+MOD JSR _DIV
+ LDA TMPL ; REMNDRL
+ STA ESTKL,X
+ LDA TMPH ; REMNDRH
+ STA ESTKH,X
+ LDA DVSIGN ; REMAINDER IS SIGN OF DIVIDEND
+ BMI NEG
+ JMP NEXTOP
;*
;* NEGATE TOS
;*
-NEG LDA #$00
- SEC
- SBC ESTKL,X
- STA ESTKL,X
- LDA #$00
- SBC ESTKH,X
- STA ESTKH,X
- JMP NEXTOP
+NEG LDA #$00
+ SEC
+ SBC ESTKL,X
+ STA ESTKL,X
+ LDA #$00
+ SBC ESTKH,X
+ STA ESTKH,X
+ JMP NEXTOP
;*
;* INTERNAL DIVIDE ALGORITHM
;*
-_NEG LDA #$00
- SEC
- SBC ESTKL,X
- STA ESTKL,X
- LDA #$00
- SBC ESTKH,X
- STA ESTKH,X
- RTS
-_DIV STY IPY
- LDY #$11 ; #BITS+1
- LDA #$00
- STA TMPL ; REMNDRL
- STA TMPH ; REMNDRH
- LDA ESTKH,X
- AND #$80
- STA DVSIGN
- BPL +
- JSR _NEG
- INC DVSIGN
-+ LDA ESTKH+1,X
- BPL +
- INX
- JSR _NEG
- DEX
- INC DVSIGN
- BNE _DIV1
-+ ORA ESTKL+1,X ; DVDNDL
- BEQ _DIVEX
-_DIV1 ASL ESTKL+1,X ; DVDNDL
- ROL ESTKH+1,X ; DVDNDH
- DEY
- BCC _DIV1
-_DIVLP ROL TMPL ; REMNDRL
- ROL TMPH ; REMNDRH
- LDA TMPL ; REMNDRL
- CMP ESTKL,X ; DVSRL
- LDA TMPH ; REMNDRH
- SBC ESTKH,X ; DVSRH
- BCC +
- STA TMPH ; REMNDRH
- LDA TMPL ; REMNDRL
- SBC ESTKL,X ; DVSRL
- STA TMPL ; REMNDRL
- SEC
-+ ROL ESTKL+1,X ; DVDNDL
- ROL ESTKH+1,X ; DVDNDH
- DEY
- BNE _DIVLP
-_DIVEX INX
- LDY IPY
- RTS
+_NEG LDA #$00
+ SEC
+ SBC ESTKL,X
+ STA ESTKL,X
+ LDA #$00
+ SBC ESTKH,X
+ STA ESTKH,X
+ RTS
+_DIV STY IPY
+ LDY #$11 ; #BITS+1
+ LDA #$00
+ STA TMPL ; REMNDRL
+ STA TMPH ; REMNDRH
+ LDA ESTKH,X
+ AND #$80
+ STA DVSIGN
+ BPL +
+ JSR _NEG
+ INC DVSIGN
++ LDA ESTKH+1,X
+ BPL +
+ INX
+ JSR _NEG
+ DEX
+ INC DVSIGN
+ BNE _DIV1
++ ORA ESTKL+1,X ; DVDNDL
+ BEQ _DIVEX
+_DIV1 ASL ESTKL+1,X ; DVDNDL
+ ROL ESTKH+1,X ; DVDNDH
+ DEY
+ BCC _DIV1
+_DIVLP ROL TMPL ; REMNDRL
+ ROL TMPH ; REMNDRH
+ LDA TMPL ; REMNDRL
+ CMP ESTKL,X ; DVSRL
+ LDA TMPH ; REMNDRH
+ SBC ESTKH,X ; DVSRH
+ BCC +
+ STA TMPH ; REMNDRH
+ LDA TMPL ; REMNDRL
+ SBC ESTKL,X ; DVSRL
+ STA TMPL ; REMNDRL
+ SEC
++ ROL ESTKL+1,X ; DVDNDL
+ ROL ESTKH+1,X ; DVDNDH
+ DEY
+ BNE _DIVLP
+_DIVEX INX
+ LDY IPY
+ RTS
;*
;* ADD TOS TO TOS-1
;*
-ADD LDA ESTKL,X
- CLC
- ADC ESTKL+1,X
- STA ESTKL+1,X
- LDA ESTKH,X
- ADC ESTKH+1,X
- STA ESTKH+1,X
- INX
- JMP NEXTOP
+ADD LDA ESTKL,X
+ CLC
+ ADC ESTKL+1,X
+ STA ESTKL+1,X
+ LDA ESTKH,X
+ ADC ESTKH+1,X
+ STA ESTKH+1,X
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* SUB TOS FROM TOS-1
;*
-SUB LDA ESTKL+1,X
- SEC
- SBC ESTKL,X
- STA ESTKL+1,X
- LDA ESTKH+1,X
- SBC ESTKH,X
- STA ESTKH+1,X
- INX
- JMP NEXTOP
+SUB LDA ESTKL+1,X
+ SEC
+ SBC ESTKL,X
+ STA ESTKL+1,X
+ LDA ESTKH+1,X
+ SBC ESTKH,X
+ STA ESTKH+1,X
+; INX
+; JMP NEXTOP
+ JMP DROP
;
;*
;* SHIFT TOS LEFT BY 1, ADD TO TOS-1
;*
-IDXW LDA ESTKL,X
- ASL
- ROL ESTKH,X
- CLC
- ADC ESTKL+1,X
- STA ESTKL+1,X
- LDA ESTKH,X
- ADC ESTKH+1,X
- STA ESTKH+1,X
- INX
- JMP NEXTOP
+IDXW LDA ESTKL,X
+ ASL
+ ROL ESTKH,X
+ CLC
+ ADC ESTKL+1,X
+ STA ESTKL+1,X
+ LDA ESTKH,X
+ ADC ESTKH+1,X
+ STA ESTKH+1,X
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* BITWISE AND TOS TO TOS-1
;*
-BAND LDA ESTKL+1,X
- AND ESTKL,X
- STA ESTKL+1,X
- LDA ESTKH+1,X
- AND ESTKH,X
- STA ESTKH+1,X
- INX
- JMP NEXTOP
+BAND LDA ESTKL+1,X
+ AND ESTKL,X
+ STA ESTKL+1,X
+ LDA ESTKH+1,X
+ AND ESTKH,X
+ STA ESTKH+1,X
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* INCLUSIVE OR TOS TO TOS-1
;*
-IOR LDA ESTKL+1,X
- ORA ESTKL,X
- STA ESTKL+1,X
- LDA ESTKH+1,X
- ORA ESTKH,X
- STA ESTKH+1,X
- INX
- JMP NEXTOP
+IOR LDA ESTKL+1,X
+ ORA ESTKL,X
+ STA ESTKL+1,X
+ LDA ESTKH+1,X
+ ORA ESTKH,X
+ STA ESTKH+1,X
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* EXLUSIVE OR TOS TO TOS-1
;*
-XOR LDA ESTKL+1,X
- EOR ESTKL,X
- STA ESTKL+1,X
- LDA ESTKH+1,X
- EOR ESTKH,X
- STA ESTKH+1,X
- INX
- JMP NEXTOP
+XOR LDA ESTKL+1,X
+ EOR ESTKL,X
+ STA ESTKL+1,X
+ LDA ESTKH+1,X
+ EOR ESTKH,X
+ STA ESTKH+1,X
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* SHIFT TOS-1 LEFT BY TOS
;*
-SHL STY IPY
- LDA ESTKL,X
- CMP #$08
- BCC SHL1
- LDY ESTKL+1,X
- STY ESTKH+1,X
- LDY #$00
- STY ESTKL+1,X
- SBC #$08
-SHL1 TAY
- BEQ SHL3
-SHL2 ASL ESTKL+1,X
- ROL ESTKH+1,X
- DEY
- BNE SHL2
-SHL3 INX
- LDY IPY
- JMP NEXTOP
+SHL STY IPY
+ LDA ESTKL,X
+ CMP #$08
+ BCC SHL1
+ LDY ESTKL+1,X
+ STY ESTKH+1,X
+ LDY #$00
+ STY ESTKL+1,X
+ SBC #$08
+SHL1 TAY
+ BEQ SHL3
+SHL2 ASL ESTKL+1,X
+ ROL ESTKH+1,X
+ DEY
+ BNE SHL2
+SHL3 LDY IPY
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* SHIFT TOS-1 RIGHT BY TOS
;*
-SHR STY IPY
- LDA ESTKL,X
- CMP #$08
- BCC SHR2
- LDY ESTKH+1,X
- STY ESTKL+1,X
- CPY #$80
- LDY #$00
- BCC SHR1
- DEY
-SHR1 STY ESTKH+1,X
- SEC
- SBC #$08
-SHR2 TAY
- BEQ SHR4
- LDA ESTKH+1,X
-SHR3 CMP #$80
- ROR
- ROR ESTKL+1,X
- DEY
- BNE SHR3
- STA ESTKH+1,X
-SHR4 INX
- LDY IPY
- JMP NEXTOP
+SHR STY IPY
+ LDA ESTKL,X
+ CMP #$08
+ BCC SHR2
+ LDY ESTKH+1,X
+ STY ESTKL+1,X
+ CPY #$80
+ LDY #$00
+ BCC SHR1
+ DEY
+SHR1 STY ESTKH+1,X
+ SEC
+ SBC #$08
+SHR2 TAY
+ BEQ SHR4
+ LDA ESTKH+1,X
+SHR3 CMP #$80
+ ROR
+ ROR ESTKL+1,X
+ DEY
+ BNE SHR3
+ STA ESTKH+1,X
+SHR4 LDY IPY
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* LOGICAL NOT
;*
-LNOT LDA ESTKL,X
- ORA ESTKH,X
- BEQ LNOT1
- LDA #$FF
-LNOT1 EOR #$FF
- STA ESTKL,X
- STA ESTKH,X
- JMP NEXTOP
+LNOT LDA ESTKL,X
+ ORA ESTKH,X
+ BEQ LNOT1
+ LDA #$FF
+LNOT1 EOR #$FF
+ STA ESTKL,X
+ STA ESTKH,X
+ JMP NEXTOP
;*
;* LOGICAL AND
;*
-LAND LDA ESTKL+1,X
- ORA ESTKH+1,X
- BEQ LAND2
- LDA ESTKL,X
- ORA ESTKH,X
- BEQ LAND1
- LDA #$FF
-LAND1 STA ESTKL+1,X
- STA ESTKH+1,X
-LAND2 INX
- JMP NEXTOP
+LAND LDA ESTKL+1,X
+ ORA ESTKH+1,X
+ BEQ LAND2
+ LDA ESTKL,X
+ ORA ESTKH,X
+ BEQ LAND1
+ LDA #$FF
+LAND1 STA ESTKL+1,X
+ STA ESTKH+1,X
+;LAND2 INX
+; JMP NEXTOP
+LAND2 JMP DROP
;*
;* LOGICAL OR
;*
-LOR LDA ESTKL,X
- ORA ESTKH,X
- ORA ESTKL+1,X
- ORA ESTKH+1,X
- BEQ LOR1
- LDA #$FF
- STA ESTKL+1,X
- STA ESTKH+1,X
-LOR1 INX
- JMP NEXTOP
+LOR LDA ESTKL,X
+ ORA ESTKH,X
+ ORA ESTKL+1,X
+ ORA ESTKH+1,X
+ BEQ LOR1
+ LDA #$FF
+ STA ESTKL+1,X
+ STA ESTKH+1,X
+;LOR1 INX
+; JMP NEXTOP
+LOR1 JMP DROP
;*
;* DUPLICATE TOS
;*
-DUP DEX
- LDA ESTKL+1,X
- STA ESTKL,X
- LDA ESTKH+1,X
- STA ESTKH,X
- JMP NEXTOP
+DUP DEX
+ LDA ESTKL+1,X
+ STA ESTKL,X
+ LDA ESTKH+1,X
+ STA ESTKH,X
+ JMP NEXTOP
;*
-;* PUSH FROM EVAL STACK TO CALL STACK
+;* PUSH EVAL STACK POINTER TO CALL STACK
;*
-PUSH LDA ESTKL,X
- PHA
- LDA ESTKH,X
- PHA
- INX
- JMP NEXTOP
+PUSHEP TXA
+ PHA
+ JMP NEXTOP
;*
-;* PULL FROM CALL STACK TO EVAL STACK
+;* PULL EVAL STACK POINTER FROM CALL STACK
;*
-PULL DEX
- PLA
- STA ESTKH,X
- PLA
- STA ESTKL,X
- JMP NEXTOP
+PULLEP PLA
+ TAX
+ JMP NEXTOP
;*
;* CONSTANT
;*
-ZERO DEX
- LDA #$00
- STA ESTKL,X
- STA ESTKH,X
- JMP NEXTOP
-CB DEX
- +INC_IP
- LDA (IP),Y
- STA ESTKL,X
- LDA #$00
- STA ESTKH,X
- JMP NEXTOP
+ZERO DEX
+ LDA #$00
+ STA ESTKL,X
+ STA ESTKH,X
+ JMP NEXTOP
+CB DEX
+ +INC_IP
+ LDA (IP),Y
+ STA ESTKL,X
+ LDA #$00
+ STA ESTKH,X
+ JMP NEXTOP
;*
;* LOAD ADDRESS & LOAD CONSTANT WORD (SAME THING, WITH OR WITHOUT FIXUP)
;*
-LA = *
-CW DEX
- +INC_IP
- LDA (IP),Y
- STA ESTKL,X
- +INC_IP
- LDA (IP),Y
- STA ESTKH,X
- JMP NEXTOP
+LA = *
+CW DEX
+ +INC_IP
+ LDA (IP),Y
+ STA ESTKL,X
+ +INC_IP
+ LDA (IP),Y
+ STA ESTKH,X
+ JMP NEXTOP
;*
;* CONSTANT STRING
;*
-CS DEX
- +INC_IP
- TYA ; NORMALIZE IP AND SAVE STRING ADDR ON ESTK
- CLC
- ADC IPL
- STA IPL
- STA ESTKL,X
- LDA #$00
- TAY
- ADC IPH
- STA IPH
- STA ESTKH,X
- LDA (IP),Y
- TAY
- JMP NEXTOP
+CS DEX
+ +INC_IP
+ TYA ; NORMALIZE IP AND SAVE STRING ADDR ON ESTK
+ CLC
+ ADC IPL
+ STA IPL
+ STA ESTKL,X
+ LDA #$00
+ TAY
+ ADC IPH
+ STA IPH
+ STA ESTKH,X
+ LDA (IP),Y
+ TAY
+ JMP NEXTOP
;*
;* LOAD VALUE FROM ADDRESS TAG
;*
-LB LDA ESTKL,X
- STA TMPL
- LDA ESTKH,X
- STA TMPH
- STY IPY
- LDY #$00
- LDA (TMP),Y
- STA ESTKL,X
- STY ESTKH,X
- LDY IPY
- JMP NEXTOP
-LW LDA ESTKL,X
- STA TMPL
- LDA ESTKH,X
- STA TMPH
- STY IPY
- LDY #$00
- LDA (TMP),Y
- STA ESTKL,X
- INY
- LDA (TMP),Y
- STA ESTKH,X
- LDY IPY
- JMP NEXTOP
+LB LDA ESTKL,X
+ STA TMPL
+ LDA ESTKH,X
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA (TMP),Y
+ STA ESTKL,X
+ STY ESTKH,X
+ LDY IPY
+ JMP NEXTOP
+LW LDA ESTKL,X
+ STA TMPL
+ LDA ESTKH,X
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA (TMP),Y
+ STA ESTKL,X
+ INY
+ LDA (TMP),Y
+ STA ESTKH,X
+ LDY IPY
+ JMP NEXTOP
;*
;* LOAD ADDRESS OF LOCAL FRAME OFFSET
;*
-LLA +INC_IP
- LDA (IP),Y
- DEX
- CLC
- ADC IFPL
- STA ESTKL,X
- LDA #$00
- ADC IFPH
- STA ESTKH,X
- JMP NEXTOP
+LLA +INC_IP
+ LDA (IP),Y
+ DEX
+ CLC
+ ADC IFPL
+ STA ESTKL,X
+ LDA #$00
+ ADC IFPH
+ STA ESTKH,X
+ JMP NEXTOP
;*
;* LOAD VALUE FROM LOCAL FRAME OFFSET
;*
-LLB +INC_IP
- LDA (IP),Y
- STY IPY
- TAY
- DEX
- LDA (IFP),Y
- STA ESTKL,X
- LDA #$00
- STA ESTKH,X
- LDY IPY
- JMP NEXTOP
-LLW +INC_IP
- LDA (IP),Y
- STY IPY
- TAY
- DEX
- LDA (IFP),Y
- STA ESTKL,X
- INY
- LDA (IFP),Y
- STA ESTKH,X
- LDY IPY
- JMP NEXTOP
+LLB +INC_IP
+ LDA (IP),Y
+ STY IPY
+ TAY
+ DEX
+ LDA (IFP),Y
+ STA ESTKL,X
+ LDA #$00
+ STA ESTKH,X
+ LDY IPY
+ JMP NEXTOP
+LLW +INC_IP
+ LDA (IP),Y
+ STY IPY
+ TAY
+ DEX
+ LDA (IFP),Y
+ STA ESTKL,X
+ INY
+ LDA (IFP),Y
+ STA ESTKH,X
+ LDY IPY
+ JMP NEXTOP
;*
;* LOAD VALUE FROM ABSOLUTE ADDRESS
;*
-LAB +INC_IP
- LDA (IP),Y
- STA TMPL
- +INC_IP
- LDA (IP),Y
- STA TMPH
- STY IPY
- LDY #$00
- LDA (TMP),Y
- DEX
- STA ESTKL,X
- STY ESTKH,X
- LDY IPY
- JMP NEXTOP
-LAW +INC_IP
- LDA (IP),Y
- STA TMPL
- +INC_IP
- LDA (IP),Y
- STA TMPH
- STY IPY
- LDY #$00
- LDA (TMP),Y
- DEX
- STA ESTKL,X
- INY
- LDA (TMP),Y
- STA ESTKH,X
- LDY IPY
- JMP NEXTOP
+LAB +INC_IP
+ LDA (IP),Y
+ STA TMPL
+ +INC_IP
+ LDA (IP),Y
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA (TMP),Y
+ DEX
+ STA ESTKL,X
+ STY ESTKH,X
+ LDY IPY
+ JMP NEXTOP
+LAW +INC_IP
+ LDA (IP),Y
+ STA TMPL
+ +INC_IP
+ LDA (IP),Y
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA (TMP),Y
+ DEX
+ STA ESTKL,X
+ INY
+ LDA (TMP),Y
+ STA ESTKH,X
+ LDY IPY
+ JMP NEXTOP
;*
;* STORE VALUE TO ADDRESS
;*
-SB LDA ESTKL+1,X
- STA TMPL
- LDA ESTKH+1,X
- STA TMPH
- LDA ESTKL,X
- STY IPY
- LDY #$00
- STA (TMP),Y
- INX
- INX
- LDY IPY
- JMP NEXTOP
-SW LDA ESTKL+1,X
- STA TMPL
- LDA ESTKH+1,X
- STA TMPH
- STY IPY
- LDY #$00
- LDA ESTKL,X
- STA (TMP),Y
- INY
- LDA ESTKH,X
- STA (TMP),Y
- INX
- INX
- LDY IPY
- JMP NEXTOP
+SB LDA ESTKL,X
+ STA TMPL
+ LDA ESTKH,X
+ STA TMPH
+ LDA ESTKL+1,X
+ STY IPY
+ LDY #$00
+ STA (TMP),Y
+ LDY IPY
+ INX
+; INX
+; JMP NEXTOP
+ JMP DROP
+SW LDA ESTKL,X
+ STA TMPL
+ LDA ESTKH,X
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA ESTKL+1,X
+ STA (TMP),Y
+ INY
+ LDA ESTKH+1,X
+ STA (TMP),Y
+ LDY IPY
+ INX
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* STORE VALUE TO LOCAL FRAME OFFSET
;*
-SLB +INC_IP
- LDA (IP),Y
- STY IPY
- TAY
- LDA ESTKL,X
- STA (IFP),Y
- INX
- LDY IPY
- JMP NEXTOP
-SLW +INC_IP
- LDA (IP),Y
- STY IPY
- TAY
- LDA ESTKL,X
- STA (IFP),Y
- INY
- LDA ESTKH,X
- STA (IFP),Y
- INX
- LDY IPY
- JMP NEXTOP
+SLB +INC_IP
+ LDA (IP),Y
+ STY IPY
+ TAY
+ LDA ESTKL,X
+ STA (IFP),Y
+ LDY IPY
+; INX
+; JMP NEXTOP
+ JMP DROP
+SLW +INC_IP
+ LDA (IP),Y
+ STY IPY
+ TAY
+ LDA ESTKL,X
+ STA (IFP),Y
+ INY
+ LDA ESTKH,X
+ STA (IFP),Y
+ LDY IPY
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* STORE VALUE TO LOCAL FRAME OFFSET WITHOUT POPPING STACK
;*
-DLB +INC_IP
- LDA (IP),Y
- STY IPY
- TAY
- LDA ESTKL,X
- STA (IFP),Y
- LDY IPY
- JMP NEXTOP
-DLW +INC_IP
- LDA (IP),Y
- STY IPY
- TAY
- LDA ESTKL,X
- STA (IFP),Y
- INY
- LDA ESTKH,X
- STA (IFP),Y
- LDY IPY
- JMP NEXTOP
+DLB +INC_IP
+ LDA (IP),Y
+ STY IPY
+ TAY
+ LDA ESTKL,X
+ STA (IFP),Y
+ LDY IPY
+ JMP NEXTOP
+DLW +INC_IP
+ LDA (IP),Y
+ STY IPY
+ TAY
+ LDA ESTKL,X
+ STA (IFP),Y
+ INY
+ LDA ESTKH,X
+ STA (IFP),Y
+ LDY IPY
+ JMP NEXTOP
;*
;* STORE VALUE TO ABSOLUTE ADDRESS
;*
-SAB +INC_IP
- LDA (IP),Y
- STA TMPL
- +INC_IP
- LDA (IP),Y
- STA TMPH
- LDA ESTKL,X
- STY IPY
- LDY #$00
- STA (TMP),Y
- INX
- LDY IPY
- JMP NEXTOP
-SAW +INC_IP
- LDA (IP),Y
- STA TMPL
- +INC_IP
- LDA (IP),Y
- STA TMPH
- STY IPY
- LDY #$00
- LDA ESTKL,X
- STA (TMP),Y
- INY
- LDA ESTKH,X
- STA (TMP),Y
- INX
- LDY IPY
- JMP NEXTOP
+SAB +INC_IP
+ LDA (IP),Y
+ STA TMPL
+ +INC_IP
+ LDA (IP),Y
+ STA TMPH
+ LDA ESTKL,X
+ STY IPY
+ LDY #$00
+ STA (TMP),Y
+ LDY IPY
+; INX
+; JMP NEXTOP
+ JMP DROP
+SAW +INC_IP
+ LDA (IP),Y
+ STA TMPL
+ +INC_IP
+ LDA (IP),Y
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA ESTKL,X
+ STA (TMP),Y
+ INY
+ LDA ESTKH,X
+ STA (TMP),Y
+ LDY IPY
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* STORE VALUE TO ABSOLUTE ADDRESS WITHOUT POPPING STACK
;*
-DAB +INC_IP
- LDA (IP),Y
- STA TMPL
- +INC_IP
- LDA (IP),Y
- STA TMPH
- STY IPY
- LDY #$00
- LDA ESTKL,X
- STA (TMP),Y
- LDY IPY
- JMP NEXTOP
-DAW +INC_IP
- LDA (IP),Y
- STA TMPL
- +INC_IP
- LDA (IP),Y
- STA TMPH
- STY IPY
- LDY #$00
- LDA ESTKL,X
- STA (TMP),Y
- INY
- LDA ESTKH,X
- STA (TMP),Y
- LDY IPY
- JMP NEXTOP
+DAB +INC_IP
+ LDA (IP),Y
+ STA TMPL
+ +INC_IP
+ LDA (IP),Y
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA ESTKL,X
+ STA (TMP),Y
+ LDY IPY
+ JMP NEXTOP
+DAW +INC_IP
+ LDA (IP),Y
+ STA TMPL
+ +INC_IP
+ LDA (IP),Y
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA ESTKL,X
+ STA (TMP),Y
+ INY
+ LDA ESTKH,X
+ STA (TMP),Y
+ LDY IPY
+ JMP NEXTOP
;*
;* COMPARES
;*
-ISEQ LDA ESTKL,X
- CMP ESTKL+1,X
- BNE ISFLS
- LDA ESTKH,X
- CMP ESTKH+1,X
- BNE ISFLS
-ISTRU LDA #$FF
- INX
- STA ESTKL,X
- STA ESTKH,X
- JMP NEXTOP
+ISEQ LDA ESTKL,X
+ CMP ESTKL+1,X
+ BNE ISFLS
+ LDA ESTKH,X
+ CMP ESTKH+1,X
+ BNE ISFLS
+ISTRU LDA #$FF
+ STA ESTKL+1,X
+ STA ESTKH+1,X
+; INX
+; JMP NEXTOP
+ JMP DROP
;
-ISNE LDA ESTKL,X
- CMP ESTKL+1,X
- BNE ISTRU
- LDA ESTKH,X
- CMP ESTKH+1,X
- BNE ISTRU
-ISFLS LDA #$00
- INX
- STA ESTKL,X
- STA ESTKH,X
- JMP NEXTOP
+ISNE LDA ESTKL,X
+ CMP ESTKL+1,X
+ BNE ISTRU
+ LDA ESTKH,X
+ CMP ESTKH+1,X
+ BNE ISTRU
+ISFLS LDA #$00
+ STA ESTKL+1,X
+ STA ESTKH+1,X
+; INX
+; JMP NEXTOP
+ JMP DROP
;
-ISGE LDA ESTKL+1,X
- CMP ESTKL,X
- LDA ESTKH+1,X
- SBC ESTKH,X
- BVC ISGE1
- EOR #$80
-ISGE1 BPL ISTRU
- BMI ISFLS
+ISGE LDA ESTKL+1,X
+ CMP ESTKL,X
+ LDA ESTKH+1,X
+ SBC ESTKH,X
+ BVC ISGE1
+ EOR #$80
+ISGE1 BPL ISTRU
+ BMI ISFLS
;
-ISGT LDA ESTKL,X
- CMP ESTKL+1,X
- LDA ESTKH,X
- SBC ESTKH+1,X
- BVC ISGT1
- EOR #$80
-ISGT1 BMI ISTRU
- BPL ISFLS
+ISGT LDA ESTKL,X
+ CMP ESTKL+1,X
+ LDA ESTKH,X
+ SBC ESTKH+1,X
+ BVC ISGT1
+ EOR #$80
+ISGT1 BMI ISTRU
+ BPL ISFLS
;
-ISLE LDA ESTKL,X
- CMP ESTKL+1,X
- LDA ESTKH,X
- SBC ESTKH+1,X
- BVC ISLE1
- EOR #$80
-ISLE1 BPL ISTRU
- BMI ISFLS
+ISLE LDA ESTKL,X
+ CMP ESTKL+1,X
+ LDA ESTKH,X
+ SBC ESTKH+1,X
+ BVC ISLE1
+ EOR #$80
+ISLE1 BPL ISTRU
+ BMI ISFLS
;
-ISLT LDA ESTKL+1,X
- CMP ESTKL,X
- LDA ESTKH+1,X
- SBC ESTKH,X
- BVC ISLT1
- EOR #$80
-ISLT1 BMI ISTRU
- BPL ISFLS
+ISLT LDA ESTKL+1,X
+ CMP ESTKL,X
+ LDA ESTKH+1,X
+ SBC ESTKH,X
+ BVC ISLT1
+ EOR #$80
+ISLT1 BMI ISTRU
+ BPL ISFLS
;*
;* BRANCHES
;*
-BRTRU INX
- LDA ESTKH-1,X
- ORA ESTKL-1,X
- BNE BRNCH
-NOBRNCH +INC_IP
- +INC_IP
- JMP NEXTOP
-BRFLS INX
- LDA ESTKH-1,X
- ORA ESTKL-1,X
- BNE NOBRNCH
-BRNCH LDA IPH
- STA TMPH
- LDA IPL
- +INC_IP
- CLC
- ADC (IP),Y
- STA TMPL
- LDA TMPH
- +INC_IP
- ADC (IP),Y
- STA IPH
- LDA TMPL
- STA IPL
- DEY
- DEY
- JMP NEXTOP
-BREQ INX
- LDA ESTKL-1,X
- CMP ESTKL,X
- BNE NOBRNCH
- LDA ESTKH-1,X
- CMP ESTKH,X
- BEQ BRNCH
- BNE NOBRNCH
-BRNE INX
- LDA ESTKL-1,X
- CMP ESTKL,X
- BNE BRNCH
- LDA ESTKH-1,X
- CMP ESTKH,X
- BEQ NOBRNCH
- BNE BRNCH
-BRGT INX
- LDA ESTKL-1,X
- CMP ESTKL,X
- LDA ESTKH-1,X
- SBC ESTKH,X
- BMI BRNCH
- BPL NOBRNCH
-BRLT INX
- LDA ESTKL,X
- CMP ESTKL-1,X
- LDA ESTKH,X
- SBC ESTKH-1,X
- BMI BRNCH
- BPL NOBRNCH
-IBRNCH LDA IPL
- CLC
- ADC ESTKL,X
- STA IPL
- LDA IPH
- ADC ESTKH,X
- STA IPH
- INX
- JMP NEXTOP
+BRTRU INX
+ LDA ESTKH-1,X
+ ORA ESTKL-1,X
+ BNE BRNCH
+NOBRNCH +INC_IP
+ +INC_IP
+ JMP NEXTOP
+BRFLS INX
+ LDA ESTKH-1,X
+ ORA ESTKL-1,X
+ BNE NOBRNCH
+BRNCH LDA IPH
+ STA TMPH
+ LDA IPL
+ +INC_IP
+ CLC
+ ADC (IP),Y
+ STA TMPL
+ LDA TMPH
+ +INC_IP
+ ADC (IP),Y
+ STA IPH
+ LDA TMPL
+ STA IPL
+ DEY
+ DEY
+ JMP NEXTOP
+BREQ INX
+ LDA ESTKL-1,X
+ CMP ESTKL,X
+ BNE NOBRNCH
+ LDA ESTKH-1,X
+ CMP ESTKH,X
+ BEQ BRNCH
+ BNE NOBRNCH
+BRNE INX
+ LDA ESTKL-1,X
+ CMP ESTKL,X
+ BNE BRNCH
+ LDA ESTKH-1,X
+ CMP ESTKH,X
+ BEQ NOBRNCH
+ BNE BRNCH
+BRGT INX
+ LDA ESTKL-1,X
+ CMP ESTKL,X
+ LDA ESTKH-1,X
+ SBC ESTKH,X
+ BMI BRNCH
+ BPL NOBRNCH
+BRLT INX
+ LDA ESTKL,X
+ CMP ESTKL-1,X
+ LDA ESTKH,X
+ SBC ESTKH-1,X
+ BMI BRNCH
+ BPL NOBRNCH
+IBRNCH LDA IPL
+ CLC
+ ADC ESTKL,X
+ STA IPL
+ LDA IPH
+ ADC ESTKH,X
+ STA IPH
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* CALL INTO ABSOLUTE ADDRESS (NATIVE CODE)
;*
-CALL +INC_IP
- LDA (IP),Y
- STA CALLADR+1
- +INC_IP
- LDA (IP),Y
- STA CALLADR+2
- LDA IPH
- PHA
- LDA IPL
- PHA
- TYA
- PHA
-CALLADR JSR $FFFF
- PLA
- TAY
- PLA
- STA IPL
- PLA
- STA IPH
- JMP NEXTOP
+CALL +INC_IP
+ LDA (IP),Y
+ STA CALLADR+1
+ +INC_IP
+ LDA (IP),Y
+ STA CALLADR+2
+ LDA IPH
+ PHA
+ LDA IPL
+ PHA
+ TYA
+ PHA
+CALLADR JSR $FFFF
+ PLA
+ TAY
+ PLA
+ STA IPL
+ PLA
+ STA IPH
+ JMP NEXTOP
;*
;* INDIRECT CALL TO ADDRESS (NATIVE CODE)
;*
-ICAL LDA ESTKL,X
- STA ICALADR+1
- LDA ESTKH,X
- STA ICALADR+2
- INX
- LDA IPH
- PHA
- LDA IPL
- PHA
- TYA
- PHA
-ICALADR JSR $FFFF
- PLA
- TAY
- PLA
- STA IPL
- PLA
- STA IPH
- JMP NEXTOP
+ICAL LDA ESTKL,X
+ STA ICALADR+1
+ LDA ESTKH,X
+ STA ICALADR+2
+ INX
+ LDA IPH
+ PHA
+ LDA IPL
+ PHA
+ TYA
+ PHA
+ICALADR JSR $FFFF
+ PLA
+ TAY
+ PLA
+ STA IPL
+ PLA
+ STA IPH
+ JMP NEXTOP
;*
;* ENTER FUNCTION WITH FRAME SIZE AND PARAM COUNT
;*
-ENTER INY
- LDA (IP),Y
- PHA ; SAVE ON STACK FOR LEAVE
- EOR #$FF
- SEC
- ADC IFPL
- STA IFPL
- BCS +
- DEC IFPH
-+ INY
- LDA (IP),Y
- ASL
- TAY
- BEQ +
-- LDA ESTKH,X
- DEY
- STA (IFP),Y
- LDA ESTKL,X
- INX
- DEY
- STA (IFP),Y
- BNE -
-+ LDY #$02
- JMP NEXTOP
+ENTER INY
+ LDA (IP),Y
+ PHA ; SAVE ON STACK FOR LEAVE
+ EOR #$FF
+ SEC
+ ADC IFPL
+ STA IFPL
+ BCS +
+ DEC IFPH
++ INY
+ LDA (IP),Y
+ ASL
+ TAY
+ BEQ +
+- LDA ESTKH,X
+ DEY
+ STA (IFP),Y
+ LDA ESTKL,X
+ INX
+ DEY
+ STA (IFP),Y
+ BNE -
++ LDY #$02
+ JMP NEXTOP
;*
;* LEAVE FUNCTION
;*
-LEAVE PLA
- CLC
- ADC IFPL
- STA IFPL
- BCS LIFPH
- RTS
-LIFPH INC IFPH
-RET RTS
-A1CMD !SOURCE "vmsrc/a1cmd.a"
-SEGEND = *
-VMINIT LDY #$10 ; INSTALL PAGE 0 FETCHOP ROUTINE
-- LDA PAGE0-1,Y
- STA DROP-1,Y
- DEY
- BNE -
- STY IFPL ; INIT FRAME POINTER
- LDA #$80
- STA IFPH
- LDA #SEGEND
- STA SRCH
- LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX
- JMP A1CMD
-PAGE0 = *
- !PSEUDOPC $00EF {
+LEAVE PLA
+ CLC
+ ADC IFPL
+ STA IFPL
+ BCS LIFPH
+ RTS
+LIFPH INC IFPH
+RET RTS
+A1CMD !SOURCE "vmsrc/a1cmd.a"
+SEGEND = *
+VMINIT LDY #$10 ; INSTALL PAGE 0 FETCHOP ROUTINE
+- LDA PAGE0-1,Y
+ STA DROP-1,Y
+ DEY
+ BNE -
+ STY IFPL ; INIT FRAME POINTER
+ LDA #$80
+ STA IFPH
+ LDA #SEGEND
+ STA SRCH
+ LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX
+ JMP A1CMD
+PAGE0 = *
+ !PSEUDOPC $00EF {
;*
;* INTERP BYTECODE INNER LOOP
;*
- INX ; DROP
- INY ; NEXTOP
- BEQ NEXTOPH
- LDA $FFFF,Y ; FETCHOP @ $F3, IP MAPS OVER $FFFF @ $F4
- STA OPIDX
- JMP (OPTBL)
-NEXTOPH INC IPH
- BNE FETCHOP
+ INX ; DROP
+ INY ; NEXTOP
+ BEQ NEXTOPH
+ LDA $FFFF,Y ; FETCHOP @ $F3, IP MAPS OVER $FFFF @ $F4
+ STA OPIDX
+ JMP (OPTBL)
+NEXTOPH INC IPH
+ BNE FETCHOP
}
diff --git a/src/vmsrc/plvm02.s b/src/vmsrc/plvm02.s
old mode 100644
new mode 100755
index a4f567b..7aeb36a
--- a/src/vmsrc/plvm02.s
+++ b/src/vmsrc/plvm02.s
@@ -1,64 +1,64 @@
;**********************************************************
;*
-;* APPLE ][ 64K/128K PLASMA INTERPETER
+;* APPLE ][ 64K/128K PLASMA INTERPRETER
;*
-;* SYSTEM ROUTINES AND LOCATIONS
+;* SYSTEM ROUTINES AND LOCATIONS
;*
;**********************************************************
;*
;* MONITOR SPECIAL LOCATIONS
;*
-CSWL = $36
-CSWH = $37
-PROMPT = $33
+CSWL = $36
+CSWH = $37
+PROMPT = $33
;*
;* PRODOS
;*
-PRODOS = $BF00
-DEVCNT = $BF31 ; GLOBAL PAGE DEVICE COUNT
-DEVLST = $BF32 ; GLOBAL PAGE DEVICE LIST
-MACHID = $BF98 ; GLOBAL PAGE MACHINE ID BYTE
-RAMSLOT = $BF26 ; SLOT 3, DRIVE 2 IS /RAM'S DRIVER VECTOR
-NODEV = $BF10
+PRODOS = $BF00
+DEVCNT = $BF31 ; GLOBAL PAGE DEVICE COUNT
+DEVLST = $BF32 ; GLOBAL PAGE DEVICE LIST
+MACHID = $BF98 ; GLOBAL PAGE MACHINE ID BYTE
+RAMSLOT = $BF26 ; SLOT 3, DRIVE 2 IS /RAM'S DRIVER VECTOR
+NODEV = $BF10
;*
;* HARDWARE ADDRESSES
;*
-KEYBD = $C000
-CLRKBD = $C010
-SPKR = $C030
-LCRDEN = $C080
-LCWTEN = $C081
-ROMEN = $C082
-LCRWEN = $C083
-LCBNK2 = $00
-LCBNK1 = $08
-ALTZPOFF= $C008
-ALTZPON = $C009
-ALTRDOFF= $C002
-ALTRDON = $C003
-ALTWROFF= $C004
-ALTWRON = $C005
- !SOURCE "vmsrc/plvmzp.inc"
-STRBUF = $0280
-INTERP = $03D0
+KEYBD = $C000
+CLRKBD = $C010
+SPKR = $C030
+LCRDEN = $C080
+LCWTEN = $C081
+ROMEN = $C082
+LCRWEN = $C083
+LCBNK2 = $00
+LCBNK1 = $08
+ALTZPOFF= $C008
+ALTZPON = $C009
+ALTRDOFF= $C002
+ALTRDON = $C003
+ALTWROFF= $C004
+ALTWRON = $C005
+ !SOURCE "vmsrc/plvmzp.inc"
+STRBUF = $0280
+INTERP = $03D0
;*
;* INTERPRETER INSTRUCTION POINTER INCREMENT MACRO
;*
!MACRO INC_IP {
INY
- BNE * + 4
- INC IPH
+ BNE * + 4
+ INC IPH
}
;******************************
;* *
;* INTERPRETER INITIALIZATION *
;* *
;******************************
-* = $2000
- LDX #$FE
+* = $2000
+ LDX #$FE
TXS
- LDX #$00
- STX $01FF
+ LDX #$00
+ STX $01FF
;*
;* DISCONNECT /RAM
;*
@@ -73,25 +73,25 @@ INTERP = $03D0
LDA RAMSLOT+1
CMP NODEV+1
BEQ RAMDONE
-RAMCONT LDY DEVCNT
-RAMLOOP LDA DEVLST,Y
+RAMCONT LDY DEVCNT
+RAMLOOP LDA DEVLST,Y
AND #$F3
CMP #$B3
BEQ GETLOOP
DEY
BPL RAMLOOP
BMI RAMDONE
-GETLOOP LDA DEVLST+1,Y
+GETLOOP LDA DEVLST+1,Y
STA DEVLST,Y
BEQ RAMEXIT
INY
BNE GETLOOP
-RAMEXIT LDA NODEV
+RAMEXIT LDA NODEV
STA RAMSLOT
LDA NODEV+1
STA RAMSLOT+1
DEC DEVCNT
-RAMDONE CLI
+RAMDONE CLI
;*
;* MOVE VM INTO LANGUAGE CARD
;*
@@ -105,7 +105,7 @@ RAMDONE CLI
STY DSTL
LDA #$D0
STA DSTH
-- LDA (SRC),Y ; COPY VM+CMD INTO LANGUAGE CARD
+- LDA (SRC),Y ; COPY VM+CMD INTO LANGUAGE CARD
STA (DST),Y
INY
BNE -
@@ -117,7 +117,7 @@ RAMDONE CLI
;*
;* MOVE FIRST PAGE OF 'BYE' INTO PLACE
;*
- STY SRCL
+ STY SRCL
LDA #$D1
STA SRCH
- LDA (SRC),Y
@@ -127,7 +127,7 @@ RAMDONE CLI
;*
;* SAVE DEFAULT COMMAND INTERPRETER PATH IN LC
;*
- JSR PRODOS ; GET PREFIX
+ JSR PRODOS ; GET PREFIX
!BYTE $C7
!WORD GETPFXPARMS
LDY STRBUF ; APPEND "CMD"
@@ -146,13 +146,13 @@ RAMDONE CLI
INY
STA STRBUF,Y
STY STRBUF
- BIT LCRWEN+LCBNK2 ; COPY TO LC FOR BYE
+ BIT LCRWEN+LCBNK2 ; COPY TO LC FOR BYE
BIT LCRWEN+LCBNK2
- LDA STRBUF,Y
STA LCDEFCMD,Y
DEY
BPL -
- JMP CMDENTRY
+ JMP CMDENTRY
GETPFXPARMS !BYTE 1
!WORD STRBUF ; PATH STRING GOES HERE
;************************************************
@@ -160,7 +160,7 @@ GETPFXPARMS !BYTE 1
;* LANGUAGE CARD RESIDENT PLASMA VM STARTS HERE *
;* *
;************************************************
-VMCORE = *
+VMCORE = *
!PSEUDOPC $D000 {
;****************
;* *
@@ -168,12 +168,12 @@ VMCORE = *
;* *
;****************
!ALIGN 255,0
-OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E
+OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E
!WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E
!WORD LNOT,LOR,LAND,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E
- !WORD DROP,DUP,PUSH,PULL,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E
+ !WORD DROP,DUP,PUSHEP,PULLEP,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E
!WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E
- !WORD BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,NEXTOP ; 50 52 54 56 58 5A 5C 5E
+ !WORD BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,NEXTOP ; 50 52 54 56 58 5A 5C 5E
!WORD LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E
!WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E
;*
@@ -182,10 +182,10 @@ OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E
DINTRP PLA
CLC
ADC #$01
- STA IPL
- PLA
+ STA IPL
+ PLA
ADC #$00
- STA IPH
+ STA IPH
LDA IFPH
PHA ; SAVE ON STACK FOR LEAVE/RET
LDA IFPL
@@ -199,16 +199,16 @@ DINTRP PLA
STA OPPAGE
JMP FETCHOP
IINTRP PLA
- STA TMPL
- PLA
- STA TMPH
+ STA TMPL
+ PLA
+ STA TMPH
LDY #$02
- LDA (TMP),Y
- STA IPH
+ LDA (TMP),Y
+ STA IPH
DEY
- LDA (TMP),Y
+ LDA (TMP),Y
STA IPL
- DEY
+ DEY
LDA IFPH
PHA ; SAVE ON STACK FOR LEAVE/RET
LDA IFPL
@@ -219,18 +219,18 @@ IINTRP PLA
STA IFPH
LDA #>OPTBL
STA OPPAGE
- JMP FETCHOP
-IINTRPX PLA
- STA TMPL
- PLA
- STA TMPH
+ JMP FETCHOP
+IINTRPX PLA
+ STA TMPL
+ PLA
+ STA TMPH
LDY #$02
- LDA (TMP),Y
- STA IPH
+ LDA (TMP),Y
+ STA IPH
DEY
- LDA (TMP),Y
+ LDA (TMP),Y
STA IPL
- DEY
+ DEY
LDA IFPH
PHA ; SAVE ON STACK FOR LEAVE/RET
LDA IFPL
@@ -277,7 +277,7 @@ CMDENTRY = *
; INSTALL PAGE 0 FETCHOP ROUTINE
;
LDY #$0F
-- LDA PAGE0,Y
+- LDA PAGE0,Y
STA DROP,Y
DEY
BPL -
@@ -285,35 +285,35 @@ CMDENTRY = *
; INSTALL PAGE 3 VECTORS
;
LDY #$12
-- LDA PAGE3,Y
+- LDA PAGE3,Y
STA INTERP,Y
DEY
BPL -
;
; READ CMD INTO MEMORY
;
- JSR PRODOS ; CLOSE EVERYTHING
+ JSR PRODOS ; CLOSE EVERYTHING
!BYTE $CC
!WORD CLOSEPARMS
- BNE FAIL
- JSR PRODOS ; OPEN CMD
+ BNE FAIL
+ JSR PRODOS ; OPEN CMD
!BYTE $C8
!WORD OPENPARMS
BNE FAIL
- LDA REFNUM
- STA READPARMS+1
- JSR PRODOS
+ LDA REFNUM
+ STA READPARMS+1
+ JSR PRODOS
!BYTE $CA
!WORD READPARMS
- BNE FAIL
- JSR PRODOS
+ BNE FAIL
+ JSR PRODOS
!BYTE $CC
!WORD CLOSEPARMS
- BNE FAIL
+ BNE FAIL
;
; INIT VM ENVIRONMENT STACK POINTERS
;
-; LDA #$00 ; INIT FRAME POINTER
+; LDA #$00 ; INIT FRAME POINTER
STA PPL
STA IFPL
LDA #$BF
@@ -321,8 +321,8 @@ CMDENTRY = *
STA IFPH
LDX #$FE ; INIT STACK POINTER (YES, $FE. SEE GETS)
TXS
- LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX
- JMP $2000 ; JUMP TO LOADED SYSTEM COMMAND
+ LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX
+ JMP $2000 ; JUMP TO LOADED SYSTEM COMMAND
;
; PRINT FAIL MESSAGE, WAIT FOR KEYPRESS, AND REBOOT
;
@@ -335,33 +335,33 @@ FAIL INC $3F4 ; INVALIDATE POWER-UP BYTE
BPL -
JSR $FD0C ; WAIT FOR KEYPRESS
JMP ($FFFC) ; RESET
-OPENPARMS !BYTE 3
+OPENPARMS !BYTE 3
!WORD STRBUF
!WORD $0800
REFNUM !BYTE 0
-READPARMS !BYTE 4
+READPARMS !BYTE 4
!BYTE 0
!WORD $2000
!WORD $9F00
!WORD 0
CLOSEPARMS !BYTE 1
!BYTE 0
-DISABLE80 !BYTE 21, 13, '1', 26, 13
+DISABLE80 !BYTE 21, 13, '1', 26, 13
FAILMSG !TEXT "...TESER OT YEK YNA .DMC GNISSIM"
-PAGE0 = *
+PAGE0 = *
;******************************
;* *
;* INTERP BYTECODE INNER LOOP *
;* *
;******************************
- !PSEUDOPC $00EF {
+ !PSEUDOPC $00EF {
INX ; DROP @ $EF
- INY ; NEXTOP @ $F0
+ INY ; NEXTOP @ $F0
BEQ NEXTOPH
LDA $FFFF,Y ; FETCHOP @ $F3, IP MAPS OVER $FFFF @ $F4
STA OPIDX
JMP (OPTBL) ; OPIDX AND OPPAGE MAP OVER OPTBL
-NEXTOPH INC IPH
+NEXTOPH INC IPH
BNE FETCHOP
}
PAGE3 = *
@@ -386,10 +386,10 @@ LCDEFCMD = *-28 ; DEFCMD IN LC MEMORY
;* *
;*****************
!ALIGN 255,0
-OPXTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E
- !WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E
+OPXTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E
+ !WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E
!WORD LNOT,LOR,LAND,LA,LLA,CB,CW,CSX ; 20 22 24 26 28 2A 2C 2E
- !WORD DROP,DUP,PUSH,PULL,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E
+ !WORD DROP,DUP,PUSHEP,PULLEP,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E
!WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E
!WORD BRNCH,IBRNCH,CALLX,ICALX,ENTER,LEAVEX,RETX,NEXTOP; 50 52 54 56 58 5A 5C 5E
!WORD LBX,LWX,LLBX,LLWX,LABX,LAWX,DLB,DLW ; 60 62 64 66 68 6A 6C 6E
@@ -397,31 +397,33 @@ OPXTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E
;*
;* ADD TOS TO TOS-1
;*
-ADD LDA ESTKL,X
+ADD LDA ESTKL,X
CLC
ADC ESTKL+1,X
STA ESTKL+1,X
LDA ESTKH,X
ADC ESTKH+1,X
STA ESTKH+1,X
- INX
- JMP NEXTOP
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* SUB TOS FROM TOS-1
;*
-SUB LDA ESTKL+1,X
+SUB LDA ESTKL+1,X
SEC
SBC ESTKL,X
STA ESTKL+1,X
LDA ESTKH+1,X
SBC ESTKH,X
STA ESTKH+1,X
- INX
- JMP NEXTOP
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* SHIFT TOS LEFT BY 1, ADD TO TOS-1
;*
-IDXW LDA ESTKL,X
+IDXW LDA ESTKL,X
ASL
ROL ESTKH,X
CLC
@@ -430,8 +432,9 @@ IDXW LDA ESTKL,X
LDA ESTKH,X
ADC ESTKH+1,X
STA ESTKH+1,X
- INX
- JMP NEXTOP
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* MUL TOS-1 BY TOS
;*
@@ -444,29 +447,30 @@ MUL STY IPY
EOR #$FF
STA TMPH
LDA #$00
- STA ESTKL+1,X ; PRODL
-; STA ESTKH+1,X ; PRODH
-MULLP LSR TMPH ; MULTPLRH
+ STA ESTKL+1,X ; PRODL
+; STA ESTKH+1,X ; PRODH
+MULLP LSR TMPH ; MULTPLRH
ROR TMPL ; MULTPLRL
BCS +
- STA ESTKH+1,X ; PRODH
+ STA ESTKH+1,X ; PRODH
LDA ESTKL,X ; MULTPLNDL
- ADC ESTKL+1,X ; PRODL
+ ADC ESTKL+1,X ; PRODL
STA ESTKL+1,X
- LDA ESTKH,X ; MULTPLNDH
- ADC ESTKH+1,X ; PRODH
-+ ASL ESTKL,X ; MULTPLNDL
+ LDA ESTKH,X ; MULTPLNDH
+ ADC ESTKH+1,X ; PRODH
++ ASL ESTKL,X ; MULTPLNDL
ROL ESTKH,X ; MULTPLNDH
DEY
BNE MULLP
STA ESTKH+1,X ; PRODH
- INX
LDY IPY
- JMP NEXTOP
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* INTERNAL DIVIDE ALGORITHM
;*
-_NEG LDA #$00
+_NEG LDA #$00
SEC
SBC ESTKL,X
STA ESTKL,X
@@ -475,7 +479,7 @@ _NEG LDA #$00
STA ESTKH,X
RTS
_DIV STY IPY
- LDY #$11 ; #BITS+1
+ LDY #$11 ; #BITS+1
LDA #$00
STA TMPL ; REMNDRL
STA TMPH ; REMNDRH
@@ -485,29 +489,29 @@ _DIV STY IPY
BPL +
JSR _NEG
INC DVSIGN
-+ LDA ESTKH+1,X
++ LDA ESTKH+1,X
BPL +
INX
JSR _NEG
DEX
INC DVSIGN
BNE _DIV1
-+ ORA ESTKL+1,X ; DVDNDL
++ ORA ESTKL+1,X ; DVDNDL
BEQ _DIVEX
-_DIV1 ASL ESTKL+1,X ; DVDNDL
+_DIV1 ASL ESTKL+1,X ; DVDNDL
ROL ESTKH+1,X ; DVDNDH
DEY
BCC _DIV1
-_DIVLP ROL TMPL ; REMNDRL
+_DIVLP ROL TMPL ; REMNDRL
ROL TMPH ; REMNDRH
LDA TMPL ; REMNDRL
- CMP ESTKL,X ; DVSRL
+ CMP ESTKL,X ; DVSRL
LDA TMPH ; REMNDRH
- SBC ESTKH,X ; DVSRH
+ SBC ESTKH,X ; DVSRH
BCC +
STA TMPH ; REMNDRH
LDA TMPL ; REMNDRL
- SBC ESTKL,X ; DVSRL
+ SBC ESTKL,X ; DVSRL
STA TMPL ; REMNDRL
SEC
+ ROL ESTKL+1,X ; DVDNDL
@@ -520,7 +524,7 @@ _DIVEX INX
;*
;* NEGATE TOS
;*
-NEG LDA #$00
+NEG LDA #$00
SEC
SBC ESTKL,X
STA ESTKL,X
@@ -531,7 +535,7 @@ NEG LDA #$00
;*
;* DIV TOS-1 BY TOS
;*
-DIV JSR _DIV
+DIV JSR _DIV
LSR DVSIGN ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1
BCS NEG
JMP NEXTOP
@@ -549,22 +553,22 @@ MOD JSR _DIV
;*
;* INCREMENT TOS
;*
-INCR INC ESTKL,X
+INCR INC ESTKL,X
BNE INCR1
INC ESTKH,X
-INCR1 JMP NEXTOP
+INCR1 JMP NEXTOP
;*
;* DECREMENT TOS
;*
-DECR LDA ESTKL,X
+DECR LDA ESTKL,X
BNE DECR1
DEC ESTKH,X
-DECR1 DEC ESTKL,X
+DECR1 DEC ESTKL,X
JMP NEXTOP
;*
;* BITWISE COMPLIMENT TOS
;*
-COMP LDA #$FF
+COMP LDA #$FF
EOR ESTKL,X
STA ESTKL,X
LDA #$FF
@@ -574,36 +578,39 @@ COMP LDA #$FF
;*
;* BITWISE AND TOS TO TOS-1
;*
-BAND LDA ESTKL+1,X
+BAND LDA ESTKL+1,X
AND ESTKL,X
STA ESTKL+1,X
LDA ESTKH+1,X
- AND ESTKH,X
+ AND ESTKH,X
STA ESTKH+1,X
- INX
- JMP NEXTOP
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* INCLUSIVE OR TOS TO TOS-1
;*
-IOR LDA ESTKL+1,X
+IOR LDA ESTKL+1,X
ORA ESTKL,X
STA ESTKL+1,X
LDA ESTKH+1,X
ORA ESTKH,X
STA ESTKH+1,X
- INX
- JMP NEXTOP
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* EXLUSIVE OR TOS TO TOS-1
;*
-XOR LDA ESTKL+1,X
+XOR LDA ESTKL+1,X
EOR ESTKL,X
STA ESTKL+1,X
LDA ESTKH+1,X
EOR ESTKH,X
STA ESTKH+1,X
- INX
- JMP NEXTOP
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* SHIFT TOS-1 LEFT BY TOS
;*
@@ -616,15 +623,16 @@ SHL STY IPY
LDY #$00
STY ESTKL+1,X
SBC #$08
-SHL1 TAY
+SHL1 TAY
BEQ SHL3
-SHL2 ASL ESTKL+1,X
+SHL2 ASL ESTKL+1,X
ROL ESTKH+1,X
DEY
BNE SHL2
-SHL3 INX
- LDY IPY
- JMP NEXTOP
+SHL3 LDY IPY
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* SHIFT TOS-1 RIGHT BY TOS
;*
@@ -638,21 +646,22 @@ SHR STY IPY
LDY #$00
BCC SHR1
DEY
-SHR1 STY ESTKH+1,X
+SHR1 STY ESTKH+1,X
SEC
SBC #$08
-SHR2 TAY
+SHR2 TAY
BEQ SHR4
LDA ESTKH+1,X
-SHR3 CMP #$80
+SHR3 CMP #$80
ROR
ROR ESTKL+1,X
DEY
BNE SHR3
STA ESTKH+1,X
-SHR4 INX
- LDY IPY
- JMP NEXTOP
+SHR4 LDY IPY
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* LOGICAL NOT
;*
@@ -667,66 +676,62 @@ LNOT1 EOR #$FF
;*
;* LOGICAL AND
;*
-LAND LDA ESTKL+1,X
+LAND LDA ESTKL+1,X
ORA ESTKH+1,X
BEQ LAND2
LDA ESTKL,X
ORA ESTKH,X
BEQ LAND1
LDA #$FF
-LAND1 STA ESTKL+1,X
+LAND1 STA ESTKL+1,X
STA ESTKH+1,X
-LAND2 INX
- JMP NEXTOP
+;LAND2 INX
+; JMP NEXTOP
+LAND2 JMP DROP
;*
;* LOGICAL OR
;*
-LOR LDA ESTKL,X
+LOR LDA ESTKL,X
ORA ESTKH,X
ORA ESTKL+1,X
ORA ESTKH+1,X
BEQ LOR1
LDA #$FF
- STA ESTKL+1,X
+ STA ESTKL+1,X
STA ESTKH+1,X
-LOR1 INX
- JMP NEXTOP
+;LOR1 INX
+; JMP NEXTOP
+LOR1 JMP DROP
;*
;* DUPLICATE TOS
;*
-DUP DEX
+DUP DEX
LDA ESTKL+1,X
STA ESTKL,X
LDA ESTKH+1,X
STA ESTKH,X
JMP NEXTOP
;*
-;* PUSH FROM EVAL STACK TO CALL STACK
+;* PUSH EVAL STACK POINTER TO CALL STACK
;*
-PUSH LDA ESTKL,X
+PUSHEP TXA
PHA
- LDA ESTKH,X
- PHA
- INX
JMP NEXTOP
;*
-;* PULL FROM CALL STACK TO EVAL STACK
+;* PULL EVAL STACK POINTER FROM CALL STACK
;*
-PULL DEX
- PLA
- STA ESTKH,X
- PLA
- STA ESTKL,X
+PULLEP PLA
+ TAX
JMP NEXTOP
;*
;* CONSTANT
;*
-ZERO DEX
+ZERO DEX
LDA #$00
STA ESTKL,X
STA ESTKH,X
JMP NEXTOP
-CB DEX
+CB DEX
+INC_IP
LDA (IP),Y
STA ESTKL,X
@@ -739,10 +744,10 @@ CB DEX
LA = *
CW DEX
+INC_IP
- LDA (IP),Y
+ LDA (IP),Y
STA ESTKL,X
+INC_IP
- LDA (IP),Y
+ LDA (IP),Y
STA ESTKH,X
JMP NEXTOP
;*
@@ -764,17 +769,57 @@ CS DEX
TAY
JMP NEXTOP
;
-CSX DEX
+CSX DEX
+INC_IP
TYA ; NORMALIZE IP
CLC
- ADC IPL
+ ADC IPL
STA IPL
- LDA #$00
+ LDA #$00
TAY
- ADC IPH
- STA IPH
- LDA (IP),Y
+ ADC IPH
+ STA IPH
+ LDA PPL ; SCAN POOL FOR STRING ALREADY THERE
+ STA TMPL
+ LDA PPH
+ STA TMPH
+_CMPPSX ;LDA TMPH ; CHECK FOR END OF POOL
+ CMP IFPH
+ BCC _CMPSX ; CHECK FOR MATCHING STRING
+ BNE _CPYSX ; BEYOND END OF POOL, COPY STRING OVER
+ LDA TMPL
+ CMP IFPL
+ BCS _CPYSX ; AT OR BEYOND END OF POOL, COPY STRING OVER
+_CMPSX STA ALTRDOFF
+ LDA (TMP),Y ; COMPARE STRINGS FROM AUX MEM TO STRINGS IN MAIN MEM
+ STA ALTRDON
+ CMP (IP),Y ; COMPARE STRING LENGTHS
+ BNE _CNXTSX1
+ TAY
+_CMPCSX STA ALTRDOFF
+ LDA (TMP),Y ; COMPARE STRING CHARS FROM END
+ STA ALTRDON
+ CMP (IP),Y
+ BNE _CNXTSX
+ DEY
+ BNE _CMPCSX
+ LDA TMPL ; MATCH - SAVE EXISTING ADDR ON ESTK AND MOVE ON
+ STA ESTKL,X
+ LDA TMPH
+ STA ESTKH,X
+ BNE _CEXSX
+_CNXTSX LDY #$00
+ STA ALTRDOFF
+ LDA (TMP),Y
+ STA ALTRDON
+_CNXTSX1 SEC
+ ADC TMPL
+ STA TMPL
+ LDA #$00
+ ADC TMPH
+ STA TMPH
+ BNE _CMPPSX
+_CPYSX LDA (IP),Y ; COPY STRING FROM AUX TO MAIN MEM POOL
TAY ; MAKE ROOM IN POOL AND SAVE ADDR ON ESTK
EOR #$FF
CLC
@@ -785,19 +830,19 @@ CSX DEX
ADC PPH
STA PPH
STA ESTKH,X ; COPY STRING FROM AUX MEM BYTECODE TO MAIN MEM POOL
-- LDA (IP),Y ; ALTRD IS ON, NO NEED TO CHANGE IT HERE
+_CPYSX1 LDA (IP),Y ; ALTRD IS ON, NO NEED TO CHANGE IT HERE
STA (PP),Y ; ALTWR IS OFF, NO NEED TO CHANGE IT HERE
DEY
CPY #$FF
- BNE -
+ BNE _CPYSX1
INY
- LDA (IP),Y ; SKIP TO NEXT OP ADDR AFTER STRING
+_CEXSX LDA (IP),Y ; SKIP TO NEXT OP ADDR AFTER STRING
TAY
JMP NEXTOP
;*
;* LOAD VALUE FROM ADDRESS TAG
;*
-LB LDA ESTKL,X
+LB LDA ESTKL,X
STA TMPL
LDA ESTKH,X
STA TMPH
@@ -807,12 +852,12 @@ LB LDA ESTKL,X
STA ESTKL,X
STY ESTKH,X
LDY IPY
- JMP NEXTOP
-LW LDA ESTKL,X
+ JMP NEXTOP
+LW LDA ESTKL,X
STA TMPL
LDA ESTKH,X
STA TMPH
- STY IPY
+ STY IPY
LDY #$00
LDA (TMP),Y
STA ESTKL,X
@@ -839,9 +884,9 @@ LWX LDA ESTKL,X
STA TMPL
LDA ESTKH,X
STA TMPH
- STY IPY
+ STY IPY
STA ALTRDOFF
- LDY #$00
+ LDY #$00
LDA (TMP),Y
STA ESTKL,X
INY
@@ -853,8 +898,8 @@ LWX LDA ESTKL,X
;*
;* LOAD ADDRESS OF LOCAL FRAME OFFSET
;*
-LLA +INC_IP
- LDA (IP),Y
+LLA +INC_IP
+ LDA (IP),Y
DEX
CLC
ADC IFPL
@@ -866,8 +911,8 @@ LLA +INC_IP
;*
;* LOAD VALUE FROM LOCAL FRAME OFFSET
;*
-LLB +INC_IP
- LDA (IP),Y
+LLB +INC_IP
+ LDA (IP),Y
STY IPY
TAY
DEX
@@ -877,8 +922,8 @@ LLB +INC_IP
STA ESTKH,X
LDY IPY
JMP NEXTOP
-LLW +INC_IP
- LDA (IP),Y
+LLW +INC_IP
+ LDA (IP),Y
STY IPY
TAY
DEX
@@ -891,7 +936,7 @@ LLW +INC_IP
JMP NEXTOP
;
LLBX +INC_IP
- LDA (IP),Y
+ LDA (IP),Y
STY IPY
TAY
DEX
@@ -904,7 +949,7 @@ LLBX +INC_IP
LDY IPY
JMP NEXTOP
LLWX +INC_IP
- LDA (IP),Y
+ LDA (IP),Y
STY IPY
TAY
DEX
@@ -920,7 +965,7 @@ LLWX +INC_IP
;*
;* LOAD VALUE FROM ABSOLUTE ADDRESS
;*
-LAB +INC_IP
+LAB +INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
@@ -934,7 +979,7 @@ LAB +INC_IP
STY ESTKH,X
LDY IPY
JMP NEXTOP
-LAW +INC_IP
+LAW +INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
@@ -951,7 +996,7 @@ LAW +INC_IP
LDY IPY
JMP NEXTOP
;
-LABX +INC_IP
+LABX +INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
@@ -967,7 +1012,7 @@ LABX +INC_IP
STA ALTRDON
LDY IPY
JMP NEXTOP
-LAWX +INC_IP
+LAWX +INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
@@ -988,47 +1033,50 @@ LAWX +INC_IP
;*
;* STORE VALUE TO ADDRESS
;*
-SB LDA ESTKL+1,X
+SB LDA ESTKL,X
STA TMPL
- LDA ESTKH+1,X
+ LDA ESTKH,X
STA TMPH
- LDA ESTKL,X
+ LDA ESTKL+1,X
STY IPY
LDY #$00
STA (TMP),Y
- INX
- INX
LDY IPY
- JMP NEXTOP
-SW LDA ESTKL+1,X
+ INX
+; INX
+; JMP NEXTOP
+ JMP DROP
+SW LDA ESTKL,X
STA TMPL
- LDA ESTKH+1,X
+ LDA ESTKH,X
STA TMPH
STY IPY
LDY #$00
- LDA ESTKL,X
+ LDA ESTKL+1,X
STA (TMP),Y
INY
- LDA ESTKH,X
+ LDA ESTKH+1,X
STA (TMP),Y
- INX
- INX
LDY IPY
- JMP NEXTOP
+ INX
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* STORE VALUE TO LOCAL FRAME OFFSET
;*
-SLB +INC_IP
- LDA (IP),Y
+SLB +INC_IP
+ LDA (IP),Y
STY IPY
TAY
LDA ESTKL,X
STA (IFP),Y
- INX
LDY IPY
- JMP NEXTOP
-SLW +INC_IP
- LDA (IP),Y
+; INX
+; JMP NEXTOP
+ JMP DROP
+SLW +INC_IP
+ LDA (IP),Y
STY IPY
TAY
LDA ESTKL,X
@@ -1036,13 +1084,14 @@ SLW +INC_IP
INY
LDA ESTKH,X
STA (IFP),Y
- INX
LDY IPY
- JMP NEXTOP
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* STORE VALUE TO LOCAL FRAME OFFSET WITHOUT POPPING STACK
;*
-DLB +INC_IP
+DLB +INC_IP
LDA (IP),Y
STY IPY
TAY
@@ -1050,7 +1099,7 @@ DLB +INC_IP
STA (IFP),Y
LDY IPY
JMP NEXTOP
-DLW +INC_IP
+DLW +INC_IP
LDA (IP),Y
STY IPY
TAY
@@ -1064,7 +1113,7 @@ DLW +INC_IP
;*
;* STORE VALUE TO ABSOLUTE ADDRESS
;*
-SAB +INC_IP
+SAB +INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
@@ -1074,10 +1123,11 @@ SAB +INC_IP
STY IPY
LDY #$00
STA (TMP),Y
- INX
LDY IPY
- JMP NEXTOP
-SAW +INC_IP
+; INX
+; JMP NEXTOP
+ JMP DROP
+SAW +INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
@@ -1090,13 +1140,14 @@ SAW +INC_IP
INY
LDA ESTKH,X
STA (TMP),Y
- INX
LDY IPY
- JMP NEXTOP
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* STORE VALUE TO ABSOLUTE ADDRESS WITHOUT POPPING STACK
;*
-DAB +INC_IP
+DAB +INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
@@ -1108,7 +1159,7 @@ DAB +INC_IP
STA (TMP),Y
LDY IPY
JMP NEXTOP
-DAW +INC_IP
+DAW +INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
@@ -1133,10 +1184,11 @@ ISEQ LDA ESTKL,X
CMP ESTKH+1,X
BNE ISFLS
ISTRU LDA #$FF
- INX
- STA ESTKL,X
- STA ESTKH,X
- JMP NEXTOP
+ STA ESTKL+1,X
+ STA ESTKH+1,X
+; INX
+; JMP NEXTOP
+ JMP DROP
;
ISNE LDA ESTKL,X
CMP ESTKL+1,X
@@ -1144,11 +1196,12 @@ ISNE LDA ESTKL,X
LDA ESTKH,X
CMP ESTKH+1,X
BNE ISTRU
-ISFLS LDA #$00
- INX
- STA ESTKL,X
- STA ESTKH,X
- JMP NEXTOP
+ISFLS LDA #$00
+ STA ESTKL+1,X
+ STA ESTKH+1,X
+; INX
+; JMP NEXTOP
+ JMP DROP
;
ISGE LDA ESTKL+1,X
CMP ESTKL,X
@@ -1156,7 +1209,7 @@ ISGE LDA ESTKL+1,X
SBC ESTKH,X
BVC ISGE1
EOR #$80
-ISGE1 BPL ISTRU
+ISGE1 BPL ISTRU
BMI ISFLS
;
ISGT LDA ESTKL,X
@@ -1165,7 +1218,7 @@ ISGT LDA ESTKL,X
SBC ESTKH+1,X
BVC ISGT1
EOR #$80
-ISGT1 BMI ISTRU
+ISGT1 BMI ISTRU
BPL ISFLS
;
ISLE LDA ESTKL,X
@@ -1174,7 +1227,7 @@ ISLE LDA ESTKL,X
SBC ESTKH+1,X
BVC ISLE1
EOR #$80
-ISLE1 BPL ISTRU
+ISLE1 BPL ISTRU
BMI ISFLS
;
ISLT LDA ESTKL+1,X
@@ -1183,19 +1236,19 @@ ISLT LDA ESTKL+1,X
SBC ESTKH,X
BVC ISLT1
EOR #$80
-ISLT1 BMI ISTRU
+ISLT1 BMI ISTRU
BPL ISFLS
;*
;* BRANCHES
;*
-BRTRU INX
+BRTRU INX
LDA ESTKH-1,X
ORA ESTKL-1,X
BNE BRNCH
-NOBRNCH +INC_IP
+NOBRNCH +INC_IP
+INC_IP
JMP NEXTOP
-BRFLS INX
+BRFLS INX
LDA ESTKH-1,X
ORA ESTKL-1,X
BNE NOBRNCH
@@ -1215,7 +1268,7 @@ BRNCH LDA IPH
DEY
DEY
JMP NEXTOP
-BREQ INX
+BREQ INX
LDA ESTKL-1,X
CMP ESTKL,X
BNE NOBRNCH
@@ -1223,7 +1276,7 @@ BREQ INX
CMP ESTKH,X
BEQ BRNCH
BNE NOBRNCH
-BRNE INX
+BRNE INX
LDA ESTKL-1,X
CMP ESTKL,X
BNE BRNCH
@@ -1231,14 +1284,14 @@ BRNE INX
CMP ESTKH,X
BEQ NOBRNCH
BNE BRNCH
-BRGT INX
+BRGT INX
LDA ESTKL-1,X
CMP ESTKL,X
LDA ESTKH-1,X
SBC ESTKH,X
BMI BRNCH
BPL NOBRNCH
-BRLT INX
+BRLT INX
LDA ESTKL,X
CMP ESTKL-1,X
LDA ESTKH,X
@@ -1252,12 +1305,13 @@ IBRNCH LDA IPL
LDA IPH
ADC ESTKH,X
STA IPH
- INX
- JMP NEXTOP
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* CALL INTO ABSOLUTE ADDRESS (NATIVE CODE)
;*
-CALL +INC_IP
+CALL +INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
@@ -1280,7 +1334,7 @@ CALL +INC_IP
STA OPPAGE
JMP NEXTOP
;
-CALLX +INC_IP
+CALLX +INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
@@ -1294,7 +1348,7 @@ CALLX +INC_IP
PHA
STA ALTRDOFF
CLI
- JSR JMPTMP
+ JSR JMPTMP
SEI
STA ALTRDON
PLA
@@ -1309,7 +1363,7 @@ CALLX +INC_IP
;*
;* INDIRECT CALL TO ADDRESS (NATIVE CODE)
;*
-ICAL LDA ESTKL,X
+ICAL LDA ESTKL,X
STA TMPL
LDA ESTKH,X
STA TMPH
@@ -1331,7 +1385,7 @@ ICAL LDA ESTKL,X
STA OPPAGE
JMP NEXTOP
;
-ICALX LDA ESTKL,X
+ICALX LDA ESTKL,X
STA TMPL
LDA ESTKH,X
STA TMPH
@@ -1363,7 +1417,7 @@ JMPTMP JMP (TMP)
;*
;* ENTER FUNCTION WITH FRAME SIZE AND PARAM COUNT
;*
-ENTER INY
+ENTER INY
LDA (IP),Y
PHA ; SAVE ON STACK FOR LEAVE
EOR #$FF ; ALLOCATE FRAME
@@ -1387,22 +1441,22 @@ ENTER INY
INX
DEY
STA (IFP),Y
- BNE -
+ BNE -
+ LDY #$02
JMP NEXTOP
;*
;* LEAVE FUNCTION
;*
-LEAVEX STA ALTRDOFF
+LEAVEX STA ALTRDOFF
CLI
-LEAVE PLA ; DEALLOCATE POOL + FRAME
+LEAVE PLA ; DEALLOCATE POOL + FRAME
CLC
ADC IFPL
STA PPL
LDA #$00
ADC IFPH
STA PPH
- PLA ; RESTORE PREVIOUS FRAME
+ PLA ; RESTORE PREVIOUS FRAME
STA IFPL
PLA
STA IFPH
@@ -1414,7 +1468,7 @@ RET LDA IFPL ; DEALLOCATE POOL
STA PPL
LDA IFPH
STA PPH
- PLA ; RESTORE PREVIOUS FRAME
+ PLA ; RESTORE PREVIOUS FRAME
STA IFPL
PLA
STA IFPH
diff --git a/src/vmsrc/plvm03.s b/src/vmsrc/plvm03.s
index bdd3425..4d8f59a 100644
--- a/src/vmsrc/plvm03.s
+++ b/src/vmsrc/plvm03.s
@@ -8,1027 +8,1076 @@
;
; HARDWARE REGISTERS
;
-MEMBANK = $FFEF
- !SOURCE "vmsrc/plvmzp.inc"
+MEMBANK = $FFEF
+ !SOURCE "vmsrc/plvmzp.inc"
;
; XPAGE ADDRESSES
;
-XPAGE = $1600
-DROPX = XPAGE+DROP
-IFPX = XPAGE+IFPH
-PPX = XPAGE+PPH
-IPX = XPAGE+IPH
-TMPX = XPAGE+TMPH
-SRCX = XPAGE+SRCH
-DSTX = XPAGE+DSTH
+XPAGE = $1600
+DROPX = XPAGE+DROP
+IFPX = XPAGE+IFPH
+PPX = XPAGE+PPH
+IPX = XPAGE+IPH
+TMPX = XPAGE+TMPH
+SRCX = XPAGE+SRCH
+DSTX = XPAGE+DSTH
;*
;* SOS
;*
- !MACRO SOS .CMD, .LIST {
- BRK
- !BYTE .CMD
- !WORD .LIST
- }
+ !MACRO SOS .CMD, .LIST {
+ BRK
+ !BYTE .CMD
+ !WORD .LIST
+ }
;*
;* INTERPRETER INSTRUCTION POINTER INCREMENT MACRO
;*
- !MACRO INC_IP {
- INY
- BNE *+4
- INC IPH
- }
+ !MACRO INC_IP {
+ INY
+ BNE *+4
+ INC IPH
+ }
;*
;* INTERPRETER HEADER+INITIALIZATION
;*
- SEGSTART = $A000
- *= SEGSTART-$0E
- !TEXT "SOS NTRP"
- !WORD $0000
- !WORD SEGSTART
- !WORD SEGEND-SEGSTART
-
- +SOS $40, SEGREQ ; ALLOCATE SEG 1 AND MAP IT
- BNE PRHEX
- LDA #$01
- STA MEMBANK
- LDY #$0F ; INSTALL PAGE 0 FETCHOP ROUTINE
- LDA #$00
-- LDX PAGE0,Y
- STX DROP,Y
- STA DROPX,Y
- DEY
- BPL -
- STA TMPX ; CLEAR ALL EXTENDED POINTERS
- STA SRCX
- STA DSTX
- STA PPX ; INIT FRAME & POOL POINTERS
- STA IFPX
- LDA #SEGSTART
- STA PPH
- STA IFPH
- LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX
- JMP SOSCMD
-PRHEX PHA
- LSR
- LSR
- LSR
- LSR
- CLC
- ADC #'0'
- CMP #':'
- BCC +
- ADC #6
-+ STA $480
- PLA
- AND #$0F
- ADC #'0'
- CMP #':'
- BCC +
- ADC #6
-+ STA $880
-FAIL RTS
-SEGREQ !BYTE 4
- !WORD $2001
- !WORD $9F01
- !BYTE $10
- !BYTE $00
-PAGE0 = *
- !PSEUDOPC $00EF {
+ SEGSTART = $A000
+ *= SEGSTART-$0E
+ !TEXT "SOS NTRP"
+ !WORD $0000
+ !WORD SEGSTART
+ !WORD SEGEND-SEGSTART
+
+ +SOS $40, SEGREQ ; ALLOCATE SEG 1 AND MAP IT
+ BNE FAIL ; PRHEX
+ LDA #$01
+ STA MEMBANK
+ LDY #$0F ; INSTALL PAGE 0 FETCHOP ROUTINE
+ LDA #$00
+- LDX PAGE0,Y
+ STX DROP,Y
+ STA DROPX,Y
+ DEY
+ BPL -
+ STA TMPX ; CLEAR ALL EXTENDED POINTERS
+ STA SRCX
+ STA DSTX
+ STA PPX ; INIT FRAME & POOL POINTERS
+ STA IFPX
+ LDA #SEGSTART
+ STA PPH
+ STA IFPH
+ LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX
+ JMP SOSCMD
+;PRHEX PHA
+; LSR
+; LSR
+; LSR
+; LSR
+; CLC
+; ADC #'0'
+; CMP #':'
+; BCC +
+; ADC #6
+;+ STA $480
+; PLA
+; AND #$0F
+; ADC #'0'
+; CMP #':'
+; BCC +
+; ADC #6
+;+ STA $481 ;$880
+FAIL STA $0480
+ RTS
+SEGREQ !BYTE 4
+ !WORD $2001
+ !WORD $9F01
+ !BYTE $10
+ !BYTE $00
+PAGE0 = *
+ !PSEUDOPC $00EF {
;*
;* INTERP BYTECODE INNER LOOP
;*
- INX ; DROP
- INY ; NEXTOP
- BEQ NEXTOPH
- LDA $FFFF,Y ; FETCHOP @ $F3, IP MAPS OVER $FFFF @ $F4
- STA OPIDX
- JMP (OPTBL)
-NEXTOPH INC IPH
- BNE FETCHOP
+ INX ; DROP
+ INY ; NEXTOP
+ BEQ NEXTOPH
+ LDA $FFFF,Y ; FETCHOP @ $F3, IP MAPS OVER $FFFF @ $F4
+ STA OPIDX
+ JMP (OPTBL)
+NEXTOPH INC IPH
+ BNE FETCHOP
}
;*
;* SYSTEM INTERPRETER ENTRYPOINT
;*
-INTERP PLA
- CLC
- ADC #$01
+INTERP PLA
+ CLC
+ ADC #$01
STA IPL
PLA
- ADC #$00
+ ADC #$00
STA IPH
- LDA IFPH
- PHA ; SAVE ON STACK FOR LEAVE/RET
- LDA IFPL
- PHA ; SAVE ON STACK FOR LEAVE/RET
- LDA PPL ; SET FP TO PP
- STA IFPL
- LDA PPH
- STA IFPH
- LDY #$00
- STY IPX
- JMP FETCHOP
+ LDA IFPH
+ PHA ; SAVE ON STACK FOR LEAVE/RET
+ LDA IFPL
+ PHA ; SAVE ON STACK FOR LEAVE/RET
+ LDA PPL ; SET FP TO PP
+ STA IFPL
+ LDA PPH
+ STA IFPH
+ LDY #$00
+ STY IPX
+ JMP FETCHOP
;*
;* ENTER INTO USER BYTECODE INTERPRETER
;*
-XINTERP PLA
+XINTERP PLA
STA TMPL
PLA
STA TMPH
- LDY #$03
- LDA (TMP),Y
- STA IPX
- DEY
- LDA (TMP),Y
- STA IPH
- DEY
- LDA (TMP),Y
- STA IPL
+ LDY #$03
+ LDA (TMP),Y
+ STA IPX
DEY
- LDA IFPH
- PHA ; SAVE ON STACK FOR LEAVE/RET
- LDA IFPL
- PHA ; SAVE ON STACK FOR LEAVE/RET
- LDA PPL ; SET FP TO PP
- STA IFPL
- LDA PPH
- STA IFPH
- JMP FETCHOP
+ LDA (TMP),Y
+ STA IPH
+ DEY
+ LDA (TMP),Y
+ STA IPL
+ DEY
+ LDA IFPH
+ PHA ; SAVE ON STACK FOR LEAVE/RET
+ LDA IFPL
+ PHA ; SAVE ON STACK FOR LEAVE/RET
+ LDA PPL ; SET FP TO PP
+ STA IFPL
+ LDA PPH
+ STA IFPH
+ JMP FETCHOP
;*
;* INTERNAL DIVIDE ALGORITHM
;*
-_NEG LDA #$00
- SEC
- SBC ESTKL,X
- STA ESTKL,X
- LDA #$00
- SBC ESTKH,X
- STA ESTKH,X
- RTS
-_DIV STY IPY
- LDY #$11 ; #BITS+1
- LDA #$00
- STA TMPL ; REMNDRL
- STA TMPH ; REMNDRH
- LDA ESTKH,X
- AND #$80
- STA DVSIGN
- BPL +
- JSR _NEG
- INC DVSIGN
-+ LDA ESTKH+1,X
- BPL +
- INX
- JSR _NEG
- DEX
- INC DVSIGN
- BNE _DIV1
-+ ORA ESTKL+1,X ; DVDNDL
- BEQ _DIVEX
-_DIV1 ASL ESTKL+1,X ; DVDNDL
- ROL ESTKH+1,X ; DVDNDH
- DEY
- BCC _DIV1
-_DIVLP ROL TMPL ; REMNDRL
- ROL TMPH ; REMNDRH
- LDA TMPL ; REMNDRL
- CMP ESTKL,X ; DVSRL
- LDA TMPH ; REMNDRH
- SBC ESTKH,X ; DVSRH
- BCC +
- STA TMPH ; REMNDRH
- LDA TMPL ; REMNDRL
- SBC ESTKL,X ; DVSRL
- STA TMPL ; REMNDRL
- SEC
-+ ROL ESTKL+1,X ; DVDNDL
- ROL ESTKH+1,X ; DVDNDH
- DEY
- BNE _DIVLP
-_DIVEX INX
- LDY IPY
- RTS
+_NEG LDA #$00
+ SEC
+ SBC ESTKL,X
+ STA ESTKL,X
+ LDA #$00
+ SBC ESTKH,X
+ STA ESTKH,X
+ RTS
+_DIV STY IPY
+ LDY #$11 ; #BITS+1
+ LDA #$00
+ STA TMPL ; REMNDRL
+ STA TMPH ; REMNDRH
+ LDA ESTKH,X
+ AND #$80
+ STA DVSIGN
+ BPL +
+ JSR _NEG
+ INC DVSIGN
++ LDA ESTKH+1,X
+ BPL +
+ INX
+ JSR _NEG
+ DEX
+ INC DVSIGN
+ BNE _DIV1
++ ORA ESTKL+1,X ; DVDNDL
+ BEQ _DIVEX
+_DIV1 ASL ESTKL+1,X ; DVDNDL
+ ROL ESTKH+1,X ; DVDNDH
+ DEY
+ BCC _DIV1
+_DIVLP ROL TMPL ; REMNDRL
+ ROL TMPH ; REMNDRH
+ LDA TMPL ; REMNDRL
+ CMP ESTKL,X ; DVSRL
+ LDA TMPH ; REMNDRH
+ SBC ESTKH,X ; DVSRH
+ BCC +
+ STA TMPH ; REMNDRH
+ LDA TMPL ; REMNDRL
+ SBC ESTKL,X ; DVSRL
+ STA TMPL ; REMNDRL
+ SEC
++ ROL ESTKL+1,X ; DVDNDL
+ ROL ESTKH+1,X ; DVDNDH
+ DEY
+ BNE _DIVLP
+_DIVEX INX
+ LDY IPY
+ RTS
;*
;* OPCODE TABLE
;*
- !ALIGN 255,0
-OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E
- !WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E
- !WORD LNOT,LOR,LAND,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E
- !WORD DROP,DUP,PUSH,PULL,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E
- !WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E
- !WORD BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,NEXTOP ; 50 52 54 56 58 5A 5C 5E
- !WORD LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E
- !WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E
+ !ALIGN 255,0
+OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E
+ !WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E
+ !WORD LNOT,LOR,LAND,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E
+ !WORD DROP,DUP,PUSHEP,PULLEP,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E
+ !WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E
+ !WORD BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,NEXTOP ; 50 52 54 56 58 5A 5C 5E
+ !WORD LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E
+ !WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E
;*
;* MUL TOS-1 BY TOS
;*
-MUL STY IPY
- LDY #$10
- LDA ESTKL+1,X
- EOR #$FF
- STA TMPL
- LDA ESTKH+1,X
- EOR #$FF
- STA TMPH
- LDA #$00
- STA ESTKL+1,X ; PRODL
-; STA ESTKH+1,X ; PRODH
-MULLP LSR TMPH ; MULTPLRH
- ROR TMPL ; MULTPLRL
- BCS +
- STA ESTKH+1,X ; PRODH
- LDA ESTKL,X ; MULTPLNDL
- ADC ESTKL+1,X ; PRODL
- STA ESTKL+1,X
- LDA ESTKH,X ; MULTPLNDH
- ADC ESTKH+1,X ; PRODH
-+ ASL ESTKL,X ; MULTPLNDL
- ROL ESTKH,X ; MULTPLNDH
- DEY
- BNE MULLP
- STA ESTKH+1,X ; PRODH
- INX
- LDY IPY
- JMP NEXTOP
+MUL STY IPY
+ LDY #$10
+ LDA ESTKL+1,X
+ EOR #$FF
+ STA TMPL
+ LDA ESTKH+1,X
+ EOR #$FF
+ STA TMPH
+ LDA #$00
+ STA ESTKL+1,X ; PRODL
+; STA ESTKH+1,X ; PRODH
+MULLP LSR TMPH ; MULTPLRH
+ ROR TMPL ; MULTPLRL
+ BCS +
+ STA ESTKH+1,X ; PRODH
+ LDA ESTKL,X ; MULTPLNDL
+ ADC ESTKL+1,X ; PRODL
+ STA ESTKL+1,X
+ LDA ESTKH,X ; MULTPLNDH
+ ADC ESTKH+1,X ; PRODH
++ ASL ESTKL,X ; MULTPLNDL
+ ROL ESTKH,X ; MULTPLNDH
+ DEY
+ BNE MULLP
+ STA ESTKH+1,X ; PRODH
+ LDY IPY
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* NEGATE TOS
;*
-NEG LDA #$00
- SEC
- SBC ESTKL,X
- STA ESTKL,X
- LDA #$00
- SBC ESTKH,X
- STA ESTKH,X
- JMP NEXTOP
+NEG LDA #$00
+ SEC
+ SBC ESTKL,X
+ STA ESTKL,X
+ LDA #$00
+ SBC ESTKH,X
+ STA ESTKH,X
+ JMP NEXTOP
;*
;* DIV TOS-1 BY TOS
;*
-DIV JSR _DIV
- LSR DVSIGN ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1
- BCS NEG
- JMP NEXTOP
+DIV JSR _DIV
+ LSR DVSIGN ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1
+ BCS NEG
+ JMP NEXTOP
;*
;* MOD TOS-1 BY TOS
;*
-MOD JSR _DIV
- LDA TMPL ; REMNDRL
- STA ESTKL,X
- LDA TMPH ; REMNDRH
- STA ESTKH,X
- LDA DVSIGN ; REMAINDER IS SIGN OF DIVIDEND
- BMI NEG
- JMP NEXTOP
+MOD JSR _DIV
+ LDA TMPL ; REMNDRL
+ STA ESTKL,X
+ LDA TMPH ; REMNDRH
+ STA ESTKH,X
+ LDA DVSIGN ; REMAINDER IS SIGN OF DIVIDEND
+ BMI NEG
+ JMP NEXTOP
;*
;* ADD TOS TO TOS-1
;*
-ADD LDA ESTKL,X
- CLC
- ADC ESTKL+1,X
- STA ESTKL+1,X
- LDA ESTKH,X
- ADC ESTKH+1,X
- STA ESTKH+1,X
- INX
- JMP NEXTOP
+ADD LDA ESTKL,X
+ CLC
+ ADC ESTKL+1,X
+ STA ESTKL+1,X
+ LDA ESTKH,X
+ ADC ESTKH+1,X
+ STA ESTKH+1,X
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* SUB TOS FROM TOS-1
;*
-SUB LDA ESTKL+1,X
- SEC
- SBC ESTKL,X
- STA ESTKL+1,X
- LDA ESTKH+1,X
- SBC ESTKH,X
- STA ESTKH+1,X
- INX
- JMP NEXTOP
+SUB LDA ESTKL+1,X
+ SEC
+ SBC ESTKL,X
+ STA ESTKL+1,X
+ LDA ESTKH+1,X
+ SBC ESTKH,X
+ STA ESTKH+1,X
+; INX
+; JMP NEXTOP
+ JMP DROP
;
;*
;* SHIFT TOS LEFT BY 1, ADD TO TOS-1
;*
-IDXW LDA ESTKL,X
- ASL
- ROL ESTKH,X
- CLC
- ADC ESTKL+1,X
- STA ESTKL+1,X
- LDA ESTKH,X
- ADC ESTKH+1,X
- STA ESTKH+1,X
- INX
- JMP NEXTOP
+IDXW LDA ESTKL,X
+ ASL
+ ROL ESTKH,X
+ CLC
+ ADC ESTKL+1,X
+ STA ESTKL+1,X
+ LDA ESTKH,X
+ ADC ESTKH+1,X
+ STA ESTKH+1,X
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* INCREMENT TOS
;*
-INCR INC ESTKL,X
- BNE INCR1
- INC ESTKH,X
-INCR1 JMP NEXTOP
+INCR INC ESTKL,X
+ BNE INCR1
+ INC ESTKH,X
+INCR1 JMP NEXTOP
;*
;* DECREMENT TOS
;*
-DECR LDA ESTKL,X
- BNE DECR1
- DEC ESTKH,X
-DECR1 DEC ESTKL,X
- JMP NEXTOP
+DECR LDA ESTKL,X
+ BNE DECR1
+ DEC ESTKH,X
+DECR1 DEC ESTKL,X
+ JMP NEXTOP
;*
;* BITWISE COMPLIMENT TOS
;*
-COMP LDA #$FF
- EOR ESTKL,X
- STA ESTKL,X
- LDA #$FF
- EOR ESTKH,X
- STA ESTKH,X
- JMP NEXTOP
+COMP LDA #$FF
+ EOR ESTKL,X
+ STA ESTKL,X
+ LDA #$FF
+ EOR ESTKH,X
+ STA ESTKH,X
+ JMP NEXTOP
;*
;* BITWISE AND TOS TO TOS-1
;*
-BAND LDA ESTKL+1,X
- AND ESTKL,X
- STA ESTKL+1,X
- LDA ESTKH+1,X
- AND ESTKH,X
- STA ESTKH+1,X
- INX
- JMP NEXTOP
+BAND LDA ESTKL+1,X
+ AND ESTKL,X
+ STA ESTKL+1,X
+ LDA ESTKH+1,X
+ AND ESTKH,X
+ STA ESTKH+1,X
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* INCLUSIVE OR TOS TO TOS-1
;*
-IOR LDA ESTKL+1,X
- ORA ESTKL,X
- STA ESTKL+1,X
- LDA ESTKH+1,X
- ORA ESTKH,X
- STA ESTKH+1,X
- INX
- JMP NEXTOP
+IOR LDA ESTKL+1,X
+ ORA ESTKL,X
+ STA ESTKL+1,X
+ LDA ESTKH+1,X
+ ORA ESTKH,X
+ STA ESTKH+1,X
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* EXLUSIVE OR TOS TO TOS-1
;*
-XOR LDA ESTKL+1,X
- EOR ESTKL,X
- STA ESTKL+1,X
- LDA ESTKH+1,X
- EOR ESTKH,X
- STA ESTKH+1,X
- INX
- JMP NEXTOP
+XOR LDA ESTKL+1,X
+ EOR ESTKL,X
+ STA ESTKL+1,X
+ LDA ESTKH+1,X
+ EOR ESTKH,X
+ STA ESTKH+1,X
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* SHIFT TOS-1 LEFT BY TOS
;*
-SHL STY IPY
- LDA ESTKL,X
- CMP #$08
- BCC SHL1
- LDY ESTKL+1,X
- STY ESTKH+1,X
- LDY #$00
- STY ESTKL+1,X
- SBC #$08
-SHL1 TAY
- BEQ SHL3
-SHL2 ASL ESTKL+1,X
- ROL ESTKH+1,X
- DEY
- BNE SHL2
-SHL3 INX
- LDY IPY
- JMP NEXTOP
+SHL STY IPY
+ LDA ESTKL,X
+ CMP #$08
+ BCC SHL1
+ LDY ESTKL+1,X
+ STY ESTKH+1,X
+ LDY #$00
+ STY ESTKL+1,X
+ SBC #$08
+SHL1 TAY
+ BEQ SHL3
+SHL2 ASL ESTKL+1,X
+ ROL ESTKH+1,X
+ DEY
+ BNE SHL2
+SHL3 LDY IPY
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* SHIFT TOS-1 RIGHT BY TOS
;*
-SHR STY IPY
- LDA ESTKL,X
- CMP #$08
- BCC SHR2
- LDY ESTKH+1,X
- STY ESTKL+1,X
- CPY #$80
- LDY #$00
- BCC SHR1
- DEY
-SHR1 STY ESTKH+1,X
- SEC
- SBC #$08
-SHR2 TAY
- BEQ SHR4
- LDA ESTKH+1,X
-SHR3 CMP #$80
- ROR
- ROR ESTKL+1,X
- DEY
- BNE SHR3
- STA ESTKH+1,X
-SHR4 INX
- LDY IPY
- JMP NEXTOP
+SHR STY IPY
+ LDA ESTKL,X
+ CMP #$08
+ BCC SHR2
+ LDY ESTKH+1,X
+ STY ESTKL+1,X
+ CPY #$80
+ LDY #$00
+ BCC SHR1
+ DEY
+SHR1 STY ESTKH+1,X
+ SEC
+ SBC #$08
+SHR2 TAY
+ BEQ SHR4
+ LDA ESTKH+1,X
+SHR3 CMP #$80
+ ROR
+ ROR ESTKL+1,X
+ DEY
+ BNE SHR3
+ STA ESTKH+1,X
+SHR4 LDY IPY
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* LOGICAL NOT
;*
-LNOT LDA ESTKL,X
- ORA ESTKH,X
- BEQ LNOT1
- LDA #$FF
-LNOT1 EOR #$FF
- STA ESTKL,X
- STA ESTKH,X
- JMP NEXTOP
+LNOT LDA ESTKL,X
+ ORA ESTKH,X
+ BEQ LNOT1
+ LDA #$FF
+LNOT1 EOR #$FF
+ STA ESTKL,X
+ STA ESTKH,X
+ JMP NEXTOP
;*
;* LOGICAL AND
;*
-LAND LDA ESTKL+1,X
- ORA ESTKH+1,X
- BEQ LAND2
- LDA ESTKL,X
- ORA ESTKH,X
- BEQ LAND1
- LDA #$FF
-LAND1 STA ESTKL+1,X
- STA ESTKH+1,X
-LAND2 INX
- JMP NEXTOP
+LAND LDA ESTKL+1,X
+ ORA ESTKH+1,X
+ BEQ LAND2
+ LDA ESTKL,X
+ ORA ESTKH,X
+ BEQ LAND1
+ LDA #$FF
+LAND1 STA ESTKL+1,X
+ STA ESTKH+1,X
+;LAND2 INX
+; JMP NEXTOP
+LAND2 JMP DROP
;*
;* LOGICAL OR
;*
-LOR LDA ESTKL,X
- ORA ESTKH,X
- ORA ESTKL+1,X
- ORA ESTKH+1,X
- BEQ LOR1
- LDA #$FF
- STA ESTKL+1,X
- STA ESTKH+1,X
-LOR1 INX
- JMP NEXTOP
+LOR LDA ESTKL,X
+ ORA ESTKH,X
+ ORA ESTKL+1,X
+ ORA ESTKH+1,X
+ BEQ LOR1
+ LDA #$FF
+ STA ESTKL+1,X
+ STA ESTKH+1,X
+;LOR1 INX
+; JMP NEXTOP
+LOR1 JMP DROP
;*
;* DUPLICATE TOS
;*
-DUP DEX
- LDA ESTKL+1,X
- STA ESTKL,X
- LDA ESTKH+1,X
- STA ESTKH,X
- JMP NEXTOP
+DUP DEX
+ LDA ESTKL+1,X
+ STA ESTKL,X
+ LDA ESTKH+1,X
+ STA ESTKH,X
+ JMP NEXTOP
;*
-;* PUSH FROM EVAL STACK TO CALL STACK
+;* PUSH EVAL STACK POINTER TO CALL STACK
;*
-PUSH LDA ESTKL,X
- PHA
- LDA ESTKH,X
- PHA
- INX
- JMP NEXTOP
+PUSHEP TXA
+ PHA
+ JMP NEXTOP
;*
;* PULL FROM CALL STACK TO EVAL STACK
;*
-PULL DEX
- PLA
- STA ESTKH,X
- PLA
- STA ESTKL,X
- JMP NEXTOP
+PULLEP PLA
+ TAX
+ JMP NEXTOP
;*
;* CONSTANT
;*
-ZERO DEX
- LDA #$00
- STA ESTKL,X
- STA ESTKH,X
- JMP NEXTOP
-CB DEX
- +INC_IP
- LDA (IP),Y
- STA ESTKL,X
- LDA #$00
- STA ESTKH,X
- JMP NEXTOP
+ZERO DEX
+ LDA #$00
+ STA ESTKL,X
+ STA ESTKH,X
+ JMP NEXTOP
+CB DEX
+ +INC_IP
+ LDA (IP),Y
+ STA ESTKL,X
+ LDA #$00
+ STA ESTKH,X
+ JMP NEXTOP
;*
;* LOAD ADDRESS & LOAD CONSTANT WORD (SAME THING, WITH OR WITHOUT FIXUP)
;*
-LA = *
-CW DEX
- +INC_IP
- LDA (IP),Y
- STA ESTKL,X
- +INC_IP
- LDA (IP),Y
- STA ESTKH,X
- JMP NEXTOP
+LA = *
+CW DEX
+ +INC_IP
+ LDA (IP),Y
+ STA ESTKL,X
+ +INC_IP
+ LDA (IP),Y
+ STA ESTKH,X
+ JMP NEXTOP
;*
;* CONSTANT STRING
;*
-CS DEX
- +INC_IP
- TYA ; NORMALIZE IP
- CLC
- ADC IPL
- STA IPL
- LDA #$00
- TAY
- ADC IPH
- STA IPH
- LDA (IP),Y
- TAY ; MAKE ROOM IN POOL AND SAVE ADDR ON ESTK
- EOR #$FF
- CLC
- ADC PPL
- STA PPL
- STA ESTKL,X
- LDA #$FF
- ADC PPH
- STA PPH
- STA ESTKH,X ; COPY STRING FROM AUX MEM BYTECODE TO MAIN MEM POOL
-- LDA (IP),Y ; ALTRD IS ON, NO NEED TO CHANGE IT HERE
- STA (PP),Y ; ALTWR IS OFF, NO NEED TO CHANGE IT HERE
- DEY
- CPY #$FF
- BNE -
- INY
- LDA (IP),Y ; SKIP TO NEXT OP ADDR AFTER STRING
- TAY
- JMP NEXTOP
+CS DEX
+ +INC_IP
+ TYA ; NORMALIZE IP
+ CLC
+ ADC IPL
+ STA IPL
+ LDA #$00
+ TAY
+ ADC IPH
+ STA IPH
+ LDA PPL ; SCAN POOL FOR STRING ALREADY THERE
+ STA TMPL
+ LDA PPH
+ STA TMPH
+_CMPPS ;LDA TMPH ; CHECK FOR END OF POOL
+ CMP IFPH
+ BCC _CMPS ; CHECK FOR MATCHING STRING
+ BNE _CPYS ; BEYOND END OF POOL, COPY STRING OVER
+ LDA TMPL
+ CMP IFPL
+ BCS _CPYS ; AT OR BEYOND END OF POOL, COPY STRING OVER
+_CMPS LDA (TMP),Y ; COMPARE STRINGS FROM AUX MEM TO STRINGS IN MAIN MEM
+ CMP (IP),Y ; COMPARE STRING LENGTHS
+ BNE _CNXTS1
+ TAY
+_CMPCS LDA (TMP),Y ; COMPARE STRING CHARS FROM END
+ CMP (IP),Y
+ BNE _CNXTS
+ DEY
+ BNE _CMPCS
+ LDA TMPL ; MATCH - SAVE EXISTING ADDR ON ESTK AND MOVE ON
+ STA ESTKL,X
+ LDA TMPH
+ STA ESTKH,X
+ BNE _CEXS
+_CNXTS LDY #$00
+ LDA (TMP),Y
+_CNXTS1 SEC
+ ADC TMPL
+ STA TMPL
+ LDA #$00
+ ADC TMPH
+ STA TMPH
+ BNE _CMPPS
+_CPYS LDA (IP),Y ; COPY STRING FROM AUX TO MAIN MEM POOL
+ TAY ; MAKE ROOM IN POOL AND SAVE ADDR ON ESTK
+ EOR #$FF
+ CLC
+ ADC PPL
+ STA PPL
+ STA ESTKL,X
+ LDA #$FF
+ ADC PPH
+ STA PPH
+ STA ESTKH,X ; COPY STRING FROM AUX MEM BYTECODE TO MAIN MEM POOL
+_CPYS1 LDA (IP),Y ; ALTRD IS ON, NO NEED TO CHANGE IT HERE
+ STA (PP),Y ; ALTWR IS OFF, NO NEED TO CHANGE IT HERE
+ DEY
+ CPY #$FF
+ BNE _CPYS1
+ INY
+_CEXS LDA (IP),Y ; SKIP TO NEXT OP ADDR AFTER STRING
+ TAY
+ JMP NEXTOP
;*
;* LOAD VALUE FROM ADDRESS TAG
;*
-LB LDA ESTKL,X
- STA TMPL
- LDA ESTKH,X
- STA TMPH
- STY IPY
- LDY #$00
- LDA (TMP),Y
- STA ESTKL,X
- STY ESTKH,X
- LDY IPY
- JMP NEXTOP
-LW LDA ESTKL,X
- STA TMPL
- LDA ESTKH,X
- STA TMPH
- STY IPY
- LDY #$00
- LDA (TMP),Y
- STA ESTKL,X
- INY
- LDA (TMP),Y
- STA ESTKH,X
- LDY IPY
- JMP NEXTOP
+LB LDA ESTKL,X
+ STA TMPL
+ LDA ESTKH,X
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA (TMP),Y
+ STA ESTKL,X
+ STY ESTKH,X
+ LDY IPY
+ JMP NEXTOP
+LW LDA ESTKL,X
+ STA TMPL
+ LDA ESTKH,X
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA (TMP),Y
+ STA ESTKL,X
+ INY
+ LDA (TMP),Y
+ STA ESTKH,X
+ LDY IPY
+ JMP NEXTOP
;*
;* LOAD ADDRESS OF LOCAL FRAME OFFSET
;*
-LLA +INC_IP
- LDA (IP),Y
- DEX
- CLC
- ADC IFPL
- STA ESTKL,X
- LDA #$00
- ADC IFPH
- STA ESTKH,X
- JMP NEXTOP
+LLA +INC_IP
+ LDA (IP),Y
+ DEX
+ CLC
+ ADC IFPL
+ STA ESTKL,X
+ LDA #$00
+ ADC IFPH
+ STA ESTKH,X
+ JMP NEXTOP
;*
;* LOAD VALUE FROM LOCAL FRAME OFFSET
;*
-LLB +INC_IP
- LDA (IP),Y
- STY IPY
- TAY
- DEX
- LDA (IFP),Y
- STA ESTKL,X
- LDA #$00
- STA ESTKH,X
- LDY IPY
- JMP NEXTOP
-LLW +INC_IP
- LDA (IP),Y
- STY IPY
- TAY
- DEX
- LDA (IFP),Y
- STA ESTKL,X
- INY
- LDA (IFP),Y
- STA ESTKH,X
- LDY IPY
- JMP NEXTOP
+LLB +INC_IP
+ LDA (IP),Y
+ STY IPY
+ TAY
+ DEX
+ LDA (IFP),Y
+ STA ESTKL,X
+ LDA #$00
+ STA ESTKH,X
+ LDY IPY
+ JMP NEXTOP
+LLW +INC_IP
+ LDA (IP),Y
+ STY IPY
+ TAY
+ DEX
+ LDA (IFP),Y
+ STA ESTKL,X
+ INY
+ LDA (IFP),Y
+ STA ESTKH,X
+ LDY IPY
+ JMP NEXTOP
;*
;* LOAD VALUE FROM ABSOLUTE ADDRESS
;*
-LAB +INC_IP
- LDA (IP),Y
- STA TMPL
- +INC_IP
- LDA (IP),Y
- STA TMPH
- STY IPY
- LDY #$00
- LDA (TMP),Y
- DEX
- STA ESTKL,X
- STY ESTKH,X
- LDY IPY
- JMP NEXTOP
-LAW +INC_IP
- LDA (IP),Y
- STA TMPL
- +INC_IP
- LDA (IP),Y
- STA TMPH
- STY IPY
- LDY #$00
- LDA (TMP),Y
- DEX
- STA ESTKL,X
- INY
- LDA (TMP),Y
- STA ESTKH,X
- LDY IPY
- JMP NEXTOP
+LAB +INC_IP
+ LDA (IP),Y
+ STA TMPL
+ +INC_IP
+ LDA (IP),Y
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA (TMP),Y
+ DEX
+ STA ESTKL,X
+ STY ESTKH,X
+ LDY IPY
+ JMP NEXTOP
+LAW +INC_IP
+ LDA (IP),Y
+ STA TMPL
+ +INC_IP
+ LDA (IP),Y
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA (TMP),Y
+ DEX
+ STA ESTKL,X
+ INY
+ LDA (TMP),Y
+ STA ESTKH,X
+ LDY IPY
+ JMP NEXTOP
;*
;* STORE VALUE TO ADDRESS
;*
-SB LDA ESTKL+1,X
- STA TMPL
- LDA ESTKH+1,X
- STA TMPH
- LDA ESTKL,X
- STY IPY
- LDY #$00
- STA (TMP),Y
- INX
- INX
- LDY IPY
- JMP NEXTOP
-SW LDA ESTKL+1,X
- STA TMPL
- LDA ESTKH+1,X
- STA TMPH
- STY IPY
- LDY #$00
- LDA ESTKL,X
- STA (TMP),Y
- INY
- LDA ESTKH,X
- STA (TMP),Y
- INX
- INX
- LDY IPY
- JMP NEXTOP
+SB LDA ESTKL,X
+ STA TMPL
+ LDA ESTKH,X
+ STA TMPH
+ LDA ESTKL+1,X
+ STY IPY
+ LDY #$00
+ STA (TMP),Y
+ LDY IPY
+ INX
+; INX
+; JMP NEXTOP
+ JMP DROP
+SW LDA ESTKL,X
+ STA TMPL
+ LDA ESTKH,X
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA ESTKL+1,X
+ STA (TMP),Y
+ INY
+ LDA ESTKH+1,X
+ STA (TMP),Y
+ LDY IPY
+ INX
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* STORE VALUE TO LOCAL FRAME OFFSET
;*
-SLB +INC_IP
- LDA (IP),Y
- STY IPY
- TAY
- LDA ESTKL,X
- STA (IFP),Y
- INX
- LDY IPY
- JMP NEXTOP
-SLW +INC_IP
- LDA (IP),Y
- STY IPY
- TAY
- LDA ESTKL,X
- STA (IFP),Y
- INY
- LDA ESTKH,X
- STA (IFP),Y
- INX
- LDY IPY
- JMP NEXTOP
+SLB +INC_IP
+ LDA (IP),Y
+ STY IPY
+ TAY
+ LDA ESTKL,X
+ STA (IFP),Y
+ LDY IPY
+; INX
+; JMP NEXTOP
+ JMP DROP
+SLW +INC_IP
+ LDA (IP),Y
+ STY IPY
+ TAY
+ LDA ESTKL,X
+ STA (IFP),Y
+ INY
+ LDA ESTKH,X
+ STA (IFP),Y
+ LDY IPY
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* STORE VALUE TO LOCAL FRAME OFFSET WITHOUT POPPING STACK
;*
-DLB +INC_IP
- LDA (IP),Y
- STY IPY
- TAY
- LDA ESTKL,X
- STA (IFP),Y
- LDY IPY
- JMP NEXTOP
-DLW +INC_IP
- LDA (IP),Y
- STY IPY
- TAY
- LDA ESTKL,X
- STA (IFP),Y
- INY
- LDA ESTKH,X
- STA (IFP),Y
- LDY IPY
- JMP NEXTOP
+DLB +INC_IP
+ LDA (IP),Y
+ STY IPY
+ TAY
+ LDA ESTKL,X
+ STA (IFP),Y
+ LDY IPY
+ JMP NEXTOP
+DLW +INC_IP
+ LDA (IP),Y
+ STY IPY
+ TAY
+ LDA ESTKL,X
+ STA (IFP),Y
+ INY
+ LDA ESTKH,X
+ STA (IFP),Y
+ LDY IPY
+ JMP NEXTOP
;*
;* STORE VALUE TO ABSOLUTE ADDRESS
;*
-SAB +INC_IP
- LDA (IP),Y
- STA TMPL
- +INC_IP
- LDA (IP),Y
- STA TMPH
- LDA ESTKL,X
- STY IPY
- LDY #$00
- STA (TMP),Y
- INX
- LDY IPY
- JMP NEXTOP
-SAW +INC_IP
- LDA (IP),Y
- STA TMPL
- +INC_IP
- LDA (IP),Y
- STA TMPH
- STY IPY
- LDY #$00
- LDA ESTKL,X
- STA (TMP),Y
- INY
- LDA ESTKH,X
- STA (TMP),Y
- INX
- LDY IPY
- JMP NEXTOP
+SAB +INC_IP
+ LDA (IP),Y
+ STA TMPL
+ +INC_IP
+ LDA (IP),Y
+ STA TMPH
+ LDA ESTKL,X
+ STY IPY
+ LDY #$00
+ STA (TMP),Y
+ LDY IPY
+; INX
+; JMP NEXTOP
+ JMP DROP
+SAW +INC_IP
+ LDA (IP),Y
+ STA TMPL
+ +INC_IP
+ LDA (IP),Y
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA ESTKL,X
+ STA (TMP),Y
+ INY
+ LDA ESTKH,X
+ STA (TMP),Y
+ LDY IPY
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* STORE VALUE TO ABSOLUTE ADDRESS WITHOUT POPPING STACK
;*
-DAB +INC_IP
- LDA (IP),Y
- STA TMPL
- +INC_IP
- LDA (IP),Y
- STA TMPH
- STY IPY
- LDY #$00
- LDA ESTKL,X
- STA (TMP),Y
- LDY IPY
- JMP NEXTOP
-DAW +INC_IP
- LDA (IP),Y
- STA TMPL
- +INC_IP
- LDA (IP),Y
- STA TMPH
- STY IPY
- LDY #$00
- LDA ESTKL,X
- STA (TMP),Y
- INY
- LDA ESTKH,X
- STA (TMP),Y
- LDY IPY
- JMP NEXTOP
+DAB +INC_IP
+ LDA (IP),Y
+ STA TMPL
+ +INC_IP
+ LDA (IP),Y
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA ESTKL,X
+ STA (TMP),Y
+ LDY IPY
+ JMP NEXTOP
+DAW +INC_IP
+ LDA (IP),Y
+ STA TMPL
+ +INC_IP
+ LDA (IP),Y
+ STA TMPH
+ STY IPY
+ LDY #$00
+ LDA ESTKL,X
+ STA (TMP),Y
+ INY
+ LDA ESTKH,X
+ STA (TMP),Y
+ LDY IPY
+ JMP NEXTOP
;*
;* COMPARES
;*
-ISEQ LDA ESTKL,X
- CMP ESTKL+1,X
- BNE ISFLS
- LDA ESTKH,X
- CMP ESTKH+1,X
- BNE ISFLS
-ISTRU LDA #$FF
- INX
- STA ESTKL,X
- STA ESTKH,X
- JMP NEXTOP
+ISEQ LDA ESTKL,X
+ CMP ESTKL+1,X
+ BNE ISFLS
+ LDA ESTKH,X
+ CMP ESTKH+1,X
+ BNE ISFLS
+ISTRU LDA #$FF
+ STA ESTKL+1,X
+ STA ESTKH+1,X
+; INX
+; JMP NEXTOP
+ JMP DROP
;
-ISNE LDA ESTKL,X
- CMP ESTKL+1,X
- BNE ISTRU
- LDA ESTKH,X
- CMP ESTKH+1,X
- BNE ISTRU
-ISFLS LDA #$00
- INX
- STA ESTKL,X
- STA ESTKH,X
- JMP NEXTOP
+ISNE LDA ESTKL,X
+ CMP ESTKL+1,X
+ BNE ISTRU
+ LDA ESTKH,X
+ CMP ESTKH+1,X
+ BNE ISTRU
+ISFLS LDA #$00
+ STA ESTKL+1,X
+ STA ESTKH+1,X
+; INX
+; JMP NEXTOP
+ JMP DROP
;
-ISGE LDA ESTKL+1,X
- CMP ESTKL,X
- LDA ESTKH+1,X
- SBC ESTKH,X
- BVC ISGE1
- EOR #$80
-ISGE1 BPL ISTRU
- BMI ISFLS
+ISGE LDA ESTKL+1,X
+ CMP ESTKL,X
+ LDA ESTKH+1,X
+ SBC ESTKH,X
+ BVC ISGE1
+ EOR #$80
+ISGE1 BPL ISTRU
+ BMI ISFLS
;
-ISGT LDA ESTKL,X
- CMP ESTKL+1,X
- LDA ESTKH,X
- SBC ESTKH+1,X
- BVC ISGT1
- EOR #$80
-ISGT1 BMI ISTRU
- BPL ISFLS
+ISGT LDA ESTKL,X
+ CMP ESTKL+1,X
+ LDA ESTKH,X
+ SBC ESTKH+1,X
+ BVC ISGT1
+ EOR #$80
+ISGT1 BMI ISTRU
+ BPL ISFLS
;
-ISLE LDA ESTKL,X
- CMP ESTKL+1,X
- LDA ESTKH,X
- SBC ESTKH+1,X
- BVC ISLE1
- EOR #$80
-ISLE1 BPL ISTRU
- BMI ISFLS
+ISLE LDA ESTKL,X
+ CMP ESTKL+1,X
+ LDA ESTKH,X
+ SBC ESTKH+1,X
+ BVC ISLE1
+ EOR #$80
+ISLE1 BPL ISTRU
+ BMI ISFLS
;
-ISLT LDA ESTKL+1,X
- CMP ESTKL,X
- LDA ESTKH+1,X
- SBC ESTKH,X
- BVC ISLT1
- EOR #$80
-ISLT1 BMI ISTRU
- BPL ISFLS
+ISLT LDA ESTKL+1,X
+ CMP ESTKL,X
+ LDA ESTKH+1,X
+ SBC ESTKH,X
+ BVC ISLT1
+ EOR #$80
+ISLT1 BMI ISTRU
+ BPL ISFLS
;*
;* BRANCHES
;*
-BRTRU INX
- LDA ESTKH-1,X
- ORA ESTKL-1,X
- BNE BRNCH
-NOBRNCH +INC_IP
- +INC_IP
- JMP NEXTOP
-BRFLS INX
- LDA ESTKH-1,X
- ORA ESTKL-1,X
- BNE NOBRNCH
-BRNCH LDA IPH
- STA TMPH
- LDA IPL
- +INC_IP
- CLC
- ADC (IP),Y
- STA TMPL
- LDA TMPH
- +INC_IP
- ADC (IP),Y
- STA IPH
- LDA TMPL
- STA IPL
- DEY
- DEY
- JMP NEXTOP
-BREQ INX
- LDA ESTKL-1,X
- CMP ESTKL,X
- BNE NOBRNCH
- LDA ESTKH-1,X
- CMP ESTKH,X
- BEQ BRNCH
- BNE NOBRNCH
-BRNE INX
- LDA ESTKL-1,X
- CMP ESTKL,X
- BNE BRNCH
- LDA ESTKH-1,X
- CMP ESTKH,X
- BEQ NOBRNCH
- BNE BRNCH
-BRGT INX
- LDA ESTKL-1,X
- CMP ESTKL,X
- LDA ESTKH-1,X
- SBC ESTKH,X
- BMI BRNCH
- BPL NOBRNCH
-BRLT INX
- LDA ESTKL,X
- CMP ESTKL-1,X
- LDA ESTKH,X
- SBC ESTKH-1,X
- BMI BRNCH
- BPL NOBRNCH
-IBRNCH LDA IPL
- CLC
- ADC ESTKL,X
- STA IPL
- LDA IPH
- ADC ESTKH,X
- STA IPH
- INX
- JMP NEXTOP
+BRTRU INX
+ LDA ESTKH-1,X
+ ORA ESTKL-1,X
+ BNE BRNCH
+NOBRNCH +INC_IP
+ +INC_IP
+ JMP NEXTOP
+BRFLS INX
+ LDA ESTKH-1,X
+ ORA ESTKL-1,X
+ BNE NOBRNCH
+BRNCH LDA IPH
+ STA TMPH
+ LDA IPL
+ +INC_IP
+ CLC
+ ADC (IP),Y
+ STA TMPL
+ LDA TMPH
+ +INC_IP
+ ADC (IP),Y
+ STA IPH
+ LDA TMPL
+ STA IPL
+ DEY
+ DEY
+ JMP NEXTOP
+BREQ INX
+ LDA ESTKL-1,X
+ CMP ESTKL,X
+ BNE NOBRNCH
+ LDA ESTKH-1,X
+ CMP ESTKH,X
+ BEQ BRNCH
+ BNE NOBRNCH
+BRNE INX
+ LDA ESTKL-1,X
+ CMP ESTKL,X
+ BNE BRNCH
+ LDA ESTKH-1,X
+ CMP ESTKH,X
+ BEQ NOBRNCH
+ BNE BRNCH
+BRGT INX
+ LDA ESTKL-1,X
+ CMP ESTKL,X
+ LDA ESTKH-1,X
+ SBC ESTKH,X
+ BMI BRNCH
+ BPL NOBRNCH
+BRLT INX
+ LDA ESTKL,X
+ CMP ESTKL-1,X
+ LDA ESTKH,X
+ SBC ESTKH-1,X
+ BMI BRNCH
+ BPL NOBRNCH
+IBRNCH LDA IPL
+ CLC
+ ADC ESTKL,X
+ STA IPL
+ LDA IPH
+ ADC ESTKH,X
+ STA IPH
+; INX
+; JMP NEXTOP
+ JMP DROP
;*
;* CALL INTO ABSOLUTE ADDRESS (NATIVE CODE)
;*
-CALL +INC_IP
- LDA (IP),Y
- STA CALLADR+1
- +INC_IP
- LDA (IP),Y
- STA CALLADR+2
- LDA IPX
- PHA
- LDA IPH
- PHA
- LDA IPL
- PHA
- TYA
- PHA
-CALLADR JSR $FFFF
- PLA
- TAY
- PLA
- STA IPL
- PLA
- STA IPH
- PLA
- STA IPX
- JMP NEXTOP
+CALL +INC_IP
+ LDA (IP),Y
+ STA CALLADR+1
+ +INC_IP
+ LDA (IP),Y
+ STA CALLADR+2
+ LDA IPX
+ PHA
+ LDA IPH
+ PHA
+ LDA IPL
+ PHA
+ TYA
+ PHA
+CALLADR JSR $FFFF
+ PLA
+ TAY
+ PLA
+ STA IPL
+ PLA
+ STA IPH
+ PLA
+ STA IPX
+ JMP NEXTOP
;*
;* INDIRECT CALL TO ADDRESS (NATIVE CODE)
;*
-ICAL LDA ESTKL,X
- STA ICALADR+1
- LDA ESTKH,X
- STA ICALADR+2
- INX
- LDA IPX
- PHA
- LDA IPH
- PHA
- LDA IPL
- PHA
- TYA
- PHA
-ICALADR JSR $FFFF
- PLA
- TAY
- PLA
- STA IPL
- PLA
- STA IPH
- PLA
- STA IPX
- JMP NEXTOP
+ICAL LDA ESTKL,X
+ STA ICALADR+1
+ LDA ESTKH,X
+ STA ICALADR+2
+ INX
+ LDA IPX
+ PHA
+ LDA IPH
+ PHA
+ LDA IPL
+ PHA
+ TYA
+ PHA
+ICALADR JSR $FFFF
+ PLA
+ TAY
+ PLA
+ STA IPL
+ PLA
+ STA IPH
+ PLA
+ STA IPX
+ JMP NEXTOP
;*
;* ENTER FUNCTION WITH FRAME SIZE AND PARAM COUNT
;*
-;*
-;* ENTER FUNCTION WITH FRAME SIZE AND PARAM COUNT
-;*
-ENTER INY
- LDA (IP),Y
- PHA ; SAVE ON STACK FOR LEAVE
- EOR #$FF
- SEC
- ADC IFPL
- STA IFPL
- BCS +
- DEC IFPH
-+ INY
- LDA (IP),Y
- ASL
- TAY
- BEQ +
-- LDA ESTKH,X
- DEY
- STA (IFP),Y
- LDA ESTKL,X
- INX
- DEY
- STA (IFP),Y
- BNE -
-+ LDY #$02
- JMP NEXTOP
+ENTER INY
+ LDA (IP),Y
+ PHA ; SAVE ON STACK FOR LEAVE
+ EOR #$FF
+ SEC
+ ADC PPL
+ STA PPL
+ STA IFPL
+ LDA #$FF
+ ADC PPH
+ STA PPH
+ STA IFPH
+ INY
+ LDA (IP),Y
+ ASL
+ TAY
+ BEQ +
+- LDA ESTKH,X
+ DEY
+ STA (IFP),Y
+ LDA ESTKL,X
+ INX
+ DEY
+ STA (IFP),Y
+ BNE -
++ LDY #$02
+ JMP NEXTOP
;*
;* LEAVE FUNCTION
;*
-LEAVE PLA
- CLC
- ADC IFPL
- STA PPL
- LDA #$00
- ADC IFPH
- STA PPH
- PLA ; RESTORE PREVIOUS FRAME
- STA IFPL
- PLA
- STA IFPH
- RTS
+LEAVE PLA
+ CLC
+ ADC IFPL
+ STA PPL
+ LDA #$00
+ ADC IFPH
+ STA PPH
+ PLA ; RESTORE PREVIOUS FRAME
+ STA IFPL
+ PLA
+ STA IFPH
+ RTS
;
-RET LDA IFPL ; DEALLOCATE POOL
- STA PPL
- LDA IFPH
- STA PPH
- PLA ; RESTORE PREVIOUS FRAME
- STA IFPL
- PLA
- STA IFPH
- RTS
-SOSCMD = *
- !SOURCE "vmsrc/soscmd.a"
-SEGEND = *
+RET LDA IFPL ; DEALLOCATE POOL
+ STA PPL
+ LDA IFPH
+ STA PPH
+ PLA ; RESTORE PREVIOUS FRAME
+ STA IFPL
+ PLA
+ STA IFPH
+ RTS
+SOSCMD = *
+ !SOURCE "vmsrc/soscmd.a"
+SEGEND = *
diff --git a/src/vmsrc/plvmzp.inc b/src/vmsrc/plvmzp.inc
old mode 100644
new mode 100755
index 82140ec..fd9bb75
--- a/src/vmsrc/plvmzp.inc
+++ b/src/vmsrc/plvmzp.inc
@@ -10,6 +10,9 @@ DST = SRC+2
DSTL = DST
DSTH = DST+1
ESTKSZ = $20
+XSTK = $A0
+XSTKL = XSTK
+XSTKH = XSTK+ESTKSZ/2
ESTK = $C0
ESTKL = ESTK
ESTKH = ESTK+ESTKSZ/2
diff --git a/src/vmsrc/soscmd.pla b/src/vmsrc/soscmd.pla
old mode 100644
new mode 100755
index 22aa240..0767d88
--- a/src/vmsrc/soscmd.pla
+++ b/src/vmsrc/soscmd.pla
@@ -34,13 +34,13 @@ predef loadmod, execmod, lookupstrmod
//
// System variables.
//
-word version = $0092 // 00.92
+word version = $0099 // 00.99
word systemflags = 0
byte refcons = 0
byte devcons = 0
word heap = $2000
byte modid = 0
-byte modseg[15]
+byte modseg[15]
word symtbl, lastsym
byte perr, terr, lerr
//
@@ -48,12 +48,6 @@ byte perr, terr, lerr
//
byte console[] = ".CONSOLE"
byte autorun[] = "AUTORUN"
-byte verstr[] = "PLASMA "
-byte freestr[] = "MEM FREE:$"
-byte errorstr[] = "ERR:$"
-byte okstr[] = "OK"
-byte huhstr[] = "?\n"
-byte devtovol[] = " => /"
byte textmode[] = 16, 0, 15
byte hexchar[] = '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'
//
@@ -91,19 +85,19 @@ byte execstr[] = "MODEXEC"
byte modadrstr[] = "MODADDR"
byte argstr[] = "ARGS"
byte prefix[] // Overlay with exported symbols table
-word exports[] = @sysstr, @syscall
-word = @callstr, @call
-word = @putcstr, @cout
-word = @putlnstr, @crout
-word = @putsstr, @prstr
-word = @getcstr, @cin
-word = @getsstr, @rdstr
-word = @hpmarkstr, @markheap
-word = @hpallocstr,@allocheap
-word = @hpalignstr,@allocalignheap
-word = @hprelstr, @releaseheap
-word = @memsetstr, @memset
-word = @memcpystr, @memcpy
+word exports[] = @sysstr, @syscall
+word = @callstr, @call
+word = @putcstr, @cout
+word = @putlnstr, @crout
+word = @putsstr, @prstr
+word = @getcstr, @cin
+word = @getsstr, @rdstr
+word = @hpmarkstr, @markheap
+word = @hpallocstr,@allocheap
+word = @hpalignstr,@allocalignheap
+word = @hprelstr, @releaseheap
+word = @memsetstr, @memset
+word = @memcpystr, @memcpy
word = @uisgtstr, @uword_isgt
word = @uisgestr, @uword_isge
word = @uisltstr, @uword_islt
@@ -114,33 +108,33 @@ word = @modadrstr, @lookupstrmod
word = @machidstr, @machid
word = @argstr, @cmdptr
word = 0
-word syslibsym = @exports
+word syslibsym = @exports
//
// CALL SOS
// SYSCALL(CMD, PARAMS)
//
asm syscall
- LDA ESTKL,X
- LDY ESTKH,X
- STA PARAMS
- STY PARAMS+1
- INX
- LDA ESTKL,X
- STA CMD
- BRK
-CMD !BYTE 00
-PARAMS !WORD 0000
- LDY #$00
- STA ESTKL,X
- STY ESTKH,X
- RTS
+ LDA ESTKL,X
+ LDY ESTKH,X
+ STA PARAMS
+ STY PARAMS+1
+ INX
+ LDA ESTKL,X
+ STA CMD
+ BRK
+CMD !BYTE 00
+PARAMS !WORD 0000
+ LDY #$00
+ STA ESTKL,X
+ STY ESTKH,X
+ RTS
end
//
// CALL 6502 ROUTINE
// CALL(AREG, XREG, YREG, STATUS, ADDR)
//
asm call
-REGVALS = SRC
+REGVALS = SRC
PHP
LDA ESTKL,X
STA TMPL
@@ -175,7 +169,7 @@ REGVALS = SRC
STY ESTKH,X
PLP
RTS
-JMPTMP JMP (TMP)
+JMPTMP JMP (TMP)
end
//
// SET MEMORY TO VALUE
@@ -183,111 +177,111 @@ end
// With optimizations from Peter Ferrie
//
asm memset
- LDA ESTKL+2,X
- STA DSTL
- LDA ESTKH+2,X
- STA DSTH
- LDY ESTKL,X
- BEQ +
- INC ESTKH,X
- LDY #$00
-+ LDA ESTKH,X
- BEQ SETMEX
-SETMLPL CLC
- LDA ESTKL+1,X
-SETMLPH STA (DST),Y
- DEC ESTKL,X
- BEQ ++
-- INY
- BEQ +
--- BCS SETMLPL
- SEC
- LDA ESTKH+1,X
- BCS SETMLPH
-+ INC DSTH
- BNE --
-++ DEC ESTKH,X
- BNE -
-SETMEX INX
- INX
- RTS
+ LDA ESTKL+2,X
+ STA DSTL
+ LDA ESTKH+2,X
+ STA DSTH
+ LDY ESTKL,X
+ BEQ +
+ INC ESTKH,X
+ LDY #$00
++ LDA ESTKH,X
+ BEQ SETMEX
+SETMLPL CLC
+ LDA ESTKL+1,X
+SETMLPH STA (DST),Y
+ DEC ESTKL,X
+ BEQ ++
+- INY
+ BEQ +
+-- BCS SETMLPL
+ SEC
+ LDA ESTKH+1,X
+ BCS SETMLPH
++ INC DSTH
+ BNE --
+++ DEC ESTKH,X
+ BNE -
+SETMEX INX
+ INX
+ RTS
end
//
// COPY MEMORY
// MEMCPY(DSTADDR, SRCADDR, SIZE)
//
asm memcpy
- INX
- INX
- LDA ESTKL-2,X
- ORA ESTKH-2,X
- BEQ CPYMEX
- LDA ESTKL-1,X
- CMP ESTKL,X
- LDA ESTKH-1,X
- SBC ESTKH,X
- BCC REVCPY
+ INX
+ INX
+ LDA ESTKL-2,X
+ ORA ESTKH-2,X
+ BEQ CPYMEX
+ LDA ESTKL-1,X
+ CMP ESTKL,X
+ LDA ESTKH-1,X
+ SBC ESTKH,X
+ BCC REVCPY
;
; FORWARD COPY
;
- LDA ESTKL,X
- STA DSTL
- LDA ESTKH,X
- STA DSTH
- LDA ESTKL-1,X
- STA SRCL
- LDA ESTKH-1,X
- STA SRCH
- LDY ESTKL-2,X
- BEQ FORCPYLP
- INC ESTKH-2,X
- LDY #$00
-FORCPYLP LDA (SRC),Y
- STA (DST),Y
- INY
- BNE +
- INC DSTH
- INC SRCH
-+ DEC ESTKL-2,X
- BNE FORCPYLP
- DEC ESTKH-2,X
- BNE FORCPYLP
- RTS
+ LDA ESTKL,X
+ STA DSTL
+ LDA ESTKH,X
+ STA DSTH
+ LDA ESTKL-1,X
+ STA SRCL
+ LDA ESTKH-1,X
+ STA SRCH
+ LDY ESTKL-2,X
+ BEQ FORCPYLP
+ INC ESTKH-2,X
+ LDY #$00
+FORCPYLP LDA (SRC),Y
+ STA (DST),Y
+ INY
+ BNE +
+ INC DSTH
+ INC SRCH
++ DEC ESTKL-2,X
+ BNE FORCPYLP
+ DEC ESTKH-2,X
+ BNE FORCPYLP
+ RTS
;
; REVERSE COPY
;
-REVCPY ;CLC
- LDA ESTKL-2,X
- ADC ESTKL,X
- STA DSTL
- LDA ESTKH-2,X
- ADC ESTKH,X
- STA DSTH
- CLC
- LDA ESTKL-2,X
- ADC ESTKL-1,X
- STA SRCL
- LDA ESTKH-2,X
- ADC ESTKH-1,X
- STA SRCH
- DEC DSTH
- DEC SRCH
- LDY #$FF
- LDA ESTKL-2,X
- BEQ REVCPYLP
- INC ESTKH-2,X
-REVCPYLP LDA (SRC),Y
- STA (DST),Y
- DEY
- CPY #$FF
- BNE +
- DEC DSTH
- DEC SRCH
-+ DEC ESTKL-2,X
- BNE REVCPYLP
- DEC ESTKH-2,X
- BNE REVCPYLP
-CPYMEX RTS
+REVCPY ;CLC
+ LDA ESTKL-2,X
+ ADC ESTKL,X
+ STA DSTL
+ LDA ESTKH-2,X
+ ADC ESTKH,X
+ STA DSTH
+ CLC
+ LDA ESTKL-2,X
+ ADC ESTKL-1,X
+ STA SRCL
+ LDA ESTKH-2,X
+ ADC ESTKH-1,X
+ STA SRCH
+ DEC DSTH
+ DEC SRCH
+ LDY #$FF
+ LDA ESTKL-2,X
+ BEQ REVCPYLP
+ INC ESTKH-2,X
+REVCPYLP LDA (SRC),Y
+ STA (DST),Y
+ DEY
+ CPY #$FF
+ BNE +
+ DEC DSTH
+ DEC SRCH
++ DEC ESTKL-2,X
+ BNE REVCPYLP
+ DEC ESTKH-2,X
+ BNE REVCPYLP
+CPYMEX RTS
end
//
// COPY FROM MAIN MEM TO EXT MEM.
@@ -295,39 +289,39 @@ end
// MEMXCPY(DSTSEG, SRC, SIZE)
//
asm memxcpy
- LDA ESTKL,X
- ORA ESTKH,X
- BEQ CPYXMEX
- LDY #$00
- STY DSTL
- LDA ESTKH+2,X
- CLC
- ADC #$60
- STA DSTH
- LDA ESTKL+2,X
- ORA #$80
- STA DSTX
- DEC DSTX
- LDA ESTKL+1,X
- STA SRCL
- LDA ESTKH+1,X
- STA SRCH
- INC ESTKH,X
-CPYXLP LDA (SRC),Y
- STA (DST),Y
- INY
- BNE +
- INC DSTH
- INC SRCH
-+ DEC ESTKL,X
- BNE CPYXLP
- DEC ESTKH,X
- BNE CPYXLP
- LDA #$00
- STA DSTX
-CPYXMEX INX
- INX
- RTS
+ LDA ESTKL,X
+ ORA ESTKH,X
+ BEQ CPYXMEX
+ LDY #$00
+ STY DSTL
+ LDA ESTKH+2,X
+ CLC
+ ADC #$60
+ STA DSTH
+ LDA ESTKL+2,X
+ ORA #$80
+ STA DSTX
+ DEC DSTX
+ LDA ESTKL+1,X
+ STA SRCL
+ LDA ESTKH+1,X
+ STA SRCH
+ INC ESTKH,X
+CPYXLP LDA (SRC),Y
+ STA (DST),Y
+ INY
+ BNE +
+ INC DSTH
+ INC SRCH
++ DEC ESTKL,X
+ BNE CPYXLP
+ DEC ESTKH,X
+ BNE CPYXLP
+ LDA #$00
+ STA DSTX
+CPYXMEX INX
+ INX
+ RTS
end
//
// POKE BYTE VAL INTO EXT MEM.
@@ -335,89 +329,89 @@ end
// XPOKEB(SEG, DST, BYTEVAL)
//
asm xpokeb
- LDA ESTKL+1,X
- STA DSTL
- LDA ESTKH+1,X
- CLC
- ADC #$60
- STA DSTH
- LDA ESTKL+2,X
- ORA #$80
- STA DSTX
- DEC DSTX
- LDY #$00
- LDA ESTKL,X
- STA (DST),Y
- STY DSTX
- INX
- INX
- RTS
+ LDA ESTKL+1,X
+ STA DSTL
+ LDA ESTKH+1,X
+ CLC
+ ADC #$60
+ STA DSTH
+ LDA ESTKL+2,X
+ ORA #$80
+ STA DSTX
+ DEC DSTX
+ LDY #$00
+ LDA ESTKL,X
+ STA (DST),Y
+ STY DSTX
+ INX
+ INX
+ RTS
end
//
// Unsigned word comparisons.
//
asm uword_isge
- LDA ESTKL+1,X
- CMP ESTKL,X
- LDA ESTKH+1,X
- SBC ESTKH,X
- LDA #$FF
- ADC #$00
- EOR #$FF
- STA ESTKL+1,X
- STA ESTKH+1,X
- INX
- RTS
+ LDA ESTKL+1,X
+ CMP ESTKL,X
+ LDA ESTKH+1,X
+ SBC ESTKH,X
+ LDA #$FF
+ ADC #$00
+ EOR #$FF
+ STA ESTKL+1,X
+ STA ESTKH+1,X
+ INX
+ RTS
end
asm uword_isle
- LDA ESTKL,X
- CMP ESTKL+1,X
- LDA ESTKH,X
- SBC ESTKH+1,X
- LDA #$FF
- ADC #$00
- EOR #$FF
- STA ESTKL+1,X
- STA ESTKH+1,X
- INX
- RTS
+ LDA ESTKL,X
+ CMP ESTKL+1,X
+ LDA ESTKH,X
+ SBC ESTKH+1,X
+ LDA #$FF
+ ADC #$00
+ EOR #$FF
+ STA ESTKL+1,X
+ STA ESTKH+1,X
+ INX
+ RTS
end
asm uword_isgt
- LDA ESTKL,X
- CMP ESTKL+1,X
- LDA ESTKH,X
- SBC ESTKH+1,X
- LDA #$FF
- ADC #$00
- STA ESTKL+1,X
- STA ESTKH+1,X
- INX
- RTS
+ LDA ESTKL,X
+ CMP ESTKL+1,X
+ LDA ESTKH,X
+ SBC ESTKH+1,X
+ LDA #$FF
+ ADC #$00
+ STA ESTKL+1,X
+ STA ESTKH+1,X
+ INX
+ RTS
end
asm uword_islt
- LDA ESTKL+1,X
- CMP ESTKL,X
- LDA ESTKH+1,X
- SBC ESTKH,X
- LDA #$FF
- ADC #$00
- STA ESTKL+1,X
- STA ESTKH+1,X
- INX
- RTS
+ LDA ESTKL+1,X
+ CMP ESTKL,X
+ LDA ESTKH+1,X
+ SBC ESTKH,X
+ LDA #$FF
+ ADC #$00
+ STA ESTKL+1,X
+ STA ESTKH+1,X
+ INX
+ RTS
end
//
// Addresses of internal routines.
//
asm interp
- DEX
- LDA #XINTERP
- STA ESTKH,X
- RTS
+ DEX
+ LDA #XINTERP
+ STA ESTKH,X
+ RTS
end
-//
+//
// A DCI string is one that has the high bit set for every character except the last.
// More efficient than C or Pascal strings.
//
@@ -433,28 +427,28 @@ end
// return len
//end
asm dcitos
- LDA ESTKL,X
- STA DSTL
- LDA ESTKH,X
- STA DSTH
- LDA ESTKL+1,X
- STA SRCL
- LDA ESTKH+1,X
- STA SRCH
- LDY #$00
-- LDA (SRC),Y
- CMP #$80
- AND #$7F
- INY
- STA (DST),Y
- BCS -
- TYA
- LDY #$00
- STA (DST),Y
- INX
- STA ESTKL,X
- STY ESTKH,X
- RTS
+ LDA ESTKL,X
+ STA DSTL
+ LDA ESTKH,X
+ STA DSTH
+ LDA ESTKL+1,X
+ STA SRCL
+ LDA ESTKH+1,X
+ STA SRCH
+ LDY #$00
+- LDA (SRC),Y
+ CMP #$80
+ AND #$7F
+ INY
+ STA (DST),Y
+ BCS -
+ TYA
+ LDY #$00
+ STA (DST),Y
+ INX
+ STA ESTKL,X
+ STY ESTKH,X
+ RTS
end
//def stodci(str, dci)
// byte len, c
@@ -466,50 +460,50 @@ end
// len = len - 1
// (dci).[len] = c
// while len
-// c = toupper((str).[len]) | $80
-// len = len - 1
-// (dci).[len] = c
+// c = toupper((str).[len]) | $80
+// len = len - 1
+// (dci).[len] = c
// loop
// return ^str
//end
asm stodci
- LDA ESTKL,X
- STA DSTL
- LDA ESTKH,X
- STA DSTH
- LDA ESTKL+1,X
- STA SRCL
- LDA ESTKH+1,X
- STA SRCH
- INX
- LDY #$00
- LDA (SRC),Y
- BEQ ++
- TAY
- LDA (SRC),Y
- JSR TOUPR
- BNE +
-- LDA (SRC),Y
- JSR TOUPR
- ORA #$80
-+ DEY
- STA (DST),Y
- BNE -
- LDA (SRC),Y
-++ STA ESTKL,X
- STY ESTKH,X
- RTS
+ LDA ESTKL,X
+ STA DSTL
+ LDA ESTKH,X
+ STA DSTH
+ LDA ESTKL+1,X
+ STA SRCL
+ LDA ESTKH+1,X
+ STA SRCH
+ INX
+ LDY #$00
+ LDA (SRC),Y
+ BEQ ++
+ TAY
+ LDA (SRC),Y
+ JSR TOUPR
+ BNE +
+- LDA (SRC),Y
+ JSR TOUPR
+ ORA #$80
++ DEY
+ STA (DST),Y
+ BNE -
+ LDA (SRC),Y
+++ STA ESTKL,X
+ STY ESTKH,X
+ RTS
end
asm toupper
- LDA ESTKL,X
-TOUPR AND #$7F
- CMP #'a'
- BCC +
- CMP #'z'+1
- BCS +
- SBC #$1F
-+ STA ESTKL,X
- RTS
+ LDA ESTKL,X
+TOUPR AND #$7F
+ CMP #'a'
+ BCC +
+ CMP #'z'+1
+ BCS +
+ SBC #$1F
++ STA ESTKL,X
+ RTS
end
//
// Module symbols are entered into the symbol table
@@ -528,25 +522,25 @@ end
// return dci
//end
asm modtosym
- LDA ESTKL+1,X
- STA SRCL
- LDA ESTKH+1,X
- STA SRCH
- LDA ESTKL,X
- STA ESTKL+1,X
- STA DSTL
- LDA ESTKH,X
- STA ESTKH+1,X
- STA DSTH
- INX
- LDY #$00
- LDA #'#'+$80
-- STA (DST),Y
- ASL
- LDA (SRC),Y
- INY
- BCS -
- RTS
+ LDA ESTKL+1,X
+ STA SRCL
+ LDA ESTKH+1,X
+ STA SRCH
+ LDA ESTKL,X
+ STA ESTKL+1,X
+ STA DSTL
+ LDA ESTKH,X
+ STA ESTKH+1,X
+ STA DSTH
+ INX
+ LDY #$00
+ LDA #'#'+$80
+- STA (DST),Y
+ ASL
+ LDA (SRC),Y
+ INY
+ BCS -
+ RTS
end
//
// Lookup routines.
@@ -569,53 +563,53 @@ end
// loop
// return 0
asm lookuptbl
- LDY #$00
- STY DSTL
- LDA ESTKH,X
- CLC
- ADC #$60
- STA DSTH
- LDA ESTKL,X
- ORA #$80
- STA DSTX
- DEC DSTX
- LDA ESTKL+1,X
- STA SRCL
- LDA ESTKH+1,X
- STA SRCH
-- LDA (DST),Y
- BEQ +
- CMP (SRC),Y
- BNE ++
- INY
- ASL
- BCS -
- LDA (DST),Y
- PHA
- INY
- LDA (DST),Y
- TAY
- PLA
-+ INX
- STA ESTKL,X
- STY ESTKH,X
- LDA #$00
- STA DSTX
- RTS
-++ LDY #$00
--- LDA (DST),Y
- INC DSTL
- BEQ +
---- ASL
- BCS --
- LDA #$02
- ADC DSTL
- STA DSTL
- BCC -
- INC DSTH
- BCS -
-+ INC DSTH
- BNE ---
+ LDY #$00
+ STY DSTL
+ LDA ESTKH,X
+ CLC
+ ADC #$60
+ STA DSTH
+ LDA ESTKL,X
+ ORA #$80
+ STA DSTX
+ DEC DSTX
+ LDA ESTKL+1,X
+ STA SRCL
+ LDA ESTKH+1,X
+ STA SRCH
+- LDA (DST),Y
+ BEQ +
+ CMP (SRC),Y
+ BNE ++
+ INY
+ ASL
+ BCS -
+ LDA (DST),Y
+ PHA
+ INY
+ LDA (DST),Y
+ TAY
+ PLA
++ INX
+ STA ESTKL,X
+ STY ESTKH,X
+ LDA #$00
+ STA DSTX
+ RTS
+++ LDY #$00
+-- LDA (DST),Y
+ INC DSTL
+ BEQ +
+--- ASL
+ BCS --
+ LDA #$02
+ ADC DSTL
+ STA DSTL
+ BCC -
+ INC DSTH
+ BCS -
++ INC DSTH
+ BNE ---
end
//
// SOS routines
@@ -697,7 +691,7 @@ end
//
def dev_control(devnum, code, list)
byte params[5]
-
+
params.0 = 3
params.1 = devnum
params.2 = code
@@ -707,7 +701,7 @@ def dev_control(devnum, code, list)
end
def dev_getnum(name)
byte params[4]
-
+
params.0 = 2
params:1 = name
params.3 = 0
@@ -716,7 +710,7 @@ def dev_getnum(name)
end
def dev_info(devnum, name, list, listlen)
byte params[7]
-
+
params.0 = 4
params.1 = devnum
params:2 = name
@@ -730,7 +724,7 @@ end
//
def seg_request(base, limit, id)
byte params[7]
-
+
params.0 = 4
params:1 = base
params:3 = limit
@@ -741,7 +735,7 @@ def seg_request(base, limit, id)
end
def seg_find(search, base, limit, pages, id)
byte params[10]
-
+
params.0 = 6
params.1 = search
params.2 = id
@@ -756,7 +750,7 @@ def seg_find(search, base, limit, pages, id)
end
def seg_release(segnum)
byte params[2]
-
+
params.0 = 1
params.1 = segnum
perr = syscall($45, @params)
@@ -790,7 +784,7 @@ end
def cout(ch)
if ch == $0D
ch = $0A0D
- write(refcons, @ch, 2)
+ write(refcons, @ch, 2)
else
write(refcons, @ch, 1)
fin
@@ -904,12 +898,12 @@ def lookupextern(esd, index)
esd = esd + dcitos(esd, @str)
if esd->0 & $10 and esd->1 == index
addr = lookupsym(sym)
- if !addr
+ if !addr
lerr = $81
- cout('?')
- prstr(@str)
- crout
- fin
+ cout('?')
+ prstr(@str)
+ crout
+ fin
return addr
fin
esd = esd + 3
@@ -950,73 +944,75 @@ def loadmod(mod)
refnum = open(@filename, O_READ)
if refnum > 0
rdlen = read(refnum, @header, 128)
- modsize = header:0
- moddep = @header.1
- defofst = modsize
+ modsize = header:0
+ moddep = @header.1
+ defofst = modsize
init = 0
- if rdlen > 4 and header:2 == $DA7E // DAVE = magic number :-)
+ if rdlen > 4 and header:2 == $DA7F // DAVE+1 = magic number :-)
//
// This is an EXTended RELocatable (data+bytecode) module.
//
- systemflags = header:4 | systemflags
+ systemflags = header:4 | systemflags
defofst = header:6
defcnt = header:8
init = header:10
moddep = @header.12
- //
- // Load module dependencies.
- //
+ //
+ // Load module dependencies.
+ //
while ^moddep
if !lookupmod(moddep)
- if refnum
- close(refnum)
- refnum = 0
- fin
+ if refnum
+ close(refnum)
+ refnum = 0
+ fin
if loadmod(moddep) < 0
- return -perr
- fin
+ return -perr
+ fin
fin
moddep = moddep + dcitos(moddep, @str)
loop
- //
- // Init def table.
- //
- deftbl = allocheap(defcnt * 6 + 1)
- deflast = deftbl
- ^deflast = 0
- if !refnum
- //
- // Reset read pointer.
- //
- refnum = open(@filename, O_READ)
- rdlen = read(refnum, @header, 128)
- fin
+ //
+ // Init def table.
+ //
+ deftbl = allocheap(defcnt * 6 + 1)
+ deflast = deftbl
+ ^deflast = 0
+ if !refnum
+ //
+ // Reset read pointer.
+ //
+ refnum = open(@filename, O_READ)
+ rdlen = read(refnum, @header, 128)
+ fin
+ else
+ return -69
fin
- //
- // Alloc heap space for relocated module (data + bytecode).
- //
- moddep = moddep + 1
- modfix = moddep - @header.2 // Adjust to skip header
- modsize = modsize - modfix
- rdlen = rdlen - modfix - 2
- modaddr = allocheap(modsize)
- memcpy(modaddr, moddep, rdlen)
- //
- // Read in remainder of module into memory for fixups.
- //
- addr = modaddr
+ //
+ // Alloc heap space for relocated module (data + bytecode).
+ //
+ moddep = moddep + 1
+ modfix = moddep - @header.2 // Adjust to skip header
+ modsize = modsize - modfix
+ rdlen = rdlen - modfix - 2
+ modaddr = allocheap(modsize)
+ memcpy(modaddr, moddep, rdlen)
+ //
+ // Read in remainder of module into memory for fixups.
+ //
+ addr = modaddr
repeat
addr = addr + rdlen
rdlen = read(refnum, addr, 4096)
until rdlen <= 0
close(refnum)
- //
- // Add module to symbol table.
- //
- addmod(mod, modaddr)
- //
- // Apply all fixups and symbol import/export.
- //
+ //
+ // Add module to symbol table.
+ //
+ addmod(mod, modaddr)
+ //
+ // Apply all fixups and symbol import/export.
+ //
modfix = modaddr - modfix
bytecode = defofst + modfix - MODADDR
modend = modaddr + modsize
@@ -1024,38 +1020,38 @@ def loadmod(mod)
esd = rld // Extern+Entry Symbol Directory
while ^esd // Scan to end of ESD
esd = esd + 4
- loop
+ loop
esd = esd + 1
- //
- // Locate bytecode defs in allocated segment.
- //
- modseg[modid] = seg_find($00, @codeseg, @defaddr, (rld - bytecode + 255) >> 8, modid + $12)
- if perr
- return -perr
- fin
- modid = modid + 1
- defext = (codeseg.0 | $80) - 1
- defaddr = (codeseg & $FF00) + $6000
+ //
+ // Locate bytecode defs in allocated segment.
+ //
+ modseg[modid] = seg_find($00, @codeseg, @defaddr, (rld - bytecode + 255) >> 8, modid + $12)
+ if perr
+ return -perr
+ fin
+ modid = modid + 1
+ defext = (codeseg.0 | $80) - 1
+ defaddr = (codeseg & $FF00) + $6000
//
// Run through the Re-Location Dictionary.
//
while ^rld
if ^rld == $02
- //
- // This is a bytcode def entry - add it to the def directory.
- //
+ //
+ // This is a bytcode def entry - add it to the def directory.
+ //
adddef(defext, rld=>1 - defofst + defaddr, @deflast)
else
addr = rld=>1 + modfix
if uword_isge(addr, modaddr) // Skip fixups to header
if ^rld & $80 // WORD sized fixup.
fixup = *addr
- else // BYTE sized fixup.
+ else // BYTE sized fixup.
fixup = ^addr
fin
if ^rld & $10 // EXTERN reference.
fixup = fixup + lookupextern(esd, rld->3)
- else // INTERN fixup.
+ else // INTERN fixup.
fixup = fixup + modfix - MODADDR
if uword_isge(fixup, bytecode)
//
@@ -1066,44 +1062,44 @@ def loadmod(mod)
fin
if ^rld & $80 // WORD sized fixup.
*addr = fixup
- else // BYTE sized fixup.
+ else // BYTE sized fixup.
^addr = fixup
fin
fin
fin
rld = rld + 4
loop
- //
+ //
// Run through the External/Entry Symbol Directory.
- //
+ //
while ^esd
sym = esd
esd = esd + dcitos(esd, @str)
if ^esd & $08
- //
+ //
// EXPORT symbol - add it to the global symbol table.
- //
+ //
addr = esd=>1 + modfix - MODADDR
if uword_isge(addr, bytecode)
- //
- // Use the def directory address for bytecode.
- //
+ //
+ // Use the def directory address for bytecode.
+ //
addr = lookupdef(addr - bytecode + defaddr, deftbl)
fin
addsym(sym, addr)
fin
esd = esd + 3
loop
- if defext
- //
- // Copy bytecode to code segment.
- //
- memxcpy(codeseg, bytecode, modsize - (bytecode - modaddr))
- fin
- //
- // Free up end-of-module main memory.
- //
- releaseheap(bytecode)
+ if defext
+ //
+ // Copy bytecode to code segment.
+ //
+ memxcpy(codeseg, bytecode, modsize - (bytecode - modaddr))
+ fin
+ //
+ // Free up end-of-module main memory.
+ //
+ releaseheap(bytecode)
else
return -perr
fin
@@ -1134,14 +1130,14 @@ def volumes
for i = $01 to $18
if dev_info(i, @devname, @info, 11) == 0
- prstr(@devname)
- if volume(@devname, @volname, @ttlblks, @freblks) == 0
- prstr(@devtovol)
- prstr(@volname)
- cout('/')
- fin
- crout
- fin
+ prstr(@devname)
+ if volume(@devname, @volname, @ttlblks, @freblks) == 0
+ prstr(" => ")
+ prstr(@volname)
+ cout('/')
+ fin
+ crout
+ fin
next
perr = 0
end
@@ -1183,12 +1179,12 @@ def catalog(optpath)
if type & $F0 == $D0 // Is it a directory?
cout('/')
len = len + 1
- elsif entry->$10 == $FF
- cout('-')
- len = len + 1
- elsif entry->$10 == $FE
- cout('+')
- len = len + 1
+ elsif entry->$10 == $FF
+ cout('-')
+ len = len + 1
+ elsif entry->$10 == $FE
+ cout('+')
+ len = len + 1
fin
for len = 19 - len downto 0
cout(' ')
@@ -1227,9 +1223,9 @@ def striptrail(strptr)
for i = 1 to ^strptr
if (strptr)[i] <= ' '
- ^strptr = i - 1
- return
- fin
+ ^strptr = i - 1
+ return
+ fin
next
end
def parsecmd(strptr)
@@ -1252,20 +1248,20 @@ def execmod(modfile)
perr = 1
if stodci(modfile, @moddci)
saveheap = heap
- savesym = lastsym
- saveflags = systemflags
- if loadmod(@moddci) < modkeep
- lastsym = savesym
- heap = saveheap
- while modid
- modid = modid - 1
- seg_release(modseg[modid])
- loop
+ savesym = lastsym
+ saveflags = systemflags
+ if loadmod(@moddci) < modkeep
+ lastsym = savesym
+ heap = saveheap
+ while modid
+ modid = modid - 1
+ seg_release(modseg[modid])
+ loop
else
- modid = 0
- fin
- xpokeb(symtbl.0, lastsym, 0)
- systemflags = saveflags
+ modid = 0
+ fin
+ xpokeb(symtbl.0, lastsym, 0)
+ systemflags = saveflags
fin
return -perr
end
@@ -1299,12 +1295,12 @@ else
//
// Print some startup info.
//
- prstr(@verstr)
+ prstr("PLASMA ")
prbyte(version.1)
cout('.')
prbyte(version.0)
crout
- prstr(@freestr)
+ prstr("MEM:$")
prword(availheap)
crout
fin
@@ -1316,32 +1312,32 @@ while 1
if ^cmdptr
when toupper(parsecmd(cmdptr))
is 'Q'
- quit
- is 'C'
- catalog(cmdptr)
- break
- is 'P'
- setpfx(cmdptr)
- break
- is 'V'
- volumes
- break
- is '+'
- execmod(cmdptr)
- write(refcons, @textmode, 3)
- break
- otherwise
- prstr(@huhstr)
+ quit
+ is 'C'
+ catalog(cmdptr)
+ break
+ is 'P'
+ setpfx(cmdptr)
+ break
+ is 'V'
+ volumes
+ break
+ is '+'
+ execmod(cmdptr)
+ write(refcons, @textmode, 3)
+ break
+ otherwise
+ prstr("?\n")
wend
if perr
- terr = perr
- prstr(@errorstr)
- prbyte(terr)
- perr = 0
+ terr = perr
+ prstr("ERR:$")
+ prbyte(terr)
+ perr = 0
else
- prstr(@okstr)
+ prstr("OK\n")
fin
- crout()
+ crout()
fin
prstr(getpfx(@prefix))
cmdptr = rdstr($BA)