diff --git a/PLASMA-BLD1.PO b/PLASMA-BLD1.PO new file mode 100644 index 0000000..19cdfc7 Binary files /dev/null and b/PLASMA-BLD1.PO differ diff --git a/PLASMA-PRE1.PO b/PLASMA-PRE1.PO new file mode 100644 index 0000000..35ca3c7 Binary files /dev/null and b/PLASMA-PRE1.PO differ diff --git a/README.md b/README.md index 58f38e0..06520e8 100755 --- a/README.md +++ b/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 diff --git a/doc/Architecture.md b/doc/Architecture.md deleted file mode 100644 index 385f81d..0000000 --- a/doc/Architecture.md +++ /dev/null @@ -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. diff --git a/doc/PLASMA123.md b/doc/PLASMA123.md deleted file mode 100644 index db39ed0..0000000 --- a/doc/PLASMA123.md +++ /dev/null @@ -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 diff --git a/doc/Preview Version 1.0.md b/doc/Preview Version 1.0.md new file mode 100644 index 0000000..b67c9ea --- /dev/null +++ b/doc/Preview Version 1.0.md @@ -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 \ | change to Prefix +| / | change to parent prefix +| V | show online Volumes +| -\ | launch SYSTEM program +| +\ | exec PLASMA module +``` +[Optional 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. diff --git a/doc/User Manual.md b/doc/User Manual.md deleted file mode 100644 index 326a96e..0000000 --- a/doc/User Manual.md +++ /dev/null @@ -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 \ [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 -``` diff --git a/src/inc/cmdsys.plh b/src/inc/cmdsys.plh index 0046e36..a5bb328 100644 --- a/src/inc/cmdsys.plh +++ b/src/inc/cmdsys.plh @@ -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 diff --git a/src/inc/conio.plh b/src/inc/conio.plh index 72eabc7..58c5590 100644 --- a/src/inc/conio.plh +++ b/src/inc/conio.plh @@ -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 diff --git a/src/inc/fileio.plh b/src/inc/fileio.plh index 51da5b8..d759ecc 100644 --- a/src/inc/fileio.plh +++ b/src/inc/fileio.plh @@ -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 // diff --git a/src/inc/fpu.plh b/src/inc/fpu.plh index 76a5572..90de2d0 100644 --- a/src/inc/fpu.plh +++ b/src/inc/fpu.plh @@ -112,5 +112,4 @@ struc t_fpu word randNum end const dropX = shiftDown // Alias dropX and shiftDown -word fpu end diff --git a/src/inc/inet.plh b/src/inc/inet.plh index 2e68f3e..f631bc6 100644 --- a/src/inc/inet.plh +++ b/src/inc/inet.plh @@ -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 diff --git a/src/inc/longjmp.plh b/src/inc/longjmp.plh new file mode 100644 index 0000000..466bbae --- /dev/null +++ b/src/inc/longjmp.plh @@ -0,0 +1,4 @@ +import longjmp + const t_except = $0140 + predef except(env), throw(env, retval) +end diff --git a/src/inc/sane.plh b/src/inc/sane.plh index 5637360..61f2334 100644 --- a/src/inc/sane.plh +++ b/src/inc/sane.plh @@ -142,5 +142,4 @@ struc t_sane word saveZP word restoreZP end -word sane end diff --git a/src/inc/sdfat.plh b/src/inc/sdfat.plh index 0959ecc..b107e1f 100644 --- a/src/inc/sdfat.plh +++ b/src/inc/sdfat.plh @@ -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 diff --git a/src/inc/testlib.plh b/src/inc/testlib.plh index 087b6f2..719f940 100644 --- a/src/inc/testlib.plh +++ b/src/inc/testlib.plh @@ -4,5 +4,5 @@ import testlib const hex = 2 const newln = 4 const str = 6 - const char = 8 + const chr = 8 end diff --git a/src/libsrc/args.pla b/src/libsrc/args.pla index f0a8e00..7945de0 100644 --- a/src/libsrc/args.pla +++ b/src/libsrc/args.pla @@ -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 \ No newline at end of file +done diff --git a/src/libsrc/conio.pla b/src/libsrc/conio.pla index 7954d3f..fa4769e 100644 --- a/src/libsrc/conio.pla +++ b/src/libsrc/conio.pla @@ -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 diff --git a/src/libsrc/dgr.pla b/src/libsrc/dgr.pla index 079f009..f50924a 100755 --- a/src/libsrc/dgr.pla +++ b/src/libsrc/dgr.pla @@ -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 diff --git a/src/libsrc/fiber.pla b/src/libsrc/fiber.pla index 7637643..408c22b 100644 --- a/src/libsrc/fiber.pla +++ b/src/libsrc/fiber.pla @@ -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 diff --git a/src/libsrc/fileio.pla b/src/libsrc/fileio.pla index 4765fcd..0c35c7f 100644 --- a/src/libsrc/fileio.pla +++ b/src/libsrc/fileio.pla @@ -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] diff --git a/src/libsrc/fpu.pla b/src/libsrc/fpu.pla index 73cb454..46410b2 100644 --- a/src/libsrc/fpu.pla +++ b/src/libsrc/fpu.pla @@ -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 diff --git a/src/libsrc/longjmp.pla b/src/libsrc/longjmp.pla new file mode 100644 index 0000000..9a4df23 --- /dev/null +++ b/src/libsrc/longjmp.pla @@ -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 diff --git a/src/libsrc/memmgr.pla b/src/libsrc/memmgr.pla index 3242992..e310b30 100755 --- a/src/libsrc/memmgr.pla +++ b/src/libsrc/memmgr.pla @@ -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) diff --git a/src/libsrc/sane.pla b/src/libsrc/sane.pla index 51f3bee..c168a17 100644 --- a/src/libsrc/sane.pla +++ b/src/libsrc/sane.pla @@ -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 diff --git a/src/libsrc/uthernet.pla b/src/libsrc/uthernet.pla index 4b5e067..a21eff3 100644 --- a/src/libsrc/uthernet.pla +++ b/src/libsrc/uthernet.pla @@ -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 diff --git a/src/makefile b/src/makefile index dce4ea5..122c28c 100755 --- a/src/makefile +++ b/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) diff --git a/src/mockingboard/seqplay.pla b/src/mockingboard/seqplay.pla index a72f3ee..729e3b2 100755 --- a/src/mockingboard/seqplay.pla +++ b/src/mockingboard/seqplay.pla @@ -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 diff --git a/src/samplesrc/hello.pla b/src/samplesrc/hello.pla index bb39d48..fa873ff 100644 --- a/src/samplesrc/hello.pla +++ b/src/samplesrc/hello.pla @@ -1,4 +1,3 @@ include "inc/cmdsys.plh" - puts("Hello, world.\n") done diff --git a/src/samplesrc/httpd.pla b/src/samplesrc/httpd.pla index b76d63d..4e8c2ca 100644 --- a/src/samplesrc/httpd.pla +++ b/src/samplesrc/httpd.pla @@ -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 diff --git a/src/samplesrc/memtest.pla b/src/samplesrc/memtest.pla index 87eafec..4f16ea1 100644 --- a/src/samplesrc/memtest.pla +++ b/src/samplesrc/memtest.pla @@ -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 diff --git a/src/samplesrc/rod.pla b/src/samplesrc/rod.pla index 9c873d4..3b4bdf4 100644 --- a/src/samplesrc/rod.pla +++ b/src/samplesrc/rod.pla @@ -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 diff --git a/src/samplesrc/rogue.io.pla b/src/samplesrc/rogue.io.pla index 4a51aeb..8f8c882 100644 --- a/src/samplesrc/rogue.io.pla +++ b/src/samplesrc/rogue.io.pla @@ -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 diff --git a/src/samplesrc/rogue.map.pla b/src/samplesrc/rogue.map.pla index 88829b0..3010c68 100644 --- a/src/samplesrc/rogue.map.pla +++ b/src/samplesrc/rogue.map.pla @@ -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 // diff --git a/src/samplesrc/rogue.pla b/src/samplesrc/rogue.pla index 3051bcd..5c2c2a5 100755 --- a/src/samplesrc/rogue.pla +++ b/src/samplesrc/rogue.pla @@ -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 diff --git a/src/samplesrc/rpncalc.pla b/src/samplesrc/rpncalc.pla index 5fc6e8a..f04398d 100644 --- a/src/samplesrc/rpncalc.pla +++ b/src/samplesrc/rpncalc.pla @@ -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 diff --git a/src/samplesrc/sanity.pla b/src/samplesrc/sanity.pla index 916acaa..8b3bff5 100644 --- a/src/samplesrc/sanity.pla +++ b/src/samplesrc/sanity.pla @@ -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 diff --git a/src/samplesrc/sieve.pla b/src/samplesrc/sieve.pla index 2d298b7..eed1c77 100644 --- a/src/samplesrc/sieve.pla +++ b/src/samplesrc/sieve.pla @@ -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 diff --git a/src/samplesrc/test.pla b/src/samplesrc/test.pla index d430e29..915a0b5 100755 --- a/src/samplesrc/test.pla +++ b/src/samplesrc/test.pla @@ -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 diff --git a/src/samplesrc/testlib.pla b/src/samplesrc/testlib.pla index a40749c..55ce84d 100755 --- a/src/samplesrc/testlib.pla +++ b/src/samplesrc/testlib.pla @@ -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]) diff --git a/src/toolsrc/codegen.c b/src/toolsrc/codegen.c index a2e3888..06b8791 100755 --- a/src/toolsrc/codegen.c +++ b/src/toolsrc/codegen.c @@ -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; diff --git a/src/toolsrc/codegen.h b/src/toolsrc/codegen.h index 49cc303..243b751 100755 --- a/src/toolsrc/codegen.h +++ b/src/toolsrc/codegen.h @@ -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); diff --git a/src/toolsrc/codegen.pla b/src/toolsrc/codegen.pla new file mode 100644 index 0000000..bea16d4 --- /dev/null +++ b/src/toolsrc/codegen.pla @@ -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 diff --git a/src/toolsrc/codeopt.pla b/src/toolsrc/codeopt.pla new file mode 100644 index 0000000..c0481d8 --- /dev/null +++ b/src/toolsrc/codeopt.pla @@ -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 diff --git a/src/toolsrc/codeseq.plh b/src/toolsrc/codeseq.plh new file mode 100644 index 0000000..6cc4cf3 --- /dev/null +++ b/src/toolsrc/codeseq.plh @@ -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 diff --git a/src/toolsrc/ed.pla b/src/toolsrc/ed.pla index eb7a518..c745d4c 100755 --- a/src/toolsrc/ed.pla +++ b/src/toolsrc/ed.pla @@ -16,6 +16,7 @@ const pushbttn2 = $C062 const pushbttn3 = $C063 const keyboard = $C000 const keystrobe = $C010 +const cmdline = $01FF // // ASCII key values // @@ -49,15 +50,13 @@ const keyctrlx = $98 const keyctrlz = $9A const keydelete = $FF // -// Input buffer -// -const getbuff = $01FF -// // Data and text buffer constants // -const maxlines = 1500 -const maxfill = 1524 -const maxlnlen = 79 +const MAXLINES = 1500 +const MAXLINESSIZE = MAXLINES+24 +const MAXLNLEN = 79 +const MAXSTRPLSIZE = $8000 +//const STRPLMAPSIZE = 224 // $E0 = 28K is memory@16 bytes per bit map, 128 bytes per 8 bit map, 1K bytes per 8 byte map const pgjmp = 16 const changed = 1 const insmode = 2 @@ -73,72 +72,36 @@ word = $0450,$04D0,$0550,$05D0,$0650,$06D0,$0750,$07D0 // // Editor variables // -byte nullstr = "" -byte[64] txtfile = "UNTITLED" -word strlinbuf = $1000 -word strpoolmap = $1F00 -word strpoolmsz = 224 // $E0 = 28K is memory@16 bytes per bit map, 128 bytes per 8 bit map, 1K bytes per 8 byte map -word strpool = $4800 -word strpoolsz = $7000 -byte flags = 0 -byte flash = 0 -word numlines = 0 -word cutbuf = 0 -byte perr, cursx, cursy, scrnleft, curscol, underchr, curschr +byte nullstr = "" +byte[64] filename = "UNTITLED" +byte exit = FALSE +byte flags = 0 +byte flash = 0 +word numlines = 0 +word cutbuf = 0 +word arg +word strplsize = MAXSTRPLSIZE +word strpool, strplmapsize, strlinbuf, strpoolmap +byte cursx, cursy, scrnleft, curscol, underchr, curschr word keyin, cursrow, scrntop, cursptr // // Predeclared functions // -predef cmdmode +predef cmdmode#0 // // Utility functions // // Defines for ASM routines // asm equates - !SOURCE "vmsrc/plvmzp.inc" + !SOURCE "vmsrc/plvmzp.inc" end -//def toupper(c) -// if c >= 'a' -// if c <= 'z' -// return c - $20 -// fin -// fin -// return c -//end -asm toupper - LDA ESTKL,X - AND #$7F - CMP #'a' - BCC + - CMP #'z'+1 - BCS + - SEC - SBC #$20 -+ STA ESTKL,X - RTS -end -asm clrhibit(strptr) - LDA ESTKL,X - STA SRCL - LDA ESTKH,X - STA SRCH - LDY #$00 - LDA (SRC),Y - BEQ + - TAY -CLHILP LDA (SRC),Y - AND #$7F - STA (SRC),Y - DEY - BNE CLHILP -+ RTS -end -asm sethibit(strptr) +asm sethibit(strptr)#0 LDA ESTKL,X STA SRCL LDA ESTKH,X STA SRCH + INX LDY #$00 LDA (SRC),Y BEQ + @@ -150,7 +113,7 @@ STHILP LDA (SRC),Y BNE STHILP + RTS end -asm cpyln(srcstr, dststr) +asm cpyln(srcstr, dststr)#0 LDA ESTKL,X STA DSTL LDA ESTKH,X @@ -160,6 +123,7 @@ asm cpyln(srcstr, dststr) STA SRCL LDA ESTKH,X STA SRCH + INX LDY #$00 LDA (SRC),Y TAY @@ -181,34 +145,73 @@ CPLNLP LDA (SRC),Y RTS end -def crout - cout($0D) -end -def bell - cout($07) +def bell#0 + putc($07) end // // Memory management routines // -def strcpy(dststr, srcstr) +def sizemask(size) + if size <= 16 + return $01 + elsif size <= 32 + return $03 + elsif size <= 48 + return $07 + elsif size <= 64 + return $0F + elsif size <= 80 + return $1F + fin + return 0 +end +def strpoolalloc(size) + byte szmask, i + word mapmask, addr + + szmask = sizemask(size) + for i = strplmapsize - 1 downto 0 + if ^(strpoolmap + i) <> $FF + mapmask = szmask + repeat + if ^(strpoolmap + i) & mapmask + mapmask = mapmask << 1 + else + ^(strpoolmap + i) = ^(strpoolmap + i) | mapmask + addr = (i << 7) + strpool + while !(mapmask & 1) + addr = addr + 16 + mapmask = mapmask >> 1 + loop + return addr + fin + until mapmask & $100 + fin + next + bell() + puts("OUT OF MEMORY!") + return 0 +end + +def strstripcpy(dststr, srcstr)#0 byte strlen strlen = ^srcstr - while (srcstr).[strlen] == $8D or (srcstr).[strlen] == $A0 + while ^(srcstr + strlen) == $8D or ^(srcstr + strlen) == $A0 strlen-- loop ^dststr = strlen memcpy(dststr + 1, srcstr + 1, strlen) end -def delstr(strptr) +def delstr(strptr)#0 byte mask, ofst if strptr and strptr <> @nullstr mask = sizemask(^strptr + 1) - ofst = (strptr - strheap) >> 4 + ofst = (strptr - strpool) >> 4 mask = mask << (ofst & $07) ofst = ofst >> 3 - strpoolmap->[ofst] = strpoolmap->[ofst] & ~mask + ^(strpoolmap + ofst) = ^(strpoolmap + ofst) & ~mask fin end def newstr(strptr) @@ -216,8 +219,8 @@ def newstr(strptr) word newptr strlen = ^strptr - while (strptr).[strlen] == $8D or (strptr).[strlen] == $A0 - strlen = strlen - 1 + while ^(strptr + strlen) == $8D or ^(strptr + strlen) == $A0 + strlen-- loop if strlen == 0 return @nullstr @@ -233,14 +236,20 @@ end def inittxtbuf#0 word i - strlinbuf = $1000 - strpoolmap = $1F00 - strpoolmsz = 224 // $E0 = 28K is memory@16 bytes per bit map, 128 bytes per 8 bit map, 1K bytes per 8 byte map - strpool = $4800 - strpoolsz = $7000 - - memset(strpoolmap, strheapmsz, 0) - memset(strlinbuf, maxfill * 2, @nullstr) + if not strpool + strlinbuf = heapalloc(MAXLINESSIZE*2) + while isult(heapavail, strplsize) + strplsize = strplsize - 4096 + loop + if isult(heapavail - strplsize, 4096) // Keep at least 4096 free + strplsize = strplsize - 4096 + fin + strplmapsize = strplsize / 128 + strpoolmap = heapalloc(strplmapsize) + strpool = heapalloc(strplsize) + fin + memset(strlinbuf, @nullstr, MAXLINESSIZE*2) + memset(strpoolmap, 0, strplmapsize) numlines = 1 cursrow = 0 curscol = 0 @@ -286,7 +295,7 @@ def txtupper#0 flags = flags | uppercase for i = numlines - 1 downto 0 - strupper(strlinbuf:[i]) + strupper(strlinbuf=>[i]) next end def txtlower#0 @@ -294,42 +303,9 @@ def txtlower#0 flags = flags & ~uppercase for i = numlines - 1 downto 0 - strlower(strlinbuf:[i]) + strlower(strlinbuf=>[i]) next end -def prbyte(h)#0 - cout('$') - call($FDDA, h, 0, 0, 0) -end -def prword(h)#0 - cout('$') - call($F941, h >> 8, h, 0, 0) -end -def print(i)#0 - byte numstr[7] - byte place, sign - - place = 6 - if i < 0 - sign = 1 - i = -i - else - sign = 0 - fin - while i >= 10 - numstr[place] = i % 10 + '0' - i = i / 10 - place = place - 1 - loop - numstr[place] = i + '0' - place = place - 1 - if sign - numstr[place] = '-' - place = place - 1 - fin - numstr[place] = 6 - place - puts(@numstr[place]) -end def nametostr(namestr, len, strptr)#0 ^strptr = len memcpy(strptr + 1, namestr, len) @@ -340,27 +316,27 @@ end def readtxt(filename)#0 byte txtbuf[81], refnum, i, j - refnum = open(filename, sysbuf) if refnum - newline(refnum, $7F, $0D) + refnum = fileio:open(filename) + fileio:newline(refnum, $7F, $0D) repeat - txtbuf = read(refnum, @txtbuf + 1, maxlnlen) + txtbuf = fileio:read(refnum, @txtbuf + 1, MAXLNLEN) if txtbuf sethibit(@txtbuf) if flags & uppercase; strupper(@txtbuf); fin - strlinbuf:[numlines] = newstr(@txtbuf) - numlines = numlines + 1 + strlinbuf=>[numlines] = newstr(@txtbuf) + numlines++ fin - if !(numlines & $0F); cout('.'); fin - until txtbuf == 0 or numlines == maxlines - close(refnum) - // - // Make sure there is a blank line at the end of the buffer - // - if numlines < maxlines and strlinbuf:[numlines - 1] <> @nullstr - strlinbuf:[numlines] = @nullstr - numlines = numlines + 1 - fin + if !(numlines & $0F); putc('.'); fin + until txtbuf == 0 or numlines == MAXLINES + fileio:close(refnum) + // + // Make sure there is a blank line at the end of the buffer + // + if numlines < MAXLINES and strlinbuf=>[numlines - 1] <> @nullstr + strlinbuf=>[numlines] = @nullstr + numlines++ + fin fin end def writetxt(filename)#0 @@ -368,32 +344,32 @@ def writetxt(filename)#0 byte j, chr word i, strptr - destroy(filename) - create(filename, $C3, $04, $00) // full access, TXT file - refnum = open(filename, sysbuf) + fileio:destroy(filename) + fileio:create(filename, $04, $00) // full access, TXT file + refnum = fileio:open(filename) if refnum == 0 return fin // // Remove blank lines at end of text. // - while numlines > 1 and strlinbuf:[numlines - 1] == @nullstr; numlines = numlines - 1; loop + while numlines > 1 and strlinbuf=>[numlines - 1] == @nullstr; numlines = numlines - 1; loop // // Write all the text line to the file. // for i = 0 to numlines - 1 - cpyln(strlinbuf:[i], @txtbuf) + cpyln(strlinbuf=>[i], @txtbuf) txtbuf = txtbuf + 1 txtbuf[txtbuf] = $0D - write(refnum, @txtbuf + 1, txtbuf) - if !(i & $0F); cout('.'); fin + fileio:write(refnum, @txtbuf + 1, txtbuf) + if !(i & $0F); putc('.'); fin next - close(refnum) + fileio:close(refnum) end // // Screen routines // -def clrscrn@0 +def clrscrn#0 call($FC58, 0, 0, 0, 0) end def drawrow(row, ofst, strptr)#0 @@ -409,41 +385,40 @@ def drawrow(row, ofst, strptr)#0 if numchars >= 40 numchars = 40 else - memset(scrnptr + numchars, 40 - numchars, $A0A0) + memset(scrnptr + numchars, $A0A0, 40 - numchars) fin memcpy(scrnptr, strptr + ofst + 1, numchars) end def drawscrn(toprow, ofst)#0 byte row, numchars word strptr, scrnptr - if ofst for row = 0 to 23 - strptr = strlinbuf:[toprow + row] - scrnptr = txtscrn[row] - if ofst >= ^strptr - numchars = 0 - else + strptr = strlinbuf=>[toprow + row] + scrnptr = txtscrn[row] + if ofst >= ^strptr + numchars = 0 + else numchars = ^strptr - ofst - fin - if numchars >= 40 + fin + if numchars >= 40 numchars = 40 - else - memset(scrnptr + numchars, 40 - numchars, $A0A0) - fin - memcpy(scrnptr, strptr + ofst + 1, numchars) + else + memset(scrnptr + numchars, $A0A0, 40 - numchars) + fin + memcpy(scrnptr, strptr + ofst + 1, numchars) next else for row = 0 to 23 - strptr = strlinbuf:[toprow + row] - scrnptr = txtscrn[row] - numchars = ^strptr - if numchars >= 40 + strptr = strlinbuf=>[toprow + row] + scrnptr = txtscrn[row] + numchars = ^strptr + if numchars >= 40 numchars = 40 - else - memset(scrnptr + numchars, 40 - numchars, $A0A0) - fin - memcpy(scrnptr, strptr + 1, numchars) + else + memset(scrnptr + numchars, $A0A0, 40 - numchars) + fin + memcpy(scrnptr, strptr + 1, numchars) next fin end @@ -507,9 +482,9 @@ end def cursup#0 if cursrow > 0 cursoff - cursrow = cursrow - 1 + cursrow-- if cursy > 0 - cursy = cursy - 1 + cursy-- else scrntop = cursrow drawscrn(scrntop, scrnleft) @@ -527,9 +502,9 @@ end def cursdown#0 if cursrow < numlines - 1 cursoff - cursrow = cursrow + 1 + cursrow++ if cursy < 23 - cursy = cursy + 1 + cursy++ else scrntop = cursrow - 23 drawscrn(scrntop, scrnleft) @@ -547,9 +522,9 @@ end def cursleft#0 if curscol > 0 cursoff - curscol = curscol - 1 + curscol-- if cursx > 0 - cursx = cursx - 1 + cursx-- else scrnleft = curscol drawscrn(scrntop, scrnleft) @@ -567,9 +542,9 @@ end def cursright#0 if curscol < 80 cursoff - curscol = curscol + 1 + curscol++ if cursx < 39 - cursx = cursx + 1 + cursx++ else scrnleft = curscol - 39 drawscrn(scrntop, scrnleft) @@ -588,10 +563,27 @@ end // Keyboard routines // def keyin2e + byte key repeat cursflash - until ^keyboard >= 128 - return ^keystrobe + key = ^keyboard + until key >= 128 + ^keystrobe + if ^pushbttn2 & 128 // Closed Apple pressed + when key + is keyarrowleft + key = keyctrla; break + is keyarrowright + key = keyctrls; break + is keyarrowup + key = keyctrlw; break + is keyarrowdown + key = keyctrlz; break + is keyenter + key = keyctrlf; break + wend + fin + return key end def keyin2 byte key @@ -611,7 +603,7 @@ def keyin2 elsif key == keyctrlp key = $DF // _ elsif key == keyctrlb - key = $DC // \ + key = $DC // \ elsif key == keyarrowleft if ^pushbttn3 < 128 key = $FF @@ -631,6 +623,9 @@ def keyin2 fin return key end +def tabkeyin + return curscol < MAXLNLEN and curscol & $01 ?? keyspace :: 0 +end // // Printer routines // @@ -641,17 +636,17 @@ def printtxt(slot)#0 scrncsw = *csw *csw = $C000 | (slot << 8) for i = 0 to numlines - 1 - cpyln(strlinbuf:[i], @txtbuf) + cpyln(strlinbuf=>[i], @txtbuf) puts(@txtbuf) - crout + putln next *csw = scrncsw end def openline(row) - if numlines < maxlines - memcpy(@strlinbuf:[row + 1], @strlinbuf:[row], (numlines - row) * 2) - strlinbuf:[row] = @nullstr - numlines = numlines + 1 + if numlines < MAXLINES + memcpy(@strlinbuf=>[row + 1], @strlinbuf=>[row], (numlines - row) * 2) + strlinbuf=>[row] = @nullstr + numlines++ flags = flags | changed return TRUE fin @@ -659,11 +654,11 @@ def openline(row) return FALSE end def cutline#0 - freestr(cutbuf) - cutbuf = strlinbuf:[cursrow] - memcpy(@strlinbuf:[cursrow], @strlinbuf:[cursrow + 1], (numlines - cursrow) * 2) + delstr(cutbuf) + cutbuf = strlinbuf=>[cursrow] + memcpy(@strlinbuf=>[cursrow], @strlinbuf=>[cursrow + 1], (numlines - cursrow) * 2) if numlines > 1 - numlines = numlines - 1 + numlines-- fin flags = flags | changed if cursrow == numlines @@ -672,10 +667,10 @@ def cutline#0 redraw end def pasteline#0 - if cutbuf and numlines < maxlines - memcpy(@strlinbuf:[cursrow + 1], @strlinbuf:[cursrow], (numlines - cursrow) * 2) - strlinbuf:[cursrow] = newstr(cutbuf) - numlines = numlines + 1 + if cutbuf and numlines < MAXLINES + memcpy(@strlinbuf=>[cursrow + 1], @strlinbuf=>[cursrow], (numlines - cursrow) * 2) + strlinbuf=>[cursrow] = newstr(cutbuf) + numlines++ flags = flags | changed redraw else @@ -686,16 +681,16 @@ def joinline#0 byte joinstr[80], joinlen if cursrow < numlines - 1 - strcpy(@joinstr, strlinbuf:[cursrow]) - joinlen = joinstr + ^(strlinbuf:[cursrow + 1]) + strstripcpy(@joinstr, strlinbuf=>[cursrow]) + joinlen = joinstr + ^(strlinbuf=>[cursrow + 1]) if joinlen < 80 - memcpy(@joinstr + joinstr + 1, strlinbuf:[cursrow + 1] + 1, ^(strlinbuf:[cursrow + 1])) + memcpy(@joinstr + joinstr + 1, strlinbuf=>[cursrow + 1] + 1, ^(strlinbuf=>[cursrow + 1])) joinstr = joinlen - freestr(strlinbuf:[cursrow]) - strlinbuf:[cursrow] = newstr(@joinstr) - freestr(strlinbuf:[cursrow + 1]) - numlines = numlines - 1 - memcpy(@strlinbuf:[cursrow + 1], @strlinbuf:[cursrow + 2], (numlines - cursrow) * 2) + delstr(strlinbuf=>[cursrow]) + strlinbuf=>[cursrow] = newstr(@joinstr) + delstr(strlinbuf=>[cursrow + 1]) + numlines-- + memcpy(@strlinbuf=>[cursrow + 1], @strlinbuf=>[cursrow + 2], (numlines - cursrow) * 2) flags = flags | changed redraw else @@ -708,19 +703,19 @@ def splitline#0 if openline(cursrow + 1) if curscol - splitlen = ^(strlinbuf:[cursrow]) + splitlen = ^(strlinbuf=>[cursrow]) if curscol < splitlen - 1 - memcpy(@splitstr + 1, strlinbuf:[cursrow] + curscol + 1, splitlen - curscol) + memcpy(@splitstr + 1, strlinbuf=>[cursrow] + curscol + 1, splitlen - curscol) splitstr = splitlen - curscol - strlinbuf:[cursrow + 1] = newstr(@splitstr) - memcpy(@splitstr + 1, strlinbuf:[cursrow] + 1, curscol) + strlinbuf=>[cursrow + 1] = newstr(@splitstr) + memcpy(@splitstr + 1, strlinbuf=>[cursrow] + 1, curscol) splitstr = curscol - freestr(strlinbuf:[cursrow]) - strlinbuf:[cursrow] = newstr(@splitstr) + delstr(strlinbuf=>[cursrow]) + strlinbuf=>[cursrow] = newstr(@splitstr) fin else - strlinbuf:[cursrow + 1] = strlinbuf:[cursrow] - strlinbuf:[cursrow] = @nullstr + strlinbuf=>[cursrow + 1] = strlinbuf=>[cursrow] + strlinbuf=>[cursrow] = @nullstr fin curscol = 0 cursx = 0 @@ -747,44 +742,44 @@ def editline(key) if (editkey(key)) flags = flags | changed - memset(@editstr, 80, $A0A0) - strcpy(@editstr, strlinbuf:[cursrow]) - undoline = strlinbuf:[cursrow] - strlinbuf:[cursrow] = @editstr + memset(@editstr, $A0A0, 80) + strstripcpy(@editstr, strlinbuf=>[cursrow]) + undoline = strlinbuf=>[cursrow] + strlinbuf=>[cursrow] = @editstr repeat if key >= keyspace if key == keydelete if curscol > 0 if curscol <= editstr memcpy(@editstr[curscol], @editstr[curscol + 1], editstr - curscol) - editstr = editstr - 1 + editstr-- fin - curscol = curscol - 1 + curscol-- cursoff if cursx > 0 - cursx = cursx - 1 + cursx-- drawrow(cursy, scrnleft, @editstr) else - scrnleft = scrnleft - 1 + scrnleft-- drawscrn(scrntop, scrnleft) fin curson fin - elsif curscol < maxlnlen - curscol = curscol + 1 - cursx = cursx + 1 + elsif curscol < MAXLNLEN + curscol++ + cursx++ if flags & insmode - if editstr < maxlnlen or editstr.maxlnlen == $A0 - editstr = editstr + 1 + if editstr < MAXLNLEN or editstr.MAXLNLEN == $A0 + editstr++ if curscol >= editstr editstr = curscol else memcpy(@editstr[curscol + 1], @editstr[curscol], editstr - curscol) fin else - curscol = curscol - 1 - cursx = cursx - 1 - key = editstr[curscol] + curscol-- + cursx-- + key = editstr[curscol] bell fin else @@ -797,8 +792,8 @@ def editline(key) if cursx <= 39 drawrow(cursy, scrnleft, @editstr) else - scrnleft = scrnleft + 1 - cursx = 39 + scrnleft++ + cursx = 39 drawscrn(scrntop, scrnleft) fin curson @@ -807,15 +802,15 @@ def editline(key) fin elsif key == keyctrld if curscol < editstr - strcpy(undoline, @editstr) + strstripcpy(undoline, @editstr) memcpy(@editstr[curscol + 1], @editstr[curscol + 2], editstr - curscol) - editstr = editstr - 1 + editstr-- cursoff drawrow(cursy, scrnleft, @editstr) curson fin elsif key == keyctrlr - strcpy(@editstr, undoline) + strstripcpy(@editstr, undoline) cursoff drawrow(cursy, scrnleft, @editstr) curson @@ -823,11 +818,11 @@ def editline(key) key = keyin() until not editkey(key) if editstr - strlinbuf:[cursrow] = newstr(@editstr) + strlinbuf=>[cursrow] = newstr(@editstr) else - strlinbuf:[cursrow] = @nullstr + strlinbuf=>[cursrow] = @nullstr fin - freestr(undoline) + delstr(undoline) fin return key end @@ -859,15 +854,15 @@ def editmode#0 is keyctrlv pasteline; break is keyctrlf - if numlines < maxlines and cursrow == numlines - 1 - strlinbuf:[numlines] = @nullstr - numlines = numlines + 1 - fin - cursdown + if numlines < MAXLINES and cursrow == numlines - 1 + strlinbuf=>[numlines] = @nullstr + numlines++ + fin + cursdown is keyctrlo openline(cursrow) redraw - break + break is keyenter if flags & insmode splitline @@ -876,10 +871,15 @@ def editmode#0 cursdown redraw fin - break + break is keyctrlt joinline; break is keyctrli + keyin = @tabkeyin + editline(keyspace) + keyin = !(MACHID & $80) ?? @keyin2 :: @keyin2e + break + is keyctrlb if flags & insmode flags = flags & ~insmode curschr = ' ' @@ -887,7 +887,7 @@ def editmode#0 flags = flags | insmode curschr = '+' fin - break + break is keyctrlc if flags & uppercase txtlower @@ -895,14 +895,16 @@ def editmode#0 txtupper fin redraw - break + break is keyescape cursoff cmdmode - redraw - break + if not exit + redraw + fin + break wend - until false + until exit end // // Command mode @@ -913,27 +915,28 @@ def prfiles(optpath) byte firstblk byte entrylen, entriesblk byte i, type, len - word entry, filecnt + word databuff, entry, filecnt if ^optpath - strcpy(@path, optpath) + strstripcpy(@path, optpath) else - getpfx(@path) + fileio:getpfx(@path) puts(@path) - crout + putln fin - refnum = open(@path, sysbuf) + databuff = heapalloc(512) + refnum = fileio:open(@path) if perr return perr fin firstblk = 1 repeat - if read(refnum, databuff, 512) == 512 + if fileio:read(refnum, databuff, 512) == 512 entry = databuff + 4 if firstblk - entrylen = databuff.$23 - entriesblk = databuff.$24 - filecnt = databuff:$25 + entrylen = databuff->$23 + entriesblk = databuff->$24 + filecnt = databuff=>$25 entry = entry + entrylen fin for i = firstblk to entriesblk @@ -943,13 +946,13 @@ def prfiles(optpath) ^entry = len puts(entry) if type & $F0 == $D0 // Is it a directory? - cout('/') - len = len + 1 + putc('/') + len++ fin for len = 20 - len downto 1 - cout(' ') + putc(' ') next - filecnt = filecnt - 1 + filecnt-- fin entry = entry + entrylen next @@ -958,14 +961,15 @@ def prfiles(optpath) filecnt = 0 fin until filecnt == 0 - close(refnum) - crout + fileio:close(refnum) + heaprelease(databuff) + putln return 0 end def striplead(strptr, chr)#0 while ^strptr and ^(strptr + 1) == chr memcpy(strptr + 1, strptr + 2, ^strptr) - ^strptr = ^strptr - 1 + ^strptr-- loop end def parsecmd(strptr) @@ -976,7 +980,7 @@ def parsecmd(strptr) if ^strptr cmd = ^(strptr + 1) memcpy(strptr + 1, strptr + 2, ^strptr) - ^strptr = ^strptr - 1 + ^strptr-- fin if ^strptr striplead(strptr, ' ') @@ -987,55 +991,49 @@ def chkchng if flags & changed puts("LOSE CHANGES TO FILE (Y/N)?") if toupper(keyin()) == 'N' - crout + putln return FALSE fin - crout + putln fin return TRUE end -def quit#0 - if chkchng - exit - fin -end -def cmdmode +def cmdmode#0 byte slot word cmdptr clrscrn - puts("PLASMA ][ EDITOR VERSION 0.99") - crout - while TRUE - puts(@txtfile) - cmdptr = rdstr($BA) + puts("PLASMA Editor, Version 1.0\n") + while not exit + puts(@filename) + cmdptr = gets($BA) when toupper(parsecmd(cmdptr)) is 'A' readtxt(cmdptr) flags = flags | changed - break + break is 'R' if chkchng inittxtbuf - numlines = 0 - strcpy(@txtfile, cmdptr) - readtxt(@txtfile) - if numlines == 0; numlines = 1; fin + numlines = 0 + strstripcpy(@filename, cmdptr) + readtxt(@filename) + if numlines == 0; numlines = 1; fin flags = flags & ~changed fin - break + break is 'W' if ^cmdptr - strcpy(@txtfile, cmdptr) + strstripcpy(@filename, cmdptr) fin - writetxt(@txtfile) + writetxt(@filename) //if flags & changed; fin flags = flags & ~changed - break + break is 'C' prfiles(cmdptr); break is 'P' - setpfx(cmdptr); break + fileio:setpfx(cmdptr); break is 'H' if ^cmdptr slot = cmdptr.1 - '0' @@ -1043,22 +1041,22 @@ def cmdmode slot = 1 fin printtxt(slot) - break + break is 'Q' - quit + exit = chkchng is 'E' is 0 return is 'N' if chkchng inittxtbuf - strcpy(@txtfile, "UNTITLED") + strstripcpy(@filename, "UNTITLED") fin - break + break otherwise bell - cout('?') - crout + putc('?') + putln wend if perr puts("ERROR: $") @@ -1066,27 +1064,28 @@ def cmdmode else puts("OK") fin - crout + putln loop end // // Init editor // -if !(^MACHID & $80) +if !(MACHID & $80) flags = uppercase | shiftlock keyin = @keyin2 else keyin = @keyin2e fin inittxtbuf -if argbuff - strcpy(@txtfile, @argbuff) - puts(@txtfile) +arg = argNext(argFirst) +if ^arg + strcpy(@filename, arg) + puts(@filename) numlines = 0 - readtxt(@txtfile) + readtxt(@filename) fin curschr = '+' -flags = flags | insmode +flags = flags | insmode drawscrn(scrntop, scrnleft) curson editmode diff --git a/src/toolsrc/lex.c b/src/toolsrc/lex.c index 985f454..5544a3d 100755 --- a/src/toolsrc/lex.c +++ b/src/toolsrc/lex.c @@ -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) { diff --git a/src/toolsrc/lex.pla b/src/toolsrc/lex.pla new file mode 100644 index 0000000..159d86a --- /dev/null +++ b/src/toolsrc/lex.pla @@ -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 diff --git a/src/toolsrc/parse.c b/src/toolsrc/parse.c index 9e81e00..6188e7e 100755 --- a/src/toolsrc/parse.c +++ b/src/toolsrc/parse.c @@ -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) { /* diff --git a/src/toolsrc/parse.pla b/src/toolsrc/parse.pla new file mode 100644 index 0000000..ce9644b --- /dev/null +++ b/src/toolsrc/parse.pla @@ -0,0 +1,1243 @@ +// +// Alebraic op to stack op +// +def push_op(op, prec)#0 + if opsp == 16; exit_err(ERR_OVER|ERR_CODE|ERR_FRAME); fin + opstack[opsp] = op + precstack[opsp] = prec + opsp++ +end +def pop_op + opsp-- + if opsp < 0; exit_err(ERR_INVAL|ERR_CODE|ERR_FRAME); fin + return opstack[opsp] +end +def tos_op + return opsp < 0 ?? 0 :: opstack[opsp-1] +end +def tos_op_prec(tos) + return opsp <= tos ?? 100 :: precstack[opsp-1] +end +def push_val(value, size, type)#0 + byte i + if valsp == 16; exit_err(ERR_OVER|ERR_CODE|ERR_FRAME); fin + valstack[valsp] = value + sizestack[valsp] = size + typestack[valsp] = type + valsp++ +end +def pop_val#3 + byte i + valsp-- + if valsp < 0; exit_err(ERR_INVAL|ERR_CODE|ERR_FRAME); fin + return valstack[valsp], sizestack[valsp], typestack[valsp] +end +// +// Constant expression parsing +// +def calc_binaryop(op)#0 + word val1, val2 + byte size1, size2, type1, type2 + + val2, size2, type2 = pop_val + val1, size1, type1 = pop_val + if type1 <> CONST_TYPE and type2 <> CONST_TYPE; exit_err(ERR_INVAL|ERR_CONST); fin + when op + is MUL_TKN + val1 = val1 * val2 + break + is DIV_TKN + val1 = val1 / val2 + break + is MOD_TKN + val1 = val1 % val2 + break + is ADD_TKN + val1 = val1 + val2 + break + is SUB_TKN + val1 = val1 - val2 + break + is SHL_TKN + val1 = val1 << val2 + break + is SHR_TKN + val1 = val1 >> val2 + break + is AND_TKN + val1 = val1 & val2 + break + is OR_TKN + val1 = val1 | val2 + break + is EOR_TKN + val1 = val1 ^ val2 + break + otherwise + exit_err(ERR_INVAL|ERR_CONST) + wend + if size2 > size1; size1 = size2; fin + push_val(val1, size1, type1) +end +def parse_constterm + word val + byte size, type + + when scan + is OPEN_PAREN_TKN + push_val(parse_constexpr) + if token <> CLOSE_PAREN_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_SYNTAX); fin + return TRUE + is ID_TKN + is INT_TKN + is CHR_TKN + is STR_TKN + return TRUE + wend + return FALSE +end +def parse_constval + byte mod, size + word type, idptr, value + + mod = 0 + while not parse_constterm + when token + is SUB_TKN + mod = mod | 1; break + is COMP_TKN + mod = mod | 2; break + is LOGIC_NOT_TKN + mod = mod | 4; break + is AT_TKN + mod = mod | 8; break + is ADD_TKN + break + otherwise + return FALSE + wend + loop + when token + is CLOSE_PAREN_TKN + value, size, type = pop_val + break + is STR_TKN + size = tknlen - 1 + value = constval + type = STR_TYPE + if mod; exit_err(ERR_INVAL|ERR_CONST); fin + break + is CHR_TKN + size = 1 + value = constval + type = CONST_TYPE + break + is INT_TKN + size = 2 + value = constval + type = CONST_TYPE + break + is ID_TKN + size = 2 + idptr = lookup_id(tknptr, tknlen) + type = idptr=>idtype + if type & (FUNC_TYPE|ADDR_TYPE) + if mod <> 8; exit_err(ERR_INVAL|ERR_CONST); fin + type = CONSTADDR_TYPE + fin + value = idptr=>idval + break + otherwise + return FALSE + wend + if mod & 1 + value = -value + fin + if mod & 2 + value = ~value + fin + if mod & 4 + value = !value + fin + push_val(value, size, type) + return TRUE +end +def parse_constexpr#3 + byte prevmatch, matchop, i + word optos + + matchop = 0 + optos = opsp + repeat + prevmatch = matchop + matchop = 0 + if parse_constval + matchop = 1 + scan + for i = 0 to bops_tblsz + if token == bops_tbl[i] + matchop = 2 + if bops_prec[i] >= tos_op_prec(optos) + calc_binaryop(pop_op) + fin + push_op(token, bops_prec[i]) + break + fin + next + fin + until matchop <> 2 + if matchop == 0 and prevmatch == 0; return 0, 0, 0; fin + if matchop == 0 and prevmatch == 2; exit_err(ERR_INVAL|ERR_SYNTAX); fin + while optos < opsp + calc_binaryop(pop_op) + loop + return pop_val +end +def parse_const(valptr) + word idptr + + when scan + is CHR_TKN + is INT_TKN + *valptr = constval + break + is ID_TKN + idptr = lookup_id(tknptr, tknlen) + if idptr=>idtype & CONST_TYPE + *valptr = idptr=>idval + break + fin + otherwise + return 0 + wend + return CONST_TYPE +end +// +// Normal expression parsing +// +def parse_list#2 + byte listdepth, stackdepth + word listseq, exprseq + + listseq = NULL + listdepth = 0 + repeat + listseq, stackdepth = parse_expr(listseq) + listdepth = listdepth + stackdepth + until token <> COMMA_TKN + return listseq, listdepth +end +def parse_value(codeseq, r_val)#2 + byte cfnparms, cfnvals, stackdepth, operation + word deref, type, optos, idptr, value, const_offset + word uopseq, valseq, idxseq + + deref = r_val + optos = opsp + type = 0 + value = 0 + cfnparms = 0 + cfnvals = 1 + stackdepth = 1 + uopseq = NULL + valseq = NULL + idxseq = NULL + // + // Parse pre-ops + // + operation = TRUE + repeat + when scan + is NEG_TKN + is COMP_TKN + is LOGIC_NOT_TKN + uopseq = gen_uop(uopseq, token); + is ADD_TKN + if not r_val; exit_err(ERR_INVAL|ERR_SYNTAX); fin + break + is BPTR_TKN + is WPTR_TKN + if type & BPTR_TYPE; exit_err(ERR_INVAL|ERR_SYNTAX); fin + type = token == BPTR_TKN ?? BPTR_TYPE :: WPTR_TYPE + deref++ + break + is AT_TKN + if not deref; exit_err(ERR_INVAL|ERR_SYNTAX); fin + deref-- + break + otherwise + operation = FALSE + wend + until not operation + // + // Determine terminal type + // + when token + is ID_TKN + idptr = lookup_id(tknptr, tknlen) + if not idptr; return codeseq, 0; fin + if not idptr=>idtype; return codeseq, 0; fin // DEBUG + type = type | idptr=>idtype + value = idptr=>idval + if type & CONST_TYPE + valseq = gen_const(NULL, value) + deref-- + else + valseq = type & LOCAL_TYPE ?? gen_oplcl(NULL, LADDR_CODE, value) :: gen_opglbl(NULL, GADDR_CODE, value, 0) + if type & FUNC_TYPE + cfnparms = idptr->funcparms + cfnvals = idptr->funcvals + fin + fin + break + is INT_TKN + is CHR_TKN + value = constval + valseq = gen_const(NULL, value) + deref-- + break + is STR_TKN + codeseq = gen_str(codeseq, constval) + scan + return codeseq, stackdepth // Special case return + break + is OPEN_PAREN_TKN + valseq, stackdepth = parse_expr(NULL) + if token <> CLOSE_PAREN_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_SYNTAX); fin + deref-- + break + is DROP_TKN + if r_val; exit_err(ERR_INVAL|ERR_STATE); fin + codeseq = gen_op(codeseq, DROP_CODE) + scan + return codeseq, 0 // Special case return + is LAMBDA_TKN + if not r_val; return codeseq, 0; fin // Lambdas can't be LVALUES + value = parse_lambda + valseq = gen_opglbl(NULL, GADDR_CODE, value, 0) + deref-- + break + otherwise + if uopseq; release_seq(uopseq); fin + if codeseq; release_seq(codeseq); fin + return NULL, 0 + wend + // + // Parse post-ops + // + operation = TRUE + repeat + when scan + is OPEN_PAREN_TKN + // + // Function call - parameters generate before call address + // + idxseq, value = parse_list + valseq = cat_seq(idxseq, valseq) + if token <> CLOSE_PAREN_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_SYNTAX); fin + if type & FUNC_TYPE // Can't check parm count on function pointers + if cfnparms <> value; exit_err(ERR_MISS|ERR_ID); fin + else + if scan == POUND_TKN // Set function pointer return vals count - can't do this to regular function call + if not parse_const(@value); exit_err(ERR_INVAL|ERR_CONST); fin + cfnvals = value + else + rewind(tknptr) + fin + if type & WORD_TYPE + valseq = gen_op(valseq, LW_CODE) + elsif type & BYTE_TYPE + exit_err(ERR_INVAL|ERR_CODE) + else + deref++ + fin + fin + valseq = gen_op(valseq, ICAL_CODE) + stackdepth = stackdepth + cfnvals - 1 + cfnparms = 0 + cfnvals = 1 + type = type & PTR_TYPE + deref-- + break + is OPEN_BRACKET_TKN + // + // Array of arrays + // + if type & FUNC_TYPE // Function address dereference + cfnparms = 0 + cfnvals = 1 + fin + repeat + valseq, drop = parse_expr(valseq) + if token <> COMMA_TKN; break; fin + valseq = gen_op(valseq, INDEXW_CODE) + valseq = gen_op(valseq, LW_CODE) // Multi-dimenstion arrays are array pointers to arrays + until FALSE + if token <> CLOSE_BRACKET_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_SYNTAX); fin + if type & WORD_TYPE + valseq = gen_op(valseq, INDEXW_CODE) + else + valseq = gen_op(valseq, INDEXB_CODE) + if not (type & BYTE_TYPE) + type = (type & PTR_TYPE) | BYTE_TYPE + deref++ + fin + fin + break + is PTRB_TKN + is PTRW_TKN + // + // Structure member pointer + // + if type & FUNC_TYPE // Function call dereference + if cfnparms; exit_err(ERR_MISS|ERR_ID); fin + valseq = gen_op(valseq, ICAL_CODE) + stackdepth = stackdepth + cfnvals - 1 + cfnparms = 0 + cfnvals = 1 + elsif type & WORD_TYPE + valseq = gen_op(valseq, LW_CODE) // Pointer dereference + elsif type & BYTE_TYPE + exit_err(ERR_INVAL|ERR_CODE) + else + deref++ + fin + type = (type & PTR_TYPE) | token == PTRB_TKN ?? BYTE_TYPE :: WORD_TYPE + if not parse_const(@const_offset) + rewind(tknptr) // Setting type override for following operations + elsif const_offset <> 0 + valseq = gen_const(valseq, const_offset) // Structure member pointer + valseq = gen_op(valseq, ADD_CODE) + fin + break + is DOT_TKN + is COLON_TKN + // + // Structure member offset + // + if type & FUNC_TYPE // Function address dereference + cfnparms = 0 + cfnvals = 1 + elsif not (type & VAR_TYPE) + deref++ + fin + type = (type & VAR_TYPE) | (token == DOT_TKN ?? BYTE_TYPE :: WORD_TYPE) + if not parse_const(@const_offset) + rewind(tknptr) // Setting type override for following operations + elsif const_offset <> 0 + valseq = gen_const(valseq, const_offset) // Structure member offset + valseq = gen_op(valseq, ADD_CODE) + fin + break + otherwise + operation = FALSE + wend + until not operation + // + //Probably parsing RVALUE as LVALUE + // + if deref < 0 + release_seq(valseq) + release_seq(uopseq) + return codeseq, 0 + fin + // + // Resolve outstanding dereference pointer loads + // + while deref > r_val + if type & FUNC_TYPE + if cfnparms; exit_err(ERR_MISS|ERR_ID); fin + valseq = gen_op(valseq, ICAL_CODE) + stackdepth = stackdepth + cfnvals - 1 + cfnparms = 0 + cfnvals = 1 + type = type & ~FUNC_TYPE; + else + valseq = gen_op(valseq, LW_CODE) + fin + deref-- + loop + if deref + if type & FUNC_TYPE + if cfnparms; exit_err(ERR_MISS|ERR_ID); fin + valseq = gen_op(valseq, ICAL_CODE) + stackdepth = stackdepth + cfnvals - 1 + type = type & ~FUNC_TYPE + elsif type & (BYTE_TYPE | BPTR_TYPE) + valseq = gen_op(valseq, LB_CODE) + elsif type & (WORD_TYPE | WPTR_TYPE) + valseq = gen_op(valseq, LW_CODE) + else + exit_err(ERR_INVAL|ERR_CODE) + fin + fin + // + // Output pre-operations + // + valseq = cat_seq(valseq, uopseq) + // + // Wrap up LVALUE store + // + if not r_val + if type & (BYTE_TYPE | BPTR_TYPE) + valseq = gen_op(valseq, SB_CODE) + elsif type & (WORD_TYPE | WPTR_TYPE) + valseq = gen_op(valseq, SW_CODE) + else + release_seq(valseq) + return codeseq, 0 // Function or const cannot be LVALUE, must be RVALUE + fin + stackdepth-- + fin + return cat_seq(codeseq, valseq), stackdepth +end +def parse_expr(codeseq)#2 + byte stackdepth, matchdepth, stkdepth1, prevmatch, matchop, i + word optos + word tag_else, tag_endtri + + stackdepth = 0 + matchop = 0 + optos = opsp + repeat + prevmatch = matchop + matchop = 0 + codeseq, matchdepth = parse_value(codeseq, RVALUE) + if matchdepth + stackdepth = stackdepth + matchdepth + matchop = 1 + for i = 0 to bops_tblsz + if token == bops_tbl[i] + matchop = 2 + if bops_prec[i] >= tos_op_prec(optos) + codeseq = gen_bop(codeseq, pop_op) + stackdepth-- + fin + push_op(token, bops_prec[i]) + break + fin + next + fin + until matchop <> 2 + if matchop == 0 and prevmatch == 2; exit_err(ERR_SYNTAX); fin + while optos < opsp + codeseq = gen_bop(codeseq, pop_op) + stackdepth-- + loop + // + // Look for ternary operator + // + if token == TERNARY_TKN + if stackdepth <> 1; exit_err(ERR_OVER|ERR_SYNTAX); fin + tag_else = new_tag(RELATIVE_FIXUP) + tag_endtri = new_tag(RELATIVE_FIXUP) + codeseq = gen_oprel(codeseq, BRFALSE_CODE, tag_else) + codeseq, stkdepth1 = parse_expr(codeseq) + if token <> TRIELSE_TKN; exit_err(ERR_MISS|ERR_SYNTAX); fin + codeseq = gen_oprel(codeseq, BRNCH_CODE, tag_endtri) + codeseq = gen_ctag(codeseq, tag_else) + codeseq, stackdepth = parse_expr(codeseq) + if stkdepth1 <> stackdepth; exit_err(ERR_INVAL|ERR_CODE); fin + codeseq = gen_ctag(codeseq, tag_endtri) + fin + return codeseq, stackdepth +end +def parse_set(codeseq) + word setptr, rseq, setseq[16] + byte lparms, rparms, i, lambda_set + + lparms = 0 + rparms = 0 + lambda_set = lambda_cnt + setptr = tknptr + repeat + setseq[lparms], drop = parse_value(NULL, LVALUE) + if not setseq[lparms]; break; fin + lparms++ + until token <> COMMA_TKN + if not lparms or token <> SET_TKN + // + // Not a set list - free everything up + // + rewind(setptr) + while lparms + lparms-- + release_seq(setseq[lparms]) + loop + while lambda_cnt > lambda_set + lambda_cnt-- + lambda_num-- + release_seq(lambda_seq[lambda_cnt]) + loop + return NULL + fin + rseq, rparms = parse_list + if lparms > rparms; exit_err(ERR_MISS|ERR_CODE|ERR_FRAME); fin + codeseq = cat_seq(codeseq, rseq) + if lparms < rparms + parse_warn("Silently dropping extra set values") + for i = rparms - lparms downto 1 + codeseq = gen_op(codeseq, DROP_CODE) + next + fin + while lparms + lparms-- + codeseq = cat_seq(codeseq, setseq[lparms]) + loop + return codeseq +end +def parse_stmnt + byte type, elem_type, elem_size, i, cfnvals + word seq, tag_prevbrk, tag_prevcnt, tag_else, tag_endif, tag_while, tag_wend + word tag_repeat, tag_for, tag_choice, tag_of, idptr, addr, stepdir + + if token <> END_TKN and token <> DONE_TKN and token <> OF_TKN and token <> DEFAULT_TKN + prevstmnt = token + fin + when token + is IF_TKN + seq, cfnvals = parse_expr(NULL) + if !seq; exit_err(ERR_INVAL|ERR_STATE); fin + if cfnvals > 1 + parse_warn("Expression value overflow") + while cfnvals > 1; cfnvals--; seq = gen_op(seq, DROP_CODE); loop + fin + tag_else = new_tag(RELATIVE_FIXUP) + tag_endif = new_tag(RELATIVE_FIXUP) + seq = gen_oprel(seq, BRFALSE_CODE, tag_else) + emit_seq(seq) + repeat + while parse_stmnt + nextln + loop + if token <> ELSEIF_TKN + break + fin + emit_branch(tag_endif) + emit_tag(tag_else) + seq, cfnvals = parse_expr(NULL) + if !seq; exit_err(ERR_INVAL|ERR_STATE); fin + if cfnvals > 1 + parse_warn("Expression value overflow") + while cfnvals > 1; cfnvals--; seq = gen_op(seq, DROP_CODE); loop + fin + tag_else = new_tag(RELATIVE_FIXUP) + seq = gen_oprel(seq, BRFALSE_CODE, tag_else) + emit_seq(seq) + until FALSE + if token == ELSE_TKN + emit_branch(tag_endif) + emit_tag(tag_else) + scan + while parse_stmnt + nextln + loop + emit_tag(tag_endif) + else + emit_tag(tag_else) + emit_tag(tag_endif) + fin + if token <> FIN_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE); fin + break + is WHILE_TKN + tag_while = new_tag(RELATIVE_FIXUP) + tag_wend = new_tag(RELATIVE_FIXUP) + tag_prevcnt = cont_tag + cont_tag = tag_while + tag_prevbrk = break_tag + break_tag = tag_wend + emit_tag(tag_while) + seq, cfnvals = parse_expr(NULL) + if !seq; exit_err(ERR_INVAL|ERR_STATE); fin + if cfnvals > 1 + parse_warn("Expression value overflow") + while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop + fin + seq = gen_oprel(seq, BRFALSE_CODE, tag_wend) + emit_seq(seq) + while parse_stmnt + nextln + loop + if token <> LOOP_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE); fin + emit_branch(tag_while) + emit_tag(tag_wend) + break_tag = tag_prevbrk + cont_tag = tag_prevcnt + break + is REPEAT_TKN + tag_repeat = new_tag(RELATIVE_FIXUP) + tag_prevbrk = break_tag + break_tag = new_tag(RELATIVE_FIXUP) + tag_prevcnt = cont_tag + cont_tag = new_tag(RELATIVE_FIXUP) + emit_tag(tag_repeat) + scan + while parse_stmnt + nextln + loop + if token <> UNTIL_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE); fin + emit_tag(cont_tag) + cont_tag = tag_prevcnt + seq, cfnvals = parse_expr(NULL) + if !seq; exit_err(ERR_INVAL|ERR_STATE); fin + if cfnvals > 1 + parse_warn("Expression value overflow") + while cfnvals > 1; cfnvals--; seq = gen_op(seq, DROP_CODE); loop + fin + seq = gen_oprel(seq, BRFALSE_CODE, tag_repeat) + emit_seq(seq) + emit_tag(break_tag) + break_tag = tag_prevbrk + break + is FOR_TKN + stack_loop++ + tag_for = new_tag(RELATIVE_FIXUP) + tag_prevcnt = cont_tag + cont_tag = tag_for + tag_prevbrk = break_tag + break_tag = new_tag(RELATIVE_FIXUP) + if scan <> ID_TKN; exit_err(ERR_MISS|ERR_ID); fin + idptr = lookup_id(tknptr, tknlen) + if idptr + type = idptr=>idtype + addr = idptr=>idval + else + exit_err(ERR_INVAL|ERR_ID) + fin + if scan <> SET_TKN; exit_err(ERR_INVAL|ERR_STATE); fin + seq, cfnvals = parse_expr(NULL) + if !seq; exit_err(ERR_INVAL|ERR_STATE); fin + if cfnvals > 1 + parse_warn("Expression value overflow") + while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop + fin + emit_seq(seq) + emit_tag(tag_for) + if type & LOCAL_TYPE + if type & BYTE_TYPE; emit_dlb(addr); else; emit_dlw(addr); fin + else + if type & BYTE_TYPE; emit_dab(addr, 0); else; emit_daw(addr, 0); fin + fin + if token == TO_TKN + stepdir = 1 + elsif token == DOWNTO_TKN + stepdir = -1 + else + exit_err(ERR_INVAL|ERR_STATE) + fin + seq, cfnvals = parse_expr(NULL) + if !seq; exit_err(ERR_INVAL|ERR_STATE); fin + if cfnvals > 1 + parse_warn("Expression value overflow") + while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop + fin + emit_seq(seq) + if stepdir > 0; emit_brgt(break_tag); else; emit_brlt(break_tag); fin + if token == STEP_TKN + seq, cfnvals = parse_expr(NULL) + if !seq; exit_err(ERR_INVAL|ERR_STATE); fin + if cfnvals > 1 + parse_warn("Expression value overflow") + while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop + fin + emit_seq(seq) + emit_code(stepdir > 0 ?? ADD_CODE :: SUB_CODE) + else + emit_code(stepdir > 0 ?? INC_CODE :: DEC_CODE) + fin + while parse_stmnt + nextln + loop + if token <> NEXT_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE); fin + emit_branch(tag_for) + cont_tag = tag_prevcnt + emit_tag(break_tag) + emit_code(DROP_CODE) + break_tag = tag_prevbrk + stack_loop-- + break + is CASE_TKN + stack_loop++ + tag_prevbrk = break_tag + break_tag = new_tag(RELATIVE_FIXUP) + tag_choice = new_tag(RELATIVE_FIXUP) + tag_of = new_tag(RELATIVE_FIXUP) + seq, cfnvals = parse_expr(NULL) + if !seq; exit_err(ERR_INVAL|ERR_STATE); fin + if cfnvals > 1 + parse_warn("Expression value overflow") + while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop + fin + emit_seq(seq) + nextln + while token <> ENDCASE_TKN + when token + is OF_TKN + seq, cfnvals = parse_expr(NULL) + if !seq; exit_err(ERR_INVAL|ERR_STATE); fin + if cfnvals > 1 + parse_warn("Expression value overflow") + while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop + fin + emit_seq(seq) + emit_brne(tag_choice) + emit_tag(tag_of) + while parse_stmnt + nextln + loop + tag_of = new_tag(RELATIVE_FIXUP) + if prevstmnt <> BREAK_TKN // Fall through to next OF if no break + emit_branch(tag_of) + fin + emit_tag(tag_choice) + tag_choice = new_tag(RELATIVE_FIXUP) + break + is DEFAULT_TKN + emit_tag(tag_of) + tag_of = 0 + scan + while parse_stmnt + nextln + loop + if token <> ENDCASE_TKN; exit_err(ERR_INVAL|ERR_STATE); fin + break + is EOL_TKN + nextln + break + otherwise + exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE) + wend + loop + if (tag_of) + emit_tag(tag_of) + fin + emit_tag(break_tag) + emit_code(DROP_CODE) + break_tag = tag_prevbrk + stack_loop-- + break + is BREAK_TKN + if break_tag + emit_branch(break_tag) + else + exit_err(ERR_INVAL|ERR_STATE) + fin + break + is CONT_TKN + if cont_tag + emit_branch(cont_tag) + else + exit_err(ERR_INVAL|ERR_STATE) + fin + break + is RETURN_TKN + if infunc + for i = 1 to stack_loop + emit_code(DROP_CODE) + next + seq, cfnvals = parse_list + emit_seq(seq) + if cfnvals > infuncvals + exit_err(ERR_OVER|ERR_CLOSE|ERR_STATE) + elsif cfnvals < infuncvals + parse_warn("Too few return values") + while cfnvals < infuncvals + cfnvals++ + emit_const(0) + loop + fin + emit_leave + else + seq, cfnvals = parse_expr(NULL) + if not seq + emit_const(0) + else + if cfnvals > 1 + exit_err(ERR_OVER|ERR_CLOSE|ERR_STATE) + while cfnvals > 1;cfnvals--; seq = gen_op(seq, DROP_CODE); loop + fin + emit_seq(seq) + fin + emit_code(RET_CODE) + fin + break + is EOL_TKN + return TRUE + is ELSE_TKN + is ELSEIF_TKN + is FIN_TKN + is LOOP_TKN + is UNTIL_TKN + is NEXT_TKN + is OF_TKN + is DEFAULT_TKN + is ENDCASE_TKN + is END_TKN + is DONE_TKN + is DEF_TKN + is EOF_TKN + return FALSE + otherwise + rewind(tknptr) + seq = parse_set(NULL) + if seq + emit_seq(seq) + else + idptr = tknptr + seq, cfnvals = parse_value(NULL, RVALUE) + if seq + if token == INC_TKN or token == DEC_TKN + emit_seq(seq) + emit_code(token == INC_TKN ?? INC_CODE :: DEC_CODE) + rewind(idptr) + seq, drop = parse_value(NULL, LVALUE) + emit_seq(seq) + else + while cfnvals + seq = cat_seq(seq, gen_op(NULL, DROP_CODE)) + cfnvals-- + loop + emit_seq(seq) + fin + else + exit_err(ERR_SYNTAX) + fin + fin + wend + return scan == EOL_TKN +end +def parse_var(type, basesize)#0 + byte consttype, constsize, idlen + word idptr, constval, arraysize, size + + idlen = 0 + size = 1 + if scan == ID_TKN + idptr = tknptr + idlen = tknlen + if scan == OPEN_BRACKET_TKN + size, constsize, consttype = parse_constexpr + if token <> CLOSE_BRACKET_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_SYNTAX); fin + scan + fin + fin + size = size * basesize + if token == SET_TKN + if type & (EXTERN_TYPE|LOCAL_TYPE); exit_err(ERR_INVAL|ERR_LOCAL|ERR_INIT); fin + if idlen + new_iddata(idptr, idlen, type, 0) + fin + constval, constsize, consttype = parse_constexpr + arraysize = emit_data(type, consttype, constval, constsize) + while token == COMMA_TKN + constval, constsize, consttype = parse_constexpr + arraysize = arraysize + emit_data(type, consttype, constval, constsize) + loop + size_iddata(PTR_TYPE, size, arraysize) + else + if idlen + if infunc + new_idlocal(idptr, idlen, type, size) + else + new_iddata(idptr, idlen, type, size) + fin + elsif not (type & (EXTERN_TYPE|LOCAL_TYPE)) + emit_fill(size) + fin + fin +end +def parse_struc#0 + byte strucid[16] + byte idlen, struclen, constsize, consttype + word type, basesize, size, offset, idstr + + struclen = 0 + if scan == ID_TKN + struclen = tknlen + if struclen > 16 + struclen = 16 + fin + for idlen = 0 to struclen + strucid[idlen] = ^(tknptr + idlen) + next + scan + fin + offset = 0 + while nextln == BYTE_TKN or token == WORD_TKN or token == EOL_TKN + if token <> EOL_TKN + basesize = 1 + type = token == BYTE_TKN ?? BYTE_TYPE :: WORD_TYPE + if scan == OPEN_BRACKET_TKN + basesize, constsize, consttype = parse_constexpr + if token <> CLOSE_BRACKET_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_SYNTAX); fin + scan + fin + repeat + size = 1 + idlen = 0 + if token == ID_TKN + idstr = tknptr + idlen = tknlen + if scan == OPEN_BRACKET_TKN + size, constsize, consttype = parse_constexpr + if token <> CLOSE_BRACKET_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_SYNTAX); fin + scan + fin + fin + size = size * basesize + if type & WORD_TYPE + size = size * 2 + fin + if idlen + new_idconst(idstr, idlen, offset) + fin + offset = offset + size + until token <> COMMA_TKN + fin + loop + if struclen + new_idconst(@strucid, struclen, offset) + fin + if token <> END_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE); fin + scan +end +def parse_vars(type) + byte idlen, size, cfnparms, cfnvals + word value, idptr + + when token + is SYSFLAGS_TKN + if type & (EXTERN_TYPE | LOCAL_TYPE); exit_err(ERR_INVAL|ERR_GLOBAL|ERR_INIT); fin + modsysflags, drop, drop = parse_constexpr + break + is CONST_TKN + if scan <> ID_TKN; exit_err(ERR_INVAL|ERR_CONST); fin + idptr = tknptr + idlen = tknlen + if scan <> SET_TKN; exit_err(ERR_INVAL|ERR_CONST); fin + value, size, type = parse_constexpr + new_idconst(idptr, idlen, value) + break + is STRUC_TKN + parse_struc + break + is EXPORT_TKN + if type & (EXTERN_TYPE|LOCAL_TYPE); exit_err(ERR_INVAL|ERR_LOCAL|ERR_SYNTAX); fin + type = EXPORT_TYPE + if scan <> BYTE_TKN and token <> WORD_TKN // This could be an exported definition + rewind(tknptr) + scan + return FALSE + fin + // Fall through to BYTE or WORD declaration + is BYTE_TKN + is WORD_TKN + type = type | (token == BYTE_TKN ?? BYTE_TYPE :: WORD_TYPE) + size = 1 + if scan == OPEN_BRACKET_TKN // Get basesize for data elements + size, drop, drop = parse_constexpr + if token <> CLOSE_BRACKET_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_SYNTAX); fin + else + rewind(tknptr) + fin + if type & WORD_TYPE; size = size * 2; fin + repeat; parse_var(type, size); until token <> COMMA_TKN + break + is PREDEF_TKN + repeat + if scan == ID_TKN + type = type | PREDEF_TYPE + idptr = tknptr + idlen = tknlen + cfnparms = 0 + cfnvals = 1 // Default to one return value for compatibility + if scan == OPEN_PAREN_TKN + repeat + if scan == ID_TKN + cfnparms++ + scan + fin + until token <> COMMA_TKN + if token <> CLOSE_PAREN_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_SYNTAX); fin + scan + fin + if token == POUND_TKN + if not parse_const(@cfnvals); exit_err(ERR_INVAL|ERR_CONST); fin + scan + fin + new_idfunc(idptr, idlen, type, new_tag(type & EXTERN_TYPE ?? EXTERN_FIXUP|WORD_FIXUP :: WORD_FIXUP), cfnparms, cfnvals) + else + exit_err(ERR_MISS|ERR_ID) + fin + until token <> COMMA_TKN + break + is EOL_TKN + break + otherwise + return FALSE + wend + return TRUE +end +def parse_mods + if token == IMPORT_TKN + if scan <> ID_TKN; exit_err(ERR_MISS|ERR_ID); fin + new_moddep(tknptr, tknlen) + scan + while parse_vars(EXTERN_TYPE); nextln; loop + if token <> END_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE); fin + scan + fin + return token == EOL_TKN +end +def parse_lambda + word func_tag + byte cfnparms + byte lambda_id[4] + + if not infunc; exit_err(ERR_INVAL|ERR_STATE); fin + if inlambda; puts("Nested lambdas!\n"); exit_err(0); fin + // + // Parse parameters and return value count + // + save_idlocal + init_idlocal + cfnparms = 0 + inlambda = TRUE + if scan == OPEN_PAREN_TKN + repeat + if scan == ID_TKN + cfnparms++ + new_idlocal(tknptr, tknlen, WORD_TYPE, 2) + scan + fin + until token <> COMMA_TKN + if token <> CLOSE_PAREN_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_SYNTAX); fin + else + exit_err(ERR_MISS|ERR_ID) + fin + if lookahead == OPEN_PAREN_TKN + scan + lambda_seq[lambda_cnt], drop = parse_list + if token <> CLOSE_PAREN_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_SYNTAX); fin + else + lambda_seq[lambda_cnt], drop = parse_expr(NULL) + rewind(tknptr) + fin + // + // Build an anonymous ID string for the Lambda function + // + lambda_id:0 = 3 | ('&' << 8) + lambda_id.2 = ((lambda_num >> 3) & $07) + '0' + lambda_id.3 = (lambda_num & $07) + '0' + lambda_num++ + if lookup_idglobal(@lambda_id.1, 3) + // + // Lambda ID already exists (from failed scanning for '=') + // + func_tag = lambda_tag[lambda_cnt] + set_idfunc(@lambda_id.1, 3, func_tag, cfnparms, 1) // Override any predef type & tag + else + // + // Creat new Lambda ID + // + func_tag = new_tag(WORD_FIXUP) + lambda_tag[lambda_cnt] = func_tag + lambda_cparms[lambda_cnt] = cfnparms + new_idfunc(@lambda_id.1, 3, FUNC_TYPE, func_tag, cfnparms, 1) + fin + lambda_cnt++ + if lambda_cnt >= LAMBDANUM; parse_warn("Lambda function overflow"); fin + inlambda = FALSE + restore_idlocal + return func_tag +end +def parse_defs + byte idlen, cfnparms, cfnvals + word type, idstr, func_tag, idptr + + type = FUNC_TYPE + if token == EXPORT_TKN + if scan <> DEF_TKN; exit_err(ERR_INVAL|ERR_STATE); fin + type = type | EXPORT_TYPE + fin + if token == DEF_TKN + if scan <> ID_TKN; exit_err(ERR_INVAL|ERR_ID); fin + lambda_cnt = 0 + cfnparms = 0 + infuncvals = 1 + infunc = TRUE + idstr = tknptr + idlen = tknlen + init_idlocal + if scan == OPEN_PAREN_TKN + repeat + if scan == ID_TKN + cfnparms++ + new_idlocal(tknptr, tknlen, WORD_TYPE, 2) + scan + fin + until token <> COMMA_TKN + if token <> CLOSE_PAREN_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_SYNTAX); fin + scan + fin + if token == POUND_TKN + if not parse_const(@infuncvals); exit_err(ERR_INVAL|ERR_CONST); fin + scan + fin + idptr = lookup_idglobal(idstr, idlen) + if idptr + if not idptr=>idtype & PREDEF_TYPE; exit_err(ERR_DUP|ERR_ID); fin + if idptr->funcparms <> cfnparms or idptr->funcvals <> infuncvals; exit_err(ERR_DUP|ERR_CODE|ERR_ID); fin + func_tag = idptr=>idval + idptr=>idtype = idptr=>idtype | type + else + func_tag = new_tag(WORD_FIXUP) + new_idfunc(idstr, idlen, type, func_tag, cfnparms, infuncvals) + fin + emit_tag(func_tag) + while parse_vars(LOCAL_TYPE); nextln; loop + emit_enter(cfnparms) + prevstmnt = 0 + while parse_stmnt; nextln; loop + infunc = FALSE + if token <> END_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE); fin + scan + if prevstmnt <> RETURN_TKN + if infuncvals; parse_warn("No return values"); fin + for cfnvals = infuncvals - 1 downto 0 + emit_const(0) + next + emit_leave + fin + while lambda_cnt + lambda_cnt-- + emit_lambdafunc(lambda_tag[lambda_cnt], lambda_cparms[lambda_cnt], lambda_seq[lambda_cnt]) + loop + fin + return token == EOL_TKN ?? TRUE :: FALSE +end +def parse_module#0 + init_idglobal + init_idlocal + if nextln + // + // Compile module + // + while parse_mods; nextln; loop + while parse_vars(GLOBAL_TYPE); nextln; loop + while parse_defs; nextln; loop + entrypoint = codeptr + prevstmnt = 0 + init_idlocal + emit_enter(0) + if token <> DONE_TKN + while parse_stmnt; nextln; loop + fin + if prevstmnt <> RETURN_TKN + emit_const(0) + emit_leave + fin + if token <> DONE_TKN; parse_warn("Missing DONE\n"); fin + //dumpsym(idglobal_tbl, globals) + fin +end diff --git a/src/toolsrc/plasm.pla b/src/toolsrc/plasm.pla new file mode 100644 index 0000000..5372e69 --- /dev/null +++ b/src/toolsrc/plasm.pla @@ -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]] [out]\n") +fin +done diff --git a/src/toolsrc/sb.pla b/src/toolsrc/sb.pla index d6d058e..4d28d29 100644 --- a/src/toolsrc/sb.pla +++ b/src/toolsrc/sb.pla @@ -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 diff --git a/src/toolsrc/swyftcode.pla b/src/toolsrc/swyftcode.pla deleted file mode 100644 index 285c4af..0000000 --- a/src/toolsrc/swyftcode.pla +++ /dev/null @@ -1,4207 +0,0 @@ -// -// Global constants -// -const FALSE = 0 -const TRUE = 1 -// -// Hardware constants -// -const csw = $0036 -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 pushbttn1 = $C061 -const pushbttn2 = $C062 -const pushbttn3 = $C063 -const keyboard = $C000 -const keystrobe = $C010 -const keyenter = $8D -const keyspace = $A0 -const keyarrowup = $8B -const keyarrowdown = $8A -const keyarrowleft = $88 -const keyarrowright = $95 -const keyescape = $9B -const keyctrla = $81 -const keyctrlb = $82 -const keyctrlc = $83 -const keyctrld = $84 -const keyctrle = $85 -const keyctrlf = $86 -const keyctrli = $89 -const keyctrlk = $8B -const keyctrll = $8C -const keyctrln = $8E -const keyctrlo = $8F -const keyctrlp = $90 -const keyctrlq = $91 -const keyctrlr = $92 -const keyctrls = $93 -const keyctrlt = $94 -const keyctrlu = $95 -const keyctrlv = $96 -const keyctrlw = $97 -const keyctrlx = $98 -const keyctrly = $99 -const keyctrlz = $9A -const keydelete = $FF -const getbuff = $01FF -// -// Data and text buffer constants -// -const machid = $BF98 -const maxlines = 626 -const maxfill = 640 -const iobuffer = $0800 -const databuff = $0C00 -const strlinbuf = $1000 -const strheapmap = $1500 -const strheapmsz = $80 // = memory@16 bytes per bit map, 128 bytes per 8 bit map, 1K bytes per 8 byte map -const maxlnlen = 79 -const strheap = $6800 -const strheasz = $4000 -const codebuff = $A800 -const codebuffsz = $1000 -const pgjmp = 16 -const changed = 1 -const insmode = 2 -const showcurs = 4 -const uppercase = 8 -const shiftlock = 128 -// -// Argument buffer (must be first declared variables) -// -word signature = $EEEE // buffer signature -byte = 32 // buffer length -byte[32] argbuff = "" // buffer -// -// Text screen row address array -// -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 -// -// Editor variables -// -byte nullstr = "" -byte version = "PLASMA ][ SWYFTCODE VERSION 00.11 " -byte errorstr = "ERROR: $" -byte okstr = "OK" -byte outofmem = "OUT OF MEMORY!" -byte losechng = "LOSE CHANGES TO FILE (Y/N)?" -byte untitled = "UNTITLED.PLA" -byte[64] txtfile = "UNTITLED.PLA" -byte flags = 0 -byte flash = 0 -word numlines = 0 -word cutbuf = 0 -byte perr, cursx, cursy, scrnleft, curscol, underchr, curschr -word keyin, cursrow, scrntop, cursptr -// -// Predeclared functions -// -predef cmdmode -// -// Compiler variables -// -// -// Tokens -// -const ID_TKN = $D6 // V -const CHR_TKN = $C3 // C -const INT_TKN = $C9 // I -const HEX_TKN = $9D -const STR_TKN = $D3 // S -const EOL_TKN = $02 -const EOF_TKN = $01 -const ERR_TKN = $00 -// -// 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 COMP_TKN = $A3 // # -const LOGIC_NOT_TKN = $FE // ~ -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 -// -// 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 // // -// -// 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 DONE_TKN = $98 -const RETURN_TKN = $99 -const BREAK_TKN = $9A -const CONT_TKN = $9B -const EXIT_TKN = $9C -const PREDEF_TKN = $9E -// -// Types -// -const CONST_TYPE = $01 -const BYTE_TYPE = $02 -const WORD_TYPE = $04 -const VAR_TYPE = $06 // (WORD_TYPE | BYTE_TYPE) -const FUNC_TYPE = $08 -const FUNC_CONST_TYPE = $09 -const ADDR_TYPE = $0E // (VAR_TYPE | FUNC_TYPE) -const LOCAL_TYPE = $10 -const BPTR_TYPE = $20 -const WPTR_TYPE = $40 -const PTR_TYPE = $60 // (BPTR_TYPE | WPTR_TYPE) -const XBYTE_TYPE = $22 // (BPTR_TYPE | BYTE_TYPE) -const XWORD_TYPE = $44 // (WPTR_TYPE | WORD_TYPE) -const CONSTADDR_TYPE = $61 // (CONST_TYPE | PTR_TYPE) -const STR_TYPE = $80 -// -// 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 = "BYTE", BYTE_TKN -byte = "WORD", WORD_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 = "CONST", CONST_TKN -byte = "STRUC", STRUC_TKN -byte = "ELSIF", ELSEIF_TKN -byte = "WHILE", WHILE_TKN -byte = "UNTIL", UNTIL_TKN -byte = "BREAK", BREAK_TKN -byte = "DOWNTO", DOWNTO_TKN -byte = "REPEAT", REPEAT_TKN -byte = "RETURN", RETURN_TKN -byte = "PREDEF", PREDEF_TKN -byte = "CONTINUE", CONT_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 = -1 -// -// Symbol table variables -// -const idglobal_tblsz = 2048 -const idlocal_tblsz = 512 -const idglobal_tbl = $1600 -const idlocal_tbl = $1E00 -const ctag_max = 1024 -const ctag_tbl = $800 -const idval = 0 -const idtype = 2 -const idname = 3 -const idrecsz = 4 -word globals = 0 -word datasize = 0 -word lastglobal -byte locals = 0 -word framesize = 0 -word lastlocal -const IS_RESOLVED = $8000 -const IS_RELATIVE = $8000 -const IS_CTAG = $8000 -const MASK_CTAG = $7FFF -word codetag = -1 -word codeptr, entrypoint = 0 -byte lastop = $FF -// -// Scanner variables -// -const inbuff = $0200 -const instr = $01FF -word scanptr = @nullstr -byte scanchr, token, tknlen -byte parserrpos, parserr = 0 -word tknptr, parserrln -word constval -word lineno = 0 -// -// Compiler output messages -// -//byte entrypt_str[] = "START: " -byte bytes_compiled_str[] = "\nBYTES COMPILED: " -//byte comp_ok_msg[] = "COMPILATION COMPLETE" -byte dup_id[] = "DUPLICATE IDENTIFIER" -byte undecl_id[] = "UNDECLARED IDENTIFIER" -byte bad_cnst[] = "BAD CONSTANT" -byte bad_struc[] = "BAD STRUCTURE" -byte bad_offset[] = "BAD STRUCT OFFSET" -byte bad_decl[] = "BAD DECLARATION" -byte bad_op[] = "BAD OPERATION" -byte bad_stmnt[] = "BAD STATMENT" -byte bad_expr[] = "BAD EXPRESSION" -byte bad_syntax[] = "BAD SYNTAX" -byte estk_overflw[] = "EVAL STACK OVERFLOW" -byte estk_underflw[] = "EVAL STACK UNDERFLOW" -byte local_overflw[] = "LOCAL FRAME OVERFLOW" -byte global_sym_overflw[] = "GLOBAL SYMBOL TABLE OVERFLOW" -byte local_sym_overflw[] = "LOCAL SYMBOL TABLE OVERFLOW" -byte ctag_full[] = "CODE LABEL OVERFLOW" -byte no_ctag_offst[] = "CODE OFFSET NOT SUPPORTED" -byte no_close_paren[] = "MISSING CLOSING PAREN" -byte no_close_bracket[] = "MISSING CLOSING BRACKET" -byte missing_op[] = "MISSING OPERAND" -byte no_fin[] = "MISSING FIN" -byte no_loop[] = "MISSING LOOP" -byte no_until[] = "MISSING UNTIL" -byte no_done[] = "MISSING DONE" -byte no_local_init[] = "NO INITIALIZED LOCALS" -// -// Runtime functions -// -byte runtime0[] = "call" -byte RUNTIME0[] = "CALL" -byte runtime1[] = "syscall" -byte RUNTIME1[] = "SYSCALL" -byte runtime2[] = "memset" -byte RUNTIME2[] = "MEMSET" -byte runtime3[] = "memcpy" -byte RUNTIME3[] = "MEMCPY" -byte runtime4[] = "putc" -byte RUNTIME4[] = "PUTC" -byte runtime5[] = "getc" -byte RUNTIME5[] = "GETC" -byte runtime6[] = "puts" -byte RUNTIME6[] = "PUTS" -byte runtime7[] = "gets" -byte RUNTIME7[] = "GETS" -byte runtime8[] = "puti" -byte RUNTIME8[] = "PUTI" -byte runtime9[] = "home" -byte RUNTIME9[] = "HOME" -byte runtime10[] = "gotoxy" -byte RUNTIME10[] = "GOTOXY" -// -// Parser variables -// -byte infunc = 0 -byte stack_loop = 0 -byte prevstmnt = 0 -word retfunc_tag = 0 -word break_tag = 0 -word cont_tag = 0 -predef parse_expr, parse_module -// -// ASM utility functions -// -// Defines for ASM routines -// -asm equates -INTERP = $03D0 -LCRDEN = $C080 -LCWTEN = $C081 -ROMEN = $C082 -LCRWEN = $C083 -LCBNK2 = $00 -LCBNK1 = $08 - !SOURCE "vmsrc/plvmzp.inc" -end -// -// SAVE VM STATE -// -asm save_vmstate - LDA $03F2 - STA VMRESET - LDA $03F3 - STA VMRESET+1 - LDA $03F4 - STA VMRESET+2 - LDA #RESETENTRY - STA $03F3 - EOR #$A5 - STA $03F4 - DEX - RTS -end -// -// RESTORE VM STATE -// -asm restore_vmstate -RESETENTRY - LDA VMRESET - STA $03F2 - LDA VMRESET+1 - STA $03F3 - LDA VMRESET+2 - STA $03F4 - LDX #$00 - STX IFPL - LDA #$BF - STA IFPH - LDX #$FE - TXS - LDX #ESTKSZ/2 - BIT ROMEN - JMP $2000 -VMRESET !FILL 3 -end -// -// CALL 6502 ROUTINE -// CALL(ADDR, AREG, XREG, YREG, STATUS) -// -asm call -REGVALS = SRC - PHP - LDA ESTKL+4,X - STA TMPL - LDA ESTKH+4,X - STA TMPH - LDA ESTKL,X - PHA - LDA ESTKL+1,X - TAY - LDA ESTKL+3,X - PHA - LDA ESTKL+2,X - INX - INX - INX - INX - STX ESP - TAX - PLA - BIT ROMEN - PLP - JSR JMPTMP - PHP - BIT LCRDEN+LCBNK2 - STA REGVALS+0 - STX REGVALS+1 - STY REGVALS+2 - PLA - STA REGVALS+3 - LDX ESP - LDA #REGVALS - STA ESTKL,X - STY ESTKH,X - PLP - RTS -JMPTMP JMP (TMP) -end -// -// CALL PRODOS -// SYSCALL(CMD, PARAMS) -// -asm syscall - LDA ESTKL,X - LDY ESTKH,X - STA PARAMS - STY PARAMS+1 - INX - LDA ESTKL,X - STA CMD - JSR $BF00 -CMD: !BYTE 00 -PARAMS: !WORD 0000 - LDY #$00 - STA ESTKL,X - STY ESTKH,X - RTS -end -// SET MEMORY TO VALUE -// MEMSET(ADDR, SIZE, VALUE) -// With optimizations from Peter Ferrie -// -asm memset - LDY #$00 - LDA ESTKL+2,X - STA DSTL - LDA ESTKH+2,X - STA DSTH - INC ESTKL+1,X - INC ESTKH+1,X -SETMLPL CLC - LDA ESTKL,X -SETMLPH DEC ESTKL+1,X - BNE + - DEC ESTKH+1,X - BEQ SETMEX -+ STA (DST),Y - INY - BNE + - INC DSTH -+ BCS SETMLPL - SEC - LDA ESTKH,X - BCS SETMLPH -SETMEX INX - INX - RTS -end -// -// COPY MEMORY -// MEMCPY(DSTADDR, SRCADDR, SIZE) -// -asm memcpy - INX - INX - LDA ESTKL-2,X - ORA ESTKH-2,X - BEQ CPYMEX - LDA ESTKL-1,X - CMP ESTKL,X - LDA ESTKH-1,X - SBC ESTKH,X - BCC REVCPY -; -; FORWARD COPY -; - LDA ESTKL,X - STA DSTL - LDA ESTKH,X - STA DSTH - LDA ESTKL-1,X - STA SRCL - LDA ESTKH-1,X - STA SRCH - INC ESTKH-2,X - LDY #$00 -FORCPYLP LDA (SRC),Y - STA (DST),Y - INY - BNE + - INC DSTH - INC SRCH -+ DEC ESTKL-2,X - BNE FORCPYLP - DEC ESTKH-2,X - BNE FORCPYLP - RTS -; -; REVERSE COPY -; -REVCPY ;CLC - LDA ESTKL-2,X - ADC ESTKL,X - STA DSTL - LDA ESTKH-2,X - ADC ESTKH,X - STA DSTH - CLC - LDA ESTKL-2,X - ADC ESTKL-1,X - STA SRCL - LDA ESTKH-2,X - ADC ESTKH-1,X - STA SRCH - DEC DSTH - DEC SRCH - LDY #$FF - LDA ESTKL-2,X - BEQ REVCPYLP - INC ESTKH-2,X -REVCPYLP LDA (SRC),Y - STA (DST),Y - DEY - CPY #$FF - BNE + - DEC DSTH - DEC SRCH -+ DEC ESTKL-2,X - BNE REVCPYLP - DEC ESTKH-2,X - BNE REVCPYLP -CPYMEX RTS -end -// -// CHAR OUT -// COUT(CHAR) -// -asm cout - LDA ESTKL,X - BIT $BF98 - BMI + - JSR TOUPR -+ ORA #$80 - BIT ROMEN - JSR $FDED - BIT LCRDEN+LCBNK2 - RTS -end -// -// CHAR IN -// RDKEY() -// -asm cin - BIT ROMEN - JSR $FD0C - BIT LCRDEN+LCBNK2 - DEX - LDY #$00 - AND #$7F - STA ESTKL,X - STY ESTKH,X - RTS -end -// -// PRINT STRING -// PRSTR(STR) -// -asm prstr - LDY #$00 - LDA ESTKL,X - STA SRCL - LDA ESTKH,X - STA SRCH - LDA (SRC),Y - STA TMP - BEQ ++ - BIT ROMEN -- INY - LDA (SRC),Y - BIT $BF98 - BMI + - JSR TOUPR -+ ORA #$80 - JSR $FDED - CPY TMP - BNE - - BIT LCRDEN+LCBNK2 -++ RTS -end -// -// READ STRING -// STR = RDSTR(PROMPTCHAR) -// -asm rdstr - LDA ESTKL,X - STA $33 - STX ESP - BIT ROMEN - JSR $FD6A - BIT LCRDEN+LCBNK2 - STX $01FF -- LDA $01FF,X - AND #$7F - STA $01FF,X - DEX - BPL - - TAX - LDX ESP - STA ESTKL,X - LDA #$01 - STA ESTKH,X - RTS -end -// -// EXIT -// -asm exit - JSR $BF00 - !BYTE $65 - !WORD EXITTBL -EXITTBL: - !BYTE 4 - !BYTE 0 -end -//def toupper_11(c) -// if c >= 'a' -// if c <= 'z' -// return c - $20 -// fin -// fin -// return c -//end -asm toupper - LDA ESTKL,X -TOUPR AND #$7F - CMP #'z'+1 - BCS + - CMP #'a' - BCC + - SBC #$20 -+ STA ESTKL,X - RTS -end -asm clrhibit(strptr) - LDA ESTKL,X - STA SRCL - LDA ESTKH,X - STA SRCH - LDY #$00 - LDA (SRC),Y - BEQ + - TAY -CLHILP LDA (SRC),Y - AND #$7F - STA (SRC),Y - DEY - BNE CLHILP -+ RTS -end -asm sethibit(strptr) - LDA ESTKL,X - STA SRCL - LDA ESTKH,X - STA SRCH - LDY #$00 - LDA (SRC),Y - BEQ + - TAY -STHILP LDA (SRC),Y - ORA #$80 - STA (SRC),Y - DEY - BNE STHILP -+ RTS -end -asm cpyln(srcstr, dststr) - LDA ESTKL,X - STA DSTL - LDA ESTKH,X - STA DSTH - INX - LDA ESTKL,X - STA SRCL - LDA ESTKH,X - STA SRCH - LDY #$00 - LDA (SRC),Y - TAY - LDA #$00 - INY - STA (DST),Y - DEY - BEQ ++ -CPLNLP LDA (SRC),Y - CMP #$20 - BCS + - ADC #$60 -+ AND #$7F - STA (DST),Y - DEY - BNE CPLNLP - LDA (SRC),Y -++ STA (DST),Y - RTS -end -// -//def skipspace(scanptr) -// while ^scanptr == ' ' -// scanptr = scanptr + 1 -// loop -// return scanptr -//end -asm skipspace(scanptr) - LDA #$00 - STA SRCL - LDA ESTKH,X - STA SRCH - LDY ESTKL,X -- LDA (SRC),Y - CMP #' ' - BNE + - INY - BNE - - INC SRCH - BNE - -+ STY ESTKL,X - LDA SRCH - STA ESTKH,X - RTS -end -//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 -asm isalpha - LDY #$00 - LDA ESTKL,X - CMP #'_' - BEQ ISALTRU - CMP #'A' - BCC ISALRET - AND #$DF - CMP #'Z'+1 - BCS ISALRET -ISALTRU DEY -ISALRET STY ESTKL,X - STY ESTKH,X - RTS -end -//def isnum(c) -// if c >= '0' and c <= '9' -// return TRUE -// fin -// return FALSE -//end -asm isnum - LDY #$00 - LDA ESTKL,X - CMP #'0' - BCC + - CMP #'9'+1 - BCS + - DEY -+ STY ESTKL,X - STY ESTKH,X - RTS -end -//def isalphanum(c) -// if c >= 'A' and c <= 'Z' -// return TRUE -// elsif c >= '0' and c <= '9' -// return TRUE -// elsif c >= 'a' and c <= 'z' -// return TRUE -// elsif c == '_' -// return TRUE -// fin -// return FALSE -//end -asm isalphanum - LDY #$00 - LDA ESTKL,X - CMP #'_' - BEQ ISANTRU - CMP #'0' - BCC ISANRET - CMP #'9'+1 - BCC ISANTRU - CMP #'A' - BCC ISANRET - AND #$DF - CMP #'Z'+1 - BCS ISANRET -ISANTRU DEY -ISANRET STY ESTKL,X - STY ESTKH,X - RTS -end -// -// Runtime routines -// -def home - return call($FC58, 0, 0, 0, 0) -end -def gotoxy(x, y) - ^$24 = x + ^$20 - return call($FB5B, y + ^$22, 0, 0, 0) -end -// -// ProDOS routines -// -def getpfx(path) - byte params[3] - - ^path = 0 - params.0 = 1 - params:1 = path - perr = syscall($C7, @params) - return path -end -def setpfx(path) - byte params[3] - - params.0 = 1 - params:1 = path - perr = syscall($C6, @params) - return path -end -def open(path, buff) - byte params[6] - - params.0 = 3 - params:1 = path - params:3 = buff - params.5 = 0 - perr = syscall($C8, @params) - return params.5 -end -def close(refnum) - byte params[2] - - params.0 = 1 - params.1 = refnum - perr = syscall($CC, @params) - return perr -end -def read(refnum, buff, len) - byte params[8] - - params.0 = 4 - params.1 = refnum - params:2 = buff - params:4 = len - params:6 = 0 - perr = syscall($CA, @params) - return params:6 -end -def write(refnum, buff, len) - byte params[8] - - params.0 = 4 - params.1 = refnum - params:2 = buff - params:4 = len - params:6 = 0 - perr = syscall($CB, @params) - return params:6 -end -def create(path, access, type, aux) - byte params[12] - - params.0 = 7 - params:1 = path - params.3 = access - params.4 = type - params:5 = aux - params.7 = $1 - params:8 = 0 - params:10 = 0 - perr = syscall($C0, @params) - return perr -end -def destroy(path) - byte params[12] - - params.0 = 1 - params:1 = path - perr = syscall($C1, @params) - return perr -end -def newline(refnum, emask, nlchar) - byte params[4] - - params.0 = 3 - params.1 = refnum - params.2 = emask - params.3 = nlchar - perr = syscall($C9, @params) - return perr -end - -//===================================== -// -// Editor -// -//===================================== - -def crout - cout($0D) -end -def bell - return call($FBDD, 0, 0, 0, 0) -end -// -// Memory management routines -// -def heapaddr(ofst, mask) - word addr - - addr = (ofst << 7) + strheap - while !(mask & 1) - addr = addr + 16 - mask = mask >> 1 - loop - return addr -end -def sizemask(size) - if size <= 16 - return $01 - elsif size <= 32 - return $03 - elsif size <= 48 - return $07 - elsif size <= 64 - return $0F - elsif size <= 80 - return $1F - fin - return 0 -end -def heapalloc(size) - byte szmask, i - word mapmask - - szmask = sizemask(size) - for i = strheapmsz - 1 downto 0 - if strheapmap.[i] <> $FF - mapmask = szmask - repeat - if strheapmap.[i] & mapmask - mapmask = mapmask << 1 - else - strheapmap.[i] = strheapmap.[i] | mapmask - return heapaddr(i, mapmask) - fin - until mapmask & $100 - fin - next - bell() - prstr(@outofmem) - return 0 -end -// -// Tokenizer -// -def keymatch(tknptr, tknlen) - 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 toupper(^(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 strtotkn(str, strlen) - word charptr, tknptr, strptr - byte[128] tknize - - // - // Skip whitespace - // - charptr = skipspace(str) - tknptr = @tknize.1 - // - // Save indentation amount - // - ^tknptr = charptr - str - // - // Beginning of token. - // - strptr = charptr - while (charptr - str) < strlen - // - // Scan for token based on first character - // - tknlen = 1 - if isalpha(^charptr) - // - // ID, either variable name or reserved word - // - repeat - charptr = charptr + 1 - until !isalphanum(^charptr) - tknlen = charptr - strptr - token = keymatch(strptr, tknlen) - if token == ID_TKN - // - // Copy ID string to tokenized stream - // - ^(tknptr + 1) = tknlen - while strptr < charptr - ^(tknptr = ^strptr - strptr = strptr + 1 - loop - fin - elsif isnum(scanchr) - // - // Decimal constant - // - constval = 0 - repeat - constval = constval * 10 + ^scanptr - '0' - scanptr = scanptr + 1 - until !isnum(^scanptr) - // - // Copy constant value to tokenized stream - // - token = INT_TKN - *(tknptr + 1) = constval - tknlen = 3 - else - // - // Potential multiple character tokens - // - when charptr - is '/' - if ^(charptr + 1) == '/' - token = COMMENT_TKN - charptr = charptr + 2 - // - // Copy comment string to tokenized stream - // - while (charptr - strptr) < strlen - ^(tknptr + tknlen + 2) = ^charptr - strptr = strptr + 1 - tknlen = tknlen + 1 - loop - ^(tknptr + 1) = tknlen - else - token = DIV_TKN - fin - break - is '=' - if ^(charptr + 1) == '=' - token = EQ_TKN - charptr = charptr + 2 - elsif ^(charptr + 1) == '>' - token = PTRW_TKN - charptr = charptr + 2 - else - token = SET_TKN - charptr = charptr + 1 - fin - break - is '-' - if ^(charptr + 1) == '>' - token = PTRB_TKN - charptr = charptr + 2 - else - token = SUB_TKN - charptr = charptr + 1 - fin - break - is '>' - if ^(charptr + 1) == '>' - token = SHR_TKN - charptr = charptr + 2 - elsif ^(charptr + 1) == '=' - token = GE_TKN - charptr = charptr + 2 - else - token = GT_TKN - charptr = charptr + 1 - fin - break - is '<' - if ^(charptr + 1) == '<' - token = SHL_TKN - charptr = charptr + 2 - elsif ^(charptr + 1) == '=' - token = LE_TKN - charptr = charptr + 2 - elsif ^(charptr + 1) == '>' - token = NE_TKN - charptr = charptr + 2 - else - token = LT_TKN - charptr = charptr + 1 - fin - break - is '$' - // - // Hexadecimal constant - // - token = HEX_TKN - tknlen = 3 - constval = 0 - repeat - charptr = charptr + 1 - if ^charptr >= '0' and ^charptr <= '9' - constval = (constval << 4) + ^charptr - '0' - elsif ^charptr >= 'A' and ^charptr <= 'F' - constval = (constval << 4) + ^charptr - '7'// 'A'-10 - elsif ^charptr >= 'a' and ^charptr <= 'f' - constval = (constval << 4) + ^charptr - 'W'// 'a'-10 - else - *(tknptr + 1) = constval - break - fin - until !^charptr - *(tknptr + 1) = constval - break - is $27 // ' - // - // Character constant - // - token = CHR_TKN - if ^(charptr + 1) <> $5C // \ - constval = ^(charptr + 1) - if ^(charptr + 2) <> $27 // ' - return parse_err(@bad_cnst) - fin - charptr = charptr + 3 - else - when ^(charptr + 2) - is 'n' - constval = $0D; break - is 'r' - constval = $0A; break - is 't' - constval = $09; break - otherwise - constval = ^(charptr + 2) - wend - if ^(charptr + 3) <> $27 // ' - return parse_err(@bad_cnst) - fin - charptr = charptr + 4 - fin - ^(tknptr + 1 = constval - tknlen = 2 - break - is '"' - // - // String constant - // - token = STR_TKN - charptr = charptr + 1 - constval = scanptr - while ^charptr and ^charptr <> '"' - charptr = charptr + 1 - loop - if !^charptr - return parse_err(@bad_cnst) - fin - charptr = charptr + 1 - break - is 0 - is ';' - if token <> EOF_TKN - token = EOL_TKN - fin - break - otherwise - // - // Simple single character tokens - // - token = scanchr | $80 - charptr = charptr + 1 - wend - fin - ^tknptr = token - tknptr = tknptr + tknlen - loop - return token -end -def tkntostr(tknptr, strptr) - byte strlen - - return strlen -end -// -// String utilities -// -def freestr(strptr) - byte mask, ofst - - if strptr and strptr <> @nullstr - mask = sizemask(^strptr + 1) - ofst = (strptr - strheap) >> 4 - mask = mask << (ofst & $07) - ofst = ofst >> 3 - strheapmap.[ofst] = strheapmap.[ofst] & ~mask - fin -end -def newstr(strptr) - byte strlen - word newptr - - strlen = ^strptr - while ^(strptr + strlen) == $8D or ^(strptr + strlen) == $A0 - strlen = strlen - 1 - loop - if strlen == 0 - return @nullstr - fin - newptr = heapalloc(strlen + 1) - if newptr - memcpy(newptr, strptr, strlen + 1) - ^newptr = strlen - return newptr - fin - return @nullstr -end -def strcpy(dststr, srcstr) - byte strlen - - strlen = ^srcstr - while ^(srcstr + strlen) == $8D or ^(srcstr + strlen) == $A0 - strlen = strlen - 1 - loop - ^dststr = strlen - memcpy(dststr + 1, srcstr + 1, strlen) -end -def inittxtbuf - word i - - memset(strheapmap, strheapmsz, 0) - memset(strlinbuf, maxfill * 2, @nullstr) - numlines = 1 - cursrow = 0 - curscol = 0 - cursx = 0 - cursy = 0 - scrnleft = 0 - scrntop = 0 - cutbuf = 0 -end -// -// Case conversion/printing routines -// -def caseconv(chr) - if flags & uppercase - if chr & $E0 == $E0 - chr = chr - $E0 - fin - fin - return chr -end -def strupper(strptr) - byte i, chr - - for i = ^strptr downto 1 - chr = ^(strptr + i) - if chr & $E0 == $E0 - ^(strptr + i) = chr - $E0 - fin - next -end -def strlower(strptr) - byte i, chr - - for i = ^strptr downto 1 - chr = ^(strptr + i) - if chr & $E0 == $00 - ^(strptr + i) = chr + $E0 - fin - next -end -def txtupper - word i, strptr - - flags = flags | uppercase - for i = numlines - 1 downto 0 - strupper(strlinbuf:[i]) - next -end -def txtlower - word i, strptr - - flags = flags & ~uppercase - for i = numlines - 1 downto 0 - strlower(strlinbuf:[i]) - next -end -def prbyte(h) - cout('$') - return call($FDDA, h, 0, 0, 0) -end -def prword(h) - cout('$') - return call($F941, h >> 8, h, 0, 0) -end -def print(i) - byte numstr[7] - byte place, sign - - place = 6 - if i < 0 - sign = 1 - i = -i - else - sign = 0 - fin - while i >= 10 - numstr[place] = i % 10 + '0' - i = i / 10 - place = place - 1 - loop - numstr[place] = i + '0' - place = place - 1 - if sign - numstr[place] = '-' - place = place - 1 - fin - numstr[place] = 6 - place - return prstr(@numstr[place]) -end -def nametostr(namestr, len, strptr) - ^strptr = len - return memcpy(strptr + 1, namestr, len) -end -// -// File routines -// -def readtxt(filename) - byte txtbuf[81], refnum, i, j - - refnum = open(filename, iobuffer) - if refnum - newline(refnum, $7F, $0D) - repeat - txtbuf = read(refnum, @txtbuf + 1, maxlnlen) - if txtbuf - sethibit(@txtbuf) - if flags & uppercase; strupper(@txtbuf); fin - strlinbuf:[numlines] = newstr(@txtbuf) - numlines = numlines + 1 - fin - if !(numlines & $0F); cout('.'); fin - until txtbuf == 0 or numlines == maxlines - close(refnum) - // - // Make sure there is a blank line at the end of the buffer - // - if numlines < maxlines and strlinbuf:[numlines - 1] <> @nullstr - strlinbuf:[numlines] = @nullstr - numlines = numlines + 1 - fin - fin -end -def writetxt(filename) - byte txtbuf[81], refnum - byte j, chr - word i, strptr - - destroy(filename) - create(filename, $C3, $04, $00) // full access, TXT file - refnum = open(filename, iobuffer) - if refnum == 0 - return - fin - // - // Remove blank lines at end of text. - // - while numlines > 1 and strlinbuf:[numlines - 1] == @nullstr; numlines = numlines - 1; loop - // - // Write all the text line to the file. - // - for i = 0 to numlines - 1 - cpyln(strlinbuf:[i], @txtbuf) - txtbuf = txtbuf + 1 - txtbuf[txtbuf] = $0D - write(refnum, @txtbuf + 1, txtbuf) - if !(i & $0F); cout('.'); fin - next - return close(refnum) -end -// -// Screen routines -// -def clrscrn - return call($FC58, 0, 0, 0, 0) -end -def drawrow(row, ofst, strptr) - byte numchars - word scrnptr - - scrnptr = txtscrn[row] - if ofst >= ^strptr - numchars = 0 - else - numchars = ^strptr - ofst - fin - if numchars >= 40 - numchars = 40 - else - memset(scrnptr + numchars, 40 - numchars, $A0A0) - fin - return memcpy(scrnptr, strptr + ofst + 1, numchars) -end -def drawscrn(toprow, ofst) - byte row, numchars - word strptr, scrnptr - - for row = 0 to 23 - strptr = strlinbuf:[toprow + row] - scrnptr = txtscrn[row] - if ofst >= ^strptr - numchars = 0 - else - numchars = ^strptr - ofst - fin - if numchars >= 40 - numchars = 40 - else - memset(scrnptr + numchars, 40 - numchars, $A0A0) - fin - memcpy(scrnptr, strptr + ofst + 1, numchars) - next -end -def cursoff - if flags & showcurs - ^cursptr = underchr - flags = flags & ~showcurs - fin -end -def curson - if !(flags & showcurs) - cursptr = txtscrn[cursy] + cursx - underchr = ^cursptr - ^cursptr = curschr - flags = flags | showcurs - fin -end -def cursflash - if flags & showcurs - if flash == 0 - ^cursptr = curschr - elsif flash == 128 - ^cursptr = underchr - fin - flash = flash + 1 - fin -end -def redraw - cursoff - drawscrn(scrntop, scrnleft) - curson -end -def curshome - cursoff - cursrow = 0 - curscol = 0 - cursx = 0 - cursy = 0 - scrnleft = 0 - scrntop = 0 - drawscrn(scrntop, scrnleft) - return curson -end -def cursend - cursoff - if numlines > 23 - cursrow = numlines - 1 - cursy = 23 - scrntop = cursrow - 23 - else - cursrow = numlines - 1 - cursy = numlines - 1 - scrntop = 0 - fin - curscol = 0 - cursx = 0 - scrnleft = 0 - drawscrn(scrntop, scrnleft) - return curson -end -def cursup - if cursrow > 0 - cursoff - cursrow = cursrow - 1 - if cursy > 0 - cursy = cursy - 1 - else - scrntop = cursrow - drawscrn(scrntop, scrnleft) - fin - curson - fin -end -def pgup - byte i - - for i = pgjmp downto 0 - cursup - next -end -def cursdown - if cursrow < numlines - 1 - cursoff - cursrow = cursrow + 1 - if cursy < 23 - cursy = cursy + 1 - else - scrntop = cursrow - 23 - drawscrn(scrntop, scrnleft) - fin - curson - fin -end -def pgdown - byte i - - for i = pgjmp downto 0 - cursdown - next -end -def cursleft - if curscol > 0 - cursoff - curscol = curscol - 1 - if cursx > 0 - cursx = cursx - 1 - else - scrnleft = curscol - drawscrn(scrntop, scrnleft) - fin - curson - fin -end -def pgleft - byte i - - for i = 7 downto 0 - cursleft - next -end -def cursright - if curscol < 80 - cursoff - curscol = curscol + 1 - if cursx < 39 - cursx = cursx + 1 - else - scrnleft = curscol - 39 - drawscrn(scrntop, scrnleft) - fin - curson - fin -end -def pgright - byte i - - for i = 7 downto 0 - cursright - next -end -// -// Keyboard routines -// -def keyin2e - byte key - repeat - cursflash - until ^keyboard >= 128 - key = ^keystrobe - if ^$C062 & 128 // Closed Apple pressed - when key - is keyarrowleft - key = keyctrla - break - is keyarrowright - key = keyctrls - break - is keyarrowup - key = keyctrlw - break - is keyarrowdown - key = keyctrlz - break - is keyenter - key = keyctrlo - break - wend - fin - return key -end -def keyin2 - byte key - - repeat - cursflash - key = ^keyboard - if key == keyctrll - ^keystrobe - flags = flags ^ shiftlock - key = 0 - fin - until key >= 128 - ^keystrobe - if key == keyctrln - key = $DB // [ - elsif key == keyctrlp - key = $DF // _ - elsif key == keyctrlb - key = $FC // | - elsif key == keyctrly - key = $FE // ~ - elsif key == keyarrowleft - if ^pushbttn3 < 128 - key = $FF - fin - elsif key >= $C0 and flags < shiftlock - 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 - fin - return key -end -// -// Printer routines -// -def printtxt(slot) - byte txtbuf[80] - word i, scrncsw - - scrncsw = *(csw) - *(csw) = $C000 | (slot << 8) - for i = 0 to numlines - 1 - cpyln(strlinbuf:[i], @txtbuf) - prstr(@txtbuf) - crout - next - *(csw) = scrncsw -end -def openline(row) - if numlines < maxlines - memcpy(@strlinbuf:[row + 1], @strlinbuf:[row], (numlines - row) * 2) - strlinbuf:[row] = @nullstr - numlines = numlines + 1 - flags = flags | changed - return 1 - fin - bell - return 0 -end -def cutline - freestr(cutbuf) - cutbuf = strlinbuf:[cursrow] - memcpy(@strlinbuf:[cursrow], @strlinbuf:[cursrow + 1], (numlines - cursrow) * 2) - if numlines > 1 - numlines = numlines - 1 - fin - flags = flags | changed - if cursrow == numlines - cursup - fin - return redraw -end -def pasteline - if cutbuf and numlines < maxlines - memcpy(@strlinbuf:[cursrow + 1], @strlinbuf:[cursrow], (numlines - cursrow) * 2) - strlinbuf:[cursrow] = newstr(cutbuf) - numlines = numlines + 1 - flags = flags | changed - redraw - else - bell - fin -end -def joinline - byte joinstr[80], joinlen - - if cursrow < numlines - 1 - strcpy(@joinstr, strlinbuf:[cursrow]) - joinlen = joinstr + ^(strlinbuf:[cursrow + 1]) - if joinlen < 80 - memcpy(@joinstr + joinstr + 1, strlinbuf:[cursrow + 1] + 1, ^(strlinbuf:[cursrow + 1])) - joinstr = joinlen - freestr(strlinbuf:[cursrow]) - strlinbuf:[cursrow] = newstr(@joinstr) - freestr(strlinbuf:[cursrow + 1]) - numlines = numlines - 1 - memcpy(@strlinbuf:[cursrow + 1], @strlinbuf:[cursrow + 2], (numlines - cursrow) * 2) - flags = flags | changed - redraw - else - bell - fin - fin -end -def splitline - byte splitstr[80], splitlen - - if openline(cursrow + 1) - if curscol - splitlen = ^(strlinbuf:[cursrow]) - if curscol < splitlen - 1 - memcpy(@splitstr + 1, strlinbuf:[cursrow] + curscol + 1, splitlen - curscol) - splitstr = splitlen - curscol - strlinbuf:[cursrow + 1] = newstr(@splitstr) - memcpy(@splitstr + 1, strlinbuf:[cursrow] + 1, curscol) - splitstr = curscol - freestr(strlinbuf:[cursrow]) - strlinbuf:[cursrow] = newstr(@splitstr) - fin - else - strlinbuf:[cursrow + 1] = strlinbuf:[cursrow] - strlinbuf:[cursrow] = @nullstr - fin - curscol = 0 - cursx = 0 - scrnleft = 0 - redraw - cursdown - fin -end -def editkey(key) - if key >= keyspace - return TRUE - elsif key == keydelete - return TRUE - elsif key == keyctrld - return TRUE - elsif key == keyctrlr - return TRUE - fin - return FALSE -end -def editline(key) - byte editstr[80] - word undoline - - if (editkey(key)) - flags = flags | changed - memset(@editstr, 80, $A0A0) - strcpy(@editstr, strlinbuf:[cursrow]) - undoline = strlinbuf:[cursrow] - strlinbuf:[cursrow] = @editstr - repeat - if key >= keyspace - if key == keydelete - if curscol > 0 - if curscol <= editstr - memcpy(@editstr[curscol], @editstr[curscol + 1], editstr - curscol) - editstr = editstr - 1 - fin - curscol = curscol - 1 - cursoff - if cursx > 0 - cursx = cursx - 1 - drawrow(cursy, scrnleft, @editstr) - else - scrnleft = scrnleft - 1 - drawscrn(scrntop, scrnleft) - fin - curson - fin - elsif curscol < maxlnlen - curscol = curscol + 1 - cursx = cursx + 1 - if flags & insmode - if editstr < maxlnlen or editstr.maxlnlen == $A0 - editstr = editstr + 1 - if curscol >= editstr - editstr = curscol - else - memcpy(@editstr[curscol + 1], @editstr[curscol], editstr - curscol) - fin - else - curscol = curscol - 1 - cursx = cursx - 1 - key = editstr[curscol] - bell - fin - else - if curscol > editstr - editstr = curscol - fin - fin - editstr[curscol] = caseconv(key) - cursoff - if cursx <= 39 - drawrow(cursy, scrnleft, @editstr) - else - scrnleft = scrnleft + 1 - cursx = 39 - drawscrn(scrntop, scrnleft) - fin - curson - else - bell - fin - elsif key == keyctrld - if curscol < editstr - strcpy(undoline, @editstr) - memcpy(@editstr[curscol + 1], @editstr[curscol + 2], editstr - curscol) - editstr = editstr - 1 - cursoff - drawrow(cursy, scrnleft, @editstr) - curson - fin - elsif key == keyctrlr - strcpy(@editstr, undoline) - cursoff - drawrow(cursy, scrnleft, @editstr) - curson - fin - key = keyin() - until not editkey(key) - if editstr - strlinbuf:[cursrow] = newstr(@editstr) - else - strlinbuf:[cursrow] = @nullstr - fin - freestr(undoline) - fin - return key -end -def editmode - repeat - when editline(keyin()) - is keyarrowup - cursup; break - is keyarrowdown - cursdown; break - is keyarrowleft - cursleft; break - is keyarrowright - cursright; break - is keyctrlw - pgup; break - is keyctrlz - pgdown; break - is keyctrla - pgleft; break - is keyctrls - pgright; break - is keyctrlq - curshome; break - is keyctrle - cursend; break - is keyctrlx - cutline; break - is keyctrlv - pasteline; break - is keyctrlf - if numlines < maxlines and cursrow == numlines - 1 - strlinbuf:[numlines] = @nullstr - numlines = numlines + 1 - fin - cursdown - is keyctrlo - openline(cursrow) - curscol = 0 - cursx = 0 - scrnleft = 0 - redraw - break - is keyenter - if flags & insmode - splitline - else - openline(cursrow + 1) - cursdown - redraw - fin - break - is keyctrlt - joinline; break - is keyctrli - if flags & insmode - flags = flags & ~insmode - curschr = ' ' - else - flags = flags | insmode - curschr = '+' - fin - break - is keyctrlc - if flags & uppercase - txtlower - else - txtupper - fin - redraw - break - is keyescape - cursoff - cmdmode(TRUE) - redraw - break - wend - until FALSE -end -// -// Command mode -// -def prfiles(optpath) - byte path[64] - byte refnum - byte firstblk - byte entrylen, entriesblk - byte i, type, len - word entry, filecnt - - if ^optpath - strcpy(@path, optpath) - else - getpfx(@path) - prstr(@path) - crout - fin - refnum = open(@path, iobuffer) - if perr - return perr - fin - firstblk = 1 - repeat - if read(refnum, databuff, 512) == 512 - entry = databuff + 4 - if firstblk - entrylen = databuff.$23 - entriesblk = databuff.$24 - filecnt = databuff:$25 - entry = entry + entrylen - fin - for i = firstblk to entriesblk - type = ^entry - if type <> 0 - len = type & $0F - ^entry = len - prstr(entry) - if type & $F0 == $D0 // Is it a directory? - cout('/') - len = len + 1 - fin - for len = 20 - len downto 1 - cout(' ') - next - filecnt = filecnt - 1 - fin - entry = entry + entrylen - next - firstblk = 0 - else - filecnt = 0 - fin - until filecnt == 0 - close(refnum) - crout - return 0 -end -def striplead(strptr, chr) - while ^strptr and ^(strptr + 1) == chr - memcpy(strptr + 1, strptr + 2, ^strptr) - ^strptr = ^strptr - 1 - loop -end -def parsecmd(strptr) - byte cmd - - cmd = 0 - striplead(strptr, ' ') - if ^strptr - cmd = ^(strptr + 1) - memcpy(strptr + 1, strptr + 2, ^strptr) - ^strptr = ^strptr - 1 - fin - if ^strptr - striplead(strptr, ' ') - fin - return cmd -end -def chkchng - if flags & changed - prstr(@losechng) - if toupper(keyin()) == 'N' - crout - return FALSE - fin - crout - fin - return TRUE -end -def quit - if chkchng - exit - fin -end -def cmdmode(clearscr) - byte slot - word cmdptr - - if (clearscr) - clrscrn - prstr(@version) - fin - crout - while TRUE - prstr(@txtfile) - cmdptr = rdstr($BA) - when toupper(parsecmd(cmdptr)) - is 'A' - readtxt(cmdptr) - flags = flags | changed - break - is 'R' - if chkchng - inittxtbuf - numlines = 0 - entrypoint = 0 - strcpy(@txtfile, cmdptr) - readtxt(@txtfile) - if numlines == 0; numlines = 1; fin - flags = flags & ~changed - fin - break - is 'W' - if ^cmdptr - strcpy(@txtfile, cmdptr) - fin - writetxt(@txtfile) - if flags & changed; entrypoint = 0; fin - flags = flags & ~changed - break - is 'C' - prfiles(cmdptr); break - is 'P' - setpfx(cmdptr); break - is 'H' - if ^cmdptr - slot = cmdptr.1 - '0' - else - slot = 1 - fin - printtxt(slot) - break - is 'Q' - quit - is 'E' - is 0 - return - is 'N' - if chkchng - inittxtbuf - strcpy(@txtfile, @untitled) - entrypoint = 0 - fin - break - is 'X' - if flags & changed or !entrypoint - parse_module - if parserr - bell - cursrow = parserrln - scrntop = cursrow & $FFF8 - cursy = cursrow - scrntop - curscol = parserrpos - scrnleft = curscol & $FFE0 - cursx = curscol - scrnleft - entrypoint = 0 - else - crout - fin - fin - if entrypoint - save_vmstate - entrypoint() - restore_vmstate - fin - crout - break - otherwise - bell - cout('?') - crout - wend - if perr - prstr(@errorstr) - call($FDDA, perr, 0, 0, 0) - else - prstr(@okstr) - fin - crout - loop -end - -//===================================== -// -// PLASMA Compiler -// -//===================================== - -// -// Error handler -// -def parse_err(err) - if !parserr - parserr = TRUE - parserrln = lineno - 1 - parserrpos = tknptr - inbuff - print(lineno) - cout(':') - prstr(err) - crout - fin - return ERR_TKN -end -// -// Code tags. Upper bit is IS_RESOLVED flag, lower 15 is offset into codebuff -// Flags are: -// -def ctag_new - if codetag >= ctag_max; return parse_err(@ctag_full); fin - codetag = codetag + 1 - ctag_tbl:[codetag] = 0 // Unresolved, nothing to update yet - return codetag | IS_CTAG -end -def ctag_resolve(ctag) - word updtptr, nextptr - - ctag = ctag & MASK_CTAG // Better be a ctag! - if ctag_tbl:[ctag] & IS_RESOLVED; return parse_err(@dup_id); fin - updtptr = ctag_tbl:[ctag] & MASK_CTAG - while updtptr - // - // Update list of addresses needing resolution - // - updtptr = updtptr + codebuff - nextptr = *updtptr & MASK_CTAG - if *updtptr & IS_RELATIVE - *updtptr = codeptr - updtptr - else - *updtptr = codeptr - fin - updtptr = nextptr - loop - ctag_tbl:[ctag] = (codeptr - codebuff) | IS_RESOLVED -end -// -// Emit data/bytecode -// -def emit_byte(bval) - ^codeptr = bval - codeptr = codeptr + 1 -end -def emit_word(wval) - *codeptr = wval - codeptr = codeptr + 2 -end -def emit_fill(size) - memset(codeptr, size, 0) - codeptr = codeptr + size -end -def emit_op(op) - lastop = op - return emit_byte(op) -end -def emit_addr(tag) - word updtptr - - if tag & IS_CTAG - tag = tag & MASK_CTAG - if ctag_tbl:[tag] & IS_RESOLVED - updtptr = (ctag_tbl:[tag] & MASK_CTAG) + codebuff - else - // - // Add to list of tags needing resolution - // - updtptr = ctag_tbl:[tag] & MASK_CTAG - ctag_tbl:[tag] = codeptr - codebuff - fin - emit_word(updtptr) - else - emit_word(tag + codebuff) - fin -end -def emit_reladdr(tag) - word updtptr - - if tag & IS_CTAG - tag = tag & MASK_CTAG - if ctag_tbl:[tag] & IS_RESOLVED - updtptr = ((ctag_tbl:[tag] & MASK_CTAG) + codebuff) - codeptr - else - // - // Add to list of tags needing resolution - // - updtptr = ctag_tbl:[tag] | IS_RELATIVE - ctag_tbl:[tag] = codeptr - codebuff - fin - emit_word(updtptr) - else - emit_word(tag - (codeptr - codebuff)) - fin -end -def emit_iddata(value, size, namestr) - return emit_fill(size) -end -def emit_data(vartype, consttype, constval, constsize) - byte i - word size, chrptr - - if consttype == 0 - size = constsize - emit_fill(constsize) - elsif consttype == STR_TYPE - size = constsize - chrptr = constval - constsize = constsize - 1 - emit_byte(constsize) - while constsize > 0 - emit_byte(^chrptr) - chrptr = chrptr + 1 - constsize = constsize - 1 - loop - else - if vartype & BYTE_TYPE - size = 1 - emit_byte(constval) - else - size = 2 - if consttype == CONSTADDR_TYPE - emit_addr(constval) - else - emit_word(constval) - fin - fin - fin - return size -end -def emit_const(cval) - if cval == 0 - emit_op($00) - elsif cval > 0 and cval < 256 - emit_op($2A) - emit_byte(cval) - else - emit_op($2C) - emit_word(cval) - fin -end -def emit_lb - return emit_op($60) -end -def emit_lw - return emit_op($62) -end -def emit_llb(offset) - emit_op($64) - return emit_byte(offset) -end -def emit_llw(offset) - emit_op($66) - return emit_byte(offset) -end -def emit_lab(tag, offset) - if tag & IS_CTAG and offset; return parse_err(@no_ctag_offst); fin - emit_op($68) - return emit_addr(tag+offset) -end -def emit_law(tag, offset) - if tag & IS_CTAG and offset; return parse_err(@no_ctag_offst); fin - emit_op($6A) - return emit_addr(tag+offset) -end -def emit_sb - return emit_op($70) -end -def emit_sw - return emit_op($72) -end -def emit_slb(offset) - emit_op($74) - return emit_byte(offset) -end -def emit_slw(offset) - emit_op($76) - return emit_byte(offset) -end -def emit_dlb(offset) - emit_op($6C) - return emit_byte(offset) -end -def emit_dlw(offset) - emit_op($6E) - return emit_byte(offset) -end -def emit_sab(tag, offset) - if tag & IS_CTAG and offset; return parse_err(@no_ctag_offst); fin - emit_op($78) - return emit_addr(tag+offset) -end -def emit_saw(tag, offset) - if tag & IS_CTAG and offset; return parse_err(@no_ctag_offst); fin - emit_op($7A) - return emit_addr(tag+offset) -end -def emit_dab(tag, offset) - if tag & IS_CTAG and offset; return parse_err(@no_ctag_offst); fin - emit_op($7C) - return emit_addr(tag+offset) -end -def emit_daw(tag, offset) - if tag & IS_CTAG and offset; return parse_err(@no_ctag_offst); fin - emit_op($7E) - return emit_addr(tag+offset) -end -def emit_call(tag) - emit_op($54) - return emit_addr(tag) -end -def emit_ical - return emit_op($56) -end -def emit_push - emit_op($34) -end -def emit_pull - emit_op($36) -end -def emit_localaddr(offset) - emit_op($28) - return emit_byte(offset) -end -def emit_globaladdr(tag, offset) - if tag & IS_CTAG and offset; return parse_err(@no_ctag_offst); fin - emit_op($26) - return emit_addr(tag+offset) -end -def emit_indexbyte - return emit_op($02) -end -def emit_indexword - return emit_op($1E) -end -def emit_unaryop(op) - when op - is NEG_TKN - emit_op($10); break - is COMP_TKN - emit_op($12); break - is LOGIC_NOT_TKN - emit_op($20); break - is INC_TKN - emit_op($0C); break - is DEC_TKN - emit_op($0E); break - is BPTR_TKN - emit_op($60); break - is WPTR_TKN - emit_op($62); break - otherwise - return FALSE - wend - return TRUE -end -def emit_binaryop(op) - when op - is MUL_TKN - // - // Replace MUL 2 with SHL 1 - // - if lastop == $2A and ^(codeptr - 1) == 2 // CB 2 - codeptr = codeptr - 1 - emit_byte(1) // CB 1 - emit_op($1A) // SHL - else - emit_op($06) - fin - break - is DIV_TKN - // - // Replace DIV 2 with SHR 1 - // - if lastop == $2A and ^(codeptr - 1) == 2 // CB 2 - codeptr = codeptr - 1 - emit_byte(1) // CB 1 - emit_op($1C) // SHR - else - emit_op($08) - fin - break - is MOD_TKN - emit_op($0A); break - is ADD_TKN - // - // Replace ADD 1 with INCR - // - if lastop == $2A and ^(codeptr - 1) == 1 // CB 1 - codeptr = codeptr - 2 - emit_op($0C) // INC_OP - else - emit_op($02) - fin - break - is SUB_TKN - // - // Replace SUB 1 with DECR - // - if lastop == $2A and ^(codeptr - 1) == 1 // CB 1 - codeptr = codeptr - 2 - emit_op($0E) // DEC_OP - else - emit_op($04) - fin - break - is SHL_TKN - emit_op($1A); break - is SHR_TKN - emit_op($1C); break - is AND_TKN - emit_op($14); break - is OR_TKN - emit_op($16); break - is EOR_TKN - emit_op($18); break - is EQ_TKN - emit_op($40); break - is NE_TKN - emit_op($42); break - is GE_TKN - emit_op($48); break - is LT_TKN - emit_op($46); break - is GT_TKN - emit_op($44); break - is LE_TKN - emit_op($4A); break - is LOGIC_OR_TKN - emit_op($22); break - is LOGIC_AND_TKN - emit_op($24); break - otherwise - return FALSE - wend - return TRUE -end -def emit_brtru(tag) - emit_op($4E) - return emit_reladdr(tag) -end -def emit_brfls(tag) - emit_op($4C) - return emit_reladdr(tag) -end -def emit_brgt(tag) - emit_op($38) - return emit_reladdr(tag) -end -def emit_brlt(tag) - emit_op($3A) - return emit_reladdr(tag) -end -def emit_brne(tag) - emit_op($3E) - return emit_reladdr(tag) -end -def emit_branch(tag) - emit_op($50) - return emit_reladdr(tag) -end -def emit_drop - return emit_op($30) -end -def emit_leave - if framesize - emit_op($5A) - else - emit_op($5C) - fin -end -def emit_enter(cparams) - emit_byte(emit_enter.[0]) - emit_byte(emit_enter.[1]) - emit_byte(emit_enter.[2]) - if framesize - emit_op($58) - emit_byte(framesize) - emit_byte(cparams) - fin -end -// -// Symbol table -// -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 + idrecsz - idcnt = idcnt - 1 - loop - return 0 -end -def dumpsym(idptr, idcnt) - while idcnt - prword(idptr=>idval) - cout(' ') - prbyte(idptr->idtype) - cout(' ') - prstr(@idptr->idname) - cout('=') - if idptr->idtype & ADDR_TYPE - if idptr=>idval & IS_CTAG - prword((ctag_tbl:[idptr=>idval & MASK_CTAG] & MASK_CTAG) + codebuff) - else - prword(idptr=>idval + codebuff) - fin - else - prword(idptr=>idval) - fin - crout - idptr = idptr + idptr->idname + idrecsz - idcnt = idcnt - 1 - loop -end -def id_lookup(nameptr, len) - word idptr - - idptr = idmatch(nameptr, len, idlocal_tbl, locals) - if idptr - return idptr - fin - idptr = idmatch(nameptr, len, idglobal_tbl, globals) - if idptr - return idptr - fin - return parse_err(@undecl_id) -end -def idglobal_lookup(nameptr, len) - return idmatch(nameptr, len, idglobal_tbl, globals) -end -def idlocal_add(namestr, len, type, size) - if idmatch(namestr, len, @idlocal_tbl, locals); return parse_err(@dup_id); fin - lastlocal=>idval = framesize - lastlocal->idtype = type | LOCAL_TYPE - nametostr(namestr, len, lastlocal + idname) - locals = locals + 1 - lastlocal = lastlocal + idrecsz + len - if lastlocal > idlocal_tbl + idlocal_tblsz - prstr(@local_sym_overflw) - exit - fin - framesize = framesize + size - if framesize > 255 - prstr(@local_overflw) - return FALSE - fin - return TRUE -end -def iddata_add(namestr, len, type, size) - if idmatch(namestr, len, idglobal_tbl, globals); return parse_err(@dup_id); fin - lastglobal=>idval = datasize - lastglobal->idtype = type - nametostr(namestr, len, lastglobal + idname) - emit_iddata(datasize, size, lastglobal + idname) - globals = globals + 1 - lastglobal = lastglobal + idrecsz + len - if lastglobal > idglobal_tbl + idglobal_tblsz - prstr(@global_sym_overflw) - exit - fin - datasize = datasize + size - return TRUE -end -def iddata_size(type, varsize, initsize) - if varsize > initsize - datasize = datasize + varsize - emit_data(0, 0, 0, varsize - initsize) - else - datasize = datasize + initsize - fin -end -def idglobal_add(namestr, len, type, value) - if idmatch(namestr, len, idglobal_tbl, globals); return parse_err(@dup_id); fin - lastglobal=>idval = value - lastglobal->idtype = type - nametostr(namestr, len, lastglobal + idname) - globals = globals + 1 - lastglobal = lastglobal + idrecsz + len - if lastglobal > idglobal_tbl + idglobal_tblsz - prstr(@global_sym_overflw) - exit - fin - return TRUE -end -def idfunc_add(namestr, len, tag) - return idglobal_add(namestr, len, FUNC_TYPE, tag) -end -def idconst_add(namestr, len, value) - return idglobal_add(namestr, len, CONST_TYPE, value) -end -def idglobal_init - word ctag - - lineno = 0 - parserr = 0 - codeptr = codebuff - lastop = $FF - entrypoint = 0 - globals = 0 - lastglobal = idglobal_tbl - codetag = -1 - // - // Create local jump table to some library functions - // - ctag = ctag_new - idfunc_add(@runtime0 + 1, runtime0, ctag) - idfunc_add(@RUNTIME0 + 1, RUNTIME0, ctag) - ctag_resolve(ctag) - emit_byte($4C) - emit_word(@call) - ctag = ctag_new - idfunc_add(@runtime1 + 1, runtime1, ctag) - idfunc_add(@RUNTIME1 + 1, RUNTIME1, ctag) - ctag_resolve(ctag) - emit_byte($4C) - emit_word(@syscall) - ctag = ctag_new - idfunc_add(@runtime2 + 1, runtime2, ctag) - idfunc_add(@RUNTIME2 + 1, RUNTIME2, ctag) - ctag_resolve(ctag) - emit_byte($4C) - emit_word(@memset) - ctag = ctag_new - idfunc_add(@runtime3 + 1, runtime3, ctag) - idfunc_add(@RUNTIME3 + 1, RUNTIME3, ctag) - ctag_resolve(ctag) - emit_byte($4C) - emit_word(@memcpy) - ctag = ctag_new - idfunc_add(@runtime4 + 1, runtime4, ctag) - idfunc_add(@RUNTIME4 + 1, RUNTIME4, ctag) - ctag_resolve(ctag) - emit_byte($4C) - emit_word(@cout) - ctag = ctag_new - idfunc_add(@runtime5 + 1, runtime5, ctag) - idfunc_add(@RUNTIME5 + 1, RUNTIME5, ctag) - ctag_resolve(ctag) - emit_byte($4C) - emit_word(@cin) - ctag = ctag_new - idfunc_add(@runtime6 + 1, runtime6, ctag) - idfunc_add(@RUNTIME6 + 1, RUNTIME6, ctag) - ctag_resolve(ctag) - emit_byte($4C) - emit_word(@prstr) - ctag = ctag_new - idfunc_add(@runtime7 + 1, runtime7, ctag) - idfunc_add(@RUNTIME7 + 1, RUNTIME7, ctag) - ctag_resolve(ctag) - emit_byte($4C) - emit_word(@rdstr) - ctag = ctag_new - idfunc_add(@runtime8 + 1, runtime8, ctag) - idfunc_add(@RUNTIME8 + 1, RUNTIME8, ctag) - ctag_resolve(ctag) - emit_byte($4C) - emit_word(@print) - ctag = ctag_new - idfunc_add(@runtime9 + 1, runtime9, ctag) - idfunc_add(@RUNTIME9 + 1, RUNTIME9, ctag) - ctag_resolve(ctag) - emit_byte($4C) - emit_word(@home) - ctag = ctag_new - idfunc_add(@runtime10 + 1, runtime10, ctag) - idfunc_add(@RUNTIME10 + 1, RUNTIME10, ctag) - ctag_resolve(ctag) - emit_byte($4C) - emit_word(@gotoxy) - // - // Start data after jump table - // - datasize = codeptr - codebuff -end -def idlocal_init - locals = 0 - framesize = 0 - lastlocal = idlocal_tbl -end -// -// Alebraic op to stack op -// -def push_op(op, prec) - opsp = opsp + 1 - if opsp == 16 - return parse_err(@estk_overflw) - fin - opstack[opsp] = op - precstack[opsp] = prec -end -def pop_op - if opsp < 0 - return parse_err(@estk_underflw) - fin - opsp = opsp - 1 - return opstack[opsp + 1] -end -def tos_op - if opsp < 0 - return 0 - fin - return opstack[opsp] -end -def tos_op_prec(tos) - if opsp <= tos - return 100 - fin - return precstack[opsp] -end -// -// Lexical anaylzer -// -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 toupper(^(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 scan - // - // Skip whitespace - // - scanptr = skipspace(scanptr) - tknptr = scanptr - scanchr = ^scanptr - // - // Scan for token based on first character - // - if isalpha(scanchr) - // - // ID, either variable name or reserved word - // - repeat - scanptr = scanptr + 1 - until !isalphanum(^scanptr) - tknlen = scanptr - tknptr - token = keymatch - elsif isnum(scanchr) - // - // Decimal constant - // - token = INT_TKN - constval = 0 - repeat - constval = constval * 10 + ^scanptr - '0' - scanptr = scanptr + 1 - until !isnum(^scanptr) - else - // - // Potential multiple character tokens - // - when scanchr - is '/' - if ^(scanptr + 1) == '/' - token = EOL_TKN - ^scanptr = $00 - else - token = DIV_TKN - scanptr = scanptr + 1 - 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 = scanptr + 1 - fin - break - is '-' - if ^(scanptr + 1) == '>' - token = PTRB_TKN - scanptr = scanptr + 2 - else - token = SUB_TKN - scanptr = scanptr + 1 - 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 = scanptr + 1 - 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 = scanptr + 1 - fin - break - is '$' - // - // Hexadecimal constant - // - token = INT_TKN - constval = 0 - repeat - scanptr = scanptr + 1 - 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 !^scanptr - break - is $27 // ' - // - // Character constant - // - token = CHR_TKN - if ^(scanptr + 1) <> $5C // \ - constval = ^(scanptr + 1) - if ^(scanptr + 2) <> $27 // ' - return parse_err(@bad_cnst) - fin - scanptr = scanptr + 3 - else - when ^(scanptr + 2) - is 'n' - constval = $0D; break - is 'r' - constval = $0A; break - is 't' - constval = $09; break - otherwise - constval = ^(scanptr + 2) - wend - if ^(scanptr + 3) <> $27 // ' - return parse_err(@bad_cnst) - fin - scanptr = scanptr + 4 - fin - break - is '"' - // - // String constant - // - token = STR_TKN - scanptr = scanptr + 1 - constval = scanptr - while ^scanptr and ^scanptr <> '"' - scanptr = scanptr + 1 - loop - if !^scanptr - return parse_err(@bad_cnst) - fin - scanptr = scanptr + 1 - break - is 0 - is ';' - if token <> EOF_TKN - token = EOL_TKN - fin - break - otherwise - // - // Simple single character tokens - // - token = scanchr | $80 - scanptr = scanptr + 1 - wend - fin - tknlen = scanptr - tknptr - return token -end -def rewind(ptr) - scanptr = 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 - if ^scanptr == ';' - scanptr = scanptr + 1 - scan - else - scanptr = inbuff - if lineno < numlines - cpyln(strlinbuf:[lineno], instr) - lineno = lineno + 1 - if !(lineno & $0F); cout('.'); fin - //cout('>') - //prstr(instr) - //crout - scan - else - ^instr = 0 - ^inbuff = 0 - token = DONE_TKN - fin - fin - return token -end -// -// Parser -// -def parse_term - when scan - is OPEN_PAREN_TKN - if !parse_expr - return FALSE - fin - if token <> CLOSE_PAREN_TKN; return parse_err(@no_close_paren); fin - is ID_TKN - is INT_TKN - is CHR_TKN - is STR_TKN - return TRUE - wend - return FALSE -end -def parse_constval(valptr, sizeptr) - byte mod, type - word idptr, ctag - - mod = 0 - type = 0 - while !parse_term - when token - is SUB_TKN - mod = mod | 1; break - is COMP_TKN - mod = mod | 2; break - is LOGIC_NOT_TKN - mod = mod | 4; break - is AT_TKN - mod = mod | 8; break - is ADD_TKN - break - otherwise - return 0 - wend - loop - when token - is STR_TKN - *valptr = constval - ^sizeptr = tknlen - 1 - type = STR_TYPE - if mod; return parse_err(@bad_op); fin - break - is CHR_TKN - *valptr = constval - ^sizeptr = 1 - type = BYTE_TYPE - break - is INT_TKN - *valptr = constval - ^sizeptr = 2 - type = WORD_TYPE - break - is ID_TKN - ^sizeptr = 2 - idptr = id_lookup(tknptr, tknlen) - if !idptr; return parse_err(@bad_cnst); fin - type = idptr->idtype - if type & ADDR_TYPE - if mod <> 8; return parse_err(@bad_cnst); fin - type = CONSTADDR_TYPE - fin - *valptr = idptr=>idval - break - otherwise - return parse_err(@bad_cnst) - wend - if mod & 1 - *valptr = -*valptr - fin - if mod & 2 - *valptr = ~*valptr - fin - if mod & 4 - *valptr = !*valptr - fin - return type -end -def ispostop - when scan - is OPEN_PAREN_TKN - is OPEN_BRACKET_TKN - is DOT_TKN - is COLON_TKN - is PTRB_TKN - is PTRW_TKN - return TRUE - wend - return FALSE -end -def parse_value(rvalue) - byte cparams, deref, type, emit_val - word optos, idptr, value - byte elem_size, elem_type - word elem_offset - - deref = rvalue - optos = opsp - type = 0 - elem_offset = 0 - emit_val = FALSE - value = 0 - - // - // Parse pre-ops - // - while !parse_term - when token - is ADD_TKN - break - is BPTR_TKN - if deref - push_op(token, 0) - else - type = type | BPTR_TYPE - deref = deref + 1 - fin - break - is WPTR_TKN - if deref - push_op(token, 0) - else - type = type | WPTR_TYPE - deref = deref + 1 - fin - break - is AT_TKN - deref = deref - 1 - break - is SUB_TKN - is COMP_TKN - is LOGIC_NOT_TKN - push_op(token, 0) - break - otherwise - return 0 - wend - loop - // - // Determine terminal type - // - when token - is INT_TKN - is CHR_TKN - value = constval - type = type | CONST_TYPE - break - is ID_TKN - idptr = id_lookup(tknptr, tknlen) - if !idptr; return 0; fin - if !(idptr->idtype); return 0; fin - type = type | idptr->idtype - value = idptr=>idval - break - is CLOSE_PAREN_TKN - // type = type | WORD_TYPE - emit_val = TRUE - break - otherwise - return 0 - wend - // - // Constant optimizations - // - if type & CONST_TYPE - cparams = TRUE - while optos < opsp and cparams - when tos_op - is NEG_TKN - pop_op - value = -value - break - is COMP_TKN - pop_op - value = ~value - break - is LOGIC_NOT_TKN - pop_op - value = !value - break - otherwise - cparams = FALSE - wend - loop - fin - // - // Parse post-ops - // - while ispostop - when token - is OPEN_BRACKET_TKN - // - // Array - // - if !emit_val - if type & ADDR_TYPE - if type & LOCAL_TYPE - emit_localaddr(value) - else - emit_globaladdr(value, 0) - fin - elsif type & CONST_TYPE - emit_const(value) - fin - emit_val = TRUE - fin // !emit_val - if type & PTR_TYPE - emit_lw - fin - if !parse_expr - return 0 - fin - if token <> CLOSE_BRACKET_TKN - return parse_err(@no_close_bracket) - fin - if type & WORD_TYPE - type = WPTR_TYPE - emit_indexword - else - type = BPTR_TYPE - emit_indexbyte - fin - break - is PTRB_TKN - is PTRW_TKN - if !emit_val - if type & FUNC_TYPE - emit_call(value) - elsif type & VAR_TYPE - if type & LOCAL_TYPE - if type & BYTE_TYPE - emit_llb(value + elem_offset) - else - emit_llw(value + elem_offset) - fin - else - if type & BYTE_TYPE - emit_lab(value, elem_offset) - else - emit_law(value, elem_offset) - fin - fin - else - if type & BPTR_TYPE - emit_lb - else - emit_lw - fin - fin - emit_val = 1; - else - if type & BYTE_TYPE - emit_lab(value, elem_offset) - else - emit_law(value, elem_offset) - fin - fin - type = type & ~(VAR_TYPE | ADDR_TYPE) - type = type | WORD_TYPE - if token == PTRB_TKN - token = DOT_TKN - else - token = COLON_TKN - fin - // - // Fall through - // - is DOT_TKN - is COLON_TKN - // - // Dot and Colon - // - if token == DOT_TKN - elem_type = BPTR_TYPE - else - elem_type = WPTR_TYPE - fin - if parse_constval(@elem_offset, @elem_size) - // - // Constant structure offset - // - if !emit_val - if type & VAR_TYPE - if elem_type & BPTR_TYPE - elem_type = (type & ~VAR_TYPE) | BYTE_TYPE - else - elem_type = (type & ~VAR_TYPE) | WORD_TYPE - fin - elsif type & CONST_TYPE - value = value + elem_offset - emit_const(value) - elem_offset = 0 - emit_val = TRUE - else // FUNC_TYPE - emit_globaladdr(value, 0) - emit_const(elem_offset) - emit_binaryop(ADD_TKN) - elem_offset = 0 - emit_val = TRUE - fin - else - if elem_offset <> 0 - emit_const(elem_offset) - emit_binaryop(ADD_TKN) - elem_offset = 0 - fin - fin // !emit_val - elsif token == OPEN_BRACKET_TKN - // - // Array of arrays - // - if !emit_val - if type & ADDR_TYPE - if type & LOCAL_TYPE - emit_localaddr(value + elem_offset) - else - emit_globaladdr(value, elem_offset) - fin - elsif type & CONST_TYPE - emit_const(value + elem_offset) - fin - elem_offset = 0 - emit_val = TRUE - fin // !emit_val - while parse_expr - if token <> COMMA_TKN - break - fin - emit_indexword - emit_lw - loop - if token <> CLOSE_BRACKET_TKN - return parse_err(@no_close_bracket) - fin - if elem_type & WPTR_TYPE - emit_indexword - else - emit_indexbyte - fin - else - return parse_err(@bad_offset) - fin - type = elem_type - break - is OPEN_PAREN_TKN - // - // Function call - // - if emit_val and type & VAR_TYPE - if lookahead <> CLOSE_PAREN_TKN - emit_push - fin - fin - cparams = 0 - while parse_expr - cparams = cparams + 1 - if token <> COMMA_TKN - break - fin - loop - if token <> CLOSE_PAREN_TKN - return parse_err(@no_close_paren) - fin - if type & FUNC_CONST_TYPE - emit_call(value) - else - if !emit_val - if type & VAR_TYPE - if type & LOCAL_TYPE - emit_llw(value + elem_offset) - else - emit_law(value, elem_offset) - fin - elsif type & PTR_TYPE - emit_lw - fin - else - if cparams - emit_pull - fin - fin - emit_ical - fin - emit_val = TRUE - type = WORD_TYPE - wend - loop - if emit_val - if rvalue - if deref and type & PTR_TYPE - if type & BPTR_TYPE - emit_lb - else - emit_lw - fin - fin - fin - else // emit_val - if type & CONST_TYPE - emit_const(value) - elsif deref - if type & FUNC_TYPE - emit_call(value) - elsif type & VAR_TYPE - if type & LOCAL_TYPE - if type & BYTE_TYPE - emit_llb(value + elem_offset) - else - emit_llw(value + elem_offset) - fin - else - if type & BYTE_TYPE - emit_lab(value, elem_offset) - else - emit_law(value, elem_offset) - fin - fin - elsif type & PTR_TYPE - if type & BPTR_TYPE - emit_lb - else - emit_lw - fin - fin - else - if type & LOCAL_TYPE - emit_localaddr(value + elem_offset) - else - emit_globaladdr(value, elem_offset) - fin - fin - fin // emit_val - while optos < opsp - if !emit_unaryop(pop_op); return parse_err(@bad_op); fin - loop - if !type - type = WORD_TYPE - fin - return type -end -def parse_constexpr(valptr, sizeptr) - byte type, size1, size2 - word val1, val2 - - type = parse_constval(@val1, @size1) - if !type; return 0; fin - size2 = 0 - when scan - is ADD_TKN - type = parse_constval(@val2, @size2) - if !type; return 0; fin - *valptr = val1 + val2 - break - is SUB_TKN - type = parse_constval(@val2, @size2) - if !type; return 0; fin - *valptr = val1 - val2 - break - is MUL_TKN - type = parse_constval(@val2, @size2) - if !type; return 0; fin - *valptr = val1 * val2 - break - is DIV_TKN - type = parse_constval(@val2, @size2) - if !type; return 0; fin - *valptr = val1 / val2 - break - is MOD_TKN - type = parse_constval(@val2, @size2) - if !type; return 0; fin - *valptr = val1 % val2 - break - is AND_TKN - type = parse_constval(@val2, @size2) - if !type; return 0; fin - *valptr = val1 & val2 - break - is OR_TKN - type = parse_constval(@val2, @size2) - if !type; return 0; fin - *valptr = val1 | val2 - break - is EOR_TKN - type = parse_constval(@val2, @size2) - if !type; return 0; fin - *valptr = val1 ^ val2 - break - otherwise - *valptr = val1 - wend - if size1 > size2 - ^sizeptr = size1 - else - ^sizeptr = size2 - fin - return type -end -def parse_expr - byte prevmatch, matchop, i - word optos - - matchop = 0 - optos = opsp - repeat - prevmatch = matchop - matchop = 0 - if parse_value(1) - matchop = 1 - for i = 0 to bops_tblsz - if token == bops_tbl[i] - matchop = 2 - if bops_prec[i] >= tos_op_prec(optos) - if !emit_binaryop(pop_op); return parse_err(@bad_op); fin - fin - push_op(token, bops_prec[i]) - break - fin - next - fin - until matchop <> 2 - if matchop == 0 and prevmatch == 2; return parse_err(@missing_op); fin - while optos < opsp - if !emit_binaryop(pop_op); return parse_err(@bad_op); fin - loop - return matchop or prevmatch -end -def parse_stmnt - byte type, elem_type, elem_size, i - word elem_offset, tag_prevbrk, tag_prevcnt, tag_else, tag_endif, tag_while, tag_wend - word tag_repeat, tag_for, tag_choice, tag_of, idptr, saveptr, addr, stepdir - - if token <> END_TKN and token <> DONE_TKN and token <> OF_TKN and token <> DEFAULT_TKN - prevstmnt = token - fin - when token - is IF_TKN - if !parse_expr; return 0; fin - tag_else = ctag_new - tag_endif = ctag_new - emit_brfls(tag_else) - scan - repeat - while parse_stmnt - nextln - loop - if token <> ELSEIF_TKN - break - fin - emit_branch(tag_endif) - ctag_resolve(tag_else) - if !parse_expr; return FALSE; fin - tag_else = ctag_new - emit_brfls(tag_else) - until FALSE - if token == ELSE_TKN - emit_branch(tag_endif) - ctag_resolve(tag_else) - scan - while parse_stmnt - nextln - loop - ctag_resolve(tag_endif) - else - ctag_resolve(tag_else) - ctag_resolve(tag_endif) - fin - if token <> FIN_TKN; return parse_err(@no_fin); fin - break - is WHILE_TKN - tag_while = ctag_new - tag_wend = ctag_new - tag_prevcnt = cont_tag - cont_tag = tag_while - tag_prevbrk = break_tag - break_tag = tag_wend - ctag_resolve(tag_while) - if !parse_expr; return FALSE; fin - emit_brfls(tag_wend) - while parse_stmnt - nextln - loop - if token <> LOOP_TKN; return parse_err(@no_loop); fin - emit_branch(tag_while) - ctag_resolve(tag_wend) - break_tag = tag_prevbrk - cont_tag = tag_prevcnt - break - is REPEAT_TKN - tag_repeat = ctag_new - tag_prevbrk = break_tag - break_tag = ctag_new - tag_prevcnt = cont_tag - cont_tag = ctag_new - ctag_resolve(tag_repeat) - scan - while parse_stmnt - nextln - loop - if token <> UNTIL_TKN; return parse_err(@no_until); fin - ctag_resolve(cont_tag) - cont_tag = tag_prevcnt - if !parse_expr; return FALSE; fin - emit_brfls(tag_repeat) - ctag_resolve(break_tag) - break_tag = tag_prevbrk - break - is FOR_TKN - stack_loop = stack_loop + 1 - tag_for = ctag_new - tag_prevcnt = cont_tag - cont_tag = tag_for - tag_prevbrk = break_tag - break_tag = ctag_new - if scan <> ID_TKN; return parse_err(@bad_stmnt); fin - idptr = id_lookup(tknptr, tknlen) - if idptr - type = idptr->idtype - addr = idptr=>idval - else - return FALSE - fin - if scan <> SET_TKN; return parse_err(@bad_stmnt); fin - if !parse_expr; return parse_err(@bad_stmnt); fin - ctag_resolve(tag_for) - if type & LOCAL_TYPE - if type & BYTE_TYPE - emit_dlb(addr) - else - emit_dlw(addr) - fin - else - if type & BYTE_TYPE - emit_dab(addr, 0) - else - emit_daw(addr, 0) - fin - fin - if token == TO_TKN - stepdir = 1 - elsif token == DOWNTO_TKN - stepdir = -1 - else - return parse_err(@bad_stmnt) - fin - if !parse_expr; return parse_err(@bad_stmnt); fin - if stepdir > 0 - emit_brgt(break_tag) - else - emit_brlt(break_tag) - fin - if token == STEP_TKN - if !parse_expr; return parse_err(@bad_stmnt); fin - if stepdir > 0 - emit_binaryop(ADD_TKN) - else - emit_binaryop(SUB_TKN) - fin - else - if stepdir > 0 - emit_unaryop(INC_TKN) - else - emit_unaryop(DEC_TKN) - fin - fin - while parse_stmnt - nextln - loop - if token <> NEXT_TKN; return parse_err(@bad_stmnt); fin - emit_branch(tag_for) - cont_tag = tag_prevcnt - ctag_resolve(break_tag) - emit_drop - break_tag = tag_prevbrk - stack_loop = stack_loop - 1 - break - is CASE_TKN - stack_loop = stack_loop + 1 - tag_prevbrk = break_tag - break_tag = ctag_new - tag_choice = ctag_new - tag_of = ctag_new - if !parse_expr; return parse_err(@bad_stmnt); fin - nextln - while token <> ENDCASE_TKN - if token == OF_TKN - if !parse_expr; return parse_err(@bad_stmnt); fin - emit_brne(tag_choice) - ctag_resolve(tag_of) - while parse_stmnt - nextln - loop - tag_of = ctag_new - if prevstmnt <> BREAK_TKN // Fall through to next OF if no break - emit_branch(tag_of) - fin - ctag_resolve(tag_choice) - tag_choice = ctag_new - elsif token == DEFAULT_TKN - ctag_resolve(tag_of) - tag_of = 0 - scan - while parse_stmnt - nextln - loop - if token <> ENDCASE_TKN; return parse_err(@bad_stmnt); fin - else - return parse_err(@bad_stmnt) - fin - loop - if (tag_of) - ctag_resolve(tag_of) - fin - ctag_resolve(break_tag) - emit_drop - break_tag = tag_prevbrk - stack_loop = stack_loop - 1 - break - is BREAK_TKN - if break_tag - emit_branch(break_tag) - else - return parse_err(@bad_stmnt) - fin - break - is CONT_TKN - if cont_tag - emit_branch(cont_tag) - else - return parse_err(@bad_stmnt) - fin - break - is RETURN_TKN - if infunc - for i = 1 to stack_loop - emit_drop - next - fin - if !parse_expr - emit_const(0) - fin - emit_leave - break - is EOL_TKN - return TRUE - is ELSE_TKN - is ELSEIF_TKN - is FIN_TKN - is LOOP_TKN - is UNTIL_TKN - is NEXT_TKN - is OF_TKN - is DEFAULT_TKN - is ENDCASE_TKN - is END_TKN - is DONE_TKN - is DEF_TKN - return FALSE - is ID_TKN - saveptr = tknptr - idptr = id_lookup(tknptr, tknlen) - if !idptr; return FALSE; fin - type = idptr->idtype - addr = idptr=>idval - if type & VAR_TYPE - elem_type = type - elem_offset = 0 - if scan == DOT_TKN or token == COLON_TKN - // - // Structure member offset - // - if token == DOT_TKN - elem_type = BYTE_TYPE - else - elem_type = WORD_TYPE - fin - if !parse_constval(@elem_offset, @elem_size) - token = ID_TKN - else - scan - fin - fin - if token == SET_TKN - if !parse_expr; return parse_err(@bad_expr); fin - if type & LOCAL_TYPE - if elem_type & BYTE_TYPE - emit_slb(addr + elem_offset) - else - emit_slw(addr + elem_offset) - fin - else - if elem_type & BYTE_TYPE - emit_sab(addr, elem_offset) - else - emit_saw(addr, elem_offset) - fin - fin - break - fin - elsif type & FUNC_TYPE - if scan == EOL_TKN - emit_call(addr) - emit_drop - break - fin - fin - tknptr = saveptr - otherwise - rewind(tknptr) - type = parse_value(0) - if type - if token == SET_TKN - if !parse_expr; return parse_err(@bad_expr); fin - if type & XBYTE_TYPE - emit_sb - else - emit_sw - fin - else - if type & BPTR_TYPE - emit_lb - elsif type & WPTR_TYPE - emit_lw - fin - emit_drop - fin - else - return parse_err(@bad_syntax) - fin - wend - if scan <> EOL_TKN - return parse_err(@bad_syntax) - fin - return TRUE -end -def parse_var(type) - byte consttype, constsize, idlen - word idptr, constval, arraysize, size - - idlen = 0 - size = 1 - if scan == OPEN_BRACKET_TKN - size = 0 - parse_constexpr(@size, @constsize) - if token <> CLOSE_BRACKET_TKN; return parse_err(@no_close_bracket); fin - scan - fin - if token == ID_TKN - idptr = tknptr - idlen = tknlen - if scan == OPEN_BRACKET_TKN - size = 0 - parse_constexpr(@size, @constsize) - if token <> CLOSE_BRACKET_TKN; return parse_err(@no_close_bracket); fin - scan - fin - fin - if type == WORD_TYPE - size = size * 2 - fin - if token == SET_TKN - if infunc; return parse_err(@no_local_init); fin - if idlen - iddata_add(idptr, idlen, type, 0) - fin - consttype = parse_constexpr(@constval, @constsize) - if consttype - arraysize = emit_data(type, consttype, constval, constsize) - while token == COMMA_TKN - consttype = parse_constexpr(@constval, @constsize) - if consttype - arraysize = arraysize + emit_data(type, consttype, constval, constsize) - else - return parse_err(@bad_decl) - fin - loop - iddata_size(PTR_TYPE, size, arraysize) - else - return parse_err(@bad_decl) - fin - elsif idlen - if infunc - idlocal_add(idptr, idlen, type, size) - else - iddata_add(idptr, idlen, type, size) - fin - fin - return TRUE -end -def parse_struc - byte strucid[16] - byte type, idlen, struclen, constsize - word size, offset, idstr - - struclen = 0 - if scan == ID_TKN - struclen = tknlen - if struclen > 16 - struclen = 16 - fin - for idlen = 0 to struclen - strucid[idlen] = ^(tknptr + idlen) - next - fin - offset = 0 - while nextln == BYTE_TKN or token == WORD_TKN - size = 1 - if token == BYTE_TKN - type = BYTE_TYPE - else - type = WORD_TYPE - fin - if scan == OPEN_BRACKET_TKN - size = 0 - parse_constexpr(@size, @constsize) - if token <> CLOSE_BRACKET_TKN; return parse_err(@no_close_bracket); fin - scan - fin - repeat - idlen = 0; - if token == ID_TKN - idstr = tknptr - idlen = tknlen - if scan == OPEN_BRACKET_TKN - size = 0 - parse_constexpr(@size, @constsize) - if token <> CLOSE_BRACKET_TKN; return parse_err(@no_close_bracket); fin - scan - fin - fin - if type & WORD_TYPE - size = size * 2 - fin - if idlen - idconst_add(idstr, idlen, offset) - fin - offset = offset + size - until token <> COMMA_TKN - if token <> EOL_TKN; return FALSE; fin - loop - if struclen - idconst_add(@strucid, struclen, offset) - fin - return token == END_TKN -end -def parse_vars - byte idlen, type, size - word value, idptr - - when token - is CONST_TKN - if scan <> ID_TKN - return parse_err(@bad_cnst) - fin - idptr = tknptr - idlen = tknlen - if scan <> SET_TKN - return parse_err(@bad_cnst) - fin - if !parse_constexpr(@value, @size) - return parse_err(@bad_cnst) - fin - idconst_add(idptr, idlen, value) - break - is STRUC_TKN - if !parse_struc; parse_err(@bad_struc); fin - break - is BYTE_TKN - is WORD_TKN - if token == BYTE_TKN - type = BYTE_TYPE - else - type = WORD_TYPE - fin - repeat - if !parse_var(type) - return FALSE - fin - until token <> COMMA_TKN - break - is PREDEF_TKN - repeat - if scan == ID_TKN - idfunc_add(tknptr, tknlen, ctag_new) - else - return parse_err(@bad_decl) - fin - until scan <> COMMA_TKN - break - is EOL_TKN - break - otherwise - return FALSE - wend - return TRUE -end -def parse_defs - byte cfnparms - word func_tag, idptr - - if token == DEF_TKN - if scan <> ID_TKN; return parse_err(@bad_decl); fin - cfnparms = 0 - infunc = TRUE - idptr = idglobal_lookup(tknptr, tknlen) - if idptr - func_tag = idptr=>idval - else - func_tag = ctag_new - idfunc_add(tknptr, tknlen, func_tag) - fin - ctag_resolve(func_tag) - retfunc_tag = ctag_new - 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 token <> CLOSE_PAREN_TKN - return parse_err(@bad_decl) - fin - scan - fin - while parse_vars - nextln - loop - emit_enter(cfnparms) - prevstmnt = 0 - while parse_stmnt - nextln - loop - infunc = FALSE - if token <> END_TKN; return parse_err(@bad_syntax); fin - if scan <> EOL_TKN; return parse_err(@bad_syntax); fin - if prevstmnt <> RETURN_TKN - emit_const(0) - emit_leave - fin - return TRUE - elsif token == EOL_TKN - return TRUE - fin - return FALSE -end -def parse_module - idglobal_init - idlocal_init - if nextln - while parse_vars - nextln - loop - while parse_defs - nextln - loop - framesize = 0 - entrypoint = codeptr - emit_enter(0) - prevstmnt = 0 - if token <> DONE_TKN - while parse_stmnt - nextln - loop - fin - if prevstmnt <> RETURN_TKN - emit_const(0) - emit_leave - fin - if not parserr - //dumpsym(idglobal_tbl, globals) - //prstr(@entrypt_str) - //prword(entrypoint) - prstr(@bytes_compiled_str) - prword(codeptr - codebuff) - crout - keyin() - fin - return not parserr - fin - return FALSE -end -// -// Close all files -// -^$BFD8 = 0 -close(0) -// -// Set memory bitmap -// -memset($BF58, 24, 0) -^$BF58 = $CF -^$BF6F = $01 -// -// Init editor -// -if !(^machid & $80) - flags = uppercase | shiftlock - keyin = @keyin2 -else - keyin = @keyin2e -fin -if signature == $EEEE - inittxtbuf - if argbuff - strcpy(@txtfile, @argbuff) - prstr(@txtfile) - numlines = 0 - readtxt(@txtfile) - fin - signature = 0 -else - cmdmode(FALSE) -fin -curschr = '+' -flags = flags | insmode -drawscrn(scrntop, scrnleft) -curson -editmode -done diff --git a/src/toolsrc/symbols.h b/src/toolsrc/symbols.h index c69b6d0..4fc90ce 100755 --- a/src/toolsrc/symbols.h +++ b/src/toolsrc/symbols.h @@ -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) diff --git a/src/toolsrc/tokens.h b/src/toolsrc/tokens.h index dfe1421..56d5c49 100755 --- a/src/toolsrc/tokens.h +++ b/src/toolsrc/tokens.h @@ -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) diff --git a/src/vmsrc/a1cmd.pla b/src/vmsrc/a1cmd.pla index 91ea541..22339c6 100755 --- a/src/vmsrc/a1cmd.pla +++ b/src/vmsrc/a1cmd.pla @@ -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 diff --git a/src/vmsrc/cmd.pla b/src/vmsrc/cmd.pla index 6d5eb75..34bc0dc 100755 --- a/src/vmsrc/cmd.pla +++ b/src/vmsrc/cmd.pla @@ -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 diff --git a/src/vmsrc/plvm.c b/src/vmsrc/plvm.c index 402c8bd..cca64ef 100755 --- a/src/vmsrc/plvm.c +++ b/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--; diff --git a/src/vmsrc/plvm01.s b/src/vmsrc/plvm01.s index 4b7ed50..80b828e 100644 --- a/src/vmsrc/plvm01.s +++ b/src/vmsrc/plvm01.s @@ -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 ;* diff --git a/src/vmsrc/plvm02.s b/src/vmsrc/plvm02.s index c71e00c..3d65dc2 100755 --- a/src/vmsrc/plvm02.s +++ b/src/vmsrc/plvm02.s @@ -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 diff --git a/src/vmsrc/plvm03.s b/src/vmsrc/plvm03.s index d2b3649..ef0c3a9 100755 --- a/src/vmsrc/plvm03.s +++ b/src/vmsrc/plvm03.s @@ -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 ;* diff --git a/src/vmsrc/plvm802.s b/src/vmsrc/plvm802.s index 410f484..6e3b918 100644 --- a/src/vmsrc/plvm802.s +++ b/src/vmsrc/plvm802.s @@ -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 diff --git a/src/vmsrc/plvmzp.inc b/src/vmsrc/plvmzp.inc index 5e45197..58f3595 100755 --- a/src/vmsrc/plvmzp.inc +++ b/src/vmsrc/plvmzp.inc @@ -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 diff --git a/src/vmsrc/soscmd.pla b/src/vmsrc/soscmd.pla index 30fc102..769d876 100755 --- a/src/vmsrc/soscmd.pla +++ b/src/vmsrc/soscmd.pla @@ -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 diff --git a/sysfiles/filetype_extensions.conf b/sysfiles/filetype_extensions.conf new file mode 100644 index 0000000..ce0c75f --- /dev/null +++ b/sysfiles/filetype_extensions.conf @@ -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; diff --git a/sysfiles/filetypes.plasma.conf b/sysfiles/filetypes.plasma.conf new file mode 100755 index 0000000..c7acaae --- /dev/null +++ b/sysfiles/filetypes.plasma.conf @@ -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=