1
0
mirror of https://github.com/dschmenk/PLASMA.git synced 2026-04-20 16:16:34 +00:00

70 Commits

Author SHA1 Message Date
David Schmenk 7aaba1f9ef Update notes to 1.2 2018-05-11 06:17:28 -07:00
David Schmenk a61da48e5d Update README.md 2018-05-11 06:16:07 -07:00
David Schmenk 45489b3ab8 Update image 2018-05-07 12:41:06 -07:00
David Schmenk 81e40c4c7f Fix unhandled IRQ on IIGS 2018-05-07 10:23:31 -07:00
David Schmenk 6ff3cc2673 Update images 2018-05-02 18:26:37 -07:00
David Schmenk f964099c24 Stop continuous events when mouse button pressed 2018-05-02 13:27:58 -07:00
David Schmenk 54ecb3eec7 Generate mouse event on button state change 2018-05-02 13:18:00 -07:00
David Schmenk bb97fe6353 Fix infunc for asm defs 2018-05-01 07:39:51 -07:00
David Schmenk 9e441de1c2 Version 1.2 with IRQ fixes and mouse module 2018-04-29 19:13:03 -07:00
David Schmenk 3d337f4fa8 Change TFTPD text file EOL strategy 2018-04-29 14:50:39 -07:00
David Schmenk 15e4013f97 Fix tftp xlte bug when writing text files. Bunp version 2018-04-29 07:25:43 -07:00
David Schmenk 5f1656b6a1 Backport some fixes from V2 2018-04-27 14:10:26 -07:00
David Schmenk 9809c2b5b2 Add TFTPD to release 1 2018-04-23 13:47:42 -07:00
David Schmenk c0ddb5d197 Add TFTPD to release 1 2018-04-23 13:46:08 -07:00
David Schmenk e3606f3f64 Fix byte variable used in negative FOR/NEXT 2018-04-05 11:51:53 -07:00
David Schmenk c2ee311517 Merge branch 'master' of https://github.com/dschmenk/PLASMA 2018-03-13 18:09:49 -07:00
David Schmenk 28571b4a35 Fix #%$&^! optimizer bug 2018-03-13 18:09:14 -07:00
David Schmenk 8b6f54e956 Update README.md 2018-03-13 11:24:27 -07:00
David Schmenk 46b0c2c041 Version 1.1 2018-03-13 11:22:10 -07:00
Dave Schmenk ba1734dd25 Update images 2018-03-13 10:30:59 -07:00
Dave Schmenk 28d1ad252a Fix for makefile noise for OSX 2018-03-13 09:41:58 -07:00
David Schmenk e280ae190b Merge pull request #39 from ZornsLemma/quieter-makefile
Reduce makefile noise
2018-03-13 16:27:40 +00:00
Dave Schmenk af44d7ee9a Fix sign of divmod 2018-03-13 09:22:17 -07:00
David Schmenk 8730e2ff9a Update test cases and portable VM 2018-03-13 07:48:34 -07:00
David Schmenk 6bbc5b6381 Fix mod sign 2018-03-12 20:47:07 -07:00
David Schmenk e77aceb4ea Assembly helper function for lex scanner ID/keyword match 2018-03-12 15:21:36 -07:00
David Schmenk 76fd2328d9 Compiler bugfixes 2018-03-10 19:00:01 -08:00
Steven Flintham f633944e48 Tweak makefile to avoid noisy no-op builds
Without this, typing 'make' when there's nothing to do generates
slightly scary-looking output.
2018-03-03 15:47:00 +00:00
ZornsLemma 70eb667db9 Merge pull request #10 from dschmenk/master
Merge latest upstream
2018-03-03 15:45:34 +00:00
Dave Schmenk 28f6e11606 Don't over-copy 65C02 routines 2018-03-02 21:54:03 -08:00
Dave Schmenk 8f408c8bbb more robust MB check 2018-02-26 19:32:20 -08:00
David Schmenk 8ebe11621a Better MockingBoard detection 2018-02-26 11:31:59 -08:00
David Schmenk b96c08fb59 Update Version 1.0.md 2018-02-26 06:41:03 -08:00
David Schmenk 0b37080b64 Update Version 1.0.md 2018-02-26 06:40:42 -08:00
David Schmenk 86408f5157 First Commodore 64 version! 2018-02-24 18:11:06 -08:00
David Schmenk c5d4d7d35f Update images for Apple 3 sound sequencer 2018-02-24 12:29:47 -08:00
David Schmenk b6bb431ac2 Remove apple II-isms from sndseq 2018-02-24 10:28:52 -08:00
David Schmenk e79d17c14a Update images 2018-02-23 18:25:16 -08:00
David Schmenk 47217c0d93 Add some useful links 2018-02-23 17:47:32 -08:00
David Schmenk 03923a9825 Uthernet II found! Fix HTTPD! 2018-02-23 17:11:55 -08:00
David Schmenk 6eb842e472 More precision for axis 2018-02-23 15:23:42 -08:00
David Schmenk ea5bdccb82 Joystick dual axis read + buzz in constant time 2018-02-23 09:29:22 -08:00
David Schmenk 44e307325c Create rel directories 2018-02-22 08:09:37 -08:00
Dave Schmenk e241719ea5 Update line drawer with new PLASMA-isms 2018-02-21 09:53:11 -08:00
David Schmenk 4204d47d3c formatting 2018-02-21 09:44:59 -08:00
Dave Schmenk 56c033fe58 Clean up samplesrc 2018-02-21 07:31:52 -08:00
Dave Schmenk da8fce2f96 Don't want built binaries in repo 2018-02-21 07:27:00 -08:00
Dave Schmenk ac78dad38f Seed Commodore 64 code 2018-02-21 07:25:22 -08:00
Dave Schmenk eb4bb099f1 Get proper link for plvmzp.inc established 2018-02-20 22:56:55 -08:00
Dave Schmenk 3a448329d0 opy ED from rel 2018-02-20 22:38:46 -08:00
Dave Schmenk 3fbf2e4fbd Support multiple architecture ports 2018-02-20 17:27:44 -08:00
Dave Schmenk a2c83dfdc0 Update images 2018-02-19 16:22:40 -08:00
David Schmenk efe08f8ea7 Save a couple bytes and sync label names 2018-02-17 10:34:09 -08:00
David Schmenk f266f1c035 Apple 3 graphics demo 2018-02-12 12:12:16 -08:00
David Schmenk c9a5b25194 Apple /// graphics library 2018-02-11 21:46:21 -08:00
David Schmenk 5c56020c2b Apple /// graphics libary 2018-02-11 21:45:31 -08:00
David Schmenk 02760f1038 Thanks SteveF! 2018-02-10 19:33:48 -08:00
ZornsLemma 5b9212be82 Merge pull request #9 from dschmenk/master
Merge latest upstream changes
2018-02-10 23:40:04 +00:00
David Schmenk dd4ecb77b3 Apple /// and ][ editor tweaks 2018-02-10 10:39:30 -08:00
David Schmenk 1fce2f5916 Apple /// and ][ editor keyboard tweaks 2018-02-10 10:09:33 -08:00
David Schmenk 9ee760007a PLASM patch #2 2018-02-09 20:39:05 -08:00
David Schmenk 474f0a9017 PLASM type override bug :-( 2018-02-09 20:17:13 -08:00
David Schmenk c786d4aaf8 Merge branch 'master' of https://github.com/dschmenk/PLASMA 2018-02-09 14:17:07 -08:00
David Schmenk ebff3ebc07 Allocate all interp bank. Check path during set_pfx 2018-02-09 14:16:06 -08:00
David Schmenk 3d1d82d8fc Update image 2018-02-08 18:49:23 -08:00
David Schmenk 7af5d53fbb Allow Apple3 heap allocator to skip graphics memory 2018-02-08 18:46:50 -08:00
David Schmenk b986e1da38 PLASM compiler patch #1 2018-02-07 12:01:55 -08:00
ZornsLemma 5a48384daa Merge pull request #8 from dschmenk/master
Merge latest upstream changes
2018-01-27 20:52:50 +00:00
ZornsLemma 9174cfef2a Merge pull request #7 from dschmenk/master
Merge latest upstream changes
2018-01-16 20:53:39 +00:00
ZornsLemma aef3daccb5 Merge pull request #6 from dschmenk/master
Merge latest upstream changes
2017-12-17 17:50:50 +00:00
81 changed files with 6480 additions and 650 deletions
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
+2 -2
View File
@@ -1,5 +1,5 @@
# 2/6/2018 PLASMA 1.0 Available! # 4/29/2018 PLASMA 1.2 Available!
[Download and read the Release Notes](https://github.com/dschmenk/PLASMA/blob/master/doc/Version%201.0.md) [Download and read the Release Notes](https://github.com/dschmenk/PLASMA/blob/master/doc/Version%201.2.md)
# The PLASMA Programming Language # The PLASMA Programming Language
+77 -39
View File
@@ -37,61 +37,99 @@ MEMORY FOR THE TEXT BUFFER.
IT HAS TWO MODES, COMMAND AND EDIT. IT HAS TWO MODES, COMMAND AND EDIT.
EDIT COMMANDS: EDIT COMMANDS:
LEFT ARROW = MOVE CHAR LEFT LEFT ARROW = MOVE CHAR LEFT
RIGHT ARROW = MOVE CHAR RIGHT RIGHT ARROW = MOVE CHAR RIGHT
UP ARROW = MOVE LINE UP UP ARROW = MOVE LINE UP
DOWN ARROW = MOVE LINE DOWN DOWN ARROW = MOVE LINE DOWN
CTRL-K = MOVE LINE UP CTRL-K = MOVE LINE UP
CTRL-J = MOVE LINE DOWN CTRL-J = MOVE LINE DOWN
CTRL-A = JUMP LEFT CTRL-A = JUMP LEFT
CTRL-S = JUMP RIGHT CTRL-S = JUMP RIGHT
CTRL-W = JUMP UP CTRL-W = JUMP UP
CTRL-Z = JUMP DOWN CTRL-Z = JUMP DOWN
CTRL-Q = JUMP BEGIN CTRL-Q = JUMP BEGIN
CTRL-E = JUMP END CTRL-E = JUMP END
CTRL-D = DELETE CHAR CTRL-D = DELETE CHAR
CTRL-X = DELETE LINE CTRL-X = DELETE/CUT LINE
CTRL-V = COPY DELETED LINE CTRL-V = COPY DELETED LINE
CTRL-O = OPEN NEW LINE CTRL-O = OPEN NEW LINE
CTRL-F = OPEN A FOLLOWING NEW LINE CTRL-F = OPEN A FOLLOWING NEW LINE
CTRL-T = JOIN LINES CTRL-T = JOIN LINES
CTRL-I = TOGGLE INSERT/OVERWRITE CTRL-B = TOGGLE INSERT/OVERWRITE
ESCAPE = SWITCH TO COMMAND MODE TAB/CTRL-I = INSERT SPACES TO NEXT TAB
ESCAPE = SWITCH TO COMMAND MODE
DELETE = DELETE CHAR LEFT
APPLE ][ FEATURES: APPLE ][ FEATURES:
------------------
SHIFT-M = ] SHIFT-M = ]
CTRL-N = [ CTRL-N = [
CTRL-P = _ SHIFT-CTRL-N = ~
CTRL-B = | CTRL-P = \
CTRL-Y = ~ SHIFT-CTRL-P = |
CTRL-L = SHIFT LOCK CTRL-G = _
CTRL-L = SHIFT LOCK
SHIFT-LEFT ARROW = DELETE (SHIFT-MOD) SHIFT-LEFT ARROW = DELETE (SHIFT-MOD)
WITH THE SHIFT-KEY MOD ON AN WITH THE SHIFT-KEY MOD ON AN
APPLE ][, UPPER AND LOWER CASE APPLE ][, UPPER AND LOWER CASE
ENTRY WORKS AS EXPECTED. ENTRY WORKS AS EXPECTED.
CTRL-C = FORCE LOWER-CASE CHARS CTRL-C = FORCE LOWER-CASE CHARS
IF YOU HAVE A LOWER-CASE CHARACTER If you have a lower-case character
GENERATOR INSTALLED, YOU CAN FORCE generator installed, you can force
LOWER-CASE DISPLAY. OTHERWISE, lower-case display. Otherwise,
UPPER CASE WILL BE DISPLAYED NORMALLY upper case will be displayed normally
BUT lower-case will be displayed in but lower-case will be displayed in
inverse. This is the default. inverse. This is the default.
Apple //e AND //c FEATURES: Apple //e AND //c FEATURES:
---------------------------
THE 'CLOSED-APPLE' KEY WILL MODIFY The 'SOLID-APPLE' key will modify
THE ARROW KEYS INTO THEIR JUMP theese keys:
EQUIVALENTS. IT WILL ALSO MODIFY
THE 'RETURN' KEY TO OPEN UP A LINE,
JUST LIKE CTRL-F.
COMMAND MODE: SA-RETURN = OPEN LINE
SA-LEFT ARROW = JUMP LEFT
SA-RIGHT ARROW = JUMP RIGHT
SA-UP ARROR = JUMP UP
SA-DOWN ARROW = JUMP DOWN
Apple /// FEATURES:
-------------------
The 'OPEN-APPLE' key will modify
these keys:
OA-\ = DELETE CHAR LEFT
OA-RETURN = OPEN LINE
OA-LEFT ARROW = JUMP LEFT
OA-RIGHT ARROW = JUMP RIGHT
OA-UP ARROR = JUMP UP
OA-DOWN ARROW = JUMP DOWN
On the keypad, 'OPEN-APPLE' allows
the keys for navigation and misc:
OA-4 = MOVE CHAR LEFT
OA-6 = MOVE CHAR RIGHT
OA-8 = MOVE LINE UP
OA-2 = MOVE LINE DOWN
OA-9 = JUMP UP
OA-3 = JUMP DOWN
OA-7 = JUMP BEGIN
OA-1 = JUMP END
OA-5 = DELETE CHAR
OA-- = DELETE/CUT LINE
OA-0 = COPY DELETED LINE
OA-ENTER = OPEN NEW LINE
OA-. = TOGGLE INSERT/OVERWRITE
COMMAND MODE:
<REQUIRED PARAMETER> <REQUIRED PARAMETER>
[OPTIONAL PARAMETER] [OPTIONAL PARAMETER]
+21 -5
View File
@@ -1,16 +1,16 @@
# PLASMA Version 1.0 # PLASMA Version 1.2
Welcome to PLASMA: the Grand Unifying Platform for the Apple 1, ][, and ///. Welcome to PLASMA: the Grand Unifying Platform for the Apple 1, ][, and ///.
Download the four disk images (three if you don't plan to boot an Apple ///): Download the four disk images (three if you don't plan to boot an Apple ///):
[PLASMA 1.0 System](https://github.com/dschmenk/PLASMA/blob/master/PLASMA-SYS1.PO?raw=true) [PLASMA 1.2 System and ProDOS Boot](https://github.com/dschmenk/PLASMA/blob/ver-1/PLASMA-SYS1.PO?raw=true)
[PLASMA 1.0 Build Tools](https://github.com/dschmenk/PLASMA/blob/master/PLASMA-BLD1.PO?raw=true) [PLASMA 1.2 Build Tools](https://github.com/dschmenk/PLASMA/blob/ver-1/PLASMA-BLD1.PO?raw=true)
[PLASMA 1.0 Demos](https://github.com/dschmenk/PLASMA/blob/master/PLASMA-DEM1.PO?raw=true) [PLASMA 1.2 Demos](https://github.com/dschmenk/PLASMA/blob/ver-1/PLASMA-DEM1.PO?raw=true)
[PLASMA 1.0 Apple /// SOS Boot ](https://github.com/dschmenk/PLASMA/blob/master/PLASMA-SOS1.PO?raw=true) [PLASMA 1.2 Apple /// SOS Boot ](https://github.com/dschmenk/PLASMA/blob/ver-1/PLASMA-SOS1.PO?raw=true)
PLASMA can be run from floppies, System in Drive 1, and Build or Demos in Drive 2. Mass storage is the recommended installation that looks like (replacing HARDISK with your volume name of choice): PLASMA can be run from floppies, System in Drive 1, and Build or Demos in Drive 2. Mass storage is the recommended installation that looks like (replacing HARDISK with your volume name of choice):
@@ -98,6 +98,22 @@ There is a [YouTube playlist](https://www.youtube.com/playlist?list=PLlPKgUMQbJ7
- The documentation is sparse and incomplete. Yep, could use your help... - The documentation is sparse and incomplete. Yep, could use your help...
# Changes in PLASMA for 1.2
1. Add TFTPD TFTP server
2. Fix Uthernet 1 driver
3. Add mouse module
4. Fix IRQ issues for interrupt driven mouse driver
# Changes in PLASMA for 1.1
1. All known bugs are fixed
2. PLASM compiler received a little performance boost with an assembly language helper for ID/keyword lexical scanner
# Changes in PLASMA for 1.0 # 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: 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
View File
@@ -1 +0,0 @@
CONST FALSE = 0
+14
View File
@@ -0,0 +1,14 @@
import grafix
predef pencolor(clr)#0
predef fillcolor(clr)#0
predef fillscreen()#0
predef penmove(x, y)#0
predef plot(x, y)#0
predef line(x1, y1, x2, y2)#0
predef lineto(x, y)#0
predef rect(x1, y1, x2, y2)#0
predef fillrect(x1, y1, x2, y2)#0
predef bitblt(blk, pitch, x, y, width, height)#0
predef drawmode(mode)#0
predef setmode(mode)#0
end
+4
View File
@@ -0,0 +1,4 @@
import joybuzz
const MAX_JOY = 79
predef joypos(buzz)#4
end
+32
View File
@@ -0,0 +1,32 @@
import mouse
//
// Status bits
//
const BUTTON_DOWN = $80
const BUTTON_LAST_DOWN = $40
const MOUSE_MOVED = $20
const VBL_INT = $08
const BUTTON_INT = $04
const MOVE_INT = $02
//
// Mode bits
//
const VBL_INT_ENABLE = $08
const BUTTON_INT_ENABLE= $04
const MOVE_INT_ENABLE = $02
const MOUSE_ENABLE = $01
//
// Mouse API
//
struc t_mouse
word chkVBL
word chkMouse
word readMouse // readMouse()#3
word setMouse // setMouse(mode)
word clearMouse
word posMouse // posMouse(x, y)
word clampMouse // clampMouse(xMin, xMax, yMin, yMax)
word homeMouse
word detachMouse
end
end
+11 -22
View File
@@ -506,7 +506,7 @@ asm _dgrFillTile
RTS RTS
end end
// //
// Wait for VLB - Doens't work on //c // Wait for VLB - Shouldn't work on //c, but seems to.
// //
asm vlbWait#0 asm vlbWait#0
- LDA $C019 - LDA $C019
@@ -525,7 +525,6 @@ export def dgrMode#1
^showpage1 ^showpage1
^ena80 = 0 ^ena80 = 0
^show80 = 0 ^show80 = 0
// ^mapaux = 0
^an3on ^an3on
return 1 return 1
end end
@@ -578,16 +577,11 @@ export def dgrLine(buff, x1, y1, x2, y2)#0
fin fin
dx2 = dx << 1 dx2 = dx << 1
dy2 = dy << 1 dy2 = dy << 1
if dx >= dy if dx >= dy // Horizontal line
// Horizontal line
if sx < 0 if sx < 0
pp = x1 x1, x2 = x2, x1
x1 = x2 y1, y2 = y2, y1
x2 = pp sy = -sy
pp = y1
y1 = y2
y2 = pp
sy = -sy
fin fin
dd2 = dx2 - dy2 dd2 = dx2 - dy2
err = dx - dy2 err = dx - dy2
@@ -600,7 +594,7 @@ export def dgrLine(buff, x1, y1, x2, y2)#0
sx = 1 sx = 1
dy-- dy--
err = err + dd2 err = err + dd2
else else
sx++ sx++
err = err - dy2 err = err - dy2
fin fin
@@ -608,16 +602,11 @@ export def dgrLine(buff, x1, y1, x2, y2)#0
if y2 == y1 if y2 == y1
dgrHLin(buff, x1, x2, y1) dgrHLin(buff, x1, x2, y1)
fin fin
else else // Vertical line
// Vertical line
if sy < 0 if sy < 0
pp = x1 x1, x2 = x2, x1
x1 = x2 y1, y2 = y2, y1
x2 = pp sx = -sx
pp = y1
y1 = y2
y2 = pp
sx = -sx
fin fin
dd2 = dy2 - dx2 dd2 = dy2 - dx2
err = dy - dx2 err = dy - dx2
@@ -630,7 +619,7 @@ export def dgrLine(buff, x1, y1, x2, y2)#0
sy = 1 sy = 1
dx-- dx--
err = err + dd2 err = err + dd2
else else
sy++ sy++
err = err - dx2 err = err - dx2
fin fin
+174
View File
@@ -0,0 +1,174 @@
include "inc/cmdsys.plh"
byte gfxref, gfxseg
byte params[8], cmd[16]
export def pencolor(clr)#0
params:4 = 2
cmd.0 = 19 // Pen color
cmd.1 = clr
syscall($CB, @params)
end
export def fillcolor(clr)#0
params:4 = 2
cmd.0 = 20 // Fill color
cmd.1 = clr
syscall($CB, @params)
end
export def fillscreen()#0
params:4 = 1
cmd.9 = 28 // Clear viewport
syscall($CB, @params)
end
export def penmove(x, y)#0
params:4 = 5
cmd.0 = 26 // Move pen
cmd:1 = x
cmd:3 = y
syscall($CB, @params)
end
export def plot(x, y)#0
params:4 = 5
cmd.0 = 25 // Plot
cmd:1 = x
cmd:3 = y
syscall($CB, @params)
end
export def line(x1, y1, x2, y2)#0
params:4 = 10
cmd.0 = 26 // Move pen
cmd:1 = x1
cmd:3 = y1
cmd.5 = 24 // Line
cmd:6 = x2
cmd:8 = y2
syscall($CB, @params)
end
export def lineto(x, y)#0
params:4 = 5
cmd.0 = 24 // Line
cmd:1 = x
cmd:3 = y
syscall($CB, @params)
end
export def rect(x1, y1, x2, y2)#0
params:4 = 10
cmd.0 = 26 // Move pen
cmd:1 = x1
cmd:3 = y1
cmd.5 = 24 // Line
cmd:6 = x2
cmd:8 = y1
syscall($CB, @params)
params:4 = 15
cmd.0 = 24 // Line
cmd:1 = x2
cmd:3 = y2
cmd.5 = 24 // Line
cmd:6 = x1
cmd:8 = y2
cmd.10 = 24 // Line
cmd:11 = x1
cmd:13 = y1
syscall($CB, @params)
end
export def fillrect(x1, y1, x2, y2)#0
params:4 = 11
cmd.0 = 2 // Set viewport
cmd:1 = x1
cmd:3 = x2
cmd:5 = y1
cmd:7 = y2
cmd.9 = 28 // Clear viewport
cmd.10 = 1 // Reset viewport
syscall($CB, @params)
end
export def bitblt(bits, pitch, x, y, width, height)#0
params:4 = 14
cmd.0 = 4 // Draw block
cmd:1 = bits
cmd.3 = ^$FFED & $8F
cmd:4 = pitch
cmd:6 = x
cmd:8 = y
cmd:10 = width
cmd:12 = height
syscall($CB, @params)
end
export def drawmode(mode)#0
params:4 = 2
cmd.0 = 21 // Transfer mode
cmd.1 = mode
syscall($CB, @params)
end
export def setmode(mode)#0
if mode < 0
//
// Free driver
//
params.0 = 1
params.1 = gfxref
syscall($CC, @params)
gfxref = 0
//
// Deaalocate bank 0
//
params.0 = 1
params.1 = gfxseg
syscall($45, @params)
^$1907 = $00 // Unset graphics pages allocated
fin
if not gfxref
return
fin
params.0 = 3
params.1 = gfxref
params:2 = @cmd
params:4 = 8
cmd.0 = 16 // Set mode
cmd.1 = mode
cmd.2 = 19 // Pen color
cmd.3 = 0
cmd.4 = 1 // Reset viewport
cmd.5 = 28 // Clear viewport
cmd.7 = 15 // Turn on screen
syscall($CB, @params)
end
if MACHID <> $F2
puts("Apple /// only.\n")
return -1
fin
//
// Allocate bank 0
//
params.0 = 4
params:1 = $2000
params:3 = $9F00
params.5 = $10
params.6 = $00
syscall($40, @params)
gfxseg = params.6
^$1907 = $80 // Set graphics pages allocated
//
// Open graphics driver
//
params.0 = 4
params:1 = ".GRAFIX"
params.3 = 0
params:4 = 0
params.6 = 0
syscall($C8, @params)
gfxref = params.3
done
+60
View File
@@ -0,0 +1,60 @@
asm asmdefs
!SOURCE "vmsrc/plvmzp.inc"
SPEAKER = $C030
GCSTRB = $C070
GC0 = $C064
GC1 = $C065
GCPB1 = $C061
GCPB2 = $C062
GCMAX = 79 ; MAX VALUE FOR GAME CONTROLLER
end
//
// Read both game controllers in parallel
//
export asm joypos(buzz)#4
LDY ESTKL,X ; BUZZ TONE
STY TMPH
DEX
DEX
DEX
LDA #$00
STA ESTKL+2,X
STA ESTKH+2,X
STA ESTKL+3,X
STA ESTKH+3,X
LDA #GCMAX
SEC
BIT GCSTRB
BUZZ DEY
BNE BUZZDLY
BIT SPEAKER
LDY TMPH ; BUZZ TONE
GC0READ BIT GC0
BPL GC0DLY
INC ESTKL+3,X
GC1READ BIT GC1
BPL GC1DLY
INC ESTKL+2,X
JOYLP SBC #$01
BNE BUZZ
TAY ; LDY #$00
BIT GCPB1 ; READ GC BUTTONS
BPL +
DEY
+ STY ESTKL+1,X
STY ESTKH+1,X
TAY ; LDY #$00
BIT GCPB2
BPL +
DEY
+ STY ESTKL,X
STY ESTKH,X
RTS
GC0DLY NOP ; TIMING
BPL GC1READ
GC1DLY NOP ; TIMING
BPL JOYLP
BUZZDLY BNE + ; TIMING
+ BNE GC0READ
end
done
+583
View File
@@ -0,0 +1,583 @@
include "inc/cmdsys.plh"
//
// Mouse driver interface
//
predef chkVbl, chkMouse, readMouse#3, setMouse(mode), clearMouse, posMouse(x, y), clampMouse(xMin, xMax, yMin, yMax), homeMouse, detachMouse
word = @chkVbl, @chkMouse, @readMouse, @setMouse, @clearMouse, @posMouse, @clampMouse, @homeMouse, @detachMouse
word rom
byte params[]
byte slot, index, page
word setMouseFW
byte vblDiv, vblInt, mouInt, bttnPrev
asm equates
!SOURCE "vmsrc/plvmzp.inc"
end
//
// Serve Mouse/VBL IRQ
//
asm serviceMouse#0
VBLINT = $400 ; DUMMY VALUES TO BE FIXED-UP
MOUINT = $401
LASTBTTN= $402
CLD
JSR $C400
BCC +
RTS ; NOT MOUSE INT
+ LDY $0778+4 ; CHECK MOUSE INT CAUSE
TYA ; WAS IT VBL?
AND #$08
BEQ + ; NOPE, MOVE OR BUTTON
end
asm vblEvent
INC VBLINT ; INC VBL EVENT
+ TYA ; MOUSE MOVE OR BUTTON ACTIVE
AND #$82
end
asm bttnEvent
EOR LASTBTTN
BEQ +
end
asm mouseEvent
INC MOUINT ; INC MOUSE EVENT
+ TYA
AND #$80
end
asm updateBttn
STA LASTBTTN
end
asm updateMouse
LDX #$C4
LDY #$40
JMP $C400 ; IIGS REQUIRES THIS HAPPEN IN IRQ
end
asm serviceCYA#0
CLC
RTS
end
//
// Check for VBL (timer) and Mouse events (atomic read and reset)
//
asm chkEvt(addr)
LDA ESTKL,X
STA ESTKH-1,X
SEI
LDA (ESTKH-1,X) ; READ INT COUNT
TAY
LDA #$00
STA (ESTKH-1,X) ; CLEAR INT COUNT
CLI
STY ESTKL,X ; RETURN INT COUNT
STA ESTKH,X
RTS
end
asm readMouse#3
LDY #$04
DEX
DEX
DEX
PHP
SEI
LDA $0478,Y
STA ESTKL+2,X
LDA $0578,Y
STA ESTKH+2,X
LDA $04F8,Y
STA ESTKL+1,X
LDA $05F8,Y
STA ESTKH+1,X
LDA $0778,Y
STA ESTKL,X
LDA #$00
STA ESTKH,X
PLP
RTS
end
//
// Convert VBL interrupts into millisecond timer increment
//
def chkVblTimer
byte count
word msec
msec = 0
count = chkEvt(@vblInt)
while count
if vblDiv & 2
msec = msec + 16
vblDiv = 0
else
msec = msec + 17
vblDiv++
fin
count--
loop
return msec
end
//
// Check for VBL/Mouse interrupt events
//
def chkVbl
return chkEvt(@vblInt)
end
def chkMouse
return chkEvt(@mouInt)
end
//
// Mouse routines
//
def setMouse(mode)
return call(setMouseFW, mode, slot, page, $04)
end
def clearMouse
return call(rom + rom->$15, $00, slot, page, $04) // clearMouseFW
end
def posMouse(x, y)
//
// Fill screen holes
//
^($0478 + index) = x
^($0578 + index) = x >> 8
^($04F8 + index) = y
^($05F8 + index) = y >> 8
return call(rom + rom->$16, $00, slot, page, $04) // posMouseFW
end
def clampMouse(xMin, xMax, yMin, yMax)
^$0478 = xMin
^$0578 = xMin >> 8
^$04F8 = xMax
^$05F8 = xMax >> 8
call(rom + rom->$17, $00, slot, page, $04) // clampMouseFW
^$0478 = yMin
^$0578 = yMin >> 8
^$04F8 = yMax
^$05F8 = yMax >> 8
return call(rom + rom->$17, $01, slot, page, $04)) // clampMouseFW
end
def homeMouse
return call(rom + rom->$18, $00, slot, page, $04) // homeMouseFW
end
//
// Detach mouse from interrupts
//
def detachMouse
setMouse(0)
params.0 = 1
params.1 = 0
return syscall($41, @params)
end
//
// Identify Mouse card/slot and initialize
//
for rom = $C100 to $C700 step $0100
if rom->5 == $38 and rom->7 == $18 and rom->11 == $01 and rom->12 == $20
puts("Found Mouse in slot #"); putc('0' + ((rom >> 8) & $07)); putln
//
// Hook mouse IRQ handler into ProDOS IRQ chain
//
params.0 = 2
params.1 = 0
params:2 = @serviceMouse
syscall($40, @params)
//
// Hook CYA IRQ handler into ProDOS IRQ chain
//
params.0 = 2
params.1 = 3
params:2 = @serviceCYA
syscall($40, @params)
//
// Set values
//
slot = rom >> 8
index = slot & $07
page = index << 4
setMouseFW = rom + rom->$12
//
// Fix-up IRQ routine
//
serviceMouse:2 = rom + rom->$13 // serveMouseFW
serviceMouse:8 = $0778+index
vblEvent:1 = @vblInt
bttnEvent:1 = @bttnPrev
mouseEvent:1 = @mouInt
updateBttn:1 = @bttnPrev
updateMouse.1 = slot
updateMouse.3 = page
updateMouse:5 = rom + rom->$14 // readMouseFW
readMouse.1 = index
call(rom + rom->$19, $00, slot, page, $04) // initMouseFW
return modkeep
fin
next
//
// Not found
//
return -1
done
What follows is the relevant parts to the mouse driver for VM02
CHKMOUSE: LDX #$20 ; LOOK FOR MOUSE
LDA #$01
JSR SCAN_SLOTS
BCS NOMOUSE
PHA ; SAVE SLOT
LDY #$13
LDA (TMPTR),Y
STA SERVEMOUSE+1 ; FIXUP IRQ HANDLER
STX SERVEMOUSE+2
LDY #$14
LDA (TMPTR),Y
STA READMOUSE+1 ; FIXUP IRQ HANDLER
STX READMOUSE+2
TXA
AND #$07
STA MOUSE_SLOT
TAY
JSR MOUSE_INIT ; MAKE SURE MOUSE IS OFF, INTS OFF
LDA WARM_INIT
BNE :+
JSR PUTS
.ASCIIZ "Mouse in slot #"
LDA MOUSE_SLOT
JSR PRBYTE
JSR CROUT
: PLA
TAY
LDA #<MOUSE_DRIVER ; LOAD MOUSE DRIVER
LDX #>MOUSE_DRIVER
JSR LOAD_DRIVER
;
; SCAN SLOTS FOR MATCHING CARD ID
; ENTRY: A = START SLOT SCAN
; X = CARD ID
; EXIT: A = SLOT # :: C = 0
; X = SLOT PAGE
;
SCAN_SLOTS: ORA #$C0
STA TMPTR+1
LDA #$00
STA TMPTR
CHKSIG: LDY #$05
LDA (TMPTR),Y
CMP #$38 ; LOOK FOR PASCAL COMPAT SIG
BNE :+
LDY #$07
LDA (TMPTR),Y
CMP #$18
BNE :+
LDY #$0B
LDA (TMPTR),Y
CMP #$01
BNE :+
LDY #$0C
TXA ; LOOK FOR MATCHING ID
CMP (TMPTR),Y
BNE :+
LDA TMPTR+1
TAX
AND #$07
CLC
RTS
: INC TMPTR+1
LDA TMPTR+1
CMP #$C8
BCC CHKSIG
SEC
RTS
;*
;* TURN VBL INTS ON AFTER INIT
;*
VBL_INIT: LDA MOUSE_SLOT
BEQ NOVBL
ASL
TAX
LSR
ORA #MOUSECTL_CALLFW
TAY
SEI ; TURN OFF INTERRUPTS
LDA LINK_DEVCTRL,X
STA CALLVBLPROC+1
LDA LINK_DEVCTRL+1,X
STA CALLVBLPROC+2
LDA #$08 ; TURN MOUSE OFF, LEAVE VBL ON
LDX #$12
CALLVBLPROC: JSR $0000
CLI ; BACK ON
LDA WARM_INIT
BNE NOVBL
JSR PUTSLN
.ASCIIZ "VBlank timer active"
NOVBL: RTS
JSR PRODOS
.BYTE $40 ; ALLOC INTERRUPT
.ADDR ALLOCINTPARMS
.IFDEF DEBUG
BCC :+
JSR PUTSLN
.ASCIIZ "FAILED TO ALLOCATE INTERRUPT"
:
.ENDIF
RTS
ALLOCINTPARMS: .BYTE $02
.BYTE $00 ; INT NUM
.ADDR IO_INTERRUPT ; INT CODE
;*
;* I/O INTERRUPT ROUTINE
;*
IO_INTERRUPT: CLD
LDY #$02 ; SLOT #1 * 2
FNDIRQPROC: LDA LINK_DEVIRQ+1,Y
BEQ NXTIRQPROC
STA CALLIRQPROC+2
LDA LINK_DEVIRQ,Y
STA CALLIRQPROC+1
TYA
LSR
PHA
CALLIRQPROC: JSR $0000
BCS :+
PLA
TAY
PHA
JSR THREAD_NOTIFYIO
: PLA
ASL
TAY
NXTIRQPROC: INY
INY
CPY #$10
BCC FNDIRQPROC
CLC
RTS
;*
;* MOUSE DEVICE DRIVER
;*
MOUSE_INIT: ORA #$C0
STA XREGMOUSE1+1
STA XREGMOUSE2+1
ASL
ASL
ASL
ASL
STA YREGMOUSE1+1
STA YREGMOUSE2+1
LDA #$00
PHA ; DISABLE ALL MOUSE INTS
LDX #$12 ; FW INDEX FOR SETMOUSE
BNE CALLMOUSEFW
MOUSE_DRIVER:
MOUSE_DRVR_SZ: .WORD MOUSE_DRVR_END - MOUSE_DRVR_START
MOUSE_READ_OFS: .WORD MOUSE_READ - MOUSE_DRVR_START
MOUSE_WRITE_OFS: .WORD MOUSE_WRITE - MOUSE_DRVR_START
MOUSE_CTRL_OFS: .WORD MOUSE_CTRL - MOUSE_DRVR_START
MOUSE_IRQ_OFS: .WORD MOUSE_IRQ - MOUSE_DRVR_START
MOUSE_DRVR_START:
MOUSE_READ:
MOUSE_WRITE: SEC
RTS
MOUSE_X: .WORD $0000
MOUSE_Y: .WORD $0000
MOUSE_STATUS: .BYTE $00
MOUSE_CTRL: PHA
TYA
AND #$F8 ; MASK OFF SLOT #
CMP #MOUSECTL_CALLFW
BNE :+
CALLMOUSEFW: STX OPADDR
XREGMOUSE2: LDX #$C4
STX OPADDR+1
LDY #$00
LDA (OPADDR),Y ; GET ENTRYPOINT OFFSET
STA OPADDR
YREGMOUSE2: LDY #$40
PLA
SEI
JMP (OPADDR) ; CALL FIXED UP FUNCTION POINTER
: CMP #MOUSECTL_READMOUSE ; COPY MOUSE STATUS/POSITION INTO EASILY ACCESSIBLE MEMORY
BNE :+
PLA
TYA
AND #$07
TAX ; SAVE MOUSE PARAMETERS
ASL
TAY
LDA LINK_DEVREAD,Y
STA TMPTR
LDA LINK_DEVREAD+1,Y
STA TMPTR+1
SEI
LDY #$02
LDA $0478,X
STA (TMPTR),Y
PHA
INY
LDA $0578,X
STA (TMPTR),Y
INY
LDA $04F8,X
STA (TMPTR),Y
PHA
INY
LDA $05F8,X
STA (TMPTR),Y
INY
LDA $0778,X
STA (TMPTR),Y
STA TMP
PLA
TAY
PLA
TAX
LDA TMP
RTS
: CMP #MOUSECTL_CLAMPX
BEQ :+
CMP #MOUSECTL_CLAMPY
BNE :++
: PLA
STA $04F8
STX $05F8
LDA #$00
STA $0478
STA $0578
TYA
LSR
LSR
LSR
AND #$01
PHA
LDX #$17 ; FW INDEX FOR CLAMPMOUSE
BNE CALLMOUSEFW
SETMOUSE: PHA
LDX #$12 ; FW INDEX FOR SETMOUSE
BNE CALLMOUSEFW
: PLA
TYA
AND #$F8 ; MASK OFF SLOT #
CMP #IOCTL_OPEN
BNE :+
LDA #<THREAD_YIELD ; REMOVE SOFTWARE TIMER
STA LINK_YIELD
LDA #>THREAD_YIELD
STA LINK_YIELD+1
LDA #$0F ; TURN MOUSE INTS ON
BNE SETMOUSE
: CMP #IOCTL_CLOSE
BNE :+
LDA #$08 ; TURN MOUSE OFF
BNE SETMOUSE
: CMP #IOCTL_DEACTIVATE
BNE :+
LDA #MOUSECTL_NOIRQ
: CMP #MOUSECTL_NOIRQ ; UNINSTALL IRQ HANDLER
BNE :+
SEI
LDA #<SW_TIMER ; RE-INSTALL SW TIMER
STA LINK_YIELD
LDA #>SW_TIMER
STA LINK_YIELD+1
BNE SETMOUSE
: CMP #IOCTL_ID
BEQ :+
SEC
RTS
: LDA #$20 ; MOUSE ID
CLC
RTS
;
; VBLANK TIMER AND MOUSE IRQ
;
MOUSE_IRQ: STA TMP
SERVEMOUSE: JSR $C400
BCS VBLEXIT ; NOT MOUSE INT
LDY TMP ; CHECK MOUSE INT CAUSE
LDA $0778,Y
PHA
AND #$08 ; WAS IT VLB?
BEQ MOUSEEXIT ; NOPE, MOVE OR BUTTON
VBLTIC: LDX #$00
LDA #$11 ; 17 MSEC (2/3 OF THE TIME)
DEC TIMERADJUST
BNE :+
LDA #$02
STA TIMERADJUST
LDA #$10 ; 16 MSEC (1/3 OF THE TIME)
: JSR SYSTEM_TIC
MOUSEEXIT: PLA
AND #$86 ; MOUSE MOVE OR BUTTON ACTIVE
BEQ VBLEXIT
XREGMOUSE1: LDX #$C4
YREGMOUSE1: LDY #$40
READMOUSE: JSR $C400 ; IIGS REQUIRES THIS HAPPEN IN IRQ
CLC
RTS
VBLEXIT: SEC
RTS
MOUSE_DRVR_END EQU *
package apple2;
/*
* This class interfaces directly with the mouse device driver.
*/
public class Mouse
{
static private int slot, mouseSlot, mouseCtrl, ctrlRead, addrXPos, addrYPos;
static public int xPos, yPos, status;
public static boolean enable()
{
//
// Search for mouse card and disable VBL interrupts
//
for (slot = 1; slot < 8; slot++)
{
int mouse = vm02.call((1 << 19), 0x90 + (slot << 1)); // ID device
if ((mouse & 0x010000FF) == 0x20) // CARRY clear == valid device IOCTL, 0x20 == mouse card ID
{
mouseCtrl = 0x90 + (slot << 1);
mouseSlot = slot << 16;
ctrlRead = mouseSlot | 0x801400;
addrXPos = vm02.peekWord(0x0370 + (slot << 1)) + 2;
addrYPos = addrXPos + 2;
return (vm02.call(mouseSlot | (3 << 19), mouseCtrl) & 0x01000000) == 0; // open port
}
}
slot = 0;
return false;
}
public static void disable()
{
vm02.call(mouseSlot | (4<<19), mouseCtrl); // close port
}
public static void disableIRQ()
{
int vblSlot, vbl;
//
// Search for mouse card and disable/remove interrupts
//
for (vblSlot = 1; vblSlot < 8; vblSlot++)
{
vbl = vm02.call((1 << 19), 0x90 + (vblSlot << 1)); // ID device
if ((vbl & 0x010000FF) == 0x20) // CARRY clear == valid device IOCTL, 0x20 == mouse card ID
{
vm02.call((vblSlot << 16) | (17 << 19), 0x90 + (vblSlot << 1)); // MOUSECTL_UNVBL
break;
}
}
}
public static int slotMask()
{
return (1 << slot);
}
public static void update()
{
status = vm02.call(ctrlRead, mouseCtrl) & 0xFF; // CALL_FW ReadMouse
xPos = vm02.peekWord(addrXPos);
yPos = vm02.peekWord(addrYPos);
}
}
@@ -67,12 +67,14 @@ predef musicStop#0
predef spkrSequence(yield, func)#0 predef spkrSequence(yield, func)#0
predef a2spkrTone(pitch, duration)#0 predef a2spkrTone(pitch, duration)#0
predef a2spkrPWM(sample, speed, len)#0 predef a2spkrPWM(sample, speed, len)#0
predef a2keypressed
// //
// Static sequencer values // Static sequencer values
// //
export word musicSequence = @spkrSequence export word musicSequence = @spkrSequence
export word spkrTone = @a2spkrTone export word spkrTone = @a2spkrTone
export word spkrPWM = @a2spkrPWM export word spkrPWM = @a2spkrPWM
word keypressed = @a2keypressed
word instr[] // Overlay with other variables word instr[] // Overlay with other variables
word seqTrack, seqEvent, seqTime, eventTime, updateTime word seqTrack, seqEvent, seqTime, eventTime, updateTime
@@ -211,6 +213,31 @@ asm psgWrite(pVIA, reg, val)#0
INX INX
RTS RTS
end end
asm viaCheck(pVIA)#1
PHP
SEI
LDA ESTKL,X
STA TMPL
LDA ESTKH,X
STA TMPH
STX ESP
LDX #$80
LDY #$04
SEC
- LDA (TMP),Y
BMI +
DEX
BNE -
TXA ; TIMEOUT
BEQ ++
+ SBC (TMP),Y
++ LDX ESP
STA ESTKL,X
LDA #$00
STA ESTKH,X
PLP
RTS
end
// //
// Apple II speaker tone generator routines // Apple II speaker tone generator routines
// //
@@ -328,6 +355,30 @@ asm a2spkrPWM(sample, speed, len)#0
INX INX
RTS RTS
end end
asm a2keypressed
INC $004E ; rndseed
BNE +
INC $004F
+ DEX
LDY #$00
BIT $C000
BPL +
DEY
+ STY ESTKL,X
STY ESTKH,X
RTS
end
def a3keypressed
byte count
byte params[5]
params.0 = 3
params.1 = cmdsys.devcons
params.2 = 5
params:3 = @count
syscall($82, @params)
return count
end
def a3spkrTone(pitch, duration)#0 def a3spkrTone(pitch, duration)#0
byte env byte env
@@ -348,14 +399,16 @@ end
// Search slots for MockingBoard // Search slots for MockingBoard
// //
def mbTicklePSG(pVIA) def mbTicklePSG(pVIA)
pVIA->IER = $7F // Mask all interrupts //puts("VIA address: $"); puth(pVIA); puts(" Timer Diff = "); puti(viaCheck(pVIA)); putln
pVIA->ACR = $00 // Stop T1 countdown if viaCheck(pVIA) == 8 and viaCheck(pVIA) == 8 // Check twice
pVIA->DDRB = $FF // Output enable port A and B pVIA->IER = $7F // Mask all interrupts
pVIA->DDRA = $FF //pVIA->ACR = $00 // Stop T1 countdown
pVIA->IORA = $00 // Reset MockingBoard pVIA->DDRB = $FF // Output enable port A and B
if pVIA->IORA == $00 pVIA->DDRA = $FF
pVIA->IORA = $00 // Reset MockingBoard
//if pVIA->IORA == $00
pVIA->IORA = $04 // Inactive MockingBoard control lines pVIA->IORA = $04 // Inactive MockingBoard control lines
if pVIA->IORA == $04 //if pVIA->IORA == $04
// //
// At least we know we have some sort of R/W in the ROM // At least we know we have some sort of R/W in the ROM
// address space. Most likely a MockingBoard or John Bell // address space. Most likely a MockingBoard or John Bell
@@ -366,7 +419,7 @@ def mbTicklePSG(pVIA)
//if mbReadP(pVIA, 2) == $7E and mbReadP(pVIA, 3) == $0A //if mbReadP(pVIA, 2) == $7E and mbReadP(pVIA, 3) == $0A
return pVIA return pVIA
//fin //fin
fin //fin
fin fin
return 0 return 0
end end
@@ -591,8 +644,7 @@ def mbSequence(yield, func)#0
// //
seqTime++ seqTime++
while !(mbVIA1->IFR & $40) // Wait for T1 interrupt while !(mbVIA1->IFR & $40) // Wait for T1 interrupt
if ^$C000 > 127; quit = TRUE; break; fin if a2keypressed(); quit = TRUE; break; fin
*rndseed++
loop loop
mbVIA1->IFR = $40 // Clear interrupt mbVIA1->IFR = $40 // Clear interrupt
if yieldTime <= seqTime; func()#0; yieldTime = seqTime + yield; fin if yieldTime <= seqTime; func()#0; yieldTime = seqTime + yield; fin
@@ -607,7 +659,7 @@ def mbSequence(yield, func)#0
psgWrite(mbVIA2, BENVAMP, $00) psgWrite(mbVIA2, BENVAMP, $00)
psgWrite(mbVIA2, CENVAMP, $00) psgWrite(mbVIA2, CENVAMP, $00)
fin fin
mbVIA1->ACR = $00 // Stop T1 countdown //mbVIA1->ACR = $00 // Stop T1 countdown
mbVIA1->IER = $7F // Mask all interrupts mbVIA1->IER = $7F // Mask all interrupts
mbVIA1->IFR = $40 // Clear interrupt mbVIA1->IFR = $40 // Clear interrupt
setStatusReg(status) setStatusReg(status)
@@ -703,7 +755,6 @@ def spkrSequence(yield, func)#0
if notes1[i] if notes1[i]
spkrTone(periods1[i], arpeggioDuration[numNotes])#0 spkrTone(periods1[i], arpeggioDuration[numNotes])#0
fin fin
*rndseed++
next next
seqTime++ seqTime++
else else
@@ -713,13 +764,12 @@ def spkrSequence(yield, func)#0
period = periods1[i] period = periods1[i]
break; break;
fin fin
*rndseed++
next next
duration = eventTime - seqTime duration = eventTime - seqTime
seqTime = duration + seqTime seqTime = duration + seqTime
spkrTone(period, DUR16TH * duration)#0 spkrTone(period, DUR16TH * duration)#0
fin fin
if ^$C000 > 127; return; fin if keypressed(); return; fin
if yieldTime <= seqTime; func()#0; yieldTime = seqTime + yield; fin if yieldTime <= seqTime; func()#0; yieldTime = seqTime + yield; fin
until FALSE until FALSE
end end
@@ -737,9 +787,8 @@ def noSequence(yield, func)#0
repeat repeat
seqTime++ seqTime++
if seqTime < 0; seqTime = 1; fin // Capture wrap-around if seqTime < 0; seqTime = 1; fin // Capture wrap-around
*rndseed++ spkrTone(0, DUR16TH) // Waste 16th of a second playing silence
a2spkrTone(0, DUR16TH) // Waste 16th of a second playing silence if keypressed(); return; fin
if ^$C000 > 127; return; fin
if yield == seqTime; func()#0; seqTime = 0; fin if yield == seqTime; func()#0; seqTime = 0; fin
until FALSE until FALSE
end end
@@ -782,31 +831,32 @@ end
// Play until keystroke // Play until keystroke
// //
export def musicGetKey(yield, backgroundProc)#1 export def musicGetKey(yield, backgroundProc)#1
while ^$C000 < 128 while not keypressed()
musicSequence(yield, backgroundProc)#0 // Call background proc every half second musicSequence(yield, backgroundProc)#0 // Call background proc every half second
loop loop
^$C010 return getc
return ^$C000
end end
when MACHID & MACHID_MODEL when MACHID & MACHID_MODEL
is MACHID_III is MACHID_III
spkrTone = @a3spkrTone spkrTone = @a3spkrTone
spkrPWM = @a3spkrPWM spkrPWM = @a3spkrPWM
keypressed = @a3keypressed
break break
is MACHID_I is MACHID_I
puts("Sound unsupported.\n") puts("Sound unsupported.\n")
return -1 return -1
break break
otherwise otherwise
puts("MockingBoard Slot:\n") //puts("MockingBoard Slot:\n")
puts("ENTER = None\n") //puts("ENTER = None\n")
puts("0 = Scan\n") //puts("0 = Scan\n")
puts("1-7 = Slot #\n") //puts("1-7 = Slot #\n")
instr = gets('>'|$80) //instr = gets('>'|$80)
if ^instr //if ^instr
mbSlot = mbSearch(^(instr + 1) - '0') // mbSlot = mbSearch(^(instr + 1) - '0')
fin //fin
mbSlot = mbSearch(0)
break break
wend wend
if mbSlot < 0 if mbSlot < 0
+195
View File
@@ -0,0 +1,195 @@
include "inc/cmdsys.plh"
//
// Handy constants.
//
const FULLMODE = 0
const MIXMODE = 1
//
// External interface.
//
struc t_conio
word keypressed
word getkey
word echo
word home
word gotoxy
word viewport
word texttype
word textmode
word grmode
word grcolor
word grplot
word tone
word rnd
end
//
// Predefined functions.
//
predef a2keypressed,a2home,a12echo(state),a2gotoxy(x,y),a2viewport(left, top, width, height),a2texttype(type)
predef a2textmode(cols),a2grmode(mix),a2grcolor(color),a2grplot(x,y),a2tone(duration, delay),a2rnd
//
// Exported function table.
//
word conio[]
//
// Function pointers.
//
word = @a2keypressed
word = @getc
word = @a12echo
word = @a2home
word = @a2gotoxy
word = @a2viewport
word = @a2texttype
word = @a2textmode
word = @a2grmode
word = @a2grcolor
word = @a2grplot
word = @a2tone
word = @a2rnd
//
// Screen row address arrays.
//
word txt1scrn[] = $0400,$0480,$0500,$0580,$0600,$0680,$0700,$0780
word = $0428,$04A8,$0528,$05A8,$0628,$06A8,$0728,$07A8
word = $0450,$04D0,$0550,$05D0,$0650,$06D0,$0750,$07D0
word txt2scrn[] = $0800,$0880,$0900,$0980,$0A00,$0A80,$0B00,$0B80
word = $0828,$08A8,$0928,$09A8,$0A28,$0AA8,$0B28,$0BA8
word = $0850,$08D0,$0950,$09D0,$0A50,$0AD0,$0B50,$0BD0
//
// Text screen parameters.
//
//byte textcols = 40
//byte curshpos = 0
//byte cursvpos = 0
//
// Apple 3 console codes.
//
byte textbwmode[] = 2, 16, 0
byte textclrmode[] = 2, 16, 1
byte grcharset[] = 1, 0, $7F, $7F, $7F, $7F, $00, $00, $00, $00
//
// Random number for Apple 1 and III.
//
word randnum = 12345
//
// Native routines.
//
asm equates
!SOURCE "vmsrc/plvmzp.inc"
end
//
// def grscrn(rowaddrs)
//
asm a2grscrn(rowaddrs)
GRSCRN = $26
GRSCRNL = GRSCRN
GRSCRNH = GRSCRNL+1
LDA ESTKL,X
STA GRSCRNL
LDA ESTKH,X
STA GRSCRNH
RTS
end
//
// def grcolor(color)
//
asm a2grcolor(color)
GRCLR = $30
LDA #$0F
AND ESTKL,X
STA GRCLR
ASL
ASL
ASL
ASL
ORA GRCLR
STA GRCLR
RTS
end
//
// def grplot(x, y)
//
asm a2grplot(x, y)
STY IPY
LDA ESTKL,X
AND #$FE
CMP ESTKL,X
TAY
LDA (GRSCRN),Y
STA DSTL
INY
LDA (GRSCRN),Y
STA DSTH
LDY ESTKL+1,X
LDA (DST),Y
EOR GRCLR
STA TMPL
LDA #$FF
ADC #$00
EOR #$F0
AND TMPL
EOR GRCLR
STA (DST),Y
LDY IPY
INX
RTS
end
//
// Commodore 64 routines.
//
def a2keypressed
return ^keyboard >= 128
end
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
def a2viewport(left, top, width, height)
if !width or !height
left = 0
top = 0
width = 40
height = 24
fin
^$20 = left
^$21 = width
^$22 = top
^$23 = height + top - 1
return a2gotoxy(0, 0)
end
def a2texttype(type)
^$32 = type
return 0
end
def a2textmode(columns)
call($FB39, 0, 0, 0, 0) // textmode()
return a2home
end
def a2grmode(mix)
call($FB2F, 0, 0, 0, 0) // initmode()
call($FB40, 0, 0, 0, 0) // grmode()
if !mix
^showfull
fin
a2home
return a2grscrn(@txt1scrn) // point to lo-res screen
end
def a2tone(duration, delay)
byte i
while duration
^speaker // toggle speaker
for i = delay downto 0; next
duration--
loop
return 0
end
def a2rnd
*a2rndnum = (*a2rndnum << 1) + *a2rndnum + 123
return *a2rndnum & $7FFF
end
done
+77
View File
@@ -0,0 +1,77 @@
include "inc/cmdsys.plh"
//
// External interface
//
struc t_fileio
word getpfx
word setpfx
word getfileinfo
word geteof
word iobufalloc
word open
word close
word read
word write
word create
word destroy
word newline
word readblock
word writeblock
end
predef a2getpfx(path), a23setpfx(path), a2getfileinfo(path, fileinfo), a23geteof(refnum), a2iobufs(iobufs), a2open(path), a2close(refnum)
predef a23read(refnum, buf, len), a2write(refnum, buf, len), a2create(path, type, aux), a23destroy(path)
predef a2newline(refnum, emask, nlchar), a2readblock(unit, buf, block), a2writeblock(unit, buf, block)
//
// Exported function table.
//
word fileio[]
word = @a2getpfx, @a23setpfx, @a2getfileinfo, @a23geteof, @a2iobufs, @a2open, @a2close
word = @a23read, @a2write, @a2create, @a23destroy
word = @a2newline, @a2readblock, @a2writeblock
//
// SOS/ProDOS error code
//
export byte perr
def a2getpfx(path)
return path
end
def a23setpfx(path)
return path
end
def a2getfileinfo(path, fileinfo)
return perr
end
def a23geteof(refnum)
return 0
end
def a2iobufs(iobufs)
return 0
end
def a2open(path)
return 0
end
def a2close(refnum)
return perr
end
def a23read(refnum, buf, len)
return len
end
def a2write(refnum, buf, len)
return len
end
def a2create(path, type, aux)
return perr
end
def a23destroy(path)
return perr
end
def a2newline(refnum, emask, nlchar)
return perr
end
def a2readblock(unit, buf, block)
return 0
end
def, a2writeblock(unit, buf, block)
return 0
end
done
+1 -1
View File
@@ -500,7 +500,7 @@ def etherServiceIP
lclport = swab(rxptr=>udp_dst) lclport = swab(rxptr=>udp_dst)
for i = 1 to MAX_UDP_NOTIFIES for i = 1 to MAX_UDP_NOTIFIES
if port=>notify_port == lclport if port=>notify_port == lclport
port=>notify_func(@iphdr=>ip_src,swab(rxptr=>udp_src),rxptr+t_udphdr,swab(rxptr=>udp_len),port=>notify_parm) port=>notify_func(@iphdr=>ip_src,swab(rxptr=>udp_src),rxptr+t_udphdr,swab(rxptr=>udp_len)-t_udphdr,port=>notify_parm)
break break
fin fin
port = port + t_notify port = port + t_notify
+4 -2
View File
@@ -837,8 +837,10 @@ def fpInit()
fpzpsave = heapalloc($0034*2) fpzpsave = heapalloc($0034*2)
(@fixupXS)=>1 = fpzpsave+$34 (@fixupXS)=>1 = fpzpsave+$34
(@fixupXR)=>1 = fpzpsave+$34 (@fixupXR)=>1 = fpzpsave+$34
sane[9] = @zpSaveX zpSaveX // Clear XBYTEs
sane[10] = @zpRestoreX heaprelease(fpzpsave)
sane[9] = @zpNopSave//zpSaveX
sane[10] = @zpNopRestore//zpRestoreX
else // Apple II else // Apple II
fpzpsave = heapalloc($0034) fpzpsave = heapalloc($0034)
sane[9] = @zpSave sane[9] = @zpSave
-116
View File
@@ -1,116 +0,0 @@
export asm tone(pitch, duration)
!SOURCE "vmsrc/plvmzp.inc"
DEX
LDA ESTKL+1,X
STA ESTKL,X
LDA ESTKH+1,X
STA ESTKH,X
LDA #$00
STA ESTKL+1,X
STA ESTKH+1,X
end
export asm tone2(pitch1, pitch2, duration)#0
STX ESP
LDY ESTKH,X
LDA ESTKL,X
BEQ +
INY
+ STA DSTL
STY DSTH
LDY ESTKL+1,X
STY TMPL
LDA ESTKL+2,X
TAX
LDA #$00
CPX TMPL
BNE +
TAX
+ STX TMPH
PHP
SEI
- CLC
-- DEY
BNE +
LDY TMPL
BEQ ++ ; SILENCE
STA $C030
BNE +++
+ NOP
NOP
++ NOP
NOP
NOP
+++ DEX
BNE +
LDX TMPH
BEQ ++ ; SILENCE
STA $C030
BNE +++
+ NOP
NOP
++ NOP
NOP
NOP
+++ ADC #$01
BNE --
DEC DSTL
BNE -
DEC DSTH
BNE -
PLP
LDX ESP
INX
INX
INX
RTS
end
export asm tonePWM(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 --
LDA $C030
INY
BNE +
INC SRCH
+ DEC DSTL
BNE -
DEC DSTH
BNE -
PLP
LDX ESP
INX
INX
INX
RTS
++
end
def toneTest#0
byte t
for t = 2 to 128
tone2(t, t >> 1, 10)
tone(t, 50)
next
end
toneTest()
done
+217 -156
View File
@@ -1,62 +1,66 @@
.SUFFIXES = .SUFFIXES =
AFLAGS = -o $@ AFLAGS = -o $@
PLVM = plvm PLVM = plvm
PLVM01 = A1PLASMA\#060280 PLVMZP_APL = vmsrc/apple/plvmzp.inc
PLVM02 = PLASMA.SYSTEM\#FF2000 PLVM01 = rel/apple/A1PLASMA\#060280
PLVM802 = PLASMA16.SYSTEM\#FF2000 PLVM02 = rel/apple/PLASMA.SYSTEM\#FF2000
PLVM03 = SOS.INTERP\#050000 PLVM802 = rel/apple/PLASMA16.SYSTEM\#FF2000
CMD = CMD\#061000 PLVM03 = rel/apple/SOS.INTERP\#050000
ED = ED\#FE1000 CMD = rel/apple/CMD\#061000
SB = SB\#FF2000 PLVMZP_C64 = vmsrc/c64/plvmzp.inc
SOS = SOS\#FE1000 PLVMC64 = rel/c64/PLASMA
ROD = ROD\#FE1000 ED = rel/ED\#FE1000
SIEVE = SIEVE\#FE1000 SOS = rel/apple/SOS\#FE1000
ARGS = ARGS\#FE1000 ROD = rel/ROD\#FE1000
SPIPORT = SPIPORT\#FE1000 SIEVE = rel/SIEVE\#FE1000
SDFAT = SDFAT\#FE1000 ARGS = rel/ARGS\#FE1000
FATCAT = FATCAT\#FE1000 SPIPORT = rel/apple/SPIPORT\#FE1000
FATGET = FATGET\#FE1000 SDFAT = rel/apple/SDFAT\#FE1000
FATPUT = FATPUT\#FE1000 FATCAT = rel/apple/FATCAT\#FE1000
FATWDSK = FATWRITEDSK\#FE1000 FATGET = rel/apple/FATGET\#FE1000
FATRDSK = FATREADDSK\#FE1000 FATPUT = rel/apple/FATPUT\#FE1000
FILEIO = FILEIO\#FE1000 FATWDSK = rel/apple/FATWRITEDSK\#FE1000
CONIO = CONIO\#FE1000 FATRDSK = rel/apple/FATREADDSK\#FE1000
SANE = SANE\#FE1000 FILEIO_APL = rel/apple/FILEIO\#FE1000
FPSTR = FPSTR\#FE1000 CONIO_APL = rel/apple/CONIO\#FE1000
FPU = FPU\#FE1000 SANE = rel/SANE\#FE1000
SNDSEQ = SNDSEQ\#FE1000 FPSTR = rel/FPSTR\#FE1000
PLAYSEQ = PLAYSEQ\#FE1000 FPU = rel/FPU\#FE1000
SANITY = SANITY\#FE1000 SNDSEQ = rel/apple/SNDSEQ\#FE1000
RPNCALC = RPNCALC\#FE1000 PLAYSEQ = rel/apple/PLAYSEQ\#FE1000
WIZNET = WIZNET\#FE1000 SANITY = rel/SANITY\#FE1000
UTHERNET2= UTHERNET2\#FE1000 RPNCALC = rel/RPNCALC\#FE1000
UTHERNET= UTHERNET\#FE1000 MOUSE = rel/apple/MOUSE\#FE1000
ETHERIP = ETHERIP\#FE1000 UTHERNET2 = rel/apple/UTHERNET2\#FE1000
INET = INET\#FE1000 UTHERNET = rel/apple/UTHERNET\#FE1000
DHCP = DHCP\#FE1000 ETHERIP = rel/ETHERIP\#FE1000
HTTPD = HTTPD\#FE1000 INET = rel/INET\#FE1000
DGR = DGR\#FE1000 DHCP = rel/DHCP\#FE1000
TONE = TONE\#FE1000 HTTPD = rel/HTTPD\#FE1000
PORTIO = PORTIO\#FE1000 TFTPD = rel/TFTPD\#FE1000
ROGUE = ROGUE\#FE1000 DGR = rel/apple/DGR\#FE1000
ROGUEMAP= ROGUEMAP\#FE1000 GRAFIX = rel/apple/GRAFIX\#FE1000
ROGUECOMBAT= ROGUECOMBAT\#FE1000 GFXDEMO = rel/apple/GFXDEMO\#FE1000
HELLO = HELLO\#FE1000 JOYBUZZ = rel/apple/JOYBUZZ\#FE1000
MON = MON\#FE1000 PORTIO = rel/apple/PORTIO\#FE1000
DGRTEST = DGRTEST\#FE1000 ROGUE = rel/ROGUE\#FE1000
TEST = TEST\#FE1000 ROGUEMAP = rel/ROGUEMAP\#FE1000
TESTLIB = TESTLIB\#FE1000 ROGUECOMBAT= rel/ROGUECOMBAT\#FE1000
PROFILE = PROFILE\#FE1000 MON = rel/apple/MON\#FE1000
MEMMGR = MEMMGR\#FE1000 DGRTEST = rel/apple/DGRTEST\#FE1000
MEMTEST = MEMTEST\#FE1000 MEMMGR = rel/MEMMGR\#FE1000
FIBERTEST = FIBERTEST\#FE1000 MEMTEST = rel/MEMTEST\#FE1000
FIBER = FIBER\#FE1000 FIBERTEST = rel/FIBERTEST\#FE1000
LONGJMP = LONGJMP\#FE1000 FIBER = rel/FIBER\#FE1000
PLASM = plasm LONGJMP = rel/LONGJMP\#FE1000
PLASMAPLASM = PLASM\#FE1000 HELLO = HELLO\#FE1000
CODEOPT = CODEOPT\#FE1000 TEST = TEST\#FE1000
INCS = toolsrc/plasm.h toolsrc/tokens.h toolsrc/symbols.h toolsrc/lex.h toolsrc/parse.h toolsrc/codegen.h TESTLIB = TESTLIB\#FE1000
OBJS = toolsrc/plasm.c toolsrc/parse.c toolsrc/lex.c toolsrc/codegen.c PLASM = plasm
PLASMAPLASM = rel/PLASM\#FE1000
CODEOPT = rel/CODEOPT\#FE1000
INCS = toolsrc/plasm.h toolsrc/tokens.h toolsrc/symbols.h toolsrc/lex.h toolsrc/parse.h toolsrc/codegen.h
OBJS = toolsrc/plasm.c toolsrc/parse.c toolsrc/lex.c toolsrc/codegen.c
# #
# Image filetypes for Virtual ][ # Image filetypes for Virtual ][
# #
@@ -73,13 +77,30 @@ TXTTYPE = .TXT
#SYSTYPE = \#FF2000 #SYSTYPE = \#FF2000
#TXTTYPE = \#040000 #TXTTYPE = \#040000
all: $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVM802) $(PLVM03) $(CMD) $(PLASMAPLASM) $(CODEOPT) $(ARGS) $(MEMMGR) $(MEMTEST) $(FIBER) $(FIBERTEST) $(LONGJMP) $(ED) $(MON) $(SOS) $(ROD) $(SIEVE) $(UTHERNET2) $(UTHERNET) $(ETHERIP) $(INET) $(DHCP) $(HTTPD) $(ROGUE) $(ROGUEMAP) $(ROGUECOMBAT) $(TONE) $(DGR) $(DGRTEST) $(FILEIO) $(CONIO) $(PORTIO) $(SPIPORT) $(SDFAT) $(FATCAT) $(FATGET) $(FATPUT) $(FATWDSK) $(FATRDSK) $(SANE) $(FPSTR) $(FPU) $(SANITY) $(RPNCALC) $(SNDSEQ) $(PLAYSEQ) apple: $(PLVMZP_APL) $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVM802) $(PLVM03) $(CMD) $(PLASMAPLASM) $(CODEOPT) $(ARGS) $(MEMMGR) $(MEMTEST) $(FIBER) $(FIBERTEST) $(LONGJMP) $(ED) $(MON) $(SOS) $(ROD) $(SIEVE) $(MOUSE) $(UTHERNET2) $(UTHERNET) $(ETHERIP) $(INET) $(DHCP) $(HTTPD) $(TFTPD) $(ROGUE) $(ROGUEMAP) $(ROGUECOMBAT) $(GRAFIX) $(GFXDEMO) $(DGR) $(DGRTEST) $(FILEIO_APL) $(CONIO_APL) $(JOYBUZZ) $(PORTIO) $(SPIPORT) $(SDFAT) $(FATCAT) $(FATGET) $(FATPUT) $(FATWDSK) $(FATRDSK) $(SANE) $(FPSTR) $(FPU) $(SANITY) $(RPNCALC) $(SNDSEQ) $(PLAYSEQ)
-rm vmsrc/plvmzp.inc
c64: $(PLVMZP_C64) $(PLASM) $(PLVM) $(PLVMC64)
-rm vmsrc/plvmzp.inc
all: apple c64
clean: clean:
-rm *FE1000 *FF2000 $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVM03) -rm *FE1000 *FF2000 $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVM03)
-rm toolsrc/*.o toolsrc/*~ toolsrc/*.a -rm rel/*
-rm vmsrc/*.o vmsrc/*~ vmsrc/*.a vmsrc/*.sym -rm rel/apple/*
-rm rel/c64/*
-rm samplesrc/*.o samplesrc/*~ samplesrc/*.a -rm samplesrc/*.o samplesrc/*~ samplesrc/*.a
-rm toolsrc/*.o toolsrc/*~ toolsrc/*.a
-rm toolsrc/apple/*.o toolsrc/apple/*~ toolsrc/apple/*.a
-rm toolsrc/c64/*.o toolsrc/c64/*~ toolsrc/c64/*.a
-rm vmsrc/*.o vmsrc/*~ vmsrc/*.a vmsrc/*.sym
-rm vmsrc/apple/*.o vmsrc/apple/*~ vmsrc/apple/*.a vmsrc/apple/*.sym
-rm vmsrc/c64/*.o vmsrc/c64/*~ vmsrc/c64/*.a vmsrc/c64/*.sym
-rm libsrc/*.o libsrc/*~ libsrc/*.a
-rm libsrc/apple/*.o libsrc/apple/*~ libsrc/apple/*.a
-rm libsrc/c64/*.o libsrc/c64/*~ libsrc/c64/*.a
-rm libsrc/*.o libsrc/*~ libsrc/*.a
# #
# PLASMA compiler: plasm # PLASMA compiler: plasm
@@ -101,27 +122,47 @@ $(CODEOPT): toolsrc/codeopt.pla toolsrc/codeseq.plh
$(PLVM): vmsrc/plvm.c $(PLVM): vmsrc/plvm.c
cc vmsrc/plvm.c -o $(PLVM) cc vmsrc/plvm.c -o $(PLVM)
vmsrc/a1cmd.a: vmsrc/a1cmd.pla $(PLASM) $(PLVMZP_APL): FORCE
./$(PLASM) -AOW < vmsrc/a1cmd.pla > vmsrc/a1cmd.a -mkdir -p rel
-mkdir -p rel/apple
-rm -f vmsrc/plvmzp.inc
-ln -s apple/plvmzp.inc vmsrc/plvmzp.inc
$(PLVM01): vmsrc/plvm01.s vmsrc/a1cmd.a $(PLVMZP_C64): FORCE
acme -o $(PLVM01) -l vmsrc/plvm01.sym vmsrc/plvm01.s -mkdir -p rel
-mkdir -p rel/c64
-rm -f vmsrc/plvmzp.inc
-ln -s c64/plvmzp.inc vmsrc/plvmzp.inc
$(CMD): vmsrc/cmd.pla vmsrc/cmdstub.s $(PLVM02) $(PLASM) FORCE:
./$(PLASM) -AOW < vmsrc/cmd.pla > vmsrc/cmd.a
acme --setpc 8192 -o $(CMD) vmsrc/cmdstub.s
$(PLVM02): vmsrc/plvm02.s vmsrc/c64/cmd.a: vmsrc/c64/cmd.pla $(PLASM)
acme -o $(PLVM02) -l vmsrc/plvm02.sym vmsrc/plvm02.s ./$(PLASM) -AOW < vmsrc/c64/cmd.pla > vmsrc/c64/cmd.a
$(PLVM802): vmsrc/plvm802.s $(PLVMC64): vmsrc/c64/plvmc64.s vmsrc/c64/cmd.a
acme -o $(PLVM802) -l vmsrc/plvm802.sym vmsrc/plvm802.s acme -f cbm -o $(PLVMC64) -l vmsrc/c64/plvmc64.sym vmsrc/c64/plvmc64.s
vmsrc/soscmd.a: vmsrc/soscmd.pla $(PLASM) vmsrc/apple/a1cmd.a: vmsrc/apple/a1cmd.pla $(PLASM)
./$(PLASM) -AOW < vmsrc/soscmd.pla > vmsrc/soscmd.a ./$(PLASM) -AOW < vmsrc/apple/a1cmd.pla > vmsrc/apple/a1cmd.a
$(PLVM03): vmsrc/plvm03.s vmsrc/soscmd.a $(PLVM01): vmsrc/apple/plvm01.s vmsrc/apple/a1cmd.a
acme -o $(PLVM03) -l vmsrc/plvm03.sym vmsrc/plvm03.s acme -o $(PLVM01) -l vmsrc/apple/plvm01.sym vmsrc/apple/plvm01.s
$(CMD): vmsrc/apple/cmd.pla vmsrc/apple/cmdstub.s $(PLVM02) $(PLASM)
./$(PLASM) -AOW < vmsrc/apple/cmd.pla > vmsrc/apple/cmd.a
acme --setpc 8192 -o $(CMD) vmsrc/apple/cmdstub.s
$(PLVM02): vmsrc/apple/plvm02.s
acme -o $(PLVM02) -l vmsrc/apple/plvm02.sym vmsrc/apple/plvm02.s
$(PLVM802): vmsrc/apple/plvm802.s
acme -o $(PLVM802) -l vmsrc/apple/plvm802.sym vmsrc/apple/plvm802.s
vmsrc/apple/soscmd.a: vmsrc/apple/soscmd.pla $(PLASM)
./$(PLASM) -AOW < vmsrc/apple/soscmd.pla > vmsrc/apple/soscmd.a
$(PLVM03): vmsrc/apple/plvm03.s vmsrc/apple/soscmd.a
acme -o $(PLVM03) -l vmsrc/apple/plvm03.sym vmsrc/apple/plvm03.s
# #
# Sample code # Sample code
@@ -137,10 +178,6 @@ $(ED): toolsrc/ed.pla $(PLVM02) $(PLASM) toolsrc/ed.pla
./$(PLASM) -AMOW < toolsrc/ed.pla > toolsrc/ed.a ./$(PLASM) -AMOW < toolsrc/ed.pla > toolsrc/ed.a
acme --setpc 4094 -o $(ED) toolsrc/ed.a acme --setpc 4094 -o $(ED) toolsrc/ed.a
$(SB): toolsrc/sb.pla $(PLVM02) $(PLASM) toolsrc/sb.pla
./$(PLASM) -AOW < toolsrc/sb.pla > toolsrc/sb.a
acme --setpc 8192 -o $(SB) toolsrc/sb.a
$(ARGS): libsrc/args.pla $(PLVM02) $(PLASM) $(ARGS): libsrc/args.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/args.pla > libsrc/args.a ./$(PLASM) -AMOW < libsrc/args.pla > libsrc/args.a
acme --setpc 4094 -o $(ARGS) libsrc/args.a acme --setpc 4094 -o $(ARGS) libsrc/args.a
@@ -161,26 +198,26 @@ $(FIBERTEST): samplesrc/fibertest.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < samplesrc/fibertest.pla > samplesrc/fibertest.a ./$(PLASM) -AMOW < samplesrc/fibertest.pla > samplesrc/fibertest.a
acme --setpc 4094 -o $(FIBERTEST) 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) $(LONGJMP): libsrc/longjmp.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/longjmp.pla > libsrc/longjmp.a ./$(PLASM) -AMOW < libsrc/longjmp.pla > libsrc/longjmp.a
acme --setpc 4094 -o $(LONGJMP) libsrc/longjmp.a acme --setpc 4094 -o $(LONGJMP) libsrc/longjmp.a
$(MON): samplesrc/mon.pla $(PLVM02) $(PLASM) $(ROGUE): samplesrc/rogue.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < samplesrc/mon.pla > samplesrc/mon.a ./$(PLASM) -AMOW < samplesrc/rogue.pla > samplesrc/rogue.a
acme --setpc 4094 -o $(MON) samplesrc/mon.a acme --setpc 4094 -o $(ROGUE) samplesrc/rogue.a
$(SOS): libsrc/sos.pla $(PLVM02) $(PLASM) $(ROGUECOMBAT): samplesrc/rogue.combat.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < libsrc/sos.pla > libsrc/sos.a ./$(PLASM) -AMOW < samplesrc/rogue.combat.pla > samplesrc/rogue.combat.a
acme --setpc 4094 -o $(SOS) libsrc/sos.a acme --setpc 4094 -o $(ROGUECOMBAT) samplesrc/rogue.combat.a
$(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
hello: samplesrc/hello.pla $(PLVM) $(PLASM)
./$(PLASM) -AMOW < samplesrc/hello.pla > samplesrc/hello.a
acme --setpc 4094 -o $(HELLO) samplesrc/hello.a
./$(PLVM) HELLO
$(ROD): samplesrc/rod.pla $(PLVM02) $(PLASM) $(ROD): samplesrc/rod.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < samplesrc/rod.pla > samplesrc/rod.a ./$(PLASM) -AMO < samplesrc/rod.pla > samplesrc/rod.a
acme --setpc 4094 -o $(ROD) samplesrc/rod.a acme --setpc 4094 -o $(ROD) samplesrc/rod.a
@@ -189,38 +226,6 @@ $(SIEVE): samplesrc/sieve.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMW < samplesrc/sieve.pla > samplesrc/sieve.a ./$(PLASM) -AMW < samplesrc/sieve.pla > samplesrc/sieve.a
acme --setpc 4094 -o $(SIEVE) samplesrc/sieve.a acme --setpc 4094 -o $(SIEVE) samplesrc/sieve.a
$(UTHERNET): libsrc/uthernet.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/uthernet.pla > libsrc/uthernet.a
acme --setpc 4094 -o $(UTHERNET) libsrc/uthernet.a
$(UTHERNET2): libsrc/uthernet2.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/uthernet2.pla > libsrc/uthernet2.a
acme --setpc 4094 -o $(UTHERNET2) libsrc/uthernet2.a
$(ETHERIP): libsrc/etherip.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/etherip.pla > libsrc/etherip.a
acme --setpc 4094 -o $(ETHERIP) libsrc/etherip.a
$(INET): libsrc/inet.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/inet.pla > libsrc/inet.a
acme --setpc 4094 -o $(INET) libsrc/inet.a
$(DHCP): libsrc/dhcp.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/dhcp.pla > libsrc/dhcp.a
acme --setpc 4094 -o $(DHCP) libsrc/dhcp.a
$(HTTPD): samplesrc/httpd.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < samplesrc/httpd.pla > samplesrc/httpd.a
acme --setpc 4094 -o $(HTTPD) samplesrc/httpd.a
$(FILEIO): libsrc/fileio.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/fileio.pla > libsrc/fileio.a
acme --setpc 4094 -o $(FILEIO) libsrc/fileio.a
$(CONIO): libsrc/conio.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/conio.pla > libsrc/conio.a
acme --setpc 4094 -o $(CONIO) libsrc/conio.a
$(SANE): libsrc/sane.pla $(PLVM02) $(PLASM) $(SANE): libsrc/sane.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/sane.pla > libsrc/sane.a ./$(PLASM) -AMOW < libsrc/sane.pla > libsrc/sane.a
acme --setpc 4094 -o $(SANE) libsrc/sane.a acme --setpc 4094 -o $(SANE) libsrc/sane.a
@@ -237,13 +242,73 @@ $(SANITY): samplesrc/sanity.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < samplesrc/sanity.pla > samplesrc/sanity.a ./$(PLASM) -AMOW < samplesrc/sanity.pla > samplesrc/sanity.a
acme --setpc 4094 -o $(SANITY) samplesrc/sanity.a acme --setpc 4094 -o $(SANITY) samplesrc/sanity.a
$(RPNCALC): samplesrc/rpncalc.pla libsrc/fpu.pla inc/fpu.plh libsrc/fpstr.pla inc/fpstr.plh libsrc/conio.pla inc/conio.plh $(PLVM02) $(PLASM) $(RPNCALC): samplesrc/rpncalc.pla libsrc/fpu.pla inc/fpu.plh libsrc/fpstr.pla inc/fpstr.plh inc/conio.plh $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < samplesrc/rpncalc.pla > samplesrc/rpncalc.a ./$(PLASM) -AMOW < samplesrc/rpncalc.pla > samplesrc/rpncalc.a
acme --setpc 4094 -o $(RPNCALC) samplesrc/rpncalc.a acme --setpc 4094 -o $(RPNCALC) samplesrc/rpncalc.a
$(TONE): libsrc/tone.pla $(PLVM02) $(PLASM) $(ETHERIP): libsrc/etherip.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/tone.pla > libsrc/tone.a ./$(PLASM) -AMOW < libsrc/etherip.pla > libsrc/etherip.a
acme --setpc 4094 -o $(TONE) libsrc/tone.a acme --setpc 4094 -o $(ETHERIP) libsrc/etherip.a
$(INET): libsrc/inet.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/inet.pla > libsrc/inet.a
acme --setpc 4094 -o $(INET) libsrc/inet.a
$(DHCP): libsrc/dhcp.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/dhcp.pla > libsrc/dhcp.a
acme --setpc 4094 -o $(DHCP) libsrc/dhcp.a
$(HTTPD): samplesrc/httpd.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < samplesrc/httpd.pla > samplesrc/httpd.a
acme --setpc 4094 -o $(HTTPD) samplesrc/httpd.a
$(TFTPD): samplesrc/tftpd.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < samplesrc/tftpd.pla > samplesrc/tftpd.a
acme --setpc 4094 -o $(TFTPD) samplesrc/tftpd.a
$(MOUSE): libsrc/apple/mouse.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/apple/mouse.pla > libsrc/apple/mouse.a
acme --setpc 4094 -o $(MOUSE) libsrc/apple/mouse.a
$(UTHERNET): libsrc/apple/uthernet.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/apple/uthernet.pla > libsrc/apple/uthernet.a
acme --setpc 4094 -o $(UTHERNET) libsrc/apple/uthernet.a
$(UTHERNET2): libsrc/apple/uthernet2.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/apple/uthernet2.pla > libsrc/apple/uthernet2.a
acme --setpc 4094 -o $(UTHERNET2) libsrc/apple/uthernet2.a
$(FILEIO_APL): libsrc/apple/fileio.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/apple/fileio.pla > libsrc/apple/fileio.a
acme --setpc 4094 -o $(FILEIO_APL) libsrc/apple/fileio.a
$(CONIO_APL): libsrc/apple/conio.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/apple/conio.pla > libsrc/apple/conio.a
acme --setpc 4094 -o $(CONIO_APL) libsrc/apple/conio.a
$(FILEIO_C64): libsrc/c64/fileio.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/c64/fileio.pla > libsrc/c64/fileio.a
acme --setpc 4094 -o $(FILEIO_C64) libsrc/c64/fileio.a
$(CONIO_C64): libsrc/c64/conio.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/c64/conio.pla > libsrc/c64/conio.a
acme --setpc 4094 -o $(CONIO_C64) libsrc/c64/conio.a
$(SNDSEQ): libsrc/apple/sndseq.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/apple/sndseq.pla > libsrc/apple/sndseq.a
acme --setpc 4094 -o $(SNDSEQ) libsrc/apple/sndseq.a
$(PLAYSEQ): samplesrc/playseq.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < samplesrc/playseq.pla > samplesrc/playseq.a
acme --setpc 4094 -o $(PLAYSEQ) samplesrc/playseq.a
$(GRAFIX): libsrc/apple/grafix.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/apple/grafix.pla > libsrc/apple/grafix.a
acme --setpc 4094 -o $(GRAFIX) libsrc/apple/grafix.a
$(GFXDEMO): samplesrc/gfxdemo.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < samplesrc/gfxdemo.pla > samplesrc/gfxdemo.a
acme --setpc 4094 -o $(GFXDEMO) samplesrc/gfxdemo.a
$(FATCAT): samplesrc/fatcat.pla $(PLVM02) $(PLASM) $(FATCAT): samplesrc/fatcat.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < samplesrc/fatcat.pla > samplesrc/fatcat.a ./$(PLASM) -AMOW < samplesrc/fatcat.pla > samplesrc/fatcat.a
@@ -265,39 +330,35 @@ $(FATRDSK): samplesrc/fatreaddsk.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < samplesrc/fatreaddsk.pla > samplesrc/fatreaddsk.a ./$(PLASM) -AMOW < samplesrc/fatreaddsk.pla > samplesrc/fatreaddsk.a
acme --setpc 4094 -o $(FATRDSK) samplesrc/fatreaddsk.a acme --setpc 4094 -o $(FATRDSK) samplesrc/fatreaddsk.a
$(SDFAT): libsrc/sdfat.pla $(PLVM02) $(PLASM) $(SDFAT): libsrc/apple/sdfat.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/sdfat.pla > libsrc/sdfat.a ./$(PLASM) -AMOW < libsrc/apple/sdfat.pla > libsrc/apple/sdfat.a
acme --setpc 4094 -o $(SDFAT) libsrc/sdfat.a acme --setpc 4094 -o $(SDFAT) libsrc/apple/sdfat.a
$(SPIPORT): libsrc/spiport.pla $(PLVM02) $(PLASM) $(SPIPORT): libsrc/apple/spiport.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/spiport.pla > libsrc/spiport.a ./$(PLASM) -AMOW < libsrc/apple/spiport.pla > libsrc/apple/spiport.a
acme --setpc 4094 -o $(SPIPORT) libsrc/spiport.a acme --setpc 4094 -o $(SPIPORT) libsrc/apple/spiport.a
$(PORTIO): libsrc/portio.pla $(PLVM02) $(PLASM) $(JOYBUZZ): libsrc/apple/joybuzz.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/portio.pla > libsrc/portio.a ./$(PLASM) -AMOW < libsrc/apple/joybuzz.pla > libsrc/apple/joybuzz.a
acme --setpc 4094 -o $(PORTIO) libsrc/portio.a acme --setpc 4094 -o $(JOYBUZZ) libsrc/apple/joybuzz.a
$(DGR): libsrc/dgr.pla $(PLVM02) $(PLASM) $(PORTIO): libsrc/apple/portio.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/dgr.pla > libsrc/dgr.a ./$(PLASM) -AMOW < libsrc/apple/portio.pla > libsrc/apple/portio.a
acme --setpc 4094 -o $(DGR) libsrc/dgr.a acme --setpc 4094 -o $(PORTIO) libsrc/apple/portio.a
$(DGR): libsrc/apple/dgr.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/apple/dgr.pla > libsrc/apple/dgr.a
acme --setpc 4094 -o $(DGR) libsrc/apple/dgr.a
$(DGRTEST): samplesrc/dgrtest.pla $(PLVM02) $(PLASM) $(DGRTEST): samplesrc/dgrtest.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < samplesrc/dgrtest.pla > samplesrc/dgrtest.a ./$(PLASM) -AMOW < samplesrc/dgrtest.pla > samplesrc/dgrtest.a
acme --setpc 4094 -o $(DGRTEST) samplesrc/dgrtest.a acme --setpc 4094 -o $(DGRTEST) samplesrc/dgrtest.a
$(ROGUE): samplesrc/rogue.pla $(PLVM02) $(PLASM) $(MON): samplesrc/mon.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < samplesrc/rogue.pla > samplesrc/rogue.a ./$(PLASM) -AMOW < samplesrc/mon.pla > samplesrc/mon.a
acme --setpc 4094 -o $(ROGUE) samplesrc/rogue.a acme --setpc 4094 -o $(MON) samplesrc/mon.a
$(ROGUECOMBAT): samplesrc/rogue.combat.pla $(PLVM02) $(PLASM) $(SOS): libsrc/apple/sos.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < samplesrc/rogue.combat.pla > samplesrc/rogue.combat.a ./$(PLASM) -AMO < libsrc/apple/sos.pla > libsrc/apple/sos.a
acme --setpc 4094 -o $(ROGUECOMBAT) samplesrc/rogue.combat.a acme --setpc 4094 -o $(SOS) libsrc/apple/sos.a
$(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
hello: samplesrc/hello.pla $(PLVM) $(PLASM)
./$(PLASM) -AMOW < samplesrc/hello.pla > samplesrc/hello.a
acme --setpc 4094 -o $(HELLO) samplesrc/hello.a
./$(PLVM) HELLO
+54 -41
View File
@@ -1,68 +1,76 @@
cp CMD#061000 prodos/CMD.BIN cp rel/apple/CMD#061000 prodos/CMD.BIN
cp PLASMA.SYSTEM#FF2000 prodos/PLASMA.SYSTEM.SYS cp rel/apple/PLASMA.SYSTEM#FF2000 prodos/PLASMA.SYSTEM.SYS
cp PLASMA16.SYSTEM#FF2000 prodos/PLASMA16.SYSTEM.SYS cp rel/apple/PLASMA16.SYSTEM#FF2000 prodos/PLASMA16.SYSTEM.SYS
cp SOS.INTERP#050000 prodos/SOS.INTERP.\$05 cp rel/apple/SOS.INTERP#050000 prodos/SOS.INTERP.\$05
cp ../doc/Editor.md prodos/EDITOR.README.TXT cp ../doc/Editor.md prodos/EDITOR.README.TXT
rm -rf prodos/sys rm -rf prodos/sys
mkdir prodos/sys mkdir prodos/sys
cp ARGS#FE1000 prodos/sys/ARGS.REL cp rel/ARGS#FE1000 prodos/sys/ARGS.REL
cp CONIO#FE1000 prodos/sys/CONIO.REL cp rel/apple/CONIO#FE1000 prodos/sys/CONIO.REL
cp DGR#FE1000 prodos/sys/DGR.REL cp rel/apple/DGR#FE1000 prodos/sys/DGR.REL
cp DHCP#FE1000 prodos/sys/DHCP.REL cp rel/DHCP#FE1000 prodos/sys/DHCP.REL
cp ED#FE1000 prodos/sys/ED.REL cp rel/ED#FE1000 prodos/sys/ED.REL
cp ETHERIP#FE1000 prodos/sys/ETHERIP.REL cp rel/ETHERIP#FE1000 prodos/sys/ETHERIP.REL
cp FIBER#FE1000 prodos/sys/FIBER.REL cp rel/FIBER#FE1000 prodos/sys/FIBER.REL
cp FILEIO#FE1000 prodos/sys/FILEIO.REL cp rel/apple/FILEIO#FE1000 prodos/sys/FILEIO.REL
cp FPSTR#FE1000 prodos/sys/FPSTR.REL cp rel/FPSTR#FE1000 prodos/sys/FPSTR.REL
cp FPU#FE1000 prodos/sys/FPU.REL cp rel/FPU#FE1000 prodos/sys/FPU.REL
cp INET#FE1000 prodos/sys/INET.REL cp rel/INET#FE1000 prodos/sys/INET.REL
cp LONGJMP#FE1000 prodos/sys/LONGJMP.REL cp rel/LONGJMP#FE1000 prodos/sys/LONGJMP.REL
cp MEMMGR#FE1000 prodos/sys/MEMMGR.REL cp rel/MEMMGR#FE1000 prodos/sys/MEMMGR.REL
cp PORTIO#FE1000 prodos/sys/PORTIO.REL cp rel/apple/PORTIO#FE1000 prodos/sys/PORTIO.REL
cp SANE#FE1000 prodos/sys/SANE.REL cp rel/apple/JOYBUZZ#FE1000 prodos/sys/JOYBUZZ.REL
cp SDFAT#FE1000 prodos/sys/SDFAT.REL cp rel/SANE#FE1000 prodos/sys/SANE.REL
cp SPIPORT#FE1000 prodos/sys/SPIPORT.REL cp rel/apple/SDFAT#FE1000 prodos/sys/SDFAT.REL
cp SNDSEQ#FE1000 prodos/sys/SNDSEQ.REL cp rel/apple/SPIPORT#FE1000 prodos/sys/SPIPORT.REL
cp UTHERNET#FE1000 prodos/sys/UTHERNET.REL cp rel/apple/SNDSEQ#FE1000 prodos/sys/SNDSEQ.REL
cp UTHERNET2#FE1000 prodos/sys/UTHERNET2.REL cp rel/apple/MOUSE#FE1000 prodos/sys/MOUSE.REL
cp SOS#FE1000 prodos/sys/SOS.REL cp rel/apple/UTHERNET#FE1000 prodos/sys/UTHERNET.REL
cp rel/apple/UTHERNET2#FE1000 prodos/sys/UTHERNET2.REL
cp rel/apple/SOS#FE1000 prodos/sys/SOS.REL
cp rel/apple/GRAFIX#FE1000 prodos/sys/GRAFIX.REL
cp ../sysfiles/FP6502.CODE#060000 prodos/sys/FP6502.CODE.BIN cp ../sysfiles/FP6502.CODE#060000 prodos/sys/FP6502.CODE.BIN
cp ../sysfiles/ELEMS.CODE#060000 prodos/sys/ELEMS.CODE.BIN cp ../sysfiles/ELEMS.CODE#060000 prodos/sys/ELEMS.CODE.BIN
rm -rf prodos/demos rm -rf prodos/demos
mkdir prodos/demos mkdir prodos/demos
cp DGRTEST#FE1000 prodos/demos/DGRTEST.REL cp rel/apple/DGRTEST#FE1000 prodos/demos/DGRTEST.REL
cp RPNCALC#FE1000 prodos/demos/RPNCALC.REL cp rel/RPNCALC#FE1000 prodos/demos/RPNCALC.REL
cp ROD#FE1000 prodos/demos/ROD.REL cp rel/ROD#FE1000 prodos/demos/ROD.REL
mkdir prodos/demos/rogue mkdir prodos/demos/rogue
cp ROGUE#FE1000 prodos/demos/rogue/ROGUE.REL cp rel/ROGUE#FE1000 prodos/demos/rogue/ROGUE.REL
cp ROGUECOMBAT#FE1000 prodos/demos/rogue/ROGUECOMBAT.REL cp rel/ROGUECOMBAT#FE1000 prodos/demos/rogue/ROGUECOMBAT.REL
cp ROGUEMAP#FE1000 prodos/demos/rogue/ROGUEMAP.REL cp rel/ROGUEMAP#FE1000 prodos/demos/rogue/ROGUEMAP.REL
cp samplesrc/LEVEL0#040000 prodos/demos/rogue/LEVEL0.TXT cp samplesrc/LEVEL0#040000 prodos/demos/rogue/LEVEL0.TXT
cp samplesrc/LEVEL1#040000 prodos/demos/rogue/LEVEL1.TXT cp samplesrc/LEVEL1#040000 prodos/demos/rogue/LEVEL1.TXT
mkdir prodos/demos/sdutils mkdir prodos/demos/sdutils
cp FATCAT#FE1000 prodos/demos/sdutils/FATCAT.REL cp rel/apple/FATCAT#FE1000 prodos/demos/sdutils/FATCAT.REL
cp FATGET#FE1000 prodos/demos/sdutils/FATGET.REL cp rel/apple/FATGET#FE1000 prodos/demos/sdutils/FATGET.REL
cp FATPUT#FE1000 prodos/demos/sdutils/FATPUT.REL cp rel/apple/FATPUT#FE1000 prodos/demos/sdutils/FATPUT.REL
cp FATREADDSK#FE1000 prodos/demos/sdutils/FATREADDSK.REL cp rel/apple/FATREADDSK#FE1000 prodos/demos/sdutils/FATREADDSK.REL
cp FATWRITEDSK#FE1000 prodos/demos/sdutils/FATWRITEDSK.REL cp rel/apple/FATWRITEDSK#FE1000 prodos/demos/sdutils/FATWRITEDSK.REL
mkdir prodos/demos/apple3
cp rel/apple/GFXDEMO#FE1000 prodos/demos/apple3/GFXDEMO.REL
cp samplesrc/APPLE3.PIX#060000 prodos/demos/apple3/APPLE3.PIX.BIN
mkdir prodos/demos/net mkdir prodos/demos/net
cp HTTPD#FE1000 prodos/demos/net/HTTPD.REL cp rel/HTTPD#FE1000 prodos/demos/net/HTTPD.REL
cp samplesrc/index.html prodos/demos/net/INDEX.HTML.TXT cp samplesrc/index.html prodos/demos/net/INDEX.HTML.TXT
cp rel/TFTPD#FE1000 prodos/sys/TFTPD.REL
mkdir prodos/demos/music mkdir prodos/demos/music
cp PLAYSEQ#FE1000 prodos/demos/music/PLAYSEQ.REL cp rel/apple/PLAYSEQ#FE1000 prodos/demos/music/PLAYSEQ.REL
cp mockingboard/ultima3.seq prodos/demos/music/ULTIMA3.SEQ.BIN cp mockingboard/ultima3.seq prodos/demos/music/ULTIMA3.SEQ.BIN
cp mockingboard/startrek.seq prodos/demos/music/STARTREK.SEQ.BIN cp mockingboard/startrek.seq prodos/demos/music/STARTREK.SEQ.BIN
rm -rf prodos/bld rm -rf prodos/bld
mkdir prodos/bld mkdir prodos/bld
cp PLASM#FE1000 prodos/bld/PLASM.REL cp rel/PLASM#FE1000 prodos/bld/PLASM.REL
cp CODEOPT#FE1000 prodos/bld/CODEOPT.REL cp rel/CODEOPT#FE1000 prodos/bld/CODEOPT.REL
cp samplesrc/dgrtest.pla prodos/bld/DGRTEST.PLA.TXT cp samplesrc/dgrtest.pla prodos/bld/DGRTEST.PLA.TXT
cp samplesrc/hello.pla prodos/bld/HELLO.PLA.TXT cp samplesrc/hello.pla prodos/bld/HELLO.PLA.TXT
cp samplesrc/hgr1test.pla prodos/bld/HGR1TEST.PLA.TXT cp samplesrc/hgr1test.pla prodos/bld/HGR1TEST.PLA.TXT
@@ -80,6 +88,8 @@ cp samplesrc/fatcat.pla prodos/bld/FATCAT.PLA.TXT
cp samplesrc/rogue.pla prodos/bld/ROGUE.PLA.TXT cp samplesrc/rogue.pla prodos/bld/ROGUE.PLA.TXT
cp samplesrc/rogue.map.pla prodos/bld/ROGUE.MAP.PLA.TXT cp samplesrc/rogue.map.pla prodos/bld/ROGUE.MAP.PLA.TXT
cp samplesrc/rogue.combat.pla prodos/bld/ROGUE.COMBAT.PLA.TXT cp samplesrc/rogue.combat.pla prodos/bld/ROGUE.COMBAT.PLA.TXT
cp samplesrc/gfxdemo.pla prodos/bld/GFXDEMO.PLA.TXT
cp samplesrc/mousetest.pla prodos/bld/MOUSETEST.PLA.TXT
mkdir prodos/bld/inc mkdir prodos/bld/inc
cp inc/args.plh prodos/bld/inc/ARGS.PLH.TXT cp inc/args.plh prodos/bld/inc/ARGS.PLH.TXT
@@ -94,9 +104,12 @@ cp inc/inet.plh prodos/bld/inc/INET.PLH.TXT
cp inc/longjmp.plh prodos/bld/inc/LONGJMP.PLH.TXT cp inc/longjmp.plh prodos/bld/inc/LONGJMP.PLH.TXT
cp inc/memmgr.plh prodos/bld/inc/MEMMGR.PLH.TXT cp inc/memmgr.plh prodos/bld/inc/MEMMGR.PLH.TXT
cp inc/sane.plh prodos/bld/inc/SANE.PLH.TXT cp inc/sane.plh prodos/bld/inc/SANE.PLH.TXT
cp inc/joybuzz.plh prodos/bld/inc/JOYBUZZ.PLH.TXT
cp inc/portio.plh prodos/bld/inc/PORTIO.PLH.TXT cp inc/portio.plh prodos/bld/inc/PORTIO.PLH.TXT
cp inc/sdfat.plh prodos/bld/inc/SDFAT.PLH.TXT cp inc/sdfat.plh prodos/bld/inc/SDFAT.PLH.TXT
cp inc/sndseq.plh prodos/bld/inc/SNDSEQ.PLH.TXT cp inc/sndseq.plh prodos/bld/inc/SNDSEQ.PLH.TXT
cp inc/spiport.plh prodos/bld/inc/SPIPORT.PLH.TXT cp inc/spiport.plh prodos/bld/inc/SPIPORT.PLH.TXT
cp inc/testlib.plh prodos/bld/inc/TESTLIB.PLH.TXT cp inc/testlib.plh prodos/bld/inc/TESTLIB.PLH.TXT
cp vmsrc/plvmzp.inc prodos/bld/inc/PLVMZP.INC.TXT cp inc/grafix.plh prodos/bld/inc/GRAFIX.PLH.TXT
cp inc/mouse.plh prodos/bld/inc/MOUSE.PLH.TXT
cp vmsrc/apple/plvmzp.inc prodos/bld/inc/PLVMZP.INC.TXT
Binary file not shown.
+14
View File
@@ -0,0 +1,14 @@
//
// THE SIMPLE "HELLO, WORLD." PROGRAM!
//
// THIS IS A COMMENT, EVEYTHING IS
// IGNORED FOR THE REST OF THE LINE
// FOLLOWING "//"
//
// TO RUN, PRESS 'ESC', THEN "X" FROM
// COMMAND MODE. PRESS ANY KEY ONCE IT
// HAS SUCCESSFULLY COMPILED AND TOLD
// YOU HOW BIG THE RESULTANT PROGRAM IS.
//
PUTS("HELLO, WORLD.")
+292
View File
@@ -0,0 +1,292 @@
// RADAR SCOPE
//
// HERE IS ANOTHER LO-RES DEMO WITH
// A LITTLE MORE ON THE ALGORITHMIC
// SIDE OF THINGS. ON A IIGS, YOU WILL
// NEED TO ENABLE THE ALTERNATE DISPLAY
// OPTION IN THE CONTROL PANEL (ROM 01
// ONLY). THIS PROGRAM COPIES THE PAGE1
// LORES GRAPHICS TO THE PAGE2 FOR A
// FLICKER-FREE DISPLAY.
//
// NOTICE HOW SOME OF THE FUNCTIONS
// RETURN A VALUE THAT ISN'T USED. THIS
// IS CALLED "CASCADING THE RETURN".
// IN PLASMA, ALL FUNCTION DEFINITIONS
// RETURN A VALUE, EVEN IF IT ISN'T
// EXPLICITY SHOWN. A VALUE OF ZERO
// WILL BE SILENTLY ADDED IF NONE IS
// SPECIFIED. BY RETURNING A VALUE OF
// A FUNCTION OR SOFTSWITCH REFERENCE AT
// THE END OF THE DEFINTION IS A SLIGHT
// OPTIMIZATION IN THAT PLASMA WILL
// JUST PASS THE LAST VALUE BACK TO THE
// CALLER, WITHOUT DROPPING THE VALUE
// ON THE STACK AND PUSHING A ZERO BACK
// ON.
//
CONST SHOWGR = $C050
CONST SHOWFULL = $C052
CONST SHOWPG1 = $C054
CONST SHOWPG2 = $C055
CONST SHOWLORES = $C056
CONST RADIUS = 19
CONST XORG = 19
CONST YORG = 23
BYTE[RADIUS] OCTANT
BYTE NUMPOINTS
DEF TEXTMODE
^SHOWPG1
RETURN CALL($FB39, 0, 0, 0, 0)
END
DEF CPYBUF
RETURN MEMCPY($0800, $0400, 1024)
END
DEF GRMODE
CALL($F832, 0, 0, 0, 0)
^SHOWGR
^SHOWFULL
CPYBUF
^SHOWPG2
RETURN ^SHOWLORES
END
DEF COLOR(CLR)
RETURN CALL($F864, CLR, 0, 0, 0)
END
DEF HLIN(LEFT, RIGHT, VERT)
^$2C = RIGHT
RETURN CALL($F819, VERT, 0, LEFT, 0)
END
DEF VLIN(TOP, BOTTOM, HORZ)
^$2D = BOTTOM
RETURN CALL($F828, TOP, 0, HORZ, 0)
END
//
// MODIFIED BRESENHAM TO DRAW SYMETRICAL
// SPANS FROM BOTH ENDS (DOUBLE SPEED)
//
DEF LINE(X1, Y1, X2, Y2)
BYTE DX, DY, DX2, DY2, PP, S
WORD SX, SY, ERR, DD2
IF X1 < X2
SX = 1
DX = X2 - X1
ELSE
SX = -1
DX = X1 - X2
FIN
IF Y1 < Y2
SY = 1
DY = Y2 - Y1
ELSE
SY = -1
DY = Y1 - Y2
FIN
DX2 = DX << 1
DY2 = DY << 1
IF DX >= DY
//
// HORIZONTAL LINE
//
IF SX < 0
PP = X1
X1 = X2
X2 = PP
PP = Y1
Y1 = Y2
Y2 = PP
SY = -SY
FIN
DD2 = DX2 - DY2
ERR = DX - DY2
DY = (DY + 1) >> 1
SX = 1
WHILE DY
IF ERR < 0
//
// DRAW TOP AND BOTTOM SPANS AT
// SAME TIME
//
IF Y2 - Y1 == SY
//
// THIS FIXES ANY OFF-BY-ONE
// PIXELS ON LAST REMAINING
// ADJACENT SPANS
//
HLIN(X1, X1 + SX - 1, Y1)
HLIN(X1 + SX, X2, Y2)
ELSE
HLIN(X1, X1 + SX - 1, Y1)
HLIN(X2 - SX + 1, X2, Y2)
FIN
X1 = X1 + SX
X2 = X2 - SX
Y1 = Y1 + SY
Y2 = Y2 - SY
DY = DY - 1
SX = 1
ERR = ERR + DD2
ELSE
SX = SX + 1
ERR = ERR - DY2
FIN
LOOP
IF Y2 == Y1
HLIN(X1, X2, Y2)
FIN
ELSE
//
// VERTICAL LINE
//
IF SY < 0
PP = X1
X1 = X2
X2 = PP
PP = Y1
Y1 = Y2
Y2 = PP
SX = -SX
FIN
DD2 = DY2 - DX2
ERR = DY - DX2
DX = (DX + 1) >> 1
SY = 1
WHILE DX
IF ERR < 0
//
// DRAW RIGHT AND LEFT SPANS
// AT THE SAME TIME
//
IF X2 - X1 == SX
//
// THIS FIXES ANY OFF-BY-ONE
// PIXELS ON LAST REMAINING
// ADJACENT SPANS
//
VLIN(Y1, Y1 + SY - 1, X1)
VLIN(Y1 + SY, Y2, X2)
ELSE
VLIN(Y1, Y1 + SY - 1, X1)
VLIN(Y2 - SY + 1, Y2, X2)
FIN
X1 = X1 + SX
X2 = X2 - SX
Y1 = Y1 + SY
Y2 = Y2 - SY
DX = DX - 1
SY = 1
ERR = ERR + DD2
ELSE
SY = SY + 1
ERR = ERR - DX2
FIN
LOOP
IF X2 == X1
VLIN(Y1, Y2, X2)
FIN
FIN
END
DEF RADAR(C)
BYTE I
FOR I = 1 TO NUMPOINTS
COLOR(C)
LINE(XORG, YORG, XORG + I, YORG - OCTANT[I])
CPYBUF
COLOR(0)
LINE(XORG, YORG, XORG + I, YORG - OCTANT[I])
NEXT
FOR I = NUMPOINTS - 1 DOWNTO 0
COLOR(C)
LINE(XORG, YORG, XORG + OCTANT[I], YORG - I)
CPYBUF
COLOR(0)
LINE(XORG, YORG, XORG + OCTANT[I], YORG - I)
NEXT
FOR I = 1 TO NUMPOINTS
COLOR(C)
LINE(XORG, YORG, XORG + OCTANT[I], YORG + I)
CPYBUF
COLOR(0)
LINE(XORG, YORG, XORG + OCTANT[I], YORG + I)
NEXT
FOR I = NUMPOINTS - 1 DOWNTO 0
COLOR(C)
LINE(XORG, YORG, XORG + I, YORG + OCTANT[I])
CPYBUF
COLOR(0)
LINE(XORG, YORG, XORG + I, YORG + OCTANT[I])
NEXT
FOR I = 1 TO NUMPOINTS
COLOR(C)
LINE(XORG, YORG, XORG - I, YORG + OCTANT[I])
CPYBUF
COLOR(0)
LINE(XORG, YORG, XORG - I, YORG + OCTANT[I])
NEXT
FOR I = NUMPOINTS - 1 DOWNTO 0
COLOR(C)
LINE(XORG, YORG, XORG - OCTANT[I], YORG + I)
CPYBUF
COLOR(0)
LINE(XORG, YORG, XORG - OCTANT[I], YORG + I)
NEXT
FOR I = 1 TO NUMPOINTS
COLOR(C)
LINE(XORG, YORG, XORG - OCTANT[I], YORG - I)
CPYBUF
COLOR(0)
LINE(XORG, YORG, XORG - OCTANT[I], YORG - I)
NEXT
FOR I = NUMPOINTS - 1 DOWNTO 0
COLOR(C)
LINE(XORG, YORG, XORG - I, YORG - OCTANT[I])
CPYBUF
COLOR(0)
LINE(XORG, YORG, XORG - I, YORG - OCTANT[I])
NEXT
END
//
// USE BRESENHAM CIRCLE ALG TO CALC
// FIRST OCTANT
//
DEF CIRCALC
BYTE X, Y
WORD ERR
X = 0
Y = RADIUS
ERR = 3 - (RADIUS << 1)
WHILE X <= Y
IF ERR <= 0
ERR = ERR + (X << 2) + 6
ELSE
ERR = ERR + ((X - Y) << 2) + 10
Y = Y - 1
FIN
OCTANT[X] = Y
X = X + 1
LOOP
NUMPOINTS = X - 1
END
CIRCALC
GRMODE
REPEAT
RADAR(15)
UNTIL ^$C000 > 127
^$C010
TEXTMODE
DONE
+245
View File
@@ -0,0 +1,245 @@
CONST FALSE = 0
CONST TRUE = 1
//
// HERE IS AN INTERACTIVE EXAMPLE.
//
// SET AUTOPLAY TO FALSE TO USE THE
// PADDLE CONTROL AND PLAY YOURSELF.
//
BYTE AUTOPLAY = TRUE
//
// THE BUILT-IN FUNCTION CALL()
// RETURNS A STRUCTURE THAT CAN BE
// USED TO READ THE REGISTER RESULTS.
// CHECK OUT THE PADDLE() FUNCTION.
//
STRUC S_CALL
BYTE AREG
BYTE XREG
BYTE YREG
BYTE FLAGS
END
CONST SHOWLORES = $C056
CONST KEYBOARD = $C000
CONST KEYSTROBE = $C010
CONST SPEAKER = $C030
BYTE PDLPOS, PDLSIZE, PDLMID, MISS
BYTE XSCRN, YSCRN
BYTE[3] SCORE
WORD XBALL, YBALL, XSPEED, YSPEED
PREDEF INCSCORE
DEF BEEP(TONE, DURATION)
BYTE I, J
FOR J = DURATION DOWNTO 0
FOR I = TONE DOWNTO 0
NEXT
^SPEAKER
NEXT
END
DEF KEYPRESSED
RETURN ^KEYBOARD > 127
END
DEF GETKEY
BYTE KEY
REPEAT
KEY = ^KEYBOARD
UNTIL KEY > 127
^KEYSTROBE
RETURN KEY
END
DEF TEXTMODE
CALL($FB39, 0, 0, 0, 0)
RETURN HOME
END
DEF PUTSXY(X, Y, STRPTR)
GOTOXY(X, Y)
RETURN PUTS(STRPTR)
END
DEF GRMODE
CALL($FB40, 0, 0, 0, 0)
^SHOWLORES
RETURN HOME
END
DEF COLOR(CLR)
RETURN CALL($F864, CLR, 0, 0, 0)
END
DEF PLOT(X, Y)
RETURN CALL($F800, Y, 0, X, 0)
END
DEF HLIN(LEFT, RIGHT, VERT)
^($2C) = RIGHT
RETURN CALL($F819, VERT, 0, LEFT, 0)
END
DEF VLIN(TOP, BOTTOM, HORZ)
^($2D) = BOTTOM
RETURN CALL($F828, TOP, 0, HORZ, 0)
END
DEF PADDLE(NUM)
RETURN CALL($FB1E, 0, NUM, 0, 0)->YREG
END
DEF BUTTON(NUM)
RETURN ^($C060 + NUM) > 127
END
DEF UPDTPDL
IF AUTOPLAY
IF PDLPOS + PDLMID > XSCRN
IF PDLPOS > 0
PDLPOS = PDLPOS - 1
FIN
ELSIF PDLPOS + PDLMID + 1 < XSCRN
IF PDLPOS + PDLSIZE < 39
PDLPOS = PDLPOS + 1
FIN
FIN
ELSE
PDLPOS = PADDLE(0) / 5
FIN
IF PDLPOS + PDLSIZE > 39
PDLPOS = 39 - PDLSIZE
FIN
IF PDLPOS
COLOR(0)
HLIN(0, PDLPOS - 1, 39)
FIN
COLOR(1)
HLIN(PDLPOS, PDLPOS + PDLSIZE, 39)
IF PDLPOS + PDLSIZE < 38
COLOR(0)
HLIN(PDLPOS + PDLSIZE + 1, 39, 39)
FIN
END
DEF UPDTBALL
BYTE XNEW, YNEW
//
// UPDATE HORIZONTAL POSITION
//
XBALL = XBALL + XSPEED
IF XBALL > 623
XBALL = 623
XSPEED = -XSPEED
BEEP(4, 10)
ELSIF XBALL < 16
XBALL = 16
XSPEED = -XSPEED
BEEP(4, 10)
FIN
XNEW = XBALL >> 4
//
// UPDATE VERTICAL POSITION
//
YBALL = YBALL + YSPEED
IF YBALL > 623
//
// CHECK FOR PADDLE HIT
//
IF XNEW >= PDLPOS AND XNEW <= PDLPOS + PDLSIZE
YBALL = 623
YSPEED = -YSPEED - 2
XSPEED = XSPEED + (XNEW - (PDLPOS + PDLMID - 1))
IF XSPEED == 0
IF PDLPOS + PDLMID > 19
XSPEED = 1
ELSE
XSPEED = -1
FIN
FIN
INCSCORE
BEEP(4, 10)
ELSE
MISS = 1
BEEP(14, 40)
FIN
ELSIF YBALL < 16
YBALL = 16
YSPEED = -YSPEED
BEEP(4, 10)
FIN
YNEW = YBALL >> 4
//
// UPDATE ON-SCREEN BALL
//
IF XNEW <> XSCRN OR YNEW <> YSCRN
COLOR(8)
PLOT(XNEW, YNEW)
COLOR(0)
PLOT(XSCRN, YSCRN)
XSCRN = XNEW
YSCRN = YNEW
FIN
END
DEF PUTSCORE
PUTC(SCORE[2])
PUTC(SCORE[1])
PUTC(SCORE[0])
END
DEF INCSCORE
SCORE[0] = SCORE[0] + 1
IF SCORE[0] > '9'
SCORE[0] = '0'
SCORE[1] = SCORE[1] + 1
IF SCORE[1] > '9'
SCORE[1] = '0'
SCORE[2] = SCORE[2] + 1
FIN
FIN
GOTOXY(17, 2)
PUTSCORE
END
DEF INITSCORE
SCORE[0] = '0'
SCORE[1] = '0'
SCORE[2] = '0'
GOTOXY(17, 2)
PUTSCORE
END
PUTS("1=HARD 2=MED 3=EASY ?")
PDLSIZE = (GETKEY - $B0) * 3
PDLMID = PDLSIZE >> 1
GRMODE
COLOR(15)
HLIN(0, 39, 0)
VLIN(1, 38, 0)
VLIN(1, 38, 39)
XBALL = PADDLE(0) + 16
YBALL = PADDLE(1) + 16
XSCRN = XBALL >> 4
YSCRN = YBALL >> 4
XSPEED = 1
YSPEED = 1
MISS = 0
INITSCORE
REPEAT
UPDTPDL
UPDTBALL
UNTIL KEYPRESSED OR MISS
TEXTMODE
HOME
PUTS("YOUR SCORE WAS ")
PUTSCORE
PUTC($0D)
PUTS("THAT'S ALL FOLKS!")
DONE
+189
View File
@@ -0,0 +1,189 @@
//
// This is a simple combat simulator
//
// Many of the different structure,
// address, an pointer operations are
// demonstrated. A few of the many
// flow control constructs are shown,
// including loops, tests, and function
// calls.
//
// A note about in-line strings. When a
// string is encountered in-line, space
// is allocated on the fly for the string
// in memory. PLASMA doesn't have garbage
// collection, so that memory adds up
// until the function exits (or the
// proram ends in the main function).
// If you use strings inside a loop, you
// may overflow memory. Try moving the
// string outside the loop, or into
// initialized memory.
//
const rndnum = $4E // ZP location of RND
const rndl = $4E
const rndh = $4F
struc t_player
byte name[32]
word morality
byte health
byte stamina
byte strength
byte skill
end
byte[32] player = "Player"
word = 0 // morality
byte = 0 // health
byte = 10 // stamina
byte = 50 // strength
byte = 20 // skill
struc t_actor
byte kind
byte life
byte power
word ethics
word next_actor
end
byte preacher = "Preacher", 200
byte zombie = "Zombie", 0
byte cowboy = "Cowboy", 129
byte clerk = "Clerk", 128
byte merchant = "Merchant", 192
byte rustler = "Rustler", 60
byte traveler = "Traveler", 132
byte rogue = "Rogue", 30
//
// Notice how the array is initialized
// with the addresses of prior records.
//
word actors = @preacher, @zombie, @cowboy
word = @clerk, @merchant, @rustler
word = @traveler, @rogue, 0
byte fightstr = "F)ight or R)un?"
byte whostr = "Whom do you want to fight (0=quit)?"
byte numactors
word choice
def rnd
*rndnum = (*rndnum << 1) + *rndnum + 251
return *rndnum & $7FFF
end
//
// Apple //e and //c computers can input
// lower-case, so convert all input into
// upper-case for easier testing.
//
def toupper(c)
if c >= 'a' and c <= 'z'
c = c - ('a' - 'A')
fin
return c
end
def putstats(other)
home()
gotoxy(0, 0)
puts(@player.name)
if player.health == 0
puts(" Died!")
fin
gotoxy(1, 1)
puts("Morality:"); puti(player:morality)
gotoxy(1, 2)
puts("Skill :"); puti(player.skill)
gotoxy(1, 3)
puts("Stamina :"); puti(player.stamina)
gotoxy(1, 4)
puts("Strength:"); puti(player.strength)
gotoxy(1, 5)
puts("Health :"); puti(player.health)
gotoxy(20, 0)
puts(actors[other->kind])
if other->life == 0
puts("Died!")
fin
gotoxy(21, 1)
puts("Ethics :"); puti(other=>ethics)
gotoxy(21, 2)
puts("Power :"); puti(other->power)
gotoxy(21, 3)
puts("Life :"); puti(other->life)
end
def fight(who)
byte[t_actor] enemy
byte quit
word p_atck, e_atck
enemy.kind = who
enemy:ethics = ^(actors[who] + ^(actors[who]) + 1) - 128
enemy.power = 64 + (rnd & 191)
enemy.life = 128 + (rnd & 127)
quit = 0
repeat
putstats(@enemy)
gotoxy(12, 8); puts(@fightstr)
if toupper(getc()) == 'F'
p_atck = player.skill * player.strength / enemy.power
p_atck = p_atck + (rnd() & 15)
if enemy.life > p_atck
enemy.life = enemy.life - p_atck
else
player:morality = player:morality - enemy:ethics
enemy.life = 0
p_atck = player.skill + enemy.power / 10
if p_atck > 255 // Limit skill
p_atck = 255
fin
player.skill = p_atck
quit = 1
fin
e_atck = enemy.power / player.stamina
e_atck = e_atck + (rnd() & 15)
if player.health > e_atck
player.health = player.health - e_atck
else
player.health = 0
quit = 1
fin
else
quit = 1
fin
until quit
putstats(@enemy)
end
//
// This is the main loop. Know when to
// walk away, know when to run.
//
home()
repeat
player.health = 192 + (rnd & 63)
numactors = 0
repeat
gotoxy(10, 10 + numactors)
puti(numactors + 1); putc(' ')
puts(actors[numactors])
numactors = numactors + 1
until not actors[numactors]
gotoxy(2, 11 + numactors)
puts(@whostr)
choice = getc() - '0'
if choice > 0 and choice <= numactors
fight(choice - 1)
elsif choice == 0
player.health = 0
fin
until player.health == 0
gotoxy(0, 21); puts("That's all, folks!")
done
+59
View File
@@ -0,0 +1,59 @@
//
// SIEVE OF ERATOSTHENESE
//
// PRIME NUMBER FINDER SHOWING OFF SOME
// OF PLASMA'S BIT MANIPULATION
// OPERATIONS.
//
// THE APPLE ][ CANNOT DISPLAY THE
// TWO SYMBOLS USED FOR BIT COMPLIMENT
// AND INCLUSIVE OR: THE TILDE AND THE
// BAR. SO ALIASES FOR THESE OPERATORS
// ARE:
//
// ~ : BITWISE COMPLIMENT (CTRL-Y)
// | : BITWISE INCLUSIVE OR (CTRL-B)
//
// ON THE APPLE ][, THESE SHOW UP AS AN
// INVERTED ^ AND AN INVERTED \.
//
// IN THIS EXAMPLE, AN ARRAY IS USED TO
// HOLD THE FLAGS USED TO IDENTIFY NON-
// PRIME VALUES. THIS IS MORE MEMORY
// EFFICIENT THAN USING A WHOLE BYTE FOR
// EACH FLAG, BUT REQUIRES BITWISE TESTS
// FOR ONE OF THE EIGHT FLAGS IN EACH
// BYTE. SHIFTING RIGHT IS A FAST WAY
// TO DIVIDE BY POWERS OF TWO:
// X >> 3 IS THE SAME AS X / 8
// SHIFTING LEFT IS A FAST WAY TO
// MULTIPLY BY POWERS OF TWO:
// X << 2 IS THE SAME AS X * 4
//
CONST FALSE = 0
CONST TRUE = NOT FALSE
CONST IMAX = 8192
CONST IMAXM1 = IMAX-1
CONST SIZEF = IMAX/8
CONST CR = $0D
BYTE[SIZEF] FLAGS
WORD PRIME, I, K, COUNT = 0
MEMSET(@FLAGS, 0, SIZEF)
FOR I = 0 TO IMAXM1
IF NOT (FLAGS[I >> 3] & (1 << (I&7)))
PRIME = I + I + 3
FOR K = PRIME + I TO IMAXM1 STEP PRIME
FLAGS[K >> 3] = FLAGS[K >> 3] | (1 << (K&7))
NEXT
COUNT = COUNT + 1
PUTI(PRIME)
PUTC(CR)
FIN
NEXT
PUTI(COUNT)
PUTS(" PRIMES BETWEEN 0 AND ")
PUTI(IMAX << 1)
DONE
+111
View File
@@ -0,0 +1,111 @@
// PRODOS
//
// I HOPE YOUR INTRODUCTION TO PLASMA
// HAS INSPIRED YOU TO PLAY AROUND WITH
// PROGRAMMING YOUR APPLE II.
//
// THIS NEXT EXAMPLE SHOWS HOW TO CALL
// PRODOS TO DISPLAY A CATALOG. YOU MAY
// WANT TO CONSULT THE PRODOS TECH REF
// TO UNDERSTAND ALL THE PARAMETERS AND
// STRUCTURE OFFSETS.
//
BYTE PERR = 0
BYTE[512] DATABUFF
DEF GETPFX(PATH)
BYTE[3] PARAMS
^PATH = 0
PARAMS.0 = 1
PARAMS:1 = PATH
PERR = SYSCALL($C7, @PARAMS)
RETURN PATH
END
DEF OPEN(PATH, IOBUFF)
BYTE[6] PARAMS
PARAMS.0 = 3
PARAMS:1 = PATH
PARAMS:3 = IOBUFF
PARAMS.5 = 0
SYSCALL($C8, @PARAMS)
RETURN PARAMS.5
END
DEF READ(REFNUM, BUFF, LEN)
BYTE[8] PARAMS
PARAMS.0 = 4
PARAMS.1 = REFNUM
PARAMS:2 = BUFF
PARAMS:4 = LEN
PARAMS:6 = 0
PERR = SYSCALL($CA, @PARAMS)
RETURN PARAMS:6
END
DEF CLOSE(REFNUM)
BYTE[2] PARAMS
PARAMS.0 = 1
PARAMS.1 = REFNUM
PERR = SYSCALL($CC, @PARAMS)
RETURN PERR
END
DEF CATALOG
BYTE[64] PATH
BYTE REFNUM
BYTE FIRSTBLK
BYTE ENTRYLEN, ENTRIESBLK
BYTE I, TYPE, LEN
WORD ENTRY, FILECNT
GETPFX(@PATH)
PUTS(@PATH)
PUTC($0D)
REFNUM = OPEN(@PATH, $0800) // SAFE IO BUFFER LOCATION
IF PERR; RETURN PERR; FIN
FIRSTBLK = 1 // FIRST BLOCK IS TREATED SPECIAL
REPEAT
IF READ(REFNUM, @DATABUFF, 512) == 512
ENTRY = @DATABUFF.$04
IF FIRSTBLK
ENTRYLEN = DATABUFF.$23
ENTRIESBLK = DATABUFF.$24
FILECNT = DATABUFF:$25
ENTRY = ENTRY + ENTRYLEN
FIN
FOR I = FIRSTBLK TO ENTRIESBLK
TYPE = ^ENTRY
IF TYPE
LEN = TYPE & $0F
^ENTRY = LEN
PUTS(ENTRY)
IF ENTRY->$10 == $D0 // IS IT A DIRECTORY?
PUTC('/')
LEN = LEN + 1
ELSIF ENTRY->$10 == $FF // IS IT A SYSTEM FILE?
PUTC('*')
LEN = LEN + 1
FIN
FOR LEN = 19 - LEN DOWNTO 0
PUTC(' ')
NEXT
FILECNT = FILECNT - 1
FIN
ENTRY = ENTRY + ENTRYLEN
NEXT
FIRSTBLK = 0 // DONE WITH FIRST BLOCK
ELSE
FILECNT = 0
FIN
UNTIL FILECNT == 0
RETURN CLOSE(REFNUM)
END
CATALOG()
DONE
+30
View File
@@ -0,0 +1,30 @@
//
// THIS EXAMPLE SHOWS HOW TO CALL
// MACHINE CODE INSIDE YOUR PLASMA
// CODE. THIS MACHINE CODE IS EMBEDDED
// INSIDE THE DATA AND MUST BE POSITION
// INDEPENDENT. FUNCTIONS ARE EXPECTED
// TO RETURN A VALUE ON THE PLASMA
// EVALUATION STACK, INDEXED BY THE
// X-REGISTER. IT MUST BE CONSISTENT:
// INX FOR EVERY ARGUMENT, DEX FOR THE
// RETURN VALUE. THE ACTUAL VALUES ARE
// LOCATED IN ZERO PAGE:
//
// $C0,X = EVAL STACK LO BYTE
// $D0,X = EVAL STACK HI BYTE
//
// IF THE RETURN VALUE IS TO BE IGNORED,
// YOU CAN SKIP THE ACTUAL SETTING OF THE
// EVAL STACK AND JUST UPDATE THE X-REG.
//
BYTE CLICK = $AD, $30, $C0 // LDA $C030
BYTE = $CA // DEX
BYTE = $60 // RTS
BYTE I
FOR I=0 TO 200
(@CLICK)()
NEXT
DONE
+159
View File
@@ -0,0 +1,159 @@
//
// Check github for fully commented code
//
const MAX_FIBERS = 3
const MAX_FIBER = MAX_FIBERS-1
const FIBER_UNAVAIL = 0
const FIBER_FREE = 1
const FIBER_HALT = 2
const FIBER_RUN = 3
byte fbrState[MAX_FIBERS]
word fbrVMState[MAX_FIBERS]
byte fbrNext[MAX_FIBERS] = 0
byte fbrRunning = 0
struc t_vm
byte estklo[$10]
byte estkhi[$10]
byte esp
word ifp
word pp
byte hwsp
byte fill[9]
byte drop
byte nextop[$10]
byte frame[$40]
byte hwstk[$80]
end
word fbrPool[t_vm*MAX_FIBERS]
byte fbrSwap = $B5
byte = $C0,$85,$06,$B5,$D0,$85,$07,$E8
byte = $B5,$C0,$85,$08,$B5,$D0,$85,$09
byte = $86,$E0,$BA,$86,$E5,$A0,$26,$B9
byte = $C0,$00,$91,$08,$B1,$06,$99,$C0
byte = $00,$88,$10,$F3,$8A,$A8,$B9,$00
byte = $01,$91,$08,$C8,$D0,$F8,$A4,$E5
byte = $B1,$06,$99,$00,$01,$C8,$D0,$F8
byte = $A6,$E5,$9A,$A6,$E0,$60
byte fbrLoad = $B5,$C0
byte = $85,$06,$B5,$D0,$85,$07,$A0,$26
byte = $B1,$06,$99,$C0,$00,$88,$10,$F8
byte = $A4,$E5,$B1,$06,$99,$00,$01,$C8
byte = $D0,$F8,$A6,$E5,$9A,$A6,$E0,$60
def fbrInit
byte i
word pool
pool = @fbrPool + t_vm
for i = MAX_FIBER downto 1
fbrState[i] = FIBER_FREE
fbrVMState[i] = pool
pool = pool + t_vm
next
fbrState = FIBER_RUN
fbrVMState = @fbrPool
end
def fbrStop(fid)
byte i
if fid
fbrState[fid] = FIBER_FREE
i = 0
while fbrNext[i] <> fid
i = fbrNext[i]
loop
fbrNext[i] = fbrNext[fid]
if fid == fbrRunning
fbrRunning = fbrNext[fbrRunning]
return (@fbrLoad)(fbrVMState[fbrRunning])
fin
fin
end
def fbrExit
fbrStop(fbrRunning)
end
def fbrStart(defaddr, param)
byte i
word vmstate
for i = MAX_FIBER downto 1
if fbrState[i] == FIBER_FREE
fbrState[i] = FIBER_RUN
vmstate = fbrVMState[i]
vmstate=>ifp = vmstate + hwstk
vmstate=>pp = vmstate + hwstk
vmstate->esp = $0E
vmstate->estklo.$0F = i
vmstate->estkhi.$0F = 0
vmstate->estklo.$0E = param.0 // param lo byte
vmstate->estkhi.$0E = param.1 // param hi byte
vmstate->hwsp = $FB
vmstate=>$FE = @fbrExit - 1
vmstate=>$FC = defaddr - 1
fbrNext[i] = fbrNext[fbrRunning]
fbrNext[fbrRunning] = i
return i
fin
next
end
def fbrYield
byte prev
if fbrNext[fbrRunning] <> fbrRunning
prev = fbrRunning
fbrRunning = fbrNext[fbrRunning]
return (@fbrSwap)(fbrVMState[prev], fbrVMState[fbrRunning])
fin
end
def fbrHalt
byte i
if fbrRunning
i = 0
while fbrNext[i] <> fbrRunning
i = fbrNext[i]
loop
fbrState[fbrRunning] = FIBER_HALT
fbrNext[i] = fbrNext[fbrRunning]
i = fbrRunning
fbrRunning = fbrNext[fbrRunning]
return (@fbrSwap)(fbrVMState[i], fbrVMState[fbrRunning])
fin
end
def fbrResume(fid)
if fbrState[fid] == FIBER_HALT
fbrState[fid] = FIBER_RUN
fbrNext[fid] = fbrNext[fbrRunning]
fbrNext[fbrRunning] = fid
fin
end
//
// Test Fibers
//
def fbrTest(fid, param)
byte x
word i
i = 1
x = fid * 8
while 1
gotoxy(x, fid)
puts(param)
x = x + i
if x < 1 or x > 32
i = -i
fin
fbrYield
loop
end
fbrInit
fbrStart(@fbrTest, " World ")
fbrStart(@fbrTest, " Hello ")
while ^$C000 < 128
fbrYield
loop
^$C010
done
+55
View File
@@ -0,0 +1,55 @@
//
// GAME PORT I/O LIBRARY
// BASED ON THE WIRING LIBRARY
//
CONST ANN0 = $C058
CONST ANN1 = $C05A
CONST ANN2 = $C05C
CONST ANN3 = $C05E
CONST OFF = 0
CONST ON = 1
CONST STROBE = $C040
CONST FLAG0 = $C060
CONST FLAG1 = $C061
CONST FLAG2 = $C062
CONST FLAG3 = $C063
CONST PREAD = $FB1E
CONST WAIT = $FCA8
DEF DIGITALREAD(PIN)
RETURN FLAG0[PIN&3] > 127
END
DEF PORTREAD
RETURN (^FLAG0>>7)&1|(^FLAG1>>6)&2|(^FLAG2>>5)&4|(^FLAG3>>4)&8
END
DEF DIGITALWRITE(PIN, VAL)
RETURN ^ANN0[((PIN&3)<<1)+VAL&1]
END
DEF PORTWRITE(VAL)
^ANN0[VAL&1]
^ANN1[(VAL>>1)&1]
^ANN2[(VAL>>2)&1]
RETURN ^ANN3[(VAL>>3)&1]
END
DEF ANALOGREAD(PIN)
RETURN CALL(PREAD,0,PIN&3,0,0).2
END
DEF DELAY(TIME)
RETURN CALL(WAIT,TIME,0,0,0)
END
//
// OUTPUT THE ANALOG INPUT TO
// THE DIGITAL PORT
//
WHILE ^$C000 < 128
PORTWRITE((255 - ANALOGREAD(2)) / 16)
LOOP
^$C010
DONE
+92
View File
@@ -0,0 +1,92 @@
//
// PLASMA UNDERSTANDS TWO TYPES OF DATA:
// BYTES (UNSIGNED 8 BIT VALUES), AND
// WORDS (SIGNED 16 BIT VALUES). FROM
// THESE TWO TYPES, EVERYTHING MUST BE
// BUILT. BUT, PLASMA HELPS OUT WITH
// DEFINING DATA, INCLUDING ARRAYS,
// STRUCTURES, STRINGS, AND POINTERS.
// YOU'VE ALREADY SEEN A STRING IN THE
// FIRST EXAMPLE. HERE ARE SOME MORE...
//
BYTE[16] FILENAME // RESERVES 16 BYTES
//
// THE FOLLOWING RESERVES A MINUMUM
// AMOUNT OF SPACE FOR A STRING, PLUS
// IT INITIALIZES IT WITH A VALUE.
//
BYTE[32] PREFIX = "/EXAMPLES"
//
// ARRAY DEFINITIONS WITH NO SIZE DON'T
// RESERVE ANY SPACE, BUT ARE USEFUL FOR
// LABELS. ARRAY DEFINITIONS WITHOUT A
// NAMED VARIABLE JUST INITIALIZE THE
// MEMORY WITH VALUES.
//
BYTE[] ALIAS // ALIAS HAS SAME
WORD MYVAR = 1 // ADDRESS AS MYVAR
WORD = 2, 3, 4// BUT DIFFERENT TYPE
//
// PLASMA ALLOWS FLEXIBLE ARRAY SYNTAX,
// MORE TRADITIONAL ARRAYS LOOK LIKE:
//
WORD MYARRAY[2] // PICK ONE STYLE AND
// STICK WITH IT
//
// PLASMA ALSO HELPS OUT WITH CONSTANTS
// THAT CAN BE GIVEN A NAME TO MAKE THE
// CODE MORE READABLE.
//
CONST SPEAKER = $C030 // HEX VALUES START WITH '$'
//
// OF COURSE PLASMA HAS LOOPING
// CONSTRUCTS INCLUDING FOR/NEXT,
// REPEAT/UNTIL, WHILE/LOOP.
//
// THE FOR/NEXT IS THE MOST FLEXIBLE,
// TAKING THE EXPANDED FORM OF:
//
// FOR VAR = LO TO HI STEP INC
//
// FOR VAR = HI DOWNTO LO STEP DEC
//
FOR MYVAR = 0 TO 1000
^SPEAKER // ACCESS SPEAKER TO MAKE NOISE
NEXT
//
// HERE IS THE SAME THING USING A WHILE
// LOOP AND THE INCREMENT STATEMENT. THE
// TONE IS SLIGHTLY LOWER THAN ABOVE DUE
// TO THE 'WHILE' EXECUTING SLIGHTLY
// SLOWER THAN THE 'FOR' LOOP.
//
MYVAR = 0
WHILE MYVAR <= 1000
^SPEAKER
MYVAR++ // INCREMENT VARIABLE
LOOP
//
// AND TO BE THOROUGH, PLASMA PROGRAMS
// SHOULD END WITH A "DONE" SO THE
// COMPILER KNOWS WHEN TO STOP. ANYTHING
// FOLLOWING "DONE" IS IGNORED.
//
DONE
THIS CAN BE HANDY TO HAVE ARBITRARY TEXT
FOLLOWING THE PROGRAM CODE.
+83
View File
@@ -0,0 +1,83 @@
//
// THE PLASMA SANDBOX CAN'T LOAD
// MODULES LIKE THE FULL VERSION, BUT
// IT HAS SOME BUILT-IN FUNCTIONS THAT
// ALLOW EXTENSIVE ACCESS TO THE APPLE'S
// HARDWARE AND SOFTWARE ENVIRONMENT.
// OTHERS ARE JUST CONVENIENT OR ADD
// PERFORMANCE WHERE PLASMA MAY BE TOO
// SLOW
//
CONST TEXTSCREEN = $0400
CONST SCREENSIZE = 1024
BYTE[SCREENSIZE] SAVETXT
BYTE I
WORD NAME
//
// BUILT-IN FUNTIONS:
//
// SYSCALL(CMD,PARAMS) : CALL PRODOS
// CALL(ADDR,AREG,XREG,YREG,PSP) : CALL 6502 ROUTINE WITH REG VALUES
// MEMSET(DSTADDR, VALUE, SIZE) : FILL DSTADDR TO DSTADDR + SIZE WITH VALUE
// MEMCPY(DSTADDR, SRCADDR, SIZE) : COPY SRCADDR TO DSTADDR, SIZE BYTES
// PUTC(CHAR) : PRINT CHAR
// GETC() : READ CHAR FROM KEYBOARD
// PUTI(NUM) : PRINT INTEGER NUMBER
// PUTS(ADDR) : PRINT STRING AT ADDR
// GETS(CHAR) : READ STRING FROM KEYBOARD, PROMPTING WITH CHAR
// HOME() : CLEAR SCREEN AND HOME CURSOR
// GOTOXY(X,Y) : SET CURSOR TO X,Y
//
//
// SAVE THE TEXT SCREEN IN A BIG (1024) ARRAY
//
MEMCPY(@SAVETXT, TEXTSCREEN, SCREENSIZE) // SAVE TEXT SCREEN
//
// CLEAR SCREEN, HOME CURSOR. FOR
// FUNCTIONS WITHOUT PARAMETERS, THE
// "()" ARE OPTIONAL, BUT HELP CLARIFY
// THE FUNCTION CALL IS NOT A VARIABLE
// REFERENCE: HOME VS HOME()
//
HOME()
FOR I = 0 TO 23
//
// MOVE CURSOR TO POSITION X, Y
//
GOTOXY(I, I)
//
// OUTPUT A CHARACTER AND A SPACE
//
PUTC('A' + I)
PUTC(' ')
//
// OUTPUT AN INTEGER
//
PUTI(I)
NEXT
//
// NOTICE THE '@' IN SOME OF THE FUNCTION
// ARGUMENTS? DID YOU NOTICE THE '^' IN
// THE PREVIOUS EXAMPLE? ALL WILL BE
// EXPLAINED IN EX.4.PLA!
//
GOTOXY(10, 5)
PUTS("WHAT IS YOUR NAME")
NAME = GETS($BF) // GETS NEEDS PROMPT CHAR: '?' + 128
GOTOXY(12, 7)
PUTS("NICE TO MEET YOU, ")
PUTS(NAME)
GOTOXY(16, 10)
PUTS("PRESS ANY KEY TO EXIT.")
GETC()
GOTOXY(0, 5)
MEMCPY(TEXTSCREEN, @SAVETXT, SCREENSIZE)
DONE
+75
View File
@@ -0,0 +1,75 @@
//
// IN PLASMA, ANY VALUE CAN BE USED
// AS A CHARACTER, INTEGER, ADDRESS,
// OFFSET, ETC. JUST LIKE IN ASSEMBLY
// LANGUAGE, THERE ARE NO RESTRICTIONS.
// WITH GREAT FLEXIBILITY COMES GREAT
// RESPONSIBILITY. IN THE FIRST EXAMPLE,
// YOU SAW WHERE A STRING WAS PRINTED.
// THE LINE LOOKED LIKE: PUTS(@HELLO)
// HOWEVER, THE STRING NAME WAS JUST
// "HELLO", WITHOUT THE '@'. SO WHAT
// DOES THAT '@' DO? IT IS THE
// ADDRESS-OF OPERATOR. IT TAKES THE
// ADDRESS WHERE THE VARIABLE IS STORED
// FOR ITS VALUE, NOT THE VALUE OF THE
// VARIABLE. WHEN OUTPUTTING THE STRING,
// THE ADDRESS OF THE STRING IS PASSED
// IN, NOT THE ENTIRE STRING. THIS IS
// MUCH MORE EFFICIENT. WHEN AN ADDRESS
// IS PASSED AROUND, IT IS REFERED TO
// AS A "POINTER". IT "POINTS" TO
// SOMETHING.
//
// THE COROLLARY TO THE ADDRESS-OF
// OPERATOR IS THE POINTER-TO OPERATOR.
// NOW, IN PLASMA, A POINTER IS JUST AN
// ADDRESS, THERE IS NO IDEA OF WHAT IT
// POINTS TO. PLASMA ONLY KNOWS ABOUT
// BYTES AND WORDS, SO THERE ARE TWO
// POINTER-TO OPERATORS:
//
// ^ POINTER-TO-BYTE
// * POINTER-TO-WORD
//
// NOW THE '*' OPERATOR LOOKS JUST LIKE
// THE MULTIPLICATION OPERATOR, BUT IT
// BEHAVES DIFFERENTLY DEPENDING ON
// WHERE IT IS PLACED. THESE OPERATORS
// ARE PRE-OPS; THEY COME BEFORE THE
// OPERAND.
//
// NOTE THAT ADDRESSES, THUS POINTERS,
// ARE 16 BIT VALUES ON THE APPLE II.
// IF YOU ARE GOING TO SAVE AN ADDRESS
// IN A VARIABLE, IT MUST BE A WORD
// VARIABLE TO HOLD THE FULL PRECISION.
//
// HERE IS AN EXAMPLE TO PLAY WITH:
//
BYTE MYBYTE = 26
WORD MYWORD = 75
WORD MYPTR
MYPTR = @MYBYTE
PUTI(^MYPTR)
PUTC($8D) // THIS IS A CARRIAGE-RETURN CHARACTER
MYPTR = @MYWORD
PUTI(*MYPTR)
DONE // EVERYTHING AFTER "DONE" IS IGNORED
TRY PLAYING AROUND WITH THE CODE. GO
AHEAD. YOU CAN'T REALLY BREAK THE
COMPUTER. IF IT LOCKS UP AND CTRL-RESET
DOESN'T GET YOU BACK TO THE EDITOR, JUST
REBOOT THE MACHINE.
HOPEFULLY YOU SEE THAT THE VARIABLE
NAMES IN PLASMA ARE JUST LABELS APPLIED
TO ADDRESSES. SPACE IS SET ASIDE
DEPENDING ON THE SIZE OF THE VARIABLE,IF
ITS AN ARRAY, AND IF IT IS INITIALIZED.
+40
View File
@@ -0,0 +1,40 @@
//
// YOU'VE ALREADY SEEN SOME OF THE
// BUILT-IN FUNCTIONS IN PLASMA, NOW
// IT IS TIME TO DEFINE OUR OWN. THE
// REAL POWER OF PLASMA COMES FROM
// FUNCTION DEFINITIONS THAT USE LOCAL
// VARIABLES, AND THE ABILITY FOR
// RECURSION - FUNCTIONS THAT CAN CALL
// THEMSELVES. THE APPLE II DOES LIMIT
// THESE ABILITIES SOMEWHAT, BUT SOME
// COMPLEX ALGORITHMS WORK JUST FINE
// WITH THESE LIMITATION (INCLUDING
// THE PLASMA COMPILER, ITSELF).
//
// A FUNCTION DEFINITION HAS OPTIONAL
// ARGUMENTS, OPTIONAL LOCAL VARIABLES,
// AND AN OPTIONAL RETURN VALUE.
//
DEF ADD(A, B)
WORD C
C = A + B
RETURN C
END
PUTI(ADD(1, 2))
DONE
IN THE ABOVE EXAMPLE, THE RETURN COULD
BE SIMPLIFIED TO "RETURN A + B" BUT
I WAS TRYING TO SHOW HOW TO USE LOCAL
VARIABLES. ARRAYS CAN ALSO BE PLACED
IN THE LOCAL VARIABLES, BUT NOTE THAT
THE MAXIMUM SIZE OF LOCAL VARIABLES HAS
TO BE 255 BYTES OR LESS, PER DEFINITION.
ALSO, DUE TO THE NATURE OF THE 6502 CALL
STACK, ONLY A CALL DEPTH OF ABOUT 96 IS
AVAILABLE. AFTER THAT, THE STACK
OVERFLOWS AND UNEXPECTED THINGS HAPPEN.
+68
View File
@@ -0,0 +1,68 @@
//
// INSTEAD OF USING HARD-TO-REMEMBER
// NUMBERS, PLASMA ALLOWS YOU TO
// REPLACE THOSE WITH SYMBOLIC VALUES
//
CONST CR = $8D
CONST MALE = 0
CONST FEMALE = 1
//
// STRUCTURES ARE SYNTACTICAL CANDY
// FOR CREATING OFFSETS. IN THE FOLLOWING
// EXAMPLE, MYSTRUC IS A CONSTANT VALUE
// OF THE SIZE OF THE STRUCTURE. THE
// ELEMENTS WILL BE CONSTANTS REPRESENTING
// THE OFFSETS INTO THE STRUCTURE.
//
STRUC MYSTRUC
BYTE[32] FIRST
BYTE[32] LAST
BYTE AGE
WORD SEX
END
BYTE MALESTR = "MALE"
BYTE FEMALESTR = "FEMALE"
//
// INITIALIZE A SAMPLE RECORD.
//
BYTE[] RECORD
BYTE[32] = "STEVE"
BYTE[32] = "WOZNIAK"
BYTE = 61
WORD = @MALESTR
//
// HERE IS A NEW WAY TO USE POINTERS: AS
// A POINTER TO A STRUCTURE. AGAIN,
// SINCE POINTERS DON'T KNOW WHAT THEY
// POINT TO, THERE ARE TWO OPERATORS TO
// POINT TO A BYTE, OR POINT TO A WORD.
// '->' POINTS TO A BYTE USING A POINTER
// AND AN OFFSET. '=>' POINTS TO A WORD
// USING A POINTER AND AN OFFSET. IN
// THE FOLLOWING EXAMPLE, THE OFFSETS
// COME FROM THE 'MYSTRUC' DEFINITION.
//
DEF PUTREC(RECPTR)
PUTS(@RECPTR->FIRST) // ADDRESS OF FIRST NAME
PUTC(CR)
PUTS(@RECPTR->LAST) // ADDRESS OF LAST NAME
PUTC(CR)
PUTI(RECPTR->AGE) // AGE (BYTE)
PUTC(CR)
PUTS(RECPTR=>SEX) // POINTER TO STRING (WORD)
END
PUTS("STRUCTURE SIZE:")
PUTI(MYSTRUC) // THIS IS JUST THE SIZE OF THE STRUCTURE
PUTC(CR)
//
// PASS THE ADDRESS OF A SAMPLE RECORD
// TO BE PRINTED OUT.
//
PUTREC(@RECORD)
DONE
+65
View File
@@ -0,0 +1,65 @@
//
// RETURNING BACK TO ARRAYS AND STRINGS.
// SINGLE DIMENSION ARRAYS CAN BE
// ACCESSED WITH INDICES, USING THE TYPE
// THE ARRAY WAS DEFINED WITH. NOTICE
// THAT WITH INITIALIZED ARRAYS, THE "[]"
// IS OPTIONAL. ONLY IF A MINIMUM SIZE
// IS SPECIFIED (OR THERE ARE NO
// INITIALIZERS) ARE THE "[]" REQUIRED.
//
BYTE[] ASTRING = "PLASMA IS COOL!"
//
// MULTI-DIMENSIONAL ARRAYS ARE DEFINED
// AS POINTERS TO ARRAYS. THIS HAS THE
// BENEFIT OF CREATING SPARSE ARRAYS AND
// NON-CONTIGUOUS ARRAYS. THE APPLE II
// SCREEN MEMORY, FOR INSTANCE, WORKS
// WELL AS AN ARRAY OF POINTERS TO BYTES.
//
// BECAUSE POINTERS ARE 16 BITS, THE
// MULTI-DIMENSIONAL ARRAY IS DEFINED AS
// 'WORDS'. BUT HOW TO REPRESENT BYTE
// ARRAYS VS WORD ARRAYS? AGAIN, THERE
// ARE TWO SIZE OPERATORS THAT DEFINE
// BYTE ARRAYS AND WORD ARRAYS. '.' SETS
// THE ARRAY TYPE TO 'BYTE' AND ':' SETS
// THE ARRAY TYPE TO 'WORD'.
//
//
// '.' AND ':' CAN ALSO HAVE CONSTANTS
// FOLLOWING THEM, TO ACCESS FIXED
// OFFSETS FROM THE ARRAY, FOR STRUCTURE
// ELEMENT ACCESS. CHECK OUT THE ACCESS
// TO THE STRING LENGTH, IN BYTE OFFSET
// 0 (ASSIGNED TO CONSTANT STRLEN).
//
CONST STRLEN = 0
WORD[] TEXTSCREEN
WORD = $400, $480, $500, $580, $600, $680, $700, $780
WORD = $428, $4A8, $528, $5A8, $628, $6A8, $728, $7A8
WORD = $450, $4D0, $550, $5D0, $650, $6D0, $750, $7D0
//
// STRINGS IN PLASMA ARE PRODOS
// COMPATIBLE "PASCAL" STRINGS. STRINGS
// WITH THE LENGTH ENCODED IN THE FIRST
// BYTE, FOLLOWED BY THE CHARACTERS.
//
WORD P
BYTE I
HOME()
FOR I = 1 TO ASTRING.STRLEN // THE LENGTH OF THE STRING
TEXTSCREEN.[I, I] = ASTRING[I] | $80
NEXT
GOTOXY(0, ASTRING.STRLEN+2)
PUTS("THE STRING LENGTH IS:")
PUTI(ASTRING.STRLEN)
DONE
NOTE THAT THE HIGH BIT IS SET WHEN
WRITING CHARACTERS TO THE SCREEN. PLASMA
AND PRODOS USE 0..128 FOR ASCII VALUES,
BUT THE APPLE II SCREEN USES 128..255 FOR
NORMAL CHARACTERS.
+71
View File
@@ -0,0 +1,71 @@
//
// PLASMA DOESN'T REQUIRE UPPER CASE.
// HOWEVER, DUE TO THE NATURE OF THE
// APPLE ][ AND ][+, UPPER CASE WILL
// LOOK BEST ON ALL APPLE II COMPUTERS.
// IF YOU PRINT LOWER CASE TEXT ON AN
// APPLE ][ OR ][+ USING PUTS, IT WILL
// BE AUTOMATICALLY SHIFTED TO UPPER
// CASE.
//
// Here is the PLASMA version of
// Rod's Colors from the DOS System
// Master disk using the built-in call
// function to call ROM routines:
//
const showlores = $C056
const keyboard = $C000
const keystrobe = $C010
byte i, j, k, w, fmi, fmk, color
def textmode
call($FB39, 0, 0, 0, 0)
return home
end
def grmode
call($FB40, 0, 0, 0, 0)
^showlores
return home
end
def colors
while 1
for w = 3 to 50
for i = 1 to 19
for j = 0 to 19
k = i + j
color = (j * 3) / (i + 3) + i * w / 12
fmi = 40 - i
fmk = 40 - k
call($F864, color, 0, 0, 0) //grcolor(color);
call($F800, k, 0, i, 0) //grplot(i, k);
call($F800, i, 0, k, 0) //grplot(k, i);
call($F800, fmk, 0, fmi, 0) //grplot(fmi, fmk);
call($F800, fmi, 0, fmk, 0) //grplot(fmk, fmi);
call($F800, fmi, 0, k, 0) //grplot(k, fmi);
call($F800, k, 0, fmi, 0) //grplot(fmi, k);
call($F800, fmk, 0, i, 0) //grplot(i, fmk);
call($F800, i, 0, fmk, 0) //grplot(fmk, i);
if ^keyboard >= 128
return ^keystrobe
fin
next
next
next
loop
end
grmode
gotoxy(10,2) // X,Y offsets from the text window
puts("Press any key to exit.")
colors
textmode
puts("That's all, folks!")
done
This program skips the optional "()" on
parameter-less functions. You decide if
this is a style you prefer. Regardless,
be consistent in your source code.
+126
View File
@@ -0,0 +1,126 @@
//
// THIS IS A FOREST FIRE SIMULATION.
//
// WRITTEN IS A SLIGHTLY DIFFERENT STYLE.
//
CONST FALSE = 0
CONST TRUE = NOT FALSE
CONST SHOWLORES = $C056
CONST KEYBOARD = $C000
CONST KEYSTROBE = $C010
CONST EMPTY = 0
CONST TREE = 4
CONST FIRE = 13
CONST FORESTSIZE = 42*42
CONST RNDNUM = $4E
CONST RNDL = $4E
CONST RNDH = $4F
BYTE TREES1[FORESTSIZE] // ALT ARRAY SIZE SPECIFIER
BYTE TREES2[FORESTSIZE]
DEF TEXTMODE
CALL($FB39, 0, 0, 0, 0)
RETURN HOME
END
DEF GRMODE
CALL($FB40, 0, 0, 0, 0)
^SHOWLORES
RETURN HOME
END
//
// RANDOM NUMBERS
//
DEF RND
*RNDNUM = (*RNDNUM << 1) + *RNDNUM + 251
RETURN *RNDNUM & $7FFF
END
//
// CHECK IF A FIRE IS BURNING AROUND TREE
//
DEF BYFIRE(TREEPTR)
IF ^(TREEPTR - 43) == FIRE
RETURN TRUE
ELSIF ^(TREEPTR - 42) == FIRE
RETURN TRUE
ELSIF ^(TREEPTR - 41) == FIRE
RETURN TRUE
ELSIF ^(TREEPTR - 1) == FIRE
RETURN TRUE
ELSIF ^(TREEPTR + 1) == FIRE
RETURN TRUE
ELSIF ^(TREEPTR + 41) == FIRE
RETURN TRUE
ELSIF ^(TREEPTR + 42) == FIRE
RETURN TRUE
ELSIF ^(TREEPTR + 43) == FIRE
RETURN TRUE
FIN
RETURN FALSE
END
DEF FORESTFIRE
WORD NEWTREES, OLDTREES, NEWTREE, OLDTREE, YROW
BYTE X, Y
MEMSET(@TREES1, EMPTY, FORESTSIZE)
MEMSET(@TREES2, EMPTY, FORESTSIZE)
OLDTREES = @TREES1
NEWTREES = @TREES2
FOR Y = 1 TO 40
YROW = Y * 42
FOR X = 1 TO 40
IF RND < 8000
^(OLDTREES + X + YROW) = TREE
FIN
NEXT
NEXT
WHILE ^KEYBOARD < 128
FOR Y = 1 TO 40
YROW = Y * 42
FOR X = 1 TO 40
OLDTREE = OLDTREES + X + YROW
NEWTREE = NEWTREES + X + YROW
WHEN ^OLDTREE
IS EMPTY
IF RND < 5000
^NEWTREE = TREE
ELSE
^NEWTREE = EMPTY
FIN
BREAK
IS TREE
IF RND < 5 OR BYFIRE(OLDTREE)
^NEWTREE = FIRE
ELSE
^NEWTREE = TREE
FIN
BREAK
IS FIRE
^NEWTREE = EMPTY
WEND
CALL($F864, ^NEWTREE, 0, 0, 0)
CALL($F800, Y - 1, 0, X - 1, 0)
NEXT
NEXT
YROW = NEWTREES
NEWTREES = OLDTREES
OLDTREES = YROW
LOOP
RETURN ^KEYSTROBE
END
PUTS("PRESS ANY KEY TO BEGIN...")
GETC
GRMODE
HOME
GOTOXY(10,2)
PUTS("PRESS ANY KEY TO EXIT.")
FORESTFIRE
TEXTMODE
HOME
PUTS("THAT'S ALL FOLKS!")
DONE
+41
View File
@@ -0,0 +1,41 @@
include "inc/cmdsys.plh"
include "inc/args.plh"
include "inc/fileio.plh"
include "inc/grafix.plh"
var arg
byte ref
def showimage#0
var row, x
byte scanline[140]
for row = 0 to 191
//
// Read one scanline at a time, scale it, and draw it
//
fileio:read(ref, @scanline, 140)
for x = 139 downto 0
//scanline[x] = scanline[x] >> 4
pencolor(scanline[x] >> 4)
plot(x, row)
next
next
end
arg = argNext(argFirst)
if ^arg
ref = fileio:open(arg)
if ref
setmode(3) // 140 x 192 full color (or greyscale)
showimage
fileio:close(ref)
getc
setmode(-1)
else
puts("Unable to open "); puts(arg); putln
fin
else
puts("Usage: gfxdemo <imagefile>\n")
fin
done
+12 -13
View File
@@ -11,13 +11,13 @@
include "inc/cmdsys.plh" include "inc/cmdsys.plh"
include "inc/inet.plh" include "inc/inet.plh"
include "inc/fileio.plh" include "inc/fileio.plh"
include "inc/conio.plh"
word socketHTTP word socketHTTP
byte[65] prefix byte[65] prefix
word filebuff, iobuff word filebuff
byte fileInfo[12] = 0 // used for get_file_info() byte[15] fileInfo = 0 // used for get_file_info()
byte hello = "Apple II Web Server - 12 Nov 15\n" byte defhtml = "INDEX.HTML"
byte defhtml = "INDEX.HTML"
byte[200] okhdr // combined response header byte[200] okhdr // combined response header
// //
// HTTP response codes // HTTP response codes
@@ -78,7 +78,7 @@ def strcat2(dst, src1, src2)
return dst return dst
end end
def itos(dst, i) def itos(dst, i)
if i < 0; ^dst = '-'; i = -i; dst = dst + 1; fin if i < 0; ^dst = '-'; i = -i; dst++; fin
if i < 10 if i < 10
^dst = i + '0' ^dst = i + '0'
else else
@@ -141,7 +141,6 @@ def servHTTP(remip, remport, lclport, data, len, param)
// Get file info // Get file info
// //
//puts("getting file info "); // debug //puts("getting file info "); // debug
fileio:getfileinfo(@filename)
refnum = fileio:open(@filename) // try to open this file with ProDOS refnum = fileio:open(@filename) // try to open this file with ProDOS
if refnum // file was opened OK if refnum // file was opened OK
filelen = fileio:geteof(refnum) // get length of file for Content-Length filelen = fileio:geteof(refnum) // get length of file for Content-Length
@@ -152,7 +151,8 @@ def servHTTP(remip, remport, lclport, data, len, param)
// //
// Content type header // Content type header
// //
if fileInfo.4 == $03 OR fileInfo.4 == $04 fileio:getfileinfo(@filename, @fileInfo)
if fileInfo.1 == $03 OR fileInfo.1 == $04
// //
// this a text file // this a text file
// //
@@ -181,8 +181,8 @@ def servHTTP(remip, remport, lclport, data, len, param)
else // file couldn't be opened, so return 404 on this else // file couldn't be opened, so return 404 on this
puts("404 Not Found");putln // debug puts("404 Not Found");putln // debug
iNet:sendTCP(socketHTTP, @httpNOTFOUND + 1, httpNOTFOUND) iNet:sendTCP(socketHTTP, @httpNOTFOUND + 1, httpNOTFOUND)
fin // if refnum fin // refnum
break // return break
fin fin
next next
else else
@@ -196,7 +196,7 @@ end
if !iNet:initIP() if !iNet:initIP()
return -1 return -1
fin fin
puts(@hello) puts("PLASMA Web Server, Version 1.0\n")
fileio:getpfx(@prefix) fileio:getpfx(@prefix)
// //
// Alloc aligned file/io buffers // Alloc aligned file/io buffers
@@ -213,7 +213,6 @@ repeat
socketHTTP = iNet:listenTCP(80, @servHTTP, 0) socketHTTP = iNet:listenTCP(80, @servHTTP, 0)
fin fin
iNet:serviceIP() iNet:serviceIP()
until ^$C000 > 127 until conio:keypressed()
^$C010
done done
+8 -2
View File
@@ -1,5 +1,11 @@
<html> <html>
<body> <body>
Hello from the Apple II! <h1>Hello from PLASMA!</h1>
<h2>Useful links:</h2>
<br /><a href="https://github.com/dschmenk/PLASMA">PLASMA Language</a>
<br /><a href="https://www.facebook.com/groups/5251478676/">Facebook Apple II Enthusiasts</a>
<br /><a href="https://groups.google.com/forum/?hl=en#!forum/comp.sys.apple2">comp.sys.apple2</a>
</body> </body>
</html> </html>
+22
View File
@@ -0,0 +1,22 @@
include "inc/cmdsys.plh"
include "inc/conio.plh"
include "inc/mouse.plh"
var count
var xPos, yPos, bttn
Mouse:clampMouse(0, 39, 0, 23)
Mouse:setMouse(VBL_INT_ENABLE|MOVE_INT_ENABLE|BUTTON_INT_ENABLE|MOUSE_ENABLE)
while ^$C000 < 128
if Mouse:chkMouse()
conio:gotoxy(xPos, yPos); putc(' ')
xPos, yPos, bttn = Mouse:readMouse()#3
conio:gotoxy(xPos, yPos); putc(bttn & BUTTON_DOWN ?? '+' :: '^')
fin
if Mouse:chkVBL()
^$400++
fin
loop
getc
Mouse:detachMouse()
done
+1 -1
View File
@@ -12,7 +12,7 @@ word ref
// Sample background process to show it's working // Sample background process to show it's working
// //
def backgroundProc#0 def backgroundProc#0
^$0400++ putc('.')
end end
arg = argNext(argFirst) arg = argNext(argFirst)
+2 -2
View File
@@ -260,8 +260,8 @@ end
// //
export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist) export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
byte o, l, dist, tile, adjtile, occluded, darkness byte l, dist, tile, adjtile, occluded, darkness
word ymap, xmap, imap word ymap, xmap, imap, o
byte yscr, xscr byte yscr, xscr
if viewdist > beamdepth if viewdist > beamdepth
+9 -1
View File
@@ -85,7 +85,7 @@ def vals123#3
return 1, 2, 3 return 1, 2, 3
end end
export def main(range)#0 export def main(range)#0
byte a, b, c word a, b, c
word lambda word lambda
a = 10 a = 10
@@ -127,6 +127,14 @@ export def main(range)#0
drop, b, drop = vals123 drop, b, drop = vals123
drop, drop, c = vals123 drop, drop, c = vals123
puts("a, b, c = "); puti(a); puts(", "); puti(b); puts(", "); puti(c); putln puts("a, b, c = "); puti(a); puts(", "); puti(b); puts(", "); puti(c); putln
puts(" 7 / 3 = "); puti(7/3); puts(" ; 7 % 3 = "); puti(7%3); putln
puts(" 7 / -3 = "); puti(7/-3); puts("; 7 % -3 = "); puti(7%-3); putln
puts("-7 / 3 = "); puti(-7/3); puts("; -7 % 3 = "); puti(-7%3); putln
puts("-7 / -3 = "); puti(-7/-3); puts(" ; -7 % -3 = "); puti(-7%-3); putln
a,b=divmod(7,3); puts("divmod( 7, 3) = "); puti(a); puts(", "); puti(b); putln
a,b=divmod(7,-3); puts("divmod( 7,-3) = "); puti(a); puts(", "); puti(b); putln
a,b=divmod(-7,3); puts("divmod(-7, 3) = "); puti(a); puts(", "); puti(b); putln
a,b=divmod(-7,-3);puts("divmod(-7,-3) = "); puti(a); puts(", "); puti(b); putln
end end
def dummy(zz)#2 def dummy(zz)#2
+503
View File
@@ -0,0 +1,503 @@
//
// TFTP Daemon
//
include "inc/cmdsys.plh"
include "inc/inet.plh"
include "inc/fileio.plh"
include "inc/conio.plh"
//
// TFTP values
//
const TFTP_PORT = 69
const TID_INC = $0010
const RRQ = $0100
const WRQ = $0200
const DATAPKT = $0300
const ACKPKT = $0400
const ERRPKT = $0500
struc t_errPkt
word errOp
word errCode
byte errStr[]
byte errStrNull
end
struc t_ackPkt
word ackOp
word ackBlock
end
struc t_datPkt
word datOp
word datBlock
byte datBytes[]
end
res[t_errPkt] tftpError = $00, $05, $00, $00, $00
res[t_ackPkt] tftpAck = $00, $04, $00, $00
//
// Current file operations
//
byte ref, type, , netscii, filename[256]
word aux, block
word buff, TID = $1001
word portTFTP, portTID
//
// Swap bytes in word
//
asm swab(val)
!SOURCE "vmsrc/plvmzp.inc"
LDA ESTKL,X
LDY ESTKH,X
STA ESTKH,X
STY ESTKL,X
RTS
end
//
// Translate 'in' value to 'out' value
//
asm xlat(in, out, buf, len)#0
INX
INX
INX
INX
LDA ESTKL-4,X
ORA ESTKH-4,X
BEQ XLATEX
LDA ESTKL-3,X
STA SRCL
LDA ESTKH-3,X
STA SRCH
LDA ESTKL-1,X
LDY ESTKL-4,X
BEQ XLATLP
INC ESTKH-4,X
LDY #$00
XLATLP CMP (SRC),Y
BNE +
LDA ESTKL-2,X
STA (SRC),Y
LDA ESTKL-1,X
+ INY
BNE +
INC DSTH
INC SRCH
+ DEC ESTKL-4,X
BNE XLATLP
DEC ESTKH-4,X
BNE XLATLP
XLATEX RTS
end
//
// Convert byte to two hex chars
//
def btoh(cptr, b)#0
byte h
h = ((b >> 4) & $0F) + '0'
if h > '9'
h = h + 7
fin
^cptr = h
cptr++
h = (b & $0F) + '0'
if h > '9'
h = h + 7
fin
^cptr = h
end
def hexByte(hexChars)
byte lo, hi
lo = toupper(^(hexChars + 1)) - '0'
if lo > 9
lo = lo - 7
fin
hi = toupper(^hexChars) - '0'
if hi > 9
hi = hi - 7
fin
return (hi << 4) | lo
end
def hexWord(hexChars)
return (hexByte(hexChars) << 8) | hexByte(hexChars + 2)
end
def mkProName(netName, proName)#3
byte n, l, ascii, proType
word proAux
proType = $02 // default to BIN
proAux = $0000 // default to 0
//
// Check for CiderPress style extension
//
for l = 0 to 255
if netName->[l] == 0; break; fin
next
ascii = toupper(netName->[l + 1]) == 'N' // Netscii mode
if l > 7 and ^(netName + l - 7) == '#'
proType = hexByte(netName + l - 6)
proAux = hexWord(netName + l - 4)
l = l - 7
fin
memcpy(proName + 1, netName, l)
^proName = l
return ascii, proType, proAux
end
def mkNetName(proName, netName)
word l, n
byte fileinfo[t_fileinfo]
if !fileio:getfileinfo(proName, @fileinfo)
//
// Scan backward looking for dir seperator
//
l = ^proName
for n = l downto 1
if ^(proName + n) == '/'
break
fin
next
memcpy(netName + 1, proName + 1 + n, l - n)
^netName = l - n + 7
//
// Build CiderPress style extension
//
n = netName + ^netName - 6
^n = '#'
btoh(n + 1, fileinfo.file_type)
btoh(n + 3, fileinfo.aux_type.1)
btoh(n + 5, fileinfo.aux_type)
else
//
// Error getting info on file
//
puts("Error reading "); puts(proName); putln
return -1
fin
return 0
end
def readUDP(ipsrc, portsrc, data, len, param)
word err
err = 0
when *data
is $0500 // Error
err = *data
is $0400 // Ack
if swab(data=>ackBlock) <> block
puts("RRQ: Out-of-sequence block\n")
err = $0800 // Out-of-sequence block
break
fin
if param == 512 // Size of initial read
param = fileio:read(ref, buff+datBytes, 512)
if type == $04 // TXT type
xlat($0D, $0A, buff+datBytes, param)
fin
block++
buff=>datBlock = swab(block)
iNet:sendUDP(portTID, ipsrc, portsrc, buff, t_datPkt + param)
fin
if err
tftpError:errCode = err
iNet:sendUDP(portTID, ipsrc, portsrc, @tftpError, t_errPkt)
fin
if param < 512 or err
//
// All done
//
iNet:closeUDP(portTID)
fileio:close(ref)
ref = 0
fin
break
otherwise
puts("TFTP: RRQ Unexpected packet opcode: $"); puth(*data); putln
wend
return 0
end
def writeUDP(ipsrc, portsrc, data, len, param)
word err
err = 0
when *data
is $0300 // Data packet
if swab(data=>datBlock) <> block
puts("WRQ: Out-of-sequence block\n")
err = $0800 // Out-of-sequence block
break
fin
len = len - t_datPkt
if type == $04 // TXT type
xlat($0A, $0D, data+datBytes, len)
fin
if fileio:write(ref, data+datBytes, len) <> len
puts("WRQ: File write error\n")
tftpError:errCode = $0300 // Disk full error
break
fin
if not err
tftpAck:ackBlock = swab(block)
block++
iNet:sendUDP(portTID, ipsrc, portsrc, @tftpAck, t_ackPkt)
else
tftpError:errCode = err
iNet:sendUDP(portTID, ipsrc, portsrc, @tftpError, t_errPkt)
fin
if len < 512 or err
//
// All done
//
iNet:closeUDP(portTID)
fileio:close(ref)
ref = 0
fin
break
otherwise
puts("WRQ: Unexpected packet opcode: $"); puth(*data); putln
wend
return 0
end
def servUDP(ipsrc, portsrc, data, len, param)
byte info[24]
when *data
is RRQ // Read request
//
// Initiate file read
//
if ref
//
// File already open and active
//
tftpError:errCode = $0300 // Allocation exceeded
iNet:sendUDP(portTFTP, ipsrc, portsrc, @tftpError, t_errPkt)
return 0
fin
//
// Extract filename
//
netscii, type, aux = mkProName(data + 2, @filename)
ref = fileio:open(@filename)
if not ref
puts("Error opening file: "); puts(@filename)
puts(", Error: "); putb(perr); putln
tftpError:errCode = $0100 // File not found
iNet:sendUDP(portTFTP, ipsrc, portsrc, @tftpError, t_errPkt)
return 0
fin
info.0 = $0A
info:1 = @filename
syscall($C4, @info)
type = info.4
puts("Reading file: "); puts(@filename); putln
TID = (TID + TID_INC) | $1000
block = 1
buff=>datBlock = swab(block)
len = fileio:read(ref, buff+datBytes, 512)
if type == $04 // TXT type
xlat($0D, $0A, buff+datBytes, 512)
fin
portTID = iNet:openUDP(TID, @readUDP, len)
iNet:sendUDP(portTID, ipsrc, portsrc, buff, t_datPkt + len)
break
is WRQ // Write request
//
// Initiate file write
//
if ref
//
// File already open and active
//
tftpError:errCode = $0300 // Allocation exceeded
iNet:sendUDP(portTFTP, ipsrc, portsrc, @tftpError, t_errPkt)
return 0
fin
//
// Extract filename
//
netscii, type, aux = mkProName(data + 2, @filename)
fileio:destroy(@filename)
if fileio:create(@filename, type, aux)
puts("Create file error: "); putb(perr); putln
fin
ref = fileio:open(@filename)
if not ref
puts("Error opening file: "); puts(@filename)
puts(", Error: "); putb(perr); putln
tftpError:errCode = $0200 // Access violation
iNet:sendUDP(portTFTP, ipsrc, portsrc, @tftpError, t_errPkt)
return 0
fin
puts("Writing file: "); puts(@filename); putln
TID = (TID + TID_INC) | $1000
block = 1
tftpAck:ackBlock = 0
portTID = iNet:openUDP(TID, @writeUDP, 0)
iNet:sendUDP(portTID, ipsrc, portsrc, @tftpAck, t_ackPkt)
break
otherwise
puts("TFTP: Server Unexpected packet opcode: $"); puth(*data); putln
wend
return 0
end
if !iNet:initIP()
return -1
fin
puts("TFTP Server Version 0.1\n")
portTFTP = iNet:openUDP(TFTP_PORT, @servUDP, 0)
//
// Alloc aligned file/io buffers
//
buff = heapalloc(t_datPkt + 512)
buff=>datOp = $0300 // Data op
//
// Service IP
//
repeat
iNet:serviceIP()
until conio:keypressed()
done
Experpts from: RFC 1350, TFTP Revision 2, July 1992
TFTP Formats
Type Op # Format without header
2 bytes string 1 byte string 1 byte
-----------------------------------------------
RRQ/ | 01/02 | Filename | 0 | Mode | 0 |
WRQ -----------------------------------------------
2 bytes 2 bytes n bytes
---------------------------------
DATA | 03 | Block # | Data |
---------------------------------
2 bytes 2 bytes
-------------------
ACK | 04 | Block # |
--------------------
2 bytes 2 bytes string 1 byte
----------------------------------------
ERROR | 05 | ErrorCode | ErrMsg | 0 |
----------------------------------------
Initial Connection Protocol for reading a file
1. Host A sends a "RRQ" to host B with source= A's TID,
destination= 69.
2. Host B sends a "DATA" (with block number= 1) to host A with
source= B's TID, destination= A's TID.
Error Codes
Value Meaning
0 Not defined, see error message (if any).
1 File not found.
2 Access violation.
3 Disk full or allocation exceeded.
4 Illegal TFTP operation.
5 Unknown transfer ID.
6 File already exists.
7 No such user.
Internet User Datagram Header [2]
(This has been included only for convenience. TFTP need not be
implemented on top of the Internet User Datagram Protocol.)
Format
0 1 2 3
0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
| Source Port | Destination Port |
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
| Length | Checksum |
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
Values of Fields
Source Port Picked by originator of packet.
Dest. Port Picked by destination machine (69 for RRQ or WRQ).
Length Number of bytes in UDP packet, including UDP header.
Checksum Reference 2 describes rules for computing checksum.
(The implementor of this should be sure that the
correct algorithm is used here.)
Field contains zero if unused.
Note: TFTP passes transfer identifiers (TID's) to the Internet User
Datagram protocol to be used as the source and destination ports.
A transfer is established by sending a request (WRQ to write onto a
foreign file system, or RRQ to read from it), and receiving a
positive reply, an acknowledgment packet for write, or the first data
packet for read. In general an acknowledgment packet will contain
the block number of the data packet being acknowledged. Each data
packet has associated with it a block number; block numbers are
consecutive and begin with one. Since the positive response to a
write request is an acknowledgment packet, in this special case the
block number will be zero. (Normally, since an acknowledgment packet
is acknowledging a data packet, the acknowledgment packet will
contain the block number of the data packet being acknowledged.) If
the reply is an error packet, then the request has been denied.
In order to create a connection, each end of the connection chooses a
TID for itself, to be used for the duration of that connection. The
TID's chosen for a connection should be randomly chosen, so that the
probability that the same number is chosen twice in immediate
succession is very low. Every packet has associated with it the two
TID's of the ends of the connection, the source TID and the
destination TID. These TID's are handed to the supporting UDP (or
other datagram protocol) as the source and destination ports. A
requesting host chooses its source TID as described above, and sends
its initial request to the known TID 69 decimal (105 octal) on the
serving host. The response to the request, under normal operation,
uses a TID chosen by the server as its source TID and the TID chosen
for the previous message by the requestor as its destination TID.
The two chosen TID's are then used for the remainder of the transfer.
As an example, the following shows the steps used to establish a
connection to write a file. Note that WRQ, ACK, and DATA are the
names of the write request, acknowledgment, and data types of packets
respectively. The appendix contains a similar example for reading a
file.
1. Host A sends a "WRQ" to host B with source= A's TID,
destination= 69.
2. Host B sends a "ACK" (with block number= 0) to host A with
source= B's TID, destination= A's TID.
At this point the connection has been established and the first data
packet can be sent by Host A with a sequence number of 1. In the
next step, and in all succeeding steps, the hosts should make sure
that the source TID matches the value that was agreed on in steps 1
and 2. If a source TID does not match, the packet should be
discarded as erroneously sent from somewhere else. An error packet
should be sent to the source of the incorrect packet, while not
disturbing the transfer. This can be done only if the TFTP in fact
receives a packet with an incorrect TID. If the supporting protocols
do not allow it, this particular error condition will not arise.
The following example demonstrates a correct operation of the
protocol in which the above situation can occur. Host A sends a
request to host B. Somewhere in the network, the request packet is
duplicated, and as a result two acknowledgments are returned to host
A, with different TID's chosen on host B in response to the two
requests. When the first response arrives, host A continues the
connection. When the second response to the request arrives, it
should be rejected, but there is no reason to terminate the first
connection. Therefore, if different TID's are chosen for the two
connections on host B and host A checks the source TID's of the
messages it receives, the first connection can be maintained while
the second is rejected by returning an error packet.
+8
View File
@@ -232,6 +232,14 @@ void idglobal_size(int type, int size, int constsize)
else if (size) else if (size)
emit_data(0, 0, 0, size); emit_data(0, 0, 0, size);
} }
void idlocal_size(int size)
{
localsize += size;
if (localsize > 255)
{
parse_error("Local variable size overflow\n");
}
}
int id_tag(char *name, int len) int id_tag(char *name, int len)
{ {
int i; int i;
+1
View File
@@ -670,6 +670,7 @@ def gen_ctag(seq, tag)
op=>opnext = new_op op=>opnext = new_op
op = op=>opnext op = op=>opnext
fin fin
op->opcode = INVALID_CODE
op->opgroup = CODETAG_GROUP op->opgroup = CODETAG_GROUP
op=>optag = tag op=>optag = tag
return seq return seq
+1 -1
View File
@@ -133,7 +133,7 @@ def crunch_seq(seq, pass)
fin fin
break break
is CONST_CODE // Collapse constant operation is CONST_CODE // Collapse constant operation
nextopnext = nextop->nextop nextopnext = nextop=>opnext
if nextopnext if nextopnext
when nextopnext->opcode when nextopnext->opcode
is MUL_CODE is MUL_CODE
+4
View File
@@ -79,6 +79,10 @@ const BRNCH_CODE = $50
// //
const CODETAG_GROUP = $06 const CODETAG_GROUP = $06
// //
// Invalid code
//
const INVALID_CODE = $FF
//
// Code sequence op // Code sequence op
// //
struc t_opseq struc t_opseq
+82 -19
View File
@@ -33,6 +33,7 @@ const keyctrlc = $83
const keyctrld = $84 const keyctrld = $84
const keyctrle = $85 const keyctrle = $85
const keyctrlf = $86 const keyctrlf = $86
const keyctrlg = $87
const keyctrli = $89 const keyctrli = $89
const keyctrlk = $8B const keyctrlk = $8B
const keyctrll = $8C const keyctrll = $8C
@@ -569,15 +570,6 @@ end
// //
// Keyboard routines // Keyboard 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 dev_control(devnum, code, list)#1 def dev_control(devnum, code, list)#1
byte params[5] byte params[5]
@@ -588,13 +580,80 @@ def dev_control(devnum, code, list)#1
perr = syscall($83, @params) perr = syscall($83, @params)
return perr return perr
end end
def cons_keyavail
byte params[5]
byte count
params.0 = 3
params.1 = cmdsys.devcons
params.2 = 5
params:3 = @count
return syscall($82, @params) ?? 0 :: count
end
def cons_keyread
byte params[8]
byte key
params.0 = 4
params.1 = cmdsys.refcons
params:2 = @key
params:4 = 1
params:6 = 0
syscall($CA, @params)
return params:6 ?? key :: 0
end
def keyin3 def keyin3
byte count, key byte key
repeat repeat
cursflash cursflash
dev_status(cmdsys.devcons, 5, @count) until cons_keyavail
until count key = cons_keyread
key = getc if key & $80 // Open Apple modifier
when key
is keyarrowleft
key = keyctrla; break
is keyarrowright
key = keyctrls; break
is keyarrowup
key = keyctrlw; break
is keyarrowdown
key = keyctrlz; break
is keyenter
key = keyctrlf; break
is $80 | '\\'
key = keydelete; break // Delete
is keyenter
key = keyctrlf; break
//
// Map OA+keypad
//
is $80 | '4'
key = keyarrowleft; break
is $80 | '6'
key = keyarrowright; break
is $80 | '8'
key = keyarrowup; break
is $80 | '2'
key = keyarrowdown; break
is $80 | '7'
key = keyctrlq; break // Top
is $80 | '1'
key = keyctrle; break // Bottom
is $80 | '9'
key = keyctrlw; break // Pg Up
is $80 | '3'
key = keyctrlz; break // Pg Dn
is $80 | '5'
key = keyctrld; break // Del
is $80 | '.'
key = keyctrlb; break // Ins
is $80 | '0'
key = keyctrlv; break // Copy
is $80 | '-'
key = keyctrlx; break // Cut
wend
fin
return key | $80 return key | $80
end end
def keyin2e def keyin2e
@@ -634,14 +693,18 @@ def keyin2
until key >= 128 until key >= 128
^keystrobe ^keystrobe
if key == keyctrln if key == keyctrln
key = $DB // [ key = $DB // '['
elsif key == $9E // SHIFT+CTRL+N
key = $FE // '~'
elsif key == keyctrlp elsif key == keyctrlp
key = $DF // _ key = $DC // '\'
elsif key == keyctrlb elsif key == $80 // SHIFT+CTRL+P -> CTRL+@
key = $DC // \ key = $FC // '|'
elsif key == keyctrlg
key = $DF // '_'
elsif key == keyarrowleft elsif key == keyarrowleft
if ^pushbttn3 < 128 if ^pushbttn3 < 128
key = $FF key = keydelete
fin fin
elsif key >= $C0 and flags < shiftlock elsif key >= $C0 and flags < shiftlock
if ^pushbttn3 < 128 if ^pushbttn3 < 128
@@ -1060,7 +1123,7 @@ def cmdmode#0
word cmdptr word cmdptr
clrscrn clrscrn
puts("PLASMA Editor, Version 1.0\n") puts("PLASMA Editor, Version 1.1\n")
while not exit while not exit
puts(@filename) puts(@filename)
cmdptr = gets($BA) cmdptr = gets($BA)
+24 -31
View File
@@ -26,28 +26,24 @@
// fin // fin
// return FALSE // return FALSE
//end //end
def keymatch //def keymatch
byte i, keypos // byte i, keypos
word chrptr // word chrptr
//
keypos = 0 // keypos = 0
while keywrds[keypos] < tknlen // while keywrds[keypos] < tknlen
keypos = keypos + keywrds[keypos] + 2 // keypos = keypos + keywrds[keypos] + 2
loop // loop
chrptr = tknptr - 1 // chrptr = tknptr - 1
while keywrds[keypos] == tknlen // while keywrds[keypos] == tknlen
for i = 1 to tknlen // i = 1; while i <= tknlen and ^(chrptr + i) == keywrds[keypos + i]; i++; loop
if ^(chrptr + i) <> keywrds[keypos + i] // if i > tknlen
break // return keywrds[keypos + keywrds[keypos] + 1]
fin // fin
next // keypos = keypos + keywrds[keypos] + 2
if i > tknlen // loop
return keywrds[keypos + keywrds[keypos] + 1] // return ID_TKN
fin //end
keypos = keypos + keywrds[keypos] + 2
loop
return ID_TKN
end
def scannum def scannum
word num word num
num = 0 num = 0
@@ -84,23 +80,20 @@ def scan
scanptr++ scanptr++
loop loop
tknptr = scanptr tknptr = scanptr
scanchr = toupper(^scanptr) scanchr, scanptr, token = scanid(scanptr, @keywrds) //scanchr = toupper(^scanptr)
// //
// Scan for token based on first character // Scan for token based on first character
// //
//if isalpha(scanchr) if token //if isalpha(scanchr)
if (scanchr >= 'A' and scanchr <= 'Z') or (scanchr == '_')
// //
// ID, either variable name or reserved word // ID, either variable name or reserved word
// //
repeat //repeat
^scanptr = scanchr // ^scanptr = scanchr
scanptr++ // scanptr++
scanchr = toupper(^scanptr) // scanchr = toupper(^scanptr)
//until not isalphanum(scanchr) //until not isalphanum(scanchr)
until not ((scanchr >= 'A' and scanchr <= 'Z') or (scanchr >= '0' and scanchr <= '9' ) or (scanchr == '_'))
tknlen = scanptr - tknptr tknlen = scanptr - tknptr
token = keymatch
elsif scanchr >= '0' and scanchr <= '9' // isnum() elsif scanchr >= '0' and scanchr <= '9' // isnum()
// //
// Decimal constant // Decimal constant
+8 -2
View File
@@ -1170,8 +1170,13 @@ int parse_var(int type, long basesize)
{ {
if (idlen) if (idlen)
id_add(idstr, idlen, type, size); id_add(idstr, idlen, type, size);
else else if (!(type & EXTERN_TYPE))
emit_data(0, 0, 0, size); {
if (type & LOCAL_TYPE)
idlocal_size(size);
else
emit_data(0, 0, 0, size);
}
} }
return (1); return (1);
} }
@@ -1584,6 +1589,7 @@ int parse_defs(void)
next_line(); next_line();
} while (scantoken != END_TOKEN); } while (scantoken != END_TOKEN);
scan(); scan();
infunc = 0;
return (1); return (1);
} }
return (scantoken == EOL_TOKEN); return (scantoken == EOL_TOKEN);
+8 -4
View File
@@ -402,7 +402,7 @@ def parse_value(codeseq, r_val)#2
else else
deref++ deref++
fin fin
type = (type & PTR_TYPE) | token == PTRB_TKN ?? BYTE_TYPE :: WORD_TYPE type = token == PTRB_TKN ?? BYTE_TYPE :: WORD_TYPE
if not parse_const(@const_offset) if not parse_const(@const_offset)
rewind(tknptr) // Setting type override for following operations rewind(tknptr) // Setting type override for following operations
elsif const_offset <> 0 elsif const_offset <> 0
@@ -421,7 +421,7 @@ def parse_value(codeseq, r_val)#2
elsif not (type & VAR_TYPE) elsif not (type & VAR_TYPE)
deref++ deref++
fin fin
type = (type & VAR_TYPE) | (token == DOT_TKN ?? BYTE_TYPE :: WORD_TYPE) type = token == DOT_TKN ?? BYTE_TYPE :: WORD_TYPE
if not parse_const(@const_offset) if not parse_const(@const_offset)
rewind(tknptr) // Setting type override for following operations rewind(tknptr) // Setting type override for following operations
elsif const_offset <> 0 elsif const_offset <> 0
@@ -941,8 +941,12 @@ def parse_var(type, basesize)#0
else else
new_iddata(idptr, idlen, type, size) new_iddata(idptr, idlen, type, size)
fin fin
elsif not (type & (EXTERN_TYPE|LOCAL_TYPE)) elsif not type & EXTERN_TYPE
emit_fill(size) if type & LOCAL_TYPE
framesize = framesize + size
else
size_iddata(type, size, 0)
fin
fin fin
fin fin
end end
+101 -1
View File
@@ -342,6 +342,106 @@ const ERR_SYNTAX = $8000
// //
//===================================== //=====================================
//
// Lexical scanner helper for keyword/IDs
//
asm scanid(scanptr, keywrds)#3
!SOURCE "vmsrc/plvmzp.inc"
LDA ESTKL,X
STA DSTL
LDA ESTKH,X
STA DSTH
LDA ESTKL+1,X
STA ESTKL,X ; COPY OUTPUT SCANPTR
STA SRCL
LDA ESTKH+1,X
STA ESTKH,X
STA SRCH
DEX
LDA #$00
STA ESTKL,X ; CLEAR OUTPUT TOKEN
STA ESTKH,X
STA ESTKH+2,X ; CLEAR MSB OF SCANCHR
TAY
LDA (SRC),Y
AND #$7F
CMP #'a'
BCC +
CMP #'z'+1
BCS +
SBC #$1F
STA (SRC),Y
+ STA ESTKL+2,X ; SET SCANCHR
CMP #'_'
BEQ +
CMP #'A'
BCC SCANEX
CMP #'Z'+1
BCS SCANEX
+ LDA #$D6 ; ID_TKN
STA ESTKL,X ; SET OUTPUT TOKEN = ID_TKN
SCANID INY
LDA (SRC),Y
AND #$7F
BEQ ++
CMP #'a'
BCC +
CMP #'z'+1
BCS ++
SBC #$1F
STA (SRC),Y ; COPY UPPERCASE CHAR BACK TO ^SCANPTR
BNE SCANID
+ CMP #'_'
BEQ SCANID
CMP #'0'
BCC ++
CMP #'9'+1
BCC SCANID
CMP #'A'
BCC ++
CMP #'Z'+1
BCC SCANID
++ STY TMPL
TYA
LDY #$00
CLC
ADC SRCL
STA ESTKL+1,X ; UPDATE SCANPTR
BCC MATCHLEN
INC ESTKH+1,X
MATCHLEN LDA (DST),Y
CMP TMPL
BCS +
ADC #$02
ADC DSTL
STA DSTL
BCC MATCHLEN
INC DSTH
BNE MATCHLEN
+ BNE SCANEX ; NO KEY MATCH
TAY
DEY
INC DSTL
BNE MATCHKEY
INC DSTH
MATCHKEY LDA (SRC),Y
CMP (DST),Y
BNE NEXTKEY
DEY
BPL MATCHKEY
LDY TMPL
LDA (DST),Y
STA ESTKL,X ; SET OUTPUT TOKEN
SCANEX RTS
NEXTKEY LDY #$00
LDA TMPL
SEC
ADC DSTL
STA DSTL
BCC MATCHLEN
INC DSTH
BNE MATCHLEN
end
// //
// Handy functions // Handy functions
// //
@@ -411,7 +511,7 @@ include "toolsrc/parse.pla"
// //
// Look at command line arguments and compile module // Look at command line arguments and compile module
// //
puts("PLASMA Compiler, Version 1.0\n") puts("PLASMA Compiler, Version 1.1\n")
arg = argNext(argFirst) arg = argNext(argFirst)
if ^arg and ^(arg + 1) == '-' if ^arg and ^(arg + 1) == '-'
opt = arg + 2 opt = arg + 2
+2
View File
@@ -46,4 +46,6 @@ int id_tag(char *name, int len);
int id_const(char *name, int len); int id_const(char *name, int len);
int id_type(char *name, int len); int id_type(char *name, int len);
void idglobal_size(int type, int size, int constsize); void idglobal_size(int type, int size, int constsize);
void idlocal_size(int size);
void idlocal_size(int size);
int tag_new(int type); int tag_new(int type);
@@ -40,7 +40,7 @@ predef sext(a)#1, divmod(a,b)#2, execmod(modfile)#1
// //
// Exported CMDSYS table // Exported CMDSYS table
// //
word version = $0100 // 01.00 word version = $0120 // 01.20
word syspath word syspath
word syscmdln word syscmdln
word = @execmod word = @execmod
+10 -11
View File
@@ -1,6 +1,5 @@
const MACHID = $BF98 const MACHID = $BF98
const iobuffer = $0800 const iobuffer = $0800
const databuff = $2000
const RELADDR = $1000 const RELADDR = $1000
const symtbl = $0C00 const symtbl = $0C00
const freemem = $0006 const freemem = $0006
@@ -38,7 +37,7 @@ predef execmod(modfile)#1
// //
// Exported CMDSYS table // Exported CMDSYS table
// //
word version = $0100 // 01.00 word version = $0120 // 01.20
word syspath word syspath
word syscmdln word syscmdln
word = @execmod word = @execmod
@@ -1260,9 +1259,9 @@ def volumes()#0
params.0 = 2 params.0 = 2
params.1 = 0 params.1 = 0
params:2 = databuff params:2 = heap
perr = syscall($C5, @params) perr = syscall($C5, @params)
strbuf = databuff strbuf = heap
for i = 0 to 15 for i = 0 to 15
^strbuf = ^strbuf & $0F ^strbuf = ^strbuf & $0F
if ^strbuf if ^strbuf
@@ -1287,12 +1286,12 @@ def catalog(path)#0
fin fin
firstblk = 1 firstblk = 1
repeat repeat
if read(refnum, databuff, 512) == 512 if read(refnum, heap, 512) == 512
entry = databuff + 4 entry = heap + 4
if firstblk if firstblk
entrylen = databuff.$23 entrylen = heap->$23
entriesblk = databuff.$24 entriesblk = heap->$24
filecnt = databuff:$25 filecnt = heap=>$25
entry = entry + entrylen entry = entry + entrylen
fin fin
for i = firstblk to entriesblk for i = firstblk to entriesblk
@@ -1372,7 +1371,7 @@ def resetmemfiles()#0
// //
// Close all files // Close all files
// //
^$BFD8 = 0 ^$BF94 = 0
close(0) close(0)
// //
// Set memory bitmap // Set memory bitmap
@@ -1390,7 +1389,7 @@ def execsys(sysfile)#0
striptrail(sysfile) striptrail(sysfile)
refnum = open(sysfile) refnum = open(sysfile)
if refnum if refnum
len = read(refnum, databuff, $FFFF) len = read(refnum, $2000, $FFFF)
resetmemfiles() resetmemfiles()
if len if len
strcpy(sysfile, $280) strcpy(sysfile, $280)
@@ -43,6 +43,6 @@ LCBNK1 = $08
JMP $1000 JMP $1000
_CMDBEGIN = * _CMDBEGIN = *
!PSEUDOPC $1000 { !PSEUDOPC $1000 {
!SOURCE "vmsrc/cmd.a" !SOURCE "vmsrc/apple/cmd.a"
_CMDEND = * _CMDEND = *
} }
+12 -13
View File
@@ -64,7 +64,7 @@ MUL STY IPY
LDA #$00 LDA #$00
STA ESTKL+1,X ; PRODL STA ESTKL+1,X ; PRODL
; STA ESTKH+1,X ; PRODH ; STA ESTKH+1,X ; PRODH
MULLP LSR TMPH ; MULTPLRH _MULLP LSR TMPH ; MULTPLRH
ROR TMPL ; MULTPLRL ROR TMPL ; MULTPLRL
BCS + BCS +
STA ESTKH+1,X ; PRODH STA ESTKH+1,X ; PRODH
@@ -76,7 +76,7 @@ MULLP LSR TMPH ; MULTPLRH
+ ASL ESTKL,X ; MULTPLNDL + ASL ESTKL,X ; MULTPLNDL
ROL ESTKH,X ; MULTPLNDH ROL ESTKH,X ; MULTPLNDH
DEY DEY
BNE MULLP BNE _MULLP
STA ESTKH+1,X ; PRODH STA ESTKH+1,X ; PRODH
LDY IPY LDY IPY
JMP DROP JMP DROP
@@ -147,7 +147,7 @@ DIVMOD JSR _DIV
STA ESTKL,X STA ESTKL,X
LDA TMPH ; REMNDRH LDA TMPH ; REMNDRH
STA ESTKH,X STA ESTKH,X
LDA DVSIGN ; REMAINDER IS SIGN OF DIVIDEND ASL DVSIGN ; REMAINDER IS SIGN OF DIVIDEND
BMI NEG BMI NEG
JMP NEXTOP JMP NEXTOP
;* ;*
@@ -171,21 +171,20 @@ _DIV STY IPY
LDA #$00 LDA #$00
STA TMPL ; REMNDRL STA TMPL ; REMNDRL
STA TMPH ; REMNDRH STA TMPH ; REMNDRH
LDA ESTKH,X
AND #$80
STA DVSIGN STA DVSIGN
BPL + LDA ESTKH+1,X
JSR _NEG
INC DVSIGN
+ LDA ESTKH+1,X
BPL + BPL +
INX INX
JSR _NEG JSR _NEG
DEX DEX
INC DVSIGN LDA #$81
BNE _DIV1 STA DVSIGN
+ ORA ESTKL+1,X ; DVDNDL + ORA ESTKL+1,X ; DVDNDL
BEQ _DIVEX BEQ _DIVEX
LDA ESTKH,X
BPL _DIV1
JSR _NEG
INC DVSIGN
_DIV1 ASL ESTKL+1,X ; DVDNDL _DIV1 ASL ESTKL+1,X ; DVDNDL
ROL ESTKH+1,X ; DVDNDH ROL ESTKH+1,X ; DVDNDH
DEY DEY
@@ -902,7 +901,7 @@ LEAVE INY ;+INC_IP
RTS RTS
+ INC IFPH + INC IFPH
RET RTS RET RTS
A1CMD !SOURCE "vmsrc/a1cmd.a" A1CMD !SOURCE "vmsrc/apple/a1cmd.a"
SEGEND = * SEGEND = *
VMINIT LDY #$10 ; INSTALL PAGE 0 FETCHOP ROUTINE VMINIT LDY #$10 ; INSTALL PAGE 0 FETCHOP ROUTINE
- LDA PAGE0-1,Y - LDA PAGE0-1,Y
+14 -14
View File
@@ -457,7 +457,7 @@ MUL STY IPY
LDA #$00 LDA #$00
STA ESTKL+1,X ; PRODL STA ESTKL+1,X ; PRODL
; STA ESTKH+1,X ; PRODH ; STA ESTKH+1,X ; PRODH
MULLP LSR TMPH ; MULTPLRH _MULLP LSR TMPH ; MULTPLRH
ROR TMPL ; MULTPLRL ROR TMPL ; MULTPLRL
BCS + BCS +
STA ESTKH+1,X ; PRODH STA ESTKH+1,X ; PRODH
@@ -469,7 +469,7 @@ MULLP LSR TMPH ; MULTPLRH
+ ASL ESTKL,X ; MULTPLNDL + ASL ESTKL,X ; MULTPLNDL
ROL ESTKH,X ; MULTPLNDH ROL ESTKH,X ; MULTPLNDH
DEY DEY
BNE MULLP BNE _MULLP
STA ESTKH+1,X ; PRODH STA ESTKH+1,X ; PRODH
LDY IPY LDY IPY
JMP DROP JMP DROP
@@ -489,21 +489,20 @@ _DIV STY IPY
LDA #$00 LDA #$00
STA TMPL ; REMNDRL STA TMPL ; REMNDRL
STA TMPH ; REMNDRH STA TMPH ; REMNDRH
LDA ESTKH,X
AND #$80
STA DVSIGN STA DVSIGN
BPL + LDA ESTKH+1,X
JSR _NEG
INC DVSIGN
+ LDA ESTKH+1,X
BPL + BPL +
INX INX
JSR _NEG JSR _NEG
DEX DEX
INC DVSIGN LDA #$81
BNE _DIV1 STA DVSIGN
+ ORA ESTKL+1,X ; DVDNDL + ORA ESTKL+1,X ; DVDNDL
BEQ _DIVEX BEQ _DIVEX
LDA ESTKH,X
BPL _DIV1
JSR _NEG
INC DVSIGN
_DIV1 ASL ESTKL+1,X ; DVDNDL _DIV1 ASL ESTKL+1,X ; DVDNDL
ROL ESTKH+1,X ; DVDNDH ROL ESTKH+1,X ; DVDNDH
DEY DEY
@@ -568,7 +567,7 @@ DIVMOD JSR _DIV
STA ESTKL,X STA ESTKL,X
LDA TMPH ; REMNDRH LDA TMPH ; REMNDRH
STA ESTKH,X STA ESTKH,X
LDA DVSIGN ; REMAINDER IS SIGN OF DIVIDEND ASL DVSIGN ; REMAINDER IS SIGN OF DIVIDEND
BMI NEG BMI NEG
JMP NEXTOP JMP NEXTOP
;* ;*
@@ -1161,7 +1160,7 @@ SAW INY ;+INC_IP
LDY IPY LDY IPY
BMI + BMI +
JMP DROP JMP DROP
JMP FIXDROP + JMP FIXDROP
;* ;*
;* STORE VALUE TO ABSOLUTE ADDRESS WITHOUT POPPING STACK ;* STORE VALUE TO ABSOLUTE ADDRESS WITHOUT POPPING STACK
;* ;*
@@ -1448,6 +1447,7 @@ ICALX LDA ESTKL,X
PHP PHP
PLA PLA
STA PSR STA PSR
SEI
STA ALTRDON STA ALTRDON
PLA PLA
STA IPH STA IPH
@@ -1884,7 +1884,7 @@ OPCPY STA DST
INC SRC INC SRC
BNE + BNE +
INC SRC+1 INC SRC+1
+ + DEY
- LDA (SRC),Y - LDA (SRC),Y
STA (DST),Y STA (DST),Y
DEY DEY
+75 -56
View File
@@ -42,17 +42,17 @@ DSTX = XPAGE+DSTH
;* ;*
;* INTERPRETER HEADER+INITIALIZATION ;* INTERPRETER HEADER+INITIALIZATION
;* ;*
SEGSTART = $A000 SEGSTART = $2000
*= SEGSTART-$0E *= SEGSTART-$0E
!TEXT "SOS NTRP" !TEXT "SOS NTRP"
!WORD $0000 !WORD $0000
!WORD SEGSTART !WORD SEGSTART
!WORD SEGEND-SEGSTART !WORD SEGEND-SEGSTART
+SOS $40, SEGREQ ; ALLOCATE SEG 1 AND MAP IT ; +SOS $40, SEGREQ ; ALLOCATE SEG 1 AND MAP IT
BNE FAIL ; PRHEX ; BNE FAIL ; PRHEX
LDA #$01 ; LDA #$00
STA MEMBANK ; STA MEMBANK
LDY #$0F ; INSTALL PAGE 0 FETCHOP ROUTINE LDY #$0F ; INSTALL PAGE 0 FETCHOP ROUTINE
LDA #$00 LDA #$00
- LDX PAGE0,Y - LDX PAGE0,Y
@@ -62,19 +62,36 @@ SEGSTART = $A000
BPL - BPL -
LDX #$4C ; SET JMPTMP OPCODE LDX #$4C ; SET JMPTMP OPCODE
STX JMPTMP STX JMPTMP
; STA JMPTMPX
; STA JMPTMPX+1
STA TMPX ; CLEAR ALL EXTENDED POINTERS STA TMPX ; CLEAR ALL EXTENDED POINTERS
STA SRCX STA SRCX
STA DSTX STA DSTX
STA PPX ; INIT FRAME & POOL POINTERS STA PPX ; INIT FRAME & POOL POINTERS
STA IFPX STA IFPX
LDA #<SEGSTART LDA #$00
STA PPL STA PPL
STA IFPL STA IFPL
LDA #>SEGSTART LDA #$A0
STA PPH STA PPH
STA IFPH STA IFPH
!IF 1 {
LDA #<VMCORE ; COPY VM+CMD INTO SBANK
STA SRCL
LDA #>VMCORE
STA SRCH
LDY #$00
STY DSTL
LDA #$A0
STA DSTH
- LDA (SRC),Y
STA (DST),Y
INY
BNE -
INC SRCH
INC DSTH
LDA DSTH
CMP #$B8
BNE -
}
LDX #$FF ; INIT STACK POINTER LDX #$FF ; INIT STACK POINTER
TXS TXS
LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX
@@ -97,13 +114,13 @@ SEGSTART = $A000
; BCC + ; BCC +
; ADC #6 ; ADC #6
;+ STA $481 ;$880 ;+ STA $481 ;$880
FAIL STA $0480 ;FAIL STA $0480
RTS ; RTS
SEGREQ !BYTE 4 ;SEGREQ !BYTE 4
!WORD $2001 ; !WORD $2000
!WORD $9F01 ; !WORD $9F00
!BYTE $10 ; !BYTE $10
!BYTE $00 ; !BYTE $00
PAGE0 = * PAGE0 = *
!PSEUDOPC DROP { !PSEUDOPC DROP {
;* ;*
@@ -115,6 +132,20 @@ PAGE0 = *
STA OPIDX STA OPIDX
JMP (OPTBL) JMP (OPTBL)
} }
VMCORE = *
!PSEUDOPC $A000 {
;*
;* OPCODE TABLE
;*
!ALIGN 255,0
OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E
!WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E
!WORD LNOT,LOR,LAND,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E
!WORD DROP,DUP,NEXTOP,DIVMOD,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E
!WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E
!WORD BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,CFFB ; 50 52 54 56 58 5A 5C 5E
!WORD LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E
!WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E
;* ;*
;* SYSTEM INTERPRETER ENTRYPOINT ;* SYSTEM INTERPRETER ENTRYPOINT
;* ;*
@@ -162,21 +193,20 @@ _DIV STY IPY
LDA #$00 LDA #$00
STA TMPL ; REMNDRL STA TMPL ; REMNDRL
STA TMPH ; REMNDRH STA TMPH ; REMNDRH
LDA ESTKH,X
AND #$80
STA DVSIGN STA DVSIGN
BPL + LDA ESTKH+1,X
JSR _NEG
INC DVSIGN
+ LDA ESTKH+1,X
BPL + BPL +
INX INX
JSR _NEG JSR _NEG
DEX DEX
INC DVSIGN LDA #$81
BNE _DIV1 STA DVSIGN
+ ORA ESTKL+1,X ; DVDNDL + ORA ESTKL+1,X ; DVDNDL
BEQ _DIVEX BEQ _DIVEX
LDA ESTKH,X
BPL _DIV1
JSR _NEG
INC DVSIGN
_DIV1 ASL ESTKL+1,X ; DVDNDL _DIV1 ASL ESTKL+1,X ; DVDNDL
ROL ESTKH+1,X ; DVDNDH ROL ESTKH+1,X ; DVDNDH
DEY DEY
@@ -201,18 +231,6 @@ _DIVEX INX
LDY IPY LDY IPY
RTS RTS
;* ;*
;* OPCODE TABLE
;*
!ALIGN 255,0
OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E
!WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E
!WORD LNOT,LOR,LAND,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E
!WORD DROP,DUP,NEXTOP,DIVMOD,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E
!WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E
!WORD BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,CFFB ; 50 52 54 56 58 5A 5C 5E
!WORD LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E
!WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E
;*
;* MUL TOS-1 BY TOS ;* MUL TOS-1 BY TOS
;* ;*
MUL STY IPY MUL STY IPY
@@ -226,7 +244,7 @@ MUL STY IPY
LDA #$00 LDA #$00
STA ESTKL+1,X ; PRODL STA ESTKL+1,X ; PRODL
; STA ESTKH+1,X ; PRODH ; STA ESTKH+1,X ; PRODH
MULLP LSR TMPH ; MULTPLRH _MULLP LSR TMPH ; MULTPLRH
ROR TMPL ; MULTPLRL ROR TMPL ; MULTPLRL
BCS + BCS +
STA ESTKH+1,X ; PRODH STA ESTKH+1,X ; PRODH
@@ -238,7 +256,7 @@ MULLP LSR TMPH ; MULTPLRH
+ ASL ESTKL,X ; MULTPLNDL + ASL ESTKL,X ; MULTPLNDL
ROL ESTKH,X ; MULTPLNDH ROL ESTKH,X ; MULTPLNDH
DEY DEY
BNE MULLP BNE _MULLP
STA ESTKH+1,X ; PRODH STA ESTKH+1,X ; PRODH
LDY IPY LDY IPY
JMP DROP JMP DROP
@@ -277,10 +295,25 @@ DIVMOD JSR _DIV
STA ESTKL,X STA ESTKL,X
LDA TMPH ; REMNDRH LDA TMPH ; REMNDRH
STA ESTKH,X STA ESTKH,X
LDA DVSIGN ; REMAINDER IS SIGN OF DIVIDEND ASL DVSIGN ; REMAINDER IS SIGN OF DIVIDEND
BMI NEG BMI NEG
JMP NEXTOP JMP NEXTOP
;* ;*
;* INCREMENT TOS
;*
INCR INC ESTKL,X
BNE +
INC ESTKH,X
+ JMP NEXTOP
;*
;* DECREMENT TOS
;*
DECR LDA ESTKL,X
BNE +
DEC ESTKH,X
+ DEC ESTKL,X
JMP NEXTOP
;*
;* ADD TOS TO TOS-1 ;* ADD TOS TO TOS-1
;* ;*
ADD LDA ESTKL,X ADD LDA ESTKL,X
@@ -317,21 +350,6 @@ IDXW LDA ESTKL,X
STA ESTKH+1,X STA ESTKH+1,X
JMP DROP JMP DROP
;* ;*
;* INCREMENT TOS
;*
INCR INC ESTKL,X
BNE +
INC ESTKH,X
+ JMP NEXTOP
;*
;* DECREMENT TOS
;*
DECR LDA ESTKL,X
BNE +
DEC ESTKH,X
+ DEC ESTKL,X
JMP NEXTOP
;*
;* BITWISE COMPLIMENT TOS ;* BITWISE COMPLIMENT TOS
;* ;*
COMP LDA #$FF COMP LDA #$FF
@@ -1065,5 +1083,6 @@ LEAVE INY ;+INC_IP
STA IFPH STA IFPH
RET RTS RET RTS
SOSCMD = * SOSCMD = *
!SOURCE "vmsrc/soscmd.a" !SOURCE "vmsrc/apple/soscmd.a"
}
SEGEND = * SEGEND = *
@@ -529,12 +529,12 @@ MUL LDX #$10
EOR #$FFFF EOR #$FFFF
STA TMP STA TMP
LDA #$0000 LDA #$0000
MULLP ASL _MULLP ASL
ASL TMP ; MULTPLR ASL TMP ; MULTPLR
BCS + BCS +
ADC TOS,S ; MULTPLD ADC TOS,S ; MULTPLD
+ DEX + DEX
BNE MULLP BNE _MULLP
STA NOS,S ; PROD STA NOS,S ; PROD
JMP DROP JMP DROP
;* ;*
@@ -543,19 +543,20 @@ MULLP ASL
_DIV STY IPY _DIV STY IPY
LDY #$11 ; #BITS+1 LDY #$11 ; #BITS+1
LDX #$00 LDX #$00
LDA TOS+2,S ; WE JSR'ED HERE SO OFFSET ACCORDINGLY LDA NOS+2,S ; WE JSR'ED HERE SO OFFSET ACCORDINGLY
BEQ _DIVEX
BPL + BPL +
LDX #$81 LDX #$81
EOR #$FFFF EOR #$FFFF
INC INC
STA TOS+2,S + STA TMP ; NOS,S
+ LDA NOS+2,S LDA TOS+2,S
BPL + BPL +
INX INX
EOR #$FFFF EOR #$FFFF
INC INC
+ STA TMP ; NOS,S STA TOS+2,S
BEQ _DIVEX + LDA TMP
_DIV1 ASL ; DVDND _DIV1 ASL ; DVDND
DEY DEY
BCC _DIV1 BCC _DIV1
@@ -1006,7 +1007,6 @@ SLB INY ;+INC_IP
TXY TXY
BMI + BMI +
JMP NEXTOP JMP NEXTOP
+ JMP FIXNEXT
SLW INY ;+INC_IP SLW INY ;+INC_IP
LDA (IP),Y LDA (IP),Y
TYX TYX
@@ -1051,7 +1051,6 @@ SAB INY ;+INC_IP
INY INY
BMI + BMI +
JMP NEXTOP JMP NEXTOP
+ JMP FIXNEXT
SAW INY ;+INC_IP SAW INY ;+INC_IP
LDA (IP),Y LDA (IP),Y
STA TMP STA TMP
@@ -17,12 +17,6 @@ const resxhgr2 = $0080
const modkeep = $2000 const modkeep = $2000
const modinitkeep = $4000 const modinitkeep = $4000
// //
// SOS flags
//
const O_READ = 1
const O_WRITE = 2
const O_READ_WRITE = 3
//
// Pedefined functions. // Pedefined functions.
// //
predef syscall(cmd,params)#1, call(addr,areg,xreg,yreg,status)#1 predef syscall(cmd,params)#1, call(addr,areg,xreg,yreg,status)#1
@@ -35,7 +29,7 @@ predef execmod(modfile)#1
// //
// Exported CMDSYS table // Exported CMDSYS table
// //
word version = $0100 // 01.00 word version = $0120 // 01.20
word syspath word syspath
word cmdlnptr word cmdlnptr
word = @execmod word = @execmod
@@ -329,9 +323,9 @@ asm memxcpy(dst,src,size)#0
ADC #$60 ADC #$60
STA DSTH STA DSTH
LDA ESTKL+2,X LDA ESTKL+2,X
ORA #$80 CLC
ADC #$7F
STA DSTX STA DSTX
DEC DSTX
LDA ESTKL+1,X LDA ESTKL+1,X
STA SRCL STA SRCL
LDA ESTKH+1,X LDA ESTKH+1,X
@@ -367,9 +361,9 @@ asm xpokeb(seg, dst, byteval)#0
ADC #$60 ADC #$60
STA DSTH STA DSTH
LDA ESTKL+2,X LDA ESTKL+2,X
ORA #$80 CLC
ADC #$7F
STA DSTX STA DSTX
DEC DSTX
LDY #$00 LDY #$00
LDA ESTKL,X LDA ESTKL,X
STA (DST),Y STA (DST),Y
@@ -577,9 +571,9 @@ asm lookuptbl(dci, tbl)#1
ADC #$60 ADC #$60
STA DSTH STA DSTH
LDA ESTKL,X LDA ESTKL,X
ORA #$80 CLC
ADC #$7F
STA DSTX STA DSTX
DEC DSTX
LDA ESTKL+1,X LDA ESTKL+1,X
STA SRCL STA SRCL
LDA ESTKH+1,X LDA ESTKH+1,X
@@ -803,14 +797,24 @@ def getpfx(path)#1
return path return path
end end
def setpfx(path)#1 def setpfx(path)#1
byte params[3] byte params[6]
byte fileinfo[2]
params.0 = 1 params.0 = 3
params:1 = path params:1 = path
perr = syscall($C6, @params) params:3 = @fileinfo
params.5 = 2
perr = syscall($C4, @params) // Get file info
if not perr and (fileinfo.1 == $00 or fileinfo.1 == $0F) // Make sure it's a directory
params.0 = 1
params:1 = path
perr = syscall($C6, @params)
else
perr = $44
fin
return path return path
end end
def volume(devname, volname, ttlblks, freblks)#1 def volume(devname, volname)#1
byte params[9] byte params[9]
params.0 = 4 params.0 = 4
@@ -819,8 +823,6 @@ def volume(devname, volname, ttlblks, freblks)#1
params:5 = 0 params:5 = 0
params:7 = 0 params:7 = 0
perr = syscall($C5, @params) perr = syscall($C5, @params)
*ttlblks = params:5
*freblks = params:7
return perr return perr
end end
def open(path)#1 def open(path)#1
@@ -899,18 +901,7 @@ end
// //
// MEMORY CALLS // MEMORY CALLS
// //
def seg_request(base, limit, id)#1 def seg_find(search, pages, id)#3
byte params[7]
params.0 = 4
params:1 = base
params:3 = limit
params.5 = id
params.6 = 0
perr = syscall($40, @params)
return params.6
end
def seg_find(search, base, limit, pages, id)#1
byte params[10] byte params[10]
params.0 = 6 params.0 = 6
@@ -921,9 +912,7 @@ def seg_find(search, base, limit, pages, id)#1
params:7 = 0 params:7 = 0
params.9 = 0 params.9 = 0
perr = syscall($41, @params) perr = syscall($41, @params)
*base = params:5 return params.9, params:5, params:7
*limit = params:7
return params.9
end end
def seg_release(segnum)#1 def seg_release(segnum)#1
byte params[2] byte params[2]
@@ -943,8 +932,9 @@ def init_cons()#0
fin fin
write(refcons, @textmode, 3) write(refcons, @textmode, 3)
devcons = dev_getnum(@console) devcons = dev_getnum(@console)
nlmode.0 = $80 nlmode:0 = $0D80
nlmode.1 = $0D //nlmode.0 = $80
//nlmode.1 = $0D
dev_control(devcons, $02, @nlmode) dev_control(devcons, $02, @nlmode)
end end
def cout(ch)#0 def cout(ch)#0
@@ -955,6 +945,9 @@ def cout(ch)#0
write(refcons, @ch, 1) write(refcons, @ch, 1)
fin fin
end end
def crout()#0
cout($0D)
end
def cin()#1 def cin()#1
byte ch byte ch
read(refcons, @ch, 1) read(refcons, @ch, 1)
@@ -975,14 +968,11 @@ def rdstr(prompt)#1
cout(prompt) cout(prompt)
^heap = read(refcons, heap + 1, 128) ^heap = read(refcons, heap + 1, 128)
if heap->[^heap] == $0D if heap->[^heap] == $0D
^heap = ^heap - 1 ^heap--
fin fin
cout($0D) crout
return heap return heap
end end
def crout()#0
cout($0D)
end
def prbyte(v)#0 def prbyte(v)#0
cout(hexchar[(v >> 4) & $0F]) cout(hexchar[(v >> 4) & $0F])
cout(hexchar[v & $0F]) cout(hexchar[v & $0F])
@@ -1150,7 +1140,7 @@ def loadmod(mod)#1
// //
// Alloc heap space for relocated module (data + bytecode). // Alloc heap space for relocated module (data + bytecode).
// //
moddep = moddep + 1 moddep++
modfix = moddep - @header.2 // Adjust to skip header modfix = moddep - @header.2 // Adjust to skip header
modsize = modsize - modfix modsize = modsize - modfix
rdlen = rdlen - modfix - 2 rdlen = rdlen - modfix - 2
@@ -1181,17 +1171,17 @@ def loadmod(mod)#1
while ^esd // Scan to end of ESD while ^esd // Scan to end of ESD
esd = esd + 4 esd = esd + 4
loop loop
esd = esd + 1 esd++
if defcnt if defcnt
// //
// Locate bytecode defs in allocated segment. // Locate bytecode defs in allocated segment.
// //
modseg[modid] = seg_find($00, @codeseg, @defaddr, (rld - bytecode + 255) >> 8, modid + $12) modseg[modid], codeseg, drop = seg_find($00, (rld - bytecode + 255) >> 8, modid + $12)
if perr if perr
return -perr return -perr
fin fin
modid = modid + 1 modid++
defext = (codeseg.0 | $80) - 1 defext = codeseg.0 + $7F // (codeseg.0 | $80) - 1
defaddr = (codeseg & $FF00) + $6000 defaddr = (codeseg & $FF00) + $6000
codefix = defaddr - bytecode codefix = defaddr - bytecode
defofst = defaddr - defofst defofst = defaddr - defofst
@@ -1268,8 +1258,6 @@ def loadmod(mod)#1
// //
memxcpy(codeseg, bytecode, modsize - (bytecode - modaddr)) memxcpy(codeseg, bytecode, modsize - (bytecode - modaddr))
fin fin
//else
// return -perr
fin fin
if lerr if lerr
return -lerr return -lerr
@@ -1298,12 +1286,11 @@ def volumes()#0
byte devname[17] byte devname[17]
byte volname[17] byte volname[17]
byte i byte i
word ttlblks, freblks
for i = $01 to $18 for i = $01 to $18
if dev_info(i, @devname, @info, 11) == 0 if dev_info(i, @devname, @info, 11) == 0
prstr(@devname) prstr(@devname)
if volume(@devname, @volname, @ttlblks, @freblks) == 0 if volume(@devname, @volname) == 0
prstr(" => /") prstr(" => /")
prstr(@volname) prstr(@volname)
cout('/') cout('/')
@@ -1423,7 +1410,7 @@ def execmod(modfile)#1
lastsym = savesym lastsym = savesym
heap = saveheap heap = saveheap
while modid while modid
modid = modid - 1 modid--
seg_release(modseg[modid]) seg_release(modseg[modid])
loop loop
else else
@@ -1445,7 +1432,7 @@ prstr("PLASMA "); prbyte(version.1); cout('.'); prbyte(version.0); crout
// //
// Init 2K symbol table. // Init 2K symbol table.
// //
seg_find($00, @symtbl, @lastsym, $08, $11) drop, symtbl, drop = seg_find($00, $08, $11)
lastsym = symtbl & $FF00 lastsym = symtbl & $FF00
xpokeb(symtbl.0, lastsym, 0) xpokeb(symtbl.0, lastsym, 0)
while *sysmodsym while *sysmodsym
@@ -1513,6 +1500,7 @@ while 1
saveX saveX
execmod(striptrail(cmdptr)) execmod(striptrail(cmdptr))
restoreX restoreX
//close(0)
init_cons init_cons
break break
otherwise otherwise
@@ -1524,7 +1512,7 @@ while 1
prbyte(terr) prbyte(terr)
perr = 0 perr = 0
else else
prstr("OK\n") prstr("OK")
fin fin
crout() crout()
fin fin
+1131
View File
File diff suppressed because it is too large Load Diff
+934
View File
@@ -0,0 +1,934 @@
;**********************************************************
;*
;* COMMODORE 64 PLASMA INTERPETER
;*
;* SYSTEM ROUTINES AND LOCATIONS
;*
;**********************************************************
;*
;* VM ZERO PAGE LOCATIONS
;*
!SOURCE "vmsrc/plvmzp.inc"
DVSIGN = TMP+2
DROP = $7F
NEXTOP = $80
FETCHOP = NEXTOP+1
IP = FETCHOP+1
IPL = IP
IPH = IPL+1
OPIDX = FETCHOP+6
OPPAGE = OPIDX+1
;*
;* INTERPRETER HEADER+INITIALIZATION
;*
*= $1000
SEGBEGIN JMP VMINIT
;*
;* SYSTEM INTERPRETER ENTRYPOINT
;*
INTERP PLA
CLC
ADC #$01
STA IPL
PLA
ADC #$00
STA IPH
LDY #$00
JMP FETCHOP
;*
;* ENTER INTO USER BYTECODE INTERPRETER
;*
IINTERP PLA
STA TMPL
PLA
STA TMPH
LDY #$02
LDA (TMP),Y
STA IPH
DEY
LDA (TMP),Y
STA IPL
DEY
JMP FETCHOP
;*
;* MUL TOS-1 BY TOS
;*
MUL STY IPY
LDY #$10
LDA ESTKL+1,X
EOR #$FF
STA TMPL
LDA ESTKH+1,X
EOR #$FF
STA TMPH
LDA #$00
STA ESTKL+1,X ; PRODL
; STA ESTKH+1,X ; PRODH
_MULLP LSR TMPH ; MULTPLRH
ROR TMPL ; MULTPLRL
BCS +
STA ESTKH+1,X ; PRODH
LDA ESTKL,X ; MULTPLNDL
ADC ESTKL+1,X ; PRODL
STA ESTKL+1,X
LDA ESTKH,X ; MULTPLNDH
ADC ESTKH+1,X ; PRODH
+ ASL ESTKL,X ; MULTPLNDL
ROL ESTKH,X ; MULTPLNDH
DEY
BNE _MULLP
STA ESTKH+1,X ; PRODH
LDY IPY
JMP DROP
;*
;* INCREMENT TOS
;*
INCR INC ESTKL,X
BNE +
INC ESTKH,X
+ JMP NEXTOP
;*
;* DECREMENT TOS
;*
DECR LDA ESTKL,X
BNE +
DEC ESTKH,X
+ DEC ESTKL,X
JMP NEXTOP
;*
;* BITWISE COMPLIMENT TOS
;*
COMP LDA #$FF
EOR ESTKL,X
STA ESTKL,X
LDA #$FF
EOR ESTKH,X
STA ESTKH,X
JMP NEXTOP
;*
;* OPCODE TABLE
;*
!ALIGN 255,0
OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E
!WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E
!WORD LNOT,LOR,LAND,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E
!WORD DROP,DUP,NEXTOP,DIVMOD,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E
!WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E
!WORD BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,CFFB ; 50 52 54 56 58 5A 5C 5E
!WORD LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E
!WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E
;*
;* DIV TOS-1 BY TOS
;*
DIV JSR _DIV
LSR DVSIGN ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1
BCS NEG
JMP NEXTOP
;*
;* MOD TOS-1 BY TOS
;*
MOD JSR _DIV
LDA TMPL ; REMNDRL
STA ESTKL,X
LDA TMPH ; REMNDRH
STA ESTKH,X
LDA DVSIGN ; REMAINDER IS SIGN OF DIVIDEND
BMI NEG
JMP NEXTOP
;*
;* DIVMOD TOS-1 BY TOS
;*
DIVMOD JSR _DIV
LSR DVSIGN ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1
BCC +
JSR _NEG
+ DEX
LDA TMPL ; REMNDRL
STA ESTKL,X
LDA TMPH ; REMNDRH
STA ESTKH,X
ASL DVSIGN ; REMAINDER IS SIGN OF DIVIDEND
BMI NEG
JMP NEXTOP
;*
;* NEGATE TOS
;*
NEG JSR _NEG
JMP NEXTOP
;*
;* INTERNAL DIVIDE ALGORITHM
;*
_NEG LDA #$00
SEC
SBC ESTKL,X
STA ESTKL,X
LDA #$00
SBC ESTKH,X
STA ESTKH,X
RTS
_DIV STY IPY
LDY #$11 ; #BITS+1
LDA #$00
STA TMPL ; REMNDRL
STA TMPH ; REMNDRH
STA DVSIGN
LDA ESTKH+1,X
BPL +
INX
JSR _NEG
DEX
LDA #$81
STA DVSIGN
+ ORA ESTKL+1,X ; DVDNDL
BEQ _DIVEX
LDA ESTKH,X
BPL _DIV1
JSR _NEG
INC DVSIGN
_DIV1 ASL ESTKL+1,X ; DVDNDL
ROL ESTKH+1,X ; DVDNDH
DEY
BCC _DIV1
_DIVLP ROL TMPL ; REMNDRL
ROL TMPH ; REMNDRH
LDA TMPL ; REMNDRL
CMP ESTKL,X ; DVSRL
LDA TMPH ; REMNDRH
SBC ESTKH,X ; DVSRH
BCC +
STA TMPH ; REMNDRH
LDA TMPL ; REMNDRL
SBC ESTKL,X ; DVSRL
STA TMPL ; REMNDRL
SEC
+ ROL ESTKL+1,X ; DVDNDL
ROL ESTKH+1,X ; DVDNDH
DEY
BNE _DIVLP
_DIVEX INX
LDY IPY
RTS
;*
;* ADD TOS TO TOS-1
;*
ADD LDA ESTKL,X
CLC
ADC ESTKL+1,X
STA ESTKL+1,X
LDA ESTKH,X
ADC ESTKH+1,X
STA ESTKH+1,X
JMP DROP
;*
;* SUB TOS FROM TOS-1
;*
SUB LDA ESTKL+1,X
SEC
SBC ESTKL,X
STA ESTKL+1,X
LDA ESTKH+1,X
SBC ESTKH,X
STA ESTKH+1,X
JMP DROP
;
;*
;* SHIFT TOS LEFT BY 1, ADD TO TOS-1
;*
IDXW LDA ESTKL,X
ASL
ROL ESTKH,X
CLC
ADC ESTKL+1,X
STA ESTKL+1,X
LDA ESTKH,X
ADC ESTKH+1,X
STA ESTKH+1,X
JMP DROP
;*
;* BITWISE AND TOS TO TOS-1
;*
BAND LDA ESTKL+1,X
AND ESTKL,X
STA ESTKL+1,X
LDA ESTKH+1,X
AND ESTKH,X
STA ESTKH+1,X
JMP DROP
;*
;* INCLUSIVE OR TOS TO TOS-1
;*
IOR LDA ESTKL+1,X
ORA ESTKL,X
STA ESTKL+1,X
LDA ESTKH+1,X
ORA ESTKH,X
STA ESTKH+1,X
JMP DROP
;*
;* EXLUSIVE OR TOS TO TOS-1
;*
XOR LDA ESTKL+1,X
EOR ESTKL,X
STA ESTKL+1,X
LDA ESTKH+1,X
EOR ESTKH,X
STA ESTKH+1,X
JMP DROP
;*
;* SHIFT TOS-1 LEFT BY TOS
;*
SHL STY IPY
LDA ESTKL,X
CMP #$08
BCC +
LDY ESTKL+1,X
STY ESTKH+1,X
LDY #$00
STY ESTKL+1,X
SBC #$08
+ TAY
BEQ +
LDA ESTKL+1,X
- ASL
ROL ESTKH+1,X
DEY
BNE -
STA ESTKL+1,X
+ LDY IPY
JMP DROP
;*
;* SHIFT TOS-1 RIGHT BY TOS
;*
SHR STY IPY
LDA ESTKL,X
CMP #$08
BCC ++
LDY ESTKH+1,X
STY ESTKL+1,X
CPY #$80
LDY #$00
BCC +
DEY
+ STY ESTKH+1,X
SEC
SBC #$08
++ TAY
BEQ +
LDA ESTKH+1,X
- CMP #$80
ROR
ROR ESTKL+1,X
DEY
BNE -
STA ESTKH+1,X
+ LDY IPY
JMP DROP
;*
;* LOGICAL AND
;*
LAND LDA ESTKL+1,X
ORA ESTKH+1,X
BEQ ++
LDA ESTKL,X
ORA ESTKH,X
BEQ +
LDA #$FF
+ STA ESTKL+1,X
STA ESTKH+1,X
++ JMP DROP
;*
;* LOGICAL OR
;*
LOR LDA ESTKL,X
ORA ESTKH,X
ORA ESTKL+1,X
ORA ESTKH+1,X
BEQ +
LDA #$FF
STA ESTKL+1,X
STA ESTKH+1,X
+ JMP DROP
;*
;* DUPLICATE TOS
;*
DUP DEX
LDA ESTKL+1,X
STA ESTKL,X
LDA ESTKH+1,X
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
STA ESTKL,X
STA ESTKH,X
JMP NEXTOP
CFFB LDA #$FF
!BYTE $2C ; BIT $00A9 - effectively skips LDA #$00, no harm in reading this address
CB LDA #$00
DEX
STA ESTKH,X
INY ;+INC_IP
LDA (IP),Y
STA ESTKL,X
JMP NEXTOP
;*
;* LOAD ADDRESS & LOAD CONSTANT WORD (SAME THING, WITH OR WITHOUT FIXUP)
;*
- 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
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
;*
;* CONSTANT STRING
;*
CS DEX
;INY ;+INC_IP
TYA ; NORMALIZE IP AND SAVE STRING ADDR ON ESTK
SEC
ADC IPL
STA IPL
STA ESTKL,X
LDA #$00
TAY
ADC IPH
STA IPH
STA ESTKH,X
LDA (IP),Y
TAY
JMP NEXTOP
;*
;* LOAD VALUE FROM ADDRESS TAG
;*
LB LDA ESTKL,X
STA ESTKH-1,X
LDA (ESTKH-1,X)
STA ESTKL,X
LDA #$00
STA ESTKH,X
JMP NEXTOP
LW LDA ESTKL,X
STA ESTKH-1,X
LDA (ESTKH-1,X)
STA ESTKL,X
INC ESTKH-1,X
BEQ +
LDA (ESTKH-1,X)
STA ESTKH,X
JMP NEXTOP
+ INC ESTKH,X
LDA (ESTKH-1,X)
STA ESTKH,X
JMP NEXTOP
;*
;* LOAD ADDRESS OF LOCAL FRAME OFFSET
;*
- TYA ; RENORMALIZE IP
CLC
ADC IPL
STA IPL
BCC +
INC IPH
+ LDY #$FF
LLA INY ;+INC_IP
BMI -
LDA (IP),Y
DEX
CLC
ADC IFPL
STA ESTKL,X
LDA #$00
ADC IFPH
STA ESTKH,X
JMP NEXTOP
;*
;* LOAD VALUE FROM LOCAL FRAME OFFSET
;*
LLB INY ;+INC_IP
LDA (IP),Y
STY IPY
TAY
DEX
LDA (IFP),Y
STA ESTKL,X
LDA #$00
STA ESTKH,X
LDY IPY
JMP NEXTOP
LLW INY ;+INC_IP
LDA (IP),Y
STY IPY
TAY
DEX
LDA (IFP),Y
STA ESTKL,X
INY
LDA (IFP),Y
STA ESTKH,X
LDY IPY
JMP NEXTOP
;*
;* LOAD VALUE FROM ABSOLUTE ADDRESS
;*
LAB INY ;+INC_IP
LDA (IP),Y
STA ESTKH-2,X
INY ;+INC_IP
LDA (IP),Y
STA ESTKH-1,X
LDA (ESTKH-2,X)
DEX
STA ESTKL,X
LDA #$00
STA ESTKH,X
JMP NEXTOP
LAW INY ;+INC_IP
LDA (IP),Y
STA TMPL
INY ;+INC_IP
LDA (IP),Y
STA TMPH
STY IPY
LDY #$00
LDA (TMP),Y
DEX
STA ESTKL,X
INY
LDA (TMP),Y
STA ESTKH,X
LDY IPY
JMP NEXTOP
;*
;* STORE VALUE TO ADDRESS
;*
SB LDA ESTKL,X
STA ESTKH-1,X
LDA ESTKL+1,X
STA (ESTKH-1,X)
INX
JMP DROP
SW LDA ESTKL,X
STA ESTKH-1,X
LDA ESTKL+1,X
STA (ESTKH-1,X)
LDA ESTKH+1,X
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 INY ;+INC_IP
LDA (IP),Y
STY IPY
TAY
LDA ESTKL,X
STA (IFP),Y
LDY IPY
BMI FIXDROP
JMP DROP
SLW INY ;+INC_IP
LDA (IP),Y
STY IPY
TAY
LDA ESTKL,X
STA (IFP),Y
INY
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 INY ;+INC_IP
LDA (IP),Y
STY IPY
TAY
LDA ESTKL,X
STA (IFP),Y
LDY IPY
JMP NEXTOP
DLW INY ;+INC_IP
LDA (IP),Y
STY IPY
TAY
LDA ESTKL,X
STA (IFP),Y
INY
LDA ESTKH,X
STA (IFP),Y
LDY IPY
JMP NEXTOP
;*
;* STORE VALUE TO ABSOLUTE ADDRESS
;*
- TYA ; RENORMALIZE IP
CLC
ADC IPL
STA IPL
BCC +
INC IPH
+ LDY #$FF
SAB INY ;+INC_IP
BMI -
LDA (IP),Y
STA ESTKH-2,X
INY ;+INC_IP
LDA (IP),Y
STA ESTKH-1,X
LDA ESTKL,X
STA (ESTKH-2,X)
JMP DROP
SAW INY ;+INC_IP
LDA (IP),Y
STA TMPL
INY ;+INC_IP
LDA (IP),Y
STA TMPH
STY IPY
LDY #$00
LDA ESTKL,X
STA (TMP),Y
INY
LDA ESTKH,X
STA (TMP),Y
LDY IPY
BMI FIXDROP
JMP DROP
;*
;* STORE VALUE TO ABSOLUTE ADDRESS WITHOUT POPPING STACK
;*
DAB INY ;+INC_IP
LDA (IP),Y
STA ESTKH-2,X
INY ;+INC_IP
LDA (IP),Y
STA ESTKH-1,X
LDA ESTKL,X
STA (ESTKH-2,X)
JMP NEXTOP
DAW INY ;+INC_IP
LDA (IP),Y
STA TMPL
INY ;+INC_IP
LDA (IP),Y
STA TMPH
STY IPY
LDY #$00
LDA ESTKL,X
STA (TMP),Y
INY
LDA ESTKH,X
STA (TMP),Y
LDY IPY
JMP NEXTOP
;*
;* COMPARES
;*
ISEQ LDA ESTKL,X
CMP ESTKL+1,X
BNE ISFLS
LDA ESTKH,X
CMP ESTKH+1,X
BNE ISFLS
ISTRU LDA #$FF
STA ESTKL+1,X
STA ESTKH+1,X
JMP DROP
;
ISNE LDA ESTKL,X
CMP ESTKL+1,X
BNE ISTRU
LDA ESTKH,X
CMP ESTKH+1,X
BNE ISTRU
ISFLS LDA #$00
STA ESTKL+1,X
STA ESTKH+1,X
JMP DROP
;
ISGE LDA ESTKL+1,X
CMP ESTKL,X
LDA ESTKH+1,X
SBC ESTKH,X
BVS +
BPL ISTRU
BMI ISFLS
+ BPL ISFLS
BMI ISTRU
;
ISGT LDA ESTKL,X
CMP ESTKL+1,X
LDA ESTKH,X
SBC ESTKH+1,X
BVS +
BMI ISTRU
BPL ISFLS
+ BMI ISFLS
BPL ISTRU
;
ISLE LDA ESTKL,X
CMP ESTKL+1,X
LDA ESTKH,X
SBC ESTKH+1,X
BVS +
BPL ISTRU
BMI ISFLS
+ BPL ISFLS
BMI ISTRU
;
ISLT LDA ESTKL+1,X
CMP ESTKL,X
LDA ESTKH+1,X
SBC ESTKH,X
BVS +
BMI ISTRU
BPL ISFLS
+ BMI ISFLS
BPL ISTRU
;*
;* BRANCHES
;*
BRTRU INX
LDA ESTKH-1,X
ORA ESTKL-1,X
BNE BRNCH
NOBRNCH INY ;+INC_IP
INY ;+INC_IP
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 TYA ; FLATTEN IP
SEC
ADC IPL
STA 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
JMP FETCHOP
BREQ INX
LDA ESTKL-1,X
CMP ESTKL,X
BNE NOBRNCH
LDA ESTKH-1,X
CMP ESTKH,X
BEQ BRNCH
BNE NOBRNCH
BRNE INX
LDA ESTKL-1,X
CMP ESTKL,X
BNE BRNCH
LDA ESTKH-1,X
CMP ESTKH,X
BEQ NOBRNCH
BNE BRNCH
BRGT INX
LDA ESTKL-1,X
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
+ 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 TMPH
ADC ESTKH,X
STA IPH
JMP DROP
;*
;* INDIRECT CALL TO ADDRESS (NATIVE CODE)
;*
ICAL LDA ESTKL,X
STA TMPL
LDA ESTKH,X
STA TMPH
INX
BNE _CALL
;*
;* CALL INTO ABSOLUTE ADDRESS (NATIVE CODE)
;*
CALL INY ;+INC_IP
LDA (IP),Y
STA TMPL
INY ;+INC_IP
LDA (IP),Y
STA TMPH
_CALL TYA
CLC
ADC IPL
PHA
LDA IPH
ADC #$00
PHA
JSR JMPTMP
PLA
STA IPH
PLA
STA IPL
LDY #$01
JMP FETCHOP
;*
;* ENTER FUNCTION WITH FRAME SIZE AND PARAM COUNT
;*
ENTER INY
LDA (IP),Y
EOR #$FF
SEC
ADC IFPL
STA IFPL
BCS +
DEC IFPH
+ INY
LDA (IP),Y
BEQ +
ASL
TAY
- LDA ESTKH,X
DEY
STA (IFP),Y
LDA ESTKL,X
INX
DEY
STA (IFP),Y
BNE -
+ LDY #$03
JMP FETCHOP
;*
;* LEAVE FUNCTION
;*
LEAVE INY ;+INC_IP
LDA (IP),Y
CLC
ADC IFPL
STA IFPL
BCS +
RTS
+ INC IFPH
RET RTS
CMD !SOURCE "vmsrc/c64/cmd.a"
SEGEND = *
VMINIT JSR $FFE7 ; CLOSE ALL CHANNELS
LDY #$10 ; INSTALL PAGE 0 FETCHOP ROUTINE
- LDA PAGE0-1,Y
STA DROP-1,Y
DEY
BNE -
LDA #$4C ; SET JMPTMP OPCODE
STA JMPTMP
STY IFPL ; INIT FRAME POINTER TO $D000
LDA #$D0
STA IFPH
LDA #<SEGEND ; SAVE HEAP START
STA $0100
LDA #>SEGEND
STA $0101
LDX #$FF ; INIT STACK POINTER
TXS
LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX
LDA $01
AND #$FE ; SWAP OUT BASIC ROM
STA $01
JMP CMD
PAGE0 = *
!PSEUDOPC DROP {
;*
;* INTERP BYTECODE INNER LOOP
;*
INX ; DROP
INY ; NEXTOP
LDA $FFFF,Y ; FETCHOP @ $F3, IP MAPS OVER $FFFF @ $F4
STA OPIDX
JMP (OPTBL)
}
+29
View File
@@ -0,0 +1,29 @@
;**********************************************************
;*
;* VM ZERO PAGE LOCATIONS
;*
;**********************************************************
SRC = $4C
SRCL = SRC
SRCH = SRC+1
DST = SRC+2
DSTL = DST
DSTH = DST+1
ESGUARD = $4E
ESTKSZ = $20
ESTK = $50
ESTKH = ESTK
ESTKL = ESTK+ESTKSZ/2
VMZP = ESTK+ESTKSZ
IFP = VMZP
IFPL = IFP
IFPH = IFP+1
PP = IFP+2
PPL = PP
PPH = PP+1
IPY = PP+2
ESP = IPY+1
JMPTMP = ESP+1
TMP = JMPTMP+1
TMPL = TMP
TMPH = TMP+1
+7
View File
@@ -455,6 +455,7 @@ void interp(code *ip);
void call(uword pc) void call(uword pc)
{ {
unsigned int i, s; unsigned int i, s;
int a, b;
char c, sz[64]; char c, sz[64];
if (show_state) if (show_state)
@@ -508,6 +509,12 @@ void call(uword pc)
mem_data[0x1FF] = i; mem_data[0x1FF] = i;
PUSH(0x1FF); PUSH(0x1FF);
break; break;
case 24: // LIBRARY CMDSYS::DIVMOD
a = POP;
b = POP;
PUSH(b / a);
PUSH(b % a);
break;
default: default:
printf("\nUnimplemented call code:$%02X\n", mem_data[pc - 1]); printf("\nUnimplemented call code:$%02X\n", mem_data[pc - 1]);
exit(1); exit(1);