ruberon/source/BIN.ob07

(*
    BSD 2-Clause License

    Copyright (c) 2018-2020, Anton Krotov
    All rights reserved.
*)

MODULE BIN;

IMPORT LISTS, CHL := CHUNKLISTS, ARITH, UTILS;


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.