ð>Syntax10.Scn.FntSyntax10b.Scn.Fnt«þÿÿÐûqInfoElemsAllocVSyntax10.Scn.FntÝõÿÿÿpdðIStampElemsAlloc30 Sep 97!ÿ"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": “þÿÿàqHistoryElemsNewHistory*Syntax10.Scn.Fnt4<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.Fntõÿÿÿ€‹ðIStampElemsAlloc30 Sep 97µêÿÿ€8ÀÔFoldElemsNewÎSyntax10.Scn.FntSyntax10b.Scn.Fntèÿÿÿ £Zà¥ParcElemsAlloc Æê°š Ðí ÁÈÀ¿Óååÿÿÿ £ZॠÆê°š Ðí þ  ÁÈÀ¿Ó¤Syntax10i.Scn.FntA#@@Ñæÿÿÿ £Zà¥À¿Óà†— ¼ýà©;€¡ògåÿÿÿð¹õॠÆê°š Ðí þ  ÁÈÀ¿Ó-¼æÿÿÿ £Zà¥À¿Óà†— ¼ý ­%€ò×tåÿÿÿ £ZॠÆê°š Ðí þ  ÁÈÀ¿ÓÏ# $ *²'u’k¡M/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 module´s 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 module´s 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. *)4ÿÿÿÿ€8ÀÔðÿÿÿ £Zà¥ParcElemsAlloc Æê  ý> ÿÿÿÿ€8ÀÔ   ÿÿÿÿ€8ÀÔÿÿÿÿ€8ÀÔÿÿÿÿ€8ÀÔ ÿÿÿÿ€8ÀÔ$ÿÿÿÿ€8ÀÔ ÿÿÿÿ€8ÀÔ ÿÿÿÿ€8ÀÔÿÿÿÿ€8ÀÔ - 9>+ "   •  3  <úÿÿ€8ÀÔSyntax10.Scn.FntSyntax10i.Scn.FntÙÿÿÿÐ2aà¥ParcElemsAlloc õ„ ¼ýÀáàØÕ€µ•€øÒ ï‰àÿÂTimes10b.Scn.Fnt&Times10.Scn.Fnt&ðÿÿÿ £ZॠÆê ¼ý\èýÿÿL¥@èKeplerElemsAllocKeplerGraphsGraphDescKeplerGraphsStarDescà°à¤yä°ä¤yàà~äà~à~ä~àÐ{äÐ{à€{ä€{à |ä |ôä{ô”{Д{´”{´¤~ä¤~ô¤~и~´¸~´°ü”{”{à”{ààyäàyà°zä°zÀôyôyàôyôôyKepler1AttrDesc   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ÀÔÿÿÿÿ€8ÀÔÿÿÿÿ€8ÀÔ §  8 D &ýÿÿ€8ÀÔÒSyntax10.Scn.FntSyntax10i.Scn.FntÙÿÿÿ £Zà¥ParcElemsAlloc Æê ¼ý€”#À¤Ü éŽ€®Áà×üàšºTimes10b.Scn.Fnt&Times10.Scn.FntÛðÿÿÿ £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ÀÔÿÿÿÿ€8ÀÔLSyntax8i.Scn.Fnt.°üÿÿÿÀÔ°­MarkElemsAlloc-íIüÿÿÿÀÔ°­dZ 8ÿÿÿÿ€8ÀÔ”ÿÿÿÿ€8ÀÔ)ÿÿÿÿ€8ÀÔøÿÿÿÿ€8ÀÔTÿÿÿÿ€8ÀÔ?ÿÿÿÿ€8ÀÔAÿÿÿÿ€8ÀÔÿÿÿÿ€8ÀÔ'üÿÿÿÀÔ°­&íÿÿÿÿ€8ÀÔ·ÿÿÿÿ€8ÀÔÿÿÿÿ€8ÀÔDÿÿÿÿ€8ÀÔ ÿÿÿÿ€8ÀÔ>ÿÿÿÿ€8ÀÔÿÿÿÿ€8ÀÔ?ÿÿÿÿ€8ÀÔÿÿÿÿ€8ÀÔ<ÿÿÿÿ€8ÀÔÿÿÿÿ€8ÀÔ?ÿÿÿÿ€8ÀÔÿÿÿÿ€8ÀÔ>ÿÿÿÿ€8ÀÔ ÿÿÿÿ€8ÀÔAÿÿÿÿ€8ÀÔÿÿÿÿ€8ÀÔ<ÿÿÿÿ€8ÀÔÿÿÿÿ€8ÀÔCÿÿÿÿ€8ÀÔÿÿÿÿ€8ÀÔ@ÿÿÿÿ€8ÀÔ ÿÿÿÿ€8ÀÔ"ÿÿÿÿ€8ÀÔÿÿÿÿ€8ÀÔEÿÿÿÿ€8ÀÔ ÿÿÿÿ€8ÀÔ?ÿÿÿÿ€8ÀÔ ÿÿÿÿ€8ÀÔ@ÿÿÿÿ€8ÀÔÿÿÿÿ€8ÀÔ=ÿÿÿÿ€8ÀÔ ÿÿÿÿ€8ÀÔ@ÿÿÿÿ€8ÀÔ  ÿÿÿÿ€8ÀÔ?ÿÿÿÿ€8ÀÔ ÿÿÿÿ€8ÀÔBÿÿÿÿ€8ÀÔ ÿÿÿÿ€8ÀÔ=ÿÿÿÿ€8ÀÔ ÿÿÿÿ€8ÀÔDÿÿÿÿ€8ÀÔÿÿÿÿ€8ÀÔ3ÿÿÿÿ€8ÀÔ ÿÿÿÿ€8ÀÔLÿÿÿÿ€8ÀÔüÿÿÿÀÔ°­'í ÿÿÿÿ€8ÀÔ. ¸"Ÿb›Pÿÿÿÿ€8ÀÔüÿÿÿÀÔ°­q#Ë=ßÿÿÿÿ€8ÀÔQÂÐÿÿÿ€8ÀÔ$Syntax10i.Scn.Fnt r not on data ÿÿÿÿ€8ÀÔ}Ðÿÿÿ€8ÀÔ$Syntax10i.Scn.Fnt r not on data ÿÿÿÿ€8ÀÔAÿÿÿÿ€8ÀÔüÿÿÿÀÔ°­(íÿÿÿÿ€8ÀÔEÿÿÿÿ€8ÀÔéPÿÿÿÿ€8ÀÔ5ÿÿÿÿ€8ÀÔËÿÿÿÿ€8ÀÔ*ÿÿÿÿ€8ÀÔ…ÿÿÿÿ€8ÀÔ'ÿÿÿÿ€8ÀÔvÿÿÿÿ€8ÀÔù^ÿÿÿÿ€8ÀÔüÿÿÿÀÔ°­,íIÿÿÿÿ€8ÀÔD̆ÿÿÿÿ€8ÀÔüÿÿÿÀÔ°­UÍ(nÿÿÿÿ€8ÀÔ`  R8-ÿÿÿÿ€8ÀÔüÿÿÿÀÔ°­.íÿÿÿÿ€8ÀÔ€®ÿÿÿ€8ÀÔ$Syntax10i.Scn.Fnt//get dynamic type from hidden parameter on stack+lÿÿÿÿ€8ÀÔÒÿÿÿ€8ÀÔ$Syntax10i.Scn.Fnt static typeƒÿÿÿÿ€8ÀÔKÒÿÿÿ€8ÀÔ$Syntax10i.Scn.Fnt static type·ÿÿÿÿ€8ÀÔÿÿÿÿ€8ÀÔüÿÿÿÀÔ°­-í_þÿÿàÞO€TableElemsAllocbSyntax10.Scn.Fnt#¤ÿÿÿùp–TableElemsAlloc#Syntax10.Scn.Fnt::/nolines "*" /noheads "*" /table Var, VarPar, Elem, Fld \ÿÿÿ`/4П#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 ÿÿÿÿ€8ÀÔ~Ðÿÿÿ€8ÀÔ$Syntax10i.Scn.Fnt r not on data ÿÿÿÿ€8ÀÔÐÿÿÿ€8ÀÔ$Syntax10i.Scn.Fnt r not on data ÿÿÿÿ€8ÀÔÐÿÿÿ€8ÀÔ$Syntax10i.Scn.Fnt r not on data ÿÿÿÿ€8ÀÔv' +?%3&W.ÿÿÿÿ€8ÀÔ:@ÿÿÿÿ€8ÀÔ¹ÿÿÿÿ€8ÀÔ üÿÿÿÀÔ°­2í &?ÿÿÿÿ€8ÀÔ7ÿÿÿÿ€8ÀÔ üÿÿÿÀÔ°­/í&ÿÿÿÿ€8ÀÔj " 6 .ÿÿÿÿ€8ÀÔ üÿÿÿÀÔ°­0í &ÿÿÿÿ€8ÀÔnÿÿÿÿ€8ÀÔ üÿÿÿÀÔ°­ŽÏ4ÿÿÿÿ€8ÀÔšÁÿÿÿ€8ÀÔ$Syntax10i.Scn.Fntpc is not within this module?ÿÿÿÿ€8ÀÔU±ÿÿÿÿ€8ÀÔ üÿÿÿÀÔ°­1í &ÿÿÿÿ€8ÀÔ;T!/ÿÿÿÿ€8ÀÔüÿÿÿÀÔ°­1í!ÿÿÿÿ€8ÀÔ.2ÿÿÿÿ€8ÀÔüÿÿÿÀÔ°­3íÿÿÿÿ€8ÀÔ{YÐÿÿÿ€8ÀÔ$Syntax10i.Scn.Fnt r not on data'ÿÿÿÿ€8ÀÔ3í €‡ÿÿÿÿ€8ÀÔÈþÿÿ@#Bð—#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) ÿÿÿÿ€8ÀÔsCJŽÿÿÿÿ€8ÀÔ üÿÿÿÀÔ°­ Ý4'ÿÿÿÿ€8ÀÔY.ÿÿÿÿ€8ÀÔ :LMODULE Ref;   (* CS, 12 Feb 96 -  *) EBNF of object files with full reference information IMPORT S := SYSTEM, Kernel, Win32, Modules, Types; CONST (* object forms *)  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;  (* object modes *)  Var* = 1; VarPar* = 2; Elem* = 3; Fld* = 4; Frame* = 5; Proc* = 6; Type* = 7; End* = 0;  (* tags *)  ProcTag = 0F8X; RecordTag = 0F7X;  (* visibility *)  internal* = 0; external* = 1; externalR* = 2;  TYPE HiddenBase = RECORD  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 docu Rider* = RECORD (HiddenBase)  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 docu ProcVar* = PROCEDURE; ExceptionInfo = Win32.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;  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;  PROCEDURE GetInt (VAR adr, i: LONGINT);  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;  PROCEDURE GetString (VAR adr: LONGINT; VAR str: ARRAY OF CHAR; VAR vis: SHORTINT);  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;  PROCEDURE PutString (VAR adr: LONGINT; VAR str: ARRAY OF CHAR);  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;  (* ---------- rider methods ----------*) PROCEDURE (VAR r: Rider) Adr* (): LONGINT;  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;  PROCEDURE (VAR r: Rider) Read* (VAR ch: CHAR);  BEGIN ASSERT(r.form IN {Char, Byte}); S.GET(r.Adr(), ch) END Read;  PROCEDURE (VAR r: Rider) ReadBool* (VAR b: BOOLEAN);  BEGIN ASSERT(r.form = Bool); S.GET(r.Adr(), b) END ReadBool;  PROCEDURE (VAR r: Rider) ReadSInt* (VAR si: SHORTINT);  BEGIN ASSERT(r.form = SInt); S.GET(r.Adr(), si) END ReadSInt;  PROCEDURE (VAR r: Rider) ReadInt* (VAR i: INTEGER);  BEGIN ASSERT(r.form = Int); S.GET(r.Adr(), i) END ReadInt;  PROCEDURE (VAR r: Rider) ReadLInt* (VAR li: LONGINT);  BEGIN ASSERT(r.form = LInt); S.GET(r.Adr(), li) END ReadLInt;  PROCEDURE (VAR r: Rider) ReadReal* (VAR x: REAL);  BEGIN ASSERT(r.form = Real); S.GET(r.Adr(), x) END ReadReal;  PROCEDURE (VAR r: Rider) ReadLReal* (VAR lr: LONGREAL);  BEGIN ASSERT(r.form = LReal); S.GET(r.Adr(), lr) END ReadLReal;  PROCEDURE (VAR r: Rider) ReadSet* (VAR s: SET);  BEGIN ASSERT(r.form = Set); S.GET(r.Adr(), s) END ReadSet;  PROCEDURE (VAR r: Rider) ReadProc* (VAR p: ProcVar);  BEGIN ASSERT(r.form = Procedure); S.GET(r.Adr(), p) END ReadProc;  PROCEDURE (VAR r: Rider) ReadPtr* (VAR p: S.PTR);  BEGIN ASSERT(r.form = Pointer); S.GET(r.Adr(), p) END ReadPtr;  PROCEDURE (VAR r: Rider) ReadString* (VAR str: ARRAY OF CHAR);  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;  PROCEDURE (VAR r: Rider) Write* (ch: CHAR);  BEGIN ASSERT(r.form IN {Char, Byte}); S.PUT(r.Adr(), ch) END Write;  PROCEDURE (VAR r: Rider) WriteBool* (b: BOOLEAN);  BEGIN ASSERT(r.form = Bool); S.PUT(r.Adr(), b) END WriteBool;  PROCEDURE (VAR r: Rider) WriteSInt* (si: SHORTINT);  BEGIN ASSERT(r.form = SInt); S.PUT(r.Adr(), si) END WriteSInt;  PROCEDURE (VAR r: Rider) WriteInt* (i: INTEGER);  BEGIN ASSERT(r.form = Int); S.PUT(r.Adr(), i) END WriteInt;  PROCEDURE (VAR r: Rider) WriteLInt* (li: LONGINT);  BEGIN ASSERT(r.form = LInt); S.PUT(r.Adr(), li) END WriteLInt;  PROCEDURE (VAR r: Rider) WriteReal* (x: REAL);  BEGIN ASSERT(r.form = Real); S.PUT(r.Adr(), x) END WriteReal;  PROCEDURE (VAR r: Rider) WriteLReal* (lr: LONGREAL);  BEGIN ASSERT(r.form = LReal); S.PUT(r.Adr(), lr) END WriteLReal;  PROCEDURE (VAR r: Rider) WriteSet* (s: SET);  BEGIN ASSERT(r.form = Set); S.PUT(r.Adr(), s) END WriteSet;  PROCEDURE (VAR r: Rider) WriteProc* (p: ProcVar);  BEGIN ASSERT(r.form = Procedure); S.PUT(r.Adr(), p) END WriteProc;  PROCEDURE (VAR r: Rider) WritePtr* (p: S.PTR);  BEGIN ASSERT(r.form = Pointer); S.PUT(r.Adr(), p) (* type should be checked *) END WritePtr;  PROCEDURE (VAR r: Rider) WriteString* (str: ARRAY OF CHAR);  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;  PROCEDURE (VAR r: Rider) LookAhead;  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;  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). *)  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.lenAdr = 0 THEN x := 1 ELSE S.GET(lenAdr, x) END ; s := s * x ELSE INC(lenAdr, 4) END END ; r.elemSize := s * size; IF r.lenAdr = 0 THEN dim0 := 1 ELSE S.GET(lenAdr, dim0) END END END ScanArray;  PROCEDURE (VAR r: Rider) Next*;  VAR r2: Rider; PROCEDURE SkipTyp (VAR r: Rider; form: SHORTINT);  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;  PROCEDURE SkipObj (VAR r: Rider; VAR tag: SHORTINT);  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;  PROCEDURE SkipVariables (VAR r: Rider);  VAR tag: SHORTINT; BEGIN S.GET(r.pos, tag); WHILE tag IN {Var, VarPar} DO INC(r.pos); SkipObj(r, tag) END END SkipVariables;  PROCEDURE SkipFields (VAR r: Rider);  VAR tag: SHORTINT; BEGIN S.GET(r.pos, tag); WHILE tag # 0 DO SkipObj(r, tag) END ; INC(r.pos) END SkipFields;  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;  PROCEDURE (VAR r: Rider) SetTo* (idx: LONGINT); (** in records: go to ith extension level; in arrays: go to ith element *)  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;  PROCEDURE (VAR r: Rider) ToFirstField; (* positions in the reference section to the first field of type r.type, afterwards: r.mode IN {Fld, Eol} *)  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;  PROCEDURE (VAR r: Rider) Type* (): Types.Type;  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  (*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)  ELSE  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) END ELSIF r.mode = Type THEN RETURN r.type ELSIF r.form = Pointer THEN  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 ELSE HALT(99) END END Type;  PROCEDURE (VAR r: Rider) Zoom* (VAR sub: Rider); (** *)  VAR p: S.PTR; baseForm, dims: SHORTINT; BEGIN CASE r.mode OF Var, VarPar, Elem, Fld: CASE r.form OF Record: IF r.base = 0 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.base = 0 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.base = 0 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;  (* ---------- procedures for opening riders ----------*) PROCEDURE Init (VAR mod: ARRAY OF CHAR; VAR r: Rider): BOOLEAN;  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;  PROCEDURE OpenStack* (info: ExceptionInfo; VAR r: Rider); (** if info # NIL, information in the ExceptionInfo is used *)  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;  PROCEDURE OpenVars* (mod: ARRAY OF CHAR; VAR r: Rider);  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;  PROCEDURE OpenProcs* (mod: ARRAY OF CHAR; VAR r: Rider);  (** 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;  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) & ((S.ADR(m.code^) > pc) OR (pc > S.ADR(m.code^) + LEN(m.code^))) 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);  (** 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;  (* PROCEDURE OpenType* (t: Types.Type; VAR r: Rider);  (** opens a rider r for the record type t *) BEGIN r.type := t; r.ToFirstField END OpenType;  *) PROCEDURE OpenPtr* (p: S.PTR; VAR r: Rider);  (*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 (S.VAL(LONGINT, p) = -1) & (r.base = 0) 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;  PROCEDURE PC* (mod, name: ARRAY OF CHAR): LONGINT;  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;  END Ref.