VM02/plasma2/plinky.pla

CONST FALSE        = 0
CONST TRUE         = NOT FALSE
CONST OK           = 0
CONST ERROR        = -1
CONST INPUTSTR     = $01FF
CONST INBUFF       = $0800
CONST OUTBUFF      = $0C00
CONST SYMTABLE     = $B000
CONST SYMSIZE      = $0A00
CONST DATABUFF     = $A000
WORD NEXTENTRY     = SYMTABLE
BYTE PLASMASTR[]   = "PLASMA LINKER 0.8"
BYTE NULLSTR[]     = ""
BYTE BADMODSTR[]   = "MODULE NOT FOUND"
BYTE ASMADR[]      = "ASM ADDRESS: $"
BYTE LOADADR[]     = "LOAD ADDRESS: $"
BYTE DATASZ[]      = "DATA SIZE: $"
BYTE RELOFSTSTR[]  = "REL OFFSET: $"
BYTE FIX16STR[]    = "FIXUP 16-BIT ADDRESS: $"
BYTE FIX8STR[]     = "FIXUP 8-BIT ADDRESS: $"
BYTE RLDLBL[]      = "RELOCATION DIRECTORY:"
BYTE ESDLBL[]      = "SYMBOL TABLE:"
BYTE MATCHEXTRNSTR = "MATCH EXTRN: "
BYTE INPUTFILESTR  = "INPUT FILE"
BYTE OUTPUTFILESTR = "OUTPUT FILE"
BYTE ERROUTSTR     = "ERROR CREATING OUTPUT FILE"
BYTE PRESSANYKEY[] = "PRESS ANY KEY TO CONTINUE..."
BYTE MODCOUNT, MODI
BYTE BINREF, BINTYPE
WORD MODBUFF,MODLEN,MODADDR,LINKADDR
BYTE MODFILES[170]
BYTE PERR
;
; SYMBOL TABLE TYPE CONSTANTS
;
CONST LOBYTE_TYPE  = $01
CONST HIBYTE_TYPE  = $02
CONST WORD_TYPE    = $03
CONST FUNC_TYPE    = $04
CONST CONST_TYPE   = $08
;
; CONVERT CHARACTER TO UPPER CASE (AND STRIP MSB)
;
DEF TOUPPER(CH)

    CH = CH & $7F
    IF CH >= 'a' AND CH <= 'z'
        CH = CH - $20
    FIN
    RETURN CH
END
DEF CROUT
    COUT($0D)
END
DEF BADMOD
    PRSTR(@BADMODSTR)
    CROUT()
END
DEF PRBYTE(VAL)
  DROP ROMCALL(VAL, 0, 0, 0, $FDDA)
END
DEF PRWORD(VAL)
  DROP ROMCALL(VAL >> 8, VAL, 0, 0, $F941)
END
;
; BASIC FILE I/O
;
DEF GETFILEINFO(PATH, INFOPTR)
    BYTE PARAMS[18]

    PARAMS.0 = 10
    PARAMS:1 = PATH
    PERR     = SYSCALL($C4, @PARAMS)
    IF NOT PERR
        MEMCPY(@PARAMS.3, INFOPTR, 15)
    FIN
    RETURN PERR
END
DEF DESTROY(PATH)
    BYTE PARAMS[3]

    PARAMS.0 = 1
    PARAMS:1 = PATH
    PERR = SYSCALL($C1, @PARAMS)
    RETURN PERR
END
DEF CREATE(PATH, ACCESS, TYPE, AUX)
    BYTE PARAMS[12]

    PARAMS.0  = 7
    PARAMS:1  = PATH
    PARAMS.3  = ACCESS
    PARAMS.4  = TYPE
    PARAMS:5  = AUX
    PARAMS.7  = $1
    PARAMS:8  = 0
    PARAMS:10 = 0
    PERR = SYSCALL($C0, @PARAMS)
    RETURN PERR
END
DEF 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
DEF WRITE(REFNUM, BUFF, LEN)
    BYTE PARAMS[8]
    PARAMS.0 = 4
    PARAMS.1 = REFNUM
    PARAMS:2 = BUFF
    PARAMS:4 = LEN
    PARAMS:6 = 0
    PERR     = SYSCALL($CB, @PARAMS)
    RETURN PARAMS:6
END
;
; REL MODULE FIXUPS
;
DEF DUMPRLD(RLD)
    COUT('$')
    PRBYTE(^RLD)
    COUT(':')
    COUT(' ')
    COUT('$')
    PRWORD(*(RLD + 1))
    COUT(' ')
    COUT('$')
    PRBYTE(^(RLD + 3))
    CROUT
    RETURN RLD + 4
END
DEF DUMPESD(ESD)
    WHILE ^ESD & $80
        COUT(^ESD)
        ESD = ESD + 1
    LOOP
    COUT(^ESD)
    COUT(':')
    COUT(' ')
    COUT('$')
    PRBYTE(^(ESD + 1))
    COUT(' ')
    COUT('$')
    PRWORD(^(ESD + 2))
    CROUT
    RETURN ESD + 4
END
DEF MATCHSTR(STR1, STR2)
    BYTE I
    IF ^STR1 == ^STR2
        FOR I = ^STR1 DOWNTO 1
            IF (STR1).[I] <> (STR2).[I]
                RETURN FALSE
            FIN
        NEXT
        RETURN TRUE
    FIN
    RETURN FALSE
END
;
; THE GLOBAL SYMBOL DICTIONARY HAS THE FORMAT OF:
;    STRING: NAME (VARIABLE LENGTH)
;    WORD:   ADDRESS
;
DEF DUMPDICT
    WORD DICTPTR

    DICTPTR = SYMTABLE
    CROUT()
    WHILE ^DICTPTR
        PRSTR(DICTPTR)
        COUT(':')
        COUT(' ')
        COUT('$')
        PRWORD(*(DICTPTR + ^DICTPTR + 1))
        CROUT()
        DICTPTR = DICTPTR  + ^DICTPTR + 3 ; NEXT ENTRY
    LOOP
END
DEF ADDSYM(SYMSTR, ADDR)
    MEMCPY(SYMSTR, NEXTENTRY, ^SYMSTR + 1)
    NEXTENTRY = NEXTENTRY + ^NEXTENTRY
    (NEXTENTRY):1 = ADDR
    NEXTENTRY = NEXTENTRY + 3
END
DEF SEARCHDICT(SYMSTR)
    WORD DICTPTR

    DICTPTR = SYMTABLE
    ;
    ; SEARCH GLOBAL DICTIONARY LOOKING FOR MATCH
    ;
    WHILE ^DICTPTR
;        CROUT
;        PRSTR(DICTPTR)
        IF MATCHSTR(DICTPTR, SYMSTR)
;            COUT('$')
;            PRWORD(*(DICTPTR + ^DICTPTR + 1))
            RETURN DICTPTR + ^DICTPTR + 1
        FIN
        DICTPTR = DICTPTR + ^DICTPTR + 3 ; NEXT ENTRY
    LOOP
    RETURN 0
END
DEF MATCHEXTRN(INDEX, ESD)
    BYTE SYMSTR[$81], I
    WORD SYMPTR

    ;
    ; FIND MATCHING ESD INDEX
    ;
    WHILE ^ESD
;        DUMPESD(ESD)
        SYMPTR = ESD
        I = 1
        WHILE ^ESD & $80
            SYMSTR[I] = TOUPPER(^ESD)
            I = I + 1
            ESD = ESD + 1
        LOOP
        SYMSTR[I] = TOUPPER(^ESD)
        SYMSTR    = I
;        CROUT
        IF ^(ESD + 1) & $10
;            PRSTR(@MATCHEXTRNSTR)
;            PRSTR(@SYMSTR)
            IF ^(ESD + 2) == INDEX
                RETURN SEARCHDICT(@SYMSTR)
            FIN
        FIN
        ESD = ESD + 4
    LOOP
    RETURN 0
END
DEF FIXUP(SEGPTR, RLD, OFST, ESD, PASS)
    WORD FIXVAL, FIXADDR, EXTRNVAL

    WHILE ^RLD
;        DUMPRLD(RLD)
        FIXADDR = SEGPTR + *(RLD + 1)
        IF ^RLD & $80
            ;
            ; 16 BIT FIXUP
            ;
;            PRSTR(@FIX16STR)
;            PRWORD(FIXADDR)
;            CROUT
            FIXVAL = *FIXADDR
            IF ^RLD & $10
                ;
                ; EXTERNAL SYMBOL
                ;
                EXTRNVAL = MATCHEXTRN(^(RLD + 3), ESD)
                IF EXTRNVAL
                    FIXVAL = FIXVAL + *EXTRNVAL
                ELSIF PASS == 2
                    RETURN ERROR
                FIN
            ELSE
                FIXVAL = FIXVAL + OFST
            FIN
            IF ^RLD & $20 ; REVERSE HI AND LO BYTES
                FIXVAL = ((FIXVAL >> 8) & $FF) ? (FIXVAL << 8)
            FIN
            *FIXADDR = FIXVAL
        ELSE
            ;
            ; 8 BIT FIXUP
            ;
;            PRSTR(@FIX8STR)
;            PRWORD(FIXADDR)
;            CROUT
            IF ^RLD & $10
                ;
                ; EXTERNAL SYMBOL
                ;
                EXTRNVAL = MATCHEXTRN(^(RLD + 3), ESD)
                IF EXTRNVAL
                    FIXVAL = FIXVAL + ^EXTRNVAL
                ELSIF PASS == 2
                    RETURN ERROR
                FIN
            ELSE
                IF ^RLD & $40
                    FIXVAL   = ^FIXADDR << 8 ? ^(RLD + 3)
                    FIXVAL   = FIXVAL + OFST
                ELSE
                    FIXVAL   = ^(RLD + 3) << 8 ? ^FIXADDR
                    FIXVAL   = FIXVAL + OFST
                FIN
            FIN
            IF ^RLD & $40
                ^FIXADDR = FIXVAL >> 8
            ELSE
                ^FIXADDR = FIXVAL
            FIN
        FIN
        RLD = RLD + 4
    LOOP
    RETURN OK
END
DEF LOADMOD(MODSTR, PASS)
    BYTE REFNUM, I, INFO[15], SYMSTR[81]
    WORD RELOFST, MODPTR, MODSYMTBL, MODSYMSZ, LEN, DATALEN, RLD, ESD

    DROP GETFILEINFO(MODSTR, @INFO)
    IF PERR OR INFO.1 <> $FE ; REL FILE TYPE
        RETURN 0, 0
    FIN
    ;
    ; READ REL FILE
    ;
    REFNUM = OPEN(MODSTR, INBUFF)
    LEN    = READ(REFNUM, DATABUFF, 32768)
    DROP CLOSE(REFNUM)
    ;
    ; GET POINTERS TO IMPORTANT SECTIONS
    ;
    DATALEN  = *DATABUFF
    MODPTR   = DATABUFF + 2
    RLD      = MODPTR + DATALEN
    ESD      = RLD
    IF MODADDR
        RELOFST = MODADDR - INFO:2
    ELSE
        MODADDR  = INFO:2
        LINKADDR = MODADDR
        RELOFST  = 0
    FIN
    MODADDR = MODADDR + DATALEN
    WHILE ^ESD ; SKIP OVER RLD
        ESD = ESD + 4
    LOOP
    ESD = ESD + 1
;    PRSTR(@RELOFSTSTR)
;    PRWORD(RELOFST)
;    CROUT()
    ;
    ; RUN THROUGH DATA FIXUP TABLE
    ;
    IF FIXUP(MODPTR, RLD, RELOFST, ESD, PASS)
        RETURN 0, 0
    FIN
    ;
    ; CREATE SYMBOL TABLE FOR EXPORTS
    ;
    IF PASS == 1
        WHILE ^ESD
;            DUMPESD(ESD)
            I = 1
            WHILE ^ESD & $80
                SYMSTR[I] = TOUPPER(^ESD)
                I = I + 1
                ESD = ESD + 1
            LOOP
            SYMSTR[I] = TOUPPER(^ESD)
            SYMSTR    = I
            IF ^(ESD + 1) & $08 ; ENTRY SYMBOL
                ADDSYM(@SYMSTR, *(ESD + 2) + RELOFST)
            FIN
            ESD = ESD + 4
        LOOP
    FIN
    RETURN DATABUFF + 2, DATALEN
END

CROUT()
PRSTR(@PLASMASTR)
CROUT()
MEMSET(0, SYMTABLE, SYMSIZE)
MODCOUNT = 0
MODADDR  = 0
PRSTR(@INPUTFILESTR)
WHILE LOADMOD(RDSTR($BA), 1)
    DROP
    MEMCPY(INPUTSTR, @MODFILES[MODCOUNT * 17], ^INPUTSTR + 1)
    MODCOUNT = MODCOUNT + 1
LOOP
DROP
IF MODCOUNT
    MODADDR = 0
    IF LINKADDR == $2000
        BINTYPE = $FF
    ELSE
        BINTYPE = $06
    FIN
    PRSTR(@OUTPUTFILESTR)
    DROP DESTROY(RDSTR($BA))
    DROP CREATE(INPUTSTR, $C3, BINTYPE, LINKADDR)
    BINREF = OPEN(INPUTSTR, OUTBUFF)
    IF BINREF == 0
        PRSTR(@ERROUTSTR)
    ELSE
        FOR MODI = 0 TO MODCOUNT - 1
            MODBUFF =, MODLEN = LOADMOD(@MODFILES[MODI * 17], 2)
            DROP WRITE(BINREF, MODBUFF, MODLEN)
        NEXT
        DROP CLOSE(BINREF)
        DUMPDICT()
    FIN
    PRSTR(@PRESSANYKEY)
    WHILE ^$C000 < 128
    LOOP
    DROP ^$C010
FIN
DONE