1
0
mirror of https://github.com/dschmenk/PLASMA.git synced 2024-07-20 13:28:56 +00:00

Synchronize CMDs

This commit is contained in:
David Schmenk 2018-02-01 18:10:02 -08:00
parent f039572dde
commit 10274bdf27
2 changed files with 594 additions and 377 deletions

View File

@ -1,3 +1,6 @@
const FALSE = 0
const TRUE = not FALSE
const RELADDR = $1000
const inbuff = $200
const freemem = $0006
@ -31,15 +34,19 @@ const CFFAEntryPtr = $0B
// Pedefined functions.
//
predef syscall(cmd,null)#1, call(addr,areg,xreg,yreg,status)#1
predef crout()#0, cout(c)#0, prstr(s)#0, print(i)#0, cin()#1, rdstr(p)#1, toupper(c)#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 loadmod(mod)#1, execmod(modfile)#1, lookupstrmod(str)#1
predef uword_isgt(a,b)#1, uword_isge(a,b)#1, uword_islt(a,b)#1, uword_isle(a,b)#1
predef sext(a)#1, divmod(a,b)#2, execmod(modfile)#1
//
// System variables.
// Exported CMDSYS table
//
word version = $0100 // 01.00
word version = $0100 // 01.00
word syspath
word syscmdln
word = @execmod
word systemflags = 0
word heap
word symtbl, lastsym
@ -68,14 +75,17 @@ word cmdptr = @hexchar // make it point to a zero
//
byte syslibstr[] = "CMDSYS"
byte machidstr[] = "MACHID"
byte syspathstr[] = "SYSPATH"
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 sysstr[] = "SYSCALL"
byte callstr[] = "CALL"
byte hpmarkstr[] = "HEAPMARK"
@ -91,8 +101,6 @@ byte uisltstr[] = "ISULT"
byte uislestr[] = "ISULE"
byte sextstr[] = "SEXT"
byte divmodstr[] = "DIVMOD"
byte argstr[] = "ARGS"
byte syspath[] = "" // Set to NULL
word exports[] = @syslibstr, @version
word = @sysstr, @syscall
word = @callstr, @call
@ -100,6 +108,8 @@ 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
@ -110,6 +120,8 @@ 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
@ -117,11 +129,19 @@ word = @uislestr, @uword_isle
word = @sextstr, @sext
word = @divmodstr, @divmod
word = @machidstr, @machid
word = @syspathstr,@syspath
word = @argstr, @cmdptr
word = 0
word syslibsym = @exports
//
// Utility functions
//
asm saveX#0
STX XREG+1
end
asm restoreX#0
XREG LDX #$00
RTS
end
//
// CALL CFFA1 API ENTRYPOINT
// SYSCALL(CMD, 0)
//
@ -189,189 +209,189 @@ end
// 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
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
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 -
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
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
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
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
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,X
STA DSTL
LDA ESTKH-3,X
ADC ESTKH,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
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
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
//
// 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
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
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
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
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 DINTERP
!BYTE $36, $5C ; DIVMOD, RET
end
asm sext(a)#1
LDY #$00
LDA ESTKL,X
BPL +
DEY
+ STY ESTKH,X
RTS
LDY #$00
LDA ESTKL,X
BPL +
DEY
+ STY ESTKH,X
RTS
end
//
// Addresses of internal routines.
//
asm interp()#1
DEX
LDA #<IINTERP
STA ESTKL,X
LDA #>IINTERP
STA ESTKH,X
RTS
DEX
LDA #<IINTERP
STA ESTKL,X
LDA #>IINTERP
STA ESTKH,X
RTS
end
//
// A DCI string is one that has the high bit set for every character except the last.
@ -389,28 +409,28 @@ end
// 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
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
@ -429,43 +449,43 @@ end
// 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
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
LDA ESTKL,X
TOUPR AND #$7F
CMP #'a'
BCC +
CMP #'z'+1
BCS +
SBC #$1F
+ STA ESTKL,X
RTS
CMP #'a'
BCC +
CMP #'z'+1
BCS +
SBC #$1F
+ STA ESTKL,X
RTS
end
//
// Module symbols are entered into the symbol table
@ -493,77 +513,74 @@ end
// loop
// return 0
asm lookuptbl(dci, tbl)#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 (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 ---
LDA ESTKL,X
STA DSTL
LDA ESTKH,X
STA DSTH
INX
LDA ESTKL,X
STA SRCL
LDA ESTKH,X
STA SRCH
-- LDY #$00
- LDA (DST),Y
BEQ +
CMP (SRC),Y
BNE ++
INY
ASL
BCS -
LDA (DST),Y
STA ESTKL,X ; MATCH
INY
LDA (DST),Y
STA ESTKH,X
RTS
+ STA ESTKL,X ; NO MATCH
STA ESTKH,X
RTS
++
- LDA (DST),Y ; NEXT ENTRY
BPL +
INY
BNE -
+ TYA
CLC
ADC #$03
ADC DSTL
STA DSTL
BCC --
INC DSTH
BNE --
end
//
// CONSOLE I/O
//
asm cout(c)#0
LDA ESTKL,X
JSR TOUPR
ORA #$80
JMP $FFEF
LDA ESTKL,X
JSR TOUPR
ORA #$80
JMP $FFEF
end
asm cin()#1
DEX
- LDA $D011
BPL -
LDA $D010
AND #$7F
STA ESTKL,X
LDA #$00
STA ESTKH,X
RTS
DEX
- LDA $D011
BPL -
LDA $D010
AND #$7F
STA ESTKL,X
LDA #$00
STA ESTKH,X
RTS
end
def crout()#0
cout($0D)
end
def prstr(str)#0
byte i
i = 1
while i <= ^str
cout((str)[i])
i = i + 1
loop
for i = 1 to ^str
cout(^(str + i))
next
end
def print(i)#0
if i < 0; cout('-'); i = -i; fin
@ -580,7 +597,7 @@ def rdstr(prompt)#1
when ch
is $15 // right arrow
if ^inbuff < maxlen //inbuff.0 < maxlen
inbuff.0 = inbuff.0 + 1
inbuff.0++
ch = inbuff[inbuff.0]
cout(ch)
fin
@ -589,7 +606,7 @@ def rdstr(prompt)#1
if inbuff.0
cout('\\')
cout(inbuff[inbuff.0])
inbuff.0 = inbuff.0 - 1
inbuff.0--
fin
break
is $04 // ctrl-d
@ -597,8 +614,8 @@ def rdstr(prompt)#1
cout('#')
cout(inbuff[inbuff.0])
memcpy(inbuff + inbuff.0, inbuff + inbuff.0 + 1, maxlen - inbuff.0)
maxlen = maxlen - 1
inbuff.0 = inbuff.0 - 1
maxlen--
inbuff.0--
fin
break
is $0C // ctrl-l
@ -617,7 +634,7 @@ def rdstr(prompt)#1
otherwise
if ch >= ' '
cout(ch)
inbuff.0 = inbuff.0 + 1
inbuff.0++
inbuff[inbuff.0] = ch
if inbuff.0 > maxlen
maxlen = inbuff.0
@ -637,6 +654,19 @@ def prword(v)#0
prbyte(v)
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
//
// CFFA1 routines
// FILE I/O
//
@ -847,9 +877,9 @@ def loadmod(mod)#1
addr = rld=>1 + modfix
//if uword_isge(addr, modaddr) // Skip fixups to header
//if type & $80 // WORD sized fixup.
// fixup = *addr
fixup = *addr
//else // BYTE sized fixup.
fixup = ^addr
// fixup = ^addr
//fin
if ^rld & $10 // EXTERN reference.
fixup = fixup + lookupextern(esd, rld->3)
@ -921,17 +951,17 @@ end
def stripchars(strptr)#1
while ^strptr and ^(strptr + 1) <> ' '
memcpy(strptr + 1, strptr + 2, ^strptr)
^strptr = ^strptr - 1
^strptr--
loop
return ^strptr
end
def stripspaces(strptr)#0
while ^strptr and ^(strptr + ^strptr) <= ' '
^strptr = ^strptr - 1
^strptr--
loop
while ^strptr and ^(strptr + 1) <= ' '
memcpy(strptr + 1, strptr + 2, ^strptr)
^strptr = ^strptr - 1
^strptr--
loop
end
def striptrail(strptr)#0
@ -952,7 +982,7 @@ def parsecmd(strptr)#1
if ^strptr
cmd = ^(strptr + 1)
memcpy(strptr + 1, strptr + 2, ^strptr)
^strptr = ^strptr - 1
^strptr--
fin
stripspaces(strptr)
return cmd
@ -964,14 +994,14 @@ def execmod(modfile)#1
perr = 1
if stodci(modfile, @moddci)
saveheap = heap
savesym = lastsym
saveflags = systemflags
if loadmod(@moddci) < modkeep
lastsym = savesym
heap = saveheap
fin
^lastsym = 0
systemflags = saveflags
savesym = lastsym
saveflags = systemflags
if loadmod(@moddci) < modkeep
lastsym = savesym
heap = saveheap
fin
^lastsym = 0
systemflags = saveflags
fin
return -perr
end
@ -1001,7 +1031,7 @@ cmdptr = heap
memset(cmdptr, 0, 128)
readfile(@autorun, cmdptr + 1)
while ^(cmdptr + ^cmdptr + 1) >= ' '
^cmdptr = ^cmdptr + 1
^cmdptr++
loop
perr = 0
//
@ -1015,24 +1045,24 @@ fin
//
// Handle commands.
//
while 1
while TRUE
if ^cmdptr
when toupper(parsecmd(cmdptr))
is 'Q'
quit
is 'M'
syscall($02, 0)
break
is '+'
execmod(cmdptr)
break
otherwise
prstr(@huhstr)
quit
is 'M'
syscall($02, 0)
break
is '+'
execmod(cmdptr)
break
otherwise
prstr(@huhstr)
wend
if perr
prstr(@errorstr)
prbyte(perr)
perr = 0
prbyte(perr)
perr = 0
else
prstr(@okstr)
fin

View File

@ -26,13 +26,14 @@ const O_READ_WRITE = 3
// 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, cin()#1, rdstr(p)#1, toupper(c)#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
//
// System variables.
// Exported CMDSYS table
//
word version = $0100 // 01.00
word syspath
@ -62,9 +63,13 @@ 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"
@ -79,9 +84,6 @@ byte uislestr[] = "ISULE"
byte sysmods[] // overlay with exported strings
byte sextstr[] = "SEXT"
byte divmodstr[] = "DIVMOD"
byte loadstr[] = "MODLOAD"
byte execstr[] = "MODEXEC"
byte modadrstr[] = "RELADDR"
byte prefix[] // Overlay with exported symbols table
word exports[] = @sysmodstr, @version
word = @sysstr, @syscall
@ -90,6 +92,8 @@ 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
@ -119,6 +123,16 @@ byte modseg[15]
word symtbl, lastsym
byte perr, terr, lerr
//
// Utility functions
//
asm saveX#0
STX XREG+1
end
asm restoreX#0
XREG LDX #$00
RTS
end
//
// CALL SOS
// SYSCALL(CMD, PARAMS)
//
@ -634,6 +648,176 @@ asm lookuptbl(dci, tbl)#1
+ 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 + 5
// 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 #$05
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
//
// SOS routines
// FILE I/O
@ -926,21 +1110,16 @@ end
def lookupextern(esd, index)#1
word sym, addr
byte str[16]
while ^esd
sym = esd
esd = sym + dcitos(sym, @str)
if esd->0 & $10 and esd->1 == index
addr = lookuptbl(sym, symtbl)
if !addr
lerr = $81
cout('?')
prstr(@str)
crout
fin
return addr
sym = lookupidx(esd, index)
if sym
addr = lookuptbl(sym, symtbl)
if !addr
perr = $81
dcitos(sym, @str)
cout('?'); prstr(@str); crout
fin
esd = esd + 3
loop
return addr
fin
return 0
end
def adddef(ext, addr, deflast)#1
@ -953,15 +1132,6 @@ def adddef(ext, addr, deflast)#1
defentry=>5 = ext // ext is byte, so this nulls out next entry
return defentry
end
def lookupdef(addr, deftbl)#1
while deftbl->0 == $20
if deftbl=>3 == addr
return deftbl
fin
deftbl = deftbl + 6
loop
return 0
end
def loadmod(mod)#1
word refnum, rdlen, modsize, bytecode, codefix, defofst, defcnt, init, fixup
word addr, defaddr, modaddr, modfix, modofst, modend
@ -987,7 +1157,7 @@ def loadmod(mod)#1
moddep = @header.1
defofst = modsize + RELADDR
init = 0
if rdlen > 4 and header:2 == $DA7F // DAVE+1 = magic number :-)
if rdlen > 4 and header:2 == $6502 // DAVE+1 = magic number :-)
//
// This is an EXTended RELocatable (data+bytecode) module.
//
@ -1086,31 +1256,36 @@ def loadmod(mod)#1
// Run through the Re-Location Dictionary.
//
while ^rld
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 + modofst
if uword_isge(fixup, bytecode)
//
// Bytecode address - replace with call def directory.
//
fixup = lookupdef(fixup + codefix, deftbl)
fin
fin
//if ^rld & $80 // WORD sized fixup.
*addr = fixup
//else // BYTE sized fixup.
// ^addr = fixup
//fin
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
rld = rld + 4
//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.
@ -1139,17 +1314,17 @@ def loadmod(mod)#1
//
memxcpy(codeseg, bytecode, modsize - (bytecode - modaddr))
fin
//
// Free up end-of-module main memory.
//
releaseheap(bytecode)
else
return -perr
//else
// return -perr
fin
if lerr
return -lerr
fin
//
// Free up end-of-module main memory.
//
releaseheap(bytecode)
//
// Call init routine if it exists.
//
fixup = 0
@ -1215,24 +1390,26 @@ def catalog(optpath)#1
fin
for i = firstblk to entriesblk
type = ^entry
if type <> 0
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
type = ' '
when entry->$10
is $0F // Is it a directory?
type = '/'
break
is $FF // SYSTEM file
type = '-'
break
is $FE // REL file
type = '+'
wend
cout(type)
for len = 18 - len downto 0
cout(' ')
next
filecnt = filecnt - 1
filecnt--
fin
entry = entry + entrylen
next
@ -1246,26 +1423,26 @@ def catalog(optpath)#1
return 0
end
def stripchars(strptr)#1
while ^strptr and ^(strptr + 1) <> ' '
while ^strptr and ^(strptr + 1) > ' '
memcpy(strptr + 1, strptr + 2, ^strptr)
^strptr = ^strptr - 1
^strptr--
loop
return ^strptr
end
def stripspaces(strptr)#0
while ^strptr and ^(strptr + ^strptr) <= ' '
^strptr = ^strptr - 1
^strptr--
loop
while ^strptr and ^(strptr + 1) <= ' '
memcpy(strptr + 1, strptr + 2, ^strptr)
^strptr = ^strptr - 1
^strptr--
loop
end
def striptrail(strptr)#1
byte i
for i = 1 to ^strptr
if (strptr)[i] <= ' '
if ^(strptr + i) <= ' '
^strptr = i - 1
break
fin
@ -1280,7 +1457,7 @@ def parsecmd(strptr)#1
if ^strptr
cmd = ^(strptr + 1)
memcpy(strptr + 1, strptr + 2, ^strptr)
^strptr = ^strptr - 1
^strptr--
fin
stripspaces(strptr)
return cmd
@ -1316,7 +1493,7 @@ init_cons
//
// Print PLASMA version
//
prstr("PLASMA "); prbyte(version.1); cout('.'); prbyte(version.0); crout
prstr("PLASMA Pre3 "); prbyte(version.1); cout('.'); prbyte(version.0); crout
//
// Init 2K symbol table.
//
@ -1365,6 +1542,14 @@ while 1
is 'P'
setpfx(cmdptr)
break
is '/'
repeat
prefix--
until prefix[prefix] == '/'
if prefix > 1
setpfx(@prefix)
fin
break
is 'S'
setpfx(cmdptr)
strcat(getpfx(@sysmods), "SYS/"))
@ -1373,7 +1558,9 @@ while 1
volumes
break
is '+'
saveX
execmod(striptrail(cmdptr))
restoreX
write(refcons, @textmode, 3)
break
otherwise