Update notes to 1.2

Reduce makefile noise

README.md

@@ -1,5 +1,5 @@
-# 2/6/2018 PLASMA 1.0 Available!
-[Download and read the Release Notes](https://github.com/dschmenk/PLASMA/blob/master/doc/Version%201.0.md)
+# 4/29/2018 PLASMA 1.2 Available!
+[Download and read the Release Notes](https://github.com/dschmenk/PLASMA/blob/master/doc/Version%201.2.md)
 
 # The PLASMA Programming Language
 

doc/Editor.md

@@ -37,61 +37,99 @@ MEMORY FOR THE TEXT BUFFER.
 
 IT HAS TWO MODES, COMMAND AND EDIT.
 
-  EDIT COMMANDS:
+EDIT COMMANDS:
 
-    LEFT ARROW  = MOVE CHAR LEFT
-    RIGHT ARROW = MOVE CHAR RIGHT
-    UP ARROW    = MOVE LINE UP
-    DOWN ARROW  = MOVE LINE DOWN
-    CTRL-K      = MOVE LINE UP
-    CTRL-J      = MOVE LINE DOWN
-    CTRL-A      = JUMP LEFT
-    CTRL-S      = JUMP RIGHT
-    CTRL-W      = JUMP UP
-    CTRL-Z      = JUMP DOWN
-    CTRL-Q      = JUMP BEGIN
-    CTRL-E      = JUMP END
-    CTRL-D      = DELETE CHAR
-    CTRL-X      = DELETE LINE
-    CTRL-V      = COPY DELETED LINE
-    CTRL-O      = OPEN NEW LINE
-    CTRL-F      = OPEN A FOLLOWING NEW LINE
-    CTRL-T      = JOIN LINES
-    CTRL-I      = TOGGLE INSERT/OVERWRITE
-    ESCAPE      = SWITCH TO COMMAND MODE
+    LEFT ARROW   = MOVE CHAR LEFT
+    RIGHT ARROW  = MOVE CHAR RIGHT
+    UP ARROW     = MOVE LINE UP
+    DOWN ARROW   = MOVE LINE DOWN
+    CTRL-K       = MOVE LINE UP
+    CTRL-J       = MOVE LINE DOWN
+    CTRL-A       = JUMP LEFT
+    CTRL-S       = JUMP RIGHT
+    CTRL-W       = JUMP UP
+    CTRL-Z       = JUMP DOWN
+    CTRL-Q       = JUMP BEGIN
+    CTRL-E       = JUMP END
+    CTRL-D       = DELETE CHAR
+    CTRL-X       = DELETE/CUT LINE
+    CTRL-V       = COPY DELETED LINE
+    CTRL-O       = OPEN NEW LINE
+    CTRL-F       = OPEN A FOLLOWING NEW LINE
+    CTRL-T       = JOIN LINES
+    CTRL-B       = TOGGLE INSERT/OVERWRITE
+    TAB/CTRL-I   = INSERT SPACES TO NEXT TAB
+    ESCAPE       = SWITCH TO COMMAND MODE
+    DELETE       = DELETE CHAR LEFT
 
   APPLE ][ FEATURES:
+  ------------------
 
-    SHIFT-M   = ]
-    CTRL-N    = [
-    CTRL-P    = _
-    CTRL-B    = |
-    CTRL-Y    = ~
-    CTRL-L    = SHIFT LOCK
+    SHIFT-M      = ]
+    CTRL-N       = [
+    SHIFT-CTRL-N = ~
+    CTRL-P       = \
+    SHIFT-CTRL-P = |
+    CTRL-G       = _
+    CTRL-L       = SHIFT LOCK
     SHIFT-LEFT ARROW = DELETE (SHIFT-MOD)
 
   WITH THE SHIFT-KEY MOD ON AN
   APPLE ][, UPPER AND LOWER CASE
   ENTRY WORKS AS EXPECTED.
 
-    CTRL-C    = FORCE LOWER-CASE CHARS
+    CTRL-C       = FORCE LOWER-CASE CHARS
 
-  IF YOU HAVE A LOWER-CASE CHARACTER
-  GENERATOR INSTALLED, YOU CAN FORCE
-  LOWER-CASE DISPLAY.  OTHERWISE,
-  UPPER CASE WILL BE DISPLAYED NORMALLY
-  BUT lower-case will be displayed in
+  If you have a lower-case character
+  generator installed, you can force
+  lower-case display.  Otherwise,
+  upper case will be displayed normally
+  but lower-case will be displayed in
   inverse.  This is the default.
 
   Apple //e AND //c FEATURES:
+  ---------------------------
 
-  THE 'CLOSED-APPLE' KEY WILL MODIFY
-  THE ARROW KEYS INTO THEIR JUMP
-  EQUIVALENTS. IT WILL ALSO MODIFY
-  THE 'RETURN' KEY TO OPEN UP A LINE,
-  JUST LIKE CTRL-F.
+  The 'SOLID-APPLE' key will modify
+  theese keys:
 
-  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>
     [OPTIONAL PARAMETER]

doc/Version 1.2.md

@@ -1,16 +1,16 @@
-# PLASMA Version 1.0
+# PLASMA Version 1.2
 
 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 ///):
 
-[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):
 
@@ -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...
 
+# 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
 
 If you have been programming in PLASMA before, the 1.0 version has some major and minor changes that you should be aware of:

src/FIRE.PLA#040000

@@ -1 +0,0 @@
-CONST FALSE      = 0

src/inc/grafix.plh

@@ -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

src/inc/joybuzz.plh

@@ -0,0 +1,4 @@
+import joybuzz
+    const MAX_JOY = 79
+    predef joypos(buzz)#4
+end

src/inc/mouse.plh

@@ -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

src/libsrc/apple/dgr.pla

@@ -506,7 +506,7 @@ asm _dgrFillTile
         RTS
 end
 //
-// Wait for VLB - Doens't work on //c
+// Wait for VLB - Shouldn't work on //c, but seems to.
 //
 asm vlbWait#0
 -       LDA     $C019
@@ -525,7 +525,6 @@ export def dgrMode#1
     ^showpage1
     ^ena80  = 0
     ^show80 = 0
-//  ^mapaux = 0
     ^an3on
     return 1
 end
@@ -578,16 +577,11 @@ export def dgrLine(buff, x1, y1, x2, y2)#0
     fin
     dx2 = dx << 1
     dy2 = dy << 1
-    if dx >= dy
-        // Horizontal line
+    if dx >= dy // Horizontal line
         if sx < 0
-            pp = x1
-            x1 = x2
-            x2 = pp
-            pp = y1
-            y1 = y2
-            y2 = pp
-            sy = -sy
+            x1, x2 = x2, x1
+            y1, y2 = y2, y1
+            sy     = -sy
         fin
         dd2 = dx2 - dy2
         err = dx - dy2
@@ -600,7 +594,7 @@ export def dgrLine(buff, x1, y1, x2, y2)#0
                 sx = 1
                 dy--
                 err = err + dd2
-                else
+            else
                 sx++
                 err = err - dy2
             fin
@@ -608,16 +602,11 @@ export def dgrLine(buff, x1, y1, x2, y2)#0
         if y2 == y1
             dgrHLin(buff, x1, x2, y1)
         fin
-    else
-        // Vertical line
+    else // Vertical line
         if sy < 0
-            pp = x1
-            x1 = x2
-            x2 = pp
-            pp = y1
-            y1 = y2
-            y2 = pp
-            sx = -sx
+            x1, x2 = x2, x1
+            y1, y2 = y2, y1
+            sx     = -sx
         fin
         dd2 = dy2 - dx2
         err = dy - dx2
@@ -630,7 +619,7 @@ export def dgrLine(buff, x1, y1, x2, y2)#0
                 sy = 1
                 dx--
                 err = err + dd2
-                else
+            else
                 sy++
                 err = err - dx2
             fin

src/libsrc/apple/grafix.pla

@@ -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

src/libsrc/apple/joybuzz.pla

@@ -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

src/libsrc/apple/mouse.pla

@@ -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);
+    }
+}

src/libsrc/apple/sndseq.pla

@@ -67,12 +67,14 @@ predef musicStop#0
 predef spkrSequence(yield, func)#0
 predef a2spkrTone(pitch, duration)#0
 predef a2spkrPWM(sample, speed, len)#0
+predef a2keypressed
 //
 // Static sequencer values
 //
 export word musicSequence = @spkrSequence
 export word spkrTone      = @a2spkrTone
 export word spkrPWM       = @a2spkrPWM
+word        keypressed    = @a2keypressed
 
 word instr[] // Overlay with other variables
 word seqTrack, seqEvent, seqTime, eventTime, updateTime
@@ -211,6 +213,31 @@ asm psgWrite(pVIA, reg, val)#0
         INX
         RTS
 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
 //
@@ -328,6 +355,30 @@ asm a2spkrPWM(sample, speed, len)#0
         INX
         RTS
 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
     byte env
 
@@ -348,14 +399,16 @@ end
 // Search slots for MockingBoard
 //
 def mbTicklePSG(pVIA)
-    pVIA->IER  = $7F  // Mask all interrupts
-    pVIA->ACR  = $00  // Stop T1 countdown
-    pVIA->DDRB = $FF  // Output enable port A and B
-    pVIA->DDRA = $FF
-    pVIA->IORA = $00 // Reset MockingBoard
-    if pVIA->IORA == $00
+    //puts("VIA address: $"); puth(pVIA); puts(" Timer Diff = "); puti(viaCheck(pVIA)); putln
+    if viaCheck(pVIA) == 8 and viaCheck(pVIA) == 8 // Check twice
+        pVIA->IER  = $7F  // Mask all interrupts
+        //pVIA->ACR  = $00  // Stop T1 countdown
+        pVIA->DDRB = $FF  // Output enable port A and B
+        pVIA->DDRA = $FF
+        pVIA->IORA = $00 // Reset MockingBoard
+        //if pVIA->IORA == $00
         pVIA->IORA = $04 // Inactive MockingBoard control lines
-        if pVIA->IORA == $04
+        //if pVIA->IORA == $04
             //
             // At least we know we have some sort of R/W in the ROM
             // address space. Most likely a MockingBoard or John Bell
@@ -366,7 +419,7 @@ def mbTicklePSG(pVIA)
             //if mbReadP(pVIA, 2) == $7E and mbReadP(pVIA, 3) == $0A
                 return pVIA
             //fin
-        fin
+        //fin
     fin
     return 0
 end
@@ -591,8 +644,7 @@ def mbSequence(yield, func)#0
         //
         seqTime++
         while !(mbVIA1->IFR & $40) // Wait for T1 interrupt
-            if ^$C000 > 127; quit = TRUE; break; fin
-            *rndseed++
+            if a2keypressed(); quit = TRUE; break; fin
         loop
         mbVIA1->IFR = $40 // Clear interrupt
         if yieldTime <= seqTime; func()#0; yieldTime = seqTime + yield; fin
@@ -607,7 +659,7 @@ def mbSequence(yield, func)#0
         psgWrite(mbVIA2, BENVAMP, $00)
         psgWrite(mbVIA2, CENVAMP, $00)
     fin
-    mbVIA1->ACR = $00 // Stop T1 countdown
+    //mbVIA1->ACR = $00 // Stop T1 countdown
     mbVIA1->IER = $7F // Mask all interrupts
     mbVIA1->IFR = $40 // Clear interrupt
     setStatusReg(status)
@@ -703,7 +755,6 @@ def spkrSequence(yield, func)#0
                 if notes1[i]
                     spkrTone(periods1[i], arpeggioDuration[numNotes])#0
                 fin
-                *rndseed++
             next
             seqTime++
         else
@@ -713,13 +764,12 @@ def spkrSequence(yield, func)#0
                     period = periods1[i]
                     break;
                 fin
-                *rndseed++
             next
             duration = eventTime - seqTime
             seqTime  = duration + seqTime
             spkrTone(period, DUR16TH * duration)#0
         fin
-        if ^$C000 > 127; return; fin
+        if keypressed(); return; fin
         if yieldTime <= seqTime; func()#0; yieldTime = seqTime + yield; fin
     until FALSE
 end
@@ -737,9 +787,8 @@ def noSequence(yield, func)#0
     repeat
         seqTime++
         if seqTime < 0; seqTime = 1; fin // Capture wrap-around
-        *rndseed++
-        a2spkrTone(0, DUR16TH) // Waste 16th of a second playing silence
-        if ^$C000 > 127; return; fin
+        spkrTone(0, DUR16TH) // Waste 16th of a second playing silence
+        if keypressed(); return; fin
         if yield == seqTime; func()#0; seqTime = 0; fin
     until FALSE
 end
@@ -782,31 +831,32 @@ end
 // Play until keystroke
 //
 export def musicGetKey(yield, backgroundProc)#1
-    while ^$C000 < 128
+    while not keypressed()
         musicSequence(yield, backgroundProc)#0 // Call background proc every half second
     loop
-    ^$C010
-    return ^$C000
+    return getc
 end
 
 when MACHID & MACHID_MODEL
     is MACHID_III
-        spkrTone = @a3spkrTone
-        spkrPWM  = @a3spkrPWM
+        spkrTone   = @a3spkrTone
+        spkrPWM    = @a3spkrPWM
+        keypressed = @a3keypressed
         break
     is MACHID_I
         puts("Sound unsupported.\n")
         return -1
         break
     otherwise
-        puts("MockingBoard Slot:\n")
-        puts("ENTER = None\n")
-        puts("0     = Scan\n")
-        puts("1-7   = Slot #\n")
-        instr = gets('>'|$80)
-        if ^instr
-            mbSlot = mbSearch(^(instr + 1) - '0')
-        fin
+        //puts("MockingBoard Slot:\n")
+        //puts("ENTER = None\n")
+        //puts("0     = Scan\n")
+        //puts("1-7   = Slot #\n")
+        //instr = gets('>'|$80)
+        //if ^instr
+        //    mbSlot = mbSearch(^(instr + 1) - '0')
+        //fin
+        mbSlot = mbSearch(0)
         break
 wend
 if mbSlot < 0

src/libsrc/c64/conio.pla

@@ -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

src/libsrc/c64/fileio.pla

@@ -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

src/libsrc/etherip.pla

@@ -500,7 +500,7 @@ def etherServiceIP
                             lclport = swab(rxptr=>udp_dst)
                             for i = 1 to MAX_UDP_NOTIFIES
                                 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
                             fin
                             port = port + t_notify

src/libsrc/sane.pla

@@ -837,8 +837,10 @@ def fpInit()
                 fpzpsave      = heapalloc($0034*2)
                 (@fixupXS)=>1 = fpzpsave+$34
                 (@fixupXR)=>1 = fpzpsave+$34
-                sane[9]       = @zpSaveX
-                sane[10]      = @zpRestoreX
+                zpSaveX // Clear XBYTEs
+                heaprelease(fpzpsave)
+                sane[9]       = @zpNopSave//zpSaveX
+                sane[10]      = @zpNopRestore//zpRestoreX
             else // Apple II
                 fpzpsave = heapalloc($0034)
                 sane[9]  = @zpSave

src/libsrc/tone.pla

@@ -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

src/makefile

@@ -1,62 +1,66 @@
 .SUFFIXES	=
-AFLAGS	= -o $@
-PLVM    = plvm
-PLVM01  = A1PLASMA\#060280
-PLVM02	= PLASMA.SYSTEM\#FF2000
-PLVM802	= PLASMA16.SYSTEM\#FF2000
-PLVM03	= SOS.INTERP\#050000
-CMD     = CMD\#061000
-ED      = ED\#FE1000
-SB      = SB\#FF2000
-SOS     = SOS\#FE1000
-ROD     = ROD\#FE1000
-SIEVE   = SIEVE\#FE1000
-ARGS    = ARGS\#FE1000
-SPIPORT = SPIPORT\#FE1000
-SDFAT   = SDFAT\#FE1000
-FATCAT  = FATCAT\#FE1000
-FATGET  = FATGET\#FE1000
-FATPUT  = FATPUT\#FE1000
-FATWDSK = FATWRITEDSK\#FE1000
-FATRDSK = FATREADDSK\#FE1000
-FILEIO  = FILEIO\#FE1000
-CONIO   = CONIO\#FE1000
-SANE    = SANE\#FE1000
-FPSTR   = FPSTR\#FE1000
-FPU     = FPU\#FE1000
-SNDSEQ  = SNDSEQ\#FE1000
-PLAYSEQ = PLAYSEQ\#FE1000
-SANITY  = SANITY\#FE1000
-RPNCALC = RPNCALC\#FE1000
-WIZNET  = WIZNET\#FE1000
-UTHERNET2= UTHERNET2\#FE1000
-UTHERNET= UTHERNET\#FE1000
-ETHERIP = ETHERIP\#FE1000
-INET    = INET\#FE1000
-DHCP    = DHCP\#FE1000
-HTTPD   = HTTPD\#FE1000
-DGR     = DGR\#FE1000
-TONE    = TONE\#FE1000
-PORTIO  = PORTIO\#FE1000
-ROGUE   = ROGUE\#FE1000
-ROGUEMAP= ROGUEMAP\#FE1000
-ROGUECOMBAT= ROGUECOMBAT\#FE1000
-HELLO   = HELLO\#FE1000
-MON     = MON\#FE1000
-DGRTEST = DGRTEST\#FE1000
-TEST    = TEST\#FE1000
-TESTLIB = TESTLIB\#FE1000
-PROFILE = PROFILE\#FE1000
-MEMMGR  = MEMMGR\#FE1000
-MEMTEST = MEMTEST\#FE1000
-FIBERTEST = FIBERTEST\#FE1000
-FIBER   = FIBER\#FE1000
-LONGJMP = LONGJMP\#FE1000
-PLASM   = plasm
-PLASMAPLASM = PLASM\#FE1000
-CODEOPT = CODEOPT\#FE1000
-INCS    = toolsrc/plasm.h toolsrc/tokens.h toolsrc/symbols.h toolsrc/lex.h toolsrc/parse.h toolsrc/codegen.h
-OBJS	= toolsrc/plasm.c toolsrc/parse.c toolsrc/lex.c toolsrc/codegen.c
+AFLAGS	   = -o $@
+PLVM       = plvm
+PLVMZP_APL = vmsrc/apple/plvmzp.inc
+PLVM01     = rel/apple/A1PLASMA\#060280
+PLVM02	   = rel/apple/PLASMA.SYSTEM\#FF2000
+PLVM802	   = rel/apple/PLASMA16.SYSTEM\#FF2000
+PLVM03	   = rel/apple/SOS.INTERP\#050000
+CMD        = rel/apple/CMD\#061000
+PLVMZP_C64 = vmsrc/c64/plvmzp.inc
+PLVMC64    = rel/c64/PLASMA
+ED         = rel/ED\#FE1000
+SOS        = rel/apple/SOS\#FE1000
+ROD        = rel/ROD\#FE1000
+SIEVE      = rel/SIEVE\#FE1000
+ARGS       = rel/ARGS\#FE1000
+SPIPORT    = rel/apple/SPIPORT\#FE1000
+SDFAT      = rel/apple/SDFAT\#FE1000
+FATCAT     = rel/apple/FATCAT\#FE1000
+FATGET     = rel/apple/FATGET\#FE1000
+FATPUT     = rel/apple/FATPUT\#FE1000
+FATWDSK    = rel/apple/FATWRITEDSK\#FE1000
+FATRDSK    = rel/apple/FATREADDSK\#FE1000
+FILEIO_APL = rel/apple/FILEIO\#FE1000
+CONIO_APL  = rel/apple/CONIO\#FE1000
+SANE       = rel/SANE\#FE1000
+FPSTR      = rel/FPSTR\#FE1000
+FPU        = rel/FPU\#FE1000
+SNDSEQ     = rel/apple/SNDSEQ\#FE1000
+PLAYSEQ    = rel/apple/PLAYSEQ\#FE1000
+SANITY     = rel/SANITY\#FE1000
+RPNCALC    = rel/RPNCALC\#FE1000
+MOUSE      = rel/apple/MOUSE\#FE1000
+UTHERNET2  = rel/apple/UTHERNET2\#FE1000
+UTHERNET   = rel/apple/UTHERNET\#FE1000
+ETHERIP    = rel/ETHERIP\#FE1000
+INET       = rel/INET\#FE1000
+DHCP       = rel/DHCP\#FE1000
+HTTPD      = rel/HTTPD\#FE1000
+TFTPD      = rel/TFTPD\#FE1000
+DGR        = rel/apple/DGR\#FE1000
+GRAFIX     = rel/apple/GRAFIX\#FE1000
+GFXDEMO    = rel/apple/GFXDEMO\#FE1000
+JOYBUZZ    = rel/apple/JOYBUZZ\#FE1000
+PORTIO     = rel/apple/PORTIO\#FE1000
+ROGUE      = rel/ROGUE\#FE1000
+ROGUEMAP   = rel/ROGUEMAP\#FE1000
+ROGUECOMBAT= rel/ROGUECOMBAT\#FE1000
+MON        = rel/apple/MON\#FE1000
+DGRTEST    = rel/apple/DGRTEST\#FE1000
+MEMMGR     = rel/MEMMGR\#FE1000
+MEMTEST    = rel/MEMTEST\#FE1000
+FIBERTEST  = rel/FIBERTEST\#FE1000
+FIBER      = rel/FIBER\#FE1000
+LONGJMP    = rel/LONGJMP\#FE1000
+HELLO      = HELLO\#FE1000
+TEST       = TEST\#FE1000
+TESTLIB    = TESTLIB\#FE1000
+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 ][
 #
@@ -73,13 +77,30 @@ TXTTYPE	= .TXT
 #SYSTYPE	= \#FF2000
 #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:
 	-rm *FE1000 *FF2000 $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVM03)
-	-rm toolsrc/*.o toolsrc/*~ toolsrc/*.a
-	-rm vmsrc/*.o vmsrc/*~ vmsrc/*.a vmsrc/*.sym
+	-rm rel/*
+	-rm rel/apple/*
+	-rm rel/c64/*
 	-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
@@ -101,27 +122,47 @@ $(CODEOPT): toolsrc/codeopt.pla toolsrc/codeseq.plh
 $(PLVM): vmsrc/plvm.c
 	cc vmsrc/plvm.c -o $(PLVM)
 
-vmsrc/a1cmd.a: vmsrc/a1cmd.pla $(PLASM)
-	./$(PLASM) -AOW < vmsrc/a1cmd.pla > vmsrc/a1cmd.a
+$(PLVMZP_APL): FORCE
+	-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
-	acme -o $(PLVM01) -l vmsrc/plvm01.sym vmsrc/plvm01.s
+$(PLVMZP_C64): FORCE
+	-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)
-	./$(PLASM) -AOW < vmsrc/cmd.pla > vmsrc/cmd.a
-	acme --setpc 8192 -o $(CMD) vmsrc/cmdstub.s
+FORCE:
 
-$(PLVM02): vmsrc/plvm02.s
-	acme -o $(PLVM02) -l vmsrc/plvm02.sym vmsrc/plvm02.s
+vmsrc/c64/cmd.a: vmsrc/c64/cmd.pla $(PLASM)
+	./$(PLASM) -AOW < vmsrc/c64/cmd.pla > vmsrc/c64/cmd.a
 
-$(PLVM802): vmsrc/plvm802.s
-	acme -o $(PLVM802) -l vmsrc/plvm802.sym vmsrc/plvm802.s
+$(PLVMC64): vmsrc/c64/plvmc64.s vmsrc/c64/cmd.a
+	acme -f cbm -o $(PLVMC64) -l vmsrc/c64/plvmc64.sym vmsrc/c64/plvmc64.s
 
-vmsrc/soscmd.a: vmsrc/soscmd.pla $(PLASM)
-	./$(PLASM) -AOW < vmsrc/soscmd.pla > vmsrc/soscmd.a
+vmsrc/apple/a1cmd.a: vmsrc/apple/a1cmd.pla $(PLASM)
+	./$(PLASM) -AOW < vmsrc/apple/a1cmd.pla > vmsrc/apple/a1cmd.a
 
-$(PLVM03): vmsrc/plvm03.s vmsrc/soscmd.a
-	acme -o $(PLVM03) -l vmsrc/plvm03.sym vmsrc/plvm03.s
+$(PLVM01): vmsrc/apple/plvm01.s vmsrc/apple/a1cmd.a
+	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
@@ -137,10 +178,6 @@ $(ED): toolsrc/ed.pla $(PLVM02) $(PLASM) toolsrc/ed.pla
 	./$(PLASM) -AMOW < toolsrc/ed.pla > toolsrc/ed.a
 	acme --setpc 4094 -o $(ED) toolsrc/ed.a
 
-$(SB): toolsrc/sb.pla $(PLVM02) $(PLASM) toolsrc/sb.pla
-	./$(PLASM) -AOW < toolsrc/sb.pla > toolsrc/sb.a
-	acme --setpc 8192 -o $(SB) toolsrc/sb.a
-
 $(ARGS): libsrc/args.pla $(PLVM02) $(PLASM)
 	./$(PLASM) -AMOW < libsrc/args.pla > 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
 	acme --setpc 4094 -o $(FIBERTEST) samplesrc/fibertest.a
 
-$(SNDSEQ): libsrc/sndseq.pla $(PLVM02) $(PLASM)
-	./$(PLASM) -AMOW < libsrc/sndseq.pla > libsrc/sndseq.a
-	acme --setpc 4094 -o $(SNDSEQ) libsrc/sndseq.a
-
-$(PLAYSEQ): samplesrc/playseq.pla $(PLVM02) $(PLASM)
-	./$(PLASM) -AMOW < samplesrc/playseq.pla > samplesrc/playseq.a
-	acme --setpc 4094 -o $(PLAYSEQ) samplesrc/playseq.a
-
 $(LONGJMP): libsrc/longjmp.pla $(PLVM02) $(PLASM)
 	./$(PLASM) -AMOW < libsrc/longjmp.pla > libsrc/longjmp.a
 	acme --setpc 4094 -o $(LONGJMP) libsrc/longjmp.a
 
-$(MON): samplesrc/mon.pla $(PLVM02) $(PLASM)
-	./$(PLASM) -AMOW < samplesrc/mon.pla > samplesrc/mon.a
-	acme --setpc 4094 -o $(MON) samplesrc/mon.a
+$(ROGUE): samplesrc/rogue.pla $(PLVM02) $(PLASM)
+	./$(PLASM) -AMOW < samplesrc/rogue.pla > samplesrc/rogue.a
+	acme --setpc 4094 -o $(ROGUE) samplesrc/rogue.a
 
-$(SOS): libsrc/sos.pla $(PLVM02) $(PLASM)
-	./$(PLASM) -AMO < libsrc/sos.pla > libsrc/sos.a
-	acme --setpc 4094 -o $(SOS) libsrc/sos.a
+$(ROGUECOMBAT): samplesrc/rogue.combat.pla $(PLVM02) $(PLASM)
+	./$(PLASM) -AMOW < samplesrc/rogue.combat.pla > samplesrc/rogue.combat.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)
 	./$(PLASM) -AMO < samplesrc/rod.pla > 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
 	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)
 	./$(PLASM) -AMOW < libsrc/sane.pla > 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
 	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
 	acme --setpc 4094 -o $(RPNCALC) samplesrc/rpncalc.a
 
-$(TONE): libsrc/tone.pla $(PLVM02) $(PLASM)
-	./$(PLASM) -AMOW < libsrc/tone.pla > libsrc/tone.a
-	acme --setpc 4094 -o $(TONE) libsrc/tone.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
+
+$(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)
 	./$(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
 	acme --setpc 4094 -o $(FATRDSK) samplesrc/fatreaddsk.a
 
-$(SDFAT): libsrc/sdfat.pla $(PLVM02) $(PLASM)
-	./$(PLASM) -AMOW < libsrc/sdfat.pla > libsrc/sdfat.a
-	acme --setpc 4094 -o $(SDFAT) libsrc/sdfat.a
+$(SDFAT): libsrc/apple/sdfat.pla $(PLVM02) $(PLASM)
+	./$(PLASM) -AMOW < libsrc/apple/sdfat.pla > libsrc/apple/sdfat.a
+	acme --setpc 4094 -o $(SDFAT) libsrc/apple/sdfat.a
 
-$(SPIPORT): libsrc/spiport.pla $(PLVM02) $(PLASM)
-	./$(PLASM) -AMOW < libsrc/spiport.pla > libsrc/spiport.a
-	acme --setpc 4094 -o $(SPIPORT) libsrc/spiport.a
+$(SPIPORT): libsrc/apple/spiport.pla $(PLVM02) $(PLASM)
+	./$(PLASM) -AMOW < libsrc/apple/spiport.pla > libsrc/apple/spiport.a
+	acme --setpc 4094 -o $(SPIPORT) libsrc/apple/spiport.a
 
-$(PORTIO): libsrc/portio.pla $(PLVM02) $(PLASM)
-	./$(PLASM) -AMOW < libsrc/portio.pla > libsrc/portio.a
-	acme --setpc 4094 -o $(PORTIO) libsrc/portio.a
+$(JOYBUZZ): libsrc/apple/joybuzz.pla $(PLVM02) $(PLASM)
+	./$(PLASM) -AMOW < libsrc/apple/joybuzz.pla > libsrc/apple/joybuzz.a
+	acme --setpc 4094 -o $(JOYBUZZ) libsrc/apple/joybuzz.a
 
-$(DGR): libsrc/dgr.pla $(PLVM02) $(PLASM)
-	./$(PLASM) -AMOW < libsrc/dgr.pla > libsrc/dgr.a
-	acme --setpc 4094 -o $(DGR) libsrc/dgr.a
+$(PORTIO): libsrc/apple/portio.pla $(PLVM02) $(PLASM)
+	./$(PLASM) -AMOW < libsrc/apple/portio.pla > libsrc/apple/portio.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)
 	./$(PLASM) -AMOW < samplesrc/dgrtest.pla > samplesrc/dgrtest.a
 	acme --setpc 4094 -o $(DGRTEST) samplesrc/dgrtest.a
 
-$(ROGUE): samplesrc/rogue.pla $(PLVM02) $(PLASM)
-	./$(PLASM) -AMOW < samplesrc/rogue.pla > samplesrc/rogue.a
-	acme --setpc 4094 -o $(ROGUE) samplesrc/rogue.a
+$(MON): samplesrc/mon.pla $(PLVM02) $(PLASM)
+	./$(PLASM) -AMOW < samplesrc/mon.pla > samplesrc/mon.a
+	acme --setpc 4094 -o $(MON) samplesrc/mon.a
 
-$(ROGUECOMBAT): samplesrc/rogue.combat.pla $(PLVM02) $(PLASM)
-	./$(PLASM) -AMOW < samplesrc/rogue.combat.pla > samplesrc/rogue.combat.a
-	acme --setpc 4094 -o $(ROGUECOMBAT) samplesrc/rogue.combat.a
+$(SOS): libsrc/apple/sos.pla $(PLVM02) $(PLASM)
+	./$(PLASM) -AMO < libsrc/apple/sos.pla > libsrc/apple/sos.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

src/mkrel

@@ -1,68 +1,76 @@
-cp CMD#061000 prodos/CMD.BIN
-cp PLASMA.SYSTEM#FF2000 prodos/PLASMA.SYSTEM.SYS
-cp PLASMA16.SYSTEM#FF2000 prodos/PLASMA16.SYSTEM.SYS
-cp SOS.INTERP#050000 prodos/SOS.INTERP.\$05
+cp rel/apple/CMD#061000 prodos/CMD.BIN
+cp rel/apple/PLASMA.SYSTEM#FF2000 prodos/PLASMA.SYSTEM.SYS
+cp rel/apple/PLASMA16.SYSTEM#FF2000 prodos/PLASMA16.SYSTEM.SYS
+cp rel/apple/SOS.INTERP#050000 prodos/SOS.INTERP.\$05
 cp ../doc/Editor.md prodos/EDITOR.README.TXT
 
 rm -rf prodos/sys
 mkdir prodos/sys
-cp ARGS#FE1000 prodos/sys/ARGS.REL
-cp CONIO#FE1000 prodos/sys/CONIO.REL
-cp DGR#FE1000 prodos/sys/DGR.REL
-cp DHCP#FE1000 prodos/sys/DHCP.REL
-cp ED#FE1000 prodos/sys/ED.REL
-cp ETHERIP#FE1000 prodos/sys/ETHERIP.REL
-cp FIBER#FE1000 prodos/sys/FIBER.REL
-cp FILEIO#FE1000 prodos/sys/FILEIO.REL
-cp FPSTR#FE1000 prodos/sys/FPSTR.REL
-cp FPU#FE1000 prodos/sys/FPU.REL
-cp INET#FE1000 prodos/sys/INET.REL
-cp LONGJMP#FE1000 prodos/sys/LONGJMP.REL
-cp MEMMGR#FE1000 prodos/sys/MEMMGR.REL
-cp PORTIO#FE1000 prodos/sys/PORTIO.REL
-cp SANE#FE1000 prodos/sys/SANE.REL
-cp SDFAT#FE1000 prodos/sys/SDFAT.REL
-cp SPIPORT#FE1000 prodos/sys/SPIPORT.REL
-cp SNDSEQ#FE1000 prodos/sys/SNDSEQ.REL
-cp UTHERNET#FE1000 prodos/sys/UTHERNET.REL
-cp UTHERNET2#FE1000 prodos/sys/UTHERNET2.REL
-cp SOS#FE1000 prodos/sys/SOS.REL
+cp rel/ARGS#FE1000 prodos/sys/ARGS.REL
+cp rel/apple/CONIO#FE1000 prodos/sys/CONIO.REL
+cp rel/apple/DGR#FE1000 prodos/sys/DGR.REL
+cp rel/DHCP#FE1000 prodos/sys/DHCP.REL
+cp rel/ED#FE1000 prodos/sys/ED.REL
+cp rel/ETHERIP#FE1000 prodos/sys/ETHERIP.REL
+cp rel/FIBER#FE1000 prodos/sys/FIBER.REL
+cp rel/apple/FILEIO#FE1000 prodos/sys/FILEIO.REL
+cp rel/FPSTR#FE1000 prodos/sys/FPSTR.REL
+cp rel/FPU#FE1000 prodos/sys/FPU.REL
+cp rel/INET#FE1000 prodos/sys/INET.REL
+cp rel/LONGJMP#FE1000 prodos/sys/LONGJMP.REL
+cp rel/MEMMGR#FE1000 prodos/sys/MEMMGR.REL
+cp rel/apple/PORTIO#FE1000 prodos/sys/PORTIO.REL
+cp rel/apple/JOYBUZZ#FE1000 prodos/sys/JOYBUZZ.REL
+cp rel/SANE#FE1000 prodos/sys/SANE.REL
+cp rel/apple/SDFAT#FE1000 prodos/sys/SDFAT.REL
+cp rel/apple/SPIPORT#FE1000 prodos/sys/SPIPORT.REL
+cp rel/apple/SNDSEQ#FE1000 prodos/sys/SNDSEQ.REL
+cp rel/apple/MOUSE#FE1000 prodos/sys/MOUSE.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/ELEMS.CODE#060000 prodos/sys/ELEMS.CODE.BIN
 
 rm -rf prodos/demos
 mkdir prodos/demos
-cp DGRTEST#FE1000 prodos/demos/DGRTEST.REL
-cp RPNCALC#FE1000 prodos/demos/RPNCALC.REL
-cp ROD#FE1000 prodos/demos/ROD.REL
+cp rel/apple/DGRTEST#FE1000 prodos/demos/DGRTEST.REL
+cp rel/RPNCALC#FE1000 prodos/demos/RPNCALC.REL
+cp rel/ROD#FE1000 prodos/demos/ROD.REL
 
 mkdir prodos/demos/rogue
-cp ROGUE#FE1000 prodos/demos/rogue/ROGUE.REL
-cp ROGUECOMBAT#FE1000 prodos/demos/rogue/ROGUECOMBAT.REL
-cp ROGUEMAP#FE1000 prodos/demos/rogue/ROGUEMAP.REL
+cp rel/ROGUE#FE1000 prodos/demos/rogue/ROGUE.REL
+cp rel/ROGUECOMBAT#FE1000 prodos/demos/rogue/ROGUECOMBAT.REL
+cp rel/ROGUEMAP#FE1000 prodos/demos/rogue/ROGUEMAP.REL
 cp samplesrc/LEVEL0#040000 prodos/demos/rogue/LEVEL0.TXT
 cp samplesrc/LEVEL1#040000 prodos/demos/rogue/LEVEL1.TXT
 
 mkdir prodos/demos/sdutils
-cp FATCAT#FE1000 prodos/demos/sdutils/FATCAT.REL
-cp FATGET#FE1000 prodos/demos/sdutils/FATGET.REL
-cp FATPUT#FE1000 prodos/demos/sdutils/FATPUT.REL
-cp FATREADDSK#FE1000 prodos/demos/sdutils/FATREADDSK.REL
-cp FATWRITEDSK#FE1000 prodos/demos/sdutils/FATWRITEDSK.REL
+cp rel/apple/FATCAT#FE1000 prodos/demos/sdutils/FATCAT.REL
+cp rel/apple/FATGET#FE1000 prodos/demos/sdutils/FATGET.REL
+cp rel/apple/FATPUT#FE1000 prodos/demos/sdutils/FATPUT.REL
+cp rel/apple/FATREADDSK#FE1000 prodos/demos/sdutils/FATREADDSK.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
-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 rel/TFTPD#FE1000 prodos/sys/TFTPD.REL
 
 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/startrek.seq prodos/demos/music/STARTREK.SEQ.BIN
 
 rm -rf prodos/bld
 mkdir prodos/bld
-cp PLASM#FE1000 prodos/bld/PLASM.REL
-cp CODEOPT#FE1000 prodos/bld/CODEOPT.REL
+cp rel/PLASM#FE1000 prodos/bld/PLASM.REL
+cp rel/CODEOPT#FE1000 prodos/bld/CODEOPT.REL
 cp samplesrc/dgrtest.pla prodos/bld/DGRTEST.PLA.TXT
 cp samplesrc/hello.pla prodos/bld/HELLO.PLA.TXT
 cp samplesrc/hgr1test.pla prodos/bld/HGR1TEST.PLA.TXT
@@ -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.map.pla prodos/bld/ROGUE.MAP.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
 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/memmgr.plh prodos/bld/inc/MEMMGR.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/sdfat.plh prodos/bld/inc/SDFAT.PLH.TXT
 cp inc/sndseq.plh prodos/bld/inc/SNDSEQ.PLH.TXT
 cp inc/spiport.plh prodos/bld/inc/SPIPORT.PLH.TXT
 cp inc/testlib.plh prodos/bld/inc/TESTLIB.PLH.TXT
-cp vmsrc/plvmzp.inc prodos/bld/inc/PLVMZP.INC.TXT
+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

src/samplesrc/examples/ex.1.pla

@@ -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.")

src/samplesrc/examples/ex.10.pla

@@ -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

src/samplesrc/examples/ex.11.pla

@@ -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

src/samplesrc/examples/ex.12.pla

@@ -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

src/samplesrc/examples/ex.13.pla

@@ -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

src/samplesrc/examples/ex.14.pla

@@ -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

src/samplesrc/examples/ex.15.pla

@@ -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

src/samplesrc/examples/ex.16.pla

@@ -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

src/samplesrc/examples/ex.17.pla

@@ -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

src/samplesrc/examples/ex.2.pla

@@ -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.

src/samplesrc/examples/ex.3.pla

@@ -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

src/samplesrc/examples/ex.4.pla

@@ -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.

src/samplesrc/examples/ex.5.pla

@@ -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.

src/samplesrc/examples/ex.6.pla

@@ -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

src/samplesrc/examples/ex.7.pla

@@ -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.

src/samplesrc/examples/ex.8.pla

@@ -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.

src/samplesrc/examples/ex.9.pla

@@ -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

src/samplesrc/gfxdemo.pla

@@ -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

src/samplesrc/httpd.pla

@@ -11,13 +11,13 @@
 include "inc/cmdsys.plh"
 include "inc/inet.plh"
 include "inc/fileio.plh"
+include "inc/conio.plh"
 
 word socketHTTP
-byte[65] prefix
-word     filebuff, iobuff
-byte fileInfo[12] = 0 // used for get_file_info()
-byte hello = "Apple II Web Server - 12 Nov 15\n"
-byte defhtml = "INDEX.HTML"
+byte[65]  prefix
+word      filebuff
+byte[15]  fileInfo = 0 // used for get_file_info()
+byte      defhtml = "INDEX.HTML"
 byte[200] okhdr // combined response header
 //
 // HTTP response codes
@@ -78,7 +78,7 @@ def strcat2(dst, src1, src2)
     return dst
 end
 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
         ^dst = i + '0'
     else
@@ -141,7 +141,6 @@ def servHTTP(remip, remport, lclport, data, len, param)
                     // Get file info
                     //
                     //puts("getting file info "); // debug
-                    fileio:getfileinfo(@filename)
                     refnum = fileio:open(@filename) // try to open this file with ProDOS
                     if refnum // file was opened OK
                         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
                         //
-                        if fileInfo.4 == $03 OR fileInfo.4 == $04
+                        fileio:getfileinfo(@filename, @fileInfo)
+                        if fileInfo.1 == $03 OR fileInfo.1 == $04
                             //
                             // 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
                         puts("404 Not Found");putln // debug
                         iNet:sendTCP(socketHTTP, @httpNOTFOUND + 1, httpNOTFOUND)
-                    fin // if refnum
-                    break // return
+                    fin // refnum
+                    break
                 fin
             next
         else
@@ -196,7 +196,7 @@ end
 if !iNet:initIP()
     return -1
 fin
-puts(@hello)
+puts("PLASMA Web Server, Version 1.0\n")
 fileio:getpfx(@prefix)
 //
 // Alloc aligned file/io buffers
@@ -213,7 +213,6 @@ repeat
         socketHTTP = iNet:listenTCP(80, @servHTTP, 0)
     fin
     iNet:serviceIP()
-until ^$C000 > 127
-^$C010
+until conio:keypressed()
 
 done

src/samplesrc/index.html

@@ -1,5 +1,11 @@
 <html>
 <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>
-</html>
+</html>

src/samplesrc/mousetest.pla

@@ -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

src/samplesrc/playseq.pla

@@ -12,7 +12,7 @@ word ref
 // Sample background process to show it's working
 //
 def backgroundProc#0
-    ^$0400++
+    putc('.')
 end
 
 arg = argNext(argFirst)

src/samplesrc/rogue.map.pla

@@ -260,8 +260,8 @@ end
 //
 
 export def drawmap(xorg, yorg, viewfield, viewdir, lightdist, viewdist)
-  byte o, l, dist, tile, adjtile, occluded, darkness
-  word ymap, xmap, imap
+  byte l, dist, tile, adjtile, occluded, darkness
+  word ymap, xmap, imap, o
   byte yscr, xscr
 
   if viewdist > beamdepth

src/samplesrc/test.pla

@@ -85,7 +85,7 @@ def vals123#3
   return 1, 2, 3
 end
 export def main(range)#0
-  byte a, b, c
+  word a, b, c
   word lambda
 
   a = 10
@@ -127,6 +127,14 @@ export def main(range)#0
   drop, b, drop = vals123
   drop, drop, c = vals123
   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
 
 def dummy(zz)#2

src/samplesrc/tftpd.pla

@@ -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.

src/toolsrc/codegen.c

@@ -232,6 +232,14 @@ void idglobal_size(int type, int size, int constsize)
     else if (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 i;

src/toolsrc/codegen.pla

@@ -670,6 +670,7 @@ def gen_ctag(seq, tag)
         op=>opnext = new_op
         op = op=>opnext
     fin
+    op->opcode  = INVALID_CODE
     op->opgroup = CODETAG_GROUP
     op=>optag   = tag
     return seq

src/toolsrc/codeopt.pla

@@ -133,7 +133,7 @@ def crunch_seq(seq, pass)
                         fin
                         break
                     is CONST_CODE // Collapse constant operation
-                        nextopnext = nextop->nextop
+                        nextopnext = nextop=>opnext
                         if nextopnext
                             when nextopnext->opcode
                                 is MUL_CODE

src/toolsrc/codeseq.plh

@@ -79,6 +79,10 @@ const BRNCH_CODE        = $50
 //
 const CODETAG_GROUP     = $06
 //
+// Invalid code
+//
+const INVALID_CODE      = $FF
+//
 // Code sequence op
 //
 struc t_opseq

src/toolsrc/ed.pla

@@ -33,6 +33,7 @@ const keyctrlc      = $83
 const keyctrld      = $84
 const keyctrle      = $85
 const keyctrlf      = $86
+const keyctrlg      = $87
 const keyctrli      = $89
 const keyctrlk      = $8B
 const keyctrll      = $8C
@@ -569,15 +570,6 @@ end
 //
 // 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
     byte params[5]
 
@@ -588,13 +580,80 @@ def dev_control(devnum, code, list)#1
     perr     = syscall($83, @params)
     return perr
 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
-    byte count, key
+    byte key
+
     repeat
         cursflash
-        dev_status(cmdsys.devcons, 5, @count)
-    until count
-    key = getc
+    until cons_keyavail
+    key = cons_keyread
+    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
 end
 def keyin2e
@@ -634,14 +693,18 @@ def keyin2
     until key >= 128
     ^keystrobe
     if key == keyctrln
-        key = $DB // [
+        key = $DB // '['
+    elsif key == $9E // SHIFT+CTRL+N
+        key = $FE // '~'
     elsif key == keyctrlp
-        key = $DF // _
-    elsif key == keyctrlb
-        key = $DC // \
+        key = $DC // '\'
+    elsif key == $80 // SHIFT+CTRL+P -> CTRL+@
+        key = $FC // '|'
+    elsif key == keyctrlg
+        key = $DF // '_'
     elsif key == keyarrowleft
         if ^pushbttn3 < 128
-            key = $FF
+            key = keydelete
         fin
     elsif key >= $C0 and flags < shiftlock
         if ^pushbttn3 < 128
@@ -1060,7 +1123,7 @@ def cmdmode#0
     word cmdptr
 
     clrscrn
-    puts("PLASMA Editor, Version 1.0\n")
+    puts("PLASMA Editor, Version 1.1\n")
     while not exit
         puts(@filename)
         cmdptr = gets($BA)

src/toolsrc/lex.pla

@@ -26,28 +26,24 @@
 //    fin
 //    return FALSE
 //end
-def keymatch
-    byte i, keypos
-    word chrptr
-
-    keypos = 0
-    while keywrds[keypos] < tknlen
-        keypos = keypos + keywrds[keypos] + 2
-    loop
-    chrptr = tknptr - 1
-    while keywrds[keypos] == tknlen
-        for i = 1 to tknlen
-            if ^(chrptr + i) <> keywrds[keypos + i]
-                break
-            fin
-        next
-        if i > tknlen
-            return keywrds[keypos + keywrds[keypos] + 1]
-        fin
-        keypos = keypos + keywrds[keypos] + 2
-    loop
-    return ID_TKN
-end
+//def keymatch
+//    byte i, keypos
+//    word chrptr
+//
+//    keypos = 0
+//    while keywrds[keypos] < tknlen
+//        keypos = keypos + keywrds[keypos] + 2
+//    loop
+//    chrptr = tknptr - 1
+//    while keywrds[keypos] == tknlen
+//        i = 1; while i <= tknlen and ^(chrptr + i) == keywrds[keypos + i]; i++; loop
+//        if i > tknlen
+//            return keywrds[keypos + keywrds[keypos] + 1]
+//        fin
+//        keypos = keypos + keywrds[keypos] + 2
+//    loop
+//    return ID_TKN
+//end
 def scannum
     word num
     num = 0
@@ -84,23 +80,20 @@ def scan
         scanptr++
     loop
     tknptr  = scanptr
-    scanchr = toupper(^scanptr)
+    scanchr, scanptr, token = scanid(scanptr, @keywrds) //scanchr = toupper(^scanptr)
     //
     // Scan for token based on first character
     //
-    //if isalpha(scanchr)
-    if (scanchr >= 'A' and scanchr <= 'Z') or (scanchr == '_')
+    if token //if isalpha(scanchr)
         //
         // ID, either variable name or reserved word
         //
-        repeat
-            ^scanptr = scanchr
-            scanptr++
-            scanchr = toupper(^scanptr)
+        //repeat
+        //    ^scanptr = scanchr
+        //    scanptr++
+        //    scanchr = toupper(^scanptr)
         //until not isalphanum(scanchr)
-        until not ((scanchr >= 'A' and scanchr <= 'Z') or (scanchr >= '0' and scanchr <= '9' ) or (scanchr == '_'))
         tknlen = scanptr - tknptr
-        token  = keymatch
     elsif scanchr >= '0' and scanchr <= '9' // isnum()
         //
         // Decimal constant

src/toolsrc/parse.c

@@ -1170,8 +1170,13 @@ int parse_var(int type, long basesize)
     {
         if (idlen)
             id_add(idstr, idlen, type, size);
-        else
-            emit_data(0, 0, 0, size);
+        else if (!(type & EXTERN_TYPE))
+        {
+            if (type & LOCAL_TYPE)
+                idlocal_size(size);
+            else
+                emit_data(0, 0, 0, size);
+        }
     }
     return (1);
 }
@@ -1584,6 +1589,7 @@ int parse_defs(void)
             next_line();
         } while (scantoken != END_TOKEN);
         scan();
+        infunc = 0;
         return (1);
     }
     return (scantoken == EOL_TOKEN);

src/toolsrc/parse.pla

@@ -402,7 +402,7 @@ def parse_value(codeseq, r_val)#2
                 else
                     deref++
                 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)
                     rewind(tknptr) // Setting type override for following operations
                 elsif const_offset <> 0
@@ -421,7 +421,7 @@ def parse_value(codeseq, r_val)#2
                 elsif not (type & VAR_TYPE)
                     deref++
                 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)
                     rewind(tknptr) // Setting type override for following operations
                 elsif const_offset <> 0
@@ -941,8 +941,12 @@ def parse_var(type, basesize)#0
             else
                 new_iddata(idptr, idlen, type, size)
             fin
-        elsif not (type & (EXTERN_TYPE|LOCAL_TYPE))
-            emit_fill(size)
+        elsif not type & EXTERN_TYPE
+            if type & LOCAL_TYPE
+                framesize = framesize + size
+            else
+                size_iddata(type, size, 0)
+            fin
         fin
     fin
 end

src/toolsrc/plasm.pla

@@ -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
 //
@@ -411,7 +511,7 @@ include "toolsrc/parse.pla"
 //
 // 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)
 if ^arg and ^(arg + 1) == '-'
     opt = arg + 2

src/toolsrc/symbols.h

@@ -46,4 +46,6 @@ int id_tag(char *name, int len);
 int id_const(char *name, int len);
 int id_type(char *name, int len);
 void idglobal_size(int type, int size, int constsize);
+void idlocal_size(int size);
+void idlocal_size(int size);
 int tag_new(int type);

src/vmsrc/apple/a1cmd.pla

@@ -40,7 +40,7 @@ predef sext(a)#1, divmod(a,b)#2, execmod(modfile)#1
 //
 // Exported CMDSYS table
 //
-word version    = $0100 // 01.00
+word version    = $0120 // 01.20
 word syspath
 word syscmdln
 word            = @execmod

src/vmsrc/apple/cmd.pla

@@ -1,6 +1,5 @@
 const MACHID      = $BF98
 const iobuffer    = $0800
-const databuff    = $2000
 const RELADDR     = $1000
 const symtbl      = $0C00
 const freemem     = $0006
@@ -38,7 +37,7 @@ predef execmod(modfile)#1
 //
 // Exported CMDSYS table
 //
-word version    = $0100 // 01.00
+word version    = $0120 // 01.20
 word syspath
 word syscmdln
 word            = @execmod
@@ -1260,9 +1259,9 @@ def volumes()#0
 
     params.0 = 2
     params.1 = 0
-    params:2 = databuff
+    params:2 = heap
     perr     = syscall($C5, @params)
-    strbuf   = databuff
+    strbuf   = heap
     for i = 0 to 15
         ^strbuf = ^strbuf & $0F
         if ^strbuf
@@ -1287,12 +1286,12 @@ def catalog(path)#0
     fin
     firstblk = 1
     repeat
-        if read(refnum, databuff, 512) == 512
-            entry = databuff + 4
+        if read(refnum, heap, 512) == 512
+            entry = heap + 4
             if firstblk
-                entrylen   = databuff.$23
-                entriesblk = databuff.$24
-                filecnt    = databuff:$25
+                entrylen   = heap->$23
+                entriesblk = heap->$24
+                filecnt    = heap=>$25
                 entry      = entry + entrylen
             fin
             for i = firstblk to entriesblk
@@ -1372,7 +1371,7 @@ def resetmemfiles()#0
     //
     // Close all files
     //
-    ^$BFD8 = 0
+    ^$BF94 = 0
     close(0)
     //
     // Set memory bitmap
@@ -1390,7 +1389,7 @@ def execsys(sysfile)#0
         striptrail(sysfile)
         refnum = open(sysfile)
         if refnum
-            len = read(refnum, databuff, $FFFF)
+            len = read(refnum, $2000, $FFFF)
             resetmemfiles()
             if len
                 strcpy(sysfile, $280)

src/vmsrc/apple/cmdstub.s

@@ -43,6 +43,6 @@ LCBNK1  =   $08
     JMP $1000
 _CMDBEGIN = *
     !PSEUDOPC   $1000 {
-    !SOURCE "vmsrc/cmd.a"
+    !SOURCE "vmsrc/apple/cmd.a"
 _CMDEND =   *
 }

src/vmsrc/apple/plvm01.s

@@ -64,7 +64,7 @@ MUL     STY     IPY
         LDA     #$00
         STA     ESTKL+1,X       ; PRODL
 ;       STA     ESTKH+1,X       ; PRODH
-MULLP   LSR     TMPH            ; MULTPLRH
+_MULLP  LSR     TMPH            ; MULTPLRH
         ROR     TMPL            ; MULTPLRL
         BCS     +
         STA     ESTKH+1,X       ; PRODH
@@ -76,7 +76,7 @@ MULLP   LSR     TMPH            ; MULTPLRH
 +       ASL     ESTKL,X         ; MULTPLNDL
         ROL     ESTKH,X         ; MULTPLNDH
         DEY
-        BNE     MULLP
+        BNE     _MULLP
         STA     ESTKH+1,X       ; PRODH
         LDY     IPY
         JMP     DROP
@@ -147,7 +147,7 @@ DIVMOD  JSR     _DIV
         STA     ESTKL,X
         LDA     TMPH            ; REMNDRH
         STA     ESTKH,X
-        LDA     DVSIGN          ; REMAINDER IS SIGN OF DIVIDEND
+        ASL     DVSIGN          ; REMAINDER IS SIGN OF DIVIDEND
         BMI     NEG
         JMP     NEXTOP
 ;*
@@ -171,21 +171,20 @@ _DIV    STY     IPY
         LDA     #$00
         STA     TMPL            ; REMNDRL
         STA     TMPH            ; REMNDRH
-        LDA     ESTKH,X
-        AND     #$80
         STA     DVSIGN
-        BPL     +
-        JSR     _NEG
-        INC     DVSIGN
-+       LDA     ESTKH+1,X
+        LDA     ESTKH+1,X
         BPL     +
         INX
         JSR     _NEG
         DEX
-        INC     DVSIGN
-        BNE     _DIV1
-+       ORA     ESTKL+1,X       ; DVDNDL
+        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
@@ -902,7 +901,7 @@ LEAVE   INY                     ;+INC_IP
         RTS
 +       INC     IFPH
 RET     RTS
-A1CMD   !SOURCE "vmsrc/a1cmd.a"
+A1CMD   !SOURCE "vmsrc/apple/a1cmd.a"
 SEGEND  =       *
 VMINIT  LDY     #$10        ; INSTALL PAGE 0 FETCHOP ROUTINE
 -       LDA     PAGE0-1,Y

src/vmsrc/apple/plvm02.s

@@ -457,7 +457,7 @@ MUL     STY     IPY
         LDA     #$00
         STA     ESTKL+1,X       ; PRODL
 ;       STA     ESTKH+1,X       ; PRODH
-MULLP   LSR     TMPH            ; MULTPLRH
+_MULLP  LSR     TMPH            ; MULTPLRH
         ROR     TMPL            ; MULTPLRL
         BCS     +
         STA     ESTKH+1,X       ; PRODH
@@ -469,7 +469,7 @@ MULLP   LSR     TMPH            ; MULTPLRH
 +       ASL     ESTKL,X         ; MULTPLNDL
         ROL     ESTKH,X         ; MULTPLNDH
         DEY
-        BNE     MULLP
+        BNE     _MULLP
         STA     ESTKH+1,X       ; PRODH
         LDY     IPY
         JMP     DROP
@@ -489,21 +489,20 @@ _DIV    STY     IPY
         LDA     #$00
         STA     TMPL            ; REMNDRL
         STA     TMPH            ; REMNDRH
-        LDA     ESTKH,X
-        AND     #$80
         STA     DVSIGN
-        BPL     +
-        JSR     _NEG
-        INC     DVSIGN
-+       LDA     ESTKH+1,X
+        LDA     ESTKH+1,X
         BPL     +
         INX
         JSR     _NEG
         DEX
-        INC     DVSIGN
-        BNE     _DIV1
-+       ORA     ESTKL+1,X       ; DVDNDL
+        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
@@ -568,7 +567,7 @@ DIVMOD  JSR     _DIV
         STA     ESTKL,X
         LDA     TMPH            ; REMNDRH
         STA     ESTKH,X
-        LDA     DVSIGN          ; REMAINDER IS SIGN OF DIVIDEND
+        ASL     DVSIGN          ; REMAINDER IS SIGN OF DIVIDEND
         BMI     NEG
         JMP     NEXTOP
 ;*
@@ -1161,7 +1160,7 @@ SAW     INY                     ;+INC_IP
         LDY     IPY
         BMI     +
         JMP     DROP
-        JMP     FIXDROP
++       JMP     FIXDROP
 ;*
 ;* STORE VALUE TO ABSOLUTE ADDRESS WITHOUT POPPING STACK
 ;*
@@ -1448,6 +1447,7 @@ ICALX   LDA     ESTKL,X
         PHP
         PLA
         STA     PSR
+        SEI
         STA     ALTRDON
         PLA
         STA     IPH
@@ -1884,7 +1884,7 @@ OPCPY   STA     DST
         INC     SRC
         BNE     +
         INC     SRC+1
-+
++       DEY
 -       LDA     (SRC),Y
         STA     (DST),Y
         DEY

src/vmsrc/apple/plvm03.s

@@ -42,17 +42,17 @@ DSTX    =       XPAGE+DSTH
 ;*
 ;* INTERPRETER HEADER+INITIALIZATION
 ;*
-SEGSTART        =       $A000
+SEGSTART        =       $2000
         *=      SEGSTART-$0E
         !TEXT   "SOS NTRP"
         !WORD   $0000
         !WORD   SEGSTART
         !WORD   SEGEND-SEGSTART
 
-        +SOS    $40, SEGREQ     ; ALLOCATE SEG 1 AND MAP IT
-        BNE     FAIL            ; PRHEX
-        LDA     #$01
-        STA     MEMBANK
+;        +SOS    $40, SEGREQ     ; ALLOCATE SEG 1 AND MAP IT
+;        BNE     FAIL            ; PRHEX
+;        LDA     #$00
+;        STA     MEMBANK
         LDY     #$0F            ; INSTALL PAGE 0 FETCHOP ROUTINE
         LDA     #$00
 -       LDX     PAGE0,Y
@@ -62,19 +62,36 @@ SEGSTART        =       $A000
         BPL     -
         LDX     #$4C            ; SET JMPTMP OPCODE
         STX     JMPTMP
-;        STA     JMPTMPX
-;        STA     JMPTMPX+1
         STA     TMPX            ; CLEAR ALL EXTENDED POINTERS
         STA     SRCX
         STA     DSTX
         STA     PPX             ; INIT FRAME & POOL POINTERS
         STA     IFPX
-        LDA     #<SEGSTART
+        LDA     #$00
         STA     PPL
         STA     IFPL
-        LDA     #>SEGSTART
+        LDA     #$A0
         STA     PPH
         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
         TXS
         LDX     #ESTKSZ/2       ; INIT EVAL STACK INDEX
@@ -97,13 +114,13 @@ SEGSTART        =       $A000
 ;        BCC     +
 ;        ADC     #6
 ;+       STA     $481    ;$880
-FAIL    STA     $0480
-        RTS
-SEGREQ  !BYTE   4
-        !WORD   $2001
-        !WORD   $9F01
-        !BYTE   $10
-        !BYTE   $00
+;FAIL    STA     $0480
+;        RTS
+;SEGREQ  !BYTE   4
+;        !WORD   $2000
+;        !WORD   $9F00
+;        !BYTE   $10
+;        !BYTE   $00
 PAGE0   =       *
         !PSEUDOPC       DROP {
 ;*
@@ -115,6 +132,20 @@ PAGE0   =       *
         STA     OPIDX
         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
 ;*
@@ -162,21 +193,20 @@ _DIV    STY     IPY
         LDA     #$00
         STA     TMPL            ; REMNDRL
         STA     TMPH            ; REMNDRH
-        LDA     ESTKH,X
-        AND     #$80
         STA     DVSIGN
-        BPL     +
-        JSR     _NEG
-        INC     DVSIGN
-+       LDA     ESTKH+1,X
+        LDA     ESTKH+1,X
         BPL     +
         INX
         JSR     _NEG
         DEX
-        INC     DVSIGN
-        BNE     _DIV1
-+       ORA     ESTKL+1,X       ; DVDNDL
+        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
@@ -201,18 +231,6 @@ _DIVEX  INX
         LDY     IPY
         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     STY     IPY
@@ -226,7 +244,7 @@ MUL     STY     IPY
         LDA     #$00
         STA     ESTKL+1,X       ; PRODL
 ;       STA     ESTKH+1,X       ; PRODH
-MULLP   LSR     TMPH            ; MULTPLRH
+_MULLP  LSR     TMPH            ; MULTPLRH
         ROR     TMPL            ; MULTPLRL
         BCS     +
         STA     ESTKH+1,X       ; PRODH
@@ -238,7 +256,7 @@ MULLP   LSR     TMPH            ; MULTPLRH
 +       ASL     ESTKL,X         ; MULTPLNDL
         ROL     ESTKH,X         ; MULTPLNDH
         DEY
-        BNE     MULLP
+        BNE     _MULLP
         STA     ESTKH+1,X       ; PRODH
         LDY     IPY
         JMP     DROP
@@ -277,10 +295,25 @@ DIVMOD  JSR     _DIV
         STA     ESTKL,X
         LDA     TMPH            ; REMNDRH
         STA     ESTKH,X
-        LDA     DVSIGN          ; REMAINDER IS SIGN OF DIVIDEND
+        ASL     DVSIGN          ; REMAINDER IS SIGN OF DIVIDEND
         BMI     NEG
         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     LDA     ESTKL,X
@@ -317,21 +350,6 @@ IDXW    LDA     ESTKL,X
         STA     ESTKH+1,X
         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
@@ -1065,5 +1083,6 @@ LEAVE   INY                     ;+INC_IP
         STA     IFPH
 RET     RTS
 SOSCMD  =       *
-        !SOURCE "vmsrc/soscmd.a"
+        !SOURCE "vmsrc/apple/soscmd.a"
+}
 SEGEND  =       *

src/vmsrc/apple/plvm802.s

@@ -529,12 +529,12 @@ MUL     LDX     #$10
         EOR     #$FFFF
         STA     TMP
         LDA     #$0000
-MULLP   ASL
+_MULLP  ASL
         ASL     TMP             ; MULTPLR
         BCS     +
         ADC     TOS,S           ; MULTPLD
 +       DEX
-        BNE     MULLP
+        BNE     _MULLP
         STA     NOS,S           ; PROD
         JMP     DROP
 ;*
@@ -543,19 +543,20 @@ MULLP   ASL
 _DIV    STY     IPY
         LDY     #$11            ; #BITS+1
         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     +
         LDX     #$81
         EOR     #$FFFF
         INC
-        STA     TOS+2,S
-+       LDA     NOS+2,S
++       STA     TMP             ; NOS,S
+        LDA     TOS+2,S
         BPL     +
         INX
         EOR     #$FFFF
         INC
-+       STA     TMP             ; NOS,S
-        BEQ     _DIVEX
+        STA     TOS+2,S
++       LDA     TMP
 _DIV1   ASL                     ; DVDND
         DEY
         BCC     _DIV1
@@ -1006,7 +1007,6 @@ SLB     INY                     ;+INC_IP
         TXY
         BMI     +
         JMP     NEXTOP
-+       JMP     FIXNEXT
 SLW     INY                     ;+INC_IP
         LDA     (IP),Y
         TYX
@@ -1051,7 +1051,6 @@ SAB     INY                     ;+INC_IP
         INY
         BMI     +
         JMP     NEXTOP
-+       JMP     FIXNEXT
 SAW     INY                     ;+INC_IP
         LDA     (IP),Y
         STA     TMP

src/vmsrc/apple/soscmd.pla

@@ -17,12 +17,6 @@ const resxhgr2    = $0080
 const modkeep     = $2000
 const modinitkeep = $4000
 //
-// SOS flags
-//
-const O_READ      = 1
-const O_WRITE     = 2
-const O_READ_WRITE = 3
-//
 // Pedefined functions.
 //
 predef syscall(cmd,params)#1, call(addr,areg,xreg,yreg,status)#1
@@ -35,7 +29,7 @@ predef execmod(modfile)#1
 //
 // Exported CMDSYS table
 //
-word version     = $0100 // 01.00
+word version     = $0120 // 01.20
 word syspath
 word cmdlnptr
 word             = @execmod
@@ -329,9 +323,9 @@ asm memxcpy(dst,src,size)#0
         ADC     #$60
         STA     DSTH
         LDA     ESTKL+2,X
-        ORA     #$80
+        CLC
+        ADC     #$7F
         STA     DSTX
-        DEC     DSTX
         LDA     ESTKL+1,X
         STA     SRCL
         LDA     ESTKH+1,X
@@ -367,9 +361,9 @@ asm xpokeb(seg, dst, byteval)#0
         ADC     #$60
         STA     DSTH
         LDA     ESTKL+2,X
-        ORA     #$80
+        CLC
+        ADC     #$7F
         STA     DSTX
-        DEC     DSTX
         LDY     #$00
         LDA     ESTKL,X
         STA     (DST),Y
@@ -577,9 +571,9 @@ asm lookuptbl(dci, tbl)#1
         ADC     #$60
         STA     DSTH
         LDA     ESTKL,X
-        ORA     #$80
+        CLC
+        ADC     #$7F
         STA     DSTX
-        DEC     DSTX
         LDA     ESTKL+1,X
         STA     SRCL
         LDA     ESTKH+1,X
@@ -803,14 +797,24 @@ def getpfx(path)#1
     return path
 end
 def setpfx(path)#1
-    byte params[3]
+    byte params[6]
+    byte fileinfo[2]
 
-    params.0 = 1
+    params.0 = 3
     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
 end
-def volume(devname, volname, ttlblks, freblks)#1
+def volume(devname, volname)#1
     byte params[9]
 
     params.0 = 4
@@ -819,8 +823,6 @@ def volume(devname, volname, ttlblks, freblks)#1
     params:5 = 0
     params:7 = 0
     perr     = syscall($C5, @params)
-    *ttlblks = params:5
-    *freblks = params:7
     return perr
 end
 def open(path)#1
@@ -899,18 +901,7 @@ end
 //
 // MEMORY CALLS
 //
-def seg_request(base, limit, id)#1
-    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
+def seg_find(search, pages, id)#3
     byte params[10]
 
     params.0 = 6
@@ -921,9 +912,7 @@ def seg_find(search, base, limit, pages, id)#1
     params:7 = 0
     params.9 = 0
     perr     = syscall($41, @params)
-    *base    = params:5
-    *limit   = params:7
-    return params.9
+    return params.9, params:5, params:7
 end
 def seg_release(segnum)#1
     byte params[2]
@@ -943,8 +932,9 @@ def init_cons()#0
     fin
     write(refcons, @textmode, 3)
     devcons  = dev_getnum(@console)
-    nlmode.0 = $80
-    nlmode.1 = $0D
+    nlmode:0 = $0D80
+    //nlmode.0 = $80
+    //nlmode.1 = $0D
     dev_control(devcons, $02, @nlmode)
 end
 def cout(ch)#0
@@ -955,6 +945,9 @@ def cout(ch)#0
         write(refcons, @ch, 1)
     fin
 end
+def crout()#0
+    cout($0D)
+end
 def cin()#1
     byte ch
     read(refcons, @ch, 1)
@@ -975,14 +968,11 @@ def rdstr(prompt)#1
     cout(prompt)
     ^heap = read(refcons, heap + 1, 128)
     if heap->[^heap] == $0D
-        ^heap = ^heap - 1
+        ^heap--
     fin
-    cout($0D)
+    crout
     return heap
 end
-def crout()#0
-    cout($0D)
-end
 def prbyte(v)#0
     cout(hexchar[(v >> 4) & $0F])
     cout(hexchar[v & $0F])
@@ -1150,7 +1140,7 @@ def loadmod(mod)#1
         //
         // Alloc heap space for relocated module (data + bytecode).
         //
-        moddep  = moddep  + 1
+        moddep++
         modfix  = moddep  - @header.2 // Adjust to skip header
         modsize = modsize - modfix
         rdlen   = rdlen   - modfix - 2
@@ -1181,17 +1171,17 @@ def loadmod(mod)#1
         while ^esd         // Scan to end of ESD
             esd = esd + 4
         loop
-        esd = esd + 1
+        esd++
         if defcnt
             //
             // 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
                 return -perr
             fin
-            modid = modid + 1
-            defext  = (codeseg.0 | $80) - 1
+            modid++
+            defext  =  codeseg.0 + $7F // (codeseg.0 | $80) - 1
             defaddr = (codeseg & $FF00) + $6000
             codefix = defaddr - bytecode
             defofst = defaddr - defofst
@@ -1268,8 +1258,6 @@ def loadmod(mod)#1
             //
             memxcpy(codeseg, bytecode, modsize - (bytecode - modaddr))
         fin
-    //else
-    //    return -perr
     fin
     if lerr
         return -lerr
@@ -1298,12 +1286,11 @@ def volumes()#0
     byte devname[17]
     byte volname[17]
     byte i
-    word ttlblks, freblks
 
     for i = $01 to $18
         if dev_info(i, @devname, @info, 11) == 0
             prstr(@devname)
-            if volume(@devname, @volname, @ttlblks, @freblks) == 0
+            if volume(@devname, @volname) == 0
                 prstr(" => /")
                 prstr(@volname)
                 cout('/')
@@ -1423,7 +1410,7 @@ def execmod(modfile)#1
             lastsym = savesym
             heap    = saveheap
             while modid
-                modid = modid - 1
+                modid--
                 seg_release(modseg[modid])
             loop
         else
@@ -1445,7 +1432,7 @@ prstr("PLASMA "); prbyte(version.1); cout('.'); prbyte(version.0); crout
 //
 // Init 2K symbol table.
 //
-seg_find($00, @symtbl, @lastsym, $08, $11)
+drop, symtbl, drop = seg_find($00, $08, $11)
 lastsym = symtbl & $FF00
 xpokeb(symtbl.0, lastsym, 0)
 while *sysmodsym
@@ -1513,6 +1500,7 @@ while 1
                 saveX
                 execmod(striptrail(cmdptr))
                 restoreX
+                //close(0)
                 init_cons
                 break
             otherwise
@@ -1524,7 +1512,7 @@ while 1
             prbyte(terr)
             perr = 0
         else
-            prstr("OK\n")
+            prstr("OK")
         fin
         crout()
     fin

src/vmsrc/c64/plvmc64.s

@@ -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)
+}

src/vmsrc/c64/plvmzp.inc

@@ -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

src/vmsrc/plvm.c

@@ -455,6 +455,7 @@ void interp(code *ip);
 void call(uword pc)
 {
     unsigned int i, s;
+    int a, b;
     char c, sz[64];
 
     if (show_state)
@@ -508,6 +509,12 @@ void call(uword pc)
             mem_data[0x1FF] = i;
             PUSH(0x1FF);
             break;
+        case 24: // LIBRARY CMDSYS::DIVMOD
+            a = POP;
+            b = POP;
+            PUSH(b / a);
+            PUSH(b % a);
+            break;
         default:
             printf("\nUnimplemented call code:$%02X\n", mem_data[pc - 1]);
             exit(1);