ruberon/source/BIN.ob07

MODULE BIN;

IMPORT LISTS, CHL := CHUNKLISTS, ARITH, UTILS IN "./utils/UTILS.ob07";


CONST

    RCODE*  = 0;  PICCODE* = RCODE + 1;
    RDATA*  = 2;  PICDATA* = RDATA + 1;
    RBSS*   = 4;  PICBSS*  = RBSS + 1;
    RIMP*   = 6;  PICIMP*  = RIMP + 1;

    IMPTAB* = 8;


TYPE

    RELOC* = POINTER TO RECORD (LISTS.ITEM)

        opcode*: INTEGER;
        offset*: INTEGER

    END;

    IMPRT* = POINTER TO RECORD (LISTS.ITEM)

        nameoffs*: INTEGER;
        label*:    INTEGER;

        OriginalFirstThunk*,
        FirstThunk*: INTEGER

    END;

    EXPRT* = POINTER TO RECORD (LISTS.ITEM)

        nameoffs*: INTEGER;
        label*:    INTEGER

    END;

    PROGRAM* = POINTER TO RECORD

        code*:      CHL.BYTELIST;
        data*:      CHL.BYTELIST;
        labels:     CHL.INTLIST;
        bss*:       INTEGER;
        stack*:     INTEGER;
        vmajor*,
        vminor*:    WCHAR;
        modname*:   INTEGER;
        _import*:   CHL.BYTELIST;
        export*:    CHL.BYTELIST;
        rel_list*:  LISTS.LIST;
        imp_list*:  LISTS.LIST;
        exp_list*:  LISTS.LIST

    END;


PROCEDURE create* (NumberOfLabels: INTEGER): PROGRAM;
    VAR
        program:  PROGRAM;
        i:        INTEGER;

    BEGIN
        NEW(program);

        program.bss := 0;

        program.labels := CHL.CreateIntList();
        FOR i := 0 TO NumberOfLabels - 1 DO
            CHL.PushInt(program.labels, 0)
        END;

        program.rel_list := LISTS.create(NIL);
        program.imp_list := LISTS.create(NIL);
        program.exp_list := LISTS.create(NIL);

        program.data    := CHL.CreateByteList();
        program.code    := CHL.CreateByteList();
        program._import := CHL.CreateByteList();
        program.export  := CHL.CreateByteList()

        RETURN program
    END create;


PROCEDURE SetParams* (program: PROGRAM; bss, stack: INTEGER; vmajor, vminor: WCHAR);
    BEGIN
        program.bss    := bss;
        program.stack  := stack;
        program.vmajor := vmajor;
        program.vminor := vminor
    END SetParams;


PROCEDURE PutReloc* (program: PROGRAM; opcode: INTEGER);
    VAR
        cmd: RELOC;

    BEGIN
        NEW(cmd);
        cmd.opcode := opcode;
        cmd.offset := CHL.Length(program.code);
        LISTS.push(program.rel_list, cmd)
    END PutReloc;


PROCEDURE PutData* (program: PROGRAM; b: BYTE);
    BEGIN
        CHL.PushByte(program.data, b)
    END PutData;


PROCEDURE get32le* (_array: CHL.BYTELIST; idx: INTEGER): INTEGER;
    VAR
        i: INTEGER;
        x: INTEGER;

    BEGIN
        x := 0;

        FOR i := 3 TO 0 BY -1 DO
            x := LSL(x, 8) + CHL.GetByte(_array, idx + i)
        END;

        IF UTILS.bit_depth = 64 THEN
            x := LSL(x, 16);
            x := LSL(x, 16);
            x := ASR(x, 16);
            x := ASR(x, 16)
        END

        RETURN x
    END get32le;


PROCEDURE put32le* (_array: CHL.BYTELIST; idx: INTEGER; x: INTEGER);
    VAR
        i: INTEGER;

    BEGIN
        FOR i := 0 TO 3 DO
            CHL.SetByte(_array, idx + i, UTILS.Byte(x, i))
        END
    END put32le;


PROCEDURE PutData32LE* (program: PROGRAM; x: INTEGER);
    VAR
        i: INTEGER;

    BEGIN
        FOR i := 0 TO 3 DO
            CHL.PushByte(program.data, UTILS.Byte(x, i))
        END
    END PutData32LE;


PROCEDURE PutData64LE* (program: PROGRAM; x: INTEGER);
    VAR
        i: INTEGER;

    BEGIN
        FOR i := 0 TO 7 DO
            CHL.PushByte(program.data, UTILS.Byte(x, i))
        END
    END PutData64LE;


PROCEDURE PutDataStr* (program: PROGRAM; s: ARRAY OF CHAR);
    VAR
        i: INTEGER;

    BEGIN
        i := 0;
        WHILE s[i] # 0X DO
            PutData(program, ORD(s[i]));
            INC(i)
        END
    END PutDataStr;


PROCEDURE PutCode* (program: PROGRAM; b: BYTE);
    BEGIN
        CHL.PushByte(program.code, b)
    END PutCode;


PROCEDURE PutCode32LE* (program: PROGRAM; x: INTEGER);
    VAR
        i: INTEGER;

    BEGIN
        FOR i := 0 TO 3 DO
            CHL.PushByte(program.code, UTILS.Byte(x, i))
        END
    END PutCode32LE;


PROCEDURE PutCode16LE* (program: PROGRAM; x: INTEGER);
    BEGIN
        CHL.PushByte(program.code, UTILS.Byte(x, 0));
        CHL.PushByte(program.code, UTILS.Byte(x, 1))
    END PutCode16LE;


PROCEDURE SetLabel* (program: PROGRAM; label, offset: INTEGER);
    BEGIN
        CHL.SetInt(program.labels, label, offset)
    END SetLabel;


PROCEDURE Import* (program: PROGRAM; name: ARRAY OF CHAR; label: INTEGER);
    VAR
        imp: IMPRT;

    BEGIN
        CHL.PushByte(program._import, 0);
        CHL.PushByte(program._import, 0);

        IF ODD(CHL.Length(program._import)) THEN
            CHL.PushByte(program._import, 0)
        END;

        NEW(imp);
        imp.nameoffs := CHL.PushStr(program._import, name);
        imp.label := label;
        LISTS.push(program.imp_list, imp)
    END Import;


PROCEDURE less (bytes: CHL.BYTELIST; a, b: EXPRT): BOOLEAN;
    VAR
        i, j: INTEGER;

    BEGIN
        i := a.nameoffs;
        j := b.nameoffs;

        WHILE (CHL.GetByte(bytes, i) # 0) & (CHL.GetByte(bytes, j) # 0) &
            (CHL.GetByte(bytes, i) = CHL.GetByte(bytes, j)) DO
            INC(i);
            INC(j)
        END

        RETURN CHL.GetByte(bytes, i) < CHL.GetByte(bytes, j)
    END less;


PROCEDURE Export* (program: PROGRAM; name: ARRAY OF CHAR; label: INTEGER);
    VAR
        exp, cur: EXPRT;

    BEGIN
        NEW(exp);
        exp.label := CHL.GetInt(program.labels, label);
        exp.nameoffs := CHL.PushStr(program.export, name);

        cur := program.exp_list.first(EXPRT);
        WHILE (cur # NIL) & less(program.export, cur, exp) DO
            cur := cur.next(EXPRT)
        END;

        IF cur # NIL THEN
            IF cur.prev # NIL THEN
                LISTS.insert(program.exp_list, cur.prev, exp)
            ELSE
                LISTS.insertL(program.exp_list, cur, exp)
            END
        ELSE
            LISTS.push(program.exp_list, exp)
        END

    END Export;


PROCEDURE GetIProc* (program: PROGRAM; n: INTEGER): IMPRT;
    VAR
        _import, res: IMPRT;

    BEGIN
        _import  := program.imp_list.first(IMPRT);

        res := NIL;
        WHILE (_import # NIL) & (n >= 0) DO
            IF _import.label # 0 THEN
                res := _import;
                DEC(n)
            END;
            _import := _import.next(IMPRT)
        END;

        ASSERT(n = -1)
        RETURN res
    END GetIProc;


PROCEDURE GetLabel* (program: PROGRAM; label: INTEGER): INTEGER;
        RETURN CHL.GetInt(program.labels, label)
    END GetLabel;


PROCEDURE NewLabel* (program: PROGRAM);
    BEGIN
        CHL.PushInt(program.labels, 0)
    END NewLabel;


PROCEDURE fixup* (program: PROGRAM);
    VAR
        rel:    RELOC;
        imp:    IMPRT;
        nproc:  INTEGER;
        L:      INTEGER;

    BEGIN

        nproc := 0;
        imp := program.imp_list.first(IMPRT);
        WHILE imp # NIL DO
            IF imp.label # 0 THEN
                CHL.SetInt(program.labels, imp.label, nproc);
                INC(nproc)
            END;
            imp := imp.next(IMPRT)
        END;

        rel := program.rel_list.first(RELOC);
        WHILE rel # NIL DO

            IF rel.opcode IN {RIMP, PICIMP} THEN
                L := get32le(program.code, rel.offset);
                put32le(program.code, rel.offset, GetLabel(program, L))
            END;

            rel := rel.next(RELOC)
        END

    END fixup;


PROCEDURE InitArray* (VAR _array: ARRAY OF BYTE; VAR idx: INTEGER; hex: ARRAY OF CHAR);
    VAR
        i, k: INTEGER;


        PROCEDURE hexdgt (dgt: CHAR): INTEGER;
        VAR
            res: INTEGER;

        BEGIN
            IF dgt < "A" THEN
                res := ORD(dgt) - ORD("0")
            ELSE
                res := ORD(dgt) - ORD("A") + 10
            END

            RETURN res
        END hexdgt;


    BEGIN
        k := LENGTH(hex);
        ASSERT(~ODD(k));
        k := k DIV 2;

        FOR i := 0 TO k - 1 DO
            _array[i + idx] := hexdgt(hex[2 * i]) * 16 + hexdgt(hex[2 * i + 1])
        END;

        INC(idx, k)
    END InitArray;


END BIN.