////////////////////////////////////////////////////////////////////////////////////////
// Copyright (C) 2015 The 8-Bit Bunch. Licensed under the Apache License, Version 1.1 
// (the "License"); you may not use this file except in compliance with the License.
// You may obtain a copy of the License at <http://www.apache.org/licenses/LICENSE-1.1>.
// Unless required by applicable law or agreed to in writing, software distributed under 
// the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF 
// ANY KIND, either express or implied. See the License for the specific language 
// governing permissions and limitations under the License.
////////////////////////////////////////////////////////////////////////////////////////

const MACHID      = $BF98
const iobuffer    = $0800
const databuff    = $2000
const MODADDR     = $1000
const symtbl      = $0C00
const freemem     = $0006
const getlnbuf    = $01FF
//
// System flags: memory allocator screen holes.
//
const restxt1     = $0001
const restxt2     = $0002
const resxtxt1    = $0004
const resxtxt2    = $0008
const reshgr1     = $0010
const reshgr2     = $0020
const resxhgr1    = $0040
const resxhgr2    = $0080
//
// Module don't free memory
//
const modkeep     = $2000
const modinitkeep = $4000
//
// Pedefined functions.
//
predef syscall, call
predef crout, cout, prstr, cin, rdstr
predef markheap, allocheap, allocalignheap, releaseheap, availheap
predef memset, memcpy
predef uword_isgt, uword_isge, uword_islt, uword_isle
predef loadmod, execmod, lookupstrmod
//
// System variable.
//
word version     = $0080 // 00.80
word systemflags = 0
word heap
word xheap       = $0800
word lastsym     = symtbl
byte perr
byte cmdln       = "" // Overlay exported strings table
//
// Standard Library exported functions.
//
byte syslibstr  = "CMDSYS"
byte machidstr  = "MACHID"
byte sysstr     = "SYSCALL"
byte callstr    = "CALL"
byte putcstr    = "PUTC"
byte putlnstr   = "PUTLN"
byte putsstr    = "PUTS"
byte getcstr    = "GETC"
byte getsstr    = "GETS"
byte hpmarkstr  = "HEAPMARK"
byte hpalignstr = "HEAPALLOCALIGN"
byte hpallocstr = "HEAPALLOC"
byte hprelstr   = "HEAPRELEASE"
byte memsetstr  = "MEMSET"
byte memcpystr  = "MEMCPY"
byte uisgtstr   = "ISUGT"
byte uisgestr   = "ISUGE"
byte uisltstr   = "ISULT"
byte uislestr   = "ISULE"
byte loadstr    = "MODLOAD"
byte execstr    = "MODEXEC"
byte modadrstr  = "MODADDR"
byte argstr     = "ARGS"
byte autorun    = "AUTORUN"
byte prefix[] // overlay with exported symbols table
word exports	  = @sysstr,    @syscall
word		  = @callstr,   @call
word		  = @putcstr,   @cout
word              = @putlnstr,  @crout
word		  = @putsstr,   @prstr
word		  = @getcstr,   @cin
word		  = @getsstr,   @rdstr
word		  = @hpmarkstr, @markheap
word		  = @hpallocstr,@allocheap
word		  = @hpalignstr,@allocalignheap
word		  = @hprelstr,  @releaseheap
word		  = @memsetstr, @memset
word		  = @memcpystr, @memcpy
word              = @uisgtstr,  @uword_isgt
word              = @uisgestr,  @uword_isge
word              = @uisltstr,  @uword_islt
word              = @uislestr,  @uword_isle
word              = @loadstr,   @loadmod
word              = @execstr,   @execmod
word              = @modadrstr, @lookupstrmod
word              = @machidstr, MACHID
word              = @argstr,    @cmdln
word              = 0
word syslibsym    = @exports
//
// String pool.
//
byte verstr     = "PLASMA "
byte freestr    = "MEM FREE:$"
byte errorstr   = "ERR:$"
byte okstr      = "OK"
byte huhstr     = "?\n"
//
// Utility functions
//
//asm equates included from cmdstub.s
//
// CALL PRODOS
// SYSCALL(CMD, PARAMS)
//
asm syscall
	LDA	ESTKL,X
	LDY	ESTKH,X
	STA	PARAMS
	STY	PARAMS+1
	INX
	LDA	ESTKL,X
	STA	CMD
	JSR	$BF00
CMD:	!BYTE	00
PARAMS:	!WORD	0000
	LDY    	#$00
	STA	ESTKL,X
	STY	ESTKH,X
	RTS
end
//
// CALL 6502 ROUTINE
// CALL(ADDR, AREG, XREG, YREG, STATUS)
//
asm call
REGVALS	=	SRC
        PHP
        LDA     ESTKL+4,X
        STA     TMPL
        LDA     ESTKH+4,X
        STA     TMPH
        LDA     ESTKL,X
        PHA
        LDA     ESTKL+1,X
        TAY
        LDA     ESTKL+3,X
        PHA
        LDA     ESTKL+2,X
        INX
        INX
        INX
	INX
        STX     ESP
        TAX
        PLA
        BIT     ROMEN
        PLP
        JSR     JMPTMP
        PHP
        BIT     LCRDEN+LCBNK2
        STA     REGVALS+0
        STX     REGVALS+1
        STY     REGVALS+2
        PLA
        STA     REGVALS+3
        LDX     ESP
        LDA     #<REGVALS
        LDY     #>REGVALS
        STA     ESTKL,X
        STY     ESTKH,X
        PLP
        RTS
JMPTMP	JMP	(TMP)
end
//
// CALL LOADED SYSTEM PROGRAM
//
asm exec
	LDX	#$00
	STX	IFPL
	LDA	#$BF
	STA	IFPH
	LDX	#$FE
	TXS
	LDX	#ESTKSZ/2
	BIT	ROMEN
	JMP	$2000
end
//
// EXIT
//
asm reboot
	BIT	ROMEN
	DEC	$03F4		; INVALIDATE POWER-UP BYTE
	JMP	($FFFC)		; RESET
end
//
// SET MEMORY TO VALUE
// MEMSET(ADDR, VALUE, SIZE)
//   With optimizations from Peter Ferrie
//
asm memset
	LDA     ESTKL+2,X
	STA     DSTL
	LDA     ESTKH+2,X
	STA     DSTH
	LDY     ESTKL,X
	BEQ	+
	INC     ESTKH,X
	LDY     #$00
+       LDA	ESTKH,X
        BEQ	SETMEX
SETMLPL	CLC
	LDA     ESTKL+1,X
SETMLPH	STA     (DST),Y
	DEC     ESTKL,X
	BNE     +
	DEC     ESTKH,X
	BEQ     SETMEX
+	INY
	BNE	+
	INC     DSTH
+	BCS	SETMLPL
	SEC
	LDA     ESTKH+1,X
	BCS	SETMLPH
SETMEX	INX
	INX
	RTS
end
//
// COPY MEMORY
// MEMCPY(DSTADDR, SRCADDR, SIZE)
//
asm memcpy
	INX
	INX
	LDA	ESTKL-2,X
	ORA	ESTKH-2,X
	BEQ	CPYMEX
	LDA	ESTKL-1,X
	CMP	ESTKL,X
	LDA	ESTKH-1,X
	SBC	ESTKH,X
 	BCC	REVCPY
;
; FORWARD COPY
;
	LDA	ESTKL,X
	STA 	DSTL
	LDA	ESTKH,X
	STA 	DSTH
	LDA	ESTKL-1,X
	STA 	SRCL
	LDA	ESTKH-1,X
	STA 	SRCH
	LDY	ESTKL-2,X
	BEQ	FORCPYLP
	INC 	ESTKH-2,X
	LDY	#$00
FORCPYLP LDA	(SRC),Y
	STA	(DST),Y
	INY
	BNE	+
	INC	DSTH
	INC	SRCH
+	DEC 	ESTKL-2,X
	BNE	FORCPYLP
	DEC	ESTKH-2,X
	BNE	FORCPYLP
	RTS
;
; REVERSE COPY
;
REVCPY	;CLC
	LDA 	ESTKL-2,X
	ADC	ESTKL,X
	STA	DSTL
	LDA	ESTKH-2,X
	ADC	ESTKH,X
	STA	DSTH
	CLC
	LDA 	ESTKL-2,X
	ADC	ESTKL-1,X
	STA	SRCL
	LDA	ESTKH-2,X
	ADC	ESTKH-1,X
	STA	SRCH
	DEC	DSTH
	DEC	SRCH
	LDY	#$FF
	LDA 	ESTKL-2,X
	BEQ	REVCPYLP
	INC 	ESTKH-2,X
REVCPYLP LDA	(SRC),Y
	STA	(DST),Y
	DEY
	CPY	#$FF
	BNE	+
	DEC	DSTH
	DEC	SRCH
+	DEC 	ESTKL-2,X
	BNE	REVCPYLP
	DEC	ESTKH-2,X
	BNE	REVCPYLP
CPYMEX	RTS
end
//
// COPY FROM MAIN MEM TO AUX MEM.
//
// MEMXCPY(DST, SRC, SIZE)
//
asm memxcpy
	LDA	ESTKL+1,X
	STA	$3C
	CLC
	ADC	ESTKL,X
	STA	$3E
	LDA	ESTKH+1,X
	STA	$3D
	ADC	ESTKH,X
	STA	$3F
	LDA	ESTKL+2,X
	STA	$42
	LDA	ESTKH+2,X
	STA	$43
	STX     ESP
	BIT	ROMEN
	SEC
	JSR	$C311
	BIT	LCRDEN+LCBNK2
	LDX     ESP
	INX
	INX
	RTS
end
asm crout
	DEX
	LDA	#$0D
	BNE	+
	; FALL THROUGH TO COUT
end
//
// CHAR OUT
// COUT(CHAR)
//
asm cout
	LDA	ESTKL,X
	BIT	$BF98
	BMI	+
	JSR	TOUPR
+	ORA 	#$80
	BIT	ROMEN
	JSR	$FDED
	BIT	LCRDEN+LCBNK2
	RTS
end
//
// CHAR IN
// RDKEY()
//
asm cin
	BIT	ROMEN
	JSR	$FD0C
	BIT	LCRDEN+LCBNK2
	DEX
	LDY	#$00
	AND	#$7F
	STA	ESTKL,X
	STY	ESTKH,X
	RTS
end
//
// PRINT STRING
// PRSTR(STR)
//
asm prstr
	LDY	#$00
	LDA     ESTKL,X
	STA     SRCL
	LDA     ESTKH,X
	STA     SRCH
	LDA     (SRC),Y
	STA     TMP
	BEQ     ++
	BIT	ROMEN
-	INY
	LDA	(SRC),Y
	BIT	$BF98
	BMI	+
	JSR	TOUPR
+	ORA	#$80
	JSR	$FDED
	CPY	TMP
	BNE	-
	BIT	LCRDEN+LCBNK2
++	RTS
end
//
// PRINT BYTE
//
asm prbyte
	LDA	ESTKL,X
	STX     ESP
	BIT	ROMEN
	JSR	$FDDA
	LDX     ESP
	BIT	LCRDEN+LCBNK2
	RTS
end
//
// PRINT WORD
//
asm prword
	STX	ESP
	TXA
	TAY
	LDA	ESTKH,Y
	LDX	ESTKL,Y
	BIT	ROMEN
	JSR	$F941
	LDX     ESP
	BIT	LCRDEN+LCBNK2
	RTS
end
//
// READ STRING
// STR = RDSTR(PROMPTCHAR)
//
asm rdstr
	LDA     ESTKL,X
	STA     $33
	STX     ESP
	BIT	ROMEN
	JSR     $FD6A
	STX     $01FF
-	LDA	$01FF,X
	AND	#$7F
	STA	$01FF,X
	DEX
	BPL	-
	TXA
	LDX     ESP
	STA     ESTKL,X
	LDA     #$01
	STA     ESTKH,X
	BIT	LCRDEN+LCBNK2
	RTS
end
asm uword_isge
	LDY	#$00
	LDA	ESTKL+1,X
	CMP	ESTKL,X
	LDA	ESTKH+1,X
	SBC	ESTKH,X
 	BCC	+
	DEY
+ 	STY	ESTKL+1,X
	STY	ESTKH+1,X
	INX
	RTS
end
asm uword_isle
	LDY	#$00
	LDA	ESTKL,X
	CMP	ESTKL+1,X
	LDA	ESTKH,X
	SBC	ESTKH+1,X
	BCC	+
	DEY
+ 	STY	ESTKL+1,X
	STY	ESTKH+1,X
	INX
	RTS
end
asm uword_isgt
	LDA	ESTKL,X
	CMP	ESTKL+1,X
	LDA	ESTKH,X
	SBC	ESTKH+1,X
	LDA	#$FF
	ADC	#$00
 	STA	ESTKL+1,X
	STA	ESTKH+1,X
	INX
	RTS
end
asm uword_islt
	LDA	ESTKL+1,X
	CMP	ESTKL,X
	LDA	ESTKH+1,X
	SBC	ESTKH,X
	LDA	#$FF
	ADC	#$00
 	STA	ESTKL+1,X
	STA	ESTKH+1,X
	INX
	RTS
end
//
// Utility routines.
//
// A DCI string is one that has the high bit set for every character except the last.
// More efficient than C or Pascal strings.
//
//def dcitos(dci, str)
//    byte len, c
//    len = 0
//    repeat
//        c = (dci).[len]
//        len = len + 1
//        (str).[len] = c & $7F
//    until !(c & $80)
//    ^str = len
//    return len
//end
asm dcitos
	LDA	ESTKL,X
	STA	DSTL
	LDA	ESTKH,X
	STA	DSTH
	LDA	ESTKL+1,X
	STA	SRCL
	LDA	ESTKH+1,X
	STA	SRCH
	LDY	#$00
-	LDA	(SRC),Y
	CMP	#$80
	AND	#$7F
	INY
	STA	(DST),Y
	BCS	-
	TYA
	LDY	#$00
	STA	(DST),Y
	INX
	STA	ESTKL,X
	STY	ESTKH,X
	RTS
end
//def stodci(str, dci)
//    byte len, c
//    len = ^str
//    if len == 0
//        return
//    fin
//    c = toupper((str).[len]) & $7F
//    len = len - 1
//    (dci).[len] = c
//    while len
//    	c = toupper((str).[len]) | $80
//    	len = len - 1
//    	(dci).[len] = c
//    loop
//    return ^str
//end
asm stodci
	LDA	ESTKL,X
	STA	DSTL
	LDA	ESTKH,X
	STA	DSTH
	LDA	ESTKL+1,X
	STA	SRCL
	LDA	ESTKH+1,X
	STA	SRCH
	INX
	LDY	#$00
	LDA	(SRC),Y
	BEQ	++
	TAY
	LDA	(SRC),Y
	JSR	TOUPR
	BNE	+
-	LDA	(SRC),Y
	JSR	TOUPR
	ORA	#$80
+	DEY
	STA	(DST),Y
	BNE	-
	LDA	(SRC),Y
++	STA	ESTKL,X
	STY	ESTKH,X
	RTS
end
asm toupper
	LDA     ESTKL,X
TOUPR	AND	#$7F
	CMP     #'a'
	BCC     +
	CMP     #'z'+1
	BCS     +
	SBC     #$1F
+	STA     ESTKL,X
	RTS
end
//
// Module symbols are entered into the symbol table
// pre-pended with a '#' to differentiate them
// from normal symbols.
//
//def modtosym(mod, dci)
//    byte len, c
//    (dci).0 = '#'|$80
//    len = 0
//    repeat
//        c = (mod).[len]
//        len = len + 1
//        (dci).[len] = c
//    until !(c & $80)
//    return dci
//end
asm modtosym
	LDA	ESTKL+1,X
	STA	SRCL
	LDA	ESTKH+1,X
	STA	SRCH
	LDA	ESTKL,X
	STA	ESTKL+1,X
	STA	DSTL
	LDA	ESTKH,X
	STA	ESTKH+1,X
	STA	DSTH
	INX
	LDY	#$00
	LDA	#'#'+$80
-	STA	(DST),Y
	CMP	#$80
	LDA	(SRC),Y
	INY
	BCS	-
	RTS
end
//
// Lookup routines.
//
//def lookuptbl(dci, tbl)
//    word match
//    while ^tbl
//        match = dci
//        while ^tbl == ^match
//            if !(^tbl & $80)
//                return (tbl):1
//            fin
//            tbl   = tbl   + 1
//            match = match + 1
//        loop
//        while (^tbl & $80)
//            tbl = tbl + 1
//        loop
//        tbl = tbl + 3
//    loop
//    return 0
asm lookuptbl
	LDA	ESTKL,X
	STA	DSTL
	LDA	ESTKH,X
	STA	DSTH
	LDA	ESTKL+1,X
	STA	SRCL
	LDA	ESTKH+1,X
	STA	SRCH
	LDY	#$00
-	LDA	(DST),Y
	BEQ	+
	CMP	(SRC),Y
	BNE	++
	INY
	CMP	#$80
	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
	BNE	++
	INC	DSTH
++	CMP	#$80
	BCS	--
	LDA	#$02
	ADC	DSTL
	STA	DSTL
	BCC	-
	INC	DSTH
	BCS	-
end
//
// ProDOS routines
//
def getpfx(path)
    byte params[3]

    ^path    = 0
    params.0 = 1
    params:1 = path
    perr     = syscall($C7, @params)
    return path
end
def setpfx(path)
    byte params[3]

    params.0 = 1
    params:1 = path
    perr     = syscall($C6, @params)
    return path
end
def open(path, buff)
    byte params[6]

    params.0 = 3
    params:1 = path
    params:3 = buff
    params.5 = 0
    perr     = syscall($C8, @params)
    return params.5
end
def close(refnum)
    byte params[2]

    params.0 = 1
    params.1 = refnum
    perr     = syscall($CC, @params)
    return perr
end
def read(refnum, buff, len)
    byte params[8]

    params.0 = 4
    params.1 = refnum
    params:2 = buff
    params:4 = len
    params:6 = 0
    perr     = syscall($CA, @params)
    return params:6
end
//
// Heap routines.
//
def availheap
    byte fp
    return @fp - heap
end
def allocheap(size)
    word addr
    addr = heap
    heap = heap + size
    if systemflags & reshgr1
        if uword_isle(addr, $4000) and uword_isgt(heap, $2000)
	    addr = $4000
	    heap = addr + size
	fin
    fin
    if systemflags & reshgr2
        if uword_isle(addr, $6000) and uword_isgt(heap, $4000)
	    addr = $6000
	    heap = addr + size
	fin
    fin
    if uword_isge(heap, @addr)
        return 0
    fin
    return addr
end
def allocalignheap(size, pow2, freeaddr)
    word align, addr
    if freeaddr
        *freeaddr = heap
    fin
    align = (1 << pow2) - 1
    addr = (heap | align) + 1
    heap = addr + size
    if uword_isge(heap, @addr)
        return 0
    fin
    return addr
end
def markheap
    return heap
end
def releaseheap(newheap)
    heap = newheap
    return @newheap - heap
end
def allocxheap(size)
    word xaddr
    xaddr = xheap
    xheap = xheap + size
    if systemflags & restxt1
        if uword_isle(xaddr, $0800) and uword_isgt(xheap, $0400)
	    xaddr = $0800
	    xheap = xaddr + size
	fin
    fin
    if systemflags & restxt2
        if uword_isle(xaddr, $0C00) and uword_isgt(xheap, $0800)
	    xaddr = $0C00
	    xheap = xaddr + size
	fin
    fin
    if systemflags & resxhgr1
        if uword_isle(xaddr, $4000) and uword_isgt(xheap, $2000)
	    xaddr = $4000
	    xheap = xaddr + size
	fin
    fin
    if systemflags & resxhgr2
        if uword_isle(xaddr, $6000) and uword_isgt(xheap, $4000)
	    xaddr = $6000
	    xheap = xaddr + size
	fin
    fin
    if uword_isge(xheap, $BF00)
        return 0
    fin
    return xaddr
end
//
// Symbol table routines.
//
def lookupsym(sym)
    return lookuptbl(sym, symtbl)
end
def addsym(sym, addr)
    while ^sym & $80
        ^lastsym = ^sym
        lastsym  = lastsym + 1
        sym      = sym     + 1
    loop
    lastsym->0 = ^sym
    lastsym=>1 = addr
    lastsym     = lastsym + 3
    ^lastsym    = 0
end
//
// Module routines.
//
def lookupmod(mod)
    byte dci[17]
    return lookuptbl(modtosym(mod, @dci), symtbl)
end
def lookupstrmod(str)
    byte mod[17]
    stodci(str, @mod)
    return lookupmod(@mod)
end
def addmod(mod, addr)
    byte dci[17]
    return addsym(modtosym(mod, @dci), addr)
end
def lookupextern(esd, index)
    word sym, addr
    byte str[16]
    while ^esd
        sym = esd
        esd = esd + dcitos(esd, @str)
        if esd->0 & $10 and esd->1 == index
            addr = lookupsym(sym)
	    if !addr
                perr = $81
	        cout('?')
		prstr(@str)
		crout
	    fin
            return addr
        fin
        esd = esd + 3
    loop
    return 0
end
def adddef(bank, addr, deflast)
    word defentry
    defentry = *deflast
    *deflast = defentry + 5
    if bank
        defentry=>1 = $03DC // JSR $03DC (AUX MEM INTERP)
    else
        defentry=>1 = $03D6 // JSR $03D6 (MAIN MEM INTERP)
    fin
    defentry->0 = $20
    defentry=>3 = addr
    defentry->5 = 0 // NULL out next entry
    return defentry
end
def lookupdef(addr, deftbl)
    while deftbl->0 == $20
        if deftbl=>3 == addr
            return deftbl
        fin
        deftbl = deftbl + 5
    loop
    return 0
end
def loadmod(mod)
    word refnum, rdlen, modsize, bytecode, defofst, defcnt, init, fixup
    word addr, defaddr, modaddr, modfix, modend
    word deftbl, deflast
    word moddep, rld, esd, sym
    byte defbank, str[16], filename[64]
    byte header[128]
    //
    // Read the RELocatable module header (first 128 bytes)
    //
    dcitos(mod, @filename)
    refnum = open(@filename, iobuffer)
    if refnum > 0
        rdlen   = read(refnum, @header, 128)
	modsize = header:0
	moddep  = @header.1
	defofst = modsize
        init    = 0
        if rdlen > 4 and header:2 == $DA7E // DAVE = magic number :-)
            //
            // This is an EXTended RELocatable (data+bytecode) module.
            //
	    systemflags = header:4 | systemflags
            defofst  = header:6
            defcnt   = header:8
            init     = header:10
            moddep   = @header.12
	    //
	    // Load module dependencies.
	    //
            while ^moddep
                if !lookupmod(moddep)
		    close(refnum)
		    refnum = 0
                    if loadmod(moddep) < 0
		        return -perr
		    fin
                fin
                moddep = moddep + dcitos(moddep, @str)
            loop
	    //
	    // Init def table.
	    //
	    deftbl   = allocheap(defcnt * 5 + 1)
	    deflast  = deftbl
	    ^deflast = 0
	    if !refnum
	        //
		// Reset read pointer.
		//
		refnum = open(@filename, iobuffer)
		rdlen  = read(refnum, @header, 128)
	    fin
        fin
	//
	// Alloc heap space for relocated module (data + bytecode).
	//
	moddep  = moddep  + 1
	modfix  = moddep  - @header.2 // Adjust to skip header
	modsize = modsize - modfix
	rdlen   = rdlen   - modfix - 2
	modaddr = allocheap(modsize)
	memcpy(modaddr, moddep, rdlen)
	//
	// Read in remainder of module into memory for fixups.
	//
	addr = modaddr//
        repeat
            addr  = addr + rdlen
            rdlen = read(refnum, addr, 4096)
        until rdlen <= 0
        close(refnum)
	//
	// Add module to symbol table.
	//
	addmod(mod, modaddr)
	//
	// Apply all fixups and symbol import/export.
	//
        modfix   = modaddr - modfix
        bytecode = defofst + modfix - MODADDR
        modend   = modaddr + modsize
        rld      = modend  // Re-Locatable Directory
        esd      = rld     // Extern+Entry Symbol Directory
        while ^esd        // Scan to end of ESD
            esd = esd + 4
	loop
        esd = esd + 1
	//
	// Locate bytecode defs in appropriate bank.
	//
	if ^MACHID & $30 == $30
	    defbank = 1
	    defaddr = allocxheap(rld - bytecode)
	    modend  = bytecode
	else
	    defbank = 0
	    defaddr = bytecode
	fin
        //
        // Run through the Re-Location Dictionary.
        //
        while ^rld
            if ^rld == $02
	    	//
		// This is a bytcode def entry - add it to the def directory.
		//
		adddef(defbank, rld=>1 - defofst + defaddr, @deflast)
            else
                addr = rld=>1 + modfix
                if uword_isge(addr, modaddr) // Skip fixups to header
                    if ^rld & $80 // WORD sized fixup.
                        fixup = *addr
                    else	      // BYTE sized fixup.
                        fixup = ^addr
                    fin
                    if ^rld & $10 // EXTERN reference.
                        fixup = fixup + lookupextern(esd, rld->3)
                    else	  // INTERN fixup.
                        fixup = fixup + modfix - MODADDR
                        if uword_isge(fixup, bytecode)
                            //
                            // Bytecode address - replace with call def directory.
                            //
                            fixup = lookupdef(fixup - bytecode + defaddr, deftbl)
                        fin
                    fin
                    if ^rld & $80 // WORD sized fixup.
                        *addr = fixup
                    else	      // BYTE sized fixup.
                        ^addr = fixup
                    fin
                fin
            fin
            rld = rld + 4
        loop
	//
        // Run through the External/Entry Symbol Directory.
	//
        while ^esd
            sym = esd
            esd = esd + dcitos(esd, @str)
            if ^esd & $08
	    	//
                // EXPORT symbol - add it to the global symbol table.
		//
                addr = esd=>1 + modfix - MODADDR
                if uword_isge(addr, bytecode)
		    //
		    // Use the def directory address for bytecode.
		    //
                    addr = lookupdef(addr - bytecode + defaddr, deftbl)
                fin
                addsym(sym, addr)
            fin
            esd = esd + 3
        loop
	if defbank
	    //
	    // Move bytecode to AUX bank.
	    //
	    memxcpy(defaddr, bytecode, modsize - (bytecode - modaddr))
       	fin
    fin
    if perr
        return -perr
    fin
    //
    // Call init routine if it exists.
    //
    fixup = 0 // This is repurposed for the return code
    if init
        fixup = adddef(defbank, init - defofst + defaddr, @deflast)()
	if fixup < modinitkeep
	    //
	    // Free init routine unless initkeep
	    //
	    if defbank
	        xheap  = init - defofst + defaddr
	    else
	        modend = init - defofst + defaddr
	    fin
        if fixup < 0
            perr = -fixup
        fin
	else
	    fixup = fixup & ~modinitkeep
	fin
    fin
    //
    // Free up the end-of-module in main memory.
    //
    releaseheap(modend)
    return fixup
end
//
// Command mode
//
def volumes
    byte params[4]
    word strbuf
    byte i

    params.0 = 2
    params.1 = 0
    params:2 = databuff
    perr     = syscall($C5, @params)
    strbuf   = databuff
    for i = 0 to 15
        ^strbuf = ^strbuf & $0F
	if ^strbuf
	    cout('/')
	    prstr(strbuf)
	    crout()
	fin
	strbuf = strbuf + 16
    next
end
def catalog(optpath)
    byte path[64]
    byte refnum
    byte firstblk
    byte entrylen, entriesblk
    byte i, type, len
    word entry, filecnt

    if ^optpath
        memcpy(@path, optpath, ^optpath + 1)
    else
        getpfx(@path)
        prstr(@path)
        crout()
    fin
    refnum = open(@path, iobuffer)
    if perr
        return perr
    fin
    firstblk = 1
    repeat
        if read(refnum, databuff, 512) == 512
            entry = databuff + 4
            if firstblk
                entrylen   = databuff.$23
                entriesblk = databuff.$24
                filecnt    = databuff:$25
                entry      = entry + entrylen
            fin
            for i = firstblk to entriesblk
                type = ^entry
                if type
                    len = type & $0F
                    ^entry = len
                    prstr(entry)
                    if type & $F0 == $D0 // Is it a directory?
                        cout('/')
                        len = len + 1
		    elsif entry->$10 == $FF
		        cout('-')
			len = len + 1
		    elsif entry->$10 == $FE
		        cout('+')
			len = len + 1
                    fin
                    for len = 19 - len downto 0
                        cout(' ')
                    next
                    filecnt = filecnt - 1
                fin
                entry = entry + entrylen
            next
            firstblk = 0
        else
            filecnt = 0
        fin
    until !filecnt
    close(refnum)
    crout()
    return 0
end
def stripchars(strptr)
    while ^strptr and ^(strptr + 1) > ' '
        memcpy(strptr + 1, strptr + 2, ^strptr)
        ^strptr = ^strptr - 1
    loop
    return ^strptr
end
def stripspaces(strptr)
    while ^strptr and ^(strptr + ^strptr) <= ' '
        ^strptr = ^strptr - 1
    loop
    while ^strptr and ^(strptr + 1) <= ' '
        memcpy(strptr + 1, strptr + 2, ^strptr)
        ^strptr = ^strptr - 1
    loop
end
def striptrail(strptr)
    byte i

    for i = 1 to ^strptr
        if ^(strptr + i) <= ' '
	    ^strptr = i - 1
	    return
	fin
    next
end
def parsecmd(strptr)
    byte cmd

    cmd = 0
    stripspaces(strptr)
    if ^strptr
        cmd = ^(strptr + 1)
        memcpy(strptr + 1, strptr + 2, ^strptr)
        ^strptr = ^strptr - 1
    fin
    stripspaces(strptr)
    return cmd
end
def resetmemfiles
    //
    // Close all files
    //
    ^$BFD8 = 0
    close(0)
    //
    // Set memory bitmap
    //
    memset($BF58, 0, 24)
    ^$BF58 = $CF
    ^$BF6F = $01
end
def execsys(sysfile)
    byte refnum
    word len

    if ^sysfile
        memcpy($280, sysfile, ^sysfile + 1)
	striptrail(sysfile)
	refnum = open(sysfile, iobuffer)
	if refnum
	    len = read(refnum, databuff, $FFFF)
	    resetmemfiles()
	    if len
	        memcpy(sysfile, $280, ^$280 + 1)
		if stripchars(sysfile) and ^$2000 == $4C and *$2003 == $EEEE
		    stripspaces(sysfile)
		    if ^$2005 >= ^sysfile + 1
		        memcpy($2006, sysfile, ^sysfile + 1)
		    fin
		fin
	        striptrail($280)
		exec()
	    fin
	fin
    fin
end
def execmod(modfile)
    byte moddci[17]
    word saveheap, savexheap, savesym, saveflags

    perr = 1
    if stodci(modfile, @moddci)
        saveheap  = heap
	savexheap = xheap
	savesym   = lastsym
	saveflags = systemflags
	if loadmod(@moddci) < modkeep
	    lastsym = savesym
	    xheap   = savexheap
	    heap    = saveheap
	fin
	^lastsym    = 0
	systemflags = saveflags
    fin
    return -perr
end
//
// Get heap start.
//
heap = *freemem
//
// Init symbol table.
//
stodci(@syslibstr, heap)
addmod(heap, @version)
while *syslibsym
    stodci(syslibsym=>0, heap)
    addsym(heap, syslibsym=>2)
    syslibsym = syslibsym + 4
loop
//
// Try to load autorun.
//
autorun = open(@autorun, iobuffer)
if autorun > 0
    cmdln = read(autorun, @syslibstr, 128)
    close(autorun)
else
    //
    // Print some startup info.
    //
    prstr(@verstr)
    prbyte(version.1)
    cout('.')
    prbyte(version.0)
    crout
    prstr(@freestr)
    prword(availheap)
    crout
fin
perr = 0
while 1
    if cmdln
        when toupper(parsecmd(@cmdln))
            is 'Q'
	        reboot()
		break
	    is 'C'
	        catalog(@cmdln)
		break
	    is 'P'
	        setpfx(@cmdln)
		break
	    is 'V'
	        volumes()
		break
	    is '-'
	        execsys(@cmdln)
		break
	    is '+'
	        execmod(@cmdln)
		break
	    otherwise
	        prstr(@huhstr)
        wend
        if perr
            prstr(@errorstr)
	    prbyte(perr)
	    perr = 0
        else
            prstr(@okstr)
        fin
	crout()
    fin
    prstr(getpfx(@prefix))
    memcpy(@cmdln, rdstr($BA), 128)
loop
done
