Subversion Repositories Kolibri OS

(*

    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.