6502/PLASMA
1
0
Fork 0
mirror of https://github.com/dschmenk/PLASMA.git synced 2025-03-31 14:30:36 +00:00
Code Issues Projects Releases Wiki Activity
99402bdf60
PLASMA/src/vmsrc/cmd.pla
dschmenk 99402bdf60 Save some bytes with inline strings
2015-11-15 13:12:39 -08:00

1338 lines
24 KiB
Plaintext
Raw Blame History

const MACHID = $BF98
const iobuffer = $0800
const databuff = $2000
const MODADDR = $1000
const symtbl = $0C00
const freemem = $0006
const getlnbuf = $01FF
//
// System flags: memory allocator screen holes.
//
const restxt1 = $0001
const restxt2 = $0002
const resxtxt1 = $0004
const resxtxt2 = $0008
const reshgr1 = $0010
const reshgr2 = $0020
const resxhgr1 = $0040
const resxhgr2 = $0080
//
// Module don't free memory
//
const modkeep = $2000
const modinitkeep = $4000
//
// Pedefined functions.
//
predef syscall, call
predef crout, cout, prstr, cin, rdstr
predef markheap, allocheap, allocalignheap, releaseheap, availheap
predef memset, memcpy
predef uword_isgt, uword_isge, uword_islt, uword_isle
predef loadmod, execmod, lookupstrmod
//
// System variable.
//
word version = $0092 // 00.92
word systemflags = 0
word heap
word xheap = $0800
word lastsym = symtbl
byte perr
byte cmdln = "" // Overlay exported strings table
//
// Standard Library exported functions.
//
byte syslibstr = "CMDSYS"
byte machidstr = "MACHID"
byte sysstr = "SYSCALL"
byte callstr = "CALL"
byte putcstr = "PUTC"
byte putlnstr = "PUTLN"
byte putsstr = "PUTS"
byte getcstr = "GETC"
byte getsstr = "GETS"
byte hpmarkstr = "HEAPMARK"
byte hpalignstr = "HEAPALLOCALIGN"
byte hpallocstr = "HEAPALLOC"
byte hprelstr = "HEAPRELEASE"
byte memsetstr = "MEMSET"
byte memcpystr = "MEMCPY"
byte uisgtstr = "ISUGT"
byte uisgestr = "ISUGE"
byte uisltstr = "ISULT"
byte uislestr = "ISULE"
byte loadstr = "MODLOAD"
byte execstr = "MODEXEC"
byte modadrstr = "MODADDR"
byte argstr = "ARGS"
byte autorun = "AUTORUN"
byte prefix[] // overlay with exported symbols table
word exports = @sysstr, @syscall
word = @callstr, @call
word = @putcstr, @cout
word = @putlnstr, @crout
word = @putsstr, @prstr
word = @getcstr, @cin
word = @getsstr, @rdstr
word = @hpmarkstr, @markheap
word = @hpallocstr,@allocheap
word = @hpalignstr,@allocalignheap
word = @hprelstr, @releaseheap
word = @memsetstr, @memset
word = @memcpystr, @memcpy
word = @uisgtstr, @uword_isgt
word = @uisgestr, @uword_isge
word = @uisltstr, @uword_islt
word = @uislestr, @uword_isle
word = @loadstr, @loadmod
word = @execstr, @execmod
word = @modadrstr, @lookupstrmod
word = @machidstr, MACHID
word = @argstr, @cmdln
word = 0
word syslibsym = @exports
//
// Utility functions
//
//asm equates included from cmdstub.s
//
// CALL PRODOS
// SYSCALL(CMD, PARAMS)
//
asm syscall
LDA ESTKL,X
LDY ESTKH,X
STA PARAMS
STY PARAMS+1
INX
LDA ESTKL,X
STA CMD
JSR $BF00
CMD: !BYTE 00
PARAMS: !WORD 0000
LDY #$00
STA ESTKL,X
STY ESTKH,X
RTS
end
//
// CALL 6502 ROUTINE
// CALL(ADDR, AREG, XREG, YREG, STATUS)
//
asm call
REGVALS = SRC
PHP
LDA ESTKL+4,X
STA TMPL
LDA ESTKH+4,X
STA TMPH
LDA ESTKL,X
PHA
LDA ESTKL+1,X
TAY
LDA ESTKL+3,X
PHA
LDA ESTKL+2,X
INX
INX
INX
INX
STX ESP
TAX
PLA
BIT ROMEN
PLP
JSR JMPTMP
PHP
BIT LCRDEN+LCBNK2
STA REGVALS+0
STX REGVALS+1
STY REGVALS+2
PLA
STA REGVALS+3
LDX ESP
LDA #<REGVALS
LDY #>REGVALS
STA ESTKL,X
STY ESTKH,X
PLP
RTS
JMPTMP JMP (TMP)
end
//
// CALL LOADED SYSTEM PROGRAM
//
asm exec
LDX #$00
STX IFPL
LDA #$BF
STA IFPH
LDX #$FE
TXS
LDX #ESTKSZ/2
BIT ROMEN
JMP $2000
end
//
// EXIT
//
asm reboot
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
//
asm memset
LDA ESTKL+2,X
STA DSTL
LDA ESTKH+2,X
STA DSTH
LDY ESTKL,X
BEQ +
INC ESTKH,X
LDY #$00
+ LDA ESTKH,X
BEQ SETMEX
SETMLPL CLC
LDA ESTKL+1,X
SETMLPH STA (DST),Y
DEC ESTKL,X
BEQ ++
- INY
BEQ +
-- BCS SETMLPL
SEC
LDA ESTKH+1,X
BCS SETMLPH
+ INC DSTH
BNE --
++ DEC ESTKH,X
BNE -
SETMEX INX
INX
RTS
end
//
// COPY MEMORY
// MEMCPY(DSTADDR, SRCADDR, SIZE)
//
asm memcpy
INX
INX
LDA ESTKL-2,X
ORA ESTKH-2,X
BEQ CPYMEX
LDA ESTKL-1,X
CMP ESTKL,X
LDA ESTKH-1,X
SBC ESTKH,X
BCC REVCPY
;
; FORWARD COPY
;
LDA ESTKL,X
STA DSTL
LDA ESTKH,X
STA DSTH
LDA ESTKL-1,X
STA SRCL
LDA ESTKH-1,X
STA SRCH
LDY ESTKL-2,X
BEQ FORCPYLP
INC ESTKH-2,X
LDY #$00
FORCPYLP LDA (SRC),Y
STA (DST),Y
INY
BNE +
INC DSTH
INC SRCH
+ DEC ESTKL-2,X
BNE FORCPYLP
DEC ESTKH-2,X
BNE FORCPYLP
RTS
;
; REVERSE COPY
;
REVCPY ;CLC
LDA ESTKL-2,X
ADC ESTKL,X
STA DSTL
LDA ESTKH-2,X
ADC ESTKH,X
STA DSTH
CLC
LDA ESTKL-2,X
ADC ESTKL-1,X
STA SRCL
LDA ESTKH-2,X
ADC ESTKH-1,X
STA SRCH
DEC DSTH
DEC SRCH
LDY #$FF
LDA ESTKL-2,X
BEQ REVCPYLP
INC ESTKH-2,X
REVCPYLP LDA (SRC),Y
STA (DST),Y
DEY
CPY #$FF
BNE +
DEC DSTH
DEC SRCH
+ DEC ESTKL-2,X
BNE REVCPYLP
DEC ESTKH-2,X
BNE REVCPYLP
CPYMEX RTS
end
//
// COPY FROM MAIN MEM TO AUX MEM.
//
// MEMXCPY(DST, SRC, SIZE)
//
asm memxcpy
LDA ESTKL+1,X
STA $3C
CLC
ADC ESTKL,X
STA $3E
LDA ESTKH+1,X
STA $3D
ADC ESTKH,X
STA $3F
LDA ESTKL+2,X
STA $42
LDA ESTKH+2,X
STA $43
STX ESP
BIT ROMEN
SEC
JSR $C311
BIT LCRDEN+LCBNK2
LDX ESP
INX
INX
RTS
end
asm crout
DEX
LDA #$0D
BNE +
; FALL THROUGH TO COUT
end
//
// CHAR OUT
// COUT(CHAR)
//
asm cout
LDA ESTKL,X
BIT $BF98
BMI +
JSR TOUPR
+ ORA #$80
BIT ROMEN
JSR $FDED
BIT LCRDEN+LCBNK2
RTS
end
//
// CHAR IN
// RDKEY()
//
asm cin
BIT ROMEN
JSR $FD0C
BIT LCRDEN+LCBNK2
DEX
LDY #$00
AND #$7F
STA ESTKL,X
STY ESTKH,X
RTS
end
//
// PRINT STRING
// PRSTR(STR)
//
asm prstr
LDY #$00
LDA ESTKL,X
STA SRCL
LDA ESTKH,X
STA SRCH
LDA (SRC),Y
BEQ ++
STA TMP
BIT ROMEN
- INY
LDA (SRC),Y
BIT $BF98
BMI +
JSR TOUPR
+ ORA #$80
JSR $FDED
CPY TMP
BNE -
BIT LCRDEN+LCBNK2
++ RTS
end
//
// PRINT BYTE
//
asm prbyte
LDA ESTKL,X
STX ESP
BIT ROMEN
JSR $FDDA
LDX ESP
BIT LCRDEN+LCBNK2
RTS
end
//
// PRINT WORD
//
asm prword
STX ESP
TXA
TAY
LDA ESTKH,Y
LDX ESTKL,Y
BIT ROMEN
JSR $F941
LDX ESP
BIT LCRDEN+LCBNK2
RTS
end
//
// READ STRING
// STR = RDSTR(PROMPTCHAR)
//
asm rdstr
LDA ESTKL,X
STA $33
STX ESP
BIT ROMEN
JSR $FD6A
STX $01FF
- LDA $01FF,X
AND #$7F
STA $01FF,X
DEX
BPL -
TXA
LDX ESP
STA ESTKL,X
LDA #$01
STA ESTKH,X
BIT LCRDEN+LCBNK2
RTS
end
asm uword_isge
LDA ESTKL+1,X
CMP ESTKL,X
LDA ESTKH+1,X
SBC ESTKH,X
LDA #$FF
ADC #$00
EOR #$FF
STA ESTKL+1,X
STA ESTKH+1,X
INX
RTS
end
asm uword_isle
LDA ESTKL,X
CMP ESTKL+1,X
LDA ESTKH,X
SBC ESTKH+1,X
LDA #$FF
ADC #$00
EOR #$FF
STA ESTKL+1,X
STA ESTKH+1,X
INX
RTS
end
asm uword_isgt
LDA ESTKL,X
CMP ESTKL+1,X
LDA ESTKH,X
SBC ESTKH+1,X
LDA #$FF
ADC #$00
STA ESTKL+1,X
STA ESTKH+1,X
INX
RTS
end
asm uword_islt
LDA ESTKL+1,X
CMP ESTKL,X
LDA ESTKH+1,X
SBC ESTKH,X
LDA #$FF
ADC #$00
STA ESTKL+1,X
STA ESTKH+1,X
INX
RTS
end
//
// Utility routines.
//
// A DCI string is one that has the high bit set for every character except the last.
// More efficient than C or Pascal strings.
//
//def dcitos(dci, str)
// byte len, c
// len = 0
// repeat
// c = (dci).[len]
// len = len + 1
// (str).[len] = c & $7F
// until !(c & $80)
// ^str = len
// return len
//end
asm dcitos
LDA ESTKL,X
STA DSTL
LDA ESTKH,X
STA DSTH
LDA ESTKL+1,X
STA SRCL
LDA ESTKH+1,X
STA SRCH
LDY #$00
- LDA (SRC),Y
CMP #$80
AND #$7F
INY
STA (DST),Y
BCS -
TYA
LDY #$00
STA (DST),Y
INX
STA ESTKL,X
STY ESTKH,X
RTS
end
//def stodci(str, dci)
// byte len, c
// len = ^str
// if len == 0
// return
// fin
// c = toupper((str).[len]) & $7F
// len = len - 1
// (dci).[len] = c
// while len
// c = toupper((str).[len]) | $80
// len = len - 1
// (dci).[len] = c
// loop
// return ^str
//end
asm stodci
LDA ESTKL,X
STA DSTL
LDA ESTKH,X
STA DSTH
LDA ESTKL+1,X
STA SRCL
LDA ESTKH+1,X
STA SRCH
INX
LDY #$00
LDA (SRC),Y
BEQ ++
TAY
LDA (SRC),Y
JSR TOUPR
BNE +
- LDA (SRC),Y
JSR TOUPR
ORA #$80
+ DEY
STA (DST),Y
BNE -
LDA (SRC),Y
++ STA ESTKL,X
STY ESTKH,X
RTS
end
asm toupper
LDA ESTKL,X
TOUPR AND #$7F
CMP #'a'
BCC +
CMP #'z'+1
BCS +
SBC #$1F
+ STA ESTKL,X
RTS
end
//
// Module symbols are entered into the symbol table
// pre-pended with a '#' to differentiate them
// from normal symbols.
//
//def modtosym(mod, dci)
// byte len, c
// (dci).0 = '#'|$80
// len = 0
// repeat
// c = (mod).[len]
// len = len + 1
// (dci).[len] = c
// until !(c & $80)
// return dci
//end
asm modtosym
LDA ESTKL+1,X
STA SRCL
LDA ESTKH+1,X
STA SRCH
LDA ESTKL,X
STA ESTKL+1,X
STA DSTL
LDA ESTKH,X
STA ESTKH+1,X
STA DSTH
INX
LDY #$00
LDA #'#'+$80
- STA (DST),Y
ASL
LDA (SRC),Y
INY
BCS -
RTS
end
//
// Lookup routines.
//
//def lookuptbl(dci, tbl)
// word match
// while ^tbl
// match = dci
// while ^tbl == ^match
// if !(^tbl & $80)
// return (tbl):1
// fin
// tbl = tbl + 1
// match = match + 1
// loop
// while (^tbl & $80)
// tbl = tbl + 1
// loop
// tbl = tbl + 3
// loop
// return 0
asm lookuptbl
LDA ESTKL,X
STA DSTL
LDA ESTKH,X
STA DSTH
LDA ESTKL+1,X
STA SRCL
LDA ESTKH+1,X
STA SRCH
LDY #$00
- LDA (DST),Y
BEQ +
CMP (SRC),Y
BNE ++
INY
ASL
BCS -
LDA (DST),Y
PHA
INY
LDA (DST),Y
TAY
PLA
+ INX
STA ESTKL,X
STY ESTKH,X
RTS
++ LDY #$00
-- LDA (DST),Y
INC DSTL
BEQ +
--- ASL
BCS --
LDA #$02
ADC DSTL
STA DSTL
BCC -
INC DSTH
BCS -
+ INC DSTH
BNE ---
end
//
// ProDOS routines
//
def getpfx(path)
byte params[3]
^path = 0
params.0 = 1
params:1 = path
perr = syscall($C7, @params)
return path
end
def setpfx(path)
byte params[3]
params.0 = 1
params:1 = path
perr = syscall($C6, @params)
return path
end
def open(path, buff)
byte params[6]
params.0 = 3
params:1 = path
params:3 = buff
params.5 = 0
perr = syscall($C8, @params)
return params.5
end
def close(refnum)
byte params[2]
params.0 = 1
params.1 = refnum
perr = syscall($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 = syscall($CA, @params)
return params:6
end
//
// Heap routines.
//
def availheap
byte fp
return @fp - heap
end
def allocheap(size)
word addr
addr = heap
heap = heap + size
if systemflags & reshgr1
if uword_islt(addr, $4000) and uword_isgt(heap, $2000)
addr = $4000
heap = addr + size
fin
fin
if systemflags & reshgr2
if uword_islt(addr, $6000) and uword_isgt(heap, $4000)
addr = $6000
heap = addr + size
fin
fin
if uword_isge(heap, @addr)
return 0
fin
return addr
end
def allocalignheap(size, pow2, freeaddr)
word align, addr
if freeaddr
*freeaddr = heap
fin
align = (1 << pow2) - 1
addr = (heap | align) + 1
heap = addr + size
if uword_isge(heap, @addr)
return 0
fin
return addr
end
def markheap
return heap
end
def releaseheap(newheap)
heap = newheap
return @newheap - heap
end
def allocxheap(size)
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.
//
def lookupsym(sym)
return lookuptbl(sym, symtbl)
end
def addsym(sym, addr)
while ^sym & $80
^lastsym = ^sym
lastsym = lastsym + 1
sym = sym + 1
loop
lastsym->0 = ^sym
lastsym=>1 = addr
lastsym = lastsym + 3
^lastsym = 0
end
//
// Module routines.
//
def lookupmod(mod)
byte dci[17]
return lookuptbl(modtosym(mod, @dci), symtbl)
end
def lookupstrmod(str)
byte mod[17]
stodci(str, @mod)
return lookupmod(@mod)
end
def addmod(mod, addr)
byte dci[17]
return addsym(modtosym(mod, @dci), addr)
end
def lookupextern(esd, index)
word sym, addr
byte str[16]
while ^esd
sym = esd
esd = esd + dcitos(esd, @str)
if esd->0 & $10 and esd->1 == index
addr = lookupsym(sym)
if !addr
perr = $81
cout('?')
prstr(@str)
crout
fin
return addr
fin
esd = esd + 3
loop
return 0
end
def adddef(bank, addr, deflast)
word defentry
defentry = *deflast
*deflast = defentry + 5
if bank
defentry=>1 = $03DC // JSR $03DC (AUX MEM INTERP)
else
defentry=>1 = $03D6 // JSR $03D6 (MAIN MEM INTERP)
fin
defentry->0 = $20
defentry=>3 = addr
defentry->5 = 0 // NULL out next entry
return defentry
end
def lookupdef(addr, deftbl)
while deftbl->0 == $20
if deftbl=>3 == addr
return deftbl
fin
deftbl = deftbl + 5
loop
return 0
end
def loadmod(mod)
word refnum, rdlen, modsize, bytecode, defofst, defcnt, init, fixup
word addr, defaddr, modaddr, modfix, modend
word deftbl, deflast
word moddep, rld, esd, sym
byte defbank, str[16], filename[64]
byte header[128]
//
// Read the RELocatable module header (first 128 bytes)
//
dcitos(mod, @filename)
refnum = open(@filename, iobuffer)
if refnum > 0
rdlen = read(refnum, @header, 128)
modsize = header:0
moddep = @header.1
defofst = modsize
init = 0
if rdlen > 4 and header:2 == $DA7E // DAVE = magic number :-)
//
// This is an EXTended RELocatable (data+bytecode) module.
//
systemflags = header:4 | systemflags
defofst = header:6
defcnt = header:8
init = header:10
moddep = @header.12
//
// Load module dependencies.
//
while ^moddep
if !lookupmod(moddep)
close(refnum)
refnum = 0
if loadmod(moddep) < 0
return -perr
fin
fin
moddep = moddep + dcitos(moddep, @str)
loop
//
// Init def table.
//
deftbl = allocheap(defcnt * 5 + 1)
deflast = deftbl
^deflast = 0
if !refnum
//
// Reset read pointer.
//
refnum = open(@filename, iobuffer)
rdlen = read(refnum, @header, 128)
fin
fin
//
// Alloc heap space for relocated module (data + bytecode).
//
moddep = moddep + 1
modfix = moddep - @header.2 // Adjust to skip header
modsize = modsize - modfix
rdlen = rdlen - modfix - 2
modaddr = allocheap(modsize)
memcpy(modaddr, moddep, rdlen)
//
// Read in remainder of module into memory for fixups.
//
addr = modaddr//
repeat
addr = addr + rdlen
rdlen = read(refnum, addr, 4096)
until rdlen <= 0
close(refnum)
//
// Add module to symbol table.
//
addmod(mod, modaddr)
//
// Apply all fixups and symbol import/export.
//
modfix = modaddr - modfix
bytecode = defofst + modfix - MODADDR
modend = modaddr + modsize
rld = modend // Re-Locatable Directory
esd = rld // Extern+Entry Symbol Directory
while ^esd // Scan to end of ESD
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
//
// Run through the Re-Location Dictionary.
//
while ^rld
if ^rld == $02
//
// This is a bytcode def entry - add it to the def directory.
//
adddef(defbank, rld=>1 - defofst + defaddr, @deflast)
else
addr = rld=>1 + modfix
if uword_isge(addr, modaddr) // Skip fixups to header
if ^rld & $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 + modfix - MODADDR
if uword_isge(fixup, bytecode)
//
// Bytecode address - replace with call def directory.
//
fixup = lookupdef(fixup - bytecode + defaddr, deftbl)
fin
fin
if ^rld & $80 // WORD sized fixup.
*addr = fixup
else // BYTE sized fixup.
^addr = fixup
fin
fin
fin
rld = rld + 4
loop
//
// Run through the External/Entry Symbol Directory.
//
while ^esd
sym = esd
esd = esd + dcitos(esd, @str)
if ^esd & $08
//
// EXPORT symbol - add it to the global symbol table.
//
addr = esd=>1 + modfix - MODADDR
if uword_isge(addr, bytecode)
//
// Use the def directory address for bytecode.
//
addr = lookupdef(addr - bytecode + defaddr, deftbl)
fin
addsym(sym, addr)
fin
esd = esd + 3
loop
if defbank
//
// Move bytecode to AUX bank.
//
memxcpy(defaddr, bytecode, modsize - (bytecode - modaddr))
fin
fin
if perr
return -perr
fin
//
// Call init routine if it exists.
//
fixup = 0 // This is repurposed for the return code
if init
fixup = adddef(defbank, init - defofst + defaddr, @deflast)()
if fixup < modinitkeep
//
// Free init routine unless initkeep
//
if defbank
xheap = init - defofst + defaddr
else
modend = init - defofst + defaddr
fin
if fixup < 0
perr = -fixup
fin
else
fixup = fixup & ~modinitkeep
fin
fin
//
// Free up the end-of-module in main memory.
//
releaseheap(modend)
return fixup
end
//
// Command mode
//
def volumes
byte params[4]
word strbuf
byte i
params.0 = 2
params.1 = 0
params:2 = databuff
perr = syscall($C5, @params)
strbuf = databuff
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(@path, optpath, ^optpath + 1)
else
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
len = type & $0F
^entry = len
prstr(entry)
if type & $F0 == $D0 // Is it a directory?
cout('/')
len = len + 1
elsif entry->$10 == $FF
cout('-')
len = len + 1
elsif entry->$10 == $FE
cout('+')
len = len + 1
fin
for len = 19 - len downto 0
cout(' ')
next
filecnt = filecnt - 1
fin
entry = entry + entrylen
next
firstblk = 0
else
filecnt = 0
fin
until !filecnt
close(refnum)
crout()
return 0
end
def stripchars(strptr)
while ^strptr and ^(strptr + 1) > ' '
memcpy(strptr + 1, strptr + 2, ^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 + 1, strptr + 2, ^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 + 1, strptr + 2, ^strptr)
^strptr = ^strptr - 1
fin
stripspaces(strptr)
return cmd
end
def resetmemfiles
//
// Close all files
//
^$BFD8 = 0
close(0)
//
// Set memory bitmap
//
memset($BF58, 0, 24)
^$BF58 = $CF
^$BF6F = $01
end
def execsys(sysfile)
byte refnum
word len
if ^sysfile
memcpy($280, sysfile, ^sysfile + 1)
striptrail(sysfile)
refnum = open(sysfile, iobuffer)
if refnum
len = read(refnum, databuff, $FFFF)
resetmemfiles()
if len
memcpy(sysfile, $280, ^$280 + 1)
if stripchars(sysfile) and ^$2000 == $4C and *$2003 == $EEEE
stripspaces(sysfile)
if ^$2005 >= ^sysfile + 1
memcpy($2006, sysfile, ^sysfile + 1)
fin
fin
striptrail($280)
exec()
fin
fin
fin
end
def execmod(modfile)
byte moddci[17]
word saveheap, savexheap, 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
systemflags = saveflags
fin
return -perr
end
//
// Get heap start.
//
heap = *freemem
//
// Init symbol table.
//
stodci(@syslibstr, heap)
addmod(heap, @version)
while *syslibsym
stodci(syslibsym=>0, heap)
addsym(heap, syslibsym=>2)
syslibsym = syslibsym + 4
loop
//
// Try to load autorun.
//
autorun = open(@autorun, iobuffer)
if autorun > 0
cmdln = read(autorun, @syslibstr, 128)
close(autorun)
else
//
// Print some startup info.
//
prstr("PLASMA ")
prbyte(version.1)
cout('.')
prbyte(version.0)
crout
prstr("MEM FREE:$")
prword(availheap)
crout
fin
perr = 0
while 1
if cmdln
when toupper(parsecmd(@cmdln))
is 'Q'
reboot()
break
is 'C'
catalog(@cmdln)
break
is 'P'
setpfx(@cmdln)
break
is 'V'
volumes()
break
is '-'
execsys(@cmdln)
break
is '+'
execmod(@cmdln)
break
otherwise
cout('?')
wend
if perr
prstr("ERR:$")
prbyte(perr)
perr = 0
else
prstr("OK")
fin
crout()
fin
prstr(getpfx(@prefix))
memcpy(@cmdln, rdstr($BA), 128)
loop
done
Reference in New Issue View Git Blame Copy Permalink