(*
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.