Copyright (C) 1994, Digital Equipment Corporation
All rights reserved.
See the file COPYRIGHT for a full description.
Last modified on Mon Jan 30 08:33:00 PST 1995 by kalsow
UNSAFE MODULE NTObjFile;
IMPORT Text, Wr, Word, IntIntTbl, TextIntTbl;
IMPORT M3ObjFile, M3ID, CoffTime, Target;
FROM M3CG IMPORT Name, BitOffset, BitSize, ByteOffset, ByteSize, TypeUID;
IMPORT RTError;
TYPE
UINT8 = M3ObjFile.UINT8;
Seg = M3ObjFile.Seg;
TYPE
SymKind = { Text, Data, Bss, Extern, File, FileAux, Section };
CONST
SegToKind = ARRAY Seg OF SymKind { SymKind.Text, SymKind.Data };
TYPE
Alignment = [0..3];
CONST
AlignBytes = ARRAY Alignment OF [0..8] { 1, 2, 4, 8 };
TYPE
SymbolList = REF ARRAY OF Symbol;
Symbol = RECORD
id : M3ID.T;
offset : INTEGER := 0; (* segment offset *)
kind : SymKind;
export : BOOLEAN := FALSE;
used : BOOLEAN := FALSE;
index : INTEGER := -1; (* final symbol table index *)
next_func : INTEGER := 0; (* symtab index of next procedure entry *)
first_line : INTEGER := 0; (* source line number *)
last_line : INTEGER := 0;
last_offset : INTEGER := 0;
lineno_offs : INTEGER := 0;
lineno_cnt : INTEGER := 0;
END;
TYPE
RelocKind = {Symbol, Offset, Segment};
TYPE
RelocList = REF ARRAY OF Reloc;
Reloc = RECORD
kind : RelocKind;
src_sym, src_offset : INTEGER;
target_sym : INTEGER;
END;
CONST (* relocation types *)
REL_I386_DIR32 = 6; (* Direct 32-bit reference to symbol *)
REL_I386_SECTION = 10; (* 16-bit reference to symbol's section number *)
REL_I386_SECREL = 11; (* 32-bit reference to symbol's section offset *)
TYPE
LineNums = REF ARRAY OF LineNum;
LineNum = RECORD addr, line: INTEGER; END;
TYPE
Bytes = REF ARRAY OF UINT8;
Ints = REF ARRAY OF INTEGER;
TextList = REF ARRAY OF TEXT;
TYPE
Chunk = RECORD
cnt : INTEGER := 0;
n_bytes : INTEGER := 0;
file_offset : INTEGER := 0;
END;
TYPE
Section = RECORD
name : TEXT := NIL;
id : INTEGER := 0;
flags : INTEGER := 0;
address : INTEGER := 0;
raw_data : Chunk;
relocation : Chunk;
line_numbers : Chunk;
data : Bytes := NIL;
line_nums : LineNums := NIL;
relocs : RelocList := NIL;
END;
TYPE
SymbolTable = RECORD
map : IntIntTbl.T := NIL;
list : SymbolList := NIL;
remap: Ints := NIL;
chunk: Chunk;
END;
TYPE
OutputStream = RECORD
wr : Wr.T := NIL;
len : INTEGER := 0;
buf : ARRAY [0..16_10000 - 1] OF UINT8;
END;
TYPE
StringTable = RECORD
cnt : INTEGER := 0;
n_bytes : INTEGER := 0;
list : TextList := NIL;
map : TextIntTbl.T := NIL;
END;
REVEAL
T = M3ObjFile.T BRANDED "NTObjFile.T" OBJECT
n_sections : INTEGER := 0;
debug_S : Section;
text : Section;
data : Section;
bss : Section;
debug_T : Section;
symtab : SymbolTable;
strings : StringTable;
out : OutputStream;
filename : TEXT := NIL;
filesym : INTEGER := -1;
gen_debugging : BOOLEAN := FALSE;
sect_syms : BOOLEAN := FALSE;
in_procedure : BOOLEAN := FALSE;
first_proc : INTEGER := 0;
last_proc : INTEGER := 0;
last_source_line : INTEGER := 0;
OVERRIDES
cursor := Cursor;
append := AppendIntegerToSegment;
appendBytes := AppendBytesToSegment;
patch := PatchSegment;
backup := BackupInSegment;
relocate := Relocate;
import_symbol := ImportSymbol;
define_symbol := DefineSymbol;
define_bss_symbol := DefineBssSymbol;
move_symbol := MoveSymbol;
export_symbol := ExportSymbol;
set_source_file := SetSourceFile;
set_source_line := SetSourceLine;
declare_typename := DeclareTypename;
declare_array := DeclareArray;
declare_open_array := DeclareOpenArray;
declare_enum := DeclareEnum;
declare_enum_elt := DeclareEnumElt;
declare_packed := DeclarePacked ;
declare_record := DeclareRecord;
declare_field := DeclareField;
declare_set := DeclareSet;
declare_subrange := DeclareSubrange;
declare_pointer := DeclarePointer;
declare_indirect := DeclareIndirect;
declare_proctype := DeclareProctype;
declare_formal := DeclareFormal;
declare_raises := DeclareRaises;
declare_object := DeclareObject;
declare_method := DeclareMethod;
declare_opaque := DeclareOpaque;
reveal_opaque := RevealOpaque;
declare_exception := DeclareException;
declare_global := DeclareGlobal;
declare_constant := DeclareConstant;
declare_local := DeclareLocal;
declare_param := DeclareParam;
declare_procedure := DeclareProcedure;
begin_procedure := BeginProcedure;
end_procedure := EndProcedure;
begin_block := BeginBlock;
end_block := EndBlock;
note_procedure_origin := NoteProcedureOrigin;
END;
CONST (* byte sizes of the structures in the object file *)
HeaderSize = 20;
SectionSize = 40;
RelocSize = 10;
LineNumSize = 6;
SymTabSize = 18;
CONST (* section flags *)
S_NO_PAD = 16_00000008;
S_CODE = 16_00000020;
S_DATA = 16_00000040;
S_BSS = 16_00000080;
S_INFO = 16_00000200;
S_REMOVE = 16_00000800;
S_ALIGN1 = 16_00100000;
S_ALIGN2 = 16_00200000;
S_ALIGN4 = 16_00300000;
S_ALIGN8 = 16_00400000;
S_ALIGN16 = 16_00500000;
S_ALIGN32 = 16_00600000;
S_ALIGN64 = 16_00700000;
S_DISCARD = 16_02000000;
S_EXEC = 16_20000000;
S_READ = 16_40000000;
S_WRITE = 16_80000000;
CONST (* CV4 symbol types *)
S_COMPILE = 1;
S_END = 6;
S_OBJNAME = 9;
S_LPROC32 = 16_204;
S_GPROC32 = 16_205;
CONST
CompilerName = "Digital SRC Modula-3 (version 3.4)";
CONST (* constants defined by the code generator *)
PrologueLength = 4;
EpilogueLength = 4;
CONST
ProcTag = ARRAY BOOLEAN OF INTEGER { S_LPROC32, S_GPROC32 };
-------------------------------------------------------- initialization ---
PROCEDURE New (): T =
CONST DebugFlags = S_READ + S_DISCARD + S_ALIGN1 + S_DATA + S_NO_PAD;
VAR t := NEW (T);
BEGIN
IF (t.gen_debugging) THEN
InitSection (t, t.debug_S, ".debug$S", DebugFlags);
END;
InitSection (t, t.text, ".text", S_READ + S_EXEC + S_ALIGN16 + S_CODE);
InitSection (t, t.data, ".data", S_WRITE + S_READ + S_ALIGN8 + S_DATA);
InitSection (t, t.bss, ".bss", S_WRITE + S_READ + S_ALIGN8 + S_BSS);
IF (t.gen_debugging) THEN
InitSection (t, t.debug_T, ".debug$T", DebugFlags);
END;
t.filesym := -1;
AddSectSym (t, t.debug_S);
AddSectSym (t, t.text);
AddSectSym (t, t.data);
AddSectSym (t, t.bss);
AddSectSym (t, t.debug_T);
IF t.gen_debugging THEN
AppendIntegerToSection (t.debug_T, 1, 4); (* CV4 version stamp *)
AppendIntegerToSection (t.debug_S, 1, 4); (* CV4 version stamp *)
END;
RETURN t;
END New;
PROCEDURE InitSection (t: T; VAR s: Section; name: TEXT; flags: INTEGER) =
BEGIN
INC (t.n_sections);
s.id := t.n_sections;
s.name := name;
s.flags := flags;
END InitSection;
PROCEDURE AddSectSym (t: T; READONLY s: Section) =
VAR z: INTEGER;
BEGIN
IF (s.id <= 0) THEN RETURN; END;
z := NewSym (t, M3ID.Add (s.name));
WITH sym = t.symtab.list[z] DO
sym.kind := SymKind.Section;
sym.offset := s.id;
sym.used := TRUE;
sym.index := -1;
END;
END AddSectSym;
---------------------------------------------------------- construction ---
PROCEDURE SegmentToSection(t: T; s: Seg): UNTRACED REF Section =
BEGIN
IF s = Seg.Text THEN
RETURN ADR(t.text);
ELSE
RETURN ADR(t.data);
END;
END SegmentToSection;
PROCEDURE Cursor (t: T; s: Seg): INTEGER =
BEGIN
RETURN SegmentToSection(t, s).raw_data.n_bytes;
END Cursor;
PROCEDURE AppendIntegerToSegment (t: T; s: Seg; value, length: INTEGER) =
BEGIN
AppendIntegerToSection (SegmentToSection(t, s)^, value, length);
END AppendIntegerToSegment;
PROCEDURE AppendBytesToSegment (t: T; s: Seg; READONLY bytes: ARRAY OF UINT8) =
BEGIN
AppendBytesToSection (SegmentToSection(t, s)^, ADR(bytes[0]), NUMBER(bytes));
END AppendBytesToSegment;
PROCEDURE BackupInSegment (t: T; s: Seg; length: CARDINAL) =
BEGIN
BackupInSection (SegmentToSection(t, s)^, length);
END BackupInSegment;
PROCEDURE AppendBytesToSection (VAR s: Section; value: UNTRACED REF UINT8; length: CARDINAL) =
VAR offs := s.raw_data.n_bytes;
seg := EnsureLength (s.data, offs + length);
BEGIN
FOR i := 0 TO length - 1 DO
seg[offs] := value^;
INC (offs);
INC (value);
END;
<* ASSERT s.raw_data.n_bytes = s.raw_data.cnt *>
s.raw_data.n_bytes := offs;
s.raw_data.cnt := offs;
END AppendBytesToSection;
PROCEDURE AppendIntegerToSection (VAR s: Section; value, length: INTEGER) =
VAR
offs := s.raw_data.n_bytes;
seg := EnsureLength (s.data, offs + length);
BEGIN
WHILE (length > 0) DO
seg[offs] := Word.And (value, 16_FF);
value := Word.RightShift (value, 8);
INC (offs);
DEC (length);
END;
<* ASSERT s.raw_data.n_bytes = s.raw_data.cnt *>
s.raw_data.n_bytes := offs;
s.raw_data.cnt := offs;
END AppendIntegerToSection;
PROCEDURE BackupInSection (VAR s: Section; length: CARDINAL) =
VAR n_bytes := s.raw_data.n_bytes;
BEGIN
<* ASSERT n_bytes >= length *>
<* ASSERT n_bytes = s.raw_data.cnt *>
DEC(s.raw_data.n_bytes, length);
DEC(s.raw_data.cnt, length);
END BackupInSection;
PROCEDURE AddName (VAR s: Section; name: TEXT) =
VAR
len := MIN (Text.Length (name), 255);
offs := s.raw_data.n_bytes;
seg := EnsureLength (s.data, offs + len + 1);
BEGIN
(* add the length prefix byte *)
seg[offs] := Word.And (len, 16_FF);
INC (offs);
(* add the bytes *)
FOR i := 0 TO len - 1 DO
seg[offs] := ORD(Text.GetChar (name, i));
INC (offs);
END;
<* ASSERT s.raw_data.n_bytes = s.raw_data.cnt *>
s.raw_data.n_bytes := offs;
s.raw_data.cnt := offs;
END AddName;
PROCEDURE EnsureLength (VAR b: Bytes; length: INTEGER): Bytes =
VAR n, m: INTEGER;
BEGIN
IF (b = NIL) THEN b := NEW (Bytes, 1024); END;
n := NUMBER (b^);
IF (n < length) THEN
m := n;
WHILE (m < length) DO
INC (m, m);
END;
VAR new := NEW (Bytes, m); BEGIN
SUBARRAY (new^, 0, n) := b^;
b := new;
END;
END;
RETURN b;
END EnsureLength;
PROCEDURE PatchSegment (t: T; s: Seg; offset, value, length: INTEGER) =
BEGIN
PatchSection (SegmentToSection(t, s)^, offset, value, length);
END PatchSegment;
PROCEDURE PatchSection (VAR s: Section; offset, value, length: INTEGER) =
VAR n_bytes := s.raw_data.n_bytes;
BEGIN
<* ASSERT n_bytes = s.raw_data.cnt *>
<* ASSERT n_bytes >= offset + length *>
WHILE (length > 0) DO
s.data[offset] := Word.And (value, 16_FF);
value := Word.RightShift (value, 8);
INC (offset);
DEC (length);
END;
END PatchSection;
PROCEDURE Relocate (t: T; src_sym, src_offs, tar_sym: INTEGER) =
BEGIN
t.symtab.list[src_sym].used := TRUE;
t.symtab.list[tar_sym].used := TRUE;
CASE t.symtab.list[src_sym].kind OF <*NOWARN*>
| SymKind.Text =>
AddReloc (t.text, RelocKind.Symbol, src_sym, src_offs, tar_sym);
| SymKind.Data =>
AddReloc (t.data, RelocKind.Symbol, src_sym, src_offs, tar_sym);
| SymKind.Bss =>
AddReloc (t.bss, RelocKind.Symbol, src_sym, src_offs, tar_sym);
END;
END Relocate;
PROCEDURE AddReloc (VAR s: Section; kind: RelocKind;
src_sym, src_offs, tar_sym: INTEGER) =
BEGIN
IF (s.relocs = NIL) OR (s.relocation.cnt >= NUMBER (s.relocs^)) THEN
ExpandRelocs (s);
END;
WITH r = s.relocs [s.relocation.cnt] DO
r.kind := kind;
r.src_sym := src_sym;
r.src_offset := src_offs;
r.target_sym := tar_sym;
END;
INC (s.relocation.cnt);
INC (s.relocation.n_bytes, RelocSize);
END AddReloc;
PROCEDURE ExpandRelocs (VAR s: Section) =
VAR n: INTEGER; new: RelocList;
BEGIN
IF (s.relocs = NIL) THEN
s.relocs := NEW (RelocList, 100);
ELSE
n := NUMBER (s.relocs^);
new := NEW (RelocList, n + n);
SUBARRAY (new^, 0, n) := s.relocs^;
s.relocs := new;
END;
END ExpandRelocs;
PROCEDURE ImportSymbol (t: T; id: M3ID.T): INTEGER =
VAR z := NewSym (t, id);
BEGIN
WITH sym = t.symtab.list[z] DO
sym.kind := SymKind.Extern;
sym.export := FALSE;
sym.offset := z;
END;
RETURN z;
END ImportSymbol;
PROCEDURE DefineSymbol (t: T; id: M3ID.T; s: Seg; offset: INTEGER): INTEGER=
VAR z := NewSym (t, id);
BEGIN
WITH sym = t.symtab.list[z] DO
sym.kind := SegToKind [s];
sym.offset := offset;
END;
RETURN z;
END DefineSymbol;
PROCEDURE DefineBssSymbol (t: T; id: M3ID.T; size, align: INTEGER): INTEGER=
VAR z := NewSym (t, id); a := FindAlign (align); ab := AlignBytes[a];
BEGIN
(* align the symbol in the segment *)
t.bss.raw_data.n_bytes := (t.bss.raw_data.n_bytes + ab - 1) DIV ab * ab;
WITH sym = t.symtab.list[z] DO
sym.kind := SymKind.Bss;
sym.offset := t.bss.raw_data.n_bytes;
END;
(* add the space to the segment *)
INC (t.bss.raw_data.n_bytes, size);
RETURN z;
END DefineBssSymbol;
PROCEDURE MoveSymbol (t: T; sym: INTEGER; new_offset: INTEGER) =
BEGIN
t.symtab.list[sym].offset := new_offset;
END MoveSymbol;
PROCEDURE ExportSymbol (t: T; sym: INTEGER) =
BEGIN
WITH s = t.symtab.list[sym] DO
s.export := TRUE;
s.used := TRUE;
END;
END ExportSymbol;
PROCEDURE FindAlign (align: INTEGER): Alignment =
BEGIN
FOR i := FIRST (AlignBytes) TO LAST (AlignBytes) DO
IF (AlignBytes[i] = align) THEN
RETURN i;
END;
END;
<*ASSERT FALSE*>
END FindAlign;
PROCEDURE NewSym (t: T; id: M3ID.T): INTEGER =
VAR x: INTEGER;
BEGIN
IF (t.symtab.map = NIL) THEN
t.symtab.map := NEW (IntIntTbl.Default).init();
END;
IF t.symtab.map.get (id, x) THEN
(*duplicate symbol *)
RTError.Msg ("NTObjFile.m3", 534, "duplicate symbol: " & M3ID.ToText (id));
<*ASSERT FALSE*>
END;
x := NextSym (t);
EVAL t.symtab.map.put (id, x);
WITH sym = t.symtab.list[x] DO
sym.id := id;
sym.kind := SymKind.Extern;
sym.index := -1;
END;
RETURN x;
END NewSym;
PROCEDURE NextSym (t: T): INTEGER =
VAR x := t.symtab.chunk.cnt;
BEGIN
INC (t.symtab.chunk.cnt);
INC (t.symtab.chunk.n_bytes, SymTabSize);
IF (t.symtab.list = NIL) OR (x >= NUMBER (t.symtab.list^)) THEN
ExpandSyms(t);
END;
RETURN x;
END NextSym;
PROCEDURE ExpandSyms (t: T) =
VAR n: INTEGER; new: SymbolList;
BEGIN
IF (t.symtab.list = NIL) THEN
t.symtab.list := NEW (SymbolList, 100);
ELSE
n := NUMBER (t.symtab.list^);
new := NEW (SymbolList, n + n);
SUBARRAY (new^, 0, n) := t.symtab.list^;
t.symtab.list := new;
END;
END ExpandSyms;
PROCEDURE SetSourceFile (t: T; filename: TEXT) =
VAR
z : INTEGER;
len := Text.Length (filename);
n_aux := (len + SymTabSize - 1) DIV SymTabSize;
obj : TEXT;
BEGIN
IF (t.filename # NIL) THEN RETURN END;
t.filename := filename;
z := NewSym (t, M3ID.Add (".file"));
t.filesym := z;
WITH sym = t.symtab.list[z] DO
sym.kind := SymKind.File;
sym.offset := n_aux;
sym.used := TRUE;
END;
(* add the auxillary symbols for the filename *)
FOR i := 0 TO n_aux - 1 DO
z := NextSym (t);
WITH sym = t.symtab.list[z] DO
sym.id := M3ID.NoID;
sym.kind := SymKind.FileAux;
sym.offset := i * SymTabSize;
sym.used := TRUE;
END;
END;
IF (t.gen_debugging) THEN
(* add the debugging info *)
obj := ObjectName (filename);
AppendIntegerToSection (t.debug_S, 7 + Text.Length (obj), 2);
AppendIntegerToSection (t.debug_S, S_OBJNAME, 2);
AppendIntegerToSection (t.debug_S, 0, 4); (* checksum for precompiled types *)
AddName (t.debug_S, obj);
END;
END SetSourceFile;
PROCEDURE ObjectName (src: TEXT): TEXT =
VAR
len := Text.Length (src);
last_slash := -1;
ext : TEXT;
ch: CHAR;
BEGIN
(* chop off any path prefix *)
FOR i := 0 TO len - 1 DO
ch := Text.GetChar (src, i);
IF (ch = '/') OR (ch = '\134') THEN
last_slash := i;
END;
END;
INC (last_slash);
src := Text.Sub (src, last_slash);
DEC (len, last_slash);
(* fix the extension *)
IF (len > 3) THEN
ext := Text.Sub (src, len-3);
IF Text.Equal (ext, ".m3") OR Text.Equal (ext, ".i3") THEN
src := Text.Sub (src, 0, len - 1) & "o";
END;
END;
RETURN src;
END ObjectName;
PROCEDURE SetSourceLine (t: T; source_line: INTEGER) =
BEGIN
IF (source_line <= 0) THEN RETURN END;
IF (t.in_procedure) THEN
AddSourceLine (t, t.text.raw_data.n_bytes, source_line);
WITH s = t.symtab.list [t.last_proc] DO
s.first_line := MIN (s.first_line, source_line);
END;
END;
t.last_source_line := source_line;
END SetSourceLine;
PROCEDURE AddSourceLine (t: T; addr, line: INTEGER) =
BEGIN
WITH c = t.text.line_numbers, list = t.text.line_nums DO
IF (list = NIL) OR (c.cnt >= NUMBER (list^)) THEN
ExpandLines (t.text);
END;
IF (line # 0) AND (c.cnt > 0) THEN
WITH last_ln = list[c.cnt - 1] DO
IF (last_ln.line # 0) AND (last_ln.addr = addr) THEN
(* forget the last line number, it's at the same pc *)
DEC (c.cnt);
DEC (c.n_bytes, LineNumSize);
END;
END;
END;
WITH ln = list [c.cnt] DO
ln.addr := addr;
ln.line := line;
END;
INC (c.cnt);
INC (c.n_bytes, LineNumSize);
END;
END AddSourceLine;
PROCEDURE ExpandLines (VAR s: Section) =
VAR n: INTEGER; new: LineNums;
BEGIN
IF (s.line_nums = NIL) THEN
s.line_nums := NEW (LineNums, 100);
ELSE
n := NUMBER (s.line_nums^);
new := NEW (LineNums, n + n);
SUBARRAY (new^, 0, n) := s.line_nums^;
s.line_nums := new;
END;
END ExpandLines;
----------------------------------------------------- debugging support ---
PROCEDURE DeclareTypename (t: T; type: TypeUID; n: Name) =
BEGIN
IF NOT t.gen_debugging THEN RETURN END;
EVAL type; EVAL n;
END DeclareTypename;
PROCEDURE DeclareArray (t: T; type, index, elt: TypeUID; s: BitSize) =
BEGIN
IF NOT t.gen_debugging THEN RETURN END;
EVAL type; EVAL index; EVAL elt; EVAL s;
END DeclareArray;
PROCEDURE DeclareOpenArray (t: T; type, elt: TypeUID; s: BitSize) =
BEGIN
IF NOT t.gen_debugging THEN RETURN END;
EVAL type; EVAL elt; EVAL s;
END DeclareOpenArray;
PROCEDURE DeclareEnum (t: T; type: TypeUID; n_elts: INTEGER; s: BitSize) =
BEGIN
IF NOT t.gen_debugging THEN RETURN END;
EVAL type; EVAL n_elts; EVAL s;
END DeclareEnum;
PROCEDURE DeclareEnumElt (t: T; n: Name) =
BEGIN
IF NOT t.gen_debugging THEN RETURN END;
EVAL n;
END DeclareEnumElt;
PROCEDURE DeclarePacked (t: T; type: TypeUID; s: BitSize; base: TypeUID) =
BEGIN
IF NOT t.gen_debugging THEN RETURN END;
EVAL type; EVAL s; EVAL base;
END DeclarePacked;
PROCEDURE DeclareRecord (t: T; type: TypeUID; s: BitSize; n_fields: INTEGER) =
BEGIN
IF NOT t.gen_debugging THEN RETURN END;
EVAL type; EVAL s; EVAL n_fields;
END DeclareRecord;
PROCEDURE DeclareField (t: T; n: Name; o: BitOffset; s: BitSize; type: TypeUID) =
BEGIN
IF NOT t.gen_debugging THEN RETURN END;
EVAL n; EVAL o; EVAL s; EVAL type;
END DeclareField;
PROCEDURE DeclareSet (t: T; type, domain: TypeUID; s: BitSize) =
BEGIN
IF NOT t.gen_debugging THEN RETURN END;
EVAL type; EVAL domain; EVAL s;
END DeclareSet;
PROCEDURE DeclareSubrange (t: T; type, domain: TypeUID; READONLY min,max: Target.Int;
s: BitSize) =
BEGIN
IF NOT t.gen_debugging THEN RETURN END;
EVAL type; EVAL domain; EVAL min; EVAL max; EVAL s;
END DeclareSubrange;
PROCEDURE DeclarePointer (t: T; type, target: TypeUID; brand: TEXT; traced: BOOLEAN) =
BEGIN
IF NOT t.gen_debugging THEN RETURN END;
EVAL type; EVAL target; EVAL brand; EVAL traced;
END DeclarePointer;
PROCEDURE DeclareIndirect (t: T; type, target: TypeUID) =
BEGIN
IF NOT t.gen_debugging THEN RETURN END;
EVAL type; EVAL target;
END DeclareIndirect;
PROCEDURE DeclareProctype (t: T; type: TypeUID; n_formals: INTEGER;
result: TypeUID; n_raises: INTEGER) =
BEGIN
IF NOT t.gen_debugging THEN RETURN END;
EVAL type; EVAL n_formals; EVAL result; EVAL n_raises;
END DeclareProctype;
PROCEDURE DeclareFormal (t: T; n: Name; type: TypeUID) =
BEGIN
IF NOT t.gen_debugging THEN RETURN END;
EVAL n; EVAL type;
END DeclareFormal;
PROCEDURE DeclareRaises (t: T; n: Name) =
BEGIN
IF NOT t.gen_debugging THEN RETURN END;
EVAL n;
END DeclareRaises;
PROCEDURE DeclareObject (t: T; type, super: TypeUID; brand: TEXT;
traced: BOOLEAN; n_fields, n_methods: INTEGER;
field_size: BitSize) =
BEGIN
IF NOT t.gen_debugging THEN RETURN END;
EVAL type; EVAL super; EVAL brand;
EVAL traced; EVAL n_fields; EVAL n_methods;
EVAL field_size;
END DeclareObject;
PROCEDURE DeclareMethod (t: T; n: Name; signature: TypeUID) =
BEGIN
IF NOT t.gen_debugging THEN RETURN END;
EVAL n; EVAL signature;
END DeclareMethod;
PROCEDURE DeclareOpaque (t: T; type, super: TypeUID) =
BEGIN
IF NOT t.gen_debugging THEN RETURN END;
EVAL type; EVAL super;
END DeclareOpaque;
PROCEDURE RevealOpaque (t: T; lhs, rhs: TypeUID) =
BEGIN
IF NOT t.gen_debugging THEN RETURN END;
EVAL lhs; EVAL rhs;
END RevealOpaque;
PROCEDURE DeclareException (t: T; sym: INTEGER; arg_type: TypeUID;
raise_proc: BOOLEAN) =
BEGIN
IF NOT t.gen_debugging THEN RETURN END;
EVAL sym; EVAL arg_type; EVAL raise_proc;
END DeclareException;
PROCEDURE DeclareGlobal (t: T; sym: INTEGER; s: ByteSize; m3t: TypeUID) =
BEGIN
IF NOT t.gen_debugging THEN RETURN END;
EVAL sym; EVAL s; EVAL m3t;
END DeclareGlobal;
PROCEDURE DeclareConstant (t: T; sym: INTEGER; s: ByteSize; m3t: TypeUID) =
BEGIN
IF NOT t.gen_debugging THEN RETURN END;
EVAL sym; EVAL s; EVAL m3t;
END DeclareConstant;
PROCEDURE DeclareLocal (t: T; n: Name; s: ByteSize; frame: ByteOffset;
m3t: TypeUID) =
BEGIN
IF NOT t.gen_debugging THEN RETURN END;
EVAL n; EVAL s; EVAL frame; EVAL m3t;
END DeclareLocal;
PROCEDURE DeclareParam (t: T; n: Name; s: ByteSize; frame: ByteOffset;
m3t: TypeUID) =
BEGIN
IF NOT t.gen_debugging THEN RETURN END;
EVAL n; EVAL s; EVAL frame; EVAL m3t;
END DeclareParam;
PROCEDURE DeclareProcedure (t: T; sym: INTEGER; n_params: INTEGER;
nested, exported: BOOLEAN) =
BEGIN
IF NOT t.gen_debugging THEN RETURN END;
EVAL sym; EVAL n_params; EVAL nested; EVAL exported;
END DeclareProcedure;
PROCEDURE BeginProcedure (t: T; sym: INTEGER) =
BEGIN
<*ASSERT NOT t.in_procedure*>
t.in_procedure := TRUE;
t.last_source_line := t.last_source_line;
WITH s = t.symtab.list[sym] DO
<*ASSERT s.first_line = 0*>
s.first_line := t.last_source_line;
s.lineno_offs := t.text.line_numbers.n_bytes;
s.lineno_cnt := t.text.line_numbers.cnt;
s.used := TRUE;
END;
AddSourceLine (t, sym, 0);
AddSourceLine (t, t.text.raw_data.n_bytes, t.last_source_line);
IF (t.last_proc = 0) THEN
t.first_proc := sym;
ELSE
t.symtab.list [t.last_proc].next_func := sym;
END;
t.last_proc := sym;
END BeginProcedure;
PROCEDURE EndProcedure (t: T; sym: INTEGER) =
VAR
export : BOOLEAN;
procname : TEXT;
code_len : INTEGER;
reloc_offs : INTEGER;
BEGIN
<*ASSERT t.in_procedure*>
WITH s = t.symtab.list [sym] DO
s.last_offset := t.text.raw_data.n_bytes;
s.last_line := t.last_source_line;
s.lineno_cnt := t.text.line_numbers.cnt - s.lineno_cnt;
export := s.export;
procname := M3ID.ToText (s.id);
code_len := s.last_offset - s.offset;
END;
t.in_procedure := FALSE;
IF NOT t.gen_debugging THEN RETURN END;
(* generate a fake debugging entry *)
AppendIntegerToSection (t.debug_S, 36 + Text.Length (procname), 2);
AppendIntegerToSection (t.debug_S, ProcTag [export], 2);
AppendIntegerToSection (t.debug_S, 0, 4); (* pParent *)
AppendIntegerToSection (t.debug_S, 0, 4); (* pEnd *)
AppendIntegerToSection (t.debug_S, 0, 4); (* pNext *)
AppendIntegerToSection (t.debug_S, code_len, 4);
AppendIntegerToSection (t.debug_S, PrologueLength, 4);
AppendIntegerToSection (t.debug_S, code_len - EpilogueLength, 4);
reloc_offs := t.debug_S.raw_data.n_bytes;
AppendIntegerToSection (t.debug_S, 0, 4); (* procedure offset *)
AppendIntegerToSection (t.debug_S, 0, 2); (* procedure segment *)
AppendIntegerToSection (t.debug_S, 16_104, 2); (* type = proc():INTEGER; HACK! *)
AppendIntegerToSection (t.debug_S, 0, 1); (* flags = {} *)
AddName (t.debug_S, procname);
(* relocate the offset and segment *)
AddReloc (t.debug_S, RelocKind.Offset, 0, reloc_offs, sym);
AddReloc (t.debug_S, RelocKind.Segment, 0, reloc_offs+4, sym);
(* generate the matching end *)
AppendIntegerToSection (t.debug_S, 2, 2);
AppendIntegerToSection (t.debug_S, S_END, 2);
END EndProcedure;
PROCEDURE BeginBlock (t: T) =
BEGIN
IF NOT t.gen_debugging THEN RETURN END;
END BeginBlock;
PROCEDURE EndBlock (t: T) =
BEGIN
IF NOT t.gen_debugging THEN RETURN END;
END EndBlock;
PROCEDURE NoteProcedureOrigin (t: T; sym: INTEGER) =
BEGIN
IF NOT t.gen_debugging THEN RETURN END;
EVAL sym;
END NoteProcedureOrigin;
---------------------------------------------------------------- output ---
PROCEDURE Dump (t: T; wr: Wr.T) =
VAR
now := CoffTime.Now ();
file_offset : INTEGER;
cur_virtual : INTEGER;
n_symbols : INTEGER;
BEGIN
t.out.wr := wr;
IF (t.gen_debugging) THEN
(* add a final debugging entry that identifies the compiler *)
AppendIntegerToSection (t.debug_S, 7 + Text.Length (CompilerName), 2);
AppendIntegerToSection (t.debug_S, S_COMPILE, 2);
AppendIntegerToSection (t.debug_S, 4, 1); (* Intel 486 *)
AppendIntegerToSection (t.debug_S, 0, 3); (* lang=C, near data & code, hardware FP *)
AddName (t.debug_S, CompilerName);
END;
n_symbols := ReorderSymbols (t);
(* initialize a fresh string space *)
WITH s = t.strings DO
s.cnt := 0;
s.n_bytes := 4; (* leave room for the count *)
s.map := NEW (TextIntTbl.Default).init ();
IF (s.list = NIL) THEN
s.list := NEW (TextList, 100);
END;
END;
(* compute the file and address space layouts *)
file_offset := HeaderSize + t.n_sections * SectionSize;
cur_virtual := 0;
LayoutSection (t.debug_S, file_offset, cur_virtual);
LayoutSection (t.text, file_offset, cur_virtual);
LayoutSection (t.data, file_offset, cur_virtual);
LayoutSection (t.bss, file_offset, cur_virtual);
LayoutSection (t.debug_T, file_offset, cur_virtual);
LayoutChunk (t.symtab.chunk, file_offset, t.symtab.list);
(* write the file header *)
Out16 (t, 16_14C); (* == Intel 386 *)
Out16 (t, t.n_sections);
Out32 (t, now);
Out32 (t, t.symtab.chunk.file_offset);
Out32 (t, t.symtab.chunk.cnt);
Out16 (t, 0); (* size of optional header *)
Out16 (t, 0); (* flags => +reloc, -exec, +lineno, +locals *)
WriteSectionHeader (t, t.debug_S);
WriteSectionHeader (t, t.text);
WriteSectionHeader (t, t.data);
WriteSectionHeader (t, t.bss);
WriteSectionHeader (t, t.debug_T);
WriteSection (t, t.debug_S);
WriteSection (t, t.text);
WriteSection (t, t.data);
WriteSection (t, t.bss);
WriteSection (t, t.debug_T);
WriteSymbols (t, n_symbols);
WriteStrings (t);
Flush (t);
t.out.wr := NIL; (* give the collector a chance... *)
END Dump;
PROCEDURE ReorderSymbols (t: T): INTEGER =
VAR next_index := 0; next_remap := 0; p: INTEGER;
BEGIN
t.symtab.remap := NEW (Ints, t.symtab.chunk.cnt);
IF (t.filename # NIL) THEN
SetSym (t, t.filesym, next_index, next_remap);
FOR i := 1 TO t.symtab.list[t.filesym].offset DO
SetSym (t, t.filesym + i, next_index, next_remap);
END;
END;
(* set the section number symbols *)
FOR i := 0 TO 9 DO
WITH sym = t.symtab.list[i] DO
IF (sym.kind = SymKind.Section) AND (sym.used) AND (sym.index < 0) THEN
SetSym (t, i, next_index, next_remap);
END;
END;
END;
(* set the symbols for procedures with bodies (in object file order) *)
p := t.first_proc;
WHILE (p # 0) DO
WITH sym = t.symtab.list[p] DO
IF (sym.used) AND (sym.index < 0) THEN
SetSym (t, p, next_index, next_remap);
END;
p := sym.next_func;
END;
END;
(* set the remaining symbols *)
FOR i := 0 TO t.symtab.chunk.cnt - 1 DO
WITH sym = t.symtab.list[i] DO
IF (sym.used) AND (sym.index < 0) THEN
SetSym (t, i, next_index, next_remap);
END;
END;
END;
t.symtab.chunk.cnt := next_index;
RETURN next_remap;
END ReorderSymbols;
PROCEDURE SetSym (t: T; old: INTEGER; VAR next_sym, next_remap: INTEGER) =
BEGIN
WITH sym = t.symtab.list[old] DO
sym.index := next_sym; INC (next_sym);
t.symtab.remap[next_remap] := old; INC (next_remap);
CASE sym.kind OF
| SymKind.Text => IF (sym.first_line # 0) THEN INC (next_sym, 6); END;
| SymKind.Section => INC (next_sym); (* 1 aux symbol *)
ELSE (* skip *)
END;
END;
END SetSym;
PROCEDURE LayoutSection (VAR s: Section; VAR offs, addr: INTEGER) =
BEGIN
IF (s.id <= 0) THEN RETURN END;
s.address := addr; INC (addr, s.raw_data.n_bytes);
LayoutChunk (s.raw_data, offs, s.data);
LayoutChunk (s.relocation, offs, s.relocs);
LayoutChunk (s.line_numbers, offs, s.line_nums);
END LayoutSection;
PROCEDURE LayoutChunk (VAR c: Chunk; VAR offs: INTEGER; data: REFANY) =
BEGIN
IF (c.n_bytes > 0) AND (data # NIL) THEN
c.file_offset := offs;
INC (offs, c.n_bytes);
ELSE
c.file_offset := 0;
END;
END LayoutChunk;
PROCEDURE WriteSectionHeader (t: T; VAR s: Section) =
BEGIN
IF (s.id <= 0) THEN RETURN END;
OutN (t, s.name);
Out32 (t, s.address); (* physical address *)
Out32 (t, 0); (* virtual address *)
Out32 (t, s.raw_data.n_bytes);
Out32 (t, s.raw_data.file_offset);
Out32 (t, s.relocation.file_offset);
Out32 (t, s.line_numbers.file_offset);
Out16 (t, s.relocation.cnt);
Out16 (t, s.line_numbers.cnt);
Out32 (t, s.flags);
END WriteSectionHeader;
PROCEDURE WriteSection (t: T; VAR s: Section) =
VAR base_line: INTEGER;
BEGIN
IF (s.id <= 0) THEN RETURN END;
(* raw data *)
IF (s.data # NIL) THEN
FOR i := 0 TO s.raw_data.n_bytes - 1 DO
Out8 (t, s.data[i]);
END;
END;
(* relocation info *)
FOR i := 0 TO s.relocation.cnt - 1 DO
WITH r = s.relocs[i] DO
CASE r.kind OF
| RelocKind.Symbol =>
Out32 (t, r.src_offset + t.symtab.list[r.src_sym].offset);
Out32 (t, t.symtab.list[r.target_sym].index);
Out16 (t, REL_I386_DIR32); (* 32-bit direct relocation *)
| RelocKind.Offset =>
Out32 (t, r.src_offset);
Out32 (t, t.symtab.list[r.target_sym].index);
Out16 (t, REL_I386_SECREL); (* section offset *)
| RelocKind.Segment =>
Out32 (t, r.src_offset);
Out32 (t, t.symtab.list[r.target_sym].index);
Out16 (t, REL_I386_SECTION); (* section id *)
END;
END;
END;
(* line numbers *)
base_line := 0;
FOR i := 0 TO s.line_numbers.cnt - 1 DO
WITH ln = s.line_nums[i] DO
IF (ln.line = 0) THEN
WITH sym = t.symtab.list[ln.addr] DO
base_line := sym.first_line - 1;
Out32 (t, sym.index);
Out16 (t, 0);
END;
ELSE
Out32 (t, ln.addr);
Out16 (t, ln.line - base_line);
END;
END;
END;
END WriteSection;
PROCEDURE WriteSymbols (t: T; n_symbols: INTEGER) =
BEGIN
WITH s = t.symtab DO
FOR i := 0 TO n_symbols - 1 DO
WriteSym (t, s.list [t.symtab.remap [i]]);
END;
END;
END WriteSymbols;
PROCEDURE WriteSym (t: T; READONLY sym: Symbol) =
CONST SClass = ARRAY BOOLEAN OF INTEGER { 3, 2 };
VAR next_func: INTEGER; has_body: BOOLEAN;
BEGIN
CASE sym.kind OF
| SymKind.Text =>
has_body := (sym.first_line # 0);
OutN (t, M3ID.ToText (sym.id));
Out32 (t, sym.offset);
Out16 (t, t.text.id); (* section = Text *)
IF (has_body) THEN
Out16 (t, 16_20); (* type = function *)
Out8 (t, SClass [TRUE]);
(* storage class = static/extern *)
Out8 (t, 1); (* #aux = 1 *)
ELSE
Out16 (t, 0); (* type = no type *)
Out8 (t, SClass [sym.export]);
(* storage class = static/extern *)
Out8 (t, 0); (* #aux = 0 *)
END;
(** HACK: We make all procedures with source lines external so
they show up in windbg call stacks. When we generate full
CodeView debugging info, we can probably remove the hack. **)
IF (has_body) THEN
next_func := 0;
IF (sym.next_func # 0) THEN
next_func := t.symtab.list [sym.next_func].index;
END;
(* function definiton auxillary info *)
Out32 (t, sym.index + 2); (* pointer to ".bf" entry *)
Out32 (t, sym.last_offset - sym.offset); (* size of code *)
Out32 (t, t.text.line_numbers.file_offset + sym.lineno_offs);
(* pointer into line number table *)
Out32 (t, next_func); (* pointer to next function *)
Out16 (t, 0); (* unused *)
(* ".bf" entry *)
OutN (t, ".bf");
Out32 (t, sym.offset); (* initial pc *)
Out16 (t, t.text.id); (* section = Text *)
Out16 (t, 0); (* type = none *)
Out16 (t, 101 + 256); (* class = function, #aux = 1 *)
(* ".bf" aux entry *)
Out32 (t, 0); (* unused *)
Out16 (t, sym.first_line - 1); (* actual source line number *)
Out32 (t, 0); (* unused *)
Out16 (t, 0); (* unused *)
IF (next_func # 0) (* next ".bf" entry *)
THEN Out32 (t, next_func + 2);
ELSE Out32 (t, 0);
END;
Out16 (t, 0); (* unused *)
(* ".lf" entry *)
OutN (t, ".lf");
(***
Out32 (t, sym.last_line - sym.first_line + 1); (* # source lines *)
***)
Out32 (t, sym.lineno_cnt); (* # line number entries *)
Out16 (t, t.text.id); (* section = Text *)
Out16 (t, 0); (* type = none *)
Out16 (t, 101); (* class = function, #aux = 0 *)
(* ".ef" entry *)
OutN (t, ".ef");
Out32 (t, sym.last_offset); (* final pc *)
Out16 (t, t.text.id); (* section = Text *)
Out16 (t, 0); (* type = none *)
Out16 (t, 101 + 256); (* class = function, #aux = 1 *)
(* ".ef" aux entry *)
Out32 (t, 0); (* unused *)
Out16 (t, sym.last_line); (* actual source line number *)
Out32 (t, 0); (* unused *)
Out16 (t, 0); (* unused *)
Out32 (t, 0); (* unused *)
Out16 (t, 0); (* unused *)
END;
| SymKind.Data =>
OutN (t, M3ID.ToText (sym.id));
Out32 (t, sym.offset);
Out16 (t, t.data.id); (* section = Data *)
Out16 (t, 0); (* type = no type *)
Out16 (t, SClass [sym.export]);
(* storage class = static/extern, #aux = 0 *)
| SymKind.Bss =>
OutN (t, M3ID.ToText (sym.id));
Out32 (t, sym.offset);
Out16 (t, t.bss.id); (* section = bss *)
Out16 (t, 0); (* type = no type *)
Out16 (t, SClass [sym.export]);
(* storage class = static/extern, #aux = 0 *)
| SymKind.Extern =>
OutN (t, M3ID.ToText (sym.id));
Out32 (t, 0); (* value = 0 *)
Out16 (t, 0); (* section = extern *)
Out16 (t, 0); (* type = no type *)
Out16 (t, 2); (* storage class = extern, #aux = 0 *)
| SymKind.File =>
OutN (t, ".file");
Out32 (t, 0); (* value = 0 *)
Out16 (t, -2); (* section = debug *)
Out16 (t, 0); (* type = no type *)
Out8 (t, ORD('\147')); (* storage class = file *)
Out8 (t, sym.offset); (* #aux *)
| SymKind.FileAux =>
VAR
name := t.filename;
len := Text.Length (name);
start := sym.offset;
stop := MIN (start + SymTabSize, len);
BEGIN
FOR i := start TO stop - 1 DO
OutPathChar (t, Text.GetChar (name, i));
END;
FOR i := stop TO start + SymTabSize - 1 DO
Out8 (t, 0);
END;
END;
| SymKind.Section =>
OutN (t, M3ID.ToText (sym.id));
Out32 (t, 0); (* value = 0 *)
Out16 (t, sym.offset); (* section # *)
Out16 (t, 0); (* type = no type *)
Out8 (t, 3); (* storage class = static *)
Out8 (t, 1); (* #aux = 1*)
IF (sym.offset = t.debug_S.id) THEN WriteSectAux (t, t.debug_S);
ELSIF (sym.offset = t.text.id) THEN WriteSectAux (t, t.text);
ELSIF (sym.offset = t.data.id) THEN WriteSectAux (t, t.data);
ELSIF (sym.offset = t.bss.id) THEN WriteSectAux (t, t.bss);
ELSIF (sym.offset = t.debug_T.id) THEN WriteSectAux (t, t.debug_T);
END;
END;
END WriteSym;
PROCEDURE WriteSectAux (t: T; READONLY s: Section) =
BEGIN
<*ASSERT s.id > 0 *>
Out32 (t, s.raw_data.n_bytes);
Out16 (t, s.relocation.cnt);
Out16 (t, s.line_numbers.cnt);
Out32 (t, 0); (* checksum *)
Out16 (t, 0); (*** s.id -- Microsoft C compiler generates zero *****)
Out32 (t, 0); (* unused *)
END WriteSectAux;
PROCEDURE WriteStrings (t: T) =
BEGIN
WITH s = t.strings DO
IF (s.cnt = 0) THEN Out32 (t, 0); RETURN; END;
Out32 (t, s.n_bytes);
FOR i := 0 TO s.cnt - 1 DO
OutT (t, s.list[i]);
Out8 (t, 0);
END;
END;
END WriteStrings;
--------------------------------------------- low-level output routines ---
PROCEDURE OutN (t: T; nm: TEXT) =
(* writes an 8-byte name *)
VAR len := Text.Length (nm);
BEGIN
IF (len <= 8) THEN
FOR i := 0 TO len - 1 DO
Out8 (t, ORD(Text.GetChar (nm, i)));
END;
FOR i := len TO 7 DO
Out8 (t, 0);
END;
ELSE
Out32 (t, 0);
Out32 (t, AddString (t, nm));
END;
END OutN;
PROCEDURE Out32 (t: T; i: INTEGER) =
BEGIN
FOR j := 0 TO 3 DO
Out8 (t, Word.And (i, 16_FF));
i := Word.RightShift (i, 8);
END;
END Out32;
PROCEDURE Out16 (t: T; i: INTEGER) =
BEGIN
FOR j := 0 TO 1 DO
Out8 (t, Word.And (i, 16_FF));
i := Word.RightShift (i, 8);
END;
END Out16;
PROCEDURE OutT (t: T; txt: TEXT) =
VAR len := Text.Length (txt);
BEGIN
FOR i := 0 TO len - 1 DO
Out8 (t, ORD(Text.GetChar (txt, i)));
END;
END OutT;
PROCEDURE OutPathChar (t: T; c: CHAR) =
(* convert Unix path name characters to NT characters *)
BEGIN
IF (c = '/') THEN
c := '\134'; (* backward slash *)
END;
Out8 (t, ORD(c));
END OutPathChar;
PROCEDURE Out8 (t: T; c: UINT8) =
BEGIN
IF (t.out.len >= NUMBER (t.out.buf)) THEN Flush (t); END;
t.out.buf [t.out.len] := c;
INC (t.out.len);
END Out8;
PROCEDURE Flush (t: T) =
<*FATAL ANY*>
BEGIN
Wr.PutString (t.out.wr, SUBARRAY (LOOPHOLE(t.out.buf, ARRAY OF CHAR), 0, t.out.len));
t.out.len := 0;
END Flush;
PROCEDURE AddString (t: T; txt: TEXT): INTEGER =
VAR offset: INTEGER;
BEGIN
WITH s = t.strings DO
IF NOT s.map.get (txt, offset) THEN
offset := s.n_bytes;
INC (s.n_bytes, 1 + Text.Length (txt));
EVAL s.map.put (txt, offset);
IF (s.list = NIL) OR (s.cnt >= NUMBER (s.list^)) THEN
ExpandStrings (s);
END;
s.list[s.cnt] := txt;
INC (s.cnt);
END;
END;
RETURN offset;
END AddString;
PROCEDURE ExpandStrings (VAR s: StringTable) =
VAR n: INTEGER; new: TextList;
BEGIN
IF (s.list = NIL) THEN
s.list := NEW (TextList, 100);
ELSE
n := NUMBER (s.list^);
new := NEW (TextList, n+n);
SUBARRAY (new^, 0, n) := s.list^;
s.list := new;
END;
END ExpandStrings;
BEGIN
END NTObjFile.