6502/PLASMA
1
0
Fork 0
mirror of https://github.com/dschmenk/PLASMA.git synced 2024-08-21 06:29:07 +00:00
Code Issues Projects Releases Wiki Activity

Merge pull request #7 from dschmenk/master

Browse Source 
Merge latest upstream changes
This commit is contained in:
ZornsLemma 2018-01-16 20:53:39 +00:00 committed by GitHub
commit 9174cfef2a
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
66 changed files with 5573 additions and 7257 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
PLASMA-BLD1.PO Normal file
View File

Binary file not shown.

BIN
PLASMA-PRE1.PO Normal file
View File

Binary file not shown.

95
README.md
View File

@ -7,7 +7,7 @@ PLASMA: **P**roto **L**anguage **A**s**S**e**M**bler for **A**pple
PLASMA is a medium level programming language targeting the 8-bit 6502 processor. Historically, there were simple languages developed in the early years of computers that improved on the tedium of assembly language programming while still being low level enough for system coding. Languages like B, FORTH, and PLASMA fall into this category.
PLASMA is a combination of virtual machine and assembler/compiler matched closely to the 6502 architecture. It is an attempt to satisfy a few challenges surrounding code size, efficient execution, small runtime and flexible code location. By architecting a unique bytecode that maps nearly one-to-one to the higher-level representation, the compiler can be very simple and execute quickly on the Apple II for a self-hosted environment. A modular approach provides for incremental development and code reuse. The syntax of the language is heavily influenced by assembly, Pascal, and C. The design philosophy was to be as simple as feasible while retaining flexibility and symantic clarity. You won't find any unnecessary or redundant syntax in PLASMA.
PLASMA is a combination of operating environment, virtual machine, and assembler/compiler matched closely to the 6502 architecture. It is an attempt to satisfy a few challenges surrounding code size, efficient execution, small runtime and flexible code location. By architecting a unique bytecode that maps nearly one-to-one to the higher-level representation, the compiler can be very simple and execute quickly on the Apple II for a self-hosted environment. A modular approach provides for incremental development and code reuse. The syntax of the language is heavily influenced by assembly, Pascal, and C. The design philosophy was to be as simple as feasible while retaining flexibility and symantic clarity. You won't find any unnecessary or redundant syntax in PLASMA.
Different projects have led to the architecture of PLASMA, most notably Apple Pascal, FORTH, and my own Java VM for the 6502: VM02. Each has tried to map a generic VM to the 6502 with varying levels of success. Apple Pascal, based on the USCD Pascal using the p-code interpreter, was a very powerful system and ran fast enough on the Apple II to be interactive but didn't win any speed contests. FORTH was the poster child for efficiency and obtuse syntax. Commonly referred to as a write only language, it was difficult to come up to speed as a developer, especially when using others' code. My own project in creating a Java VM for the Apple II uncovered the folly of shoehorning a large, 32-bit virtual memory environment into 8-bit, 64K hardware.
@ -101,6 +101,8 @@ Different projects have led to the architecture of PLASMA, most notably Apple Pa
# Build Environment
## PLASMA Cross-Compiler
The first step in writing PLASMA code is to get a build environment working. If you have Unix-like environment, then this is a fairly easy exercise. Windows users may want to install the [Cygwin](https://www.cygwin.com/) environment to replicate a Unix-like environment under Windows. When installing Cygwin, make sure **gcc-core**, **make**, and **git** are installed under the **Devel** packages. Mac OS X users may have to install the **Xcode** from the App Store.
Launch the command-line/terminal application for your environment to download and build PLASMA. Create a source code directory and change the working directory to it, something like:
@ -110,7 +112,7 @@ mkdir Src
cd Src
```
## acme Cross-Assembler
### acme Cross-Assembler
There are two source projects you need to download: the first is a nice cross-platform 6502 assembler called [acme](http://sourceforge.net/p/acme-crossass/code-0/6/tree/trunk/docs/QuickRef.txt). Download, build, and install the acme assembler by typing:
@ -124,7 +126,7 @@ cd ../..
Under Unix that `cp` command may have to be preceded by `sudo` to elevate the privileges to copy into `/usr/local/bin`.
## PLASMA Source
### PLASMA Source
Now, to download PLASMA and build it, type:
@ -134,7 +136,7 @@ cd PLASMA/src
make
```
### Portable VM
#### Portable VM
To see if everything built correctly, type:
@ -166,6 +168,22 @@ to run the module. You will be rewarded with `Hello, world.` printed to the scre
and you should see the same screenful of gibberish you saw from the portable VM, but on the Apple II this time. Both VMs are running the exact same module binaries. To view the source of these modules refer to `PLASMA/src/samplesrc/hello.pla`, `PLASMA/src/samplesrc/test.pla`, and `PLASMA/src/samplesrc/testlib.pla`. To get even more insight into the compiled source, view the corresponding `.a` files.
## PLASMA Target Hosted Compiler
The PLASMA compiler is also self-hosted on the Apple II and III. The PLASMA system and development disks can be run on a real or emulated machine. It is recommended to copy the files to a hard disk, or similar mass storage device. Boot the PLASMA system and change the prefix to the development disk/directory. The 'HELLO.PLA' source file should be there. To compile the module, type:
```
+PLASM HELLO.PLA
```
After the compiler loads (which can take some time on an un-accelerated machine), you will see the compiler banner message. The complilation process prints out a `.` once in awhile. When compilation is complete, the module will be written to disk, and the prompt will return. To execute the module, type:
```
+HELLO
```
and just like with the cross-compiled module, you will get the `Hello, word.` message printed to the screen.
# Tutorial
During KansasFest 2015, I gave a PLASMA introduction using the Apple II PLASMA sandbox IDE. You can play along using your favorite Apple II emulator, or one that runs directly in your browser: [Apple II Emulator in Javascript](https://www.scullinsteel.com/apple/e). Download [SANDBOX.PO](https://github.com/dschmenk/PLASMA/blob/master/SANDBOX.PO?raw=true) and load it into Drive 1 of the emulator. Start the [KansasFest PLASMA Code-along video](https://www.youtube.com/watch?v=RrR79WVHwJo?t=11m24s) and follow along.
@ -178,11 +196,11 @@ Although the low-level PLASMA VM operations could easily by coded by hand, they
## PLASMA Modules
PLASMA programs are built up around modules: small, self contained, dynamically loaded and linked software components that provide a well defined interface to other modules. The module format extends the .REL file type originally defined by the EDASM assembler from the DOS/ProDOS Toolkit from Apple Computer, Inc. PLASMA extends the file format through a backwards compatible extension that the PLASMA loader recognizes to locate the PLASMA bytecode and provide for advanced dynamic loading of module dependencies.
PLASMA programs are built up around modules: small, self contained, dynamically loaded and linked software components that provide a well defined interface to other modules. The module format extends the .REL file type originally defined by the EDASM assembler from the DOS/ProDOS Toolkit from Apple Computer, Inc. PLASMA extends the file format through a backwards compatible extension that the PLASMA loader recognizes to locate the PLASMA bytecode and provide for advanced dynamic loading of module dependencies. Modules are first-class citizens in PLASMA: an imported module is assigned to a variable which can be accessed like any other.
## Data Types
PLASMA only defines two data types: `byte` and `word`. All operations take place on word-sized quantities, with the exception of loads and stores to byte sized addresses. The interpretation of a value can be an integer, an address, or anything that fits in 16 bits. There are a number of address operators to identify how an address value is to be interpreted.
PLASMA only defines two data types: `char`(or `byte`) and `var`(or `word`). All operations take place on word-sized quantities, with the exception of loads and stores to byte sized addresses. The interpretation of a value can be an integer, an address, or anything that fits in 16 bits. There are a number of address operators to identify how an address value is to be interpreted.
## Obligatory 'Hello World'
@ -258,8 +276,8 @@ end
import testlib
predef puti
byte testdata, teststring
word testarray
char testdata, teststring
var testarray
end
```
@ -301,9 +319,9 @@ There is a shortcut for defining constant offsets into structures:
```
struc t_entry
word id
byte[32] name
word next_entry
var id
char[32] name
var next_entry
end
```
@ -357,7 +375,7 @@ Strings are defined like Pascal strings, a length byte followed by the string ch
//
// An initialized string of 64 characters
//
byte[64] txtfile = "UNTITLED"
char[64] txtfile = "UNTITLED"
```
### Function Definitions
@ -446,7 +464,7 @@ Values can be treated as pointers by preceding them with a `^` for byte pointers
```
char[] hellostr = "Hello"
word srcstr, strlen
var srcstr, strlen
srcstr = @hellostr // srcstr points to address of hellostr
strlen = ^srcstr // the first byte srcstr points to is the string length
@ -456,8 +474,8 @@ Functions with parameters or expressions to be used as a function address to cal
```
predef keyin2plus
word keyin
byte key
var keyin
char key
keyin = @keyin2plus // address-of keyin2plus function
key = keyin()
@ -589,14 +607,14 @@ Here is an example using the `import`s from the previous examples to export an i
```
predef mydef(var)
export word[10] myfuncs = @putc, @mydef, $0000
export var[10] myfuncs = @putc, @mydef, $0000
```
Exporting functions is simple:
```
export def plot(x, y)
romcall(y, 0, x, 0, $F800)
call($F800, y, 0, x, 0)
end
```
@ -622,7 +640,7 @@ call(addr, aReg, xReg, yReg, statusReg) returns a pointer to a four-byte structu
const xreg = 1
const getlin = $FD6A
numchars = call(getlin, 0, 0, 0, 0).xreg // return char count in X reg
numchars = call(getlin, 0, 0, 0, 0)->xreg // return char count in X reg
```
syscall(cmd, params) calls ProDOS, returning the status value.
@ -644,14 +662,14 @@ putc(char), puts(string), home, gotoxy(x,y), getc() and gets() are other handy u
```
putc('.')
byte okstr[] = "OK"
char okstr[] = "OK"
puts(@okstr)
```
memset(addr, val, len) will fill memory with a 16-bit value. memcpy(dstaddr, srcaddr, len) will copy memory from one address to another, taking care to copy in the proper direction.
```
byte nullstr[] = ""
char nullstr[] = ""
memset(strlinbuf, @nullstr, maxfill * 2) // fill line buff with pointer to null string
memcpy(scrnptr, strptr + ofst + 1, numchars)
```
@ -719,8 +737,8 @@ predef myfunc
byte smallarray[4]
byte initbarray[] = 1, 2, 3, 4, 5, 6, 7, 8, 9, 10
byte string[64] = "Initialized string"
word wlabel[]
char string[64] = "Initialized string"
var wlabel[]
word = 1000, 2000, 3000, 4000 // Anonymous array
word funclist = @myfunc, $0000
```
@ -732,14 +750,33 @@ predef myfunc(var)#0
byte[4] smallarray
byte[] initbarray = 1, 2, 3, 4, 5, 6, 7, 8, 9, 10
byte[64] string = "Initialized string"
word[] wlabel
char[64] string = "Initialized string"
var[] wlabel
word = 1000, 2000, 3000, 4000 // Anonymous array
word funclist = @myfunc, $0000
```
Arrays can be uninitialized and reserve a size, as in `smallarray` above. Initialized arrays without a size specified in the definition will take up as much data as is present, as in `initbarray` above. Strings are special arrays that include a hidden length byte in the beginning (Pascal strings). When specified with a size, a minimum size is reserved for the string value. Labels can be defined as arrays without size or initializers; this can be useful when overlapping labels with other arrays or defining the actual array data as anonymous arrays in following lines as in `wlabel` and following lines. Addresses of other data (must be defined previously) or function definitions (pre-defined with predef), including imported references, can be initializers.
The base array size can be used to initialize multiple variable of arbitrary size. Three, four byte values can be defined as such:
```
byte[4] a, b, c
```
All three variables will have 4 bytes reserved for them. If you combine a base size with an array size, you can define multiple large values. For instance,
```
byte[4] a[5]
```
will assign an array of five, four byte elements, for a total of 20 bytes. This may make more sense when we combine the alias for `byte`, `res` with structure definitions. An array of five structures would look like:
```
res[t_record] patient[20]
```
The result would be to reserve 20 patient records.
#### Type Overrides
Arrays are usually identified by the data type specifier, `byte` or `word` when the array is defined. However, this can be overridden with the type override specifiers: `:` and `.`. `:` overrides the type to be `word`, `.` overrides the type to be `byte`. An example of accessing a `word` array as `bytes`:
@ -1018,6 +1055,12 @@ predef bivalfunc#2
a, b = bivalfunc() // Two values returned from function
stack[0], stack[1], stack[3] = 0, stack[0], stack[1] // Push 0 to bottom of three element stack
```
Should multiple values be returned, but only a subset is interesting, the special value `drop` can be used to ignore values.
```
predef trivalfunc#3
drop, drop, c = trivalfunc() // Three values returned from function, but we're only interested in the last one
```
#### Empty Assignments
An assignment doesn't even need to save the expression into memory, although the expression will be evaluated. This can be useful when referencing hardware that responds just to being accessed. On the Apple II, the keyboard is read from location $C000, then the strobe, telling the hardware to prepare for another key press is cleared by just reading the address $C010. In PLASMA, this looks like:
@ -1298,8 +1341,8 @@ The compact code representation comes through the use of opcodes closely matched
| $2E | CS | constant string
| $30 | DROP | drop top stack value
| $32 | DUP | duplicate top stack value
| $34 | PUSHEP | push eval stack pointer call stack
| $36 | PULLEP | pull eval stack pointer from call stack
| $34 | NOP |
| $36 | DIVMOD | divide next from to by top, leave result and remainder on stack
| $38 | BRGT | branch next from top greater than top
| $3A | BRLT | branch next from top less than top
| $3C | BREQ | branch next from top equal to top

92
doc/Architecture.md
View File

@ -1,92 +0,0 @@
# PLASMA 123 Internal Architecture
This document describes the low-level implementation of PLASMA. It is not necessary to know how PLASMA is implemented to write PLASMA programs, but understanding how the virtual machine operates can give you insight on how certain operations are carried out and how to write optimal PLASMA code. It *is* a requirement to understand when interfacing to native 6502 code. PLASMA consists of a virtual machine and a compiler to translate PLASMA source code to PLASMA bytecode.
## The Virtual Machine
The 6502 processor is a challenging target for a compiler. Most high level languages do have a compiler avialable targetting the 6502, but none are particularly efficient at code generation. Usually a series of calls into routines that do much of the work, not too dissimlar to a threaded interpreter. Generating inline 6502 leads quickly to code bloat and unwieldy binaries. The trick is to find a happy medium between efficient code execution and small code size. To this end, the PLASMA VM enforces some restrictions that are a result of the 6502 architecture, yet don't hamper the expressiveness of the PLASMA language.
### The Stacks
The PLASMA VM is architected around three stacks: the evaluation stack, the call stack, and the local frame stack. These stacks provide the PLASMA VM with foundation for efficient operation and compact bytecode. The stack architecure also creates a simple target for the PLASMA compiler.
#### The Evaluation Stack
All calculations, data moves, and paramter passing is done on the evaluation stack. This stack is located on the zero page of the 6502; an efficient section of memory that can be addressed with only an eight bit address. As a structure that is accessed more than any other on PLASMA, it makes sense to put it in fastest memory. The evaluation stack is a 16 entry stack that is split into low bytes and high bytes. The 6502's X register is used to index into the evaluation stack. It *always* points to the top of the evaluation stack, so care must be taken to save/restore its value when calling native 6502 code. Parameters and results are also passed on the evaluation stack. Caller and callee must agree on the number of parameters: PLASMA does no error checking. Native functions can pull values from the evaluation stack by using the zero page indexed addressing using the X register.
#### The Call Stack
Function calls use the call stack to save the return address of the calling code. PLASMA uses the 6502 hardware stack for this purpose, as it is the 6502's JSR (Jump SubRoutine) instruction that PLASMA's call opcodes are implemented.
#### The Local Frame Stack
One of the biggest problems to overcome with the 6502 is its very small hardware stack. Algorithms that incorporate recursive procedure calls are very difficult or slow on the 6502. PLASMA takes the middle ground when implementing local frames; a frame pointer on the zero page is indirectly indexed by the Y register. Because the Y register is only eight bits, the local frame size is limited to 256 bytes. 256 bytes really is sufficient for all but the most complex of functions. With a little creative use of dynamic memory allocation, almost anything can be implemented without undue hassle. When a function with parameters is called, the first order of business is to allocate the frame, copy the parameters off the evaluation stack into local variables, and save a link to the previous frame. This is all done automatically with the ENTER opcode. The reverse takes place with the LEAVE opcode when the function exits. Functions that have neither parameters or local variables can forgoe the frame build/destroy process.
#### The Local String Pool
In-line strings are copied from the bytecode stream into the local string pool during execution. The string pool is deallocated along with the local frame whenthe function exits.
### The Bytecodes
The compact code representation comes through the use of opcodes closely matched to the PLASMA compiler. They are:
| OPCODE | Name | Description
|:------:|:------:|-----------------------------------
| $00 | ZERO | push zero on the stack
| $02 | ADD | add top two values, leave result on top
| $04 | SUB | subtract next from top from top, leave result on top
| $06 | MUL | multiply two topmost stack values, leave result on top
| $08 | DIV | divide next from top by top, leave result on top
| $0A | MOD | divide next from top by top, leave remainder on top
| $0C | INCR | increment top of stack
| $0E | DECR | decrement top of stack
| $10 | NEG | negate top of stack
| $12 | COMP | compliment top of stack
| $14 | AND | bit wise AND top two values, leave result on top
| $16 | IOR | bit wise inclusive OR top two values, leave result on top
| $18 | XOR | bit wise exclusive OR top two values, leave result on top
| $1A | SHL | shift left next from top by top, leave result on top
| $1C | SHR | shift right next from top by top, leave result on top
| $02 | IDXB | add top of stack to next from top, leave result on top (ADD)
| $1E | IDXW | add 2X top of stack to next from top, leave result on top
| $20 | NOT | logical NOT of top of stack
| $22 | LOR | logical OR top two values, leave result on top
| $24 | LAND | logical AND top two values, leave result on top
| $26 | LA | load address
| $28 | LLA | load local address from frame offset
| $2A | CB | constant byte
| $2C | CW | constant word
| $2E | CS | constant string
| $30 | DROP | drop top stack value
| $32 | DUP | duplicate top stack value
| $34 | PUSH | push top to call stack
| $36 | PULL | pull from call stack
| $38 | BRGT | branch next from top greater than top
| $3A | BRLT | branch next from top less than top
| $3C | BREQ | branch next from top equal to top
| $3E | BRNE | branch next from top not equal to top
| $40 | ISEQ | if next from top is equal to top, set top true
| $42 | ISNE | if next from top is not equal to top, set top true
| $44 | ISGT | if next from top is greater than top, set top true
| $46 | ISLT | if next from top is less than top, set top true
| $48 | ISGE | if next from top is greater than or equal to top, set top true
| $4A | ISLE | if next from top is less than or equal to top, set top true
| $4C | BRFLS | branch if top of stack is zero
| $4E | BRTRU | branch if top of stack is non-zero
| $50 | BRNCH | branch to address
| $52 | IBRNCH | branch to address on stack top
| $54 | CALL | sub routine call with stack parameters
| $56 | ICAL | sub routine call to address on stack top with stack parameters
| $58 | ENTER | allocate frame size and copy stack parameters to local frame
| $5A | LEAVE | deallocate frame and return from sub routine call
| $5C | RET | return from sub routine call
| $60 | LB | load byte from top of stack address
| $62 | LW | load word from top of stack address
| $64 | LLB | load byte from frame offset
| $66 | LLW | load word from frame offset
| $68 | LAB | load byte from absolute address
| $6A | LAW | load word from absolute address
| $6C | DLB | duplicate top of stack into local byte at frame offset
| $6E | DLW | duplicate top of stack into local word at frame offset
| $70 | SB | store top of stack byte into next from top address
| $72 | SW | store top of stack word into next from top address
| $74 | SLB | store top of stack into local byte at frame offset
| $76 | SLW | store top of stack into local word at frame offset
| $78 | SAB | store top of stack into byte at absolute address
| $7A | SAW | store top of stack into word at absolute address
| $7C | DAB | duplicate top of stack into byte at absolute address
| $7E | DAW | duplicate top of stack into word at absolute address
The opcodes were developed over time by starting with a very basic set of operations and slowly adding opcodes when the PLASMA compiler could improve code density or performance.

423
doc/PLASMA123.md
View File

@ -1,423 +0,0 @@
# PLASMA 123 (1][///)
## Introduction
PLASMA is a combination of virtual machine and assembler/compiler matched closely to the 6502 architecture. It is an attempt to satisfy a few challenges surrounding code size, efficient execution, small runtime and flexible code location. By architecting a unique bytecode that maps nearly one-to-one to the higher level representation, the compiler/assembler can be very simple and execute quickly on the Apple II for a self-hosted environment. A modular approach provides for incremental development and code reuse. Different projects have led to the architecture of PLASMA, most notably Apple Pascal, FORTH, and my own Java VM for the 6502, VM02. Each has tried to map a generic VM to the 6502 with varying levels of success. Apple Pascal, based on the USCD Pascal using the p-code interpreter, was a very powerful system and ran fast enough on the Apple II to be interactive but didn't win any speed contests. FORTH was the poster child for efficiency and obtuse syntax. Commonly referred to as a write only language, it was difficult to come up to speed as a developer, especially when using other's code. My own project in creating a Java VM for the Apple II uncovered the folly of shoehorning a large system into something never intended to run 32 bit applications.
## Multi-Platform Support
PLASMA 123 is named as such because it runs on the Apple I, II, and III. More platforms will be supported in the future. Through the use of dynamically loaded modules, system differences can be virtualized to provide a consistent set of services for a variety of physical machines.
## Low Level Implementation
Both the Pascal and Java VMs used a bytecode to hide the underlying CPU architecture and offer platform agnostic application execution. The application and tool chains were easily moved from platform to platform by simply writing a bytecode interpreter and small runtime to translate the higher level constructs to the underlying hardware. The performance of the system was dependent on the actual hardware and efficiency of the interpreter. Just-in-time compilation wasn't really an option on small, 8 bit systems. FORTH, on the other hand, was usually implemented as a threaded interpreter. A threaded interpreter will use the address of functions to call as the code stream instead of a bytecode, eliminating one level of indirection with a slight increase in code size. The threaded approach can be made faster at the expense of another slight increase in size by inserting an actual Jump SubRoutine opcode before each address, thus removing the interpreter's inner loop altogether.
All three systems were implemented using stack architecture. Pascal and Java were meant to be compiled high level languages, using a stack machine as a simple compilation target. FORTH was meant to be written directly as a stack oriented language, similar to RPN on HP calculators. The 6502 is a challenging target due to it's unusual architecture so writing a bytecode interpreter for Pascal and Java results in some inefficiencies and limitations. FORTH's inner interpreter loop on the 6502 tends to be less efficient than most other CPUs. Another difference is how each system creates and manipulates it's stack. Pascal and Java use the 6502 hardware stack for all stack operations. Unfortunately the 6502 stack is hard-limited to 256 bytes. However, in normal usage this isn't too much of a problem as the compilers don't put undue pressure on the stack size by keeping most values in global or local variables. FORTH creates a small stack using a portion of the 6502's zero page, a 256 byte area of low memory that can be accessed with only a byte address and indexed using either of the X or Y registers. With zero page, the X register can be used as an indexed, indirect address and the Y register can be used as an indirect, indexed address.
## A New Approach
PLASMA takes an approach that uses the best of all the above implementations to create a unique, powerful and efficient platform for developing new applications on the Apple I, II, and III. One goal was to create a very small VM runtime, bytecode interpreter, and module loader. The decision was made early on to implement a stack based architecture duplicating the approach taken by FORTH. Space in the zero page would be assigned to a 16 bit, 16 element evaluation stack, indexed by the X register.
A simple compiler was written so that higher level constructs could be used and global/local variables would hold values instead of using clever stack manipulation. Function/procedure frames would allow for local variables, but with a limitation - the frame could be no larger than 256 bytes. By enforcing this limitation, the function frame could easily be accessed through a frame pointer value in zero page, indexed by the Y register. The call stack uses the 6502's hardware stack resulting in the same 256 byte limitation imposed by the hardware. However, this limitation could be lifted by extending the call sequence to save and restore the return address in the function frame. This was not done initially for performance reasons and simplicity of implementation. Even with these limitations, recursive functions can be effectively implemented.
One of the goals of PLASMA was to allow for intermixing of functions implemented as bytecode, or native code. Taking a page from the FORTH play book, a function call is implemented as a native subroutine call to an address. If the function is in bytecode, the first thing it does is call back into the interpreter to execute the following bytecode (or a pointer to the bytecode). Function call parameters are pushed onto the evaluation stack in order they are written. The first operation inside of the function call is to pull the parameters off the evaluation stack and put them in local frame storage. Function callers and callees must agree on the number of parameters to avoid stack underflow/overflow. All functions return a value on the evaluation stack regardless of it being used or not.
The bytecode interpreter is capable of executing code in main memory or banked/extended memory, increasing the available code space and relieving pressure on the limited 64K of addressable data memory. In the Apple IIe with 64K expansion card, the IIc, and the IIgs, there is an auxiliary memory that swaps in and out for the main memory in chunks. The interpreter resides in the Language Card memory area that can easily swap in and out the $0200 to $BFFF memory bank. The module loader will move the bytecode into the auxiliary memory and fix up the entrypoints to reflect the bytecode location. The Apple /// has a sophisticated extended addressing architecture where bytecode is located and interpreted.
Lastly, PLASMA is not a typed language. Just like assembly, any value can represent a character, integer, or address. It's the programmer's job to know the type. Only bytes and words are known to PLASMA. Bytes are unsigned 8 bit quantities, words are signed 16 bit quantities. All stack operations involve 16 bits of precision.
The PLASMA low level operations are defined as:
| OPCODE | Description
|:------:|-----------------------------------
| ZERO | push zero on the stack
| ADD | add top two values, leave result on top
| SUB | subtract next from top from top, leave result on top
| MUL | multiply two topmost stack values, leave result on top
| DIV | divide next from top by top, leave result on top
| MOD | divide next from top by top, leave remainder on top
| INCR | increment top of stack
| DECR | decrement top of stack
| NEG | negate top of stack
| COMP | compliment top of stack
| AND | bit wise AND top two values, leave result on top
| IOR | bit wise inclusive OR top two values, leave result on top
| XOR | bit wise exclusive OR top two values, leave result on top
| LOR | logical OR top two values, leave result on top
| LAND | logical AND top two values, leave result on top
| SHL | shift left next from top by top, leave result on top
| SHR | shift right next from top by top, leave result on top
| IDXB | add top of stack to next from top, leave result on top (ADD)
| IDXW | add 2X top of stack to next from top, leave result on top
| NOT | logical NOT of top of stack
| LA | load address
| LLA | load local address from frame offset
| CB | constant byte
| CW | constant word
| CS | constant string
| DROP | drop top stack value
| DUP | duplicate top stack value
| PUSH | push top to call stack
| PULL | pull from call stack
| BRGT | branch next from top greater than top
| BRLT | branch next from top less than top
| BREQ | branch next from top equal to top
| BRNE | branch next from top not equal to top
| ISEQ | if next from top is equal to top, set top true
| ISNE | if next from top is not equal to top, set top true
| ISGT | if next from top is greater than top, set top true
| ISLT | if next from top is less than top, set top true
| ISGE | if next from top is greater than or equal to top, set top true
| ISLE | if next from top is less than or equal to top, set top true
| BRFLS | branch if top of stack is zero
| BRTRU | branch if top of stack is non-zero
| BRNCH | branch to address
| CALL | sub routine call with stack parameters
| ICAL | sub routine call to indirect address on stack top with stack parameters
| ENTER | allocate frame size and copy stack parameters to local frame
| LEAVE | deallocate frame and return from sub routine call
| RET | return from sub routine call
| LB | load byte from top of stack address
| LW | load word from top of stack address
| LLB | load byte from frame offset
| LLW | load word from frame offset
| LAB | load byte from absolute address
| LAW | load word from absolute address
| SB | store top of stack byte into next from top address
| SW | store top of stack word into next from top address
| SLB | store top of stack into local byte at frame offset
| SLW | store top of stack into local word at frame offset
| SAB | store top of stack into byte at absolute address
| SAW | store top of stack into word at absolute address
| DLB | duplicate top of stack into local byte at frame offset
| DLW | duplicate top of stack into local word at frame offset
| DAB | duplicate top of stack into byte at absolute address
| DAW | duplicate top of stack into word at absolute address
## PLASMA Compiler/Assembler
Although the low-level operations could easily by coded by hand, they were chosen to be an easy target for a simple compiler. Think along the lines of an advanced assembler or stripped down C compiler ( C--). Taking concepts from BASIC, Pascal, C and assembler, the PLASMA compiler is simple yet expressive. The syntax is line oriented; there is no statement delimiter except newline.
Comments are allowed throughout the source, starting with the ‘//’ symbol. The rest of the line is ignored.
```
// Data and text buffer constants
```
Hexadecimal constants are preceded with a ‘$’ to identify them as such.
```
$C030 // Speaker address
```
### Constants, Variables and Functions
The source code of a PLASMA module first defines imports, constants, variables and data. Constants must be initialized with a value. Variables can have sizes associated with them to declare storage space. Data can be declared with or without a variable name associated with it. Arrays, tables, strings and any predeclared data can be created and accessed in multiple ways. Arrays can be defined with a size to reserve a minimum storage amount, and the brackets can be after the type declaration or after the identifier.
```
//
// Import standard library functions.
//
import stdlib
predef putc, puts, getc, gets, cls, memcpy, memset, memclr
end
//
// Constants used for hardware and flags
//
const speaker = $C030
const changed = 1
const insmode = 2
//
// Array declaration of screen row addresses. All variations are allowed.
//
word txtscrn[] = $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
word txt2scrn[8] = $0800,$0880,$0900,$0980,$0A00,$0A80,$0B00,$0B80
word[8] txt2scrna = $0828,$08A8,$0928,$09A8,$0A28,$0AA8,$0B28,$0BA8
word txt2scrnb = $0850,$08D0,$0950,$09D0,$0A50,$0AD0,$0B50,$0BD0
//
// Misc global variables
//
byte flags = 0
word numlines = 0
byte cursx, cursy
word cursrow, scrntop, cursptr
```
Variables can have optional brackets; empty brackets don’t reserve any space for the variable but are useful as a label for data that is defined following the variable. Brackets with a constant inside defines a minimum size reserved for the variable. Any data following the variable will take at least the amount of reserved space, but potentially more.
Strings are defined like Pascal strings, a length byte followed by the string characters so they can be a maximum of 255 characters long. Strings can only appear in the variable definitions of a module. String constants can’t be used in expressions or statements.
```
//
// An initialized string of 64 characters
//
byte[64] txtfile = "UNTITLED"
```
Functions are defined after all constants, variables and data. Functions can be forward declared with a *predef* type in the constant and variable declarations. Functions have optional parameters and always return a value. Functions can have their own variable declarations. However, unlike the global declarations, no data can be predeclared, only storage space. 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. A function can specify a value to return. If no return value is specified, a default of 0 will be returned.
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.
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.
```
word hgrscan[] = $2000,$2400,$2800,$2C00,$3000,$3400,$3800,$3C00
word = $2080,$2480,$2880,$2C80,$3080,$3480,$3880,$3C80
hgrscan.[yscan, xscan] = fillval
```
Values can be treated as pointers by preceding them with a ‘^’ for byte pointers, ‘*’ for word pointers.
```
strlen = ^srcstr
```
Addresses of variables and functions can be taken with a preceding ‘@’, address-of operator. Parenthesis can surround an expression to be used as a pointer, but not address-of.
Functions can have optional parameters when called and local variables. Defined functions without parameters can be called simply, without any paranthesis.
```
def drawscrn(topline, leftpos)
byte i
for i = 0 to 23
drawline(textbuff[i + topline], leftpos)
next
end
def redraw
cursoff
drawscrn(scrntop, scrnleft)
curson
end
redraw
```
Functions with parameters or expressions to be used as a function address to call must use parenthesis, even if empty.
```
predef keyin2plus
word keyin
byte key
keyin = @keyin2plus // address-of keyin2plus function
key = keyin()
```
Expressions and Statements
Expressions are algebraic. Data is free-form, but all operations on the evaluation stack use 16 bits of precision with the exception of byte load and stores. A stand-alone expression will be evaluated and read from or called. This allows for easy access to the Apple’s soft switches and other memory mapped hardware. The value of the expression is dropped.
```
const speaker=$C030
^speaker // click speaker
close(refnum)
```
More complex expressions can be built up using algebraic unary and binary operations.
| OP | Unary Operation |
|:----:|---------------------|
| ^ | byte pointer
| * | word pointer
| @ | address of
| - | negate
| ~ | bitwise compliment
| NOT | logical NOT
| OP | Binary Operation |
|:----:|----------------------|
| * | multiply
| / | divide
| % | modulo
| + | add
| - | subtract
| << | shift left
| >> | shift right
| & | bitwise AND
| ^ | bitwise XOR
| &#124; | bitwise OR
| == | equals
| <> | not equal
| >= | greater than or equal
| > | greater than
| <= | less than or equal
| < | less than
| OR | logical OR
| AND | logical AND
Statements are built up from expressions and control flow keywords. Simplicity of syntax took precedence over flexibility and complexity. The simplest statement is the basic assignment using ‘=’.
```
byte numchars
numchars = 0
```
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.
Control structures affect the flow of control through the program. There are conditional and looping constructs. The most widely used is probably the if/elsif/else/fin construct.
```
if ^pushbttn3 < 128
if key == $C0
key = $D0 // P
elsif key == $DD
key = $CD // M
elsif key == $DE
key = $CE // N
fin
else
key = key | $E0
fin
```
The when/is/otherwise/wend statement is similar to the if/elsif/else/fin construct except that it is more efficient. It selects one path based on the evaluated expressions, then merges the code path back together at the end. However only the 'when' value is compared against a list of expressions. The expressions do not need to be constants, they can be any valid expression. The list of expressions is evaluated in order, so for efficiency sake, place the most common cases earlier in the list. Just as in C programs, a 'break' statement is required to keep one clause from falling through to the next. Falling through from one clause to the next can have it's uses, so this behavior has been added to PLASMA.
```
when keypressed
is keyarrowup
cursup
break
is keyarrowdown
cursdown
break
is keyarrowleft
cursleft
break
is keyarrowright
cursright
break
is keyctrlx
cutline
break
is keyctrlv
pasteline
break
is keyescape
cursoff
cmdmode
redraw
break
otherwise
bell
wend
```
The most common looping statement is the for/next construct.
```
for xscan = 0 to 19
(scanptr):[xscan] = val
next
```
The for/next statement will efficiently increment or decrement a variable form the starting value to the ending value. The increment/decrement amount can be set with the step option after the ending value; the default is one. If the ending value is less than the starting value, use downto instead of to to progress in the negative direction. Only use positive step values. The to or downto will add or subtract the step value appropriately.
```
for i = heapmapsz - 1 downto 0
if sheapmap.[i] <> $FF
mapmask = szmask
fin
next
```
while/loop statements will continue looping as long as the while expression is non-zero.
```
while !(mask & 1)
addr = addr + 16
mask = mask >> 1
loop
```
Lastly, the repeat/until statement will continue looping as long as the until expression is zero.
```
repeat
txtbuf = read(refnum, @txtbuf + 1, maxlnlen)
numlines = numlines + 1
until txtbuf == 0 or numlines == maxlines
```
### Runtime
PLASMA includes a very minimal runtime that nevertheless provides a great deal of functionality to the system. Two system calls are provided to access native 6502 routines (usually in ROM) and ProDOS.
call(aReg, xReg, yReg, statusReg, addr) returns a pointer to a four byte structure containing the A,X,Y and STATUS register results.
```
const xreg = 1
const getlin = $FD6A
numchars = call(0, 0, 0, 0, getlin).xreg // return char count in X reg
```
syscall(cmd, params) calls ProDOS, returning the status value.
```
def read(refnum, buff, len)
byte params[8]
params.0 = 4
params.1 = refnum
params:2 = buff
params:4 = len
perr = syscall($CA, @params)
return params:6
end
```
putc(char), puts(string), home, gotoxy(x,y), getc() and gets() are other handy utility routines for interacting with the console.
```
putc('.')
byte okstr[] = "OK"
puts(@okstr)
```
memset(addr, val, len) will fill memory with a 16 bit value. memcpy(dstaddr, srcaddr, len) will copy memory from one address to another, taking care to copy in the proper direction.
```
byte nullstr[] = ""
memset(strlinbuf, @nullstr, maxfill * 2) // fill line buff with pointer to null string
memcpy(scrnptr, strptr + ofst + 1, numchars)
```
## Implementation Details
This version of PLASMA has dispensed with the native/threaded/bytecode code generation from the original version to focus on code density and the ability to interpret bytecode from extended memory, should it be available. By focussing on the bytecode interpreter, certain optimizations were implemented that weren't posssible when allowing for threaded/native code; the interpreted bytecode is now about the same performance as the directly threaded code.
Dynamically loadable modules, a backward compatible extension to the .REL format introduced by EDASM, is the new, main feature for this version of PLASMA. This allows different platforms the ability to virtualize their differences in a way such that the modules can run unmodified.
### Apple 1 PLASMA
Obviously the Apple 1 is a little more constrained than most machines PLASMA is targetting. But, with the required addition of the CFFA1 (http://dreher.net/?s=projects/CFforApple1&c=projects/CFforApple1/main.php), the Apple 1 gets 32K of RAM and a mass storage device. Enough to run PLASMA and load/execute modules.
### Apple ][ PLASMA
The Apple II support covers the full range of the Apple II family. From the Rev 0 Apple II to the ROM3 Apple IIgs. The only requirement is 64K of RAM. If 128K is present, it will be automatically used to load and interpret bytecode, freeing up the main 40K for data and native 6502 code. The IIgs is currently operated in the compatibilty 8 bit mode.
### Apple /// PLASMA
Probably the most exciting development is the support for the Apple ///. PLASMA on the Apple /// provides 32K for global data and 6502 code, and the rest of the memory for bytecode and extended data.
## References
PLASMA User Manual: https://github.com/dschmenk/PLASMA/blob/master/doc/User%20Manual.md
PLASMA Architecture: https://github.com/dschmenk/PLASMA/blob/master/doc/Architecture.md
PLASMA KFEST 2015 video: https://www.youtube.com/watch?v=RrR79WVHwJo
BCPL: http://en.wikipedia.org/wiki/BCPL
B Programming Language User Manual http://cm.bell-labs.com/cm/cs/who/dmr/kbman.html
FORTH http://en.wikipedia.org/wiki/Forth_(programming_language)
UCSD Pascal http://wiki.freepascal.org/UCSD_Pascal
p-code https://www.princeton.edu/~achaney/tmve/wiki100k/docs/P-code_machine.html
VM02: Apple II Java VM http://sourceforge.net/projects/vm02/
Threaded code http://en.wikipedia.org/wiki/Threaded_code

40
doc/Preview Version 1.0.md Normal file
View File

@ -0,0 +1,40 @@
# Developer Preview Version 1.0
PLASMA is approaching a 1.0 release after _only_ 12 years. Hopefully it was worth the wait. To work out the remaining kinks, this Developer Preview will allow programmers to kcick the tires, so to speak, to provide feedback on the system.
Download the two disk images:
(PLASMA Preview 1.0 System)[https://github.com/dschmenk/PLASMA/blob/master/PLASMA-PRE1.PO?raw=true]
(PLASMA 1.0 Build System)[https://github.com/dschmenk/PLASMA/blob/master/PLASMA-BLD1.PO?raw=true]
PLASMA can be run from floppies, System in drive 1, and Build in drive 2. All Apple II computers are supported, from the earliest Rev 0 to the last Apple IIGS. However, an accelerator and hard disk/CFFA are highly recommended. The recommended mass storage installation looks like:
System Files => /HARDISK/PLASMA.PRE1/
Build Files => /HARDISK/BLD/
Keeping the system files seperate from the build directory will make upgrading to the final 1.0 Release later a little easier. To boot directly into PLASMA, you will need to put the system files in the root prefix of the boot device and make sure PLASMA.SYSTEM is the first SYSTEM file in the directory. Otherwise, launch PLASMA.SYSTEM from your command processor of choice.
## 65802/65816 Support
PLASMA can utilize the 16 bit features of the 65802 and 65816 processors to improve performance of the PLASMA VM operation. This is transparent to the programmer/user and doesn't make any additional memory or capabilities available to PLASMA. Launch `PLASMA16.SYSTEM` to use the 16 bit PLASMA VM. If you don't have the right CPU, it will print a message and restart.
# PLASMA Command Line Shell
PLASMA incorporates a very basic command line shell to facilitate navigating the filesystem and executing both SYSTEM programs and PLASMA modules. It has a few built-in commands:
| Command | Operation |
|:-------------------:|-----------------------|
| C [PREFIX] | Catalog prefix
| P \<PREFIX\> | change to Prefix
| / | change to parent prefix
| V | show online Volumes
| -\<SYSTEM PROGRAM\> | launch SYSTEM program
| +\<PLASMA MODULE\> | exec PLASMA module
```
[Optional parameters]
<Required parameters>
```
The shell is very breif with error messages. It is meant solely as a way to run programs that accept command line parameters and take up as little memory as possible. It does, however, provide a rich runtime for PLASMA modules.

648
doc/User Manual.md
View File

@ -1,648 +0,0 @@
# PLASMA 123 Programming User Manual
## (Proto Language AsSeMbler for Apple)
## Introduction
PLASMA is a medium level programming language targetting the 8 bit 6502 processor. Historically, there were simple languages developed in the early history of computers that improved on the tedium of assembly language programming while still being low level enough for system coding. Languages like B, FORTH, and PLASMA fall into this category. The following will take you through the process of writing, building and running a PLASMA module.
### PLASMA Modules
To keep development compartmentalized and easily managed, PLASMA uses relatively small, dynamically loaded and linked modules. The module format extends the .REL filetype originally defined by the EDASM assembler from the DOS/ProDOS Toolkit from Apple Computer, Inc. PLASMA extends the file format through a backwards compatible extension that the PLASMA loader recognizes to locate the PLASMA bytecode and provide for advanced dynamic loading of module dependencies.
### Obligatory 'Hello World'
To start things off, here is the standard introductory program:
```
import cmdsys
predef puts
end
puts("Hello, world.\n")
done
```
Three tools are required to build and run this program: **plasm**, **acme**, and **plvm**. The PLASMA compiler, **plasm**, will convert the PLASMA source code (usually with an extension of .pla) into an assembly language source file. **acme**, the portable 6502 assembler, will convert the assembly source into a binary ready for loading. To execute the module, the PLASMA portable VM, **plvm**, can load and interpret the bytecode. The same binary can be loaded onto the target platform and run there with the appropriate VM. On Linux/Unix from lawless-legends/PLASMA/src, the steps would be entered as:
```
./plasm -AM < hello.pla > hello.a
acme --setpc 4094 -o HELLO.REL hello.a
./plvm HELLO.REL
```
The computer will respond with:
```
Load module HELLO.REL
Hello, world.
```
A couple of things to note: **plasm** only accepts input from stdin and output to stdout. To build **acme** compatible module source, tha '-AM' flags must be passed in. The **acme** assembler needs the --setpc 4094 to assemble the module at the proper address ($1000 - 2), and the -o option sets the output file. The makefile in the lawless-legends/PLASMA/src directory has automated this process. Enter:
```
make hello
```
for the **make** program to build all the dependencies and run the module.
## Organization of a PLASMA Source File
### Character Case
All identifiers and reserved words are case insensitive. Case is only significant inside character constants and strings. Imported and exported symbols are always promoted to upper case when resolved. Because some Apple IIs only work easily with uppercase, the eases the chance of mismatched symbol names.
### Comments
Comments are allowed throughout a PLASMA source file. The format follows that of C and C++: they begin with a `//` and comment out the rest of the line:
```
// This is a comment, the rest of this line is ignored
```
### Declarations
The beginning of the source file is the best place for certain declarations. This will help when reading others' code as well as returning to your own after a time.
#### Module Dependencies
Module dependencies will direct the loader to make sure these modules are loaded first, thus resolving any outstanding references. A module dependency is declared with the `import` statement block with predefined function and data definitions. The `import` block is completed with an `end`. An example:
```
import cmdsys
const reshgr1 = $0004
predef putc, puts, getc, gets, cls, gotoxy
end
import testlib
predef puti
byte testdata, teststring
word testarray
end
```
The `predef` pre-defines functions that can be called throughout the module. The data declarations, `byte` and `word` will refer to data in those modules. `const` can appear in an `import` block, although not required. It does keep values associated with the imported module in a well-contained block for readability and useful with pre-processor file inclusion. Case is not significant for either the module name nor the pre-defined function/data labels. They are all converted to uppercase with 16 characters significant when the loader resolves them.
#### Constant Declarations
Constants help with the readability of source code where hard-coded numbers might not be very descriptive.
```
const MACHID = $BF98
const speaker = $C030
const bufflen = 2048
```
These constants can be used in expressions just like a variable name.
#### Structure Declarations
There is a shortcut for defining constant offsets into structures:
```
struc t_entry
word id
byte[32] name
word next_entry
end
```
is equivalent to:
```
const t_entry = 36 // size of the structure
const id = 0 // offset to id element
const name = 2 // offset to name element
const next_entry = 34 // offset to next_entry element
```
#### Predefined Functions
Sometimes a function needs to be referenced before it is defined. The `predef` declaration reserves the label for a function. The `import` declaration block also uses the `predef` declaration to reserve an external function. Outside of an `import` block, `predef` will only predefine a function that must be declared later in the source file, otherwise an error will occur.
```
predef exec_file, mydef
```
#### Global Data & Variable Declarations
One of the most powerful features in PLASMA is the flexible data declarations. Data must be defined after all the `import` declarations and before any function definitions, `asm` or `def`. Global labels and data can be defined in multiple ways, and exported for inclusion in other modules. Data can be initialized with constant values, addresses, calculated values (must resolve to a constant), and addresses from imported modules. Here is an example using the `predef` line from the previous examples to export an initialized array of 10 function pointer elements (2 defined + null delimiter):
```
export word[10] myfuncs = @exec_file, @mydef, $0000
```
See the section on arrays for more information.
#### Native Functions
An advanced feature of PLASMA is the ability to write functions in native assembly language. This is a very advanced topic that is covered more in-depth in the Advanced Topics section.
#### Function Definitions
Function definitions **must** come after all other declarations. Once a function definition is written, no other global declarations are allowed. Function definitions can be `export`ed for inclusion in other modules. Functions can take parameters, passed on the evaluation stack, then copied to the local frame for easy access. 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 embedd the parameter number and type in the function name itself. This is a notational aid; the compiler enforces nothing.
Function definitions are completed with the `end` statement. All definitions return a value, even if not specified in the source. A return value of zero will be inserted by the compiler at the `end` of a definition (or a `return` statement without a value).
#### Module Initialization Function
After all the function definitions are complete, an optional module initiialization routine follows. This is an un-named defintion an is written in-line without a definition declaration. As such, it doesn't have parameters or local variables. Function definitions can be called from within the initialization code.
For libraries or class modules, the initialization routine can perform any up-front work needed before the module is called. For program modules, the initialization routine is the "main" routine, called after all the other module dependencies are loaded and initialized.
A return value is system specific. The default of zero should mean "no error". Negative values should mean "error", and positive values can instruct the system to do extra work, perhaps leaving the module in memory (terminate and stay resident).
#### Exported Declarations
Data and function labels can be exported so other modules may access this modules data and code. By prepending `export` to the data or functions declaration, the label will become available to the loader for inter-module resolution. Exported labels are converted to uppercase with 16 significant characters. Although the label will have to match the local version, external modules will match the case-insignificant, short version. Thus, "ThisIsAVeryLongLabelName" would be exported as: "THISISAVERYLONGL".
```
export def plot(x, y)
romcall(y, 0, x, 0, $F800)
end
```
#### Module Done
The final declaration of a module source file is the `done` statement. This declares the end of the source file. Anything following this statement is ignored.
### m4 Pre-Processor
The m4 pre-processor can be very helpful when managing module imports and macro facilities. The easiest way to use the pre-processor is to write a module import header for each library module. Any module that depends on a given library can `include()` the shared header file. See the GNU m4 documentation for more information: https://www.gnu.org/software/m4/manual/
## Stacks
The basic architecture of PLASMA relies on different stack based FIFO data structures. The stacks aren't directly manipulated from PLASMA, but almost every PLASMA operation involves one or more of the stacks. A stack architecture is a very flexible and convenient way to manage an interpreted language, even if it isn't the highest performance.
### Call Stack
The call stack, where function return addresses are saved, is implemented using the hardware call stack of the CPU. This makes for a fast and efficient implementation of function call/return.
### Local Frame Stack
Any function definition that involves parameters or local variables builds a local frame to contain the variables. Often called automatic variables, they only persist during the lifetime of the function. They are a very powerful tool when implementing recursive algorithms. PLASMA puts a limitation of 256 bytes for the size of the frame, due to the nature of the 6502 CPU (8 bit index register). With careful planning, this shouldn't be too constraining.
### Local String Pool
Any function that uses in-line strings will have those strings copied to the local string pool for usage. This allows string literals to exist in the same memory as the bytecode and only copied to main memory when used. The string pool is deallocated along with the local frame stack when the function exits.
### Evaluation Stack
All temporary values are loaded and manipulated on the PLASMA evaluation stack. This is a small (16 element) stack implemeted in high performance memory/registers of the host CPU. Parameters to functions are passed on the evaluation stack, then moved to local variables for named reference inside the funtion.
## Data Types
PLASMA only really defines two data types: `byte`, `word`. All operations take place on word sized quantities, with the exception of loads and stores to byte sized addresses. The interpretation of a value can be an interger, an address, or anything that fits in 16 bits. There are a number of address operators to identify how an address value is to be interpreted.
### Decimal and Hexadecimal Numbers
Numbers can be represented in either decimal (base 10), or hexadecimal (base 16). Values beginning with a `$` will be parsed as hexadecimal, in keeping with 6502 assembler syntax.
### 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, it's address is used:
```
char mystring[] = "This is my string; I am very proud of it.\n"
puts(@mystring)
```
Excaped characters, like the `\n` above are replaces with the Carriage Return character. The list of escaped characters is:
| Escaped Char | ASCII Value
|:------------:|------------
| \n | LF
| \t | TAB
| \r | CR
| \\\\ | \
| \\0 | NUL
#### In-line String Literals
Strings can be used as literals inside expression or as parameters. The above example can ber written as:
```
puts("This is my string; I am very proud of it.\n")
```
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 either 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 the best string")
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.
### Words
Words, 16 bit signed values, are the native sized quanta of PLASMA. All calculations, parameters, and return values are words.
### Bytes
Bytes are unsigned, 8 bit values, stored at an address. Bytes cannot be manipulated as bytes, but are promoted to words as soon as they are read onto the evaluation stack. When written to a byte addres, the low order byte of a word is used.
### Addresses
Words can represent many things in PLASMA, including addresses. PLASMA uses a 16 bit address space for data and function entrypoints. There are many operators in PLASMA to help with address calculation and access. Due to the signed implementation of word in PLASMA, the Standard Library has some unsigned comparison functions to help with address comparisons.
#### Arrays
Arrays are the most useful data structure in PLASMA. Using an index into a list of values is indispensible. PLASMA has a flexible array operator. Arrays can be defined in many ways, usually as:
[`export`] <`byte`, `word`> [label] [= < number, character, string, address, ... >]
For example:
```
predef myfunc
byte smallarray[4]
byte initbarray[] = 1, 2, 3, 4, 5, 6, 7, 8, 9, 10
byte string[64] = "Initialized string"
word wlabel[]
word = 1000, 2000, 3000, 4000 // Anonymous array
word funclist = @myfunc, $0000
```
Equivalently written as:
```
predef myfunc
byte[4] smallarray
byte[] initbarray = 1, 2, 3, 4, 5, 6, 7, 8, 9, 10
byte[64] string = "Initialized string"
word[] wlabel
word = 1000, 2000, 3000, 4000 // Anonymous array
word funclist = @myfunc, $0000
```
Arrays can be uninitialized and reserve a size, as in `smallarray` above. Initilized arrays without a size specifier in the definition will take up as much data as is present, as in `initbarray` above. Strings are special arrays that include a hidden length byte in the beginning (Pascal strings). When specified with a size, a minimum size is reserved for the string value. Labels can be defined as arrays without size or initializers; this can be useful when overlapping labels with other arrays or defining the actual array data as anonymous arrays in following lines as in `wlabel` and following lines. Addresses of other data (must be defined previously) or function definitions (pre-defined with predef), including imported references, can be initializers.
##### Type Overrides
Arrays are usually identified by the data type specifier, `byte` or `word` when the array is defined. However, this can be overridden with the type override specifiers: `:` and `.`. `:` overrides the type to be `word`, `.` overrides the type to be `byte`. An example of accessing a `word` array as `bytes`:
```
word myarray = $AABB, $CCDD, $EEFF
def prarray
byte i
for i = 0 to 5
puti(myarray.[i])
next
end
```
The override operator becomes more useful when multi-dimenstional arrays are used.
##### Multi-Dimensional Arrays
Multi-dimensional arrays are implemented as arrays of arrays, not as a single block of memory. This allows constructs such as:
```
//
// Hi-Res scanline addresses
//
word hgrscan = $2000,$2400,$2800,$2C00,$3000,$3400,$3800,$3C00
word = $2080,$2480,$2880,$2C80,$3080,$3480,$3880,$3C80
```
...
```
def hgrfill(val)
byte yscan, xscan
for yscan = 0 to 191
for xscan = 0 to 19
hgrscan:[yscan, xscan] = val
next
next
end
```
Every array dimension except the last is a pointer to another array of pointers, thus the type is word. The last dimension is either `word` or `byte`, but cannot be specified with an array declaration, so the type override is used to identify the type of the final element. In the above example, the memory would be accessed as bytes with the following:
```
def hgrfill(val)
byte yscan, xscan
for yscan = 0 to 191
for xscan = 0 to 39
hgrscan.[yscan, xscan] = val
next
next
end
```
Notice how xscan goes to 39 instead of 19 in the byte accessed version.
#### Offsets (Structure Elements)
Structures are another fundamental construct when accessing in-common data. Using fixed element offsets from a given address means you only have to pass one address around to access the entire record. Offsets are specified with a constant expression following the type override specifier.
```
predef puti // print an integer
byte myrec[]
word = 2
byte = "PLASMA"
puti(myrec:0) // ID = 2
putc($8D) // Carriage return
puti(myrec.2) // Name length = 6 (Pascal string puts length byte first)
```
This contrived example shows how one can access offsets from a variable as either `byte`s or `word`s regardless of how they were defined. This operator becomes more powerful when combined with pointers, defined next.
#### Defining Structures
Structures can be defined so that the offsets are calculated for you. The previous example can be written as:
```
predef puti // print an integer
struc mystruc // mystruc will be defined as the size of the structure itself
word id
byte name // one byte for length, the number of characters are variable
end
byte myrec[]
word = 2
byte = "PLASMA"
puti(mystruc) // This will print '3', the size of the structure as defined
putc($8D) // Carriage return
puti(myrec:id) // ID = 2
putc($8D) // Carriage return
puti(myrec.name) // Name length = 6 (Pascal string puts length byte first)
```
#### Pointers
Pointers are values that represent addresses. In order to get the value pointed to by the address, one must 'dereference' the pointer. All data and code memory has a unique address, all 65536 of them (16 bits). In the Apple II, many addresses are actually connected to hardware instead of memory. Accessing these addresses can make thing happen in the Apple II, or read external inputs like the keyboard and joystick.
##### Pointer Dereferencing
Just as there are type override for arrays and offsets, there is a `byte` and `word` type override for pointers. Prepending a value with `^` dereferences a `byte`. Prepending a value with `*` dereferences a `word`. These are unary operators, so they won't be confused with the binary operators using the same symbol. An example getting the length of a Pascal string (length byte at the beginning of character array):
```
byte mystring = "This is my string"
def strlen(strptr)
return ^strptr
end
puti(strlen(@mystring)) // print 17 in this case
```
Pointers to structures or arrays can be referenced with the `->` and `=>` operators, pointing to `byte` or `word` sized elements.
```
struc record
byte id
word addr
end
def addentry(entry, new_id, new_addr)
entry->id = new_id // set ID (byte)
entry=>addr = new_addr // set address (word)
return entry + record // return next enry address
end
```
The above is equivalent to:
```
const elem_id = 0
const elem_addr = 1
const record_size = 3
def addentry(entry, new_id, new_addr)
(entry).elem_id = new_id // set ID byte
(entry):elem_addr = new_addr // set address
return entry + record_size // return next enry address
end
```
##### Addresses of Data/Code
Along with dereferencing a pointer, there is the question of getting the address of a variable. The `@` operator prepended to a variable name or a function definition name, will return the address of the variable/definition. From the previous example, the call to `strlen` would look like:
```
puti(strlen(@mystring)) // would print 17 in this example
```
##### Function Pointers
One very powerful combination of operations is the function pointer. This involves getting the address of a function and saving it in a `word` variable. Then, the function can be called be dereferencing the variable as a function call invocation. PLASMA is smart enough to know what you mean when your code looks like this:
```
word funcptr
def addvals(a, b)
return a + b
end
def subvals(a, b)
return a - b
end
funcptr = @addvals
puti(funcptr(5, 2)) // Outputs 7
funcptr = @subvals
puti(funcptr(5, 2)) // Outputs 3
```
These concepts can be combined with the structure offsets to create a function table that can be easily changed on the fly. Virtual functions in object oriented languages are implemented this way.
```
predef myinit, mynew, mydelete
export word myobject_class = @myinit, @mynew, @mydelete
// Rest of class data/code follows...
```
And an external module can call into this library (class) like:
```
import myclass
const init = 0
const new = 2
const delete = 4
word myobject_class
end
word an_obj // an object pointer
myobject_class:init()
an_obj = myobject_class:new()
myobject_class:delete(an_obj)
```
## Function Definitions
Function definitions in PLASMA is what really seperates PLASMA from a low level language like assembly, or even a language like FORTH. The ability to pass in arguments and declare local variables provides PLASMA with a higher language feel and the ability to easily implement recursive functions.
### Expressions
Exressions are comprised of operators and operations. Operator precedence follows address, arithmatic, binary, and logical from highest to lowest. Parantheses can be used to force operations to happen in a specific order.
#### Address Operators
Address operators can work on any value, i.e. anything can be an address. Parentheses can be used to get the value from a variable, then use that as an address to dereference for any of the post-operators.
| OP | Pre-Operation |
|:----:|---------------------|
| ^ | byte pointer
| * | word pointer
| @ | address of
| OP | Post-Operation |
|:----:|---------------------|
| . | byte type override
| : | word type override
| -> | pointer to byte type
| => | pointer to word type
| [] | array index
| () | functional call
#### Arithmetic, Bitwise, and Logical Operators
| OP | Unary Operation |
|:----:|---------------------|
| - | negate
| ~ | bitwise compliment
| NOT | logical NOT
| ! | logical NOT (alternate)
| OP | Binary Operation |
|:----:|----------------------|
| * | multiply
| / | divide
| % | modulo
| + | add
| - | subtract
| << | shift left
| >> | shift right
| & | bitwise AND
| ^ | bitwise XOR
| &#124; | bitwise OR
| == | equals
| <> | not equal
| != | not equal (alt)
| >= | greater than or equal
| > | greater than
| <= | less than or equal
| < | less than
| OR | logical OR
| AND | logical AND
| &#124;&#124; | logical OR (alt)
| && | logical AND (alt)
### Statements
PLASMA definitions are a list of statements the carry out the algorithm. Statements are generally assignment or control flow in nature. Generally there is one statement per line. The ';' symbol seperates multiple statements on a single line. It is considered bad form to have multiple statements per line unless they are very short.
#### Assignment
Assignments evaluate an expression and save the result into memory. They can be very simple or quite complex. A simple example:
```
byte a
a = 0
```
##### Empty Assignments
An assignment doesn't even have to save the expression into memory, although the expression will be avaluated. This can be useful when referencing hardware that responds just to being accessed. On the Apple II, the keyboard is read from location $C000, then the strobe, telling the hardware to prepare for another keypress is cleared by just reading the address $C010. In PLASMA, this looks like:
```
byte keypress
keypress = ^$C000 // read keyboard
^$C010 // read keyboard strobe, throw away value
```
#### Increment and Decrement
PLASMA has an increment and decrement statement. This is different than the increment and decrement operations in languages like C and Java. Instead, they cannot be part of an expression and only exist as a statement in postfix:
```
byte i
i = 4
i++ // increment i by 1
puti(i) // print 5
i-- // decrement i by 1
puti(i) // print 4
```
#### Control Flow
PLASMA implements most of the control flow that most higher level languages provide. It may do it in a slightly different way, though. One thing you won't find in PLASMA is GOTO - there are other ways around it.
##### CALL
Function calls are the easiest ways to pass control to another function. Function calls can be part of an expression, or be all by itself - the same as an empty assignment statement.
##### RETURN
`return` will exit the current definition. An optional value can be returned, however, if a value isn't specified a default of zero will be returned. All definitions return a value, regardless of whether it used or not.
##### IF/[ELSIF]/[ELSE]/FIN
The common `if` test can have optional `elsif` and/or `else` clauses. Any expression that is evaluated to non-zero is treated as TRUE, zero is treated as FALSE.
##### WHEN/IS/[OTHERWISE]/WEND
The complex test case is handled with `when`. Basically a `if`, `elsifF`, `else` list of comparisons, it is gernerally more efficient. The `is` value can be any expression. It is evaluated and tested for equality to the `when` value.
```
when key
is 'A'
// handle A character
break
is 'B'
// handle B character
break
```
...
```
is 'Z'
// handle Z character
break
otherwise
// Not a known key
wend
```
With a little "Yoda-Speak", some fairly complex test can be made:
```
const FALSE = 0
const TRUE = NOT FALSE
byte a
when TRUE
is (a <= 10)
// 10 or less
break
is (a > 10) AND (a < 20)
// between 10 and 20
break
is (a >= 20)
// 20 or greater
wend
```
A `when` clause can fall-through to the following clause, just like C `switch` statements by leaving out the `break`.
##### FOR \<TO,DOWNTO\> [STEP]/NEXT
Iteration over a range is handled with the `for`/`next` loop. When iterating from a smaller to larger value, the `to` construct is used; when iterating from larger to smaller, the `downto` construct is used.
```
for a = 1 to 10
// do something with a
next
for a = 10 downto 1
// do something else with a
next
```
An optional stepping value can be used to change the default iteration step from 1 to something else. Always use a positive value; when iterating using `downto`, the step value will be subtracted from the current value.
##### WHILE/LOOP
For loops that test at the top of the loop, use `while`. The loop will run zero or more times.
```
a = c // Who knows what c could be
while a < 10
// do something
a = b * 2 // b is something special, I'm sure
loop
```
##### REPEAT/UNTIL
For loops that always run at least once, use the `repeat` loop.
```
repeat
update_cursor
until keypressed
```
##### CONTINUE
To continue to the next iteration of a looping structure, the `continue` statement will immediately skip to the next iteration of the innermost looping construct.
##### BREAK
To exit early from one of the looping constructs or `when`, the `break` statement will break out of it immediately and resume control immediately following the bottom of the loop/`when`.
## Advanced Topics
There are some things about PLASMA that aren't necessary to know, but can add to it's effectiveness in a tight situation. Usually you can just code along, and the system will do a pretty reasonable job of carrying out your task. However, a little knowledge in the way to implement small assembly language routines or some coding practices just might be the ticket.
### Native Assembly Functions
Assembly code in PLASMA is implemented strictly as a pass-through to the assembler. No syntax checking, or checking at all, is made. All assembly routines *must* come after all data has been declared, and before any PLASMA function definitions. Native assemlbly functions can't see PLASMA labels and definitions, so they are pretty much relegated to leaf functions. Lasltly, PLASMA modules are relocatable, but labels inside assembly functions don't get flagged for fixups. The assembly code must use all relative branches and only accessing data/code at a fixed address. Data passed in on the PLASMA evalution stack is readily accessed with the X register and the zero page address of the ESTK. The X register must be properly saved, incremented, and/or decremented to remain consistent with the rest of PLASMA. Parameters are "popped" off the evaluation stack with `INX`, and the return value is "pushed" with `DEX`.
### Code Optimizations
#### Functions Without Parameters Or Local Variables
Certain simple functions that don't take parameters or use local variables will skip the Frame Stack Entry/Leave setup. That can speed up the function significantly. The following could be a very useful function:
```
def keypress
while ^$C000 < 128
loop
^$C010
return ^$C000
end
```
#### Return Values
PLASMA always returns a value from a function, even if you don't supply one. Probably the easiest optimization to make in PLASMA is to cascade a return value if you don't care about the value you return. This only works if the last thing you do before returning from your routine is calling another definition. You would go from:
```
def mydef
// do some stuff
calldef(10) // call some other def
end
```
PLASMA will effectively add a RETURN 0 to the end of your function, as well as add code to ignore the result of `calldef(10)`. As long as you don't care about the return value from `mydef` or want to use its return as the return value fromyour function (cascade the return), you can save some code bytes with:
```
def mydef
// do some stuff
return calldef(10) // call some other def
end
```

32
src/inc/cmdsys.plh
View File

@ -1,8 +1,17 @@
import cmdsys
//
// Useful values for everyone
//
const _SYSVER_ = $0100 // Version built against
const FALSE = 0
const TRUE = not FALSE
const NULL = 0
//
// Machine ID values
//
const MACHID_CLOCK = $01
const MACHID_80COL = $02
const MACHID_MEM = $03
const MACHID_48K = $10
const MACHID_64K = $20
const MACHID_128K = $30
const MACHID_MODEL = $C8
@ -30,12 +39,23 @@ import cmdsys
const modkeep = $2000
const modinitkeep = $4000
//
// CMD exported interface table
//
struc t_cmdsys
word sysver
word syspath
word cmdline
word modexec
byte refcons
byte devcons
end
//
// CMD exported functions
//
predef putc(c)#0, putln()#0, puts(s)#0, puti(i)#0, getc()#1, gets(p)#1, toupper(c)#1
predef putc(c)#0, putln()#0, puts(s)#0, puti(i)#0, getc()#1, gets(p)#1, putb(b)#0, puth(h)#0
predef call(addr,areg,xreg,yreg,status)#1, syscall(cmd,params)#1
predef heapmark()#1, heapallocalign(size, pow2, freeaddr)#1, heapalloc(size)#1, heaprelease(newheap)#1, heapavail()#1
predef memset(addr,value,size)#0, memcpy(dst,src,size)#0
predef divmod(a,b)#2, isugt(a,b)#1, isuge(a,b)#1, isult(a,b)#1, isule(a,b)#1
predef modload(mod)#1, modexec(modfile)#1, modaddr(str)#1
predef heapmark()#1, heapallocalign(size, pow2, freeaddr)#1
predef heapalloc(size)#1, heaprelease(newheap)#1, heapavail()#1
predef memset(addr,value,size)#0, memcpy(dst,src,size)#0, strcpy(dst,src)#1, strcat(dst,src)#1
predef toupper(c)#1, sext(a)#1, divmod(a,b)#2, isugt(a,b)#1, isuge(a,b)#1, isult(a,b)#1, isule(a,b)#1
end

29
src/inc/conio.plh
View File

@ -1,17 +1,16 @@
import conio
const NORMAL = $FF
const INVERSE = $3F
const FLASH = $7F
struc t_conio
word keypressed
word home
word gotoxy
word viewport
word texttype
word textmode
word grmode
word grcolor
word grplot
end
word conio
const NORMAL = $FF
const INVERSE = $3F
const FLASH = $7F
struc t_conio
word keypressed
word home
word gotoxy
word viewport
word texttype
word textmode
word grmode
word grcolor
word grplot
end
end

2
src/inc/fileio.plh
View File

@ -38,6 +38,7 @@ import fileio
word setpfx
word getfileinfo
word geteof
word openbuf
word open
word close
word read
@ -48,7 +49,6 @@ import fileio
word readblock
word writeblock
end
word fileio
//
// Globally accessible error code
//

1
src/inc/fpu.plh
View File

@ -112,5 +112,4 @@ struc t_fpu
word randNum
end
const dropX = shiftDown // Alias dropX and shiftDown
word fpu
end

3
src/inc/inet.plh
View File

@ -1,7 +1,7 @@
//
// iNet API
//
import inet
import iNet
struc t_inet
word initIP
word serviceIP
@ -19,5 +19,4 @@ struc t_inet
word setCallback
word setParam
end
word iNet
end

4
src/inc/longjmp.plh Normal file
View File

@ -0,0 +1,4 @@
import longjmp
const t_except = $0140
predef except(env), throw(env, retval)
end

1
src/inc/sane.plh
View File

@ -142,5 +142,4 @@ struc t_sane
word saveZP
word restoreZP
end
word sane
end

3
src/inc/sdfat.plh
View File

@ -17,7 +17,7 @@ import sdFAT
//
// Interface
//
struc t_fatio
struc t_sdFAT
word getDir
word setDir
word newDir
@ -41,5 +41,4 @@ import sdFAT
word isDir
word isFile
end
word sdFAT // sdFAT interface
end

2
src/inc/testlib.plh
View File

@ -4,5 +4,5 @@ import testlib
const hex = 2
const newln = 4
const str = 6
const char = 8
const chr = 8
end

14
src/libsrc/args.pla
View File

@ -1,13 +1,12 @@
include "inc/cmdsys.plh"
const cmdline = $01FF
def argDelim(str)
byte n
// Strip leading spaces
// Skip leading spaces
while ^str and ^(str + 1) == ' '
memcpy(str + 1, str + 2, ^str - 1)
^str--
^(str + 1) = ^str - 1
str++
loop
// Scan to trailing spaces (if any)
for n = 1 to ^str
@ -26,9 +25,8 @@ export def argNext(str)
end
export def argFirst
// NULL terminate command line
^(cmdline + ^cmdline + 1) = 0
return argDelim(cmdline)
^(cmdsys:cmdline + ^cmdsys:cmdline + 1) = NULL
return argDelim(cmdsys:cmdline)
end
done
done

87
src/libsrc/conio.pla
View File

@ -2,8 +2,6 @@ include "inc/cmdsys.plh"
//
// Handy constants.
//
const FALSE = 0
const TRUE = !FALSE
const FULLMODE = 0
const MIXMODE = 1
//
@ -24,6 +22,9 @@ const hgr1 = $2000
const hgr2 = $4000
const page1 = 0
const page2 = 1
//
// External interface
//
struc t_conio
word keypressed
word home
@ -41,31 +42,9 @@ end
predef a2keypressed,a2home,a2gotoxy(x,y),a2viewport(left, top, width, height),a2texttype(type)
predef a2textmode(cols),a2grmode(mix),a2grcolor(color),a2grplot(x,y)
//
// Screen row address arrays.
//
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
word txt2scrn[] = $0800,$0880,$0900,$0980,$0A00,$0A80,$0B00,$0B80
word = $0828,$08A8,$0928,$09A8,$0A28,$0AA8,$0B28,$0BA8
word = $0850,$08D0,$0950,$09D0,$0A50,$0AD0,$0B50,$0BD0
//
// Text screen parameters.
//
byte textcols = 40
byte curshpos = 0
byte cursvpos = 0
//
// Apple 3 console codes.
//
byte textbwmode[] = 2, 16, 0
byte textclrmode[] = 2, 16, 1
byte grcharset[] = 1, 0, $7F, $7F, $7F, $7F, $00, $00, $00, $00
byte devcons
//
// Exported function table.
//
export word conio[]
word conio[]
//
// Function pointers.
//
@ -79,6 +58,27 @@ word = @a2grmode
word = @a2grcolor
word = @a2grplot
//
// Screen row address arrays.
//
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
word txt2scrn[] = $0800,$0880,$0900,$0980,$0A00,$0A80,$0B00,$0B80
word = $0828,$08A8,$0928,$09A8,$0A28,$0AA8,$0B28,$0BA8
word = $0850,$08D0,$0950,$09D0,$0A50,$0AD0,$0B50,$0BD0
//
// Text screen parameters.
//
//byte textcols = 40
//byte curshpos = 0
//byte cursvpos = 0
//
// Apple 3 console codes.
//
byte textbwmode[] = 2, 16, 0
byte textclrmode[] = 2, 16, 1
byte grcharset[] = 1, 0, $7F, $7F, $7F, $7F, $00, $00, $00, $00
//
// Native routines.
//
asm equates
@ -133,7 +133,7 @@ asm a2grplot(x, y)
STA TMPL
LDA #$FF
ADC #$00
EOR #$0F
EOR #$F0
AND TMPL
EOR GRCLR
STA (DST),Y
@ -155,8 +155,8 @@ def a1home
return 0
end
def a1gotoxy(x, y)
curshpos = x
cursvpos = y
//curshpos = x
//cursvpos = y
putln
while x
putc(' ')
@ -183,13 +183,13 @@ def a2keypressed
return ^keyboard >= 128
end
def a2home
curshpos = 0
cursvpos = 0
//curshpos = 0
//cursvpos = 0
return call($FC58, 0, 0, 0, 0) // home()
end
def a2gotoxy(x, y)
curshpos = x
cursvpos = y
//curshpos = x
//cursvpos = y
^$24 = x + ^$20
return call($FB5B, y + ^$22, 0, 0, 0)
end
@ -246,18 +246,18 @@ def dev_status(devnum, code, list)
end
def a3keypressed
byte count
dev_status(devcons, 5, @count)
dev_status(cmdsys.devcons, 5, @count)
return count
end
def a3home
curshpos = 0
cursvpos = 0
//curshpos = 0
//cursvpos = 0
putc(28)
return 0
end
def a3gotoxy(x, y)
curshpos = x
cursvpos = y
//curshpos = x
//cursvpos = y
putc(24)
putc(x)
putc(25)
@ -271,7 +271,7 @@ def a3viewport(left, top, width, height)
//
left = 0
top = 0
width = textcols
width = 40//textcols
height = 24
fin
putc(1) // Reset viewport
@ -306,7 +306,7 @@ def a3grmode(mix)
mix = 23
fin
puts(@textclrmode)
dev_control(devcons, 17, @grcharset)
dev_control(cmdsys.devcons, 17, @grcharset)
a3viewport(0, 20, 40, 4)
for i = 0 to mix
memset(txt1scrn[i], 40, $0000) // text screen
@ -317,8 +317,8 @@ end
//
// Machine specific initialization.
//
when MACHID & $C8
is $08 // Apple 1
when MACHID & MACHID_MODEL
is MACHID_I
conio:keypressed = @a1keypressed
conio:home = @a1home
conio:gotoxy = @a1gotoxy
@ -327,7 +327,7 @@ when MACHID & $C8
conio:textmode = @a1textmode
conio:grmode = @a1grmode
break
is $C0 // Apple ///
is MACHID_III
conio:keypressed = @a3keypressed
conio:home = @a3home
conio:gotoxy = @a3gotoxy
@ -335,8 +335,7 @@ when MACHID & $C8
conio:texttype = @a3texttype
conio:textmode = @a3textmode
conio:grmode = @a3grmode
devcons = modaddr("CMDSYS").5 // devcons variable from STDLIB
break
otherwise // Apple ][
//otherwise // MACHID_II
wend
done

20
src/libsrc/dgr.pla
View File

@ -653,16 +653,16 @@ fin
//
// Assembly fixups
//
*(@_dgrPlotPix):1 = @_dgrSetPix
*(@_dgrHLinPix):1 = @_dgrSetPix
*(@_dgrVLinPix):1 = @_dgrSetPix
*(@_dgrBLTPix):1 = @_dgrSetPix
*(@_dgrTileTile):1 = @dgrTile
*(@_dgrFillTile):1 = @dgrTile
*(@_dgrSetEvnEvn):1 = @evnclr
*(@_dgrSetEvnOdd):1 = @oddclr
*(@_dgrSetOddEvn):1 = @evnclr
*(@_dgrSetOddOdd):1 = @oddclr
_dgrPlotPix:1 = @_dgrSetPix
_dgrHLinPix:1 = @_dgrSetPix
_dgrVLinPix:1 = @_dgrSetPix
_dgrBLTPix:1 = @_dgrSetPix
_dgrTileTile:1 = @dgrTile
_dgrFillTile:1 = @dgrTile
_dgrSetEvnEvn:1 = @evnclr
_dgrSetEvnOdd:1 = @oddclr
_dgrSetOddEvn:1 = @evnclr
_dgrSetOddOdd:1 = @oddclr
// Put read AUX mem routine in scary location
memcpy($0100, @auxRead, 9)
done

39
src/libsrc/fiber.pla
View File

@ -30,15 +30,14 @@ struc t_vm
word pp
byte hwsp
byte fill[9]
byte drop
byte dropop
byte nextop[$10]
byte hwstk[$C0]
end
byte valstr[] = '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'
//
// Save current VM state and restore another
//
asm fbrSwap(saveVM, restoreVM)
asm fbrSwap(saveVM, restoreVM)#0
!SOURCE "vmsrc/plvmzp.inc"
HWSP = IPY
LDA ESTKL,X
@ -50,6 +49,7 @@ asm fbrSwap(saveVM, restoreVM)
STA DSTL
LDA ESTKH,X
STA DSTH
INX
STX ESP
TSX
STX HWSP
@ -79,7 +79,7 @@ end
//
// Load Zero Page VM state and 6502 stack
//
asm fbrLoad(loadVM)
asm fbrLoad(loadVM)#0
LDA ESTKL,X
STA SRCL
LDA ESTKH,X
@ -122,8 +122,8 @@ export def fbrInit(numPool)
pool = fbrPool + 256
for i = fbrMax downto 1
if i < numPool
fbrState[i] = FIBER_FREE
fbrVMState[i] = pool
fbrState[i] = FIBER_FREE
fbrVMState[i] = pool
pool = pool + 512
fin
next
@ -140,7 +140,7 @@ end
//
// Stop fiber and return it to FREE pool
//
export def fbrStop(fid)
export def fbrStop(fid)#0
byte i
//
@ -158,19 +158,18 @@ export def fbrStop(fid)
fbrNext[i] = fbrNext[fid]
if fid == fbrRunning
fbrRunning = fbrNext[fbrRunning]
return fbrLoad(fbrVMState[fbrRunning])
fbrLoad(fbrVMState[fbrRunning]) // This doesn't actually return here - returns to next fiber
fin
fin
return 0
end
//
// Stop current fiber
//
export def fbrExit
export def fbrExit#0
//
// Stop running fiber
//
return fbrStop(fbrRunning)
fbrStop(fbrRunning)
end
//
// Start a fiber RUNning
@ -219,7 +218,7 @@ end
//
// Round-robin schedule RUNning fibers
//
export def fbrYield
export def fbrYield#0
byte prev
//
@ -228,9 +227,8 @@ export def fbrYield
if fbrNext[fbrRunning] <> fbrRunning
prev = fbrRunning
fbrRunning = fbrNext[fbrRunning]
return fbrSwap(fbrVMState[prev], fbrVMState[fbrRunning])
fbrSwap(fbrVMState[prev], fbrVMState[fbrRunning])
fin
return 0
end
//
// HALT current fiber and await a RESUME
@ -269,17 +267,22 @@ export def fbrResume(fid)#0
fbrNext[fbrRunning] = fid
fin
end
done
//
// Test Fiber library
//
def puth(h)#0
word valstr
valstr = "0123456789ABCDEF"
valstr++
putc('$')
putc(valstr[(h >> 12) & $0F])
putc(valstr[(h >> 8) & $0F])
putc(valstr[(h >> 4) & $0F])
putc(valstr[ h & $0F])
putc(valstr->[(h >> 12) & $0F])
putc(valstr->[(h >> 8) & $0F])
putc(valstr->[(h >> 4) & $0F])
putc(valstr->[ h & $0F])
end
def fbrTest(fid, param)#0

32
src/libsrc/fileio.pla
View File

@ -20,13 +20,14 @@ const O_READ_WRITE = 3
//
const sysbuf = $0800
//
// All our file I/O routines
// External interface
//
struc t_fileio
word getpfx
word setpfx
word getfileinfo
word geteof
word openbuf
word open
word close
word read
@ -37,15 +38,16 @@ struc t_fileio
word readblock
word writeblock
end
predef a2getpfx(path), a23setpfx(path), a2getfileinfo(path, fileinfo), a23geteof(refnum), a2open(path), a23close(refnum)
predef a2getpfx(path), a23setpfx(path), a2getfileinfo(path, fileinfo), a23geteof(refnum), a2openbuf(path, iobuf), a2open(path), a23close(refnum)
predef a23read(refnum, buf, len), a2write(refnum, buf, len), a2create(path, type, aux), a23destroy(path)
predef a23newline(refnum, emask, nlchar), a2readblock(unit, buf, block), a2writeblock(unit, buf, block)
//
// Exported function table.
//
export word fileio[] = @a2getpfx, @a23setpfx, @a2getfileinfo, @a23geteof, @a2open, @a23close
word = @a23read, @a2write, @a2create, @a23destroy
word = @a23newline, @a2readblock, @a2writeblock
word fileio[]
word = @a2getpfx, @a23setpfx, @a2getfileinfo, @a23geteof, @a2openbuf, @a2open, @a23close
word = @a23read, @a2write, @a2create, @a23destroy
word = @a23newline, @a2readblock, @a2writeblock
//
// SOS/ProDOS error code
//
@ -126,6 +128,15 @@ def a1open(path)
*CFFA1FileName = path
return 0
end
def a2openbuf(path, iobuf)
byte params[6]
params.0 = 3
params:1 = path
params:3 = iobuf
params.5 = 0
perr = syscall($C8, @params)
return params.5
end
def a2open(path)
byte params[6]
params.0 = 3
@ -135,6 +146,17 @@ def a2open(path)
perr = syscall($C8, @params)
return params.5
end
def a3openbuf(path, iobuf)
byte params[7]
params.0 = 4
params:1 = path
params.3 = 0
params:4 = iobuf
params.6 = 0
perr = syscall($C8, @params)
return params.3
end
def a3open(path)
byte params[7]

5
src/libsrc/fpu.pla
View File

@ -22,7 +22,8 @@ predef compXY, annuityXY, randNum(pSeed)
//
// FP6502 functions
//
export word fpu = @reset
//export word fpu = @reset
word fpu = @reset
word = @setEnv, @getEnv, @testExcept, @setExcept, @enterProc, @exitProc
word = @constPi, @constE
word = @pushInt, @pushSgl, @pushDbl, @pushExt, @pushStr
@ -37,7 +38,7 @@ word = @logb, @scalb, @trunc, @round, @sqrt, @squared
// ELEMS6502 functions
//
word = @cos, @sin, @tan, @atan
word = @log2X, log21X, @lnX, @ln1X, @pow2X, @pow21X, @powEX, @powE1X, @powE21X, @powXInt, @powXY
word = @log2X, @log21X, @lnX, @ln1X, @pow2X, @pow21X, @powEX, @powE1X, @powE21X, @powXInt, @powXY
word = @compXY, @annuityXY, @randNum
//
// Useful constants

67
src/libsrc/longjmp.pla Normal file
View File

@ -0,0 +1,67 @@
asm incs
!SOURCE "vmsrc/plvmzp.inc"
end
//
// Save environment (PLASMA ZP and stack) for below and return 0
//
export asm except(env)
LDA ESTKL,X
STA SRC
LDA ESTKH,X
STA SRC+1
STX ESP
TSX
STX TMPL
LDY TMPL
- LDA $0100,Y
STA (SRC),Y
INY
BNE -
INC SRC+1
LDX #ESTK
- LDA $00,X
STA (SRC),Y
INY
INX
BNE -
TXA
LDX ESP
STA ESTKL,X
STA ESTKH,X
RTS
end
//
// Restore environment saved above and return retval
//
export asm throw(env, retval)
LDA ESTKL,X
STA SRC
LDA ESTKH,X
STA SRC+1
LDA ESTKL+1,X
STA DST
LDY ESTKH+1,X
INY
STY DST+1
LDX #ESTK
LDY #$00
- LDA (DST),Y
STA $00,X
INY
INX
BNE -
DEC DST+1
LDX TMPL
TXS
LDY TMPL
- LDA (DST),Y
STA $0100,Y
INY
BNE -
LDX ESP
LDA SRC
STA ESTKL,X
LDA SRC+1
STA ESTKH,X
RTS
end

4
src/libsrc/memmgr.pla
View File

@ -105,9 +105,9 @@ byte hexchar = '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'
//
// Fill block filename
//
def strcharadd(str, char)#0
def strcharadd(str, chr)#0
^str = ^str + 1
str->.[^str] = char
str->.[^str] = chr
end
def swapfile(filestr, hmem)#0
memcpy(filestr, @swapvol, swapvol + 1)

8
src/libsrc/sane.pla
View File

@ -16,7 +16,8 @@ end
// External interface to SANE libraries
//
predef fpInit(), fpDefaultHalt(pstatus), uninit0(), uninit1(op, dst), uninit2(op, dst, src), uninit3(op, dst, src, src2)
export word sane = @fpInit, @fpDefaultHalt, @uninit0, @uninit1, @uninit2, @uninit3, @uninit1, @uninit2, @uninit3, @uninit0, @uninit0
//export word sane = @fpInit, @fpDefaultHalt, @uninit0, @uninit1, @uninit2, @uninit3, @uninit1, @uninit2, @uninit3, @uninit0, @uninit0
word sane = @fpInit, @fpDefaultHalt, @uninit0, @uninit1, @uninit2, @uninit3, @uninit1, @uninit2, @uninit3, @uninit0, @uninit0
//
// Pointer to FP6502 entry
//
@ -726,10 +727,11 @@ end
def loadcode(codefile)
byte ref
word pcode, seglen
byte filepath[64]
//puts(codefile); puts(":\n")
pcode = 0
ref = fileio:open(codefile)
ref = fileio:open(strcat(strcpy(@filepath, cmdsys:syspath), codefile))
//puts("ref = "); prbyte(ref); puts(" perr = "); prbyte(perr); putln
if ref
pcode = heapmark

14
src/libsrc/uthernet.pla
View File

@ -11,10 +11,10 @@ end
//
// Uthernet register offsets
//
const TXDATA = $00
const RXDATA = $00
const TXCMD = $04
const TXLEN = $06
const TX_DATA = $00
const RX_DATA = $00
const TX_CMD = $04
const TX_LEN = $06
const INT_STATUS = $08
const PREG_INDEX = $0A
const PREG_DATA = $0C
@ -214,13 +214,13 @@ end
// Identify Uthernet card and initialize
//
for slot = $90 to $F0 step $10
if (peekiow(slot+TXCMD) & $CC3F) == $09
if (peekiow(slot+TX_CMD) & $CC3F) == $09
pokeiow(slot+PREG_INDEX, 0)
if peekiow(slot+PREG_DATA) == $630E
pokepreg($0114, $40) // RESET
rxdata_hi = slot + 1
txcmd = slot + TXCMD
txlen = slot + TXLEN
txcmd = slot + TX_CMD
txlen = slot + TX_LEN
isq = slot + INT_STATUS
pregidx = slot + PREG_INDEX
pregdata = slot + PREG_DATA

27
src/makefile
View File

@ -6,7 +6,7 @@ PLVM02 = PLASMA.SYSTEM\#FF2000
PLVM802 = PLASMA16.SYSTEM\#FF2000
PLVM03 = SOS.INTERP\#050000
CMD = CMD\#FF2000
ED = ED\#FF2000
ED = ED\#FE1000
SB = SB\#FF2000
ROD = ROD\#FE1000
SIEVE = SIEVE\#FE1000
@ -50,7 +50,10 @@ PROFILE = PROFILE\#FE1000
MEMMGR = MEMMGR\#FE1000
MEMTEST = MEMTEST\#FE1000
FIBER = FIBER\#FE1000
LONGJMP = LONGJMP\#FE1000
PLASM = plasm
PLASMAPLASM = PLASM\#FE1000
CODEOPT = CODEOPT\#FE1000
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
#
@ -69,7 +72,7 @@ TXTTYPE = .TXT
#SYSTYPE = \#FF2000
#TXTTYPE = \#040000
all: $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVM802) $(PLVM03) $(CMD) $(ARGS) $(MEMMGR) $(MEMTEST) $(FIBER) $(SB) $(MON) $(ROD) $(SIEVE) $(UTHERNET2) $(UTHERNET) $(ETHERIP) $(INET) $(DHCP) $(HTTPD) $(ROGUE) $(ROGUEMAP) $(ROGUECOMBAT) $(ROGUEIO) $(HGR1) $(TONE) $(DGR) $(DGRTEST) $(FILEIO) $(CONIO) $(PORTIO) $(SPIPORT) $(SDFAT) $(FATCAT) $(FATGET) $(FATPUT) $(FATWDSK) $(FATRDSK) $(SANE) $(FPSTR) $(FPU) $(SANITY) $(RPNCALC)
all: $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVM802) $(PLVM03) $(CMD) $(PLASMAPLASM) $(CODEOPT) $(ARGS) $(MEMMGR) $(MEMTEST) $(FIBER) $(LONGJMP) $(ED) $(MON) $(ROD) $(SIEVE) $(UTHERNET2) $(UTHERNET) $(ETHERIP) $(INET) $(DHCP) $(HTTPD) $(ROGUE) $(ROGUEMAP) $(ROGUECOMBAT) $(ROGUEIO) $(HGR1) $(TONE) $(DGR) $(DGRTEST) $(FILEIO) $(CONIO) $(PORTIO) $(SPIPORT) $(SDFAT) $(FATCAT) $(FATGET) $(FATPUT) $(FATWDSK) $(FATRDSK) $(SANE) $(FPSTR) $(FPU) $(SANITY) $(RPNCALC)
clean:
-rm *FE1000 *FF2000 $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVM03)
@ -83,6 +86,14 @@ clean:
$(PLASM): $(OBJS) $(INCS)
cc $(OBJS) -o $(PLASM)
$(PLASMAPLASM): toolsrc/plasm.pla toolsrc/lex.pla toolsrc/parse.pla toolsrc/codegen.pla toolsrc/codeseq.plh
./$(PLASM) -AMOW < toolsrc/plasm.pla > toolsrc/plasm.a
acme --setpc 4094 -o $(PLASMAPLASM) toolsrc/plasm.a
$(CODEOPT): toolsrc/codeopt.pla toolsrc/codeseq.plh
./$(PLASM) -AMOW < toolsrc/codeopt.pla > toolsrc/codeopt.a
acme --setpc 4094 -o $(CODEOPT) toolsrc/codeopt.a
#
# PLASMA VMs
#
@ -122,8 +133,8 @@ test: samplesrc/test.pla samplesrc/testlib.pla $(PLVM) $(PLASM)
./$(PLVM) TEST
$(ED): toolsrc/ed.pla $(PLVM02) $(PLASM) toolsrc/ed.pla
./$(PLASM) -AOW < toolsrc/ed.pla > toolsrc/ed.a
acme --setpc 8192 -o $(ED) toolsrc/ed.a
./$(PLASM) -AMOW < toolsrc/ed.pla > toolsrc/ed.a
acme --setpc 4094 -o $(ED) toolsrc/ed.a
$(SB): toolsrc/sb.pla $(PLVM02) $(PLASM) toolsrc/sb.pla
./$(PLASM) -AOW < toolsrc/sb.pla > toolsrc/sb.a
@ -145,16 +156,20 @@ $(FIBER): libsrc/fiber.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/fiber.pla > libsrc/fiber.a
acme --setpc 4094 -o $(FIBER) libsrc/fiber.a
$(LONGJMP): libsrc/longjmp.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/longjmp.pla > libsrc/longjmp.a
acme --setpc 4094 -o $(LONGJMP) libsrc/longjmp.a
$(MON): samplesrc/mon.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < samplesrc/mon.pla > samplesrc/mon.a
acme --setpc 4094 -o $(MON) samplesrc/mon.a
$(ROD): samplesrc/rod.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < samplesrc/rod.pla > samplesrc/rod.a
./$(PLASM) -AMO < samplesrc/rod.pla > samplesrc/rod.a
acme --setpc 4094 -o $(ROD) samplesrc/rod.a
$(SIEVE): samplesrc/sieve.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < samplesrc/sieve.pla > samplesrc/sieve.a
./$(PLASM) -AMW < samplesrc/sieve.pla > samplesrc/sieve.a
acme --setpc 4094 -o $(SIEVE) samplesrc/sieve.a
$(UTHERNET): libsrc/uthernet.pla $(PLVM02) $(PLASM)

2
src/mockingboard/seqplay.pla
View File

@ -5,8 +5,6 @@ include "../inc/args.plh"
// Usage is documented following the source in this file...
//
const rndseed = $004E
const FALSE = 0
const TRUE = !FALSE
const LSB = 0
const MSB = 1
const MB_ARPEGGIO = 4 // In 16ths of a second

1
src/samplesrc/hello.pla
View File

@ -1,4 +1,3 @@
include "inc/cmdsys.plh"
puts("Hello, world.\n")
done

24
src/samplesrc/httpd.pla
View File

@ -77,7 +77,7 @@ end
//
// String functions
//
def strcat(dst, src1, src2)
def strcat2(dst, src1, src2)
memcpy(dst + 1, src1 + 1, ^src1)
memcpy(dst + 1 + ^src1, src2 + 1, ^src2)
^dst = ^src1 + ^src2
@ -141,7 +141,7 @@ def servHTTP(remip, remport, lclport, data, len, param)
url = url + 1
fin
fin
strcat(@filename, @prefix, url)
strcat2(@filename, @prefix, url)
puts("GET:"); puts(@filename);putln
//
// Get file info
@ -152,9 +152,9 @@ def servHTTP(remip, remport, lclport, data, len, param)
if refnum // file was opened OK
filelen = fileio:geteof(refnum) // get length of file for Content-Length
lenstr = itos(@lenstr + 1, filelen) - (@lenstr + 1)
strcat(@okhdr, @httpOK, @httpContentLen)
strcat(@okhdr, @okhdr, @lenstr)
strcat(@okhdr, @okhdr, "\n\r")
strcat2(@okhdr, @httpOK, @httpContentLen)
strcat2(@okhdr, @okhdr, @lenstr)
strcat2(@okhdr, @okhdr, "\n\r")
//
// Content type header
//
@ -163,23 +163,23 @@ def servHTTP(remip, remport, lclport, data, len, param)
// this a text file
//
//puts(@mimeTextHtml) // debug
strcat(@okhdr, @okhdr, @httpContentType)
strcat(@okhdr, @okhdr, @mimeTextHtml)
strcat2(@okhdr, @okhdr, @httpContentType)
strcat2(@okhdr, @okhdr, @mimeTextHtml)
else
//
// send as binary attachment
//
//puts(@mimeOctetStream) // debug
strcat(@okhdr, @okhdr, @httpContentType)
strcat(@okhdr, @okhdr, @mimeOctetStream)
strcat(@okhdr, @okhdr, "\n\r")
strcat2(@okhdr, @okhdr, @httpContentType)
strcat2(@okhdr, @okhdr, @mimeOctetStream)
strcat2(@okhdr, @okhdr, "\n\r")
//
// and send filename too
//
strcat(@okhdr, @okhdr, @httpContentAttach)
strcat2(@okhdr, @okhdr, @httpContentAttach)
// todo: get the base filename...
fin
strcat(@okhdr, @okhdr, @httpEnd)
strcat2(@okhdr, @okhdr, @httpEnd)
//dumpchars(@okhdr + 1, okhdr) // debug
iNet:sendTCP(socketHTTP, @okhdr + 1, okhdr) // send HTTP response header to client
sendFile(refnum, socketHTTP, filelen) // send file data to client

7
src/samplesrc/memtest.pla
View File

@ -3,13 +3,6 @@ include "inc/memmgr.plh"
word a, b, c, d, e, memptr
word memfre, memlrgst
def putb(hexb)
return call($FDDA, hexb, 0, 0, 0)
end
def puth(hex)
return call($F941, hex >> 8, hex, 0, 0)
end
sbrk($3000) // Set small pool size
memfre=hmemFre(@memlrgst);puth(memfre); putc(' '); puth(memlrgst); putln

305
src/samplesrc/rod.pla
View File

@ -1,280 +1,41 @@
include "inc/cmdsys.plh"
include "inc/conio.plh"
//
// Handy constants.
// Rod's Colors
//
const FALSE=0
const TRUE=!FALSE
const FULLMODE=0
const MIXMODE=1
//
// Apple II hardware constants.
//
const speaker = $C030
const showgraphics = $C050
const showtext = $C051
const showfull = $C052
const showmix = $C053
const showpage1 = $C054
const showpage2 = $C055
const showlores = $C056
const showhires = $C057
const keyboard = $C000
const keystrobe = $C010
const hgr1 = $2000
const hgr2 = $4000
const page1 = 0
const page2 = 1
//
// Predefined functions.
//
predef a2keypressed#1, a2gotoxy(x,y)#0, a2grmode(m)#0, a2textmode#0
//
// String data.
//
byte a1err[] = "Apple 1 not supported.\n"
byte a3err[] = "Apple 3 version mismatch.\n"
byte exitmsg[] = "Press any key to exit.\n"
byte goodbye[] = "That's all, folks!\n"
byte cmdsys[] = "cmdsys"
//
// Screen row address arrays.
//
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
word txt2scrn[] = $0800,$0880,$0900,$0980,$0A00,$0A80,$0B00,$0B80
word = $0828,$08A8,$0928,$09A8,$0A28,$0AA8,$0B28,$0BA8
word = $0850,$08D0,$0950,$09D0,$0A50,$0AD0,$0B50,$0BD0
//
// Apple 3 console codes.
//
byte textbwmode[] = 2, 16, 0
byte textclrmode[] = 2, 16, 1
byte grcharset[] = 1, 0, $7F, $7F, $7F, $7F, $00, $00, $00, $00
byte devcons
//
// Function pointers.
//
word keypressed = @a2keypressed
word gotoxy = @a2gotoxy
word grmode = @a2grmode
word textmode = @a2textmode
//
// Common routines.
//
asm equates
!SOURCE "vmsrc/plvmzp.inc"
end
//
// def grscrn(rowaddrs)
//
asm grscrn(rowaddrs)#0
GRSCRN = $26
GRSCRNL = GRSCRN
GRSCRNH = GRSCRNL+1
LDA ESTKL,X
STA GRSCRNL
LDA ESTKH,X
STA GRSCRNH
INX
RTS
end
//
// def grcolor(color)
//
asm grcolor(color)#0
GRCLR = $30
LDA #$0F
AND ESTKL,X
STA GRCLR
ASL
ASL
ASL
ASL
ORA GRCLR
STA GRCLR
INX
RTS
end
//
// def grplot(x, y)
//
asm grplot(x, y)#0
STY IPY
LDA ESTKL,X
AND #$FE
CMP ESTKL,X
TAY
LDA (GRSCRN),Y
STA DSTL
INY
LDA (GRSCRN),Y
STA DSTH
LDA #$FF
ADC #$00
EOR #$0F
TAY
AND GRCLR
STA TMPL
TYA
EOR #$FF
LDY ESTKL+1,X
AND (DST),Y
ORA TMPL
STA (DST),Y
LDY IPY
INX
INX
RTS
end
//
// Apple II routines.
//
def a2keypressed#1
if ^keyboard >= 128
return ^keystrobe
fin
return FALSE
end
def a2gotoxy(x, y)#0
^$24 = x + ^$20
call($FB5B, y + ^$22, 0, 0, 0)
end
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()
grscrn(@txt1scrn) // point to lo-res screen
end
def a2textmode#0
call($FB39, 0, 0, 0, 0) // textmode()
call($FC58, 0, 0, 0, 0) // home()
end
//
// Apple III routines.
//
def dev_control(devnum, code, list)#1
byte params[5]
def rod
var i, j, k, w, fmi, fmk, color
params.0 = 3
params.1 = devnum
params.2 = code
params:3 = list
return syscall($83, @params)
end
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#1
byte count
dev_status(devcons, 5, @count)
if count
return getc
fin
return FALSE
end
def a3gotoxy(x, y)#0
putc(24)
putc(x)
putc(25)
putc(y)
end
def a3viewport(left, top, width, height)#0
putc(1) // Reset viewport
putc(26)
putc(left)
putc(top)
putc(2)
putc(26)
putc(left + width - 1)
putc(top + height - 1)
putc(3)
a3gotoxy(0, 0)
end
def a3grmode(mix)#0
byte i
if mix
mix = 19
else
mix = 23
fin
puts(@textclrmode)
dev_control(devcons, 17, @grcharset)
a3viewport(0, 20, 40, 4)
for i = 0 to mix
memset(txt1scrn[i], $0000, 40) // text screen
memset(txt2scrn[i], $0000, 40) // color screen
next
grscrn(@txt2scrn) // point to color screen
end
def a3textmode#0
puts(@textbwmode)
a3viewport(0, 0, 40, 24)
putc(28)
end
//
// Rod's Colors.
//
def rod#0
byte i, j, k, w, fmi, fmk, color
while TRUE
for w = 3 to 50
for i = 1 to 19
for j = 0 to 19
k = i + j
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()#1
return
fin
next
next
while TRUE
for w = 3 to 50
for i = 1 to 19
for j = 0 to 19
k = i + j
color = (j * 3) / (i + 3) + i * w / 12
fmi = 40 - i
fmk = 40 - k
conio:grcolor(color)
conio:grplot(i, k)
conio:grplot(k, i)
conio:grplot(fmi, fmk)
conio:grplot(fmk, fmi)
conio:grplot(k, fmi)
conio:grplot(fmi, k)
conio:grplot(i, fmk)
conio:grplot(fmk, i)
if conio:keypressed()
return getc
fin
next
loop
next
next
loop
end
//
// Machine specific initialization.
//
when MACHID & $C8
is $08 // Apple 1
puts(@a1err)
return
is $C0 // Apple ///
keypressed = @a3keypressed
gotoxy = @a3gotoxy
grmode = @a3grmode
textmode = @a3textmode
if modaddr(@cmdsys):0 == $0099
devcons = modaddr(@cmdsys).5 // devcons variable from cmdsys
else
puts(@a3err)
return
fin
otherwise // Apple ][
wend
grmode(MIXMODE)#0
gotoxy(11, 1)#0
puts(@exitmsg)
conio:grmode(TRUE)
conio:gotoxy(11, 1)
puts("Press any key to exit.")
rod
textmode()#0
puts(@goodbye)
conio:textmode(40)
puts("That's all, folks!\n")
done

18
src/samplesrc/rogue.io.pla
View File

@ -3,17 +3,15 @@ include "inc/cmdsys.plh"
const modkeep = $2000
const modinitkeep = $4000
byte cmdsys = "cmdsys"
byte[] initstr
byte = " ( )\n"
byte = " )\\ ) ( /( (\n"
byte = "(()/( )\\()) )\\ ) ( (\n"
byte = " ( )\n"
byte = " )\\ ) ( /( (\n"
byte = " (()/( )\\()) )\\ ) ( (\n"
byte = " /(_))((_)\\ (()/( )\\ )\\\n"
byte = "(_)) ((_) /(_))_ _ ((_)((_)\n"
byte = "| _ \\ / _ \\(_)) __|| | | || __|\n"
byte = "| / | (_) | | (_ || |_| || _|\n"
byte = "|_|_\\ \\___/ \\___| \\___/ |___|\n"
byte = "| _ \\ / _ \\(_)) __| | | | || __|\n"
byte = "| / | (_) | || (_ | |_| || _|\n"
byte = "|_|_\\\\___/ \\___| \\___/ |___|\n"
byte = "\n"
byte = " By Resman\n"
byte = " Artwork by Seth Sternberger\n"
@ -40,7 +38,6 @@ const a2rndh = $4F
word iobuff
word a3rndnum = 12345
byte devcons
def a3rnd
a3rndnum = (a3rndnum << 1) + a3rndnum + 123
@ -182,7 +179,7 @@ def dev_status(devnum, code, list)
end
def a3keypressed
byte count
dev_status(devcons, 5, @count)
dev_status(cmdsys.devcons, 5, @count)
return count
end
@ -233,7 +230,6 @@ when MACHID & $C8
home = @a3home
gotoxy = @a3gotoxy
tone = @a3tone
devcons = modaddr(@cmdsys).5 // devcons variable from cmdsys
open = @a3open
read = @a3read
close = @a3close

3
src/samplesrc/rogue.map.pla
View File

@ -11,9 +11,6 @@ import rogueio
word rnd, getkb, home, gotoxy, tone, open, read, close, newline
end
const FALSE = 0
const TRUE = 1
//
// Octant beam parameters
//

3
src/samplesrc/rogue.pla
View File

@ -44,9 +44,6 @@ import rogueio
word rnd, getkb, home, gotoxy, tone
end
const FALSE = 0
const TRUE = not FALSE
const maxlight = 10
const maxview = 19

14
src/samplesrc/rpncalc.pla
View File

@ -26,6 +26,10 @@ predef digitKey(pkey)#0, pointKey(pkey)#0, opKey(pkey)#0
predef enterKey(pkey)#0, copyKey(pkey)#0, chsKey(pkey)#0, memKey(pkey)#0
predef elemsKey(pkey)#0
//
// Run state
//
byte quit = FALSE
//
// Current input
//
byte inputStr[32] = ""
@ -395,11 +399,13 @@ def cmdKey(pkey)#0
// cmdLine = gets(':'|$80)
word d
showStatus("Press 1-9 for fix point digits:")
d = getc - '0'
showStatus("Press 1-9 for fix point digits(Q=Quit):")
d = toupper(getc) - '0'
if d >= 1 and d <= 9
displayFix = d
displayInt = displayWidth - displayFix - 1
elsif d == 'Q' - '0'
quit = TRUE
fin
clearStatus
//
@ -417,7 +423,7 @@ def inputKey#0
byte inkey
word pkeys
while 1
while not quit
pkeys = @keypad
conio:gotoxy(18, 7)
inkey = toupper(getc)
@ -442,7 +448,7 @@ initInput
showStack
showMem
showInput
showStatus("Version 0.5")
showStatus("Version 0.6")
inputKey
conio:gotoxy(0, 22)
done

2
src/samplesrc/sanity.pla
View File

@ -297,7 +297,7 @@ iB = 4
iC = -1
zero = 0
puts("SANE sanity test...\n")
sane.initFP()
sane:initFP()
sane:saveZP()
sane:op2FP(FFINT|FOZ2X, @xT, @iA) // Convert int A to ext T
sane:op2FP(FFINT|FOADD, @xT, @iB) // Add int B to ext T

14
src/samplesrc/sieve.pla
View File

@ -1,14 +1,11 @@
include "inc/cmdsys.plh"
const FALSE = 0
const TRUE = !FALSE
const size = 8190
const sizepl = size+1
byte flag[sizepl]
word flag
byte iter
word prime, i, k, count
byte strPrimes[] = " primes.\n"
def beep#0
putc(7)
@ -16,14 +13,15 @@ end
beep
//for iter = 1 to 10
memset(@flag, TRUE, sizepl)
flag = heapalloc(sizepl)
memset(flag, TRUE, sizepl)
count = 0
for i = 0 to size
if flag[i]
if flag->[i]
prime = i + i + 3
k = i + prime
while k <= size
flag[k] = FALSE
flag->[k] = FALSE
k = k + prime
loop
count = count + 1
@ -34,5 +32,5 @@ beep
//next
beep
puti(count)
puts(@strPrimes)
puts(" primes.\n")
done

45
src/samplesrc/test.pla
View File

@ -81,8 +81,11 @@ def printfunc(a, b, lambda)#0
puti(lambda(a,b))
putln
end
def vals123#3
return 1, 2, 3
end
export def main(range)#0
byte a
byte a, b, c
word lambda
a = 10
@ -120,6 +123,10 @@ export def main(range)#0
printfunc(1, 2, &(a,b) (a-b))
lambda = &(x,y) x * y
puti(lambda(2,3));putln
a = vals123
drop, b, drop = vals123
drop, drop, c = vals123
puts("a, b, c = "); puti(a); puts(", "); puti(b); puts(", "); puti(c); putln
end
def dummy(zz)#2
@ -165,17 +172,29 @@ putln
puts(@constr); puti(constval); putln
puts("Signed byte constant:"); puti(-3); putln
puts("Hello from in-line string!\$7F\n")
puti(array:0); puts(" == "); puti(array:1); puts (" is "); puts(array:0 == array:1 ?? "TRUE\n" :: "FALSE\n")
puti(array:0); puts(" <> "); puti(array:1); puts (" is "); puts(array:0 <> array:1 ?? "TRUE\n" :: "FALSE\n")
puti(array:0); puts(" >= "); puti(array:1); puts (" is "); puts(array:0 >= array:1 ?? "TRUE\n" :: "FALSE\n")
puti(array:0); puts(" <= "); puti(array:1); puts (" is "); puts(array:0 <= array:1 ?? "TRUE\n" :: "FALSE\n")
puti(array:0); puts(" > "); puti(array:1); puts (" is "); puts(array:0 > array:1 ?? "TRUE\n" :: "FALSE\n")
puti(array:0); puts(" < "); puti(array:1); puts (" is "); puts(array:0 < array:1 ?? "TRUE\n" :: "FALSE\n")
puti(array:0); puts(" == "); puti(array:0); puts (" is "); puts(array:0 == array:0 ?? "TRUE\n" :: "FALSE\n")
puti(array:0); puts(" <> "); puti(array:0); puts (" is "); puts(array:0 <> array:0 ?? "TRUE\n" :: "FALSE\n")
puti(array:0); puts(" >= "); puti(array:0); puts (" is "); puts(array:0 >= array:0 ?? "TRUE\n" :: "FALSE\n")
puti(array:0); puts(" <= "); puti(array:0); puts (" is "); puts(array:0 <= array:0 ?? "TRUE\n" :: "FALSE\n")
puti(array:0); puts(" > "); puti(array:0); puts (" is "); puts(array:0 > array:0 ?? "TRUE\n" :: "FALSE\n")
puti(array:0); puts(" < "); puti(array:0); puts (" is "); puts(array:0 < array:0 ?? "TRUE\n" :: "FALSE\n")
puti(array:0); puts(" == "); puti(array:1); puts (" is ")
puts(array:0 == array:1 ?? "TRUE\n" :: "FALSE\n")
puti(array:0); puts(" <> "); puti(array:1); puts (" is ")
puts(array:0 <> array:1 ?? "TRUE\n" :: "FALSE\n")
puti(array:0); puts(" >= "); puti(array:1); puts (" is ")
puts(array:0 >= array:1 ?? "TRUE\n" :: "FALSE\n")
puti(array:0); puts(" <= "); puti(array:1); puts (" is ")
puts(array:0 <= array:1 ?? "TRUE\n" :: "FALSE\n")
puti(array:0); puts(" > "); puti(array:1); puts (" is ")
puts(array:0 > array:1 ?? "TRUE\n" :: "FALSE\n")
puti(array:0); puts(" < "); puti(array:1); puts (" is ")
puts(array:0 < array:1 ?? "TRUE\n" :: "FALSE\n")
puti(array:0); puts(" == "); puti(array:0); puts (" is ")
puts(array:0 == array:0 ?? "TRUE\n" :: "FALSE\n")
puti(array:0); puts(" <> "); puti(array:0); puts (" is ")
puts(array:0 <> array:0 ?? "TRUE\n" :: "FALSE\n")
puti(array:0); puts(" >= "); puti(array:0); puts (" is ")
puts(array:0 >= array:0 ?? "TRUE\n" :: "FALSE\n")
puti(array:0); puts(" <= "); puti(array:0); puts (" is ")
puts(array:0 <= array:0 ?? "TRUE\n" :: "FALSE\n")
puti(array:0); puts(" > "); puti(array:0); puts (" is ")
puts(array:0 > array:0 ?? "TRUE\n" :: "FALSE\n")
puti(array:0); puts(" < "); puti(array:0); puts (" is ")
puts(array:0 < array:0 ?? "TRUE\n" :: "FALSE\n")
ptr = 0
done

6
src/samplesrc/testlib.pla
View File

@ -5,14 +5,14 @@ include "inc/cmdsys.plh"
//
// Module data.
//
predef puth(h)#0
export word print[] = @puti, @puth, @putln, @puts, @putc
predef puthex(h)#0
export word print[] = @puti, @puthex, @putln, @puts, @putc
byte valstr[] = '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'
byte loadstr[] = "testlib loaded!"
//
// Define functions.
//
def puth(h)#0
def puthex(h)#0
putc('$')
putc(valstr[(h >> 12) & $0F])
putc(valstr[(h >> 8) & $0F])

49
src/toolsrc/codegen.c
View File

@ -45,7 +45,7 @@ int id_match(char *name, int len, char *id)
if (len > 16) len = 16;
while (len--)
{
if (name[len] != id[1 + len])
if (toupper(name[len]) != id[1 + len])
return (0);
}
return (1);
@ -73,7 +73,11 @@ int idglobal_lookup(char *name, int len)
int i;
for (i = 0; i < globals; i++)
if (id_match(name, len, &(idglobal_name[i][0])))
{
if (idglobal_type[i] & EXTERN_TYPE)
idglobal_type[i] |= ACCESSED_TYPE;
return (i);
}
return (-1);
}
int idconst_add(char *name, int len, int value)
@ -90,7 +94,7 @@ int idconst_add(char *name, int len, int value)
idconst_name[consts][0] = len;
if (len > ID_LEN) len = ID_LEN;
while (len--)
idconst_name[consts][1 + len] = name[len];
idconst_name[consts][1 + len] = toupper(name[len]);
idconst_value[consts] = value;
consts++;
return (1);
@ -119,7 +123,7 @@ int idlocal_add(char *name, int len, int type, int size)
idlocal_name[locals][0] = len;
if (len > ID_LEN) len = ID_LEN;
while (len--)
idlocal_name[locals][1 + len] = name[len];
idlocal_name[locals][1 + len] = toupper(name[len]);
idlocal_type[locals] = type | LOCAL_TYPE;
idlocal_offset[locals] = localsize;
localsize += size;
@ -149,7 +153,7 @@ int idglobal_add(char *name, int len, int type, int size)
idglobal_name[globals][0] = len;
if (len > ID_LEN) len = ID_LEN;
while (len--)
idglobal_name[globals][1 + len] = name[len];
idglobal_name[globals][1 + len] = toupper(name[len]);
idglobal_type[globals] = type;
if (!(type & EXTERN_TYPE))
{
@ -201,7 +205,7 @@ int idfunc_add(char *name, int len, int type, int tag)
idglobal_name[globals][0] = len;
if (len > ID_LEN) len = ID_LEN;
while (len--)
idglobal_name[globals][1 + len] = name[len];
idglobal_name[globals][1 + len] = toupper(name[len]);
idglobal_type[globals] = type;
idglobal_tag[globals++] = tag;
if (type & EXTERN_TYPE)
@ -350,7 +354,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$DA7F\t\t\t; MAGIC #\n", DW);
printf("\t%s\t$6502\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);
@ -409,13 +413,13 @@ void emit_esd(void)
printf(";\n; EXTERNAL/ENTRY SYMBOL DICTIONARY\n;\n");
for (i = 0; i < globals; i++)
{
if (idglobal_type[i] & EXTERN_TYPE)
if (idglobal_type[i] & ACCESSED_TYPE) // Only refer to accessed externals
{
emit_dci(&idglobal_name[i][1], idglobal_name[i][0]);
printf("\t%s\t$10\t\t\t; EXTERNAL SYMBOL FLAG\n", DB);
printf("\t%s\t%d\t\t\t; ESD INDEX\n", DW, idglobal_tag[i]);
}
else if (idglobal_type[i] & EXPORT_TYPE)
else if (idglobal_type[i] & EXPORT_TYPE)
{
emit_dci(&idglobal_name[i][1], idglobal_name[i][0]);
printf("\t%s\t$08\t\t\t; ENTRY SYMBOL FLAG\n", DB);
@ -445,7 +449,10 @@ void emit_moddep(char *name, int len)
if (outflags & MODULE)
{
if (name)
{
emit_dci(name, len);
idglobal_add(name, len, EXTERN_TYPE | WORD_TYPE, 2); // Add to symbol table
}
else
printf("\t%s\t$00\t\t\t; END OF MODULE DEPENDENCIES\n", DB);
}
@ -750,6 +757,7 @@ void emit_brnch(int tag)
}
void emit_breq(int tag)
{
emit_pending_seq();
printf("\t%s\t$3C\t\t\t; BREQ\t_B%03d\n", DB, tag);
printf("\t%s\t_B%03d-*\n", DW, tag);
}
@ -794,7 +802,7 @@ void emit_leave(void)
{
emit_pending_seq();
if (localsize)
printf("\t%s\t$5A\t\t\t; LEAVE\n", DB);
printf("\t%s\t$5A,$%02X\t\t\t; LEAVE\t%d\n", DB, localsize, localsize);
else
printf("\t%s\t$5C\t\t\t; RET\n", DB);
}
@ -814,14 +822,6 @@ void emit_start(void)
outflags |= INIT;
defs++;
}
void emit_push_exp(void)
{
printf("\t%s\t$34\t\t\t; PUSH EXP\n", DB);
}
void emit_pull_exp(void)
{
printf("\t%s\t$36\t\t\t; PULL EXP\n", DB);
}
void emit_drop(void)
{
emit_pending_seq();
@ -992,7 +992,6 @@ int try_dupify(t_opseq *op)
{
if (op->code != opn->code)
return crunched;
switch (op->code)
{
case CONST_CODE:
@ -1008,19 +1007,16 @@ int try_dupify(t_opseq *op)
case GADDR_CODE:
case LAB_CODE:
case LAW_CODE:
if ((op->tag != opn->tag) || (op->offsz != opn->offsz) ||
(op->type != opn->type))
if ((op->tag != opn->tag) || (op->offsz != opn->offsz) /*|| (op->type != opn->type)*/)
return crunched;
break;
default:
return crunched;
}
opn->code = DUP_CODE;
crunched = 1;
crunched = 1;
}
return crunched;
}
/*
@ -1649,13 +1645,6 @@ int emit_pending_seq()
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;

6
src/toolsrc/codegen.h
View File

@ -59,8 +59,6 @@ typedef struct _opseq {
#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
@ -80,8 +78,6 @@ typedef struct _opseq {
#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)
@ -137,8 +133,6 @@ void emit_brlt(int tag);
void emit_brne(int tag);
void emit_brnch(int tag);
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);

947
src/toolsrc/codegen.pla Normal file
View File

@ -0,0 +1,947 @@
//
// Address tags
//
def new_tag(type)
tag_cnt++
if tag_cnt >= tag_num; exit_err(ERR_OVER|ERR_CODE|ERR_TABLE); fin
tag_addr=>[tag_cnt] = 0 // Unresolved, nothing to update yet
tag_type->[tag_cnt] = type
return tag_cnt
end
//
// New/release sequence ops
//
def new_op
word op
op = freeop_lst
if not op
puts("Compiler out of sequence ops!")
return NULL
fin
freeop_lst = freeop_lst=>opnext
op=>opnext = NULL
return op
end
def release_op(op)#0
if op
op=>opnext = freeop_lst
freeop_lst = op
fin
end
def release_seq(seq)#0
word op
while seq
op = seq
seq = seq=>opnext
//
//Free this op
//
op=>opnext = freeop_lst
freeop_lst = op
loop
end
//
// Append one sequence to the end of another
//
def cat_seq(seq1, seq2)
word op
if not seq1; return seq2; fin
op = seq1
while op=>opnext; op = op=>opnext; loop
op=>opnext = seq2
return seq1
end
//
// Emit data/bytecode
//
def emit_byte(bval)#0
^codeptr = bval
codeptr++
if codeptr - codebuff > codebufsz; exit_err(ERR_OVER|ERR_CODE|ERR_TABLE); fin
end
def emit_word(wval)#0
*codeptr = wval
codeptr = codeptr + 2
if codeptr - codebuff > codebufsz; exit_err(ERR_OVER|ERR_CODE|ERR_TABLE); fin
end
def emit_fill(size)#0
memset(codeptr, 0, size)
codeptr = codeptr + size
if codeptr - codebuff > codebufsz; exit_err(ERR_OVER|ERR_CODE|ERR_TABLE); fin
end
def emit_addr(tag, offset)#0
if tag_type->[tag] & RELATIVE_FIXUP; puts("Global fixup to relative tag"); exit_err(0); fin // DEBUG
fixup_tag=>[fixup_cnt] = tag
fixup_addr=>[fixup_cnt] = codeptr
fixup_cnt++
if fixup_cnt >= fixup_num; exit_err(ERR_OVER|ERR_ID|ERR_TABLE); fin
emit_word(offset + tag_addr=>[tag])
end
def emit_reladdr(tag)#0
word updtptr
if not (tag_type->[tag] & RELATIVE_FIXUP); puts("Not relative tag fixup"); exit_err(0); fin // DEBUG
if tag_type->[tag] & RESOLVED_FIXUP
updtptr = tag_addr=>[tag] - codeptr
else
//
// Add to list of tags needing resolution
//
updtptr = tag_addr=>[tag]
tag_addr=>[tag] = codeptr
fin
emit_word(updtptr)
end
def emit_data(vartype, consttype, constval, constsize)
byte type
word size, chrptr
if consttype == 0
size = constsize
emit_fill(constsize)
elsif consttype == STR_TYPE
constsize = ^constval
size = constsize + 1
chrptr = constval + 1
emit_byte(constsize)
while constsize > 0
emit_byte(^chrptr)
chrptr++
constsize--
loop
elsif consttype == CONSTADDR_TYPE
size = 2
emit_addr(constval, 0)
else
if vartype & BYTE_TYPE
size = 1
emit_byte(constval)
else
size = 2
emit_word(constval)
fin
fin
return size
end
def emit_const(cval)#0
emit_pending_seq
if cval == $0000 // ZERO
emit_byte($00)
elsif cval & $FF00 == $0000 // Constant BYTE
emit_byte($2A)
emit_byte(cval)
elsif cval & $FF00 == $FF00 // Constant $FF00 | BYTE
emit_byte($5E)
emit_byte(cval)
else // Constant WORD
emit_byte($2C)
emit_word(cval)
fin
end
def emit_code(bval)#0
emit_pending_seq
^codeptr = bval
codeptr++
if codeptr - codebuff > codebufsz; exit_err(ERR_OVER|ERR_CODE|ERR_TABLE); fin
end
def emit_dlb(offset)#0
emit_pending_seq
emit_byte($6C)
emit_byte(offset)
end
def emit_dlw(offset)#0
emit_pending_seq
emit_byte($6E)
emit_byte(offset)
end
def emit_dab(tag, offset)#0
emit_pending_seq
emit_byte($7C)
emit_addr(tag, offset)
end
def emit_daw(tag, offset)#0
emit_pending_seq
emit_byte($7E)
emit_addr(tag, offset)
end
def emit_brgt(tag)#0
emit_pending_seq
emit_byte($38)
emit_reladdr(tag)
end
def emit_brlt(tag)#0
emit_pending_seq
emit_byte($3A)
emit_reladdr(tag)
end
def emit_brne(tag)#0
emit_pending_seq
emit_byte($3E)
emit_reladdr(tag)
end
def emit_branch(tag)#0
emit_pending_seq
emit_byte($50)
emit_reladdr(tag)
end
def emit_leave#0
emit_pending_seq
if framesize
emit_byte($5A)
emit_byte(framesize)
else
emit_byte($5C)
fin
end
def emit_enter(cparms)#0
if framesize
emit_byte($58)
emit_byte(framesize)
emit_byte(cparms)
fin
end
def emit_tag(tag)#0
word fixups, updtptr, nextptr, codeofst
emit_pending_seq
if tag_type->[tag] & RESOLVED_FIXUP; puts("Tag already resolved"); exit_err(0); fin // DEBUG
//
// Update list of addresses needing resolution
//
if tag_type->[tag] & RELATIVE_FIXUP
updtptr = tag_addr=>[tag]
while updtptr
nextptr = *updtptr
*updtptr = codeptr - updtptr
updtptr = nextptr
loop
updtptr = codeptr
else
codeofst = codeptr - codebuff
for fixups = fixup_cnt-1 downto 0
if fixup_tag=>[fixups] == tag
updtptr = fixup_addr=>[fixups]
*updtptr = *updtptr + codeofst
fin
next
updtptr = codeptr - codebuff
fin
tag_addr=>[tag] = updtptr
tag_type->[tag] = tag_type->[tag] | RESOLVED_FIXUP
end
//
// Emit the pending sequence
//
def emit_pending_seq#0
word op, pending
//
// This is called by some of the emit_*() functions to ensure that any
// pending ops are emitted before they emit their own op when they are
// called from the parser. However, this function itself calls some of those
// emit_*() functions to emit instructions from the pending sequence, which
// would cause an infinite loop if we weren't careful. We therefore set
// pending_seq to null on entry and work with a local copy, so if this
// function calls back into itself it is a no-op.
//
if not pending_seq; return; fin
pending = pending_seq; pending_seq = NULL
if outflags & OPTIMIZE
while optimize_seq(@pending, 0); loop
if outflags & OPTIMIZE2
while optimize_seq(@pending, 1); loop
fin
fin
while pending
op = pending
when op->opgroup
//
// Constant value
//
is CONST_GROUP
if op->opcode == CONST_CODE
if op=>opval == $0000 // ZERO
^codeptr = $00
codeptr++
elsif op=>opval & $FF00 == $0000 // Constant BYTE
*codeptr = $2A | (op->opval << 8)
codeptr = codeptr + 2
elsif op=>opval & $FF00 == $FF00 // Constant $FF00 | BYTE
*codeptr = $5E | (op->opval << 8)
codeptr = codeptr + 2
else // Constant WORD
codeptr->0 = $2C
codeptr=>1 = op=>opval
codeptr = codeptr + 3
fin
fin
break
//
// Constant string
//
is CONSTR_GROUP
^codeptr = $2E
codeptr++
emit_data(0, STR_TYPE, op=>opval, 0)
break
//
// Single op codes
//
is STACK_GROUP
^codeptr = op->opcode
codeptr++
break
//
// Local address codes
//
is LOCAL_GROUP
*codeptr = op->opcode | (op->opoffset << 8)
codeptr = codeptr + 2
break
//
// Global address codes
//
is GLOBAL_GROUP
^codeptr = op->opcode
codeptr++
emit_addr(op=>optag, op=>opoffset)
break
//
// Relative address codes
//
is RELATIVE_GROUP
^codeptr = op->opcode
codeptr++
emit_reladdr(op=>optag)
break
//
// Code tags
//
is CODETAG_GROUP
emit_tag(op=>optag)
break
otherwise
return
wend
pending = pending=>opnext;
//
// Free this op
//
op=>opnext = freeop_lst
freeop_lst = op
loop
if codeptr - codebuff > codebufsz; exit_err(ERR_OVER|ERR_CODE|ERR_TABLE); fin
end
//
// Emit a sequence of ops (into the pending sequence)
//
def emit_seq(seq)#0
word op
byte string
string = FALSE
op = seq
while op
if op->opcode == CONSTR_CODE; string = TRUE; break; fin
op = op=>opnext
loop
pending_seq = cat_seq(pending_seq, seq)
//
// The source code comments in the output are much more logical if we don't
// merge multiple sequences together. There's no value in doing this merging
// if we're not optimizing, and we optionally allow it to be prevented even
// when we are optimizing by specifing the -N (NO_COMBINE) flag.
//
// We must also force output if the sequence includes a CS opcode, as the
// associated 'constant' is only temporarily valid.
//
if not (outflags & (OPTIMIZE|OPTIMIZE2)) or outflags & NO_COMBINE or string
emit_pending_seq
fin
end
//
// Emit lambda function
//
def emit_lambdafunc(tag, cparms, lambda_seq)#0
emit_tag(tag)
framesize = cparms * 2
emit_enter(cparms)
emit_seq(lambda_seq)
emit_leave
end
//
// ID manager
//
def idmatch(nameptr, len, idptr, idcnt)
byte i
while idcnt
if len == idptr->idname
for i = 1 to len
if nameptr->[i - 1] <> idptr->idname.[i]; break; fin
next
if i > len; return idptr; fin
fin
idptr = idptr + idptr->idname + t_id
idcnt--
loop
return NULL
end
def lookup_id(nameptr, len)
word idptr
idptr = idmatch(nameptr, len, idlocal_tbl, locals)
if not idptr
idptr = idmatch(nameptr, len, idglobal_tbl, globals)
if idptr
if idptr=>idtype & EXTERN_TYPE
idptr=>idtype = idptr=>idtype | EXTACCESS_TYPE
fin
fin
fin
return idptr
end
def lookup_idglobal(nameptr, len)
word idptr
idptr = idmatch(nameptr, len, idglobal_tbl, globals)
if idptr
if idptr=>idtype & EXTERN_TYPE
idptr=>idtype = idptr=>idtype | EXTACCESS_TYPE
fin
fin
return idptr
end
def new_iddata(nameptr, len, type, size)#0
if idmatch(nameptr, len, idglobal_tbl, globals); exit_err(ERR_DUP|ERR_ID); fin
nametostr(nameptr, len, lastglobal + idname)
lastglobal=>idtype = type
if type & EXTERN_TYPE
lastglobal=>idval = new_tag(EXTERN_FIXUP|WORD_FIXUP)//datasize
else
lastglobal=>idval = new_tag(WORD_FIXUP)//datasize
emit_tag(lastglobal=>idval)
if size
emit_fill(size)
datasize = datasize + size
fin
fin
globals++
lastglobal = lastglobal + t_id + len
if lastglobal - idglobal_tbl > globalbufsz; exit_err(ERR_OVER|ERR_GLOBAL|ERR_ID|ERR_TABLE); fin
end
def size_iddata(type, varsize, initsize)#0
if varsize > initsize
datasize = datasize + varsize
emit_data(0, 0, 0, varsize - initsize)
else
datasize = datasize + initsize
fin
end
def new_idglobal(nameptr, len, type, value, cparms, cvals)#0
if idmatch(nameptr, len, idglobal_tbl, globals); exit_err(ERR_DUP|ERR_ID); fin
lastglobal=>idval = value
lastglobal=>idtype = type
lastglobal->funcparms = cparms
lastglobal->funcvals = cvals
nametostr(nameptr, len, lastglobal + idname)
globals++
lastglobal = lastglobal + t_id + len
if lastglobal - idglobal_tbl > globalbufsz; exit_err(ERR_OVER|ERR_GLOBAL|ERR_ID|ERR_TABLE); fin
end
def new_idconst(nameptr, len, value)#0
new_idglobal(nameptr, len, CONST_TYPE, value, 0, 0)
end
def new_idfunc(nameptr, len, type, tag, cfnparms, cfnvals)#0
new_idglobal(nameptr, len, type|FUNC_TYPE, tag, cfnparms, cfnvals)
if not (type & EXTERN_TYPE); def_cnt++; fin
end
def set_idfunc(nameptr, len, tag, cparms, cvals)#0
word idptr
idptr = lookup_idglobal(nameptr, len)
if idptr
if not (idptr=>idtype & FUNC_TYPE); exit_err(ERR_UNDECL|ERR_CODE); fin // DEBUG
idptr=>idval = tag
idptr->funcparms = cparms
idptr->funcvals = cvals
else
exit_err(ERR_UNDECL|ERR_ID)
fin
end
def init_idglobal#0
word op
word i
tag_num = TAGNUM
fixup_num = FIXUPNUM
globalbufsz = IDGLOBALSZ
localbufsz = IDLOCALSZ
if isult(heapavail, $8000)
tag_num = TAGNUM/2
fixup_num = FIXUPNUM/2
globalbufsz = IDGLOBALSZ
localbufsz = IDLOCALSZ/2
fin
//
//Init free op sequence list
//
freeop_lst = heapalloc(OPSEQNUM*t_opseq)
op = freeop_lst
for i = OPSEQNUM-1 downto 0
op=>opnext = op + t_opseq
op = op + t_opseq
next
op=>opnext = NULL
//
// Allocate remaining buffers
//
tag_addr = heapalloc(tag_num*2)
tag_type = heapalloc(tag_num)
fixup_tag = heapalloc(fixup_num*2)
fixup_addr = heapalloc(fixup_num*2)
idglobal_tbl = heapalloc(globalbufsz)
idlocal_tbl = heapalloc(localbufsz)
codebufsz = heapavail - 4096
codebuff = heapalloc(codebufsz)
codeptr = codebuff
lastglobal = idglobal_tbl
puts("Data+Code buffer size = "); puti(codebufsz); putln
end
def new_idlocal(nameptr, len, type, size)#0
if idmatch(nameptr, len, @idlocal_tbl, locals); exit_err(ERR_DUP|ERR_ID); fin
lastlocal=>idval = framesize
lastlocal=>idtype = type | LOCAL_TYPE
nametostr(nameptr, len, lastlocal + idname)
locals++
lastlocal = lastlocal + t_id + len
if lastlocal - idlocal_tbl > localbufsz; exit_err(ERR_OVER|ERR_LOCAL|ERR_TABLE); fin
framesize = framesize + size
if framesize > 255; exit_err(ERR_OVER|ERR_LOCAL|ERR_FRAME); fin
end
def init_idlocal#0
locals = 0
framesize = 0
lastlocal = idlocal_tbl
end
def save_idlocal#0
savelocals = locals
savesize = framesize
savelast = lastlocal
memcpy(heapmark, idlocal_tbl, lastlocal - idlocal_tbl)
end
def restore_idlocal#0
locals = savelocals
framesize = savesize
lastlocal = savelast
memcpy(idlocal_tbl, heapmark, lastlocal - idlocal_tbl)
end
//
// Module dependency list
//
def new_moddep(nameptr, len)#0
if len > 15; len = 15; fin
new_iddata(nameptr, len, EXTERN_TYPE|WORD_TYPE, 2)
memcpy(@moddep_tbl[moddep_cnt*16] + 1, nameptr, len)
moddep_tbl[moddep_cnt*16] = len
moddep_cnt++
if moddep_cnt > MODDEPNUM; parse_warn("Module dependency overflow"); fin
end
//
// Generate/add to a sequence of code
//
def gen_op(seq, code)
word op
if not seq
seq = new_op
op = seq
else
op = seq
while op=>opnext; op = op=>opnext; loop
op=>opnext = new_op
op = op=>opnext
fin
op->opcode = code
op->opgroup = STACK_GROUP
return seq
end
def gen_const(seq, cval)
word op
if not seq
seq = new_op
op = seq
else
op = seq
while op=>opnext; op = op=>opnext; loop
op=>opnext = new_op
op = op=>opnext
fin
op->opcode = CONST_CODE
op->opgroup = CONST_GROUP
op=>opval = cval
return seq
end
def gen_str(seq, cval)
word op
if not seq
seq = new_op
op = seq
else
op = seq
while op=>opnext; op = op=>opnext; loop
op=>opnext = new_op
op = op=>opnext
fin
op->opcode = CONSTR_CODE
op->opgroup = CONSTR_GROUP
op=>opval = cval
return seq
end
def gen_oplcl(seq, code, offsz)
word op
if not seq
seq = new_op
op = seq
else
op = seq
while op=>opnext; op = op=>opnext; loop
op=>opnext = new_op
op = op=>opnext
fin
op->opcode = code
op->opgroup = LOCAL_GROUP
op=>opoffset = offsz
return seq
end
def gen_opglbl(seq, code, tag, offsz)
word op
if not seq
seq = new_op
op = seq
else
op = seq
while op=>opnext; op = op=>opnext; loop
op=>opnext = new_op
op = op=>opnext
fin
op->opcode = code
op->opgroup = GLOBAL_GROUP
op=>optag = tag
op=>opoffset = offsz
return seq
end
def gen_oprel(seq, code, tag)
word op
if not seq
seq = new_op
op = seq
else
op = seq
while op=>opnext; op = op=>opnext; loop
op=>opnext = new_op
op = op=>opnext
fin
op->opcode = code
op->opgroup = RELATIVE_GROUP
op=>optag = tag
return seq
end
def gen_ctag(seq, tag)
word op
if not seq
seq = new_op
op = seq
else
op = seq
while op=>opnext; op = op=>opnext; loop
op=>opnext = new_op
op = op=>opnext
fin
op->opgroup = CODETAG_GROUP
op=>optag = tag
return seq
end
def gen_uop(seq, tkn)
byte code
word op
if not seq
seq = new_op
op = seq
else
op = seq
while op=>opnext; op = op=>opnext; loop
op=>opnext = new_op
op = op=>opnext
fin
when tkn
is NEG_TKN
code = $10; break
is COMP_TKN
code = $12; break
is LOGIC_NOT_TKN
code = $20; break
is INC_TKN
code = $0C; break
is DEC_TKN
code = $0E; break
is BPTR_TKN
code = $60; break
is WPTR_TKN
code = $62; break
otherwise
exit_err(ERR_INVAL|ERR_SYNTAX)
wend
op->opcode = code
op->opgroup = STACK_GROUP
return seq
end
def gen_bop(seq, tkn)
byte code
word op
if not seq
seq = new_op
op = seq
else
op = seq
while op=>opnext; op = op=>opnext; loop
op=>opnext = new_op
op = op=>opnext
fin
when tkn
is MUL_TKN
code = $06; break
is DIV_TKN
code = $08; break
is MOD_TKN
code = $0A; break
is ADD_TKN
code = $02; break
is SUB_TKN
code = $04; break
is SHL_TKN
code = $1A; break
is SHR_TKN
code = $1C; break
is AND_TKN
code = $14; break
is OR_TKN
code = $16; break
is EOR_TKN
code = $18; break
is EQ_TKN
code = $40; break
is NE_TKN
code = $42; break
is GE_TKN
code = $48; break
is LT_TKN
code = $46; break
is GT_TKN
code = $44; break
is LE_TKN
code = $4A; break
is LOGIC_OR_TKN
code = $22; break
is LOGIC_AND_TKN
code = $24; break
otherwise
exit_err(ERR_INVAL|ERR_SYNTAX)
wend
op->opcode = code
op->opgroup = STACK_GROUP
return seq
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.
//
def dcitos(dci, str)
byte len, c
len = 0
repeat
c = ^(dci + len)
len++
^(str + len) = c & $7F
until not (c & $80)
^str = len
return len
end
def stodci(str, dci)
byte len, c
len = ^str
if not len; return 0; fin
c = toupper(^(str + len)) & $7F
len--
^(dci + len) = c
while len
c = toupper(^(str + len)) | $80
len--
^(dci + len) = c
loop
return ^str
end
//
// Write Extended REL header
//
def writeheader(refnum)
word moddep, modfix
byte len, header[128]
moddep = @header:12 // Beginning of module dependency list
while moddep_cnt
moddep_cnt--
moddep = moddep + stodci(@moddep_tbl[moddep_cnt*16], moddep)
loop
^moddep = 0 // Terminate dependency list
len = moddep - 1 - @header
modfix = len + RELADDR - codebuff // Convert generated address into module adress
header:0 = len + codeptr - codebuff // sizeof header+data+bytecode
header:2 = $6502 // Magic #
header:4 = modsysflags // Module SYSFLAGS
header:6 = len + RELADDR + datasize // Byte code offset
header:8 = def_cnt // DEFinition count
header:10 = entrypoint + modfix // Init entrypoint
fileio:write(refnum, @header, len + 2)
return len
end
//
// Write DeFinition Directory
//
def writeDFD(refnum, modfix)#0
word dfd, idptr, idcnt
byte defdir[128]
dfd, idptr, idcnt = @defdir, idglobal_tbl, globals
while idcnt
if idptr=>idtype & (FUNC_TYPE|EXTERN_TYPE) == FUNC_TYPE
dfd->0 = $02
dfd=>1 = tag_addr=>[idptr=>idval] + modfix
dfd->3 = 0
dfd = dfd + 4
fin
idptr = idptr + idptr->idname + t_id
idcnt--
loop
fileio:write(refnum, @defdir, dfd - @defdir)
end
//
// Build External Symbol Directory on heap
//
def buildESD(modfix)#2
word modofst, esd, idptr, idcnt, len
byte symnum
symnum, esd, idptr, idcnt = 0, heapmark, idglobal_tbl, globals
while idcnt
if idptr=>idtype & EXPORT_TYPE
esd = esd + stodci(@idptr->idname, esd)
esd->0 = $08
esd=>1 = tag_addr=>[idptr=>idval] + modfix
esd = esd + 3
elsif idptr=>idtype & EXTACCESS_TYPE
esd = esd + stodci(@idptr->idname, esd)
esd->0 = $10
esd=>1 = symnum
esd = esd + 3
idptr->extnum = symnum
symnum++
fin
idptr = idptr + idptr->idname + t_id
idcnt--
loop
^esd = 0
len = esd - heapmark + 1
esd = heapalloc(len)
return esd, len
end
//
// Write ReLocation Directory
//
def writeRLD(refnum, modofst)#0
word rld, rldlen, fixups, updtptr, idptr, idcnt, tag
byte type
rld = heapmark
rldlen = 0
for fixups = fixup_cnt-1 downto 0
tag = fixup_tag=>[fixups]
type = tag_type->[tag]
if not (type & RELATIVE_FIXUP)
if rldlen == 64 // Write out blocks of entries
fileio:write(refnum, heapmark, rld - heapmark)
rld = heapmark
rldlen = 0
fin
if type & EXTERN_FIXUP
idptr = idglobal_tbl
for idcnt = globals-1 downto 0
if (idptr=>idtype & EXTERN_TYPE) and (idptr=>idval == tag)
rld->3 = idptr->extnum
break
fin
idptr = idptr + idptr->idname + t_id
next
else
rld->3 = 0
fin
rld->0 = $01 | (type & MASK_FIXUP)
rld=>1 = fixup_addr=>[fixups] + modofst
rld = rld + 4
rldlen++
fin
next
^rld = 0
fileio:write(refnum, heapmark, rld - heapmark + 1)
end
//
// Write Extended REL file
//
def writemodule(refnum)#0
word hdrlen, esd, esdlen, modfix, modadj, modofst, fixups, updtptr
//
// Write module header
//
hdrlen = writeheader(refnum)
modfix = hdrlen + RELADDR
modofst = hdrlen - codebuff
//
// Adjust internal fixups for header size
//
for fixups = fixup_cnt-1 downto 0
if not (tag_type->[fixup_tag=>[fixups]] & (EXTERN_FIXUP|RELATIVE_FIXUP))
updtptr = fixup_addr=>[fixups]
*updtptr = *updtptr + modfix
fin
next
//
// Write data/code buffer
//
fileio:write(refnum, codebuff, codeptr - codebuff)
//
// Write bytecode definition directory
//
writeDFD(refnum, modfix)
//
// Build EXERN/ENTRY directory
//
esd, esdlen = buildESD(modfix)
//
// Write relocation directory
//
writeRLD(refnum, modofst)
//
// Write EXTERN/EBTRY directory
//
fileio:write(refnum, esd, esdlen)
heaprelease(esd)
end

453
src/toolsrc/codeopt.pla Normal file
View File

@ -0,0 +1,453 @@
include "inc/cmdsys.plh"
//
// Imports from main compiler
//
import plasm
word freeop_lst
word optimize_seq
end
//
// Code sequence values shares with main compiler
//
include "toolsrc/codeseq.plh"
//
// Replace all but the first of a series of identical load opcodes by DUP. This
// doesn't reduce the number of opcodes but does reduce their size in bytes.
// This is only called on the second optimisation pass because the DUP opcodes
// may inhibit other peephole optimisations which are more valuable.
//
def try_dupify(op)
byte crunched
word nextop
crunched = FALSE
nextop = op=>opnext
while nextop
if op->opcode <> nextop->opcode; return crunched; fin
when op->opcode
is CONST_CODE
if op=>opval <> nextop=>opval; return crunched; fin
break
is LADDR_CODE
is LLB_CODE
is LLW_CODE
if op=>opoffset <> nextop=>opoffset; return crunched; fin
break
is GADDR_CODE
is LAB_CODE
is LAW_CODE
if (op=>optag <> nextop=>optag) or (op=>opoffset <> nextop=>opoffset); return crunched; fin
break
otherwise
return crunched
wend
nextop->opcode = DUP_CODE
nextop->opgroup = STACK_GROUP
nextop = nextop=>opnext
crunched = TRUE
loop
return crunched
end
def is_hardware_address(addr)
return isuge(addr, $C000) and isult(addr, $D000)
end
//
// Crunch sequence (peephole optimize)
//
def crunch_seq(seq, pass)
word nextop, nextopnext, opprev, op, freeops
byte crunched, shiftcnt
opprev = NULL
op = *seq
nextop = op=>opnext
crunched = FALSE
freeops = 0
while op and nextop
when op->opcode
is CONST_CODE
if op=>opval == 1
if nextop->opcode == ADD_CODE
op->opcode = INC_CODE
op->opgroup = STACK_GROUP
freeops = 1
break
fin
if nextop->opcode == SUB_CODE
op->opcode = DEC_CODE
op->opgroup = STACK_GROUP
freeops = 1
break
fin
if nextop->opcode == SHL_CODE
op->opcode = DUP_CODE
op->opgroup = STACK_GROUP
nextop->opcode = ADD_CODE
crunched = 1
break
fin
fin
when nextop->opcode
is NEG_CODE
op=>opval = -op=>opval
freeops = 1
break
is COMP_CODE
op=>opval = ~op=>opval
freeops = 1
break
is LOGIC_NOT_CODE
op=>opval = op=>opval ?? FALSE :: TRUE
freeops = 1
break
is BRFALSE_CODE
if op=>opval
freeops = -2 // Remove constant and never taken branch
else
op->opcode = BRNCH_CODE // Always taken branch
op->opgroup = RELATIVE_GROUP
op=>optag = nextop=>optag
freeops = 1
fin
break
is BRTRUE_CODE
if not op=>opval
freeops = -2 // Remove constant never taken branch
else
op->opcode = BRNCH_CODE // Always taken branch
op->opgroup = RELATIVE_GROUP
op=>optag = nextop=>optag
freeops = 1
fin
break
is NE_CODE
if not op=>opval
freeops = -2 // Remove ZERO:ISNE
fin
break
is EQ_CODE
if not op=>opval
op->opcode = LOGIC_NOT_CODE // Replace ZERO:ISEQ
op->opgroup = STACK_GROUP
freeops = 1
fin
break
is CONST_CODE // Collapse constant operation
nextopnext = nextop->nextop
if nextopnext
when nextopnext->opcode
is MUL_CODE
op=>opval = op=>opval * nextop=>opval
freeops = 2
break
is DIV_CODE
op=>opval = op=>opval / nextop=>opval
freeops = 2
break
is MOD_CODE
op=>opval = op=>opval % nextop=>opval
freeops = 2
break
is ADD_CODE
op=>opval = op=>opval + nextop=>opval
freeops = 2
break
is SUB_CODE
op=>opval = op=>opval - nextop=>opval
freeops = 2
break
is SHL_CODE
op=>opval = op=>opval << nextop=>opval
freeops = 2
break
is SHR_CODE
op=>opval = op=>opval >> nextop=>opval
freeops = 2
break
is AND_CODE
op=>opval = op=>opval & nextop=>opval
freeops = 2
break
is OR_CODE
op=>opval = op=>opval | nextop=>opval
freeops = 2
break
is EOR_CODE
op=>opval = op=>opval ^ nextop=>opval
freeops = 2
break
is EQ_CODE
op=>opval = op=>opval == nextop=>opval
freeops = 2
break
is NE_CODE
op=>opval = op=>opval <> nextop=>opval
freeops = 2
break
is GE_CODE
op=>opval = op=>opval >= nextop=>opval
freeops = 2
break
is LT_CODE
op=>opval = op=>opval < nextop=>opval
freeops = 2
break
is GT_CODE
op=>opval = op=>opval > nextop=>opval
freeops = 2
break
is LE_CODE
op=>opval = op=>opval <= nextop=>opval
freeops = 2
break
is LOGIC_OR_CODE
op=>opval = op=>opval or nextop=>opval
freeops = 2
break
is LOGIC_AND_CODE
op=>opval = op=>opval and nextop=>opval
freeops = 2
break
wend // End of collapse constant operation
fin
if pass and not freeops and op=>opval
crunched = try_dupify(op)
fin
break // CONST_CODE
is MUL_CODE
for shiftcnt = 0 to 15
if op=>opval == 1 << shiftcnt
op=>opval = shiftcnt
nextop->opcode = SHL_CODE
break
fin
next
break
is DIV_CODE
for shiftcnt = 0 to 15
if op=>opval == 1 << shiftcnt
op=>opval = shiftcnt
nextop->opcode = SHR_CODE
break
fin
next
break
wend
break // CONST_CODE
is LADDR_CODE
when nextop->opcode
is CONST_CODE
if nextop=>opnext
nextopnext = nextop=>opnext
when nextopnext->opcode
is INDEXB_CODE // ADD_CODE
op=>opoffset = op=>opoffset + nextop=>opval
freeops = 2
break
is INDEXW_CODE
op=>opoffset = op=>opoffset + nextop=>opval * 2
freeops = 2
break
wend
fin
break
is LB_CODE
op->opcode = LLB_CODE
freeops = 1
break
is LW_CODE
op->opcode = LLW_CODE
freeops = 1
break
is SB_CODE
op->opcode = SLB_CODE
freeops = 1
break
is SW_CODE
op->opcode = SLW_CODE
freeops = 1
break
wend
if pass > 0 and not freeops
crunched = try_dupify(op)
fin
break // LADDR_CODE
is GADDR_CODE
when nextop->opcode
is CONST_CODE
if nextop=>opnext
nextopnext = nextop=>opnext
when nextopnext->opcode
is INDEXB_CODE // ADD_CODE
op=>opoffset = op=>opoffset + nextop=>opval
freeops = 2
break
is INDEXW_CODE
op=>opoffset = op=>opoffset + nextop=>opval * 2
freeops = 2
break
wend
fin
break
is LB_CODE
op->opcode = LAB_CODE
freeops = 1
break
is LW_CODE
op->opcode = LAW_CODE
freeops = 1
break
is SB_CODE
op->opcode = SAB_CODE
freeops = 1
break
is SW_CODE
op->opcode = SAW_CODE
freeops = 1
break
is ICAL_CODE
op->opcode = CALL_CODE
freeops = 1
break
wend
if pass and not freeops
crunched = try_dupify(op)
fin
break // GADDR_CODE
is LLB_CODE
if pass
crunched = try_dupify(op)
fin
break // LLB_CODE
is LLW_CODE
// LLW [n]:CB 8:SHR -> LLB [n+1]
if nextop->opcode == CONST_CODE and nextop=>opval == 8
if nextop=>opnext
nextopnext = nextop=>opnext
if nextopnext->opcode == SHR_CODE
op->opcode = LLB_CODE
op=>opoffset++
freeops = 2
break
fin
fin
fin
if pass and not freeops
crunched = try_dupify(op)
fin
break // LLW_CODE
is LAB_CODE
if pass and not is_hardware_address(op=>opoffset)
crunched = try_dupify(op)
fin
break // LAB_CODE
is LAW_CODE
// LAW x:CB 8:SHR -> LAB x+1
if nextop->opcode == CONST_CODE and nextop=>opval == 8
if nextop=>opnext
nextopnext = nextop=>opnext
if nextopnext->opcode == SHR_CODE
op->opcode = LAB_CODE
op=>opoffset++
freeops = 2
break
fin
fin
fin
if pass and not freeops and not is_hardware_address(op=>opoffset)
crunched = try_dupify(op)
fin
break // LAW_CODE
is LOGIC_NOT_CODE
when nextop->opcode
is BRFALSE_CODE
op->opcode = BRTRUE_CODE
op->opgroup = RELATIVE_GROUP
op=>optag = nextop=>optag
freeops = 1
break
is BRTRUE_CODE
op->opcode = BRFALSE_CODE
op->opgroup = RELATIVE_GROUP
op=>optag = nextop=>optag
freeops = 1
break
wend
break // LOGIC_NOT_CODE
is SLB_CODE
if nextop->opcode == LLB_CODE and op=>opoffset == nextop=>opoffset
op->opcode = DLB_CODE
freeops = 1
fin
break // SLB_CODE
is SLW_CODE
if nextop->opcode == LLW_CODE and op=>opoffset == nextop=>opoffset
op->opcode = DLW_CODE
freeops = 1
fin
break // SLW_CODE
is SAB_CODE
if nextop->opcode == LAB_CODE and op=>optag == nextop=>optag and op=>opoffset == nextop=>opoffset
op->opcode = DAB_CODE
freeops = 1
fin
break // SAB_CODE
is SAW_CODE
if nextop->opcode == LAW_CODE and op=>optag == nextop=>optag and op=>opoffset == nextop=>opoffset
op->opcode = DAW_CODE
freeops = 1
fin
break // SAW_CODE
wend
//
// Free up crunched ops. If freeops is positive we free up that many ops
// *after* op; if it's negative, we free up abs(freeops) ops *starting
// with* op.
//
if freeops < 0
freeops = -freeops
if op == *seq
//
// If op is at the start of the sequence, we treat this as a special case.
//
while freeops
nextop = op=>opnext
op=>opnext = freeop_lst
freeop_lst = op
*seq = nextop
op = nextop
freeops--
loop
crunched = TRUE
else
//
// Otherwise we just move op back to point to the previous op and
// let the following loop remove the required number of ops.
//
op = opprev
nextop = op=>opnext
fin
fin
while freeops
op=>opnext = nextop=>opnext
nextop=>opnext = freeop_lst
freeop_lst = nextop
nextop = op=>opnext
crunched = TRUE
freeops--
loop
opprev = op
op = nextop
nextop = op=>opnext
loop
return crunched
end
//
// Point to crunch function
//
optimize_seq = @crunch_seq
//
// Keep this module in memory
//
return modkeep
done

91
src/toolsrc/codeseq.plh Normal file
View File

@ -0,0 +1,91 @@
//
// Constant code group
//
const CONST_GROUP = $00
const CONST_CODE = $2C
const CONSTR_GROUP = $01
const CONSTR_CODE = $2E
//
// Stack code group
//
const STACK_GROUP = $02
const INDEXB_CODE = $02
const ADD_CODE = $02
const SUB_CODE = $04
const MUL_CODE = $06
const DIV_CODE = $08
const MOD_CODE = $0A
const INC_CODE = $0C
const DEC_CODE = $0E
const NEG_CODE = $10
const COMP_CODE = $12
const AND_CODE = $14
const OR_CODE = $16
const EOR_CODE = $18
const SHL_CODE = $1A
const SHR_CODE = $1C
const INDEXW_CODE = $1E
const LOGIC_NOT_CODE = $20
const LOGIC_OR_CODE = $22
const LOGIC_AND_CODE = $24
const DROP_CODE = $30
const DUP_CODE = $32
const EQ_CODE = $40
const NE_CODE = $42
const GT_CODE = $44
const LT_CODE = $46
const GE_CODE = $48
const LE_CODE = $4A
const ICAL_CODE = $56
const RET_CODE = $5C
const LB_CODE = $60
const BPTR_CODE = $60
const LW_CODE = $62
const WPTR_CODE = $62
const SB_CODE = $70
const SW_CODE = $72
//
// Local address code group
//
const LOCAL_GROUP = $03
const LADDR_CODE = $28
const LLB_CODE = $64
const LLW_CODE = $66
const DLB_CODE = $6C
const DLW_CODE = $6E
const SLB_CODE = $74
const SLW_CODE = $76
//
// Global address code group
//
const GLOBAL_GROUP = $04
const GADDR_CODE = $26
const CALL_CODE = $54
const LAB_CODE = $68
const LAW_CODE = $6A
const SAB_CODE = $78
const SAW_CODE = $7A
const DAB_CODE = $7C
const DAW_CODE = $7E
//
// Relative address code group
//
const RELATIVE_GROUP = $05
const BRFALSE_CODE = $4C
const BRTRUE_CODE = $4E
const BRNCH_CODE = $50
//
// Code tag address group
//
const CODETAG_GROUP = $06
//
// Code sequence op
//
struc t_opseq
byte opcode
byte opgroup
word opval[]
word optag
word opoffset
word opnext
end

577
src/toolsrc/ed.pla
View File

File diff suppressed because it is too large Load Diff

12
src/toolsrc/lex.c
View File

@ -41,13 +41,18 @@ t_token keywords[] = {
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',
DROP_TOKEN, 'D', 'R', 'O', 'P',
END_TOKEN, 'E', 'N', 'D',
DONE_TOKEN, 'D', 'O', 'N', 'E',
LOGIC_NOT_TOKEN, 'N', 'O', 'T',
LOGIC_AND_TOKEN, 'A', 'N', 'D',
LOGIC_OR_TOKEN, 'O', 'R',
BYTE_TOKEN, 'R', 'E', 'S',
BYTE_TOKEN, 'B', 'Y', 'T', 'E',
BYTE_TOKEN, 'C', 'H', 'A', 'R',
BYTE_TOKEN, 'R', 'E', 'S',
WORD_TOKEN, 'W', 'O', 'R', 'D',
WORD_TOKEN, 'V', 'A', 'R',
CONST_TOKEN, 'C', 'O', 'N', 'S', 'T',
STRUC_TOKEN, 'S', 'T', 'R', 'U', 'C',
PREDEF_TOKEN, 'P', 'R', 'E', 'D', 'E', 'F',
@ -406,11 +411,6 @@ t_token scan(void)
scantoken = TERNARY_TOKEN;
scanpos += 2;
}
else
{
scantoken = TERNARY_TOKEN;
scanpos++;
}
break;
default:
/*
@ -424,7 +424,7 @@ t_token scan(void)
}
void scan_rewind(char *backptr)
{
scanpos = backptr;
scanpos = tokenstr = backptr;
}
int scan_lookahead(void)
{

378
src/toolsrc/lex.pla Normal file
View File

@ -0,0 +1,378 @@
//
// Lexical anaylzer
//
//def isalpha(c)
// if c >= 'A' and c <= 'Z'
// return TRUE
// //elsif c >= 'a' and c <= 'z'
// // return TRUE
// elsif c == '_'
// return TRUE
// fin
// return FALSE
//end
//def isnum(c)
// return c >= '0' and c <= '9'
//end
//def isalphanum(c)
// if c >= 'A' and c <= 'Z'
// return TRUE
// //elsif c >= 'a' and c <= 'z'
// // return TRUE
// elsif c >= '0' and c <= '9'
// return TRUE
// elsif c == '_'
// return TRUE
// fin
// return FALSE
//end
def keymatch
byte i, keypos
word chrptr
keypos = 0
while keywrds[keypos] < tknlen
keypos = keypos + keywrds[keypos] + 2
loop
chrptr = tknptr - 1
while keywrds[keypos] == tknlen
for i = 1 to tknlen
if ^(chrptr + i) <> keywrds[keypos + i]
break
fin
next
if i > tknlen
return keywrds[keypos + keywrds[keypos] + 1]
fin
keypos = keypos + keywrds[keypos] + 2
loop
return ID_TKN
end
def scannum
word num
num = 0
if ^scanptr == '$'
repeat
scanptr++
if ^scanptr >= '0' and ^scanptr <= '9'
num = (num << 4) + ^scanptr - '0'
elsif ^scanptr >= 'A' and ^scanptr <= 'F'
num = (num << 4) + ^scanptr - '7'// 'A'-10
elsif ^scanptr >= 'a' and ^scanptr <= 'f'
num = (num << 4) + ^scanptr - 'W'// 'a'-10
else
break
fin
until not ^scanptr
elsif ^scanptr < '0' or ^scanptr > '9'
repeat
num = num * 10 + ^scanptr - '0'
scanptr++
until ^scanptr < '0' or ^scanptr > '9'
else
num = ^scanptr
fin
return num
end
def scan
//
// Skip whitespace
//
while ^scanptr == ' '
scanptr++
loop
tknptr = scanptr
scanchr = toupper(^scanptr)
//
// Scan for token based on first character
//
//if isalpha(scanchr)
if (scanchr >= 'A' and scanchr <= 'Z') or (scanchr == '_')
//
// ID, either variable name or reserved word
//
repeat
^scanptr = scanchr
scanptr++
scanchr = toupper(^scanptr)
//until not isalphanum(scanchr)
until not ((scanchr >= 'A' and scanchr <= 'Z') or (scanchr >= '0' and scanchr <= '9' ) or (scanchr == '_'))
tknlen = scanptr - tknptr
token = keymatch
elsif scanchr >= '0' and scanchr <= '9' // isnum()
//
// Decimal constant
//
token = INT_TKN
constval = 0
repeat
constval = constval * 10 + ^scanptr - '0'
scanptr++
until ^scanptr < '0' or ^scanptr > '9'
else
//
// Potential multiple character tokens
//
when scanchr
is '$'
//
// Hexadecimal constant
//
token = INT_TKN
constval = 0
repeat
scanptr++
if ^scanptr >= '0' and ^scanptr <= '9'
constval = (constval << 4) + ^scanptr - '0'
elsif ^scanptr >= 'A' and ^scanptr <= 'F'
constval = (constval << 4) + ^scanptr - '7'// 'A'-10
elsif ^scanptr >= 'a' and ^scanptr <= 'f'
constval = (constval << 4) + ^scanptr - 'W'// 'a'-10
else
break
fin
until not ^scanptr
break
is '\''
//
// Character constant
//
token = CHR_TKN
scanptr++
if ^scanptr <> '\\'
constval = ^scanptr
else
scanptr++
when ^scanptr
is 'n'
is 'N'
constval = $0D; break
is 'r'
is 'R'
constval = $0A; break
is 't'
is 'T'
constval = $09; break
is '\\'
constval = '\\'; break
otherwise
constval = scannum
scanptr--
wend
fin
if ^(scanptr + 1) <> '\''; exit_err(ERR_INVAL|ERR_CONST); fin
scanptr = scanptr + 2
break
is '"'
//
// String constant
//
token = STR_TKN
constval = strconstptr
^constval = 0
strconstptr++
scanptr++
while ^scanptr and ^scanptr <> '"'
if ^scanptr <> '\\'
^strconstptr = ^scanptr
else
scanptr++
when ^scanptr
is 'n'
is 'N'
^strconstptr = $0D; break
is 'r'
is 'R'
^strconstptr = $0A; break
is 't'
is 'T'
^strconstptr = $09; break
is '\\'
^strconstptr = '\\'; break
otherwise
^strconstptr = scannum
scanptr--
wend
fin
strconstptr++
^constval++
scanptr++
loop
if not ^scanptr; exit_err(ERR_INVAL|ERR_CONST); fin
strconstptr++
scanptr++
break
is '/'
if ^(scanptr + 1) == '/'
token = EOL_TKN
^scanptr = $00
else
token = DIV_TKN
scanptr++
fin
break
is '='
if ^(scanptr + 1) == '='
token = EQ_TKN
scanptr = scanptr + 2
elsif ^(scanptr + 1) == '>'
token = PTRW_TKN
scanptr = scanptr + 2
else
token = SET_TKN
scanptr++
fin
break
is '-'
if ^(scanptr + 1) == '>'
token = PTRB_TKN
scanptr = scanptr + 2
elsif ^(scanptr + 1) == '-'
token = DEC_TKN
scanptr = scanptr + 2
else
token = SUB_TKN
scanptr++
fin
break
is '+'
if ^(scanptr + 1) == '+'
token = INC_TKN
scanptr = scanptr + 2
else
token = ADD_TKN
scanptr++
fin
break
is '>'
if ^(scanptr + 1) == '>'
token = SHR_TKN
scanptr = scanptr + 2
elsif ^(scanptr + 1) == '='
token = GE_TKN
scanptr = scanptr + 2
else
token = GT_TKN
scanptr++
fin
break
is '<'
if ^(scanptr + 1) == '<'
token = SHL_TKN
scanptr = scanptr + 2
elsif ^(scanptr + 1) == '='
token = LE_TKN
scanptr = scanptr + 2
elsif ^(scanptr + 1) == '>'
token = NE_TKN
scanptr = scanptr + 2
else
token = LT_TKN
scanptr++
fin
break
is ':'
if ^(scanptr + 1) == ':'
token = TRIELSE_TKN;
scanptr = scanptr + 2
else
token = COLON_TKN;
scanptr++
fin
break
is '?'
if ^(scanptr + 1) == '?'
token = TERNARY_TKN;
scanptr = scanptr + 2
fin
break
is 0
is ';'
if token <> EOF_TKN
token = EOL_TKN
fin
break
otherwise
//
// Simple single character tokens
//
token = scanchr | $80
scanptr++
wend
fin
tknlen = scanptr - tknptr
return token
end
def rewind(ptr)#0
scanptr = ptr
tknptr = ptr
end
def lookahead
word backptr, backtkn
byte prevtkn, prevlen, look
backptr = scanptr
backtkn = tknptr
prevtkn = token
prevlen = tknlen
look = scan
scanptr = backptr
tknptr = backtkn
token = prevtkn
tknlen = prevlen
return look
end
//
// Get next line of input
//
def nextln
strconstptr = strconstbuff // Reset string constant buffer
if ^scanptr == ';'
scanptr++
scan
else
if token <> EOL_TKN and token <> EOF_TKN; puti(token&$7F); puts("Extraneous characters\n"); exit_err(0); fin
scanptr = inbuff
^instr = fileio:read(refnum, inbuff, 127)
if ^instr
^(instr + ^instr) = NULL // NULL terminate string
lineno++
if !(lineno & $0F); putc('.'); fin
if scan == INCLUDE_TKN
if incref; puts("Nested INCLUDEs not allowed\n"); exit_err(0); fin
if scan <> STR_TKN; puts("Missing INCLUDE file\n"); exit_err(0); fin
strcpy(@incfile, constval)
sysincbuf = heapallocalign(1024, 8, @sysincfre)
incref = fileio:openbuf(@incfile, sysincbuf)
if not incref
puts("Unable to open INCLUDE file: ")
puts(@incfile)
putln
exit_err(0)
fin
fileio:newline(incref, $7F, $0D)
refnum = incref
parsefile = @incfile
srcline = lineno
lineno = 0
scan
return nextln
fin
else
if refnum == incref
fileio:close(incref)
heaprelease(sysincfre)
incref = 0
refnum = srcref
parsefile = @srcfile
lineno = srcline
return nextln
else
*instr = NULL // NULL terminated 0 length string
token = EOF_TKN
fin
fin
fin
return token
end

463
src/toolsrc/parse.c
View File

@ -228,8 +228,12 @@ int parse_constval(void)
type = id_type(tokenstr, tokenlen);
if (type & CONST_TYPE)
value = id_const(tokenstr, tokenlen);
else if ((type & (FUNC_TYPE | EXTERN_TYPE)) || ((type & ADDR_TYPE) && (mod == 8)))
else if (type & (FUNC_TYPE | ADDR_TYPE))
{
if (mod != 8)
parse_error("Invalid address constant");
value = id_tag(tokenstr, tokenlen);
}
else
return (0);
break;
@ -362,11 +366,11 @@ t_opseq *parse_value(t_opseq *codeseq, int rvalue, int *stackdepth)
}
else if (scantoken == BPTR_TOKEN || scantoken == WPTR_TOKEN)
{
deref++;
if (!type)
type |= scantoken == BPTR_TOKEN ? BPTR_TYPE : WPTR_TYPE;
else if (scantoken == BPTR_TOKEN)
if (type & BPTR_TYPE)
parse_error("Byte value used as pointer");
else
type = scantoken == BPTR_TOKEN ? BPTR_TYPE : WPTR_TYPE;
deref++;
}
else if (scantoken == NEG_TOKEN || scantoken == COMP_TOKEN || scantoken == LOGIC_NOT_TOKEN)
{
@ -392,35 +396,41 @@ t_opseq *parse_value(t_opseq *codeseq, int rvalue, int *stackdepth)
if (scantoken == INT_TOKEN || scantoken == CHAR_TOKEN)
{
value = constval;
type |= CONST_TYPE;
valseq = gen_const(NULL, value);
deref--;
}
else if (scantoken == ID_TOKEN)
{
if ((type |= id_type(tokenstr, tokenlen)) & CONST_TYPE)
{
value = id_const(tokenstr, tokenlen);
value = id_const(tokenstr, tokenlen);
valseq = gen_const(NULL, value);
deref--;
}
else //if (type & (VAR_TYPE | FUNC_TYPE))
else
{
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);
if (type & FUNC_TYPE)
{
cfnparms = funcparms_cnt(type);
cfnvals = funcvals_cnt(type);
}
}
}
else if (scantoken == LAMBDA_TOKEN)
{
type |= CONST_TYPE;
value = parse_lambda();
if (!rvalue) // Lambdas can't be LVALUEs
{
release_seq(uopseq);
return (codeseq);
}
value = parse_lambda();
valseq = gen_gbladr(NULL, value, FUNC_TYPE);
deref--;
}
else if (scantoken == OPEN_PAREN_TOKEN)
{
@ -428,9 +438,22 @@ t_opseq *parse_value(t_opseq *codeseq, int rvalue, int *stackdepth)
parse_error("Bad expression in parenthesis");
if (scantoken != CLOSE_PAREN_TOKEN)
parse_error("Missing closing parenthesis");
deref--;
}
else if (scantoken == DROP_TOKEN)
{
if (rvalue)
parse_error("DROP is LVALUE only");
codeseq = gen_drop(codeseq);
scan();
return (codeseq);
}
else
{
release_seq(uopseq);
release_seq(codeseq);
return (NULL);
}
/*
* Parse post operators.
*/
@ -444,33 +467,36 @@ t_opseq *parse_value(t_opseq *codeseq, int rvalue, int *stackdepth)
valseq = cat_seq(parse_list(NULL, &value), valseq);
if (scantoken != CLOSE_PAREN_TOKEN)
parse_error("Missing function call closing parenthesis");
if (scan() == POUND_TOKEN)
if (type & FUNC_TYPE)
{
/*
* Set function pointer return vals count - can't do this to regular function call
*/
if (type & FUNC_TYPE)
parse_error("Overriding function return count");
if (!parse_const(&cfnvals))
parse_error("Invalid def return value count");
if (cfnparms != value) // Can't check parm count on function pointers
parse_error("Parameter count mismatch");
}
else
scan_rewind(tokenstr);
if ((type & FUNC_TYPE) && (cfnparms != value))
parse_error("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--;
if (scan() == POUND_TOKEN)
{
/*
* Set function pointer return vals count - can't do this to regular function call
*/
if (!parse_const(&cfnvals))
parse_error("Invalid def return value count");
}
else
scan_rewind(tokenstr);
if (type & WORD_TYPE)
valseq = gen_lw(valseq);
else if (type & BYTE_TYPE)
parse_error("Using BYTE value as a pointer");
else
deref++;
}
valseq = gen_icall(valseq);
if (stackdepth)
*stackdepth = cfnvals;
cfnvals = 1;
type &= ~(FUNC_TYPE | VAR_TYPE);
*stackdepth += cfnvals - 1;
cfnparms = 0; cfnvals = 1;
type &= PTR_TYPE;
deref--;
}
else if (scantoken == OPEN_BRACKET_TOKEN)
{
@ -480,31 +506,29 @@ t_opseq *parse_value(t_opseq *codeseq, int rvalue, int *stackdepth)
if (type & FUNC_TYPE)
{
/*
* Function call dereference
* Function address dereference
*/
valseq = gen_icall(valseq);
if (stackdepth)
*stackdepth = cfnvals;
cfnparms = 0; cfnvals = 1;
}
while ((idxseq = parse_expr(NULL, stackdepth)))
while ((valseq = parse_expr(valseq, stackdepth)) && scantoken == COMMA_TOKEN)
{
valseq = cat_seq(valseq, idxseq);
if (scantoken != COMMA_TOKEN)
break;
valseq = gen_idxw(valseq);
valseq = gen_lw(valseq);
valseq = gen_lw(valseq); // Multi-dimenstion arrays are array pointers to arrays
}
if (scantoken != CLOSE_BRACKET_TOKEN)
parse_error("Missing closing bracket");
if (type & (WPTR_TYPE | WORD_TYPE))
if (type & WORD_TYPE)
{
valseq = gen_idxw(valseq);
type = (type & PTR_TYPE) | WORD_TYPE;
}
else
{
valseq = gen_idxb(valseq);
type = (type & PTR_TYPE) | BYTE_TYPE;
if (!(type & BYTE_TYPE))
{
type = (type & PTR_TYPE) | BYTE_TYPE;
deref++;
}
}
}
else if (scantoken == PTRB_TOKEN || scantoken == PTRW_TOKEN)
@ -517,23 +541,27 @@ t_opseq *parse_value(t_opseq *codeseq, int rvalue, int *stackdepth)
/*
* Function call dereference
*/
if (cfnparms)
parse_error("Parameter count mismatch");
valseq = gen_icall(valseq);
if (stackdepth)
*stackdepth = cfnvals;
type &= ~FUNC_TYPE;
*stackdepth += cfnvals - 1;
cfnparms = 0; cfnvals = 1;
}
else if (type & (VAR_TYPE | PTR_TYPE))
else if (type & WORD_TYPE)
{
/*
* Pointer dereference
*/
valseq = gen_lw(valseq);
}
type = (scantoken == PTRB_TOKEN) ? BPTR_TYPE : WPTR_TYPE;
else if (type & BYTE_TYPE)
parse_error("Using BYTE value as a pointer");
else
deref++;
type = (type & PTR_TYPE) | (scantoken == PTRB_TOKEN) ? BYTE_TYPE : WORD_TYPE; // Type override
if (!parse_const(&const_offset))
{
if (scantoken == EOL_TOKEN || scantoken == CLOSE_PAREN_TOKEN)
parse_error("Syntax");
/*
* Setting type override for following operations
*/
@ -556,20 +584,15 @@ t_opseq *parse_value(t_opseq *codeseq, int rvalue, int *stackdepth)
if (type & FUNC_TYPE)
{
/*
* Function call dereference
* Function address dereference
*/
valseq = gen_icall(valseq);
if (stackdepth)
*stackdepth = cfnvals;
type &= ~FUNC_TYPE;
cfnparms = 0; cfnvals = 1;
}
type = (type & (VAR_TYPE | CONST_TYPE))
? ((scantoken == DOT_TOKEN) ? BYTE_TYPE : WORD_TYPE)
: ((scantoken == DOT_TOKEN) ? BPTR_TYPE : WPTR_TYPE);
else if (!(type & VAR_TYPE))
deref++;
type = (type & PTR_TYPE) | ((scantoken == DOT_TOKEN) ? BYTE_TYPE : WORD_TYPE); // Type override
if (!parse_const(&const_offset))
{
if (scantoken == EOL_TOKEN || scantoken == CLOSE_PAREN_TOKEN)
parse_error("Syntax");
/*
* Setting type override for following operations
*/
@ -587,35 +610,54 @@ t_opseq *parse_value(t_opseq *codeseq, int rvalue, int *stackdepth)
else
break;
}
/*
* Probably parsing RVALUE as LVALUE
*/
if (deref < 0)
{
release_seq(valseq);
release_seq(uopseq);
return (NULL);
}
/*
* Resolve outstanding dereference pointer loads
*/
while (deref > rvalue)
{
deref--;
if (type & FUNC_TYPE)
{
if (cfnparms)
parse_error("Parameter count mismatch");
valseq = gen_icall(valseq);
if (stackdepth)
*stackdepth = cfnvals;
*stackdepth += cfnvals - 1;
cfnparms = 0; cfnvals = 1;
type &= ~FUNC_TYPE;
}
else if (type & VAR_TYPE)
else //if (type & VAR_TYPE)
valseq = gen_lw(valseq);
//else
// {fprintf(stderr,"deref=%d",deref);parse_error("What are we dereferencing #1?");}
deref--;
}
if (deref)
{
if (type & FUNC_TYPE)
{
if (cfnparms)
parse_error("Parameter count mismatch");
valseq = gen_icall(valseq);
if (stackdepth)
*stackdepth = cfnvals;
*stackdepth += cfnvals - 1;
cfnparms = 0; cfnvals = 1;
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);
else
parse_error("What are we dereferencing?");
}
/*
* Output pre-operations
@ -635,6 +677,8 @@ t_opseq *parse_value(t_opseq *codeseq, int rvalue, int *stackdepth)
release_seq(valseq);
return (NULL); // Function or const cannot be LVALUE, must be RVALUE
}
if (stackdepth)
(*stackdepth)--;
}
return (cat_seq(codeseq, valseq));
}
@ -726,8 +770,7 @@ t_opseq *parse_set(t_opseq *codeseq)
}
if (lparms == 0 || scantoken != SET_TOKEN)
{
tokenstr = setptr;
scan_rewind(tokenstr);
scan_rewind(setptr);
while (lparms--)
release_seq(setseq[lparms]);
while (lambda_cnt > lambda_set)
@ -741,18 +784,15 @@ t_opseq *parse_set(t_opseq *codeseq)
rseq = parse_list(NULL, &rparms);
if (lparms > rparms)
parse_error("Set value list underflow");
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 (lparms < rparms)
{
if (rparms - lparms == 1)
parse_warn("Silently dropping extra rvalues");
for (i = rparms - lparms; i > 0; i--)
codeseq = gen_drop(codeseq);
else
codeseq = gen_pullexp(codeseq);
}
while (lparms--)
codeseq = cat_seq(codeseq, setseq[lparms]);
return (codeseq);
}
int parse_stmnt(void)
@ -770,13 +810,17 @@ int parse_stmnt(void)
switch (scantoken)
{
case IF_TOKEN:
if (!(seq = parse_expr(NULL, NULL)))
if (!(seq = parse_expr(NULL, &cfnvals)))
parse_error("Bad expression");
if (cfnvals > 1)
{
parse_warn("Expression value overflow");
while (cfnvals-- > 1) seq = gen_drop(seq);
}
tag_else = tag_new(BRANCH_TYPE);
tag_endif = tag_new(BRANCH_TYPE);
seq = gen_brfls(seq, tag_else);
emit_seq(seq);
//scan();
do
{
while (parse_stmnt()) next_line();
@ -784,8 +828,13 @@ int parse_stmnt(void)
break;
emit_brnch(tag_endif);
emit_codetag(tag_else);
if (!(seq = parse_expr(NULL, NULL)))
if (!(seq = parse_expr(NULL, &cfnvals)))
parse_error("Bad expression");
if (cfnvals > 1)
{
parse_warn("Expression value overflow");
while (cfnvals-- > 1) seq = gen_drop(seq);
}
tag_else = tag_new(BRANCH_TYPE);
seq = gen_brfls(seq, tag_else);
emit_seq(seq);
@ -814,11 +863,16 @@ int parse_stmnt(void)
tag_prevbrk = break_tag;
break_tag = tag_wend;
emit_codetag(tag_while);
if (!(seq = parse_expr(NULL, NULL)))
if (!(seq = parse_expr(NULL, &cfnvals)))
parse_error("Bad expression");
if (cfnvals > 1)
{
parse_warn("Expression value overflow");
while (cfnvals-- > 1) seq = gen_drop(seq);
}
seq = gen_brfls(seq, tag_wend);
emit_seq(seq);
while (parse_stmnt()) next_line();
while (parse_stmnt()) next_line();
if (scantoken != LOOP_TOKEN)
parse_error("Missing WHILE/END");
emit_brnch(tag_while);
@ -839,8 +893,13 @@ int parse_stmnt(void)
parse_error("Missing REPEAT/UNTIL");
emit_codetag(cont_tag);
cont_tag = tag_prevcnt;
if (!(seq = parse_expr(NULL, NULL)))
if (!(seq = parse_expr(NULL, &cfnvals)))
parse_error("Bad expression");
if (cfnvals > 1)
{
parse_warn("Expression value overflow");
while (cfnvals-- > 1) seq = gen_drop(seq);
}
seq = gen_brfls(seq, tag_repeat);
emit_seq(seq);
emit_codetag(break_tag);
@ -859,8 +918,14 @@ int parse_stmnt(void)
addr = id_tag(tokenstr, tokenlen);
if (scan() != SET_TOKEN)
parse_error("Missing FOR =");
if (!emit_seq(parse_expr(NULL, NULL)))
if (!(seq = parse_expr(NULL, &cfnvals)))
parse_error("Bad FOR expression");
if (cfnvals > 1)
{
parse_warn("Expression value overflow");
while (cfnvals-- > 1) seq = gen_drop(seq);
}
emit_seq(seq);
emit_codetag(tag_for);
if (type & LOCAL_TYPE)
type & BYTE_TYPE ? emit_dlb(addr) : emit_dlw(addr);
@ -872,13 +937,25 @@ int parse_stmnt(void)
step = -1;
else
parse_error("Missing FOR TO");
if (!emit_seq(parse_expr(NULL, NULL)))
if (!(seq = parse_expr(NULL, &cfnvals)))
parse_error("Bad FOR TO expression");
if (cfnvals > 1)
{
parse_warn("Expression value overflow");
while (cfnvals-- > 1) seq = gen_drop(seq);
}
emit_seq(seq);
step > 0 ? emit_brgt(break_tag) : emit_brlt(break_tag);
if (scantoken == STEP_TOKEN)
{
if (!emit_seq(parse_expr(NULL, NULL)))
if (!(seq = parse_expr(NULL, &cfnvals)))
parse_error("Bad FOR STEP expression");
if (cfnvals > 1)
{
parse_warn("Expression value overflow");
while (cfnvals-- > 1) seq = gen_drop(seq);
}
emit_seq(seq);
emit_op(step > 0 ? ADD_TOKEN : SUB_TOKEN);
}
else
@ -899,15 +976,27 @@ int parse_stmnt(void)
break_tag = tag_new(BRANCH_TYPE);
tag_choice = tag_new(BRANCH_TYPE);
tag_of = tag_new(BRANCH_TYPE);
if (!emit_seq(parse_expr(NULL, NULL)))
if (!(seq = parse_expr(NULL, &cfnvals)))
parse_error("Bad CASE expression");
if (cfnvals > 1)
{
parse_warn("Expression value overflow");
while (cfnvals-- > 1) seq = gen_drop(seq);
}
emit_seq(seq);
next_line();
while (scantoken != ENDCASE_TOKEN)
{
if (scantoken == OF_TOKEN)
{
if (!emit_seq(parse_expr(NULL, NULL)))
if (!(seq = parse_expr(NULL, &cfnvals)))
parse_error("Bad CASE OF expression");
if (cfnvals > 1)
{
parse_warn("Expression value overflow");
while (cfnvals-- > 1) seq = gen_drop(seq);
}
emit_seq(seq);
emit_brne(tag_choice);
emit_codetag(tag_of);
while (parse_stmnt()) next_line();
@ -938,18 +1027,18 @@ int parse_stmnt(void)
break_tag = tag_prevbrk;
stack_loop--;
break;
case CONTINUE_TOKEN:
if (cont_tag)
emit_brnch(cont_tag);
else
parse_error("CONTINUE without loop");
break;
case BREAK_TOKEN:
if (break_tag)
emit_brnch(break_tag);
else
parse_error("BREAK without loop");
break;
case CONTINUE_TOKEN:
if (cont_tag)
emit_brnch(cont_tag);
else
parse_error("CONTINUE without loop");
break;
case RETURN_TOKEN:
if (infunc)
{
@ -970,13 +1059,21 @@ int parse_stmnt(void)
}
else
{
if (!emit_seq(parse_expr(NULL, NULL)))
if (!(seq = parse_expr(NULL, &cfnvals)))
emit_const(0);
else
{
if (cfnvals > 1)
{
parse_warn("Expression value overflow");
while (cfnvals-- > 1) seq = gen_drop(seq);
}
emit_seq(seq);
}
emit_ret();
}
break;
case EOL_TOKEN:
//case COMMENT_TOKEN:
return (1);
case ELSE_TOKEN:
case ELSEIF_TOKEN:
@ -1004,23 +1101,18 @@ int parse_stmnt(void)
{
emit_seq(rseq);
emit_unaryop(scantoken);
tokenstr = idptr;
scan_rewind(tokenstr);
scan_rewind(idptr);
emit_seq(parse_value(NULL, LVALUE, NULL));
}
else if (scantoken != SET_TOKEN)
else
{
if (stackdepth > 1)
while (stackdepth)
{
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));
stackdepth--;
}
emit_seq(rseq);
}
else
parse_error("Invalid LVALUE");
}
else
parse_error("Syntax error");
@ -1028,22 +1120,14 @@ int parse_stmnt(void)
}
return (scan() == EOL_TOKEN);
}
int parse_var(int type)
int parse_var(int type, long basesize)
{
char *idstr;
long constval;
int consttype, constsize, arraysize, idlen = 0;
long size = 1;
int consttype, constsize, arraysize, idlen = 0;
if (scan() == OPEN_BRACKET_TOKEN)
{
size = 0;
parse_constexpr(&size, &constsize);
if (scantoken != CLOSE_BRACKET_TOKEN)
parse_error("Missing closing bracket");
scan();
}
if (scantoken == ID_TOKEN)
if (scan() == ID_TOKEN)
{
idstr = tokenstr;
idlen = tokenlen;
@ -1056,8 +1140,7 @@ int parse_var(int type)
scan();
}
}
if (type & WORD_TYPE)
size *= 2;
size *= basesize;
if (scantoken == SET_TOKEN)
{
if (type & (EXTERN_TYPE | LOCAL_TYPE))
@ -1083,13 +1166,18 @@ int parse_var(int type)
else
parse_error("Bad variable initializer");
}
else if (idlen)
id_add(idstr, idlen, type, size);
else
{
if (idlen)
id_add(idstr, idlen, type, size);
else
emit_data(0, 0, 0, size);
}
return (1);
}
int parse_struc(void)
{
long size;
long basesize, size;
int type, constsize, offset = 0;
char *idstr, strucid[80];
int idlen = 0, struclen = 0;
@ -1105,17 +1193,19 @@ int parse_struc(void)
{
if (scantoken == EOL_TOKEN)
continue;
size = 1;
basesize = 1;
type = scantoken == BYTE_TOKEN ? BYTE_TYPE : WORD_TYPE;
if (scan() == OPEN_BRACKET_TOKEN)
{
size = 0;
parse_constexpr(&size, &constsize);
basesize = 0;
parse_constexpr(&basesize, &constsize);
if (scantoken != CLOSE_BRACKET_TOKEN)
parse_error("Missing closing bracket");
scan();
}
do {
do
{
size = 1;
idlen = 0;
if (scantoken == ID_TOKEN)
{
@ -1130,6 +1220,7 @@ int parse_struc(void)
scan();
}
}
size *= basesize;
if (type & WORD_TYPE)
size *= 2;
if (idlen)
@ -1140,7 +1231,7 @@ int parse_struc(void)
if (struclen)
idconst_add(strucid, struclen, offset);
if (scantoken != END_TOKEN)
return (0);
parse_error("Missing STRUC/END");
scan();
return (1);
}
@ -1155,7 +1246,7 @@ int parse_vars(int type)
{
case SYSFLAGS_TOKEN:
if (type & (EXTERN_TYPE | LOCAL_TYPE))
parse_error("sysflags must be global");
parse_error("SYSFLAGS must be global");
if (!parse_constexpr(&value, &size))
parse_error("Bad constant");
emit_sysflags(value);
@ -1172,8 +1263,7 @@ int parse_vars(int type)
idconst_add(idstr, idlen, value);
break;
case STRUC_TOKEN:
if (!parse_struc())
parse_error("Bad structure definition");
parse_struc();
break;
case EXPORT_TOKEN:
if (type & (EXTERN_TYPE | LOCAL_TYPE))
@ -1194,86 +1284,63 @@ int parse_vars(int type)
*/
case BYTE_TOKEN:
case WORD_TOKEN:
type |= (scantoken == BYTE_TOKEN) ? BYTE_TYPE : WORD_TYPE;
if (!parse_var(type))
return (0);
while (scantoken == COMMA_TOKEN)
type |= (scantoken == BYTE_TOKEN) ? BYTE_TYPE : WORD_TYPE;
cfnvals = 1; // Just co-opt a long variable for this case
if (scan() == OPEN_BRACKET_TOKEN)
{
if (!parse_var(type))
return (0);
//
// Get base size for variables
//
cfnvals = 0;
parse_constexpr(&cfnvals, &size);
if (scantoken != CLOSE_BRACKET_TOKEN)
parse_error("Missing closing bracket");
}
else
scan_rewind(tokenstr);
if (type & WORD_TYPE)
cfnvals *= 2;
do parse_var(type, cfnvals); while (scantoken == COMMA_TOKEN);
break;
case PREDEF_TOKEN:
/*
* Pre definition.
*/
if (scan() == ID_TOKEN)
do
{
type |= PREDEF_TYPE;
idstr = tokenstr;
idlen = tokenlen;
cfnparms = 0;
cfnvals = 1; // Default to one return value for compatibility
if (scan() == OPEN_PAREN_TOKEN)
if (scan() == ID_TOKEN)
{
do
type = (type & ~FUNC_PARMVALS) | PREDEF_TYPE;
idstr = tokenstr;
idlen = tokenlen;
cfnparms = 0;
cfnvals = 1; // Default to one return value for compatibility
if (scan() == OPEN_PAREN_TOKEN)
{
if (scan() == ID_TOKEN)
do
{
cfnparms++;
scan();
}
} while (scantoken == COMMA_TOKEN);
if (scantoken != CLOSE_PAREN_TOKEN)
parse_error("Bad function parameter list");
scan();
}
if (scantoken == POUND_TOKEN)
{
if (!parse_const(&cfnvals))
parse_error("Invalid def return value count");
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;
type &= ~FUNC_PARMVALS;
cfnparms = 0;
cfnvals = 1; // Default to one return value for compatibility
if (scan() == OPEN_PAREN_TOKEN)
{
do
if (scan() == ID_TOKEN)
{
if (scan() == ID_TOKEN)
{
cfnparms++;
scan();
}
} while (scantoken == COMMA_TOKEN);
if (scantoken != CLOSE_PAREN_TOKEN)
parse_error("Bad function parameter list");
scan();
}
if (scantoken == POUND_TOKEN)
{
if (!parse_const(&cfnvals))
parse_error("Invalid def return value count");
scan();
}
type |= funcparms_type(cfnparms) | funcvals_type(cfnvals);
idfunc_add(idstr, idlen, type, tag_new(type));
cfnparms++;
scan();
}
} while (scantoken == COMMA_TOKEN);
if (scantoken != CLOSE_PAREN_TOKEN)
parse_error("Bad function parameter list");
scan();
}
else
parse_error("Bad function pre-declaration");
if (scantoken == POUND_TOKEN)
{
if (!parse_const(&cfnvals))
parse_error("Invalid def return value count");
scan();
}
type |= funcparms_type(cfnparms) | funcvals_type(cfnvals);
idfunc_add(idstr, idlen, type, tag_new(type));
}
}
else
parse_error("Bad function pre-declaration");
else
parse_error("Bad function pre-declaration");
} while (scantoken == COMMA_TOKEN);
case EOL_TOKEN:
break;
default:
@ -1292,7 +1359,7 @@ int parse_mods(void)
while (parse_vars(EXTERN_TYPE)) next_line();
if (scantoken != END_TOKEN)
parse_error("Missing END");
return (scan() == EOL_TOKEN);
scan();
}
if (scantoken == EOL_TOKEN)
return (1);
@ -1303,7 +1370,6 @@ int parse_lambda(void)
{
int func_tag;
int cfnparms;
char *expr;
if (!infunc)
parse_error("Lambda functions only allowed inside definitions");
@ -1328,7 +1394,6 @@ int parse_lambda(void)
}
else
parse_error("Missing parameter list in lambda function");
expr = scanpos;
if (scan_lookahead() == OPEN_PAREN_TOKEN)
{
/*

1243
src/toolsrc/parse.pla Normal file
View File

File diff suppressed because it is too large Load Diff

504
src/toolsrc/plasm.pla Normal file
View File

@ -0,0 +1,504 @@
include "inc/cmdsys.plh"
include "inc/args.plh"
include "inc/fileio.plh"
include "inc/longjmp.plh"
//
// Tokens
//
const ID_TKN = $D6 // V
const CHR_TKN = $C3 // C
const INT_TKN = $C9 // I
const STR_TKN = $D3 // S
const EOL_TKN = $02
const EOF_TKN = $01
const ERR_TKN = $00
//
//Ternary operand operators
//
const TERNARY_TKN = $BF // ?
const TRIELSE_TKN = $DF // _
//
// Binary operand operators
//
const SET_TKN = $BD // =
const ADD_TKN = $AB // +
const SUB_TKN = $AD // -
const MUL_TKN = $AA // *
const DIV_TKN = $AF // /
const MOD_TKN = $A5 // %
const OR_TKN = $FC // |
const EOR_TKN = $DE // ^
const AND_TKN = $A6 // &
const SHR_TKN = $D2 // R
const SHL_TKN = $CC // L
const GT_TKN = $BE // >
const GE_TKN = $C8 // H
const LT_TKN = $BC // <
const LE_TKN = $C2 // B
const NE_TKN = $D5 // U
const EQ_TKN = $C5 // E
const LOGIC_AND_TKN = $CE // N
const LOGIC_OR_TKN = $CF // O
//
// Unary operand operators
//
const AT_TKN = $C0 // @
const DOT_TKN = $AE // .
const COLON_TKN = $BA // :
const NEG_TKN = $AD // -
const POUND_TKN = $A3 // #
const COMP_TKN = $FE // ~
const LOGIC_NOT_TKN = $A1 // !
const BPTR_TKN = $DE // ^
const WPTR_TKN = $AA // *
const PTRB_TKN = $D8 // X
const PTRW_TKN = $D7 // W
const INC_TKN = $C1 // A
const DEC_TKN = $C4 // D
const LAMBDA_TKN = $A6 // &
//
// Enclosure tokens
//
const OPEN_PAREN_TKN = $A8 // (
const CLOSE_PAREN_TKN = $A9 // )
const OPEN_BRACKET_TKN = $DB // [
const CLOSE_BRACKET_TKN = $DD // ]
//
// Misc. tokens
//
const COMMA_TKN = $AC // ,
//const COMMENT_TKN = $BB // //
const DROP_TKN = $BB
//
// Keyword tokens
//
const CONST_TKN = $80
const BYTE_TKN = $81
const WORD_TKN = $82
const IF_TKN = $83
const ELSEIF_TKN = $84
const ELSE_TKN = $85
const FIN_TKN = $86
const END_TKN = $87
const WHILE_TKN = $88
const LOOP_TKN = $89
const CASE_TKN = $8A
const OF_TKN = $8B
const DEFAULT_TKN = $8C
const ENDCASE_TKN = $8D
const FOR_TKN = $8E
const TO_TKN = $8F
const DOWNTO_TKN = $90
const STEP_TKN = $91
const NEXT_TKN = $92
const REPEAT_TKN = $93
const UNTIL_TKN = $94
const DEF_TKN = $95
const STRUC_TKN = $96
const SYSFLAGS_TKN = $97
const DONE_TKN = $98
const RETURN_TKN = $99
const BREAK_TKN = $9A
const CONT_TKN = $9B
const PREDEF_TKN = $9C
const IMPORT_TKN = $9D
const EXPORT_TKN = $9E
const INCLUDE_TKN = $9F
//
// Types
//
const GLOBAL_TYPE = $0000
const CONST_TYPE = $0001
const BYTE_TYPE = $0002
const WORD_TYPE = $0004
const VAR_TYPE = $0006 // (WORD_TYPE | BYTE_TYPE)
const FUNC_TYPE = $0008
const FUNC_CONST_TYPE = $0009
const ADDR_TYPE = $000E // (VAR_TYPE | FUNC_TYPE)
const LOCAL_TYPE = $0010
const BPTR_TYPE = $0020
const WPTR_TYPE = $0040
const PTR_TYPE = $0060 // (BPTR_TYPE | WPTR_TYPE)
const XBYTE_TYPE = $0022 // (BPTR_TYPE | BYTE_TYPE)
const XWORD_TYPE = $0044 // (WPTR_TYPE | WORD_TYPE)
const CONSTADDR_TYPE = $0061 // (CONST_TYPE | PTR_TYPE)
const STR_TYPE = $0080
const PREDEF_TYPE = $0100
const EXPORT_TYPE = $0200
const EXTERN_TYPE = $0400
const EXTACCESS_TYPE = $0800
const RELATIVE_TYPE = $8000
//
// Fixup flags mask
//
const RESOLVED_FIXUP = $01
const RELATIVE_FIXUP = $02
const MASK_FIXUP = $90
const WORD_FIXUP = $80
const BYTE_FIXUP = $00
const EXTERN_FIXUP = $10
//
// Keywords
//
byte keywrds = "IF", IF_TKN
byte = "TO", TO_TKN
byte = "IS", OF_TKN
byte = "OR", LOGIC_OR_TKN
byte = "FOR", FOR_TKN
byte = "FIN", FIN_TKN
byte = "DEF", DEF_TKN
byte = "END", END_TKN
byte = "AND", LOGIC_AND_TKN
byte = "NOT", LOGIC_NOT_TKN
byte = "RES", BYTE_TKN
byte = "VAR", WORD_TKN
byte = "RES", BYTE_TKN
byte = "WORD", WORD_TKN
byte = "CHAR", BYTE_TKN
byte = "BYTE", BYTE_TKN
byte = "ELSE", ELSE_TKN
byte = "NEXT", NEXT_TKN
byte = "WHEN", CASE_TKN
byte = "LOOP", LOOP_TKN
byte = "STEP", STEP_TKN
byte = "DONE", DONE_TKN
byte = "WEND", ENDCASE_TKN
byte = "DROP", DROP_TKN
byte = "CONST", CONST_TKN
byte = "STRUC", STRUC_TKN
byte = "ELSIF", ELSEIF_TKN
byte = "WHILE", WHILE_TKN
byte = "UNTIL", UNTIL_TKN
byte = "BREAK", BREAK_TKN
byte = "IMPORT", IMPORT_TKN
byte = "EXPORT", EXPORT_TKN
byte = "DOWNTO", DOWNTO_TKN
byte = "REPEAT", REPEAT_TKN
byte = "RETURN", RETURN_TKN
byte = "PREDEF", PREDEF_TKN
byte = "INCLUDE", INCLUDE_TKN
byte = "CONTINUE", CONT_TKN
byte = "SYSFLAGS", SYSFLAGS_TKN
byte = "OTHERWISE",DEFAULT_TKN
byte = $FF
//
// Mathematical ops
//
const bops_tblsz = 17 // minus 1
byte[] bops_tbl // Highest precedence
byte = MUL_TKN, DIV_TKN, MOD_TKN
byte = ADD_TKN, SUB_TKN
byte = SHR_TKN, SHL_TKN
byte = AND_TKN
byte = EOR_TKN
byte = OR_TKN
byte = GT_TKN, GE_TKN, LT_TKN, LE_TKN
byte = EQ_TKN, NE_TKN
byte = LOGIC_AND_TKN
byte = LOGIC_OR_TKN
// Lowest precedence
byte[] bops_prec // Highest precedence
byte = 1, 1, 1
byte = 2, 2
byte = 3, 3
byte = 4
byte = 5
byte = 6
byte = 7, 7, 7, 7
byte = 8, 8
byte = 9
byte = 10
// Lowest precedence
byte[16] opstack
byte[16] precstack
word opsp
word[16] valstack
byte[16] sizestack
byte[16] typestack
word valsp
//
// Code sequence shared with optimizer
//
include "toolsrc/codeseq.plh"
//
//
// Symbol table variables
//
struc t_id
word idval
word idtype
byte funcparms
byte funcvals
byte extnum
byte idname
end
//
// Generated code buffers
//
const OPSEQNUM = 256
const TAGNUM = 1024
const FIXUPNUM = 2048
const MODDEPNUM = 8
const IDGLOBALSZ = 4096
const IDLOCALSZ = 512
word fixup_cnt, tag_cnt = -1
word fixup_tag, fixup_addr
word tag_addr, tag_type
word idglobal_tbl, idlocal_tbl
word pending_seq
word globals, lastglobal, lastlocal, savelast
word tag_num, fixup_num, globalbufsz, localbufsz, codebufsz
word datasize, framesize, savesize
byte locals, savelocals
word codebuff, codeptr, entrypoint
word modsysflags
byte[16] moddep_tbl[MODDEPNUM]
byte moddep_cnt, def_cnt = 1
predef emit_pending_seq#0
//
// Module relocation base address
//
const RELADDR = $1000
//
// Exports for optimizer module
//
export word freeop_lst
export word optimize_seq
//
// Compiler flags
//
const OPTIMIZE = 1
const OPTIMIZE2 = 2
const NO_COMBINE = 4
const WARNINGS = 8
byte outflags
//
// ProDOS/SOS file references
//
byte refnum, srcref, incref
byte[32] srcfile, incfile, relfile
word parsefile // Pointer to current file
word sysincbuf, sysincfre // System I/O buffer for include files
word srcline // Saved source line number
//
// Scanner variables
//
word instr
word inbuff
word scanptr
byte token = EOL_TKN
byte scanchr, tknlen
word tknptr, parserrln
word constval
word lineno
//
// Parser variables
//
const LVALUE = 0
const RVALUE = 1
const LAMBDANUM = 16
word strconstbuff
word strconstptr
byte infunc, inlambda
byte stack_loop
byte prevstmnt
word infuncvals
word break_tag
word cont_tag
byte lambda_cnt, lambda_num
byte[LAMBDANUM] lambda_cparms
word[LAMBDANUM] lambda_seq, lambda_tag
predef parse_constexpr#3, parse_expr(codeseq)#2, parse_lambda
//
// Arg pointer
//
word arg, opt
//
// Long jump environment
//
word exit
//
// Error string flags
//
const ERR_DUP = $0001
const ERR_UNDECL = $0002
const ERR_INVAL = $0004
const ERR_MISS = $0008
const ERR_OVER = $0010
const ERR_CLOSE = $0020
const ERR_LOCAL = $0040
const ERR_GLOBAL = $0080
const ERR_CODE = $0100
const ERR_ID = $0200
const ERR_CONST = $0400
const ERR_INIT = $0800
const ERR_STATE = $1000
const ERR_FRAME = $2000
const ERR_TABLE = $4000
const ERR_SYNTAX = $8000
//=====================================
//
// PLASMA Compiler
//
//=====================================
//
// Handy functions
//
def puth(hex)#0
putc('$')
call($F941, hex >> 8, hex, 0, 0)
end
def nametostr(namestr, len, strptr)#0
^strptr = len
memcpy(strptr + 1, namestr, len)
end
def putcurln#0
byte i
putln; puts(parsefile); putc('['); puti(lineno); puts("]\n")
puts(instr); putln
for i = tknptr - inbuff downto 1
putc(' ')
next
puts("^\n")
end
//
// Error handler
//
def exit_err(err)#0
byte i
puts("\nError:")
if err & ERR_DUP; puts("duplicate "); fin
if err & ERR_UNDECL; puts("undeclared "); fin
if err & ERR_INVAL; puts("invalid "); fin
if err & ERR_MISS; puts("missing "); fin
if err & ERR_OVER; puts("overflowed "); fin
if err & ERR_CLOSE; puts("closing "); fin
if err & ERR_LOCAL; puts("local "); fin
if err & ERR_GLOBAL; puts("global "); fin
if err & ERR_CODE; puts("code "); fin
if err & ERR_ID; puts("identifier "); fin
if err & ERR_CONST; puts("constant"); fin
if err & ERR_INIT; puts("initializer"); fin
if err & ERR_STATE; puts("statement"); fin
if err & ERR_FRAME; puts("frame"); fin
if err & ERR_TABLE; puts("table"); fin
if err & ERR_SYNTAX; puts("syntax"); fin
putcurln
fileio:close(0) // Close all open files
throw(exit, TRUE)
end
//
// Warning
//
def parse_warn(msg)#0
if outflags & WARNINGS
puts("\nWarning:")
puts(msg)
putcurln
fin
end
//
// Include code to reduce size of this file
//
include "toolsrc/codegen.pla"
include "toolsrc/lex.pla"
include "toolsrc/parse.pla"
//
// Look at command line arguments and compile module
//
puts("PLASMA Compiler, Version 1.0\n")
arg = argNext(argFirst)
if ^arg and ^(arg + 1) == '-'
opt = arg + 2
while TRUE
if toupper(^opt) == 'O'
//
// Load optimizer module here
//
if cmdsys:modexec("CODEOPT") >= 0
outflags = outflags | OPTIMIZE
fin
if not (outflags & OPTIMIZE)
puts("\nOptimizer disabled\n")
fin
opt++
if ^opt == '2'
outflags = outflags | OPTIMIZE2
opt++
fin
elsif toupper(^opt) == 'N'
outflags = outflags | NO_COMBINE
opt++
elsif toupper(^opt) == 'W'
outflags = outflags | WARNINGS
opt++
else
break
fin
loop
arg = argNext(arg)
fin
if ^arg
strcpy(@srcfile, arg)
arg = argNext(arg)
if ^arg
strcpy(@relfile, arg)
else
strcpy(@relfile, @srcfile)
//
// Strip trailing extension
//
while relfile and relfile[relfile] <> '.'
relfile--
loop
if relfile; relfile--; fin // Strip '.'
if not relfile
//
// Copy default name over
//
strcpy(@relfile, "A.OUT")
fin
fin
fin
if srcfile and relfile
srcref = fileio:open(@srcfile)
if srcref
fileio:newline(srcref, $7F, $0D)
refnum = srcref
parsefile = @srcfile
strconstbuff = heapalloc(80)
instr = cmdsys:cmdline
inbuff = instr + 1
scanptr = inbuff
*instr = NULL
exit = heapalloc(t_except)
if not except(exit)
//
// Parse source code module
//
parse_module
fileio:close(srcref)
puts("\nBytes compiled: "); puti(codeptr - codebuff); putln
//
// Write REL file
//
fileio:destroy(@relfile)
fileio:create(@relfile, $FE, $1000) // full access, REL file
srcref = fileio:open(@relfile)
if srcref
writemodule(srcref)
fileio:close(srcref)
else
puts("\nError opening: "); puts(@relfile); putln
fin
fin
else
puts("\nError opening: "); puts(@srcfile); putln
fin
else
puts("Usage:+PLASM [-[W][O[2]][N]] <src> [out]\n")
fin
done

108
src/toolsrc/sb.pla
View File

@ -2024,7 +2024,7 @@ end
//
def emit_byte(bval)#0
^codeptr = bval
codeptr = codeptr + 1
codeptr++
end
def emit_word(wval)#0
*codeptr = wval
@ -2087,14 +2087,14 @@ def emit_data(vartype, consttype, constval, constsize)
size = constsize
emit_fill(constsize)
elsif consttype == STR_TYPE
size = constsize
chrptr = constval
constsize = constsize - 1
size = constsize
chrptr = constval
constsize--
emit_byte(constsize)
while constsize > 0
emit_byte(^chrptr)
chrptr = chrptr + 1
constsize = constsize - 1
chrptr++
constsize--
loop
else
if vartype & BYTE_TYPE
@ -2105,7 +2105,7 @@ def emit_data(vartype, consttype, constval, constsize)
if consttype == CONSTADDR_TYPE
emit_addr(constval)
else
emit_word(constval)
emit_word(constval)
fin
fin
fin
@ -2375,9 +2375,9 @@ def emit_drop#0
end
def emit_leave#0
if framesize
emit_op($5A)
emit_op($5A)
else
emit_op($5C)
emit_op($5C)
fin
end
def emit_enter(cparams)#0
@ -2408,7 +2408,7 @@ def idmatch(nameptr, len, idptr, idcnt)
fin
fin
idptr = idptr + idptr->idname + idrecsz
idcnt = idcnt - 1
idcnt--
loop
return 0
end
@ -2431,7 +2431,7 @@ def dumpsym(idptr, idcnt)#0
fin
crout
idptr = idptr + idptr->idname + idrecsz
idcnt = idcnt - 1
idcnt--
loop
end
def id_lookup(nameptr, len)
@ -2455,7 +2455,7 @@ def idlocal_add(namestr, len, type, size)
lastlocal=>idval = framesize
lastlocal->idtype = type | LOCAL_TYPE
nametostr(namestr, len, lastlocal + idname)
locals = locals + 1
locals++
lastlocal = lastlocal + idrecsz + len
if lastlocal > idlocal_tbl + idlocal_tblsz
prstr(@local_sym_overflw)
@ -2463,8 +2463,7 @@ def idlocal_add(namestr, len, type, size)
fin
framesize = framesize + size
if framesize > 255
prstr(@local_overflw)
return FALSE
return parse_err(@local_overflw)
fin
return TRUE
end
@ -2474,7 +2473,7 @@ def iddata_add(namestr, len, type, size)
lastglobal->idtype = type
nametostr(namestr, len, lastglobal + idname)
emit_iddata(datasize, size, lastglobal + idname)
globals = globals + 1
globals++
lastglobal = lastglobal + idrecsz + len
if lastglobal > idglobal_tbl + idglobal_tblsz
prstr(@global_sym_overflw)
@ -2496,7 +2495,7 @@ def idglobal_add(namestr, len, type, value)
lastglobal=>idval = value
lastglobal->idtype = type
nametostr(namestr, len, lastglobal + idname)
globals = globals + 1
globals++
lastglobal = lastglobal + idrecsz + len
if lastglobal > idglobal_tbl + idglobal_tblsz
prstr(@global_sym_overflw)
@ -2639,7 +2638,7 @@ def pop_val(valptr, sizeptr, typeptr)
^sizeptr = sizestack[valsp]
^typeptr = typestack[valsp]
valsp--
return valsp + 1
return valsp + 1
end
//
// Lexical anaylzer
@ -2878,16 +2877,12 @@ def nextln
cpyln(strlinbuf:[lineno], instr)
lineno++
if !(lineno & $0F); cout('.'); fin
print(lineno);cout(':');print(numlines)
cout('>')
prstr(instr)
crout
//print(lineno);cout(':');print(numlines);cout('>');prstr(instr);crout
scan
else
cout('<')
crout
^instr = 0
^inbuff = 0
//cout('<');crout
*instr = 0
//^inbuff = 0
token = DONE_TKN
fin
fin
@ -2973,7 +2968,7 @@ def parse_constval
when token
is SUB_TKN
mod = mod | 1; break
is ALT_COMP_TKN
is ALT_COMP_TKN
is COMP_TKN
mod = mod | 2; break
is LOGIC_NOT_TKN
@ -3012,7 +3007,7 @@ def parse_constval
if !idptr; return parse_err(@bad_cnst); fin
type = idptr->idtype
if type & ADDR_TYPE
if mod <> 8; return parse_err(@bad_cnst); fin
if mod <> 8; return parse_err(@bad_cnst); fin
type = CONSTADDR_TYPE
fin
value = idptr=>idval
@ -3139,20 +3134,20 @@ def parse_value(rvalue)
if deref
push_op(token, 0)
else
deref = deref + 1
type = type | BPTR_TYPE
deref++
type = type | BPTR_TYPE
fin
break
is WPTR_TKN
if deref
push_op(token, 0)
else
deref = deref + 1
type = type | WPTR_TYPE
deref++
type = type | WPTR_TYPE
fin
break
is AT_TKN
deref = deref - 1
deref--
break
is SUB_TKN
is ALT_COMP_TKN
@ -3184,14 +3179,14 @@ def parse_value(rvalue)
// type = type | WORD_TYPE
emit_val = TRUE
break
is STR_TKN
//
// Special case
//
emit_constr(constval, tknlen - 1)
scan
return WORD_TYPE
break
is STR_TKN
//
// Special case
//
emit_constr(constval, tknlen - 1)
scan
return WORD_TYPE
break
otherwise
return 0
wend
@ -3205,16 +3200,16 @@ def parse_value(rvalue)
is NEG_TKN
pop_op
value = -value
break
break
is ALT_COMP_TKN
is COMP_TKN
pop_op
value = ~value
break
break
is LOGIC_NOT_TKN
pop_op
value = !value
break
break
otherwise
cparams = FALSE
wend
@ -3238,7 +3233,8 @@ def parse_value(rvalue)
ref_offset = 0
fin
if ref_type & BPTR_TYPE; emit_lb
elsif ref_type & WPTR_TYPE; emit_lw; fin
elsif ref_type & WPTR_TYPE; emit_lw
fin
if lookahead <> CLOSE_PAREN_TKN
emit_push
fin
@ -3847,7 +3843,7 @@ def parse_var(type)
byte consttype, constsize, idlen
word idptr, constval, arraysize, size
cout('T')
//cout('T')
idlen = 0
size = 1
if scan == OPEN_BRACKET_TKN
@ -3903,7 +3899,7 @@ def parse_struc
byte type, idlen, struclen, constsize
word size, offset, idstr
cout('S')
//cout('S')
struclen = 0
if scan == ID_TKN
struclen = tknlen
@ -3959,7 +3955,7 @@ def parse_vars
byte idlen, type, size
word value, idptr
cout('V')
//cout('V')
when token
is CONST_TKN
if scan <> ID_TKN
@ -4012,7 +4008,7 @@ def parse_defs
word func_tag, idptr
if token == DEF_TKN
cout('D')
//cout('D')
if scan <> ID_TKN; return parse_err(@bad_decl); fin
cfnparms = 0
infunc = TRUE
@ -4028,12 +4024,12 @@ def parse_defs
idlocal_init
if scan == OPEN_PAREN_TKN
repeat
if scan == ID_TKN
cfnparms = cfnparms + 1
idlocal_add(tknptr, tknlen, WORD_TYPE, 2)
scan
fin
until token <> COMMA_TKN
if scan == ID_TKN
cfnparms = cfnparms + 1
idlocal_add(tknptr, tknlen, WORD_TYPE, 2)
scan
fin
until token <> COMMA_TKN
if token <> CLOSE_PAREN_TKN
return parse_err(@bad_decl)
fin
@ -4070,7 +4066,7 @@ def parse_module
while parse_defs
nextln
loop
cout('I')
//cout('I')
framesize = 0
entrypoint = codeptr
emit_enter(0)
@ -4080,7 +4076,7 @@ def parse_module
nextln
loop
fin
cout('!')
//cout('!')
if prevstmnt <> RETURN_TKN
emit_const(0)
emit_leave

4207
src/toolsrc/swyftcode.pla
View File

File diff suppressed because it is too large Load Diff

1
src/toolsrc/symbols.h
View File

@ -20,6 +20,7 @@
#define EXPORT_TYPE (1 << 12)
#define PREDEF_TYPE (1 << 13)
#define FUNC_TYPE (ASM_TYPE | DEF_TYPE | PREDEF_TYPE)
#define ACCESSED_TYPE (1 << 15)
#define FUNC_PARMS (0x0F << 16)
#define FUNC_VALS (0x0F << 20)
#define FUNC_PARMVALS (FUNC_PARMS|FUNC_VALS)

7
src/toolsrc/tokens.h
View File

@ -35,8 +35,8 @@
#define PREDEF_TOKEN TOKEN(22)
#define DEF_TOKEN TOKEN(23)
#define ASM_TOKEN TOKEN(24)
#define IMPORT_TOKEN TOKEN(25)
#define EXPORT_TOKEN TOKEN(26)
#define IMPORT_TOKEN TOKEN(25)
#define EXPORT_TOKEN TOKEN(26)
#define DONE_TOKEN TOKEN(27)
#define RETURN_TOKEN TOKEN(28)
#define BREAK_TOKEN TOKEN(29)
@ -107,7 +107,8 @@
#define COLON_TOKEN TOKEN(':')
#define POUND_TOKEN TOKEN('#')
#define COMMA_TOKEN TOKEN(',')
#define COMMENT_TOKEN TOKEN(';')
//#define COMMENT_TOKEN TOKEN(';')
#define DROP_TOKEN TOKEN(';')
#define EOL_TOKEN TOKEN(0)
#define INCLUDE_TOKEN TOKEN(0x7E)
#define EOF_TOKEN TOKEN(0x7F)

305
src/vmsrc/a1cmd.pla
View File

@ -1,4 +1,4 @@
const MODADDR = $1000
const RELADDR = $1000
const inbuff = $200
const freemem = $0006
//
@ -34,12 +34,12 @@ predef syscall(cmd,null)#1, call(addr,areg,xreg,yreg,status)#1
predef crout()#0, cout(c)#0, prstr(s)#0, print(i)#0, cin()#1, rdstr(p)#1, toupper(c)#1
predef markheap()#1, allocheap(size)#1, allocalignheap(size, pow2, freeaddr), releaseheap(newheap)#1, availheap()#1
predef memset(addr,value,size)#0, memcpy(dst,src,size)#0
predef uword_isgt(a,b)#1, uword_isge(a,b)#1, uword_islt(a,b)#1, uword_isle(a,b)#1, divmod(a,b)#2
predef uword_isgt(a,b)#1, uword_isge(a,b)#1, uword_islt(a,b)#1, uword_isle(a,b)#1, sext(a)#1, divmod(a,b)#2
predef loadmod(mod)#1, execmod(modfile)#1, lookupstrmod(str)#1
//
// System variables.
//
word version = $0099 // 00.99
word version = $0100 // 01.00
word systemflags = 0
word heap
word symtbl, lastsym
@ -68,6 +68,7 @@ word cmdptr = @hexchar // make it point to a zero
//
byte syslibstr[] = "CMDSYS"
byte machidstr[] = "MACHID"
byte syspathstr[] = "SYSPATH"
byte putcstr[] = "PUTC"
byte putlnstr[] = "PUTLN"
byte putsstr[] = "PUTS"
@ -88,12 +89,12 @@ byte uisgtstr[] = "ISUGT"
byte uisgestr[] = "ISUGE"
byte uisltstr[] = "ISULT"
byte uislestr[] = "ISULE"
byte sextstr[] = "SEXT"
byte divmodstr[] = "DIVMOD"
byte loadstr[] = "MODLOAD"
byte execstr[] = "MODEXEC"
byte modadrstr[] = "MODADDR"
byte argstr[] = "ARGS"
word exports[] = @sysstr, @syscall
byte syspath[] = "" // Set to NULL
word exports[] = @syslibstr, @version
word = @sysstr, @syscall
word = @callstr, @call
word = @putcstr, @cout
word = @putlnstr, @crout
@ -113,11 +114,10 @@ word = @uisgtstr, @uword_isgt
word = @uisgestr, @uword_isge
word = @uisltstr, @uword_islt
word = @uislestr, @uword_isle
word = @sextstr, @sext
word = @divmodstr, @divmod
word = @loadstr, @loadmod
word = @execstr, @execmod
word = @modadrstr, @lookupstrmod
word = @machidstr, @machid
word = @syspathstr,@syspath
word = @argstr, @cmdptr
word = 0
word syslibsym = @exports
@ -352,27 +352,15 @@ asm uword_islt(a,b)#1
RTS
end
asm divmod(a,b)#2
LDA #>(_divmod-1)
PHA
LDA #<(_divmod-1)
PHA
JSR INTERP
!BYTE $0A, $5C ; MOD, RET
_divmod DEX
LDA DSTL ; DVDNDL
STA ESTKL,X
LDA DSTH ; DVDNDH
STA ESTKH,X
LSR DVSIGN ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1
BCS +
RTS
+ LDA #$00
; SEC
SBC ESTKL,X
STA ESTKL,X
LDA #$00
SBC ESTKH,X
STA ESTKH,X
JSR INTERP ; CALL DINTERP
!BYTE $36, $5C ; DIVMOD, RET
end
asm sext(a)#1
LDY #$00
LDA ESTKL,X
BPL +
DEY
+ STY ESTKH,X
RTS
end
//
@ -485,38 +473,6 @@ end
// pre-pended with a '#' to differentiate them
// from normal symbols.
//
//def modtosym(mod, dci)
// byte len, c
// (dci).0 = '#'|$80
// len = 0
// repeat
// c = (mod).[len]
// len = len + 1
// (dci).[len] = c
// until !(c & $80)
// return dci
//end
asm modtosym(mod, dci)#1
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.
//
@ -622,47 +578,53 @@ def rdstr(prompt)#1
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 < maxlen //inbuff.0 < maxlen
inbuff.0 = inbuff.0 + 1
ch = inbuff[inbuff.0]
cout(ch)
fin
break
is $08 // left arrow
if inbuff.0
cout('\\')
cout(inbuff[inbuff.0])
inbuff.0 = inbuff.0 - 1
fin
break
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
break
is $0C // ctrl-l
crout
prstr(inbuff)
break
is $0D // return
is $18 // ctrl-x
crout
inbuff.0 = 0
break
is $9B // escape
inbuff.0 = 0
ch = $0D
break
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
@ -737,9 +699,6 @@ end
//
// Symbol table routines.
//
def lookupsym(sym)#1
return lookuptbl(sym, symtbl)
end
def addsym(sym, addr)#0
while ^sym & $80
^lastsym = ^sym
@ -754,33 +713,20 @@ end
//
// Module routines.
//
def lookupmod(mod)#1
byte dci[17]
return lookuptbl(modtosym(mod, @dci), symtbl)
end
def lookupstrmod(str)#1
byte mod[17]
stodci(str, @mod)
return lookupmod(@mod)
end
def addmod(mod, addr)#0
byte dci[17]
addsym(modtosym(mod, @dci), addr)
end
def lookupextern(esd, index)#1
word sym, addr
byte str[16]
while ^esd
sym = esd
esd = esd + dcitos(esd, @str)
esd = sym + dcitos(sym, @str)
if esd->0 & $10 and esd->1 == index
addr = lookupsym(sym)
if !addr
addr = lookuptbl(sym, symtbl)
if !addr
perr = $81
cout('?')
prstr(@str)
crout
fin
cout('?')
prstr(@str)
crout
fin
return addr
fin
esd = esd + 3
@ -808,10 +754,10 @@ def lookupdef(addr, deftbl)#1
end
def loadmod(mod)#1
word rdlen, modsize, bytecode, defofst, defcnt, init, fixup
word addr, modaddr, modfix, modend
word addr, modaddr, modfix, modofst, modend
word deftbl, deflast
word moddep, rld, esd, sym
byte str[17], filename[17]
byte type, str[17], filename[17]
byte header[128]
//
// Read the RELocatable module header (first 128 bytes)
@ -826,7 +772,7 @@ def loadmod(mod)#1
memcpy(@header, heap, 128)
modsize = header:0
moddep = @header.1
defofst = modsize
defofst = modsize + RELADDR
init = 0
if rdlen > 4 and heap=>2 == $DA7F // DAVE+1 = magic number :-)
//
@ -840,7 +786,7 @@ def loadmod(mod)#1
// Load module dependencies.
//
while ^moddep
if !lookupmod(moddep)
if !lookuptbl(moddep, symtbl)
if loadmod(moddep) < 0
return -perr
fin
@ -857,8 +803,6 @@ def loadmod(mod)#1
// Re-read file
//
readfile(@filename, heap)
else
return -69
fin
//
// Alloc heap space for relocated module (data + bytecode).
@ -872,13 +816,15 @@ def loadmod(mod)#1
//
// Add module to symbol table.
//
addmod(mod, modaddr)
addsym(mod, modaddr)
//
// Apply all fixups and symbol import/export.
//
modfix = modaddr - modfix
bytecode = defofst + modfix - MODADDR
modofst = modfix - RELADDR
modend = modaddr + modsize
bytecode = defofst + modofst
defofst = bytecode - defofst
rld = modend // Re-Locatable Directory
esd = rld // Extern+Entry Symbol Directory
while ^esd // Scan to end of ESD
@ -886,40 +832,43 @@ def loadmod(mod)#1
loop
esd = esd + 1
//
// Run through the DeFinition Dictionary.
//
while ^rld == $02
//
// This is a bytcode def entry - add it to the def directory.
//
adddef(rld=>1 + defofst, @deflast)
rld = rld + 4
loop
//
// Run through the Re-Location Dictionary.
//
while ^rld
if ^rld == $02
//
// 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.
fixup = ^addr
fin
if ^rld & $10 // EXTERN reference.
fixup = fixup + lookupextern(esd, rld->3)
else // INTERN fixup.
fixup = fixup + modfix - MODADDR
if uword_isge(fixup, bytecode)
//
// Bytecode address - replace with call def directory.
//
fixup = lookupdef(fixup - bytecode + bytecode, deftbl)
fin
fin
if ^rld & $80 // WORD sized fixup.
*addr = fixup
else // BYTE sized fixup.
^addr = fixup
addr = rld=>1 + modfix
//if uword_isge(addr, modaddr) // Skip fixups to header
//if type & $80 // WORD sized fixup.
// fixup = *addr
//else // BYTE sized fixup.
fixup = ^addr
//fin
if ^rld & $10 // EXTERN reference.
fixup = fixup + lookupextern(esd, rld->3)
else // INTERN fixup.
fixup = fixup + modofst
if uword_isge(fixup, bytecode)
//
// Bytecode address - replace with call def directory.
//
fixup = lookupdef(fixup + defofst, deftbl)
fin
fin
fin
//if type & $80 // WORD sized fixup.
*addr = fixup
//else // BYTE sized fixup.
// ^addr = fixup
//fin
//fin
rld = rld + 4
loop
//
@ -932,12 +881,12 @@ def loadmod(mod)#1
//
// EXPORT symbol - add it to the global symbol table.
//
addr = esd=>1 + modfix - MODADDR
addr = esd=>1 + modofst
if uword_isge(addr, bytecode)
//
// Use the def directory address for bytecode.
//
addr = lookupdef(addr - bytecode + bytecode, deftbl)
addr = lookupdef(addr + defofst, deftbl)
fin
addsym(sym, addr)
fin
@ -948,22 +897,23 @@ def loadmod(mod)#1
return -perr
fin
//
// Free up the end-of-module in main memory.
//
releaseheap(modend)
//
// Call init routine if it exists.
//
fixup = 0
if init
fixup = adddef(init - defofst + bytecode, @deflast)()
init = init - defofst + bytecode
fixup = adddef(init, @deflast)()
if fixup < 0
perr = -fixup
fin
if !(systemflags & modinitkeep)
modend = init - defofst + bytecode
releaseheap(init)
fin
fin
//
// Free up the end-of-module in main memory.
//
releaseheap(modend)
return fixup | (systemflags & modkeep)
end
//
@ -1031,13 +981,15 @@ end
//
heap = *freemem
//
// Print PLASMA version
//
prstr(@verstr); prbyte(version.1); cout('.'); prbyte(version.0); crout
//
// Init symbol table.
//
symtbl = allocheap($200)
lastsym = symtbl
^lastsym = 0
stodci(@syslibstr, heap)
addmod(heap, @version)
while *syslibsym
stodci(syslibsym=>0, heap)
addsym(heap, syslibsym=>2)
@ -1057,11 +1009,6 @@ perr = 0
// Print some startup info.
//
if not ^cmdptr
prstr(@verstr)
prbyte(version.1)
cout('.')
prbyte(version.0)
crout
prstr(@freestr)
prword(availheap)
crout

399
src/vmsrc/cmd.pla
View File

@ -1,7 +1,7 @@
const MACHID = $BF98
const iobuffer = $0800
const databuff = $2000
const MODADDR = $1000
const RELADDR = $1000
const symtbl = $0C00
const freemem = $0006
const getlnbuf = $01FF
@ -25,31 +25,35 @@ const modinitkeep = $4000
// Pedefined functions.
//
predef syscall(cmd,params)#1, call(addr,areg,xreg,yreg,status)#1
predef crout()#0, cout(c)#0, prstr(s)#0, print(i)#0, cin()#1, rdstr(p)#1, toupper(c)#1
predef crout()#0, cout(c)#0, prstr(s)#0, prbyte(b)#0, prword(w)#0, print(i)#0, cin()#1, rdstr(p)#1, toupper(c)#1
predef markheap()#1, allocheap(size)#1, allocalignheap(size, pow2, freeaddr)#1, releaseheap(newheap)#1, availheap()#1
predef memset(addr,value,size)#0, memcpy(dst,src,size)#0
predef uword_isgt(a,b)#1, uword_isge(a,b)#1, uword_islt(a,b)#1, uword_isle(a,b)#1, divmod(a,b)#2
predef loadmod(mod)#1, execmod(modfile)#1, lookupstrmod(str)#1
predef memset(addr,value,size)#0, memcpy(dst,src,size)#0, strcpy(dst,src)#1, strcat(dst,src)#1
predef uword_isgt(a,b)#1, uword_isge(a,b)#1, uword_islt(a,b)#1, uword_isle(a,b)#1, sext(a)#1, divmod(a,b)#2
predef execmod(modfile)#1
//
// System variable.
// Exported CMDSYS table
//
word version = $0099 // 00.99
word systemflags = 0
word heap
word xheap = $0800
word lastsym = symtbl
byte perr
byte cmdln = "" // Overlay exported strings table
word version = $0100 // 01.00
word syspath
word = getlnbuf
word = @execmod
word = getlnbuf
//
// Working input buffer overlayed with strings table
//
byte cmdln = ""
//
// Standard Library exported functions.
//
byte syslibstr = "CMDSYS"
byte sysmodstr = "CMDSYS"
byte machidstr = "MACHID"
byte sysstr = "SYSCALL"
byte callstr = "CALL"
byte putcstr = "PUTC"
byte putlnstr = "PUTLN"
byte putsstr = "PUTS"
byte putbstr = "PUTB"
byte putwstr = "PUTH"
byte putistr = "PUTI"
byte getcstr = "GETC"
byte getsstr = "GETS"
@ -59,24 +63,27 @@ byte hpalignstr = "HEAPALLOCALIGN"
byte hpallocstr = "HEAPALLOC"
byte hprelstr = "HEAPRELEASE"
byte hpavlstr = "HEAPAVAIL"
byte memsetstr = "MEMSET"
word memsetstr = "MEMSET"
byte memcpystr = "MEMCPY"
byte uisgtstr = "ISUGT"
byte uisgestr = "ISUGE"
byte uisltstr = "ISULT"
byte uislestr = "ISULE"
byte sysmods[] // overlay with exported strings
byte strcpystr = "STRCPY"
byte strcatstr = "STRCAT"
byte sextstr = "SEXT"
byte divmodstr = "DIVMOD"
byte loadstr = "MODLOAD"
byte execstr = "MODEXEC"
byte modadrstr = "MODADDR"
byte argstr = "ARGS"
byte autorun = "AUTORUN"
byte prefix[] // overlay with exported symbols table
word exports = @sysstr, @syscall
word exports = @sysmodstr, @version
word = @sysstr, @syscall
word = @callstr, @call
word = @putcstr, @cout
word = @putlnstr, @crout
word = @putsstr, @prstr
word = @putbstr, @prbyte
word = @putwstr, @prword
word = @putistr, @print
word = @getcstr, @cin
word = @getsstr, @rdstr
@ -92,19 +99,34 @@ word = @uisgtstr, @uword_isgt
word = @uisgestr, @uword_isge
word = @uisltstr, @uword_islt
word = @uislestr, @uword_isle
word = @strcpystr, @strcpy
word = @strcatstr, @strcat
word = @sextstr, @sext
word = @divmodstr, @divmod
word = @loadstr, @loadmod
word = @execstr, @execmod
word = @modadrstr, @lookupstrmod
word = @machidstr, MACHID
word = @argstr, @cmdln
word = 0
word syslibsym = @exports
word sysmodsym = @exports
//
// System variable.
//
word systemflags = 0
byte perr
word heap
word xheap = $0800
word lastsym = symtbl
//
// Utility functions
//
//asm equates included from cmdstub.s
//
asm saveX#0
STX XREG+1
RTS
end
asm restoreX#0
XREG LDX #$00
RTS
end
// CALL PRODOS
// SYSCALL(CMD, PARAMS)
//
@ -335,10 +357,8 @@ asm memxcpy(dst,src,size)#0
RTS
end
asm crout()#0
DEX
LDA #$0D
BNE +
; FALL THROUGH TO COUT
LDA #$8D
BNE ++
end
//
// CHAR OUT
@ -350,10 +370,10 @@ asm cout(c)#0
BMI +
JSR TOUPR
+ ORA #$80
BIT ROMEN
INX
++ BIT ROMEN
JSR $FDED
BIT LCRDEN+LCBNK2
INX
RTS
end
//
@ -399,11 +419,20 @@ asm prstr(s)#0
RTS
end
//
// PRINT WORD
//
asm prword(w)#0
LDA ESTKH,X
JSR +
DEX
; FALL THROUGH TO PRBYTE
end
//
// PRINT BYTE
//
asm prbyte(b)#0
LDA ESTKL,X
STX ESP
+ STX ESP
BIT ROMEN
JSR $FDDA
LDX ESP
@ -412,22 +441,6 @@ asm prbyte(b)#0
RTS
end
//
// PRINT WORD
//
asm prword(w)#0
STX ESP
TXA
TAY
LDA ESTKH,Y
LDX ESTKL,Y
BIT ROMEN
JSR $F941
LDX ESP
BIT LCRDEN+LCBNK2
INX
RTS
end
//
// READ STRING
// STR = RDSTR(PROMPTCHAR)
//
@ -502,27 +515,15 @@ asm uword_islt(a,b)#1
RTS
end
asm divmod(a,b)#2
LDA #>(_divmod-1)
PHA
LDA #<(_divmod-1)
PHA
JSR $03D0 ; CALL DINTERP
!BYTE $0A, $5C ; MOD, RET
_divmod DEX
LDA DSTL ; DVDNDL
STA ESTKL,X
LDA DSTH ; DVDNDH
STA ESTKH,X
LSR DVSIGN ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1
BCS +
RTS
+ LDA #$00
; SEC
SBC ESTKL,X
STA ESTKL,X
LDA #$00
SBC ESTKH,X
STA ESTKH,X
JSR INTERP ; CALL INTERP
!BYTE $36, $5C ; DIVMOD, RET
end
asm sext(a)#1
LDY #$00
LDA ESTKL,X
BPL +
DEY
+ STY ESTKH,X
RTS
end
//
@ -622,43 +623,6 @@ TOUPR AND #$7F
RTS
end
//
// Module symbols are entered into the symbol table
// pre-pended with a '#' to differentiate them
// from normal symbols.
//
//def modtosym(mod, dci)
// byte len, c
// (dci).0 = '#'|$80
// len = 0
// repeat
// c = (mod).[len]
// len = len + 1
// (dci).[len] = c
// until !(c & $80)
// return dci
//end
asm modtosym(mod,dci)#1
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.
//
//def lookuptbl(dci, tbl)
@ -748,12 +712,12 @@ def setpfx(path)#1
perr = syscall($C6, @params)
return path
end
def open(path, buff)#1
def open(path)#1
byte params[6]
params.0 = 3
params:1 = path
params:3 = buff
params:3 = iobuffer
params.5 = 0
perr = syscall($C8, @params)
return params.5
@ -861,49 +825,44 @@ end
//
// Symbol table routines.
//
def lookupsym(sym)#1
return lookuptbl(sym, symtbl)
end
def addsym(sym, addr)#0
while ^sym & $80
^lastsym = ^sym
lastsym = lastsym + 1
sym = sym + 1
lastsym++
sym++
loop
lastsym->0 = ^sym
lastsym=>1 = addr
lastsym = lastsym + 3
^lastsym = 0
lastsym = lastsym + 3
^lastsym = 0
end
//
// String routines.
//
def strcpy(dst, src)#1
memcpy(dst+1, src+1, ^src)
^dst = ^src
return dst
end
def strcat(dst, src)#1
memcpy(dst + ^dst + 1, src + 1, ^src)
^dst = ^dst + ^src
return dst
end
//
// Module routines.
//
def lookupmod(mod)#1
byte dci[17]
return lookuptbl(modtosym(mod, @dci), symtbl)
end
def lookupstrmod(str)#1
byte mod[17]
stodci(str, @mod)
return lookupmod(@mod)
end
def addmod(mod, addr)#0
byte dci[17]
addsym(modtosym(mod, @dci), addr)
end
def lookupextern(esd, index)#1
word sym, addr
byte str[16]
while ^esd
sym = esd
esd = esd + dcitos(esd, @str)
esd = sym + dcitos(sym, @str)
if esd->0 & $10 and esd->1 == index
addr = lookupsym(sym)
addr = lookuptbl(sym, symtbl)
if !addr
perr = $81
cout('?')
prstr(@str)
crout
cout('?'); prstr(@str); crout
fin
return addr
fin
@ -935,24 +894,30 @@ def lookupdef(addr, deftbl)#1
return 0
end
def loadmod(mod)#1
word refnum, rdlen, modsize, bytecode, defofst, defcnt, init, fixup
word addr, defaddr, modaddr, modfix, modend
word rdlen, modsize, bytecode, codefix, defofst, defcnt, init, fixup
word addr, defaddr, modaddr, modfix, modofst, modend
word deftbl, deflast
word moddep, rld, esd, sym
byte defbank, str[16], filename[64]
byte refnum, defbank, str[16], filename[64]
byte header[128]
//
// Read the RELocatable module header (first 128 bytes)
//
dcitos(mod, @filename)
refnum = open(@filename, iobuffer)
if refnum > 0
refnum = open(@filename)
if !refnum
//
// Try system path
//
refnum = open(strcpy(@filename,strcat(strcpy(@header, @sysmods), @filename)))
fin
if refnum
rdlen = read(refnum, @header, 128)
modsize = header:0
moddep = @header.1
defofst = modsize
defofst = modsize + RELADDR
init = 0
if rdlen > 4 and header:2 == $DA7F // DAVE+1 = magic number :-)
if rdlen > 4 and header:2 == $6502 // DAVE+1 = magic number :-)
//
// This is an EXTended RELocatable (data+bytecode) module.
//
@ -965,7 +930,7 @@ def loadmod(mod)#1
// Load module dependencies.
//
while ^moddep
if !lookupmod(moddep)
if !lookuptbl(moddep, symtbl)
close(refnum)
refnum = 0
if loadmod(moddep) < 0
@ -984,11 +949,9 @@ def loadmod(mod)#1
//
// Reset read pointer.
//
refnum = open(@filename, iobuffer)
refnum = open(@filename)
rdlen = read(refnum, @header, 128)
fin
else
return -69
fin
//
// Alloc heap space for relocated module (data + bytecode).
@ -1002,7 +965,7 @@ def loadmod(mod)#1
//
// Read in remainder of module into memory for fixups.
//
addr = modaddr//
addr = modaddr
repeat
addr = addr + rdlen
rdlen = read(refnum, addr, 4096)
@ -1011,16 +974,17 @@ def loadmod(mod)#1
//
// Add module to symbol table.
//
addmod(mod, modaddr)
addsym(mod, modaddr)
//
// Apply all fixups and symbol import/export.
//
modfix = modaddr - modfix
bytecode = defofst + modfix - MODADDR
modofst = modfix - RELADDR
modend = modaddr + modsize
bytecode = defofst + modofst
rld = modend // Re-Locatable Directory
esd = rld // Extern+Entry Symbol Directory
while ^esd // Scan to end of ESD
while ^esd // Scan to end of ESD
esd = esd + 4
loop
esd = esd + 1
@ -1035,41 +999,46 @@ def loadmod(mod)#1
defbank = 0
defaddr = bytecode
fin
codefix = defaddr - bytecode
defofst = defaddr - defofst
//
// Run through the DeFinition Dictionary.
//
while ^rld == $02
//
// This is a bytcode def entry - add it to the def directory.
//
adddef(defbank, rld=>1 + defofst, @deflast)
rld = rld + 4
loop
//
// 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)
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.
fixup = ^addr
fin
if ^rld & $10 // EXTERN reference.
fixup = fixup + lookupextern(esd, rld->3)
else // INTERN fixup.
fixup = fixup + modfix - MODADDR
if uword_isge(fixup, bytecode)
//
// Bytecode address - replace with call def directory.
//
fixup = lookupdef(fixup - bytecode + defaddr, deftbl)
fin
fin
if ^rld & $80 // WORD sized fixup.
*addr = fixup
else // BYTE sized fixup.
^addr = fixup
addr = rld=>1 + modfix
//if uword_isge(addr, modaddr) // Skip fixups to header
//if type & $80 // WORD sized fixup.
fixup = *addr
//else // BYTE sized fixup.
// fixup = ^addr
//fin
if ^rld & $10 // EXTERN reference.
fixup = fixup + lookupextern(esd, rld->3)
else // INTERN fixup.
fixup = fixup + modofst
if uword_isge(fixup, bytecode)
//
// Bytecode address - replace with call def directory.
//
fixup = lookupdef(fixup + codefix, deftbl)
fin
fin
fin
//if type & $80 // WORD sized fixup.
*addr = fixup
//else // BYTE sized fixup.
// ^addr = fixup
//fin
//fin
rld = rld + 4
loop
//
@ -1082,12 +1051,12 @@ def loadmod(mod)#1
//
// EXPORT symbol - add it to the global symbol table.
//
addr = esd=>1 + modfix - MODADDR
addr = esd=>1 + modofst
if uword_isge(addr, bytecode)
//
// Use the def directory address for bytecode.
//
addr = lookupdef(addr - bytecode + defaddr, deftbl)
addr = lookupdef(addr + codefix, deftbl)
fin
addsym(sym, addr)
fin
@ -1104,19 +1073,27 @@ def loadmod(mod)#1
return -perr
fin
//
// Free up rld+esd (and bytecode on 128K) in main memory.
//
releaseheap(modend)
//
// Call init routine if it exists.
//
fixup = 0 // This is repurposed for the return code
if init
fixup = adddef(defbank, init - defofst + defaddr, @deflast)()
init = init + defofst
fixup = adddef(defbank, init, @deflast)()
if fixup < modinitkeep
//
// Free init routine unless initkeep
//
if defbank
xheap = init - defofst + defaddr
xheap = init
else
modend = init - defofst + defaddr
//
// Free up init code in main memory.
//
releaseheap(init)
fin
if fixup < 0
perr = -fixup
@ -1125,10 +1102,6 @@ def loadmod(mod)#1
fixup = fixup & ~modinitkeep
fin
fin
//
// Free up the end-of-module in main memory.
//
releaseheap(modend)
return fixup
end
//
@ -1169,7 +1142,7 @@ def catalog(optpath)#1
prstr(@path)
crout()
fin
refnum = open(@path, iobuffer)
refnum = open(@path)
if perr
return perr
fin
@ -1237,7 +1210,7 @@ def striptrail(strptr)#1
for i = 1 to ^strptr
if ^(strptr + i) <= ' '
^strptr = i - 1
return strptr
break
fin
next
return strptr
@ -1275,7 +1248,7 @@ def execsys(sysfile)#0
if ^sysfile
memcpy($280, sysfile, ^sysfile + 1)
striptrail(sysfile)
refnum = open(sysfile, iobuffer)
refnum = open(sysfile)
if refnum
len = read(refnum, databuff, $FFFF)
resetmemfiles()
@ -1318,34 +1291,34 @@ end
//
heap = *freemem
//
// Print PLASMA version
//
prstr("PLASMA Pre "); prbyte(version.1); cout('.'); prbyte(version.0); crout
//
// Init symbol table.
//
stodci(@syslibstr, heap)
addmod(heap, @version)
while *syslibsym
stodci(syslibsym=>0, heap)
addsym(heap, syslibsym=>2)
syslibsym = syslibsym + 4
while *sysmodsym
stodci(sysmodsym=>0, heap)
addsym(heap, sysmodsym=>2)
sysmodsym = sysmodsym + 4
loop
//
// Set system path
//
strcat(strcpy(@sysmods, $280), "SYS/")) // This is the path to CMD
syspath = @sysmods // Update external interface table
//
// Try to load autorun.
//
autorun = open(@autorun, iobuffer)
autorun = open(@autorun)
if autorun > 0
cmdln = read(autorun, @syslibstr, 128)
cmdln = read(autorun, @sysmodstr, 128)
close(autorun)
else
//
// Print some startup info.
//
prstr("PLASMA ")
prbyte(version.1)
cout('.')
prbyte(version.0)
crout
prstr("MEM FREE:$")
prword(availheap)
crout
prstr("MEM FREE:$"); prword(availheap); crout
fin
perr = 0
while 1
@ -1360,6 +1333,14 @@ while 1
is 'P'
setpfx(@cmdln)
break
is '/'
repeat
prefix--
until prefix[prefix] == '/'
if prefix > 1
setpfx(@prefix)
fin
break
is 'V'
volumes()
break
@ -1367,7 +1348,13 @@ while 1
execsys(@cmdln)
break
is '+'
saveX
execmod(striptrail(@cmdln))
//
// Clean up
//
restoreX
resetmemfiles
break
otherwise
cout('?')
@ -1382,6 +1369,6 @@ while 1
crout()
fin
prstr(getpfx(@prefix))
memcpy(@cmdln, rdstr($BA), 128)
strcpy(@cmdln, rdstr($BA))
loop
done

137
src/vmsrc/plvm.c
View File

@ -40,17 +40,47 @@ word *esp = eval_stack + EVAL_STACKSZ;
#define SYMTBLSZ 1024
#define SYMSZ 16
#define MODTBLSZ 128
#define MODSZ 16
#define MODLSTSZ 32
byte symtbl[SYMTBLSZ];
byte *lastsym = symtbl;
byte modtbl[MODTBLSZ];
byte *lastmod = modtbl;
/*
* Predef.
*/
void interp(code *ip);
/*
* CMDSYS exports
*/
char *syslib_exp[] = {
"CMDSYS",
"MACHID",
"PUTC",
"PUTLN",
"PUTS",
"PUTI",
"GETC",
"GETS",
"PUTB",
"PUTH",
"TOUPPER",
"CALL",
"SYSCALL",
"HEAPMARK",
"HEAPALLOCALLIGN",
"HEAPALLOC",
"HEAPRELEASE",
"HEAPAVAIL",
"MEMSET",
"MEMCPY",
"STRCPY",
"STRCAT",
"SEXT",
"DIVMOD",
"ISUGT",
"ISUGE",
"ISULT",
"ISULE",
0
};
/*
* Utility routines.
*
@ -181,19 +211,6 @@ uword add_sym(byte *sym, int addr)
/*
* Module routines.
*/
void dump_mod(void)
{
printf("\nSystem Module Table:\n");
dump_tbl(modtbl);
}
uword lookup_mod(byte *mod)
{
return lookup_tbl(mod, modtbl);
}
uword add_mod(byte *mod, int addr)
{
return add_tbl(mod, addr, &lastmod);
}
uword defcall_add(int bank, int addr)
{
mem_data[lastdef] = bank ? 2 : 1;
@ -204,7 +221,7 @@ uword defcall_add(int bank, int addr)
uword def_lookup(byte *cdd, int defaddr)
{
int i, calldef = 0;
for (i = 0; cdd[i * 4] == 0x02; i++)
for (i = 0; cdd[i * 4] == 0x00; i++)
{
if ((cdd[i * 4 + 1] | (cdd[i * 4 + 2] << 8)) == defaddr)
{
@ -263,7 +280,7 @@ int load_mod(byte *mod)
*/
while (*moddep)
{
if (lookup_mod(moddep) == 0)
if (lookup_sym(moddep) == 0)
{
if (fd)
{
@ -324,7 +341,7 @@ int load_mod(byte *mod)
/*
* Add module to symbol table.
*/
add_mod(mod, modaddr);
add_sym(mod, modaddr);
/*
* Print out the Re-Location Dictionary.
*/
@ -337,6 +354,7 @@ int load_mod(byte *mod)
if (show_state) printf("\tDEF CODE");
addr = rld[1] | (rld[2] << 8);
addr += modfix - MOD_ADDR;
rld[0] = 0; // Set call code to 0
rld[1] = addr;
rld[2] = addr >> 8;
end = rld - mem_data + 4;
@ -440,25 +458,29 @@ void call(uword pc)
char c, sz[64];
if (show_state)
printf("\nCall code:$%02X\n", mem_data[pc]);
printf("\nCall: %s\n", mem_data[pc] ? syslib_exp[mem_data[pc] - 1] : "BYTECODE");
switch (mem_data[pc++])
{
case 0: // NULL call
printf("NULL call code\n");
break;
case 1: // BYTECODE in mem_code
//interp(mem_code + (mem_data[pc] + (mem_data[pc + 1] << 8)));
break;
case 2: // BYTECODE in mem_data
case 0: // BYTECODE in mem_data
interp(mem_data + (mem_data[pc] + (mem_data[pc + 1] << 8)));
break;
case 1: // CMDSYS call
printf("CMD call code!\n");
break;
case 2: // MACHID
printf("MACHID call code!\n");
break;
case 3: // LIBRARY STDLIB::PUTC
c = POP;
if (c == 0x0D)
c = '\n';
putchar(c);
break;
case 4: // LIBRARY STDLIB::PUTS
case 4: // LIBRARY STDLIB::PUTNL
putchar('\n');
fflush(stdout);
break;
case 5: // LIBRARY STDLIB::PUTS
s = POP;
i = mem_data[s++];
while (i--)
@ -469,19 +491,14 @@ void call(uword pc)
putchar(c);
}
break;
case 5: // LIBRARY STDLIB::PUTSZ
s = POP;
while ((c = mem_data[s++]))
{
if (c == 0x0D)
c = '\n';
putchar(c);
}
case 6: // LIBRARY STDLIB::PUTI
i = POP;
printf("%d", i);
break;
case 6: // LIBRARY STDLIB::GETC
case 7: // LIBRARY STDLIB::GETC
PUSH(getchar());
break;
case 7: // LIBRARY STDLIB::GETS
case 8: // LIBRARY STDLIB::GETS
gets(sz);
for (i = 0; sz[i]; i++)
mem_data[0x200 + i] = sz[i];
@ -489,19 +506,8 @@ void call(uword pc)
mem_data[0x1FF] = i;
PUSH(i);
break;
case 8: // LIBRARY STDLIB::PUTNL
putchar('\n');
fflush(stdout);
break;
case 9: // LIBRARY STDLIB::MACHID
PUSH(0x0000);
break;
case 10: // LIBRARY STDLIB::PUTI
i = POP;
printf("%d", i);
break;
default:
printf("\nBad call code:$%02X\n", mem_data[pc - 1]);
printf("\nUnimplemented call code:$%02X\n", mem_data[pc - 1]);
exit(1);
}
}
@ -658,12 +664,9 @@ void interp(code *ip)
val = TOS;
PUSH(val);
break;
case 0x34: // PUSH : TOSP = TOS
val = esp - eval_stack;
PHA(val);
case 0x34: // NOP
break;
case 0x36: // PULL : TOS = TOSP
esp = eval_stack + PLA;
case 0x36: // NOP
break;
case 0x38: // BRGT : TOS-1 > TOS ? IP += (IP)
val = POP;
@ -873,22 +876,11 @@ void interp(code *ip)
*/
default:
fprintf(stderr, "Illegal opcode 0x%02X @ 0x%04X\n", ip[-1], ip - mem_data);
exit(-1);
}
}
}
char *syslib_exp[] = {
"PUTC",
"PUTS",
"PUTSZ",
"GETC",
"GETS",
"PUTLN",
"MACHID",
"PUTI",
0
};
int main(int argc, char **argv)
{
byte dci[32];
@ -906,17 +898,16 @@ int main(int argc, char **argv)
/*
* Add default library.
*/
stodci("CMDSYS", dci);
add_mod(dci, 0xFFFF);
for (i = 0; syslib_exp[i]; i++)
{
mem_data[i] = i + 3;
mem_data[i] = i;
stodci(syslib_exp[i], dci);
add_sym(dci, i);
add_sym(dci, i+1);
}
if (argc)
{
stodci(*argv, dci);
if (show_state) dump_sym();
load_mod(dci);
if (show_state) dump_sym();
argc--;

71
src/vmsrc/plvm01.s
View File

@ -10,6 +10,7 @@ SELFMODIFY = 1
;* VM ZERO PAGE LOCATIONS
;*
!SOURCE "vmsrc/plvmzp.inc"
DVSIGN = TMP+2
DROP = $EF
NEXTOP = $F0
FETCHOP = NEXTOP+3
@ -122,7 +123,7 @@ COMP LDA #$FF
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 DROP,DUP,NEXTOP,DIVMOD,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,CFFB ; 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
@ -130,25 +131,37 @@ OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0
;*
;* 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 ESTKL,X ; SAVE IN CASE OF DIVMOD
STA DSTL
LDA ESTKH,X
STA DSTH
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
;*
;* DIVMOD TOS-1 BY TOS
;*
DIVMOD JSR _DIV
LSR DVSIGN ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1
BCC +
INX
JSR _NEG
DEX
+ 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
;*
@ -393,18 +406,6 @@ DUP DEX
STA ESTKH,X
JMP NEXTOP
;*
;* PUSH EVAL STACK POINTER TO CALL STACK
;*
PUSHEP TXA
PHA
JMP NEXTOP
;*
;* PULL EVAL STACK POINTER FROM CALL STACK
;*
PULLEP PLA
TAX
JMP NEXTOP
;*
;* CONSTANT
;*
ZERO DEX
@ -875,15 +876,15 @@ BRGT INX
CMP ESTKL,X
LDA ESTKH-1,X
SBC ESTKH,X
BMI BRNCH
BPL NOBRNCH
BMI BRNCH
BRLT INX
LDA ESTKL,X
CMP ESTKL-1,X
LDA ESTKH,X
SBC ESTKH-1,X
BMI BRNCH
BPL NOBRNCH
BMI BRNCH
IBRNCH LDA IPL
CLC
ADC ESTKL,X
@ -937,8 +938,8 @@ ICALADR JSR $FFFF
STA IPH
PLA
STA IPL
LDY #$00
JMP NEXTOP
LDY #$01
JMP FETCHOP
;*
;* ENTER FUNCTION WITH FRAME SIZE AND PARAM COUNT
;*
@ -964,8 +965,8 @@ ENTER INY
DEY
STA (IFP),Y
BNE -
+ LDY #$02
JMP NEXTOP
+ LDY #$03
JMP FETCHOP
;*
;* LEAVE FUNCTION
;*

105
src/vmsrc/plvm02.s
View File

@ -40,7 +40,8 @@ ALTRDON = $C003
ALTWROFF= $C004
ALTWRON = $C005
!SOURCE "vmsrc/plvmzp.inc"
PSR = TMPH+1
PSR = TMP+2
DVSIGN = PSR+1
DROP = $EF
NEXTOP = $F0
FETCHOP = NEXTOP+3
@ -181,7 +182,7 @@ VMCORE = *
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 DROP,DUP,NEXTOP,DIVMOD,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,CFFB ; 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
@ -281,8 +282,8 @@ BYE LDY DEFCMD
STA STRBUF,Y
DEY
BPL -
INY ; CLEAR CMDLINE BUFF
STY $01FF
; INY ; CLEAR CMDLINE BUFF
; STY $01FF
CMDENTRY = *
;
; DEACTIVATE 80 COL CARDS
@ -338,8 +339,9 @@ CMDENTRY = *
;
; INIT VM ENVIRONMENT STACK POINTERS
;
; LDA #$00 ; INIT FRAME POINTER
STA PPL
; LDA #$00
STA $01FF ; CLEAR CMDLINE BUFF
STA PPL ; INIT FRAME POINTER
STA IFPL
LDA #$BF
STA PPH
@ -347,6 +349,13 @@ CMDENTRY = *
LDX #$FE ; INIT STACK POINTER (YES, $FE. SEE GETS)
TXS
LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX
;
; CHANGE CMD STRING TO SYSPATH STRING
;
LDA STRBUF
SEC
SBC #$03
STA STRBUF
JMP $2000 ; JUMP TO LOADED SYSTEM COMMAND
;
; PRINT FAIL MESSAGE, WAIT FOR KEYPRESS, AND REBOOT
@ -414,9 +423,9 @@ LCDEFCMD = *-28 ; DEFCMD IN LC MEMORY
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,PUSHEP,PULLEP,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E
!WORD DROP,DUP,NEXTOP,DIVMOD,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,CFFB; 50 52 54 56 58 5A 5C 5E
!WORD BRNCH,IBRNCH,CALLX,ICALX,ENTER,LEAVEX,RETX,CFFB ; 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
!WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E
;*
@ -535,8 +544,7 @@ _DIVLP ROL TMPL ; REMNDRL
ROL ESTKH+1,X ; DVDNDH
DEY
BNE _DIVLP
_DIVEX INX
LDY IPY
_DIVEX LDY IPY
RTS
;*
;* NEGATE TOS
@ -553,6 +561,7 @@ NEG LDA #$00
;* DIV TOS-1 BY TOS
;*
DIV JSR _DIV
INX
LSR DVSIGN ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1
BCS NEG
JMP NEXTOP
@ -560,10 +569,7 @@ DIV JSR _DIV
;* MOD TOS-1 BY TOS
;*
MOD JSR _DIV
LDA ESTKL,X ; SAVE IN CASE OF DIVMOD
STA DSTL
LDA ESTKH,X
STA DSTH
INX
LDA TMPL ; REMNDRL
STA ESTKL,X
LDA TMPH ; REMNDRH
@ -572,6 +578,22 @@ MOD JSR _DIV
BMI NEG
JMP NEXTOP
;*
;* DIVMOD TOS-1 BY TOS
;*
DIVMOD JSR _DIV
LSR DVSIGN ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1
BCC +
INX
JSR _NEG
DEX
+ LDA TMPL ; REMNDRL
STA ESTKL,X
LDA TMPH ; REMNDRH
STA ESTKH,X
LDA DVSIGN ; REMAINDER IS SIGN OF DIVIDEND
BMI NEG
JMP NEXTOP
;*
;* INCREMENT TOS
;*
INCR INC ESTKL,X
@ -719,18 +741,6 @@ DUP DEX
STA ESTKH,X
JMP NEXTOP
;*
;* PUSH EVAL STACK POINTER TO CALL STACK
;*
PUSHEP TXA
PHA
JMP NEXTOP
;*
;* PULL EVAL STACK POINTER FROM CALL STACK
;*
PULLEP PLA
TAX
JMP NEXTOP
;*
;* CONSTANT
;*
ZERO DEX
@ -1379,15 +1389,15 @@ BRGT INX
CMP ESTKL,X
LDA ESTKH-1,X
SBC ESTKH,X
BMI BRNCH
BPL NOBRNCH
BMI BRNCH
BRLT INX
LDA ESTKL,X
CMP ESTKL-1,X
LDA ESTKH,X
SBC ESTKH-1,X
BMI BRNCH
BPL NOBRNCH
BMI BRNCH
IBRNCH LDA IPL
CLC
ADC ESTKL,X
@ -1423,8 +1433,8 @@ CALL +INC_IP
BIT LCRWEN+LCBNK2
BIT LCRWEN+LCBNK2
}
LDY #$00
JMP NEXTOP
LDY #$01
JMP FETCHOP
;
CALLX +INC_IP
LDA (IP),Y
@ -1459,8 +1469,8 @@ CALLX +INC_IP
BIT LCRWEN+LCBNK2
BIT LCRWEN+LCBNK2
}
LDY #$00
JMP NEXTOP
LDY #$01
JMP FETCHOP
;*
;* INDIRECT CALL TO ADDRESS (NATIVE CODE)
;*
@ -1487,8 +1497,8 @@ ICAL LDA ESTKL,X
BIT LCRWEN+LCBNK2
BIT LCRWEN+LCBNK2
}
LDY #$00
JMP NEXTOP
LDY #$01
JMP FETCHOP
;
ICALX LDA ESTKL,X
STA TMPL
@ -1521,8 +1531,8 @@ ICALX LDA ESTKL,X
BIT LCRWEN+LCBNK2
BIT LCRWEN+LCBNK2
}
LDY #$00
JMP NEXTOP
LDY #$01
JMP FETCHOP
;*
;* JUMP INDIRECT TRHOUGH TMP
;*
@ -1532,7 +1542,6 @@ JMPTMP JMP (TMP)
;*
ENTER INY
LDA (IP),Y
PHA ; SAVE ON STACK FOR LEAVE
EOR #$FF ; ALLOCATE FRAME
SEC
ADC PPL
@ -1555,16 +1564,30 @@ ENTER INY
DEY
STA (IFP),Y
BNE -
+ LDY #$02
JMP NEXTOP
+ LDY #$03
JMP FETCHOP
;*
;* LEAVE FUNCTION
;*
LEAVEX STA ALTRDOFF
LEAVEX +INC_IP
LDA (IP),Y
STA ALTRDOFF
CLC
ADC IFPL
STA PPL
LDA #$00
ADC IFPH
STA PPH
PLA ; RESTORE PREVIOUS FRAME
STA IFPL
PLA
STA IFPH
LDA PSR
PHA
PLP
LEAVE PLA ; DEALLOCATE POOL + FRAME
RTS
LEAVE +INC_IP
LDA (IP),Y
CLC
ADC IFPL
STA PPL

51
src/vmsrc/plvm03.s
View File

@ -11,6 +11,7 @@ SELFMODIFY = 1
;
MEMBANK = $FFEF
!SOURCE "vmsrc/plvmzp.inc"
DVSIGN = TMP+2
DROP = $EF
NEXTOP = $F0
FETCHOP = NEXTOP+3
@ -227,7 +228,7 @@ _DIVEX INX
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 DROP,DUP,NEXTOP,DIVMOD,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,CFFB ; 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
@ -286,10 +287,6 @@ DIV JSR _DIV
;* MOD TOS-1 BY TOS
;*
MOD JSR _DIV
LDA ESTKL,X ; SAVE IN CASE OF DIVMOD
STA DSTL
LDA ESTKH,X
STA DSTH
LDA TMPL ; REMNDRL
STA ESTKL,X
LDA TMPH ; REMNDRH
@ -298,6 +295,22 @@ MOD JSR _DIV
BMI NEG
JMP NEXTOP
;*
;* DIVMOD TOS-1 BY TOS
;*
DIVMOD JSR _DIV
LSR DVSIGN ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1
BCC +
INX
JSR _NEG
DEX
+ 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
@ -501,18 +514,6 @@ DUP DEX
STA ESTKH,X
JMP NEXTOP
;*
;* PUSH EVAL STACK POINTER TO CALL STACK
;*
PUSHEP TXA
PHA
JMP NEXTOP
;*
;* PULL FROM CALL STACK TO EVAL STACK
;*
PULLEP PLA
TAX
JMP NEXTOP
;*
;* CONSTANT
;*
ZERO DEX
@ -1032,15 +1033,15 @@ BRGT INX
CMP ESTKL,X
LDA ESTKH-1,X
SBC ESTKH,X
BMI BRNCH
BPL NOBRNCH
BMI BRNCH
BRLT INX
LDA ESTKL,X
CMP ESTKL-1,X
LDA ESTKH,X
SBC ESTKH-1,X
BMI BRNCH
BPL NOBRNCH
BMI BRNCH
IBRNCH LDA IPL
CLC
ADC ESTKL,X
@ -1076,8 +1077,8 @@ CALLADR JSR $FFFF
STA IPH
PLA
STA IPL
LDY #$00
JMP NEXTOP
LDY #$01
JMP FETCHOP
;*
;* INDIRECT CALL TO ADDRESS (NATIVE CODE)
;*
@ -1102,8 +1103,8 @@ ICALADR JSR $FFFF
STA IPH
PLA
STA IPL
LDY #$00
JMP NEXTOP
LDY #$01
JMP FETCHOP
;*
;* ENTER FUNCTION WITH FRAME SIZE AND PARAM COUNT
;*
@ -1132,8 +1133,8 @@ ENTER INY
DEY
STA (IFP),Y
BNE -
+ LDY #$02
JMP NEXTOP
+ LDY #$03
JMP FETCHOP
;*
;* LEAVE FUNCTION
;*

187
src/vmsrc/plvm802.s
View File

@ -51,8 +51,8 @@ ALTRDON = $C003
ALTWROFF= $C004
ALTWRON = $C005
!SOURCE "vmsrc/plvmzp.inc"
HWSP = TMPH+1
PSR = HWSP+1
PSR = TMP+2
HWSP = PSR+1
DROP = $EF
NEXTOP = DROP+1
FETCHOP = NEXTOP+3
@ -129,11 +129,11 @@ BADCPU !TEXT "65C802/65C816 CPU REQUIRED.", 13
;*
;* INITIALIZE STACK
;*
INITSP LDX #$FE
TXS
LDX #$00
STX $01FF
;*
;INITSP LDX #$FE
; TXS
; LDX #$00
; STX $01FF
;*
;* DISCONNECT /RAM
;*
@ -246,7 +246,7 @@ VMCORE = *
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 DROP,DUP,NEXTOP,DIVMOD,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,CFFB ; 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
@ -361,8 +361,8 @@ BYE LDY DEFCMD
STA STRBUF,Y
DEY
BPL -
INY ; CLEAR CMDLINE BUFF
STY $01FF
; INY ; CLEAR CMDLINE BUFF
; STY $01FF
CMDENTRY = *
;
; DEACTIVATE 80 COL CARDS
@ -425,8 +425,9 @@ CMDENTRY = *
;
; INIT VM ENVIRONMENT STACK POINTERS
;
; LDA #$00 ; INIT FRAME POINTER
STA PPL
; LDA #$00
STA $01FF ; CLEAR CMDLINE BUFF
STA PPL ; INIT FRAME POINTER
STA IFPL
LDA #$BF
STA PPH
@ -434,6 +435,13 @@ CMDENTRY = *
LDX #$FE ; INIT STACK POINTER (YES, $FE. SEE GETS)
TXS
LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX
;
; CHANGE CMD STRING TO SYSPATH STRING
;
LDA STRBUF
SEC
SBC #$03
STA STRBUF
JMP $2000 ; JUMP TO LOADED SYSTEM COMMAND
;
; PRINT FAIL MESSAGE, WAIT FOR KEYPRESS, AND REBOOT
@ -510,7 +518,7 @@ LCDEFCMD = *-28 ; DEFCMD IN LC MEMORY
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,PUSHEP,PULLEP,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E
!WORD DROP,DUP,NEXTOP,DIVMOD,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,CFFB ; 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
@ -584,14 +592,14 @@ _DIV STY IPY
_DIV1 ASL ; DVDND
DEY
BCC _DIV1
STA TMP ;NOS,S ; DVDND
STA TMP ; NOS,S ; DVDND
LDA #$0000 ; REMNDR
_DIVLP ROL ; REMNDR
CMP TOS+2,S ; DVSR
BCC +
SBC TOS+2,S ; DVSR
SEC
+ ROL TMP ;NOS,S ; DVDND
+ ROL TMP ; NOS,S ; DVDND
DEY
BNE _DIVLP
_DIVEX LDY IPY
@ -603,7 +611,7 @@ DIV JSR _DIV
LDA TMP
STA NOS,S
PLA
TXA
TXA ; DIVSGN
LSR ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1
BCS NEG
JMP NEXTOP
@ -613,11 +621,47 @@ DIV JSR _DIV
MOD JSR _DIV
STA NOS,S ; REMNDR
PLA
STA DST ; SAVE IN CASE OF DIVMOD
STX DVSIGN
TXA
AND #$0080 ; REMAINDER IS SIGN OF DIVIDEND
BNE NEG
CPX #$80 ; DIVSGN
BCS NEG ; REMAINDER IS SIGN OF DIVIDEND
JMP NEXTOP
;*
;* DIVMOD TOS-1 BY TOS - !!!HACK!!! MUST COPY ESTK TO HW STACK
;*
DIVMOD +ACCMEM8
LDX ESP
LDA ESTKH+1,X
PHA
LDA ESTKL+1,X
PHA
LDA ESTKH,X
PHA
LDA ESTKL,X
PHA
+ACCMEM16
JSR _DIV
CPX #$80 ; DIVSGN
BCC + ; REMAINDER IS SIGN OF DIVIDEND
EOR #$FFFF
INC
+ STA TOS,S ; REMNDR
TXA ; DIVSGN
LSR ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1
LDA TMP
BCC +
EOR #$FFFF
INC
+ STA NOS,S ; DVDND
+ACCMEM8
LDX ESP
PLA
STA ESTKL,X
PLA
STA ESTKH,X
PLA
STA ESTKL+1,X
PLA
STA ESTKH+1,X
+ACCMEM16
JMP NEXTOP
;*
;* NEGATE TOS
@ -729,55 +773,6 @@ DUP LDA TOS,S
PHA
JMP NEXTOP
;*
;* PRIVATE EP STASH
;*
EPSAVE !BYTE $01 ; INDEX INTO STASH ARRAY (16 SHOULD BE ENOUGH)
!WORD $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000
!WORD $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000
;*
;* PUSH EVAL STACK POINTER TO PRIVATE STASH
;*
PUSHEP LDX LCRWEN+LCBNK2 ; RWEN LC MEM
LDX LCRWEN+LCBNK2
LDX EPSAVE
TSC
STA EPSAVE,X
INX
INX
!IF DEBUG {
CPX #33
BCC +
LDX #$80+'>'
STX $7D0+30
- BRA -
LDX #$32
+
}
STX EPSAVE
LDX LCRDEN+LCBNK2 ; REN LC MEM
JMP NEXTOP
;*
;* PULL EVAL STACK POINTER FROM PRIVATE STASH
;*
PULLEP LDX LCRWEN+LCBNK2 ; RWEN LC MEM
LDX LCRWEN+LCBNK2
LDX EPSAVE
DEX
DEX
!IF DEBUG {
BPL +
LDX #$80+'<'
STX $7D0+30
- BRA -
LDX #$00
+
}
LDA EPSAVE,X
TCS
STX EPSAVE
LDX LCRDEN+LCBNK2 ; REN LC MEM
JMP NEXTOP
;*
;* CONSTANT
;*
ZERO PEA $0000
@ -1287,8 +1282,8 @@ BRGT PLA
SEC
SBC TOS,S
BVS +
BMI BRNCH
BPL NOBRNCH
BMI BRNCH
+ BMI NOBRNCH
BPL BRNCH
BRLT PLA
@ -1420,8 +1415,8 @@ EMUSTK STA TMP
LDX LCRWEN+LCBNK2
LDX LCRWEN+LCBNK2
}
LDY #$00
JMP NEXTOP
LDY #$01
JMP FETCHOP
;*
;* CALL INTO ABSOLUTE ADDRESS (NATIVE CODE)
;*
@ -1538,8 +1533,8 @@ EMUSTKX STA TMP
LDX LCRWEN+LCBNK2
LDX LCRWEN+LCBNK2
}
LDY #$00
JMP NEXTOP
LDY #$01
JMP FETCHOP
;*
;* JUMP INDIRECT THROUGH TMP
;*
@ -1548,20 +1543,17 @@ JMPTMP JMP (TMP)
;* ENTER FUNCTION WITH FRAME SIZE AND PARAM COUNT
;*
ENTER INY
TYA ; QUICKY CLEAR OUT MSB
+ACCMEM8 ; 8 BIT A/M
LDA (IP),Y
AND #$00FF
!IF DEBUG {
+ACCMEM8 ; 8 BIT A/M
PHA
CLC
ADC #$80+'0'
STA $7D0+31
PLA
}
PHA ; SAVE ON STACK FOR LEAVE
DEC HWSP ; UPDATE HWSP TO SKIP FRAME SIZE
+ACCMEM16 ; 16 BIT A/M
; AND #$00FF
}
EOR #$FFFF ; ALLOCATE FRAME
SEC
ADC PP
@ -1584,13 +1576,20 @@ ENTER INY
BNE -
STX ESP
+ +ACCMEM16 ; 16 BIT A/M
LDY #$02
JMP NEXTOP
LDY #$03
JMP FETCHOP
;*
;* LEAVE FUNCTION
;*
LEAVEX STX ALTRDOFF
LEAVE +ACCMEM8 ; 8 BIT A/M
LEAVEX +INC_IP
+ACCMEM8 ; 8 BIT A/M
LDA (IP),Y ; DEALLOCATE POOL + FRAME
STA ALTRDOFF
BRA +
LEAVE +INC_IP
+ACCMEM8 ; 8 BIT A/M
LDA (IP),Y ; DEALLOCATE POOL + FRAME
+ STA TMPL
TSC ; MOVE HW EVAL STACK TO ZP EVAL STACK
EOR #$FF
SEC
@ -1616,8 +1615,7 @@ LEAVE +ACCMEM8 ; 8 BIT A/M
INX
+ CPX ESP
BNE -
!IF DEBUG {
STX TMPL
!IF DEBUG {
TSX
CPX HWSP
BEQ +
@ -1626,10 +1624,10 @@ LEAVE +ACCMEM8 ; 8 BIT A/M
- LDX $C000
BPL -
LDX $C010
+ LDX TMPL
+
}
TYX ; RESTORE NEW ESP
PLA ; DEALLOCATE POOL + FRAME
LDA TMPL ; DEALLOCATE POOL + FRAME
+ACCMEM16 ; 16 BIT A/M
AND #$00FF
CLC
@ -1639,10 +1637,12 @@ LEAVE +ACCMEM8 ; 8 BIT A/M
STA IFP
SEC ; SWITCH TO EMULATED MODE
XCE
!AS
LDA PSR
PHA
PLP
RTS
+ACCMEM16 ; 16 BIT A/M
;
RETX STX ALTRDOFF
RET +ACCMEM8 ; 8 BIT A/M
@ -1672,19 +1672,18 @@ RET +ACCMEM8 ; 8 BIT A/M
+ CPX ESP
BNE -
!IF DEBUG {
STX TMPL
TSX
CPX HWSP
BEQ +
LDX #$80+'R'
LDX #$80+'X'
STX $7D0+30
- LDX $C000
BPL -
LDX $C010
+ LDX TMPL
+
}
TYX
+ACCMEM16 ; 16 BIT A/M
+ACCMEM16
LDA IFP ; DEALLOCATE POOL
STA PP
PLA ; RESTORE PREVIOUS FRAME
@ -1870,7 +1869,7 @@ STEP STX TMPL
CMP #$10
BCC DBGKEY
; LDX TMPL
; CPX #$56 ; FORCE PAUSE AT 'ICAL'
; CPX #$54 ; FORCE PAUSE AT 'CALL'
; BEQ DBGKEY
- LDX $C000
CPX #$9B

9
src/vmsrc/plvmzp.inc
View File

@ -17,17 +17,14 @@ ESTK = $C0
ESTKL = ESTK
ESTKH = ESTK+ESTKSZ/2
VMZP = ESTK+ESTKSZ
ESP = VMZP
DVSIGN = VMZP
IFP = ESP+1
IFP = VMZP
IFPL = IFP
IFPH = IFP+1
PP = IFP+2
PPL = PP
PPH = PP+1
IPY = PP+2
TMP = IPY+1
ESP = IPY+1
TMP = ESP+1
TMPL = TMP
TMPH = TMP+1
NPARMS = TMPL
FRMSZ = TMPH

289
src/vmsrc/soscmd.pla
View File

@ -1,5 +1,5 @@
const membank = $FFEF
const MODADDR = $1000
const RELADDR = $1000
//
// System flags: memory allocator screen holes.
//
@ -29,20 +29,17 @@ predef syscall(cmd,params)#1, call(addr,areg,xreg,yreg,status)#1
predef crout()#0, cout(c)#0, prstr(s)#0, print(i)#0, cin()#1, rdstr(p)#1, toupper(c)#1
predef markheap()#1, allocheap(size)#1, allocalignheap(size, pow2, freeaddr), releaseheap(newheap)#1, availheap()#1
predef memset(addr,value,size)#0, memcpy(dst,src,size)#0
predef uword_isgt(a,b)#1, uword_isge(a,b)#1, uword_islt(a,b)#1, uword_isle(a,b)#1, divmod(a,b)#2
predef loadmod(mod)#1, execmod(modfile)#1, lookupstrmod(str)#1
predef uword_isgt(a,b)#1, uword_isge(a,b)#1, uword_islt(a,b)#1, uword_isle(a,b)#1, sext(a)#1, divmod(a,b)#2
predef execmod(modfile)#1
//
// System variables.
//
word version = $0099 // 00.99
word systemflags = 0
word version = $0100 // 01.00
word syspath
word cmdptr
word = @execmod
byte refcons = 0
byte devcons = 0
word heap = $2000
byte modid = 0
byte modseg[15]
word symtbl, lastsym
byte perr, terr, lerr
//
// String pool.
//
@ -55,13 +52,9 @@ byte hexchar[] = '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E',
//
byte machid = $F2 // Apple ///, 80 columns
//
// Command line pointer
//
word cmdptr
//
// Standard Library exported functions.
//
byte syslibstr[] = "CMDSYS"
byte sysmodstr[] = "CMDSYS"
byte machidstr[] = "MACHID"
byte sysstr[] = "SYSCALL"
byte callstr[] = "CALL"
@ -83,13 +76,15 @@ byte uisgtstr[] = "ISUGT"
byte uisgestr[] = "ISUGE"
byte uisltstr[] = "ISULT"
byte uislestr[] = "ISULE"
byte sysmods[] // overlay with exported strings
byte sextstr[] = "SEXT"
byte divmodstr[] = "DIVMOD"
byte loadstr[] = "MODLOAD"
byte execstr[] = "MODEXEC"
byte modadrstr[] = "MODADDR"
byte argstr[] = "ARGS"
byte modadrstr[] = "RELADDR"
byte prefix[] // Overlay with exported symbols table
word exports[] = @sysstr, @syscall
word exports[] = @sysmodstr, @version
word = @sysstr, @syscall
word = @callstr, @call
word = @putcstr, @cout
word = @putlnstr, @crout
@ -109,14 +104,20 @@ word = @uisgtstr, @uword_isgt
word = @uisgestr, @uword_isge
word = @uisltstr, @uword_islt
word = @uislestr, @uword_isle
word = @sextstr, @sext
word = @divmodstr, @divmod
word = @loadstr, @loadmod
word = @execstr, @execmod
word = @modadrstr, @lookupstrmod
word = @machidstr, @machid
word = @argstr, @cmdptr
word = 0
word syslibsym = @exports
word sysmodsym = @exports
//
// System variables.
//
word systemflags = 0
word heap = $2000
byte modid = 0
byte modseg[15]
word symtbl, lastsym
byte perr, terr, lerr
//
// CALL SOS
// SYSCALL(CMD, PARAMS)
@ -413,27 +414,15 @@ asm uword_islt(a,b)#1
RTS
end
asm divmod(a,b)#2
LDA #>(_divmod-1)
PHA
LDA #<(_divmod-1)
PHA
JSR INTERP
!BYTE $0A, $5C ; MOD, RET
_divmod DEX
LDA DSTL ; DVDNDL
STA ESTKL,X
LDA DSTH ; DVDNDH
STA ESTKH,X
LSR DVSIGN ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1
BCS +
RTS
+ LDA #$00
; SEC
SBC ESTKL,X
STA ESTKL,X
LDA #$00
SBC ESTKH,X
STA ESTKH,X
JSR INTERP ; CALL INTERP
!BYTE $36, $5C ; DIVMOD, RET
end
asm sext(a)#1
LDY #$00
LDA ESTKL,X
BPL +
DEY
+ STY ESTKH,X
RTS
end
//
@ -557,27 +546,27 @@ end
// until !(c & $80)
// return dci
//end
asm modtosym(mod, dci)#1
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
//asm modtosym(mod, dci)#1
// 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.
//
@ -900,9 +889,6 @@ end
//
// Symbol table routines.
//
def lookupsym(sym)#1
return lookuptbl(sym, symtbl)
end
def addsym(sym, addr)#0
while ^sym & $80
xpokeb(symtbl.0, lastsym, ^sym)
@ -916,29 +902,37 @@ def addsym(sym, addr)#0
lastsym = lastsym + 3
end
//
// String routines.
//
def strcpy(dst, src)#1
memcpy(dst+1, src+1, ^src)
^dst = ^src
return dst
end
def strcat(dst, src)#1
memcpy(dst + ^dst + 1, src + 1, ^src)
^dst = ^dst + ^src
return dst
end
//
// Module routines.
//
def lookupmod(mod)#1
byte dci[17]
return lookuptbl(modtosym(mod, @dci), symtbl)
end
def lookupstrmod(str)#1
byte mod[17]
stodci(str, @mod)
return lookupmod(@mod)
end
def addmod(mod, addr)#0
byte dci[17]
addsym(modtosym(mod, @dci), addr)
end
//def lookupmod(mod)#1
// byte dci[17]
// return lookuptbl(modtosym(mod, @dci), symtbl)
//end
//def addmod(mod, addr)#0
// byte dci[17]
// addsym(modtosym(mod, @dci), addr)
//end
def lookupextern(esd, index)#1
word sym, addr
byte str[16]
while ^esd
sym = esd
esd = esd + dcitos(esd, @str)
esd = sym + dcitos(sym, @str)
if esd->0 & $10 and esd->1 == index
addr = lookupsym(sym)
addr = lookuptbl(sym, symtbl)
if !addr
lerr = $81
cout('?')
@ -971,8 +965,8 @@ def lookupdef(addr, deftbl)#1
return 0
end
def loadmod(mod)#1
word refnum, rdlen, modsize, bytecode, defofst, defcnt, init, fixup
word addr, defaddr, modaddr, modfix, modend
word refnum, rdlen, modsize, bytecode, codefix, defofst, defcnt, init, fixup
word addr, defaddr, modaddr, modfix, modofst, modend
word deftbl, deflast, codeseg
word moddep, rld, esd, sym
byte defext, str[16], filename[33]
@ -983,12 +977,18 @@ def loadmod(mod)#1
//
dcitos(mod, @filename)
refnum = open(@filename)
if refnum > 0
if !refnum
//
// Try system path
//
refnum = open(strcpy(@filename,strcat(strcpy(@header, @sysmods), @filename)))
fin
if refnum
rdlen = read(refnum, @header, 128)
modsize = header:0
//moddep = @header.1
//defofst = modsize
//init = 0
moddep = @header.1
defofst = modsize + RELADDR
init = 0
if rdlen > 4 and header:2 == $DA7F // DAVE+1 = magic number :-)
//
// This is an EXTended RELocatable (data+bytecode) module.
@ -1002,7 +1002,7 @@ def loadmod(mod)#1
// Load module dependencies.
//
while ^moddep
if !lookupmod(moddep)
if !lookuptbl(moddep, symtbl)
if refnum
close(refnum)
refnum = 0
@ -1026,8 +1026,6 @@ def loadmod(mod)#1
refnum = open(@filename)
rdlen = read(refnum, @header, 128)
fin
else
return -69
fin
//
// Alloc heap space for relocated module (data + bytecode).
@ -1050,13 +1048,14 @@ def loadmod(mod)#1
//
// Add module to symbol table.
//
addmod(mod, modaddr)
addsym(mod, modaddr)
//
// Apply all fixups and symbol import/export.
//
modfix = modaddr - modfix
bytecode = defofst + modfix - MODADDR
modofst = modfix - RELADDR
modend = modaddr + modsize
bytecode = defofst + modofst
rld = modend // Re-Locatable Directory
esd = rld // Extern+Entry Symbol Directory
while ^esd // Scan to end of ESD
@ -1073,40 +1072,45 @@ def loadmod(mod)#1
modid = modid + 1
defext = (codeseg.0 | $80) - 1
defaddr = (codeseg & $FF00) + $6000
codefix = defaddr - bytecode
defofst = defaddr - defofst
//
// Run through the DeFinition Dictionary.
//
while ^rld == $02
//
// This is a bytcode def entry - add it to the def directory.
//
adddef(defext, rld=>1 + defofst, @deflast)
rld = rld + 4
loop
//
// Run through the Re-Location Dictionary.
//
while ^rld
if ^rld == $02
//
// 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.
fixup = ^addr
fin
if ^rld & $10 // EXTERN reference.
fixup = fixup + lookupextern(esd, rld->3)
else // INTERN fixup.
fixup = fixup + modfix - MODADDR
if uword_isge(fixup, bytecode)
//
// Bytecode address - replace with call def directory.
//
fixup = lookupdef(fixup - bytecode + defaddr, deftbl)
fin
fin
if ^rld & $80 // WORD sized fixup.
*addr = fixup
else // BYTE sized fixup.
^addr = fixup
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.
// fixup = ^addr
//fin
if ^rld & $10 // EXTERN reference.
fixup = fixup + lookupextern(esd, rld->3)
else // INTERN fixup.
fixup = fixup + modofst
if uword_isge(fixup, bytecode)
//
// Bytecode address - replace with call def directory.
//
fixup = lookupdef(fixup + codefix, deftbl)
fin
fin
//if ^rld & $80 // WORD sized fixup.
*addr = fixup
//else // BYTE sized fixup.
// ^addr = fixup
//fin
fin
rld = rld + 4
loop
@ -1120,12 +1124,12 @@ def loadmod(mod)#1
//
// EXPORT symbol - add it to the global symbol table.
//
addr = esd=>1 + modfix - MODADDR
addr = esd=>1 + modofst
if uword_isge(addr, bytecode)
//
// Use the def directory address for bytecode.
//
addr = lookupdef(addr - bytecode + defaddr, deftbl)
addr = lookupdef(addr + codefix, deftbl)
fin
addsym(sym, addr)
fin
@ -1152,7 +1156,7 @@ def loadmod(mod)#1
//
fixup = 0
if init
fixup = adddef(defext, init - defofst + defaddr, @deflast)()
fixup = adddef(defext, init + defofst, @deflast)()
if fixup < 0
perr = -fixup
fin
@ -1259,15 +1263,16 @@ def stripspaces(strptr)#0
^strptr = ^strptr - 1
loop
end
def striptrail(strptr)#0
def striptrail(strptr)#1
byte i
for i = 1 to ^strptr
if (strptr)[i] <= ' '
^strptr = i - 1
return
break
fin
next
return strptr
end
def parsecmd(strptr)#1
byte cmd
@ -1311,19 +1316,26 @@ end
//
init_cons
//
// Print PLASMA version
//
prstr("PLASMA "); prbyte(version.1); cout('.'); prbyte(version.0); crout
//
// Init 2K symbol table.
//
seg_find($00, @symtbl, @lastsym, $08, $11)
lastsym = symtbl & $FF00
xpokeb(symtbl.0, lastsym, 0)
stodci(@syslibstr, heap)
addmod(heap, @version)
while *syslibsym
stodci(syslibsym=>0, heap)
addsym(heap, syslibsym=>2)
syslibsym = syslibsym + 4
while *sysmodsym
stodci(sysmodsym=>0, heap)
addsym(heap, sysmodsym=>2)
sysmodsym = sysmodsym + 4
loop
//
// Clear system path
//
sysmods = 0
syspath = @sysmods
//
// Try to load autorun.
//
cmdptr = heap
@ -1336,11 +1348,6 @@ else
//
// Print some startup info.
//
prstr("PLASMA ")
prbyte(version.1)
cout('.')
prbyte(version.0)
crout
prstr("MEM:$")
prword(availheap)
crout
@ -1360,11 +1367,15 @@ while 1
is 'P'
setpfx(cmdptr)
break
is 'S'
setpfx(cmdptr)
strcat(getpfx(@sysmods), "SYS/"))
break
is 'V'
volumes
break
is '+'
execmod(cmdptr)
execmod(striptrail(cmdptr))
write(refcons, @textmode, 3)
break
otherwise

9
sysfiles/filetype_extensions.conf Normal file
View File

@ -0,0 +1,9 @@
# Filetype extension configuration file for Geany
# Insert as many items as you want, separate them with a ";".
# See Geany's main documentation for details.
[Extensions]
PLASMA=*.pla;*.plh;
# Note: restarting is required after editing groups
[Groups]
Programming=PLASMA;

86
sysfiles/filetypes.plasma.conf Executable file
View File

@ -0,0 +1,86 @@
# For complete documentation of this file, please see Geany's main documentation
[styling]
# Edit these in the colorscheme .conf file instead
default=default
commentline=comment_line
number=number_1
string=string_1
character=character
word=keyword_1
global=type
symbol=preprocessor
classname=class
defname=function
operator=operator
identifier=identifier_1
modulename=type
backticks=backticks
instancevar=default
classvar=default
datasection=default
heredelim=operator
worddemoted=keyword_1
stdin=default
stdout=default
stderr=default
regex=regex
here_q=here_doc
here_qq=here_doc
here_qx=here_doc
string_q=string_2
string_qq=string_2
string_qx=string_2
string_qr=string_2
string_qw=string_2
upper_bound=default
error=error
pod=comment_doc
[keywords]
# all items must be in one line
primary=done include import export struc const word byte var char res and predef asm def end not or repeat until continue break for to downto next step when wend is otherwise if else elsif fin while loop return
[settings]
# default extension used when saving files
extension=pla
# MIME type
mime_type=application/x-plasma
# the following characters are these which a "word" can contains, see documentation
$wordchars=$_abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789
# single comments, like # in this file
comment_single=//
# multiline comments
#comment_open==begin
#comment_close==end
# set to false if a comment character/string should start at column 0 of a line, true uses any
# indentation of the line, e.g. setting to true causes the following on pressing CTRL+d
#command_example();
# setting to false would generate this
# command_example();
# This setting works only for single line comments
comment_use_indent=true
# context action command (please see Geany's main documentation for details)
context_action_cmd=
lexer_filetype=C
[indentation]
width=4
# 0 is spaces, 1 is tabs, 2 is tab & spaces
type=0
[build-menu]
# %f will be replaced by the complete filename
# %e will be replaced by the filename without extension
# (use only one of it at one time)
FT_00_LB=_Compile
FT_00_CM=plasm -AMOW < "%f"
FT_00_WD=
EX_00_LB=_Execute
EX_00_CM=plvm "%f#FE1000"
EX_00_WD=