UNSAFE MODULE; 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; NTObjFile
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---------------------------------------------------------- construction ---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; PROCEDUREInitSection (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; PROCEDUREAddSectSym (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;
PROCEDURE----------------------------------------------------- debugging support ---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; PROCEDURECursor (t: T; s: Seg): INTEGER = BEGIN RETURN SegmentToSection(t, s).raw_data.n_bytes; END Cursor; PROCEDUREAppendIntegerToSegment (t: T; s: Seg; value, length: INTEGER) = BEGIN AppendIntegerToSection (SegmentToSection(t, s)^, value, length); END AppendIntegerToSegment; PROCEDUREAppendBytesToSegment (t: T; s: Seg; READONLY bytes: ARRAY OF UINT8) = BEGIN AppendBytesToSection (SegmentToSection(t, s)^, ADR(bytes[0]), NUMBER(bytes)); END AppendBytesToSegment; PROCEDUREBackupInSegment (t: T; s: Seg; length: CARDINAL) = BEGIN BackupInSection (SegmentToSection(t, s)^, length); END BackupInSegment; PROCEDUREAppendBytesToSection (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; PROCEDUREAppendIntegerToSection (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; PROCEDUREBackupInSection (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; PROCEDUREAddName (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; PROCEDUREEnsureLength (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; PROCEDUREPatchSegment (t: T; s: Seg; offset, value, length: INTEGER) = BEGIN PatchSection (SegmentToSection(t, s)^, offset, value, length); END PatchSegment; PROCEDUREPatchSection (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; PROCEDURERelocate (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; PROCEDUREAddReloc (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; PROCEDUREExpandRelocs (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; PROCEDUREImportSymbol (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; PROCEDUREDefineSymbol (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; PROCEDUREDefineBssSymbol (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; PROCEDUREMoveSymbol (t: T; sym: INTEGER; new_offset: INTEGER) = BEGIN t.symtab.list[sym].offset := new_offset; END MoveSymbol; PROCEDUREExportSymbol (t: T; sym: INTEGER) = BEGIN WITH s = t.symtab.list[sym] DO s.export := TRUE; s.used := TRUE; END; END ExportSymbol; PROCEDUREFindAlign (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; PROCEDURENewSym (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; PROCEDURENextSym (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; PROCEDUREExpandSyms (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; PROCEDURESetSourceFile (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; PROCEDUREObjectName (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; PROCEDURESetSourceLine (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; PROCEDUREAddSourceLine (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; PROCEDUREExpandLines (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;
PROCEDURE---------------------------------------------------------------- output ---DeclareTypename (t: T; type: TypeUID; n: Name) = BEGIN IF NOT t.gen_debugging THEN RETURN END; EVAL type; EVAL n; END DeclareTypename; PROCEDUREDeclareArray (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; PROCEDUREDeclareOpenArray (t: T; type, elt: TypeUID; s: BitSize) = BEGIN IF NOT t.gen_debugging THEN RETURN END; EVAL type; EVAL elt; EVAL s; END DeclareOpenArray; PROCEDUREDeclareEnum (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; PROCEDUREDeclareEnumElt (t: T; n: Name) = BEGIN IF NOT t.gen_debugging THEN RETURN END; EVAL n; END DeclareEnumElt; PROCEDUREDeclarePacked (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; PROCEDUREDeclareRecord (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; PROCEDUREDeclareField (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; PROCEDUREDeclareSet (t: T; type, domain: TypeUID; s: BitSize) = BEGIN IF NOT t.gen_debugging THEN RETURN END; EVAL type; EVAL domain; EVAL s; END DeclareSet; PROCEDUREDeclareSubrange (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; PROCEDUREDeclarePointer (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; PROCEDUREDeclareIndirect (t: T; type, target: TypeUID) = BEGIN IF NOT t.gen_debugging THEN RETURN END; EVAL type; EVAL target; END DeclareIndirect; PROCEDUREDeclareProctype (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; PROCEDUREDeclareFormal (t: T; n: Name; type: TypeUID) = BEGIN IF NOT t.gen_debugging THEN RETURN END; EVAL n; EVAL type; END DeclareFormal; PROCEDUREDeclareRaises (t: T; n: Name) = BEGIN IF NOT t.gen_debugging THEN RETURN END; EVAL n; END DeclareRaises; PROCEDUREDeclareObject (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; PROCEDUREDeclareMethod (t: T; n: Name; signature: TypeUID) = BEGIN IF NOT t.gen_debugging THEN RETURN END; EVAL n; EVAL signature; END DeclareMethod; PROCEDUREDeclareOpaque (t: T; type, super: TypeUID) = BEGIN IF NOT t.gen_debugging THEN RETURN END; EVAL type; EVAL super; END DeclareOpaque; PROCEDURERevealOpaque (t: T; lhs, rhs: TypeUID) = BEGIN IF NOT t.gen_debugging THEN RETURN END; EVAL lhs; EVAL rhs; END RevealOpaque; PROCEDUREDeclareException (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; PROCEDUREDeclareGlobal (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; PROCEDUREDeclareConstant (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; PROCEDUREDeclareLocal (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; PROCEDUREDeclareParam (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; PROCEDUREDeclareProcedure (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; PROCEDUREBeginProcedure (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; PROCEDUREEndProcedure (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; PROCEDUREBeginBlock (t: T) = BEGIN IF NOT t.gen_debugging THEN RETURN END; END BeginBlock; PROCEDUREEndBlock (t: T) = BEGIN IF NOT t.gen_debugging THEN RETURN END; END EndBlock; PROCEDURENoteProcedureOrigin (t: T; sym: INTEGER) = BEGIN IF NOT t.gen_debugging THEN RETURN END; EVAL sym; END NoteProcedureOrigin;
PROCEDURE--------------------------------------------- low-level output routines ---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; PROCEDUREReorderSymbols (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; PROCEDURESetSym (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; PROCEDURELayoutSection (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; PROCEDURELayoutChunk (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; PROCEDUREWriteSectionHeader (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; PROCEDUREWriteSection (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; PROCEDUREWriteSymbols (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; PROCEDUREWriteSym (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; PROCEDUREWriteSectAux (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; PROCEDUREWriteStrings (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;
PROCEDUREOutN (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; PROCEDUREOut32 (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; PROCEDUREOut16 (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; PROCEDUREOutT (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; PROCEDUREOutPathChar (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; PROCEDUREOut8 (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; PROCEDUREFlush (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; PROCEDUREAddString (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; PROCEDUREExpandStrings (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.