6502/PLASMA
1
0
Fork 0
mirror of https://github.com/dschmenk/PLASMA.git synced 2025-01-21 02:33:24 +00:00
Code Issues Projects Releases Wiki Activity

Merge pull request #8 from dschmenk/master

Browse Source 
Merge latest upstream changes
This commit is contained in:
ZornsLemma 2018-01-27 20:52:50 +00:00 committed by GitHub
commit 5a48384daa
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
49 changed files with 3310 additions and 2588 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
PLASMA-BLD1.PO
View File

Binary file not shown.

BIN
PLASMA-DEM1.PO Normal file
View File

Binary file not shown.

BIN
PLASMA-PRE2.PO Normal file
View File

Binary file not shown.

BIN
PLASMA-PRE3.PO Normal file
View File

Binary file not shown.

13
README.md
View File

@ -1,3 +1,6 @@
# 1/24/2018 Developer Preview #3 1.0 Available
[Download and read the Release Notes](https://github.com/dschmenk/PLASMA/blob/master/doc/Preview%20Version%201.0.md)
# The PLASMA Programming Language
![Luc Viatour](https://upload.wikimedia.org/wikipedia/commons/thumb/2/26/Plasma-lamp_2.jpg/1200px-Plasma-lamp_2.jpg)
@ -7,7 +10,7 @@ PLASMA: **P**roto **L**anguage **A**s**S**e**M**bler for **A**pple
PLASMA is a medium level programming language targeting the 8-bit 6502 processor. Historically, there were simple languages developed in the early years of computers that improved on the tedium of assembly language programming while still being low level enough for system coding. Languages like B, FORTH, and PLASMA fall into this category.
PLASMA is a combination of operating environment, virtual machine, and assembler/compiler matched closely to the 6502 architecture. It is an attempt to satisfy a few challenges surrounding code size, efficient execution, small runtime and flexible code location. By architecting a unique bytecode that maps nearly one-to-one to the higher-level representation, the compiler can be very simple and execute quickly on the Apple II for a self-hosted environment. A modular approach provides for incremental development and code reuse. The syntax of the language is heavily influenced by assembly, Pascal, and C. The design philosophy was to be as simple as feasible while retaining flexibility and symantic clarity. You won't find any unnecessary or redundant syntax in PLASMA.
PLASMA is a combination of operating environment, virtual machine, and assembler/compiler matched closely to the 6502 architecture. It is an attempt to satisfy a few challenges surrounding code size, efficient execution, small runtime and flexible code location. By architecting a unique bytecode that maps nearly one-to-one to the higher-level representation, the compiler can be very simple and execute quickly on the Apple II for a self-hosted environment. A modular approach provides for incremental development and code reuse. The syntax of the language is heavily influenced by assembly, Pascal, and C. The design philosophy was to be as simple as feasible while retaining flexibility and semantic clarity. You won't find any unnecessary or redundant syntax in PLASMA.
Different projects have led to the architecture of PLASMA, most notably Apple Pascal, FORTH, and my own Java VM for the 6502: VM02. Each has tried to map a generic VM to the 6502 with varying levels of success. Apple Pascal, based on the USCD Pascal using the p-code interpreter, was a very powerful system and ran fast enough on the Apple II to be interactive but didn't win any speed contests. FORTH was the poster child for efficiency and obtuse syntax. Commonly referred to as a write only language, it was difficult to come up to speed as a developer, especially when using others' code. My own project in creating a Java VM for the Apple II uncovered the folly of shoehorning a large, 32-bit virtual memory environment into 8-bit, 64K hardware.
@ -380,7 +383,7 @@ char[64] txtfile = "UNTITLED"
### Function Definitions
Functions are defined after all constants, variables and data. Function definitions can be `export`ed for inclusion in other modules and can be forward declared with a `predef` type in the constant and variable declarations. Functions can take parameters, passed on the evaluation stack, then copied to the local frame for easy access. They can have their own variable declarations, however, unlike the global declarations, no data can be predeclared - only storage space. A local frame is built for every function invocation and there is also a limit of 254 bytes of local storage. Each parameter takes two bytes of local storage, plus two bytes for the previous frame pointer. If a function has no parameters or local variables, no local frame will be created, improving performance. Functions always return a single value by default.
Functions are defined after all constants, variables and data. Function definitions can be `export`ed for inclusion in other modules and can be forward declared with a `predef` type in the constant and variable declarations. Functions can take parameters passed on the evaluation stack, then copied to the local frame for easy access. They can have their own variable declarations, however, unlike the global declarations, no data can be predeclared - only storage space. A local frame is built for every function invocation and there is also a limit of 254 bytes of local storage. Each parameter takes two bytes of local storage, plus two bytes for the previous frame pointer. If a function has no parameters or local variables, no local frame will be created, improving performance. Functions return a single value by default.
```
def myfunc(a, b) // Two parameters and defaults to one returned value
```
@ -600,7 +603,7 @@ redraw
### 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".
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".
Here is an example using the `import`s from the previous examples to export an initialized array of 10 elements (2 defined + null delimiter):
@ -692,7 +695,7 @@ putc(']')
putc('\n')
```
Escaped characters, like the `\n` above are replaces with the Carriage Return character. The list of escaped characters is:
Escaped characters, like the `\n` above are replaced with the Carriage Return character. The list of escaped characters is:
| Escaped Char | ASCII Value
|:------------:|------------
@ -1256,7 +1259,7 @@ would silently return 100,0 because of the return value count in the definition.
## 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 assembly functions can't see PLASMA labels and definitions, so they are pretty much relegated to leaf functions. Lastly, PLASMA modules are re-locatable, but labels inside assembly functions don't get flagged for fix-ups. The assembly code must use all relative branches and only accessing data/code at a fixed address. Data passed in on the PLASMA evaluation 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`. It is possible to relocate absolute addresses with a little trickery. Look to some of the library modules where native code is fixed up in the initialization block.
Native assembly functions are only available on the cross-compiler. 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 assembly functions can't see PLASMA labels and definitions, so they are pretty much relegated to leaf functions. Lastly, PLASMA modules are re-locatable, but labels inside assembly functions don't get flagged for fix-ups. The assembly code must use all relative branches and only access data/code at a fixed address. Data passed in on the PLASMA evaluation 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`. It is possible to relocate absolute addresses with a little trickery. Look to some of the library modules where native code is fixed up in the initialization block.
# Implementation

144
doc/Preview Version 1.0.md
View File

@ -1,40 +1,152 @@
# Developer Preview Version 1.0
# Developer Preview #3 Version 1.0
PLASMA is approaching a 1.0 release after _only_ 12 years. Hopefully it was worth the wait. To work out the remaining kinks, this Developer Preview will allow programmers to kcick the tires, so to speak, to provide feedback on the system.
PLASMA is approaching a 1.0 release after _only_ 12 years. Hopefully it was worth the wait. To work out the remaining kinks, this Developer Preview will allow programmers to kick the tires, so to speak, to provide feedback on the system.
Download the two disk images:
Download the three disk images:
(PLASMA Preview 1.0 System)[https://github.com/dschmenk/PLASMA/blob/master/PLASMA-PRE1.PO?raw=true]
[PLASMA Preview #3 1.0 System](https://github.com/dschmenk/PLASMA/blob/master/PLASMA-PRE3.PO?raw=true)
(PLASMA 1.0 Build System)[https://github.com/dschmenk/PLASMA/blob/master/PLASMA-BLD1.PO?raw=true]
[PLASMA 1.0 Build System](https://github.com/dschmenk/PLASMA/blob/master/PLASMA-BLD1.PO?raw=true)
[PLASMA 1.0 Demos](https://github.com/dschmenk/PLASMA/blob/master/PLASMA-DEM1.PO?raw=true)
PLASMA can be run from floppies, System in drive 1, and Build in drive 2. All Apple II computers are supported, from the earliest Rev 0 to the last Apple IIGS. However, an accelerator and hard disk/CFFA are highly recommended. The recommended mass storage installation looks like:
System Files => /HARDISK/PLASMA.PRE1/
System Files => /HARDISK/PLASMA.PRE3/
Build Files => /HARDISK/BLD/
Keeping the system files seperate from the build directory will make upgrading to the final 1.0 Release later a little easier. To boot directly into PLASMA, you will need to put the system files in the root prefix of the boot device and make sure PLASMA.SYSTEM is the first SYSTEM file in the directory. Otherwise, launch PLASMA.SYSTEM from your command processor of choice.
Demo Files => /HARDISK/DEMOS/
Keeping the system files seperate from the build directory will make upgrading to the final 1.0 Release later a little easier. To boot directly into PLASMA, you will need to put the system files in the root prefix of the boot device and make sure PLASMA.SYSTEM is the first SYSTEM file in the directory. Otherwise, start PLASMA.SYSTEM from your program launcher of choice.
## 65802/65816 Support
PLASMA can utilize the 16 bit features of the 65802 and 65816 processors to improve performance of the PLASMA VM operation. This is transparent to the programmer/user and doesn't make any additional memory or capabilities available to PLASMA. Launch `PLASMA16.SYSTEM` to use the 16 bit PLASMA VM. If you don't have the right CPU, it will print a message and restart.
# PLASMA Command Line Shell
## PLASMA Command Line Shell
PLASMA incorporates a very basic command line shell to facilitate navigating the filesystem and executing both SYSTEM programs and PLASMA modules. It has a few built-in commands:
| Command | Operation |
|:-------------------:|-----------------------|
| C [PREFIX] | Catalog prefix
| P \<PREFIX\> | change to Prefix
| / | change to parent prefix
| V | show online Volumes
| -\<SYSTEM PROGRAM\> | launch SYSTEM program
| +\<PLASMA MODULE\> | exec PLASMA module
|:----------------------------:|-------------------------|
| C [PREFIX] | Catalog prefix
| P \<PREFIX\> | change to Prefix
| / | change to parent prefix
| V | show online Volumes
| -\<SYSTEM PROGRAM\> [PARAMS] | launch SYSTEM program
| +\<PLASMA MODULE\> [PARAMS] | exec PLASMA module
```
[Optional parameters]
<Required parameters>
```
The shell is very breif with error messages. It is meant solely as a way to run programs that accept command line parameters and take up as little memory as possible. It does, however, provide a rich runtime for PLASMA modules.
The shell is very brief with error messages. It is meant solely as a way to run programs that accept command line parameters and take up as little memory as possible. It does, however, provide a rich runtime for PLASMA modules.
## Included Modules
The Developers Preview comes with a basic set of system modules. When PLASMA is launched, the SYS/ directory immediately below where PLASMA.SYSTEM was launched contains the modules. The system volume (where PLASMA was started) must remain in place for the duration of PLASMAs run. Otherwise it won't be able to find CMD or the system libraries. Probably the most useful included module is the editor. It is used for editing PLASMA source file, assembly source files, or any ProDOS text file. Execute it with:
```
+ED [TEXT FILE]
```
### Compiler Modules
The build disk includes sample source, include files for the system modules, and the PLASMA compiler+optimizer modules. The compiler is invoked with:
```
+PLASM [-[W][O[2]] <SOURCE FILE> [OUTPUT FILE]
```
Compiler warnings are enabled with `-W`. The optional optimizer is enabled with `-O` and extra optimizations are enabled with `-O2`. The source code for a few sample programs are included. The big one, `RPNCALC.PLA`, is the sample RPN calculator that uses many of PLASMA's advanced features. The self-hosted compiler is the same compiler as the cross-compiler, just transcribed from C to PLASMA (yes, the self-hosted PLASMA compiler is written in PLASMA). It requires patience when compiling: it is a fairly large and extensive program.
### Demos
There are some demo programs included for your perusal. Check out `ROGUE` for some diversion. You can find the documentation here: https://github.com/dschmenk/PLASMA/blob/master/doc/Rogue%20Instructions.md. A music sequencer to play through a MockingBoard if it is detected, or the built-in speaker if not. There may be problems if there is a CP/M card present when detecting the MockingBoard. A minimal Web server if you have an Uthernet2 card (required). Bug reports appreciated.
## Source Code
This is a Developers Preview, all sample source code is included from the project. It builds without alteration and should be a good starting point for further explorations. The header files for the included library modules are in the INC directory. Previously, examples from the sandbox were included but they have been removed to make room for all the project samples and include files.
## Issues
- All the modules and runtime are written mostly in PLASMA; the compiler and editor as well. This means that there may be some startup delay as the PLASMA module loader reads in the module dependencies and performs dynamic linking. But a 1 MHz, 8 bit CPU interpreting bytecodes is never going to match a modern computer. As noted earlier, an accelerator and mass storage are your (and PLASMA's) friend.
- All the project modules are included. They have been tested, with the exception of the Uthernet2 driver. I seem to have misplaced mine. If someone can try the Web Server demo in /PLASMA.DEMOS/NET and leave feedback would be very appreciated.
- The documentation is sparse and incomplete. Yep, could use your help...
# Changes in PLASMA for 1.0
If you have been programming in PLASMA before, the 1.0 version has some major and minor changes that you should be aware of:
1. Case is no longer significant. Imported symbols were always upper case. Now, all symbols are treated as if they were upper case. You may find that some symbols clash with previously defined symbols of different case. Hey, we didn't need lower case in 1977 and we don't need it now. You kids, get off my lawn!
2. Modules are now first class citizens. Translation: importing a module adds a symbol with the module name. You can simply refer to a module's address with it's name. This is how a module's API table is accessed (instead of adding a variable of the same name in the IMPORT section).
3. Bytecode changes means previously compiled modules will crash. Rebuild.
4. `BYTE` and `WORD` have aliases that may improve readability of the code. `CHAR` (character) and `RES` (reserve) are synonyms for `BYTE`. `VAR` (variable) is a synonym for `WORD`. These aliases add no functionality. They are simply syntactic sugar to add context to the source code, but may cause problems if you've previously used the same names for identifiers.
5. When declaring variables, a base size can come after the type, and an array size can folllow the identifier. For instance:
```
res[10] a, b, c
```
will reserve three variables of 10 bytes each. Additionally:
```
res[10] v[5], w[3]
```
will reserve a total of 80 bytes (10 * 5 + 10 * 3). This would be useful when combined with a structure definition. One could:
```
res[t_record] patients[20]
```
to reserve an array of 20 patient records.
6. Ternary operator. Just like C and descendants, `??` and `::` allow for an if-then-else inside an expression:
```
puts(truth == TRUE ?? "TRUE" :: "FALSE")
```
7. Multiple value assignements. Multiple values can be returned from functions and listed on variable assignments:
```
def func#3 // Return 3 values
return 10, 20, 30
end
a, b, c = 1, 2, 3
c, d, f = func()
x, y = y, x // Swap x and y
```
8. `DROP` allows for explicit dropping of values. In the above `func()` example, if the middle value was the only one desired, the others can be ignored with:
```
drop, h, drop = func()
```
9. The compiler tracks parameter and return counts for functions. If the above `func()` were used without assigning all the return values, they would be dropped:
```
a = func() // Two values silently dropped
```
To generate compiler warning for this issue, and a few others, use the `-W` option when compiling.
10. Lambda (Anonymous) Functions. The ability to code a quick function in-line can be very powerful when used properly. Look here, https://en.wikipedia.org/wiki/Anonymous_function, for more information.
11. SANE (Standard Apple Numerics Environment) Floating Point Library. An extensive library (two, actually) of extended floating point (80 bit IEEE precision) functionality is suported. A wrapper library has been written to greatly simplify the interface to SANE. Look at the `RPNCALC.PLA` source code as an example.
12. Library Documentation. Preliminary documentation is available on the Wiki: https://github.com/dschmenk/PLASMA/wiki
13. Significant effort has gone into VM tuning and speeding up module loading/dynamic linking.
14. The VM zero page usage has changed. If you write assembly language routines, you will need to rebuild.
# Thanks
I wish to thank the people who have contributed the the PLASMA project. They have greatly improved the development of the language and documentation:
- Martin Haye: PLASMA programmer extraordinaire. Mr. Lawless Legends has requested many of the crucial features that set PLASMA apart.
- Steve F (ZornsLemma): Has taken the optimizer to new levels and his work on porting PLASMA to the Beeb are amazing: http://stardot.org.uk/forums/viewtopic.php?f=55&t=12306&sid=5a503c593f0698ebc31e590ac61b09fc
- Peter Ferrie: Assembly optimizer extraordinaire. He has made significant improvements into the code footprint in PLASMA so all the functionality can exist in just a few bytes.
- David Schmidt (DaveX): His help in documentation have made it much more accessible and professional. Of course any errors are all his. Just kidding, they're mine ;-)
- Andy Werner (6502.org): Catching the grammatical errors that I ain't no good at.
- John Brooks: Apple II Guru par excellence. His insights got 10% performance increase out of the VM.
Dave Schmenk
http://schmenk.is-a-geek.com

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

@ -0,0 +1,4 @@
import fiber
predef fbrInit(numPool), fbrStop(fid)#0, fbrExit#0, fbrStart(defaddr, param)
predef fbrYield#0, fbrHalt#0, fbrResume(fid)#0
end

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

@ -0,0 +1,4 @@
import portio
predef digitalRead(pin), portRead, digitalWrite(pin, val)#0
predef portWrite(val)#0, analogRead(pin), delay(time)#0
end

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

@ -0,0 +1,4 @@
import sndseq
predef spkrTone(pitch, duration)#0, spkrPWM(sample, speed, len)#0
predef musicPlay(track, rept)#0, musicStop#0, musicGetKey(backgroundProc)#1
end

26
src/inc/spiport.plh
View File

@ -1,7 +1,27 @@
import spiport
const SPI_SLAVE_READY = '@'
const SPI_SLAVE_ERROR = '!'
const SPI_SLAVE_BUSY = $FF
//
// Wiring constants for Arduino
//
const PINHIGH = 1
const PINLOW = 0
const PINOUTPUT = 1
const PININPUT = 0
const PINPULLUP = 2
//
// SPI commands to Wiring functions on Arduino
//
const CMDPINMODE = 3
const CMDDIGREAD = 4
const CMDDIGWRITE = 5
const CMDANAREAD = 6
const CMDANAWRITE = 7
//
// SPI commands to serial functions on Arduino
//
const CMDSERMODE = 8
const CMDSERAVAIL = 9
const CMDSERREAD = 10
const CMDSERWRITE = 11
predef spiXferByte(outbyte), spiSend(data), spiRecv, spiWriteBuf(buf, len), spiReadBuf(buf, len)
predef spiDelay(time), spiReady
end

23
src/inc/wireio.plh
View File

@ -1,23 +0,0 @@
//
// Wiring constants for Arduino
//
const PINHIGH = 1
const PINLOW = 0
const PINOUTPUT = 1
const PININPUT = 0
const PINPULLUP = 2
//
// SPI commands to Wiring functions on Arduino
//
const CMDPINMODE = 3
const CMDDIGREAD = 4
const CMDDIGWRITE = 5
const CMDANAREAD = 6
const CMDANAWRITE = 7
//
// SPI commands to serial functions on Arduino
//
const CMDSERMODE = 8
const CMDSERAVAIL = 9
const CMDSERREAD = 10
const CMDSERWRITE = 11

801
src/libsrc/dgr.pla
View File

@ -50,461 +50,470 @@ end
// Plot pixel
//
export asm dgrPlot(buff, x, y)#0
; GET BUFFER ADDRESS
STX ESP
LDA ESTKL+2,X
STA SRCL
LDA ESTKH+2,X
STA SRCH
LDA ESTKL,X ; Y COORD
AND #$FE
TAY
LDA (SRC),Y
STA GBASL
INY
LDA (SRC),Y
STA GBASH
LDA ESTKL+1,X ; X COORD
LSR ESTKL,X
LDX GCLR ; COLOR
PHP
SEI
; GET BUFFER ADDRESS
STX ESP
LDA ESTKL+2,X
STA SRCL
LDA ESTKH+2,X
STA SRCH
LDA ESTKL,X ; Y COORD
AND #$FE
TAY
LDA (SRC),Y
STA GBASL
INY
LDA (SRC),Y
STA GBASH
LDA ESTKL+1,X ; X COORD
LSR ESTKL,X
LDX GCLR ; COLOR
PHP
SEI
end
asm _dgrPlotPix
JSR $3000
PLP
LDX ESP
INX
INX
INX
RTS
JSR $3000 ; _dgrSetPix
PLP
LDX ESP
INX
INX
INX
RTS
end
//
// Plot horizontal row of pixels
//
export asm dgrHLin(buff, x1, x2, y)#0
; GET BUFFER ADDRESS
STX ESP
LDA ESTKL+3,X
STA SRCL
LDA ESTKH+3,X
STA SRCH
LDA ESTKL,X ; Y COORD
AND #$FE
TAY
LDA (SRC),Y
STA GBASL
INY
LDA (SRC),Y
STA GBASH
LDA ESTKL+2,X ; X1 COORD
LSR ESTKL,X
PHP
- PLP
PHP
SEI
LDX GCLR ; COLOR
; GET BUFFER ADDRESS
STX ESP
LDA ESTKL+3,X
STA SRCL
LDA ESTKH+3,X
STA SRCH
LDA ESTKL+1,X ; X2 COORD
STA TMPH
LDA ESTKL,X ; Y COORD
AND #$FE
TAY
LDA (SRC),Y
STA GBASL
INY
LDA (SRC),Y
STA GBASH
LDY ESTKL+2,X ; X1 COORD
PHP
SEI
- LDA ESTKL,X
LSR
TYA
LDX GCLR ; COLOR
end
asm _dgrHLinPix
JSR $3000
LDX ESP
INC ESTKL+2,X ; X1 COORD
LDA ESTKL+2,X
CMP ESTKL+1,X ; X2 COORD
BCC -
BEQ -
PLP
INX
INX
INX
INX
RTS
JSR $3000 ; _dgrSetPix
LDX ESP
INC ESTKL+2,X ; X1 COORD
LDY ESTKL+2,X
CPY TMPH ; X2 COORD
BCC -
BEQ -
PLP
INX
INX
INX
INX
RTS
end
//
// Plot horizontal row of pixels
//
export asm dgrVLin(buff, x, y1, y2)#0
; GET BUFFER ADDRESS
STX ESP
LDA ESTKL+3,X
STA SRCL
LDA ESTKH+3,X
STA SRCH
LDA ESTKL+1,X ; Y1 COORD
- AND #$FE
TAY
LDA (SRC),Y
STA GBASL
INY
LDA (SRC),Y
STA GBASH
LDA ESTKL+1,X
LSR
LDA ESTKL+2,X ; X COORD
LDX GCLR ; COLOR
PHP
SEI
STX ESP
LDA ESTKL+3,X
STA SRCL
LDA ESTKH+3,X
STA SRCH
LDA ESTKL+1,X ; Y1 COORD
PHP
SEI
- AND #$FE
TAY
LDA (SRC),Y
STA GBASL
INY
LDA (SRC),Y
STA GBASH
LDA ESTKL+1,X
LSR
LDA ESTKL+2,X ; X COORD
LDX GCLR ; COLOR
end
asm _dgrVLinPix
JSR $3000
PLP
LDX ESP
INC ESTKL+1,X ; Y1 COORD
LDA ESTKL+1,X
CMP ESTKL,X ; Y2 COORD
BCC -
BEQ -
INX
INX
INX
INX
RTS
JSR $3000 ; _dgrSetPix
LDX ESP
INC ESTKL+1,X ; Y1 COORD
LDA ESTKL+1,X
CMP ESTKL,X ; Y2 COORD
BCC -
BEQ -
PLP
INX
INX
INX
INX
RTS
end
//
// Draw sprite
//
export asm dgrBLT(buff, x, y, width, height, src)#0
LDA ESTKL,X ; SPRITE
STA SRCL
LDA ESTKH,X
STA SRCH
LDA ESTKL+5,X
STA DSTL
LDA ESTKH+5,X
STA DSTH
LDA ESTKL+4,X ; X1 COORD
CMP #80
BPL ++++
CLC
ADC ESTKL+2,X
BMI ++++
STA ESTKH+2,X ; X2 COORD
LDA ESTKL+3,X ; Y1 COORD
CMP #48
BPL ++++
STA ESTKH+3,X ; Y COORD
CLC
ADC ESTKL+1,X
BMI ++++
STA ESTKH+1,X ; Y2 COORD
STX ESP
LDA ESTKH+3,X
- CMP #48
BCC +
LDA SRCL ; SKIP TO NEXT ROW
CLC
ADC ESTKL+2,X ; WIDTH
STA SRCL
LDA SRCH
ADC #$00
STA SRCH
BNE +++
+ AND #$FE
TAY
LDA (DST),Y
STA GBASL
INY
LDA (DST),Y
STA GBASH
LDA ESTKL+4,X ; X1 COORD
STA ESTKH+4,X ; X COORD
PHP
SEI
-- CMP #80
BCS ++
STA TMP
LDA ESTKH+3,X ; Y COORD
LSR
LDY #$00
LDA (SRC),Y
BMI ++
TAX
LDA TMP
LDA ESTKL,X ; SPRITE
STA SRCL
LDA ESTKH,X
STA SRCH
LDA ESTKL+5,X
STA DSTL
LDA ESTKH+5,X
STA DSTH
LDA ESTKL+4,X ; X1 COORD
CMP #80
BPL ++++
CLC
ADC ESTKL+2,X
BMI ++++
STA ESTKH+2,X ; X2 COORD
LDA ESTKL+3,X ; Y1 COORD
CMP #48
BPL ++++
STA ESTKH+3,X ; Y COORD
CLC
ADC ESTKL+1,X
BMI ++++
STA ESTKH+1,X ; Y2 COORD
STX ESP
LDA ESTKH+3,X
- CMP #48
BCC +
LDA SRCL ; SKIP TO NEXT ROW
CLC
ADC ESTKL+2,X ; WIDTH
STA SRCL
LDA SRCH
ADC #$00
STA SRCH
BNE +++
+ AND #$FE
TAY
LDA (DST),Y
STA GBASL
INY
LDA (DST),Y
STA GBASH
LDA ESTKL+4,X ; X1 COORD
STA ESTKH+4,X ; X COORD
PHP
SEI
-- CMP #80
BCS ++
STA TMP
LDA ESTKH+3,X ; Y COORD
LSR
LDY #$00
LDA (SRC),Y
BMI ++
TAX
LDA TMP
end
asm _dgrBLTPix
JSR $4000
LDX ESP
++ INC SRCL
BNE +
INC SRCH
+ INC ESTKH+4,X ; X COORD
LDA ESTKH+4,X
BMI --
CMP ESTKH+2,X ; X2 COORD
BCC --
PLP
+++ INC ESTKH+3,X ; Y COORD
LDA ESTKH+3,X
BMI -
CMP ESTKH+1,X ; Y2 COORD
BCC -
++++ INX
INX
INX
INX
INX
INX
RTS
JSR $4000 ; _dgrSetPix
LDX ESP
++ INC SRCL
BNE +
INC SRCH
+ INC ESTKH+4,X ; X COORD
LDA ESTKH+4,X
BMI --
CMP ESTKH+2,X ; X2 COORD
BCC --
PLP
+++ INC ESTKH+3,X ; Y COORD
LDA ESTKH+3,X
BMI -
CMP ESTKH+1,X ; Y2 COORD
BCC -
++++ INX
INX
INX
INX
INX
INX
RTS
end
//
// Internal set pixel routine
// - It expects the carry to be set for even or odd scanlines. Bad.
// - ACCUM has horizontal coordinate
// - X_REG has color
// - GBASE points to scanline
//
asm _dgrSetPix
BCS ++
; EVEN ROW
LSR
TAY
BCS +
BCS ++
; EVEN ROW
LSR
TAY
BCS +
end
asm _dgrSetEvnEvn
; EVEN PIXEL
LDA $2000,X
AND #$0F
STA TMP
JSR $0100 ; LDA AUX (DST),Y
AND #$F0
ORA TMP
STA $C005 ; WRITE AUX MEM
STA (GBASE),Y
STA $C004 ; WRITE MAIN MEM
RTS
; EVEN PIXEL
LDA $2000,X
AND #$0F
STA TMP
JSR $0100 ; LDA AUX (DST),Y
AND #$F0
ORA TMP
STA $C005 ; WRITE AUX MEM
STA (GBASE),Y
STA $C004 ; WRITE MAIN MEM
RTS
end
asm _dgrSetEvnOdd
; ODD PIXEL
+ LDA $1000,X
AND #$0F
STA TMP
LDA (GBASE),Y
AND #$F0
ORA TMP
STA (GBASE),Y
RTS
; ODD ROW
++ LSR
TAY
BCS +++
; ODD PIXEL
+ LDA $1000,X
AND #$0F
STA TMP
LDA (GBASE),Y
AND #$F0
ORA TMP
STA (GBASE),Y
RTS
; ODD ROW
++ LSR
TAY
BCS +++
end
asm _dgrSetOddEvn
; EVEN PIXEL
LDA $2000,X
AND #$F0
STA TMP
JSR $0100 ; LDA AUX (DST),Y
AND #$0F
ORA TMP
STA $C005 ; WRITE AUX MEM
STA (GBASE),Y
STA $C004 ; WRITE MAIN MEM
RTS
; EVEN PIXEL
LDA $2000,X
AND #$F0
STA TMP
JSR $0100 ; LDA AUX (DST),Y
AND #$0F
ORA TMP
STA $C005 ; WRITE AUX MEM
STA (GBASE),Y
STA $C004 ; WRITE MAIN MEM
RTS
end
asm _dgrSetOddOdd
; ODD PIXEL
+++ LDA $1000,X
AND #$F0
STA TMP
LDA (GBASE),Y
AND #$0F
ORA TMP
STA (GBASE),Y
RTS
; ODD PIXEL
+++ LDA $1000,X
AND #$F0
STA TMP
LDA (GBASE),Y
AND #$0F
ORA TMP
STA (GBASE),Y
RTS
end
//
// This gets copied to $0100!!!
//
asm auxRead
STA $C003 ; READ AUX MEM
LDA (GBASE),Y
STA $C002 ; READ MAIN MEM
RTS
STA $C003 ; READ AUX MEM
LDA (GBASE),Y
STA $C002 ; READ MAIN MEM
RTS
end
//
// Draw 8x8 tile (forced to 2x2 block address)
//
export asm dgrTile(buff, x, y, src)#0
STX ESP
LDA ESTKL,X ; TILE
STA SRCL
LDA ESTKH,X
STA SRCH
LDA ESTKL+3,X
STA DSTL
LDA ESTKH+3,X
STA DSTH
LDA ESTKL+2,X ; X1 COORD
CMP #80
BPL ++++
CLC
ADC #$08
BMI ++++
STA ESTKH+2,X ; X2 COORD
LDA ESTKL+1,X ; Y1 COORD
CMP #48
BPL ++++
STA TMPL ; Y COORD
CLC
ADC #$08
BMI ++++
STA ESTKH+1,X ; Y2 COORD
LDA TMPL ; Y COORD
- CMP #48
BCC +
LDA SRCL ; SKIP TO NEXT ROW
ADC #$07 ; CARRY = 1
STA SRCL
LDA SRCH
ADC #$00
STA SRCH
BNE +++
+ AND #$FE
TAY
LDA (DST),Y
STA GBASL
INY
LDA (DST),Y
STA GBASH
LDA ESTKL+2,X ; X1 COORD
STA TMPH ; X COORD
PHP
SEI
-- LSR
TAY
CMP #40
LDX #$00
LDA (SRC,X)
INC SRCL
BNE +
INC SRCH
+ BCS +
STA $C005 ; WRITE AUX MEM
STA (GBASE),Y
STA $C004 ; WRITE MAIN MEM
+ LDA (SRC,X)
INC SRCL
BNE +
INC SRCH
+ BCS ++
STA (GBASE),Y
++ INC TMPH ; X COORD
INC TMPH ; X COORD
LDX ESP
LDA TMPH
BMI --
CMP ESTKH+2,X ; X2 COORD
BCC --
PLP
+++ INC TMPL ; Y COORD
INC TMPL ; Y COORD
LDA TMPL
BMI -
CMP ESTKH+1,X ; Y2 COORD
BCC -
++++ INX
INX
INX
INX
RTS
STX ESP
LDA ESTKL,X ; TILE
STA SRCL
LDA ESTKH,X
STA SRCH
LDA ESTKL+3,X
STA DSTL
LDA ESTKH+3,X
STA DSTH
LDA ESTKL+2,X ; X1 COORD
CMP #80
BPL ++++
CLC
ADC #$08
BMI ++++
STA ESTKH+2,X ; X2 COORD
LDA ESTKL+1,X ; Y1 COORD
CMP #48
BPL ++++
STA TMPL ; Y COORD
CLC
ADC #$08
BMI ++++
STA ESTKH+1,X ; Y2 COORD
LDA TMPL ; Y COORD
- CMP #48
BCC +
LDA SRCL ; SKIP TO NEXT ROW
ADC #$07 ; CARRY = 1
STA SRCL
LDA SRCH
ADC #$00
STA SRCH
BNE +++
+ AND #$FE
TAY
LDA (DST),Y
STA GBASL
INY
LDA (DST),Y
STA GBASH
LDA ESTKL+2,X ; X1 COORD
STA TMPH ; X COORD
PHP
SEI
-- LSR
TAY
CMP #40
LDX #$00
LDA (SRC,X)
INC SRCL
BNE +
INC SRCH
+ BCS +
STA $C005 ; WRITE AUX MEM
STA (GBASE),Y
STA $C004 ; WRITE MAIN MEM
+ LDA (SRC,X)
INC SRCL
BNE +
INC SRCH
+ BCS ++
STA (GBASE),Y
++ INC TMPH ; X COORD
INC TMPH ; X COORD
LDX ESP
LDA TMPH
BMI --
CMP ESTKH+2,X ; X2 COORD
BCC --
PLP
+++ INC TMPL ; Y COORD
INC TMPL ; Y COORD
LDA TMPL
BMI -
CMP ESTKH+1,X ; Y2 COORD
BCC -
++++ INX
INX
INX
INX
RTS
end
//
// Draw a string of tiles
//
export asm dgrTileStr(buff, x, y, tilestr, strlen, tilebuff)#0
- DEX
DEX
DEX
DEX
LDA ESTKL+9,X ; BUFF
STA ESTKL+3,X
LDA ESTKH+9,X
STA ESTKH+3,X
LDA ESTKL+8,X ; X COORD
STA ESTKL+2,X
LDA ESTKL+7,X ; Y COORD
STA ESTKL+1,X
LDA ESTKL+4,X ; TILE
STA ESTKL,X
LDA ESTKH+4,X ; TILE
STA ESTKH,X
- DEX
DEX
DEX
DEX
LDA ESTKL+9,X ; BUFF
STA ESTKL+3,X
LDA ESTKH+9,X
STA ESTKH+3,X
LDA ESTKL+8,X ; X COORD
STA ESTKL+2,X
LDA ESTKL+7,X ; Y COORD
STA ESTKL+1,X
LDA ESTKL+4,X ; TILE
STA ESTKL,X
LDA ESTKH+4,X ; TILE
STA ESTKH,X
end
asm _dgrTileTile
JSR $5000
LDA ESTKL+4,X ; UPDATE X COORD
CLC
ADC #$08
CMP #80 ; OFF RIGHT SIDE
BPL +
STA ESTKL+4,X
DEC ESTKL+1,X ; DEC STRLEN
BNE -
+ TXA
CLC
ADC #6
TAX
RTS
JSR $5000
LDA ESTKL+4,X ; UPDATE X COORD
CLC
ADC #$08
CMP #80 ; OFF RIGHT SIDE
BPL +
STA ESTKL+4,X
DEC ESTKL+1,X ; DEC STRLEN
BNE -
+ TXA
CLC
ADC #6
TAX
RTS
end
//
// Draw a string of tiles
// Fill a buffer with tiles
//
export asm dgrFill(buff, x, y, tile)#0
LDA ESTKL+2,X
AND #$0F
STA ESTKL+2,X
LDA ESTKL+1,X
AND #$0F
STA ESTKL+1,X
LDA #$00
SEC
SBC ESTKL+2,X ; ORIGINAL X
STA ESTKL+2,X
STA ESTKH+2,X
LDA #$00
SEC
SBC ESTKL+1,X
STA ESTKL+1,X
- DEX
DEX
DEX
DEX
LDA ESTKL+7,X ; BUFF
STA ESTKL+3,X
LDA ESTKH+7,X
STA ESTKH+3,X
LDA ESTKL+6,X ; X COORD
STA ESTKL+2,X
LDA ESTKL+5,X ; Y COORD
STA ESTKL+1,X
LDA ESTKL+4,X ; TILE
STA ESTKL,X
LDA ESTKH+4,X ; TILE
STA ESTKH,X
LDA ESTKL+2,X
AND #$0F
STA ESTKL+2,X
LDA ESTKL+1,X
AND #$0F
STA ESTKL+1,X
LDA #$00
SEC
SBC ESTKL+2,X ; ORIGINAL X
STA ESTKL+2,X
STA ESTKH+2,X
LDA #$00
SEC
SBC ESTKL+1,X
STA ESTKL+1,X
- DEX
DEX
DEX
DEX
LDA ESTKL+7,X ; BUFF
STA ESTKL+3,X
LDA ESTKH+7,X
STA ESTKH+3,X
LDA ESTKL+6,X ; X COORD
STA ESTKL+2,X
LDA ESTKL+5,X ; Y COORD
STA ESTKL+1,X
LDA ESTKL+4,X ; TILE
STA ESTKL,X
LDA ESTKH+4,X ; TILE
STA ESTKH,X
end
asm _dgrFillTile
JSR $5000
LDA ESTKL+2,X ; UPDATE X COORD
CLC
ADC #$08
STA ESTKL+2,X
CMP #80 ; OFF RIGHT SIDE?
BMI -
LDA ESTKH+2,X ; RESTORE X COORD
STA ESTKL+2,X
LDA ESTKL+1,X ; UPDATE Y COORD
CLC
ADC #$08
STA ESTKL+1,X
CMP #48 ; OFF BOTTOM?
BMI -
INX
INX
INX
INX
RTS
JSR $5000
LDA ESTKL+2,X ; UPDATE X COORD
CLC
ADC #$08
STA ESTKL+2,X
CMP #80 ; OFF RIGHT SIDE?
BMI -
LDA ESTKH+2,X ; RESTORE X COORD
STA ESTKL+2,X
LDA ESTKL+1,X ; UPDATE Y COORD
CLC
ADC #$08
STA ESTKL+1,X
CMP #48 ; OFF BOTTOM?
BMI -
INX
INX
INX
INX
RTS
end
//
// Wait for VLB
// Wait for VLB - Doens't work on //c
//
asm vlbWait#0
- LDA $C019
BMI -
- LDA $C019
BPL -
RTS
- LDA $C019
BMI -
- LDA $C019
BPL -
RTS
end
//
// Set double lores graphics, return draw buffer
@ -529,7 +538,7 @@ export def txtMode#0
^ena80 = 0
^show40 = 0
^mapmain = 0
^an3on
^an3off
call($FC58, 0, 0, 0, 0) // home()
end
//
@ -645,7 +654,7 @@ end
// Make sure we are a 128K //e or //c
//
if MACHID & $F0 <> $B0
puts("\n128K REQUIRED FOR DOUBLE LO-RES.")
puts("\n128K required for double-lores.\n")
^$C010
while ^$C000 < 128; loop
return -1

40
src/libsrc/dhcp.pla
View File

@ -87,22 +87,14 @@ byte[] endDHCP
//
// DEBUG
//
//byte boundstr = "Apple II bound to:\n"
//byte dnsstr = "DNS: "
//def putb(hexb)
// return call($FDDA, hexb, 0, 0, 0)
//end
//def puth(hex)
// return call($F941, hex >> 8, hex, 0, 0)
//end
//def putip(ipptr)
// byte i
//
// for i = 0 to 2
// puti(ipptr->[i]); putc('.')
// next
// puti(ipptr->[i])
//end
def putip(ipptr)#0
byte i
for i = 0 to 2
puti(ipptr->[i]); putc('.')
next
puti(ipptr->[i])
end
//def dumpbytes(buf, len)
// word i
//
@ -132,13 +124,13 @@ def parseopts(opts, match)
i = 0
while opts->[i] <> $FF and i < 64
while !opts->[i] and i < 64
i = i + 1
loop
while !opts->[i] and i < 64
i++
loop
if opts->[i] == match
return i
fin
i = i + opts->[i + 1] + 2
return i
fin
i = i + opts->[i + 1] + 2
loop
return -1
end
@ -224,7 +216,7 @@ repeat
until retry > 4 or optsOP.2 == DHCP_ACK
iNet:closeUDP(portDHCP)
iNet:setInterfaceIP(@localip, @localnet, @localgw)
//puts(@boundstr);putip(@localip);putc('/');putip(@localnet);putln
puts("Apple II bound to:\n");putip(@localip);putc('/');putip(@localnet);putln
iNet:setDNS(@localdns)
//puts(@dnsstr);putip(@localdns);putln
//puts("DNS: ");putip(@localdns);putln
done

20
src/libsrc/etherip.pla
View File

@ -198,15 +198,15 @@ asm sum1(prevsum, buf, len)
STA ESTKL,X
BEQ +
!BYTE $A9
- CLC
- CLC
INC ESTKH,X
+ BCS -
+ BCS -
CHKLP LDA (SRC),Y
PHA
INY
BNE +
INC SRCH
+ LDA (SRC),Y
+ LDA (SRC),Y
ADC ESTKH+2,X
STA ESTKH+2,X
PLA
@ -215,7 +215,7 @@ CHKLP LDA (SRC),Y
INY
BNE +
INC SRCH
+ DEC ESTKL,X
+ DEC ESTKL,X
BNE CHKLP
DEC ESTKH,X
BNE CHKLP
@ -224,7 +224,7 @@ CHKLP LDA (SRC),Y
BNE +
INC ESTKL+2,X
BEQ -
+ INX
+ INX
INX
RTS
end
@ -255,10 +255,10 @@ def etherSendIP(ipdst, proto, seglist, size)
memcpy(@hdr.ip_dst, ipdst, IP4ADR_SIZE)
retry = 0
while hdr:ip_dst:0 <> remoteip:0 and hdr:ip_dst:2 <> remoteip:2
if retry >= 3
if retry >= 3
return -1 // ARP failed
fin
retry = retry + 1
retry++
memset(@dstMAC, MAC_BROADCAST, MAC_SIZE)
memset(@remoteha, 0, MAC_SIZE)
memcpy(@remoteip, @hdr.ip_dst, IP4ADR_SIZE)
@ -560,13 +560,13 @@ end
//
// Initialize the driver interface
//
export def setEtherDriver(MAC, getlen, readframe, setlen, writeframe)#0
export def setEtherDriver(MAC, getlen, readfrm, setlen, writefrm)#0
memcpy(@myMAC, MAC, MAC_SIZE)
memcpy(@localha, MAC, MAC_SIZE)
getFrameLen = getlen
readFrame = readframe
readFrame = readfrm
setFrameLen = setlen
writeFrame = writeframe
writeFrame = writefrm
end
//
// Set the local IP addresses

47
src/libsrc/fiber.pla
View File

@ -23,13 +23,14 @@ byte fbrRunning = 0
// Zero Page VM state and 6502 stack
//
struc t_vm
byte estklo[$10]
byte estkhi[$10]
byte esp
byte estklo[$10]
word ifp
word pp
byte hwsp
byte fill[9]
byte esp
byte jmptmp
byte fill[8]
byte dropop
byte nextop[$10]
byte hwstk[$C0]
@ -199,9 +200,10 @@ export def fbrStart(defaddr, param)
// Initialize stack to point to fiber def and fbrExit
// This allows a fiber to return and it will fall into fbrExit
//
vmstate->hwsp = $FB
vmstate=>$FE = @fbrExit - 1
vmstate=>$FC = defaddr - 1
vmstate->jmptmp = $4C
vmstate->hwsp = $FB
vmstate=>$FE = @fbrExit - 1
vmstate=>$FC = defaddr - 1
//
// Link into RUN list
//
@ -268,36 +270,3 @@ export def fbrResume(fid)#0
fin
end
done
//
// Test Fiber library
//
def puth(h)#0
word valstr
valstr = "0123456789ABCDEF"
valstr++
putc('$')
putc(valstr->[(h >> 12) & $0F])
putc(valstr->[(h >> 8) & $0F])
putc(valstr->[(h >> 4) & $0F])
putc(valstr->[ h & $0F])
end
def fbrTest(fid, param)#0
byte i
for i = 1 to param
puth(fid); putc($0D)
fbrYield
next
end
//puts("fbrSwap = "); puth(@fbrSwap); putln
fbrInit(4)
fbrStart(@fbrTest, 3)
fbrStart(@fbrTest, 2)
fbrStart(@fbrTest, 1)
fbrYield; fbrYield; fbrYield; fbrYield
done

4
src/libsrc/inet.pla
View File

@ -211,7 +211,7 @@ def iNetInit
//
while ^driver
//puts(driver);putln
if modexec(driver) >= 0
if cmdsys:modexec(driver) >= 0
break
fin
driver = driver + ^driver + 1
@ -222,7 +222,7 @@ def iNetInit
//
// Get an IP address
//
modexec("DHCP")
cmdsys:modexec("DHCP")
iNet:resolveIP = @iNetResolve
return @iNet
end

2
src/libsrc/portio.pla
View File

@ -25,7 +25,7 @@ export def portRead
return (^FLAG0>>7)&1|(^FLAG1>>6)&2|(^FLAG2>>5)&4|(^FLAG3>>4)&8
end
def digitalWrite(pin, val)#0
export def digitalWrite(pin, val)#0
ANN0[((pin&3)<<1)+(val&1)]
end

12
src/libsrc/sane.pla
View File

@ -565,13 +565,14 @@ asm auxmove(dst, src, len)#0
CLC
BEQ +
SEC
+ LDA ESTKH,X
ADC #$00
STA $02FF
+ LDA #$00
TAY
ADC ESTKH,X
INX
INX
INX
STX ESP
TAX
PHP
SEI
STA $C009 ; SELECT ALTZP
@ -585,7 +586,6 @@ asm auxmove(dst, src, len)#0
STA $3C
LDA $02FD
STA $3D
LDY #$00
- LDA ($3C),Y
STA ($42),Y
INY
@ -594,7 +594,7 @@ asm auxmove(dst, src, len)#0
INC $43
+ DEC $02FE
BNE -
DEC $02FF
DEX
BNE -
STA $C008 ; SELECT MAINZP
PLP
@ -728,7 +728,7 @@ def loadcode(codefile)
byte ref
word pcode, seglen
byte filepath[64]
//puts(codefile); puts(":\n")
pcode = 0
ref = fileio:open(strcat(strcpy(@filepath, cmdsys:syspath), codefile))

839
src/libsrc/sndseq.pla Executable file
View File

@ -0,0 +1,839 @@
include "inc/cmdsys.plh"
include "inc/fileio.plh"
include "inc/args.plh"
//
// Usage is documented following the source in this file...
//
const rndseed = $004E
const LSB = 0
const MSB = 1
const MB_ARPEGGIO = 4 // In 16ths of a second
const MAX_MBCH_NOTES = 9
const SPKR_ARPEGGIO = 2 // In 16ths of a second
const DUR16TH = 8
const MAX_SPKR_NOTES = 4
const NOTEDIV = 4
//
// 6522 VIA registers
//
struc t_VIA
byte IORB // I/O Register B
byte IORA // I/O Register A
byte DDRB // Data Direction Register B
byte DDRA // Data Direction Register A
word T1C // Timer 1 Count
word T1L // Timer 1 Latch
word T2C // Timer 2 Count
byte SR // Shift Register
byte ACR // Aux Control Register
byte PCR // Peripheral Control Register
byte IFR // Interrupt Flag Register
byte IER // Interrupt Enable Register
byte IOA_noHS // I/O Register A - no HandShake
end
const T1CH = T1C+1
//
// AY-3-8910 PSG registers
//
struc t_PSG
word AFREQ // A Frequency Period
word BFREQ // B Frequency Period
word CFREQ // C Frequency Period
byte NGFREQ // Noise Generator Frequency Period
byte MIXER // Enable=0/Disable=1 NG C(5) B(4) A(3) Tone C(2) B(1) A(0)
byte AENVAMP // A Envelope/Amplitude
byte BENVAMP // B Envelope/Amplitude
byte CENVAMP // C Envelope/Amplitude
word ENVPERIOD // Envelope Period
byte ENVSHAPE // Envelope Shape
end
//
// Sequence event
//
struc t_event
byte deltatime // Event delta time in 4.4 seconds
byte percnote // Percussion:7==0 ? Pitch:4-0 : Octave:6-4,Note:3-0
byte perchanvol // Percussion ? EnvDur:7-0 : Channel:7,Volume:3-0
end
//
// Predef routines
//
predef musicPlay(track, rept)#0
predef musicStop#0
//
// Static sequencer values
//
export word musicSequence
word seqTrack, seqEvent, seqTime, eventTime, updateTime
byte numNotes, seqRepeat
byte indexA[2], indexB[2], indexC[2]
byte noteA[2], noteB[2], noteC[2]
word notes1[MAX_MBCH_NOTES], notes2[MAX_MBCH_NOTES]
word notes[2] = @notes1, @notes2
word periods1[MAX_MBCH_NOTES], periods2[MAX_MBCH_NOTES]
word periods[2] = @periods1, @periods2
//
// MockingBoard data.
//
word[] mbVIAs // Treat this as an array of VIA ptrs
word mbVIA1 = -1 // Init to "discover MockingBoard flag" value
word mbVIA2 = 0
//
// Octave basis frequency periods (starting at MIDI note #12)
// Notes will be encoded as basis note (LSNibble) and octave (MSNibble))
//
word[] spkrOctave0 // Overlay and scale mbOctave0 for speaker version
word[12] mbOctave0 = 3900, 3681, 3474, 3279, 3095, 2922, 2758, 2603, 2457, 2319, 2189, 2066
word[5] arpeggioDuration = DUR16TH, DUR16TH, DUR16TH/2, DUR16TH/3, DUR16TH/4
//
// Emulators are broken - they only activate the MockingBoard's 6522 Timer1
// functionality when interrupts are enabled. This music sequencer is run
// in polling mode without the use of MockingBoard interrupts. To work around
// the emulators, MockingBoard interrupts are enabled, but the 6502 IRQs are
// disabled. NO INTERRUPTS ARE HANDLED WHEN PLAYING MUSIC! The previous state
// is restored between playing sequences.
//
asm vmincs
!SOURCE "vmsrc/plvmzp.inc"
end
asm getStatusReg#1
PHP
PLA
DEX
STA ESTKL,X
LDA #$00
STA ESTKH,X
RTS
end
asm setStatusReg(stat)#0
LDA ESTKL,X
INX
PHA
PLP
RTS
end
asm disableInts#0
SEI
RTS
end
asm enableInts#0
CLI
RTS
end
//
// Write Programmable Sound Generator Registers
//
asm psgWriteTone(pVIA, reg, freq, vol)#0
LDA ESTKL+3,X
STA TMPL
LDA ESTKH+3,X
STA TMPH
LDY #$01
LDA ESTKL+2,X
LSR
ADC #$08
STA (TMP),Y
DEY
LDA #$07
STA (TMP),Y
LDA #$04
STA (TMP),Y
LDA ESTKL,X
INY
STA (TMP),Y
DEY
LDA #$06
STA (TMP),Y
LDA #$04
STA (TMP),Y
INX
BNE +
end
asm psgWriteWord(pVIA, reg, val)#0
LDA ESTKL+2,X
STA TMPL
LDA ESTKH+2,X
STA TMPH
+ LDY #$01
TYA
CLC
ADC ESTKL+1,X
STA (TMP),Y
DEY
LDA #$07
STA (TMP),Y
LDA #$04
STA (TMP),Y
LDA ESTKH,X
INY
STA (TMP),Y
DEY
LDA #$06
STA (TMP),Y
LDA #$04
STA (TMP),Y
BNE +
end
asm psgWrite(pVIA, reg, val)#0
LDA ESTKL+2,X
STA TMPL
LDA ESTKH+2,X
STA TMPH
+ LDY #$01
LDA ESTKL+1,X
STA (TMP),Y
DEY
LDA #$07
STA (TMP),Y
LDA #$04
STA (TMP),Y
LDA ESTKL,X
INY
STA (TMP),Y
DEY
LDA #$06
STA (TMP),Y
LDA #$04
STA (TMP),Y
INX
INX
INX
RTS
end
//
// Apple II speaker tone generator routines
//
export asm spkrTone(pitch, duration)#0
STX ESP
LDY ESTKH,X
LDA ESTKL,X
BEQ +
INY
+ STA DSTL
STY DSTH
LDY ESTKH+1,X
LDA ESTKL+1,X
BEQ +
INY
+ STA TMPL
STY TMPH
TAX
LDA #$FF
PHP
SEI
;
; Total loop count is 32 cycles, regardless of path taken
;
- NOP ; 2
NOP ; 2
BCS + ; 3
;---
;+7 = 12 (from BCS below)
+
-- SEC ; 2
DEX ; 2
BNE ++ ; 2/3
;----
; 6/7
DEY ; 2
BNE +++ ; 2/3
;----
;+4/5 = 10/11
BIT $C030 ; 4
LDX TMPL ; 3
LDY TMPH ; 3
;---
;+10 = 20
TONELP SBC #$01 ; 2
BCS - ; 2/3
;----
; 4/5
DEC DSTL ; 5
BNE -- ; 3
;----
;+8 = 12
DEC DSTH ; This sequence isn't accounted for
BNE -- ; since it is taken only in extreme cases
BEQ TONEXIT
++ NOP ; 2
NOP ; 2
;---
;+4 = 11 (from BNE above)
+++ BIT $C000 ; 4
BMI TONEXIT ; 2
BPL TONELP ; 3
;---
;+9 = 20
TONEXIT PLP
LDX ESP
INX
INX
RTS
end
export asm spkrPWM(sample, speed, len)#0
STX ESP
LDY ESTKH,X
LDA ESTKL,X
BEQ +
INY
+ STY DSTH
STA DSTL
LDA ESTKL+2,X
STA SRCL
LDA ESTKH+2,X
STA SRCH
LDY ESTKL+1,X
INY
STY TMPL
LDY #$00
PHP
SEI
- LDA (SRC),Y
SEC
-- LDX TMPL
--- DEX
BNE ---
SBC #$01
BCS --
BIT $C030
INY
BNE +
INC SRCH
+ DEC DSTL
BNE -
DEC DSTH
BNE -
PLP
LDX ESP
INX
INX
INX
RTS
end
//
// Search slots for MockingBoard
//
def mbTicklePSG(pVIA)
pVIA->IER = $7F // Mask all interrupts
pVIA->ACR = $00 // Stop T1 countdown
pVIA->DDRB = $FF // Output enable port A and B
pVIA->DDRA = $FF
pVIA->IORA = $00 // Reset MockingBoard
if pVIA->IORA == $00
pVIA->IORA = $04 // Inactive MockingBoard control lines
if pVIA->IORA == $04
//
// At least we know we have some sort of R/W in the ROM
// address space. Most likely a MockingBoard or John Bell
// 6522 board. We will assume its a MockingBoard because
// emulators fail the following PSG read test.
//
//psgWriteWord(pVIA, 2, $DA7E)
//if mbReadP(pVIA, 2) == $7E and mbReadP(pVIA, 3) == $0A
return pVIA
//fin
fin
fin
return 0
end
def mbSearch(slot)
if slot
mbVIA1 = mbTicklePSG($C000 + (slot << 8))
if mbVIA1
mbVIA2 = mbTicklePSG(mbVIA1 + $80)
return slot
fin
else
for slot = 1 to 7
if slot == 3 or slot == 6
continue
fin
mbVIA1 = mbTicklePSG($C000 + (slot << 8))
if mbVIA1
mbVIA2 = mbTicklePSG(mbVIA1 + $80)
return slot
fin
next
fin
return 0
end
def psgSetup(pVIA)#0
psgWrite(pVIA, MIXER, $3F) // Turn everything off
psgWrite(pVIA, AENVAMP, $00)
psgWrite(pVIA, BENVAMP, $00)
psgWrite(pVIA, CENVAMP, $10)
psgWrite(pVIA, NGFREQ, $01)
psgWriteWord(pVIA, ENVPERIOD, $0001)
psgWrite(pVIA, ENVSHAPE, $00) // Single decay
psgWriteWord(pVIA, AFREQ, $0000) // Fast response to update
psgWriteWord(pVIA, BFREQ, $0000)
psgWriteWord(pVIA, CFREQ, $0000)
psgWrite(pVIA, MIXER, $38) // Tone on C, B, A
end
//
// Sequence notes through MockingBoard
//
def mbSequence(yield, func)#0
word period, n, yieldTime
byte note, volume, channel, i, overflow, status, quit
//
// Reset oscillator table
//
indexA[0] = 0; indexA[1] = 0
indexB[0] = 1; indexB[1] = 1
indexC[0] = 2; indexC[1] = 2
noteA[0] = 0; noteA[1] = 0
noteB[0] = 0; noteB[1] = 0
noteC[0] = 0; noteC[1] = 0
//
// Get the PSGs ready
//
status = getStatusReg
disableInts
mbVIA1->ACR = $40 // Continuous T1 interrupts
mbVIA1=>T1L = $F9C2 // 16 Ints/sec
mbVIA1=>T1C = $F9C2 // 16 Ints/sec
mbVIA1->IFR = $40 // Clear interrupt
mbVIA1->IER = $C0 // Enable Timer1 interrupt
psgSetup(mbVIA1)
if mbVIA2; psgSetup(mbVIA2); fin
overflow = 0
if yield and func
yieldTime = seqTime + yield
else
yieldTime = $7FFF
fin
updateTime = seqTime
quit = FALSE
repeat
while eventTime == seqTime
note = seqEvent->percnote
if note & $80
//
// Note event
//
volume = seqEvent->perchanvol
channel = (volume & mbVIA2.LSB) >> 7 // Clever - mbVIA2.0 will be $80 if it exists
if volume & $0F
//
// Note on
//
for i = 0 to MAX_MBCH_NOTES-1
//
// Look for available slot in active note table
//
if !notes[channel, i].LSB //or notes[channel, i] == note
break
fin
next
//
// Full note table, kick one out
//
if i == MAX_MBCH_NOTES
i = overflow
overflow = (overflow + 1) % MAX_MBCH_NOTES
else
numNotes++
fin
notes[channel, i] = note | (volume << 8)
periods[channel, i] = mbOctave0[note & $0F] >> ((note >> 4) & $07)
else
//
// Note off
//
for i = 0 to MAX_MBCH_NOTES-1
//
// Remove from active note table
//
if notes[channel, i].LSB == note
notes[channel, i] = 0
numNotes--
break
fin
next
fin
updateTime = seqTime
else
//
// Percussion event
//
period = seqEvent->perchanvol
if period
if (period & $80)
psgWrite(mbVIA1, MIXER, $1C) // NG on C, Tone on B, A
psgWrite(mbVIA1, CENVAMP, $10)
psgWrite(mbVIA1, ENVSHAPE, (note >> 4) & $04)
psgWrite(mbVIA1, NGFREQ, (note >> 1) & $1F)
psgWrite(mbVIA1, ENVPERIOD+1, period & $7F)
elsif mbVIA2
psgWrite(mbVIA2, MIXER, $1C) // NG on C, Tone on B, A
psgWrite(mbVIA2, CENVAMP, $10)
psgWrite(mbVIA2, ENVSHAPE, (note >> 4) & $04)
psgWrite(mbVIA2, NGFREQ, (note >> 1) & $1F)
psgWrite(mbVIA2, ENVPERIOD+1, period)
fin
else
if seqRepeat
//
// Reset sequence
//
musicPlay(seqTrack, TRUE)
seqTime = -1 // Offset seqTime++ later
else
musicStop
fin
quit = TRUE // Exit out
break
fin
fin
//
// Next event
//
seqEvent = seqEvent + t_event
eventTime = seqEvent->deltatime + eventTime
loop
if updateTime <= seqTime
//
// Time slice active note tables (arpeggio)
//
for channel = 0 to 1
//
// Multiplex oscillator A
//
i = indexA[channel]
repeat
i = (i + 3) % MAX_MBCH_NOTES
n = notes[channel, i]
if n // Non-zero volume
break
fin
until i == indexA[channel]
if n.LSB <> noteA[channel]
psgWriteTone(mbVIAs[channel], AFREQ, periods[channel, i], n.MSB)
noteA[channel] = n.LSB
indexA[channel] = i
fin
//
// Multiplex oscillator B
//
i = indexB[channel]
repeat
i = (i + 3) % MAX_MBCH_NOTES
n = notes[channel, i]
if n // Non-zero volume
break
fin
until i == indexB[channel]
if n.LSB <> noteB[channel]
psgWriteTone(mbVIAs[channel], BFREQ, periods[channel, i], n.MSB)
noteB[channel] = n.LSB
indexB[channel] = i
fin
//
// Multiplex oscillator C
//
i = indexC[channel]
repeat
i = (i + 3) % MAX_MBCH_NOTES
n = notes[channel, i]
if n // Non-zero volume
break
fin
until i == indexC[channel]
if n.LSB <> noteC[channel]
psgWrite(mbVIAs[channel], MIXER, $38) // Tone on C, B, A
psgWriteTone(mbVIAs[channel], CFREQ, periods[channel, i], n.MSB)
noteC[channel] = n.LSB
indexC[channel] = i
fin
next
updateTime = seqTime + MB_ARPEGGIO - (numNotes >> 2)
fin
//
// Increment time tick
//
seqTime++
while !(mbVIA1->IFR & $40) // Wait for T1 interrupt
if ^$C000 > 127; quit = TRUE; break; fin
*rndseed++
loop
mbVIA1->IFR = $40 // Clear interrupt
if yieldTime <= seqTime; func()#0; yieldTime = seqTime + yield; fin
until quit
psgWrite(mbVIA1, MIXER, $FF) // Turn everything off
psgWrite(mbVIA1, AENVAMP, $00)
psgWrite(mbVIA1, BENVAMP, $00)
psgWrite(mbVIA1, CENVAMP, $00)
if mbVIA2
psgWrite(mbVIA2, MIXER, $FF)
psgWrite(mbVIA2, AENVAMP, $00)
psgWrite(mbVIA2, BENVAMP, $00)
psgWrite(mbVIA2, CENVAMP, $00)
fin
mbVIA1->ACR = $00 // Stop T1 countdown
mbVIA1->IER = $7F // Mask all interrupts
mbVIA1->IFR = $40 // Clear interrupt
setStatusReg(status)
end
//
// Sequence notes through Apple II speaker
//
def spkrSequence(yield, func)#0
word period, duration, yieldTime
byte note, i, n, overflow
//
// Start sequencing
//
overflow = 0
if yield and func
yieldTime = seqTime + yield
else
yieldTime = $7FFF
fin
updateTime = seqTime
repeat
while eventTime == seqTime
note = seqEvent->percnote
if note & $80
//
// Note event
//
if seqEvent->perchanvol & $0F
//
// Note on
//
for i = 0 to MAX_SPKR_NOTES-1
//
// Look for available slot in active note table
//
if !notes1[i] or note == notes1[i]
break
fin
next
if i == MAX_SPKR_NOTES
//
// Full note table, kick one out
//
overflow = (overflow + 1) & (MAX_SPKR_NOTES-1)
i = overflow
elsif !notes1[i]
//
// Add new note
//
numNotes++
fin
notes1[i] = note
periods1[i] = spkrOctave0[note & $0F] >> ((note >> 4) & $07)
else
//
// Note off
//
for i = 0 to MAX_SPKR_NOTES-1
//
// Remove from active note table
//
if notes1[i] == note
notes1[i] = 0
numNotes--
break
fin
next
fin
else
//
// Percussion event
//
if seqEvent->perchanvol
//spkrPWM($D000, 0, 64) // Play some random sample as percussion
else
if seqRepeat
musicPlay(seqTrack, TRUE)
else
musicStop
fin
return
fin
fin
//
// Next event
//
seqEvent = seqEvent + t_event
eventTime = eventTime + seqEvent->deltatime
loop
if numNotes > 1
for i = 0 to MAX_SPKR_NOTES-1
if notes1[i]
spkrTone(periods1[i], arpeggioDuration[numNotes])
fin
*rndseed++
next
seqTime++
else
period = 0
for i = 0 to MAX_SPKR_NOTES-1
if notes1[i]
period = periods1[i]
break;
fin
*rndseed++
next
duration = eventTime - seqTime
seqTime = duration + seqTime
spkrTone(period, DUR16TH * duration)
fin
if ^$C000 > 127; return; fin
if yieldTime <= seqTime; func()#0; yieldTime = seqTime + yield; fin
until FALSE
end
//
// No sequence, just waste time and yield
//
def noSequence(yield, func)#0
//
// Start wasting time
//
if !yield or !func
yield = 0
fin
seqTime = 0
repeat
seqTime++
if seqTime < 0; seqTime = 1; fin // Capture wrap-around
*rndseed++
spkrTone(0, DUR16TH) // Waste 16th of a second playing silence
if ^$C000 > 127; return; fin
if yield == seqTime; func()#0; seqTime = 0; fin
until FALSE
end
//
// Start sequencing music track
//
export def musicPlay(track, rept)#0
byte i
//
// First time search for MockingBoard
//
if mbVIA1 == -1
if !mbSearch(0)
//
// No MockingBoard - scale octave0 for speaker
//
for i = 0 to 11
spkrOctave0[i] = mbOctave0[i]/NOTEDIV
next
fin
fin
//
// Zero out active notes
//
for i = 0 to MAX_MBCH_NOTES-1; notes1[i] = 0; notes2[i] = 0; next
for i = 0 to MAX_MBCH_NOTES-1; periods1[i] = 0; periods2[i] = 0; next
//
// Start sequencing
//
seqRepeat = rept
seqTrack = track
seqEvent = seqTrack
seqTime = 0
eventTime = seqEvent->deltatime
numNotes = 0
//
// Select proper sequencer based on hardware
//
if mbVIA1
musicSequence = @mbSequence
else
musicSequence = @spkrSequence
fin
end
//
// Stop sequencing music track
//
export def musicStop#0
musicSequence = @noSequence
end
//
// Get a keystroke and convert it to upper case
//
export def musicGetKey(backgroundProc)#1
byte key
while ^$C000 < 128
musicSequence($08, backgroundProc)#0 // Call background proc every half second
loop
key = ^$C000 & $7F
^$C010
return key
end
done
////////////////////////////////////////////////////////////////////////////////
There are three main externally callable routines in this module:
musicPlay(trackPtr, trackRepeat)
Start playing a track sequence in the getUpperKey routine
Params:
Pointer to a track sequence created from the cvtmidi.py tool
Repeat flag - TRUE or FALSE.
The first time its is called, it will try and search for a MockingBoard.
However, it is noted that this can cause problems if a Z-80 card is installed.
The scanning routine might cause a hang if it encounters a Z-80 card before
it finds a MockingBoard. In order to make this robust, it might be best to
prompt the user to search for the MockingBoard, enter the actual MockingBoard
slot, or skip the MockingBoard and use the internal speaker.
musicStop()
Stop playing a track sequence in the getUpperKey routine
The getUpperKey routine will call a dummy sequence routine that will
keep the correct timing for any background processing
getKey()
Wait for a keypress and return the character
While waiting for the keypress, the track sequence will be played though
either the MockingBoard (if present) or the internal speaker. Optionally,
a background function can be called periodically based on the sequencer
timing, so its pretty accurate.
The low level internal speaker routines used to generate tones and waveforms
can be called for warnings, sound effects, etc:
spkrTone(period, duration)
Play a tone
Params:
(1020000 / 64 / period) Hz
(duration * 32 * 256 / 1020000) seconds
spkrPWM(samples, speed, len)
Play a Pulse Width Modulated waveform
Params:
Pointer to 8 bit pulse width samples
Speed to play through samples
Length of sample
The main routines for sequencing music are:
mbSequence(yield, func)
spkrSequence(yield, func)
noSequence(yield, func)
All three try and provide more functionality than would be present in
previous music sequencers. The MockingBoard sequencer will attempt to play up
to 9 tones per sound generator (18 if a MockingBoard II is found). Up to
four notes will be played simultaneously on the internal speaker. In order
to play more notes than the hardware normally supports, a technique using
arpeggio (playing multiple notes in a quick sequence rather than concurrently)
pulls off this feat. The sequencers will immediately return if a keypress is
detected. Finally, during the sequencing, a background function can be periodically
called every 'yield' time which has a resolution of a 16th of a second. Pass
in zero for 'yield' and/or 'func' to disable any background calls.

12
src/libsrc/tone.pla
View File

@ -17,15 +17,15 @@ export asm tone2(pitch1, pitch2, duration)#0
INY
+ STA DSTL
STY DSTH
LDY ESTKL+1,X
LDY ESTKL+1,X
STY TMPL
LDA ESTKL+2,X
TAX
CMP TMPL
BNE +
LDX #$00
+ STX TMPH
TAX
LDA #$00
CPX TMPL
BNE +
TAX
+ STX TMPH
PHP
SEI
- CLC

28
src/libsrc/uthernet.pla
View File

@ -6,7 +6,7 @@ include "inc/cmdsys.plh"
// Include dependency on S/W IP stack
//
import etherip
predef setEtherDriver(MAC, getlen, readframe, setlen, writeframe)#0
predef setEtherDriver(MAC, getlen, readfrm, setlen, writefrm)#0
end
//
// Uthernet register offsets
@ -100,9 +100,9 @@ asm pokefrm(buf, len)
STA ESTKL,X
BEQ +
!BYTE $A9
- CLC
- CLC
INC ESTKH,X
+ BCS -
+ BCS -
POKELP LDA (SRC),Y
end
asm _pokefrml
@ -114,8 +114,8 @@ asm _pokefrmh
STA $C000
INY
BNE +
INC SRCH
+ DEC ESTKL,X
INC SRCH
+ DEC ESTKL,X
BNE POKELP
DEC ESTKH,X
BNE POKELP
@ -137,24 +137,24 @@ asm peekfrm(buf, len)
ROR
ADC #$00
STA ESTKL,X
BEQ +
!BYTE $A9
- CLC
INC ESTKH,X
+ BCS -
BEQ +
!BYTE $A9
- CLC
INC ESTKH,X
+ BCS -
end
asm _peekfrml
PEEKLP LDA $C000
PEEKLP LDA $C000
STA (DST),Y
INY
end
asm _peekfrmh
+ LDA $C000
STA (DST),Y
STA (DST),Y
INY
BNE +
INC DSTH
+ DEC ESTKL,X
INC DSTH
+ DEC ESTKL,X
BNE PEEKLP
DEC ESTKH,X
BNE PEEKLP

27
src/makefile
View File

@ -5,7 +5,7 @@ PLVM01 = A1PLASMA\#060280
PLVM02 = PLASMA.SYSTEM\#FF2000
PLVM802 = PLASMA16.SYSTEM\#FF2000
PLVM03 = SOS.INTERP\#050000
CMD = CMD\#FF2000
CMD = CMD\#061000
ED = ED\#FE1000
SB = SB\#FF2000
ROD = ROD\#FE1000
@ -23,6 +23,8 @@ CONIO = CONIO\#FE1000
SANE = SANE\#FE1000
FPSTR = FPSTR\#FE1000
FPU = FPU\#FE1000
SNDSEQ = SNDSEQ\#FE1000
PLAYSEQ = PLAYSEQ\#FE1000
SANITY = SANITY\#FE1000
RPNCALC = RPNCALC\#FE1000
WIZNET = WIZNET\#FE1000
@ -41,14 +43,13 @@ ROGUEMAP= ROGUEMAP\#FE1000
ROGUECOMBAT= ROGUECOMBAT\#FE1000
HELLO = HELLO\#FE1000
MON = MON\#FE1000
HGR1 = HGR1\#FE1000
HGR1TEST= HGR1TEST\#FE1000
DGRTEST = DGRTEST\#FE1000
TEST = TEST\#FE1000
TESTLIB = TESTLIB\#FE1000
PROFILE = PROFILE\#FE1000
MEMMGR = MEMMGR\#FE1000
MEMTEST = MEMTEST\#FE1000
FIBERTEST = FIBERTEST\#FE1000
FIBER = FIBER\#FE1000
LONGJMP = LONGJMP\#FE1000
PLASM = plasm
@ -72,7 +73,7 @@ TXTTYPE = .TXT
#SYSTYPE = \#FF2000
#TXTTYPE = \#040000
all: $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVM802) $(PLVM03) $(CMD) $(PLASMAPLASM) $(CODEOPT) $(ARGS) $(MEMMGR) $(MEMTEST) $(FIBER) $(LONGJMP) $(ED) $(MON) $(ROD) $(SIEVE) $(UTHERNET2) $(UTHERNET) $(ETHERIP) $(INET) $(DHCP) $(HTTPD) $(ROGUE) $(ROGUEMAP) $(ROGUECOMBAT) $(ROGUEIO) $(HGR1) $(TONE) $(DGR) $(DGRTEST) $(FILEIO) $(CONIO) $(PORTIO) $(SPIPORT) $(SDFAT) $(FATCAT) $(FATGET) $(FATPUT) $(FATWDSK) $(FATRDSK) $(SANE) $(FPSTR) $(FPU) $(SANITY) $(RPNCALC)
all: $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVM802) $(PLVM03) $(CMD) $(PLASMAPLASM) $(CODEOPT) $(ARGS) $(MEMMGR) $(MEMTEST) $(FIBER) $(FIBERTEST) $(LONGJMP) $(ED) $(MON) $(ROD) $(SIEVE) $(UTHERNET2) $(UTHERNET) $(ETHERIP) $(INET) $(DHCP) $(HTTPD) $(ROGUE) $(ROGUEMAP) $(ROGUECOMBAT) $(ROGUEIO) $(TONE) $(DGR) $(DGRTEST) $(FILEIO) $(CONIO) $(PORTIO) $(SPIPORT) $(SDFAT) $(FATCAT) $(FATGET) $(FATPUT) $(FATWDSK) $(FATRDSK) $(SANE) $(FPSTR) $(FPU) $(SANITY) $(RPNCALC) $(SNDSEQ) $(PLAYSEQ)
clean:
-rm *FE1000 *FF2000 $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVM03)
@ -156,6 +157,18 @@ $(FIBER): libsrc/fiber.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/fiber.pla > libsrc/fiber.a
acme --setpc 4094 -o $(FIBER) libsrc/fiber.a
$(FIBERTEST): samplesrc/fibertest.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < samplesrc/fibertest.pla > samplesrc/fibertest.a
acme --setpc 4094 -o $(FIBERTEST) samplesrc/fibertest.a
$(SNDSEQ): libsrc/sndseq.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/sndseq.pla > libsrc/sndseq.a
acme --setpc 4094 -o $(SNDSEQ) libsrc/sndseq.a
$(PLAYSEQ): samplesrc/playseq.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < samplesrc/playseq.pla > samplesrc/playseq.a
acme --setpc 4094 -o $(PLAYSEQ) samplesrc/playseq.a
$(LONGJMP): libsrc/longjmp.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/longjmp.pla > libsrc/longjmp.a
acme --setpc 4094 -o $(LONGJMP) libsrc/longjmp.a
@ -284,12 +297,6 @@ $(ROGUEMAP): samplesrc/rogue.map.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < samplesrc/rogue.map.pla > samplesrc/rogue.map.a
acme --setpc 4094 -o $(ROGUEMAP) samplesrc/rogue.map.a
$(HGR1): samplesrc/hgr1.pla samplesrc/hgr1test.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < samplesrc/hgr1test.pla > samplesrc/hgr1test.a
acme --setpc 4094 -o $(HGR1TEST) samplesrc/hgr1test.a
./$(PLASM) -AMOW < samplesrc/hgr1.pla > samplesrc/hgr1.a
acme --setpc 4094 -o $(HGR1) samplesrc/hgr1.a
hello: samplesrc/hello.pla $(PLVM) $(PLASM)
./$(PLASM) -AMOW < samplesrc/hello.pla > samplesrc/hello.a
acme --setpc 4094 -o $(HELLO) samplesrc/hello.a

95
src/mkrel Executable file
View File

@ -0,0 +1,95 @@
cp CMD#061000 prodos/CMD.BIN
cp PLASMA.SYSTEM#FF2000 prodos/PLASMA.SYSTEM.SYS
cp PLASMA16.SYSTEM#FF2000 prodos/PLASMA16.SYSTEM.SYS
rm -rf prodos/sys
mkdir prodos/sys
cp ARGS#FE1000 prodos/sys/ARGS.REL
cp CONIO#FE1000 prodos/sys/CONIO.REL
cp DGR#FE1000 prodos/sys/DGR.REL
cp DHCP#FE1000 prodos/sys/DHCP.REL
cp ED#FE1000 prodos/sys/ED.REL
cp ETHERIP#FE1000 prodos/sys/ETHERIP.REL
cp FIBER#FE1000 prodos/sys/FIBER.REL
cp FILEIO#FE1000 prodos/sys/FILEIO.REL
cp FPSTR#FE1000 prodos/sys/FPSTR.REL
cp FPU#FE1000 prodos/sys/FPU.REL
cp INET#FE1000 prodos/sys/INET.REL
cp LONGJMP#FE1000 prodos/sys/LONGJMP.REL
cp MEMMGR#FE1000 prodos/sys/MEMMGR.REL
cp PORTIO#FE1000 prodos/sys/PORTIO.REL
cp SANE#FE1000 prodos/sys/SANE.REL
cp SDFAT#FE1000 prodos/sys/SDFAT.REL
cp SPIPORT#FE1000 prodos/sys/SPIPORT.REL
cp SNDSEQ#FE1000 prodos/sys/SNDSEQ.REL
cp UTHERNET#FE1000 prodos/sys/UTHERNET.REL
cp UTHERNET2#FE1000 prodos/sys/UTHERNET2.REL
cp ../sysfiles/FP6502.CODE#060000 prodos/sys/FP6502.CODE.BIN
cp ../sysfiles/ELEMS.CODE#060000 prodos/sys/ELEMS.CODE.BIN
rm -rf prodos/demos
mkdir prodos/demos
cp DGRTEST#FE1000 prodos/demos/DGRTEST.REL
cp RPNCALC#FE1000 prodos/demos/RPNCALC.REL
cp ROD#FE1000 prodos/demos/ROD.REL
mkdir prodos/demos/rogue
cp ROGUE#FE1000 prodos/demos/rogue/ROGUE.REL
cp ROGUECOMBAT#FE1000 prodos/demos/rogue/ROGUECOMBAT.REL
cp ROGUEIO#FE1000 prodos/demos/rogue/ROGUEIO.REL
cp ROGUEMAP#FE1000 prodos/demos/rogue/ROGUEMAP.REL
cp samplesrc/LEVEL0#040000 prodos/demos/rogue/LEVEL0.TXT
cp samplesrc/LEVEL1#040000 prodos/demos/rogue/LEVEL1.TXT
mkdir prodos/demos/sdutils
cp FATCAT#FE1000 prodos/demos/sdutils/FATCAT.REL
cp FATGET#FE1000 prodos/demos/sdutils/FATGET.REL
cp FATPUT#FE1000 prodos/demos/sdutils/FATPUT.REL
cp FATREADDSK#FE1000 prodos/demos/sdutils/FATREADDSK.REL
cp FATWRITEDSK#FE1000 prodos/demos/sdutils/FATWRITEDSK.REL
mkdir prodos/demos/net
cp HTTPD#FE1000 prodos/demos/net/HTTPD.REL
cp samplesrc/index.html prodos/demos/net/INDEX.HTML.TXT
mkdir prodos/demos/music
cp PLAYSEQ#FE1000 prodos/demos/music/PLAYSEQ.REL
cp mockingboard/ultima3.seq prodos/demos/music/ULTIMA3.SEQ.BIN
cp mockingboard/startrek.seq prodos/demos/music/STARTREK.SEQ.BIN
rm -rf prodos/bld
mkdir prodos/bld
cp PLASM#FE1000 prodos/bld/PLASM.REL
cp CODEOPT#FE1000 prodos/bld/CODEOPT.REL
cp samplesrc/dgrtest.pla prodos/bld/DGRTEST.PLA.TXT
cp samplesrc/hello.pla prodos/bld/HELLO.PLA.TXT
cp samplesrc/hgr1test.pla prodos/bld/HGR1TEST.PLA.TXT
cp samplesrc/fibertest.pla prodos/bld/FIBERTEST.PLA.TXT
cp samplesrc/mon.pla prodos/bld/MON.PLA.TXT
cp samplesrc/memtest.pla prodos/bld/MEMTEST.PLA.TXT
cp samplesrc/rod.pla prodos/bld/ROD.PLA.TXT
cp samplesrc/sieve.pla prodos/bld/SIEVE.PLA.TXT
cp samplesrc/test.pla prodos/bld/TEST.PLA.TXT
cp samplesrc/testlib.pla prodos/bld/TESTLIB.PLA.TXT
cp samplesrc/playseq.pla prodos/bld/PLAYSEQ.PLA.TXT
cp samplesrc/rpncalc.pla prodos/bld/RPNCALC.PLA.TXT
mkdir prodos/bld/inc
cp inc/args.plh prodos/bld/inc/ARGS.PLH.TXT
cp inc/cmdsys.plh prodos/bld/inc/CMDSYS.PLH.TXT
cp inc/conio.plh prodos/bld/inc/CONIO.PLH.TXT
cp inc/dgr.plh prodos/bld/inc/DGR.PLH.TXT
cp inc/fiber.plh prodos/bld/inc/FIBER.PLH.TXT
cp inc/fileio.plh prodos/bld/inc/FILEIO.PLH.TXT
cp inc/fpstr.plh prodos/bld/inc/FPSTR.PLH.TXT
cp inc/fpu.plh prodos/bld/inc/FPU.PLH.TXT
cp inc/inet.plh prodos/bld/inc/INET.PLH.TXT
cp inc/longjmp.plh prodos/bld/inc/LONGJMP.PLH.TXT
cp inc/memmgr.plh prodos/bld/inc/MEMMGR.PLH.TXT
cp inc/sane.plh prodos/bld/inc/SANE.PLH.TXT
cp inc/portio.plh prodos/bld/inc/PORTIO.PLH.TXT
cp inc/sdfat.plh prodos/bld/inc/SDFAT.PLH.TXT
cp inc/sndseq.plh prodos/bld/inc/SNDSEQ.PLH.TXT
cp inc/spiport.plh prodos/bld/inc/SPIPORT.PLH.TXT
cp inc/testlib.plh prodos/bld/inc/TESTLIB.PLH.TXT
cp vmsrc/plvmzp.inc prodos/bld/inc/PLVMZP.INC.TXT

BIN
src/mockingboard/startrek.seq Normal file
View File

Binary file not shown.

BIN
src/mockingboard/ultima3.seq Executable file → Normal file
View File

Binary file not shown.

24
src/samplesrc/fibertest.pla Normal file
View File

@ -0,0 +1,24 @@
//
// Test Fiber library
//
include "inc/cmdsys.plh"
include "inc/fiber.plh"
def fbrTest(fid, param)#0
byte i
for i = 1 to param
puti(fid); putln
fbrYield
next
end
//puts("fbrSwap = "); puth(@fbrSwap); putln
fbrInit(4)
fbrStart(@fbrTest, 3)
fbrStart(@fbrTest, 2)
fbrStart(@fbrTest, 1)
fbrYield; fbrYield; fbrYield; fbrYield
done

10
src/samplesrc/hgr1.pla
View File

@ -1,10 +0,0 @@
include "inc/cmdsys.plh"
sysflags reshgr1 // Reserve HGR page 1
memset($2000, 0, $2000) // Clear HGR page 1
^$C054
^$C052
^$C057
^$C050
done

109
src/samplesrc/hgr1test.pla
View File

@ -1,27 +1,24 @@
include "inc/cmdsys.plh"
import HGR1
end
sysflags reshgr1 // Reserve HGR page 1
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
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
@ -48,75 +45,11 @@ 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
word testval
//
// def draw_scan(d8p8, scanptr)
//
asm draw_scan(d8p8, scanptr)#0
!SOURCE "vmsrc/plvmzp.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 +
SEC
ROL PIX
INY
CPY #36
BEQ ++
+ LDA ESTKL+1,X
ADC WFIXL
STA WFIXL
LDA ESTKH+1,X
ADC WFIXH
STA WFIXH
BCC -
INC WINT
BCS -
++ INX
INX
RTS
end
def draw_ground(page)#0
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)
memset(hgr1, 0, $2000) // Clear HGR page 1
^showpage1
^showfull
^showhires
^showgraphics
getc
^showpage1
^showtext

9
src/samplesrc/httpd.pla
View File

@ -40,12 +40,6 @@ byte mimeOctetStream = "application/octet-stream"
//
// DEBUG
//
def putb(hexb)#0
call($FDDA, hexb, 0, 0, 0)
end
def puth(hex)#0
call($F941, hex >> 8, hex, 0, 0)
end
def putip(ipptr)#0
byte i
@ -203,12 +197,11 @@ if !iNet:initIP()
return -1
fin
puts(@hello)
getpfx(@prefix)
fileio:getpfx(@prefix)
//
// Alloc aligned file/io buffers
//
filebuff = heapallocalign(1024, 8, 0)
//iobuff = heapallocalign(1024, 8, 0)
//
// Service IP
//

5
src/samplesrc/index.html Executable file
View File

@ -0,0 +1,5 @@
<html>
<body>
Hello from the Apple II!
</body>
</html>

32
src/samplesrc/playseq.pla Normal file
View File

@ -0,0 +1,32 @@
include "inc/cmdsys.plh"
include "inc/args.plh"
include "inc/fileio.plh"
include "inc/sndseq.plh"
//
// These are utility sequences/routines needed to test the music sequencer code.
//
word arg
word ref
//
// Sample background process to show it's working
//
def backgroundProc#0
^$0400++
end
arg = argNext(argFirst)
if ^arg
ref = fileio:open(arg)
if ref
fileio:read(ref, heapmark(), heapavail())
fileio:close(ref)
musicPlay(heapmark(), TRUE)
musicGetKey(@backgroundProc)
musicStop
else
puts("File not found.\n")
fin
fin
done

25
src/samplesrc/rogue.combat.pla
View File

@ -1,7 +1,8 @@
include "inc/cmdsys.plh"
include "inc/conio.plh"
import rogueio
word rnd, getkb, home, gotoxy, tone
word rnd, getkb, tone
end
import roguemap
predef moveplayer
@ -138,28 +139,28 @@ export def fight(player, enemy)
word p_atck, e_atck
repeat
home()
gotoxy(0, 0)
conio:home()
conio:gotoxy(0, 0)
puts(player+name)
gotoxy(1, 2)
conio:gotoxy(1, 2)
puts("Skill :"); puti(player->skill)
gotoxy(1, 3)
conio:gotoxy(1, 3)
puts("Health :"); puti(player->health)
gotoxy(1, 4)
conio:gotoxy(1, 4)
puts("Energy :"); puti(player->energy)
gotoxy(20, 0)
conio:gotoxy(20, 0)
puts(entity[enemy->kind])
gotoxy(21, 2)
conio:gotoxy(21, 2)
puts("Power :"); puti(enemy->power)
gotoxy(21, 3)
conio:gotoxy(21, 3)
puts("Life :"); puti(enemy->life)
for e_atck = 0 to 9
gotoxy(0, 10 + e_atck)
conio:gotoxy(0, 10 + e_atck)
puts(@ascii_warrior + e_atck * 11)
gotoxy(20, 10 + e_atck)
conio:gotoxy(20, 10 + e_atck)
puts(ascii_entity[enemy->kind] + e_atck * 11)
next
gotoxy(12, 8); puts("F)ight or R)un?")
conio:gotoxy(12, 8); puts("F)ight or R)un?")
if toupper(getkb()) == 'R'
return 1
else

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

@ -1,17 +1,15 @@
include "inc/cmdsys.plh"
const modkeep = $2000
const modinitkeep = $4000
include "inc/conio.plh"
byte[] initstr
byte = " ( )\n"
byte = " )\\ ) ( /( (\n"
byte = " (()/( )\\()) )\\ ) ( (\n"
byte = " ( )\n"
byte = " )\\ ) ( /( (\n"
byte = "(()/( )\\()) )\\ ) ( (\n"
byte = " /(_))((_)\\ (()/( )\\ )\\\n"
byte = "(_)) ((_) /(_))_ _ ((_)((_)\n"
byte = "| _ \\ / _ \\(_)) __| | | | || __|\n"
byte = "| / | (_) | || (_ | |_| || _|\n"
byte = "|_|_\\\\___/ \\___| \\___/ |___|\n"
byte = "| _ \\ / _ \\(_)) __|| | | || __|\n"
byte = "| / | (_) | | (_ || |_| || _|\n"
byte = "|_|_\\ \\___/ \\___| \\___/ |___|\n"
byte = "\n"
byte = " By Resman\n"
byte = " Artwork by Seth Sternberger\n"
@ -22,10 +20,7 @@ word titlestr = @initstr
// Machine specific routines
//
export word rnd, getkb, home, gotoxy, tone
export word open, read, close, newline
byte noapple1 = "APPLE 1 NOT SUPPORTED."
export word rnd, getkb, tone
const ENV_REG = $FFDF
@ -35,8 +30,6 @@ const a2rndnum = $4E // ZP location of RND
const a2rndl = $4E
const a2rndh = $4F
word iobuff
word a3rndnum = 12345
def a3rnd
@ -60,7 +53,7 @@ def a2tone(duration, delay)
^SPEAKER
for i = 0 to delay
next
duration = duration - 1
duration--
loop
return 0
end
@ -75,183 +68,41 @@ def a3tone(duration, pitch)
return 0
end
//
// ProDOS file routines
//
def a2open(path, access)
byte params[6]
params.0 = 3
params:1 = path
params:3 = heapallocalign($0400, 8, @iobuff)
params.5 = 0
syscall($C8, @params)
return params.5
end
def a2close(refnum)
byte params[2]
if iobuff
heaprelease(iobuff)
iobuff = 0
fin
params.0 = 1
params.1 = refnum
return syscall($CC, @params)
end
def a2read(refnum, buff, len)
byte params[8]
params.0 = 4
params.1 = refnum
params:2 = buff
params:4 = len
params:6 = 0
syscall($CA, @params)
return params:6
end
def a2newline(refnum, emask, nlchar)
byte params[4]
params.0 = 3
params.1 = refnum
params.2 = emask
params.3 = nlchar
return syscall($C9, @params)
end
//
// SOS file routines
//
def a3open(path, access)
byte params[7]
params.0 = 4
params:1 = path
params.3 = 0
params:4 = @access
params.6 = 1
syscall($C8, @params)
return params.3
end
def a3close(refnum)
byte params[2]
params.0 = 1
params.1 = refnum
return syscall($CC, @params)
end
def a3read(refnum, buff, len)
byte params[8]
params.0 = 4
params.1 = refnum
params:2 = buff
params:4 = len
params:6 = 0
syscall($CA, @params)
return params:6
end
def a3newline(refnum, emask, nlchar)
byte params[4]
params.0 = 3
params.1 = refnum
params.2 = $FF
params.3 = nlchar
return syscall($C9, @params)
end
//
// Apple /// console routines
//
def dev_status(devnum, code, list)
byte params[5]
params.0 = 3
params.1 = devnum
params.2 = code
params:3 = list
return syscall($82, @params)
end
def a3keypressed
byte count
dev_status(cmdsys.devcons, 5, @count)
return count
end
def a3getkb
while not a3keypressed
while not conio:keypressed()
a3rndnum = a3rndnum + 123
loop
return getc()
end
def a3home
putc(28)
return 0
end
def a3gotoxy(ch, cv)
putc(24)
putc(ch)
putc(25)
putc(cv)
return 0
end
//
// Apple ][ console routines
//
def a2home
return call($FC58, 0, 0, 0, 0) // home()
end
def a2gotoxy(x, y)
^$24 = x + ^$20
return call($FB5B, y + ^$22, 0, 0, 0)
end
//
// Set machine specific routines
//
when MACHID & $C8
is $08 // Apple 1
puts(@noapple1)
puts("APPLE 1 NOT SUPPORTED.")
return -1
is $C0 // Apple ///
rnd = @a3rnd
getkb = @a3getkb
home = @a3home
gotoxy = @a3gotoxy
tone = @a3tone
open = @a3open
read = @a3read
close = @a3close
newline = @a3newline
break
otherwise // Apple ][
rnd = @a2rnd
getkb = @a2getkb
home = @a2home
gotoxy = @a2gotoxy
tone = @a2tone
open = @a2open
read = @a2read
close = @a2close
newline = @a2newline
wend
//
// Print title page
//
home()
conio:home()
while ^titlestr
puts(titlestr)
titlestr = titlestr + ^titlestr + 1

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

@ -2,13 +2,15 @@
// Map module
//
include "inc/cmdsys.plh"
include "inc/conio.plh"
include "inc/fileio.plh"
import rogueio
const O_READ = 1
const O_WRITE = 2
const O_READ_WRITE = 3
word rnd, getkb, home, gotoxy, tone, open, read, close, newline
word rnd, getkb, tone
end
//
@ -175,14 +177,14 @@ export def loadmap(level)
// Set level map and read it
//
catacomb[catacomb] = '0' + level
mapref = open(@catacomb, O_READ)
mapref = fileio:open(@catacomb)
if mapref
newline(mapref, $7F, $0D)
fileio:newline(mapref, $7F, $0D)
for row = 1 to maprows - 2
l = read(mapref, map + (row << 6) + 1, mapcols)
l = fileio:read(mapref, map + (row << 6) + 1, mapcols)
^(map + (row << 6) + l) = WALL_TILE
next
close(mapref)
fileio:close(mapref)
return TRUE
fin
return FALSE
@ -260,7 +262,7 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
//
// Clear screen
//
home()
conio:home()
//
// Draw background map if in light
//
@ -302,96 +304,96 @@ export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
occluded = 1
when o & 7
is 0
//
// Run through lit octant beam points
//
//
// Run through lit octant beam points
//
for l = 1 to dbeam[lightdist]
//
// Check parent visiblity
//
//
// Check parent visiblity
//
if vispix[vbeam[l]]
imap = ((yorg - ybeam[l]) << rowshift) + xorg + xbeam[l]
tile = ^(map + imap)
if tile & OPAQUE_TILE
//
// The view stops here
//
//
// The view stops here
//
vispix[l] = 0
else
//
// This tile is transparent
//
//
// This tile is transparent
//
vispix[l] = 1
//
// Check adjacent tile for opaqueness - improves wall display
//
//
// Check adjacent tile for opaqueness - improves wall display
//
adjtile = ^(map + imap + 1) & INV_TILE
if adjtile & OPAQUE_TILE
^(viewmap + imap + 1) = adjtile | VIEWED_TILE
screen.[ycentr-ybeam[l], xcentr+xbeam[l]+1] = adjtile
fin
fin
fin
//
// Update view
//
//
// Update view
//
^(viewmap + imap) = tile | VIEWED_TILE
if tile <> PIT_TILE
if tile <> PIT_TILE
screen.[ycentr-ybeam[l], xcentr+xbeam[l]] = tile & INV_TILE
fin
fin
else
vispix[l] = 0
fin
next
//
// Run through visible octant beam points
//
//
// Run through visible octant beam points
//
for l = l to dbeam[viewdist]
//
// Check parent visiblity
//
//
// Check parent visiblity
//
if vispix[vbeam[l]]
imap = ((yorg - ybeam[l]) << rowshift) + xorg + xbeam[l]
tile = ^(map + imap)
if tile & OPAQUE_TILE
//
// The view stops here
//
//
// The view stops here
//
vispix[l] = 0
else
//
// This tile is transparent
//
//
// This tile is transparent
//
vispix[l] = 1
occluded = 0
occluded = 0
fin
//
// If the tile is in light, update view
//
if tile & LIT_TILE
//
// If the tile is in light, update view
//
if tile & LIT_TILE
^(viewmap + imap) = tile | VIEWED_TILE
screen.[ycentr-ybeam[l], xcentr+xbeam[l]] = tile & INV_TILE
darkness = 0
fin
fin
else
vispix[l] = 0
fin
//
// Advance beam distance
//
if l == dbeam[dist]
if occluded
//
// Beam fully occluded
// Advance beam distance
//
break
fin
//
// Update distance
//
if l == dbeam[dist]
if occluded
//
// Beam fully occluded
//
break
fin
//
// Update distance
//
occluded = 1
dist = dist + 1
fin
next
fin
next
break
is 1
for l = 1 to dbeam[lightdist]

23
src/samplesrc/rogue.pla
View File

@ -1,4 +1,5 @@
include "inc/cmdsys.plh"
include "inc/conio.plh"
import roguemap
const xcentr = 20
@ -41,7 +42,7 @@ import roguecombat
end
import rogueio
word rnd, getkb, home, gotoxy, tone
word rnd, getkb, tone
end
const maxlight = 10
@ -200,24 +201,24 @@ end
//
def status#0
gotoxy(0, statusline)
conio:gotoxy(0, statusline)
puts(@helthstr)
puti(player.health)
gotoxy(9, statusline)
conio:gotoxy(9, statusline)
puts(@enrgystr)
puti(player.energy)
gotoxy(17, statusline)
conio:gotoxy(17, statusline)
puts(@oilstr)
puti(player:oil/10)
gotoxy(25, statusline)
conio:gotoxy(25, statusline)
puts(@goldstr)
puti(player.gold)
if player.raft
gotoxy(32, statusline)
conio:gotoxy(32, statusline)
puts(@raftstr)
fin
if player.key
gotoxy(36, statusline)
conio:gotoxy(36, statusline)
puts(@keystr)
fin
end
@ -461,7 +462,7 @@ def play
if player.health == 0
return FALSE
fin
gotoxy(xcentr, ycentr)
conio:gotoxy(xcentr, ycentr)
when toupper(getkb())
is 'I'
if totaldarkness
@ -598,7 +599,7 @@ def play
break
is 'X'
clearstatus
gotoxy(0, statusline)
conio:gotoxy(0, statusline)
puts(@quitstr)
if toupper(getkb()) == 'Y'
player.health = 0
@ -637,7 +638,7 @@ while loadmap(level)
totaldarkness = drawmap(player.xpos, player.ypos, player.fov, player.angle, player.lamp, maxview)
if not totaldarkness
drawentities
gotoxy(xcentr, ycentr)
conio:gotoxy(xcentr, ycentr)
putc(vplayer[player.angle])
fin
status
@ -647,7 +648,7 @@ while loadmap(level)
player.key = 0
level = level + 1
clearstatus
gotoxy(0, statusline)
conio:gotoxy(0, statusline)
if player.health == 0
break
fin

6
src/toolsrc/codegen.c
View File

@ -17,6 +17,7 @@ static int defs = 0;
static int asmdefs = 0;
static int codetags = 1; // Fix check for break_tag and cont_tag
static int fixups = 0;
static int lastglobalsize = 0;
static char idconst_name[1024][ID_LEN+1];
static int idconst_value[1024];
static char idglobal_name[1024][ID_LEN+1];
@ -465,7 +466,11 @@ void emit_sysflags(int val)
void emit_bytecode_seg(void)
{
if ((outflags & MODULE) && !(outflags & BYTECODE_SEG))
{
if (lastglobalsize == 0) // Pad a byte if last label is at end of data segment
printf("\t%s\t$00\t\t\t; PAD BYTE\n", DB);
printf("_SUBSEG%c\t\t\t\t; BYTECODE STARTS\n", LBL);
}
outflags |= BYTECODE_SEG;
}
void emit_comment(char *s)
@ -482,6 +487,7 @@ void emit_idlocal(char *name, int value)
}
void emit_idglobal(int tag, int size, char *name)
{
lastglobalsize = size;
if (size == 0)
printf("_D%03d%c\t\t\t\t\t; %s\n", tag, LBL, name);
else

6
src/toolsrc/codegen.pla
View File

@ -125,6 +125,11 @@ def emit_data(vartype, consttype, constval, constsize)
fin
return size
end
def emit_codeseg#0
if lastglobalsize == 0
emit_byte($00) // Pad byte between last data tag and code seg
fin
end
def emit_const(cval)#0
emit_pending_seq
if cval == $0000 // ZERO
@ -421,6 +426,7 @@ def new_iddata(nameptr, len, type, size)#0
else
lastglobal=>idval = new_tag(WORD_FIXUP)//datasize
emit_tag(lastglobal=>idval)
lastglobalsize = size
if size
emit_fill(size)
datasize = datasize + size

1
src/toolsrc/parse.pla
View File

@ -1225,6 +1225,7 @@ def parse_module#0
//
while parse_mods; nextln; loop
while parse_vars(GLOBAL_TYPE); nextln; loop
emit_codeseg
while parse_defs; nextln; loop
entrypoint = codeptr
prevstmnt = 0

2
src/toolsrc/plasm.pla
View File

@ -246,7 +246,7 @@ word fixup_tag, fixup_addr
word tag_addr, tag_type
word idglobal_tbl, idlocal_tbl
word pending_seq
word globals, lastglobal, lastlocal, savelast
word globals, lastglobal, lastglobalsize, lastlocal, savelast
word tag_num, fixup_num, globalbufsz, localbufsz, codebufsz
word datasize, framesize, savesize
byte locals, savelocals

3
src/vmsrc/a1cmd.pla
View File

@ -149,8 +149,7 @@ asm call(addr,areg,xreg,yreg,sstatus)#1
STA CALL6502+2
LDA ESTKL,X
PHA
LDA ESTKL+1,X
TAY
LDY ESTKL+1,X
LDA ESTKL+3,X
PHA
LDA ESTKL+2,X

429
src/vmsrc/cmd.pla
View File

@ -22,6 +22,11 @@ const resxhgr2 = $0080
const modkeep = $2000
const modinitkeep = $4000
//
// Prefix commands
//
const GET_PFX = $C7
const SET_PFX = $C6
//
// Pedefined functions.
//
predef syscall(cmd,params)#1, call(addr,areg,xreg,yreg,status)#1
@ -35,46 +40,48 @@ predef execmod(modfile)#1
//
word version = $0100 // 01.00
word syspath
word = getlnbuf
word syscmdln
word = @execmod
word = getlnbuf
//
// Working input buffer overlayed with strings table
//
byte cmdln = ""
//
// Name for auto-run file (must follow cmdln)
//
byte autorun = "AUTORUN"
//
// Standard Library exported functions.
//
byte sysmodstr = "CMDSYS"
byte machidstr = "MACHID"
byte sysstr = "SYSCALL"
byte callstr = "CALL"
byte putsstr = "PUTS"
byte putistr = "PUTI"
byte putcstr = "PUTC"
byte putlnstr = "PUTLN"
byte putsstr = "PUTS"
byte putbstr = "PUTB"
byte putwstr = "PUTH"
byte putistr = "PUTI"
byte getcstr = "GETC"
byte getsstr = "GETS"
byte toupstr = "TOUPPER"
byte strcpystr = "STRCPY"
byte strcatstr = "STRCAT"
byte hpmarkstr = "HEAPMARK"
byte hpalignstr = "HEAPALLOCALIGN"
byte hpallocstr = "HEAPALLOC"
byte hprelstr = "HEAPRELEASE"
byte hpavlstr = "HEAPAVAIL"
byte sysmods[] // overlay with exported strings
word memsetstr = "MEMSET"
byte memcpystr = "MEMCPY"
byte uisgtstr = "ISUGT"
byte uisgestr = "ISUGE"
byte uisltstr = "ISULT"
byte uislestr = "ISULE"
byte sysmods[] // overlay with exported strings
byte strcpystr = "STRCPY"
byte strcatstr = "STRCAT"
byte sextstr = "SEXT"
byte divmodstr = "DIVMOD"
byte autorun = "AUTORUN"
byte machidstr = "MACHID"
byte sysstr = "SYSCALL"
byte callstr = "CALL"
byte prefix[] // overlay with exported symbols table
word exports = @sysmodstr, @version
word = @sysstr, @syscall
@ -121,7 +128,6 @@ word lastsym = symtbl
//
asm saveX#0
STX XREG+1
RTS
end
asm restoreX#0
XREG LDX #$00
@ -141,9 +147,9 @@ asm syscall(cmd,params)#1
JSR $BF00
CMD: !BYTE 00
PARAMS: !WORD 0000
LDY #$00
; LDY #$00
STA ESTKL,X
STY ESTKH,X
; STY ESTKH,X
RTS
end
//
@ -159,8 +165,7 @@ REGVALS = SRC
STA TMPH
LDA ESTKL,X
PHA
LDA ESTKL+1,X
TAY
LDY ESTKL+1,X
LDA ESTKL+3,X
PHA
LDA ESTKL+2,X
@ -188,19 +193,11 @@ REGVALS = SRC
STY ESTKH,X
PLP
RTS
JMPTMP JMP (TMP)
end
//
// CALL LOADED SYSTEM PROGRAM
//
asm exec()#0
LDX #$00
STX IFPL
LDA #$BF
STA IFPH
LDX #$FE
TXS
LDX #ESTKSZ/2
BIT ROMEN
JMP $2000
end
@ -647,11 +644,12 @@ asm lookuptbl(dci, tbl)#1
STA DSTL
LDA ESTKH,X
STA DSTH
LDA ESTKL+1,X
INX
LDA ESTKL,X
STA SRCL
LDA ESTKH+1,X
LDA ESTKH,X
STA SRCH
LDY #$00
-- LDY #$00
- LDA (DST),Y
BEQ +
CMP (SRC),Y
@ -660,29 +658,197 @@ asm lookuptbl(dci, tbl)#1
ASL
BCS -
LDA (DST),Y
PHA
STA ESTKL,X ; MATCH
INY
LDA (DST),Y
TAY
PLA
+ INX
STA ESTKL,X
STY ESTKH,X
STA ESTKH,X
RTS
++ LDY #$00
-- LDA (DST),Y
INC DSTL
BEQ +
--- ASL
BCS --
LDA #$02
+ STA ESTKL,X ; NO MATCH
STA ESTKH,X
RTS
++
- LDA (DST),Y ; NEXT ENTRY
BPL +
INY
BNE -
+ TYA
CLC
ADC #$03
ADC DSTL
STA DSTL
BCC -
BCC --
INC DSTH
BCS -
+ INC DSTH
BNE --
end
// def lookupidx(esd, index)
// word sym
// while ^esd
// sym = esd
// esd = sym + dcitos(sym, @str)
// if esd->0 & $10 and esd->1 == index
// return sym
// fin
// esd = esd + 3
// loop
//end
asm lookupidx(esd, index)#1
LDA ESTKL,X
STA TMPL
INX
--- LDA ESTKH,X
STA SRCH
LDA ESTKL,X
-- STA SRCL
LDY #$00
- LDA (SRC),Y
BPL +
INY
BNE -
+ BEQ ++ ; END OF ESD
INY
LDA (SRC),Y
INY
AND #$10 ; EXTERN FLAG?
BEQ +
LDA (SRC),Y
CMP TMPL
BEQ +++ ; MATCH
+ INY
TYA
SEC
ADC SRCL
STA ESTKL,X ; SYM PTRL
BCC --
INC ESTKH,X ; SYM PTRH
BNE ---
++ STA ESTKL,X ; END OF ESD
STA ESTKH,X
+++ RTS
end
//def lookupdef(addr, deftbl)#1
// while deftbl->0 == $20
// if deftbl=>3 == addr
// return deftbl
// fin
// deftbl = deftbl + 5
// loop
// return 0
//end
asm lookupdef(addr, deftbl)#1
LDA ESTKH,X
STA SRCH
LDA ESTKL,X
STA SRCL
INX
- LDY #$00
LDA (SRC),Y
CMP #$20 ; JSR OPCODE?
BNE ++
LDY #$03
LDA (SRC),Y
CMP ESTKL,X
BNE +
INY
LDA (SRC),Y
CMP ESTKH,X
BNE +
LDA SRCL ; MATCH
STA ESTKL,X
LDA SRCH
STA ESTKH,X
RTS
+ LDA #$05
CLC
ADC SRCL
STA SRCL
BCC -
INC SRCH
BNE -
++ STY ESTKL,X
STY ESTKH,X
RTS
end
//
// Reloc internal data
//
//def reloc(modfix, modofst, bytecode, rld)#3
// word addr, fixup
// while ^rld
// if ^rld & $10 // EXTERN reference.
// return rld, addr, fixup
// fin
// addr = rld=>1 + modfix
// fixup = *addr + modofst
// if uword_isge(fixup, bytecode) // Bytecode address.
// return rld, addr, fixup
// fin
// *addr = fixup
// rld = rld + 4
// loop
// return rld, addr, fixup
//end
asm reloc(modfix, modofst, bytecode, rld)#3
LDA ESTKL,X
STA SRCL
LDA ESTKH,X
STA SRCH
LDY #$00
- LDA (SRC),Y
BEQ RLDEX ; END OF RLD
PHA
INY
LDA (SRC),Y
INY
CLC
ADC ESTKL+3,X ; ADDR=ENTRY=>1+MODFIX
STA DSTL
LDA (SRC),Y
ADC ESTKH+3,X
STA DSTH
PLA
AND #$10 ; EXTERN REF - EXIT
BNE RLDEX
LDY #$00 ; FIXUP=*ADDR+MODOFST
LDA (DST),Y
INY
CLC
ADC ESTKL+2,X
STA TMPL
LDA (DST),Y
ADC ESTKH+2,X
CMP ESTKH+1,X ; FIXUP >= BYTECODE?
BCC +
STA TMPH
BNE RLDEX ; YEP, EXIT
LDA TMPL
CMP ESTKL+1,X
BCS RLDEX ; YEP, EXIT
LDA TMPH
+ STA (DST),Y ; *ADDR=FIXUP
DEY
LDA TMPL
STA (DST),Y
LDA SRCL ; NEXT ENTRY
; CLC
ADC #$04
STA SRCL
BCC -
INC SRCH
BNE -
RLDEX INX
LDA TMPL
STA ESTKL,X
LDA TMPH
STA ESTKH,X
LDA DSTL
STA ESTKL+1,X
LDA DSTH
STA ESTKH+1,X
LDA SRCL
STA ESTKL+2,X
LDA SRCH
STA ESTKH+2,X
RTS
end
//
// Cheap and dirty print integer
@ -695,21 +861,12 @@ end
//
// ProDOS routines
//
def getpfx(path)#1
byte params[3]
^path = 0
params.0 = 1
params:1 = path
perr = syscall($C7, @params)
return path
end
def setpfx(path)#1
def pfxop(path, op)#1
byte params[3]
params.0 = 1
params:1 = path
perr = syscall($C6, @params)
perr = syscall(op, @params)
return path
end
def open(path)#1
@ -775,8 +932,8 @@ def allocalignheap(size, pow2, freeaddr)
*freeaddr = heap
fin
align = (1 << pow2) - 1
addr = (heap | align) + 1
heap = addr + size
addr = (heap | align) + 1
heap = addr + size
if uword_isge(heap, @addr)
return 0
fin
@ -855,44 +1012,28 @@ end
def lookupextern(esd, index)#1
word sym, addr
byte str[16]
while ^esd
sym = esd
esd = sym + dcitos(sym, @str)
if esd->0 & $10 and esd->1 == index
addr = lookuptbl(sym, symtbl)
if !addr
perr = $81
cout('?'); prstr(@str); crout
fin
return addr
sym = lookupidx(esd, index)
if sym
addr = lookuptbl(sym, symtbl)
if !addr
perr = $81
dcitos(sym, @str)
cout('?'); prstr(@str); crout
fin
esd = esd + 3
loop
return addr
fin
return 0
end
def adddef(bank, addr, deflast)#1
word defentry
defentry = *deflast
*deflast = defentry + 5
if bank
defentry=>1 = $03DC // JSR $03DC (AUX MEM INTERP)
else
defentry=>1 = $03D6 // JSR $03D6 (MAIN MEM INTERP)
fin
defentry->0 = $20
defentry=>1 = bank ?? $03DC :: $03D6 // JSR $03DC (AUX MEM INTERP) or $03D6 (MAIN MEM INTERP)
defentry=>3 = addr
defentry->5 = 0 // NULL out next entry
return defentry
end
def lookupdef(addr, deftbl)#1
while deftbl->0 == $20
if deftbl=>3 == addr
return deftbl
fin
deftbl = deftbl + 5
loop
return 0
end
def loadmod(mod)#1
word rdlen, modsize, bytecode, codefix, defofst, defcnt, init, fixup
word addr, defaddr, modaddr, modfix, modofst, modend
@ -1015,31 +1156,36 @@ def loadmod(mod)#1
// Run through the Re-Location Dictionary.
//
while ^rld
addr = rld=>1 + modfix
rld, addr, fixup = reloc(modfix, modofst, bytecode, rld)
if ^rld
*addr = ^rld & $10 ?? *addr + lookupextern(esd, rld->3) :: lookupdef(fixup + codefix, deftbl)
rld = rld + 4
fin
//addr = rld=>1 + modfix
//if uword_isge(addr, modaddr) // Skip fixups to header
//if type & $80 // WORD sized fixup.
fixup = *addr
//else // BYTE sized fixup.
// fixup = ^addr
//fin
if ^rld & $10 // EXTERN reference.
fixup = fixup + lookupextern(esd, rld->3)
else // INTERN fixup.
fixup = fixup + modofst
if uword_isge(fixup, bytecode)
//
// Bytecode address - replace with call def directory.
//
fixup = lookupdef(fixup + codefix, deftbl)
fin
fin
//if type & $80 // WORD sized fixup.
*addr = fixup
//else // BYTE sized fixup.
// ^addr = fixup
//fin
// if type & $80 // WORD sized fixup.
// fixup = *addr
// else // BYTE sized fixup.
// fixup = ^addr
// fin
// if ^rld & $10 // EXTERN reference.
// fixup = fixup + lookupextern(esd, rld->3)
// else // INTERN fixup.
// fixup = fixup + modofst
// if uword_isge(fixup, bytecode)
// //
// // Bytecode address - replace with call def directory.
// //
// fixup = lookupdef(fixup + codefix, deftbl)
// fin
// fin
// if type & $80 // WORD sized fixup.
// *addr = fixup
// else // BYTE sized fixup.
// ^addr = fixup
// fin
//fin
rld = rld + 4
//rld = rld + 4
loop
//
// Run through the External/Entry Symbol Directory.
@ -1120,9 +1266,7 @@ def volumes()#0
for i = 0 to 15
^strbuf = ^strbuf & $0F
if ^strbuf
cout('/')
prstr(strbuf)
crout()
cout('/'); prstr(strbuf); crout()
fin
strbuf = strbuf + 16
next
@ -1136,9 +1280,9 @@ def catalog(optpath)#1
word entry, filecnt
if ^optpath
memcpy(@path, optpath, ^optpath + 1)
strcpy(@path, optpath)
else
getpfx(@path)
pfxop(@path, GET_PFX)
prstr(@path)
crout()
fin
@ -1162,20 +1306,22 @@ def catalog(optpath)#1
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
type = ' '
when entry->$10
is $0F // Is it a directory?
type = '/'
break
is $FF // SYSTEM file
type = '-'
break
is $FE // REL file
type = '+'
wend
cout(type)
for len = 18 - len downto 0
cout(' ')
next
filecnt = filecnt - 1
filecnt--
fin
entry = entry + entrylen
next
@ -1191,17 +1337,17 @@ end
def stripchars(strptr)#1
while ^strptr and ^(strptr + 1) > ' '
memcpy(strptr + 1, strptr + 2, ^strptr)
^strptr = ^strptr - 1
^strptr--
loop
return ^strptr
end
def stripspaces(strptr)#0
while ^strptr and ^(strptr + ^strptr) <= ' '
^strptr = ^strptr - 1
^strptr--
loop
while ^strptr and ^(strptr + 1) <= ' '
memcpy(strptr + 1, strptr + 2, ^strptr)
^strptr = ^strptr - 1
^strptr--
loop
end
def striptrail(strptr)#1
@ -1223,7 +1369,7 @@ def parsecmd(strptr)#1
if ^strptr
cmd = ^(strptr + 1)
memcpy(strptr + 1, strptr + 2, ^strptr)
^strptr = ^strptr - 1
^strptr--
fin
stripspaces(strptr)
return cmd
@ -1246,18 +1392,18 @@ def execsys(sysfile)#0
word len
if ^sysfile
memcpy($280, sysfile, ^sysfile + 1)
strcpy($280, sysfile)
striptrail(sysfile)
refnum = open(sysfile)
if refnum
len = read(refnum, databuff, $FFFF)
resetmemfiles()
if len
memcpy(sysfile, $280, ^$280 + 1)
strcpy(sysfile, $280)
if stripchars(sysfile) and ^$2000 == $4C and *$2003 == $EEEE
stripspaces(sysfile)
if ^$2005 >= ^sysfile + 1
memcpy($2006, sysfile, ^sysfile + 1)
strcpy($2006, sysfile)
fin
fin
striptrail($280)
@ -1293,7 +1439,7 @@ heap = *freemem
//
// Print PLASMA version
//
prstr("PLASMA Pre "); prbyte(version.1); cout('.'); prbyte(version.0); crout
prstr("PLASMA Pre3 "); prbyte(version.1); cout('.'); prbyte(version.0); crout
//
// Init symbol table.
//
@ -1306,14 +1452,15 @@ loop
// Set system path
//
strcat(strcpy(@sysmods, $280), "SYS/")) // This is the path to CMD
syspath = @sysmods // Update external interface table
syspath = @sysmods // Update external interface table
syscmdln = @cmdln
//
// Try to load autorun.
//
autorun = open(@autorun)
if autorun > 0
cmdln = read(autorun, @sysmodstr, 128)
close(autorun)
cmdln = read(autorun, @autorun, 128)
close(0)
else
//
// Print some startup info.
@ -1322,34 +1469,34 @@ else
fin
perr = 0
while 1
if cmdln
when toupper(parsecmd(@cmdln))
if ^getlnbuf
when toupper(parsecmd(getlnbuf))
is 'Q'
reboot()
break
is 'C'
catalog(@cmdln)
catalog(getlnbuf)
break
is 'P'
setpfx(@cmdln)
pfxop(getlnbuf, SET_PFX)
break
is '/'
repeat
prefix--
until prefix[prefix] == '/'
if prefix > 1
setpfx(@prefix)
pfxop(@prefix, SET_PFX)
fin
break
is 'V'
volumes()
break
is '-'
execsys(@cmdln)
execsys(getlnbuf)
break
is '+'
saveX
execmod(striptrail(@cmdln))
execmod(striptrail(getlnbuf))
//
// Clean up
//
@ -1368,7 +1515,7 @@ while 1
fin
crout()
fin
prstr(getpfx(@prefix))
prstr(pfxop(@prefix, GET_PFX))
strcpy(@cmdln, rdstr($BA))
loop
done

85
src/vmsrc/cmdstub.s
View File

@ -1,49 +1,48 @@
INTERP = $03D0
LCRDEN = $C080
LCWTEN = $C081
ROMEN = $C082
LCRWEN = $C083
LCBNK2 = $00
LCBNK1 = $08
!SOURCE "vmsrc/plvmzp.inc"
INTERP = $03D0
LCRDEN = $C080
LCWTEN = $C081
ROMEN = $C082
LCRWEN = $C083
LCBNK2 = $00
LCBNK1 = $08
!SOURCE "vmsrc/plvmzp.inc"
;*
;* MOVE CMD DOWN TO $1000-$2000
;*
LDA #<_CMDBEGIN
STA SRCL
LDA #>_CMDBEGIN
STA SRCH
LDY #$00
STY DSTL
LDA #$10
STA DSTH
- LDA (SRC),Y
STA (DST),Y
INY
BNE -
INC SRCH
INC DSTH
LDA DSTH
CMP #$20 ; STOP WHEN DST=$2000 REACHED
BNE -
LDA #<_CMDEND
STA SRCL
LDA #>_CMDEND
STA SRCH
LDA #<_CMDBEGIN
STA SRCL
LDA #>_CMDBEGIN
STA SRCH
LDY #$00
STY DSTL
LDX #$10
STX DSTH
- LDA (SRC),Y
STA (DST),Y
INY
BNE -
INC SRCH
INC DSTH
DEX ; STOP WHEN DST=$2000 REACHED
BNE -
LDA #<_CMDEND
STA SRCL
LDA #>_CMDEND
STA SRCH
;
; INIT VM ENVIRONMENT STACK POINTERS
;
STY PPL
STY IFPL ; INIT FRAME POINTER
LDA #$BF
STA PPH
STA IFPH
LDX #$FE ; INIT STACK POINTER (YES, $FE. SEE GETS)
TXS
LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX
JMP $1000
_CMDBEGIN = *
!PSEUDOPC $1000 {
!SOURCE "vmsrc/cmd.a"
_CMDEND = *
}
STY PPL
STY IFPL ; INIT FRAME POINTER
LDA #$BF
STA PPH
STA IFPH
LDX #$FE ; INIT STACK POINTER (YES, $FE. SEE GETS)
TXS
LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX
JMP $1000
_CMDBEGIN = *
!PSEUDOPC $1000 {
!SOURCE "vmsrc/cmd.a"
_CMDEND = *
}

2
src/vmsrc/plvm.c
View File

@ -265,7 +265,7 @@ int load_mod(byte *mod)
moddep = header + 1;
modsize = header[0] | (header[1] << 8);
magic = header[2] | (header[3] << 8);
if (magic == 0xDA7F)
if (magic == 0x6502)
{
/*
* This is a relocatable bytecode module.

1528
src/vmsrc/plvm01.s
View File

File diff suppressed because it is too large Load Diff

565
src/vmsrc/plvm02.s
View File

@ -5,7 +5,6 @@
;* SYSTEM ROUTINES AND LOCATIONS
;*
;**********************************************************
SELFMODIFY = 0
;*
;* MONITOR SPECIAL LOCATIONS
;*
@ -44,7 +43,7 @@ PSR = TMP+2
DVSIGN = PSR+1
DROP = $EF
NEXTOP = $F0
FETCHOP = NEXTOP+3
FETCHOP = NEXTOP+1
IP = FETCHOP+1
IPL = IP
IPH = IPL+1
@ -52,20 +51,12 @@ OPIDX = FETCHOP+6
OPPAGE = OPIDX+1
STRBUF = $0280
INTERP = $03D0
;*
;* INTERPRETER INSTRUCTION POINTER INCREMENT MACRO
;*
!MACRO INC_IP {
INY
BNE * + 4
INC IPH
}
;******************************
;* *
;* INTERPRETER INITIALIZATION *
;* *
;******************************
* = $2000
* = $2000
LDX #$FE
TXS
LDX #$00
@ -197,22 +188,10 @@ DINTRP PLA
PLA
ADC #$00
STA IPH
LDA IFPH
PHA ; SAVE ON STACK FOR LEAVE/RET
LDA IFPL
PHA ; SAVE ON STACK FOR LEAVE/RET
LDA PPL ; SET FP TO PP
STA IFPL
LDA PPH
STA IFPH
LDY #$00
!IF SELFMODIFY {
BEQ +
} ELSE {
LDA #>OPTBL
STA OPPAGE
JMP FETCHOP
}
IINTRP PLA
STA TMPL
PLA
@ -224,20 +203,8 @@ IINTRP PLA
LDA (TMP),Y
STA IPL
DEY
LDA IFPH
PHA ; SAVE ON STACK FOR LEAVE/RET
LDA IFPL
PHA ; SAVE ON STACK FOR LEAVE/RET
LDA PPL ; SET FP TO PP
STA IFPL
LDA PPH
STA IFPH
+ LDA #>OPTBL
STA OPPAGE
!IF SELFMODIFY {
BIT LCRWEN+LCBNK2
BIT LCRWEN+LCBNK2
}
JMP FETCHOP
IINTRPX PHP
PLA
@ -254,21 +221,9 @@ IINTRPX PHP
LDA (TMP),Y
STA IPL
DEY
LDA IFPH
PHA ; SAVE ON STACK FOR LEAVE/RET
LDA IFPL
PHA ; SAVE ON STACK FOR LEAVE/RET
LDA PPL ; SET FP TO PP
STA IFPL
LDA PPH
STA IFPH
LDA #>OPXTBL
STA OPPAGE
STA ALTRDON
!IF SELFMODIFY {
BIT LCRWEN+LCBNK2
BIT LCRWEN+LCBNK2
}
JMP FETCHOP
;************************************************************
;* *
@ -308,6 +263,11 @@ CMDENTRY = *
DEY
BPL -
;
; SET JMPTMP OPCODE
;
LDA #$4C
STA JMPTMP
;
; INSTALL PAGE 3 VECTORS
;
LDY #$12
@ -391,12 +351,9 @@ PAGE0 = *
!PSEUDOPC DROP {
INX ; DROP @ $EF
INY ; NEXTOP @ $F0
BEQ NEXTOPH
LDA $FFFF,Y ; FETCHOP @ $F3, IP MAPS OVER $FFFF @ $F4
STA OPIDX
JMP (OPTBL) ; OPIDX AND OPPAGE MAP OVER OPTBL
NEXTOPH INC IPH
BNE FETCHOP
}
PAGE3 = *
;*
@ -597,16 +554,19 @@ DIVMOD JSR _DIV
;* INCREMENT TOS
;*
INCR INC ESTKL,X
BNE INCR1
INC ESTKH,X
INCR1 JMP NEXTOP
BEQ INCR1
JMP NEXTOP
INCR1 INC ESTKH,X
JMP NEXTOP
;*
;* DECREMENT TOS
;*
DECR LDA ESTKL,X
BNE DECR1
DEC ESTKH,X
BEQ DECR1
DEC ESTKL,X
JMP NEXTOP
DECR1 DEC ESTKL,X
DEC ESTKH,X
JMP NEXTOP
;*
;* BITWISE COMPLIMENT TOS
@ -662,10 +622,12 @@ SHL STY IPY
SBC #$08
SHL1 TAY
BEQ SHL3
SHL2 ASL ESTKL+1,X
LDA ESTKL+1,X
SHL2 ASL
ROL ESTKH+1,X
DEY
BNE SHL2
STA ESTKL+1,X
SHL3 LDY IPY
JMP DROP
;*
@ -696,17 +658,6 @@ SHR3 CMP #$80
SHR4 LDY IPY
JMP DROP
;*
;* LOGICAL NOT
;*
LNOT LDA ESTKL,X
ORA ESTKH,X
BEQ LNOT1
LDA #$FF
LNOT1 EOR #$FF
STA ESTKL,X
STA ESTKH,X
JMP NEXTOP
;*
;* LOGICAL AND
;*
LAND LDA ESTKL+1,X
@ -741,10 +692,20 @@ DUP DEX
STA ESTKH,X
JMP NEXTOP
;*
;* LOGICAL NOT
;*
LNOT LDA ESTKL,X
ORA ESTKH,X
BNE +
LDA #$FF
STA ESTKL,X
STA ESTKH,X
JMP NEXTOP
;*
;* CONSTANT
;*
ZERO DEX
LDA #$00
+ LDA #$00
STA ESTKL,X
STA ESTKH,X
JMP NEXTOP
@ -753,19 +714,34 @@ CFFB LDA #$FF
CB LDA #$00
DEX
STA ESTKH,X
+INC_IP
INY
LDA (IP),Y
STA ESTKL,X
JMP NEXTOP
;*
;* LOAD ADDRESS & LOAD CONSTANT WORD (SAME THING, WITH OR WITHOUT FIXUP)
;*
LA = *
CW DEX
+INC_IP
- TYA ; RENORMALIZE IP
CLC
ADC IPL
STA IPL
BCC +
INC IPH
+ LDY #$FF
LA INY ;+INC_IP
BMI -
DEX
LDA (IP),Y
STA ESTKL,X
+INC_IP
INY
LDA (IP),Y
STA ESTKH,X
JMP NEXTOP
CW DEX
INY ;+INC_IP
LDA (IP),Y
STA ESTKL,X
INY
LDA (IP),Y
STA ESTKH,X
JMP NEXTOP
@ -773,7 +749,7 @@ CW DEX
;* CONSTANT STRING
;*
CS DEX
+INC_IP
INY ;+INC_IP
TYA ; NORMALIZE IP AND SAVE STRING ADDR ON ESTK
CLC
ADC IPL
@ -788,8 +764,8 @@ CS DEX
TAY
JMP NEXTOP
;
CSX DEX
+INC_IP
CSX DEX
INY ;+INC_IP
TYA ; NORMALIZE IP
CLC
ADC IPL
@ -861,89 +837,64 @@ _CEXSX LDA (IP),Y ; SKIP TO NEXT OP ADDR AFTER STRING
;*
;* LOAD VALUE FROM ADDRESS TAG
;*
!IF SELFMODIFY {
LB LDA ESTKL,X
STA LBLDA+1
LDA ESTKH,X
STA LBLDA+2
LBLDA LDA $FFFF
STA ESTKH-1,X
LDA (ESTKH-1,X)
STA ESTKL,X
LDA #$00
STA ESTKH,X
JMP NEXTOP
} ELSE {
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 ESTKH-1,X
LDA (ESTKH-1,X)
STA ESTKL,X
INY
LDA (TMP),Y
INC ESTKH-1,X
BEQ +
LDA (ESTKH-1,X)
STA ESTKH,X
JMP NEXTOP
+ INC ESTKH,X
LDA (ESTKH-1,X)
STA ESTKH,X
LDY IPY
JMP NEXTOP
;
!IF SELFMODIFY {
LBX LDA ESTKL,X
STA LBXLDA+1
LDA ESTKH,X
STA LBXLDA+2
STA ESTKH-1,X
STA ALTRDOFF
LBXLDA LDA $FFFF
LDA (ESTKH-1,X)
STA ESTKL,X
LDA #$00
STA ESTKH,X
STA ALTRDON
JMP NEXTOP
} ELSE {
LBX LDA ESTKL,X
STA TMPL
LDA ESTKH,X
STA TMPH
STY IPY
LWX LDA ESTKL,X
STA ESTKH-1,X
STA ALTRDOFF
LDY #$00
LDA (TMP),Y
LDA (ESTKH-1,X)
STA ESTKL,X
STY ESTKH,X
LDY IPY
INC ESTKH-1,X
BEQ +
LDA (ESTKH-1,X)
STA ESTKH,X
STA ALTRDON
JMP NEXTOP
}
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
+ INC ESTKH,X
LDA (ESTKH-1,X)
STA ESTKH,X
LDY IPY
STA ALTRDON
JMP NEXTOP
;*
;* LOAD ADDRESS OF LOCAL FRAME OFFSET
;*
LLA +INC_IP
- TYA ; RENORMALIZE IP
CLC
ADC IPL
STA IPL
BCC +
INC IPH
+ LDY #$FF
LLA INY ;+INC_IP
BMI -
LDA (IP),Y
DEX
CLC
@ -956,7 +907,7 @@ LLA +INC_IP
;*
;* LOAD VALUE FROM LOCAL FRAME OFFSET
;*
LLB +INC_IP
LLB INY ;+INC_IP
LDA (IP),Y
STY IPY
TAY
@ -967,7 +918,7 @@ LLB +INC_IP
STA ESTKH,X
LDY IPY
JMP NEXTOP
LLW +INC_IP
LLW INY ;+INC_IP
LDA (IP),Y
STY IPY
TAY
@ -980,7 +931,7 @@ LLW +INC_IP
LDY IPY
JMP NEXTOP
;
LLBX +INC_IP
LLBX INY ;+INC_IP
LDA (IP),Y
STY IPY
TAY
@ -993,7 +944,7 @@ LLBX +INC_IP
STA ALTRDON
LDY IPY
JMP NEXTOP
LLWX +INC_IP
LLWX INY ;+INC_IP
LDA (IP),Y
STY IPY
TAY
@ -1010,39 +961,22 @@ LLWX +INC_IP
;*
;* LOAD VALUE FROM ABSOLUTE ADDRESS
;*
!IF SELFMODIFY {
LAB +INC_IP
LAB INY ;+INC_IP
LDA (IP),Y
STA LABLDA+1
+INC_IP
STA ESTKH-2,X
INY ;+INC_IP
LDA (IP),Y
STA LABLDA+2
LABLDA LDA $FFFF
STA ESTKH-1,X
LDA (ESTKH-2,X)
DEX
STA ESTKL,X
LDA #$00
STA ESTKH,X
JMP NEXTOP
} ELSE {
LAB +INC_IP
LAW INY ;+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
INY ;+INC_IP
LDA (IP),Y
STA TMPH
STY IPY
@ -1056,43 +990,24 @@ LAW +INC_IP
LDY IPY
JMP NEXTOP
;
!IF SELFMODIFY {
LABX +INC_IP
LABX INY ;+INC_IP
LDA (IP),Y
STA LABXLDA+1
+INC_IP
STA ESTKH-2,X
INY ;+INC_IP
LDA (IP),Y
STA LABXLDA+2
STA ESTKH-1,X
STA ALTRDOFF
LABXLDA LDA $FFFF
LDA (ESTKH-2,X)
DEX
STA ESTKL,X
LDA #$00
STA ESTKH,X
STA ALTRDON
JMP NEXTOP
} ELSE {
LABX +INC_IP
LAWX INY ;+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 NEXTOP
}
LAWX +INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
INY ;+INC_IP
LDA (IP),Y
STA TMPH
STY IPY
@ -1110,56 +1025,39 @@ LAWX +INC_IP
;*
;* STORE VALUE TO ADDRESS
;*
!IF SELFMODIFY {
SB LDA ESTKL,X
STA SBSTA+1
LDA ESTKH,X
STA SBSTA+2
STA ESTKH-1,X
LDA ESTKL+1,X
SBSTA STA $FFFF
STA (ESTKH-1,X)
INX
JMP DROP
} ELSE {
SB LDA ESTKL,X
STA TMPL
LDA ESTKH,X
STA TMPH
LDA ESTKL+1,X
STY IPY
LDY #$00
STA (TMP),Y
LDY IPY
INX
JMP DROP
}
SW LDA ESTKL,X
STA TMPL
LDA ESTKH,X
STA TMPH
STY IPY
LDY #$00
STA ESTKH-1,X
LDA ESTKL+1,X
STA (TMP),Y
INY
STA (ESTKH-1,X)
LDA ESTKH+1,X
STA (TMP),Y
LDY IPY
INC ESTKH-1,X
BEQ +
STA (ESTKH-1,X)
INX
JMP DROP
+ INC ESTKH,X
STA (ESTKH-1,X)
INX
JMP DROP
;*
;* STORE VALUE TO LOCAL FRAME OFFSET
;*
SLB +INC_IP
SLB INY ;+INC_IP
LDA (IP),Y
STY IPY
TAY
LDA ESTKL,X
STA (IFP),Y
LDY IPY
; INX
; JMP NEXTOP
BMI FIXDROP
JMP DROP
SLW +INC_IP
SLW INY ;+INC_IP
LDA (IP),Y
STY IPY
TAY
@ -1169,11 +1067,20 @@ SLW +INC_IP
LDA ESTKH,X
STA (IFP),Y
LDY IPY
BMI FIXDROP
JMP DROP
FIXDROP TYA
LDY #$00
CLC
ADC IPL
STA IPL
BCC +
INC IPH
+ JMP DROP
;*
;* STORE VALUE TO LOCAL FRAME OFFSET WITHOUT POPPING STACK
;*
DLB +INC_IP
DLB INY ;+INC_IP
LDA (IP),Y
STY IPY
TAY
@ -1181,7 +1088,7 @@ DLB +INC_IP
STA (IFP),Y
LDY IPY
JMP NEXTOP
DLW +INC_IP
DLW INY ;+INC_IP
LDA (IP),Y
STY IPY
TAY
@ -1195,36 +1102,27 @@ DLW +INC_IP
;*
;* STORE VALUE TO ABSOLUTE ADDRESS
;*
!IF SELFMODIFY {
SAB +INC_IP
- TYA ; RENORMALIZE IP
CLC
ADC IPL
STA IPL
BCC +
INC IPH
+ LDY #$FF
SAB INY ;+INC_IP
BMI -
LDA (IP),Y
STA SABSTA+1
+INC_IP
STA ESTKH-2,X
INY ;+INC_IP
LDA (IP),Y
STA SABSTA+2
STA ESTKH-1,X
LDA ESTKL,X
SABSTA STA $FFFF
; INX
; JMP NEXTOP
STA (ESTKH-2,X)
JMP DROP
} ELSE {
SAB +INC_IP
SAW INY ;+INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
LDA (IP),Y
STA TMPH
LDA ESTKL,X
STY IPY
LDY #$00
STA (TMP),Y
LDY IPY
JMP DROP
}
SAW +INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
INY ;+INC_IP
LDA (IP),Y
STA TMPH
STY IPY
@ -1235,38 +1133,24 @@ SAW +INC_IP
LDA ESTKH,X
STA (TMP),Y
LDY IPY
BMI FIXDROP
JMP DROP
;*
;* STORE VALUE TO ABSOLUTE ADDRESS WITHOUT POPPING STACK
;*
!IF SELFMODIFY {
DAB +INC_IP
DAB INY ;+INC_IP
LDA (IP),Y
STA DABSTA+1
+INC_IP
STA ESTKH-2,X
INY ;+INC_IP
LDA (IP),Y
STA DABSTA+2
STA ESTKH-1,X
LDA ESTKL,X
DABSTA STA $FFFF
STA (ESTKH-2,X)
JMP NEXTOP
} ELSE {
DAB +INC_IP
DAW INY ;+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
INY ;+INC_IP
LDA (IP),Y
STA TMPH
STY IPY
@ -1307,37 +1191,41 @@ ISGE LDA ESTKL+1,X
CMP ESTKL,X
LDA ESTKH+1,X
SBC ESTKH,X
BVC ISGE1
EOR #$80
ISGE1 BPL ISTRU
BVS +
BPL ISTRU
BMI ISFLS
+ BPL ISFLS
BMI ISTRU
;
ISGT LDA ESTKL,X
CMP ESTKL+1,X
LDA ESTKH,X
SBC ESTKH+1,X
BVC ISGT1
EOR #$80
ISGT1 BMI ISTRU
BVS +
BMI ISTRU
BPL ISFLS
+ BMI ISFLS
BPL ISTRU
;
ISLE LDA ESTKL,X
CMP ESTKL+1,X
LDA ESTKH,X
SBC ESTKH+1,X
BVC ISLE1
EOR #$80
ISLE1 BPL ISTRU
BVS +
BPL ISTRU
BMI ISFLS
+ BPL ISFLS
BMI ISTRU
;
ISLT LDA ESTKL+1,X
CMP ESTKL,X
LDA ESTKH+1,X
SBC ESTKH,X
BVC ISLT1
EOR #$80
ISLT1 BMI ISTRU
BVS +
BMI ISTRU
BPL ISFLS
+ BMI ISFLS
BPL ISTRU
;*
;* BRANCHES
;*
@ -1345,29 +1233,40 @@ BRTRU INX
LDA ESTKH-1,X
ORA ESTKL-1,X
BNE BRNCH
NOBRNCH +INC_IP
+INC_IP
NOBRNCH INY ;+INC_IP
INY
BMI FIXNEXT
JMP NEXTOP
FIXNEXT TYA
LDY #$00
CLC
ADC IPL
STA IPL
BCC +
INC IPH
+ 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
BRNCH TYA ; FLATTEN IP
SEC
ADC IPL
STA TMPL
LDA TMPH
+INC_IP
ADC (IP),Y
STA IPH
LDA TMPL
LDA #$00
TAY
ADC IPH
STA TMPH ; ADD BRANCH OFFSET
LDA (TMP),Y
;CLC ; BETTER NOT CARRY OUT OF IP+Y
ADC TMPL
STA IPL
INY
LDA (TMP),Y
ADC TMPH
STA IPH
DEY
DEY
JMP NEXTOP
JMP FETCHOP
BREQ INX
LDA ESTKL-1,X
CMP ESTKL,X
@ -1389,30 +1288,44 @@ BRGT INX
CMP ESTKL,X
LDA ESTKH-1,X
SBC ESTKH,X
BVS +
BPL NOBRNCH
BMI BRNCH
+ BPL BRNCH
BMI NOBRNCH
BRLT INX
LDA ESTKL,X
CMP ESTKL-1,X
LDA ESTKH,X
SBC ESTKH-1,X
BVS +
BPL NOBRNCH
BMI BRNCH
IBRNCH LDA IPL
+ BPL BRNCH
BMI NOBRNCH
IBRNCH TYA ; FLATTEN IP
CLC
ADC IPL
STA TMPL
LDA #$00
TAY
ADC IPH
STA TMPH ; ADD BRANCH OFFSET
LDA TMPL
;CLC ; BETTER NOT CARRY OUT OF IP+Y
ADC ESTKL,X
STA IPL
LDA IPH
LDA TMPH
ADC ESTKH,X
STA IPH
JMP DROP
;*
;* CALL INTO ABSOLUTE ADDRESS (NATIVE CODE)
;*
CALL +INC_IP
CALL INY ;+INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
INY ;+INC_IP
LDA (IP),Y
STA TMPH
TYA
@ -1429,17 +1342,13 @@ CALL +INC_IP
STA IPL
LDA #>OPTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE
STA OPPAGE
!IF SELFMODIFY {
BIT LCRWEN+LCBNK2
BIT LCRWEN+LCBNK2
}
LDY #$01
JMP FETCHOP
;
CALLX +INC_IP
CALLX INY ;+INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
INY ;+INC_IP
LDA (IP),Y
STA TMPH
TYA
@ -1465,10 +1374,6 @@ CALLX +INC_IP
STA IPL
LDA #>OPXTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE
STA OPPAGE
!IF SELFMODIFY {
BIT LCRWEN+LCBNK2
BIT LCRWEN+LCBNK2
}
LDY #$01
JMP FETCHOP
;*
@ -1493,10 +1398,6 @@ ICAL LDA ESTKL,X
STA IPL
LDA #>OPTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE
STA OPPAGE
!IF SELFMODIFY {
BIT LCRWEN+LCBNK2
BIT LCRWEN+LCBNK2
}
LDY #$01
JMP FETCHOP
;
@ -1527,20 +1428,20 @@ ICALX LDA ESTKL,X
STA IPL
LDA #>OPXTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE
STA OPPAGE
!IF SELFMODIFY {
BIT LCRWEN+LCBNK2
BIT LCRWEN+LCBNK2
}
LDY #$01
JMP FETCHOP
;*
;* JUMP INDIRECT TRHOUGH TMP
;*
JMPTMP JMP (TMP)
;JMPTMP JMP (TMP)
;*
;* ENTER FUNCTION WITH FRAME SIZE AND PARAM COUNT
;*
ENTER INY
ENTER LDA IFPH
PHA ; SAVE ON STACK FOR LEAVE
LDA IFPL
PHA
INY
LDA (IP),Y
EOR #$FF ; ALLOCATE FRAME
SEC
@ -1569,24 +1470,7 @@ ENTER INY
;*
;* LEAVE FUNCTION
;*
LEAVEX +INC_IP
LDA (IP),Y
STA ALTRDOFF
CLC
ADC IFPL
STA PPL
LDA #$00
ADC IFPH
STA PPH
PLA ; RESTORE PREVIOUS FRAME
STA IFPL
PLA
STA IFPH
LDA PSR
PHA
PLP
RTS
LEAVE +INC_IP
LEAVEX INY ;+INC_IP
LDA (IP),Y
CLC
ADC IFPL
@ -1598,20 +1482,23 @@ LEAVE +INC_IP
STA IFPL
PLA
STA IFPH
RTS
;
RETX STA ALTRDOFF
LDA PSR
PHA
PLP
RET LDA IFPL ; DEALLOCATE POOL
RTS
LEAVE INY ;+INC_IP
LDA (IP),Y
CLC
ADC IFPL
STA PPL
LDA IFPH
LDA #$00
ADC IFPH
STA PPH
PLA ; RESTORE PREVIOUS FRAME
STA IFPL
PLA
STA IFPH
RTS
RET RTS
VMEND = *
}

164
src/vmsrc/plvm03.s
View File

@ -14,7 +14,7 @@ MEMBANK = $FFEF
DVSIGN = TMP+2
DROP = $EF
NEXTOP = $F0
FETCHOP = NEXTOP+3
FETCHOP = NEXTOP+1
IP = FETCHOP+1
IPL = IP
IPH = IPL+1
@ -44,8 +44,12 @@ DSTX = XPAGE+DSTH
;*
!MACRO INC_IP {
INY
BNE *+4
INC IPH
BPL +
INC IPH
TYA
AND #$7F
TAY
+
}
;*
;* INTERPRETER HEADER+INITIALIZATION
@ -113,12 +117,9 @@ PAGE0 = *
;*
INX ; DROP
INY ; NEXTOP
BEQ NEXTOPH
LDA $FFFF,Y ; FETCHOP @ $F3, IP MAPS OVER $FFFF @ $F4
STA OPIDX
JMP (OPTBL)
NEXTOPH INC IPH
BNE FETCHOP
}
;*
;* SYSTEM INTERPRETER ENTRYPOINT
@ -130,6 +131,7 @@ INTERP PLA
PLA
ADC #$00
STA IPH
LDA IFPH
PHA ; SAVE ON STACK FOR LEAVE/RET
LDA IFPL
@ -138,6 +140,7 @@ INTERP PLA
STA IFPL
LDA PPH
STA IFPH
LDY #$00
STY IPX
JMP FETCHOP
@ -158,6 +161,7 @@ XINTERP PLA
LDA (TMP),Y
STA IPL
DEY
LDA IFPH
PHA ; SAVE ON STACK FOR LEAVE/RET
LDA IFPL
@ -166,6 +170,7 @@ XINTERP PLA
STA IFPL
LDA PPH
STA IFPH
JMP FETCHOP
;*
;* INTERNAL DIVIDE ALGORITHM
@ -268,13 +273,7 @@ MULLP LSR TMPH ; MULTPLRH
;*
;* NEGATE TOS
;*
NEG LDA #$00
SEC
SBC ESTKL,X
STA ESTKL,X
LDA #$00
SBC ESTKH,X
STA ESTKH,X
NEG JSR _NEG
JMP NEXTOP
;*
;* DIV TOS-1 BY TOS
@ -427,13 +426,13 @@ SHL STY IPY
SBC #$08
SHL1 TAY
BEQ SHL3
SHL2 ASL ESTKL+1,X
LDA ESTKL+1,X
SHL2 ASL
ROL ESTKH+1,X
DEY
BNE SHL2
STA ESTKL+1,X
SHL3 LDY IPY
; INX
; JMP NEXTOP
JMP DROP
;*
;* SHIFT TOS-1 RIGHT BY TOS
@ -461,8 +460,6 @@ SHR3 CMP #$80
BNE SHR3
STA ESTKH+1,X
SHR4 LDY IPY
; INX
; JMP NEXTOP
JMP DROP
;*
;* LOGICAL NOT
@ -535,7 +532,7 @@ CB LDA #$00
;*
LA = *
CW DEX
+INC_IP
INY ;+INC_IP
LDA (IP),Y
STA ESTKL,X
+INC_IP
@ -546,7 +543,7 @@ CW DEX
;* CONSTANT STRING
;*
CS DEX
+INC_IP
INY ;+INC_IP
TYA ; NORMALIZE IP
CLC
ADC IPL
@ -691,7 +688,7 @@ LLW +INC_IP
;* LOAD VALUE FROM ABSOLUTE ADDRESS
;*
!IF SELFMODIFY {
LAB +INC_IP
LAB INY ;+INC_IP
LDA (IP),Y
STA LABLDA+1
+INC_IP
@ -704,7 +701,7 @@ LABLDA LDA $FFFF
STA ESTKH,X
JMP NEXTOP
} ELSE {
LAB +INC_IP
LAB INY ;+INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
@ -719,7 +716,7 @@ LAB +INC_IP
LDY IPY
JMP NEXTOP
}
LAW +INC_IP
LAW INY ;+INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
@ -760,8 +757,6 @@ SB LDA ESTKL,X
STA (TMP),Y
LDY IPY
INX
; INX
; JMP NEXTOP
JMP DROP
}
SW LDA ESTKL,X
@ -777,8 +772,6 @@ SW LDA ESTKL,X
STA (TMP),Y
LDY IPY
INX
; INX
; JMP NEXTOP
JMP DROP
;*
;* STORE VALUE TO LOCAL FRAME OFFSET
@ -790,8 +783,6 @@ SLB +INC_IP
LDA ESTKL,X
STA (IFP),Y
LDY IPY
; INX
; JMP NEXTOP
JMP DROP
SLW +INC_IP
LDA (IP),Y
@ -803,8 +794,6 @@ SLW +INC_IP
LDA ESTKH,X
STA (IFP),Y
LDY IPY
; INX
; JMP NEXTOP
JMP DROP
;*
;* STORE VALUE TO LOCAL FRAME OFFSET WITHOUT POPPING STACK
@ -832,7 +821,7 @@ DLW +INC_IP
;* STORE VALUE TO ABSOLUTE ADDRESS
;*
!IF SELFMODIFY {
SAB +INC_IP
SAB INY ;+INC_IP
LDA (IP),Y
STA SABSTA+1
+INC_IP
@ -840,11 +829,9 @@ SAB +INC_IP
STA SABSTA+2
LDA ESTKL,X
SABSTA STA $FFFF
; INX
; JMP NEXTOP
JMP DROP
} ELSE {
SAB +INC_IP
SAB INY ;+INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
@ -855,11 +842,9 @@ SAB +INC_IP
LDY #$00
STA (TMP),Y
LDY IPY
; INX
; JMP NEXTOP
JMP DROP
}
SAW +INC_IP
SAW INY ;+INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
@ -873,14 +858,12 @@ SAW +INC_IP
LDA ESTKH,X
STA (TMP),Y
LDY IPY
; INX
; JMP NEXTOP
JMP DROP
;*
;* STORE VALUE TO ABSOLUTE ADDRESS WITHOUT POPPING STACK
;*
!IF SELFMODIFY {
DAB +INC_IP
DAB INY ;+INC_IP
LDA (IP),Y
STA DABSTA+1
+INC_IP
@ -890,7 +873,7 @@ DAB +INC_IP
DABSTA STA $FFFF
JMP NEXTOP
} ELSE {
DAB +INC_IP
DAB INY ;+INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
@ -903,7 +886,7 @@ DAB +INC_IP
LDY IPY
JMP NEXTOP
}
DAW +INC_IP
DAW INY ;+INC_IP
LDA (IP),Y
STA TMPL
+INC_IP
@ -989,29 +972,31 @@ BRTRU INX
LDA ESTKH-1,X
ORA ESTKL-1,X
BNE BRNCH
NOBRNCH +INC_IP
NOBRNCH INY ;+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
BRNCH TYA ; FLATTEN IP
SEC
ADC IPL
STA TMPL
LDA TMPH
+INC_IP
ADC (IP),Y
STA IPH
LDA TMPL
LDA #$00
TAY
ADC IPH
STA TMPH ; ADD BRANCH OFFSET
LDA (TMP),Y
;CLC ; BETTER NOT CARRY OUT OF IP+Y
ADC TMPL
STA IPL
INY
LDA (TMP),Y
ADC TMPH
STA IPH
DEY
DEY
JMP NEXTOP
JMP FETCHOP
BREQ INX
LDA ESTKL-1,X
CMP ESTKL,X
@ -1049,19 +1034,26 @@ IBRNCH LDA IPL
LDA IPH
ADC ESTKH,X
STA IPH
; INX
; JMP NEXTOP
JMP DROP
;*
;* INDIRECT CALL TO ADDRESS (NATIVE CODE)
;*
ICAL LDA ESTKL,X
STA CALLADR+1
LDA ESTKH,X
STA CALLADR+2
INX
BNE _CALL
;*
;* CALL INTO ABSOLUTE ADDRESS (NATIVE CODE)
;*
CALL +INC_IP
CALL INY ;+INC_IP
LDA (IP),Y
STA CALLADR+1
+INC_IP
INY ;+INC_IP
LDA (IP),Y
STA CALLADR+2
TYA
_CALL TYA
CLC
ADC IPL
PHA
@ -1080,37 +1072,14 @@ CALLADR JSR $FFFF
LDY #$01
JMP FETCHOP
;*
;* INDIRECT CALL TO ADDRESS (NATIVE CODE)
;*
ICAL LDA ESTKL,X
STA ICALADR+1
LDA ESTKH,X
STA ICALADR+2
INX
TYA
CLC
ADC IPL
PHA
LDA IPH
ADC #$00
PHA
LDA IPX
PHA
ICALADR JSR $FFFF
PLA
STA IPX
PLA
STA IPH
PLA
STA IPL
LDY #$01
JMP FETCHOP
;*
;* ENTER FUNCTION WITH FRAME SIZE AND PARAM COUNT
;*
ENTER INY
LDA (IP),Y
ENTER LDA IFPH
PHA ; SAVE ON STACK FOR LEAVE
LDA IFPL
PHA
INY
LDA (IP),Y
EOR #$FF
SEC
ADC PPL
@ -1138,7 +1107,8 @@ ENTER INY
;*
;* LEAVE FUNCTION
;*
LEAVE PLA
LEAVE INY ;+INC_IP
LDA (IP),Y
CLC
ADC IFPL
STA PPL
@ -1149,17 +1119,7 @@ LEAVE PLA
STA IFPL
PLA
STA IFPH
RTS
;
RET LDA IFPL ; DEALLOCATE POOL
STA PPL
LDA IFPH
STA PPH
PLA ; RESTORE PREVIOUS FRAME
STA IFPL
PLA
STA IFPH
RTS
RET RTS
SOSCMD = *
!SOURCE "vmsrc/soscmd.a"
SEGEND = *

419
src/vmsrc/plvm802.s
View File

@ -6,7 +6,6 @@
;*
;**********************************************************
!CPU 65816
SELFMODIFY = 0
DEBUG = 0
;*
;* THE DEFAULT CPU MODE FOR EXECUTING OPCODES IS:
@ -55,7 +54,7 @@ PSR = TMP+2
HWSP = PSR+1
DROP = $EF
NEXTOP = DROP+1
FETCHOP = NEXTOP+3
FETCHOP = NEXTOP+1
IP = FETCHOP+1
IPL = IP
IPH = IPL+1
@ -72,17 +71,6 @@ INTERP = $03D0
TOS = $01 ; TOS
NOS = $03 ; TOS-1
;*
;* INTERPRETER INSTRUCTION POINTER INCREMENT MACRO
;*
!MACRO INC_IP {
INY
BNE +
LDX IPH
INX
STX IPH
+
}
;*
;* ACCUM/MEM SIZE MACROS
;*
!MACRO ACCMEM8 {
@ -265,9 +253,6 @@ DINTRP PHP
PLA
INC
STA IP
PEI (IFP) ; SAVE ON STACK FOR LEAVE/RET
LDA PP ; SET FP TO PP
STA IFP
STX ESP
TSX
STX HWSP
@ -276,10 +261,6 @@ DINTRP PHP
BRA SETDBG
} ELSE {
STX OPPAGE
!IF SELFMODIFY {
LDX LCRWEN+LCBNK2
LDX LCRWEN+LCBNK2
}
LDY #$00
JMP FETCHOP
}
@ -295,10 +276,7 @@ IINTRP PHP
LDA (TOS,S),Y
DEY
STA IP
LDA IFP
STA TOS,S ; SAVE ON STACK FOR LEAVE/RET
LDA PP ; SET FP TO PP
STA IFP
PLA
STX ESP
TSX
STX HWSP
@ -307,10 +285,6 @@ IINTRP PHP
BRA SETDBG
} ELSE {
STX OPPAGE
!IF SELFMODIFY {
LDX LCRWEN+LCBNK2
LDX LCRWEN+LCBNK2
}
JMP FETCHOP
}
!AS
@ -325,10 +299,7 @@ IINTRPX PHP
LDA (TOS,S),Y
DEY
STA IP
LDA IFP
STA TOS,S ; SAVE ON STACK FOR LEAVE/RET
LDA PP ; SET FP TO PP
STA IFP
PLA
STX ESP
TSX
STX HWSP
@ -343,10 +314,6 @@ SETDBG LDY LCRWEN+LCBNK2
LDY #$00
}
STX OPPAGE
!IF SELFMODIFY {
LDX LCRWEN+LCBNK2
LDX LCRWEN+LCBNK2
}
JMP FETCHOP
;************************************************************
;* *
@ -394,6 +361,11 @@ CMDENTRY = *
DEY
BPL -
;
; SET JMPTMP OPCODE
;
LDA #$4C
STA JMPTMP
;
; INSTALL PAGE 3 VECTORS
;
LDY #$12
@ -477,13 +449,8 @@ PAGE0 = *
!PSEUDOPC DROP {
PLA ; DROP @ $EF
INY ; NEXTOP @ $F0
BEQ NEXTOPH
LDX $FFFF,Y ; FETCHOP @ $F3, IP MAPS OVER $FFFF @ $F4
JMP (OPTBL,X) ; OPIDX AND OPPAGE MAP OVER OPTBL
NEXTOPH LDX IPH
INX
STX IPH
BRA FETCHOP
}
PAGE3 = *
;*
@ -739,15 +706,6 @@ SHR PLA
STA TOS,S
SHREX JMP NEXTOP
;*
;* LOGICAL NOT
;*
LNOT LDA TOS,S
BEQ LNOT1
LDA #$0001
LNOT1 DEC
STA TOS,S
JMP NEXTOP
;*
;* LOGICAL AND
;*
LAND PLA
@ -773,16 +731,23 @@ DUP LDA TOS,S
PHA
JMP NEXTOP
;*
;* LOGICAL NOT
;*
LNOT PLA
BNE ZERO
PEA $FFFF
JMP NEXTOP
;*
;* CONSTANT
;*
ZERO PEA $0000
JMP NEXTOP
CFFB +INC_IP
CFFB INY ;+INC_IP
LDA (IP),Y
ORA #$FF00
PHA
JMP NEXTOP
CB +INC_IP
CB INY ;+INC_IP
LDA (IP),Y
AND #$00FF
PHA
@ -790,16 +755,22 @@ CB +INC_IP
;*
;* LOAD ADDRESS & LOAD CONSTANT WORD (SAME THING, WITH OR WITHOUT FIXUP)
;*
LA = *
CW +INC_IP
LA INY ;+INC_IP
LDA (IP),Y
+INC_IP
PHA
INY
BMI +
JMP NEXTOP
+ JMP FIXNEXT
CW INY ;+INC_IP
LDA (IP),Y
PHA
INY ;+INC_IP
JMP NEXTOP
;*
;* CONSTANT STRING
;*
CS +INC_IP
CS INY ;+INC_IP
TYA ; NORMALIZE IP AND SAVE STRING ADDR ON ESTK
CLC
ADC IP
@ -809,7 +780,7 @@ CS +INC_IP
TAY
JMP NEXTOP
;
CSX +INC_IP
CSX INY ;+INC_IP
TYA ; NORMALIZE IP
CLC
ADC IP
@ -866,14 +837,6 @@ _CEXSX LDA (IP) ; SKIP TO NEXT OP ADDR AFTER STRING
;*
;* LOAD VALUE FROM ADDRESS TAG
;*
!IF SELFMODIFY {
LB LDA TOS,S
STA LBLDX+1
LBLDX LDX $FFFF
TXA
STA TOS,S
JMP NEXTOP
} ELSE {
LB TYX
LDY #$00
TYA ; QUICKY CLEAR OUT MSB
@ -883,7 +846,6 @@ LB TYX
STA TOS,S
TXY
JMP NEXTOP
}
LW TYX
LDY #$00
LDA (TOS,S),Y
@ -891,16 +853,6 @@ LW TYX
TXY
JMP NEXTOP
;
!IF SELFMODIFY {
LBX LDA TOS,S
STA LBXLDX+1
STX ALTRDOFF
LBXLDX LDX $FFFF
STX ALTRDON
TXA
STA TOS,S
JMP NEXTOP
} ELSE {
LBX TYX
LDY #$00
TYA ; QUICKY CLEAR OUT MSB
@ -912,7 +864,6 @@ LBX TYX
STA TOS,S
TXY
JMP NEXTOP
}
LWX TYX
LDY #$00
STX ALTRDOFF
@ -924,7 +875,13 @@ LWX TYX
;*
;* LOAD ADDRESS OF LOCAL FRAME OFFSET
;*
LLA +INC_IP
- TYA
CLC
ADC IP
STA IP
LDY #$FF
LLA INY ;+INC_IP
BMI -
LDA (IP),Y
AND #$00FF
CLC
@ -934,7 +891,7 @@ LLA +INC_IP
;*
;* LOAD VALUE FROM LOCAL FRAME OFFSET
;*
LLB +INC_IP
LLB INY ;+INC_IP
TYX
LDA (IP),Y
TAY
@ -943,7 +900,7 @@ LLB +INC_IP
PHA
TXY
JMP NEXTOP
LLW +INC_IP
LLW INY ;+INC_IP
TYX
LDA (IP),Y
TAY
@ -952,7 +909,7 @@ LLW +INC_IP
TXY
JMP NEXTOP
;
LLBX +INC_IP
LLBX INY ;+INC_IP
TYX
LDA (IP),Y
TAY
@ -963,7 +920,7 @@ LLBX +INC_IP
PHA
TXY
JMP NEXTOP
LLWX +INC_IP
LLWX INY ;+INC_IP
TYX
LDA (IP),Y
TAY
@ -976,50 +933,26 @@ LLWX +INC_IP
;*
;* LOAD VALUE FROM ABSOLUTE ADDRESS
;*
!IF SELFMODIFY {
LAB +INC_IP
LAB INY ;+INC_IP
LDA (IP),Y
+INC_IP
STA LABLDX+1
LABLDX LDX $FFFF
TXA
PHA
JMP NEXTOP
} ELSE {
LAB +INC_IP
LDA (IP),Y
+INC_IP
STA TMP
TYA ; QUICKY CLEAR OUT MSB
+ACCMEM8 ; 8 BIT A/M
LDA (TMP)
+ACCMEM16 ; 16 BIT A/M
PHA
INY ;+INC_IP
JMP NEXTOP
}
LAW +INC_IP
LAW INY ;+INC_IP
LDA (IP),Y
+INC_IP
STA TMP
LDA (TMP)
PHA
INY ;+INC_IP
JMP NEXTOP
;
!IF SELFMODIFY {
LABX +INC_IP
LABX INY ;+INC_IP
LDA (IP),Y
+INC_IP
STA LABXLDX+1
STX ALTRDOFF
LABXLDX LDX $FFFF
STX ALTRDON
TXA
PHA
JMP NEXTOP
} ELSE {
LABX +INC_IP
LDA (IP),Y
+INC_IP
STA TMP
TYA ; QUICKY CLEAR OUT MSB
STX ALTRDOFF
@ -1028,30 +961,21 @@ LABX +INC_IP
+ACCMEM16 ; 16 BIT A/M
STX ALTRDON
PHA
INY ;+INC_IP
JMP NEXTOP
}
LAWX +INC_IP
LAWX INY ;+INC_IP
LDA (IP),Y
+INC_IP
STA TMP
STX ALTRDOFF
LDA (TMP)
STX ALTRDON
PHA
INY ;+INC_IP
JMP NEXTOP
;
;*
;* STORE VALUE TO ADDRESS
;*
!IF SELFMODIFY {
SB LDA TOS,S
STA SBSTX+1
LDA NOS,S
TAX
SBSTX STX $FFFF
PLA
JMP DROP
} ELSE {
SB TYX
LDY #$00
+ACCMEM8 ; 8 BIT A/M
@ -1061,7 +985,6 @@ SB TYX
TXY
PLA
JMP DROP
}
SW TYX
LDY #$00
LDA NOS,S
@ -1072,19 +995,7 @@ SW TYX
;*
;* STORE VALUE TO LOCAL FRAME OFFSET
;*
!IF SELFMODIFY {
SLB +INC_IP
LDA (IP),Y
AND #$00FF
CLC
ADC IFP
STA SLBSTX+1
PLA
TAX
SLBSTX STX $FFFF
JMP NEXTOP
} ELSE {
SLB +INC_IP
SLB INY ;+INC_IP
TYX
LDA (IP),Y
TAY
@ -1093,32 +1004,23 @@ SLB +INC_IP
STA (IFP),Y
+ACCMEM16 ; 16 BIT A/M
TXY
BMI +
JMP NEXTOP
}
SLW +INC_IP
+ JMP FIXNEXT
SLW INY ;+INC_IP
LDA (IP),Y
TYX
TAY
PLA
STA (IFP),Y
TXY
BMI +
JMP NEXTOP
+ JMP FIXNEXT
;*
;* STORE VALUE TO LOCAL FRAME OFFSET WITHOUT POPPING STACK
;*
!IF SELFMODIFY {
DLB +INC_IP
LDA (IP),Y
AND #$00FF
CLC
ADC IFP
STA DLBSTX+1
LDA TOS,S
TAX
DLBSTX STX $FFFF
JMP NEXTOP
} ELSE {
DLB +INC_IP
DLB INY ;+INC_IP
TYX
+ACCMEM8 ; 8 BIT A/M
LDA (IP),Y
@ -1128,8 +1030,7 @@ DLB +INC_IP
+ACCMEM16 ; 16 BIT A/M
TXY
JMP NEXTOP
}
DLW +INC_IP
DLW INY ;+INC_IP
LDA (IP),Y
TYX
TAY
@ -1140,62 +1041,44 @@ DLW +INC_IP
;*
;* STORE VALUE TO ABSOLUTE ADDRESS
;*
!IF SELFMODIFY {
SAB +INC_IP
SAB INY ;+INC_IP
LDA (IP),Y
+INC_IP
STA SABSTX+1
PLA
TAX
SABSTX STX $FFFF
JMP NEXTOP
} ELSE {
SAB +INC_IP
LDA (IP),Y
+INC_IP
STA TMP
PLA
+ACCMEM8 ; 8 BIT A/M
STA (TMP)
+ACCMEM16 ; 16 BIT A/M
INY
BMI +
JMP NEXTOP
}
SAW +INC_IP
+ JMP FIXNEXT
SAW INY ;+INC_IP
LDA (IP),Y
+INC_IP
STA TMP
PLA
STA (TMP)
INY
BMI +
JMP NEXTOP
+ JMP FIXNEXT
;*
;* STORE VALUE TO ABSOLUTE ADDRESS WITHOUT POPPING STACK
;*
!IF SELFMODIFY {
DAB +INC_IP
DAB INY ;+INC_IP
LDA (IP),Y
+INC_IP
STA DABSTX+1
LDA TOS,S
TAX
DABSTX STX $FFFF
JMP NEXTOP
} ELSE {
DAB +INC_IP
LDA (IP),Y
+INC_IP
STA TMP
+ACCMEM8 ; 8 BIT A/M
LDA TOS,S
STA (TMP)
+ACCMEM16 ; 16 BIT A/M
INY ;+INC_IP
JMP NEXTOP
}
DAW +INC_IP
DAW INY ;+INC_IP
LDA (IP),Y
+INC_IP
STA TMP
LDA TOS,S
STA (TMP)
INY ;+INC_IP
JMP NEXTOP
;*
;* COMPARES
@ -1258,18 +1141,27 @@ ISLT PLA
;*
BRTRU PLA
BNE BRNCH
NOBRNCH +INC_IP
+INC_IP
NOBRNCH INY ;+INC_IP
INY
BMI FIXNEXT
JMP NEXTOP
FIXNEXT TYA
SEC
ADC IP
STA IP
LDY #$00
JMP FETCHOP
BRFLS PLA
BNE NOBRNCH
BRNCH LDA IP
+INC_IP
BRNCH TYA ; FLATTEN IP
CLC
ADC IP
INY ;+INC_IP
;CLC ; ADD BRANCH OFFSET (BETTER NOT CARRY OUT OF IP+Y)
ADC (IP),Y
STA IP
DEY
JMP NEXTOP
LDY #$01
JMP FETCHOP
BREQ PLA
CMP TOS,S
BEQ BRNCH
@ -1296,26 +1188,27 @@ BRLT PLA
+ BMI BRNCH
BEQ BRNCH
BPL NOBRNCH
IBRNCH PLA
IBRNCH TYA ; FLATTEN IP
CLC
ADC IP
STA IP
JMP NEXTOP
;*
;* CALL INTO ABSOLUTE ADDRESS (NATIVE CODE)
;*
CALL +INC_IP
LDA (IP),Y
INY
BNE EMUSTK
LDX IPH
INX
STX IPH
BRA EMUSTK
PLA
;CLC ; ADD BRANCH OFFSET (BETTER NOT CARRY OUT OF IP+Y)
ADC IP
STA IP
LDY #$01
JMP FETCHOP
;*
;* INDIRECT CALL TO ADDRESS (NATIVE CODE)
;*
ICAL PLA
BRA EMUSTK
;*
;* CALL INTO ABSOLUTE ADDRESS (NATIVE CODE)
;*
CALL INY ;+INC_IP
LDA (IP),Y
INY
EMUSTK STA TMP
TYA ; FLATTEN IP
CLC
@ -1341,14 +1234,16 @@ EMUSTK STA TMP
ADC ESP ; ESP - STACK DEPTH
TAY
TAX
BRA +
CPX ESP
BEQ +
- PLA
STA ESTKL,X
PLA
STA ESTKH,X
INX
+ CPX ESP
CPX ESP
BNE -
+
!IF DEBUG {
TXA
TSX
@ -1378,7 +1273,6 @@ EMUSTK STA TMP
STA IPL
PLA
STA IPH
STX TMPL
!IF DEBUG {
TXA
EOR #$FF
@ -1388,18 +1282,20 @@ EMUSTK STA TMP
ADC #$80+'0'
STA $7D0+32
}
STX TMPL
TSX ; RESTORE BASELINE HWSP
STX HWSP
CPY TMPL
BEQ +
TYX
BRA +
- DEX
LDA ESTKH,X
PHA
LDA ESTKL,X
PHA
+ CPX TMPL
CPX TMPL
BNE -
CLC ; SWITCH BACK TO NATIVE MODE
+ CLC ; SWITCH BACK TO NATIVE MODE
XCE
+ACCMEM16 ; 16 BIT A/M
LDX #>OPTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE
@ -1411,33 +1307,25 @@ EMUSTK STA TMP
LDX #>DBGTBL
}
STX OPPAGE
!IF SELFMODIFY {
LDX LCRWEN+LCBNK2
LDX LCRWEN+LCBNK2
}
LDY #$01
JMP FETCHOP
;*
;* CALL INTO ABSOLUTE ADDRESS (NATIVE CODE)
;*
CALLX +INC_IP
LDA (IP),Y
INY
BNE EMUSTKX
LDX IPH
INX
STX IPH
BRA EMUSTKX
;*
;* INDIRECT CALL TO ADDRESS (NATIVE CODE)
;*
ICALX PLA
BRA EMUSTKX
;*
;* CALL INTO ABSOLUTE ADDRESS (NATIVE CODE)
;*
CALLX INY ;+INC_IP
LDA (IP),Y
INY
EMUSTKX STA TMP
TYA ; FLATTEN IP
CLC
ADC IP
STA IP
SEC ; SWITCH TO EMULATED MODE
SEC ; SWITCH TO EMULATION MODE
XCE
!AS
TSC ; MOVE HW EVAL STACK TO ZP EVAL STACK
@ -1457,14 +1345,16 @@ EMUSTKX STA TMP
ADC ESP ; ESP - STACK DEPTH
TAY
TAX
BRA +
CPX ESP
BEQ +
- PLA
STA ESTKL,X
PLA
STA ESTKH,X
INX
+ CPX ESP
CPX ESP
BNE -
+
!IF DEBUG {
TXA
TSX
@ -1496,7 +1386,6 @@ EMUSTKX STA TMP
STA IPL
PLA
STA IPH
STX TMPL
!IF DEBUG {
TXA
EOR #$FF
@ -1506,18 +1395,20 @@ EMUSTKX STA TMP
ADC #$80+'0'
STA $7D0+32
}
STX TMPL
TSX ; RESTORE BASELINE HWSP
STX HWSP
CPY TMPL
BEQ +
TYX
BRA +
- DEX
LDA ESTKH,X
PHA
LDA ESTKL,X
PHA
+ CPX TMPL
CPX TMPL
BNE -
CLC ; SWITCH BACK TO NATIVE MODE
+ CLC ; SWITCH BACK TO NATIVE MODE
XCE
+ACCMEM16 ; 16 BIT A/M
LDX #>OPXTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE
@ -1529,20 +1420,19 @@ EMUSTKX STA TMP
LDX #>DBGTBL
}
STX OPPAGE
!IF SELFMODIFY {
LDX LCRWEN+LCBNK2
LDX LCRWEN+LCBNK2
}
LDY #$01
JMP FETCHOP
;*
;* JUMP INDIRECT THROUGH TMP
;*
JMPTMP JMP (TMP)
;JMPTMP JMP (TMP)
;*
;* ENTER FUNCTION WITH FRAME SIZE AND PARAM COUNT
;*
ENTER INY
ENTER PEI (IFP) ; SAVE ON STACK FOR LEAVE
TSX ; REFLECT SP IN SAVED HWSP
STX HWSP
INY
LDA (IP),Y
AND #$00FF
!IF DEBUG {
@ -1581,14 +1471,14 @@ ENTER INY
;*
;* LEAVE FUNCTION
;*
LEAVEX +INC_IP
LEAVE INY ;+INC_IP
+ACCMEM8 ; 8 BIT A/M
LDA (IP),Y ; DEALLOCATE POOL + FRAME
BRA +
LEAVEX INY ;+INC_IP
+ACCMEM8 ; 8 BIT A/M
LDA (IP),Y ; DEALLOCATE POOL + FRAME
STA ALTRDOFF
BRA +
LEAVE +INC_IP
+ACCMEM8 ; 8 BIT A/M
LDA (IP),Y ; DEALLOCATE POOL + FRAME
+ STA TMPL
TSC ; MOVE HW EVAL STACK TO ZP EVAL STACK
EOR #$FF
@ -1605,15 +1495,16 @@ LEAVE +INC_IP
EOR #$FF
SEC
ADC ESP ; ESP - STACK DEPTH
TAY
TAX
BRA +
CPX ESP
BEQ ++
TAY
- PLA
STA ESTKL,X
PLA
STA ESTKH,X
INX
+ CPX ESP
CPX ESP
BNE -
!IF DEBUG {
TSX
@ -1627,25 +1518,28 @@ LEAVE +INC_IP
+
}
TYX ; RESTORE NEW ESP
LDA TMPL ; DEALLOCATE POOL + FRAME
+ACCMEM16 ; 16 BIT A/M
AND #$00FF
++ +ACCMEM16 ; 16 BIT A/M
LDY TMPL ; DEALLOCATE POOL + FRAME
TYA
CLC
ADC IFP
STA PP
PLA ; RESTORE PREVIOUS FRAME
STA IFP
SEC ; SWITCH TO EMULATED MODE
SEC ; SWITCH TO EMULATION MODE
XCE
!AS
LDA PSR
PHA
PLP
RTS
+ACCMEM16 ; 16 BIT A/M
!AL
;
RETX STX ALTRDOFF
RET +ACCMEM8 ; 8 BIT A/M
RET SEC ; SWITCH TO EMULATION MODE
XCE
!AS
;+ACCMEM8 ; 8 BIT A/M
TSC ; MOVE HW EVAL STACK TO ZP EVAL STACK
EOR #$FF
SEC
@ -1661,15 +1555,16 @@ RET +ACCMEM8 ; 8 BIT A/M
EOR #$FF
SEC
ADC ESP ; ESP - STACK DEPTH
TAY
TAX
BRA +
CPX ESP
BEQ ++
TAY
- PLA
STA ESTKL,X
PLA
STA ESTKH,X
INX
+ CPX ESP
CPX ESP
BNE -
!IF DEBUG {
TSX
@ -1683,15 +1578,7 @@ RET +ACCMEM8 ; 8 BIT A/M
+
}
TYX
+ACCMEM16
LDA IFP ; DEALLOCATE POOL
STA PP
PLA ; RESTORE PREVIOUS FRAME
STA IFP
SEC ; SWITCH TO EMULATED MODE
XCE
!AS
LDA PSR
++ LDA PSR
PHA
PLP
RTS
@ -1868,9 +1755,9 @@ STEP STX TMPL
TSX
CMP #$10
BCC DBGKEY
; LDX TMPL
; CPX #$54 ; FORCE PAUSE AT 'CALL'
; BEQ DBGKEY
LDX TMPL
CPX #$00 ; FORCE PAUSE AT 'ZERO'
BEQ DBGKEY
- LDX $C000
CPX #$9B
BNE +

11
src/vmsrc/plvmzp.inc
View File

@ -9,13 +9,11 @@ SRCH = SRC+1
DST = SRC+2
DSTL = DST
DSTH = DST+1
ESGUARD = $BE
ESTKSZ = $20
XSTK = $A0
XSTKL = XSTK
XSTKH = XSTK+ESTKSZ/2
ESTK = $C0
ESTKL = ESTK
ESTKH = ESTK+ESTKSZ/2
ESTKH = ESTK
ESTKL = ESTK+ESTKSZ/2
VMZP = ESTK+ESTKSZ
IFP = VMZP
IFPL = IFP
@ -25,6 +23,7 @@ PPL = PP
PPH = PP+1
IPY = PP+2
ESP = IPY+1
TMP = ESP+1
JMPTMP = ESP+1
TMP = JMPTMP+1
TMPL = TMP
TMPH = TMP+1

4
src/vmsrc/soscmd.pla
View File

@ -153,8 +153,7 @@ REGVALS = SRC
LDA ESTKL,X
PHA
INX
LDA ESTKL,X
TAY
LDY ESTKL,X
INX
LDA ESTKL+1,X
PHA
@ -178,7 +177,6 @@ REGVALS = SRC
STY ESTKH,X
PLP
RTS
JMPTMP JMP (TMP)
end
//
// SET MEMORY TO VALUE