Syntax10.Scn.FntSyntax10b.Scn.FntInfoElemsAllocUSyntax10.Scn.FntpdIStampElemsAlloc2 Sep 99!"Title": RefInfo "Author": Christoph Steindl (CS) "Abstract": provides access to the full reference information stored in object files. "Keywords": reference information "Version": 1.0 "From": 12.02.96 10:30:10 "Until":  "Changes": no changes "Hints": AHistoryElemsNewHistory1Syntax10.Scn.Fnt9m<16: r.Type() on VarPar-Record returns the static type if r is not on data 17: r.Zoom on Proc (non data) corrected. r.endpc correctly set in OpenProc 18: r.Type() returns NIL for PTR TO ARRAY and SYSTEM.PTR r.Zoom on SYSTEM.PTR return r.form = None, r.mode = End 19: if r.mode=Frame then r.lenAdr = static link or 0Syntax10i.Scn.FntStampElemsAlloc2 Sep 998FoldElemsNewSyntax10.Scn.FntSyntax10b.Scn.Fnt ZParcElemsAlloc  Z  Syntax10i.Scn.FntA#@@ Z;g Z  - Z%t Z  # $ *'ukM/L8F&L5Fe~(* Objectfile Format Suffixes 32 32 bit value (signed) 16 16 bit value (signed) 8 8 bit value (signed) U16 16 bit value (unsigned) Num in the portable compactified integer format supported by Files.ReadNum and Files.WriteNum. String zero-terminated string EBNF ObjectFile = Header VarEntries Entries Commands Pointers Imports DataLinks Links Consts Code Types References. Header = ObjectTag Version refSize32 nofDataEntries16 nofEntries16 nofCommands16 nofPointers16 nofTypes16 nofImports16 nofDataLinks16 nofLinks16 dataSize32 constSize16 codeSizeU16 key32 modulenameString. (* dataSize, constSize, and codeSize in bytes *) VarEntries = VarEntryTag {varEntryOffset32}. (* nofDataEntries times *) Entries = EntryTag {entryU16}. (* nofEntries times *) Commands = CommandTag {Command}. Command = nameString entryU16. (* nofCommands times *) Pointers = PointerTag {offset32}. (* nofPointers times *) Imports = ImportTag {Import}. (* nofImports times *) Import = key32 nameString. DataLinks = DataLinkTag {DataLink}. (* nofDataLinks times *) DataLink = moduleNumber8 entryNumber16 nofFixups16 {offsetU16}. (* nofFixups times, moduleNumber refers to the modules in the import list, where the first imported module is number 1. The number 0 is the compiled module itself. The following entry is predefined: modulenumber entrynumber meaning 00 0FFFFH global variables and constants in the compiled module *) Links = LinkTag {Link}. (* nofLinks times *) Link = moduleNumber8 entryNumber8 linkU16. (* moduleNumber refers to the modules in the import list, where the first imported module is number 1. The number 0 is the compiled module itself. Five entry-numbers are predefined:module# entrynumber meaning 00 255 (0FFH) case table fixup in the constant area. Insert absolute address! 00 254 (0FEH) local procedure assignment. Insert absolute address! 00 253 (0FDH) Kernel.New: NEW (pointer to record) 00 252 (0FCH) Kernel.NewSys: SYSTEM.NEW (pointer, nofBytes) 00 251 (0FBH) Kernel.NewArr: NEW (pointer to array of Type, dim0, ..., dimn-1 ) *)  Consts = ConstTag {byte8}. (* constSize times *) Code = CodeTag {byte8}. (* codeSize times *) Types = TypeTag {Type}. Type = recordSize32 typeDescEntryNr16 baseTypeMod16 baseTypeEntryNr16 nofMethods16 nofInheritedMethods16 nofNewMethods16 nofPointers16 nameString {NewMethod} {pointerOffset32}. (* nofNewMethods, nofPointers times *) (* baseTypeMod and baseTypeEntryNr refer to the module in which the base type is declared and the entrynumber of that type, respectively. The number 0FFFFH (-1) is used if the type does not have a base type. *) NewMethod = methodNr16 entryNr16. References = ReferenceTag {Procedure} {Record}. (* refSize bytes *) Procedure = ProcTag offsetNum nameString {Variable}. (* offsetNum is in the portable compactified integer format supported by Files.ReadNum and Files.WriteNum. The name $$ identifies the body of a module (offsetNum = 0). *) Variable = (VarTag | VarParTag) Object. (* offsetNum is in the portable compactified integer format supported by Files.ReadNum and Files.WriteNum. *) Object = nameString offsetNum Typ. Typ = ProcTyp | BasicTyp | ArrayTyp | RecordTyp | DynArrTyp. ProcTyp = ProcTypTag fingerPrintNum | LIntTag. (* procedures with the sysflag set are handled as longints (the address of the first instruction...) *) BasicTyp = ByteTag | BoolTag | CharTag | SIntTag | IntTag | LIntTag | RealTag | LRealTag | SetTag | StringTag | NilTypTag | NoTypTag | PointerTag Typ. (* Typ is the reference information of type that the pointer points to *) ArrayTyp = CompTag nofElemsNum elemSizeNum Typ. (* Typ is the reference information for the type of an array element *) RecordTyp = RecordTag moduleNumber8 typeDescEntryNrNum. (* typeDescEntryNr is an index in the modules varEntries table *) DynArrTyp = DynArrTag elemSizeNum Typ. (* Typ is the reference information for the type of an array element *) Record = RecordTag typeDescEntryNrNum typeName {Field} 0H8. (* typeDescEntryNr is an index in the modules varEntries table *) Field = Object. ObjectTag = 0F8H8. Version = 036H8. VarEntryTag = 08CH8. EntryTag = 082H8. CommandTag = 083H8. PointerTag = 084H8. ImportTag = 085H8. DataLinkTag = 08DH8. LinkTag = 086H8. ConstTag = 087H8. CodeTag = 088H8. TypeTag = 089H8. ReferenceTag = 08BH8. ProcTag = 0F8H8. RecordTag = 0F7H8. VarTag = 1H8. VarParTag = 2H8. ByteTag = 1H8. BoolTag = 2H8. CharTag = 3H8. SIntTag = 4H8. IntTag = 5H8. LIntTag = 6H8. RealTag = 7H8. LRealTag = 8H8. SetTag = 9H8. StringTag = 0AH8. NilTypTag = 0BH8. NoTypTag = 0CH8. PointerTag = 0DH8. ProcTypTag = 0EH8. CompTag = 0FH8. RecordTag = 010H8. DynArrTag = 011H8. *)48 ZParcElemsAlloc pVersionElemsAllocBeg#Syntax10.Scn.Fnt Windows LinuxLinuxWindows#Syntax10.Scn.FntWin32Linux pVersionElemsAllocEnd 81Syntax10.Scn.FntSyntax10b.Scn.Fnt   None* = 0; Byte* = 1; Bool* = 2; Char* = 3; SInt* = 4; Int* = 5; LInt* = 6; Real* = 7; LReal* = 8; Set* = 9; String* = 10; NilTyp* = 11; NoTyp* = 12; Pointer* = 13; Procedure* = 14; Array* = 15; Record* = 16; DynArr* = 17; 88Syntax10i.Scn.FntSyntax10.Scn.FntSyntax10b.Scn.Fnt[ Var* = 1; VarPar* = 2; Elem* = 3; Fld* = 4; Frame* = 5; Proc* = 6; Type* = 7; End* = 0; 8 8<Syntax10i.Scn.FntSyntax10.Scn.Fnt$% ProcTag = 0F8X; RecordTag = 0F7X; 8 r8_Syntax10.Scn.FntSyntax10b.Scn.Fnt 0 internal* = 0; external* = 1; externalR* = 2; 88FSyntax10.Scn.FntSyntax10b.Scn.Fnt Syntax10i.Scn.Fnt- 9>+ "     3  d8FoldElemsNewSyntax10.Scn.FntSyntax10i.Scn.FntParcElemsAllocL\L@KeplerElemsAllocKeplerGraphsGraphDescKeplerGraphsStarDescyy~~~~{{{{||{{{{~~~~~{{{yyzzyyyyKepler1AttrDesc   KeplerFramesCaptionDescPCSyntax10.Scn.FntBPSyntax10.Scn.FntBPSyntax10.Scn.FntBPSyntax10.Scn.FntSPSyntax10.Scn.Fnt !last pushedSyntax10.Scn.Fnt"@(*  Var, VarPar Fld Elem Frame Proc Type base cur.fp or sb adr of cur.rec. adr. of cur.array --- --- --- m declaring module module of rec.type mod.of var or fld mod.of cur.proc. declaring module declaring module type --- type of rec. --- --- --- type of cur.record extType --- dyn.type of rec. --- --- --- --- extLevel --- level of dyn.type --- --- --- --- fp --- --- --- fp of cur.frame --- --- pc --- --- --- pc of cur.proc 1. instr. of proc (abs) --- elemSize --- --- size of element --- --- --- lenAdr --- --- adr.of len of dyn.arr --- --- --- staticLink --- --- --- static link --- ---  Procedure call chain is linked by base pointer BP, [SP] is the most recently pushed value. *) 8 pos*: LONGINT; (* current position in reference section *) base*: LONGINT; (* base address used to access the value of the item *) m*: Modules.Module; (* module containing the variable, procedure, record type *) type*: Types.Type; (* type of the current extension level *) extType*: Types.Type; (* dynamic type of a variable *) fp*: LONGINT; (* frame pointer*) pc*: LONGINT; (* program counter *) extLevel*: SHORTINT; (* extension level of extType, can be decremented for implementation of foldedBaseType, auto-incrementation of extension level until extLevel *) elemSize*: LONGINT; (* size of an array element *) lenAdr*: LONGINT; (*address of length of current dimension (for DynArr)*) staticLink*: LONGINT (* static link for mode = Frame *) END ; HiddenBase docu88Syntax10.Scn.FntSyntax10b.Scn.Fnt Syntax10i.Scn.Fnt  8 D N8FoldElemsNewSyntax10.Scn.FntSyntax10i.Scn.Fnt ZParcElemsAlloc# Z (*  Var, VarPar Fld Elem Frame Proc Type name variable name field name array name proc.name proc.name type name (unless anon.) mod declaring module decl.mod.of rec ---- decl.mod.of proc. declaring module declaring module form variable form field form element form --- --- --- off offset in frame offset in rec offset in array offset in code offset in code --- or register id idx --- --- element index --- --- --- len --- --- array length of procedure of procedure --- level --- ext.level of rec. --- --- --- ---  *) 8 name*: ARRAY 128 OF CHAR; mode*: SHORTINT; (* "dynamic type" of rider, Proc after OpenProcs and OpenProc, Fld (or Elem) after OpenPtr, Frame after OpenStack, Type after OpenTypes, and Var after OpenVars *) form*: SHORTINT; vis*: SHORTINT; (* visibility *) idx*: LONGINT; (* number of Next operations performed, initially 0 *) off*: LONGINT; (* offset to be added to base to obtain the address of the item *) len*: LONGINT; (* of array *) mod*: ARRAY 32 OF CHAR; (* name of module *) level*: SHORTINT END ; Rider docu8 p#Syntax10.Scn.Fnt Windows LinuxLinuxWindows#Syntax10.Scn.FntWin32Linux pcMarkElemsAlloc-IdZ 8J8#Syntax10.Scn.Fnt VAR li: LONGINT; BEGIN li := m.varEntries[tdadr]; S.GET(li, li); S.GET(li - 4, li); li := li DIV 4 * 4; RETURN S.VAL(Types.Type, li) END TypeOf; 8)8#Syntax10.Scn.Fnt VAR n: LONGINT; s: SHORTINT; x: CHAR; BEGIN s := 0; n := 0; S.GET(adr, x); INC(adr); WHILE ORD(x) >= 128 DO INC(n, ASH(ORD(x) - 128, s)); INC(s, 7); S.GET(adr, x); INC(adr) END ; i := n + ASH(ORD(x) MOD 64 - ORD(x) DIV 64 * 64, s) END GetInt; 8T8#Syntax10.Scn.Fnt?? VAR i: INTEGER; ch: CHAR; len: LONGINT; BEGIN i := 0; len := LEN(str); S.GET(adr, ch); WHILE (ch > 2X) & (i < len - 1) DO str[i] := ch; INC(adr); INC(i); S.GET(adr, ch) END ; str[i] := 0X; IF ch > 2X THEN WHILE ch > 2X DO INC(adr); S.GET(adr, ch) END END ; vis := SHORT(ORD(ch)); INC(adr) END GetString; 8A]8#Syntax10.Scn.Fnt VAR i: INTEGER; ch: CHAR; BEGIN i := 0; REPEAT ch := str[i]; S.PUT(adr, ch); INC(adr); INC(i) UNTIL ch = 0X END PutString; 8'&'8#Syntax10.Scn.Fnt VAR adr: LONGINT; BEGIN ASSERT(r.base # 0, 99); adr := r.base + r.off; IF (r.mode = VarPar) OR (r.mode = Var) & (r.form = DynArr) THEN S.GET(adr, adr) END ; RETURN adr END Adr; 88#Syntax10.Scn.FntDD BEGIN ASSERT(r.form IN {Char, Byte}); S.GET(r.Adr(), ch) END Read; 8 8#Syntax10.Scn.Fnt>> BEGIN ASSERT(r.form = Bool); S.GET(r.Adr(), b) END ReadBool; 88#Syntax10.Scn.Fnt?? BEGIN ASSERT(r.form = SInt); S.GET(r.Adr(), si) END ReadSInt; 88#Syntax10.Scn.Fnt<< BEGIN ASSERT(r.form = Int); S.GET(r.Adr(), i) END ReadInt; 88#Syntax10.Scn.Fnt?? BEGIN ASSERT(r.form = LInt); S.GET(r.Adr(), li) END ReadLInt; 88#Syntax10.Scn.Fnt>> BEGIN ASSERT(r.form = Real); S.GET(r.Adr(), x) END ReadReal; 8 8#Syntax10.Scn.FntAA BEGIN ASSERT(r.form = LReal); S.GET(r.Adr(), lr) END ReadLReal; 88#Syntax10.Scn.Fnt<< BEGIN ASSERT(r.form = Set); S.GET(r.Adr(), s) END ReadSet; 88#Syntax10.Scn.FntCC BEGIN ASSERT(r.form = Procedure); S.GET(r.Adr(), p) END ReadProc; 88#Syntax10.Scn.Fnt@@ BEGIN ASSERT(r.form = Pointer); S.GET(r.Adr(), p) END ReadPtr; 8 8#Syntax10.Scn.Fnt"" VAR adr, pos, nofElems, elemSize: LONGINT; form, vis: SHORTINT; BEGIN pos := r.pos; IF r.form = Array THEN GetInt(pos, nofElems) ELSE ASSERT(r.form = DynArr) END ; GetInt(pos, elemSize); S.GET(pos, form); ASSERT(form = Char); adr := r.Adr(); GetString(adr, str, vis); END ReadString; 88#Syntax10.Scn.FntEE BEGIN ASSERT(r.form IN {Char, Byte}); S.PUT(r.Adr(), ch) END Write; 8 8#Syntax10.Scn.Fnt?? BEGIN ASSERT(r.form = Bool); S.PUT(r.Adr(), b) END WriteBool; 8 8#Syntax10.Scn.Fnt@@ BEGIN ASSERT(r.form = SInt); S.PUT(r.Adr(), si) END WriteSInt; 88#Syntax10.Scn.Fnt== BEGIN ASSERT(r.form = Int); S.PUT(r.Adr(), i) END WriteInt; 8 8#Syntax10.Scn.Fnt@@ BEGIN ASSERT(r.form = LInt); S.PUT(r.Adr(), li) END WriteLInt; 8  8#Syntax10.Scn.Fnt?? BEGIN ASSERT(r.form = Real); S.PUT(r.Adr(), x) END WriteReal; 8 8#Syntax10.Scn.FntBB BEGIN ASSERT(r.form = LReal); S.PUT(r.Adr(), lr) END WriteLReal; 8 8#Syntax10.Scn.Fnt== BEGIN ASSERT(r.form = Set); S.PUT(r.Adr(), s) END WriteSet; 8 8#Syntax10.Scn.FntDD BEGIN ASSERT(r.form = Procedure); S.PUT(r.Adr(), p) END WriteProc; 8`8CSyntax10.Scn.Fnt3Syntax10i.Scn.Fnt^ BEGIN ASSERT(r.form = Pointer); S.PUT(r.Adr(), p) (* type should be checked *) END WritePtr; 8 8#Syntax10.Scn.FntLL VAR adr, pos, nofElems, elemSize: LONGINT; form: SHORTINT; BEGIN (* check bounds (especially with dynamic arrays) *) pos := r.pos; IF r.form = Array THEN GetInt(pos, nofElems) ELSE ASSERT(r.form = DynArr) END ; GetInt(pos, elemSize); S.GET(pos, form); ASSERT(form = Char); adr := r.Adr(); PutString(adr, str) END WriteString; 8' |8mSyntax10.Scn.Fnt. Syntax10i.Scn.Fnt"bP VAR tag: CHAR; tdadr, pc, fp, idx: LONGINT; sub: Rider; BEGIN idx := r.idx + 1; CASE r.mode OF Var, VarPar: S.GET(r.pos, r.mode); IF ~(r.mode IN {Var, VarPar}) THEN r.mode := End ELSE r.idx := idx; INC(r.pos); GetString(r.pos, r.name, r.vis); GetInt(r.pos, r.off); S.GET(r.pos, r.form); INC(r.pos) END | Proc: S.GET(r.pos, tag); IF tag # ProcTag THEN r.mode := End ELSE r.idx := idx; INC(r.pos); GetInt(r.pos, r.off); GetString(r.pos, r.name, r.vis); r.pc := S.ADR(r.m.code^) + r.off END | Type: S.GET(r.pos, tag); IF tag # RecordTag THEN r.mode := End ELSE r.idx := idx; INC(r.pos); GetInt(r.pos, tdadr); GetString(r.pos, r.name, r.vis); r.type := TypeOf(r.m, tdadr) END | Fld: S.GET(r.pos, tag); IF tag = 0X THEN (* auto-advance to next level *) IF r.level < r.extLevel THEN INC(r.level); r.type := Types.BaseOf(r.extType, r.level); r.ToFirstField ELSE r.mode := End END ELSE r.idx := idx; GetString(r.pos, r.name, r.vis); GetInt(r.pos, r.off); S.GET(r.pos, r.form); INC(r.pos) END | Elem: IF idx >= r.len THEN r.mode := End ELSE INC(r.off, r.elemSize); r.idx := idx END | Frame: IF advance THEN S.GET(r.fp + 4, pc); S.GET(r.fp, fp) (* pc and fp of caller *) ELSE fp := r.fp; pc := r.pc; advance := TRUE END ; OpenProc(pc, r); IF r.mode # End THEN r.Zoom(sub); IF (r.name # "$$") & (sub.off # 0) THEN ASSERT(sub.name = "@"); S.GET(fp + sub.off, r.staticLink) ELSE r.staticLink := 0 END ; r.idx := idx; r.fp := fp; r.mode := Frame END | End: END END LookAhead; 8q#=8 Syntax10.Scn.FntQSyntax10i.Scn.Fnt8FoldElemsNew#Syntax10.Scn.Fnt r.lenAdr = 0 8}8#Syntax10.Scn.Fnt r.lenAdr = 0 8A VAR pos, len, lenAdr, s, size, x: LONGINT; BEGIN ASSERT(r.form IN {Array, DynArr}); GetInt(r.pos, size); S.GET(r.pos, baseForm); INC(r.pos); pos := r.pos; IF r.form = Array THEN r.form := baseForm; r.elemSize := size; WHILE baseForm = Array DO GetInt(pos, len); GetInt(pos, size); S.GET(pos, baseForm); INC(pos) END ELSE (*DynArr*) r.form := baseForm; lenAdr := r.lenAdr; s := 1; dims := 1; WHILE baseForm = DynArr DO INC(dims); GetInt(pos, size); S.GET(pos, baseForm); INC(pos); IF baseForm # DynArr THEN IF r not on data THEN x := 1 ELSE S.GET(lenAdr, x) END ; s := s * x ELSE INC(lenAdr, 4) END END ; r.elemSize := s * size; IF r not on data THEN dim0 := 1 ELSE S.GET(lenAdr, dim0) END END END ScanArray; 8(8Syntax10.Scn.FntE(8FoldElemsNew_Syntax10.Scn.FntSyntax10b.Scn.FntPz VAR h: LONGINT; BEGIN LOOP CASE form OF DynArr: GetInt(r.pos, h); S.GET(r.pos, form); INC(r.pos) | Array: GetInt(r.pos, h); GetInt(r.pos, h); S.GET(r.pos, form); INC(r.pos) | Record: INC(r.pos); GetInt(r.pos, h); EXIT | Pointer: S.GET(r.pos, form); INC(r.pos) | Procedure: GetInt(r.pos, h); EXIT | NoTyp, None..Set: EXIT END END END SkipTyp; 8Syntax10i.Scn.Fnt58#Syntax10.Scn.Fnt VAR h: LONGINT; name: ARRAY 32 OF CHAR; form, vis: SHORTINT; BEGIN GetString(r.pos, name, vis); GetInt(r.pos, h); S.GET(r.pos, form); INC(r.pos); SkipTyp(r, form); S.GET(r.pos, tag) END SkipObj; 8*Y8#Syntax10.Scn.Fnt VAR tag: SHORTINT; BEGIN S.GET(r.pos, tag); WHILE tag IN {Var, VarPar} DO INC(r.pos); SkipObj(r, tag) END END SkipVariables; 8'h8#Syntax10.Scn.Fntvv VAR tag: SHORTINT; BEGIN S.GET(r.pos, tag); WHILE tag # 0 DO SkipObj(r, tag) END ; INC(r.pos) END SkipFields; 8^I VAR r2: Rider; PROCEDURE SkipTyp (VAR r: Rider; form: SHORTINT);  PROCEDURE SkipObj (VAR r: Rider; VAR tag: SHORTINT);  PROCEDURE SkipVariables (VAR r: Rider);  PROCEDURE SkipFields (VAR r: Rider);  BEGIN CASE r.mode OF Var, VarPar, Fld: SkipTyp(r, r.form) | Proc: SkipVariables(r) | Type: SkipFields(r) | Frame, Elem, End: END ; r.LookAhead; IF r.mode = Proc THEN r2 := r; SkipVariables(r2); r2.LookAhead; IF r2.mode = End THEN (* r denotes last proc in module *) r.len := LEN(r.m.code^) - r.off ELSE r.len := r2.off - r.off END END END Next; 8,I8QSyntax10.Scn.FntDSyntax10i.Scn.Fnt BEGIN ASSERT(r.mode IN {Fld, Elem, End}); IF r.type # NIL THEN (*Fld*) IF idx <= r.extLevel THEN r.level := SHORT(SHORT(idx)); r.type := Types.BaseOf(r.extType, SHORT(idx)); r.ToFirstField ELSE r.mode := End END ELSIF (r.len # 0) & (r.elemSize # 0) THEN (*Elem*) IF (idx >= 0) & (idx < r.len) THEN r.off := idx * r.elemSize; r.idx := idx ELSE r.mode := End END ELSE HALT(99) END END SetTo; 8U(n)8Syntax10.Scn.Fnt`Syntax10i.Scn.Fnt  RSyntax10b.Scn.Fnt8-Y VAR destType: Types.Type; i, len, j: LONGINT; BEGIN ASSERT(r.type # NIL); destType := r.type; (* is changed by LookAhead(Type)! *) r.m := r.type.module; COPY(r.m.name, r.mod); r.pos := Types.RefposOf(destType); r.mode := Type; r.idx := -1; r.LookAhead; ASSERT(r.type = destType); r.mode := Fld; r.idx := -1; r.LookAhead END ToFirstField; 8.P8_Syntax10.Scn.Fnt!8FoldElemsNewCSyntax10.Scn.FntSyntax10i.Scn.Fnt+l (*stack[off] = Adr(rec), stack[off+4] = tdadr*) S.GET(r.base + r.off + 4, li); S.GET(li - 4, li); li := li DIV 4 * 4; RETURN S.VAL(Types.Type, li) Syntax10i.Scn.Fnt/8[8#Syntax10.Scn.Fnt S.GET(r.pos, mno); li := r.pos + 1; GetInt(li, tdadr); m := r.m; RETURN TypeOf(S.VAL(Modules.Module, m.imports[mno]), tdadr) 8K 8*Syntax10.Scn.Fnt S.GET(r.pos, tag); IF tag = Record THEN li := r.pos + 1; S.GET(li, mno); INC(li); GetInt(li, tdadr); m := r.m; RETURN TypeOf(S.VAL(Modules.Module, m.imports[mno]), tdadr) ELSE RETURN NIL END 8R VAR li: LONGINT; mno, tag: SHORTINT; tdadr: LONGINT; m: Modules.Module; BEGIN IF r.form = Record THEN IF (r.mode = VarPar) & (r.base # 0) THEN get dynamic type from hidden parameter on stack ELSE static type END ELSIF r.mode = Type THEN RETURN r.type ELSIF r.form = Pointer THEN static type ELSE HALT(99) END END Type; 8-_`J`E TableElemsAllocbSyntax10.Scn.Fnt#9@@TableElemsAlloc#Syntax10.Scn.Fnt::/nolines "*" /noheads "*" /table Var, VarPar, Elem, Fld \@p1@@#Syntax10.Scn.Fnt/columns LL /nolines "*" /table r.form sub.mode Record, Pointer (to Record) Fld Array, DynArray, Pointer (to Array/DynArray) Elem @/columns LL /table r.mode sub.mode   Type Fld Proc, Frame Var 8Syntax10.Scn.Fnt~8FoldElemsNew#Syntax10.Scn.Fnt r.base = 0Syntax10i.Scn.Fnt 88#Syntax10.Scn.Fnt r.base = 0 88#Syntax10.Scn.Fnt r.base = 0 8v' +?%3&WSyntax10b.Scn.Fnt. VAR p: S.PTR; baseForm, dims: SHORTINT; BEGIN CASE r.mode OF Var, VarPar, Elem, Fld: CASE r.form OF Record: IF r not on data THEN sub.base := 0 ELSE sub.base := r.Adr() END ; sub.extType := r.Type(); ASSERT(sub.extType # NIL); sub.type := Types.BaseOf(sub.extType, 0); sub.level := 0; sub.extLevel := SHORT(Types.LevelOf(sub.extType)); sub.ToFirstField | Array, DynArr: sub := r; IF r not on data THEN sub.base := 0 ELSE sub.base := r.Adr() END ; IF r.form = Array THEN GetInt(sub.pos, sub.len); sub.lenAdr := 0 ELSE (* DynArr *) IF r not on data THEN sub.len := 1; sub.lenAdr := 0 ELSIF r.mode = Elem THEN ASSERT(r.lenAdr # 0); sub.lenAdr := r.lenAdr + 4 (* sub.len is set by sub.ScanArray *) ELSE (*Var, VarPar, Fld*) sub.lenAdr := r.base + r.off + 4 (*stack[off] = Adr(arr), stack[off+4] = length of first dimension*) (* sub.len is set by sub.ScanArray *) END END ; sub.ScanArray(baseForm, dims, sub.len); sub.mode := Elem; sub.type := NIL; sub.idx := -1; sub.off := -sub.elemSize; sub.LookAhead | Pointer: sub := r; IF r.base # 0 THEN sub.ReadPtr(p) ELSE p := S.VAL(S.PTR, -1) END; S.GET(sub.pos, sub.form); INC(sub.pos); OpenPtr(p, sub) ELSE sub.mode := End; sub.form := None END | Type: sub := r; sub.base := 0; sub.extType := sub.type; sub.extLevel := SHORT(Types.LevelOf(sub.type)); sub.type := Types.BaseOf(sub.extType, 0); sub.level := 0; sub.ToFirstField | Proc, Frame: sub := r; IF (r.mode = Proc) & (r.base = 0) THEN sub.base := 0 (*!*) ELSIF sub.name = "$$" THEN sub.base := sub.m.sb ELSE sub.base := sub.fp END ; sub.mode := Var; sub.idx := -1; sub.LookAhead END END Zoom; 8:@%8#Syntax10.Scn.Fnt BEGIN r.m := Modules.ThisMod(mod); IF r.m # NIL THEN COPY(mod, r.mod); r.pos := S.ADR(r.m.refs^); RETURN TRUE ELSE r.mode := End; r.mod := ""; RETURN FALSE END END Init; 8 2 &?^8CSyntax10.Scn.FntSyntax10b.Scn.Fnt7` BEGIN advance := FALSE; IF info = NIL THEN advance := TRUE; S.GETREG(5, r.fp) ELSE advance := FALSE; r.fp := info.cont.Ebp; r.pc := info.cont.Eip END ; (* IF fp = 0 THEN S.GETREG(5, r.fp); r.pc := 0 ELSE r.fp := fp; r.pc := pc; r.firstpc := pc END ; r.base := r.fp; *) r.mode := Frame; r.base := 0; r.idx := -1; r.LookAhead END OpenStack; 8 /&C8Syntax10.Scn.FntjSyntax10i.Scn.Fnt " 6Syntax10b.Scn.Fnt .? VAR h: LONGINT; name: ARRAY 32 OF CHAR; vis: SHORTINT; BEGIN IF Init(mod, r) THEN r.base := r.m.sb; (* The Module body is treated like a procedure (with name "$$"), global variables are treated like local variables of the module body. The module body is the first procedure in the reference section. *) (* S.GET(r.pos, ch); ASSERT(ch = ProcTag); *) INC(r.pos); GetInt(r.pos, h); (* ASSERT(h = 0); *) (* offset *) GetString(r.pos, name, vis); (* ASSERT(name = "$$"); *) (* name of module body *) r.mode := Var; r.idx := -1; r.LookAhead END END OpenVars; 8 0 &8qSyntax10.Scn.FntSyntax10i.Scn.FntnSyntax10b.Scn.Fnt (** opens a rider r for the (global and local) procedures (not including the module body) in module mod *) BEGIN IF Init(mod, r) THEN r.mode := Proc; r.idx := -2; r.LookAhead; (* skip module body *) r.Next END END OpenProcs; 8 488#Syntax10.Scn.Fnt??((S.ADR(m.code^) > pc) OR (pc > S.ADR(m.code^) + LEN(m.code^)))8U8 1 &8qSyntax10.Scn.FntSyntax10i.Scn.Fnt;T!Syntax10b.Scn.Fnt/ (** opens a rider r for the record types of module mod *) BEGIN OpenProcs(mod, r); IF r.mode # End THEN WHILE r.mode # End DO r.Next END ; (* skip body and procedures *) r.mode := Type; r.idx := -1; r.LookAhead END END OpenTypes; 81!]8CSyntax10.Scn.FntSyntax10i.Scn.Fnt.2a (** opens a rider r for the record type t *) BEGIN r.type := t; r.ToFirstField END OpenType; 83 8Syntax10.Scn.FntSyntax10i.Scn.Fnt{Y8FoldElemsNew#Syntax10.Scn.Fnt''(S.VAL(LONGINT, p) = -1) & (r.base = 0) 83Syntax10b.Scn.Fnt 8|Syntax10.Scn.Fnt<N TableElemsAlloc#Syntax10.Scn.Fnt/rows "LLLLL" /columns "LLLLL" /table DynArr of Array of Simple r.base := Align(adr + 12 + 4*dims) r.base := adr TypeWOPtr r.base := Align(adr + 12 + 4*dims) r.base := adr + 16 TypeWithPtr S.GET(adr+8, r.base) S.GET(adr+8, r.base) Ptr S.GET(adr+8, r.base) S.GET(adr+8, r.base)  8sCJ (*for arrays, r.form must Array or DynArr, and r must be positioned after the pointer base form in the reference information*) CONST arrayBit = 1; VAR tag: SET; adr: LONGINT; baseForm, dims: SHORTINT; BEGIN IF r not on data THEN r.mode := Var; r.Zoom(r) ELSIF p = NIL THEN r.mode := End ELSE adr := S.VAL(LONGINT, p); S.GET(adr - 4, tag); (*TD for OberonD*) adr := S.VAL(LONGINT, p); IF r.form IN {Array, DynArr} THEN IF r.form = Array THEN GetInt(r.pos, r.len); r.lenAdr := 0 ELSE r.lenAdr := adr + 12 (* r.len set in r.ScanArray *) END ; r.ScanArray(baseForm, dims, r.len); IF arrayBit IN tag THEN S.GET(adr + 8, r.base) ELSIF r.lenAdr > 0 THEN (* DynArr *) r.base := (adr + 12 + 4 * dims + 4) DIV 8 * 8 ELSIF baseForm < Array THEN r.base := adr ELSE r.base := adr + 16 END ;  r.mode := Elem; r.type := NIL; r.off := -r.elemSize; r.idx := -1; r.LookAhead ELSE IF tag * {3} = {} THEN r.mode := End; RETURN END ; (* subObjBit must be set, otherwise it may be a tag itself *) r.base := adr; r.extType := Types.TypeOf(p); IF r.extType = NIL THEN r.mode := End ELSE r.type := Types.BaseOf(r.extType, 0); r.level := 0; r.extLevel := SHORT(Types.LevelOf(r.extType)); r.ToFirstField END END END END OpenPtr; 8  4'18CSyntax10.Scn.FntYSyntax10b.Scn.Fnt. VAR r: Rider; BEGIN OpenProcs(mod, r); WHILE r.mode # End DO IF r.name = name THEN RETURN r.pc END ; r.Next END ; RETURN 0 END PC; 8+rMODULE Ref;   (* CS, 12 Feb 96 -  *) EBNF of object files with full reference information IMPORT S := SYSTEM, Kernel, Unix, Modules, Types; CONST (* object forms *)  (* object modes *)  (* tags *)  (* visibility *)  TYPE HiddenBase = RECORD  Rider* = RECORD (HiddenBase)  ProcVar* = PROCEDURE; ExceptionInfo = Unix.ExceptionInfo; VAR advance: BOOLEAN; (* used in OpenFrame and LookAhead(Frame) *) (*---------- forward declarations ----------*) PROCEDURE^ (VAR r: Rider) ToFirstField; PROCEDURE^ OpenPtr* (p: S.PTR; VAR r: Rider); PROCEDURE^ OpenProc* (pc: LONGINT; VAR r: Rider); PROCEDURE^ (VAR r: Rider) Zoom* (VAR sub: Rider); (*---------- auxiliaries ----------*) PROCEDURE TypeOf (m: Modules.Module; tdadr: LONGINT): Types.Type;  PROCEDURE GetInt (VAR adr, i: LONGINT);  PROCEDURE GetString (VAR adr: LONGINT; VAR str: ARRAY OF CHAR; VAR vis: SHORTINT);  PROCEDURE PutString (VAR adr: LONGINT; VAR str: ARRAY OF CHAR);  (* ---------- rider methods ----------*) PROCEDURE (VAR r: Rider) Adr* (): LONGINT;  PROCEDURE (VAR r: Rider) Read* (VAR ch: CHAR);  PROCEDURE (VAR r: Rider) ReadBool* (VAR b: BOOLEAN);  PROCEDURE (VAR r: Rider) ReadSInt* (VAR si: SHORTINT);  PROCEDURE (VAR r: Rider) ReadInt* (VAR i: INTEGER);  PROCEDURE (VAR r: Rider) ReadLInt* (VAR li: LONGINT);  PROCEDURE (VAR r: Rider) ReadReal* (VAR x: REAL);  PROCEDURE (VAR r: Rider) ReadLReal* (VAR lr: LONGREAL);  PROCEDURE (VAR r: Rider) ReadSet* (VAR s: SET);  PROCEDURE (VAR r: Rider) ReadProc* (VAR p: ProcVar);  PROCEDURE (VAR r: Rider) ReadPtr* (VAR p: S.PTR);  PROCEDURE (VAR r: Rider) ReadString* (VAR str: ARRAY OF CHAR);  PROCEDURE (VAR r: Rider) Write* (ch: CHAR);  PROCEDURE (VAR r: Rider) WriteBool* (b: BOOLEAN);  PROCEDURE (VAR r: Rider) WriteSInt* (si: SHORTINT);  PROCEDURE (VAR r: Rider) WriteInt* (i: INTEGER);  PROCEDURE (VAR r: Rider) WriteLInt* (li: LONGINT);  PROCEDURE (VAR r: Rider) WriteReal* (x: REAL);  PROCEDURE (VAR r: Rider) WriteLReal* (lr: LONGREAL);  PROCEDURE (VAR r: Rider) WriteSet* (s: SET);  PROCEDURE (VAR r: Rider) WriteProc* (p: ProcVar);  PROCEDURE (VAR r: Rider) WritePtr* (p: S.PTR);  PROCEDURE (VAR r: Rider) WriteString* (str: ARRAY OF CHAR);  PROCEDURE (VAR r: Rider) LookAhead;  PROCEDURE (VAR r: Rider) ScanArray (VAR baseForm, dims: SHORTINT; VAR dim0: LONGINT); (* returns the form of the elements of the array (CHAR in the example POINTER TO ARRAY OF ARRAY OF CHAR) in baseform, the number of dimensions (2 in this example) in dims, the number of elements in the first dimension (10 when the array has been allocated with NEW(p, 10, 32)) in dim0 (only if it is an open array, dim0 is not changed if it is a fixed array) and the length of an array element of the outermost array in r.elemsize (32 * SIZE(CHAR) = 32 in this example). *)  PROCEDURE (VAR r: Rider) Next*;  PROCEDURE (VAR r: Rider) SetTo* (idx: LONGINT); (** in records: go to ith extension level; in arrays: go to ith element *)  PROCEDURE (VAR r: Rider) ToFirstField; (* positions in the reference section to the first field of type r.type, afterwards: r.mode IN {Fld, Eol} *)  PROCEDURE (VAR r: Rider) Type* (): Types.Type;  PROCEDURE (VAR r: Rider) Zoom* (VAR sub: Rider); (** *)  (* ---------- procedures for opening riders ----------*) PROCEDURE Init (VAR mod: ARRAY OF CHAR; VAR r: Rider): BOOLEAN;  PROCEDURE OpenStack* (info: ExceptionInfo; VAR r: Rider); (** if info # NIL, information in the ExceptionInfo is used *)  PROCEDURE OpenVars* (mod: ARRAY OF CHAR; VAR r: Rider);  PROCEDURE OpenProcs* (mod: ARRAY OF CHAR; VAR r: Rider);  PROCEDURE OpenProc* (pc: LONGINT; VAR r: Rider);  VAR m: Modules.Module; r2: Rider; BEGIN IF pc = 0 THEN r.mode := End; r.mod := ""; r.name := ""; RETURN END ; m := Kernel.modules; WHILE (m # NIL) & pc is not within this module DO m := m.next END ; IF m = NIL THEN r.mode := End; r.mod := ""; r.name := "" ELSE (* pc is within module m *) r.m := m; COPY(m.name, r.mod); r.pos := S.ADR(m.refs^); r.fp := 0; r.base := 0; r.mode := Proc; r.idx := -1; r.LookAhead; DEC(pc, S.ADR(m.code^)); (* (* This would not find module body, as r.len is set by r.Next which has not yet been called. *) WHILE (r.mode # End) & (pc >= r.off + r.len) DO r.Next END ; *) WHILE (r.mode # End) & (r.off <= pc) DO r2 := r; r.Next END ; r := r2; ASSERT(r.mode # End) END END OpenProc;  PROCEDURE OpenTypes* (mod: ARRAY OF CHAR; VAR r: Rider);  (* PROCEDURE OpenType* (t: Types.Type; VAR r: Rider);  *) PROCEDURE OpenPtr* (p: S.PTR; VAR r: Rider);  PROCEDURE PC* (mod, name: ARRAY OF CHAR): LONGINT;  END Ref. Folds.Compile Ref.Mod/s RefElems.Mod/s System.Mod/s ~ Folds.Compile Ref.Mod/t ~ Folds.Profile Folds.Compile Ref.Mod ~ compiling Ref.Obj/s new symbol file 16374 => 7339 (without dumping procedures) System.Directory Ref.Obj/s Ref.Obj 21194 bytes => 10094 (without dumping procedures)