384 lines
7.6 KiB
Plaintext
384 lines
7.6 KiB
Plaintext
(*
|
|
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. |