6502/PLASMA
1
0
Fork 0
mirror of https://github.com/dschmenk/PLASMA.git synced 2024-06-01 03:41:34 +00:00
Code Issues Projects Releases Wiki Activity
9f45afe3d0
PLASMA/src/vmsrc/apple/sossys.pla
dschmenk 85710bbfdf Fix some SOS exemod memory problems and remove last hard-coded Apple 
II-ism from PLFORTH
2024-01-10 12:11:32 -08:00

1291 lines
29 KiB
Plaintext
Executable File
Raw Blame History

const membank = $FFEF
const RELADDR = $1000
//
// 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
//
// Private addresses
//
const instr = $A020
const cmdparser = $A0F0
const xinterp = $A0F8
//
// Indirect interpreter DEFinition entrypoint
//
struc t_defentry
byte interpjsr
word interpaddr
word bytecodeaddr
byte bytecodexbyte
end
//
// Pedefined functions.
//
predef syscall(cmd,params)#1, call(addr,areg,xreg,yreg,status)#1
predef crout()#0, cout(c)#0, prstr(s)#0, print(i)#0, prbyte(b)#0, prword(w)#0
predef cin()#1, rdstr(p)#1, toupper(c)#1, strcpy(dst,src)#1, strcat(dst,src)#1
predef markheap()#1, allocheap(size)#1, allocalignheap(size, pow2, freeaddr), releaseheap(newheap)#1, availheap()#1
predef memset(addr,value,size)#0, memcpy(dst,src,size)#0
predef uword_isgt(a,b)#1, uword_isge(a,b)#1, uword_islt(a,b)#1, uword_isle(a,b)#1, sext(a)#1, divmod(a,b)#2
predef execmod(modfile)#1, open(path)#1, close(refnum)#1, read(refnum, buff, len)#1, write(refnum, buff, len)#1
predef syslookuptbl(dci)#1
//
// Exported CMDSYS table
//
word version = $0210 // 02.10
word syspath
word cmdlnptr
word = @execmod, @open, @close, @read, @write
byte perr
byte jitcount = 0 // Keep these here for compatibility
byte jitsize = 0
byte refcons = 0
byte devcons = 0
word = @syslookuptbl
//
// String pool.
//
byte hexchar[] = '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'
//
// Exported Machine ID.
//
byte machid = $F2 // Apple ///, 80 columns
//
// Console and textmode control characters
//
byte console[] = ".CONSOLE"
byte textmode[] = 16, 0, 15
//
// Working input buffer overlayed with strings table
//
byte cmdln = ""
//
// SOS.CMD as DCI string
//
byte soscmd = 'S'|$80,'O'|$80,'S'|$80,'.'|$80,'C'|$80,'M'|$80,'D'
//
// Standard Library exported functions.
//
byte sysmodstr[] = "CMDSYS"
byte machidstr[] = "MACHID"
byte sysstr[] = "SYSCALL"
byte callstr[] = "CALL"
byte putcstr[] = "PUTC"
byte putlnstr[] = "PUTLN"
byte putsstr[] = "PUTS"
byte putistr[] = "PUTI"
byte putbstr[] = "PUTB"
byte putwstr[] = "PUTH"
byte getcstr[] = "GETC"
byte getsstr[] = "GETS"
byte toupstr[] = "TOUPPER"
byte strcpystr[] = "STRCPY"
byte strcatstr[] = "STRCAT"
byte hpmarkstr[] = "HEAPMARK"
byte hpalignstr[] = "HEAPALLOCALIGN"
byte hpallocstr[] = "HEAPALLOC"
byte hprelstr[] = "HEAPRELEASE"
byte hpavlstr[] = "HEAPAVAIL"
byte memsetstr[] = "MEMSET"
byte memcpystr[] = "MEMCPY"
byte uisgtstr[] = "ISUGT"
byte uisgestr[] = "ISUGE"
byte uisltstr[] = "ISULT"
byte uislestr[] = "ISULE"
byte sextstr[] = "SEXT"
byte divmodstr[] = "DIVMOD"
word exports[] = @sysmodstr, @version
word = @sysstr, @syscall
word = @callstr, @call
word = @putcstr, @cout
word = @putlnstr, @crout
word = @putsstr, @prstr
word = @putistr, @print
word = @putbstr, @prbyte
word = @putwstr, @prword
word = @getcstr, @cin
word = @getsstr, @rdstr
word = @toupstr, @toupper
byte sysmods[] // overlay sys path with exports
word = @hpmarkstr, @markheap
word = @hpallocstr,@allocheap
word = @hpalignstr,@allocalignheap
word = @hprelstr, @releaseheap
word = @hpavlstr, @availheap
word = @memsetstr, @memset
word = @memcpystr, @memcpy
word = @strcpystr, @strcpy
word = @strcatstr, @strcat
word = @uisgtstr, @uword_isgt
word = @uisgestr, @uword_isge
word = @uisltstr, @uword_islt
word = @uislestr, @uword_isle
word = @sextstr, @sext
word = @divmodstr, @divmod
word = @machidstr, @machid
word = 0
word sysmodsym = @exports
//
// System variables.
//
word systemflags = 0
word heap = $2000
byte autorun[]
byte modseg[15]
byte modid = 0
word symtbl, lastsym
//
// CALL SOS
// SYSCALL(CMD, PARAMS)
//
asm syscall(cmd,params)#1
LDA ESTKL,X
LDY ESTKH,X
STA PARAMS
STY PARAMS+1
INX
LDA ESTKL,X
STA CMD
BRK
CMD !BYTE 00
PARAMS !WORD 0000
LDY #$00
STA ESTKL,X
STY ESTKH,X
RTS
end
//
// CALL 6502 ROUTINE
// CALL(AREG, XREG, YREG, STATUS, ADDR)
//
asm call(addr,areg,xreg,yreg,sstatus)#1
REGVALS = SRC
PHP
LDA ESTKL,X
STA TMPL
LDA ESTKH,X
STA TMPH
INX
LDA ESTKL,X
PHA
INX
LDY ESTKL,X
INX
LDA ESTKL+1,X
PHA
LDA ESTKL,X
INX
STX ESP
TAX
PLA
PLP
JSR JMPTMP
PHP
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
end
//
// SET MEMORY TO VALUE
// MEMSET(ADDR, VALUE, SIZE)
// With optimizations from Peter Ferrie
//
asm memset(addr,value,size)#0
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
INX
RTS
end
//
// COPY MEMORY
// MEMCPY(DSTADDR, SRCADDR, SIZE)
//
asm memcpy(dst,src,size)#0
INX
INX
INX
LDA ESTKL-3,X
ORA ESTKH-3,X
BEQ CPYMEX
LDA ESTKL-2,X
CMP ESTKL-1,X
LDA ESTKH-2,X
SBC ESTKH-1,X
BCC REVCPY
;
; FORWARD COPY
;
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 FORCPYLP
INC ESTKH-3,X
LDY #$00
FORCPYLP LDA (SRC),Y
STA (DST),Y
INY
BNE +
INC DSTH
INC SRCH
+ DEC ESTKL-3,X
BNE FORCPYLP
DEC ESTKH-3,X
BNE FORCPYLP
RTS
;
; REVERSE COPY
;
REVCPY ;CLC
LDA ESTKL-3,X
ADC ESTKL-1,X
STA DSTL
LDA ESTKH-3,X
ADC ESTKH-1,X
STA DSTH
CLC
LDA ESTKL-3,X
ADC ESTKL-2,X
STA SRCL
LDA ESTKH-3,X
ADC ESTKH-2,X
STA SRCH
DEC DSTH
DEC SRCH
LDY #$FF
LDA ESTKL-3,X
BEQ REVCPYLP
INC ESTKH-3,X
REVCPYLP LDA (SRC),Y
STA (DST),Y
DEY
CPY #$FF
BNE +
DEC DSTH
DEC SRCH
+ DEC ESTKL-3,X
BNE REVCPYLP
DEC ESTKH-3,X
BNE REVCPYLP
CPYMEX RTS
end
//
// COPY FROM MAIN MEM TO EXT MEM.
//
// MEMXCPY(DSTSEG, SRC, SIZE)
//
asm memxcpy(dst,src,size)#0
LDA ESTKL,X
ORA ESTKH,X
BEQ CPYXMEX
LDY #$00
STY DSTL
LDA ESTKH+2,X
CLC
ADC #$60
STA DSTH
LDA ESTKL+2,X
CLC
ADC #$7F
STA DSTX
LDA ESTKL+1,X
STA SRCL
LDA ESTKH+1,X
STA SRCH
INC ESTKH,X
CPYXLP LDA (SRC),Y
STA (DST),Y
INY
BNE +
INC DSTH
INC SRCH
+ DEC ESTKL,X
BNE CPYXLP
DEC ESTKH,X
BNE CPYXLP
LDA #$00
STA DSTX
CPYXMEX INX
INX
INX
RTS
end
//
// POKE BYTE VAL INTO EXT MEM.
//
// XPOKEB(SEG, DST, BYTEVAL)
//
asm xpokeb(seg, dst, byteval)#0
LDA ESTKL+1,X
STA DSTL
LDA ESTKH+1,X
CLC
ADC #$60
STA DSTH
LDA ESTKL+2,X
CLC
ADC #$7F
STA DSTX
LDY #$00
LDA ESTKL,X
STA (DST),Y
STY DSTX
INX
INX
INX
RTS
end
//
// Unsigned word comparisons.
//
asm uword_isge(a,b)#1
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(a,b)#1
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(a,b)#1
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(a,b)#1
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
asm divmod(a,b)#2
JSR INTERP ; CALL INTERP
!BYTE $36, $5C ; DIVMOD, RET
end
asm sext(a)#1
LDY #$00
LDA ESTKL,X
BPL +
DEY
+ STY ESTKH,X
RTS
end
//
// 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(dci, str)#1
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(str, dci)#1
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(c)#1
LDA ESTKL,X
TOUPR AND #$7F
CMP #'a'
BCC +
CMP #'z'+1
BCS +
SBC #$1F
+ STA ESTKL,X
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(dci, tbl)#1
LDY #$00
STY DSTL
LDA ESTKH,X
CLC
ADC #$60
STA DSTH
LDA ESTKL,X
CLC
ADC #$7F
STA DSTX
LDA ESTKL+1,X
STA SRCL
LDA ESTKH+1,X
STA SRCH
- 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
LDA #$00
STA DSTX
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
// def lookupidx(esd, index)
// word sym
// while ^esd
// sym = esd
// esd = sym + dcitos(sym, @str)
// if esd->0 & $10 and esd->1 == index
// return sym
// fin
// esd = esd + 3
// loop
//end
asm lookupidx(esd, index)#1
LDA ESTKL,X
STA TMPL
INX
--- LDA ESTKH,X
STA SRCH
LDA ESTKL,X
-- STA SRCL
LDY #$00
- LDA (SRC),Y
BPL +
INY
BNE -
+ BEQ ++ ; END OF ESD
INY
LDA (SRC),Y
INY
AND #$10 ; EXTERN FLAG?
BEQ +
LDA (SRC),Y
CMP TMPL
BEQ +++ ; MATCH
+ INY
TYA
SEC
ADC SRCL
STA ESTKL,X ; SYM PTRL
BCC --
INC ESTKH,X ; SYM PTRH
BNE ---
++ STA ESTKL,X ; END OF ESD
STA ESTKH,X
+++ RTS
end
//def lookupdef(addr, deftbl)#1
// while deftbl->0 == $20
// if deftbl=>3 == addr
// return deftbl
// fin
// deftbl = deftbl + t_defentry
// loop
// return 0
//end
asm lookupdef(addr, deftbl)#1
LDA ESTKH,X
STA SRCH
LDA ESTKL,X
STA SRCL
INX
- LDY #$00
LDA (SRC),Y
CMP #$20 ; JSR OPCODE?
BNE ++
LDY #$03
LDA (SRC),Y
CMP ESTKL,X
BNE +
INY
LDA (SRC),Y
CMP ESTKH,X
BNE +
LDA SRCL ; MATCH
STA ESTKL,X
LDA SRCH
STA ESTKH,X
RTS
+ LDA #$06 ; T_DEFENTRY
CLC
ADC SRCL
STA SRCL
BCC -
INC SRCH
BNE -
++ STY ESTKL,X
STY ESTKH,X
RTS
end
//
// Reloc internal data
//
//def reloc(modfix, modofst, bytecode, rld)#3
// word addr, fixup
// while ^rld
// if ^rld & $10 // EXTERN reference.
// return rld, addr, fixup
// fin
// addr = rld=>1 + modfix
// fixup = *addr + modofst
// if uword_isge(fixup, bytecode) // Bytecode address.
// return rld, addr, fixup
// fin
// *addr = fixup
// rld = rld + 4
// loop
// return rld, addr, fixup
//end
asm reloc(modfix, modofst, bytecode, rld)#3
LDA ESTKL,X
STA SRCL
LDA ESTKH,X
STA SRCH
LDY #$00
- LDA (SRC),Y
BEQ RLDEX ; END OF RLD
PHA
INY
LDA (SRC),Y
INY
CLC
ADC ESTKL+3,X ; ADDR=ENTRY=>1+MODFIX
STA DSTL
LDA (SRC),Y
ADC ESTKH+3,X
STA DSTH
PLA
AND #$10 ; EXTERN REF - EXIT
BNE RLDEX
TAY ; FIXUP=*ADDR+MODOFST
LDA (DST),Y
INY
CLC
ADC ESTKL+2,X
STA TMPL
LDA (DST),Y
ADC ESTKH+2,X
CMP ESTKH+1,X ; FIXUP >= BYTECODE?
BCC +
STA TMPH
BNE RLDEX ; YEP, EXIT
LDA TMPL
CMP ESTKL+1,X
BCS RLDEX ; YEP, EXIT
LDA TMPH
+ STA (DST),Y ; *ADDR=FIXUP
DEY
LDA TMPL
STA (DST),Y
LDA SRCL ; NEXT ENTRY
; CLC
ADC #$04
STA SRCL
BCC -
INC SRCH
BNE -
RLDEX INX
LDA TMPL
STA ESTKL,X
LDA TMPH
STA ESTKH,X
LDA DSTL
STA ESTKL+1,X
LDA DSTH
STA ESTKH+1,X
LDA SRCL
STA ESTKL+2,X
LDA SRCH
STA ESTKH+2,X
RTS
end
def syslookuptbl(dci)#1
return lookuptbl(dci, symtbl)
end
//
// SOS routines
// FILE I/O
//
def open(path)#1
byte params[7]
params.0 = 4
params:1 = path
params.3 = 0
params:4 = 0
params.6 = 0
perr = syscall($C8, @params)
return params.3
end
def close(refnum)#1
byte params[2]
params.0 = 1
params.1 = refnum
perr = syscall($CC, @params)
return perr
end
def read(refnum, buff, len)#1
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
def write(refnum, buff, len)#1
byte params[6]
params.0 = 3
params.1 = refnum
params:2 = buff
params:4 = len
perr = syscall($CB, @params)
return perr
end
//
// CONSOLE I/O
//
def dev_control(devnum, code, list)#1
byte params[5]
params.0 = 3
params.1 = devnum
params.2 = code
params:3 = list
return syscall($83, @params)
end
def dev_getnum(name)#1
byte params[4]
params.0 = 2
params:1 = name
params.3 = 0
syscall($84, @params)
return params.3
end
def init_cons()#0
byte nlmode[2]
refcons = open(@console)
devcons = dev_getnum(@console)
nlmode:0 = $0D80
//nlmode.0 = $80
//nlmode.1 = $0D
dev_control(devcons, $02, @nlmode)
write(refcons, @textmode, 3)
end
//
// MEMORY CALLS
//
def seg_find(search, pages, id)#3
byte params[10]
params.0 = 6
params.1 = search
params.2 = id
params:3 = pages
params:5 = 0
params:7 = 0
params.9 = 0
perr = syscall($41, @params)
return params.9, params:5, params:7
end
def seg_release(segnum)#1
byte params[2]
params.0 = 1
params.1 = segnum
perr = syscall($45, @params)
return perr
end
//
// CONSOLE I/O
//
def cout(ch)#0
byte nc
nc = 1
if ch == $0D
ch = $0A0D
nc = 2
fin
write(refcons, @ch, nc)
end
def crout()#0
cout($0D)
end
def cin()#1
byte ch
read(refcons, @ch, 1)
return ch & $7F
end
def prstr(str)#0
write(refcons, str + 1, ^str)
if str->[^str] == $0D
cout($0A)
fin
end
def print(i)#0
if i < 0; cout('-'); i = -i; fin
if i >= 10; print(i / 10); fin
cout(i % 10 + '0')
end
def rdstr(prompt)#1
cout(prompt)
^instr = read(refcons, instr+1, 128)
if instr->[^instr] == $0D
^instr--
fin
crout
return instr
end
def prbyte(v)#0
cout(hexchar[(v >> 4) & $0F])
cout(hexchar[v & $0F])
end
def prword(v)#0
prbyte(v >> 8)
prbyte(v)
end
//
// Heap routines.
//
def availheap()#1
byte fp
return @fp - heap
end
def allocheap(size)#1
word addr
addr = heap
heap = heap + size
if uword_isge(heap, @addr)
heap = addr
return 0
fin
return addr
end
def allocalignheap(size, pow2, freeaddr)#1
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()#1
return heap
end
def releaseheap(newheap)#1
heap = newheap
return @newheap - heap
end
//
// Symbol table routines.
//
def addsym(sym, addr)#0
while ^sym & $80
xpokeb(symtbl.0, lastsym, ^sym)
lastsym = lastsym + 1
sym = sym + 1
loop
xpokeb(symtbl.0, lastsym, ^sym)
xpokeb(symtbl.0, lastsym + 1, addr.0)
xpokeb(symtbl.0, lastsym + 2, addr.1)
xpokeb(symtbl.0, lastsym + 3, 0)
lastsym = lastsym + 3
end
//
// String routines.
//
def strcpy(dst, src)#1
memcpy(dst+1, src+1, ^src)
^dst = ^src
return dst
end
def strcat(dst, src)#1
memcpy(dst + ^dst + 1, src + 1, ^src)
^dst = ^dst + ^src
return dst
end
//
// Module routines.
//
def lookupextern(esd, index)#1
word sym, addr
byte str[33]
sym = lookupidx(esd, index)
if sym
addr = lookuptbl(sym, symtbl)
if !addr
perr = $81
dcitos(sym, @str)
cout('?'); prstr(@str); crout
fin
return addr
fin
return 0
end
def adddef(ext, addr, deflast)#1
word preventry, defentry, defsize
defentry = *deflast
*deflast = defentry + t_defentry
defentry->interpjsr = $20 // JSR
defentry=>interpaddr = *xinterp // XINTERP
defentry=>bytecodeaddr = addr
defentry->bytecodexbyte = ext
defentry->t_defentry = 0
return defentry
end
def loadmod(mod)#1
word refnum, 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
byte lerr, defext, fileinfo[], str[16], filename[33]
byte header[128]
lerr = 0
//
// Read the RELocatable module header (first 128 bytes)
//
dcitos(mod, @filename)
refnum = open(@filename)
if !refnum and filename < 16
//
// Try system path
//
refnum = open(strcpy(@filename,strcat(strcpy(@header, @sysmods), @filename)))
fin
if refnum
header.0 = 3
header:1 = @filename
header:3 = @fileinfo
header.5 = 2
if not syscall($C4, @header) and fileinfo.1 <> $FE // Make sure it's a REL module
close(refnum)
perr = $4A // Incompatible type
return -perr
fin
rdlen = read(refnum, @header, 128)
modsize = header:0
moddep = @header.1
defofst = modsize + RELADDR
defext = 0
init = 0
if rdlen > 4 and header:2 == $6502 // 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 !lookuptbl(moddep, symtbl)
if refnum
close(refnum)
refnum = 0
fin
if loadmod(moddep) < 0
return -perr
fin
fin
moddep = moddep + dcitos(moddep, @str)
loop
//
// Init def table.
//
deftbl = allocheap(defcnt * t_defentry + 1)
deflast = deftbl
^deflast = 0
if !refnum
//
// Reset read pointer.
//
refnum = open(@filename)
rdlen = read(refnum, @header, 128)
fin
fin
//
// Alloc heap space for relocated module (data + bytecode).
//
moddep++
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.
//
addsym(mod, modaddr)
//
// Apply all fixups and symbol import/export.
//
modfix = modaddr - modfix
modofst = modfix - RELADDR
modend = modaddr + modsize
bytecode = defofst + modofst
rld = modend // Re-Locatable Directory
esd = rld // Extern+Entry Symbol Directory
while ^esd // Scan to end of ESD
esd = esd + 4
loop
esd++
if defcnt
//
// Locate bytecode defs in allocated segment.
//
modseg[modid], codeseg, drop = seg_find($00, (rld - bytecode + 255) >> 8, modid + $12)
if perr
return -perr
fin
modid++
defext = codeseg.0 + $7F // (codeseg.0 | $80) - 1
defaddr = (codeseg & $FF00) + $6000
codefix = defaddr - bytecode
defofst = defaddr - defofst
fin
//
// Run through the DeFinition Dictionary.
//
while ^rld == $02
//
// This is a bytcode def entry - add it to the def directory.
//
adddef(defext, rld=>1 + defofst, @deflast)
rld = rld + 4
loop
//
// Run through the Re-Location Dictionary.
//
while ^rld
rld, addr, fixup = reloc(modfix, modofst, bytecode, rld)
if ^rld
*addr = ^rld & $10 ?? *addr + lookupextern(esd, rld->3) :: lookupdef(fixup + codefix, deftbl)
rld = rld + 4
fin
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 + modofst
if uword_isge(addr, bytecode)
//
// Use the def directory address for bytecode.
//
addr = lookupdef(addr + codefix, deftbl)
fin
addsym(sym, addr)
fin
esd = esd + 3
loop
if defext
//
// Copy bytecode to code segment.
//
memxcpy(codeseg, bytecode, modsize - (bytecode - modaddr))
fin
else
lerr = $46
fin
if lerr
return -lerr
fin
//
// Free up end-of-module main memory.
//
releaseheap(bytecode)
//
// Call init routine if it exists.
//
initcode = 0
if init
initcode = adddef(defext, init + defofst, @deflast)()
if initcode < 0
perr = -initcode
fin
fin
return initcode
end
def execmod(modfile)#1
byte moddci[63]
word saveheap, savesym, saveflags, savemodid
perr = 1
if stodci(modfile, @moddci)
saveheap = heap
savesym = lastsym
saveflags = systemflags
savemodid = modid
if loadmod(@moddci) < modkeep
lastsym = savesym
heap = saveheap
while modid > savemodid
modid--
seg_release(modseg[modid])
loop
xpokeb(symtbl.0, lastsym, 0)
systemflags = saveflags
fin
fin
return -perr
end
//
// Init 2K symbol table.
//
drop, symtbl, drop = seg_find($00, $08, $11)
lastsym = symtbl & $FF00
xpokeb(symtbl.0, lastsym, 0)
while *sysmodsym
stodci(sysmodsym=>0, heap)
addsym(heap, sysmodsym=>2)
sysmodsym = sysmodsym + 4
loop
//
// Clear system path and command line
//
sysmods = 0
syspath = @sysmods
cmdlnptr = @cmdln
//
// Print PLASMA version
//
init_cons
prstr("PLASMA 2.1\n")//; putb(version.1); putc('.'); putb(version.0); putln
prstr("MEM:$"); prword(availheap); crout
//
// Exec command line parser
//
loadmod(@soscmd)
modid = 0
autorun = open("AUTORUN")
if autorun > 0
cmdln = read(autorun, @cmdln.1, 64)
close(autorun)
fin
//
// Call cmd line parser
//
repeat
execmod((*cmdparser)())
write(refcons, @textmode, 3)
cmdln = 0
until 0
done
Reference in New Issue View Git Blame Copy Permalink