mirror of
https://github.com/dschmenk/PLASMA.git
synced 2024-06-01 03:41:34 +00:00
1225 lines
27 KiB
Plaintext
Executable File
1225 lines
27 KiB
Plaintext
Executable File
const RELADDR = $1000
|
|
const inbuff = $01FF
|
|
const freemem = $0006
|
|
//
|
|
// 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 = $1000
|
|
const modinitkeep = $2000
|
|
//
|
|
// CFFA1 addresses.
|
|
//
|
|
const CFFADest = $00
|
|
const CFFAFileName = $02
|
|
const CFFAOldName = $04
|
|
const CFFAFileType = $06
|
|
const CFFAAuxType = $07
|
|
const CFFAFileSize = $09
|
|
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, 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
|
|
predef sext(a)#1, divmod(a,b)#2, execmod(modfile)#1, syslookuptbl(a)#1
|
|
//
|
|
// Exported CMDSYS table
|
|
//
|
|
word version = $0211 // 02.11
|
|
word syspath
|
|
word syscmdln
|
|
word = @execmod
|
|
word systemflags = 0
|
|
word heap
|
|
word symtbl, lastsym
|
|
byte perr, refauto
|
|
word = @syslookuptbl
|
|
//
|
|
// String pool.
|
|
//
|
|
byte autorun[] = "AUTORUN"
|
|
byte verstr[] = "\nAPPLE1 PLASMA "
|
|
byte freestr[] = "MEM FREE:$"
|
|
byte errorstr[] = "ERR:$"
|
|
byte prompt[] = "PLASMA"
|
|
byte okstr[] = "OK"
|
|
byte huhstr[] = "?\n"
|
|
byte hexchar[] = '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'
|
|
//
|
|
// Exported Machine ID.
|
|
//
|
|
byte machid = $08 // Apple 1 (NA in ProDOS Tech Ref)
|
|
//
|
|
// Command line pointer
|
|
//
|
|
word cmdptr = @hexchar // make it point to a zero
|
|
//
|
|
// Standard Library exported functions.
|
|
//
|
|
byte syslibstr[] = "CMDSYS"
|
|
byte machidstr[] = "MACHID"
|
|
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"
|
|
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[] = @syslibstr, @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
|
|
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 syslibsym = @exports
|
|
//
|
|
// Utility functions
|
|
//
|
|
//
|
|
// CALL CFFA1 API ENTRYPOINT
|
|
// SYSCALL(CMD, 0)
|
|
//
|
|
asm syscall(cmd, null)#1
|
|
INX
|
|
LDA ESTKL,X
|
|
STX ESP
|
|
TAX
|
|
JSR $900C
|
|
LDX ESP
|
|
LDY #$00
|
|
STA ESTKL,X
|
|
STY ESTKH,X
|
|
RTS
|
|
end
|
|
//
|
|
// CALL 6502 ROUTINE
|
|
// CALL(ADDR, AREG, XREG, YREG, STATUS)
|
|
//
|
|
asm call(addr,areg,xreg,yreg,sstatus)#1
|
|
PHP
|
|
LDA ESTKL+4,X
|
|
STA CALL6502+1
|
|
LDA ESTKH+4,X
|
|
STA CALL6502+2
|
|
LDA ESTKL,X
|
|
PHA
|
|
LDY ESTKL+1,X
|
|
LDA ESTKL+3,X
|
|
PHA
|
|
LDA ESTKL+2,X
|
|
INX
|
|
INX
|
|
INX
|
|
INX
|
|
STX ESP
|
|
TAX
|
|
PLA
|
|
PLP
|
|
CALL6502 JSR $FFFF
|
|
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
|
|
REGVALS !FILL 4
|
|
end
|
|
//
|
|
// QUIT TO MONITOR
|
|
//
|
|
asm quit()#0
|
|
JMP $9000
|
|
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
|
|
//
|
|
// 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 DINTERP
|
|
!BYTE $36, $5C ; DIVMOD, RET
|
|
end
|
|
asm sext(a)#1
|
|
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
|
|
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
|
|
//
|
|
// Module symbols are entered into the symbol table
|
|
// pre-pended with a '#' to differentiate them
|
|
// from normal symbols.
|
|
//
|
|
//
|
|
// 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
|
|
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
|
|
// 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
|
|
INY
|
|
LDA (SRC),Y
|
|
CLC
|
|
ADC ESTKL+3,X ; ADDR=ENTRY=>1+MODFIX
|
|
STA DSTL
|
|
INY
|
|
LDA (SRC),Y
|
|
ADC ESTKH+3,X
|
|
STA DSTH
|
|
LDY #$00
|
|
LDA (SRC),Y
|
|
AND #$10 ; EXTERN REF - EXIT
|
|
BNE RLDEX
|
|
LDA (SRC),Y
|
|
BMI FIX16
|
|
AND #$40
|
|
BNE FIXMSB
|
|
FIXLSB LDA (DST),Y
|
|
CLC
|
|
ADC ESTKL+2,X
|
|
CLC
|
|
BCC FIX8
|
|
FIXMSB LDY #$03
|
|
LDA (SRC),Y ; FIXUPH=(ENTRY->3+MODOFSTL)+(^ADDR+MODOFSTH)
|
|
CLC
|
|
ADC ESTKL+2,X
|
|
LDY #$00
|
|
LDA (DST),Y
|
|
ADC ESTKH+2,X
|
|
CLC
|
|
BCC FIX8
|
|
FIX16 LDA (DST),Y ; FIXUP=*ADDR+MODOFST
|
|
CLC
|
|
ADC ESTKL+2,X
|
|
STA TMPL
|
|
INY
|
|
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
|
|
FIX8 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
|
|
//
|
|
// CONSOLE I/O
|
|
//
|
|
asm cout(c)#0
|
|
LDA ESTKL,X
|
|
JSR TOUPR
|
|
INX
|
|
ORA #$80
|
|
JMP $FFEF
|
|
; JMP $FDED
|
|
end
|
|
asm cin()#1
|
|
- LDA $D011
|
|
;- LDA $C000
|
|
BPL -
|
|
LDA $D010
|
|
; STA $C010
|
|
AND #$7F
|
|
DEX
|
|
STA ESTKL,X
|
|
LDA #$00
|
|
STA ESTKH,X
|
|
RTS
|
|
end
|
|
def crout()#0
|
|
cout($0D)
|
|
end
|
|
def prstr(str)#0
|
|
byte i
|
|
for i = 1 to ^str
|
|
cout(^(str + i))
|
|
next
|
|
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
|
|
byte ch, maxlen
|
|
maxlen = 0
|
|
^inbuff = 0
|
|
cout(prompt)
|
|
repeat
|
|
ch = cin
|
|
when ch
|
|
is $15 // right arrow
|
|
if ^inbuff < maxlen
|
|
^inbuff++
|
|
ch = ^(inbuff + ^inbuff)]
|
|
cout(ch)
|
|
fin
|
|
break
|
|
is $08 // left arrow
|
|
if ^inbuff
|
|
cout('\\')
|
|
cout(^(inbuff + ^inbuff))
|
|
inbuff.0--
|
|
fin
|
|
break
|
|
is $04 // ctrl-d
|
|
if inbuff.0
|
|
cout('#')
|
|
cout(^(inbuff + ^inbuff))
|
|
memcpy(inbuff + ^inbuff, inbuff + ^inbuff + 1, maxlen - ^inbuff)
|
|
maxlen--
|
|
^inbuff--
|
|
fin
|
|
break
|
|
is $0C // ctrl-l
|
|
crout
|
|
prstr(inbuff)
|
|
break
|
|
is $0D // return
|
|
break
|
|
is $18 // ctrl-x
|
|
crout
|
|
^inbuff = 0
|
|
break
|
|
is $9B // escape
|
|
^inbuff = 0
|
|
ch = $0D
|
|
break
|
|
otherwise
|
|
if ch >= ' '
|
|
cout(ch)
|
|
^inbuff++
|
|
^(inbuff + ^inbuff) = ch
|
|
if ^inbuff > maxlen
|
|
maxlen = ^inbuff
|
|
fin
|
|
fin
|
|
wend
|
|
until ch == $0D or ^inbuff == $7F
|
|
cout($0D)
|
|
return inbuff
|
|
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
|
|
//
|
|
// 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
|
|
//
|
|
def finddirentry(filename)#1
|
|
*CFFAFileName = filename
|
|
perr = syscall($14, 0)
|
|
return *CFFAEntryPtr
|
|
end
|
|
def readfile(filename, buffer)#1
|
|
*CFFADest = buffer
|
|
*CFFAFileName = filename
|
|
perr = syscall($22, 0)
|
|
return perr
|
|
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)
|
|
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 syslookuptbl(dci)#1
|
|
return lookuptbl(dci, symtbl)
|
|
end
|
|
def addsym(sym, addr)#0
|
|
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 lookupextern(esd, index)#1
|
|
word sym, addr
|
|
byte str[33]
|
|
while ^esd
|
|
sym = esd
|
|
esd = sym + dcitos(sym, @str)
|
|
if esd->0 & $10 and esd->1 == index
|
|
addr = lookuptbl(sym, symtbl)
|
|
if !addr
|
|
perr = $81
|
|
cout('?')
|
|
prstr(@str)
|
|
crout
|
|
fin
|
|
return addr
|
|
fin
|
|
esd = esd + 3
|
|
loop
|
|
return 0
|
|
end
|
|
def adddef(addr, deflast)#1
|
|
word defentry
|
|
defentry = *deflast
|
|
*deflast = defentry + 5
|
|
defentry->0 = $20
|
|
defentry=>1 = interp
|
|
defentry=>3 = addr
|
|
defentry->5 = 0 // null out next entry
|
|
return defentry
|
|
end
|
|
def loadmod(mod)#1
|
|
word rdlen, modsize, bytecode, defofst, defcnt, init, fixup
|
|
word addr, modaddr, modfix, modofst, modend
|
|
word deftbl, deflast
|
|
word moddep, rld, esd, sym
|
|
byte type, str[17], filename[17]
|
|
byte header[128]
|
|
//
|
|
// Read the RELocatable module header (first 128 bytes)
|
|
//
|
|
dcitos(mod, @filename)
|
|
rdlen = finddirentry(@filename)=>$15
|
|
if perr
|
|
return -perr
|
|
fin
|
|
if rdlen > 0
|
|
readfile(@filename, heap)
|
|
memcpy(@header, heap, 128)
|
|
modsize = header:0
|
|
moddep = @header.1
|
|
defofst = modsize + RELADDR
|
|
init = 0
|
|
if rdlen > 4 and header:2 == $6502 // magic number
|
|
//
|
|
// This is an EXTended RELocatable (data+bytecode) module.
|
|
//
|
|
defofst = header:6
|
|
defcnt = header:8
|
|
init = header:10
|
|
moddep = @header.12
|
|
//
|
|
// Load module dependencies.
|
|
//
|
|
while ^moddep
|
|
if !lookuptbl(moddep, symtbl)
|
|
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
|
|
//
|
|
// Re-read file
|
|
//
|
|
readfile(@filename, heap)
|
|
fin
|
|
//
|
|
// Alloc heap space for relocated module (data + bytecode).
|
|
//
|
|
moddep = moddep + 1 - @header + heap
|
|
modfix = moddep - (heap + 2) // Adjust to skip header
|
|
modsize = modsize - modfix
|
|
rdlen = rdlen - modfix - 2
|
|
modaddr = allocheap(modsize)
|
|
memcpy(modaddr, moddep, rdlen)
|
|
//
|
|
// 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
|
|
defofst = bytecode - defofst
|
|
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
|
|
//
|
|
// Run through the DeFinition Dictionary.
|
|
//
|
|
while ^rld == $02
|
|
//
|
|
// This is a bytcode def entry - add it to the def directory.
|
|
//
|
|
adddef(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, 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, deftbl)
|
|
fin
|
|
addsym(sym, addr)
|
|
fin
|
|
esd = esd + 3
|
|
loop
|
|
fin
|
|
if perr
|
|
return -perr
|
|
fin
|
|
//
|
|
// Free up the end-of-module in main memory.
|
|
//
|
|
releaseheap(modend)
|
|
//
|
|
// Call init routine if it exists.
|
|
//
|
|
fixup = modkeep
|
|
if init
|
|
init = init + defofst
|
|
fixup = adddef(init, @deflast)()
|
|
if fixup < 0
|
|
perr = -fixup
|
|
fin
|
|
if !(systemflags & modinitkeep)
|
|
releaseheap(init)
|
|
fin
|
|
fin
|
|
return fixup | (systemflags & modkeep)
|
|
end
|
|
//
|
|
// Command mode
|
|
//
|
|
def stripchars(strptr)#1
|
|
while ^strptr and ^(strptr + 1) <> ' '
|
|
memcpy(strptr + 1, strptr + 2, ^strptr)
|
|
^strptr--
|
|
loop
|
|
return ^strptr
|
|
end
|
|
def stripspaces(strptr)#0
|
|
while ^strptr and ^(strptr + ^strptr) <= ' '
|
|
^strptr--
|
|
loop
|
|
while ^strptr and ^(strptr + 1) <= ' '
|
|
memcpy(strptr + 1, strptr + 2, ^strptr)
|
|
^strptr--
|
|
loop
|
|
end
|
|
def striptrail(strptr)#0
|
|
byte i
|
|
|
|
for i = 1 to ^strptr
|
|
if (strptr)[i] == ' '
|
|
^strptr = i - 1
|
|
return
|
|
fin
|
|
next
|
|
end
|
|
def parsecmd(strptr)#1
|
|
byte cmd
|
|
|
|
cmd = 0
|
|
stripspaces(strptr)
|
|
if ^strptr
|
|
cmd = ^(strptr + 1)
|
|
memcpy(strptr + 1, strptr + 2, ^strptr)
|
|
^strptr--
|
|
fin
|
|
stripspaces(strptr)
|
|
return cmd
|
|
end
|
|
def execmod(modfile)#1
|
|
byte moddci[63]
|
|
word saveheap, savesym, saveflags
|
|
|
|
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
|
|
fin
|
|
return -perr
|
|
end
|
|
//
|
|
// Get heap start.
|
|
//
|
|
heap = *freemem
|
|
//
|
|
// Print PLASMA version
|
|
//
|
|
prstr(@verstr); prbyte(version.1); cout('.'); prbyte(version.0); crout
|
|
//
|
|
// Init symbol table.
|
|
//
|
|
symtbl = allocheap($200)
|
|
lastsym = symtbl
|
|
^lastsym = 0
|
|
while *syslibsym
|
|
stodci(syslibsym=>0, heap)
|
|
addsym(heap, syslibsym=>2)
|
|
syslibsym = syslibsym + 4
|
|
loop
|
|
//
|
|
// Try to load autorun.
|
|
//
|
|
cmdptr = heap
|
|
memset(cmdptr, 0, 128)
|
|
readfile(@autorun, cmdptr + 1)
|
|
while ^(cmdptr + ^cmdptr + 1) >= ' '
|
|
^cmdptr++
|
|
loop
|
|
perr = 0
|
|
//
|
|
// Print some startup info.
|
|
//
|
|
if not ^cmdptr
|
|
prstr(@freestr)
|
|
prword(availheap)
|
|
crout
|
|
fin
|
|
//
|
|
// Handle commands.
|
|
//
|
|
while 1
|
|
if ^cmdptr
|
|
when toupper(parsecmd(cmdptr))
|
|
is 'Q'
|
|
quit
|
|
break
|
|
is 'M'
|
|
syscall($02, 0)
|
|
break
|
|
is '+'
|
|
execmod(cmdptr)
|
|
break
|
|
otherwise
|
|
prstr(@huhstr)
|
|
wend
|
|
if perr
|
|
prstr(@errorstr)
|
|
prbyte(perr)
|
|
perr = 0
|
|
else
|
|
prstr(@okstr)
|
|
fin
|
|
crout()
|
|
fin
|
|
prstr(@prompt)
|
|
cmdptr = rdstr($BA)
|
|
loop
|
|
done
|