mirror of
https://github.com/dschmenk/PLASMA.git
synced 2024-08-21 06:29:07 +00:00
Merge pull request #7 from dschmenk/master
Merge latest upstream changes
This commit is contained in:
commit
9174cfef2a
BIN
PLASMA-BLD1.PO
Normal file
BIN
PLASMA-BLD1.PO
Normal file
Binary file not shown.
BIN
PLASMA-PRE1.PO
Normal file
BIN
PLASMA-PRE1.PO
Normal file
Binary file not shown.
95
README.md
95
README.md
@ -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
|
||||
|
@ -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
423
doc/PLASMA123.md
@ -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
|
||||
| | | 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
40
doc/Preview Version 1.0.md
Normal 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.
|
@ -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
|
||||
| | | 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
|
||||
| || | 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
|
||||
```
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
//
|
||||
|
@ -112,5 +112,4 @@ struc t_fpu
|
||||
word randNum
|
||||
end
|
||||
const dropX = shiftDown // Alias dropX and shiftDown
|
||||
word fpu
|
||||
end
|
||||
|
@ -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
4
src/inc/longjmp.plh
Normal file
@ -0,0 +1,4 @@
|
||||
import longjmp
|
||||
const t_except = $0140
|
||||
predef except(env), throw(env, retval)
|
||||
end
|
@ -142,5 +142,4 @@ struc t_sane
|
||||
word saveZP
|
||||
word restoreZP
|
||||
end
|
||||
word sane
|
||||
end
|
||||
|
@ -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
|
||||
|
@ -4,5 +4,5 @@ import testlib
|
||||
const hex = 2
|
||||
const newln = 4
|
||||
const str = 6
|
||||
const char = 8
|
||||
const chr = 8
|
||||
end
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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]
|
||||
|
||||
|
@ -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
67
src/libsrc/longjmp.pla
Normal 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
|
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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
27
src/makefile
@ -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)
|
||||
|
@ -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,4 +1,3 @@
|
||||
include "inc/cmdsys.plh"
|
||||
|
||||
puts("Hello, world.\n")
|
||||
done
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
//
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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])
|
||||
|
@ -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;
|
||||
|
@ -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
947
src/toolsrc/codegen.pla
Normal 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
453
src/toolsrc/codeopt.pla
Normal 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
91
src/toolsrc/codeseq.plh
Normal 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
|
File diff suppressed because it is too large
Load Diff
@ -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
378
src/toolsrc/lex.pla
Normal 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
|
@ -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
1243
src/toolsrc/parse.pla
Normal file
File diff suppressed because it is too large
Load Diff
504
src/toolsrc/plasm.pla
Normal file
504
src/toolsrc/plasm.pla
Normal 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
|
@ -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
|
||||
|
File diff suppressed because it is too large
Load Diff
@ -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)
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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
137
src/vmsrc/plvm.c
@ -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--;
|
||||
|
@ -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
|
||||
;*
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
;*
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
9
sysfiles/filetype_extensions.conf
Normal 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
86
sysfiles/filetypes.plasma.conf
Executable 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=
|
Loading…
Reference in New Issue
Block a user