6502/PLASMA
1
0
Fork 0
mirror of https://github.com/dschmenk/PLASMA.git synced 2025-04-05 03:37:43 +00:00
Code Issues Projects Releases Wiki Activity

Merge pull request #13 from dschmenk/master

Browse Source 
Merge latest upstream changes
This commit is contained in:
ZornsLemma 2018-05-04 23:02:30 +01:00 committed by GitHub
commit 660334fd84
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
49 changed files with 3411 additions and 3232 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
PLASMA-BLD2.PO
View File

Binary file not shown.

BIN
PLASMA-DEM2.PO
View File

Binary file not shown.

BIN
PLASMA-SOS2.PO → PLASMA-FPSOS.PO
View File

Binary file not shown.

BIN
PLASMA-SYS2.PO
View File

Binary file not shown.

82
README.md
View File

@ -1,12 +1,12 @@
# 3/13/2018 PLASMA 1.1 Available!
[Download and read the Release Notes](https://github.com/dschmenk/PLASMA/blob/master/doc/Version%201.1.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
![Luc Viatour](https://upload.wikimedia.org/wikipedia/commons/thumb/2/26/Plasma-lamp_2.jpg/1200px-Plasma-lamp_2.jpg)
image credit: Luc Viatour / www.Lucnix.be
PLASMA: **P**roto **L**anguage **A**s**S**e**M**bler for **A**pple
PLASMA: **P**roto **L**anguage **A**s**S**e**M**bler for **A**ll
PLASMA is a medium level programming language targeting the 8-bit 6502 processor. Historically, there were simple languages developed in the early years of computers that improved on the tedium of assembly language programming while still being low level enough for system coding. Languages like B, FORTH, and PLASMA fall into this category.
@ -94,7 +94,7 @@ Different projects have led to the architecture of PLASMA, most notably Apple Pa
- [Call Stack](#call-stack)
- [Local Frame Stack](#local-frame-stack)
- [Local String Pool](#local-string-pool)
- [The Bytecodes](#the-bytecodes)
- [The Bytecodes](https://github.com/dschmenk/PLASMA/wiki/PLASMA-Byte-Codes)
- [Apple 1 PLASMA](#apple-1-plasma)
- [Apple II PLASMA](#apple-ii-plasma)
- [Apple /// PLASMA](#apple--plasma)
@ -1313,80 +1313,6 @@ One of the biggest problems to overcome with the 6502 is its very small hardware
Any function that uses in-line strings may have those strings copied to the local string pool for usage. This allows string literals to exist in the same memory as the bytecode and only copied to main memory when used. The string pool is deallocated along with the local frame stack when the function exits.
### The Opcodes
The compact code representation comes through the use of opcodes closely matched to the PLASMA compiler. They are:
| OPCODE | Name | Description
|:------:|:------:|-----------------------------------
| $00 | ZERO | push zero on the stack
| $02 | ADD | add top two values, leave result on top
| $04 | SUB | subtract next from top from top, leave result on top
| $06 | MUL | multiply two topmost stack values, leave result on top
| $08 | DIV | divide next from top by top, leave result on top
| $0A | MOD | divide next from top by top, leave remainder on top
| $0C | INCR | increment top of stack
| $0E | DECR | decrement top of stack
| $10 | NEG | negate top of stack
| $12 | COMP | compliment top of stack
| $14 | AND | bit wise AND top two values, leave result on top
| $16 | IOR | bit wise inclusive OR top two values, leave result on top
| $18 | XOR | bit wise exclusive OR top two values, leave result on top
| $1A | SHL | shift left next from top by top, leave result on top
| $1C | SHR | shift right next from top by top, leave result on top
| $02 | IDXB | add top of stack to next from top, leave result on top (ADD)
| $1E | IDXW | add 2X top of stack to next from top, leave result on top
| $20 | NOT | logical NOT of top of stack
| $22 | LOR | logical OR top two values, leave result on top
| $24 | LAND | logical AND top two values, leave result on top
| $26 | LA | load address
| $28 | LLA | load local address from frame offset
| $2A | CB | constant byte
| $2C | CW | constant word
| $2E | CS | constant string
| $30 | DROP | drop top stack value
| $32 | DUP | duplicate top stack value
| $34 | NOP |
| $36 | DIVMOD | divide next from to by top, leave result and remainder on stack
| $38 | BRGT | branch next from top greater than top
| $3A | BRLT | branch next from top less than top
| $3C | BREQ | branch next from top equal to top
| $3E | BRNE | branch next from top not equal to top
| $40 | ISEQ | if next from top is equal to top, set top true
| $42 | ISNE | if next from top is not equal to top, set top true
| $44 | ISGT | if next from top is greater than top, set top true
| $46 | ISLT | if next from top is less than top, set top true
| $48 | ISGE | if next from top is greater than or equal to top, set top true
| $4A | ISLE | if next from top is less than or equal to top, set top true
| $4C | BRFLS | branch if top of stack is zero
| $4E | BRTRU | branch if top of stack is non-zero
| $50 | BRNCH | branch to address
| $52 | IBRNCH | branch to address on stack top
| $54 | CALL | sub routine call with stack parameters
| $56 | ICAL | sub routine call to address on stack top with stack parameters
| $58 | ENTER | allocate frame size and copy stack parameters to local frame
| $5A | LEAVE | deallocate frame and return from sub routine call
| $5C | RET | return from sub routine call
| $5E | CFFB | constant with $FF MSB
| $60 | LB | load byte from top of stack address
| $62 | LW | load word from top of stack address
| $64 | LLB | load byte from frame offset
| $66 | LLW | load word from frame offset
| $68 | LAB | load byte from absolute address
| $6A | LAW | load word from absolute address
| $6C | DLB | duplicate top of stack into local byte at frame offset
| $6E | DLW | duplicate top of stack into local word at frame offset
| $70 | SB | store next from top of stack byte into top address
| $72 | SW | store next from top of stack word into top address
| $74 | SLB | store top of stack into local byte at frame offset
| $76 | SLW | store top of stack into local word at frame offset
| $78 | SAB | store top of stack into byte at absolute address
| $7A | SAW | store top of stack into word at absolute address
| $7C | DAB | duplicate top of stack into byte at absolute address
| $7E | DAW | duplicate top of stack into word at absolute address
The opcodes were developed over time by starting with a very basic set of operations and slowly adding opcodes when the PLASMA compiler could improve code density or performance.
## Apple 1 PLASMA
Obviously the Apple 1 is a little more constrained than most machines PLASMA is targeting. But, with the required addition of the CFFA1 (http://dreher.net/?s=projects/CFforApple1&c=projects/CFforApple1/main.php), the Apple 1 gets 32K of RAM and a mass storage device. Enough to run PLASMA and load/execute modules.

20
doc/Version 1.1.md → doc/Version 1.2.md
View File

@ -1,16 +1,16 @@
# PLASMA Version 1.1
# 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.1 System and ProDOS Boot](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.1 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.1 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.1 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,16 @@ 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

3
src/inc/lz4.plh Normal file
View File

@ -0,0 +1,3 @@
import lz4
predef lz4Unpack(seq, seqend, buff, buffend)
end

32
src/inc/mouse.plh Normal file
View File

@ -0,0 +1,32 @@
import mouse
//
// Status bits
//
const BUTTON_DOWN = $80
const BUTTON_LAST_DOWN = $40
const MOUSE_MOVED = $20
const VBL_INT = $08
const BUTTON_INT = $04
const MOVE_INT = $02
//
// Mode bits
//
const VBL_INT_ENABLE = $08
const BUTTON_INT_ENABLE= $04
const MOVE_INT_ENABLE = $02
const MOUSE_ENABLE = $01
//
// Mouse API
//
struc t_mouse
word chkVBL
word chkMouse
word readMouse // readMouse()#3
word setMouse // setMouse(mode)
word clearMouse
word posMouse // posMouse(x, y)
word clampMouse // clampMouse(xMin, xMax, yMin, yMax)
word homeMouse
word detachMouse
end
end

6
src/libsrc/apple/jit.pla
View File

@ -3,11 +3,6 @@
//
include "inc/cmdsys.plh"
//
// Module don't free memory
//
const modkeep = $2000
const modinitkeep = $4000
//
// Indirect interpreter DEFinition entrypoint
//
struc t_defentry
@ -47,5 +42,6 @@ fin
*jitcomp = @compiler
cmdsys.jitcount = 44
cmdsys.jitsize = 96
puts("JITC enabled\n")
return modkeep
done

14
src/libsrc/apple/jit16.pla
View File

@ -3,11 +3,6 @@
//
include "inc/cmdsys.plh"
//
// Module don't free memory
//
const modkeep = $2000
const modinitkeep = $4000
//
// Indirect interpreter DEFinition entrypoint
//
struc t_defentry
@ -37,7 +32,13 @@ def defcpy(dst, defptr)#0
*$0042 = dst
call($C311, 0, 0, 0, $04) // CALL XMOVE with carry clear (AUX->MAIN) and ints disabled
end
include "libsrc/jitcore.pla"
//
// Identify hardware addresses for certain byte sized access operations
//
def is_hwaddr(addr)
return addr >= $C000 and addr < $C100
end
include "libsrc/jit16core.pla"
//
// Install JIT compiler
//
@ -47,5 +48,6 @@ fin
*jitcomp = @compiler
cmdsys.jitcount = 44
cmdsys.jitsize = 96
puts("16-bit VM/JITC enabled\n")
return modkeep
done

572
src/libsrc/apple/mouse.pla Normal file
View File

@ -0,0 +1,572 @@
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
//
// 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)
//
// 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);
}
}

250
src/libsrc/apple/uthernet.pla
View File

@ -11,10 +11,10 @@ end
//
// Uthernet register offsets
//
const TX_DATA = $00
const RX_DATA = $00
const TX_CMD = $04
const TX_LEN = $06
const TX_DATA = $00
const RX_DATA = $00
const TX_CMD = $04
const TX_LEN = $06
const INT_STATUS = $08
const PREG_INDEX = $0A
const PREG_DATA = $0C
@ -22,13 +22,14 @@ const AUTO_INC = $8000
//
// Uthernet register addresses
//
byte[] slot // Init time only
byte rxdata_lo, rxdata_hi
byte txcmd
byte txlen
byte isq
word rom[]
byte pregidx
byte pregdata
byte[] slot // Init time only
//
// Uthernet MAC address
//
@ -37,156 +38,155 @@ byte[6] utherMAC = $00,$0A,$99,$1E,$02,$A0
// Defines for ASM routines
//
asm equates
!SOURCE "vmsrc/plvmzp.inc"
!SOURCE "vmsrc/plvmzp.inc"
end
//
// Uthernet I/O functions
//
asm _pokeiow(val)
LDA ESTKL,X
asm _pokeiow(val)#0
LDA ESTKL,X
end
asm _pokeiowl
STA $C000
LDA ESTKH,X
STA $C000
LDA ESTKH,X
end
asm _pokeiowh
STA $C000
RTS
STA $C000
INX
RTS
end
//
// PEEK BYTE FROM I/O SPACE
// _peekio()
//
asm _peekio
DEX
asm _peekio#1
DEX
end
asm _peekiol
LDA $C000
STA ESTKL,X
LDA #$00
STA ESTKH,X
RTS
LDA $C000
STA ESTKL,X
LDA #$00
STA ESTKH,X
RTS
end
//
// PEEK WORD FROM I/O SPACE
// _peekiow()
//
asm _peekiow
DEX
asm _peekiow#1
DEX
end
asm _peekiowl
LDA $C000
STA ESTKL,X
LDA $C000
STA ESTKL,X
end
asm _peekiowh
LDA $C000
STA ESTKH,X
RTS
LDA $C000
STA ESTKH,X
RTS
end
//
// WRITE FRAME DATA INTO I/O SPACE
// pokefrm(BUF, LEN)
//
asm pokefrm(buf, len)
LDY #$00
LDA ESTKL+1,X
STA SRCL
LDA ESTKH+1,X
STA SRCH
LSR ESTKH,X ; CONVERT BYTE LEN TO WORD LEN
LDA ESTKL,X
ROR
ADC #$00
STA ESTKL,X
BEQ +
!BYTE $A9
- CLC
INC ESTKH,X
+ BCS -
POKELP LDA (SRC),Y
asm pokefrm(buf, len)#1
LDY #$00
LDA ESTKL+1,X
STA SRCL
LDA ESTKH+1,X
STA SRCH
LSR ESTKH,X ; CONVERT BYTE LEN TO WORD LEN
LDA ESTKL,X
ROR
ADC #$00
STA ESTKL,X
BEQ +
INC ESTKH,X
+ BCC POKELP
INC ESTKH,X
POKELP LDA (SRC),Y
end
asm _pokefrml
STA $C000
INY
LDA (SRC),Y
STA $C000
INY
LDA (SRC),Y
end
asm _pokefrmh
STA $C000
INY
BNE +
INC SRCH
+ DEC ESTKL,X
BNE POKELP
DEC ESTKH,X
BNE POKELP
INX
RTS
STA $C000
INY
BNE +
INC SRCH
+ DEC ESTKL,X
BNE POKELP
DEC ESTKH,X
BNE POKELP
INX
RTS
end
//
// READ FRAME DATA FROM I/O SPACE
// peekfrm(BUF, LEN)
//
asm peekfrm(buf, len)
LDY #$00
LDA ESTKL+1,X
STA DSTL
LDA ESTKH+1,X
STA DSTH
LSR ESTKH,X ; CONVERT BYTE LEN TO WORD LEN
LDA ESTKL,X
ROR
ADC #$00
STA ESTKL,X
BEQ +
!BYTE $A9
- CLC
INC ESTKH,X
+ BCS -
asm peekfrm(buf, len)#1
LDY #$00
LDA ESTKL+1,X
STA DSTL
LDA ESTKH+1,X
STA DSTH
LSR ESTKH,X ; CONVERT BYTE LEN TO WORD LEN
LDA ESTKL,X
ROR
ADC #$00
STA ESTKL,X
BEQ +
INC ESTKH,X
+ BCC PEEKLP
INC ESTKH,X
end
asm _peekfrml
PEEKLP LDA $C000
STA (DST),Y
INY
PEEKLP LDA $C000
STA (DST),Y
INY
end
asm _peekfrmh
+ LDA $C000
STA (DST),Y
INY
BNE +
INC DSTH
+ DEC ESTKL,X
BNE PEEKLP
DEC ESTKH,X
BNE PEEKLP
EXPSW INX
RTS
LDA $C000
STA (DST),Y
INY
BNE +
INC DSTH
+ DEC ESTKL,X
BNE PEEKLP
DEC ESTKH,X
BNE PEEKLP
EXPSW INX
RTS
end
def pokeiow(io, data)
def pokeiow(io, data)#0
_pokeiowl.1 = io
_pokeiowh.1 = io+1
return _pokeiow(data)
_pokeiow(data)
end
def peekio(io)
def peekio(io)#1
_peekiol.1 = io
return _peekio()
end
def peekiow(io)
def peekiow(io)#1
_peekiowl.1 = io
_peekiowh.1 = io+1
return _peekiow()
end
def pokepreg(reg, data)
def pokepreg(reg, data)#0
pokeiow(pregidx, reg)
return pokeiow(pregdata, data)
pokeiow(pregdata, data)
end
def peekpreg(reg)
def peekpreg(reg)#1
pokeiow(pregidx, reg)
return peekiow(pregdata)
end
//
// Set the length of the next packet to send and wait for data space availability
//
def pokefrmlen(len)
def pokefrmlen(len)#1
pokeiow(txcmd, $C0)
pokeiow(txlen, len)
repeat; until peekpreg($0138) & $0100
@ -195,7 +195,7 @@ end
//
// Return the length of awaiting packet, 0 otherwise
//
def peekfrmlen
def peekfrmlen#1
word len
len = 0
if peekiow(isq) & $3F == $04
@ -214,35 +214,37 @@ end
// Identify Uthernet card and initialize
//
for slot = $90 to $F0 step $10
if (peekiow(slot+TX_CMD) & $CC3F) == $09
pokeiow(slot+PREG_INDEX, 0)
if peekiow(slot+PREG_DATA) == $630E
pokepreg($0114, $40) // RESET
rxdata_hi = slot + 1
txcmd = slot + TX_CMD
txlen = slot + TX_LEN
isq = slot + INT_STATUS
pregidx = slot + PREG_INDEX
pregdata = slot + PREG_DATA
_pokefrml.1 = slot
_pokefrmh.1 = slot+1
_peekfrml.1 = slot
_peekfrmh.1 = slot+1
pokepreg($0158, utherMAC:0) // MAC addr
pokepreg($015A, utherMAC:2) // MAC addr
pokepreg($015C, utherMAC:4) // MAC addr
pokepreg($0102, $0100) // Recv cfg
pokepreg($0104, $0D00) // Recv ctrl
pokepreg($0106, $8200) // Xmit cfg
pokepreg($0112, $00C0) // Line ctrl
//
// Install etherip driver
//
puts("Found Uthernet I in slot #")
putc('0' + ((slot - $80) >> 4))
putln
setEtherDriver(@utherMAC, @peekfrmlen, @peekfrm, @pokefrmlen, @pokefrm)
return modkeep
rom = ((slot & $70) << 4) | $C000
if rom=>$06 <> $3C86 or (slot == $0B or (rom->$05 <> $38 and rom->$07 <> $18)) // Skip slots with signature
if (peekiow(slot+TX_CMD) & $CC3F) == $0009
pokeiow(slot+PREG_INDEX, 0)
if peekiow(slot+PREG_DATA) == $630E
pregidx = slot + PREG_INDEX
pregdata = slot + PREG_DATA
pokepreg($0114, $40) // RESET
rxdata_lo = slot + RX_DATA
rxdata_hi = slot + RX_DATA + 1
txcmd = slot + TX_CMD
txlen = slot + TX_LEN
isq = slot + INT_STATUS
_pokefrml.1 = slot + TX_DATA
_pokefrmh.1 = slot + TX_DATA + 1
_peekfrml.1 = slot + RX_DATA
_peekfrmh.1 = slot + RX_DATA + 1
pokepreg($0158, utherMAC:0) // MAC addr
pokepreg($015A, utherMAC:2) // MAC addr
pokepreg($015C, utherMAC:4) // MAC addr
pokepreg($0102, $0100) // Recv cfg
pokepreg($0104, $0D00) // Recv ctrl
pokepreg($0106, $8200) // Xmit cfg
pokepreg($0112, $00C0) // Line ctrl
//
// Install etherip driver
//
puts("Found Uthernet I in slot #"); putc('0' + ((slot - $80) >> 4)); putln
setEtherDriver(@utherMAC, @peekfrmlen, @peekfrm, @pokefrmlen, @pokefrm)
return modkeep
fin
fin
fin
next

345
src/libsrc/apple/uthernet2.pla
View File

@ -71,10 +71,11 @@ const WIZ_RXMEM3 = $7800
//
// Wiznet indirect registers
//
byte slot
word saveidx
byte regidx
byte regdata
word[] rom
word saveidx
byte regidx
byte regdata
byte[] slot
//
// Wiznet MAC address
//
@ -137,7 +138,6 @@ word bcast = IP_BROADCAST, IP_BROADCAST
//
// ICMP type/codes
//
const IP_PROTO_ICMP = 1
const ICMP_ECHO_REQST = 8
const ICMP_ECHO_REPLY = 0
//
@ -180,12 +180,12 @@ end
//
// Local network parameters
//
const MAX_WIZ_CHANNELS = 4
const MAX_WIZ_CHANNELS = 4
//
// Channel protocols
//
const WIZ_PROTO_CLOSED = 0
const WIZ_PROTO_TCP = 1
const WIZ_PROTO_CLOSED = 0
const WIZ_PROTO_TCP = 1
const WIZ_PROTO_UDP = 2
const WIZ_PROTO_IP = 3
const WIZ_PROTO_RAW = 4
@ -212,7 +212,7 @@ struc t_channel
word channel_recv_func
word channel_recv_parm
end
byte[t_channel * MAX_WIZ_CHANNELS] wizChannel
byte[t_channel] wizChannel[MAX_WIZ_CHANNELS]
//
// Service ICMP hook
//
@ -227,11 +227,11 @@ end
// Swap bytes in word
//
asm swab(val)
LDA ESTKL,X
LDY ESTKH,X
STA ESTKH,X
STY ESTKL,X
RTS
LDA ESTKL,X
LDY ESTKH,X
STA ESTKH,X
STY ESTKL,X
RTS
end
//
// Wiznet I/O functions
@ -239,118 +239,122 @@ end
// POKE WORD TO I/O SPACE
// Note: Big Endian format
//
asm _pokeiow(val)
LDA ESTKH,X
asm _pokeiow(val)#0
LDA ESTKH,X
end
asm _pokeiowl
STA $C000
LDA ESTKL,X
STA $C000
LDA ESTKL,X
end
asm _pokeiowh
STA $C000
RTS
STA $C000
INX
RTS
end
//
// POKE BYTE TO I/O SPACE
//
asm _pokeio(val)
LDA ESTKL,X
asm _pokeio(val)#0
LDA ESTKL,X
end
asm _pokeiol
STA $C000
RTS
STA $C000
INX
RTS
end
//
// PEEK BYTE FROM I/O SPACE
//
asm _peekio
DEX
DEX
end
asm _peekiol
LDA $C000
STA ESTKL,X
LDA #$00
STA ESTKH,X
RTS
LDA $C000
STA ESTKL,X
LDA #$00
STA ESTKH,X
RTS
end
//
// PEEK WORD FROM I/O SPACE
// Note: Big Endian format
//
asm _peekiow
DEX
DEX
end
asm _peekiowl
LDA $C000
STA ESTKH,X
LDA $C000
STA ESTKH,X
end
asm _peekiowh
LDA $C000
STA ESTKL,X
RTS
LDA $C000
STA ESTKL,X
RTS
end
//
// WRITE DATA INTO I/O SPACE
// pokedata(BUF, LEN)
//
asm pokedata(buf, len)
LDA ESTKL+1,X
STA SRCL
LDA ESTKH+1,X
STA SRCH
LDY ESTKL,X
BEQ POKELP
LDY #$00
INC ESTKH,X
POKELP LDA (SRC),Y
asm pokedata(buf, len)#0
LDA ESTKL+1,X
STA SRCL
LDA ESTKH+1,X
STA SRCH
LDY ESTKL,X
BEQ POKELP
LDY #$00
INC ESTKH,X
POKELP LDA (SRC),Y
end
asm _pokedata
STA $C000
INY
BNE +
INC SRCH
+ DEC ESTKL,X
BNE POKELP
DEC ESTKH,X
BNE POKELP
INX
RTS
STA $C000
INY
BNE +
INC SRCH
+ DEC ESTKL,X
BNE POKELP
DEC ESTKH,X
BNE POKELP
INX
INX
RTS
end
//
// READ DATA FROM I/O SPACE
// peekdata(BUF, LEN)
//
asm peekdata(buf, len)
LDA ESTKL+1,X
STA DSTL
LDA ESTKH+1,X
STA DSTH
LDY ESTKL,X
BEQ PEEKLP
LDY #$00
INC ESTKH,X
asm peekdata(buf, len)#0
LDA ESTKL+1,X
STA DSTL
LDA ESTKH+1,X
STA DSTH
LDY ESTKL,X
BEQ PEEKLP
LDY #$00
INC ESTKH,X
end
asm _peekdata
PEEKLP LDA $C000
STA (DST),Y
INY
BNE +
INC DSTH
+ DEC ESTKL,X
BNE PEEKLP
DEC ESTKH,X
BNE PEEKLP
INX
RTS
PEEKLP LDA $C000
STA (DST),Y
INY
BNE +
INC DSTH
+ DEC ESTKL,X
BNE PEEKLP
DEC ESTKH,X
BNE PEEKLP
INX
INX
RTS
end
def pokeiow(io, data)
def pokeiow(io, data)#0
_pokeiowl.1 = io
_pokeiowh.1 = io+1
return _pokeiow(data)
_pokeiow(data)
end
def pokeio(io, data)
def pokeio(io, data)#0
_pokeiol.1 = io
return _pokeio(data)
_pokeio(data)
end
def peekio(io)
_peekiol.1 = io
@ -361,26 +365,26 @@ def peekiow(io)
_peekiowh.1 = io+1
return _peekiow()
end
def pokereg(reg, data)
def pokereg(reg, data)#0
_pokeiow(reg)
return _pokeio(data)
_pokeio(data)
end
def peekreg(reg)
_pokeiow(reg)
return _peekio()
end
def pokeregs(reg, buf, len)
def pokeregs(reg, buf, len)#0
_pokeiow(reg)
return pokedata(buf, len)
pokedata(buf, len)
end
def peekregs(reg, buf, len)
def peekregs(reg, buf, len)#0
_pokeiow(reg)
return peekdata(buf, len)
peekdata(buf, len)
end
def pokeregw(reg, dataw)
def pokeregw(reg, dataw)#0
_pokeiow(reg)
_pokeio(dataw.1)
return _pokeio(dataw.0)
_pokeio(dataw.0)
end
def peekregw(reg)
word dataw
@ -415,7 +419,7 @@ def wizSendUDP(wiz, ipdst, portdst, data, len)
splitlen = WIZ_TXSIZE - txrr
pokeregs(wizdata + txrr, data, splitlen)
pokeregs(wizdata, data + splitlen, len - splitlen)
else
else
pokeregs(wizdata + txrr, data, len)
fin
//
@ -480,14 +484,14 @@ end
//
def wizCloseUDP(wiz)
if isuge(wiz, @wizChannel) and isult(wiz, @wizChannel + MAX_WIZ_CHANNELS * t_channel)
//
// Clear notiications on this port
//
//
// Clear notiications on this port
//
if wiz->channel_proto == WIZ_PROTO_UDP
wiz->channel_proto = WIZ_PROTO_CLOSED
pokereg(wiz=>channel_regs + WIZ_SnCR, $10) // CLOSE
return 0
fin
return 0
fin
fin
//
// Invalid port
@ -508,8 +512,8 @@ def wizListenTCP(lclport, callback, param)
for i = 1 to MAX_WIZ_CHANNELS
if wiz->channel_proto == WIZ_PROTO_TCP and wiz->channel_state == TCP_STATE_LISTEN and wiz=>channel_lclport == lclport
break
fin
wiz = wiz + t_channel
fin
wiz = wiz + t_channel
next
if i > MAX_WIZ_CHANNELS
//
@ -519,8 +523,8 @@ def wizListenTCP(lclport, callback, param)
for i = 1 to MAX_WIZ_CHANNELS
if !wiz->channel_proto
break
fin
wiz = wiz + t_channel
fin
wiz = wiz + t_channel
next
if i > MAX_WIZ_CHANNELS
return 0
@ -670,10 +674,10 @@ end
def wizSetParam(wiz, param)
if wiz->channel_proto == WIZ_PROTO_UDP or wiz->channel_proto == WIZ_PROTO_TCP
//
// Update param on this port
//
wiz=>channel_recv_parm = param
return 0
// Update param on this port
//
wiz=>channel_recv_parm = param
return 0
fin
//
// Invalid port
@ -787,11 +791,11 @@ def wizServiceIP
fin
wiz = wiz + t_channel
next
if ir & $80
if ir & $80
//
// IP conflict
//
pokereg(WIZ_IR, $80)
// IP conflict
//
pokereg(WIZ_IR, $80)
fin
if ir & $40
//
@ -839,71 +843,74 @@ end
// Identify Uthernet II card and initialize
//
for slot = $90 to $F0 step $10
regdata = peekio(slot)
if (regdata & $E4) == $00
pokeio(slot, $03) // Try setting auto-increment indirect I/F
if peekio(slot) == $03
saveidx = peekiow(slot + 1)
peekio(slot + 3) // Dummy read to data register should increment index
if peekiow(slot + 1) == saveidx + 1
//
// Good chance this is it
//
pokeio(slot, $80) // RESET
regidx = slot + 1
regdata = slot + 3
_pokedata.1 = regdata
_peekdata.1 = regdata
pokeio(slot, $03) // Auto-increment indirect I/F + enable ping
//
// The following looks redundant, but it sets up the peek/poke locations
// for peekreg(s)/pokereg(s)
//
pokeiow(regidx, WIZ_MR)
pokeio(regdata, $03) // Auto-increment indirect I/F + enable ping
peekio(regdata)
//
// Initialize common registers
//
pokeregs(WIZ_SHAR, @wizMAC, 6) // MAC addr
pokeregw(WIZ_RTR, 5000) // Timeout period to 500ms
pokereg(WIZ_RMSR, $55) // 2K Rx memory/channel
pokereg(WIZ_TMSR, $55) // 2K Tx memory/channel
//
// Print settings
//
puts("Found Uthernet II in slot #")
putc('0' + ((slot - $80) >> 4))
putln
//
// Fill channel structure
//
saveidx = @wizChannel
for slot = 0 to 3
saveidx=>channel_regs = WIZ_SREGS + (WIZ_SSIZE * slot)
saveidx=>channel_txmem = WIZ_TXMEM + (WIZ_TXSIZE * slot)
saveidx=>channel_rxmem = WIZ_RXMEM + (WIZ_RXSIZE * slot)
saveidx = saveidx + t_channel
next
//
// Fill in Net class
//
iNet:serviceIP = @wizServiceIP
iNet:openUDP = @wizOpenUDP
iNet:sendUDP = @wizSendUDP
iNet:closeUDP = @wizCloseUDP
iNet:listenTCP = @wizListenTCP
iNet:connectTCP = @wizConnectTCP
iNet:sendTCP = @wizSendTCP
iNet:closeTCP = @wizCloseTCP
iNet:setInterfaceIP = @setWizIP
iNet:getInterfaceHA = @getWizHA
iNet:setCallback = @wizSetCallback
iNet:setParam = @wizSetParam
return modkeep
rom = ((slot & $70) << 4) | $C000
if rom=>$06 <> $3C86 or (slot == $0B or (rom->$05 <> $38 and rom->$07 <> $18)) // Skip slots with signature
regdata = peekio(slot)
if (regdata & $E4) == $00
pokeio(slot, $03) // Try setting auto-increment indirect I/F
if peekio(slot) == $03
saveidx = peekiow(slot + 1)
peekio(slot + 3) // Dummy read to data register should increment index
if peekiow(slot + 1) == saveidx + 1
//
// Good chance this is it
//
pokeio(slot, $80) // RESET
regidx = slot + 1
regdata = slot + 3
_pokedata.1 = regdata
_peekdata.1 = regdata
pokeio(slot, $03) // Auto-increment indirect I/F + enable ping
//
// The following looks redundant, but it sets up the peek/poke locations
// for peekreg(s)/pokereg(s)
//
pokeiow(regidx, WIZ_MR)
pokeio(regdata, $03) // Auto-increment indirect I/F + enable ping
peekio(regdata)
//
// Initialize common registers
//
pokeregs(WIZ_SHAR, @wizMAC, 6) // MAC addr
pokeregw(WIZ_RTR, 5000) // Timeout period to 500ms
pokereg(WIZ_RMSR, $55) // 2K Rx memory/channel
pokereg(WIZ_TMSR, $55) // 2K Tx memory/channel
//
// Print settings
//
puts("Found Uthernet II in slot #")
putc('0' + ((slot - $80) >> 4))
putln
//
// Fill channel structure
//
saveidx = @wizChannel
for slot = 0 to 3
saveidx=>channel_regs = WIZ_SREGS + (WIZ_SSIZE * slot)
saveidx=>channel_txmem = WIZ_TXMEM + (WIZ_TXSIZE * slot)
saveidx=>channel_rxmem = WIZ_RXMEM + (WIZ_RXSIZE * slot)
saveidx = saveidx + t_channel
next
//
// Fill in Net class
//
iNet:serviceIP = @wizServiceIP
iNet:openUDP = @wizOpenUDP
iNet:sendUDP = @wizSendUDP
iNet:closeUDP = @wizCloseUDP
iNet:listenTCP = @wizListenTCP
iNet:connectTCP = @wizConnectTCP
iNet:sendTCP = @wizSendTCP
iNet:closeTCP = @wizCloseTCP
iNet:setInterfaceIP = @setWizIP
iNet:getInterfaceHA = @getWizHA
iNet:setCallback = @wizSetCallback
iNet:setParam = @wizSetParam
return modkeep
fin
fin
pokeio(slot, regdata) // Restore register
fin
pokeio(slot, regdata) // Restore register
fin
next
//

10
src/libsrc/dhcp.pla
View File

@ -137,7 +137,7 @@ end
def recvDHCP(remip, remport, pkt, len, param)
word servopts, maskopts, gwopts, dnsopts
//putip(remip);putc(':');puti(remport);putln
//puts("recvDHCP: ");putip(remip);putc(':');puti(remport);putln
//dumpdhcp(pkt)
if pkt=>dhcp_xid:0 == $0201 and pkt=>dhcp_xid:2 == $0403
when pkt->dhcp_opts.[parseopts(@pkt->dhcp_opts, 53) + 2]
@ -155,10 +155,10 @@ def recvDHCP(remip, remport, pkt, len, param)
iNet:sendUDP(portDHCP, 0, DHCP_SERVER_PORT, @DHCP, @endDHCP - @DHCP)
break
is DHCP_ACK
optsOP.2 = DHCP_ACK
//
// Copy parameters to working copy
//
optsOP.2 = DHCP_ACK
memcpy(@localip, @pkt->dhcp_yourip, IP4ADR_SIZE)
maskopts = parseopts(@pkt->dhcp_opts, 1) + 2
if maskopts >= 0
@ -187,7 +187,7 @@ iNet:getInterfaceHA(@optsCID.3)
//
// Clear our local IP address
//
iNet:setInterfaceIP(@zeros,@ones, @zeros)
iNet:setInterfaceIP(@zeros, @ones, @zeros)
//
// Prepare to receive DHCP packets from a server
//
@ -212,11 +212,11 @@ repeat
break
fin
next
retry = retry + 1
retry++
until retry > 4 or optsOP.2 == DHCP_ACK
iNet:closeUDP(portDHCP)
iNet:setInterfaceIP(@localip, @localnet, @localgw)
puts("Apple II bound to:\n");putip(@localip);putc('/');putip(@localnet);putln
iNet:setDNS(@localdns)
//puts("DNS: ");putip(@localdns);putln
puts("DNS:");putip(@localdns);putln
done

12
src/libsrc/etherip.pla
View File

@ -52,7 +52,6 @@ const IP_PROTO_TCP = $06
//
// ICMP type/codes
//
const IP_PROTO_ICMP = 1
const ICMP_ECHO_REQST = 8
const ICMP_ECHO_REPLY = 0
//
@ -101,7 +100,7 @@ const ARP_REQST = $0100 // BE format
const ARP_REPLY = $0200 // BE format
struc t_arp
word arp_hw
word arp_proto
word arp_prot
byte arp_hlen
byte arp_plen
word arp_op
@ -155,8 +154,8 @@ struc t_notify
word notify_func
word notify_parm
end
byte[t_notify * MAX_UDP_NOTIFIES] portsUDP
byte[t_notify * MAX_TCP_NOTIFIES] portsTCP
byte[t_notify] portsUDP[MAX_UDP_NOTIFIES]
byte[t_notify] portsTCP[MAX_TCP_NOTIFIES]
//
// Service ICMP hook
//
@ -379,12 +378,14 @@ end
// Open TCP socket in SERVER mode
//
def etherListenTCP(lclport, callback, param)
puts("TCP/IP not yet implented for this hardware.\n")
return 0
end
//
// Open TCP socket in CLIENT mode
//
def etherConnectTCP(remip, remport, lclport, callback, param)
puts("TCP/IP not yet implented for this hardware.\n")
return 0
end
//
@ -500,7 +501,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
@ -586,7 +587,6 @@ def getEtherHA(ha)
if ha; memcpy(ha, @myMAC, MAC_SIZE); fin
return MAC_SIZE
end
//
// Fill in iNet class
//

63
src/libsrc/inet.pla
View File

@ -33,7 +33,7 @@ end
//
// External interface to net class. Must be first.
//
export byte[t_inet] iNet
res[t_inet] iNet
//
// List of loadable network device drivers
//
@ -54,12 +54,6 @@ def iNetSetDNS(ipptr)
return 0
end
//def putb(hexb)
// return call($FDDA, hexb, 0, 0, 0)
//end
//def puth(hex)
// return call($F941, hex >> 8, hex, 0, 0)
//end
//def dumpbytes(buf, len)
// word i
//
@ -87,14 +81,14 @@ def parseIP(ipstr, ipaddr)
endstr = ipstr + ^ipstr
for i = 0 to 3
ipstr = ipstr + 1
while ^ipstr >= '0' and ^ipstr <= '9' and ipstr <= endstr
ipaddr->[i] = ipaddr->[i] * 10 + ^ipstr - '0'
ipstr = ipstr + 1
loop
if ^ipstr <> '.' and ipstr < endstr
return 0
fin
while ^ipstr >= '0' and ^ipstr <= '9' and ipstr <= endstr
ipaddr->[i] = ipaddr->[i] * 10 + ^ipstr - '0'
ipstr = ipstr + 1
loop
if ^ipstr <> '.' and ipstr < endstr
return 0
fin
next
return i == 3
end
@ -105,11 +99,11 @@ def parseDomain(domstr, msgptr)
l = 0
for i = 1 to ^domstr
if domstr->[i] == '.'
msgptr->[l] = i - l - 1
l = i
else
msgptr->[i] = domstr->[i]
fin
msgptr->[l] = i - l - 1
l = i
else
msgptr->[i] = domstr->[i]
fin
next
msgptr->[l] = i - l - 1
msgptr = msgptr + i
@ -154,7 +148,7 @@ def recvDNS(remip, remport, pkt, len, ipaddr)
resptr = resptr + 8
//dumpbytes(resptr + 2, ^(resptr + 1))
resptr = resptr + 2 + ^(resptr + 1); putln
r = r - 1
r--
loop
fin
stateDNS = DNS_ANSWER
@ -171,7 +165,7 @@ def iNetResolve(namestr, ipaddr)
//
// Query Domain Name Server for address
//
dnspkt = heapmark // Use heap as working DNS query packet
dnspkt = heapalloc(^namestr + t_dnshdr + 8) // Use heap as working DNS query packet
msgptr = dnspkt
msgptr=>dnsID = $BEEF
msgptr=>dnsCode = $0001 // RD (Recursion Desired)
@ -181,9 +175,8 @@ def iNetResolve(namestr, ipaddr)
msgptr=>dnsArCount = 0
msgptr = parseDomain(namestr, msgptr + t_dnshdr)
msgptr=>0 = $0100 // BE TYPE = Address
msgptr=>2 = $0100 // BE CLASS = INternet
msgptr=>2 = $0100 // BE CLASS = Internet
msglen = msgptr - dnspkt + 4
heapalloc(msglen)
//
// Prepare to receive DNS answer from server
//
@ -204,29 +197,27 @@ def iNetResolve(namestr, ipaddr)
fin
return ipaddr=>0 <> 0 or ipaddr=>2 <> 0
end
//
// Initialze network stack
//
def iNetInit
//
// Look for net hardware
//
while ^driver
//puts(driver);putln
if cmdsys:modexec(driver) >= 0
break
//
// Get an IP address
//
cmdsys:modexec("DHCP")
iNet:resolveIP = @iNetResolve
return @iNet
fin
driver = driver + ^driver + 1
loop
if !^driver
return 0
fin
//
// Get an IP address
//
cmdsys:modexec("DHCP")
iNet:resolveIP = @iNetResolve
return @iNet
puts("No network adapters found.\n")
return NULL
end
//
// Fill iNet class
//

1633
src/libsrc/jit16core.pla
View File

File diff suppressed because it is too large Load Diff

38
src/libsrc/jitcore.pla
View File

@ -315,7 +315,7 @@ def compiler(defptr)#0
VX-- // DEX
if VY == j
^codeptr = $98; codeptr++ // TYA -> LDA #imm
else
*codeptr = $A9+(j<<8) // LDA #imm
codeptr = codeptr + 2
@ -944,7 +944,6 @@ def compiler(defptr)#0
is $7A // SAW
dest = *(bytecode+i+1)
i = i + 2
//puts("SAW $"); puth(dest)
if not A_IS_TOSL
*codeptr = $D0B5+(VX<<8) // LDA ESTKL,X
codeptr = codeptr + 2
@ -952,9 +951,10 @@ def compiler(defptr)#0
codeptr->0 = $8D // STA abs
codeptr=>1 = dest
if opcode == $78
//puts("SAB $"); puth(*(bytecode+i))
//puts("SAB $"); puth(dest)
codeptr = codeptr + 3
else
//puts("SAW $"); puth(dest)
codeptr=>3 = $C0B5+(VX<<8) // LDA ESTKH,X
codeptr->5 = $8D // STA abs+1
codeptr=>6 = dest+1
@ -967,7 +967,6 @@ def compiler(defptr)#0
is $7E // DAW
dest = *(bytecode+i+1)
i = i + 2
//puts("DAW $"); puth(*(bytecode+i))
if not A_IS_TOSL
*codeptr = $D0B5+(VX<<8) // LDA ESTKL,X
codeptr = codeptr + 2
@ -976,7 +975,7 @@ def compiler(defptr)#0
codeptr->0 = $8D // STA abs
codeptr=>1 = dest
if opcode == $7C
//puts("DAB $"); puth(*(bytecode+i))
//puts("DAB $"); puth(dest)
codeptr = codeptr + 3
if VY <> 0
*codeptr = $00A0 // LDY #$00
@ -986,6 +985,7 @@ def compiler(defptr)#0
*codeptr = $C094+(VX<<8) // STY ESTKH,X
codeptr = codeptr + 2
else
//puts("DAW $"); puth(dest)
codeptr=>3 = $C0B4+(VX<<8) // LDY ESTKH,X
codeptr->5 = $8C // STY abs+1
codeptr=>6 = dest+1
@ -1172,14 +1172,13 @@ def compiler(defptr)#0
codeptr=>6 = $C0F5//+(VX<<8) // SBC ESTKH
codeptr=>8 = $0250 // BVC +2
codeptr=>10 = $8049 // EOR #$80
codeptr=>12 = $0510 // BPL +5
codeptr=>14 = $E8E8 // INX; INX
codeptr->16 = $4C // JMP abs
codeptr=>17 = addrxlate=>[dest]
if not (codeptr->18 & $80) // Unresolved address list
addrxlate=>[dest] = codeptr + 17 - *jitcodeptr
codeptr=>12 = $0310 // BPL +3
codeptr->14 = $4C // JMP abs
codeptr=>15 = addrxlate=>[dest]
if not (codeptr->16 & $80) // Unresolved address list
addrxlate=>[dest] = codeptr + 15 - *jitcodeptr
fin
codeptr = codeptr + 19
codeptr = codeptr + 17
A_IS_TOSL = FALSE
break
is $A2 // BRLT - FOR/NEXT SPECIFIC TEST & BRANCH
@ -1200,14 +1199,13 @@ def compiler(defptr)#0
codeptr=>4 = $C0F5+$0100//+(VX<<8) // SBC ESTKH+1
codeptr=>6 = $0250 // BVC +2
codeptr=>8 = $8049 // EOR #$80
codeptr=>10 = $0510 // BPL +5
codeptr=>12 = $E8E8 // INX; INX
codeptr->14 = $4C // JMP abs
codeptr=>15 = addrxlate=>[dest]
if not (codeptr->16 & $80) // Unresolved address list
addrxlate=>[dest] = codeptr + 15 - *jitcodeptr
codeptr=>10 = $0310 // BPL +3
codeptr->12 = $4C // JMP abs
codeptr=>13 = addrxlate=>[dest]
if not (codeptr->14 & $80) // Unresolved address list
addrxlate=>[dest] = codeptr + 13 - *jitcodeptr
fin
codeptr = codeptr + 17
codeptr = codeptr + 15
A_IS_TOSL = FALSE
break
is $A4 // INCBRLE - FOR/NEXT SPECIFIC INC & TEST & BRANCH
@ -1259,7 +1257,6 @@ def compiler(defptr)#0
addrxlate=>[dest] = codeptr + 15 - *jitcodeptr
fin
codeptr = codeptr + 17
VX = VX + 2 // INX; INX
A_IS_TOSL = FALSE
break
is $A8 // DECBRGR - FOR/NEXT SPECIFIC DEC & TEST & BRANCH
@ -1321,7 +1318,6 @@ def compiler(defptr)#0
addrxlate=>[dest] = codeptr + 13 - *jitcodeptr
fin
codeptr = codeptr + 15
VX = VX + 2 // INX; INX
A_IS_TOSL = FALSE
break
is $AC // BRAND - LOGICAL AND SPECIFIC BRANCH

91
src/libsrc/lz4.pla Normal file
View File

@ -0,0 +1,91 @@
include "inc/cmdsys.plh"
asm incs
!SOURCE "vmsrc/plvmzp.inc"
end
//
// Always forward copy memory - important for overlapping match sequences
//
asm bcpy(dst, src, len)#0
INX
INX
INX
LDA ESTKL-3,X
ORA ESTKH-3,X
BEQ CPYEX
LDA ESTKL-1,X
STA DSTL
LDA ESTKH-1,X
STA DSTH
LDA ESTKL-2,X
STA SRCL
LDA ESTKH-2,X
STA SRCH
LDY ESTKL-3,X
BEQ CPYLP
INC ESTKH-3,X
LDY #$00
CPYLP LDA (SRC),Y
STA (DST),Y
INY
BNE +
INC DSTH
INC SRCH
+ DEC ESTKL-3,X
BNE CPYLP
DEC ESTKH-3,X
BNE CPYLP
CPYEX RTS
end
//
// Unpack LZ4 sequence into buffer, return unpacked length
//
export def lz4Unpack(seq, seqend, buff, buffend)
word data, len, match, i
byte token
data = buff
while isult(seq, seqend)
token = ^seq
seq++
len = token >> 4
if len
//
// Literal sequence
//
if len == 15
while ^seq == 255
len = len + 255
seq++
loop
len = len + ^seq
seq++
fin
if isuge(data + len, buffend); return 0; fin
bcpy(data, seq, len)
data = data + len
seq = seq + len
fin
len = token & $0F
if len or isult(seq, seqend)
//
// Match sequence
//
match = data - *seq
seq = seq + 2
len = len + 4
if len == 19 // $0F + 4
while ^seq == 255
len = len + 255
seq++
loop
len = len + ^seq
seq++
fin
if isuge(data + len, buffend); return 0; fin
bcpy(data, match, len)
data = data + len
fin
loop
return data - buff
end
done

5
src/libsrc/memmgr.pla
View File

@ -544,7 +544,7 @@ export def hmemNew(size)
//
// Allocate 3/4 of available heap on 128K machine, 1/2 on 64K machine
//
poolsize = ((@page - heapmark) >> 1) & $7FFF
poolsize = (heapavail >> 1) & $7FFF
if MACHID & $30 == $30
poolsize = poolsize + (poolsize >> 1)
fin
@ -666,7 +666,7 @@ end
// !!! Does this work on Apple ///???
//
sysbuf = $0800 // heapallocalign(1024, 8, 0)
initdata = heapmark // Use data at top of heap for initialization
initdata = heapalloc(t_initdata) // Use data on heap for initialization
initdata=>volparms.0 = 2
initdata=>volparms.1 = 0
initdata=>volparms:2 = sysbuf
@ -733,5 +733,6 @@ repeat
fin
until !initdata->filecnt
fileio:close(initdata->catref)
heaprelease(initdata)
//puts(@swapvol); putln
done

38
src/makefile
View File

@ -4,12 +4,12 @@ PLVM = plvm
PLVMZP_APL = vmsrc/apple/plvmzp.inc
PLVM01 = rel/apple/A1PLASMA\#060280
PLVM02 = rel/apple/PLASMA.SYSTEM\#FF2000
PLVMJIT = rel/apple/PLASMAJIT.SYSTEM\#FF2000
PLVM802 = rel/apple/PLASMA16.SYSTEM\#FF2000
PLVMJIT = rel/apple/PLVM.128\#FF2000
PLVM802 = rel/apple/PLVM16\#FF2000
PLVM03 = rel/apple/SOS.INTERP\#050000
SOSCMD = rel/apple/SOS.CMD\#FE1000
CMD = rel/apple/CMD\#061000
CMDJIT = rel/apple/CMDJIT\#061000
CMDJIT = rel/apple/CMD128\#061000
PLVMZP_C64 = vmsrc/c64/plvmzp.inc
PLVMC64 = rel/c64/PLASMA
ED = rel/ED\#FE1000
@ -36,12 +36,16 @@ SNDSEQ = rel/apple/SNDSEQ\#FE1000
PLAYSEQ = rel/apple/PLAYSEQ\#FE1000
SANITY = rel/SANITY\#FE1000
RPNCALC = rel/RPNCALC\#FE1000
LZ4 = rel/LZ4\#FE1000
LZ4CAT = rel/LZ4CAT\#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
@ -81,7 +85,7 @@ TXTTYPE = .TXT
#SYSTYPE = \#FF2000
#TXTTYPE = \#040000
apple: $(PLVMZP_APL) $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVMJIT) $(PLVM802) $(PLVM03) $(CMD) $(CMDJIT) $(JIT) $(JIT16) $(JITUNE) $(SOSCMD) $(PLASMAPLASM) $(CODEOPT) $(ARGS) $(MEMMGR) $(MEMTEST) $(FIBER) $(FIBERTEST) $(LONGJMP) $(ED) $(MON) $(SOS) $(ROD) $(SIEVE) $(UTHERNET2) $(UTHERNET) $(ETHERIP) $(INET) $(DHCP) $(HTTPD) $(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)
apple: $(PLVMZP_APL) $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVMJIT) $(PLVM802) $(PLVM03) $(CMD) $(CMDJIT) $(JIT) $(JIT16) $(JITUNE) $(SOSCMD) $(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) $(LZ4) $(LZ4CAT) $(RPNCALC) $(SNDSEQ) $(PLAYSEQ)
-rm vmsrc/plvmzp.inc
c64: $(PLVMZP_C64) $(PLASM) $(PLVM) $(PLVMC64)
@ -232,7 +236,7 @@ hello: samplesrc/hello.pla $(PLVM) $(PLASM)
acme --setpc 4094 -o $(HELLO) samplesrc/hello.a
./$(PLVM) HELLO
$(ROD): samplesrc/rod.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMO < samplesrc/rod.pla > samplesrc/rod.a
./$(PLASM) -AMOW < samplesrc/rod.pla > samplesrc/rod.a
acme --setpc 4094 -o $(ROD) samplesrc/rod.a
$(SIEVE): samplesrc/sieve.pla $(PLVM02) $(PLASM)
@ -255,6 +259,14 @@ $(SANITY): samplesrc/sanity.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < samplesrc/sanity.pla > samplesrc/sanity.a
acme --setpc 4094 -o $(SANITY) samplesrc/sanity.a
$(LZ4): libsrc/lz4.pla $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < libsrc/lz4.pla > libsrc/lz4.a
acme --setpc 4094 -o $(LZ4) libsrc/lz4.a
$(LZ4CAT): samplesrc/lz4cat.pla inc/lz4.plh $(PLVM02) $(PLASM)
./$(PLASM) -AMOW < samplesrc/lz4cat.pla > samplesrc/lz4cat.a
acme --setpc 4094 -o $(LZ4CAT) samplesrc/lz4cat.a
$(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
@ -275,6 +287,14 @@ $(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
@ -364,19 +384,19 @@ $(MON): samplesrc/mon.pla $(PLVM02) $(PLASM)
acme --setpc 4094 -o $(MON) samplesrc/mon.a
$(SOS): libsrc/apple/sos.pla $(PLVM03) $(PLASM)
./$(PLASM) -AMO < libsrc/apple/sos.pla > libsrc/apple/sos.a
./$(PLASM) -AMOW < libsrc/apple/sos.pla > libsrc/apple/sos.a
acme --setpc 4094 -o $(SOS) libsrc/apple/sos.a
$(JIT): libsrc/apple/jit.pla libsrc/jitcore.pla $(PLVMJIT) $(PLASM)
./$(PLASM) -AMO < libsrc/apple/jit.pla > libsrc/apple/jit.a
./$(PLASM) -AMOW < libsrc/apple/jit.pla > libsrc/apple/jit.a
acme --setpc 4094 -o $(JIT) libsrc/apple/jit.a
$(JIT16): libsrc/apple/jit16.pla libsrc/jit16core.pla $(PLVMJIT) $(PLASM)
./$(PLASM) -AMO < libsrc/apple/jit16.pla > libsrc/apple/jit16.a
./$(PLASM) -AMOW < libsrc/apple/jit16.pla > libsrc/apple/jit16.a
acme --setpc 4094 -o $(JIT16) libsrc/apple/jit16.a
$(JITUNE): libsrc/apple/jitune.pla $(PLVMJIT) $(PLASM)
./$(PLASM) -AMO < libsrc/apple/jitune.pla > libsrc/apple/jitune.a
./$(PLASM) -AMOW < libsrc/apple/jitune.pla > libsrc/apple/jitune.a
acme --setpc 4094 -o $(JITUNE) libsrc/apple/jitune.a

59
src/mkrel
View File

@ -1,47 +1,60 @@
cp rel/apple/CMD#061000 prodos/CMD.BIN
cp rel/apple/CMDJIT#061000 prodos/CMDJIT.BIN
cp rel/apple/CMD128#061000 prodos/CMD128.BIN
cp rel/apple/PLASMA.SYSTEM#FF2000 prodos/PLASMA.SYSTEM.SYS
cp rel/apple/PLASMAJIT.SYSTEM#FF2000 prodos/PLIJIT.SYSTEM.SYS
cp rel/apple/PLASMA16.SYSTEM#FF2000 prodos/PLASMA16.SYSTEM.SYS
cp rel/apple/SOS.INTERP#050000 prodos/SOS.INTERP.\$05
cp rel/apple/SOS.CMD#FE1000 prodos/SOS.CMD.REL
cp rel/apple/PLVM.128#FF2000 prodos/PLVM.128.SYS
cp rel/apple/PLVM16#FF2000 prodos/PLVM16.SYS
cp ../doc/Editor.md prodos/EDITOR.README.TXT
rm -rf prodos/sys
mkdir prodos/sys
cp rel/ARGS#FE1000 prodos/sys/ARGS.REL
cp rel/apple/FILEIO#FE1000 prodos/sys/FILEIO.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/ARGS#FE1000 prodos/sys/ARGS.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/INET#FE1000 prodos/sys/INET.REL
cp rel/DHCP#FE1000 prodos/sys/DHCP.REL
cp rel/ETHERIP#FE1000 prodos/sys/ETHERIP.REL
cp rel/apple/MOUSE#FE1000 prodos/sys/MOUSE.REL
cp rel/apple/UTHERNET2#FE1000 prodos/sys/UTHERNET2.REL
cp rel/apple/UTHERNET#FE1000 prodos/sys/UTHERNET.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/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 rel/apple/JIT#FE1000 prodos/sys/JIT.REL
cp rel/apple/JIT16#FE1000 prodos/sys/JIT16.REL
cp rel/apple/JITUNE#FE1000 prodos/sys/JITUNE.REL
cp ../sysfiles/FP6502.CODE#060000 prodos/sys/FP6502.CODE.BIN
cp ../sysfiles/ELEMS.CODE#060000 prodos/sys/ELEMS.CODE.BIN
cp rel/LZ4#FE1000 prodos/sys/LZ4.REL
#cp rel/FPSTR#FE1000 prodos/sys/FPSTR.REL
#cp rel/FPU#FE1000 prodos/sys/FPU.REL
#cp rel/SANE#FE1000 prodos/sys/SANE.REL
#cp ../sysfiles/FP6502.CODE#060000 prodos/sys/FP6502.CODE.BIN
#cp ../sysfiles/ELEMS.CODE#060000 prodos/sys/ELEMS.CODE.BIN
rm -rf prodos/fpsos
mkdir prodos/fpsos
cp rel/apple/SOS.INTERP#050000 prodos/fpsos/SOS.INTERP.\$05
cp rel/apple/SOS.CMD#FE1000 prodos/fpsos/SOS.CMD.REL
mkdir prodos/fpsos/sys
cp rel/apple/SOS#FE1000 prodos/fpsos/sys/SOS.REL
cp rel/apple/GRAFIX#FE1000 prodos/fpsos/sys/GRAFIX.REL
cp rel/FPSTR#FE1000 prodos/fpsos/sys/FPSTR.REL
cp rel/FPU#FE1000 prodos/fpsos/sys/FPU.REL
cp rel/SANE#FE1000 prodos/fpsos/sys/SANE.REL
cp ../sysfiles/FP6502.CODE#060000 prodos/fpsos/sys/FP6502.CODE.BIN
cp ../sysfiles/ELEMS.CODE#060000 prodos/fpsos/sys/ELEMS.CODE.BIN
rm -rf prodos/demos
mkdir prodos/demos
cp rel/apple/DGRTEST#FE1000 prodos/demos/DGRTEST.REL
cp rel/RPNCALC#FE1000 prodos/demos/RPNCALC.REL
cp rel/LZ4CAT#FE1000 prodos/demos/LZ4CAT.REL
cp rel/ROD#FE1000 prodos/demos/ROD.REL
mkdir prodos/demos/rogue
@ -63,6 +76,7 @@ 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 rel/TFTPD#FE1000 prodos/demos/net/TFTPD.REL
cp rel/HTTPD#FE1000 prodos/demos/net/HTTPD.REL
cp samplesrc/index.html prodos/demos/net/INDEX.HTML.TXT
@ -79,6 +93,7 @@ cp samplesrc/dgrtest.pla prodos/bld/DGRTEST.PLA.TXT
cp samplesrc/hello.pla prodos/bld/HELLO.PLA.TXT
cp samplesrc/hgr1test.pla prodos/bld/HGR1TEST.PLA.TXT
cp samplesrc/fibertest.pla prodos/bld/FIBERTEST.PLA.TXT
cp samplesrc/mousetest.pla prodos/bld/MOUSETEST.PLA.TXT
cp samplesrc/mon.pla prodos/bld/MON.PLA.TXT
cp samplesrc/memtest.pla prodos/bld/MEMTEST.PLA.TXT
cp samplesrc/rod.pla prodos/bld/ROD.PLA.TXT
@ -89,10 +104,8 @@ cp samplesrc/playseq.pla prodos/bld/PLAYSEQ.PLA.TXT
cp samplesrc/rpncalc.pla prodos/bld/RPNCALC.PLA.TXT
cp samplesrc/httpd.pla prodos/bld/HTTPD.PLA.TXT
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/lz4cat.pla prodos/bld/LZ4CAT.PLA.TXT
mkdir prodos/bld/inc
cp inc/args.plh prodos/bld/inc/ARGS.PLH.TXT
@ -103,6 +116,7 @@ cp inc/fiber.plh prodos/bld/inc/FIBER.PLH.TXT
cp inc/fileio.plh prodos/bld/inc/FILEIO.PLH.TXT
cp inc/fpstr.plh prodos/bld/inc/FPSTR.PLH.TXT
cp inc/fpu.plh prodos/bld/inc/FPU.PLH.TXT
cp inc/mouse.plh prodos/bld/inc/MOUSE.PLH.TXT
cp inc/inet.plh prodos/bld/inc/INET.PLH.TXT
cp inc/longjmp.plh prodos/bld/inc/LONGJMP.PLH.TXT
cp inc/memmgr.plh prodos/bld/inc/MEMMGR.PLH.TXT
@ -114,4 +128,5 @@ 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 inc/grafix.plh prodos/bld/inc/GRAFIX.PLH.TXT
cp inc/lz4.plh prodos/bld/inc/LZ4.PLH.TXT
cp vmsrc/apple/plvmzp.inc prodos/bld/inc/PLVMZP.INC.TXT

107
src/samplesrc/lz4cat.pla Normal file
View File

@ -0,0 +1,107 @@
include "inc/cmdsys.plh"
include "inc/args.plh"
include "inc/fileio.plh"
include "inc/lz4.plh"
struc t_header
word magic[2]
byte FLG
byte BD
end
word arg
byte ref
def lz4ReadBlock(flags)#2
word size[2], block, data, len
len = fileio:read(ref, @size, 4)
if len <> 4 or size[0] == 0 or size[1] & $7FFF
return NULL, 0
fin
block = heapalloc(size[0])
if block
len = fileio:read(ref, block, size[0])
if len <> size[0]
heaprelease(block)
return NULL, 0
fin
else
return NULL, 0
fin
if size[1] & $8000
//
// Uncompressed block
//
data = block
else
//
// Decompress block
//
len = heapavail - 256 // Allocate almost entire heap to decompress into
data = heapalloc(len)
if data
len = lz4Unpack(block, block + size[0], data, data + len)
memcpy(block, data, len)
data = block
else
len = 0
fin
heaprelease(block + len)
fin
if flags & $10 // Block Checksum
fileio:read(ref, @size, 4)
fin
return data, len
end
def lz4ReadFrame#0
word data, len
byte header[t_header], opt
fileio:read(ref, @header, t_header)
if header:magic[1] <> $184D or header:magic[0] <> $2204
puts("Not LZ4 file.\n")
return
fin
if header.FLG & $C0 <> $40
puts("Wrong LZ4 version.\n")
return
fin
if header.BD & $70 <> $40
puts("Not 64K block size.\n")
return
fin
opt = 1
if header.FLG & $08 // Content Size
opt = opt + 8
fin
if header.FLG & $01 // Dictionary ID
opt = opt + 4
fin
fileio:read(ref, heapmark, opt) // Read rest of header and throw away
repeat
data, len = lz4ReadBlock(header.FLG)
if len
while len
putc(^data <> $0A ?? ^data :: $0D)
data++
len--
loop
heaprelease(data)
fin
until not data
if header.FLG & $04 // Content Checksun
fileio:read(ref, heapmark, 4)
fin
end
arg = argNext(argFirst)
if ^arg
ref = fileio:open(arg)
if ref
lz4ReadFrame
fileio:close(ref)
else
puts("File not found.\n")
fin
fin
done

22
src/samplesrc/mousetest.pla Normal file
View File

@ -0,0 +1,22 @@
include "inc/cmdsys.plh"
include "inc/conio.plh"
include "inc/mouse.plh"
var count
var xPos, yPos, bttn
Mouse:clampMouse(0, 39, 0, 23)
Mouse:setMouse(VBL_INT_ENABLE|MOVE_INT_ENABLE|BUTTON_INT_ENABLE|MOUSE_ENABLE)
while ^$C000 < 128
if Mouse:chkMouse()
conio:gotoxy(xPos, yPos); putc(' ')
xPos, yPos, bttn = Mouse:readMouse()#3
conio:gotoxy(xPos, yPos); putc(bttn & BUTTON_DOWN ?? '+' :: '^')
fin
if Mouse:chkVBL()
^$400++
fin
loop
getc
Mouse:detachMouse()
done

5
src/samplesrc/rod.pla
View File

@ -3,7 +3,7 @@ include "inc/conio.plh"
//
// Rod's Colors
//
def rod
def rod#0
byte i, j, k, w, fmi, fmk, color
while TRUE
@ -24,7 +24,8 @@ def rod
conio:grplot(i, fmk)
conio:grplot(fmk, i)
if conio:keypressed()
return getc
getc
return
fin
next
next

503
src/samplesrc/tftpd.pla Normal file
View File

@ -0,0 +1,503 @@
//
// TFTP Daemon
//
include "inc/cmdsys.plh"
include "inc/inet.plh"
include "inc/fileio.plh"
include "inc/conio.plh"
//
// TFTP values
//
const TFTP_PORT = 69
const TID_INC = $0010
const RRQ = $0100
const WRQ = $0200
const DATAPKT = $0300
const ACKPKT = $0400
const ERRPKT = $0500
struc t_errPkt
word errOp
word errCode
byte errStr[]
byte errStrNull
end
struc t_ackPkt
word ackOp
word ackBlock
end
struc t_datPkt
word datOp
word datBlock
byte datBytes[]
end
res[t_errPkt] tftpError = $00, $05, $00, $00, $00
res[t_ackPkt] tftpAck = $00, $04, $00, $00
//
// Current file operations
//
byte ref, type, , netscii, filename[256]
word aux, block
word buff, TID = $1001
word portTFTP, portTID
//
// Swap bytes in word
//
asm swab(val)
!SOURCE "vmsrc/plvmzp.inc"
LDA ESTKL,X
LDY ESTKH,X
STA ESTKH,X
STY ESTKL,X
RTS
end
//
// Translate 'in' value to 'out' value
//
asm xlat(in, out, buf, len)#0
INX
INX
INX
INX
LDA ESTKL-4,X
ORA ESTKH-4,X
BEQ XLATEX
LDA ESTKL-3,X
STA SRCL
LDA ESTKH-3,X
STA SRCH
LDA ESTKL-1,X
LDY ESTKL-4,X
BEQ XLATLP
INC ESTKH-4,X
LDY #$00
XLATLP CMP (SRC),Y
BNE +
LDA ESTKL-2,X
STA (SRC),Y
LDA ESTKL-1,X
+ INY
BNE +
INC DSTH
INC SRCH
+ DEC ESTKL-4,X
BNE XLATLP
DEC ESTKH-4,X
BNE XLATLP
XLATEX RTS
end
//
// Convert byte to two hex chars
//
def btoh(cptr, b)#0
byte h
h = ((b >> 4) & $0F) + '0'
if h > '9'
h = h + 7
fin
^cptr = h
cptr++
h = (b & $0F) + '0'
if h > '9'
h = h + 7
fin
^cptr = h
end
def hexByte(hexChars)
byte lo, hi
lo = toupper(^(hexChars + 1)) - '0'
if lo > 9
lo = lo - 7
fin
hi = toupper(^hexChars) - '0'
if hi > 9
hi = hi - 7
fin
return (hi << 4) | lo
end
def hexWord(hexChars)
return (hexByte(hexChars) << 8) | hexByte(hexChars + 2)
end
def mkProName(netName, proName)#3
byte n, l, ascii, proType
word proAux
proType = $02 // default to BIN
proAux = $0000 // default to 0
//
// Check for CiderPress style extension
//
for l = 0 to 255
if netName->[l] == 0; break; fin
next
ascii = toupper(netName->[l + 1]) == 'N' // Netscii mode
if l > 7 and ^(netName + l - 7) == '#'
proType = hexByte(netName + l - 6)
proAux = hexWord(netName + l - 4)
l = l - 7
fin
memcpy(proName + 1, netName, l)
^proName = l
return ascii, proType, proAux
end
def mkNetName(proName, netName)
word l, n
byte fileinfo[t_fileinfo]
if !fileio:getfileinfo(proName, @fileinfo)
//
// Scan backward looking for dir seperator
//
l = ^proName
for n = l downto 1
if ^(proName + n) == '/'
break
fin
next
memcpy(netName + 1, proName + 1 + n, l - n)
^netName = l - n + 7
//
// Build CiderPress style extension
//
n = netName + ^netName - 6
^n = '#'
btoh(n + 1, fileinfo.file_type)
btoh(n + 3, fileinfo.aux_type.1)
btoh(n + 5, fileinfo.aux_type)
else
//
// Error getting info on file
//
puts("Error reading "); puts(proName); putln
return -1
fin
return 0
end
def readUDP(ipsrc, portsrc, data, len, param)
word err
err = 0
when *data
is $0500 // Error
err = *data
is $0400 // Ack
if swab(data=>ackBlock) <> block
puts("RRQ: Out-of-sequence block\n")
err = $0800 // Out-of-sequence block
break
fin
if param == 512 // Size of initial read
param = fileio:read(ref, buff+datBytes, 512)
if type == $04 // TXT type
xlat($0D, $0A, buff+datBytes, param)
fin
block++
buff=>datBlock = swab(block)
iNet:sendUDP(portTID, ipsrc, portsrc, buff, t_datPkt + param)
fin
if err
tftpError:errCode = err
iNet:sendUDP(portTID, ipsrc, portsrc, @tftpError, t_errPkt)
fin
if param < 512 or err
//
// All done
//
iNet:closeUDP(portTID)
fileio:close(ref)
ref = 0
fin
break
otherwise
puts("TFTP: RRQ Unexpected packet opcode: $"); puth(*data); putln
wend
return 0
end
def writeUDP(ipsrc, portsrc, data, len, param)
word err
err = 0
when *data
is $0300 // Data packet
if swab(data=>datBlock) <> block
puts("WRQ: Out-of-sequence block\n")
err = $0800 // Out-of-sequence block
break
fin
len = len - t_datPkt
if type == $04 // TXT type
xlat($0A, $0D, data+datBytes, len)
fin
if fileio:write(ref, data+datBytes, len) <> len
puts("WRQ: File write error\n")
tftpError:errCode = $0300 // Disk full error
break
fin
if not err
tftpAck:ackBlock = swab(block)
block++
iNet:sendUDP(portTID, ipsrc, portsrc, @tftpAck, t_ackPkt)
else
tftpError:errCode = err
iNet:sendUDP(portTID, ipsrc, portsrc, @tftpError, t_errPkt)
fin
if len < 512 or err
//
// All done
//
iNet:closeUDP(portTID)
fileio:close(ref)
ref = 0
fin
break
otherwise
puts("WRQ: Unexpected packet opcode: $"); puth(*data); putln
wend
return 0
end
def servUDP(ipsrc, portsrc, data, len, param)
byte info[24]
when *data
is RRQ // Read request
//
// Initiate file read
//
if ref
//
// File already open and active
//
tftpError:errCode = $0300 // Allocation exceeded
iNet:sendUDP(portTFTP, ipsrc, portsrc, @tftpError, t_errPkt)
return 0
fin
//
// Extract filename
//
netscii, type, aux = mkProName(data + 2, @filename)
ref = fileio:open(@filename)
if not ref
puts("Error opening file: "); puts(@filename)
puts(", Error: "); putb(perr); putln
tftpError:errCode = $0100 // File not found
iNet:sendUDP(portTFTP, ipsrc, portsrc, @tftpError, t_errPkt)
return 0
fin
info.0 = $0A
info:1 = @filename
syscall($C4, @info)
type = info.4
puts("Reading file: "); puts(@filename); putln
TID = (TID + TID_INC) | $1000
block = 1
buff=>datBlock = swab(block)
len = fileio:read(ref, buff+datBytes, 512)
if type == $04 // TXT type
xlat($0D, $0A, buff+datBytes, 512)
fin
portTID = iNet:openUDP(TID, @readUDP, len)
iNet:sendUDP(portTID, ipsrc, portsrc, buff, t_datPkt + len)
break
is WRQ // Write request
//
// Initiate file write
//
if ref
//
// File already open and active
//
tftpError:errCode = $0300 // Allocation exceeded
iNet:sendUDP(portTFTP, ipsrc, portsrc, @tftpError, t_errPkt)
return 0
fin
//
// Extract filename
//
netscii, type, aux = mkProName(data + 2, @filename)
fileio:destroy(@filename)
if fileio:create(@filename, type, aux)
puts("Create file error: "); putb(perr); putln
fin
ref = fileio:open(@filename)
if not ref
puts("Error opening file: "); puts(@filename)
puts(", Error: "); putb(perr); putln
tftpError:errCode = $0200 // Access violation
iNet:sendUDP(portTFTP, ipsrc, portsrc, @tftpError, t_errPkt)
return 0
fin
puts("Writing file: "); puts(@filename); putln
TID = (TID + TID_INC) | $1000
block = 1
tftpAck:ackBlock = 0
portTID = iNet:openUDP(TID, @writeUDP, 0)
iNet:sendUDP(portTID, ipsrc, portsrc, @tftpAck, t_ackPkt)
break
otherwise
puts("TFTP: Server Unexpected packet opcode: $"); puth(*data); putln
wend
return 0
end
if !iNet:initIP()
return -1
fin
puts("TFTP Server Version 0.1\n")
portTFTP = iNet:openUDP(TFTP_PORT, @servUDP, 0)
//
// Alloc aligned file/io buffers
//
buff = heapalloc(t_datPkt + 512)
buff=>datOp = $0300 // Data op
//
// Service IP
//
repeat
iNet:serviceIP()
until conio:keypressed()
done
Experpts from: RFC 1350, TFTP Revision 2, July 1992
TFTP Formats
Type Op # Format without header
2 bytes string 1 byte string 1 byte
-----------------------------------------------
RRQ/ | 01/02 | Filename | 0 | Mode | 0 |
WRQ -----------------------------------------------
2 bytes 2 bytes n bytes
---------------------------------
DATA | 03 | Block # | Data |
---------------------------------
2 bytes 2 bytes
-------------------
ACK | 04 | Block # |
--------------------
2 bytes 2 bytes string 1 byte
----------------------------------------
ERROR | 05 | ErrorCode | ErrMsg | 0 |
----------------------------------------
Initial Connection Protocol for reading a file
1. Host A sends a "RRQ" to host B with source= A's TID,
destination= 69.
2. Host B sends a "DATA" (with block number= 1) to host A with
source= B's TID, destination= A's TID.
Error Codes
Value Meaning
0 Not defined, see error message (if any).
1 File not found.
2 Access violation.
3 Disk full or allocation exceeded.
4 Illegal TFTP operation.
5 Unknown transfer ID.
6 File already exists.
7 No such user.
Internet User Datagram Header [2]
(This has been included only for convenience. TFTP need not be
implemented on top of the Internet User Datagram Protocol.)
Format
0 1 2 3
0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
| Source Port | Destination Port |
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
| Length | Checksum |
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
Values of Fields
Source Port Picked by originator of packet.
Dest. Port Picked by destination machine (69 for RRQ or WRQ).
Length Number of bytes in UDP packet, including UDP header.
Checksum Reference 2 describes rules for computing checksum.
(The implementor of this should be sure that the
correct algorithm is used here.)
Field contains zero if unused.
Note: TFTP passes transfer identifiers (TID's) to the Internet User
Datagram protocol to be used as the source and destination ports.
A transfer is established by sending a request (WRQ to write onto a
foreign file system, or RRQ to read from it), and receiving a
positive reply, an acknowledgment packet for write, or the first data
packet for read. In general an acknowledgment packet will contain
the block number of the data packet being acknowledged. Each data
packet has associated with it a block number; block numbers are
consecutive and begin with one. Since the positive response to a
write request is an acknowledgment packet, in this special case the
block number will be zero. (Normally, since an acknowledgment packet
is acknowledging a data packet, the acknowledgment packet will
contain the block number of the data packet being acknowledged.) If
the reply is an error packet, then the request has been denied.
In order to create a connection, each end of the connection chooses a
TID for itself, to be used for the duration of that connection. The
TID's chosen for a connection should be randomly chosen, so that the
probability that the same number is chosen twice in immediate
succession is very low. Every packet has associated with it the two
TID's of the ends of the connection, the source TID and the
destination TID. These TID's are handed to the supporting UDP (or
other datagram protocol) as the source and destination ports. A
requesting host chooses its source TID as described above, and sends
its initial request to the known TID 69 decimal (105 octal) on the
serving host. The response to the request, under normal operation,
uses a TID chosen by the server as its source TID and the TID chosen
for the previous message by the requestor as its destination TID.
The two chosen TID's are then used for the remainder of the transfer.
As an example, the following shows the steps used to establish a
connection to write a file. Note that WRQ, ACK, and DATA are the
names of the write request, acknowledgment, and data types of packets
respectively. The appendix contains a similar example for reading a
file.
1. Host A sends a "WRQ" to host B with source= A's TID,
destination= 69.
2. Host B sends a "ACK" (with block number= 0) to host A with
source= B's TID, destination= A's TID.
At this point the connection has been established and the first data
packet can be sent by Host A with a sequence number of 1. In the
next step, and in all succeeding steps, the hosts should make sure
that the source TID matches the value that was agreed on in steps 1
and 2. If a source TID does not match, the packet should be
discarded as erroneously sent from somewhere else. An error packet
should be sent to the source of the incorrect packet, while not
disturbing the transfer. This can be done only if the TFTP in fact
receives a packet with an incorrect TID. If the supporting protocols
do not allow it, this particular error condition will not arise.
The following example demonstrates a correct operation of the
protocol in which the above situation can occur. Host A sends a
request to host B. Somewhere in the network, the request packet is
duplicated, and as a result two acknowledgments are returned to host
A, with different TID's chosen on host B in response to the two
requests. When the first response arrives, host A continues the
connection. When the second response to the request arrives, it
should be rejected, but there is no reason to terminate the first
connection. Therefore, if different TID's are chosen for the two
connections on host B and host A checks the source TID's of the
messages it receives, the first connection can be maintained while
the second is rejected by returning an error packet.

33
src/tftpbld Executable file
View File

@ -0,0 +1,33 @@
#!/bin/bash
# Build tools
echo "BLD/PLASM"; atftp $1 --put -l rel/PLASM#FE1000 -r $2/BLD/PLASM#FE1000
echo "BLD/CODEOPT"; atftp $1 --put -l rel/CODEOPT#FE1000 -r $2/BLD/CODEOPT#FE1000
#Build incs
echo "BLD/INC/ARGS.PLH"; atftp $1 --put -l inc/args.plh -r $2/BLD/INC/ARGS.PLH#040000
echo "BLD/INC/CMDSYS.PLH"; atftp $1 --put -l inc/cmdsys.plh -r $2/BLD/INC/CMDSYS.PLH#040000
echo "BLD/INC/CONIO.PLH"; atftp $1 --put -l inc/conio.plh -r $2/BLD/INC/CONIO.PLH#040000
echo "BLD/INC/DGR.PLH"; atftp $1 --put -l inc/dgr.plh -r $2/BLD/INC/DGR.PLH#040000
echo "BLD/INC/FIBER.PLH"; atftp $1 --put -l inc/fiber.plh -r $2/BLD/INC/FIBER.PLH#040000
echo "BLD/INC/FILEIO.PLH"; atftp $1 --put -l inc/fileio.plh -r $2/BLD/INC/FILEIO.PLH#040000
echo "BLD/INC/FPSTR.PLH"; atftp $1 --put -l inc/fpstr.plh -r $2/BLD/INC/FPSTR.PLH#040000
echo "BLD/INC/FPU.PLH"; atftp $1 --put -l inc/fpu.plh -r $2/BLD/INC/FPU.PLH#040000
echo "BLD/INC/GRAFIX.PLH"; atftp $1 --put -l inc/grafix.plh -r $2/BLD/INC/GRAFIX.PLH#040000
echo "BLD/INC/INET.PLH"; atftp $1 --put -l inc/inet.plh -r $2/BLD/INC/INET.PLH#040000
echo "BLD/INC/JOYBUZZ.PLH"; atftp $1 --put -l inc/joybuzz.plh -r $2/BLD/INC/JOYBUZZ.PLH#040000
echo "BLD/INC/LONGJUMP.PLH"; atftp $1 --put -l inc/longjmp.plh -r $2/BLD/INC/LONGJUMP.PLH#040000
echo "BLD/INC/LZ4.PLH"; atftp $1 --put -l inc/lz4.plh -r $2/BLD/INC/LZ4.PLH#040000
echo "BLD/INC/MEMMGR.PLH"; atftp $1 --put -l inc/memmgr.plh -r $2/BLD/INC/MEMMGR.PLH#040000
echo "BLD/INC/MOUSE.PLH"; atftp $1 --put -l inc/mouse.plh -r $2/BLD/INC/MOUSE.PLH#040000
echo "BLD/INC/PORTIO.PLH"; atftp $1 --put -l inc/portio.plh -r $2/BLD/INC/PORTIO.PLH#040000
echo "BLD/INC/SANE.PLH"; atftp $1 --put -l inc/sane.plh -r $2/BLD/INC/SANE.PLH#040000
echo "BLD/INC/SDFAT.PLH"; atftp $1 --put -l inc/sdfat.plh -r $2/BLD/INC/SDFAT.PLH#040000
echo "BLD/INC/SNDSEQ.PLH"; atftp $1 --put -l inc/sndseq.plh -r $2/BLD/INC/SNDSEQ.PLH#040000
echo "BLD/INC/SPIPORT.PLH"; atftp $1 --put -l inc/spiport.plh -r $2/BLD/INC/SPIPORT.PLH#040000
echo "BLD/INC/TESTLIB.PLH"; atftp $1 --put -l inc/testlib.plh -r $2/BLD/INC/TESTLIB.PLH#040000
# Sample source
echo "BLD/MOUSETEST.PLA"; atftp $1 --put -l samplesrc/mousetest.pla -r $2/BLD/MOUSETEST.PLA#040000
echo "BLD/HTTPD.PLA"; atftp $1 --put -l samplesrc/httpd.pla -r $2/BLD/HTTPD.PLA#040000
echo "BLD/LZ4CAT.PLA"; atftp $1 --put -l samplesrc/lz4cat.pla -r $2/BLD/LZ4CAT.PLA#040000

4
src/tftpdemos Executable file
View File

@ -0,0 +1,4 @@
#!/bin/bash
# Net demos
echo "NET/TFTPD"; atftp $1 --put -l rel/TFTPD#FE1000 -r $2/DEMOS/NET/TFTPD#FE1000

36
src/tftpsys Executable file
View File

@ -0,0 +1,36 @@
#!/bin/bash
# Core VM, CMDSYS, JITC files
echo "PLASMA.SYSTEM"; atftp $1 --put -l rel/apple/PLASMA.SYSTEM#FF2000 -r $2/PLASMA.SYSTEM#FF2000
echo "PLVM.128"; atftp $1 --put -l rel/apple/PLVM.128#FF2000 -r $2/PLVM.128#FF2000
echo "PLVM16"; atftp $1 --put -l rel/apple/PLVM16#FF2000 -r $2/PLVM16#FF2000
echo "CMD"; atftp $1 --put -l rel/apple/CMD#061000 -r $2/CMD#061000
echo "CMD128"; atftp $1 --put -l rel/apple/CMD128#061000 -r $2/CMD128#061000
echo "SYS/JIT"; atftp $1 --put -l rel/apple/JIT#FE1000 -r $2/SYS/JIT#FE1000
echo "SYS/JIT16"; atftp $1 --put -l rel/apple/JIT16#FE1000 -r $2/SYS/JIT16#FE1000
echo "SYS/JITUNE"; atftp $1 --put -l rel/apple/JITUNE#FE1000 -r $2/SYS/JITUNE#FE1000
# Core libraries
echo "SYS/ARGS"; atftp $1 --put -l rel/ARGS#FE1000 -r $2/SYS/ARGS#FE1000
echo "SYS/DHCP"; atftp $1 --put -l rel/DHCP#FE1000 -r $2/SYS/DHCP#FE1000
echo "SYS/ED"; atftp $1 --put -l rel/ED#FE1000 -r $2/SYS/ED#FE1000
echo "SYS/ETHERIP"; atftp $1 --put -l rel/ETHERIP#FE1000 -r $2/SYS/ETHERIP#FE1000
echo "SYS/MOUSE"; atftp $1 --put -l rel/apple/MOUSE#FE1000 -r $2/SYS/MOUSE#FE1000
echo "SYS/FIBER"; atftp $1 --put -l rel/FIBER#FE1000 -r $2/SYS/FIBER#FE1000
echo "SYS/FPSTR"; atftp $1 --put -l rel/FPSTR#FE1000 -r $2/SYS/FPSTR#FE1000
echo "SYS/FPU"; atftp $1 --put -l rel/FPU#FE1000 -r $2/SYS/FPU#FE1000
echo "SYS/INET"; atftp $1 --put -l rel/INET#FE1000 -r $2/SYS/INET#FE1000
echo "SYS/LONGJUMP"; atftp $1 --put -l rel/LONGJMP#FE1000 -r $2/SYS/LONGJMP#FE1000
echo "SYS/LZ4"; atftp $1 --put -l rel/LZ4#FE1000 -r $2/SYS/LZ4#FE1000
echo "SYS/MEMMGR"; atftp $1 --put -l rel/MEMMGR#FE1000 -r $2/SYS/MEMMGR#FE1000
echo "SYS/SANE"; atftp $1 --put -l rel/SANE#FE1000 -r $2/SYS/SANE#FE1000
echo "SYS/CONIO"; atftp $1 --put -l rel/apple/CONIO#FE1000 -r $2/SYS/CONIO#FE1000
echo "SYS/DGR"; atftp $1 --put -l rel/apple/DGR#FE1000 -r $2/SYS/DGR#FE1000
echo "SYS/FILEIO"; atftp $1 --put -l rel/apple/FILEIO#FE1000 -r $2/SYS/FILEIO#FE1000
echo "SYS/GRAFIX"; atftp $1 --put -l rel/apple/GRAFIX#FE1000 -r $2/SYS/GRAFIX#FE1000
echo "SYS/JOYBUZZ"; atftp $1 --put -l rel/apple/JOYBUZZ#FE1000 -r $2/SYS/JOYBUZZ#FE1000
echo "SYS/MON"; atftp $1 --put -l rel/apple/MON#FE1000 -r $2/SYS/MON#FE1000
echo "SYS/PORTIO"; atftp $1 --put -l rel/apple/PORTIO#FE1000 -r $2/SYS/PORTIO#FE1000
echo "SYS/SPIPORT"; atftp $1 --put -l rel/apple/SPIPORT#FE1000 -r $2/SYS/SPIPORT#FE1000
echo "SYS/UTHERNET2";atftp $1 --put -l rel/apple/UTHERNET2#FE1000 -r $2/SYS/UTHERNET2#FE1000
echo "SYS/UTHERNET"; atftp $1 --put -l rel/apple/UTHERNET#FE1000 -r $2/SYS/UTHERNET#FE1000

14
src/toolsrc/codegen.c
View File

@ -89,6 +89,16 @@ int idconst_add(char *name, int len, int value)
printf("Constant count overflow\n");
return (0);
}
if (idconst_lookup(name, len) > 0)
{
parse_error("const/global name conflict\n");
return (0);
}
if (idglobal_lookup(name, len) > 0)
{
parse_error("global label already defined\n");
return (0);
}
name[len] = '\0';
emit_idconst(name, value);
name[len] = c;
@ -865,7 +875,7 @@ void emit_select(int tag)
void emit_caseblock(int casecnt, int *caseof, int *casetag)
{
int i;
if (casecnt < 1 || casecnt > 256)
parse_error("Switch count under/overflow\n");
emit_pending_seq();
@ -1372,7 +1382,7 @@ int crunch_seq(t_opseq **seq, int pass)
case BINARY_CODE(LE_TOKEN):
op->val = op->val <= opnext->val ? 1 : 0;
freeops = 2;
break;
break;
}
// End of collapse constant operation
if ((pass > 0) && (freeops == 0) && (op->val != 0))

39
src/toolsrc/codegen.pla
View File

@ -153,6 +153,26 @@ def emit_code(bval)#0
codeptr++
if codeptr - codebuff > codebufsz; exit_err(ERR_OVER|ERR_CODE|ERR_TABLE); fin
end
def emit_slb(offset)#0
emit_pending_seq
emit_byte($74)
emit_byte(offset)
end
def emit_slw(offset)#0
emit_pending_seq
emit_byte($76)
emit_byte(offset)
end
def emit_sab(tag, offset)#0
emit_pending_seq
emit_byte($78)
emit_addr(tag, offset)
end
def emit_saw(tag, offset)#0
emit_pending_seq
emit_byte($7A)
emit_addr(tag, offset)
end
def emit_dlb(offset)#0
emit_pending_seq
emit_byte($6C)
@ -180,7 +200,7 @@ def emit_select(tag)#0
end
def emit_caseblock(cnt, oflist, taglist)#0
byte i
if not cnt or cnt > 256; exit_err(ERR_OVER|ERR_STATE); fin
emit_pending_seq
emit_byte(cnt)
@ -534,7 +554,7 @@ def init_idglobal#0
fixup_num = FIXUPNUM
globalbufsz = IDGLOBALSZ
localbufsz = IDLOCALSZ
if isult(heapavail, $4000)
if isult(heapavail, $6000)
dfd_num = DFDNUM/2
tag_num = TAGNUM/2
fixup_num = FIXUPNUM/2
@ -888,17 +908,10 @@ def writeDFD(refnum, modfix)#0
dfd = @defdir
for cnt = 0 to dfd_cnt-1
//dfd, idptr, cnt = @defdir, idglobal_tbl, globals
//while cnt
//if idptr=>idtype & (FUNC_TYPE|EXTERN_TYPE) == FUNC_TYPE
dfd->0 = $02
dfd=>1 = tag_addr=>[dfd_tag=>[cnt]] + modfix
dfd->3 = 0
dfd = dfd + 4
//fin
//idptr = idptr + idptr->idname + t_id
//cnt--
//loop
dfd->0 = $02
dfd=>1 = tag_addr=>[dfd_tag=>[cnt]] + modfix
dfd->3 = 0
dfd = dfd + 4
next
fileio:write(refnum, @defdir, dfd - @defdir)
end

2
src/toolsrc/ed.pla
View File

@ -17,7 +17,7 @@ const pushbttn2 = $C062
const pushbttn3 = $C063
const keyboard = $C000
const keystrobe = $C010
const cmdline = $01FF
const inputln = $01FF
//
// ASCII key values
//

4
src/toolsrc/lex.pla
View File

@ -36,7 +36,9 @@
// loop
// chrptr = tknptr - 1
// while keywrds[keypos] == tknlen
// i = 1; while i <= tknlen and ^(chrptr + i) == keywrds[keypos + i]; i++; loop
// for i = 1 to tknlen
// if ^(chrptr + i) <> keywrds[keypos + i]; break; fin
// next
// if i > tknlen
// return keywrds[keypos + keywrds[keypos] + 1]
// fin

48
src/toolsrc/parse.c
View File

@ -8,7 +8,7 @@
int parse_mods(void);
int infunc = 0, break_tag = 0, cont_tag = 0, stack_loop = 0, infor = 0;
int infunc = 0, break_tag = 0, cont_tag = 0, stack_loop = 0;
long infuncvals = 0;
t_token prevstmnt;
static int lambda_num = 0;
@ -831,7 +831,7 @@ t_opseq *parse_set(t_opseq *codeseq)
int parse_stmnt(void)
{
int tag_prevbrk, tag_prevcnt, tag_else, tag_endif, tag_while, tag_wend, tag_repeat, tag_for, tag_choice, tag_of;
int type, addr, step, cfnvals, prev_for, constsize, casecnt, i;
int type, addr, step, cfnvals, constsize, casecnt, i;
int *caseval, *casetag;
long constval;
char *idptr;
@ -891,8 +891,6 @@ int parse_stmnt(void)
parse_error("Missing IF/FIN");
break;
case WHILE_TOKEN:
prev_for = infor;
infor = 0;
tag_while = tag_new(BRANCH_TYPE);
tag_wend = tag_new(BRANCH_TYPE);
tag_prevcnt = cont_tag;
@ -917,11 +915,8 @@ int parse_stmnt(void)
emit_codetag(tag_wend);
break_tag = tag_prevbrk;
cont_tag = tag_prevcnt;
infor = prev_for;
break;
case REPEAT_TOKEN:
prev_for = infor;
infor = 0;
tag_prevbrk = break_tag;
break_tag = tag_new(BRANCH_TYPE);
tag_repeat = tag_new(BRANCH_TYPE);
@ -945,12 +940,9 @@ int parse_stmnt(void)
emit_seq(seq);
emit_codetag(break_tag);
break_tag = tag_prevbrk;
infor = prev_for;
break;
case FOR_TOKEN:
stack_loop += 2;
prev_for = infor;
infor = 1;
tag_prevbrk = break_tag;
break_tag = tag_new(BRANCH_TYPE);
tag_for = tag_new(BRANCH_TYPE);
@ -1029,13 +1021,15 @@ int parse_stmnt(void)
emit_decbrge(tag_for);
}
emit_codetag(break_tag);
if (type & LOCAL_TYPE)
type & BYTE_TYPE ? emit_slb(addr) : emit_slw(addr);
else
type & BYTE_TYPE ? emit_sab(addr, 0, type) : emit_saw(addr, 0, type);
emit_drop();
break_tag = tag_prevbrk;
infor = prev_for;
stack_loop -= 2;
break;
case CASE_TOKEN:
prev_for = infor;
infor = 0;
tag_prevbrk = break_tag;
break_tag = tag_new(BRANCH_TYPE);
tag_choice = tag_new(BRANCH_TYPE);
@ -1111,15 +1105,10 @@ int parse_stmnt(void)
free(casetag);
emit_codetag(break_tag);
break_tag = tag_prevbrk;
infor = prev_for;
break;
case BREAK_TOKEN:
if (break_tag)
{
if (infor)
emit_drop2();
emit_brnch(break_tag);
}
else
parse_error("BREAK without loop");
break;
@ -1130,19 +1119,19 @@ int parse_stmnt(void)
parse_error("CONTINUE without loop");
break;
case RETURN_TOKEN:
cfnvals = stack_loop;
while (cfnvals >= 2)
{
emit_drop2();
cfnvals -= 2;
}
if (cfnvals)
{
emit_drop();
cfnvals--;
}
if (infunc)
{
int i;
i = stack_loop;
while (i >= 2)
{
emit_drop2();
i -= 2;
}
if (i)
emit_drop();
cfnvals = 0;
emit_seq(parse_list(NULL, &cfnvals));
if (cfnvals > infuncvals)
parse_error("Too many return values");
@ -1699,6 +1688,7 @@ int parse_defs(void)
next_line();
} while (scantoken != END_TOKEN);
scan();
infunc = 0;
return (1);
}
return (scantoken == EOL_TOKEN);

39
src/toolsrc/parse.pla
View File

@ -80,8 +80,6 @@ def calc_binaryop(op)#0
push_val(val1, size1, type1)
end
def parse_constterm
word val
byte size, type
when scan
is OPEN_PAREN_TKN
@ -598,7 +596,7 @@ def parse_set(codeseq)
return codeseq
end
def parse_stmnt
byte type, elem_type, elem_size, cfnvals, prev_for
byte type, elem_type, elem_size, cfnvals
word seq, fromseq, toseq, tag_prevbrk, tag_prevcnt, tag_else, tag_endif, tag_while, tag_wend
word tag_repeat, tag_for, tag_choice, tag_of, idptr, addr, stepdir
word caseconst, casecnt, caseval, casetag, i
@ -652,8 +650,6 @@ def parse_stmnt
if token <> FIN_TKN; exit_err(ERR_MISS|ERR_CLOSE|ERR_STATE); fin
break
is WHILE_TKN
prev_for = infor
infor = FALSE
tag_while = new_tag(RELATIVE_FIXUP)
tag_wend = new_tag(RELATIVE_FIXUP)
tag_prevcnt = cont_tag
@ -678,11 +674,8 @@ def parse_stmnt
emit_tag(tag_wend)
break_tag = tag_prevbrk
cont_tag = tag_prevcnt
infor = prev_for
break
is REPEAT_TKN
prev_for = infor
infor = FALSE
tag_repeat = new_tag(RELATIVE_FIXUP)
tag_prevbrk = break_tag
break_tag = new_tag(RELATIVE_FIXUP)
@ -706,11 +699,8 @@ def parse_stmnt
emit_seq(seq)
emit_tag(break_tag)
break_tag = tag_prevbrk
infor = prev_for
break
is FOR_TKN
prev_for = infor
infor = TRUE
stack_loop = stack_loop + 2
tag_for = new_tag(RELATIVE_FIXUP)
tag_prevcnt = cont_tag
@ -784,13 +774,16 @@ def parse_stmnt
fin
fin
emit_tag(break_tag)
if type & LOCAL_TYPE
if type & BYTE_TYPE; emit_slb(addr); else; emit_slw(addr); fin
else
if type & BYTE_TYPE; emit_sab(addr, 0); else; emit_saw(addr, 0); fin
fin
emit_code(DROP_CODE)
break_tag = tag_prevbrk
stack_loop = stack_loop - 2
infor = prev_for
break
is CASE_TKN
prev_for = infor
infor = FALSE
tag_prevbrk = break_tag
break_tag = new_tag(RELATIVE_FIXUP)
tag_choice = new_tag(RELATIVE_FIXUP)
@ -863,11 +856,9 @@ def parse_stmnt
heaprelease(caseval)
emit_tag(break_tag)
break_tag = tag_prevbrk
infor = prev_for
break
is BREAK_TKN
if break_tag
if infor; emit_code(DROP2_CODE); fin
emit_branch(break_tag)
else
exit_err(ERR_INVAL|ERR_STATE)
@ -881,15 +872,15 @@ def parse_stmnt
fin
break
is RETURN_TKN
i = stack_loop
while i >= 2
emit_code(DROP2_CODE)
i = i - 2
loop
if i
emit_code(DROP_CODE)
fin
if infunc
i = stack_loop
while i >= 2
emit_code(DROP2_CODE)
i = i - 2
loop
if i
emit_code(DROP_CODE)
fin
seq, cfnvals = parse_list
emit_seq(seq)
if cfnvals > infuncvals

2
src/toolsrc/plasm.pla
View File

@ -298,7 +298,7 @@ const RVALUE = 1
const LAMBDANUM = 16
word strconstbuff
word strconstptr
byte infunc, inlambda, infor
byte infunc, inlambda
byte stack_loop
byte prevstmnt
word infuncvals

279
src/vmsrc/apple/cmd.pla
View File

@ -1,6 +1,5 @@
const MACHID = $BF98
const iobuffer = $0800
const databuff = $2000
const RELADDR = $1000
const symtbl = $0C00
const freemem = $0006
@ -43,8 +42,8 @@ word syspath
word syscmdln
word = @execmod, @open, @close, @read, @write
byte perr
byte jitcount = $10
byte jitsize = $FF
byte jitcount = 0
byte jitsize = 0
//
// Working input buffer overlayed with strings table
//
@ -121,20 +120,12 @@ word sysmodsym = @exports
//
word systemflags = 0
word heap
word xheap = $0800
word lastsym = symtbl
//
// Utility functions
//
//asm equates included from cmdstub.s
//
asm saveX#0
STX XREG+1
end
asm restoreX#0
XREG LDX #$00
RTS
end
// CALL PRODOS
// SYSCALL(CMD, PARAMS)
//
@ -204,14 +195,6 @@ asm exec()#0
JMP $2000
end
//
// EXIT
//
asm reboot()#0
BIT ROMEN
DEC $03F4 ; INVALIDATE POWER-UP BYTE
JMP ($FFFC) ; RESET
end
//
// SET MEMORY TO VALUE
// MEMSET(ADDR, VALUE, SIZE)
// With optimizations from Peter Ferrie
@ -931,39 +914,6 @@ def releaseheap(newheap)#1
heap = newheap
return @newheap - heap
end
def allocxheap(size)#1
word xaddr
xaddr = xheap
xheap = xheap + size
if systemflags & restxt1
if uword_isle(xaddr, $0800) and uword_isgt(xheap, $0400)
xaddr = $0800
xheap = xaddr + size
fin
fin
if systemflags & restxt2
if uword_isle(xaddr, $0C00) and uword_isgt(xheap, $0800)
xaddr = $0C00
xheap = xaddr + size
fin
fin
if systemflags & resxhgr1
if uword_isle(xaddr, $4000) and uword_isgt(xheap, $2000)
xaddr = $4000
xheap = xaddr + size
fin
fin
if systemflags & resxhgr2
if uword_isle(xaddr, $6000) and uword_isgt(xheap, $4000)
xaddr = $6000
xheap = xaddr + size
fin
fin
if uword_isge(xheap, $BF00)
return 0
fin
return xaddr
end
//
// Symbol table routines.
//
@ -1009,29 +959,29 @@ def lookupextern(esd, index)#1
fin
return 0
end
def adddef(bank, addr, deflast)#1
def adddef(addr, deflast)#1
word defentry
defentry = *deflast
*deflast = defentry + 5
defentry->0 = $20
defentry=>1 = bank ?? $03DC :: $03D6 // JSR $03DC (AUX MEM INTERP) or $03D6 (MAIN MEM INTERP)
defentry=>1 = $03D6
defentry=>3 = addr
defentry->5 = 0 // NULL out next entry
return defentry
end
def loadmod(mod)#1
word rdlen, modsize, bytecode, codefix, defofst, defcnt, init, fixup
word rdlen, modsize, bytecode, codefix, defofst, defcnt, init, initcode[], fixup
word addr, defaddr, modaddr, modfix, modofst, modend
word deftbl, deflast
word moddep, rld, esd, sym
byte refnum, defbank, filename[64], str[]
byte refnum, filename[64], str[]
byte header[128]
//
// Read the RELocatable module header (first 128 bytes)
//
dcitos(mod, @filename)
refnum = open(@filename)
if !refnum
if !refnum and filename < 16
//
// Try system path
//
@ -1121,17 +1071,7 @@ def loadmod(mod)#1
esd = esd + 4
loop
esd = esd + 1
//
// Locate bytecode defs in appropriate bank.
//
if ^MACHID & $30 == $30
defbank = 1
defaddr = allocxheap(rld - bytecode)
modend = bytecode
else
defbank = 0
defaddr = bytecode
fin
defaddr = bytecode
codefix = defaddr - bytecode
defofst = defaddr - defofst
//
@ -1141,7 +1081,7 @@ def loadmod(mod)#1
//
// This is a bytcode def entry - add it to the def directory.
//
adddef(defbank, rld=>1 + defofst, @deflast)
adddef(rld=>1 + defofst, @deflast)
rld = rld + 4
loop
//
@ -1153,31 +1093,6 @@ def loadmod(mod)#1
*addr = ^rld & $10 ?? *addr + lookupextern(esd, rld->3) :: lookupdef(fixup + codefix, deftbl)
rld = rld + 4
fin
//addr = rld=>1 + modfix
//if uword_isge(addr, modaddr) // Skip fixups to header
// if type & $80 // WORD sized fixup.
// fixup = *addr
// else // BYTE sized fixup.
// fixup = ^addr
// fin
// if ^rld & $10 // EXTERN reference.
// fixup = fixup + lookupextern(esd, rld->3)
// else // INTERN fixup.
// fixup = fixup + modofst
// if uword_isge(fixup, bytecode)
// //
// // Bytecode address - replace with call def directory.
// //
// fixup = lookupdef(fixup + codefix, deftbl)
// fin
// fin
// if type & $80 // WORD sized fixup.
// *addr = fixup
// else // BYTE sized fixup.
// ^addr = fixup
// fin
//fin
//rld = rld + 4
loop
//
// Run through the External/Entry Symbol Directory.
@ -1200,15 +1115,6 @@ def loadmod(mod)#1
fin
esd = esd + 3
loop
if defbank
//
// Move bytecode to AUX bank.
//
*$003C = bytecode
*$003E = modaddr + modsize
*$0042 = defaddr
call($C311, 0, 0, 0, $05) // CALL XMOVE with carry set (MAIN->AUX) and ints disabled
fin
else
perr = $46
fin
@ -1216,36 +1122,29 @@ def loadmod(mod)#1
return -perr
fin
//
// Free up rld+esd (and bytecode on 128K) in main memory.
// Free up rld+esd in main memory.
//
releaseheap(modend)
//
// Call init routine if it exists.
//
fixup = 0 // This is repurposed for the return code
initcode = 0
if init
init = init + defofst
fixup = adddef(defbank, init, @deflast)()
if fixup < modinitkeep
init = init + defofst
initcode = adddef(init, @deflast)()
if initcode < modinitkeep
//
// Free init routine unless initkeep
//
if defbank
xheap = init
else
//
// Free up init code in main memory.
//
releaseheap(init)
fin
if fixup < 0
perr = -fixup
releaseheap(init)
if initcode < 0
perr = -initcode
fin
else
fixup = fixup & ~modinitkeep
initcode = initcode & ~modinitkeep
fin
fin
return fixup
return initcode
end
//
// Command mode
@ -1257,9 +1156,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
@ -1284,12 +1183,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
@ -1366,10 +1265,13 @@ def parsecmd(strptr)#1
return cmd
end
def resetmemfiles()#0
byte terr
terr = perr // Save perr
//
// Close all files
//
^$BFD8 = 0
^$BF94 = 0
close(0)
//
// Set memory bitmap
@ -1377,6 +1279,7 @@ def resetmemfiles()#0
memset($BF58, 0, 24)
^$BF58 = $CF
^$BF6F = $01
perr = terr // Restore perr
end
def execsys(sysfile)#0
byte refnum
@ -1387,7 +1290,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)
@ -1405,17 +1308,15 @@ def execsys(sysfile)#0
end
def execmod(modfile)#1
byte moddci[17]
word saveheap, savexheap, savesym, saveflags
word saveheap, savesym, saveflags
perr = 1
if stodci(modfile, @moddci)
saveheap = heap
savexheap = xheap
savesym = lastsym
saveflags = systemflags
if loadmod(@moddci) < modkeep
lastsym = savesym
xheap = savexheap
heap = saveheap
fin
^lastsym = 0
@ -1424,13 +1325,68 @@ def execmod(modfile)#1
return -perr
end
//
// Command line processor
//
def docmds#0
while 1
if ^getlnbuf
strcpy(@cmdln, getlnbuf)
when toupper(parsecmd(getlnbuf))
is 'C'
catalog(getlnbuf)
break
is 'P'
pfxop(getlnbuf, SET_PFX)
break
is '/'
repeat
prefix--
until prefix[prefix] == '/'
if prefix > 1
pfxop(@prefix, SET_PFX)
fin
break
is 'V'
volumes()
break
is '-'
execsys(getlnbuf)
break
is '+'
execmod(striptrail(getlnbuf))
//
// Clean up
//
resetmemfiles
break
otherwise
cout('?')
wend
if perr
prstr("ERR:$")
prbyte(perr)
else
prstr("OK")
fin
crout()
fin
prstr(pfxop(@prefix, GET_PFX))
rdstr($BA)
loop
end
//
// Dummy definition to get free heap
//
def lastdef#0
end
//
// Get heap start.
//
heap = *freemem
heap = @lastdef
//
// Print PLASMA version
//
prstr("PLASMA 2.0 Dev\n")//; prbyte(version.1); cout('.'); prbyte(version.0); crout
prstr("PLASMA 2.0 Dev 64K\n")//; prbyte(version.1); cout('.'); prbyte(version.0); crout
//
// Init symbol table.
//
@ -1449,8 +1405,8 @@ syscmdln = @cmdln
// Try to load autorun.
//
autorun = open(@autorun)
if autorun > 0
cmdln = read(autorun, @autorun, 128)
if autorun
^getlnbuf = read(autorun, getlnbuf + 1, 128)
close(0)
else
//
@ -1459,54 +1415,5 @@ else
prstr("MEM FREE:$"); prword(availheap); crout
fin
perr = 0
while 1
if ^getlnbuf
when toupper(parsecmd(getlnbuf))
is 'Q'
reboot()
break
is 'C'
catalog(getlnbuf)
break
is 'P'
pfxop(getlnbuf, SET_PFX)
break
is '/'
repeat
prefix--
until prefix[prefix] == '/'
if prefix > 1
pfxop(@prefix, SET_PFX)
fin
break
is 'V'
volumes()
break
is '-'
execsys(getlnbuf)
break
is '+'
saveX
execmod(striptrail(getlnbuf))
//
// Clean up
//
restoreX
resetmemfiles
break
otherwise
cout('?')
wend
if perr
prstr("ERR:$")
prbyte(perr)
perr = 0
else
prstr("OK")
fin
crout()
fin
prstr(pfxop(@prefix, GET_PFX))
strcpy(@cmdln, rdstr($BA))
loop
docmds
done

185
src/vmsrc/apple/cmdjit.pla
View File

@ -1,6 +1,5 @@
const MACHID = $BF98
const iobuffer = $0800
const databuff = $2000
const RELADDR = $1000
const symtbl = $0C00
const freemem = $0006
@ -146,13 +145,6 @@ word lastsym = symtbl
//
//asm equates included from cmdstub.s
//
//asm saveX#0
// STX XREG+1
//end
//asm restoreX#0
//XREG LDX #$00
// RTS
//end
// CALL PRODOS
// SYSCALL(CMD, PARAMS)
//
@ -222,14 +214,6 @@ asm exec()#0
JMP $2000
end
//
// EXIT
//
asm reboot()#0
BIT ROMEN
DEC $03F4 ; INVALIDATE POWER-UP BYTE
JMP ($FFFC) ; RESET
end
//
// SET MEMORY TO VALUE
// MEMSET(ADDR, VALUE, SIZE)
// With optimizations from Peter Ferrie
@ -1027,7 +1011,7 @@ def adddef(isfirst, addr, deflast)#1
if not isfirst
preventry = defentry - t_defentry
defsize = addr - preventry=>bytecodeaddr
if defsize <= jitsize // and *jitcomp
if defsize <= jitsize
preventry=>interpaddr = $03D6 // JSR $03D6 (JIT INTERP)
preventry->callcount = jitcount // Set JIT countdown
preventry->bytecodesize = defsize // Set size
@ -1036,12 +1020,11 @@ def adddef(isfirst, addr, deflast)#1
defentry->interpjsr = $20
defentry=>interpaddr = $03DC // JSR $03DC (BYTECODE INTERP)
defentry=>bytecodeaddr = addr
//defentry=>5 = 0 // Clear count and size
defentry->t_defentry = 0 // NULL out next entry
defentry->t_defentry = 0 // NULL out next entry
return defentry
end
def loadmod(mod)#1
word rdlen, modsize, bytecode, codefix, defofst, defcnt, init, fixup
word rdlen[], bytecode, modsize, codefix, defofst, defcnt, init, initcode[], fixup
word addr, defaddr, modaddr, modfix, modofst, modend
word deftbl, deflast
word moddep, rld, esd, sym
@ -1052,7 +1035,7 @@ def loadmod(mod)#1
//
dcitos(mod, @filename)
refnum = open(@filename)
if !refnum
if !refnum and filename < 16
//
// Try system path
//
@ -1203,29 +1186,29 @@ def loadmod(mod)#1
return -perr
fin
//
// Free up rld+esd (and bytecode on 128K) in main memory.
// Free up rld+esd+bytecode in main memory.
//
releaseheap(modend)
//
// Call init routine if it exists.
//
fixup = 0 // This is repurposed for the return code
initcode = 0
if init
init = init + defofst
fixup = adddef(deffirst, init, @deflast)()
if fixup < modinitkeep
init = init + defofst
initcode = adddef(deffirst, init, @deflast)()
if initcode < modinitkeep
//
// Free init routine unless initkeep
//
xheap = init
if fixup < 0
perr = -fixup
if initcode < 0
perr = -initcode
fin
else
fixup = fixup & ~modinitkeep
initcode = initcode & ~modinitkeep
fin
fin
return fixup
return initcode
end
//
// Command mode
@ -1237,9 +1220,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
@ -1264,12 +1247,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
@ -1346,10 +1329,13 @@ def parsecmd(strptr)#1
return cmd
end
def resetmemfiles()#0
byte terr
terr = perr // Save perr
//
// Close all files
//
^$BFD8 = 0
^$BF94 = 0
close(0)
//
// Set memory bitmap
@ -1357,6 +1343,7 @@ def resetmemfiles()#0
memset($BF58, 0, 24)
^$BF58 = $CF
^$BF6F = $01
perr = terr // Restore perr
end
def execsys(sysfile)#0
byte refnum
@ -1367,7 +1354,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)
@ -1406,13 +1393,71 @@ def execmod(modfile)#1
return -perr
end
//
// Command line processor
//
def docmds#0
loadmod(jitmod) // Cannot do this in init code - it will overwrite it!
xheap = $0400 // Reset heap to point at low memory
xheaptop = $A000 // Top below JITC
while 1
if ^getlnbuf
strcpy(@cmdln, getlnbuf)
when toupper(parsecmd(getlnbuf))
is 'C'
catalog(getlnbuf)
break
is 'P'
pfxop(getlnbuf, SET_PFX)
break
is '/'
repeat
prefix--
until prefix[prefix] == '/'
if prefix > 1
pfxop(@prefix, SET_PFX)
fin
break
is 'V'
volumes()
break
is '-'
execsys(getlnbuf)
break
is '+'
execmod(striptrail(getlnbuf))
//
// Clean up
//
resetmemfiles
break
otherwise
cout('?')
wend
if perr
prstr("ERR:$")
prbyte(perr)
else
prstr("OK")
fin
crout()
fin
prstr(pfxop(@prefix, GET_PFX))
rdstr($BA)
loop
end
//
// Dummy definition to get free heap
//
def lastdef#0
end
//
// Get heap start.
//
heap = *freemem
heap = @lastdef
//
// Print PLASMA version
//
prstr("PLASMA JITC 2.0 Dev\n")//; prbyte(version.1); cout('.'); prbyte(version.0); crout
prstr("PLASMA 2.0 Dev 128K\n")//; prbyte(version.1); cout('.'); prbyte(version.0); crout
//
// Init symbol table.
//
@ -1427,15 +1472,12 @@ loop
strcat(strcpy(@sysmods, $280), "SYS/")) // This is the path to CMD
syspath = @sysmods // Update external interface table
syscmdln = @cmdln
loadmod(jitmod)
xheap = $0800 // Reset heap to point at low memory
xheaptop = $A000 // Top where JIT loaded
//
// Try to load autorun.
//
autorun = open(@autorun)
if autorun > 0
cmdln = read(autorun, @autorun, 128)
if autorun
^getlnbuf = read(autorun, getlnbuf + 1, 128)
close(0)
else
//
@ -1444,54 +1486,5 @@ else
prstr("MEM FREE:$"); prword(availheap); crout
fin
perr = 0
while 1
if ^getlnbuf
when toupper(parsecmd(getlnbuf))
is 'Q'
reboot()
break
is 'C'
catalog(getlnbuf)
break
is 'P'
pfxop(getlnbuf, SET_PFX)
break
is '/'
repeat
prefix--
until prefix[prefix] == '/'
if prefix > 1
pfxop(@prefix, SET_PFX)
fin
break
is 'V'
volumes()
break
is '-'
execsys(getlnbuf)
break
is '+'
//saveX
execmod(striptrail(getlnbuf))
//
// Clean up
//
//restoreX
resetmemfiles
break
otherwise
cout('?')
wend
if perr
prstr("ERR:$")
prbyte(perr)
perr = 0
else
prstr("OK")
fin
crout()
fin
prstr(pfxop(@prefix, GET_PFX))
strcpy(@cmdln, rdstr($BA))
loop
docmds
done

32
src/vmsrc/apple/cmdjitstub.s
View File

@ -1,12 +1,12 @@
INTERP = $03D0
LCRDEN = $C080
LCWTEN = $C081
ROMEN = $C082
LCRWEN = $C083
LCBNK2 = $00
LCBNK1 = $08
JITCOMP = $03E2
JITCODE = $03E4
INTERP = $03D0
LCRDEN = $C080
LCWTEN = $C081
ROMEN = $C082
LCRWEN = $C083
LCBNK2 = $00
LCBNK1 = $08
JITCOMP = $03E2
JITCODE = $03E4
!SOURCE "vmsrc/plvmzp.inc"
;*
;* MOVE CMD DOWN TO $1000-$2000
@ -25,20 +25,17 @@ JITCODE = $03E4
BNE -
INC SRCH
INC DSTH
DEX ; STOP WHEN DST=$2000 REACHED
DEX ; STOP WHEN DST=$2000 REACHED
BNE -
LDA #<_CMDEND
STA SRCL
LDA #>_CMDEND
STA SRCH
;
; INIT VM ENVIRONMENT STACK POINTERS
;
STY $01FF
STY PPL
STY IFPL ; INIT FRAME POINTER = $AF00 (4K FOR JIT CODE)
STY JITCODE
STY JITCOMP
STY JITCOMP+1
STY PPL
STY IFPL ; INIT FRAME POINTER
STY JITCODE
LDA #$AF
STA PPH
STA IFPH
@ -46,7 +43,6 @@ JITCODE = $03E4
LDX #$FE ; INIT STACK POINTER (YES, $FE. SEE GETS)
TXS
LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX
JMP $1000
_CMDBEGIN = *
!PSEUDOPC $1000 {

71
src/vmsrc/apple/cmdstub.s
View File

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

32
src/vmsrc/apple/plvm01.s
View File

@ -121,6 +121,7 @@ OPTBL !WORD CN,CN,CN,CN,CN,CN,CN,CN ; 00 02
!WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 90 92 94 96 98 9A 9C 9E
!WORD BRGT,BRLT,INCBRLE,ADDBRLE,DECBRGE,SUBBRGE,BRAND,BROR ; A0 A2 A4 A6 A8 AA AC AE
!WORD ADDLB,ADDLW,ADDAB,ADDAW,IDXLB,IDXLW,IDXAB,IDXAW ; B0 B2 B4 B6 B8 BA BC BE
!WORD NATV ; C0
;*
;* DIV TOS-1 BY TOS
;*
@ -932,20 +933,16 @@ BRGT LDA ESTKL+1,X
SBC ESTKH,X
BVS +
BPL NOBRNCH
- INX ; DROP FOR VALUES
INX
BNE BRNCH ; BMI BRNCH
BMI BRNCH
BRLT LDA ESTKL,X
CMP ESTKL+1,X
LDA ESTKH,X
SBC ESTKH+1,X
BVS +
BPL NOBRNCH
INX ; DROP FOR VALUES
INX
BNE BRNCH ; BMI BRNCH
BMI BRNCH
+ BMI NOBRNCH
BPL -
BPL BRNCH
DECBRGE DEC ESTKL,X
LDA ESTKL,X
CMP #$FF
@ -957,9 +954,7 @@ _BRGE LDA ESTKL,X
SBC ESTKH+1,X
BVS +
BPL BRNCH
- INX ; DROP FOR VALUES
INX
BNE NOBRNCH ; BMI NOBRNCH
BMI NOBRNCH
INCBRLE INC ESTKL,X
BNE _BRLE
INC ESTKH,X
@ -969,11 +964,9 @@ _BRLE LDA ESTKL+1,X
SBC ESTKH,X
BVS +
BPL BRNCH
INX ; DROP FOR VALUES
INX
BNE NOBRNCH ; BMI NOBRNCH
BMI NOBRNCH
+ BMI BRNCH
BPL -
BPL NOBRNCH
SUBBRGE LDA ESTKL+1,X
SEC
SBC ESTKL,X
@ -1066,6 +1059,17 @@ LEAVE INY ;+INC_IP
RTS
+ INC IFPH
RET RTS
;*
;* RETURN TO NATIVE CODE
;*
NATV TYA ; FLATTEN IP
SEC
ADC IPL
STA IPL
BCS +
JMP (IP)
+ INC IPH
JMP (IP)
A1CMD !SOURCE "vmsrc/apple/a1cmd.a"
SEGEND = *
VMINIT LDY #$10 ; INSTALL PAGE 0 FETCHOP ROUTINE

1051
src/vmsrc/apple/plvm02.s
View File

File diff suppressed because it is too large Load Diff

52
src/vmsrc/apple/plvm03.s
View File

@ -1262,32 +1262,16 @@ BRGT LDA ESTKL+1,X
CMP ESTKL,X
LDA ESTKH+1,X
SBC ESTKH,X
BVS +
BPL NOBRNCH
- INX ; DROP FOR VALUES
INX
BNE BRNCH ; BMI BRNCH
BVS ++
- BPL NOBRNCH
BMI BRNCH
BRLT LDA ESTKL,X
CMP ESTKL+1,X
LDA ESTKH,X
SBC ESTKH+1,X
BVS +
BVS ++
BPL NOBRNCH
BMI -
+ BMI NOBRNCH
BPL -
INCBRLE INC ESTKL,X
BNE _BRLE
INC ESTKH,X
_BRLE LDA ESTKL+1,X
CMP ESTKL,X
LDA ESTKH+1,X
SBC ESTKH,X
BVS +
BPL BRNCH
- INX ; DROP FOR VALUES
INX
BNE NOBRNCH ; BMI NOBRNCH
BMI BRNCH
DECBRGE DEC ESTKL,X
LDA ESTKL,X
CMP #$FF
@ -1297,11 +1281,19 @@ _BRGE LDA ESTKL,X
+ CMP ESTKL+1,X
LDA ESTKH,X
SBC ESTKH+1,X
BVS +
BVS -
BPL BRNCH
BMI -
+ BMI BRNCH
BPL -
BMI NOBRNCH
INCBRLE INC ESTKL,X
BNE _BRLE
INC ESTKH,X
_BRLE LDA ESTKL+1,X
CMP ESTKL,X
LDA ESTKH+1,X
SBC ESTKH,X
BVS -
++ BPL BRNCH
BMI NOBRNCH
SUBBRGE LDA ESTKL+1,X
SEC
SBC ESTKL,X
@ -1428,11 +1420,11 @@ RET RTS
NATV TYA ; FLATTEN IP
SEC
ADC IPL
STA TMPL
LDA #$00
ADC IPH
STA TMPH
JMP JMPTMP
STA IPL
BCS +
JMP (IP)
+ INC IPH
JMP (IP)
SOSCMD = *
!SOURCE "vmsrc/apple/sossys.a"

170
src/vmsrc/apple/plvm802.s
View File

@ -84,12 +84,20 @@ NOS = $03 ; TOS-1
REP #$20 ; 16 BIT A/M
!AL
}
!MACRO INDEX8 {
SEP #$10 ; 8 BIT X/Y
!AS
}
!MACRO INDEX16 {
REP #$10 ; 16 BIT X/Y
!AL
}
;******************************
;* *
;* INTERPRETER INITIALIZATION *
;* *
;******************************
* = $2000
* = $2000
;*
;* MUST HAVE 128K FOR JIT
;*
@ -135,13 +143,6 @@ BADCPU !TEXT "65C802/65C816 CPU REQUIRED.", 13
ANYKEY !TEXT "PRESS ANY KEY...", 0
++ XCE ; SWITCH BACK TO EMULATED MODE
;*
;* INITIALIZE STACK
;*
;INITSP LDX #$FE
; TXS
; LDX #$00
; STX $01FF
;*
;* DISCONNECT /RAM
;*
@ -188,7 +189,7 @@ RAMDONE ;CLI UNTIL I KNOW WHAT TO DO WITH THE UNENHANCED IIE
STY DSTL
LDA #$D0
STA DSTH
- LDA (SRC),Y ; COPY VM+CMD INTO LANGUAGE CARD
- LDA (SRC),Y ; COPY VM+BYE INTO LANGUAGE CARD
STA (DST),Y
INY
BNE -
@ -200,10 +201,7 @@ RAMDONE ;CLI UNTIL I KNOW WHAT TO DO WITH THE UNENHANCED IIE
;*
;* MOVE FIRST PAGE OF 'BYE' INTO PLACE
;*
STY SRCL
LDA #$D1
STA SRCH
- LDA (SRC),Y
- LDA $D100,Y
STA $1000,Y
INY
BNE -
@ -228,13 +226,13 @@ RAMDONE ;CLI UNTIL I KNOW WHAT TO DO WITH THE UNENHANCED IIE
LDA #"D"
INY
STA STRBUF,Y
LDA #"J"
LDA #"1"
INY
STA STRBUF,Y
LDA #"I"
LDA #"2"
INY
STA STRBUF,Y
LDA #"T"
LDA #"8"
INY
STA STRBUF,Y
STY STRBUF
@ -343,26 +341,15 @@ BYE LDY DEFCMD
; STY $01FF
CMDENTRY = *
;
; SET DCI STRING FOR JIT MODULE
;
LDA #'J'|$80
STA JITMOD+0
LDA #'I'|$80
STA JITMOD+1
LDA #'T'|$80
STA JITMOD+2
LDA #'1'|$80
STA JITMOD+3
LDA #'6'
STA JITMOD+4
;
; DEACTIVATE 80 COL CARDS
; DEACTIVATE 80 COL CARDS AND SET DCI STRING FOR JIT MODULE
;
BIT ROMEN
LDY #4
- LDA DISABLE80,Y
ORA #$80
JSR $FDED
LDA JITDCI,Y
STA JITMOD,Y
DEY
BPL -
BIT $C054 ; SET TEXT MODE
@ -376,7 +363,7 @@ CMDENTRY = *
;
; INSTALL PAGE 0 FETCHOP ROUTINE
;
LDY #$11
LDY #$0F
- LDA PAGE0,Y
STA DROP,Y
DEY
@ -440,7 +427,7 @@ CMDENTRY = *
; PRINT FAIL MESSAGE, WAIT FOR KEYPRESS, AND REBOOT
;
FAIL INC $3F4 ; INVALIDATE POWER-UP BYTE
LDY #31
LDY #11
- LDA FAILMSG,Y
ORA #$80
JSR $FDED
@ -460,7 +447,8 @@ READPARMS !BYTE 4
CLOSEPARMS !BYTE 1
!BYTE 0
DISABLE80 !BYTE 21, 13, '1', 26, 13
FAILMSG !TEXT "...TESER OT YEK YNA .DMC GNISSIM"
JITDCI !BYTE 'J'|$80,'I'|$80,'T'|$80,'1'|$80,'6'
FAILMSG !TEXT ".DMC GNISSIM"
PAGE0 = *
;******************************
;* *
@ -470,7 +458,7 @@ PAGE0 = *
!PSEUDOPC DROP {
PLA ; DROP @ $EF
INY ; NEXTOP @ $F0
LDX $FFFF,Y ; FETCHOP @ $F3, IP MAPS OVER $FFFF @ $F4
LDX $FFFF,Y ; FETCHOP @ $F1, IP MAPS OVER $FFFF @ $F2
JMP (OPTBL,X) ; OPIDX AND OPPAGE MAP OVER OPTBL
}
PAGE3 = *
@ -547,7 +535,7 @@ JITINTRPX PHP
STX ALTRDON
LDX #>OPXTBL
!IF DEBUG {
SETDBG LDY LCRWEN+LCBNK2
LDY LCRWEN+LCBNK2
LDY LCRWEN+LCBNK2
STX DBG_OP+2
LDY LCRDEN+LCBNK2
@ -575,11 +563,13 @@ RUNJIT DEX ; ADD PARAMETER TO DEF ENTRY
STA IP
STX ESP
TSX
DEX ; TAKE INTO ACCOUNT JSR BELOW
DEX
STX HWSP
STX ALTRDON
LDX #>OPXTBL
!IF DEBUG {
SETDBG LDY LCRWEN+LCBNK2
LDY LCRWEN+LCBNK2
LDY LCRWEN+LCBNK2
STX DBG_OP+2
LDY LCRDEN+LCBNK2
@ -588,7 +578,7 @@ SETDBG LDY LCRWEN+LCBNK2
STX OPPAGE
LDY #$00
JSR FETCHOP ; CALL JIT COMPILER
!AS
!AS ; RETURN IN EMULATION MODE
PLA
STA TMPH
PLA
@ -738,31 +728,31 @@ DIVMOD +ACCMEM8
;*
;* NEGATE TOS
;*
NEG LDA #$0000
SEC
SBC TOS,S
STA TOS,S
NEG PLA
EOR #$FFFF
INC
PHA
JMP NEXTOP
;*
;* INCREMENT TOS
;*
INCR LDA TOS,S
INCR PLA
INC
STA TOS,S
PHA
JMP NEXTOP
;*
;* DECREMENT TOS
;*
DECR LDA TOS,S
DECR PLA
DEC
STA TOS,S
PHA
JMP NEXTOP
;*
;* BITWISE COMPLIMENT TOS
;*
COMP LDA TOS,S
COMP PLA
EOR #$FFFF
STA TOS,S
PHA
JMP NEXTOP
;*
;* BITWISE AND TOS TO TOS-1
@ -791,11 +781,11 @@ XOR PLA
SHL PLA
TAX
BEQ +
LDA TOS,S
PLA
- ASL
DEX
BNE -
STA TOS,S
PHA
+ JMP NEXTOP
;*
;* SHIFT TOS-1 RIGHT BY TOS
@ -803,12 +793,12 @@ SHL PLA
SHR PLA
TAX
BEQ +
LDA TOS,S
PLA
- CMP #$8000
ROR
DEX
BNE -
STA TOS,S
PHA
+ JMP NEXTOP
;*
;* DUPLICATE TOS
@ -1553,47 +1543,35 @@ BRGT LDA NOS,S
SBC TOS,S
BVS +
BPL NOBRNCH
PLA ; DROP FOR VALUES
PLA
BRA BRNCH ; BMI BRNCH
BMI BRNCH
BRLT LDA TOS,S
SEC
SBC NOS,S
BVS +
BPL NOBRNCH
PLA ; DROP FOR VALUES
PLA
BRA BRNCH ; BMI BRNCH
BMI BRNCH
+ BMI NOBRNCH
PLA ; DROP FOR VALUES
PLA
BRA BRNCH ; BMI BRNCH
DECBRGE LDA TOS,S
BPL BRNCH
DECBRGE PLA
DEC
STA TOS,S
PHA
_BRGE LDA TOS,S
SEC
SBC NOS,S
BVS +
BPL BRNCH
PLA ; DROP FOR VALUES
PLA
BRA NOBRNCH ; BMI NOBRNCH
INCBRLE LDA TOS,S
BMI NOBRNCH
INCBRLE PLA
INC
STA TOS,S
PHA
_BRLE LDA NOS,S
SEC
SBC TOS,S
BVS +
BPL BRNCH
PLA ; DROP FOR VALUES
PLA
BNE NOBRNCH ; BMI NOBRNCH
BMI NOBRNCH
+ BMI BRNCH
PLA ; DROP FOR VALUES
PLA
BRA NOBRNCH ; BMI NOBRNCH
BPL NOBRNCH
SUBBRGE LDA NOS,S
SEC
SBC TOS,S
@ -1995,51 +1973,7 @@ NATV TYA ; FLATTEN IP
SEC
ADC IP
STA IP
SEC ; SWITCH TO EMULATION MODE
XCE
!AS
;+ACCMEM8 ; 8 BIT A/M
TSC ; MOVE HW EVAL STACK TO ZP EVAL STACK
EOR #$FF
SEC
ADC HWSP ; STACK DEPTH = (HWSP - SP)/2
LSR
!IF DEBUG {
PHA
CLC
ADC #$80+'0'
STA $7D0+31
PLA
}
EOR #$FF
SEC
ADC ESP ; ESP - STACK DEPTH
TAX
CPX ESP
BEQ ++
TAY
- PLA
STA ESTKL,X
PLA
STA ESTKH,X
INX
CPX ESP
BNE -
!IF DEBUG {
TSX
CPX HWSP
BEQ +
LDX #$80+'V'
STX $7D0+30
- LDX $C000
BPL -
LDX $C010
+
}
TYX
++ LDA PSR
PHA
PLP
+INDEX16 ; SET 16 BIT X/Y
JMP (IP)
!IF DEBUG {
;*****************

95
src/vmsrc/apple/plvmjit02.s
View File

@ -1,6 +1,6 @@
;**********************************************************
;*
;* APPLE ][ 64K/128K PLASMA INTERPRETER
;* APPLE ][ 128K PLASMA INTERPRETER
;*
;* SYSTEM ROUTINES AND LOCATIONS
;*
@ -61,10 +61,6 @@ JITCODE = $03E4
;* *
;******************************
* = $2000
LDX #$FE
TXS
LDX #$00
STX $01FF
;*
;* MUST HAVE 128K FOR JIT
;*
@ -134,7 +130,7 @@ RAMDONE ;CLI UNTIL I KNOW WHAT TO DO WITH THE UNENHANCED IIE
STY DSTL
LDA #$D0
STA DSTH
- LDA (SRC),Y ; COPY VM+CMD INTO LANGUAGE CARD
- LDA (SRC),Y ; COPY VM+BYE INTO LANGUAGE CARD
STA (DST),Y
INY
BNE -
@ -146,10 +142,7 @@ RAMDONE ;CLI UNTIL I KNOW WHAT TO DO WITH THE UNENHANCED IIE
;*
;* MOVE FIRST PAGE OF 'BYE' INTO PLACE
;*
STY SRCL
LDA #$D1
STA SRCH
- LDA (SRC),Y
- LDA $D100,Y
STA $1000,Y
INY
BNE -
@ -181,13 +174,13 @@ RAMDONE ;CLI UNTIL I KNOW WHAT TO DO WITH THE UNENHANCED IIE
LDA #"D"
INY
STA STRBUF,Y
LDA #"J"
LDA #"1"
INY
STA STRBUF,Y
LDA #"I"
LDA #"2"
INY
STA STRBUF,Y
LDA #"T"
LDA #"8"
INY
STA STRBUF,Y
STY STRBUF
@ -278,22 +271,15 @@ BYE LDY DEFCMD
; STY $01FF
CMDENTRY = *
;
; SET DCI STRING FOR JIT MODULE
;
LDA #'J'|$80
STA JITMOD+0
LDA #'I'|$80
STA JITMOD+1
LDA #'T'
STA JITMOD+2
;
; DEACTIVATE 80 COL CARDS
; DEACTIVATE 80 COL CARDS AND SET DCI STRING FOR JIT MODULE
;
BIT ROMEN
LDY #4
- LDA DISABLE80,Y
ORA #$80
JSR $FDED
LDA JITDCI,Y
STA JITMOD,Y
DEY
BPL -
BIT $C054 ; SET TEXT MODE
@ -316,7 +302,7 @@ CMDENTRY = *
;
; INSTALL PAGE 3 VECTORS
;
LDY #$16
LDY #$12
- LDA PAGE3,Y
STA INTERP,Y
DEY
@ -343,19 +329,6 @@ CMDENTRY = *
!WORD CLOSEPARMS
BNE FAIL
;
; INIT VM ENVIRONMENT STACK POINTERS
;
; LDA #$00
STA $01FF ; CLEAR CMDLINE BUFF
STA PPL ; INIT FRAME POINTER
STA IFPL
LDA #$AF ; FRAME POINTER AT $AF00, BELOW JIT BUFFER
STA PPH
STA IFPH
LDX #$FE ; INIT STACK POINTER (YES, $FE. SEE GETS)
TXS
LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX
;
; CHANGE CMD STRING TO SYSPATH STRING
;
LDA STRBUF
@ -387,6 +360,7 @@ READPARMS !BYTE 4
CLOSEPARMS !BYTE 1
!BYTE 0
DISABLE80 !BYTE 21, 13, '1', 26, 13
JITDCI !BYTE 'J'|$80,'I'|$80,'T'
FAILMSG !TEXT ".DMC GNISSIM"
PAGE0 = *
;******************************
@ -1796,20 +1770,16 @@ BRGT LDA ESTKL+1,X
SBC ESTKH,X
BVS +
BPL NOBRNCH
- INX ; DROP FOR VALUES
INX
BNE BRNCH ; BMI BRNCH
BMI BRNCH
BRLT LDA ESTKL,X
CMP ESTKL+1,X
LDA ESTKH,X
SBC ESTKH+1,X
BVS +
BPL NOBRNCH
INX ; DROP FOR VALUES
INX
BNE BRNCH ; BMI BRNCH
BMI BRNCH
+ BMI NOBRNCH
BPL -
BPL BRNCH
DECBRGE DEC ESTKL,X
LDA ESTKL,X
CMP #$FF
@ -1821,9 +1791,7 @@ _BRGE LDA ESTKL,X
SBC ESTKH+1,X
BVS +
BPL BRNCH
- INX ; DROP FOR VALUES
INX
BNE NOBRNCH ; BMI NOBRNCH
BMI NOBRNCH
INCBRLE INC ESTKL,X
BNE _BRLE
INC ESTKH,X
@ -1833,11 +1801,9 @@ _BRLE LDA ESTKL+1,X
SBC ESTKH,X
BVS +
BPL BRNCH
INX ; DROP FOR VALUES
INX
BNE NOBRNCH ; BMI NOBRNCH
BMI NOBRNCH
+ BMI BRNCH
BPL -
BPL NOBRNCH
SUBBRGE LDA ESTKL+1,X
SEC
SBC ESTKL,X
@ -1866,7 +1832,7 @@ CALL INY ;+INC_IP
LDA (IP),Y
STA TMPH
TYA
CLC
SEC
ADC IPL
PHA
LDA IPH
@ -1879,7 +1845,7 @@ CALL INY ;+INC_IP
STA IPL
LDA #>OPTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE
STA OPPAGE
LDY #$01
LDY #$00
JMP FETCHOP
CALLX INY ;+INC_IP
LDA (IP),Y
@ -1888,7 +1854,7 @@ CALLX INY ;+INC_IP
LDA (IP),Y
STA TMPH
TYA
CLC
SEC
ADC IPL
PHA
LDA IPH
@ -1910,7 +1876,7 @@ CALLX INY ;+INC_IP
STA IPL
LDA #>OPXTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE
STA OPPAGE
LDY #$01
LDY #$00
JMP FETCHOP
;*
;* INDIRECT CALL TO ADDRESS (NATIVE CODE)
@ -1921,7 +1887,7 @@ ICAL LDA ESTKL,X
STA TMPH
INX
TYA
CLC
SEC
ADC IPL
PHA
LDA IPH
@ -1934,7 +1900,7 @@ ICAL LDA ESTKL,X
STA IPL
LDA #>OPTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE
STA OPPAGE
LDY #$01
LDY #$00
JMP FETCHOP
ICALX LDA ESTKL,X
STA TMPL
@ -1942,7 +1908,7 @@ ICALX LDA ESTKL,X
STA TMPH
INX
TYA
CLC
SEC
ADC IPL
PHA
LDA IPH
@ -1956,6 +1922,7 @@ ICALX LDA ESTKL,X
PHP
PLA
STA PSR
SEI
STA ALTRDON
PLA
STA IPH
@ -1963,7 +1930,7 @@ ICALX LDA ESTKL,X
STA IPL
LDA #>OPXTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE
STA OPPAGE
LDY #$01
LDY #$00
JMP FETCHOP
;*
;* JUMP INDIRECT TRHOUGH TMP
@ -2041,11 +2008,11 @@ RET RTS
NATV TYA ; FLATTEN IP
SEC
ADC IPL
STA TMPL
LDA #$00
ADC IPH
STA TMPH
JMP JMPTMP
STA IPL
BCS +
JMP (IP)
+ INC IPH
JMP (IP)
VMEND = *
}
;***************************************

41
src/vmsrc/apple/sossys.pla
View File

@ -1047,7 +1047,7 @@ def adddef(isfirst, ext, addr, deflast)#1
return defentry
end
def loadmod(mod)#1
word refnum[], deffirst, rdlen, modsize, bytecode, codefix, defofst, defcnt, init, fixup
word refnum[], deffirst, rdlen, modsize, bytecode, codefix, defofst, defcnt, init, initcode[], fixup
word addr, defaddr, modaddr, modfix, modofst, modend
word deftbl, deflast, codeseg
word moddep, rld, esd, sym
@ -1059,7 +1059,7 @@ def loadmod(mod)#1
//
dcitos(mod, @filename)
refnum = open(@filename)
if !refnum
if !refnum and filename < 16
//
// Try system path
//
@ -1190,31 +1190,6 @@ def loadmod(mod)#1
*addr = ^rld & $10 ?? *addr + lookupextern(esd, rld->3) :: lookupdef(fixup + codefix, deftbl)
rld = rld + 4
fin
//addr = rld=>1 + modfix
//if uword_isge(addr, modaddr) // Skip fixups to header
// if type & $80 // WORD sized fixup.
// fixup = *addr
// else // BYTE sized fixup.
// fixup = ^addr
// fin
// if ^rld & $10 // EXTERN reference.
// fixup = fixup + lookupextern(esd, rld->3)
// else // INTERN fixup.
// fixup = fixup + modofst
// if uword_isge(fixup, bytecode)
// //
// // Bytecode address - replace with call def directory.
// //
// fixup = lookupdef(fixup + codefix, deftbl)
// fin
// fin
// if type & $80 // WORD sized fixup.
// *addr = fixup
// else // BYTE sized fixup.
// ^addr = fixup
// fin
//fin
//rld = rld + 4
loop
//
// Run through the External/Entry Symbol Directory.
@ -1256,14 +1231,14 @@ def loadmod(mod)#1
//
// Call init routine if it exists.
//
fixup = 0
initcode = 0
if init
fixup = adddef(deffirst, defext, init + defofst, @deflast)()
if fixup < 0
perr = -fixup
initcode = adddef(deffirst, defext, init + defofst, @deflast)()
if initcode < 0
perr = -initcode
fin
fin
return fixup
return initcode
end
def execmod(modfile)#1
byte moddci[17]
@ -1312,7 +1287,7 @@ cmdlnptr = @cmdln
// Print PLASMA version
//
init_cons
prstr("PLASMA JITC 2.0 Dev\n")//; putb(version.1); putc('.'); putb(version.0); putln
prstr("PLASMA 2.0 Dev JITC\n")//; putb(version.1); putc('.'); putb(version.0); putln
prstr("MEM:$"); prword(availheap); crout
//
// Exec command line parser

20
src/vmsrc/c64/cmd.pla
View File

@ -30,14 +30,13 @@ predef sext(a)#1, divmod(a,b)#2, execmod(modfile)#1
//
// Exported CMDSYS table
//
word version = $0110 // 01.10
word version = $0200 // 02.00
word syspath
word syscmdln
word = @execmod
word systemflags = 0
word heap
word symtbl, lastsym
byte perr, refauto
word = @execmod, 0, 0, 0, 0
byte perr
byte jitcount = 0
byte jitsize = 0
//
// String pool.
//
@ -115,6 +114,13 @@ word = @machidstr, @machid
word = 0
word syslibsym = @exports
//
// System variable.
//
word systemflags = 0
word heap
word symtbl, lastsym
byte refauto
//
// Utility functions
//
asm saveX#0
@ -1072,7 +1078,7 @@ heap = *freemem
//
// Print PLASMA version
//
prstr("\nPRELIM PLASMA "); prbyte(version.1); cout('.'); prbyte(version.0); crout
prstr("\nPLASMA 2.0 Dev\n") //; prbyte(version.1); cout('.'); prbyte(version.0); crout
//
// Init symbol table.
//

331
src/vmsrc/c64/plvmc64.s
View File

@ -121,6 +121,7 @@ OPTBL !WORD CN,CN,CN,CN,CN,CN,CN,CN ; 00 02
!WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 90 92 94 96 98 9A 9C 9E
!WORD BRGT,BRLT,INCBRLE,ADDBRLE,DECBRGE,SUBBRGE,BRAND,BROR ; A0 A2 A4 A6 A8 AA AC AE
!WORD ADDLB,ADDLW,ADDAB,ADDAW,IDXLB,IDXLW,IDXAB,IDXAW ; B0 B2 B4 B6 B8 BA BC BE
!WORD NATV ; C0
;*
;* DIV TOS-1 BY TOS
;*
@ -143,7 +144,7 @@ MOD JSR _DIV
;* DIVMOD TOS-1 BY TOS
;*
DIVMOD JSR _DIV
LSR DVSIGN ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1
LSR DVSIGN ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1
BCC +
JSR _NEG
+ DEX
@ -527,45 +528,72 @@ LLW INY ;+INC_IP
;*
;* ADD VALUE FROM LOCAL FRAME OFFSET
;*
ADDLB LDA #$60 ; RTS
STA NEXTOP
JSR LLB
LDA #$C8 ; INY
STA NEXTOP
JMP ADD
ADDLBX LDA #$60 ; RTS
STA NEXTOP
JSR LLBX
LDA #$C8 ; INY
STA NEXTOP
JMP ADD
ADDLW LDA #$60 ; RTS
STA NEXTOP
JSR LLW
LDA #$C8 ; INY
STA NEXTOP
JMP ADD
ADDLWX LDA #$60 ; RTS
STA NEXTOP
JSR LLWX
LDA #$C8 ; INY
STA NEXTOP
JMP ADD
ADDLB INY ;+INC_IP
LDA (IP),Y
STY IPY
TAY
LDA (IFP),Y
CLC
ADC ESTKL,X
STA ESTKL,X
BCC +
INC ESTKH,X
+ LDY IPY
JMP NEXTOP
ADDLW INY ;+INC_IP
LDA (IP),Y
STY IPY
TAY
LDA (IFP),Y
CLC
ADC ESTKL,X
STA ESTKL,X
INY
LDA (IFP),Y
ADC ESTKH,X
STA ESTKH,X
LDY IPY
JMP NEXTOP
;*
;* INDEX VALUE FROM LOCAL FRAME OFFSET
;*
IDXLB LDA #$60 ; RTS
STA NEXTOP
JSR LLB
LDA #$C8 ; INY
STA NEXTOP
JMP IDXW
IDXLW LDA #$60 ; RTS
STA NEXTOP
JSR LLW
LDA #$C8 ; INY
STA NEXTOP
JMP IDXW
IDXLB INY ;+INC_IP
LDA (IP),Y
STY IPY
TAY
LDA (IFP),Y
LDY #$00
ASL
BCC +
INY
CLC
+ ADC ESTKL,X
STA ESTKL,X
TYA
ADC ESTKH,X
STA ESTKH,X
LDY IPY
JMP NEXTOP
IDXLW INY ;+INC_IP
LDA (IP),Y
STY IPY
TAY
LDA (IFP),Y
ASL
STA TMPL
INY
LDA (IFP),Y
ROL
STA TMPH
LDA TMPL
CLC
ADC ESTKL,X
STA ESTKL,X
LDA TMPH
ADC ESTKH,X
STA ESTKH,X
LDY IPY
JMP NEXTOP
;*
;* LOAD VALUE FROM ABSOLUTE ADDRESS
;*
@ -600,33 +628,84 @@ LAW INY ;+INC_IP
;*
;* ADD VALUE FROM ABSOLUTE ADDRESS
;*
ADDAB LDA #$60 ; RTS
STA NEXTOP
JSR LAB
LDA #$C8 ; INY
STA NEXTOP
JMP ADD
ADDAW LDA #$60 ; RTS
STA NEXTOP
JSR LAW
LDA #$C8 ; INY
STA NEXTOP
JMP ADD
ADDAB INY ;+INC_IP
LDA (IP),Y
STA ESTKH-2,X
INY ;+INC_IP
LDA (IP),Y
STA ESTKH-1,X
LDA (ESTKH-2,X)
CLC
ADC ESTKL,X
STA ESTKL,X
BCC +
INC ESTKH,X
+ JMP NEXTOP
ADDAW INY ;+INC_IP
LDA (IP),Y
STA SRCL
INY ;+INC_IP
LDA (IP),Y
STA SRCH
STY IPY
LDY #$00
LDA (SRC),Y
CLC
ADC ESTKL,X
STA ESTKL,X
INY
LDA (SRC),Y
ADC ESTKH,X
STA ESTKH,X
LDY IPY
JMP NEXTOP
;*
;* INDEX VALUE FROM ABSOLUTE ADDRESS
;*
IDXAB LDA #$60 ; RTS
STA NEXTOP
JSR LAB
LDA #$C8 ; INY
STA NEXTOP
JMP IDXW
IDXAW LDA #$60 ; RTS
STA NEXTOP
JSR LAW
LDA #$C8 ; INY
STA NEXTOP
JMP IDXW
IDXAB INY ;+INC_IP
LDA (IP),Y
STA ESTKH-2,X
INY ;+INC_IP
LDA (IP),Y
STA ESTKH-1,X
LDA (ESTKH-2,X)
STY IPY
LDY #$00
ASL
BCC +
INY
CLC
+ ADC ESTKL,X
STA ESTKL,X
TYA
ADC ESTKH,X
STA ESTKH,X
LDY IPY
JMP NEXTOP
IDXAW INY ;+INC_IP
LDA (IP),Y
STA SRCL
INY ;+INC_IP
LDA (IP),Y
STA SRCH
STY IPY
LDY #$00
LDA (SRC),Y
ASL
STA TMPL
INY
LDA (SRC),Y
ROL
STA TMPH
LDA TMPL
CLC
ADC ESTKL,X
STA ESTKL,X
LDA TMPH
ADC ESTKH,X
STA ESTKH,X
LDY IPY
JMP NEXTOP
;*
;* STORE VALUE TO ADDRESS
;*
@ -694,6 +773,8 @@ DLB INY ;+INC_IP
TAY
LDA ESTKL,X
STA (IFP),Y
LDA #$00
STA ESTKH,X
LDY IPY
JMP NEXTOP
DLW INY ;+INC_IP
@ -754,6 +835,8 @@ DAB INY ;+INC_IP
STA ESTKH-1,X
LDA ESTKL,X
STA (ESTKH-2,X)
LDA #$00
STA ESTKH,X
JMP NEXTOP
DAW INY ;+INC_IP
LDA (IP),Y
@ -850,20 +933,17 @@ SEL INX
DEY
LDA (IP),Y
STA TMPL ; CASE COUNT
LDA ESTKL-1,X
INC IPL
BNE CASELP
INC IPH
CASELP CMP (IP),Y
BNE +
CASELP LDA ESTKL-1,X
CMP (IP),Y
BEQ +
LDA ESTKH-1,X
INY
CMP (IP),Y
BEQ BRNCH
LDA ESTKL-1,X
DEY
+ INY
INY
SBC (IP),Y
BMI CASEEND
- INY
INY
DEC TMPL
BEQ FIXNEXT
@ -871,6 +951,27 @@ CASELP CMP (IP),Y
BNE CASELP
INC IPH
BNE CASELP
+ LDA ESTKH-1,X
INY
SBC (IP),Y
BEQ BRNCH
BPL -
CASEEND LDA #$00
STA TMPH
DEC TMPL
LDA TMPL
ASL ; SKIP REMAINING CASES
ROL TMPH
ASL
ROL TMPH
; CLC
ADC IPL
STA IPL
LDA TMPH
ADC IPH
STA IPH
INY
INY
FIXNEXT TYA
LDY #$00
SEC
@ -946,20 +1047,16 @@ BRGT LDA ESTKL+1,X
SBC ESTKH,X
BVS +
BPL NOBRNCH
- INX ; DROP FOR VALUES
INX
BNE BRNCH ; BMI BRNCH
BMI BRNCH
BRLT LDA ESTKL,X
CMP ESTKL+1,X
LDA ESTKH,X
SBC ESTKH+1,X
BVS +
BPL NOBRNCH
INX ; DROP FOR VALUES
INX
BNE BRNCH ; BMI BRNCH
BMI BRNCH
+ BMI NOBRNCH
BPL -
BPL BRNCH
DECBRGE DEC ESTKL,X
LDA ESTKL,X
CMP #$FF
@ -971,9 +1068,7 @@ _BRGE LDA ESTKL,X
SBC ESTKH+1,X
BVS +
BPL BRNCH
- INX ; DROP FOR VALUES
INX
BNE NOBRNCH ; BMI NOBRNCH
BMI NOBRNCH
INCBRLE INC ESTKL,X
BNE _BRLE
INC ESTKH,X
@ -983,11 +1078,9 @@ _BRLE LDA ESTKL+1,X
SBC ESTKH,X
BVS +
BPL BRNCH
INX ; DROP FOR VALUES
INX
BNE NOBRNCH ; BMI NOBRNCH
BMI NOBRNCH
+ BMI BRNCH
BPL -
BPL NOBRNCH
SUBBRGE LDA ESTKL+1,X
SEC
SBC ESTKL,X
@ -1007,15 +1100,6 @@ ADDBRLE LDA ESTKL,X
INX
BNE _BRLE
;*
;* 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
@ -1024,8 +1108,8 @@ CALL INY ;+INC_IP
INY ;+INC_IP
LDA (IP),Y
STA TMPH
_CALL TYA
CLC
TYA
SEC
ADC IPL
PHA
LDA IPH
@ -1036,7 +1120,29 @@ _CALL TYA
STA IPH
PLA
STA IPL
LDY #$01
LDY #$00
JMP FETCHOP
;*
;* INDIRECT CALL TO ADDRESS (NATIVE CODE)
;*
ICAL LDA ESTKL,X
STA TMPL
LDA ESTKH,X
STA TMPH
INX
TYA
SEC
ADC IPL
PHA
LDA IPH
ADC #$00
PHA
JSR JMPTMP
PLA
STA IPH
PLA
STA IPL
LDY #$00
JMP FETCHOP
;*
;* ENTER FUNCTION WITH FRAME SIZE AND PARAM COUNT
@ -1076,28 +1182,39 @@ LEAVE INY ;+INC_IP
RTS
+ INC IFPH
RET RTS
;*
;* RETURN TO NATIVE CODE
;*
NATV TYA ; FLATTEN IP
SEC
ADC IPL
STA IPL
BCS +
JMP (IP)
+ INC IPH
JMP (IP)
CMD !SOURCE "vmsrc/c64/cmd.a"
SEGEND = *
VMINIT JSR $FFE7 ; CLOSE ALL CHANNELS
LDY #$10 ; INSTALL PAGE 0 FETCHOP ROUTINE
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
LDA #$4C ; SET JMPTMP OPCODE
STA JMPTMP
STY IFPL ; INIT FRAME POINTER TO $D000
STY IFPL ; INIT FRAME POINTER TO $D000
LDA #$D0
STA IFPH
LDA #<SEGEND ; SAVE HEAP START
LDA #<SEGEND ; SAVE HEAP START
STA $0100
LDA #>SEGEND
STA $0101
LDX #$FF ; INIT STACK POINTER
LDX #$FF ; INIT STACK POINTER
TXS
LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX
LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX
LDA $01
AND #$FE ; SWAP OUT BASIC ROM
AND #$FE ; SWAP OUT BASIC ROM
STA $01
JMP CMD
PAGE0 = *
@ -1105,9 +1222,9 @@ PAGE0 = *
;*
;* INTERP BYTECODE INNER LOOP
;*
INX ; DROP
INY ; NEXTOP
LDA $FFFF,Y ; FETCHOP @ $F3, IP MAPS OVER $FFFF @ $F4
INX ; DROP
INY ; NEXTOP
LDA $FFFF,Y ; FETCHOP @ $F3, IP MAPS OVER $FFFF @ $F4
STA OPIDX
JMP (OPTBL)
}

153
src/vmsrc/plvm.c
View File

@ -526,7 +526,7 @@ void call(uword pc)
*
OPTBL DW CN,CN,CN,CN,CN,CN,CN,CN ; 00 02 04 06 08 0A 0C 0E
DW CN,CN,CN,CN,CN,CN,CN,CN ; 10 12 14 16 18 1A 1C 1E
DW MINUS1,NEXTOP,NEXTOP,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E
DW MINUS1,BREQ,BRNE,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E
DW DROP,DROP2,DUP,DIVMOD,ADDI,SUBI,ANDI,ORI ; 30 32 34 36 38 3A 3C 3E
DW ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E
DW BRNCH,SEL,CALL,ICAL,ENTER,LEAVE,RET,CFFB ; 50 52 54 56 58 5A 5C 5E
@ -535,10 +535,11 @@ OPTBL DW CN,CN,CN,CN,CN,CN,CN,CN ; 00 02 04 06
DW LNOT,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 80 82 84 86 88 8A 8C 8E
DW NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 90 92 94 96 98 9A 9C 9E
DW BRGT,BRLT,INCBRLE,ADDBRLE,DECBRGE,SUBBRGE,BRAND,BROR ; A0 A2 A4 A6 A8 AA AC AE
DW ADDLB,ADDLW,ADDAB,ADDAW,IDXLB,IDXLW,IDXAB,IDXAW ; B0 B2 B4 B6 B8 BA BC BE
*/
void interp(code *ip)
{
int val, ea, frmsz, parmcnt, nybble;
int val, ea, frmsz, parmcnt;
code *previp = ip;
while (1)
@ -558,7 +559,6 @@ void interp(code *ip)
printf("]\n");
gets(cmdline);
}
nybble = 15;
previp = ip;
switch (*ip++)
{
@ -566,53 +566,42 @@ void interp(code *ip)
* 0x00-0x1F
*/
case 0x00:
nybble--;
case 0x02:
nybble--;
case 0x04:
nybble--;
case 0x06:
nybble--;
case 0x08:
nybble--;
case 0x0A:
nybble--;
case 0x0C:
nybble--;
case 0x0E:
nybble--;
case 0x10:
nybble--;
case 0x12:
nybble--;
case 0x14:
nybble--;
case 0x16:
nybble--;
case 0x18:
nybble--;
case 0x1A:
nybble--;
case 0x1C:
nybble--;
case 0x1E:
PUSH(nybble);
PUSH(*previp/2);
break;
/*
* 0x20-0x2F
*/
case 0x20: // NOT : TOS = !TOS
TOS = !TOS;
case 0x20: // MINUS 1 : TOS = -1
PUSH(-1);
break;
case 0x22: // LOR : TOS = TOS || TOS-1
case 0x22: // BREQ
val = POP;
ea = POP;
PUSH(ea || val);
if (val == POP)
ip += WORD_PTR(ip) ;
else
ip += 2;
break;
case 0x24: // LAND : TOS = TOS && TOS-1
case 0x24: // BRNE
val = POP;
ea = POP;
PUSH(ea && val);
if (val != POP)
ip += WORD_PTR(ip) ;
else
ip += 2;
break;
case 0x26: // LA : TOS = @VAR ; equivalent to CW ADDRESSOF(VAR)
PUSH(WORD_PTR(ip));
@ -640,7 +629,7 @@ void interp(code *ip)
case 0x30: // DROP : TOS =
POP;
break;
case 0x32: // DROP2 : TOS ==
case 0x32: // DROP2 : TOS =, TOS =
POP;
POP;
break;
@ -728,7 +717,7 @@ void interp(code *ip)
{
ip += 2;
ip += WORD_PTR(ip);
parmcnt = 0;
break;
}
else
ip += 4;
@ -745,7 +734,6 @@ void interp(code *ip)
case 0x58: // ENTER : NEW FRAME, FOREACH PARAM LOCALVAR = TOS
frmsz = BYTE_PTR(ip);
ip++;
PHA(frmsz);
if (show_state)
printf("< $%04X: $%04X > ", fp - frmsz, fp);
fp -= frmsz;
@ -763,7 +751,7 @@ void interp(code *ip)
printf("\n");
break;
case 0x5A: // LEAVE : DEL FRAME, IP = TOFP
fp += PLA;
fp += BYTE_PTR(ip);
case 0x5C: // RET : IP = TOFP
return;
case 0x5E: // CFFB : TOS = CONSTANTBYTE(IP) | 0xFF00
@ -801,6 +789,7 @@ void interp(code *ip)
break;
case 0x6C: // DLB : TOS = TOS, LOCALBYTE [IP] = TOS
mem_data[TO_UWORD(fp + BYTE_PTR(ip))] = TOS;
TOS = TOS & 0xFF;
ip++;
break;
case 0x6E: // DLW : TOS = TOS, LOCALWORD [IP] = TOS
@ -847,6 +836,7 @@ void interp(code *ip)
break;
case 0x7C: // DAB : TOS = TOS, BYTE (IP) = TOS
mem_data[UWORD_PTR(ip)] = TOS;
TOS = TOS & 0xFF;
ip += 2;
break;
case 0x7E: // DAW : TOS = TOS, WORD (IP) = TOS
@ -855,11 +845,11 @@ void interp(code *ip)
mem_data[ea + 1] = TOS >> 8;
ip += 2;
break;
/*
* 0x080-0x08F
*/
case 0x80: // ZERO : TOS = 0
PUSH(0);
/*
* 0x080-0x08F
*/
case 0x80: // NOT : TOS = !TOS
TOS = !TOS;
break;
case 0x82: // ADD : TOS = TOS + TOS-1
val = POP;
@ -931,92 +921,62 @@ void interp(code *ip)
ea = POP;
PUSH(ea + val * 2);
break;
/*
/*
* 0xA0-0xAF
*/
case 0xA0: // BRGT : TOS-1 > TOS ? IP += (IP)
val = POP;
if (TOS < val)
{
POP;
ip += WORD_PTR(ip);
}
else
{
PUSH(val);
ip += 2;
}
PUSH(val);
break;
case 0xA2: // BRLT : TOS-1 < TOS ? IP += (IP)
val = POP;
if (TOS > val)
{
POP;
ip += WORD_PTR(ip);
}
else
{
PUSH(val);
ip += 2;
}
PUSH(val);
break;
case 0xA4: // INCBRLE : TOS = TOS + 1
val = POP;
val++;
if (TOS >= val)
{
PUSH(val);
ip += WORD_PTR(ip);
}
else
{
POP;
ip += 2;
}
PUSH(val);
break;
case 0xA6: // ADDBRLE : TOS = TOS + TOS-1
val = POP;
ea = POP;
val = ea + val;
if (TOS >= val)
{
PUSH(val);
ip += WORD_PTR(ip);
}
else
{
POP;
ip += 2;
}
PUSH(val);
break;
case 0xA8: // DECBRGE : TOS = TOS - 1
val = POP;
val--;
if (TOS <= val)
{
PUSH(val);
ip += WORD_PTR(ip);
}
else
{
POP;
ip += 2;
}
PUSH(val);
break;
case 0xAA: // SUBBRGE : TOS = TOS-1 - TOS
val = POP;
ea = POP;
val = ea - val;
if (TOS <= val)
{
PUSH(val);
ip += WORD_PTR(ip);
}
else
{
POP;
ip += 2;
}
PUSH(val);
break;
case 0xAC: // BRAND : SHORT CIRCUIT AND
if (TOS) // EVALUATE RIGHT HAND OF AND
@ -1040,6 +1000,53 @@ void interp(code *ip)
ip += WORD_PTR(ip);
}
break;
/*
* 0xB0-0xBF
*/
case 0xB0: // ADDLB : TOS = TOS + LOCALBYTE[IP]
val = POP + mem_data[TO_UWORD(fp + BYTE_PTR(ip))];
PUSH(val);
ip++;
break;
case 0xB2: // ADDLW : TOS = TOS + LOCALWORD[IP]
ea = TO_UWORD(fp + BYTE_PTR(ip));
val = POP + (mem_data[ea] | (mem_data[ea + 1] << 8));
PUSH(val);
ip++;
break;
case 0xB4: // ADDAB : TOS = TOS + BYTE[IP]
val = POP + mem_data[UWORD_PTR(ip)];
PUSH(val);
ip += 2;
break;
case 0xB6: // ADDAW : TOS = TOS + WORD[IP]
ea = UWORD_PTR(ip);
val = POP + (mem_data[ea] | (mem_data[ea + 1] << 8));
PUSH(val);
ip += 2;
break;
case 0xB8: // IDXLB : TOS = TOS + LOCALBYTE[IP]*2
val = POP + mem_data[TO_UWORD(fp + BYTE_PTR(ip))] * 2;
PUSH(val);
ip++;
break;
case 0xBA: // IDXLW : TOS = TOS + LOCALWORD[IP]*2
ea = TO_UWORD(fp + BYTE_PTR(ip));
val = POP + (mem_data[ea] | (mem_data[ea + 1] << 8)) * 2;
PUSH(val);
ip++;
break;
case 0xBC: // IDXAB : TOS = TOS + BYTE[IP]*2
val = POP + mem_data[UWORD_PTR(ip)] * 2;
PUSH(val);
ip += 2;
break;
case 0xBE: // IDXAW : TOS = TOS + WORD[IP]*2
ea = UWORD_PTR(ip);
val = POP + (mem_data[ea] | (mem_data[ea + 1] << 8)) * 2;
PUSH(val);
ip += 2;
break;
/*
* Odd codes and everything else are errors.
*/