mirror of https://github.com/dschmenk/VM02.git
493 lines
7.6 KiB
Plaintext
Executable File
493 lines
7.6 KiB
Plaintext
Executable File
const iobuffer = $0800
|
|
const databuff = $0C00
|
|
const autorun = $01FF
|
|
byte version[] = "PLASMA ][ VM VERSION 0.8"
|
|
byte errorstr[] = "ERROR: $"
|
|
byte okstr[] = "OK"
|
|
byte prefix[32] = ""
|
|
byte perr
|
|
word cmdptr
|
|
|
|
;
|
|
; Utility functions
|
|
;
|
|
; CALL PRODOS
|
|
; SYSCALL(CMD, PARAMS)
|
|
;
|
|
asm prodos
|
|
LDA ESTKL,X
|
|
LDY ESTKH,X
|
|
STA PARAMS
|
|
STY PARAMS+1
|
|
INX
|
|
LDA ESTKL,X
|
|
STA CMD
|
|
STX ESP
|
|
JSR $BF00
|
|
CMD: DB 00
|
|
PARAMS: DW 0000
|
|
BIT LCBNK2
|
|
LDX ESP
|
|
STA ESTKL,X
|
|
LDY #$00
|
|
STY ESTKH,X
|
|
end
|
|
;
|
|
; CALL LOADED SYSTEM PROGRAM
|
|
;
|
|
asm exec
|
|
LDX #$FF
|
|
TXS
|
|
BIT ROMIN
|
|
JMP $2000
|
|
end
|
|
;
|
|
; SET MEMORY TO 0
|
|
; MEMCLR(ADDR, SIZE)
|
|
;
|
|
asm memclr
|
|
LDY #$00
|
|
LDA ESTKL+1,X
|
|
STA DSTL
|
|
LDA ESTKH+1,X
|
|
STA DSTH
|
|
INC ESTKL,X
|
|
INC ESTKH,X
|
|
TYA
|
|
SETMLP: DEC ESTKL,X
|
|
BNE :+
|
|
DEC ESTKH,X
|
|
BEQ :++
|
|
: STA (DST),Y
|
|
INY
|
|
BNE SETMLP
|
|
INC DSTH
|
|
BNE SETMLP
|
|
: INX
|
|
INX
|
|
end
|
|
;
|
|
; COPY MEMORY
|
|
; MEMCPY(SRCADDR, DSTADDR, SIZE)
|
|
;
|
|
asm memcpy
|
|
LDY #$00
|
|
LDA ESTKL,X
|
|
BNE :+
|
|
LDA ESTKH,X
|
|
BEQ MEMEXIT
|
|
: LDA ESTKL+1,X
|
|
STA DSTL
|
|
LDA ESTKH+1,X
|
|
STA DSTH
|
|
LDA ESTKL+2,X
|
|
STA SRCL
|
|
LDA ESTKH+2,X
|
|
STA SRCH
|
|
CMP DSTH
|
|
BCC REVCPY
|
|
BNE FORCPY
|
|
LDA SRCL
|
|
CMP DSTL
|
|
BCS FORCPY
|
|
REVCPY: ; REVERSE DIRECTION COPY
|
|
; CLC
|
|
LDA ESTKL,X
|
|
ADC DSTL
|
|
STA DSTL
|
|
LDA ESTKH,X
|
|
ADC DSTH
|
|
STA DSTH
|
|
CLC
|
|
LDA ESTKL,X
|
|
ADC SRCL
|
|
STA SRCL
|
|
LDA ESTKH,X
|
|
ADC SRCH
|
|
STA SRCH
|
|
INC ESTKH,X
|
|
REVCPYLP:
|
|
LDA DSTL
|
|
BNE :+
|
|
DEC DSTH
|
|
: DEC DSTL
|
|
LDA SRCL
|
|
BNE :+
|
|
DEC SRCH
|
|
: DEC SRCL
|
|
LDA (SRC),Y
|
|
STA (DST),Y
|
|
DEC ESTKL,X
|
|
BNE REVCPYLP
|
|
DEC ESTKH,X
|
|
BNE REVCPYLP
|
|
BEQ MEMEXIT
|
|
FORCPY: INC ESTKH,X
|
|
FORCPYLP:
|
|
LDA (SRC),Y
|
|
STA (DST),Y
|
|
INC DSTL
|
|
BNE :+
|
|
INC DSTH
|
|
: INC SRCL
|
|
BNE :+
|
|
INC SRCH
|
|
: DEC ESTKL,X
|
|
BNE FORCPYLP
|
|
DEC ESTKH,X
|
|
BNE FORCPYLP
|
|
MEMEXIT: INX
|
|
INX
|
|
INX
|
|
end
|
|
;
|
|
; CHAR OUT
|
|
; COUT(CHAR)
|
|
;
|
|
asm cout
|
|
LDA ESTKL,X
|
|
INX
|
|
ORA #$80
|
|
BIT ROMIN
|
|
JSR $FDED
|
|
BIT LCBNK2
|
|
end
|
|
;
|
|
; CHAR IN
|
|
; RDKEY()
|
|
;
|
|
asm cin
|
|
BIT ROMIN
|
|
STX ESP
|
|
JSR $FD0C
|
|
LDX ESP
|
|
BIT LCBNK2
|
|
DEX
|
|
STA ESTKL,X
|
|
LDY #$00
|
|
STY ESTKH,X
|
|
end
|
|
;
|
|
; PRINT STRING
|
|
; PRSTR(STR)
|
|
;
|
|
asm prstr
|
|
LDY #$00
|
|
LDA ESTKL,X
|
|
STA SRCL
|
|
LDA ESTKH,X
|
|
STA SRCH
|
|
BIT ROMIN
|
|
LDA (SRC),Y
|
|
STA ESTKL,X
|
|
BEQ :+
|
|
_PRS1: INY
|
|
LDA (SRC),Y
|
|
ORA #$80
|
|
JSR $FDED
|
|
TYA
|
|
CMP ESTKL,X
|
|
BNE _PRS1
|
|
: INX
|
|
BIT LCBNK2
|
|
end
|
|
;
|
|
; PRINT BYTE
|
|
;
|
|
asm prbyte
|
|
LDA ESTKL,X
|
|
INX
|
|
STX ESP
|
|
BIT ROMIN
|
|
JSR $FDDA
|
|
BIT LCBNK2
|
|
LDX ESP
|
|
end
|
|
;
|
|
; READ STRING
|
|
; STR = RDSTR(PROMPTCHAR)
|
|
;
|
|
asm rdstr
|
|
LDA ESTKL,X
|
|
STA $33
|
|
STX ESP
|
|
BIT ROMIN
|
|
JSR $FD6A
|
|
BIT LCBNK2
|
|
STX $01FF
|
|
: LDA $01FF,X
|
|
AND #$7F
|
|
STA $01FF,X
|
|
DEX
|
|
BPL :-
|
|
LDX ESP
|
|
LDA #$FF
|
|
STA ESTKL,X
|
|
LDA #$01
|
|
STA ESTKH,X
|
|
end
|
|
asm toupper
|
|
LDA ESTKL,X
|
|
CMP #'a'
|
|
BCC :+
|
|
CMP #'z'+1
|
|
BCS :+
|
|
SEC
|
|
SBC #$20
|
|
STA ESTKL,X
|
|
:
|
|
end
|
|
;
|
|
; EXIT
|
|
;
|
|
asm reboot
|
|
BIT ROMIN
|
|
LDA #$00
|
|
STA $3F4 ; INVALIDATE POWER-UP BYTE
|
|
JMP ($FFFC) ; RESET
|
|
end
|
|
def crout
|
|
cout($0D)
|
|
end
|
|
;
|
|
; ProDOS routines
|
|
;
|
|
def getpfx(path)
|
|
byte params[3]
|
|
|
|
^path = 0
|
|
params.0 = 1
|
|
params:1 = path
|
|
perr = prodos($C7, @params)
|
|
return path
|
|
end
|
|
def setpfx(path)
|
|
byte params[3]
|
|
|
|
params.0 = 1
|
|
params:1 = path
|
|
perr = prodos($C6, @params)
|
|
return path
|
|
end
|
|
def online
|
|
byte params[4]
|
|
|
|
params.0 = 2
|
|
params.1 = 0
|
|
params:2 = $2000
|
|
perr = prodos($C5, @params)
|
|
return $2000
|
|
end
|
|
def open(path, buff)
|
|
byte params[6]
|
|
|
|
params.0 = 3
|
|
params:1 = path
|
|
params:3 = buff
|
|
params.5 = 0
|
|
perr = prodos($C8, @params)
|
|
return params.5
|
|
end
|
|
def close(refnum)
|
|
byte params[2]
|
|
|
|
params.0 = 1
|
|
params.1 = refnum
|
|
perr = prodos($CC, @params)
|
|
return perr
|
|
end
|
|
def read(refnum, buff, len)
|
|
byte params[8]
|
|
|
|
params.0 = 4
|
|
params.1 = refnum
|
|
params:2 = buff
|
|
params:4 = len
|
|
params:6 = 0
|
|
perr = prodos($CA, @params)
|
|
return params:6
|
|
end
|
|
;
|
|
; Command mode
|
|
;
|
|
def volumes
|
|
word strbuf
|
|
byte i
|
|
|
|
strbuf = online()
|
|
for i = 0 to 15
|
|
^strbuf = ^strbuf & $0F
|
|
if ^strbuf
|
|
cout('/')
|
|
prstr(strbuf)
|
|
crout()
|
|
fin
|
|
strbuf = strbuf + 16
|
|
next
|
|
end
|
|
def catalog(optpath)
|
|
byte path[64]
|
|
byte refnum
|
|
byte firstblk
|
|
byte entrylen, entriesblk
|
|
byte i, type, len
|
|
word entry, filecnt
|
|
|
|
if ^optpath
|
|
memcpy(optpath, @path, ^optpath + 1)
|
|
else
|
|
drop getpfx(@path)
|
|
prstr(@path)
|
|
crout()
|
|
fin
|
|
refnum = open(@path, iobuffer);
|
|
if perr
|
|
return perr
|
|
fin
|
|
firstblk = 1
|
|
repeat
|
|
if read(refnum, databuff, 512) == 512
|
|
entry = databuff + 4
|
|
if firstblk
|
|
entrylen = databuff.$23
|
|
entriesblk = databuff.$24
|
|
filecnt = databuff:$25
|
|
entry = entry + entrylen
|
|
fin
|
|
for i = firstblk to entriesblk
|
|
type = ^entry
|
|
if type <> 0
|
|
len = type & $0F
|
|
^entry = len
|
|
prstr(entry)
|
|
if type & $F0 == $D0 ; Is it a directory?
|
|
cout('/')
|
|
len = len + 1
|
|
elsif (entry).$10 == $FF
|
|
cout('*')
|
|
len = len + 1
|
|
fin
|
|
for len = 19 - len downto 0
|
|
cout(' ')
|
|
next
|
|
filecnt = filecnt - 1
|
|
fin
|
|
entry = entry + entrylen
|
|
next
|
|
firstblk = 0
|
|
else
|
|
filecnt = 0
|
|
fin
|
|
until filecnt == 0
|
|
drop close(refnum)
|
|
crout()
|
|
return 0
|
|
end
|
|
def stripchars(strptr)
|
|
while ^strptr and ^(strptr + 1) <> ' '
|
|
memcpy(strptr + 2, strptr + 1, ^strptr)
|
|
^strptr = ^strptr - 1
|
|
loop
|
|
return ^strptr
|
|
end
|
|
def stripspaces(strptr)
|
|
while ^strptr and ^(strptr + ^strptr) <= ' '
|
|
^strptr = ^strptr - 1
|
|
loop
|
|
while ^strptr and ^(strptr + 1) <= ' '
|
|
memcpy(strptr + 2, strptr + 1, ^strptr)
|
|
^strptr = ^strptr - 1
|
|
loop
|
|
end
|
|
def striptrail(strptr)
|
|
byte i
|
|
|
|
for i = 1 to ^strptr
|
|
if (strptr)[i] == ' '
|
|
^strptr = i - 1
|
|
return
|
|
fin
|
|
next
|
|
end
|
|
def parsecmd(strptr)
|
|
byte cmd
|
|
|
|
cmd = 0
|
|
stripspaces(strptr)
|
|
if ^strptr
|
|
cmd = ^(strptr + 1)
|
|
memcpy(strptr + 2, strptr + 1, ^strptr)
|
|
^strptr = ^strptr - 1
|
|
fin
|
|
stripspaces(strptr)
|
|
return cmd
|
|
end
|
|
def resetmemfiles
|
|
;
|
|
; Close all files
|
|
;
|
|
^$BFD8 = 0
|
|
drop close(0)
|
|
;
|
|
; Set memory bitmap
|
|
;
|
|
memclr($BF58, 24)
|
|
^$BF58 = $CF
|
|
^$BF6F = $01
|
|
end
|
|
def execsys(sysfile)
|
|
byte refnum
|
|
word len
|
|
|
|
if ^sysfile
|
|
memcpy(sysfile, $280, ^sysfile + 1)
|
|
striptrail(sysfile)
|
|
refnum = open(sysfile, iobuffer)
|
|
if refnum
|
|
len = read(refnum, $2000, $FFFF)
|
|
resetmemfiles()
|
|
if len
|
|
memcpy($280, sysfile, ^$280 + 1)
|
|
if stripchars(sysfile) and ^$2000 == $4C and *$2003 == $EEEE
|
|
stripspaces(sysfile)
|
|
if ^$2006 <= ^sysfile
|
|
memcpy(sysfile, $2006, ^sysfile + 1)
|
|
fin
|
|
fin
|
|
striptrail($280)
|
|
exec()
|
|
fin
|
|
fin
|
|
fin
|
|
end
|
|
|
|
resetmemfiles()
|
|
execsys(autorun)
|
|
prstr(@version)
|
|
crout();
|
|
while 1
|
|
prstr(getpfx(@prefix))
|
|
cmdptr = rdstr($BA)
|
|
when toupper(parsecmd(cmdptr))
|
|
is 'Q'
|
|
reboot()
|
|
is 'C'
|
|
drop catalog(cmdptr)
|
|
is 'P'
|
|
drop setpfx(cmdptr)
|
|
is 'V'
|
|
volumes();
|
|
is '-'
|
|
execsys(cmdptr)
|
|
perr = $46
|
|
wend
|
|
if perr
|
|
prstr(@errorstr)
|
|
prbyte(perr)
|
|
else
|
|
prstr(@okstr)
|
|
fin
|
|
crout()
|
|
loop
|
|
done
|