Generic.Reflection.Mod 35 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125
  1. MODULE Reflection;
  2. (** (c) Felix Friedrich, ETH Zurich, 2016 -- Reflection with more structured references section emitted by FoxCompiler *)
  3. IMPORT Modules, Streams, SYSTEM, Machine, Heaps, Objects, Trace;
  4. CONST
  5. ShowAllProcs = TRUE;
  6. MaxFrames = 128;
  7. MaxString = 64;
  8. MaxArray = 8;
  9. MaxCols = 70;
  10. Sep = " ";
  11. SepLen = 2;
  12. LineDelay = 0;
  13. CONST
  14. sfTypeNone* = 0X;
  15. sfTypeCHAR* = 01X;
  16. sfTypeCHAR8* = 02X;
  17. sfTypeCHAR16* = 03X;
  18. sfTypeCHAR32* = 04X;
  19. sfTypeRANGE* = 05X;
  20. sfTypeSHORTINT* = 06X;
  21. sfTypeINTEGER* = 07X;
  22. sfTypeLONGINT* = 08X;
  23. sfTypeHUGEINT* = 09X;
  24. sfTypeWORD* = 0AX;
  25. sfTypeLONGWORD* = 0BX;
  26. sfTypeSIGNED8* = 0CX;
  27. sfTypeSIGNED16* = 0DX;
  28. sfTypeSIGNED32* = 0EX;
  29. sfTypeSIGNED64* = 0FX;
  30. sfTypeUNSIGNED8* = 10X;
  31. sfTypeUNSIGNED16* = 11X;
  32. sfTypeUNSIGNED32* = 12X;
  33. sfTypeUNSIGNED64* = 13X;
  34. sfTypeREAL* = 14X;
  35. sfTypeLONGREAL* = 15X;
  36. sfTypeCOMPLEX* = 16X;
  37. sfTypeLONGCOMPLEX* = 17X;
  38. sfTypeBOOLEAN* = 18X;
  39. sfTypeSET* = 19X;
  40. sfTypeANY* = 1AX;
  41. sfTypeOBJECT* = 1BX;
  42. sfTypeBYTE* = 1CX;
  43. sfTypeADDRESS* = 1DX;
  44. sfTypeSIZE* = 1EX;
  45. sfTypeRecord* = 20X;
  46. sfTypePointerToRecord* = 21X;
  47. sfTypePointerToArray* = 22X;
  48. sfTypeOpenArray* = 23X;
  49. sfTypeStaticArray* = 24X;
  50. sfTypeDynamicArray* = 25X;
  51. sfTypeMathStaticArray* = 26X;
  52. sfTypeMathOpenArray* = 27X;
  53. sfTypeMathTensor* = 28X;
  54. sfTypeDelegate* = 29X;
  55. sfTypeENUM* = 2AX;
  56. sfTypeCELL* = 2BX;
  57. sfTypePORT* = 2CX;
  58. sfIN* = 0X;
  59. sfOUT* = 1X;
  60. (* variable / parameter addressing modes *)
  61. sfAbsolute* = 0X; (* global vars *)
  62. sfRelative* = 1X; (* variables, value parameters *)
  63. sfIndirect* = 2X; (* var parameters *)
  64. sfScopeBegin* = 0F0X;
  65. sfScopeEnd* = 0F1X;
  66. sfProcedure* = 0F2X;
  67. sfVariable* = 0F3X;
  68. sfTypeDeclaration* = 0F4X;
  69. sfModule*= 0FFX;
  70. (*
  71. References section format:
  72. Scope = sfScopeBegin {variable:Variable} {procedure:Procedure} {typeDecl:TypeDeclaration} sfScopeEnd.
  73. Module = sfModule prevSymbolOffset:SIZE name:String Scope.
  74. Procedure = sfProcedure prevSymbolOffset:SIZE name:String start:ADR end:ADR returnType:Type {parameter:Variable} Scope.
  75. Variable = sfVariable prevSymbolOffset:SIZE name:String (sfRelative offset: SIZE | sfIndirec offset: SIZE | sfAbsolute address:ADDRESS) type:Type.
  76. TypeDeclaration = sfTypeDeclaration prevSymbolOffset:SIZE name:String typeInfo:ADR Scope.
  77. *)
  78. VAR
  79. modes: ARRAY 25 OF CHAR;
  80. TYPE
  81. Name = ARRAY 128 OF CHAR;
  82. PROCEDURE CheckHeapAddress(address: ADDRESS): BOOLEAN;
  83. BEGIN
  84. RETURN Machine.ValidHeapAddress(address);
  85. END CheckHeapAddress;
  86. PROCEDURE Wait(w: Streams.Writer);
  87. VAR i: LONGINT;
  88. BEGIN
  89. IF LineDelay > 0 THEN
  90. FOR i := 0 TO LineDelay DO END;
  91. w.Update
  92. END;
  93. END Wait;
  94. PROCEDURE Expect(b: BOOLEAN): BOOLEAN;
  95. BEGIN
  96. IF ~b THEN Trace.String("Format error in references section"); Trace.Ln END;
  97. RETURN b;
  98. END Expect;
  99. (* consume a char from the byte stream *)
  100. PROCEDURE GetChar*(refs: Modules.Bytes; VAR offset: LONGINT): CHAR;
  101. VAR c: CHAR;
  102. BEGIN
  103. IF ~Expect(offset < LEN(refs)) THEN RETURN 0X END;
  104. c := refs[offset];
  105. INC(offset);
  106. RETURN c;
  107. END GetChar;
  108. (* skip a char in the byte stream *)
  109. PROCEDURE SkipChar*(VAR offset: LONGINT);
  110. BEGIN
  111. INC(offset, SIZEOF(CHAR));
  112. END SkipChar;
  113. (* consume an address in the byte stream *)
  114. PROCEDURE GetAddress*(refs: Modules.Bytes; VAR offset: LONGINT): ADDRESS;
  115. VAR adr: ADDRESS; i: LONGINT;
  116. BEGIN
  117. IF ~Expect(offset < LEN(refs)) THEN RETURN 0 END;
  118. FOR i := 0 TO SIZEOF(ADDRESS)-1 DO
  119. SYSTEM.PUT8(ADDRESSOF(adr)+i, GetChar(refs, offset));
  120. END;
  121. RETURN adr;
  122. END GetAddress;
  123. (* skip an address in the byte stream *)
  124. PROCEDURE SkipAddress*(VAR offset: LONGINT);
  125. BEGIN
  126. INC(offset, SIZEOF(ADDRESS));
  127. END SkipAddress;
  128. (* consume a size in the byte stream *)
  129. PROCEDURE GetSize*(refs: Modules.Bytes; VAR offset: LONGINT): SIZE;
  130. VAR size: SIZE; i: LONGINT;
  131. BEGIN
  132. IF ~Expect(offset < LEN(refs)) THEN RETURN 0 END;
  133. FOR i := 0 TO SIZEOF(SIZE)-1 DO
  134. SYSTEM.PUT8(ADDRESSOF(size)+i, refs[offset]);
  135. INC(offset);
  136. END;
  137. RETURN size;
  138. END GetSize;
  139. (* skip a size in the byte stream *)
  140. PROCEDURE SkipSize*(VAR offset: LONGINT);
  141. BEGIN
  142. INC(offset, SIZEOF(SIZE));
  143. END SkipSize;
  144. (* consume a string in the byte stream *)
  145. PROCEDURE GetString*(refs: Modules.Bytes; VAR offset: LONGINT; VAR string: ARRAY OF CHAR);
  146. VAR ch: CHAR; i: LONGINT;
  147. BEGIN
  148. i := 0;
  149. REPEAT
  150. ch := GetChar(refs, offset);
  151. string[i] := ch;
  152. INC(i);
  153. UNTIL ch = 0X;
  154. END GetString;
  155. (* skip a string in the byte stream *)
  156. PROCEDURE SkipString*(refs: Modules.Bytes; VAR offset: LONGINT);
  157. BEGIN
  158. WHILE(refs[offset] # 0X) DO INC(offset) END; INC(offset);
  159. END SkipString;
  160. (* extract a full name from the byte stream by traversing up the symbols in their scopes *)
  161. PROCEDURE GetFullName*(refs: Modules.Bytes; offset: LONGINT; VAR name: ARRAY OF CHAR);
  162. VAR n: LONGINT;
  163. PROCEDURE Traverse(offset: LONGINT);
  164. VAR c: CHAR;
  165. BEGIN
  166. IF offset >= 0 THEN
  167. c := GetChar(refs, offset);
  168. IF (c = sfProcedure) OR (c=sfVariable) OR (c=sfTypeDeclaration) OR (c=sfModule) THEN
  169. Traverse(GetSize(refs, offset));
  170. END;
  171. IF (n > 0) & (n<LEN(name)) THEN name[n] := "."; INC(n); END;
  172. WHILE (n<LEN(name)) & (refs[offset] # 0X) DO
  173. name[n] := refs[offset];
  174. INC(n); INC(offset);
  175. END;
  176. END;
  177. END Traverse;
  178. BEGIN
  179. n := 0;
  180. Traverse(offset);
  181. name[n] := 0X;
  182. END GetFullName;
  183. (* "lock free" version of Modules.ThisTypeByAdr *)
  184. PROCEDURE ThisTypeByAdr(adr: ADDRESS; VAR m: Modules.Module; VAR t: Modules.TypeDesc);
  185. BEGIN
  186. IF adr # 0 THEN
  187. SYSTEM.GET (adr + Heaps.TypeDescOffset, adr);
  188. IF CheckHeapAddress(adr) THEN
  189. t := SYSTEM.VAL(Modules.TypeDesc, adr);
  190. m := t.mod;
  191. ELSE
  192. m := NIL; t := NIL
  193. END
  194. ELSE
  195. m := NIL; t := NIL
  196. END
  197. END ThisTypeByAdr;
  198. (* output type descriptor information *)
  199. PROCEDURE WriteType*(w: Streams.Writer; adr: ADDRESS);
  200. VAR module: Modules.Module; typeDesc: Modules.TypeDesc;
  201. BEGIN
  202. IF CheckHeapAddress(adr) THEN
  203. ThisTypeByAdr(adr, module, typeDesc);
  204. IF module # NIL THEN
  205. w.String(module.name);
  206. ELSE
  207. w.String("NIL"); RETURN
  208. END;
  209. w.String(".");
  210. IF typeDesc # NIL THEN
  211. IF typeDesc.name = "" THEN
  212. w.String("ANONYMOUS")
  213. ELSE
  214. w.String(typeDesc.name);
  215. END;
  216. ELSE
  217. w.String("NIL");
  218. END;
  219. ELSE
  220. w.String("UNKNOWN");
  221. END;
  222. END WriteType;
  223. (* Write the specified procedure name and returns parameters for use with Variables *)
  224. PROCEDURE WriteProc0(w: Streams.Writer; mod: Modules.Module; pc, fp: ADDRESS; VAR refs: Modules.Bytes; VAR refpos: LONGINT; VAR base: ADDRESS);
  225. VAR ch: CHAR; startpc, end: ADDRESS; offset: LONGINT; name: Name;
  226. BEGIN
  227. refpos := -1;
  228. IF mod = NIL THEN
  229. IF pc = 0 THEN w.String("NIL")
  230. ELSE
  231. w.String("Unknown PC="); w.Address(pc); w.Char("H")
  232. END;
  233. IF fp # -1 THEN
  234. w.String(" FP="); w.Address(fp); w.Char("H")
  235. END
  236. ELSE
  237. refs := mod.refs;
  238. refpos := FindByAdr(refs, 0, pc);
  239. IF refpos >= 0 THEN
  240. offset := refpos;
  241. IF GetChar(refs, offset) = sfProcedure THEN
  242. SkipSize(offset);
  243. SkipString(refs, offset);
  244. GetFullName(refs, refpos, name);
  245. startpc := GetAddress(refs, offset);
  246. end := GetAddress(refs, offset);
  247. w.String(name);
  248. w.Char(":"); w.Int(LONGINT(pc-startpc),1);
  249. base := fp; (*! only for local !! *)
  250. refpos := offset;
  251. END;
  252. ELSE
  253. w.String("procedure not found in module "); w.String(mod.name);
  254. END;
  255. w.String(" pc="); w.Int(LONGINT(pc),1); w.String(" ["); w.Address (pc); w.String("H]");
  256. w.String(" = "); w.Int(LONGINT(startpc),1); w.String(" + "); w.Int(LONGINT(pc-startpc),1);
  257. w.String(" crc="); w.Hex(mod.crc,-8);
  258. (*Wait(w);*)
  259. END
  260. END WriteProc0;
  261. PROCEDURE WriteBasicValue*(w: Streams.Writer; type: CHAR; adr: ADDRESS; VAR size: SIZE);
  262. VAR
  263. b: BOOLEAN;
  264. c: CHAR; c8: CHAR8; c16: CHAR16; c32: CHAR32;
  265. s: SHORTINT; i: INTEGER; l: LONGINT; h: HUGEINT;
  266. sz: SIZE; a: ADDRESS;
  267. word: WORD; lword: LONGWORD;
  268. s8: SIGNED8; s16: SIGNED16; s32: SIGNED32; s64: SIGNED64;
  269. u8: UNSIGNED8; u16: UNSIGNED16; u32: UNSIGNED32; u64: UNSIGNED64;
  270. r: REAL; x: LONGREAL;
  271. cplx: COMPLEX; lcplx: LONGCOMPLEX;
  272. set: SET;
  273. byte: SYSTEM.BYTE;
  274. PROCEDURE Signed(i: HUGEINT);
  275. BEGIN
  276. w.Int(i,1);
  277. END Signed;
  278. PROCEDURE Unsigned(i: HUGEINT; size: LONGINT);
  279. BEGIN
  280. w.Hex(i,-2*size);
  281. END Unsigned;
  282. BEGIN
  283. CASE type OF
  284. | sfTypePointerToRecord, sfTypeANY, sfTypeOBJECT:
  285. size := SIZEOF(ADDRESS);
  286. SYSTEM.GET(adr, a); Unsigned(a, SIZEOF(ADDRESS));
  287. | sfTypeBOOLEAN:
  288. size := SIZEOF(BOOLEAN);
  289. SYSTEM.GET(adr, b); IF b THEN w.String("true") ELSE w.String("false") END;
  290. | sfTypeCHAR, sfTypeCHAR8:
  291. size := SIZEOF(CHAR);
  292. SYSTEM.GET(adr, c); IF (c > " ") & (c <= "~") THEN w.Char( c ); ELSE w.Hex( ORD( c ), -2 ); w.Char( "X" ) END;
  293. | sfTypeCHAR16:
  294. size := SIZEOF(CHAR16);
  295. SYSTEM.GET(adr, i); w.Hex(i,-4); w.Char("X");
  296. | sfTypeCHAR32:
  297. size := SIZEOF(CHAR32);
  298. SYSTEM.GET(adr, l); w.Hex(l,-8); w.Char("X");
  299. | sfTypeSHORTINT:
  300. size := SIZEOF(SHORTINT);
  301. SYSTEM.GET(adr, s); Signed(s);
  302. | sfTypeINTEGER:
  303. size := SIZEOF(INTEGER);
  304. SYSTEM.GET(adr, i); Signed(i);
  305. | sfTypeLONGINT:
  306. size := SIZEOF(LONGINT);
  307. SYSTEM.GET(adr, l); Signed(l);
  308. | sfTypeHUGEINT:
  309. size := SIZEOF(HUGEINT);
  310. SYSTEM.GET(adr, h); Signed(h);
  311. | sfTypeWORD:
  312. size := SIZEOF(WORD);
  313. SYSTEM.GET(adr, word); Signed(word);
  314. | sfTypeLONGWORD:
  315. size := SIZEOF(LONGWORD);
  316. SYSTEM.GET(adr, lword); Signed(lword);;
  317. | sfTypeSIGNED8:
  318. size := SIZEOF(SIGNED8);
  319. SYSTEM.GET(adr, s8); Signed(s8);
  320. | sfTypeSIGNED16:
  321. size := SIZEOF(SIGNED16);
  322. SYSTEM.GET(adr, s16); Signed(s16);
  323. | sfTypeSIGNED32:
  324. size := SIZEOF(SIGNED32);
  325. SYSTEM.GET(adr, s32); Signed(s32);
  326. | sfTypeSIGNED64:
  327. size := SIZEOF(SIGNED64);
  328. SYSTEM.GET(adr, s64); Signed(s64);
  329. | sfTypeUNSIGNED8:
  330. size := SIZEOF(UNSIGNED8);
  331. SYSTEM.GET(adr, u8); Unsigned(u8, SIZEOF(UNSIGNED8));
  332. | sfTypeUNSIGNED16:
  333. size := SIZEOF(UNSIGNED16);
  334. SYSTEM.GET(adr, u16); Unsigned(u16, SIZEOF(UNSIGNED16));
  335. | sfTypeUNSIGNED32:
  336. size := SIZEOF(UNSIGNED32);
  337. SYSTEM.GET(adr, u32); Unsigned(u32, SIZEOF(UNSIGNED32));
  338. | sfTypeUNSIGNED64:
  339. size := SIZEOF(UNSIGNED64);
  340. SYSTEM.GET(adr, s64); Unsigned(s64, SIZEOF(UNSIGNED64));
  341. | sfTypeREAL:
  342. size := SIZEOF(REAL);
  343. SYSTEM.GET(adr, r); w.Float(r,7);
  344. w.String(" (");
  345. SYSTEM.GET(adr, u32); Unsigned(u32, SIZEOF(UNSIGNED32));
  346. w.String(")");
  347. | sfTypeLONGREAL:
  348. size := SIZEOF(LONGREAL);
  349. SYSTEM.GET(adr, x); w.Float(x,13);
  350. w.String(" (");
  351. SYSTEM.GET(adr, s64); Unsigned(s64, SIZEOF(UNSIGNED64));
  352. w.String(")");
  353. | sfTypeCOMPLEX:
  354. size := SIZEOF(COMPLEX);
  355. SYSTEM.GET(adr, cplx); w.Float(RE(cplx),7); w.String("+ i*"); w.Float(IM(cplx),7);
  356. | sfTypeLONGCOMPLEX:
  357. size := SIZEOF(LONGCOMPLEX);
  358. SYSTEM.GET(adr, x); w.Float(x,13); SYSTEM.GET(adr + SIZEOF(LONGREAL), x); w.String("+ i*"); w.Float(x,13);
  359. | sfTypeSET:
  360. size := SIZEOF(SET);
  361. SYSTEM.GET(adr, set); w.Set(set);
  362. | sfTypeBYTE:
  363. size := SIZEOF(SYSTEM.BYTE);
  364. SYSTEM.GET(adr, c); Unsigned(ORD(c), 1);
  365. | sfTypeRANGE:
  366. size := SIZEOF(RANGE);
  367. SYSTEM.GET(adr, sz); Unsigned(sz,SIZEOF(SIZE)); w.String(".."); Unsigned(sz, SIZEOF(SIZE));
  368. | sfTypeADDRESS:
  369. size := SIZEOF(ADDRESS);
  370. SYSTEM.GET(adr, a); Unsigned(a, SIZEOF(ADDRESS));
  371. | sfTypeSIZE:
  372. size := SIZEOF(SIZE);
  373. SYSTEM.GET(adr, sz); Signed(sz); w.String("["); Unsigned(sz, SIZEOF(SIZE)); w.String("]");
  374. | sfTypeENUM:
  375. SYSTEM.GET(adr, word); Signed(word);
  376. | sfTypePORT:
  377. SYSTEM.GET(adr, a); Unsigned(a, SIZEOF(ADDRESS));
  378. ELSE
  379. w.String("UNKOWN TYPE "); Unsigned(ORD(type),1);
  380. END;
  381. w.Update;
  382. END WriteBasicValue;
  383. PROCEDURE OnHeapOrStack(adr: ADDRESS; low, high: ADDRESS): BOOLEAN;
  384. BEGIN
  385. RETURN (low <= adr) & (adr < high) OR CheckHeapAddress(adr);
  386. END OnHeapOrStack;
  387. PROCEDURE WriteValueString*(w: Streams.Writer; adr: ADDRESS; maxLen: LONGINT; low, high: ADDRESS);
  388. CONST MaxString = 32;
  389. VAR ch: CHAR;
  390. BEGIN
  391. IF maxLen > MaxString THEN maxLen := MaxString END;
  392. w.Char('"');
  393. LOOP
  394. IF (maxLen <= 0) OR ~OnHeapOrStack(adr, low, high) THEN
  395. EXIT END;
  396. SYSTEM.GET(adr, ch);
  397. IF (ch < " ") OR (ch > "~") THEN EXIT END;
  398. w.Char(ch);
  399. INC(adr);
  400. DEC(maxLen);
  401. END;
  402. w.Char('"');
  403. END WriteValueString;
  404. PROCEDURE WriteValue*(w: Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT; adr: ADDRESS; low, high: ADDRESS);
  405. VAR type: CHAR; a: ADDRESS; size: SIZE; len: SIZE;
  406. BEGIN
  407. IF ~OnHeapOrStack(adr, low, high) THEN
  408. SkipType(refs, offset);
  409. w.String("INVALID ADR:"); w.Address(adr);
  410. RETURN;
  411. END;
  412. type := GetChar(refs, offset);
  413. CASE type OF
  414. sfTypeNone:
  415. w.String("NONE");
  416. | sfTypePointerToRecord, sfTypeANY, sfTypeOBJECT:
  417. WriteBasicValue(w,type, adr, size);
  418. SYSTEM.GET(adr, a);
  419. IF a = 0 THEN
  420. w.String("NIL");
  421. ELSIF CheckHeapAddress(a) THEN
  422. SYSTEM.GET(a + Heaps.TypeDescOffset, a);
  423. w.String(" (");
  424. WriteType(w,a);
  425. w.String(")");
  426. ELSE
  427. w.String("(UNKNOWN)");
  428. END;
  429. | sfTypePointerToArray:
  430. WriteBasicValue(w, sfTypeANY, adr, size);
  431. SYSTEM.GET(adr, a);
  432. IF ~OnHeapOrStack(a,low,high) THEN w.String(" (INVALID)") END;
  433. SkipType(refs, offset)
  434. | sfTypeOpenArray:
  435. IF (refs[offset] = sfTypeCHAR) OR (refs[offset] = sfTypeCHAR8) THEN (* ARRAY OF CHAR *)
  436. SYSTEM.GET(adr, a);
  437. WriteValueString(w, a, MaxString, low, high);
  438. ELSE
  439. w.String("... (NO STRING)")
  440. END;
  441. SkipType(refs, offset);
  442. | sfTypeStaticArray:
  443. len := GetSize(refs, offset);
  444. IF (refs[offset] = sfTypeCHAR) OR (refs[offset] = sfTypeCHAR8) THEN (* ARRAY x OF CHAR *)
  445. WriteValueString(w, adr, len, low, high);
  446. ELSE
  447. w.String("... (NO STRING)");
  448. END;
  449. SkipType(refs, offset);
  450. | sfTypeDynamicArray:
  451. w.String("... (DYNAMIC ARRAY)");
  452. SkipType(refs, offset);
  453. | sfTypeMathOpenArray:
  454. w.String("... (MATH OPEN ARRAY)");
  455. SkipType(refs, offset);
  456. | sfTypeMathStaticArray:
  457. w.String("... (MATH STATIC ARRAY)");
  458. SkipSize(offset); SkipType(refs, offset);
  459. | sfTypeMathTensor:
  460. w.String("...(MATH TENSOR)");
  461. SkipType(refs, offset);
  462. | sfTypeRecord:
  463. w.String("...");
  464. w.String("(");
  465. a := GetAddress(refs, offset);
  466. WriteType(w,a);
  467. w.String(")");
  468. | sfTypeDelegate:
  469. w.String("(DELEGATE)");
  470. WHILE refs[offset] = sfVariable DO SkipVariable(refs, offset) END;
  471. SkipType(refs, offset);
  472. | sfTypePORT:
  473. WriteBasicValue(w, type, adr, size);
  474. SkipChar(offset);
  475. ELSE
  476. WriteBasicValue(w, type, adr, size);
  477. END;
  478. w.Update;
  479. END WriteValue;
  480. PROCEDURE WriteVariable*(w: Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT; base: ADDRESS; low, high: ADDRESS);
  481. VAR name: ARRAY 128 OF CHAR; adr: LONGINT; prevScope: SIZE; c: CHAR;
  482. BEGIN
  483. IF ~Expect(GetChar(refs, offset) = sfVariable) THEN RETURN END;
  484. prevScope := GetSize(refs, offset);
  485. GetString(refs, offset, name);
  486. w.String(Sep); w.String(name); w.Char("=");
  487. c := GetChar(refs, offset);
  488. IF c = sfRelative THEN
  489. adr := base + GetSize(refs, offset)
  490. ELSIF c = sfIndirect THEN
  491. adr := base + GetSize(refs, offset);
  492. w.Address(adr); w.String("->");
  493. IF ~OnHeapOrStack(adr,low,high) THEN w.String(" (INVALID)");
  494. SkipType(refs,offset);
  495. RETURN;
  496. END;
  497. SYSTEM.GET(adr, adr);
  498. ELSE (* absolute *)
  499. adr := GetAddress(refs, offset);
  500. END;
  501. WriteValue(w, refs, offset, adr, low, high);
  502. END WriteVariable;
  503. (* write variables taking meta information from stream in stream at offset, potentially stored at base address
  504. *)
  505. PROCEDURE WriteVariables*(w: Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT; base: ADDRESS; low, high: ADDRESS);
  506. VAR count: LONGINT;
  507. BEGIN
  508. WHILE refs[offset] = sfVariable DO
  509. WriteVariable(w, refs, offset, base, low, high); w.Ln;
  510. (*INC(count); *)
  511. END;
  512. IF count > 0 THEN w.Ln; Wait(w); END;
  513. END WriteVariables;
  514. (* skip type metadata in stream *)
  515. PROCEDURE SkipType*(refs: Modules.Bytes; VAR offset: LONGINT);
  516. VAR size: SIZE; adr: LONGINT; c: CHAR;
  517. BEGIN
  518. c := GetChar(refs, offset);
  519. CASE c OF
  520. sfTypeNone .. sfTypeSIZE:
  521. | sfTypePointerToRecord:
  522. | sfTypePointerToArray: SkipType(refs, offset);
  523. | sfTypeOpenArray: SkipType(refs, offset);
  524. | sfTypeStaticArray: SkipSize(offset); SkipType(refs, offset);
  525. | sfTypeDynamicArray: SkipType(refs, offset);
  526. | sfTypeMathOpenArray: SkipType(refs, offset);
  527. | sfTypeMathStaticArray: SkipSize(offset); SkipType(refs, offset);
  528. | sfTypeMathTensor: SkipType(refs, offset);
  529. | sfTypeRecord: SkipSize(offset);
  530. | sfTypeDelegate:
  531. WHILE refs[offset] = sfVariable DO SkipVariable(refs, offset) END;
  532. SkipType(refs, offset);
  533. | sfTypeENUM:
  534. | sfTypePORT: SkipChar(offset);
  535. ELSE (* ?? *)
  536. END;
  537. END SkipType;
  538. (* skip procedure metadata in stream *)
  539. PROCEDURE SkipProcedure*(refs: Modules.Bytes; VAR offset: LONGINT);
  540. BEGIN
  541. IF ~Expect(GetChar(refs, offset) = sfProcedure) THEN RETURN END;
  542. SkipSize(offset);
  543. SkipString(refs, offset);
  544. SkipAddress(offset);
  545. SkipAddress(offset);
  546. WHILE (refs[offset] = sfVariable) DO SkipVariable(refs, offset) END;
  547. SkipType(refs, offset);
  548. SkipScope(refs, offset);
  549. END SkipProcedure;
  550. (* skip variable metadata in stream *)
  551. PROCEDURE SkipVariable*(refs: Modules.Bytes; VAR offset: LONGINT);
  552. BEGIN
  553. IF ~Expect(GetChar(refs, offset) = sfVariable) THEN RETURN END;
  554. SkipSize(offset);
  555. SkipString(refs, offset);
  556. SkipChar(offset);
  557. SkipAddress(offset);
  558. SkipType(refs, offset);
  559. END SkipVariable;
  560. (* skip type declaration meta data in stream *)
  561. PROCEDURE SkipTypeDeclaration*(refs: Modules.Bytes; VAR offset: LONGINT);
  562. BEGIN
  563. IF ~Expect(GetChar(refs, offset) = sfTypeDeclaration) THEN RETURN END;
  564. SkipSize(offset);
  565. SkipString(refs, offset);
  566. SkipAddress(offset);
  567. IF refs[offset] = sfScopeBegin THEN SkipScope(refs, offset) END;
  568. END SkipTypeDeclaration;
  569. (* skip type declaration meta data in stream *)
  570. PROCEDURE SkipModule*(refs: Modules.Bytes; VAR offset: LONGINT);
  571. BEGIN
  572. IF ~Expect(GetChar(refs, offset) = sfModule) THEN RETURN END;
  573. SkipSize(offset);
  574. SkipString(refs, offset);
  575. IF refs[offset] = sfScopeBegin THEN SkipScope(refs, offset) END;
  576. END SkipModule;
  577. (* skip a scope in stream *)
  578. PROCEDURE SkipScope*(refs: Modules.Bytes; VAR offset: LONGINT);
  579. BEGIN
  580. IF ~Expect(GetChar(refs, offset) = sfScopeBegin) THEN RETURN END;
  581. WHILE (refs[offset] = sfVariable) DO SkipVariable(refs, offset) END;
  582. WHILE (refs[offset] = sfProcedure) DO SkipProcedure(refs, offset) END;
  583. WHILE (refs[offset] = sfTypeDeclaration) DO SkipTypeDeclaration(refs, offset) END;
  584. IF ~Expect(GetChar(refs, offset) = sfScopeEnd) THEN RETURN END;
  585. END SkipScope;
  586. TYPE
  587. Search = RECORD
  588. name: ARRAY 256 OF CHAR; (* for search by name *)
  589. nameOffset: LONGINT; (* to incrementally search through scopes *)
  590. minLevel: LONGINT; (* in order to stop scope search *)
  591. pc: ADDRESS; (* for search by address *)
  592. pos: LONGINT; (* symbol position in stream, -1 if not found *)
  593. found: BOOLEAN; (* if found *)
  594. END;
  595. (* check if stream contains the string part stored in search record with respective offset *)
  596. PROCEDURE FindString(refs: Modules.Bytes; VAR offset: LONGINT; level: LONGINT; VAR find: Search);
  597. VAR ofs: LONGINT;
  598. BEGIN
  599. IF find.minLevel > level THEN
  600. SkipString(refs, offset)
  601. ELSE
  602. ofs := find.nameOffset;
  603. WHILE (refs[offset] # 0X) & (find.name[ofs] = refs[offset]) DO
  604. INC(offset); INC(ofs);
  605. END;
  606. IF (refs[offset] = 0X) THEN
  607. IF find.name[ofs] = 0X THEN
  608. find.found := TRUE;
  609. ELSIF find.name[ofs] = "." THEN
  610. find.minLevel := level+1;
  611. find.nameOffset := ofs+1;
  612. END;
  613. END;
  614. WHILE(refs[offset] # 0X) DO INC(offset) END;
  615. INC(offset);
  616. END;
  617. END FindString;
  618. (* find a symbol by name or pc starting from the procedure stream section *)
  619. PROCEDURE FindInProcedure(refs: Modules.Bytes; VAR offset: LONGINT; level: LONGINT; VAR find: Search);
  620. VAR name: ARRAY 128 OF CHAR; start, end, pos: LONGINT;
  621. BEGIN
  622. pos := offset;
  623. IF ~Expect(GetChar(refs, offset) = sfProcedure) THEN RETURN END;
  624. SkipSize(offset);
  625. FindString(refs, offset, level, find);
  626. start := GetAddress(refs, offset);
  627. end := GetAddress(refs, offset);
  628. find.found := find.found OR (start <= find.pc) & (find.pc < end);
  629. IF find.found THEN
  630. find.pos := pos;
  631. RETURN;
  632. END;
  633. WHILE (refs[offset] = sfVariable) DO
  634. IF find.minLevel <= level+1 THEN
  635. FindInVariable(refs, offset, level+1, find);
  636. IF find.found THEN RETURN END;
  637. ELSE
  638. SkipVariable(refs, offset)
  639. END;
  640. END;
  641. SkipType(refs, offset);
  642. FindInScope(refs, offset, level+1, find);
  643. END FindInProcedure;
  644. (* find a symbol by name or pc starting from the variable stream section *)
  645. PROCEDURE FindInVariable(refs: Modules.Bytes; VAR offset: LONGINT; level: LONGINT; VAR find: Search);
  646. VAR name: ARRAY 128 OF CHAR; pos: LONGINT;
  647. BEGIN
  648. pos := offset;
  649. IF ~Expect(GetChar(refs, offset) = sfVariable) THEN RETURN END;
  650. SkipSize(offset);
  651. FindString(refs, offset, level, find);
  652. IF find.found THEN
  653. find.pos := pos;
  654. RETURN;
  655. END;
  656. SkipChar(offset);
  657. SkipSize(offset);
  658. SkipType(refs, offset);
  659. END FindInVariable;
  660. (* find a symbol by name or pc starting from the type declaration stream section *)
  661. PROCEDURE FindInTypeDeclaration(refs: Modules.Bytes; VAR offset: LONGINT; level: LONGINT; VAR find: Search);
  662. VAR name: ARRAY 128 OF CHAR; adr, pos: LONGINT;
  663. BEGIN
  664. pos := offset;
  665. IF ~Expect(GetChar(refs, offset) = sfTypeDeclaration) THEN RETURN END;
  666. SkipSize(offset);
  667. FindString(refs, offset, level, find);
  668. IF find.found THEN
  669. find.pos := pos;
  670. RETURN;
  671. END;
  672. SkipAddress(offset);
  673. IF refs[offset] = sfScopeBegin THEN FindInScope(refs, offset, level+1, find) END;
  674. END FindInTypeDeclaration;
  675. PROCEDURE FindInModule(refs: Modules.Bytes; VAR offset: LONGINT; level: LONGINT; VAR find: Search);
  676. VAR pos: LONGINT;
  677. BEGIN
  678. pos := offset;
  679. IF ~Expect(GetChar(refs, offset) = sfModule) THEN RETURN END;
  680. SkipSize(offset);
  681. FindString(refs, offset, level, find);
  682. IF find.found THEN
  683. find.pos := pos;
  684. RETURN;
  685. END;
  686. FindInScope(refs, offset, level+1, find);
  687. END FindInModule;
  688. (* find a symbol by name or pc in a scope in the stream *)
  689. PROCEDURE FindInScope(refs: Modules.Bytes; VAR offset: LONGINT; level: LONGINT; VAR find: Search);
  690. VAR no,i: LONGINT;
  691. BEGIN
  692. IF ~Expect(GetChar(refs, offset) = sfScopeBegin) THEN RETURN END;
  693. WHILE ~find.found &(refs[offset] = sfVariable) & (find.minLevel <= level) DO (* Variable *)
  694. FindInVariable(refs, offset, level, find);
  695. END;
  696. WHILE ~find.found & (refs[offset] = sfProcedure) & (find.minLevel <= level) DO (* Procedure *)
  697. FindInProcedure(refs, offset, level, find);
  698. END;
  699. WHILE ~find.found & (refs[offset] = sfTypeDeclaration) & (find.minLevel <= level) DO (* TypeDeclaration *)
  700. FindInTypeDeclaration(refs, offset,level, find);
  701. END;
  702. IF find.found OR (find.minLevel > level) THEN RETURN END;
  703. IF ~Expect(GetChar(refs, offset) = sfScopeEnd) THEN RETURN END;
  704. END FindInScope;
  705. PROCEDURE InitSearch(VAR search: Search);
  706. BEGIN
  707. search.found := FALSE;
  708. search.pos := -1;
  709. search.name := "";
  710. search.nameOffset := 0;
  711. search.minLevel := 0;
  712. search.pc := 0;
  713. END InitSearch;
  714. (* Find a symbol in the stream starting at offset.
  715. If name is supposed to contain the referred to symbol, choose skipFirstSymbol = FALSE
  716. Example FindByName(m.refs, 0, "Reflection.FindByName", FALSE)
  717. otherwise choose skipFirstSymbol = TRUE
  718. Example FindByName(m.refs, 0, "FindByName", TRUE);
  719. *)
  720. PROCEDURE FindByName*(refs: Modules.Bytes; offset: LONGINT; CONST name: ARRAY OF CHAR; skipFirstSymbol: BOOLEAN): SIZE;
  721. VAR search: Search;
  722. BEGIN
  723. InitSearch(search);
  724. COPY(name, search.name);
  725. IF skipFirstSymbol THEN search.minLevel := 1 END;
  726. CASE refs[offset] OF
  727. sfModule: FindInModule(refs, offset, 0, search);
  728. |sfVariable: FindInVariable(refs, offset, 0, search);
  729. |sfProcedure: FindInProcedure(refs, offset, 0, search);
  730. |sfTypeDeclaration: FindInTypeDeclaration(refs, offset, 0, search);
  731. ELSE (* wrong position in stream *)
  732. END;
  733. RETURN search.pos;
  734. END FindByName;
  735. PROCEDURE FindByAdr*(refs: Modules.Bytes; offset: SIZE; pc: ADDRESS): SIZE;
  736. VAR search: Search;
  737. BEGIN
  738. InitSearch(search);
  739. search.pc := pc;
  740. CASE refs[offset] OF
  741. sfModule: FindInModule(refs, offset, 0, search);
  742. |sfVariable: FindInVariable(refs, offset, 0, search);
  743. |sfProcedure: FindInProcedure(refs, offset, 0, search);
  744. |sfTypeDeclaration: FindInTypeDeclaration(refs, offset, 0, search);
  745. ELSE (* wrong position in stream *)
  746. END;
  747. RETURN search.pos;
  748. END FindByAdr;
  749. (** service procedures *)
  750. (** Find procedure name and write it. *)
  751. PROCEDURE WriteProc*(w: Streams.Writer; pc: ADDRESS);
  752. VAR refs: Modules.Bytes; refpos: LONGINT; base: ADDRESS;
  753. BEGIN
  754. WriteProc0(w, Modules.ThisModuleByAdr0(pc), pc, -1, refs, refpos, base)
  755. END WriteProc;
  756. (** Write the state of the specified module. *)
  757. PROCEDURE ModuleState*(w: Streams.Writer; mod: Modules.Module);
  758. VAR offset: LONGINT; base: ADDRESS; refs: Modules.Bytes;
  759. BEGIN
  760. IF mod = NIL THEN RETURN END;
  761. refs := mod.refs;
  762. offset := 0;
  763. w.String("State "); w.String(mod.name); w.Char(":"); w.Ln; Wait(w);
  764. IF (GetChar(refs, offset) = sfModule) THEN
  765. SkipSize(offset);
  766. SkipString(refs, offset);
  767. IF (GetChar(refs, offset) = sfScopeBegin) THEN
  768. WriteVariables(w, refs, offset, 0, 0, 0)
  769. END;
  770. END;
  771. END ModuleState;
  772. PROCEDURE CheckBP(bp: ADDRESS): ADDRESS;
  773. VAR n: ADDRESS;
  774. BEGIN
  775. IF bp # NIL THEN
  776. SYSTEM.GET(bp, n);
  777. IF ODD(n) THEN INC(bp, SIZEOF(ADDRESS)) END;
  778. END;
  779. RETURN bp;
  780. END CheckBP;
  781. (* Display call trackback. *)
  782. PROCEDURE StackTraceBack*(w: Streams.Writer; pc, bp: ADDRESS; low,high: ADDRESS; long, overflow: BOOLEAN);
  783. VAR count,offset: LONGINT; stacklow: ADDRESS; base: ADDRESS; m: Modules.Module; refs: Modules.Bytes;
  784. BEGIN
  785. count := 0; (* frame count *)
  786. REPEAT
  787. m := Modules.ThisModuleByAdr0(pc);
  788. IF (ShowAllProcs OR (m # NIL) OR (count = 0)) & (bp # 0) & (bp >= low) & (bp < high) THEN
  789. IF CheckHeapAddress( pc ) THEN
  790. WriteProc0(w, m, pc, bp, refs, offset, base); w.Ln;Wait(w); w.Update;
  791. IF long & (~overflow OR (count > 0)) THEN (* show variables *)
  792. IF offset >= 0 THEN
  793. WriteVariables(w,refs,offset, base, low, high);
  794. SkipType(refs, offset);
  795. IF Expect(GetChar(refs, offset) = sfScopeBegin) THEN
  796. WriteVariables(w,refs,offset, base, low, high);
  797. END;
  798. END;
  799. IF (m # NIL) & (base # m.sb) & (count = 0) THEN ModuleState(w, m) END
  800. END;
  801. ELSE
  802. w.String( "Unknown external procedure, pc = " ); w.Address( pc ); w.Ln; Wait(w);
  803. END;
  804. bp := CheckBP(bp);
  805. SYSTEM.GET(bp + SIZEOF(ADDRESS), pc); (* return addr from stack *)
  806. SYSTEM.GET(bp, bp); (* follow dynamic link *)
  807. INC(count)
  808. ELSE
  809. bp := 0
  810. END;
  811. UNTIL (bp = 0) OR (count = MaxFrames);
  812. IF bp # 0 THEN w.String("...") END
  813. END StackTraceBack;
  814. (** Write a process's state in one line. *)
  815. PROCEDURE WriteProcess*(w: Streams.Writer; p: Objects.Process);
  816. VAR adr: ADDRESS; mode: LONGINT; m: Modules.Module;
  817. BEGIN
  818. IF p # NIL THEN
  819. w.Int(p.id, 5);
  820. mode := p.mode;
  821. IF (mode >= Objects.Ready) & (mode <= Objects.Terminated) THEN
  822. adr := (mode-Objects.Ready)*4;
  823. FOR adr := adr TO adr+3 DO w.Char(modes[adr]) END
  824. ELSE
  825. w.Char(" "); w.Int(mode, 1)
  826. END;
  827. w.Int(p.procID, 2);
  828. w.Int(p.priority, 2);
  829. w.Update;
  830. w.Address (SYSTEM.VAL(ADDRESS, p.obj));
  831. IF p.obj # NIL THEN
  832. SYSTEM.GET(SYSTEM.VAL(ADDRESS, p.obj) - SIZEOF(ADDRESS), adr);
  833. w.Char(":"); WriteType(w, adr)
  834. END;
  835. w.Update;
  836. w.Char(" "); WriteProc(w, p.state.PC);
  837. IF p.mode = Objects.AwaitingLock THEN
  838. adr := SYSTEM.VAL(ADDRESS, p.waitingOn);
  839. w.Address (adr);
  840. w.Update;
  841. IF adr # 0 THEN (* can be 0 when snapshot is taken *)
  842. SYSTEM.GET(adr - SIZEOF(ADDRESS), adr);
  843. IF adr = SYSTEM.TYPECODE(Modules.Module) THEN
  844. w.Char("-");
  845. m := SYSTEM.VAL(Modules.Module, adr);
  846. w.String(m.name)
  847. ELSE
  848. w.Char(":"); WriteType(w, adr)
  849. END;
  850. w.Update;
  851. END
  852. ELSIF p.mode = Objects.AwaitingCond THEN
  853. w.Char(" "); WriteProc(w, SYSTEM.VAL(ADDRESS, p.condition));
  854. w.Address (p.condFP)
  855. END;
  856. w.Char(" "); w.Set(p.flags)
  857. END
  858. END WriteProcess;
  859. (* for interface compatibility *)
  860. PROCEDURE GetVariableAdr*(fp, pc: ADDRESS; CONST name: ARRAY OF CHAR): SIZE;
  861. BEGIN
  862. RETURN -1;
  863. END GetVariableAdr;
  864. PROCEDURE GetProcedureName*(pc: ADDRESS; VAR name: ARRAY OF CHAR; VAR startpc: ADDRESS);
  865. VAR m: Modules.Module; offset: LONGINT;
  866. BEGIN
  867. name := "";
  868. m := Modules.ThisModuleByAdr0(pc);
  869. IF m # NIL THEN
  870. offset := FindByAdr(m.refs,0,pc);
  871. IF offset >= 0 THEN
  872. GetFullName(m.refs, offset, name);
  873. IF GetChar(m.refs, offset) = sfProcedure THEN
  874. SkipSize(offset);
  875. SkipString(m.refs,offset);
  876. startpc := GetAddress(m.refs, offset);
  877. END;
  878. END;
  879. END;
  880. END GetProcedureName;
  881. TYPE
  882. Variable* = RECORD
  883. adr-: ADDRESS;
  884. type-, size-, n-, tdadr-: LONGINT
  885. END;
  886. PROCEDURE FindVar*(mod: Modules.Module; CONST name: ARRAY OF CHAR; VAR v: Variable): BOOLEAN;
  887. BEGIN
  888. END FindVar;
  889. PROCEDURE WriteVar*(w: Streams.Writer; v: Variable; VAR col: LONGINT);
  890. BEGIN
  891. END WriteVar;
  892. PROCEDURE ReportType(w:Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT);
  893. VAR size: SIZE; adr: LONGINT; c: CHAR;
  894. BEGIN
  895. c := GetChar(refs, offset);
  896. CASE c OF
  897. sfTypeNone: w.String("no type");
  898. | sfTypePointerToRecord: w.String("POINTER TO RECORD");
  899. | sfTypePointerToArray: w.String("POINTER TO "); ReportType(w, refs, offset);
  900. | sfTypeOpenArray: w.String("ARRAY OF "); ReportType(w, refs, offset);
  901. | sfTypeStaticArray: w.String("ARRAY "); w.Int(GetSize(refs, offset),1 ); w.String(" OF "); ReportType(w, refs, offset);
  902. | sfTypeDynamicArray: w.String("DARRAY OF "); ReportType(w,refs, offset);
  903. | sfTypeMathOpenArray: w.String("ARRAY [*] OF "); ReportType(w, refs, offset);
  904. | sfTypeMathStaticArray: w.String("ARRAY ["); w.Int(GetSize(refs, offset),1); w.String("] OF "); ReportType(w, refs, offset);
  905. | sfTypeMathTensor: w.String("ARRAY [?] OF "); ReportType(w, refs, offset);
  906. | sfTypeRecord: w.String("RECORD "); w.Address(GetAddress(refs, offset));
  907. | sfTypeDelegate:
  908. w.String("PROCEDURE (");
  909. WHILE refs[offset] = sfVariable DO ReportVariable(w, refs, offset) END;
  910. w.String("):"); ReportType(w, refs, offset);
  911. | sfTypeBOOLEAN: w.String("BOOLEAN");
  912. | sfTypeCHAR: w.String("CHAR");
  913. | sfTypeCHAR8: w.String("CHAR8");
  914. | sfTypeCHAR16: w.String("CHAR16");
  915. | sfTypeCHAR32: w.String("CHAR32");
  916. | sfTypeSHORTINT: w.String("SHORTINT");
  917. | sfTypeINTEGER: w.String("INTEGER");
  918. | sfTypeLONGINT: w.String("LONGINT");
  919. | sfTypeHUGEINT: w.String("HUGEINT");
  920. | sfTypeWORD: w.String("WORD");
  921. | sfTypeLONGWORD: w.String("LONGWORD");
  922. | sfTypeSIGNED8: w.String("SIGNED8");
  923. | sfTypeSIGNED16: w.String("SIGNED16");
  924. | sfTypeSIGNED32: w.String("SIGNED32");
  925. | sfTypeSIGNED64: w.String("SIGNED64");
  926. | sfTypeUNSIGNED8: w.String("UNSIGNED8");
  927. | sfTypeUNSIGNED16: w.String("UNSIGNED16");
  928. | sfTypeUNSIGNED32: w.String("UNSIGNED32");
  929. | sfTypeUNSIGNED64: w.String("UNSIGNED64");
  930. | sfTypeREAL: w.String("REAL");
  931. | sfTypeLONGREAL: w.String("LONGREAL");
  932. | sfTypeCOMPLEX: w.String("COMPLEX");
  933. | sfTypeLONGCOMPLEX: w.String("LONGCOMPLEX");
  934. | sfTypeSET: w.String("SET");
  935. | sfTypeANY: w.String("ANY");
  936. | sfTypeOBJECT: w.String("OBJECT");
  937. | sfTypeBYTE: w.String("BYTE");
  938. | sfTypeRANGE: w.String("RANGE");
  939. | sfTypeADDRESS: w.String("ADDRESS");
  940. | sfTypeSIZE: w.String("SIZE");
  941. | sfTypePORT: w.String("PORT"); IF GetChar(refs,offset) = sfIN THEN w.String("IN") ELSE w.String("OUT") END;
  942. ELSE w.String("????? TYPE ?????");
  943. END;
  944. END ReportType;
  945. PROCEDURE ReportProcedure(w: Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT);
  946. VAR name: Name; start, end: LONGINT;
  947. BEGIN
  948. w.Int(offset,1); w.String(":");
  949. w.String("PROCEDURE ");
  950. IF ~Expect(GetChar(refs, offset) = sfProcedure) THEN RETURN END;
  951. SkipSize(offset);
  952. GetString(refs, offset, name);
  953. w.String(name);
  954. start := GetAddress(refs, offset);
  955. end := GetAddress(refs, offset);
  956. w.String("[@"); w.Address(start); w.String(" - "); w.Address(end); w.String("]");
  957. w.String("("); w.Ln;
  958. WHILE refs[offset] = sfVariable DO
  959. ReportVariable(w, refs, offset);
  960. END;
  961. w.String(")");
  962. w.String(":");
  963. ReportType(w, refs, offset);
  964. w.Ln;
  965. ReportScope(w, refs, offset);
  966. END ReportProcedure;
  967. PROCEDURE ReportVariable(w: Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT);
  968. VAR name: ARRAY 128 OF CHAR; adr: ADDRESS; size: SIZE;
  969. BEGIN
  970. w.Int(offset,1); w.String(":");
  971. w.String("VAR ");
  972. IF ~Expect(GetChar(refs, offset) = sfVariable) THEN RETURN END;
  973. SkipSize(offset);
  974. GetString(refs, offset, name);
  975. w.String(name);
  976. IF GetChar(refs, offset) = sfRelative THEN
  977. size := GetSize(refs, offset);
  978. w.String("[@"); w.Int(size,1); w.String("]");
  979. ELSE (* absolute *)
  980. adr := GetAddress(refs, offset);
  981. w.String("[@"); w.Address(adr); w.String("]");
  982. END;
  983. w.String(":");
  984. ReportType(w, refs, offset);
  985. w.Ln;
  986. END ReportVariable;
  987. PROCEDURE ReportTypeDeclaration(w: Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT);
  988. VAR name: ARRAY 128 OF CHAR; adr: LONGINT;
  989. BEGIN
  990. w.Int(offset,1); w.String(":");
  991. w.String("TYPE ");
  992. IF ~Expect(GetChar(refs, offset) = sfTypeDeclaration) THEN RETURN END;
  993. SkipSize(offset);
  994. GetString(refs, offset, name);
  995. w.String(name);
  996. adr := GetAddress(refs, offset);
  997. w.String(" ");
  998. w.Address(adr);
  999. w.Ln;
  1000. IF refs[offset] = sfScopeBegin THEN ReportScope(w, refs, offset) END;
  1001. END ReportTypeDeclaration;
  1002. PROCEDURE ReportScope(w:Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT);
  1003. BEGIN
  1004. IF ~Expect(GetChar(refs, offset) = sfScopeBegin) THEN RETURN END;
  1005. w.Int(offset,1); w.String(": Scope"); w.Ln;
  1006. WHILE (refs[offset] = sfVariable) DO (* Variable *)
  1007. ReportVariable(w, refs, offset);
  1008. END;
  1009. WHILE (refs[offset] = sfProcedure) DO (* Procedure *)
  1010. ReportProcedure(w, refs, offset);
  1011. END;
  1012. WHILE (refs[offset] = sfTypeDeclaration) DO (* TypeDeclaration *)
  1013. ReportTypeDeclaration(w, refs, offset);
  1014. END;
  1015. IF ~Expect(GetChar(refs, offset) = sfScopeEnd) THEN RETURN END;
  1016. w.String("END"); w.Ln;
  1017. END ReportScope;
  1018. PROCEDURE ReportModule(w: Streams.Writer; refs: Modules.Bytes; offset: LONGINT);
  1019. VAR name: Name;
  1020. BEGIN
  1021. w.String("MODULE ");
  1022. IF ~Expect(GetChar(refs, offset) = sfModule) THEN RETURN END;
  1023. SkipSize(offset);
  1024. GetString(refs, offset, name);
  1025. w.String(name);
  1026. ReportScope(w, refs, offset);
  1027. END ReportModule;
  1028. PROCEDURE Report*(w:Streams.Writer; refs: Modules.Bytes; offset: LONGINT);
  1029. BEGIN
  1030. CASE refs[offset] OF
  1031. sfModule: ReportModule(w, refs, offset);
  1032. |sfVariable: ReportVariable(w, refs, offset);
  1033. |sfProcedure: ReportProcedure(w, refs, offset);
  1034. |sfTypeDeclaration: ReportTypeDeclaration(w, refs, offset);
  1035. ELSE (* wrong position in stream *)
  1036. END;
  1037. END Report;
  1038. BEGIN
  1039. modes := " rdy run awl awc awe rip"; (* 4 characters per mode from Objects.Ready to Objects.Terminated *)
  1040. END Reflection.
  1041. StaticLinker.Link --fileFormat=PE32 --fileName=A2.exe --extension=GofW --displacement=401000H Runtime Trace Kernel32 Machine Heaps Modules Objects Kernel KernelLog Streams Commands Files WinFS Clock Dates Reals Strings Diagnostics BitSets StringPool ObjectFile GenericLinker Reflection GenericLoader BootConsole ~