Working Apple II loader

This commit is contained in:
David Schmenk 2014-05-08 22:51:03 -07:00
parent 97529baec3
commit bb5eb20141
8 changed files with 524 additions and 206 deletions

View File

@ -1,11 +1,96 @@
const iobuffer = $0800 const iobuffer = $0800
const databuff = $0C00 const databuff = $0C00
const MOD_ADDR = $1000 const MODADDR = $1000
predef home, gotoxy, viewport, crout, cout, prstr, cin, rdstr
predef syscall, romcall
predef markheap, allocheap, releaseheap, availheap
predef memclr, memset, memcpy
predef uword_isgt, uword_isge, uword_islt, uword_isle
predef getpfx, setpfx, newline, online, open, close, read, write, create, destroy
byte version[] = "PLASMA VERSION 0.9" byte version[] = "PLASMA VERSION 0.9"
byte errorstr[] = "ERROR: $" byte errorstr[] = "ERROR: $"
byte okstr[] = "OK" byte okstr[] = "OK"
byte heaperr[] = "ERR: HEAP/FRAME COLLISION.\n" byte heaperr[] = "ERR: HEAP/FRAME COLLISION.\n"
byte prefix[32] = "" byte prefix[32] = ""
byte readerrstr = "ERROR READING FILE"
byte davestr[] = "Relocateble PLASMA module:"
byte modsizestr[] = "Module size: $"
byte modlenstr[] = "Module len: $"
byte modcodestr[] = "Module code: $"
byte modinitstr[] = "Module init: $"
byte adddefstr[] = "Add def call: $"
byte defstr[] = "DEF "
byte externstr[] = "EXTERN[$"
byte internstr[] = "INTERN "
byte wordstr[] = " WORD"
byte bytestr[] = " BYTE"
byte addrstr[] = "@$"
byte luerrstr[] = "Lookup fail: "
byte stdlibstr[] = "STDLIB"
byte clsstr[] = "CLS"
byte gotoxystr[] = "GOTOXY"
byte viewstr[] = "VIEWPORT"
byte putnlstr[] = "PUTNL"
byte putcstr[] = "PUTC"
byte putsstr[] = "PUTS"
byte getcstr[] = "GETC"
byte getsstr[] = "GETS"
byte sysstr[] = "SYSCALL"
byte romstr[] = "ROMCALL"
byte getpfxstr[] = "GETPREFIX"
byte setpfxstr[] = "SETPREFIX"
byte newlinestr[] = "SETNEWLINE"
byte onlinestr[] = "ONLINE"
byte openstr[] = "OPEN"
byte closestr[] = "CLOSE"
byte readstr[] = "READ"
byte writestr[] = "WRITE"
byte creatstr[] = "CREATE"
byte destroystr[] = "DESTROY"
byte hpmarkstr[] = "HEAPMARK"
byte hpallocstr[] = "HEAPALLOC"
byte hprelstr[] = "HEAPRELEASE"
byte hpavailstr[] = "HEAPAVAIL"
byte memclrstr[] = "MEMCLR"
byte memsetstr[] = "MEMSET"
byte memcpystr[] = "MEMCPY"
byte uisgtstr[] = "ISUGT"
byte uisgestr[] = "ISUGE"
byte uisltstr[] = "ISULT"
byte uislestr[] = "ISULE"
word exports[] = @clsstr, @home
word = @gotoxystr, @gotoxy
word = @viewstr, @viewport
word = @putnlstr, @crout
word = @putcstr, @cout
word = @putsstr, @prstr
word = @getcstr, @cin
word = @getsstr, @rdstr
word = @sysstr, @syscall
word = @romstr, @romcall
word = @hpmarkstr, @markheap
word = @hpallocstr,@allocheap
word = @hprelstr, @releaseheap
word = @hpavailstr,@availheap
word = @memclrstr, @memclr
word = @memsetstr, @memset
word = @memcpystr, @memcpy
word = @uisgtstr, @uword_isgt
word = @uisgestr, @uword_isge
word = @uisltstr, @uword_islt
word = @uislestr, @uword_isle
word = @getpfxstr, @getpfx
word = @setpfxstr, @setpfx
word = @newlinestr,@newline
word = @onlinestr, @online
word = @openstr, @open
word = @closestr, @close
word = @readstr, @read
word = @writestr, @write
word = @creatstr, @create
word = @destroystr,@destroy
word = 0
word heap = $6000 word heap = $6000
byte modtbl[256] byte modtbl[256]
word lastmod = @modtbl word lastmod = @modtbl
@ -13,7 +98,7 @@ byte symtbl[1024]
word lastsym = @symtbl word lastsym = @symtbl
byte deftbl[2048] byte deftbl[2048]
word lastdef = @deftbl word lastdef = @deftbl
byte perr word perr
word cmdptr word cmdptr
; ;
; Utility functions ; Utility functions
@ -35,10 +120,54 @@ LCBNK1 = $08
ESP !BYTE 0 ESP !BYTE 0
end end
; ;
; CALL 6502 ROUTINE
; ROMCALL(AREG, XREG, YREG, STATUS, ADDR)
;
asm romcall
PHP
LDA ESTKL,X
STA TMPL
LDA ESTKH,X
STA TMPH
INX
LDA ESTKL,X
PHA
INX
LDA ESTKL,X
TAY
INX
LDA ESTKL+1,X
PHA
LDA ESTKL,X
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
REGVALS !FILL 4
JMPTMP JMP (TMP)
end
;
; CALL PRODOS ; CALL PRODOS
; SYSCALL(CMD, PARAMS) ; SYSCALL(CMD, PARAMS)
; ;
asm prodos asm syscall
LDA ESTKL,X LDA ESTKL,X
LDY ESTKH,X LDY ESTKH,X
STA PARAMS STA PARAMS
@ -92,19 +221,54 @@ asm memclr
INC ESTKL,X INC ESTKL,X
INC ESTKH,X INC ESTKH,X
TYA TYA
SETMLP DEC ESTKL,X CLRMLP DEC ESTKL,X
BNE + BNE +
DEC ESTKH,X DEC ESTKH,X
BEQ ++ BEQ ++
+ STA (DST),Y + STA (DST),Y
INY INY
BNE SETMLP BNE CLRMLP
INC DSTH INC DSTH
BNE SETMLP BNE CLRMLP
++ INX ++ INX
RTS RTS
end end
; ;
; SET MEMORY TO VALUE
; MEMSET(ADDR, SIZE, VALUE)
;
asm memset
LDY #$00
LDA ESTKL+2,X
STA DSTL
LDA ESTKH+2,X
STA DSTH
INC ESTKL+1,X
INC ESTKH+1,X
SETMLP DEC ESTKL+1,X
BNE +
DEC ESTKH+1,X
BEQ SETMEX
+ LDA ESTKL,X
STA (DST),Y
INY
BNE +
INC DSTH
+ DEC ESTKL+1,X
BNE +
DEC ESTKH+1,X
BEQ SETMEX
+ LDA ESTKH,X
STA (DST),Y
INY
BNE SETMLP
INC DSTH
BNE SETMLP
SETMEX INX
INX
RTS
end
;
; COPY MEMORY ; COPY MEMORY
; MEMCPY(DSTADDR, SRCADDR, SIZE) ; MEMCPY(DSTADDR, SRCADDR, SIZE)
; ;
@ -113,7 +277,7 @@ asm memcpy
LDA ESTKL,X LDA ESTKL,X
BNE + BNE +
LDA ESTKH,X LDA ESTKH,X
BEQ MEMEXIT BEQ CPYMEX
+ LDA ESTKL+2,X + LDA ESTKL+2,X
STA DSTL STA DSTL
LDA ESTKH+2,X LDA ESTKH+2,X
@ -159,7 +323,7 @@ REVCPYLP
BNE REVCPYLP BNE REVCPYLP
DEC ESTKH,X DEC ESTKH,X
BNE REVCPYLP BNE REVCPYLP
BEQ MEMEXIT BEQ CPYMEX
FORCPY INC ESTKH,X FORCPY INC ESTKH,X
FORCPYLP FORCPYLP
LDA (SRC),Y LDA (SRC),Y
@ -174,7 +338,32 @@ FORCPYLP
BNE FORCPYLP BNE FORCPYLP
DEC ESTKH,X DEC ESTKH,X
BNE FORCPYLP BNE FORCPYLP
MEMEXIT INX CPYMEX INX
INX
RTS
end
;
; HOME
;
asm home
DEX
RTS
end
;
; SET CURSOR POSITION
; GOTOXY(X,Y)
;
asm gotoxy
INX
RTS
end
;
; SET VIEWPORT
; VIEWPORT(LEFT, TOP, RIGHT, BOTTOM)
;
asm viewport
INX
INX
INX INX
RTS RTS
end end
@ -216,10 +405,11 @@ asm prstr
STA SRCL STA SRCL
LDA ESTKH,X LDA ESTKH,X
STA SRCH STA SRCH
BIT ROMEN STY ESTKH,X
LDA (SRC),Y LDA (SRC),Y
STA ESTKL,X STA ESTKL,X
BEQ + BEQ +
BIT ROMEN
- INY - INY
LDA (SRC),Y LDA (SRC),Y
ORA #$80 ORA #$80
@ -227,8 +417,8 @@ asm prstr
TYA TYA
CMP ESTKL,X CMP ESTKL,X
BNE - BNE -
+ BIT LCRDEN+LCBNK2 BIT LCRDEN+LCBNK2
RTS + RTS
end end
; ;
; PRINT BYTE ; PRINT BYTE
@ -365,7 +555,7 @@ def getpfx(path)
^path = 0 ^path = 0
params.0 = 1 params.0 = 1
params:1 = path params:1 = path
perr = prodos($C7, @params) perr = syscall($C7, @params)
return path return path
end end
def setpfx(path) def setpfx(path)
@ -373,7 +563,7 @@ def setpfx(path)
params.0 = 1 params.0 = 1
params:1 = path params:1 = path
perr = prodos($C6, @params) perr = syscall($C6, @params)
return path return path
end end
def online def online
@ -382,7 +572,7 @@ def online
params.0 = 2 params.0 = 2
params.1 = 0 params.1 = 0
params:2 = databuff params:2 = databuff
perr = prodos($C5, @params) perr = syscall($C5, @params)
return databuff return databuff
end end
def open(path, buff) def open(path, buff)
@ -392,7 +582,7 @@ def open(path, buff)
params:1 = path params:1 = path
params:3 = buff params:3 = buff
params.5 = 0 params.5 = 0
perr = prodos($C8, @params) perr = syscall($C8, @params)
return params.5 return params.5
end end
def close(refnum) def close(refnum)
@ -400,7 +590,7 @@ def close(refnum)
params.0 = 1 params.0 = 1
params.1 = refnum params.1 = refnum
perr = prodos($CC, @params) perr = syscall($CC, @params)
return perr return perr
end end
def read(refnum, buff, len) def read(refnum, buff, len)
@ -411,9 +601,52 @@ def read(refnum, buff, len)
params:2 = buff params:2 = buff
params:4 = len params:4 = len
params:6 = 0 params:6 = 0
perr = prodos($CA, @params) perr = syscall($CA, @params)
return params:6 return params:6
end end
def write(refnum, buff, len)
byte params[8]
params.0 = 4
params.1 = refnum
params:2 = buff
params:4 = len
params:6 = 0
perr = syscall($CB, @params)
return params:6
end
def create(path, access, type, aux)
byte params[12]
params.0 = 7
params:1 = path
params.3 = access
params.4 = type
params:5 = aux
params.7 = $1
params:8 = 0
params:10 = 0
perr = syscall($C0, @params)
return perr
end
def destroy(path)
byte params[12]
params.0 = 1
params:1 = path
perr = syscall($C1, @params)
return perr
end
def newline(refnum, emask, nlchar)
byte params[4]
params.0 = 3
params.1 = refnum
params.2 = emask
params.3 = nlchar
perr = syscall($C9, @params)
return perr
end
; ;
; Utility routines. ; Utility routines.
@ -422,33 +655,40 @@ end
; More efficient than C or Pascal strings. ; More efficient than C or Pascal strings.
; ;
def dcitos(dci, str) def dcitos(dci, str)
byte len byte len, c
len = 0 len = 0
repeat repeat
str.[len] = dci.[len] & $7F c = (dci).[len]
len = len + 1 len = len + 1
until len > 15 or !(dci.[len - 1] & $80) (str).[len] = c & $7F
str.[len] = 0 until !(c & $80)
^str = len
return len return len
end end
def stodci(str, dci) def stodci(str, dci)
byte len byte len, c
len = 0 len = ^str
while len < 16 and str.[len] if len == 0
dci.[len] = toupper(str.[len]) | $80 return
len = len + 1 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 loop
dci.[len - 1] = dci.[len - 1] & $7F; return ^str
return len;
end end
; ;
; Heap routines. ; Heap routines.
; ;
def avail_heap def availheap
byte fp byte fp
return @fp - heap return @fp - heap
end end
def alloc_heap(size) def allocheap(size)
word addr word addr
addr = heap addr = heap
heap = heap + size heap = heap + size
@ -458,21 +698,21 @@ def alloc_heap(size)
; fin ; fin
return addr return addr
end end
def free_heap(size) def freeheap(size)
heap = heap - size; heap = heap - size;
return @size - heap; return @size - heap;
end end
def mark_heap def markheap
return heap; return heap;
end end
def release_heap(newheap) def releaseheap(newheap)
heap = newheap; heap = newheap;
return @newheap - heap; return @newheap - heap;
end end
;def avail_xheap(void) ;def availxheap(void)
; return 0xC000 - xheap; ; return 0xC000 - xheap;
;end ;end
;def alloc_xheap(int size) ;def allocxheap(int size)
; uword addr = xheap; ; uword addr = xheap;
; xheap += size; ; xheap += size;
; if (xheap >= 0xC000) ; if (xheap >= 0xC000)
@ -482,14 +722,14 @@ end
; } ; }
; return addr; ; return addr;
;end ;end
;def free_xheap(int size) ;def freexheap(int size)
; xheap -= size; ; xheap -= size;
; return 0xC000 - heap; ; return 0xC000 - heap;
;end ;end
;def mark_xheap(void) ;def markxheap(void)
; return xheap; ; return xheap;
;end ;end
;def release_xheap(uword newxheap) ;def releasexheap(uword newxheap)
; xheap = newxheap; ; xheap = newxheap;
; return 0xC000 - xheap; ; return 0xC000 - xheap;
;end ;end
@ -510,13 +750,13 @@ end
; ;
; DCI table routines, ; DCI table routines,
; ;
def dump_tbl(tbl) def dumptbl(tbl)
byte len byte len
word entbl
while ^tbl while ^tbl
len = 0 len = 0
while ^tbl & $80 while ^tbl & $80
cout(^tbl & $7F) cout(^tbl)
tbl = tbl + 1 tbl = tbl + 1
len = len + 1 len = len + 1
loop loop
@ -528,118 +768,139 @@ def dump_tbl(tbl)
len = len + 1 len = len + 1
loop loop
cout('$') cout('$')
prbyte((tbl).1) prword(*tbl)
prbyte((tbl).0) crout
tbl = tbl + 2 tbl = tbl + 2
loop loop
end end
def lookup_tbl(dci, tbl) def lookuptbl(dci, tbl)
byte str[20] byte str[20]
word match, entry word match
entry = tbl
while ^entry while ^tbl
dcitos(tbl, @str)
prstr(@str)
crout
match = dci match = dci
while ^entry == ^match while ^tbl == ^match
if !(^entry & $80) if !(^tbl & $80)
return (entry):1 return (tbl):1
fin fin
entry = entry + 1 tbl = tbl + 1
match = match + 1 match = match + 1
loop loop
while ^entry & $80 while ^tbl & $80
entry = entry + 1 tbl = tbl + 1
loop loop
entry = entry + 2 tbl = tbl + 3
loop loop
prstr(@luerrstr)
dcitos(dci, @str)
prstr(@str)
crout
return 0 return 0
end end
def add_tbl(dci, val, last) def addtbl(dci, val, last)
while ^dci & $80 while ^dci & $80
^(*last) = ^dci ^*last = ^dci
*last = *last + 1 *last = *last + 1
dci = dci + 1 dci = dci + 1
loop loop
^(*last) = ^dci ^*last = ^dci
*last = *last + 1 *last = *last + 1
dci = dci + 1 **last = val
^(*last) = val *last = *last + 2
*last = *last + 2
end end
; ;
; Symbol table routines. ; Symbol table routines.
; ;
def dump_sym def dumpsym
;printf("\nSystem Symbol Table:\n"); ;printf("\nSystem Symbol Table:\n");
dump_tbl(symtbl) dumptbl(@symtbl)
end end
def lookup_sym(sym) def lookupsym(sym)
return lookup_tbl(sym, symtbl) return lookuptbl(sym, @symtbl)
end end
def add_sym(sym, addr) def addsym(sym, addr)
return add_tbl(sym, addr, @lastsym); return addtbl(sym, addr, @lastsym);
end end
; ;
; Module routines. ; Module routines.
; ;
def dump_mod def dumpmod
;printf("\nSystem Module Table:\n"); ;printf("\nSystem Module Table:\n");
dump_tbl(modtbl) dumptbl(@modtbl)
end end
def lookup_mod(mod) def lookupmod(mod)
return lookup_tbl(mod, modtbl) return lookuptbl(mod, @modtbl)
end end
def add_mod(mod, addr) def addmod(mod)
return add_tbl(mod, addr, @lastmod) return addtbl(mod, @lastmod)
end end
def defcall_add(bank, addr) def adddef(bank, addr)
(lastdef).0 = $20 ; JSR $03D6 (lastdef).0 = $20 ; JSR $03D6
(lastdef):1 = $03D6 (lastdef):1 = $03D6
(lastdef).3 = bank (lastdef).3 = bank
(lastdef):4 = addr (lastdef):4 = addr
prstr(@adddefstr)
prword(lastdef)
crout
lastdef = lastdef + 6 lastdef = lastdef + 6
return lastdef - 6
end end
def def_lookup(cdd, defaddr) def lookupdef(bank, addr)
word i word entry
i = 0
while (cdd).[i] == $02 entry = @deftbl
if (cdd):[i + 1] == defaddr) while ^entry == $20
return cdd + i if (entry):4 == addr
if (entry).3 == bank
return entry
fin
fin fin
i = i + 4 entry = entry + 6
loop loop
return 0 return 0
end end
def extern_lookup(esd, index) def lookupextern(esd, index)
word sym word sym
byte str[17] byte str[16]
while ^esd while ^esd
sym = esd; sym = esd
esd = esd + dcitos(esd, str) esd = esd + dcitos(esd, @str)
if (esd).0 & $10 and (esd).1 == index if (esd).0 & $10 and (esd).1 == index
return lookup_sym(sym) return lookupsym(sym)
fin fin
esd = esd + 3 esd = esd + 3
loop loop
return 0 return 0
end end
def load_mod(mod) def loadmod(mod)
word refnum, len, size,modend, bytecode, fixup, addr, init, modaddr, modfix word refnum, len, size,modend, bytecode, fixup, addr, init, modaddr, modfix
word moddep, rld, esd, cdd, sym; word moddep, rld, esd, cdd, sym;
byte str[16]
byte filename[64]
byte header[128] byte header[128]
byte filename[32]
byte str[17]
init = 0 dcitos(mod, @filename)
modaddr = mark_heap prbyte(filename)
dcitos(mod, filename) cout(' ')
;printf("Load module %s\n", filename) prstr(@filename)
refnum = open(filename) crout
refnum = open(@filename, iobuffer)
if refnum > 0 if refnum > 0
modaddr = markheap
init = 0
len = read(refnum, @header, 128) len = read(refnum, @header, 128)
prstr(@modlenstr)
prword(len)
crout
if len > 4 and header:2 == $DA7E ; DAVE if len > 4 and header:2 == $DA7E ; DAVE
; ;
; This is a relocatable bytecode module. ; This is a relocatable bytecode module.
; ;
prstr(@davestr)
crout
bytecode = header:4 bytecode = header:4
init = header:6 init = header:6
moddep = @header + 8 moddep = @header + 8
@ -649,28 +910,34 @@ def load_mod(mod)
; ;
close(refnum) close(refnum)
while ^moddep while ^moddep
if lookup_mod(moddep) == 0 if lookupmod(moddep) == 0
load_mod(moddep) dumpmod
if loadmod(moddep) <> 0
dumpmod
return perr
fin
fin fin
moddep = moddep + dcitos(moddep, str) moddep = moddep + dcitos(moddep, @str)
prstr(@str)
crout
loop loop
modaddr = mark_heap modaddr = markheap
refnum = open(filename) refnum = open(@filename, iobuffer)
len = read(refnum, modaddr, 128) len = read(refnum, modaddr, 128)
fin fin
else else
memcpy(modaddr, header, len) memcpy(modaddr, @header, len)
fin fin
addr = modaddr + len; addr = modaddr + len;
repeat repeat
len = read(refnum, addr, 4096) len = read(refnum, addr, 4096)
addr = addr + len addr = addr + len
until len > 0 until len <= 0
close(refnum) close(refnum)
size = addr - modaddr size = addr - modaddr
len = *modaddr len = *modaddr
modend = modaddr + len modend = modaddr + len
modfix = modaddr - MOD_ADDR modfix = modaddr - MODADDR
bytecode = bytecode + modfix bytecode = bytecode + modfix
rld = modaddr + len ; Re-Locatable Directory rld = modaddr + len ; Re-Locatable Directory
cdd = rld ; Code Definition Directory cdd = rld ; Code Definition Directory
@ -679,88 +946,107 @@ def load_mod(mod)
esd = esd + 4 esd = esd + 4
loop loop
esd = esd + 1 esd = esd + 1
;if show_state ;if showstate
; ;
; Dump different parts of module. ; Dump different parts of module.
; ;
;printf("Module size: %d\n", size); prstr(@modsizestr)
prword(size)
crout
;printf("Module code+data size: %d\n", len); ;printf("Module code+data size: %d\n", len);
;printf("Module magic: $%04X\n", magic); prstr(@modlenstr)
prword(len)
crout
;printf("Module bytecode: $%04X\n", bytecode); ;printf("Module bytecode: $%04X\n", bytecode);
prstr(@modcodestr)
prword(bytecode)
crout
;printf("Module init: $%04X\n", init); ;printf("Module init: $%04X\n", init);
prstr(@modinitstr)
prword(init)
crout
;fin ;fin
; ;
; Print out the Re-Location Dictionary. ; Print out the Re-Location Dictionary.
; ;
;if show_state ;if showstate
;printf("\nRe-Location Dictionary:\n") ;printf("\nRe-Location Dictionary:\n")
;fin ;fin
while ^rld while ^rld
if ^rld == $02 if ^rld == $02
;if show_state prstr("\tDEF CODE") addr = (rld):1 + modfix
(rld):1 = (rld):1 + modfix (rld):1 = addr
modend = rld + 4 adddef(0, addr)
prstr(@defstr)
else else
addr = (rld):1 + modfix addr = (rld):1 + modfix
if (rld).0 & $80 if ^rld & $80
fixup = *addr fixup = *addr
else else
fixup = ^addr fixup = ^addr
fin fin
if (^rld & $10) if ^rld & $10
;if show_state printf("\tEXTERN[$%02X] ", rld[3]); prstr(@externstr)
fixup = fixup + extern_lookup(esd, rld[3]); prbyte((rld).3);"\tEXTERN[$%02X] ", rld[3]);
cout(']')
fixup = fixup + lookupextern(esd, (rld).3);
else else
;if (show_state) printf("\tINTERN ") prstr(@internstr);printf("\tINTERN ")
fixup = fixup + modfix fixup = fixup + modfix
if uword_isge(fixup, bytecode) if uword_isge(fixup, bytecode)
; ;
; Replace with call def dictionary. ; Replace with call def dictionary.
; ;
fixup = def_lookup(cdd, fixup) fixup = lookupdef(0, fixup)
fin fin
fin fin
if ^rld & $80 if ^rld & $80
;if show_state printf("WORD") prstr(@wordstr);printf("WORD")
*addr = fixup *addr = fixup
else else
;if show_state printf("BYTE") prstr(@bytestr);printf("BYTE")
^addr = fixup ^addr = fixup
fin fin
fin fin
;if show_state printf("@$%04X\n", addr) prstr(@addrstr)
rld = rld + 4; prword(addr)
crout;printf("@$%04X\n", addr)
rld = rld + 4
loop loop
;if show_state printf("\nExternal/Entry Symbol Directory:\n") ;if showstate printf("\nExternal/Entry Symbol Directory:\n")
while ^esd while ^esd
sym = esd sym = esd
esd = esd + dcitos(esd, str) esd = esd + dcitos(esd, @str)
if ^esd & $10 if ^esd & $10
;if show_state printf("\tIMPORT %s[$%02X]\n", string, esd[1]) ;if showstate printf("\tIMPORT %s[$%02X]\n", string, esd[1])
elsif ^esd & $08 elsif ^esd & $08
addr = (esd):1 + modfix addr = (esd):1 + modfix
;if show_state printf("\tEXPORT %s@$%04X\n", string, addr) ;if showstate printf("\tEXPORT %s@$%04X\n", string, addr)
if uword_isge(addr, bytecode) if uword_isge(addr, bytecode)
addr = def_lookup(cdd, addr) addr = lookupdef(0, addr)
fin fin
add_sym(sym, addr) addsym(sym, addr)
fin fin
esd = esd + 3 esd = esd + 3
loop loop
else else
;printf("Error: Unable to load module %s\n", filename); prstr(@readerrstr)
return -1 crout
perr = 0x100
return perr
fin fin
; ;
; Reserve heap space for relocated module. ; Reserve heap space for relocated module.
; ;
alloc_heap(modend - modaddr) allocheap(modend - modaddr)
; ;
; Call init routine. ; Call init routine.
; ;
if init if init
return (init + modfix)() init = adddef(0, init + modfix)
cin
return init()
fin fin
return 0 return 0
end end
@ -797,7 +1083,7 @@ def catalog(optpath)
prstr(@path) prstr(@path)
crout() crout()
fin fin
refnum = open(@path, iobuffer); refnum = open(@path, iobuffer)
if perr if perr
return perr return perr
fin fin
@ -917,50 +1203,45 @@ def execsys(sysfile)
fin fin
fin fin
end end
def execmod(modfile)
byte dci[17]
word saveheap, savemod, savesym, savedef
if stodci(modfile, @dci)
saveheap = heap
savemod = lastmod
savesym = lastsym
savedef = lastdef
loadmod(@dci)
heap = saveheap
lastmod = savemod
lastsym = savesym
lastdef = savedef
^heap = 0
^lastmod = 0
^lastsym = 0
^lastdef = 0
fin
end
def initsyms
byte dci[17]
word globals
def prucomp(a, b) stodci(@stdlibstr, @dci)
if uword_isgt(a, b) addmod(@dci, 1)
prword(a) globals = @exports
cout('>') while *globals
prword(b) stodci(*globals, @dci)
crout globals = globals + 2
fin addsym(@dci, *globals)
if uword_isge(a, b) globals = globals + 2
prword(a) loop
cout('>')
cout('=')
prword(b)
crout
fin
if uword_islt(a, b)
prword(a)
cout('<')
prword(b)
crout
fin
if uword_isle(a, b)
prword(a)
cout('<')
cout('=')
prword(b)
crout
fin
end end
resetmemfiles() resetmemfiles()
prstr(@version) prstr(@version)
crout() crout()
prucomp($1, $2) initsyms
prucomp($2, $1)
prucomp($100, $200)
prucomp($200, $100)
prucomp($9000, $A000)
prucomp($A000, $9000)
prucomp($E000, $E000)
prucomp($E001, $E000)
prucomp($E000, $E001)
prucomp($FFFF, $FFFE)
prucomp($FFFE, $FFFF)
while 1 while 1
prstr(getpfx(@prefix)) prstr(getpfx(@prefix))
cmdptr = rdstr($BA) cmdptr = rdstr($BA)
@ -976,10 +1257,13 @@ while 1
is '-' is '-'
execsys(cmdptr) execsys(cmdptr)
perr = $46 perr = $46
is '+'
execmod(cmdptr)
wend wend
if perr if perr
prstr(@errorstr) prstr(@errorstr)
prbyte(perr) prbyte(perr)
perr = 0
else else
prstr(@okstr) prstr(@okstr)
fin fin

View File

@ -11,7 +11,9 @@ static int consts = 0;
static int externs = 0; static int externs = 0;
static int globals = 0; static int globals = 0;
static int locals = 0; static int locals = 0;
static int predefs = 0;
static int defs = 0; static int defs = 0;
static int asmdefs = 0;
static int codetags = 0; static int codetags = 0;
static int fixups = 0; static int fixups = 0;
static char idconst_name[1024][17]; static char idconst_name[1024][17];
@ -23,9 +25,9 @@ static int localsize = 0;
static char idlocal_name[128][17]; static char idlocal_name[128][17];
static int idlocal_type[128]; static int idlocal_type[128];
static int idlocal_offset[128]; static int idlocal_offset[128];
static char fixup_size[255]; static char fixup_size[1024];
static int fixup_type[255]; static int fixup_type[1024];
static int fixup_tag[255]; static int fixup_tag[1024];
#define FIXUP_BYTE 0x00 #define FIXUP_BYTE 0x00
#define FIXUP_WORD 0x80 #define FIXUP_WORD 0x80
int id_match(char *name, int len, char *id) int id_match(char *name, int len, char *id)
@ -155,13 +157,14 @@ int idfunc_add(char *name, int len, int type, int tag)
printf("\t\t\t\t\t; %s -> X%03d\n", &idglobal_name[globals - 1][1], tag); printf("\t\t\t\t\t; %s -> X%03d\n", &idglobal_name[globals - 1][1], tag);
return (1); return (1);
} }
int idfunc_set(char *name, int len, int type) int idfunc_set(char *name, int len, int type, int tag)
{ {
int i; int i;
if (((i = idglobal_lookup(name, len)) >= 0) && (idglobal_type[i] & FUNC_TYPE)) if (((i = idglobal_lookup(name, len)) >= 0) && (idglobal_type[i] & FUNC_TYPE))
{ {
idglobal_tag[i] = tag;
idglobal_type[i] = type; idglobal_type[i] = type;
return (idglobal_type[i]); return (type);
} }
parse_error("Undeclared identifier"); parse_error("Undeclared identifier");
return (0); return (0);
@ -215,9 +218,15 @@ int id_type(char *name, int len)
int tag_new(int type) int tag_new(int type)
{ {
if (type & EXTERN_TYPE) if (type & EXTERN_TYPE)
{
if (externs > 254)
parse_error("External variable count overflow\n");
return (externs++); return (externs++);
}
if (type & PREDEF_TYPE)
return (predefs++);
if (type & ASM_TYPE) if (type & ASM_TYPE)
return (globals); return (asmdefs++);
if (type & DEF_TYPE) if (type & DEF_TYPE)
return (defs++); return (defs++);
if (type & BRANCH_TYPE) if (type & BRANCH_TYPE)
@ -226,11 +235,6 @@ int tag_new(int type)
} }
int fixup_new(int tag, int type, int size) int fixup_new(int tag, int type, int size)
{ {
if (fixups > 255)
{
printf("External variable count overflow\n");
return (0);
}
fixup_tag[fixups] = tag; fixup_tag[fixups] = tag;
fixup_type[fixups] = type; fixup_type[fixups] = type;
fixup_size[fixups] = size; fixup_size[fixups] = size;
@ -268,6 +272,8 @@ char *tag_string(int tag, int type)
t = 'A'; t = 'A';
else if (type & BRANCH_TYPE) else if (type & BRANCH_TYPE)
t = 'B'; t = 'B';
else if (type & PREDEF_TYPE)
t = 'P';
else else
t = 'D'; t = 'D';
sprintf(str, "_%c%03d", t, tag); sprintf(str, "_%c%03d", t, tag);
@ -418,7 +424,7 @@ void emit_idglobal(int tag, int size, char *name)
} }
void emit_idfunc(int tag, int type, char *name) void emit_idfunc(int tag, int type, char *name)
{ {
printf("%s%c\t\t\t\t\t; %s()\n", tag_string(tag, type), LBL, name); printf("%s%c\t\t\t\t\t; %s()\n", tag_string(tag, type), LBL, name);
} }
void emit_idconst(char *name, int value) void emit_idconst(char *name, int value)
{ {

8
PLASMA/src/hello.pla Normal file
View File

@ -0,0 +1,8 @@
import STDLIB
predef puts
end
byte hellostr[] = "Hello, world.\n"
puts(@hellostr)
done

View File

@ -163,7 +163,7 @@ t_token scan(void)
switch (scanpos[2]) switch (scanpos[2])
{ {
case 'n': case 'n':
constval = '\n'; constval = 0x0D;
break; break;
case 'r': case 'r':
constval = '\r'; constval = '\r';
@ -207,7 +207,7 @@ t_token scan(void)
switch (scanpos[1]) switch (scanpos[1])
{ {
case 'n': case 'n':
*scanpos = '\n'; *scanpos = 0x0D;
break; break;
case 'r': case 'r':
*scanpos = '\r'; *scanpos = '\r';

View File

@ -840,8 +840,9 @@ int parse_stmnt(void)
} }
else else
{ {
parse_error("RETURN outside of function"); if (!parse_expr())
return (0); emit_const(0);
emit_ret();
} }
break; break;
case EOL_TOKEN: case EOL_TOKEN:
@ -1077,7 +1078,7 @@ int parse_vars(int type)
*/ */
if (scan() == ID_TOKEN) if (scan() == ID_TOKEN)
{ {
type |= DEF_TYPE; type |= PREDEF_TYPE;
idstr = tokenstr; idstr = tokenstr;
idlen = tokenlen; idlen = tokenlen;
idfunc_add(tokenstr, tokenlen, type, tag_new(type)); idfunc_add(tokenstr, tokenlen, type, tag_new(type));
@ -1165,13 +1166,14 @@ int parse_defs(void)
type |= DEF_TYPE; type |= DEF_TYPE;
if (idglobal_lookup(tokenstr, tokenlen) >= 0) if (idglobal_lookup(tokenstr, tokenlen) >= 0)
{ {
if (!(id_type(tokenstr, tokenlen) & DEF_TYPE)) if (!(id_type(tokenstr, tokenlen) & PREDEF_TYPE))
{ {
parse_error("Mismatch function type"); parse_error("Mismatch function type");
return (0); return (0);
} }
idfunc_set(tokenstr, tokenlen, type); // Override any predef type emit_idfunc(id_tag(tokenstr, tokenlen), PREDEF_TYPE, tokenstr);
func_tag = id_tag(tokenstr, tokenlen); func_tag = tag_new(type);
idfunc_set(tokenstr, tokenlen, type, func_tag); // Override any predef type & tag
} }
else else
{ {
@ -1241,8 +1243,14 @@ int parse_defs(void)
type |= ASM_TYPE; type |= ASM_TYPE;
if (idglobal_lookup(tokenstr, tokenlen) >= 0) if (idglobal_lookup(tokenstr, tokenlen) >= 0)
{ {
idfunc_set(tokenstr, tokenlen, type); // Override any predef type if (!(id_type(tokenstr, tokenlen) & PREDEF_TYPE))
func_tag = id_tag(tokenstr, tokenlen); {
parse_error("Mismatch function type");
return (0);
}
emit_idfunc(id_tag(tokenstr, tokenlen), PREDEF_TYPE, tokenstr);
func_tag = tag_new(type);
idfunc_set(tokenstr, tokenlen, type, func_tag); // Override any predef type & tag
} }
else else
{ {
@ -1300,14 +1308,18 @@ int parse_module(void)
while (parse_defs()) next_line(); while (parse_defs()) next_line();
if (scantoken != DONE_TOKEN && scantoken != EOF_TOKEN) if (scantoken != DONE_TOKEN && scantoken != EOF_TOKEN)
{ {
emit_bytecode_seg();
emit_start(); emit_start();
emit_def("_INIT", 1); emit_def("_INIT", 1);
prevstmnt = 0; prevstmnt = 0;
while (parse_stmnt()) next_line(); while (parse_stmnt()) next_line();
if (scantoken != DONE_TOKEN) if (scantoken != DONE_TOKEN)
parse_error("Missing DONE statement"); parse_error("Missing DONE statement");
emit_const(0); if (prevstmnt != RETURN_TOKEN)
emit_ret(); {
emit_const(0);
emit_ret();
}
} }
} }
emit_trailer(); emit_trailer();

View File

@ -435,7 +435,7 @@ void interp(code *ip);
void call(uword pc) void call(uword pc)
{ {
unsigned int i, s; unsigned int i, s;
char sz[64]; char c, sz[64];
switch (mem_data[pc++]) switch (mem_data[pc++])
{ {
@ -453,7 +453,10 @@ void call(uword pc)
PUSH(0); PUSH(0);
break; break;
case 4: // LIBRARY STDLIB::PUTC case 4: // LIBRARY STDLIB::PUTC
putchar(POP); c = POP;
if (c == 0x0D)
c = '\n';
putchar(c);
PUSH(0); PUSH(0);
break; break;
case 5: // LIBRARY STDLIB::PUTS case 5: // LIBRARY STDLIB::PUTS
@ -461,15 +464,20 @@ void call(uword pc)
i = mem_data[s++]; i = mem_data[s++];
PUSH(i); PUSH(i);
while (i--) while (i--)
putchar(mem_data[s++]); {
c = mem_data[s++];
if (c == 0x0D)
c = '\n';
putchar(c);
}
break; break;
case 6: // LIBRARY STDLIB::PUTSZ case 6: // LIBRARY STDLIB::PUTSZ
s = POP; s = POP;
while (i = mem_data[s++]) while (c = mem_data[s++])
{ {
if (i == '\r') if (c == 0x0D)
i = '\n'; c = '\n';
putchar(i); putchar(c);
} }
PUSH(0); PUSH(0);
break; break;

View File

@ -9,7 +9,6 @@
#define ASM_TYPE (1 << 3) #define ASM_TYPE (1 << 3)
#define DEF_TYPE (1 << 4) #define DEF_TYPE (1 << 4)
#define BRANCH_TYPE (1 << 5) #define BRANCH_TYPE (1 << 5)
#define FUNC_TYPE (ASM_TYPE | DEF_TYPE)
#define LOCAL_TYPE (1 << 6) #define LOCAL_TYPE (1 << 6)
#define EXTERN_TYPE (1 << 7) #define EXTERN_TYPE (1 << 7)
#define ADDR_TYPE (VAR_TYPE | FUNC_TYPE | EXTERN_TYPE) #define ADDR_TYPE (VAR_TYPE | FUNC_TYPE | EXTERN_TYPE)
@ -19,7 +18,8 @@
#define STRING_TYPE (1 << 10) #define STRING_TYPE (1 << 10)
#define TAG_TYPE (1 << 11) #define TAG_TYPE (1 << 11)
#define EXPORT_TYPE (1 << 12) #define EXPORT_TYPE (1 << 12)
#define PREDEF_TYPE (1 << 13)
#define FUNC_TYPE (ASM_TYPE | DEF_TYPE | PREDEF_TYPE)
int id_match(char *name, int len, char *id); int id_match(char *name, int len, char *id);
int idlocal_lookup(char *name, int len); int idlocal_lookup(char *name, int len);
int idglobal_lookup(char *name, int len); int idglobal_lookup(char *name, int len);
@ -27,7 +27,7 @@ int idconst_lookup(char *name, int len);
int idlocal_add(char *name, int len, int type, int size); int idlocal_add(char *name, int len, int type, int size);
int idglobal_add(char *name, int len, int type, int size); int idglobal_add(char *name, int len, int type, int size);
int id_add(char *name, int len, int type, int size); int id_add(char *name, int len, int type, int size);
int idfunc_set(char *name, int len, int type); int idfunc_set(char *name, int len, int type, int tag);
int idfunc_add(char *name, int len, int type, int tag); int idfunc_add(char *name, int len, int type, int tag);
int idconst_add(char *name, int len, int value); int idconst_add(char *name, int len, int value);
int id_tag(char *name, int len); int id_tag(char *name, int len);

View File

@ -49,5 +49,5 @@ export def indirect
mainptr() mainptr()
end end
ascii indirect
done done