const membank     = $FFEF
const RELADDR     = $1000
//
// System flags: memory allocator screen holes.
//
const restxt1     = $0001
const restxt2     = $0002
const resxtxt1    = $0004
const resxtxt2    = $0008
const reshgr1     = $0010
const reshgr2     = $0020
const resxhgr1    = $0040
const resxhgr2    = $0080
//
// Module don't free memory
//
const modkeep     = $2000
const modinitkeep = $4000
//
// Private addresses
//
const instr       = $A020
const cmdparser   = $A0F0
const xinterp     = $A0F8
//
// Indirect interpreter DEFinition entrypoint
//
struc t_defentry
    byte interpjsr
    word interpaddr
    word bytecodeaddr
    byte bytecodexbyte
end
//
// Pedefined functions.
//
predef syscall(cmd,params)#1, call(addr,areg,xreg,yreg,status)#1
predef crout()#0, cout(c)#0, prstr(s)#0, print(i)#0, prbyte(b)#0, prword(w)#0
predef cin()#1, rdstr(p)#1, toupper(c)#1, strcpy(dst,src)#1, strcat(dst,src)#1
predef markheap()#1, allocheap(size)#1, allocalignheap(size, pow2, freeaddr), releaseheap(newheap)#1, availheap()#1
predef memset(addr,value,size)#0, memcpy(dst,src,size)#0
predef uword_isgt(a,b)#1, uword_isge(a,b)#1, uword_islt(a,b)#1, uword_isle(a,b)#1, sext(a)#1, divmod(a,b)#2
predef execmod(modfile)#1, open(path)#1, close(refnum)#1, read(refnum, buff, len)#1, write(refnum, buff, len)#1
//
// Exported CMDSYS table
//
word version      = $0200 // 02.00
word syspath
word cmdlnptr
word              = @execmod, @open, @close, @read, @write
byte perr
byte jitcount     = 0 // Keep these here for compatibility
byte jitsize      = 0
byte refcons      = 0
byte devcons      = 0
//
// String pool.
//
byte hexchar[]    = '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'
//
// Exported Machine ID.
//
byte machid       = $F2 // Apple ///, 80 columns
//
// Console and textmode control characters
//
byte console[]    = ".CONSOLE"
byte textmode[]   = 16, 0, 15

//
// Working input buffer overlayed with strings table
//
byte cmdln        = ""
//
// SOS.CMD as DCI string
//
byte soscmd       = 'S'|$80,'O'|$80,'S'|$80,'.'|$80,'C'|$80,'M'|$80,'D'
//
// Standard Library exported functions.
//
byte sysmodstr[]  = "CMDSYS"
byte machidstr[]  = "MACHID"
byte sysstr[]     = "SYSCALL"
byte callstr[]    = "CALL"
byte putcstr[]    = "PUTC"
byte putlnstr[]   = "PUTLN"
byte putsstr[]    = "PUTS"
byte putistr[]    = "PUTI"
byte putbstr[]    = "PUTB"
byte putwstr[]    = "PUTH"
byte getcstr[]    = "GETC"
byte getsstr[]    = "GETS"
byte toupstr[]    = "TOUPPER"
byte strcpystr[]  = "STRCPY"
byte strcatstr[]  = "STRCAT"
byte hpmarkstr[]  = "HEAPMARK"
byte hpalignstr[] = "HEAPALLOCALIGN"
byte hpallocstr[] = "HEAPALLOC"
byte hprelstr[]   = "HEAPRELEASE"
byte hpavlstr[]   = "HEAPAVAIL"
byte memsetstr[]  = "MEMSET"
byte memcpystr[]  = "MEMCPY"
byte uisgtstr[]   = "ISUGT"
byte uisgestr[]   = "ISUGE"
byte uisltstr[]   = "ISULT"
byte uislestr[]   = "ISULE"
byte sextstr[]    = "SEXT"
byte divmodstr[]  = "DIVMOD"
byte sysmods[]    = "" // overlay sys path with exports
word exports[]    = @sysmodstr, @version
word              = @sysstr,    @syscall
word              = @callstr,   @call
word              = @putcstr,   @cout
word              = @putlnstr,  @crout
word              = @putsstr,   @prstr
word              = @putistr,   @print
word              = @putbstr,   @prbyte
word              = @putwstr,   @prword
word              = @getcstr,   @cin
word              = @getsstr,   @rdstr
word              = @toupstr,   @toupper
word              = @hpmarkstr, @markheap
word              = @hpallocstr,@allocheap
word              = @hpalignstr,@allocalignheap
word              = @hprelstr,  @releaseheap
word              = @hpavlstr,  @availheap
word              = @memsetstr, @memset
word              = @memcpystr, @memcpy
word              = @strcpystr, @strcpy
word              = @strcatstr, @strcat
word              = @uisgtstr,  @uword_isgt
word              = @uisgestr,  @uword_isge
word              = @uisltstr,  @uword_islt
word              = @uislestr,  @uword_isle
word              = @sextstr,   @sext
word              = @divmodstr, @divmod
word              = @machidstr, @machid
word              = 0
word sysmodsym    = @exports
//
// System variables.
//
word systemflags = 0
word heap        = $2000
byte autorun[]
byte modseg[15]
byte modid        = 0
word symtbl, lastsym
//
// CALL SOS
// SYSCALL(CMD, PARAMS)
//
asm syscall(cmd,params)#1
        LDA     ESTKL,X
        LDY     ESTKH,X
        STA     PARAMS
        STY     PARAMS+1
        INX
        LDA     ESTKL,X
        STA     CMD
        BRK
CMD     !BYTE   00
PARAMS  !WORD   0000
        LDY     #$00
        STA     ESTKL,X
        STY     ESTKH,X
        RTS
end
//
// CALL 6502 ROUTINE
// CALL(AREG, XREG, YREG, STATUS, ADDR)
//
asm call(addr,areg,xreg,yreg,sstatus)#1
REGVALS =       SRC
        PHP
        LDA     ESTKL,X
        STA     TMPL
        LDA     ESTKH,X
        STA     TMPH
        INX
        LDA     ESTKL,X
        PHA
        INX
        LDY     ESTKL,X
        INX
        LDA     ESTKL+1,X
        PHA
        LDA     ESTKL,X
        INX
        STX     ESP
        TAX
        PLA
        PLP
        JSR     JMPTMP
        PHP
        STA     REGVALS+0
        STX     REGVALS+1
        STY     REGVALS+2
        PLA
        STA     REGVALS+3
        LDX     ESP
        LDA     #<REGVALS
        LDY     #>REGVALS
        STA     ESTKL,X
        STY     ESTKH,X
        PLP
        RTS
end
//
// SET MEMORY TO VALUE
// MEMSET(ADDR, VALUE, SIZE)
//   With optimizations from Peter Ferrie
//
asm memset(addr,value,size)#0
        LDA     ESTKL+2,X
        STA     DSTL
        LDA     ESTKH+2,X
        STA     DSTH
        LDY     ESTKL,X
        BEQ     +
        INC     ESTKH,X
        LDY     #$00
+       LDA     ESTKH,X
        BEQ     SETMEX
SETMLPL CLC
        LDA     ESTKL+1,X
SETMLPH STA     (DST),Y
        DEC     ESTKL,X
        BEQ     ++
-       INY
        BEQ     +
--      BCS     SETMLPL
        SEC
        LDA     ESTKH+1,X
        BCS     SETMLPH
+       INC     DSTH
        BNE     --
++      DEC     ESTKH,X
        BNE     -
SETMEX  INX
        INX
        INX
        RTS
end
//
// COPY MEMORY
// MEMCPY(DSTADDR, SRCADDR, SIZE)
//
asm memcpy(dst,src,size)#0
        INX
        INX
        INX
        LDA     ESTKL-3,X
        ORA     ESTKH-3,X
        BEQ     CPYMEX
        LDA     ESTKL-2,X
        CMP     ESTKL-1,X
        LDA     ESTKH-2,X
        SBC     ESTKH-1,X
        BCC     REVCPY
;
; FORWARD COPY
;
        LDA     ESTKL-1,X
        STA     DSTL
        LDA     ESTKH-1,X
        STA     DSTH
        LDA     ESTKL-2,X
        STA     SRCL
        LDA     ESTKH-2,X
        STA     SRCH
        LDY     ESTKL-3,X
        BEQ     FORCPYLP
        INC     ESTKH-3,X
        LDY     #$00
FORCPYLP LDA    (SRC),Y
        STA     (DST),Y
        INY
        BNE     +
        INC     DSTH
        INC     SRCH
+       DEC     ESTKL-3,X
        BNE     FORCPYLP
        DEC     ESTKH-3,X
        BNE     FORCPYLP
        RTS
;
; REVERSE COPY
;
REVCPY  ;CLC
        LDA     ESTKL-3,X
        ADC     ESTKL-1,X
        STA     DSTL
        LDA     ESTKH-3,X
        ADC     ESTKH-1,X
        STA     DSTH
        CLC
        LDA     ESTKL-3,X
        ADC     ESTKL-2,X
        STA     SRCL
        LDA     ESTKH-3,X
        ADC     ESTKH-2,X
        STA     SRCH
        DEC     DSTH
        DEC     SRCH
        LDY     #$FF
        LDA     ESTKL-3,X
        BEQ     REVCPYLP
        INC     ESTKH-3,X
REVCPYLP LDA    (SRC),Y
        STA     (DST),Y
        DEY
        CPY     #$FF
        BNE     +
        DEC     DSTH
        DEC     SRCH
+       DEC     ESTKL-3,X
        BNE     REVCPYLP
        DEC     ESTKH-3,X
        BNE     REVCPYLP
CPYMEX  RTS
end
//
// COPY FROM MAIN MEM TO EXT MEM.
//
// MEMXCPY(DSTSEG, SRC, SIZE)
//
asm memxcpy(dst,src,size)#0
        LDA     ESTKL,X
        ORA     ESTKH,X
        BEQ     CPYXMEX
        LDY     #$00
        STY     DSTL
        LDA     ESTKH+2,X
        CLC
        ADC     #$60
        STA     DSTH
        LDA     ESTKL+2,X
        CLC
        ADC     #$7F
        STA     DSTX
        LDA     ESTKL+1,X
        STA     SRCL
        LDA     ESTKH+1,X
        STA     SRCH
        INC     ESTKH,X
CPYXLP  LDA     (SRC),Y
        STA     (DST),Y
        INY
        BNE     +
        INC     DSTH
        INC     SRCH
+       DEC     ESTKL,X
        BNE     CPYXLP
        DEC     ESTKH,X
        BNE     CPYXLP
        LDA     #$00
        STA     DSTX
CPYXMEX INX
        INX
        INX
        RTS
end
//
// POKE BYTE VAL INTO EXT MEM.
//
// XPOKEB(SEG, DST, BYTEVAL)
//
asm xpokeb(seg, dst, byteval)#0
        LDA     ESTKL+1,X
        STA     DSTL
        LDA     ESTKH+1,X
        CLC
        ADC     #$60
        STA     DSTH
        LDA     ESTKL+2,X
        CLC
        ADC     #$7F
        STA     DSTX
        LDY     #$00
        LDA     ESTKL,X
        STA     (DST),Y
        STY     DSTX
        INX
        INX
        INX
        RTS
end
//
// Unsigned word comparisons.
//
asm uword_isge(a,b)#1
        LDA     ESTKL+1,X
        CMP     ESTKL,X
        LDA     ESTKH+1,X
        SBC     ESTKH,X
        LDA     #$FF
        ADC     #$00
        EOR     #$FF
        STA     ESTKL+1,X
        STA     ESTKH+1,X
        INX
        RTS
end
asm uword_isle(a,b)#1
        LDA     ESTKL,X
        CMP     ESTKL+1,X
        LDA     ESTKH,X
        SBC     ESTKH+1,X
        LDA     #$FF
        ADC     #$00
        EOR     #$FF
        STA     ESTKL+1,X
        STA     ESTKH+1,X
        INX
        RTS
end
asm uword_isgt(a,b)#1
        LDA     ESTKL,X
        CMP     ESTKL+1,X
        LDA     ESTKH,X
        SBC     ESTKH+1,X
        LDA     #$FF
        ADC     #$00
        STA     ESTKL+1,X
        STA     ESTKH+1,X
        INX
        RTS
end
asm uword_islt(a,b)#1
        LDA     ESTKL+1,X
        CMP     ESTKL,X
        LDA     ESTKH+1,X
        SBC     ESTKH,X
        LDA     #$FF
        ADC     #$00
        STA     ESTKL+1,X
        STA     ESTKH+1,X
        INX
        RTS
end
asm divmod(a,b)#2
        JSR     INTERP          ; CALL INTERP
        !BYTE   $36, $5C        ; DIVMOD, RET
end
asm sext(a)#1
        LDY     #$00
        LDA     ESTKL,X
        BPL     +
        DEY
+       STY     ESTKH,X
        RTS
end
//
// A DCI string is one that has the high bit set for every character except the last.
// More efficient than C or Pascal strings.
//
//def dcitos(dci, str)
//    byte len, c
//    len = 0
//    repeat
//        c = (dci).[len]
//        len = len + 1
//        (str).[len] = c & $7F
//    until !(c & $80)
//    ^str = len
//    return len
//end
asm dcitos(dci, str)#1
        LDA     ESTKL,X
        STA     DSTL
        LDA     ESTKH,X
        STA     DSTH
        LDA     ESTKL+1,X
        STA     SRCL
        LDA     ESTKH+1,X
        STA     SRCH
        LDY     #$00
-       LDA     (SRC),Y
        CMP     #$80
        AND     #$7F
        INY
        STA     (DST),Y
        BCS     -
        TYA
        LDY     #$00
        STA     (DST),Y
        INX
        STA     ESTKL,X
        STY     ESTKH,X
        RTS
end
//def stodci(str, dci)
//    byte len, c
//    len = ^str
//    if len == 0
//        return
//    fin
//    c = toupper((str).[len]) & $7F
//    len = len - 1
//    (dci).[len] = c
//    while len
//      c = toupper((str).[len]) | $80
//      len = len - 1
//      (dci).[len] = c
//    loop
//    return ^str
//end
asm stodci(str, dci)#1
        LDA     ESTKL,X
        STA     DSTL
        LDA     ESTKH,X
        STA     DSTH
        LDA     ESTKL+1,X
        STA     SRCL
        LDA     ESTKH+1,X
        STA     SRCH
        INX
        LDY     #$00
        LDA     (SRC),Y
        BEQ     ++
        TAY
        LDA     (SRC),Y
        JSR     TOUPR
        BNE     +
-       LDA     (SRC),Y
        JSR     TOUPR
        ORA     #$80
+       DEY
        STA     (DST),Y
        BNE     -
        LDA     (SRC),Y
++      STA     ESTKL,X
        STY     ESTKH,X
        RTS
end
asm toupper(c)#1
        LDA     ESTKL,X
TOUPR   AND     #$7F
        CMP     #'a'
        BCC     +
        CMP     #'z'+1
        BCS     +
        SBC     #$1F
+       STA     ESTKL,X
        RTS
end
//
// Lookup routines.
//
//def lookuptbl(dci, tbl)
//    word match
//    while ^tbl
//        match = dci
//        while ^tbl == ^match
//            if !(^tbl & $80)
//                return (tbl):1
//            fin
//            tbl   = tbl   + 1
//            match = match + 1
//        loop
//        while (^tbl & $80)
//            tbl = tbl + 1
//        loop
//        tbl = tbl + 3
//    loop
//    return 0
asm lookuptbl(dci, tbl)#1
        LDY     #$00
        STY     DSTL
        LDA     ESTKH,X
        CLC
        ADC     #$60
        STA     DSTH
        LDA     ESTKL,X
        CLC
        ADC     #$7F
        STA     DSTX
        LDA     ESTKL+1,X
        STA     SRCL
        LDA     ESTKH+1,X
        STA     SRCH
-       LDA     (DST),Y
        BEQ     +
        CMP     (SRC),Y
        BNE     ++
        INY
        ASL
        BCS     -
        LDA     (DST),Y
        PHA
        INY
        LDA     (DST),Y
        TAY
        PLA
+       INX
        STA     ESTKL,X
        STY     ESTKH,X
        LDA     #$00
        STA     DSTX
        RTS
++      LDY     #$00
--      LDA     (DST),Y
        INC     DSTL
        BEQ     +
---     ASL
        BCS     --
        LDA     #$02
        ADC     DSTL
        STA     DSTL
        BCC     -
        INC     DSTH
        BCS     -
+       INC     DSTH
        BNE     ---
end
// def lookupidx(esd, index)
//    word sym
//    while ^esd
//        sym = esd
//        esd = sym + dcitos(sym, @str)
//        if esd->0 & $10 and esd->1 == index
//            return sym
//        fin
//        esd = esd + 3
//    loop
//end
asm lookupidx(esd, index)#1
        LDA     ESTKL,X
        STA     TMPL
        INX
---     LDA     ESTKH,X
        STA     SRCH
        LDA     ESTKL,X
--      STA     SRCL
        LDY     #$00
-       LDA     (SRC),Y
        BPL     +
        INY
        BNE     -
+       BEQ     ++              ; END OF ESD
        INY
        LDA     (SRC),Y
        INY
        AND     #$10            ; EXTERN FLAG?
        BEQ     +
        LDA     (SRC),Y
        CMP     TMPL
        BEQ     +++             ; MATCH
+       INY
        TYA
        SEC
        ADC     SRCL
        STA     ESTKL,X         ; SYM PTRL
        BCC     --
        INC     ESTKH,X         ; SYM PTRH
        BNE     ---
++      STA     ESTKL,X         ; END OF ESD
        STA     ESTKH,X
+++     RTS
end
//def lookupdef(addr, deftbl)#1
//    while deftbl->0 == $20
//        if deftbl=>3 == addr
//            return deftbl
//        fin
//        deftbl = deftbl + t_defentry
//    loop
//    return 0
//end
asm lookupdef(addr, deftbl)#1
        LDA     ESTKH,X
        STA     SRCH
        LDA     ESTKL,X
        STA     SRCL
        INX
-       LDY     #$00
        LDA     (SRC),Y
        CMP     #$20            ; JSR OPCODE?
        BNE     ++
        LDY     #$03
        LDA     (SRC),Y
        CMP     ESTKL,X
        BNE     +
        INY
        LDA     (SRC),Y
        CMP     ESTKH,X
        BNE     +
        LDA     SRCL            ; MATCH
        STA     ESTKL,X
        LDA     SRCH
        STA     ESTKH,X
        RTS
+       LDA     #$06            ; T_DEFENTRY
        CLC
        ADC     SRCL
        STA     SRCL
        BCC     -
        INC     SRCH
        BNE     -
++      STY     ESTKL,X
        STY     ESTKH,X
        RTS
end
//
// Reloc internal data
//
//def reloc(modfix, modofst, bytecode, rld)#3
//    word addr, fixup
//    while ^rld
//        if ^rld & $10 // EXTERN reference.
//            return rld, addr, fixup
//        fin
//        addr = rld=>1 + modfix
//        fixup = *addr + modofst
//        if uword_isge(fixup, bytecode) // Bytecode address.
//            return rld, addr, fixup
//        fin
//        *addr = fixup
//        rld = rld + 4
//    loop
//    return rld, addr, fixup
//end
asm reloc(modfix, modofst, bytecode, rld)#3
        LDA     ESTKL,X
        STA     SRCL
        LDA     ESTKH,X
        STA     SRCH
        LDY     #$00
-       LDA     (SRC),Y
        BEQ     RLDEX       ; END OF RLD
        PHA
        INY
        LDA     (SRC),Y
        INY
        CLC
        ADC     ESTKL+3,X   ; ADDR=ENTRY=>1+MODFIX
        STA     DSTL
        LDA     (SRC),Y
        ADC     ESTKH+3,X
        STA     DSTH
        PLA
        AND     #$10        ; EXTERN REF - EXIT
        BNE     RLDEX
        TAY                 ; FIXUP=*ADDR+MODOFST
        LDA     (DST),Y
        INY
        CLC
        ADC     ESTKL+2,X
        STA     TMPL
        LDA     (DST),Y
        ADC     ESTKH+2,X
        CMP     ESTKH+1,X   ; FIXUP >= BYTECODE?
        BCC     +
        STA     TMPH
        BNE     RLDEX       ; YEP, EXIT
        LDA     TMPL
        CMP     ESTKL+1,X
        BCS     RLDEX       ; YEP, EXIT
        LDA     TMPH
+       STA     (DST),Y     ; *ADDR=FIXUP
        DEY
        LDA     TMPL
        STA     (DST),Y
        LDA     SRCL        ; NEXT ENTRY
;       CLC
        ADC     #$04
        STA     SRCL
        BCC     -
        INC     SRCH
        BNE     -
RLDEX   INX
        LDA     TMPL
        STA     ESTKL,X
        LDA     TMPH
        STA     ESTKH,X
        LDA     DSTL
        STA     ESTKL+1,X
        LDA     DSTH
        STA     ESTKH+1,X
        LDA     SRCL
        STA     ESTKL+2,X
        LDA     SRCH
        STA     ESTKH+2,X
        RTS
end
//
// SOS routines
// FILE I/O
//
def open(path)#1
    byte params[7]

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

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

    params.0 = 4
    params.1 = refnum
    params:2 = buff
    params:4 = len
    params:6 = 0
    perr     = syscall($CA, @params)
    return params:6
end
def write(refnum, buff, len)#1
    byte params[6]

    params.0 = 3
    params.1 = refnum
    params:2 = buff
    params:4 = len
    perr     = syscall($CB, @params)
    return perr
end
//
// CONSOLE I/O
//
def dev_control(devnum, code, list)#1
    byte params[5]

    params.0 = 3
    params.1 = devnum
    params.2 = code
    params:3 = list
    return syscall($83, @params)
end
def dev_getnum(name)#1
    byte params[4]

    params.0 = 2
    params:1 = name
    params.3 = 0
    syscall($84, @params)
    return params.3
end
def init_cons()#0
    byte nlmode[2]

    refcons  = open(@console)
    devcons  = dev_getnum(@console)
    nlmode:0 = $0D80
    //nlmode.0 = $80
    //nlmode.1 = $0D
    dev_control(devcons, $02, @nlmode)
    write(refcons, @textmode, 3)
end
//
// MEMORY CALLS
//
def seg_find(search, pages, id)#3
    byte params[10]

    params.0 = 6
    params.1 = search
    params.2 = id
    params:3 = pages
    params:5 = 0
    params:7 = 0
    params.9 = 0
    perr     = syscall($41, @params)
    return params.9, params:5, params:7
end
def seg_release(segnum)#1
    byte params[2]

    params.0 = 1
    params.1 = segnum
    perr     = syscall($45, @params)
    return perr
end
//
// CONSOLE I/O
//
def cout(ch)#0
    byte nc

    nc = 1
    if ch == $0D
        ch = $0A0D
        nc = 2
    fin
    write(refcons, @ch, nc)
end
def crout()#0
    cout($0D)
end
def cin()#1
    byte ch
    read(refcons, @ch, 1)
    return ch & $7F
end
def prstr(str)#0
    write(refcons, str + 1, ^str)
    if str->[^str] == $0D
        cout($0A)
    fin
end
def print(i)#0
    if i < 0; cout('-'); i = -i; fin
    if i >= 10; print(i / 10); fin
    cout(i % 10 + '0')
end
def rdstr(prompt)#1
    cout(prompt)
    ^instr = read(refcons, instr+1, 128)
    if instr->[^instr] == $0D
        ^instr--
    fin
    crout
    return instr
end
def prbyte(v)#0
    cout(hexchar[(v >> 4) & $0F])
    cout(hexchar[v & $0F])
end
def prword(v)#0
    prbyte(v >> 8)
    prbyte(v)
end
//
// Heap routines.
//
def availheap()#1
    byte fp
    return @fp - heap
end
def allocheap(size)#1
    word addr
    addr = heap
    heap = heap + size
    if uword_isge(heap, @addr)
        heap = addr
        return 0
    fin
    return addr
end
def allocalignheap(size, pow2, freeaddr)#1
    word align, addr
    if freeaddr
        *freeaddr = heap
    fin
    align = (1 << pow2) - 1
    addr = (heap | align) + 1
    heap = addr + size
    if uword_isge(heap, @addr)
        return 0
    fin
    return addr
end
def markheap()#1
    return heap
end
def releaseheap(newheap)#1
    heap = newheap
    return @newheap - heap
end
//
// Symbol table routines.
//
def addsym(sym, addr)#0
    while ^sym & $80
        xpokeb(symtbl.0, lastsym, ^sym)
        lastsym  = lastsym + 1
        sym      = sym     + 1
    loop
    xpokeb(symtbl.0, lastsym, ^sym)
    xpokeb(symtbl.0, lastsym + 1, addr.0)
    xpokeb(symtbl.0, lastsym + 2, addr.1)
    xpokeb(symtbl.0, lastsym + 3, 0)
    lastsym = lastsym + 3
end
//
// String routines.
//
def strcpy(dst, src)#1
    memcpy(dst+1, src+1, ^src)
    ^dst = ^src
    return dst
end
def strcat(dst, src)#1
    memcpy(dst + ^dst + 1, src + 1, ^src)
    ^dst = ^dst + ^src
    return dst
end
//
// Module routines.
//
def lookupextern(esd, index)#1
    word sym, addr
    byte str[16]
    sym = lookupidx(esd, index)
    if sym
        addr = lookuptbl(sym, symtbl)
        if !addr
            perr = $81
            dcitos(sym, @str)
            cout('?'); prstr(@str); crout
        fin
        return addr
    fin
    return 0
end
def adddef(ext, addr, deflast)#1
    word preventry, defentry, defsize
    defentry = *deflast
    *deflast = defentry + t_defentry
    defentry->interpjsr     = $20      // JSR
    defentry=>interpaddr    = *xinterp // XINTERP
    defentry=>bytecodeaddr  = addr
    defentry->bytecodexbyte = ext
    defentry->t_defentry    = 0
    return defentry
end
def loadmod(mod)#1
    word refnum, rdlen, modsize, bytecode, codefix, defofst, defcnt, init, initcode[], fixup
    word addr, defaddr, modaddr, modfix, modofst, modend
    word deftbl, deflast, codeseg
    word moddep, rld, esd, sym
    byte lerr, defext, fileinfo[], str[16], filename[33]
    byte header[128]
    lerr = 0
    //
    // Read the RELocatable module header (first 128 bytes)
    //
    dcitos(mod, @filename)
    refnum = open(@filename)
    if !refnum and filename < 16
        //
        // Try system path
        //
        refnum = open(strcpy(@filename,strcat(strcpy(@header, @sysmods), @filename)))
    fin
    if refnum
        header.0 = 3
        header:1 = @filename
        header:3 = @fileinfo
        header.5 = 2
        if not syscall($C4, @header) and fileinfo.1 <> $FE // Make sure it's a REL module
            close(refnum)
            perr = $4A // Incompatible type
            return -perr
        fin
        rdlen   = read(refnum, @header, 128)
        modsize = header:0
        moddep  = @header.1
        defofst = modsize + RELADDR
        defext  = 0
        init    = 0
        if rdlen > 4 and header:2 == $6502 // magic number
            //
            // This is an EXTended RELocatable (data+bytecode) module.
            //
            systemflags = header.4 | systemflags
            defofst     = header:6
            defcnt      = header:8
            init        = header:10
            moddep      = @header.12
            //
            // Load module dependencies.
            //
            while ^moddep
                if !lookuptbl(moddep, symtbl)
                    if refnum
                        close(refnum)
                        refnum = 0
                    fin
                    if loadmod(moddep) < 0
                        return -perr
                    fin
                fin
                moddep = moddep + dcitos(moddep, @str)
            loop
            //
            // Init def table.
            //
            deftbl   = allocheap(defcnt * t_defentry + 1)
            deflast  = deftbl
            ^deflast = 0
            if !refnum
                //
                // Reset read pointer.
                //
                refnum = open(@filename)
                rdlen  = read(refnum, @header, 128)
            fin
        fin
        //
        // Alloc heap space for relocated module (data + bytecode).
        //
        moddep++
        modfix  = moddep  - @header.2 // Adjust to skip header
        modsize = modsize - modfix
        rdlen   = rdlen   - modfix - 2
        modaddr = allocheap(modsize)
        memcpy(modaddr, moddep, rdlen)
        //
        // Read in remainder of module into memory for fixups.
        //
        addr = modaddr
        repeat
            addr  = addr + rdlen
            rdlen = read(refnum, addr, 4096)
        until rdlen <= 0
        close(refnum)
        //
        // Add module to symbol table.
        //
        addsym(mod, modaddr)
        //
        // Apply all fixups and symbol import/export.
        //
        modfix   = modaddr - modfix
        modofst  = modfix  - RELADDR
        modend   = modaddr + modsize
        bytecode = defofst + modofst
        rld      = modend  // Re-Locatable Directory
        esd      = rld     // Extern+Entry Symbol Directory
        while ^esd         // Scan to end of ESD
            esd = esd + 4
        loop
        esd++
        if defcnt
            //
            // Locate bytecode defs in allocated segment.
            //
            modseg[modid], codeseg, drop = seg_find($00, (rld - bytecode + 255) >> 8, modid + $12)
            if perr
                return -perr
            fin
            modid++
            defext  =  codeseg.0 + $7F // (codeseg.0 | $80) - 1
            defaddr = (codeseg & $FF00) + $6000
            codefix = defaddr - bytecode
            defofst = defaddr - defofst
        fin
        //
        // Run through the DeFinition Dictionary.
        //
        while ^rld == $02
            //
            // This is a bytcode def entry - add it to the def directory.
            //
            adddef(defext, rld=>1 + defofst, @deflast)
            rld = rld + 4
        loop
        //
        // Run through the Re-Location Dictionary.
        //
        while ^rld
            rld, addr, fixup = reloc(modfix, modofst, bytecode, rld)
            if ^rld
                *addr = ^rld & $10 ?? *addr + lookupextern(esd, rld->3) :: lookupdef(fixup + codefix, deftbl)
                rld   = rld + 4
            fin
        loop
        //
        // Run through the External/Entry Symbol Directory.
        //
        while ^esd
            sym = esd
            esd = esd + dcitos(esd, @str)
            if ^esd & $08
                //
                // EXPORT symbol - add it to the global symbol table.
                //
                addr = esd=>1 + modofst
                if uword_isge(addr, bytecode)
                    //
                    // Use the def directory address for bytecode.
                    //
                    addr = lookupdef(addr + codefix, deftbl)
                fin
                addsym(sym, addr)
            fin
            esd = esd + 3
        loop
        if defext
            //
            // Copy bytecode to code segment.
            //
            memxcpy(codeseg, bytecode, modsize - (bytecode - modaddr))
        fin
    else
        lerr = $46
    fin
    if lerr
        return -lerr
    fin
    //
    // Free up end-of-module main memory.
    //
    releaseheap(bytecode)
    //
    // Call init routine if it exists.
    //
    initcode = 0
    if init
        initcode = adddef(defext, init + defofst, @deflast)()
        if initcode < 0
            perr = -initcode
        fin
    fin
    return initcode
end
def execmod(modfile)#1
    byte moddci[17]
    word saveheap, savesym, saveflags

    perr = 1
    if stodci(modfile, @moddci)
        saveheap  = heap
        savesym   = lastsym
        saveflags = systemflags
        if loadmod(@moddci) < modkeep
            lastsym     = savesym
            heap        = saveheap
            while modid
                modid--
                seg_release(modseg[modid])
            loop
            xpokeb(symtbl.0, lastsym, 0)
            systemflags = saveflags
        else
            modid = 0
        fin
    fin
    return -perr
end
//
// Init 2K symbol table.
//
drop, symtbl, drop = seg_find($00, $08, $11)
lastsym = symtbl & $FF00
xpokeb(symtbl.0, lastsym, 0)
while *sysmodsym
    stodci(sysmodsym=>0, heap)
    addsym(heap, sysmodsym=>2)
    sysmodsym = sysmodsym + 4
loop
//
// Clear system path and command line
//
sysmods  = 0
syspath  = @sysmods
cmdlnptr = @cmdln
//
// Print PLASMA version
//
init_cons
prstr("PLASMA 2.0 ALPHA1\n")//; putb(version.1); putc('.'); putb(version.0); putln
prstr("MEM:$"); prword(availheap); crout
//
// Exec command line parser
//
loadmod(@soscmd)
modid   = 0
autorun = open("AUTORUN")
if autorun > 0
    cmdln = read(autorun, @cmdln.1, 64)
    close(autorun)
fin
//
// Call cmd line parser
//
repeat
    execmod((*cmdparser)())
    write(refcons, @textmode, 3)
    cmdln = 0
until 0
done
