From 45bd973607cc42e497debfee45824b00006af5a7 Mon Sep 17 00:00:00 2001 From: dschmenk Date: Mon, 26 May 2014 21:02:26 -0700 Subject: [PATCH] Initial Import from Lawless Legends --- README.md | 400 +++++++++ User Manual.md | 497 ++++++++++++ src/class.pla | 31 + src/cmd.pla | 1411 ++++++++++++++++++++++++++++++++ src/cmdexec.pla | 179 ++++ src/cmdstub.s | 31 + src/codegen.c | 812 +++++++++++++++++++ src/codegen.h | 59 ++ src/hello.pla | 8 + src/hgr1.pla | 21 + src/hgr1test.pla | 127 +++ src/lex.c | 364 +++++++++ src/lex.h | 10 + src/makefile | 82 ++ src/parse.c | 1335 ++++++++++++++++++++++++++++++ src/parse.h | 1 + src/plasm.c | 35 + src/plvm.c | 939 +++++++++++++++++++++ src/plvm02.s | 2028 ++++++++++++++++++++++++++++++++++++++++++++++ src/plvm02zp.inc | 32 + src/rod.pla | 84 ++ src/samplib.s | 150 ++++ src/symbols.h | 39 + src/test.pla | 57 ++ src/testcls.pla | 32 + src/testlib.pla | 29 + src/tokens.h | 106 +++ 27 files changed, 8899 insertions(+) create mode 100644 README.md create mode 100644 User Manual.md create mode 100755 src/class.pla create mode 100644 src/cmd.pla create mode 100644 src/cmdexec.pla create mode 100644 src/cmdstub.s create mode 100755 src/codegen.c create mode 100755 src/codegen.h create mode 100644 src/hello.pla create mode 100644 src/hgr1.pla create mode 100644 src/hgr1test.pla create mode 100755 src/lex.c create mode 100755 src/lex.h create mode 100755 src/makefile create mode 100755 src/parse.c create mode 100755 src/parse.h create mode 100755 src/plasm.c create mode 100755 src/plvm.c create mode 100644 src/plvm02.s create mode 100644 src/plvm02zp.inc create mode 100644 src/rod.pla create mode 100755 src/samplib.s create mode 100755 src/symbols.h create mode 100755 src/test.pla create mode 100755 src/testcls.pla create mode 100755 src/testlib.pla create mode 100755 src/tokens.h diff --git a/README.md b/README.md new file mode 100644 index 0000000..6ec585d --- /dev/null +++ b/README.md @@ -0,0 +1,400 @@ +#PLASMA +##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 fast just-in-time compilation. 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. + +##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 II. 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 memory, increasing the available code space and relieving pressure on the limited 48K of data memory. In the Apple IIe with 64K expansion card, the IIc, and the IIgs, there is an auxilliary 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 auxilliary memory and fix up the entrypoints to reflect the bytecode location. + +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 +| SWAP | swap two topmost stack values +| 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 ‘;’ character. 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. + +``` + ; + ; 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 + ; + 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 + ; + ; 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 txtfile[64] = "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. Multiple brackets can follow the ‘.’ or ‘:’ type identifier, but all but the last index will be treated as a pointer to an array. + +``` + 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. + +``` + when keypressed + is keyarrowup + cursup + is keyarrowdown + cursdown + is keyarrowleft + cursleft + is keyarrowright + cursright + is keyctrlx + cutline + is keyctrlv + pasteline + is keyescape + cursoff + cmdmode + redraw + 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. + +romcall(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 = (romcall(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, len, val) 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, maxfill * 2, @nullstr) ; fill line buff with pointer to null string + memcpy(scrnptr, strptr + ofst + 1, numchars) +``` + +##Implementation Details +###The Original PLASMA +The original design concept was to create an efficient, flexible, and expressive environment for building applications directly on the Apple II. Choosing a stack based architecture was easy after much experience with other stack based implementations. It also makes the compiler simple to implement. The first take on the stack architecture was to make it a very strict stack architecture in that everything had to be on the stack. The only opcode with operands was the CONSTANT opcode. This allowed for a very small bytecode interpreter and a very easy compile target. However, only when adding an opcode with operands that would greatly improved performance, native code generation or code size was it done. The opcode table grew slowly over time but still retains a small runtime interpreter with good native code density. + +The VM was constructed such that code generation could ouput native 6502 code, threaded code into the opcode functions, or interpreted bytecodes. This gave a level of control over speed vs memory. + +###The Lawless Legends PLASMA +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 AUX 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. A game like Lawless Legends will push the capabilities of the Apple II well beyond anything before it. A powerful OS + language + VM environment is required to achieve the goals set out. + +## References +PLASMA User Manual: https://github.com/badvision/lawless-legends/blob/master/Docs/Tutorials/PLASMA/User%20Manual.md + +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/User Manual.md b/User Manual.md new file mode 100644 index 0000000..b736066 --- /dev/null +++ b/User Manual.md @@ -0,0 +1,497 @@ +# PLASMA 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 stdlib + predef puts +end + +byte hello[] = "Hello, world.\n" + +puts(@hello) +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 4096 -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 4096 to assemble the module at the proper address, 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 an assembler: 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 stdlib + 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. + +#### 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 exeample using the `predef` line from the previous examples to export an initialized array of 10 function pointer elements (2 defined + null delimiter): +``` +export word myfuncs[10] = @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 agrre 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 (2 bytes reserved for previous frame pointer, 254 bytes for local variables), due to the nature of the 6502 CPU (8 bit index register). With careful planning, this shouldn't be too constraining. + +### 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 + +### 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 +``` +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 +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. + +#### 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" +byte len +word strptr + +def strlen(strptr) + return ^strptr +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. + +### 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 +| [] | 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 +| >= | greater than or equal +| > | greater than +| <= | less than or equal +| < | less than +| OR | logical OR +| AND | logical AND + +### Statements +PLASMA definitions are a list of statements the carry out the algorithm. Statements are generally assignment or control flow in nature. + +#### 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 +``` + +#### 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 + is 'B' + ; handle B character +``` +... +``` + is 'Z' + ; handle Z character + 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 + is (a > 10) AND (a < 20) + ; between 10 and 20 + is (a >= 20) + ; 20 or greater +wend +``` + +##### 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 +``` +##### BREAK +To exit early from one of the looping constructs, the `break` statement will break out of it immediately and resume control immediately following the bottom of the loop. + +## 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/class.pla b/src/class.pla new file mode 100755 index 0000000..d5c7b43 --- /dev/null +++ b/src/class.pla @@ -0,0 +1,31 @@ +; +; Declare all imported modules and their data/functions. +; +import stdlib + predef putc, puts +end +import testcls + word print + const dec = 0 + const hex = 2 +end + +byte spaces[] = " " + +def putln + putc($0D) +end + +def printnums + word i + i = 10000 + repeat + print:dec(i) + puts(@spaces) + print:hex(i) + putln + i = i / 10 + until i == 0 +end +printnums +done diff --git a/src/cmd.pla b/src/cmd.pla new file mode 100644 index 0000000..c13fe94 --- /dev/null +++ b/src/cmd.pla @@ -0,0 +1,1411 @@ +const MACHID = $BF98 +const iobuffer = $0800 +const databuff = $2000 +const MODADDR = $1000 +const symtbl = $0C00 +const freemem = $0006 +; +; ROMCALL return register structure. +; +const acc = 0 +const xreg = 1 +const yreg = 2 +const preg = 3 +; +; System flags: memory allocator screen holes. +; +const restxt1 = $0001 +const restxt2 = $0002 +const reshgr1 = $0004 +const reshgr2 = $0008 +const resxhgr1 = $0010 +const resxhgr2 = $0020 +; +; Pedefined functions. +; +predef home, gotoxy, viewport, crout, cout, prstr, cin, rdstr +predef syscall, romcall +predef markheap, allocheap, allocalignheap, releaseheap, availheap +predef memset, memcpy, xmemcpy, memxcpy +predef uword_isgt, uword_isge, uword_islt, uword_isle +predef execmod +; +; Standard Library exported functions. +; +byte stdlibstr[] = "STDLIB" +byte clsstr[] = "CLS" +byte gotoxystr[] = "GOTOXY" +byte viewstr[] = "VIEWPORT" +byte putcstr[] = "PUTC" +byte putsstr[] = "PUTS" +byte getcstr[] = "GETC" +byte getsstr[] = "GETS" +byte sysstr[] = "SYSCALL" +byte romstr[] = "ROMCALL" +byte hpmarkstr[] = "HEAPMARK" +byte hpalignstr[] = "HEAPALLOCALIGN" +byte hpallocstr[] = "HEAPALLOC" +byte hprelstr[] = "HEAPRELEASE" +byte hpavailstr[] = "HEAPAVAIL" +byte memsetstr[] = "MEMSET" +byte memcpystr[] = "MEMCPY" +byte memxcpystr[] = "MEMXCPY" +byte uisgtstr[] = "ISUGT" +byte uisgestr[] = "ISUGE" +byte uisltstr[] = "ISULT" +byte uislestr[] = "ISULE" +byte execstr[] = "EXEC" +word exports[] = @clsstr, @home +word = @gotoxystr, @gotoxy +word = @viewstr, @viewport +word = @putcstr, @cout +word = @putsstr, @prstr +word = @getcstr, @cin +word = @getsstr, @rdstr +word = @sysstr, @syscall +word = @romstr, @romcall +word = @hpmarkstr, @markheap +word = @hpallocstr,@allocheap +word = @hpalignstr,@allocalignheap +word = @hprelstr, @releaseheap +word = @memsetstr, @memset +word = @memcpystr, @memcpy +word = @memxcpystr, @memxcpy +word = @uisgtstr, @uword_isgt +word = @uisgestr, @uword_isge +word = @uisltstr, @uword_islt +word = @uislestr, @uword_isle +word = @execstr, @execmod +word = 0 +word stdlibsym = @exports +; +; String pool. +; +byte version[] = "PLASMA 0.9\n" +byte freestr[] = "MEM FREE:$" +byte errorstr[] = "ERR:$" +byte okstr[] = "OK" +byte huhstr[] = "?\n" +byte prefix[32] = "" +; +; System variable. +; +word heap +word lastsym = symtbl +word xheap = $0800 +word systemflags = 0 +word perr +word cmdptr +; +; Utility functions +; +asm equates +;* +;* BANK SWITCHED MEM +;* +LCRDEN = $C080 +LCWTEN = $C081 +ROMEN = $C082 +LCRWEN = $C083 +LCBNK2 = $00 +LCBNK1 = $08 + !SOURCE "plvm02zp.inc" +end +; +; CALL 6502 ROUTINE +; ROMCALL(AREG, XREG, YREG, STATUS, ADDR) +; +asm romcall + PHP + LDA ESTKL,X + STA TMPL + LDA ESTKH,X + STA TMPH + INX + LDA ESTKL,X + PHA + INX + LDA ESTKL,X + TAY + INX + LDA ESTKL+1,X + PHA + LDA ESTKL,X + 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 +REGVALS !FILL 4 +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 + STX ESP + JSR $BF00 +CMD: !BYTE 00 +PARAMS: !WORD 0000 + LDX ESP + STA ESTKL,X + LDY #$00 + STY ESTKH,X + RTS +end +; +; CALL LOADED SYSTEM PROGRAM +; +asm exec + LDA #$00 + STA IFPL + LDA #$BF + STA IFPH + LDX #$FF + TXS + LDX #ESTKSZ/2 + BIT ROMEN + JMP $2000 +end +; +; EXIT +; +asm reboot + BIT ROMEN + LDA #$00 + STA $3F4 ; INVALIDATE POWER-UP BYTE + JMP ($FFFC) ; RESET +end +; +; SET MEMORY TO VALUE +; MEMSET(ADDR, SIZE, VALUE) +; +asm memset + LDY #$00 + LDA ESTKL+2,X + STA DSTL + LDA ESTKH+2,X + STA DSTH + INC ESTKL+1,X + INC ESTKH+1,X +SETMLP DEC ESTKL+1,X + BNE + + DEC ESTKH+1,X + BEQ SETMEX ++ LDA ESTKL,X + STA (DST),Y + INY + BNE + + INC DSTH ++ DEC ESTKL+1,X + BNE + + DEC ESTKH+1,X + BEQ SETMEX ++ LDA ESTKH,X + STA (DST),Y + INY + BNE SETMLP + INC DSTH + BNE SETMLP +SETMEX INX + INX + RTS +end +; +; COPY MEMORY +; MEMCPY(DSTADDR, SRCADDR, SIZE) +; +asm memcpy + LDY #$00 + LDA ESTKL,X + BNE + + LDA ESTKH,X + BEQ CPYMEX ++ LDA ESTKL+2,X + STA DSTL + LDA ESTKH+2,X + STA DSTH + LDA ESTKL+1,X + STA SRCL + LDA ESTKH+1,X + STA SRCH + CMP DSTH + BCC REVCPY + BNE FORCPY + LDA SRCL + CMP DSTL + BCS FORCPY +REVCPY ; REVERSE DIRECTION COPY +; CLC + LDA ESTKL,X + ADC DSTL + STA DSTL + LDA ESTKH,X + ADC DSTH + STA DSTH + CLC + LDA ESTKL,X + ADC SRCL + STA SRCL + LDA ESTKH,X + ADC SRCH + STA SRCH + INC ESTKH,X +REVCPYLP + LDA DSTL + BNE + + DEC DSTH ++ DEC DSTL + LDA SRCL + BNE + + DEC SRCH ++ DEC SRCL + LDA (SRC),Y + STA (DST),Y + DEC ESTKL,X + BNE REVCPYLP + DEC ESTKH,X + BNE REVCPYLP + BEQ CPYMEX +FORCPY INC ESTKH,X +FORCPYLP + LDA (SRC),Y + STA (DST),Y + INC DSTL + BNE + + INC DSTH ++ INC SRCL + BNE + + INC SRCH ++ DEC ESTKL,X + BNE FORCPYLP + DEC ESTKH,X + BNE FORCPYLP +CPYMEX INX + INX + RTS +end +; +; COPY FROM MAIN MEM TO AUX MEM. +; +; MEMXCPY(DIR, DST, SRC, SIZE) +; DIR = 0 : COPY FROM MAIN TO AUX +; DIR = 1 : COPY FROM AUX TO MAIN +; +asm memxcpy + LDA ESTKL+1,X + STA $3C + CLC + ADC ESTKL,X + STA $3E + LDA ESTKH+1,X + STA $3D + ADC ESTKH,X + STA $3F + LDA ESTKL+2,X + STA $42 + LDA ESTKH+2,X + STA $43 + STX ESP + BIT ROMEN + LDA #$00 + CMP ESTKL+3,X + JSR $C311 + BIT LCRDEN+LCBNK2 + LDX ESP + INX + INX + INX + RTS +end +; +; SET VIEWPORT +; VIEWPORT(LEFT, TOP, WIDTH, HEIGHT) +; +asm viewport + LDA ESTKL+3,X + STA $20 + LDA ESTKL+1,X + STA $21 + LDA ESTKL+2,X + STA $22 + CLC + ADC ESTKL,X + STA $23 + LDY #$00 + STY $24 + LDA $22 + INX + INX + BNE VTAB +; STX ESP +; BIT ROMEN +; JSR $FB5B +; BIT LCRDEN+LCBNK2 +; LDX ESP +; INX +; RTS +end +; +; SET VIEWPORT RELATIVE CURSOR POSITION +; GOTOXY(X,Y) +; +asm gotoxy + LDA ESTKL+1,X + STA $24 + LDA ESTKL,X + CLC + ADC $22 +VTAB STX ESP + BIT ROMEN + JSR $FB5B + BIT LCRDEN+LCBNK2 + LDX ESP + INX + RTS +end +; +; CHAR OUT +; COUT(CHAR) +; +asm cout + LDA ESTKL,X + ORA #$80 + BIT ROMEN + JSR $FDED + BIT LCRDEN+LCBNK2 + RTS +end +; +; PRINT STRING +; PRSTR(STR) +; +asm prstr + LDY #$00 + LDA ESTKL,X + STA SRCL + LDA ESTKH,X + STA SRCH + STY ESTKH,X + LDA (SRC),Y + STA ESTKL,X + BEQ + + BIT ROMEN +- INY + LDA (SRC),Y + ORA #$80 + JSR $FDED + TYA + CMP ESTKL,X + BNE - + BIT LCRDEN+LCBNK2 ++ RTS +end +; +; PRINT BYTE +; +asm prbyte + LDA ESTKL,X + STX ESP + BIT ROMEN + JSR $FDDA + LDX ESP + BIT LCRDEN+LCBNK2 + RTS +end +; +; PRINT WORD +; +asm prword + LDA ESTKH,X + TAY + LDA ESTKL,X + STX ESP + TAX + TYA + BIT ROMEN + JSR $F941 + LDX ESP + BIT LCRDEN+LCBNK2 + RTS +end +; +; READ STRING +; STR = RDSTR(PROMPTCHAR) +; +asm rdstr + LDA ESTKL,X + STA $33 + STX ESP + BIT ROMEN + JSR $FD6A + STX $01FF +- LDA $01FF,X + AND #$7F + STA $01FF,X + DEX + BPL - + LDX ESP + LDA #$FF + STA ESTKL,X + LDA #$01 + STA ESTKH,X + BIT LCRDEN+LCBNK2 + RTS +end +asm uword_isge + LDY #$00 + LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X ++ BCC + + DEY ++ STY ESTKL+1,X + STY ESTKH+1,X + INX + RTS +end +asm uword_isle + LDY #$00 + LDA ESTKL,X + CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X ++ BCC + + DEY ++ STY ESTKL+1,X + STY ESTKH+1,X + INX + RTS +end +asm uword_isgt + LDY #$FF + LDA ESTKL,X + CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X ++ BCC + + INY ++ STY ESTKL+1,X + STY ESTKH+1,X + INX + RTS +end +asm uword_islt + LDY #$FF + LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X ++ BCC + + INY ++ STY ESTKL+1,X + STY ESTKH+1,X + INX + RTS +end +; +; Utility routines. +; +; A DCI string is one that has the high bit set for every character except the last. +; More efficient than C or Pascal strings. +; +;def dcitos(dci, str) +; byte len, c +; len = 0 +; repeat +; c = (dci).[len] +; len = len + 1 +; (str).[len] = c & $7F +; until !(c & $80) +; ^str = len +; return len +;end +asm dcitos + LDA ESTKL,X + STA DSTL + LDA ESTKH,X + STA DSTH + LDA ESTKL+1,X + STA SRCL + LDA ESTKH+1,X + STA SRCH + LDY #$00 +- LDA (SRC),Y + INY + PHA + AND #$7F + STA (DST),Y + PLA + BMI - + TYA + LDY #$00 + STA (DST),Y + INX + STA ESTKL,X + STY ESTKH,X + RTS +end +;def stodci(str, dci) +; byte len, c +; len = ^str +; if len == 0 +; return +; fin +; c = toupper((str).[len]) & $7F +; len = len - 1 +; (dci).[len] = c +; while len +; c = toupper((str).[len]) | $80 +; len = len - 1 +; (dci).[len] = c +; loop +; return ^str +;end +asm stodci + LDA ESTKL,X + STA DSTL + LDA ESTKH,X + STA DSTH + LDA ESTKL+1,X + STA SRCL + LDA ESTKH+1,X + STA SRCH + INX + LDY #$00 + LDA (SRC),Y + BEQ ++ + TAY + LDA (SRC),Y + JSR TOUPR + BNE + +- LDA (SRC),Y + JSR TOUPR + ORA #$80 ++ DEY + STA (DST),Y + BNE - + LDA (SRC),Y +++ STA ESTKL,X + STY ESTKH,X + RTS +end +asm toupper + LDA ESTKL,X +TOUPR AND #$7F + CMP #'a' + BCC + + CMP #'z'+1 + BCS + + SEC + SBC #$20 ++ STA ESTKL,X + 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 + 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 +- LDA (SRC),Y + INY + STA (DST),Y + AND #$80 + BMI - + RTS +end +; +; Lookup routines. +; +;def lookuptbl(dci, tbl) +; word match +; while ^tbl +; match = dci +; while ^tbl == ^match +; if !(^tbl & $80) +; return (tbl):1 +; fin +; tbl = tbl + 1 +; match = match + 1 +; loop +; while (^tbl & $80) +; tbl = tbl + 1 +; loop +; tbl = tbl + 3 +; loop +; return 0 +asm lookuptbl + LDA ESTKL,X + STA DSTL + LDA ESTKH,X + STA DSTH + LDA ESTKL+1,X + STA SRCL + LDA ESTKH+1,X + STA SRCH + LDY #$00 +- LDA (DST),Y + BEQ + + CMP (SRC),Y + BNE ++ + INY + AND #$80 + BMI - + LDA (DST),Y + PHA + INY + LDA (DST),Y + TAY + PLA ++ INX + STA ESTKL,X + STY ESTKH,X + RTS +++ LDY #$00 +-- LDA (DST),Y + INC DSTL + BNE ++ + INC DSTH +++ AND #$80 + BMI -- + LDA #$02 + CLC + ADC DSTL + STA DSTL + TYA + ADC DSTH + STA DSTH + BNE - +end +def lookupdef(addr, deftbl) + while (deftbl).0 == $20 + if (deftbl):3 == addr + return deftbl + fin + deftbl = deftbl + 5 + loop + return 0 +;asm lookupdef +; LDA ESTKL,X +; STA DSTL +; LDA ESTKH,X +; STA DSTH +; INX +;- LDY #$00 +; LDA #$20 +; AND (DST),Y +; BEQ ++ +; LDY #$03 +; LDA (DST),Y +; CMP ESTKL,X +; BNE +++ +; INY +; LDA (DST),Y +; CMP ESTKH,X +; BNE ++ +;+ LDA DSTL +; LDY DSTH +;++ STA ESTKL,X +; STY ESTKH,X +; RTS +;+++ LDA #$05 +; CLC +; ADC DSTL +; STA DSTL +; LDA #$00 +; ADC DSTH +; STA DSTH +; BNE - +end +; +; CHAR IN +; RDKEY() +; +def cin + return romcall(0, 0, 0, 0, $FD0C).acc +end +; +; HOME +; +def home + return romcall(0, 0, 0, 0, $FC58) +end +def crout + return cout($0D) +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 online + byte params[4] + + params.0 = 2 + params.1 = 0 + params:2 = databuff + perr = syscall($C5, @params) + return databuff +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 +; +; Heap routines. +; +def availheap + byte fp + return @fp - heap +end +def allocheap(size) + word addr + addr = heap + heap = heap + size + if systemflags & reshgr1 + if uword_isle(addr, $4000) and uword_isgt(heap, $2000) + addr = $4000 + heap = addr + size + fin + fin + if systemflags & reshgr2 + if uword_isle(addr, $6000) and uword_isgt(heap, $4000) + addr = $6000 + heap = addr + size + fin + fin + if uword_isge(heap, @addr) + return 0 + fin + return addr +end +def allocalignheap(size, pow2, freeaddr) + word align, addr + if freeaddr + *freeaddr = heap + fin + align = (1 << pow2) - 1 + addr = (heap | align) + 1 + heap = addr + size + if uword_isge(heap, @addr) + return 0 + fin + return addr +end +def markheap + return heap; +end +def releaseheap(newheap) + heap = newheap; + return @newheap - heap; +end +def availxheap(void) + return $BF00 - xheap; +end +def allocxheap(size) + word xaddr + xaddr = xheap + xheap = xheap + size + if systemflags & restxt1 + if uword_isle(xaddr, $0800) and uword_isgt(xheap, $0400) + xaddr = $0800 + xheap = xaddr + size + fin + fin + if systemflags & restxt2 + if uword_isle(xaddr, $0C00) and uword_isgt(xheap, $0800) + xaddr = $0C00 + xheap = xaddr + size + fin + fin + if systemflags & resxhgr1 + if uword_isle(xaddr, $4000) and uword_isgt(xheap, $2000) + xaddr = $4000 + xheap = xaddr + size + fin + fin + if systemflags & resxhgr2 + if uword_isle(xaddr, $6000) and uword_isgt(xheap, $4000) + xaddr = $6000 + xheap = xaddr + size + fin + fin + if uword_isge(xheap, $BF00) + return 0 + fin + return xaddr +end +;def markxheap +; return xheap +;end +;def releasexheap(newxheap) +; xheap = newxheap; +; return $BF00 - xheap +;end +; +; DCI table routines, +; +;def dumptbl(tbl) +; byte len +; +; while ^tbl +; len = 0 +; while ^tbl & $80 +; cout(^tbl) +; tbl = tbl + 1 +; len = len + 1 +; loop +; cout(^tbl) +; tbl = tbl + 1 +; cout(':') +; while len < 15 +; cout(' ') +; len = len + 1 +; loop +; cout('$') +; prword(*tbl) +; crout +; tbl = tbl + 2 +; loop +;end +def addtbl(dci, val, last) + while ^dci & $80 + ^*last = ^dci + *last = *last + 1 + dci = dci + 1 + loop + ^*last = ^dci + *last = *last + 1 + **last = val + *last = *last + 2 + ^*last = 0 +end +; +; Symbol table routines. +; +def lookupsym(sym) + return lookuptbl(sym, symtbl) +end +def addsym(sym, addr) + return addtbl(sym, addr, @lastsym); +end +; +; Module routines. +; +def lookupmod(mod) + byte dci[17] + return lookuptbl(modtosym(mod, @dci), symtbl) +end +def addmod(mod, addr) + byte dci[17] + return addtbl(modtosym(mod, @dci), addr, @lastsym) +end +def lookupextern(esd, index) + word sym + byte str[16] + while ^esd + sym = esd + esd = esd + dcitos(esd, @str) + if (esd).0 & $10 and (esd).1 == index + return lookupsym(sym) + fin + esd = esd + 3 + loop + return 0 +end +def adddef(bank, addr, deflast) + (*deflast).0 = $20 + if bank == 0 + (*deflast):1 = $03D6 ; JSR $03D6 (MAIN MEM INTERP) + else + (*deflast):1 = $03DC ; JSR $03DC (AUX MEM INTERP) + fin + (*deflast):3 = addr + *deflast = *deflast + 5 + (*deflast).0 = 0 + return *deflast - 5 +end +def loadmod(mod) + word refnum, rdlen, modsize, bytecode, defofst, defcnt, init, fixup + word addr, defaddr, modaddr, modfix + word deftbl, deflast + word moddep, rld, esd, sym + byte 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 + rdlen = read(refnum, @header, 128) + modsize = header:0 + moddep = @header.1 + defofst = modsize + init = 0 + if rdlen > 4 and header:2 == $DA7E ; DAVE = magic number :-) + ; + ; This is an EXTended RELocatable (data+bytecode) module. + ; + systemflags = header:4 | systemflags + defofst = header:6 + defcnt = header:8 + init = header:10 + moddep = @header.12 + ; + ; Load module dependencies. + ; + while ^moddep + if lookupmod(moddep) == 0 + close(refnum) + refnum = 0 + if loadmod(moddep) < 0 + return perr + fin + fin + moddep = moddep + dcitos(moddep, @str) + loop + ; + ; Init def table. + ; + deftbl = allocheap(defcnt * 5 + 1) + deflast = deftbl + ^deflast = 0 + if refnum == 0 + ; + ; Reset read pointer. + ; + refnum = open(@filename, iobuffer) + rdlen = read(refnum, @header, 128) + fin + fin + ; + ; Alloc heap space for relocated module (data + bytecode). + ; + moddep = moddep + 1 + modfix = moddep - @header.2 ; Adjust to skip header + modsize = modsize - modfix + rdlen = rdlen - modfix - 2 + modaddr = allocheap(modsize) + memcpy(modaddr, moddep, rdlen) + ; + ; Read in remainder of module into memory for fixups. + ; + addr = modaddr; + repeat + addr = addr + rdlen + rdlen = read(refnum, addr, 4096) + until rdlen <= 0 + close(refnum) + ; + ; Apply all fixups and symbol import/export. + ; + modfix = modaddr - modfix + bytecode = defofst + modfix - MODADDR + rld = modaddr + modsize ; Re-Locatable Directory + esd = rld ; Extern+Entry Symbol Directory + while ^esd <> $00 ; Scan to end of ESD + esd = esd + 4 + loop + esd = esd + 1 + ; + ; Locate bytecode defs in appropriate bank. + ; + if ^MACHID & $30 == $30 + defbank = 1 + defaddr = allocxheap(rld - bytecode) + else + defbank = 0 + defaddr = bytecode + fin + ; + ; Run through the Re-Location Dictionary. + ; + while ^rld + if ^rld == $02 + ; + ; This is a bytcode def entry - add it to the def directory. + ; + adddef(defbank, (rld):1 - defofst + defaddr, @deflast) + else + addr = (rld):1 + modfix + if 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 + fin + fin + fin + rld = rld + 4 + loop + ; + ; Run through the External/Entry Symbol Directory. + ; + while ^esd + sym = esd + esd = esd + dcitos(esd, @str) + if ^esd & $08 + ; + ; EXPORT symbol - add it to the global symbol table. + ; + addr = (esd):1 + modfix - MODADDR + if uword_isge(addr, bytecode) + ; + ; Use the def directory address for bytecode. + ; + addr = lookupdef(addr - bytecode + defaddr, deftbl) + fin + addsym(sym, addr) + fin + esd = esd + 3 + loop + if defbank + ; + ; Move bytecode to AUX bank. + ; + memxcpy(0, defaddr, bytecode, modsize - (bytecode - modaddr)) + ; + ; Free up the bytecode in main memory. + ; + releaseheap(bytecode) + fin + else + perr = perr | 0x100 + return -perr + fin + ; + ; Call init routine if it exists. + ; + if init + return adddef(defbank, init - defofst + defaddr, @deflast)() + fin + return 0 +end +; +; Command mode +; +def volumes + word strbuf + byte i + + strbuf = online() + for i = 0 to 15 + ^strbuf = ^strbuf & $0F + if ^strbuf + cout('/') + prstr(strbuf) + crout() + fin + strbuf = strbuf + 16 + next +end +def catalog(optpath) + byte path[64] + byte refnum + byte firstblk + byte entrylen, entriesblk + byte i, type, len + word entry, filecnt + + if ^optpath + memcpy(@path, optpath, ^optpath + 1) + 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 + elsif (entry).$10 == $FF + cout('-') + len = len + 1 + elsif (entry).$10 == $FE + cout('+') + len = len + 1 + fin + for len = 19 - len downto 0 + 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 stripchars(strptr) + while ^strptr and ^(strptr + 1) <> ' ' + memcpy(strptr + 1, strptr + 2, ^strptr) + ^strptr = ^strptr - 1 + loop + return ^strptr +end +def stripspaces(strptr) + while ^strptr and ^(strptr + ^strptr) <= ' ' + ^strptr = ^strptr - 1 + loop + while ^strptr and ^(strptr + 1) <= ' ' + memcpy(strptr + 1, strptr + 2, ^strptr) + ^strptr = ^strptr - 1 + loop +end +def striptrail(strptr) + byte i + + for i = 1 to ^strptr + if (strptr)[i] == ' ' + ^strptr = i - 1 + return + fin + next +end +def parsecmd(strptr) + byte cmd + + cmd = 0 + stripspaces(strptr) + if ^strptr + cmd = ^(strptr + 1) + memcpy(strptr + 1, strptr + 2, ^strptr) + ^strptr = ^strptr - 1 + fin + stripspaces(strptr) + return cmd +end +def resetmemfiles + ; + ; Close all files + ; + ^$BFD8 = 0 + close(0) + ; + ; Set memory bitmap + ; + ;memclr($BF58, 24) + memset($BF58, 24, 0) + ^$BF58 = $CF + ^$BF6F = $01 +end +def execsys(sysfile) + byte refnum + word len + + if ^sysfile + memcpy($280, sysfile, ^sysfile + 1) + striptrail(sysfile) + refnum = open(sysfile, iobuffer) + if refnum + len = read(refnum, databuff, $FFFF) + resetmemfiles() + if len + memcpy(sysfile, $280, ^$280 + 1) + if stripchars(sysfile) and ^$2000 == $4C and *$2003 == $EEEE + stripspaces(sysfile) + if ^$2006 <= ^sysfile + memcpy($2006, sysfile, ^sysfile + 1) + fin + fin + striptrail($280) + exec() + fin + fin + fin +end +def execmod(modfile) + byte moddci[17] + word saveheap, savexheap, savesym, saveflags + + if stodci(modfile, @moddci) + saveheap = heap + savexheap = xheap + savesym = lastsym + saveflags = systemflags + ^lastsym = 0 + perr = loadmod(@moddci) + systemflags = saveflags + lastsym = savesym + xheap = savexheap + heap = saveheap + fin +end + +heap = *freemem +stodci(@stdlibstr, $0280) +addmod($0280, 1) +while *stdlibsym + stodci((stdlibsym):0, $0280) + addsym($0280, (stdlibsym):2) + stdlibsym = stdlibsym + 4 +loop +resetmemfiles() +prstr(@version) +prstr(@freestr) +prword(availheap) +crout +while 1 + prstr(getpfx(@prefix)) + cmdptr = rdstr($BA) + if ^cmdptr + when toupper(parsecmd(cmdptr)) + is 'Q' + reboot() + is 'C' + catalog(cmdptr) + is 'P' + setpfx(cmdptr) + is 'V' + volumes(); + is '-' + execsys(cmdptr) + is '+' + execmod(cmdptr) + otherwise + prstr(@huhstr) + wend + if perr + prstr(@errorstr) + prbyte(perr) + perr = 0 + else + prstr(@okstr) + fin + crout() + fin +loop +done diff --git a/src/cmdexec.pla b/src/cmdexec.pla new file mode 100644 index 0000000..1b9cb12 --- /dev/null +++ b/src/cmdexec.pla @@ -0,0 +1,179 @@ +const iobuffer = $0800 +const databuff = $0C00 +const memmap = $BF58 +const sysfile = $0280 +byte syshalt[] = "SYSTEM HALTED..." +byte perr +; +; Utility functions +; +; CALL PRODOS +; SYSCALL(CMD, PARAMS) +; +asm prodos + LDA ESTKL,X + LDY ESTKH,X + STA PARAMS + STY PARAMS+1 + INX + LDA ESTKL,X + STA CMD + STX ESP + JSR $BF00 +CMD: !BYTE 00 +PARAMS: !WORD 0000 + LDX ESP + STA ESTKL,X + LDY #$00 + STY ESTKH,X + RTS +end +; +; CALL LOADED SYSTEM PROGRAM +; +asm exec + LDA #$00 + STA IFPL + LDA #$BF + STA IFPH + LDX #$FE + TXS + LDX #ESTKSZ/2 + BIT ROMEN + JMP $2000 +end +; +; EXIT +; +asm reboot + BIT ROMEN + LDA #$00 + STA $3F4 ; INVALIDATE POWER-UP BYTE + JMP ($FFFC) ; RESET +end +; +; SET MEMORY TO 0 +; MEMCLR(ADDR, SIZE) +; +asm memclr + LDY #$00 + LDA ESTKL+1,X + STA DSTL + LDA ESTKH+1,X + STA DSTH + INC ESTKL,X + INC ESTKH,X + TYA +SETMLP DEC ESTKL,X + BNE + + DEC ESTKH,X + BEQ ++ ++ STA (DST),Y + INY + BNE SETMLP + INC DSTH + BNE SETMLP +++ INX + RTS +end +asm cin + BIT ROMEN + STX ESP + JSR $FD0C + LDX ESP + DEX + STA ESTKL,X + LDY #$00 + STY ESTKH,X + BIT LCRDEN+LCBNK2 + RTS +end +; +; PRINT STRING +; PRSTR(STR) +; +asm prstr + LDY #$00 + LDA ESTKL,X + STA SRCL + LDA ESTKH,X + STA SRCH + BIT ROMEN + LDA (SRC),Y + STA ESTKL,X + BEQ + +- INY + LDA (SRC),Y + ORA #$80 + JSR $FDED + TYA + CMP ESTKL,X + BNE - ++ BIT LCRDEN+LCBNK2 + RTS +end +; +; ProDOS routines +; +def open(path, buff) + byte params[6] + + params.0 = 3 + params:1 = path + params:3 = buff + params.5 = 0 + perr = prodos($C8, @params) + return params.5 +end +def close(refnum) + byte params[2] + + params.0 = 1 + params.1 = refnum + perr = prodos($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 = prodos($CA, @params) + return params:6 +end +def resetmemfiles + ; + ; Close all files + ; + ^$BFD8 = 0 + close(0) + ; + ; Set memory bitmap + ; + memclr(memmap, 24) + ^memmap.0 = $CF + ^memmap.23 = $01 +end +def execsys + byte refnum + + if ^sysfile + refnum = open(sysfile, iobuffer) + if refnum + if read(refnum, $2000, $FFFF) + resetmemfiles() + exec() + fin + fin + fin +end + +resetmemfiles() +execsys +prstr(@syshalt) +cin() +reboot() +done \ No newline at end of file diff --git a/src/cmdstub.s b/src/cmdstub.s new file mode 100644 index 0000000..6696417 --- /dev/null +++ b/src/cmdstub.s @@ -0,0 +1,31 @@ +;* +;* MOVE CMD DOWN TO $1000-$2000 +;* + LDA #<_CMDBEGIN + STA $06 + LDA #>_CMDBEGIN + STA $07 + LDA #$00 + STA $08 + LDA #$10 + STA $09 + LDY #$00 +- LDA ($06),Y + STA ($08),Y + INY + BNE - + INC $07 + INC $09 + LDA $09 + CMP #$20 + BNE - + LDA #<_CMDEND + STA $06 + LDA #>_CMDEND + STA $07 + JMP $1000 +_CMDBEGIN = * + !PSEUDOPC $1000 { + !SOURCE "cmd.a" +_CMDEND = * +} \ No newline at end of file diff --git a/src/codegen.c b/src/codegen.c new file mode 100755 index 0000000..bb5ec00 --- /dev/null +++ b/src/codegen.c @@ -0,0 +1,812 @@ +#include +#include +#include "tokens.h" +#include "lex.h" +#include "symbols.h" +#include "codegen.h" +/* + * Symbol table and fixup information. + */ +static int consts = 0; +static int externs = 0; +static int globals = 0; +static int locals = 0; +static int predefs = 0; +static int defs = 0; +static int asmdefs = 0; +static int codetags = 0; +static int fixups = 0; +static char idconst_name[1024][17]; +static int idconst_value[1024]; +static char idglobal_name[1024][17]; +static int idglobal_type[1024]; +static int idglobal_tag[1024]; +static int localsize = 0; +static char idlocal_name[128][17]; +static int idlocal_type[128]; +static int idlocal_offset[128]; +static char fixup_size[2048]; +static int fixup_type[2048]; +static int fixup_tag[2048]; +#define FIXUP_BYTE 0x00 +#define FIXUP_WORD 0x80 +int id_match(char *name, int len, char *id) +{ + if (len == id[0]) + { + if (len > 16) len = 16; + while (len--) + { + if (name[len] != id[1 + len]) + return (0); + } + return (1); + } + return (0); +} +int idconst_lookup(char *name, int len) +{ + int i; + for (i = 0; i < consts; i++) + if (id_match(name, len, &(idconst_name[i][0]))) + return (i); + return (-1); +} +int idlocal_lookup(char *name, int len) +{ + int i; + for (i = 0; i < locals; i++) + if (id_match(name, len, &(idlocal_name[i][0]))) + return (i); + return (-1); +} +int idglobal_lookup(char *name, int len) +{ + int i; + for (i = 0; i < globals; i++) + if (id_match(name, len, &(idglobal_name[i][0]))) + return (i); + return (-1); +} +int idconst_add(char *name, int len, int value) +{ + char c = name[len]; + if (consts > 1024) + { + printf("Constant count overflow\n"); + return (0); + } + name[len] = '\0'; + emit_idconst(name, value); + name[len] = c; + idconst_name[consts][0] = len; + if (len > 16) len = 16; + while (len--) + idconst_name[consts][1 + len] = name[len]; + idconst_value[consts] = value; + consts++; + return (1); +} +int idlocal_add(char *name, int len, int type, int size) +{ + char c = name[len]; + if (localsize > 255) + { + printf("Local variable size overflow\n"); + return (0); + } + name[len] = '\0'; + emit_idlocal(name, localsize); + name[len] = c; + idlocal_name[locals][0] = len; + if (len > 16) len = 16; + while (len--) + idlocal_name[locals][1 + len] = name[len]; + idlocal_type[locals] = type | LOCAL_TYPE; + idlocal_offset[locals] = localsize; + localsize += size; + locals++; + return (1); +} +int idglobal_add(char *name, int len, int type, int size) +{ + char c = name[len]; + if (globals > 1024) + { + printf("Global variable count overflow\n"); + return (0); + } + name[len] = '\0'; + name[len] = c; + idglobal_name[globals][0] = len; + if (len > 16) len = 16; + while (len--) + idglobal_name[globals][1 + len] = name[len]; + idglobal_type[globals] = type; + if (!(type & EXTERN_TYPE)) + { + emit_idglobal(globals, size, name); + idglobal_tag[globals] = globals; + globals++; + } + else + { + printf("\t\t\t\t\t; %s -> X%03d\n", &idglobal_name[globals][1], externs); + idglobal_tag[globals++] = externs++; + } + return (1); +} +int id_add(char *name, int len, int type, int size) +{ + return ((type & LOCAL_TYPE) ? idlocal_add(name, len, type, size) : idglobal_add(name, len, type, size)); +} +int idfunc_add(char *name, int len, int type, int tag) +{ + if (globals > 1024) + { + printf("Global variable count overflow\n"); + return (0); + } + idglobal_name[globals][0] = len; + if (len > 16) len = 16; + while (len--) + idglobal_name[globals][1 + len] = name[len]; + idglobal_type[globals] = type; + idglobal_tag[globals++] = tag; + if (type & EXTERN_TYPE) + printf("\t\t\t\t\t; %s -> X%03d\n", &idglobal_name[globals - 1][1], tag); + return (1); +} +int idfunc_set(char *name, int len, int type, int tag) +{ + int i; + if (((i = idglobal_lookup(name, len)) >= 0) && (idglobal_type[i] & FUNC_TYPE)) + { + idglobal_tag[i] = tag; + idglobal_type[i] = type; + return (type); + } + parse_error("Undeclared identifier"); + return (0); +} +void idglobal_size(int type, int size, int constsize) +{ + if (size > constsize) + emit_data(0, 0, 0, size - constsize); + else if (size) + emit_data(0, 0, 0, size); +} +int idlocal_size(void) +{ + return (localsize); +} +void idlocal_reset(void) +{ + locals = 0; + localsize = 2; +} +int id_tag(char *name, int len) +{ + int i; + if ((i = idlocal_lookup(name, len)) >= 0) + return (idlocal_offset[i]); + if ((i = idglobal_lookup(name, len)) >= 0) + return (idglobal_tag[i]); + return (-1); +} +int id_const(char *name, int len) +{ + int i; + if ((i = idconst_lookup(name, len)) >= 0) + return (idconst_value[i]); + parse_error("Undeclared constant"); + return (0); +} +int id_type(char *name, int len) +{ + int i; + if ((i = idconst_lookup(name, len)) >= 0) + return (CONST_TYPE); + if ((i = idlocal_lookup(name, len)) >= 0) + return (idlocal_type[i] | LOCAL_TYPE); + if ((i = idglobal_lookup(name, len)) >= 0) + return (idglobal_type[i]); + parse_error("Undeclared identifier"); + return (0); +} +int tag_new(int type) +{ + if (type & EXTERN_TYPE) + { + if (externs > 254) + parse_error("External variable count overflow\n"); + return (externs++); + } + if (type & PREDEF_TYPE) + return (predefs++); + if (type & ASM_TYPE) + return (asmdefs++); + if (type & DEF_TYPE) + return (defs++); + if (type & BRANCH_TYPE) + return (codetags++); + return globals++; +} +int fixup_new(int tag, int type, int size) +{ + fixup_tag[fixups] = tag; + fixup_type[fixups] = type; + fixup_size[fixups] = size; + return (fixups++); +} +/* + * Emit assembly code. + */ +#define BYTECODE_SEG 8 +#define INIT 16 +#define SYSFLAGS 32 +static int outflags = 0; +static char *DB = ".BYTE"; +static char *DW = ".WORD"; +static char *DS = ".RES"; +static char LBL = ':'; +char *supper(char *s) +{ + static char su[80]; + int i; + for (i = 0; s[i]; i++) + su[i] = toupper(s[i]); + su[i] = '\0'; + return su; +} +char *tag_string(int tag, int type) +{ + static char str[16]; + char t; + + if (type & EXTERN_TYPE) + t = 'X'; + else if (type & DEF_TYPE) + t = 'C'; + else if (type & ASM_TYPE) + t = 'A'; + else if (type & BRANCH_TYPE) + t = 'B'; + else if (type & PREDEF_TYPE) + t = 'P'; + else + t = 'D'; + sprintf(str, "_%c%03d", t, tag); + return str; +} +void emit_dci(char *str, int len) +{ + if (len--) + { + printf("\t; DCI STRING: %s\n", supper(str)); + printf("\t%s\t$%02X", DB, toupper(*str++) | (len ? 0x80 : 0x00)); + while (len--) + printf(",$%02X", toupper(*str++) | (len ? 0x80 : 0x00)); + printf("\n"); + } +} +void emit_flags(int flags) +{ + outflags = flags; + if (outflags & ACME) + { + DB = "!BYTE"; + DW = "!WORD"; + DS = "!FILL"; + LBL = ' '; + } +} +void emit_header(void) +{ + if (outflags & ACME) + printf("; ACME COMPATIBLE OUTPUT\n"); + else + printf("; CA65 COMPATIBLE OUTPUT\n"); + if (outflags & MODULE) + { + printf("\t%s\t_SEGEND-_SEGBEGIN\t; LENGTH OF HEADER + CODE/DATA + BYTECODE SEGMENT\n", DW); + printf("_SEGBEGIN%c\n", LBL); + printf("\t%s\t$DA7E\t\t\t; MAGIC #\n", DW); + printf("\t%s\t_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); + printf("\t%s\t_INIT\t\t\t; MODULE INITIALIZATION ROUTINE\n", DW); + } + else + { + printf("\tJMP\t_INIT\t\t\t; MODULE INITIALIZATION ROUTINE\n"); + } +} +void emit_rld(void) +{ + int i; + + printf(";\n; RE-LOCATEABLE DICTIONARY\n;\n"); + /* + * First emit the bytecode definition entrypoint information. + */ + for (i = 0; i < globals; i++) + if (!(idglobal_type[i] & EXTERN_TYPE) && (idglobal_type[i] & DEF_TYPE)) + { + printf("\t%s\t$02\t\t\t; CODE TABLE FIXUP\n", DB); + printf("\t%s\t_C%03d\t\t\n", DW, idglobal_tag[i]); + printf("\t%s\t$00\n", DB); + } + /* + * Now emit the fixup table. + */ + for (i = 0; i < fixups; i++) + { + if (fixup_type[i] & EXTERN_TYPE) + { + printf("\t%s\t$%02X\t\t\t; EXTERNAL FIXUP\n", DB, 0x11 + fixup_size[i] & 0xFF); + printf("\t%s\t_F%03d-_SEGBEGIN\t\t\n", DW, i); + printf("\t%s\t%d\t\t\t; ESD INDEX\n", DB, fixup_tag[i]); + } + else + { + printf("\t%s\t$%02X\t\t\t; INTERNAL FIXUP\n", DB, 0x01 + fixup_size[i] & 0xFF); + printf("\t%s\t_F%03d-_SEGBEGIN\t\t\n", DW, i); + printf("\t%s\t$00\n", DB); + } + } + printf("\t%s\t$00\t\t\t; END OF RLD\n", DB); +} +void emit_esd(void) +{ + int i; + + printf(";\n; EXTERNAL/ENTRY SYMBOL DICTIONARY\n;\n"); + for (i = 0; i < globals; i++) + { + if (idglobal_type[i] & EXTERN_TYPE) + { + 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) + { + emit_dci(&idglobal_name[i][1], idglobal_name[i][0]); + printf("\t%s\t$08\t\t\t; ENTRY SYMBOL FLAG\n", DB); + printf("\t%s\t%s\t\t\n", DW, tag_string(idglobal_tag[i], idglobal_type[i])); + } + } + printf("\t%s\t$00\t\t\t; END OF ESD\n", DB); +} +void emit_trailer(void) +{ + if (!(outflags & BYTECODE_SEG)) + emit_bytecode_seg(); + if (!(outflags & INIT)) + printf("_INIT\t=\t0\n"); + if (!(outflags & SYSFLAGS)) + printf("_SYSFLAGS\t=\t0\n"); + if (outflags & MODULE) + { + printf("_DEFCNT\t=\t%d\n", defs); + printf("_SEGEND%c\n", LBL); + emit_rld(); + emit_esd(); + } +} +void emit_moddep(char *name, int len) +{ + if (name) + emit_dci(name, len); + else + printf("\t%s\t$00\t\t\t; END OF MODULE DEPENDENCIES\n", DB); +} +void emit_sysflags(int val) +{ + printf("_SYSFLAGS\t=\t$%04X\t\t; SYSTEM FLAGS\n", val); + outflags |= SYSFLAGS; +} +void emit_bytecode_seg(void) +{ + if ((outflags & MODULE) && !(outflags & BYTECODE_SEG)) + printf("_SUBSEG%c\t\t\t\t; BYTECODE STARTS\n", LBL); + outflags |= BYTECODE_SEG; +} +void emit_comment(char *s) +{ + printf("\t\t\t\t\t; %s\n", s); +} +void emit_asm(char *s) +{ + printf("%s\n", s); +} +void emit_idlocal(char *name, int value) +{ + printf("\t\t\t\t\t; %s -> [%d]\n", name, value); +} +void emit_idglobal(int tag, int size, char *name) +{ + if (size == 0) + printf("_D%03d%c\t\t\t\t\t; %s\n", tag, LBL, name); + else + printf("_D%03d%c\t%s\t%d\t\t\t; %s\n", tag, LBL, DS, size, name); +} +void emit_idfunc(int tag, int type, char *name) +{ + printf("%s%c\t\t\t\t\t; %s()\n", tag_string(tag, type), LBL, name); +} +void emit_idconst(char *name, int value) +{ + printf("\t\t\t\t\t; %s = %d\n", name, value); +} +int emit_data(int vartype, int consttype, long constval, int constsize) +{ + int datasize, i; + char *str; + if (consttype == 0) + { + datasize = constsize; + printf("\t%s\t$%02X\n", DS, constsize); + } + else if (consttype & STRING_TYPE) + { + datasize = constsize; + str = (char *)constval; + printf("\t%s\t$%02X\n", DB, --constsize); + while (constsize-- > 0) + { + printf("\t%s\t$%02X", DB, *str++); + for (i = 0; i < 7; i++) + { + if (constsize-- > 0) + printf(",$%02X", *str++); + else + break; + } + printf("\n"); + } + } + else if (consttype & ADDR_TYPE) + { + if (vartype & WORD_TYPE) + { + int fixup = fixup_new(constval, consttype, FIXUP_WORD); + datasize = 2; + if (consttype & EXTERN_TYPE) + printf("_F%03d%c\t%s\t0\t\t\t; %s\n", fixup, LBL, DW, tag_string(constval, consttype)); + else + printf("_F%03d%c\t%s\t%s\n", fixup, LBL, DW, tag_string(constval, consttype)); + } + else + { + int fixup = fixup_new(constval, consttype, FIXUP_BYTE); + datasize = 1; + if (consttype & EXTERN_TYPE) + printf("_F%03d%c\t%s\t0\t\t\t; %s\n", fixup, LBL, DB, tag_string(constval, consttype)); + else + printf("_F%03d%c\t%s\t%s\n", fixup, LBL, DB, tag_string(constval, consttype)); + } + } + else + { + if (vartype & WORD_TYPE) + { + datasize = 2; + printf("\t%s\t$%04lX\n", DW, constval & 0xFFFF); + } + else + { + datasize = 1; + printf("\t%s\t$%02lX\n", DB, constval & 0xFF); + } + } + return (datasize); +} +void emit_def(char *name, int is_bytecode) +{ + if (!(outflags & MODULE)) + { + //printf("%s%c\n", name, LBL); + if (is_bytecode) + printf("\tJSR $03D0\n"); + } +} +void emit_codetag(int tag) +{ + printf("_B%03d%c\n", tag, LBL); +} +void emit_const(int cval) +{ + if (cval == 0) + printf("\t%s\t$00\t\t\t; ZERO\n", DB); + else if (cval > 0 && cval < 256) + printf("\t%s\t$2A,$%02X\t\t\t; CB\t%d\n", DB, cval, cval); + else + printf("\t%s\t$2C,$%02X,$%02X\t\t; CW\t%d\n", DB, cval&0xFF,(cval>>8)&0xFF, cval); +} +void emit_lb(void) +{ + printf("\t%s\t$60\t\t\t; LB\n", DB); +} +void emit_lw(void) +{ + printf("\t%s\t$62\t\t\t; LW\n", DB); +} +void emit_llb(int index) +{ + printf("\t%s\t$64,$%02X\t\t\t; LLB\t[%d]\n", DB, index, index); +} +void emit_llw(int index) +{ + printf("\t%s\t$66,$%02X\t\t\t; LLW\t[%d]\n", DB, index, index); +} +void emit_lab(int tag, int offset, int type) +{ + int fixup = fixup_new(tag, type, FIXUP_WORD); + char *taglbl = tag_string(tag, type); + printf("\t%s\t$68\t\t\t; LAB\t%s+%d\n", DB, taglbl, offset); + printf("_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl, offset); +} +void emit_law(int tag, int offset, int type) +{ + int fixup = fixup_new(tag, type, FIXUP_WORD); + char *taglbl = tag_string(tag, type); + printf("\t%s\t$6A\t\t\t; LAW\t%s+%d\n", DB, taglbl, offset); + printf("_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl, offset); +} +void emit_sb(void) +{ + printf("\t%s\t$70\t\t\t; SB\n", DB); +} +void emit_sw(void) +{ + printf("\t%s\t$72\t\t\t; SW\n", DB); +} +void emit_slb(int index) +{ + printf("\t%s\t$74,$%02X\t\t\t; SLB\t[%d]\n", DB, index, index); +} +void emit_slw(int index) +{ + printf("\t%s\t$76,$%02X\t\t\t; SLW\t[%d]\n", DB, index, index); +} +void emit_dlb(int index) +{ + printf("\t%s\t$6C,$%02X\t\t\t; DLB\t[%d]\n", DB, index, index); +} +void emit_dlw(int index) +{ + printf("\t%s\t$6E,$%02X\t\t\t; DLW\t[%d]\n", DB, index, index); +} +void emit_sab(int tag, int offset, int type) +{ + int fixup = fixup_new(tag, type, FIXUP_WORD); + char *taglbl = tag_string(tag, type); + printf("\t%s\t$78\t\t\t; SAB\t%s+%d\n", DB, taglbl, offset); + printf("_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl, offset); +} +void emit_saw(int tag, int offset, int type) +{ + int fixup = fixup_new(tag, type, FIXUP_WORD); + char *taglbl = tag_string(tag, type); + printf("\t%s\t$7A\t\t\t; SAW\t%s+%d\n", DB, taglbl, offset); + printf("_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl, offset); +} +void emit_dab(int tag, int type) +{ + int fixup = fixup_new(tag, type, FIXUP_WORD); + char *taglbl = tag_string(tag, type); + printf("\t%s\t$7C\t\t\t; DAB\t%s\n", DB, taglbl); + printf("_F%03d%c\t%s\t%s\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl); +} +void emit_daw(int tag, int type) +{ + int fixup = fixup_new(tag, type, FIXUP_WORD); + char *taglbl = tag_string(tag, type); + printf("\t%s\t$7E\t\t\t; DAW\t%s\n", DB, taglbl); + printf("_F%03d%c\t%s\t%s\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl); +} +void emit_localaddr(int index) +{ + printf("\t%s\t$28,$%02X\t\t\t; LLA\t[%d]\n", DB, index, index); +} +void emit_globaladdr(int tag, int offset, int type) +{ + int fixup = fixup_new(tag, type, FIXUP_WORD); + char *taglbl = tag_string(tag, type); + printf("\t%s\t$26\t\t\t; LA\t%s+%d\n", DB, taglbl, offset); + printf("_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "" : taglbl, offset); +} +void emit_indexbyte(void) +{ + printf("\t%s\t$02\t\t\t; IDXB\n", DB); +} +void emit_indexword(void) +{ + printf("\t%s\t$1E\t\t\t; IDXW\n", DB); +} +void emit_brfls(int tag) +{ + printf("\t%s\t$4C\t\t\t; BRFLS\t_B%03d\n", DB, tag); + printf("\t%s\t_B%03d-*\n", DW, tag); +} +void emit_brtru(int tag) +{ + printf("\t%s\t$4E\t\t\t; BRTRU\t_B%03d\n", DB, tag); + printf("\t%s\t_B%03d-*\n", DW, tag); +} +void emit_brnch(int tag) +{ + printf("\t%s\t$50\t\t\t; BRNCH\t_B%03d\n", DB, tag); + printf("\t%s\t_B%03d-*\n", DW, tag); +} +void emit_breq(int tag) +{ + printf("\t%s\t$3C\t\t\t; BREQ\t_B%03d\n", DB, tag); + printf("\t%s\t_B%03d-*\n", DW, tag); +} +void emit_brne(int tag) +{ + printf("\t%s\t$3E\t\t\t; BRNE\t_B%03d\n", DB, tag); + printf("\t%s\t_B%03d-*\n", DW, tag); +} +void emit_brgt(int tag) +{ + printf("\t%s\t$38\t\t\t; BRGT\t_B%03d\n", DB, tag); + printf("\t%s\t_B%03d-*\n", DW, tag); +} +void emit_brlt(int tag) +{ + printf("\t%s\t$3A\t\t\t; BRLT\t_B%03d\n", DB, tag); + printf("\t%s\t_B%03d-*\n", DW, tag); +} +void emit_call(int tag, int type) +{ + int fixup = fixup_new(tag, type, FIXUP_WORD); + char *taglbl = tag_string(tag, type); + printf("\t%s\t$54\t\t\t; CALL\t%s\n", DB, taglbl); + printf("_F%03d%c\t%s\t%s\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl); +} +void emit_ical(void) +{ + printf("\t%s\t$56\t\t\t; ICAL\n", DB); +} +void emit_leave(int framesize) +{ + if (framesize > 2) + printf("\t%s\t$5A\t\t\t; LEAVE\n", DB); + else + printf("\t%s\t$5C\t\t\t; RET\n", DB); +} +void emit_ret(void) +{ + printf("\t%s\t$5C\t\t\t; RET\n", DB); +} +void emit_enter(int framesize, int cparams) +{ + if (framesize > 2) + printf("\t%s\t$58,$%02X,$%02X\t\t; ENTER\t%d,%d\n", DB, framesize, cparams, framesize, cparams); +} +void emit_start(void) +{ + printf("_INIT%c\n", LBL); + outflags |= INIT; + defs++; +} +void emit_dup(void) +{ + printf("\t%s\t$32\t\t\t; DUP\n", DB); +} +void emit_push(void) +{ + printf("\t%s\t$34\t\t\t; PUSH\n", DB); +} +void emit_pull(void) +{ + printf("\t%s\t$36\t\t\t; PULL\n", DB); +} +void emit_swap(void) +{ + printf("\t%s\t$2E\t\t\t; SWAP\n", DB); +} +void emit_drop(void) +{ + printf("\t%s\t$30\t\t\t; DROP\n", DB); +} +int emit_unaryop(int op) +{ + switch (op) + { + case NEG_TOKEN: + printf("\t%s\t$10\t\t\t; NEG\n", DB); + break; + case COMP_TOKEN: + printf("\t%s\t$12\t\t\t; COMP\n", DB); + break; + case LOGIC_NOT_TOKEN: + printf("\t%s\t$20\t\t\t; NOT\n", DB); + break; + case INC_TOKEN: + printf("\t%s\t$0C\t\t\t; INCR\n", DB); + break; + case DEC_TOKEN: + printf("\t%s\t$0E\t\t\t; DECR\n", DB); + break; + case BPTR_TOKEN: + emit_lb(); + break; + case WPTR_TOKEN: + emit_lw(); + break; + default: + printf("emit_unaryop(%c) ???\n", op & 0x7F); + return (0); + } + return (1); +} +int emit_op(t_token op) +{ + switch (op) + { + case MUL_TOKEN: + printf("\t%s\t$06\t\t\t; MUL\n", DB); + break; + case DIV_TOKEN: + printf("\t%s\t$08\t\t\t; DIV\n", DB); + break; + case MOD_TOKEN: + printf("\t%s\t$0A\t\t\t; MOD\n", DB); + break; + case ADD_TOKEN: + printf("\t%s\t$02\t\t\t; ADD\n", DB); + break; + case SUB_TOKEN: + printf("\t%s\t$04\t\t\t; SUB\n", DB); + break; + case SHL_TOKEN: + printf("\t%s\t$1A\t\t\t; SHL\n", DB); + break; + case SHR_TOKEN: + printf("\t%s\t$1C\t\t\t; SHR\n", DB); + break; + case AND_TOKEN: + printf("\t%s\t$14\t\t\t; AND\n", DB); + break; + case OR_TOKEN: + printf("\t%s\t$16\t\t\t; IOR\n", DB); + break; + case EOR_TOKEN: + printf("\t%s\t$18\t\t\t; XOR\n", DB); + break; + case EQ_TOKEN: + printf("\t%s\t$40\t\t\t; ISEQ\n", DB); + break; + case NE_TOKEN: + printf("\t%s\t$42\t\t\t; ISNE\n", DB); + break; + case GE_TOKEN: + printf("\t%s\t$48\t\t\t; ISGE\n", DB); + break; + case LT_TOKEN: + printf("\t%s\t$46\t\t\t; ISLT\n", DB); + break; + case GT_TOKEN: + printf("\t%s\t$44\t\t\t; ISGT\n", DB); + break; + case LE_TOKEN: + printf("\t%s\t$4A\t\t\t; ISLE\n", DB); + break; + case LOGIC_OR_TOKEN: + printf("\t%s\t$22\t\t\t; LOR\n", DB); + break; + case LOGIC_AND_TOKEN: + printf("\t%s\t$24\t\t\t; LAND\n", DB); + break; + case COMMA_TOKEN: + break; + default: + return (0); + } + return (1); +} diff --git a/src/codegen.h b/src/codegen.h new file mode 100755 index 0000000..3c47732 --- /dev/null +++ b/src/codegen.h @@ -0,0 +1,59 @@ +#define ACME 1 +#define MODULE 2 +void emit_flags(int flags); +void emit_header(void); +void emit_trailer(void); +void emit_moddep(char *name, int len); +void emit_sysflags(int val); +void emit_bytecode_seg(void); +void emit_comment(char *s); +void emit_asm(char *s); +void emit_idlocal(char *name, int value); +void emit_idglobal(int value, int size, char *name); +void emit_idfunc(int tag, int type, char *name); +void emit_idconst(char *name, int value); +void emit_def(char *name, int is_bytecode); +int emit_data(int vartype, int consttype, long constval, int constsize); +void emit_codetag(int tag); +void emit_const(int cval); +void emit_lb(void); +void emit_lw(void); +void emit_llb(int index); +void emit_llw(int index); +void emit_lab(int tag, int offset, int type); +void emit_law(int tag, int offset, int type); +void emit_sb(void); +void emit_sw(void); +void emit_slb(int index); +void emit_slw(int index); +void emit_dlb(int index); +void emit_dlw(int index); +void emit_sab(int tag, int offset, int type); +void emit_saw(int tag, int ofset, int type); +void emit_dab(int tag, int type); +void emit_daw(int tag, int type); +void emit_call(int tag, int type); +void emit_ical(void); +void emit_localaddr(int index); +void emit_globaladdr(int tag, int offset, int type); +void emit_indexbyte(void); +void emit_indexword(void); +int emit_unaryop(int op); +int emit_op(t_token op); +void emit_brtru(int tag); +void emit_brfls(int tag); +void emit_brgt(int tag); +void emit_brlt(int tag); +void emit_brne(int tag); +void emit_brnch(int tag); +void emit_swap(void); +void emit_dup(void); +void emit_push(void); +void emit_pull(void); +void emit_drop(void); +void emit_leave(int framesize); +void emit_ret(void); +void emit_enter(int framesize, int cparams); +void emit_start(void); +void emit_rld(void); +void emit_esd(void); diff --git a/src/hello.pla b/src/hello.pla new file mode 100644 index 0000000..36f52b6 --- /dev/null +++ b/src/hello.pla @@ -0,0 +1,8 @@ +import STDLIB + predef puts +end + +byte hellostr[] = "Hello, world.\n" + +puts(@hellostr) +done diff --git a/src/hgr1.pla b/src/hgr1.pla new file mode 100644 index 0000000..41f4114 --- /dev/null +++ b/src/hgr1.pla @@ -0,0 +1,21 @@ +import STDLIB + predef memset + ; + ; System flags: memory allocator screen holes. + ; + const restxt1 = $0001 + const restxt2 = $0002 + const reshgr1 = $0004 + const reshgr2 = $0008 + const resxhgr1 = $0010 + const resxhgr2 = $0020 +end + +sysflags reshgr1 ; Reserve HGR page 1 + +memset($2000, $2000, 0) ; Clear HGR page 1 +^$C054 +^$C052 +^$C057 +^$C050 +done \ No newline at end of file diff --git a/src/hgr1test.pla b/src/hgr1test.pla new file mode 100644 index 0000000..86adc87 --- /dev/null +++ b/src/hgr1test.pla @@ -0,0 +1,127 @@ +import STDLIB + predef memset, memcpy, getc, heapalloc, heapmark, heaprelease +end +import HGR1 +end + +const view_height = 64 ; scan count of ground view +const fix_bits = 8 ; number of fixed point bits +; +; Hardware addresses +; +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 +word hgrpage[] = hgr1, hgr2 +word hgrscan[] = $0000,$0400,$0800,$0C00,$1000,$1400,$1800,$1C00 +word = $0080,$0480,$0880,$0C80,$1080,$1480,$1880,$1C80 +word = $0100,$0500,$0900,$0D00,$1100,$1500,$1900,$1D00 +word = $0180,$0580,$0980,$0D80,$1180,$1580,$1980,$1D80 +word = $0200,$0600,$0A00,$0E00,$1200,$1600,$1A00,$1E00 +word = $0280,$0680,$0A80,$0E80,$1280,$1680,$1A80,$1E80 +word = $0300,$0700,$0B00,$0F00,$1300,$1700,$1B00,$1F00 +word = $0380,$0780,$0B80,$0F80,$1380,$1780,$1B80,$1F80 +word = $0028,$0428,$0828,$0C28,$1028,$1428,$1828,$1C28 +word = $00A8,$04A8,$08A8,$0CA8,$10A8,$14A8,$18A8,$1CA8 +word = $0128,$0528,$0928,$0D28,$1128,$1528,$1928,$1D28 +word = $01A8,$05A8,$09A8,$0DA8,$11A8,$15A8,$19A8,$1DA8 +word = $0228,$0628,$0A28,$0E28,$1228,$1628,$1A28,$1E28 +word = $02A8,$06A8,$0AA8,$0EA8,$12A8,$16A8,$1AA8,$1EA8 +word = $0328,$0728,$0B28,$0F28,$1328,$1728,$1B28,$1F28 +word = $03A8,$07A8,$0BA8,$0FA8,$13A8,$17A8,$1BA8,$1FA8 +word = $0050,$0450,$0850,$0C50,$1050,$1450,$1850,$1C50 +word = $00D0,$04D0,$08D0,$0CD0,$10D0,$14D0,$18D0,$1CD0 +word = $0150,$0550,$0950,$0D50,$1150,$1550,$1950,$1D50 +word = $01D0,$05D0,$09D0,$0DD0,$11D0,$15D0,$19D0,$1DD0 +word = $0250,$0650,$0A50,$0E50,$1250,$1650,$1A50,$1E50 +word = $02D0,$06D0,$0AD0,$0ED0,$12D0,$16D0,$1AD0,$1ED0 +word = $0350,$0750,$0B50,$0F50,$1350,$1750,$1B50,$1F50 +word = $03D0,$07D0,$0BD0,$0FD0,$13D0,$17D0,$1BD0,$1FD0 +word hcolor[] = $0000,$552A,$2A55,$7F7F,$8080,$D5AA,$AAD5,$FFFF +; +; def draw_scan(d8p8, scanptr) +; +asm draw_scan + !SOURCE "plvm02zp.inc" +WFIXL = $80 +WFIXH = $81 +WINT = $82 +PIX = $83 + LDA ESTKL,X + STA TMPL + LDA ESTKH,X + STA TMPH + LDA ESTKL+1,X + STA WFIXL + STA WFIXH + LDA ESTKH+1,X + LSR + STA WINT + ROR WFIXH + ROR WFIXL + LDA #$FF + SEC + SBC WFIXL + STA WFIXL + LDA #$FF + SBC WFIXH + STA WFIXH + LDA #$FF + SBC WINT + STA WINT + LDY #$01 + STY PIX + DEY +- EOR ESTKH+1,X + LSR + BCC + + LDA PIX + ORA (TMP),Y + STA (TMP),Y ++ ASL PIX + BPL + + LDA #$01 + STA PIX + INY + CPY #36 + BEQ ++ ++ LDA ESTKL+1,X + CLC + ADC WFIXL + STA WFIXL + LDA ESTKH+1,X + ADC WFIXH + STA WFIXH + LDA #$00 + ADC WINT + STA WINT + BNE - + BEQ - +++ INX + RTS +end +def draw_ground(page) + byte ip + + for ip = 1 to view_height + draw_scan((127 << fix_bits) / ip, hgrpage[page] + hgrscan[ip + 191 - view_height] + 2) + next +end + +draw_ground(page1) +getc +^showpage1 +^showtext +done \ No newline at end of file diff --git a/src/lex.c b/src/lex.c new file mode 100755 index 0000000..10f1bf8 --- /dev/null +++ b/src/lex.c @@ -0,0 +1,364 @@ +#include +#include +#include +#include "tokens.h" +#include "symbols.h" + +char *statement, *scanpos, *tokenstr; +t_token scantoken, prevtoken; +int tokenlen; +long constval; +int lineno = 0; +t_token keywords[] = { + IF_TOKEN, 'I', 'F', + ELSE_TOKEN, 'E', 'L', 'S', 'E', + ELSEIF_TOKEN, 'E', 'L', 'S', 'I', 'F', + FIN_TOKEN, 'F', 'I', 'N', + WHILE_TOKEN, 'W', 'H', 'I', 'L', 'E', + LOOP_TOKEN, 'L', 'O', 'O', 'P', + CASE_TOKEN, 'W', 'H', 'E', 'N', + OF_TOKEN, 'I', 'S', + DEFAULT_TOKEN, 'O', 'T', 'H', 'E', 'R', 'W', 'I', 'S', 'E', + ENDCASE_TOKEN, 'W', 'E', 'N', 'D', + FOR_TOKEN, 'F', 'O', 'R', + TO_TOKEN, 'T', 'O', + DOWNTO_TOKEN, 'D', 'O', 'W', 'N', 'T', 'O', + STEP_TOKEN, 'S', 'T', 'E', 'P', + NEXT_TOKEN, 'N', 'E', 'X', 'T', + REPEAT_TOKEN, 'R', 'E', 'P', 'E', 'A', 'T', + UNTIL_TOKEN, 'U', 'N', 'T', 'I', 'L', + BREAK_TOKEN, 'B', 'R', 'E', 'A', 'K', + ASM_TOKEN, 'A', 'S', 'M', + DEF_TOKEN, 'D', 'E', 'F', + EXPORT_TOKEN, 'E', 'X', 'P', 'O', 'R', 'T', + IMPORT_TOKEN, 'I', 'M', 'P', 'O', 'R', 'T', + RETURN_TOKEN, 'R', 'E', 'T', 'U', 'R', 'N', + END_TOKEN, 'E', 'N', 'D', + EXIT_TOKEN, 'E', 'X', 'I', 'T', + 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, 'B', 'Y', 'T', 'E', + WORD_TOKEN, 'W', 'O', 'R', 'D', + CONST_TOKEN, 'C', 'O', 'N', 'S', 'T', + PREDEF_TOKEN, 'P', 'R', 'E', 'D', 'E', 'F', + SYSFLAGS_TOKEN, 'S', 'Y', 'S', 'F', 'L', 'A', 'G', 'S', + EOL_TOKEN +}; + +void parse_error(char *errormsg) +{ + char *error_carrot = statement; + + fprintf(stderr, "\n%4d: %s\n ", lineno, statement); + for (error_carrot = statement; error_carrot != tokenstr; error_carrot++) + putc(*error_carrot == '\t' ? '\t' : ' ', stderr); + fprintf(stderr, "^\nError: %s\n", errormsg); + exit(1); +} +t_token scan(void) +{ + prevtoken = scantoken; + /* + * Skip whitespace. + */ + while (*scanpos && (*scanpos == ' ' || *scanpos == '\t')) scanpos++; + tokenstr = scanpos; + /* + * Scan for token based on first character. + */ + if (*scanpos == '\0' || *scanpos == '\n' || *scanpos == ';') + scantoken = EOL_TOKEN; + else if ((scanpos[0] >= 'a' && scanpos[0] <= 'z') + || (scanpos[0] >= 'A' && scanpos[0] <= 'Z') + || (scanpos[0] == '_')) + { + /* + * ID, either variable name or reserved word. + */ + int keypos = 0, matchpos = 0; + + do + { + scanpos++; + } + while ((*scanpos >= 'a' && *scanpos <= 'z') + || (*scanpos >= 'A' && *scanpos <= 'Z') + || (*scanpos == '_') + || (*scanpos >= '0' && *scanpos <= '9')); + scantoken = ID_TOKEN; + tokenlen = scanpos - tokenstr; + /* + * Search for matching keyword. + */ + while (keywords[keypos] != EOL_TOKEN) + { + while (keywords[keypos + 1 + matchpos] == toupper(tokenstr[matchpos])) + matchpos++; + if (IS_TOKEN(keywords[keypos + 1 + matchpos]) && (matchpos == tokenlen)) + { + /* + * A match. + */ + scantoken = keywords[keypos]; + break; + } + else + { + /* + * Find next keyword. + */ + keypos += matchpos + 1; + matchpos = 0; + while (!IS_TOKEN(keywords[keypos])) keypos++; + } + } + } + else if (scanpos[0] >= '0' && scanpos[0] <= '9') + { + /* + * Number constant. + */ + for (constval = 0; *scanpos >= '0' && *scanpos <= '9'; scanpos++) + constval = constval * 10 + *scanpos - '0'; + scantoken = INT_TOKEN; + } + else if (scanpos[0] == '$') + { + /* + * Hexadecimal constant. + */ + constval = 0; + while (scanpos++) + { + if (*scanpos >= '0' && *scanpos <= '9') + constval = constval * 16 + *scanpos - '0'; + else if (*scanpos >= 'A' && *scanpos <= 'F') + constval = constval * 16 + *scanpos - 'A' + 10; + else if (*scanpos >= 'a' && *scanpos <= 'f') + constval = constval * 16 + *scanpos - 'a' + 10; + else + break; + } + scantoken = INT_TOKEN; + } + else if (scanpos[0] == '\'') + { + /* + * Character constant. + */ + scantoken = CHAR_TOKEN; + if (scanpos[1] != '\\') + { + constval = scanpos[1]; + if (scanpos[2] != '\'') + { + parse_error("Bad character constant"); + return (-1); + } + scanpos += 3; + } + else + { + switch (scanpos[2]) + { + case 'n': + constval = 0x0D; + break; + case 'r': + constval = '\r'; + break; + case 't': + constval = '\t'; + break; + case '\'': + constval = '\''; + break; + case '\\': + constval = '\\'; + break; + case '0': + constval = '\0'; + break; + default: + parse_error("Bad character constant"); + return (-1); + } + if (scanpos[3] != '\'') + { + parse_error("Bad character constant"); + return (-1); + } + scanpos += 4; + } + } + else if (scanpos[0] == '\"') + { + char *scanshift; + /* + * String constant. + */ + scantoken = STRING_TOKEN; + constval = (long)++scanpos; + while (*scanpos && *scanpos != '\"') + { + if (*scanpos == '\\') + { + switch (scanpos[1]) + { + case 'n': + *scanpos = 0x0D; + break; + case 'r': + *scanpos = '\r'; + break; + case 't': + *scanpos = '\t'; + break; + case '\'': + *scanpos = '\''; + break; + case '\\': + *scanpos = '\\'; + break; + case '0': + *scanpos = '\0'; + break; + default: + parse_error("Bad string constant"); + return (-1); + } + for (scanshift = scanpos + 1; *scanshift; scanshift++) + scanshift[0] = scanshift[1]; + } + else + scanpos++; + } + if (!*scanpos++) + { + parse_error("Unterminated string"); + return (-1); + } + } + else + { + /* + * Potential two and three character tokens. + */ + switch (scanpos[0]) + { + case '>': + if (scanpos[1] == '>') + { + scantoken = SHR_TOKEN; + scanpos += 2; + } + else if (scanpos[1] == '=') + { + scantoken = GE_TOKEN; + scanpos += 2; + } + else + { + scantoken = GT_TOKEN; + scanpos++; + } + break; + case '<': + if (scanpos[1] == '<') + { + scantoken = SHL_TOKEN; + scanpos += 2; + } + else if (scanpos[1] == '=') + { + scantoken = LE_TOKEN; + scanpos += 2; + } + else if (scanpos[1] == '>') + { + scantoken = NE_TOKEN; + scanpos += 2; + } + else + { + scantoken = LT_TOKEN; + scanpos++; + } + break; + case '=': + if (scanpos[1] == '=') + { + scantoken = EQ_TOKEN; + scanpos += 2; + } + else + { + scantoken = SET_TOKEN; + scanpos++; + } + break; + case '+': + if (scanpos[1] == '+') + { + scantoken = INC_TOKEN; + scanpos += 2; + } + else + { + scantoken = ADD_TOKEN; + scanpos++; + } + break; + case '-': + if (scanpos[1] == '-') + { + scantoken = DEC_TOKEN; + scanpos += 2; + } + else + { + scantoken = SUB_TOKEN; + scanpos++; + } + break; + default: + /* + * Simple single character tokens. + */ + scantoken = TOKEN(*scanpos++); + } + } + tokenlen = scanpos - tokenstr; + return (scantoken); +} +void scan_rewind(char *backptr) +{ + scanpos = backptr; +} +int scan_lookahead(void) +{ + char *backpos = scanpos; + char *backstr = tokenstr; + int prevtoken = scantoken; + int prevlen = tokenlen; + int look = scan(); + scanpos = backpos; + tokenstr = backstr; + scantoken = prevtoken; + tokenlen = prevlen; + return (look); +} +char inputline[512]; +int next_line(void) +{ + gets(inputline); + lineno++; + statement = inputline; + scanpos = inputline; + scantoken = EOL_TOKEN; + scan(); + printf("; %03d: %s\n", lineno, inputline); + return (1); +} diff --git a/src/lex.h b/src/lex.h new file mode 100755 index 0000000..5bfbda7 --- /dev/null +++ b/src/lex.h @@ -0,0 +1,10 @@ +extern char *statement, *scanpos, *tokenstr; +extern t_token scantoken, prevtoken; +extern int tokenlen; +extern long constval; +extern char inputline[]; +void parse_error(char *errormsg); +int next_line(void); +void scan_rewind(char *backptr); +int scan_lookahead(void); +t_token scan(void); diff --git a/src/makefile b/src/makefile new file mode 100755 index 0000000..da8c635 --- /dev/null +++ b/src/makefile @@ -0,0 +1,82 @@ +.SUFFIXES = +AFLAGS = -o $@ +LFLAGS = -C default.cfg +PLVM = plvm +PLVM02 = PLVM02.SYS +CMD = CMD.SYS +PLASM = plasm +INCS = tokens.h symbols.h lex.h parse.h codegen.h +OBJS = plasm.c parse.o lex.o codegen.o +# +# Image filetypes for Virtual ][ +# +PLATYPE = .\$$ED +BINTYPE = .BIN +SYSTYPE = .SYS +TXTTYPE = .TXT +# +# Image filetypes for CiderPress +# +#PLATYPE = \#ed0000 +#BINTYPE = \#060000 +#SYSTYPE = \#ff0000 +#TXTTYPE = \#040000 + +all: $(PLASM) $(PLVM) $(PLVM02) $(CMD) TESTLIB ROD.REL + +clean: + -rm *.o *~ *.a *.SYM *.SYS *.REL TESTLIB $(PLASM) $(PLVM) + +$(PLASM): $(OBJS) $(INCS) + cc $(OBJS) -o $(PLASM) + +$(PLVM): plvm.c + cc plvm.c -o $(PLVM) + +cmdexec.a: cmdexec.pla $(PLASM) + ./$(PLASM) -A < cmdexec.pla > cmdexec.a + +$(PLVM02): plvm02.s cmdexec.a + acme -o $(PLVM02) -l PLVM02.SYM plvm02.s + +$(CMD): cmd.pla cmdstub.s $(PLVM) $(PLASM) + ./$(PLASM) -A < cmd.pla > cmd.a + acme --setpc 8192 -o $(CMD) cmdstub.s + +TESTLIB: testlib.pla $(PLVM) $(PLASM) + ./$(PLASM) -AM < testlib.pla > testlib.a + acme --setpc 4094 -o TESTLIB testlib.a + +test: test.pla TESTLIB $(PLVM) $(PLASM) + ./$(PLASM) -AM < test.pla > test.a + acme --setpc 4094 -o TEST.REL test.a + ./$(PLVM) TEST.REL + +TESTCLS: testcls.pla $(PLVM) $(PLASM) + ./$(PLASM) -AM < testcls.pla > testcls.a + acme --setpc 4094 -o TESTCLS testcls.a + +class: class.pla TESTCLS $(PLVM) $(PLASM) + ./$(PLASM) -AM < class.pla > class.a + acme --setpc 4094 -o CLASS.REL class.a + ./$(PLVM) CLASS.REL + +debug: test.pla TESTLIB $(PLVM) $(PLASM) + ./$(PLASM) -AM < test.pla > test.a + acme --setpc 4094 -o TEST.REL test.a + ./$(PLVM) -s TEST.REL MAIN + +hello: hello.pla $(PLVM) $(PLASM) + ./$(PLASM) -AM < hello.pla > hello.a + acme --setpc 4094 -o HELLO.REL hello.a + ./$(PLVM) HELLO.REL + +ROD.REL: rod.pla $(PLVM) $(PLASM) + ./$(PLASM) -AM < rod.pla > rod.a + acme --setpc 4094 -o ROD.REL rod.a + +HGR1: hgr1.pla hgr1test.pla $(PLVM) $(PLASM) + ./$(PLASM) -AM < hgr1test.pla > hgr1test.a + acme --setpc 4094 -o HGR1TEST.REL hgr1test.a + ./$(PLASM) -AM < hgr1.pla > hgr1.a + acme --setpc 4094 -o HGR1 hgr1.a diff --git a/src/parse.c b/src/parse.c new file mode 100755 index 0000000..67d82f2 --- /dev/null +++ b/src/parse.c @@ -0,0 +1,1335 @@ +#include +#include "tokens.h" +#include "symbols.h" +#include "lex.h" +#include "codegen.h" +#include "parse.h" + +int infunc = 0, break_tag = 0, stack_loop = 0; +t_token prevstmnt; + +t_token binary_ops_table[] = { + /* Highest precedence */ + MUL_TOKEN, DIV_TOKEN, MOD_TOKEN, + ADD_TOKEN, SUB_TOKEN, + SHR_TOKEN, SHL_TOKEN, + AND_TOKEN, + EOR_TOKEN, + OR_TOKEN, + GT_TOKEN, GE_TOKEN, LT_TOKEN, LE_TOKEN, + EQ_TOKEN, NE_TOKEN, + LOGIC_AND_TOKEN, + LOGIC_OR_TOKEN + /* Lowest precedence */ +}; +t_token binary_ops_precedence[] = { + /* Highest precedence */ + 1, 1, 1, + 2, 2, + 3, 3, + 4, + 5, + 6, + 7, 7, 7, 7, + 8, 8, + 9, + 10 + /* Lowest precedence */ +}; + +t_token opstack[16]; +int precstack[16]; +int opsptr = -1; +void push_op(t_token op, int prec) +{ + if (++opsptr == 16) + { + parse_error("Stack overflow\n"); + return; + } + opstack[opsptr] = op; + precstack[opsptr] = prec; +} +t_token pop_op(void) +{ + if (opsptr < 0) + { + parse_error("Stack underflow\n"); + return (0); + } + return opstack[opsptr--]; +} +t_token tos_op(void) +{ + return opsptr < 0 ? 0 : opstack[opsptr]; +} +int tos_op_prec(int tos) +{ + return opsptr <= tos ? 100 : precstack[opsptr]; +} +int parse_expr(void); +int parse_term(void) +{ + /* + * Parse terminal tokens. + */ + switch (scan()) + { + case CHAR_TOKEN: + case INT_TOKEN: + case FLOAT_TOKEN: + case ID_TOKEN: + case STRING_TOKEN: + break; + case OPEN_PAREN_TOKEN: + if (!parse_expr()) + { + parse_error("Bad expression in parenthesis"); + return (0); + } + if (scantoken != CLOSE_PAREN_TOKEN) + { + parse_error("Missing closing parenthesis"); + return (0); + } + break; + default: + /* + * Non-terminal token. + */ + return (0); + } + return (1); +} +int parse_constval(long *value, int *size) +{ + int mod = 0, type = 0; + *value = 0; + while (!parse_term()) + { + switch (scantoken) + { + case ADD_TOKEN: + /* + * Just ignore unary plus, it is a no-op. + */ + break; + case NEG_TOKEN: + mod |= 1; + break; + case COMP_TOKEN: + mod |= 2; + break; + case LOGIC_NOT_TOKEN: + mod |= 4; + break; + case AT_TOKEN: + mod |= 8; + break; + default: + return (0); + } + } + /* + * Determine which terminal type. + */ + if (scantoken == STRING_TOKEN) + { + *value = constval; + *size = tokenlen - 1; + type = STRING_TYPE; + if (mod) + { + parse_error("Invalid string modifiers"); + return (0); + } + } + else if (scantoken == CHAR_TOKEN) + { + *value = constval; + *size = 1; + type = CONST_TYPE; + } + else if (scantoken == INT_TOKEN) + { + *value = constval; + *size = 2; + type = CONST_TYPE; + } + else if (scantoken == ID_TOKEN) + { + 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))) + *value = id_tag(tokenstr, tokenlen); + else + { + parse_error("Invalid constant"); + return (0); + } + } + else + { + parse_error("Invalid constant"); + return (0); + } + if (mod & 1) + *value = -*value; + if (mod & 2) + *value = ~*value; + if (mod & 4) + *value = *value ? 0 : -1; + return (type); +} +int parse_value(int rvalue) +{ + int cparams; + int deref = rvalue; + int optos = opsptr; + int type = 0, value = 0, emit_value = 0; + int elem_size, elem_type; + long elem_offset = 0; + /* + * Parse pre operand operators. + */ + while (!parse_term()) + { + switch (scantoken) + { + case ADD_TOKEN: + /* + * Just ignore unary plus, it is a no-op. + */ + break; + case BPTR_TOKEN: + if (deref) + push_op(scantoken, 0); + else + { + type |= BPTR_TYPE; + deref++; + } + break; + case WPTR_TOKEN: + if (deref) + push_op(scantoken, 0); + else + { + type |= WPTR_TYPE; + deref++; + } + break; + case AT_TOKEN: + deref--; + break; + case NEG_TOKEN: + case COMP_TOKEN: + case LOGIC_NOT_TOKEN: + push_op(scantoken, 0); + break; + default: + return (0); + } + } + /* + * Determine which terminal type. + */ + if (scantoken == INT_TOKEN || scantoken == CHAR_TOKEN) + { + value = constval; + type |= CONST_TYPE; + } + else if (scantoken == ID_TOKEN) + { + if ((type |= id_type(tokenstr, tokenlen)) & CONST_TYPE) + value = id_const(tokenstr, tokenlen); + else if (type & VAR_TYPE) + value = id_tag(tokenstr, tokenlen); + else if (type & FUNC_TYPE) + value = id_tag(tokenstr, tokenlen); + else + { + printf("Bad ID type\n"); + return (0); + } + } + else if (scantoken == CLOSE_PAREN_TOKEN) + { + // type |= WORD_TYPE; + emit_value = 1; + } + else + return (0); + if (type & CONST_TYPE) + { + /* + * Quick optimizations + */ + while ((optos < opsptr) + && ((tos_op() == NEG_TOKEN) || (tos_op() == COMP_TOKEN) || (tos_op() == LOGIC_NOT_TOKEN))) + { + switch (pop_op()) + { + case NEG_TOKEN: + value = -value; + break; + case COMP_TOKEN: + value = ~value; + break; + case LOGIC_NOT_TOKEN: + value = value ? 0 : -1; + break; + } + } + } + /* + * Parse post operand operators. + */ + while (scan() == OPEN_PAREN_TOKEN + || scantoken == OPEN_BRACKET_TOKEN + || scantoken == DOT_TOKEN + || scantoken == COLON_TOKEN) + { + if (scantoken == OPEN_BRACKET_TOKEN) + { + /* + * Array + */ + if (!emit_value) + { + if (type & ADDR_TYPE) + { + if (type & LOCAL_TYPE) + emit_localaddr(value); + else + emit_globaladdr(value, 0, type); + } + else if (type & CONST_TYPE) + { + emit_const(value); + } + emit_value = 1; + } + if (type & PTR_TYPE) + emit_lw(); + if (!parse_expr()) + { + parse_error("Bad expression"); + return (0); + } + if (scantoken != CLOSE_BRACKET_TOKEN) + { + parse_error("Missing closing bracket"); + return (0); + } + if (type & WORD_TYPE) + { + //type |= WPTR_TYPE; + type = WPTR_TYPE; + emit_indexword(); + } + else + { + //type |= BPTR_TYPE; + type = BPTR_TYPE; + emit_indexbyte(); + } + //type &= ~(ADDR_TYPE | CONST_TYPE); + } + else if (scantoken == DOT_TOKEN || scantoken == COLON_TOKEN) + { + /* + * Structure member offset or array of arrays + */ + elem_type = (scantoken == DOT_TOKEN) ? BPTR_TYPE : WPTR_TYPE; + if (parse_constval(&elem_offset, &elem_size)) + { + /* + * Constant member offset + */ + if (!emit_value) + { + if (type & VAR_TYPE) + { + elem_type = (type & ~VAR_TYPE) | (elem_type == BPTR_TYPE ? BYTE_TYPE : WORD_TYPE); + } + else if (type & CONST_TYPE) + { + value += elem_offset; + emit_const(value); + elem_offset = 0; + emit_value = 1; + } + else // FUNC_TYPE + { + emit_globaladdr(value, elem_offset, type); + emit_value = 1; + } + } + else + { + if (elem_offset != 0) + { + emit_const(elem_offset); + emit_op(ADD_TOKEN); + elem_offset = 0; + } + } + } + else if (scantoken == OPEN_BRACKET_TOKEN) + { + /* + * Array of arrays + */ + if (!emit_value) + { + if (type & ADDR_TYPE) + { + if (type & LOCAL_TYPE) + emit_localaddr(value + elem_offset); + else + emit_globaladdr(value, elem_offset, type); + } + else if (type & CONST_TYPE) + { + emit_const(value); + } + emit_value = 1; + } + while (parse_expr()) + { + if (scantoken != COMMA_TOKEN) + break; + emit_indexword(); + emit_lw(); + } + if (scantoken != CLOSE_BRACKET_TOKEN) + { + parse_error("Missing closing bracket"); + return (0); + } + if (elem_type & WPTR_TYPE) + emit_indexword(); + else + emit_indexbyte(); + } + else + { + parse_error("Invalid member offset"); + return (0); + } + type = elem_type; //(type & ~(ADDR_TYPE | CONST_TYPE)) | elem_type; + } + else if (scantoken == OPEN_PAREN_TOKEN) + { + /* + * Function call + */ + if (emit_value && !(type & (FUNC_TYPE | CONST_TYPE))) + { + if (scan_lookahead() != CLOSE_PAREN_TOKEN) + emit_push(); + } + cparams = 0; + while (parse_expr()) + { + cparams++; + if (scantoken != COMMA_TOKEN) + break; + } + if (scantoken != CLOSE_PAREN_TOKEN) + { + parse_error("Missing closing parenthesis"); + return (0); + } + if (type & (FUNC_TYPE | CONST_TYPE)) + emit_call(value, type); + else + { + if (!emit_value) + { + if (type & VAR_TYPE) + { + if (type & LOCAL_TYPE) + emit_llw(value + elem_offset); + else + emit_law(value, elem_offset, type); + } + else if (type & PTR_TYPE) + emit_lw(); + } + else + if (cparams) + emit_pull(); + emit_ical(); + } + emit_value = 1; + type = WORD_TYPE; //(type & ~(FUNC_TYPE | CONST_TYPE)) | WORD_TYPE; + } + } + if (emit_value) + { + if (rvalue && deref && (type & PTR_TYPE)) + (type & BPTR_TYPE) ? emit_lb() : emit_lw(); + } + else + { + if (type & CONST_TYPE) + emit_const(value); + else if (deref) + { + if (type & FUNC_TYPE) + emit_call(value, type); + else if (type & VAR_TYPE) + { + if (type & LOCAL_TYPE) + (type & BYTE_TYPE) ? emit_llb(value + elem_offset) : emit_llw(value + elem_offset); + else + (type & BYTE_TYPE) ? emit_lab(value, elem_offset, type) : emit_law(value, elem_offset, type); + } + else if (type & PTR_TYPE) + (type & BPTR_TYPE) ? emit_lb() : emit_lw(); + } + else + { + if (type & LOCAL_TYPE) + emit_localaddr(value + elem_offset); + else + emit_globaladdr(value, elem_offset, type); + } + } + while (optos < opsptr) + { + if (!emit_unaryop(pop_op())) + { + parse_error(": Invalid unary operation"); + return (0); + } + } + return (type ? type : WORD_TYPE); +} +int parse_constexpr(long *value, int *size) +{ + long val1, val2; + int type, size1, size2 = 0; + + if (!(type = parse_constval(&val1, &size1))) + return (0); + if (scan() == ADD_TOKEN) + { + if (!parse_constval(&val2, &size2)) + return (0); + *value = val1 + val2; + } + else if (scantoken == SUB_TOKEN) + { + if (!parse_constval(&val2, &size2)) + return (0); + *value = val1 - val2; + } + else if (scantoken == MUL_TOKEN) + { + if (!parse_constval(&val2, &size2)) + return (0); + *value = val1 * val2; + } + else if (scantoken == DIV_TOKEN) + { + if (!parse_constval(&val2, &size2)) + return (0); + *value = val1 / val2; + } + else if (scantoken == AND_TOKEN) + { + if (!parse_constval(&val2, &size2)) + return (0); + *value = val1 & val2; + } + else if (scantoken == OR_TOKEN) + { + if (!parse_constval(&val2, &size2)) + return (0); + *value = val1 | val2; + } + else if (scantoken == EOR_TOKEN) + { + if (!parse_constval(&val2, &size2)) + return (0); + *value = val1 ^ val2; + } + else + *value = val1; + *size = size1 > size2 ? size1 : size2; + return (type); +} +int parse_expr() +{ + int prevmatch; + int matchop = 0; + int optos = opsptr; + int i; + int prevtype, type = 0; + do + { + /* + * Parse sequence of double operand operations. + */ + prevmatch = matchop; + matchop = 0; + if (parse_value(1)) + { + matchop = 1; + for (i = 0; i < sizeof(binary_ops_table); i++) + if (scantoken == binary_ops_table[i]) + { + matchop = 2; + if (binary_ops_precedence[i] >= tos_op_prec(optos)) + if (!emit_op(pop_op())) + { + parse_error(": Invalid binary operation"); + return (0); + } + push_op(scantoken, binary_ops_precedence[i]); + break; + } + } + } + while (matchop == 2); + if (matchop == 0 && prevmatch == 2) + { + parse_error("Missing operand"); + return (0); + } + while (optos < opsptr) + if (!emit_op(pop_op())) + { + parse_error(": Invalid binary operation"); + return (0); + } + return (matchop || prevmatch); +} +int parse_stmnt(void) +{ + int tag_prevbrk, tag_else, tag_endif, tag_while, tag_wend, tag_repeat, tag_for, tag_choice, type, addr, step; + char *idptr; + + /* + * Optimization for last function LEAVE + */ + if (scantoken != END_TOKEN && scantoken != DONE_TOKEN) + prevstmnt = scantoken; + + switch (scantoken) + { + case IF_TOKEN: + if (!parse_expr()) + { + parse_error("Bad expression"); + return (0); + } + tag_else = tag_new(BRANCH_TYPE); + tag_endif = tag_new(BRANCH_TYPE); + emit_brfls(tag_else); + scan(); + do { + while (parse_stmnt()) next_line(); + if (scantoken != ELSEIF_TOKEN) + break; + emit_brnch(tag_endif); + emit_codetag(tag_else); + if (!parse_expr()) + { + parse_error("Bad expression"); + return (0); + } + tag_else = tag_new(BRANCH_TYPE); + emit_brfls(tag_else); + } + while (1); + if (scantoken == ELSE_TOKEN) + { + emit_brnch(tag_endif); + emit_codetag(tag_else); + scan(); + while (parse_stmnt()) next_line(); + emit_codetag(tag_endif); + } + else + { + emit_codetag(tag_else); + emit_codetag(tag_endif); + } + if (scantoken != FIN_TOKEN) + { + parse_error("Missing IF/FIN"); + return (0); + } + break; + case WHILE_TOKEN: + tag_while = tag_new(BRANCH_TYPE); + tag_wend = tag_new(BRANCH_TYPE); + tag_prevbrk = break_tag; + break_tag = tag_wend; + emit_codetag(tag_while); + if (!parse_expr()) + { + parse_error("Bad expression"); + return (0); + } + emit_brfls(tag_wend); + while (parse_stmnt()) next_line(); + if (scantoken != LOOP_TOKEN) + { + parse_error("Missing WHILE/END"); + return (0); + } + emit_brnch(tag_while); + emit_codetag(tag_wend); + break_tag = tag_prevbrk; + break; + case REPEAT_TOKEN: + tag_prevbrk = break_tag; + break_tag = tag_new(BRANCH_TYPE); + tag_repeat = tag_new(BRANCH_TYPE); + emit_codetag(tag_repeat); + scan(); + while (parse_stmnt()) next_line(); + if (scantoken != UNTIL_TOKEN) + { + parse_error("Missing REPEAT/UNTIL"); + return (0); + } + if (!parse_expr()) + { + parse_error("Bad expression"); + return (0); + } + emit_brfls(tag_repeat); + emit_codetag(break_tag); + break_tag = tag_prevbrk; + break; + case FOR_TOKEN: + stack_loop++; + tag_prevbrk = break_tag; + break_tag = tag_new(BRANCH_TYPE); + tag_for = tag_new(BRANCH_TYPE); + if (scan() != ID_TOKEN) + { + parse_error("Missing FOR variable"); + return (0); + } + type = id_type(tokenstr, tokenlen); + addr = id_tag(tokenstr, tokenlen); + if (scan() != SET_TOKEN) + { + parse_error("Missing FOR ="); + return (0); + } + if (!parse_expr()) + { + parse_error("Bad FOR expression"); + return (0); + } + emit_codetag(tag_for); + if (type & LOCAL_TYPE) + type & BYTE_TYPE ? emit_dlb(addr) : emit_dlw(addr); + else + type & BYTE_TYPE ? emit_dab(addr, type) : emit_daw(addr, type); + if (scantoken == TO_TOKEN) + step = 1; + else if (scantoken == DOWNTO_TOKEN) + step = -1; + else + { + parse_error("Missing FOR TO"); + return (0); + } + if (!parse_expr()) + { + parse_error("Bad FOR TO expression"); + return (0); + } + step > 0 ? emit_brgt(break_tag) : emit_brlt(break_tag); + if (scantoken == STEP_TOKEN) + { + if (!parse_expr()) + { + parse_error("Bad FOR STEP expression"); + return (0); + } + emit_op(step > 0 ? ADD_TOKEN : SUB_TOKEN); + } + else + emit_unaryop(step > 0 ? INC_TOKEN : DEC_TOKEN); + while (parse_stmnt()) next_line(); + if (scantoken != NEXT_TOKEN) + { + parse_error("Missing FOR/NEXT "); + return (0); + } + emit_brnch(tag_for); + emit_codetag(break_tag); + emit_drop(); + break_tag = tag_prevbrk; + stack_loop--; + break; + case CASE_TOKEN: + stack_loop++; + tag_prevbrk = break_tag; + break_tag = tag_new(BRANCH_TYPE); + tag_choice = tag_new(BRANCH_TYPE); + if (!parse_expr()) + { + parse_error("Bad CASE expression"); + return (0); + } + next_line(); + while (scantoken != ENDCASE_TOKEN) + { + if (scantoken == OF_TOKEN) + { + if (!parse_expr()) + { + parse_error("Bad CASE OF expression"); + return (0); + } + emit_brne(tag_choice); + while (parse_stmnt()) next_line(); + emit_brnch(break_tag); + emit_codetag(tag_choice); + tag_choice = tag_new(BRANCH_TYPE); + } + else if (scantoken == DEFAULT_TOKEN) + { + scan(); + while (parse_stmnt()) next_line(); + if (scantoken != ENDCASE_TOKEN) + { + parse_error("Bad CASE DEFAULT clause"); + return (0); + } + } + else + { + parse_error("Bad CASE clause"); + return (0); + } + } + emit_codetag(break_tag); + emit_drop(); + break_tag = tag_prevbrk; + stack_loop--; + break; + case BREAK_TOKEN: + if (break_tag) + emit_brnch(break_tag); + else + { + parse_error("BREAK without loop"); + return (0); + } + break; + case RETURN_TOKEN: + if (infunc) + { + int i; + for (i = 0; i < stack_loop; i++) + emit_drop(); + if (!parse_expr()) + emit_const(0); + emit_leave(idlocal_size()); + } + else + { + if (!parse_expr()) + emit_const(0); + emit_ret(); + } + break; + case EOL_TOKEN: + case COMMENT_TOKEN: + return (1); + case ELSE_TOKEN: + case ELSEIF_TOKEN: + case FIN_TOKEN: + case LOOP_TOKEN: + case UNTIL_TOKEN: + case NEXT_TOKEN: + case OF_TOKEN: + case DEFAULT_TOKEN: + case ENDCASE_TOKEN: + case END_TOKEN: + case DONE_TOKEN: + case DEF_TOKEN: + return (0); + case ID_TOKEN: + idptr = tokenstr; + type = id_type(tokenstr, tokenlen); + addr = id_tag(tokenstr, tokenlen); + if (type & VAR_TYPE) + { + int elem_type = type; + long elem_offset = 0; + if (scan() == DOT_TOKEN || scantoken == COLON_TOKEN) + { + /* + * Structure member offset + */ + int elem_size; + elem_type = (scantoken == DOT_TOKEN) ? BYTE_TYPE : WORD_TYPE; + if (!parse_constval(&elem_offset, &elem_size)) + scantoken = ID_TOKEN; + else + scan(); + } + if (scantoken == SET_TOKEN) + { + if (!parse_expr()) + { + parse_error("Bad expression"); + return (0); + } + if (type & LOCAL_TYPE) + (elem_type & BYTE_TYPE) ? emit_slb(addr + elem_offset) : emit_slw(addr + elem_offset); + else + (elem_type & BYTE_TYPE) ? emit_sab(addr, elem_offset, type) : emit_saw(addr, elem_offset, type); + break; + } + } + else if (type & FUNC_TYPE) + { + if (scan() == EOL_TOKEN) + { + emit_call(addr, type); + emit_drop(); + break; + } + } + tokenstr = idptr; + default: + scan_rewind(tokenstr); + if ((type = parse_value(0)) != 0) + { + if (scantoken == SET_TOKEN) + { + if (!parse_expr()) + { + parse_error("Bad expression"); + return (0); + } + if (type & LOCAL_TYPE) + (type & (BYTE_TYPE | BPTR_TYPE)) ? emit_sb() : emit_sw(); + else + (type & (BYTE_TYPE | BPTR_TYPE)) ? emit_sb() : emit_sw(); + } + else + { + if (type & BPTR_TYPE) + emit_lb(); + else if (type & WPTR_TYPE) + emit_lw(); + emit_drop(); + } + } + else + { + parse_error("Syntax error"); + return (0); + } + } + if (scan() != EOL_TOKEN && scantoken != COMMENT_TOKEN) + { + parse_error("Extraneous characters"); + return (0); + } + return (1); +} +int parse_var(int type) +{ + char *idstr; + long constval; + int consttype, constsize, arraysize, idlen = 0; + long size = 1; + + if (scan() == ID_TOKEN) + { + idstr = tokenstr; + idlen = tokenlen; + if (scan() == OPEN_BRACKET_TOKEN) + { + size = 0; + parse_constexpr(&size, &constsize); + if (scantoken != CLOSE_BRACKET_TOKEN) + { + parse_error("Missing closing bracket"); + return (0); + } + scan(); + } + } + if (type & WORD_TYPE) + size *= 2; + if (scantoken == SET_TOKEN) + { + if (type & (EXTERN_TYPE | LOCAL_TYPE)) + { + parse_error("Cannot initiallize local/external variables"); + return (0); + } + if (idlen) + idglobal_add(idstr, idlen, type, 0); + if ((consttype = parse_constexpr(&constval, &constsize))) + { + /* + * Variable initialization. + */ + arraysize = emit_data(type, consttype, constval, constsize); + while (scantoken == COMMA_TOKEN) + { + if ((consttype = parse_constexpr(&constval, &constsize))) + arraysize += emit_data(type, consttype, constval, constsize); + else + { + parse_error("Bad array declaration"); + return (0); + } + } + if (size > arraysize) + idglobal_size(PTR_TYPE, size, arraysize); + } + else + { + parse_error("Bad variable initializer"); + return (0); + } + } + else if (idlen) + id_add(idstr, idlen, type, size); + return (1); +} +int parse_vars(int type) +{ + long value; + int idlen, size; + char *idstr; + + switch (scantoken) + { + case SYSFLAGS_TOKEN: + if (type & (EXTERN_TYPE | LOCAL_TYPE)) + { + parse_error("sysflags must be global"); + return (0); + } + if (!parse_constexpr(&value, &size)) + { + parse_error("Bad constant"); + return (0); + } + emit_sysflags(value); + break; + case CONST_TOKEN: + if (scan() != ID_TOKEN) + { + parse_error("Missing variable"); + return (0); + } + idstr = tokenstr; + idlen = tokenlen; + if (scan() != SET_TOKEN) + { + parse_error("Bad LValue"); + return (0); + } + if (!parse_constexpr(&value, &size)) + { + parse_error("Bad constant"); + return (0); + } + idconst_add(idstr, idlen, value); + break; + case EXPORT_TOKEN: + if (type & (EXTERN_TYPE | LOCAL_TYPE)) + { + parse_error("Cannot export local/imported variables"); + return (0); + } + type = EXPORT_TYPE; + idstr = tokenstr; + if (scan() != BYTE_TOKEN && scantoken != WORD_TOKEN) + { + /* + * This could be an exported definition. + */ + scan_rewind(idstr); + scan(); + return (0); + } + /* + * Fall through to BYTE or WORD declaration. + */ + case BYTE_TOKEN: + case WORD_TOKEN: + type |= (scantoken == BYTE_TOKEN) ? BYTE_TYPE : WORD_TYPE; + if (!parse_var(type)) + return (0); + while (scantoken == COMMA_TOKEN) + { + if (!parse_var(type)) + return (0); + } + break; + case PREDEF_TOKEN: + /* + * Pre definition. + */ + if (scan() == ID_TOKEN) + { + type |= PREDEF_TYPE; + idstr = tokenstr; + idlen = tokenlen; + idfunc_add(tokenstr, tokenlen, type, tag_new(type)); + while (scan() == COMMA_TOKEN) + { + if (scan() == ID_TOKEN) + { + idstr = tokenstr; + idlen = tokenlen; + idfunc_add(tokenstr, tokenlen, type, tag_new(type)); + } + else + { + parse_error("Bad function pre-declaration"); + return (0); + } + } + } + else + { + parse_error("Bad function pre-declaration"); + return (0); + } + case EOL_TOKEN: + case COMMENT_TOKEN: + return (1); + default: + return (0); + } + return (1); +} +int parse_mods(void) +{ + if (scantoken == IMPORT_TOKEN) + { + if (scan() != ID_TOKEN) + { + parse_error("Bad import definition"); + return (0); + } + emit_moddep(tokenstr, tokenlen); + scan(); + while (parse_vars(EXTERN_TYPE)) next_line(); + if (scantoken != END_TOKEN) + { + parse_error("Syntax error"); + return (0); + } + if (scan() != EOL_TOKEN && scantoken != COMMENT_TOKEN) + { + parse_error("Extraneous characters"); + return (0); + } + } + if (scantoken == EOL_TOKEN || scantoken == COMMENT_TOKEN) + return (1); + emit_moddep(0, 0); + return (0); +} +int parse_defs(void) +{ + char c; + int func_tag, cfnparms, type = GLOBAL_TYPE; + static char bytecode = 0; + if (scantoken == EXPORT_TOKEN) + { + if (scan() != DEF_TOKEN && scantoken != ASM_TOKEN) + { + parse_error("Bad export definition"); + return 0; + } + type = EXPORT_TYPE; + } + if (scantoken == DEF_TOKEN) + { + if (scan() != ID_TOKEN) + { + parse_error("Missing function name"); + return (0); + } + emit_bytecode_seg(); + bytecode = 1; + cfnparms = 0; + infunc = 1; + type |= DEF_TYPE; + if (idglobal_lookup(tokenstr, tokenlen) >= 0) + { + if (!(id_type(tokenstr, tokenlen) & PREDEF_TYPE)) + { + parse_error("Mismatch function type"); + return (0); + } + emit_idfunc(id_tag(tokenstr, tokenlen), PREDEF_TYPE, tokenstr); + func_tag = tag_new(type); + idfunc_set(tokenstr, tokenlen, type, func_tag); // Override any predef type & tag + } + else + { + func_tag = tag_new(type); + idfunc_add(tokenstr, tokenlen, type, func_tag); + } + c = tokenstr[tokenlen]; + tokenstr[tokenlen] = '\0'; + emit_idfunc(func_tag, type, tokenstr); + emit_def(tokenstr, 1); + tokenstr[tokenlen] = c; + idlocal_reset(); + if (scan() == OPEN_PAREN_TOKEN) + { + do + { + if (scan() == ID_TOKEN) + { + cfnparms++; + idlocal_add(tokenstr, tokenlen, WORD_TYPE, 2); + scan(); + } + } while (scantoken == COMMA_TOKEN); + if (scantoken != CLOSE_PAREN_TOKEN) + { + parse_error("Bad function parameter list"); + return (0); + } + scan(); + } + while (parse_vars(LOCAL_TYPE)) next_line(); + emit_enter(idlocal_size(), cfnparms); + prevstmnt = 0; + while (parse_stmnt()) next_line(); + infunc = 0; + if (scantoken != END_TOKEN) + { + parse_error("Syntax error"); + return (0); + } + if (scan() != EOL_TOKEN && scantoken != COMMENT_TOKEN) + { + parse_error("Extraneous characters"); + return (0); + } + if (prevstmnt != RETURN_TOKEN) + { + emit_const(0); + emit_leave(idlocal_size()); + } + return (1); + } + else if (scantoken == ASM_TOKEN) + { + if (scan() != ID_TOKEN) + { + parse_error("Missing function name"); + return (0); + } + if (bytecode) + { + parse_error("ASM code only allowed before DEF code"); + return (0); + } + cfnparms = 0; + infunc = 1; + type |= ASM_TYPE; + if (idglobal_lookup(tokenstr, tokenlen) >= 0) + { + if (!(id_type(tokenstr, tokenlen) & PREDEF_TYPE)) + { + parse_error("Mismatch function type"); + return (0); + } + emit_idfunc(id_tag(tokenstr, tokenlen), PREDEF_TYPE, tokenstr); + func_tag = tag_new(type); + idfunc_set(tokenstr, tokenlen, type, func_tag); // Override any predef type & tag + } + else + { + func_tag = tag_new(type); + idfunc_add(tokenstr, tokenlen, type, func_tag); + } + c = tokenstr[tokenlen]; + tokenstr[tokenlen] = '\0'; + emit_idfunc(func_tag, type, tokenstr); + emit_def(tokenstr, 0); + tokenstr[tokenlen] = c; + if (scan() == OPEN_PAREN_TOKEN) + { + do + { + if (scan() == ID_TOKEN) + { + cfnparms++; + idlocal_add(tokenstr, tokenlen, WORD_TYPE, 2); + scan(); + } + } + while (scantoken == COMMA_TOKEN); + if (scantoken != CLOSE_PAREN_TOKEN) + { + parse_error("Bad function parameter list"); + return (0); + } + scan(); + } + do + { + if (scantoken == EOL_TOKEN || scantoken == COMMENT_TOKEN) + next_line(); + else if (scantoken != END_TOKEN) + { + emit_asm(inputline); + next_line(); + } + } + while (scantoken != END_TOKEN); + return (1); + } + if (scantoken == EOL_TOKEN || scantoken == COMMENT_TOKEN) + return (1); + return (0); +} +int parse_module(void) +{ + emit_header(); + if (next_line()) + { + while (parse_mods()) next_line(); + while (parse_vars(GLOBAL_TYPE)) next_line(); + while (parse_defs()) next_line(); + if (scantoken != DONE_TOKEN && scantoken != EOF_TOKEN) + { + emit_bytecode_seg(); + emit_start(); + emit_def("_INIT", 1); + prevstmnt = 0; + while (parse_stmnt()) next_line(); + if (scantoken != DONE_TOKEN) + parse_error("Missing DONE statement"); + if (prevstmnt != RETURN_TOKEN) + { + emit_const(0); + emit_ret(); + } + } + } + emit_trailer(); + return (0); +} diff --git a/src/parse.h b/src/parse.h new file mode 100755 index 0000000..94930b7 --- /dev/null +++ b/src/parse.h @@ -0,0 +1 @@ +int parse_module(void); diff --git a/src/plasm.c b/src/plasm.c new file mode 100755 index 0000000..2416456 --- /dev/null +++ b/src/plasm.c @@ -0,0 +1,35 @@ +#include +#include "tokens.h" +#include "lex.h" +#include "codegen.h" +#include "parse.h" + +int main(int argc, char **argv) +{ + int j, i, flags = 0; + for (i = 1; i < argc; i++) + { + if (argv[i][0] == '-') + { + j = 1; + while (argv[i][j]) + { + switch(argv[i][j++]) + { + case 'A': + flags |= ACME; + break; + case 'M': + flags |= MODULE; + break; + } + } + } + } + emit_flags(flags); + if (parse_module()) + { + fprintf(stderr, "Compilation complete.\n"); + } + return (0); +} diff --git a/src/plvm.c b/src/plvm.c new file mode 100755 index 0000000..a69707d --- /dev/null +++ b/src/plvm.c @@ -0,0 +1,939 @@ +#include +#include +#include +#include +#include +#include + +typedef unsigned char code; +typedef unsigned char byte; +typedef signed short word; +typedef unsigned short uword; +typedef unsigned short address; +/* + * Debug + */ +int show_state = 0; +/* + * Bytecode memory + */ +#define BYTE_PTR(bp) ((byte)((bp)[0])) +#define WORD_PTR(bp) ((word)((bp)[0] | ((bp)[1] << 8))) +#define UWORD_PTR(bp) ((uword)((bp)[0] | ((bp)[1] << 8))) +#define TO_UWORD(w) ((uword)((w))) +#define MOD_ADDR 0x1000 +#define DEF_CALL 0x0800 +#define DEF_CALLSZ 0x0800 +#define DEF_ENTRYSZ 6 +#define MEM_SIZE 65536 +byte mem_data[MEM_SIZE]; +uword sp = 0x01FE, fp = 0xFFFF, heap = 0x0200, deftbl = DEF_CALL, lastdef = DEF_CALL; + +#define EVAL_STACKSZ 16 +#define PUSH(v) (*(--esp))=(v) +#define POP ((word)(*(esp++))) +#define UPOP ((uword)(*(esp++))) +#define TOS (esp[0]) +word eval_stack[EVAL_STACKSZ]; +word *esp = eval_stack + EVAL_STACKSZ; + +#define SYMTBLSZ 1024 +#define SYMSZ 16 +#define MODTBLSZ 128 +#define MODSZ 16 +#define MODLSTSZ 32 +byte symtbl[SYMTBLSZ]; +byte *lastsym = symtbl; +byte modtbl[MODTBLSZ]; +byte *lastmod = modtbl; +/* + * Predef. + */ +void interp(code *ip); +/* + * Utility routines. + * + * A DCI string is one that has the high bit set for every character except the last. + * More efficient than C or Pascal strings. + */ +int dcitos(byte *dci, char *str) +{ + int len = 0; + do + str[len] = *dci & 0x7F; + while ((len++ < 16) && (*dci++ & 0x80)); + str[len] = 0; + return len; +} +int stodci(char *str, byte *dci) +{ + int len = 0; + do + dci[len] = toupper(*str) | 0x80; + while (*str++ && (len++ < 16)); + dci[len - 1] &= 0x7F; + return len; +} +/* + * Heap routines. + */ +uword avail_heap(void) +{ + return fp - heap; +} +uword alloc_heap(int size) +{ + uword addr = heap; + heap += size; + if (heap >= fp) + { + printf("Error: heap/frame collision.\n"); + exit (1); + } + return addr; +} +uword free_heap(int size) +{ + heap -= size; + return fp - heap; +} +uword mark_heap(void) +{ + return heap; +} +uword release_heap(uword newheap) +{ + heap = newheap; + return fp - heap; +} +/* + * DCI table routines, + */ +void dump_tbl(byte *tbl) +{ + int len; + byte *entbl; + while (*tbl) + { + len = 0; + while (*tbl & 0x80) + { + putchar(*tbl++ & 0x7F); + len++; + } + putchar(*tbl++); + putchar(':'); + while (len++ < 15) + putchar(' '); + printf("$%04X\n", tbl[0] | (tbl[1] << 8)); + tbl += 2; + } +} +uword lookup_tbl(byte *dci, byte *tbl) +{ + char str[20]; + byte *match, *entry = tbl; + while (*entry) + { + match = dci; + while (*entry == *match) + { + if (!(*entry & 0x80)) + return entry[1] | (entry[2] << 8); + entry++; + match++; + } + while (*entry++ & 0x80); + entry += 2; + } + return 0; +} +uword add_tbl(byte *dci, int val, byte **last) +{ + while (*dci & 0x80) + *(*last)++ = *dci++; + *(*last)++ = *dci++; + *(*last)++ = val; + *(*last)++ = val >> 8; + return 0; +} + +/* + * Symbol table routines. + */ +void dump_sym(void) +{ + printf("\nSystem Symbol Table:\n"); + dump_tbl(symtbl); +} +uword lookup_sym(byte *sym) +{ + return lookup_tbl(sym, symtbl); +} +uword add_sym(byte *sym, int addr) +{ + return add_tbl(sym, addr, &lastsym); +} + +/* + * 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; + mem_data[lastdef + 1] = addr; + mem_data[lastdef + 2] = addr >> 8; + return lastdef++; +} +uword def_lookup(byte *cdd, int defaddr) +{ + int i, calldef = 0; + for (i = 0; cdd[i * 4] == 0x02; i++) + { + if ((cdd[i * 4 + 1] | (cdd[i * 4 + 2] << 8)) == defaddr) + { + calldef = cdd + i * 4 - mem_data; + break; + } + } + return calldef; +} +uword extern_lookup(byte *esd, int index) +{ + byte *sym; + char string[32]; + while (*esd) + { + sym = esd; + esd += dcitos(esd, string); + if ((esd[0] & 0x10) && (esd[1] == index)) + return lookup_sym(sym); + esd += 3; + } + printf("\nError: extern index %d not found in ESD.\n", index); + return 0; +} +int load_mod(byte *mod) +{ + uword modsize, hdrlen, len, end, magic, bytecode, fixup, addr, sysflags, defcnt = 0, init = 0, modaddr = mark_heap(); + word modfix; + byte *moddep, *rld, *esd, *cdd, *sym; + byte header[128]; + int fd; + char filename[32], string[17]; + + dcitos(mod, filename); + printf("Load module %s\n", filename); + fd = open(filename, O_RDONLY, 0); + if ((fd > 0) && (len = read(fd, header, 128)) > 0) + { + moddep = header + 1; + modsize = header[0] | (header[1] << 8); + magic = header[2] | (header[3] << 8); + if (magic == 0xDA7E) + { + /* + * This is a relocatable bytecode module. + */ + sysflags = header[4] | (header[5] << 8); + bytecode = header[6] | (header[7] << 8); + defcnt = header[8] | (header[9] << 8); + init = header[10] | (header[11] << 8); + moddep = header + 12; + /* + * Load module dependencies. + */ + while (*moddep) + { + if (lookup_mod(moddep) == 0) + { + if (fd) + { + close(fd); + fd = 0; + } + load_mod(moddep); + } + moddep += dcitos(moddep, string); + } + if (fd == 0) + { + fd = open(filename, O_RDONLY, 0); + len = read(fd, header, 128); + } + } + /* + * Alloc heap space for relocated module (data + bytecode). + */ + moddep += 1; + hdrlen = moddep - header; + len -= hdrlen; + modaddr = mark_heap(); + end = modaddr + len; + /* + * Read in remainder of module into memory for fixups. + */ + memcpy(mem_data + modaddr, moddep, len); + while ((len = read(fd, mem_data + end, 4096)) > 0) + end += len; + close(fd); + /* + * Apply all fixups and symbol import/export. + */ + modfix = modaddr - hdrlen + 2; // - MOD_ADDR; + bytecode += modfix - MOD_ADDR; + end = modaddr - hdrlen + modsize + 2; + rld = mem_data + end; // Re-Locatable Directory + esd = rld; // Extern+Entry Symbol Directory + while (*esd != 0x00) // Scan to end of RLD + esd += 4; + esd++; + cdd = rld; + if (show_state) + { + /* + * Dump different parts of module. + */ + printf("Module load addr: $%04X\n", modaddr); + printf("Module size: %d\n", end - modaddr + hdrlen); + printf("Module code+data size: %d\n", modsize); + printf("Module magic: $%04X\n", magic); + printf("Module sysflags: $%04X\n", sysflags); + printf("Module bytecode: $%04X\n", bytecode); + printf("Module def count: $%04X\n", defcnt); + printf("Module init: $%04X\n", init ? init + modfix - MOD_ADDR : 0); + } + /* + * Print out the Re-Location Dictionary. + */ + if (show_state) + printf("\nRe-Location Dictionary:\n"); + while (*rld) + { + if (rld[0] == 0x02) + { + if (show_state) printf("\tDEF CODE"); + addr = rld[1] | (rld[2] << 8); + addr += modfix - MOD_ADDR; + rld[1] = addr; + rld[2] = addr >> 8; + end = rld - mem_data + 4; + } + else + { + addr = rld[1] | (rld[2] << 8); + if (addr > 12) + { + addr += modfix; + if (rld[0] & 0x80) + fixup = (mem_data[addr] | (mem_data[addr + 1] << 8)); + else + fixup = mem_data[addr]; + if (rld[0] & 0x10) + { + if (show_state) printf("\tEXTERN[$%02X] ", rld[3]); + fixup += extern_lookup(esd, rld[3]); + } + else + { + fixup += modfix - MOD_ADDR; + if (fixup >= bytecode) + { + /* + * Replace with call def dictionary. + */ + if (show_state) printf("\tDEF[$%04X->", fixup); + fixup = def_lookup(cdd, fixup); + if (show_state) printf("$%04X] ", fixup); + } + else + if (show_state) printf("\tINTERN "); + } + if (rld[0] & 0x80) + { + if (show_state) printf("WORD"); + mem_data[addr] = fixup; + mem_data[addr + 1] = fixup >> 8; + } + else + { + if (show_state) printf("BYTE"); + mem_data[addr] = fixup; + } + } + else + { + if (show_state) printf("\tIGNORE (HDR) "); + } + } + if (show_state) printf("@$%04X\n", addr); + rld += 4; + } + if (show_state) printf("\nExternal/Entry Symbol Directory:\n"); + while (*esd) + { + sym = esd; + esd += dcitos(esd, string); + if (esd[0] & 0x10) + { + if (show_state) printf("\tIMPORT %s[$%02X]\n", string, esd[1]); + } + else if (esd[0] & 0x08) + { + addr = esd[1] | (esd[2] << 8); + addr += modfix - MOD_ADDR; + if (show_state) printf("\tEXPORT %s@$%04X\n", string, addr); + if (addr >= bytecode) + addr = def_lookup(cdd, addr); + add_sym(sym, addr); + } + esd += 3; + } + } + else + { + printf("Error: Unable to load module %s\n", filename); + exit (1); + } + /* + * Reserve heap space for relocated module. + */ + alloc_heap(end - modaddr); + /* + * Call init routine. + */ + if (init) + { + interp(mem_data + init + modfix - MOD_ADDR); + return POP; + } + return 0; +} +void interp(code *ip); + +void call(uword pc) +{ + unsigned int i, s; + char c, sz[64]; + + 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 + interp(mem_data + (mem_data[pc] + (mem_data[pc + 1] << 8))); + break; + case 3: // LIBRARY STDLIB::VIEWPORT + printf("Set Viewport %d, %d, %d, %d\n", esp[3], esp[2], esp[1], esp[0]); + esp += 4; + PUSH(0); + break; + case 4: // LIBRARY STDLIB::PUTC + c = POP; + if (c == 0x0D) + c = '\n'; + putchar(c); + PUSH(0); + break; + case 5: // LIBRARY STDLIB::PUTS + s = POP; + i = mem_data[s++]; + PUSH(i); + while (i--) + { + c = mem_data[s++]; + if (c == 0x0D) + c = '\n'; + putchar(c); + } + break; + case 6: // LIBRARY STDLIB::PUTSZ + s = POP; + while ((c = mem_data[s++])) + { + if (c == 0x0D) + c = '\n'; + putchar(c); + } + PUSH(0); + break; + case 7: // LIBRARY STDLIB::GETC + PUSH(getchar()); + break; + case 8: // LIBRARY STDLIB::GETS + gets(sz); + for (i = 0; sz[i]; i++) + mem_data[0x200 + i] = sz[i]; + mem_data[0x200 + i] = 0; + mem_data[0x1FF] = i; + PUSH(i); + break; + case 9: // LIBRARY STDLIB::CLS + puts("\033[2J"); + fflush(stdout); + PUSH(0); + PUSH(0); + case 10: // LIBRARY STDLIB::GOTOXY + s = POP + 1; + i = POP + 1; + printf("\033[%d;%df", s, i); + fflush(stdout); + PUSH(0); + break; + case 11: // LIBRARY STDLIB::PUTNL + putchar('\n'); + fflush(stdout); + PUSH(0); + break; + default: + printf("Bad call code\n"); + } +} + +/* + * OPCODE TABLE + * +OPTBL: DW ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E + DW NEG,COMP,AND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E + DW NOT,LOR,LAND,LA,LLA,CB,CW,SWAP ; 20 22 24 26 28 2A 2C 2E + DW DROP,DUP,PUSH,PULL,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E + DW ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E + DW BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,??? ; 50 52 54 56 58 5A 5C 5E + DW LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E + DW SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E +*/ +void interp(code *ip) +{ + int val, ea, frmsz, parmcnt; + + while (1) + { + if (show_state) + { + char cmdline[16]; + word *dsp = &eval_stack[EVAL_STACKSZ - 1]; + printf("$%04X: $%02X [ ", ip - mem_data, *ip); + while (dsp >= esp) + printf("$%04X ", (*dsp--) & 0xFFFF); + printf("]\n"); + gets(cmdline); + } + switch (*ip++) + { + /* + * 0x00-0x0F + */ + case 0x00: // ZERO : TOS = 0 + PUSH(0); + break; + case 0x02: // ADD : TOS = TOS + TOS-1 + val = POP; + ea = POP; + PUSH(ea + val); + break; + case 0x04: // SUB : TOS = TOS-1 - TOS + val = POP; + ea = POP; + PUSH(ea - val); + break; + case 0x06: // MUL : TOS = TOS * TOS-1 + val = POP; + ea = POP; + PUSH(ea * val); + break; + case 0x08: // DIV : TOS = TOS-1 / TOS + val = POP; + ea = POP; + PUSH(ea / val); + break; + case 0x0A: // MOD : TOS = TOS-1 % TOS + val = POP; + ea = POP; + PUSH(ea % val); + break; + case 0x0C: // INCR : TOS = TOS + 1 + TOS++;; + break; + case 0x0E: // DECR : TOS = TOS - 1 + TOS--; + break; + /* + * 0x10-0x1F + */ + case 0x10: // NEG : TOS = -TOS + TOS = -TOS; + break; + case 0x12: // COMP : TOS = ~TOS + TOS = ~TOS; + break; + case 0x14: // AND : TOS = TOS & TOS-1 + val = POP; + ea = POP; + PUSH(ea & val); + break; + case 0x16: // IOR : TOS = TOS ! TOS-1 + val = POP; + ea = POP; + PUSH(ea | val); + break; + case 0x18: // XOR : TOS = TOS ^ TOS-1 + val = POP; + ea = POP; + PUSH(ea ^ val); + break; + case 0x1A: // SHL : TOS = TOS-1 << TOS + val = POP; + ea = POP; + PUSH(ea << val); + break; + case 0x1C: // SHR : TOS = TOS-1 >> TOS + val = POP; + ea = POP; + PUSH(ea >> val); + break; + case 0x1E: // IDXW : TOS = TOS * 2 + TOS *= 2; + break; + /* + * 0x20-0x2F + */ + case 0x20: // NOT : TOS = !TOS + TOS = !TOS; + break; + case 0x22: // LOR : TOS = TOS || TOS-1 + val = POP; + ea = POP; + PUSH(ea || val); + break; + case 0x24: // LAND : TOS = TOS && TOS-1 + val = POP; + ea = POP; + PUSH(ea && val); + break; + case 0x26: // LA : TOS = @VAR ; equivalent to CW ADDRESSOF(VAR) + PUSH(WORD_PTR(ip)); + ip += 2; + break; + case 0x28: // LLA : TOS = @LOCALVAR ; equivalent to CW FRAMEPTR+OFFSET(LOCALVAR) + PUSH(fp + BYTE_PTR(ip)); + ip++; + break; + case 0x2A: // CB : TOS = CONSTANTBYTE (IP) + PUSH(BYTE_PTR(ip)); + ip++; + break; + case 0x2C: // CW : TOS = CONSTANTWORD (IP) + PUSH(WORD_PTR(ip)); + ip += 2; + break; + case 0x2E: // SWAP : TOS = TOS-1, TOS-1 = TOS + val = POP; + ea = POP; + PUSH(val); + PUSH(ea); + break; + /* + * 0x30-0x3F + */ + case 0x30: // DROP : TOS = + POP; + break; + case 0x32: // DUP : TOS = TOS + val = TOS; + PUSH(val); + break; + case 0x34: // PUSH : TOSP = TOS + val = POP; + mem_data[sp--] = val >> 8; + mem_data[sp--] = val; + break; + case 0x36: // PULL : TOS = TOSP + PUSH(mem_data[sp] | (mem_data[sp + 1] << 8)); + sp += 2; + break; + case 0x38: // BRGT : TOS-1 > TOS ? IP += (IP) + val = POP; + if (TOS > val) + ip += WORD_PTR(ip); + else + ip += 2; + break; + case 0x3A: // BRLT : TOS-1 < TOS ? IP += (IP) + val = POP; + if (TOS < val) + ip += WORD_PTR(ip); + else + ip += 2; + break; + case 0x3C: // BREQ : TOS == TOS-1 ? IP += (IP) + val = POP; + if (TOS == val) + ip += WORD_PTR(ip); + else + ip += 2; + break; + case 0x3E: // BRNE : TOS != TOS-1 ? IP += (IP) + val = POP; + if (TOS != val) + ip += WORD_PTR(ip); + else + ip += 2; + break; + /* + * 0x40-0x4F + */ + case 0x40: // ISEQ : TOS = TOS == TOS-1 + val = POP; + ea = POP; + PUSH((ea == val) ? -1 : 0); + break; + case 0x42: // ISNE : TOS = TOS != TOS-1 + val = POP; + ea = POP; + PUSH((ea != val) ? -1 : 0); + break; + case 0x44: // ISGT : TOS = TOS-1 > TOS + val = POP; + ea = POP; + PUSH((ea > val) ? -1 : 0); + break; + case 0x46: // ISLT : TOS = TOS-1 < TOS + val = POP; + ea = POP; + PUSH((ea < val) ? -1 : 0); + break; + case 0x48: // ISGE : TOS = TOS-1 >= TOS + val = POP; + ea = POP; + PUSH((ea >= val) ? -1 : 0); + break; + case 0x4A: // ISLE : TOS = TOS-1 <= TOS + val = POP; + ea = POP; + PUSH((ea <= val) ? -1 : 0); + break; + case 0x4C: // BRFLS : !TOS ? IP += (IP) + if (!POP) + ip += WORD_PTR(ip) ; + else + ip += 2; + break; + case 0x4E: // BRTRU : TOS ? IP += (IP) + if (POP) + ip += WORD_PTR(ip); + else + ip += 2; + break; + /* + * 0x50-0x5F + */ + case 0x50: // BRNCH : IP += (IP) + ip += WORD_PTR(ip); + break; + case 0x52: // IBRNCH : IP += TOS + ip += POP; + break; + case 0x54: // CALL : TOFP = IP, IP = (IP) ; call + call(UWORD_PTR(ip)); + ip += 2; + break; + case 0x56: // ICALL : IP = TOS ; indirect call + ea = UPOP; + call(ea); + break; + case 0x58: // ENTER : NEW FRAME, FOREACH PARAM LOCALVAR = TOS + frmsz = BYTE_PTR(ip); + ip++; + mem_data[fp - frmsz] = fp; + mem_data[fp - frmsz + 1] = fp >> 8; + if (show_state) + printf("< $%04X: $%04X > ", fp - frmsz, fp); + fp -= frmsz; + parmcnt = BYTE_PTR(ip); + ip++; + while (parmcnt--) + { + val = POP; + mem_data[fp + parmcnt * 2 + 2] = val; + mem_data[fp + parmcnt * 2 + 3] = val >> 8; + if (show_state) + printf("< $%04X: $%04X > ", fp + parmcnt * 2 + 2, mem_data[fp + parmcnt * 2 + 2] | (mem_data[fp + parmcnt * 2 + 3] >> 8)); + } + if (show_state) + printf("\n"); + break; + case 0x5A: // LEAVE : DEL FRAME, IP = TOFP + fp = mem_data[fp] | (mem_data[fp + 1] << 8); + case 0x5C: // RET : IP = TOFP + return; + case 0x5E: // ??? + break; + /* + * 0x60-0x6F + */ + case 0x60: // LB : TOS = BYTE (TOS) + ea = TO_UWORD(POP); + PUSH(mem_data[ea]); + break; + case 0x62: // LW : TOS = WORD (TOS) + ea = UPOP; + PUSH(mem_data[ea] | (mem_data[ea + 1] << 8)); + break; + case 0x64: // LLB : TOS = LOCALBYTE [IP] + PUSH(mem_data[TO_UWORD(fp + BYTE_PTR(ip))]); + ip++; + break; + case 0x66: // LLW : TOS = LOCALWORD [IP] + ea = TO_UWORD(fp + BYTE_PTR(ip)); + PUSH(mem_data[ea] | (mem_data[ea + 1] << 8)); + ip++; + break; + case 0x68: // LAB : TOS = BYTE (IP) + PUSH(mem_data[UWORD_PTR(ip)]); + ip += 2; + break; + case 0x6A: // LAW : TOS = WORD (IP) + ea = UWORD_PTR(ip); + PUSH(mem_data[ea] | (mem_data[ea + 1] << 8)); + ip += 2; + break; + case 0x6C: // DLB : TOS = TOS, LOCALBYTE [IP] = TOS + mem_data[TO_UWORD(fp + BYTE_PTR(ip))] = TOS; + ip++; + break; + case 0x6E: // DLW : TOS = TOS, LOCALWORD [IP] = TOS + ea = TO_UWORD(fp + BYTE_PTR(ip)); + mem_data[ea] = TOS; + mem_data[ea + 1] = TOS >> 8; + ip++; + break; + /* + * 0x70-0x7F + */ + case 0x70: // SB : BYTE (TOS) = TOS-1 + val = POP; + ea = UPOP; + mem_data[ea] = val; + break; + case 0x72: // SW : WORD (TOS) = TOS-1 + val = POP; + ea = UPOP; + mem_data[ea] = val; + mem_data[ea + 1] = val >> 8; + break; + case 0x74: // SLB : LOCALBYTE [TOS] = TOS-1 + mem_data[TO_UWORD(fp + BYTE_PTR(ip))] = POP; + ip++; + break; + case 0x76: // SLW : LOCALWORD [TOS] = TOS-1 + ea = TO_UWORD(fp + BYTE_PTR(ip)); + val = POP; + mem_data[ea] = val; + mem_data[ea + 1] = val >> 8; + ip++; + break; + case 0x78: // SAB : BYTE (IP) = TOS + mem_data[UWORD_PTR(ip)] = POP; + ip += 2; + break; + case 0x7A: // SAW : WORD (IP) = TOS + ea = UWORD_PTR(ip); + val = POP; + mem_data[ea] = val; + mem_data[ea + 1] = val >> 8; + ip += 2; + break; + case 0x7C: // DAB : TOS = TOS, BYTE (IP) = TOS + mem_data[UWORD_PTR(ip)] = TOS; + ip += 2; + break; + case 0x7E: // DAW : TOS = TOS, WORD (IP) = TOS + ea = UWORD_PTR(ip); + mem_data[ea] = TOS; + mem_data[ea + 1] = TOS >> 8; + ip += 2; + break; + /* + * Odd codes and everything else are errors. + */ + default: + fprintf(stderr, "Illegal opcode 0x%02X @ 0x%04X\n", ip[-1], ip - mem_data); + } + } +} + +char *stdlib_exp[] = { + "VIEWPORT", + "PUTC", + "PUTS", + "PUTSZ", + "GETC", + "GETS", + "CLS", + "GOTOXY", + "PUTNL", + 0 +}; + +byte stdlib[] = { + 0x00 +}; + +int main(int argc, char **argv) +{ + byte dci[32]; + int i; + + if (--argc) + { + argv++; + if ((*argv)[0] == '-' && (*argv)[1] == 's') + { + show_state = 1; + argc--; + argv++; + } + /* + * Add default library. + */ + stodci("STDLIB", dci); + add_mod(dci, 0xFFFF); + for (i = 0; stdlib_exp[i]; i++) + { + mem_data[i] = i + 3; + stodci(stdlib_exp[i], dci); + add_sym(dci, i); + } + if (argc) + { + stodci(*argv, dci); + load_mod(dci); + if (show_state) dump_sym(); + argc--; + argv++; + } + if (argc) + { + stodci(*argv, dci); + call(lookup_sym(dci)); + } + } + return 0; +} diff --git a/src/plvm02.s b/src/plvm02.s new file mode 100644 index 0000000..57035ec --- /dev/null +++ b/src/plvm02.s @@ -0,0 +1,2028 @@ +;********************************************************** +;* +;* SYSTEM ROUTINES AND LOCATIONS +;* +;********************************************************** +;* +;* MONITOR SPECIAL LOCATIONS +;* +CSWL = $36 +CSWH = $37 +PROMPT = $33 +;* +;* PRODOS +;* +PRODOS = $BF00 +DEVCNT = $BF31 ; GLOBAL PAGE DEVICE COUNT +DEVLST = $BF32 ; GLOBAL PAGE DEVICE LIST +MACHID = $BF98 ; GLOBAL PAGE MACHINE ID BYTE +RAMSLOT = $BF26 ; SLOT 3, DRIVE 2 IS /RAM'S DRIVER VECTOR +NODEV = $BF10 +;* +;* HARDWARE ADDRESSES +;* +KEYBD = $C000 +CLRKBD = $C010 +SPKR = $C030 +LCRDEN = $C080 +LCWTEN = $C081 +ROMEN = $C082 +LCRWEN = $C083 +LCBNK2 = $00 +LCBNK1 = $08 +ALTZPOFF= $C008 +ALTZPON = $C009 +ALTRDOFF= $C002 +ALTRDON = $C003 +ALTWROFF= $C004 +ALTWRON = $C005 + !SOURCE "plvm02zp.inc" +STRBUF = $0280 +;********************************************************** +;* +;* INTERPRETER INSTRUCTION POINTER INCREMENT MACRO +;* +;********************************************************** + !MACRO INC_IP { + INY + BNE * + 4 + INC IPH + } +;*********************************************** +;* +;* INTERPRETER INITIALIZATION +;* +;*********************************************** +* = $2000 + LDX #$FF + TXS +;* +;* DISCONNECT /RAM +;* + SEI ; DISABLE /RAM + LDA MACHID + AND #$30 + CMP #$30 + BNE RAMDONE + LDA RAMSLOT + CMP NODEV + BNE RAMCONT + LDA RAMSLOT+1 + CMP NODEV+1 + BEQ RAMDONE +RAMCONT LDY DEVCNT +RAMLOOP LDA DEVLST,Y + AND #$F3 + CMP #$B3 + BEQ GETLOOP + DEY + BPL RAMLOOP + BMI RAMDONE +GETLOOP LDA DEVLST+1,Y + STA DEVLST,Y + BEQ RAMEXIT + INY + BNE GETLOOP +RAMEXIT LDA NODEV + STA RAMSLOT + LDA NODEV+1 + STA RAMSLOT+1 + DEC DEVCNT +RAMDONE CLI +;* +;* INSTALL PAGE 3 VECTORS +;* + LDY #$20 +- LDA PAGE3,Y + STA $03D0,Y + DEY + BPL - +;* +;* MOVE VM INTO LANGUAGE CARD +;* + BIT LCRWEN+LCBNK2 + BIT LCRWEN+LCBNK2 + LDA #VMCORE + STA SRCH + LDA #$00 + STA DSTL + LDA #$D0 + STA DSTH + LDY #$00 +- LDA (SRC),Y ; COPY VM+CMD INTO LANGUAGE CARD + STA (DST),Y + INY + BNE - + INC SRCH + INC DSTH + LDA DSTH + CMP #$E0 + BNE - +;* +;* MOVE FIRST PAGE OF 'BYE' INTO PLACE +;* + LDY #$00 + STY SRCL + LDA #$D1 + STA SRCH +- LDA (SRC),Y + STA $1000,Y + INY + BNE - +;* +;* SAVE DEFAULT COMMAND INTERPRETER PATH IN LC +;* + JSR PRODOS ; GET PREFIX + !BYTE $C7 + !WORD GETPFXPARMS + LDY STRBUF ; APPEND "CMD" + LDA #"/" + CMP STRBUF,Y + BEQ + + INY + STA STRBUF,Y ++ LDA #"C" + INY + STA STRBUF,Y + LDA #"M" + INY + STA STRBUF,Y + LDA #"D" + INY + STA STRBUF,Y + STY STRBUF + BIT LCRWEN+LCBNK2 ; COPY TO LC FOR BYE + BIT LCRWEN+LCBNK2 +- LDA STRBUF,Y + STA $D103,Y ; YEAH, I HARDCODED THE ADDRESS + DEY + BPL - + +;* +;* LOOK FOR STARTUP FILE +;* + JSR PRODOS ; OPEN AUTORUN + !BYTE $C8 + !WORD OPENPARMS + BNE NOAUTO + LDA REFNUM + STA NLPARMS+1 + JSR PRODOS + !BYTE $C9 + !WORD NLPARMS + BNE NOAUTO + LDA REFNUM + STA READPARMS+1 + JSR PRODOS + !BYTE $CA + !WORD READPARMS + BNE NOAUTO + LDX READPARMS+6 + STX STRBUF ; STRING LENGTH + JSR PRODOS + !BYTE $CC + !WORD CLOSEPARMS +NOAUTO JMP CMDEXEC +GETPFXPARMS !BYTE 1 + !WORD STRBUF ; PATH STRING GOES HERE +AUTORUN !BYTE 7 + !TEXT "AUTORUN" +OPENPARMS !BYTE 3 + !WORD AUTORUN + !WORD $0800 +REFNUM !BYTE 0 +NLPARMS !BYTE 3 + !BYTE 0 + !BYTE $7F + !BYTE $0D +READPARMS !BYTE 4 + !BYTE 0 + !WORD STRBUF+1 + !WORD $0080 + !WORD 0 +CLOSEPARMS !BYTE 1 + !BYTE 0 +PAGE3 = * + !PSEUDOPC $03D0 { +;* +;* PAGE 3 VECTORS INTO INTERPRETER +;* + BIT LCRDEN+LCBNK2 ; $03D0 - DIRECT INTERP ENTRY + JMP INTERP + BIT LCRDEN+LCBNK2 ; $03D6 - INDIRECT INTERP ENTRY + JMP IINTRP + BIT LCRDEN+LCBNK2 ; $03DC - INDIRECT INTERPX ENTRY + JMP IINTRPX +TMRVEC !WORD TMRRTS +TMRRTS RTS +} +VMCORE = * + !PSEUDOPC $D000 { +;* +;* OPXCODE TABLE +;* +OPXTBL !WORD ZEROX,ADDX,SUBX,MULX,DIVX,MODX,INCRX,DECRX ; 00 02 04 06 08 0A 0C 0E + !WORD NEGX,COMPX,BANDX,IORX,XORX,SHLX,SHRX,IDXWX ; 10 12 14 16 18 1A 1C 1E + !WORD LNOTX,LORX,LANDX,LAX,LLAX,CBX,CWX,SWAPX ; 20 22 24 26 28 2A 2C 2E + !WORD DROPX,DUPX,PUSHX,PULLX,BRGTX,BRLTX,BREQX,BRNEX ; 30 32 34 36 38 3A 3C 3E + !WORD ISEQX,ISNEX,ISGTX,ISLTX,ISGEX,ISLEX,BRFLSX,BRTRUX; 40 42 44 46 48 4A 4C 4E + !WORD BRNCHX,IBRNCHX,CALLX,ICALX,ENTERX,LEAVEX,RETX,NEXTOPX; 50 52 54 56 58 5A 5C 5E + !WORD LBX,LWX,LLBX,LLWX,LABX,LAWX,DLBX,DLWX ; 60 62 64 66 68 6A 6C 6E + !WORD SBX,SWX,SLBX,SLWX,SABX,SAWX,DABX,DAWX ; 70 72 74 76 78 7A 7C 7E +;* +;* OPCODE TABLE +;* +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,SWAP ; 20 22 24 26 28 2A 2C 2E + !WORD DROP,DUP,PUSH,PULL,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E + !WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E + !WORD BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,NEXTOP ; 50 52 54 56 58 5A 5C 5E + !WORD LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E + !WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E +;* +;* 'BYE' COMMAND PROCESSING +;* + !PSEUDOPC $1000 { +;* +;* CLEAR COMMAND LINE LENGTH BYTE IF CALLED FROM 'BYE' +;* +BYE JMP CPYCMD +DEFCMD !FILL 63 ; AT $D103 IN LC MEMORY +CPYCMD LDY DEFCMD +- LDA DEFCMD,Y ; SET DEFAULT COMMAND WHEN CALLED FROM 'BYE' + STA STRBUF,Y + DEY + BPL - +;* +;* MOVE REST OF CMD FROM LANGUAGE CARD +;* +CMDEXEC LDY #$00 + STY SRCL + STY DSTL + LDA #$D2 + STA SRCH + LDA #$11 + STA DSTH + BIT LCRDEN+LCBNK2 +- LDA (SRC),Y + STA (DST),Y + INY + BNE - + INC SRCH + INC DSTH + LDA SRCH + CMP #$D4 ; #$E0 + BNE - +;* +;* DEACTIVATE 80 COL CARDS +;* + LDX #$FE + TXS + BIT ROMEN + LDY #4 +- LDA DISABLE80,Y + ORA #$80 + JSR $FDED + DEY + BPL - + BIT $C054 ; SET TEXT MODE + BIT $C051 + BIT $C058 + JSR $FC58 ; HOME +;* +;* JUMP TO INTERPRETER +;* +START LDA #$00 + STA IFPL + LDA #$BF + STA IFPH + LDX #ESTKSZ/2 + !SOURCE "cmdexec.a" +DISABLE80 !BYTE 21, 13, '1', 26, 13 +} +;* +;* ENTER INTO BYTECODE INTERPRETER +;* +INTERP BIT LCRWEN+LCBNK2 ; WRITE ENABLE LANGUAGE CARD + BIT LCRWEN+LCBNK2 + PLA + STA IPL + PLA + STA IPH + LDY #$01 + BNE FETCHOP +IINTRP BIT LCRWEN+LCBNK2 ; WRITE ENABLE LANGUAGE CARD + BIT LCRWEN+LCBNK2 + PLA + STA TMPL + PLA + STA TMPH + LDY #$02 + LDA (TMP),Y + STA IPH + DEY + LDA (TMP),Y + STA IPL + DEY + BEQ FETCHOP +IINTRPX BIT LCRWEN+LCBNK2 ; WRITE ENABLE LANGUAGE CARD + BIT LCRWEN+LCBNK2 + PLA + STA TMPL + PLA + STA TMPH + LDY #$02 + LDA (TMP),Y + STA IPH + DEY + LDA (TMP),Y + STA IPL + DEY + SEI + STA ALTRDON + BEQ FETCHOPX +;* +;* INTERP BYTECODE IN AUX MEM +;* +NEXTOPHX INC IPH + BNE FETCHOPX +DROPX INX +NEXTOPX INY + BEQ NEXTOPHX +; INC TICTOC +; BEQ TIMERX +FETCHOPX LDA (IP),Y + STA *+4 + JMP (OPXTBL) ; USE AUX OPCODES +TIMERX STA ALTRDOFF + CLI + JSR JMPTMR + SEI + STA ALTRDON + JMP FETCHOPX +;* +;* INTERP BYTECODE IN MAIN MEM +;* +NEXTOPH INC IPH + BNE FETCHOP +DROP INX +NEXTOP INY + BEQ NEXTOPH +; INC TICTOC +; BEQ TIMER +FETCHOP LDA (IP),Y + ORA #$80 ; USE MAIN OPCODES + STA *+4 + JMP (OPTBL) +TIMER JSR JMPTMR + JMP FETCHOP +;* +;* INDIRECT JUMP TO (TMRVEC) +;* +JMPTMR JMP (TMRVEC) +;* +;* INDIRECT JUMP TO (TMP) +;* +JMPTMP JMP (TMP) +;* +;* ADD TOS TO TOS-1 +;* +ADD LDA ESTKL,X + CLC + ADC ESTKL+1,X + STA ESTKL+1,X + LDA ESTKH,X + ADC ESTKH+1,X + STA ESTKH+1,X + INX + JMP NEXTOP +; +ADDX LDA ESTKL,X + CLC + ADC ESTKL+1,X + STA ESTKL+1,X + LDA ESTKH,X + ADC ESTKH+1,X + STA ESTKH+1,X + INX + JMP NEXTOPX +;* +;* SUB TOS FROM TOS-1 +;* +SUB LDA ESTKL+1,X + SEC + SBC ESTKL,X + STA ESTKL+1,X + LDA ESTKH+1,X + SBC ESTKH,X + STA ESTKH+1,X + INX + JMP NEXTOP +; +SUBX LDA ESTKL+1,X + SEC + SBC ESTKL,X + STA ESTKL+1,X + LDA ESTKH+1,X + SBC ESTKH,X + STA ESTKH+1,X + INX + JMP NEXTOPX +;* +;* SHIFT TOS-1 LEFT BY 1, ADD TO TOS-1 +;* +IDXW LDA ESTKL,X + ASL + ROL ESTKH,X + CLC + ADC ESTKL+1,X + STA ESTKL+1,X + LDA ESTKH,X + ADC ESTKH+1,X + STA ESTKH+1,X + INX + JMP NEXTOP +; +IDXWX LDA ESTKL,X + ASL + ROL ESTKH,X + CLC + ADC ESTKL+1,X + STA ESTKL+1,X + LDA ESTKH,X + ADC ESTKH+1,X + STA ESTKH+1,X + INX + JMP NEXTOPX +;* +;* INTERNAL MULTIPLY ALGORITHM +;* +_MUL STY IPY + LDY #$00 + STY TMPL ; PRODL + STY TMPH ; PRODH + LDY #$10 +MUL1 LSR ESTKH,X ; MULTPLRH + ROR ESTKL,X ; MULTPLRL + BCC MUL2 + LDA ESTKL+1,X ; MULTPLNDL + CLC + ADC TMPL ; PRODL + STA TMPL + LDA ESTKH+1,X ; MULTPLNDH + ADC TMPH ; PRODH + STA TMPH +MUL2 ASL ESTKL+1,X ; MULTPLNDL + ROL ESTKH+1,X ; MULTPLNDH + DEY + BNE MUL1 + INX + LDA TMPL ; PRODL + STA ESTKL,X + LDA TMPH ; PRODH + STA ESTKH,X + LDY IPY + RTS +;* +;* MUL TOS-1 BY TOS +;* +MUL JSR _MUL + JMP NEXTOP +; +MULX JSR _MUL + JMP NEXTOPX +;* +;* INTERNAL DIVIDE ALGORITHM +;* +_NEG LDA #$00 + SEC + SBC ESTKL,X + STA ESTKL,X + LDA #$00 + SBC ESTKH,X + STA ESTKH,X + RTS +_DIV STY IPY + LDA ESTKH,X + AND #$80 + STA DVSIGN + BPL _DIV1 + JSR _NEG + INC DVSIGN +_DIV1 LDA ESTKH+1,X + BPL _DIV2 + INX + JSR _NEG + DEX + INC DVSIGN + BNE _DIV3 +_DIV2 ORA ESTKL+1,X ; DVDNDL + BNE _DIV3 + STA TMPL + STA TMPH + RTS +_DIV3 LDY #$11 ; #BITS+1 + LDA #$00 + STA TMPL ; REMNDRL + STA TMPH ; REMNDRH +_DIV4 ASL ESTKL+1,X ; DVDNDL + ROL ESTKH+1,X ; DVDNDH + DEY + BCC _DIV4 + STY ESTKL-1,X +_DIV5 ROL TMPL ; REMNDRL + ROL TMPH ; REMNDRH + LDA TMPL ; REMNDRL + SEC + SBC ESTKL,X ; DVSRL + TAY + LDA TMPH ; REMNDRH + SBC ESTKH,X ; DVSRH + BCC _DIV6 + STA TMPH ; REMNDRH + STY TMPL ; REMNDRL +_DIV6 ROL ESTKL+1,X ; DVDNDL + ROL ESTKH+1,X ; DVDNDH + DEC ESTKL-1,X + BNE _DIV5 + LDY IPY + RTS +;* +;* NEGATE TOS +;* +NEG LDA #$00 + SEC + SBC ESTKL,X + STA ESTKL,X + LDA #$00 + SBC ESTKH,X + STA ESTKH,X + JMP NEXTOP +; +NEGX LDA #$00 + SEC + SBC ESTKL,X + STA ESTKL,X + LDA #$00 + SBC ESTKH,X + STA ESTKH,X + JMP NEXTOPX +;* +;* DIV TOS-1 BY TOS +;* +DIV JSR _DIV + INX + LSR DVSIGN ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1 + BCS NEG + JMP NEXTOP +; +DIVX JSR _DIV + INX + LSR DVSIGN ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1 + BCS NEGX + JMP NEXTOPX +;* +;* MOD TOS-1 BY TOS +;* +MOD JSR _DIV + INX + LDA TMPL ; REMNDRL + STA ESTKL,X + LDA TMPH ; REMNDRH + STA ESTKH,X + LDA DVSIGN ; REMAINDER IS SIGN OF DIVIDEND + BMI NEG + JMP NEXTOP +; +MODX JSR _DIV + INX + LDA TMPL ; REMNDRL + STA ESTKL,X + LDA TMPH ; REMNDRH + STA ESTKH,X + LDA DVSIGN ; REMAINDER IS SIGN OF DIVIDEND + BMI NEGX + JMP NEXTOPX +;* +;* INCREMENT TOS +;* +INCR INC ESTKL,X + BNE INCR1 + INC ESTKH,X +INCR1 JMP NEXTOP +; +INCRX INC ESTKL,X + BNE INCRX1 + INC ESTKH,X +INCRX1 JMP NEXTOPX +;* +;* DECREMENT TOS +;* +DECR LDA ESTKL,X + BNE DECR1 + DEC ESTKH,X +DECR1 DEC ESTKL,X + JMP NEXTOP +; +DECRX LDA ESTKL,X + BNE DECRX1 + DEC ESTKH,X +DECRX1 DEC ESTKL,X + JMP NEXTOPX +;* +;* BITWISE COMPLIMENT TOS +;* +COMP LDA #$FF + EOR ESTKL,X + STA ESTKL,X + LDA #$FF + EOR ESTKH,X + STA ESTKH,X + JMP NEXTOP +; +COMPX LDA #$FF + EOR ESTKL,X + STA ESTKL,X + LDA #$FF + EOR ESTKH,X + STA ESTKH,X + JMP NEXTOPX +;* +;* BITWISE AND TOS TO TOS-1 +;* +BAND LDA ESTKL+1,X + AND ESTKL,X + STA ESTKL+1,X + LDA ESTKH+1,X + AND ESTKH,X + STA ESTKH+1,X + INX + JMP NEXTOP +; +BANDX LDA ESTKL+1,X + AND ESTKL,X + STA ESTKL+1,X + LDA ESTKH+1,X + AND ESTKH,X + STA ESTKH+1,X + INX + JMP NEXTOPX +;* +;* INCLUSIVE OR TOS TO TOS-1 +;* +IOR LDA ESTKL+1,X + ORA ESTKL,X + STA ESTKL+1,X + LDA ESTKH+1,X + ORA ESTKH,X + STA ESTKH+1,X + INX + JMP NEXTOP +; +IORX LDA ESTKL+1,X + ORA ESTKL,X + STA ESTKL+1,X + LDA ESTKH+1,X + ORA ESTKH,X + STA ESTKH+1,X + INX + JMP NEXTOPX +;* +;* EXLUSIVE OR TOS TO TOS-1 +;* +XOR LDA ESTKL+1,X + EOR ESTKL,X + STA ESTKL+1,X + LDA ESTKH+1,X + EOR ESTKH,X + STA ESTKH+1,X + INX + JMP NEXTOP +; +XORX LDA ESTKL+1,X + EOR ESTKL,X + STA ESTKL+1,X + LDA ESTKH+1,X + EOR ESTKH,X + STA ESTKH+1,X + INX + JMP NEXTOPX +;* +;* SHIFT TOS-1 LEFT BY TOS +;* +SHL STY IPY + LDA ESTKL,X + CMP #$08 + BCC SHL1 + LDY ESTKL+1,X + STY ESTKH+1,X + LDY #$00 + STY ESTKL+1,X + SBC #$08 +SHL1 TAY + BEQ SHL3 +SHL2 ASL ESTKL+1,X + ROL ESTKH+1,X + DEY + BNE SHL2 +SHL3 INX + LDY IPY + JMP NEXTOP +; +SHLX STY IPY + LDA ESTKL,X + CMP #$08 + BCC SHLX1 + LDY ESTKL+1,X + STY ESTKH+1,X + LDY #$00 + STY ESTKL+1,X + SBC #$08 +SHLX1 TAY + BEQ SHLX3 +SHLX2 ASL ESTKL+1,X + ROL ESTKH+1,X + DEY + BNE SHLX2 +SHLX3 INX + LDY IPY + JMP NEXTOPX +;* +;* SHIFT TOS-1 RIGHT BY TOS +;* +SHR STY IPY + LDA ESTKL,X + CMP #$08 + BCC SHR2 + LDY ESTKH+1,X + STY ESTKL+1,X + CPY #$80 + LDY #$00 + BCC SHR1 + DEY +SHR1 STY ESTKH+1,X + SEC + SBC #$08 +SHR2 TAY + BEQ SHR4 + LDA ESTKH+1,X +SHR3 CMP #$80 + ROR + ROR ESTKL+1,X + DEY + BNE SHR3 + STA ESTKH+1,X +SHR4 INX + LDY IPY + JMP NEXTOP +; +SHRX STY IPY + LDA ESTKL,X + CMP #$08 + BCC SHRX2 + LDY ESTKH+1,X + STY ESTKL+1,X + CPY #$80 + LDY #$00 + BCC SHRX1 + DEY +SHRX1 STY ESTKH+1,X + SEC + SBC #$08 +SHRX2 TAY + BEQ SHRX4 + LDA ESTKH+1,X +SHRX3 CMP #$80 + ROR + ROR ESTKL+1,X + DEY + BNE SHRX3 + STA ESTKH+1,X +SHRX4 INX + LDY IPY + JMP NEXTOPX +;* +;* LOGICAL NOT +;* +LNOT LDA ESTKL,X + ORA ESTKH,X + BEQ LNOT1 + LDA #$FF +LNOT1 EOR #$FF + STA ESTKL,X + STA ESTKH,X + JMP NEXTOP +; +LNOTX LDA ESTKL,X + ORA ESTKH,X + BEQ LNOTX1 + LDA #$FF +LNOTX1 EOR #$FF + STA ESTKL,X + STA ESTKH,X + JMP NEXTOPX +;* +;* LOGICAL AND +;* +LAND LDA ESTKL,X + ORA ESTKH,X + BEQ LAND1 + LDA ESTKL+1,X + ORA ESTKH+1,X + BEQ LAND1 + LDA #$FF +LAND1 STA ESTKL+1,X + STA ESTKH+1,X + INX + JMP NEXTOP +; +LANDX LDA ESTKL,X + ORA ESTKH,X + BEQ LANDX1 + LDA ESTKL+1,X + ORA ESTKH+1,X + BEQ LANDX1 + LDA #$FF +LANDX1 STA ESTKL+1,X + STA ESTKH+1,X + INX + JMP NEXTOPX +;* +;* LOGICAL OR +;* +LOR LDA ESTKL,X + ORA ESTKH,X + ORA ESTKL+1,X + ORA ESTKH+1,X + BEQ LOR1 + LDA #$FF +LOR1 STA ESTKL+1,X + STA ESTKH+1,X + INX + JMP NEXTOP +; +LORX LDA ESTKL,X + ORA ESTKH,X + ORA ESTKL+1,X + ORA ESTKH+1,X + BEQ LORX1 + LDA #$FF +LORX1 STA ESTKL+1,X + STA ESTKH+1,X + INX + JMP NEXTOPX +;* +;* SWAP TOS WITH TOS-1 +;* +SWAP STY IPY + LDA ESTKL,X + LDY ESTKL+1,X + STA ESTKL+1,X + STY ESTKL,X + LDA ESTKH,X + LDY ESTKH+1,X + STA ESTKH+1,X + STY ESTKH,X + LDY IPY + JMP NEXTOP +; +SWAPX STY IPY + LDA ESTKL,X + LDY ESTKL+1,X + STA ESTKL+1,X + STY ESTKL,X + LDA ESTKH,X + LDY ESTKH+1,X + STA ESTKH+1,X + STY ESTKH,X + LDY IPY + JMP NEXTOPX +;* +;* DUPLICATE TOS +;* +DUP DEX + LDA ESTKL+1,X + STA ESTKL,X + LDA ESTKH+1,X + STA ESTKH,X + JMP NEXTOP +; +DUPX DEX + LDA ESTKL+1,X + STA ESTKL,X + LDA ESTKH+1,X + STA ESTKH,X + JMP NEXTOPX + +;* +;* PUSH FROM EVAL STACK TO CALL STACK +;* +PUSH LDA ESTKL,X + PHA + LDA ESTKH,X + PHA + INX + JMP NEXTOP +; +PUSHX LDA ESTKL,X + PHA + LDA ESTKH,X + PHA + INX + JMP NEXTOPX +;* +;* PULL FROM CALL STACK TO EVAL STACK +;* +PULL DEX + PLA + STA ESTKH,X + PLA + STA ESTKL,X + JMP NEXTOP +; +PULLX DEX + PLA + STA ESTKH,X + PLA + STA ESTKL,X + JMP NEXTOPX +;* +;* CONSTANT +;* +ZERO DEX + LDA #$00 + STA ESTKL,X + STA ESTKH,X + JMP NEXTOP +CB DEX + +INC_IP + LDA (IP),Y + STA ESTKL,X + LDA #$00 + STA ESTKH,X + JMP NEXTOP +; +ZEROX DEX + LDA #$00 + STA ESTKL,X + STA ESTKH,X + JMP NEXTOPX +CBX DEX + +INC_IP + LDA (IP),Y + STA ESTKL,X + LDA #$00 + STA ESTKH,X + JMP NEXTOPX +;* +;* LOAD ADDRESS & LOAD CONSTANT WORD (SAME THING, WITH OR WITHOUT FIXUP) +;* +LA = * +CW DEX + +INC_IP + LDA (IP),Y + STA ESTKL,X + +INC_IP + LDA (IP),Y + STA ESTKH,X + JMP NEXTOP +; +LAX = * +CWX DEX + +INC_IP + LDA (IP),Y + STA ESTKL,X + +INC_IP + LDA (IP),Y + STA ESTKH,X + JMP NEXTOPX +;* +;* LOAD VALUE FROM ADDRESS TAG +;* +LB LDA ESTKL,X + STA TMPL + LDA ESTKH,X + STA TMPH + STY IPY + LDY #$00 + LDA (TMP),Y + STA ESTKL,X + STY ESTKH,X + LDY IPY + JMP NEXTOP +LW LDA ESTKL,X + STA TMPL + LDA ESTKH,X + STA TMPH + STY IPY + LDY #$00 + LDA (TMP),Y + STA ESTKL,X + INY + LDA (TMP),Y + STA ESTKH,X + LDY IPY + JMP NEXTOP +; +LBX LDA ESTKL,X + STA TMPL + LDA ESTKH,X + STA TMPH + STY IPY + STA ALTRDOFF + LDY #$00 + LDA (TMP),Y + STA ESTKL,X + STY ESTKH,X + LDY IPY + STA ALTRDON + JMP NEXTOPX +LWX LDA ESTKL,X + STA TMPL + LDA ESTKH,X + STA TMPH + STY IPY + STA ALTRDOFF + LDY #$00 + LDA (TMP),Y + STA ESTKL,X + INY + LDA (TMP),Y + STA ESTKH,X + LDY IPY + STA ALTRDON + JMP NEXTOPX +;* +;* LOAD ADDRESS OF LOCAL FRAME OFFSET +;* +LLA +INC_IP + LDA (IP),Y + DEX + CLC + ADC IFPL + STA ESTKL,X + LDA #$00 + ADC IFPH + STA ESTKH,X + JMP NEXTOP +; +LLAX +INC_IP + LDA (IP),Y + DEX + CLC + ADC IFPL + STA ESTKL,X + LDA #$00 + ADC IFPH + STA ESTKH,X + JMP NEXTOPX +;* +;* LOAD VALUE FROM LOCAL FRAME OFFSET +;* +LLB +INC_IP + LDA (IP),Y + STY IPY + TAY + DEX + LDA (IFP),Y + STA ESTKL,X + LDA #$00 + STA ESTKH,X + LDY IPY + JMP NEXTOP +LLW +INC_IP + LDA (IP),Y + STY IPY + TAY + DEX + LDA (IFP),Y + STA ESTKL,X + INY + LDA (IFP),Y + STA ESTKH,X + LDY IPY + JMP NEXTOP +; +LLBX +INC_IP + LDA (IP),Y + STY IPY + TAY + DEX + STA ALTRDOFF + LDA (IFP),Y + STA ESTKL,X + LDA #$00 + STA ESTKH,X + STA ALTRDON + LDY IPY + JMP NEXTOPX +LLWX +INC_IP + LDA (IP),Y + STY IPY + TAY + DEX + STA ALTRDOFF + LDA (IFP),Y + STA ESTKL,X + INY + LDA (IFP),Y + STA ESTKH,X + STA ALTRDON + LDY IPY + JMP NEXTOPX +;* +;* LOAD VALUE FROM ABSOLUTE ADDRESS +;* +LAB +INC_IP + LDA (IP),Y + STA TMPL + +INC_IP + LDA (IP),Y + STA TMPH + STY IPY + LDY #$00 + LDA (TMP),Y + DEX + STA ESTKL,X + STY ESTKH,X + LDY IPY + JMP NEXTOP +LAW +INC_IP + LDA (IP),Y + STA TMPL + +INC_IP + LDA (IP),Y + STA TMPH + STY IPY + LDY #$00 + LDA (TMP),Y + DEX + STA ESTKL,X + INY + LDA (TMP),Y + STA ESTKH,X + LDY IPY + JMP NEXTOP +; +LABX +INC_IP + LDA (IP),Y + STA TMPL + +INC_IP + LDA (IP),Y + STA TMPH + STY IPY + STA ALTRDOFF + LDY #$00 + LDA (TMP),Y + DEX + STA ESTKL,X + STY ESTKH,X + STA ALTRDON + LDY IPY + JMP NEXTOPX +LAWX +INC_IP + LDA (IP),Y + STA TMPL + +INC_IP + LDA (IP),Y + STA TMPH + STY IPY + STA ALTRDOFF + LDY #$00 + LDA (TMP),Y + DEX + STA ESTKL,X + INY + LDA (TMP),Y + STA ESTKH,X + STA ALTRDON + LDY IPY + JMP NEXTOPX +;* +;* STORE VALUE TO ADDRESS +;* +SB LDA ESTKL+1,X + STA TMPL + LDA ESTKH+1,X + STA TMPH + LDA ESTKL,X + STY IPY + LDY #$00 + STA (TMP),Y + INX + INX + LDY IPY + JMP NEXTOP +SW LDA ESTKL+1,X + STA TMPL + LDA ESTKH+1,X + STA TMPH + STY IPY + LDY #$00 + LDA ESTKL,X + STA (TMP),Y + INY + LDA ESTKH,X + STA (TMP),Y + INX + INX + LDY IPY + JMP NEXTOP +; +SBX LDA ESTKL+1,X + STA TMPL + LDA ESTKH+1,X + STA TMPH + LDA ESTKL,X + STY IPY + STA ALTRDOFF + LDY #$00 + STA (TMP),Y + STA ALTRDON + INX + INX + LDY IPY + JMP NEXTOPX +SWX LDA ESTKL+1,X + STA TMPL + LDA ESTKH+1,X + STA TMPH + STY IPY + STA ALTRDOFF + LDY #$00 + LDA ESTKL,X + STA (TMP),Y + INY + LDA ESTKH,X + STA (TMP),Y + STA ALTRDON + INX + INX + LDY IPY + JMP NEXTOPX +;* +;* STORE VALUE TO LOCAL FRAME OFFSET +;* +SLB +INC_IP + LDA (IP),Y + STY IPY + TAY + LDA ESTKL,X + STA (IFP),Y + INX + LDY IPY + JMP NEXTOP +SLW +INC_IP + LDA (IP),Y + STY IPY + TAY + LDA ESTKL,X + STA (IFP),Y + INY + LDA ESTKH,X + STA (IFP),Y + INX + LDY IPY + JMP NEXTOP +; +SLBX +INC_IP + LDA (IP),Y + STY IPY + STA ALTRDOFF + TAY + LDA ESTKL,X + STA (IFP),Y + STA ALTRDON + INX + LDY IPY + JMP NEXTOPX +SLWX +INC_IP + LDA (IP),Y + STY IPY + STA ALTRDOFF + TAY + LDA ESTKL,X + STA (IFP),Y + INY + LDA ESTKH,X + STA (IFP),Y + STA ALTRDON + INX + LDY IPY + JMP NEXTOPX +;* +;* STORE VALUE TO LOCAL FRAME OFFSET WITHOUT POPPING STACK +;* +DLB +INC_IP + LDA (IP),Y + STY IPY + TAY + LDA ESTKL,X + STA (IFP),Y + LDY IPY + JMP NEXTOP +DLW +INC_IP + LDA (IP),Y + STY IPY + TAY + LDA ESTKL,X + STA (IFP),Y + INY + LDA ESTKH,X + STA (IFP),Y + LDY IPY + JMP NEXTOP +; +DLBX +INC_IP + LDA (IP),Y + STY IPY + STA ALTRDOFF + TAY + LDA ESTKL,X + STA (IFP),Y + STA ALTRDON + LDY IPY + JMP NEXTOPX +DLWX +INC_IP + LDA (IP),Y + STY IPY + STA ALTRDOFF + TAY + LDA ESTKL,X + STA (IFP),Y + INY + LDA ESTKH,X + STA (IFP),Y + STA ALTRDON + LDY IPY + JMP NEXTOPX +;* +;* STORE VALUE TO ABSOLUTE ADDRESS +;* +SAB +INC_IP + LDA (IP),Y + STA TMPL + +INC_IP + LDA (IP),Y + STA TMPH + LDA ESTKL,X + STY IPY + LDY #$00 + STA (TMP),Y + INX + LDY IPY + JMP NEXTOP +SAW +INC_IP + LDA (IP),Y + STA TMPL + +INC_IP + LDA (IP),Y + STA TMPH + STY IPY + LDY #$00 + LDA ESTKL,X + STA (TMP),Y + INY + LDA ESTKH,X + STA (TMP),Y + INX + LDY IPY + JMP NEXTOP +; +SABX +INC_IP + LDA (IP),Y + STA TMPL + +INC_IP + LDA (IP),Y + STA TMPH + LDA ESTKL,X + STY IPY + STA ALTRDOFF + LDY #$00 + STA (TMP),Y + STA ALTRDON + INX + LDY IPY + JMP NEXTOPX +SAWX +INC_IP + LDA (IP),Y + STA TMPL + +INC_IP + LDA (IP),Y + STA TMPH + STY IPY + STA ALTRDOFF + LDY #$00 + LDA ESTKL,X + STA (TMP),Y + INY + LDA ESTKH,X + STA (TMP),Y + STA ALTRDON + INX + LDY IPY + JMP NEXTOPX +;* +;* STORE VALUE TO ABSOLUTE ADDRESS WITHOUT POPPING STACK +;* +DAB +INC_IP + LDA (IP),Y + STA TMPL + +INC_IP + LDA (IP),Y + STA TMPH + STY IPY + LDY #$00 + LDA ESTKL,X + STA (TMP),Y + LDY IPY + JMP NEXTOP +DAW +INC_IP + LDA (IP),Y + STA TMPL + +INC_IP + LDA (IP),Y + STA TMPH + STY IPY + LDY #$00 + LDA ESTKL,X + STA (TMP),Y + INY + LDA ESTKH,X + STA (TMP),Y + LDY IPY + JMP NEXTOP +; +DABX +INC_IP + LDA (IP),Y + STA TMPL + +INC_IP + LDA (IP),Y + STA TMPH + STY IPY + STA ALTRDOFF + LDY #$00 + LDA ESTKL,X + STA (TMP),Y + STA ALTRDON + LDY IPY + JMP NEXTOPX +DAWX +INC_IP + LDA (IP),Y + STA TMPL + +INC_IP + LDA (IP),Y + STA TMPH + STY IPY + STA ALTRDOFF + LDY #$00 + LDA ESTKL,X + STA (TMP),Y + INY + LDA ESTKH,X + STA (TMP),Y + STA ALTRDON + LDY IPY + JMP NEXTOPX +;* +;* COMPARES +;* +ISEQ STY IPY + LDY #$00 + LDA ESTKL,X + CMP ESTKL+1,X + BNE ISEQ1 + LDA ESTKH,X + CMP ESTKH+1,X + BNE ISEQ1 + DEY +ISEQ1 STY ESTKL+1,X + STY ESTKH+1,X + INX + LDY IPY + JMP NEXTOP +; +ISEQX STY IPY + LDY #$00 + LDA ESTKL,X + CMP ESTKL+1,X + BNE ISEQX1 + LDA ESTKH,X + CMP ESTKH+1,X + BNE ISEQX1 + DEY +ISEQX1 STY ESTKL+1,X + STY ESTKH+1,X + INX + LDY IPY + JMP NEXTOPX +; +ISNE STY IPY + LDY #$FF + LDA ESTKL,X + CMP ESTKL+1,X + BNE ISNE1 + LDA ESTKH,X + CMP ESTKH+1,X + BNE ISNE1 + INY +ISNE1 STY ESTKL+1,X + STY ESTKH+1,X + INX + LDY IPY + JMP NEXTOP +; +ISNEX STY IPY + LDY #$FF + LDA ESTKL,X + CMP ESTKL+1,X + BNE ISNEX1 + LDA ESTKH,X + CMP ESTKH+1,X + BNE ISNEX1 + INY +ISNEX1 STY ESTKL+1,X + STY ESTKH+1,X + INX + LDY IPY + JMP NEXTOPX +; +ISGE STY IPY + LDY #$00 + LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X + BVC ISGE1 + EOR #$80 +ISGE1 BMI ISGE2 + DEY +ISGE2 STY ESTKL+1,X + STY ESTKH+1,X + INX + LDY IPY + JMP NEXTOP +; +ISGEX STY IPY + LDY #$00 + LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X + BVC ISGEX1 + EOR #$80 +ISGEX1 BMI ISGEX2 + DEY +ISGEX2 STY ESTKL+1,X + STY ESTKH+1,X + INX + LDY IPY + JMP NEXTOPX +; +ISGT STY IPY + LDY #$00 + LDA ESTKL,X + CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X + BVC ISGT1 + EOR #$80 +ISGT1 BPL ISGT2 + DEY +ISGT2 STY ESTKL+1,X + STY ESTKH+1,X + INX + LDY IPY + JMP NEXTOP +; +ISGTX STY IPY + LDY #$00 + LDA ESTKL,X + CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X + BVC ISGTX1 + EOR #$80 +ISGTX1 BPL ISGTX2 + DEY +ISGTX2 STY ESTKL+1,X + STY ESTKH+1,X + INX + LDY IPY + JMP NEXTOPX +; +ISLE STY IPY + LDY #$00 + LDA ESTKL,X + CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X + BVC ISLE1 + EOR #$80 +ISLE1 BMI ISLE2 + DEY +ISLE2 STY ESTKL+1,X + STY ESTKH+1,X + INX + LDY IPY + JMP NEXTOP +; +ISLEX STY IPY + LDY #$00 + LDA ESTKL,X + CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X + BVC ISLEX1 + EOR #$80 +ISLEX1 BMI ISLEX2 + DEY +ISLEX2 STY ESTKL+1,X + STY ESTKH+1,X + INX + LDY IPY + JMP NEXTOPX +; +ISLT STY IPY + LDY #$00 + LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X + BVC ISLT1 + EOR #$80 +ISLT1 BPL ISLT2 + DEY +ISLT2 STY ESTKL+1,X + STY ESTKH+1,X + INX + LDY IPY + JMP NEXTOP +; +ISLTX STY IPY + LDY #$00 + LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X + BVC ISLTX1 + EOR #$80 +ISLTX1 BPL ISLTX2 + DEY +ISLTX2 STY ESTKL+1,X + STY ESTKH+1,X + INX + LDY IPY + JMP NEXTOPX +;* +;* BRANCHES +;* +BRTRU INX + LDA ESTKH-1,X + ORA ESTKL-1,X + BNE BRNCH +NOBRNCH +INC_IP + +INC_IP + JMP NEXTOP +BRFLS INX + LDA ESTKH-1,X + ORA ESTKL-1,X + BNE NOBRNCH +BRNCH LDA IPH + STA TMPH + LDA IPL + +INC_IP + CLC + ADC (IP),Y + STA TMPL + LDA TMPH + +INC_IP + ADC (IP),Y + STA IPH + LDA TMPL + STA IPL + DEY + DEY + JMP NEXTOP +BREQ INX + LDA ESTKL-1,X + CMP ESTKL,X + BNE NOBRNCH + LDA ESTKL-1,X + CMP ESTKL,X + BEQ BRNCH + BNE NOBRNCH +BRNE INX + LDA ESTKL-1,X + CMP ESTKL,X + BNE BRNCH + LDA ESTKL-1,X + CMP ESTKL,X + BEQ NOBRNCH + BNE BRNCH +BRGT INX + LDA ESTKL-1,X + CMP ESTKL,X + LDA ESTKH-1,X + SBC ESTKH,X + BMI BRNCH + BPL NOBRNCH +BRLT INX + LDA ESTKL,X + CMP ESTKL-1,X + LDA ESTKH,X + SBC ESTKH-1,X + BMI BRNCH + BPL NOBRNCH +IBRNCH LDA IPL + CLC + ADC ESTKL,X + STA IPL + LDA IPH + ADC ESTKH,X + STA IPH + INX + JMP NEXTOP +; +BRTRUX INX + LDA ESTKH-1,X + ORA ESTKL-1,X + BNE BRNCHX +NOBRNCHX +INC_IP + +INC_IP + JMP NEXTOPX +BRFLSX INX + LDA ESTKH-1,X + ORA ESTKL-1,X + BNE NOBRNCHX +BRNCHX LDA IPH + STA TMPH + LDA IPL + +INC_IP + CLC + ADC (IP),Y + STA TMPL + LDA TMPH + +INC_IP + ADC (IP),Y + STA IPH + LDA TMPL + STA IPL + DEY + DEY + JMP NEXTOPX +BREQX INX + LDA ESTKL-1,X + CMP ESTKL,X + BNE NOBRNCHX + LDA ESTKL-1,X + CMP ESTKL,X + BEQ BRNCHX + BNE NOBRNCHX +BRNEX INX + LDA ESTKL-1,X + CMP ESTKL,X + BNE BRNCHX + LDA ESTKL-1,X + CMP ESTKL,X + BEQ NOBRNCHX + BNE BRNCHX +BRGTX INX + LDA ESTKL-1,X + CMP ESTKL,X + LDA ESTKH-1,X + SBC ESTKH,X + BMI BRNCHX + BPL NOBRNCHX +BRLTX INX + LDA ESTKL,X + CMP ESTKL-1,X + LDA ESTKH,X + SBC ESTKH-1,X + BMI BRNCHX + BPL NOBRNCHX +IBRNCHX LDA IPL + CLC + ADC ESTKL,X + STA IPL + LDA IPH + ADC ESTKH,X + STA IPH + INX + JMP NEXTOPX +;* +;* CALL INTO ABSOLUTE ADDRESS (NATIVE CODE) +;* +CALL +INC_IP + LDA (IP),Y + STA TMPL + +INC_IP + LDA (IP),Y + STA TMPH + LDA IPH + PHA + LDA IPL + PHA + TYA + PHA + JSR JMPTMP + PLA + TAY + PLA + STA IPL + PLA + STA IPH + BIT LCRWEN+LCBNK2 ; WRITE ENABLE LANGUAGE CARD + BIT LCRWEN+LCBNK2 + JMP NEXTOP +; +CALLX +INC_IP + LDA (IP),Y + STA TMPL + +INC_IP + LDA (IP),Y + STA TMPH + LDA IPH + PHA + LDA IPL + PHA + TYA + PHA + STA ALTRDOFF + CLI + JSR JMPTMP + SEI + STA ALTRDON + PLA + TAY + PLA + STA IPL + PLA + STA IPH + BIT LCRWEN+LCBNK2 ; WRITE ENABLE LANGUAGE CARD + BIT LCRWEN+LCBNK2 + JMP NEXTOPX +;* +;* INDIRECT CALL TO ADDRESS (NATIVE CODE) +;* +ICAL LDA ESTKL,X + STA TMPL + LDA ESTKH,X + STA TMPH + INX + LDA IPH + PHA + LDA IPL + PHA + TYA + PHA + JSR JMPTMP + PLA + TAY + PLA + STA IPL + PLA + STA IPH + BIT LCRWEN+LCBNK2 ; WRITE ENABLE LANGUAGE CARD + BIT LCRWEN+LCBNK2 + JMP NEXTOP +; +ICALX LDA ESTKL,X + STA TMPL + LDA ESTKH,X + STA TMPH + INX + LDA IPH + PHA + LDA IPL + PHA + TYA + PHA + STA ALTRDOFF + CLI + JSR JMPTMP + SEI + STA ALTRDON + PLA + TAY + PLA + STA IPL + PLA + STA IPH + BIT LCRWEN+LCBNK2 ; WRITE ENABLE LANGUAGE CARD + BIT LCRWEN+LCBNK2 + JMP NEXTOPX +;* +;* ENTER FUNCTION WITH FRAME SIZE AND PARAM COUNT +;* +ENTER +INC_IP + LDA (IP),Y + STA FRMSZ + +INC_IP + LDA (IP),Y + STA NPARMS + STY IPY + LDA IFPL + PHA + SEC + SBC FRMSZ + STA IFPL + LDA IFPH + PHA + SBC #$00 + STA IFPH + LDY #$01 + PLA + STA (IFP),Y + DEY + PLA + STA (IFP),Y + LDA NPARMS + BEQ ENTER5 + ASL + TAY + INY +ENTER4 LDA ESTKH,X + STA (IFP),Y + DEY + LDA ESTKL,X + STA (IFP),Y + DEY + INX + DEC TMPL + BNE ENTER4 +ENTER5 LDY IPY + JMP NEXTOP +; +ENTERX +INC_IP + LDA (IP),Y + STA FRMSZ + +INC_IP + LDA (IP),Y + STA NPARMS + STY IPY + STA ALTRDOFF + LDA IFPL + PHA + SEC + SBC FRMSZ + STA IFPL + LDA IFPH + PHA + SBC #$00 + STA IFPH + LDY #$01 + PLA + STA (IFP),Y + DEY + PLA + STA (IFP),Y + LDA NPARMS + BEQ ENTERX5 + ASL + TAY + INY +ENTERX4 LDA ESTKH,X + STA (IFP),Y + DEY + LDA ESTKL,X + STA (IFP),Y + DEY + INX + DEC TMPL + BNE ENTERX4 +ENTERX5 STA ALTRDON + LDY IPY + JMP NEXTOPX +;* +;* LEAVE FUNCTION +;* +LEAVE LDY #$01 + LDA (IFP),Y + DEY + PHA + LDA (IFP),Y + STA IFPL + PLA + STA IFPH +RET RTS +; +LEAVEX STA ALTRDOFF + CLI + LDY #$01 + LDA (IFP),Y + DEY + PHA + LDA (IFP),Y + STA IFPL + PLA + STA IFPH + RTS +RETX STA ALTRDOFF + CLI + RTS +VMEND = * +} \ No newline at end of file diff --git a/src/plvm02zp.inc b/src/plvm02zp.inc new file mode 100644 index 0000000..d8f3831 --- /dev/null +++ b/src/plvm02zp.inc @@ -0,0 +1,32 @@ +;********************************************************** +;* +;* VM ZERO PAGE LOCATIONS +;* +;********************************************************** +ESTKSZ = $20 +ESTK = $C0 +ESTKL = ESTK +ESTKH = ESTK+ESTKSZ/2 +VMZP = ESTK+ESTKSZ +IFP = VMZP +IFPL = IFP +IFPH = IFP+1 +IP = IFP+2 +IPL = IP +IPH = IP+1 +IPY = IP+2 +TMP = IP+3 +TMPL = TMP +TMPH = TMP+1 +TMPX = TMP+2 +NPARMS = TMPL +FRMSZ = TMPH +DVSIGN = TMPX +ESP = TMPX +TICTOC = TMP+3 +SRC = $06 +SRCL = SRC +SRCH = SRC+1 +DST = SRC+2 +DSTL = DST +DSTH = DST+1 diff --git a/src/rod.pla b/src/rod.pla new file mode 100644 index 0000000..e54412c --- /dev/null +++ b/src/rod.pla @@ -0,0 +1,84 @@ +import STDLIB + predef romcall, puts +end +const speaker=$C030 +const showgraphics=$C050 +const showtext=$C051 +const showfull=$C052 +const showmix=$C053 +const TRUE=$FFFF +const FALSE=$0000 +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 +byte exitmsg[] = "PRESS ANY KEY TO EXIT.\n" +byte goodbye[] = "THAT'S ALL FOLKS!\n" +byte i, j, k, w, fmi, fmk, color + +def textmode + romcall(0, 0, 0, 0, $FB39) +end +def home + romcall(0, 0, 0, 0, $FC58) +end +def gotoxy(x, y) + ^($24) = x + romcall(y, 0, 0, 0, $FB5B) +end +def grmode + romcall(0, 0, 0, 0, $FB40) + ^showlores +end +def grcolor(color) + romcall(color, 0, 0, 0, $F864) +end +def grplot(x, y) + romcall(y, 0, x, 0, $F800) +end +def colors + 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 + romcall(color, 0, 0, 0, $F864) ;grcolor(color); + romcall(k, 0, i, 0, $F800) ;grplot(i, k); + romcall(i, 0, k, 0, $F800) ;grplot(k, i); + romcall(fmk, 0, fmi, 0, $F800) ;grplot(fmi, fmk); + romcall(fmi, 0, fmk, 0, $F800) ;grplot(fmk, fmi); + romcall(fmi, 0, k, 0, $F800) ;grplot(k, fmi); + romcall(k, 0, fmi, 0, $F800) ;grplot(fmi, k); + romcall(fmk, 0, i, 0, $F800) ;grplot(i, fmk); + romcall(i, 0, fmk, 0, $F800) ;grplot(fmk, i); + if ^keyboard >= 128 + ^keystrobe + return + fin + next + next + next + loop +end + + +grmode() +gotoxy(10,22) +puts(@exitmsg) +colors() +textmode() +home() +puts(@goodbye) +while ^keyboard < 128 +loop +^keystrobe +done \ No newline at end of file diff --git a/src/samplib.s b/src/samplib.s new file mode 100755 index 0000000..8f837e9 --- /dev/null +++ b/src/samplib.s @@ -0,0 +1,150 @@ +; +; Sample PLASMA library. +; +!TO "samplib.bin", PLAIN +* = $1000 +; +; DATA/CODE SEGMENT +; +_SEGBEGIN + !WORD _SEGEND-_SEGBEGIN ; LENGTH OF HEADER + CODE/DATA + BYTECODE SEGMENT +; +; MODULE HEADER +; + !WORD $DA7E ; MAGIC # + !WORD _SUBSEG ; BYTECODE SUB-SEGMENT + !WORD _INIT ; BYTECODE INIT ROUTINE +; +; MODULE DEPENDENCY LIST +; NOTE: DCI = PSUEDO OP FOR ASCII STRING WITH HI BIT SET EXCEPT LAST CHAR +; + ;DCI "STDLIB" + !CT "hi.ascii" + !TX "STDLI" + !CT RAW + !TX 'B' + ;DCI "FILEIO" + !CT "hi.ascii" + !TX "FILEI" + !CT RAW + !TX 'O' + !BYTE 0 +; +; NATIVE CODE + GLOBAL DATA +; +COUNT !WORD 0 +INCCNT +FIXUP1 INC COUNT + BNE XINIT +FIXUP2 INC COUNT+1 +XINIT RTS +; +; BYTECODE SUB-SEGMENT +; +_SUBSEG +MYFUNC !BYTE $58, $01, $16 ; ENTER 1,16 + !BYTE $66, $02 ; LLW 2 + !BYTE $2A, $01 ; CB 1 + !BYTE $54 ; CALL EXTERN(1) "OPEN" +FIXUP4 !WORD $0000 + !BYTE $6E, $04 ; DLW 4 + !BYTE $54 ; CALL EXTERN(3) "READ" +FIXUP5 !WORD $0000 + !BYTE $30 ; DROP + !BYTE $66, $04 ; LLW 4 + !BYTE $54 ; CALL EXTERN(2) ; "CLOSE" +FIXUP6 !WORD $0000 + !BYTE $30 ; DROP + !BYTE $6A ; LAW COUNT +FIXUP7 !WORD $0000 + !BYTE $54 ; CALL INCNT +FIXUP8 !WORD $0000 + !BYTE $5A ; LEAVE +_INIT + !BYTE $5C ; RET +; +; END OF CODE/DATA + BYTECODE SEGMENT +; +_SEGEND +; +; BYTCODE FUNCTION DICTIONARY +; + !BYTE $A1 ; FIXUP FLAGS + !WORD MYFUNC ; FIXUP OFFSET + !BYTE $00 ; FIXUP LO BYTE (OF HI BYTE)/IMPORT INDEX +; +; RE-LOCATION DICTIONARY (FIXUP TABLE) +; + !BYTE $81 ; FIXUP FLAGS + !WORD FIXUP1+1 ; FIXUP OFFSET + !BYTE $00 ; FIXUP LO BYTE (OF HI BYTE)/IMPORT INDEX + !BYTE $81 + !WORD FIXUP2+1 + !BYTE $00 + !BYTE $91 ; IMPORT FIXUP + !WORD FIXUP4 + !BYTE $01 ; IMPORT INDEX 1 + !BYTE $91 + !WORD FIXUP5 + !BYTE $03 + !BYTE $91 + !WORD FIXUP6 + !BYTE $02 + !BYTE $81 + !WORD FIXUP7 + !BYTE $00 + !BYTE $81 + !WORD FIXUP8 + !BYTE $00 + !BYTE 0 ; END OF RLD +; +; EXTERNAL/ENTRY SYMBOL DIRECTORY +;; +; IMPORT TABLE +; +IMPTBL ;DCI "OPEN" ; EXTERNAL SYMBOL NAME + !CT "hi.ascii" + !TX "OPE" + !CT RAW + !TX 'N' + !BYTE $10 ; EXTERNAL SYMBOL FLAG + !WORD 1 ; SYMBOL INDEX + ;DCI "CLOSE" + !CT "hi.ascii" + !TX "CLOS" + !CT RAW + !TX 'E' + !BYTE $10 + !WORD 2 + ;DCI "READ" + !CT "hi.ascii" + !TX "REA" + !CT RAW + !TX 'D' + !BYTE $10 + !WORD 3 + ;DCI "MEMSET" + !CT "hi.ascii" + !TX "MEMSE" + !CT RAW + !TX 'T' + !BYTE $10 + !WORD 4 +; +; EXPORT TABLE +; +EXPTBL ;DCI "INCNT" ; ENTRY SYMBOL NAME + !CT "hi.ascii" + !TX "INCN" + !CT RAW + !TX 'T' + !BYTE $08 ; ENTRY SYMBOL FLAG + !WORD INCCNT ; OFFSET + ;DCI "MYFUNC" + !CT "hi.ascii" + !TX "MYFUN" + !CT RAW + !TX 'C' + !BYTE $08 + !WORD MYFUNC + !BYTE 0 ; END OF ESD diff --git a/src/symbols.h b/src/symbols.h new file mode 100755 index 0000000..4298211 --- /dev/null +++ b/src/symbols.h @@ -0,0 +1,39 @@ +/* + * Symbol table types. + */ +#define GLOBAL_TYPE (0) +#define CONST_TYPE (1 << 0) +#define WORD_TYPE (1 << 1) +#define BYTE_TYPE (1 << 2) +#define VAR_TYPE (WORD_TYPE | BYTE_TYPE) +#define ASM_TYPE (1 << 3) +#define DEF_TYPE (1 << 4) +#define BRANCH_TYPE (1 << 5) +#define LOCAL_TYPE (1 << 6) +#define EXTERN_TYPE (1 << 7) +#define ADDR_TYPE (VAR_TYPE | FUNC_TYPE | EXTERN_TYPE) +#define WPTR_TYPE (1 << 8) +#define BPTR_TYPE (1 << 9) +#define PTR_TYPE (BPTR_TYPE | WPTR_TYPE) +#define STRING_TYPE (1 << 10) +#define TAG_TYPE (1 << 11) +#define EXPORT_TYPE (1 << 12) +#define PREDEF_TYPE (1 << 13) +#define FUNC_TYPE (ASM_TYPE | DEF_TYPE | PREDEF_TYPE) +int id_match(char *name, int len, char *id); +int idlocal_lookup(char *name, int len); +int idglobal_lookup(char *name, int len); +int idconst_lookup(char *name, int len); +int idlocal_add(char *name, int len, int type, int size); +int idglobal_add(char *name, int len, int type, int size); +int id_add(char *name, int len, int type, int size); +int idfunc_set(char *name, int len, int type, int tag); +int idfunc_add(char *name, int len, int type, int tag); +int idconst_add(char *name, int len, int value); +int id_tag(char *name, int len); +int id_const(char *name, int len); +int id_type(char *name, int len); +void idglobal_size(int type, int size, int constsize); +int idlocal_size(void); +void idlocal_reset(void); +int tag_new(int type); diff --git a/src/test.pla b/src/test.pla new file mode 100755 index 0000000..8116fbe --- /dev/null +++ b/src/test.pla @@ -0,0 +1,57 @@ +; +; Declare all imported modules and their data/functions. +; +import stdlib + predef cls, gotoxy, viewport, puts, putc, getc +end + +import testlib + predef puti, putnl +end +const mainentry = 2 +; +; Predeclare any functions called before defined. +; +predef ascii, main +; +; Declare all global variables for this module. +; +byte hello[] = "Hello, world.\n" +word defptr = @ascii, @main +word struct[] = 1, 10, 100 +; +; Define functions. +; +def ascii + byte i + for i = 32 to 127 + putc(i) + next +end + +def nums(range) + word i + for i = -10 to range + puti(i) + putnl + next +end + +export def main(range) + cls + nums(range) + viewport(12, 12, 16, 8) + ascii + viewport(0, 0, 40, 24) + gotoxy(15,5) + puts(@hello) +end + +export def indirect + word mainptr + mainptr = @main + return defptr:mainentry(struct:2) +end + +indirect +done diff --git a/src/testcls.pla b/src/testcls.pla new file mode 100755 index 0000000..e2ae4d6 --- /dev/null +++ b/src/testcls.pla @@ -0,0 +1,32 @@ +; +; Declare all imported modules and their data/functions. +; +import stdlib + predef putc +end +predef puti, puth +export word print[] = @puti, @puth +byte valstr[] = '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F' +; +; Define functions. +; +def puti(i) + if i < 0 + putc('-') + i = -i + fin + if i < 10 + putc(i + '0') + else + puti(i / 10) + putc(i % 10 + '0') + fin +end +def puth(h) + putc('$') + putc(valstr[(h >> 12) & $0F]) + putc(valstr[(h >> 8) & $0F]) + putc(valstr[(h >> 4) & $0F]) + putc(valstr[ h & $0F]) +end +done diff --git a/src/testlib.pla b/src/testlib.pla new file mode 100755 index 0000000..3ecde6b --- /dev/null +++ b/src/testlib.pla @@ -0,0 +1,29 @@ +; +; Declare all imported modules and their data/functions. +; +import stdlib + predef cls, gotoxy, puts, putc +end +byte loadstr[] = "testlib loaded!" +; +; Define functions. +; +export def puti(i) + if i < 0 + putc('-') + i = -i + fin + if i < 10 + putc(i + '0') + else + puti(i / 10) + putc(i % 10 + '0') + fin +end +export def putnl + putc($0D) +end + +puts(@loadstr) +putnl +done diff --git a/src/tokens.h b/src/tokens.h new file mode 100755 index 0000000..8696f34 --- /dev/null +++ b/src/tokens.h @@ -0,0 +1,106 @@ + +#define TOKEN(c) (0x80|(c)) +#define IS_TOKEN(c) (0x80&(c)) +/* + * Identifier and constant tokens. + */ +#define ID_TOKEN TOKEN('V') +#define CHAR_TOKEN TOKEN('Y') +#define INT_TOKEN TOKEN('Z') +#define FLOAT_TOKEN TOKEN('F') +#define STRING_TOKEN TOKEN('S') +/* + * Keyword tokens. + */ +#define CONST_TOKEN TOKEN(1) +#define BYTE_TOKEN TOKEN(2) +#define WORD_TOKEN TOKEN(3) +#define IF_TOKEN TOKEN(4) +#define ELSEIF_TOKEN TOKEN(5) +#define ELSE_TOKEN TOKEN(6) +#define FIN_TOKEN TOKEN(7) +#define END_TOKEN TOKEN(8) +#define WHILE_TOKEN TOKEN(9) +#define LOOP_TOKEN TOKEN(10) +#define CASE_TOKEN TOKEN(11) +#define OF_TOKEN TOKEN(12) +#define DEFAULT_TOKEN TOKEN(13) +#define ENDCASE_TOKEN TOKEN(14) +#define FOR_TOKEN TOKEN(15) +#define TO_TOKEN TOKEN(16) +#define DOWNTO_TOKEN TOKEN(17) +#define STEP_TOKEN TOKEN(18) +#define NEXT_TOKEN TOKEN(19) +#define REPEAT_TOKEN TOKEN(20) +#define UNTIL_TOKEN TOKEN(21) +#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 DONE_TOKEN TOKEN(27) +#define RETURN_TOKEN TOKEN(28) +#define BREAK_TOKEN TOKEN(29) +#define SYSFLAGS_TOKEN TOKEN(30) +#define EXIT_TOKEN TOKEN(31) +#define EVAL_TOKEN TOKEN(32) +/* + * Double operand operators. + */ +#define SET_TOKEN TOKEN('=') +#define ADD_TOKEN TOKEN('+') +#define ADD_SELF_TOKEN TOKEN('a') +#define SUB_TOKEN TOKEN('-') +#define SUB_SELF_TOKEN TOKEN('u') +#define MUL_TOKEN TOKEN('*') +#define MUL_SELF_TOKEN TOKEN('m') +#define DIV_TOKEN TOKEN('/') +#define DIV_SELF_TOKEN TOKEN('d') +#define MOD_TOKEN TOKEN('%') +#define OR_TOKEN TOKEN('|') +#define OR_SELF_TOKEN TOKEN('o') +#define EOR_TOKEN TOKEN('^') +#define EOR_SELF_TOKEN TOKEN('x') +#define AND_TOKEN TOKEN('&') +#define AND_SELF_TOKEN TOKEN('n') +#define SHR_TOKEN TOKEN('R') +#define SHR_SELF_TOKEN TOKEN('r') +#define SHL_TOKEN TOKEN('L') +#define SHL_SELF_TOKEN TOKEN('l') +#define GT_TOKEN TOKEN('>') +#define GE_TOKEN TOKEN('H') +#define LT_TOKEN TOKEN('<') +#define LE_TOKEN TOKEN('B') +#define NE_TOKEN TOKEN('U') +#define EQ_TOKEN TOKEN('E') +#define LOGIC_AND_TOKEN TOKEN('N') +#define LOGIC_OR_TOKEN TOKEN('O') +/* + * Single operand operators. + */ +#define NEG_TOKEN TOKEN('-') +#define COMP_TOKEN TOKEN('~') +#define LOGIC_NOT_TOKEN TOKEN('!') +#define INC_TOKEN TOKEN('P') +#define DEC_TOKEN TOKEN('K') +#define BPTR_TOKEN TOKEN('^') +#define WPTR_TOKEN TOKEN('*') +#define POST_INC_TOKEN TOKEN('p') +#define POST_DEC_TOKEN TOKEN('k') +#define OPEN_PAREN_TOKEN TOKEN('(') +#define CLOSE_PAREN_TOKEN TOKEN(')') +#define OPEN_BRACKET_TOKEN TOKEN('[') +#define CLOSE_BRACKET_TOKEN TOKEN(']') +/* + * Misc. tokens. + */ +#define AT_TOKEN TOKEN('@') +#define DOT_TOKEN TOKEN('.') +#define COLON_TOKEN TOKEN(':') +#define POUND_TOKEN TOKEN('#') +#define COMMA_TOKEN TOKEN(',') +#define COMMENT_TOKEN TOKEN(';') +#define EOL_TOKEN TOKEN(0) +#define EOF_TOKEN TOKEN(0x7F) + +typedef unsigned char t_token;