Generic.Reflection.Mod 35 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119
  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(u8, SIZEOF(UNSIGNED16));
  335. | sfTypeUNSIGNED32:
  336. size := SIZEOF(UNSIGNED32);
  337. SYSTEM.GET(adr, u32); Unsigned(u8, SIZEOF(UNSIGNED32));
  338. | sfTypeUNSIGNED64:
  339. size := SIZEOF(UNSIGNED64);
  340. SYSTEM.GET(adr, u64); Unsigned(u8, SIZEOF(UNSIGNED64));
  341. | sfTypeREAL:
  342. size := SIZEOF(REAL);
  343. SYSTEM.GET(adr, r); w.Float(r,7);
  344. | sfTypeLONGREAL:
  345. size := SIZEOF(LONGREAL);
  346. SYSTEM.GET(adr, x); w.Float(x,13);
  347. | sfTypeCOMPLEX:
  348. size := SIZEOF(COMPLEX);
  349. SYSTEM.GET(adr, cplx); w.Float(RE(cplx),7); w.String("+ i*"); w.Float(IM(cplx),7);
  350. | sfTypeLONGCOMPLEX:
  351. size := SIZEOF(LONGCOMPLEX);
  352. SYSTEM.GET(adr, x); w.Float(x,13); SYSTEM.GET(adr + SIZEOF(LONGREAL), x); w.String("+ i*"); w.Float(x,13);
  353. | sfTypeSET:
  354. size := SIZEOF(SET);
  355. SYSTEM.GET(adr, set); w.Set(set);
  356. | sfTypeBYTE:
  357. size := SIZEOF(SYSTEM.BYTE);
  358. SYSTEM.GET(adr, c); Unsigned(ORD(c), 1);
  359. | sfTypeRANGE:
  360. size := SIZEOF(RANGE);
  361. SYSTEM.GET(adr, sz); Unsigned(sz,SIZEOF(SIZE)); w.String(".."); Unsigned(sz, SIZEOF(SIZE));
  362. | sfTypeADDRESS:
  363. size := SIZEOF(ADDRESS);
  364. SYSTEM.GET(adr, a); Unsigned(a, SIZEOF(ADDRESS));
  365. | sfTypeSIZE:
  366. size := SIZEOF(SIZE);
  367. SYSTEM.GET(adr, sz); Signed(sz); w.String("["); Unsigned(sz, SIZEOF(SIZE)); w.String("]");
  368. | sfTypeENUM:
  369. SYSTEM.GET(adr, word); Signed(word);
  370. | sfTypePORT:
  371. SYSTEM.GET(adr, a); Unsigned(a, SIZEOF(ADDRESS));
  372. ELSE
  373. w.String("UNKOWN TYPE "); Unsigned(ORD(type),1);
  374. END;
  375. w.Update;
  376. END WriteBasicValue;
  377. PROCEDURE OnHeapOrStack(adr: ADDRESS; low, high: ADDRESS): BOOLEAN;
  378. BEGIN
  379. RETURN (low <= adr) & (adr < high) OR CheckHeapAddress(adr);
  380. END OnHeapOrStack;
  381. PROCEDURE WriteValueString*(w: Streams.Writer; adr: ADDRESS; maxLen: LONGINT; low, high: ADDRESS);
  382. CONST MaxString = 32;
  383. VAR ch: CHAR;
  384. BEGIN
  385. IF maxLen > MaxString THEN maxLen := MaxString END;
  386. w.Char('"');
  387. LOOP
  388. IF (maxLen <= 0) OR ~OnHeapOrStack(adr, low, high) THEN
  389. EXIT END;
  390. SYSTEM.GET(adr, ch);
  391. IF (ch < " ") OR (ch > "~") THEN EXIT END;
  392. w.Char(ch);
  393. INC(adr);
  394. DEC(maxLen);
  395. END;
  396. w.Char('"');
  397. END WriteValueString;
  398. PROCEDURE WriteValue*(w: Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT; adr: ADDRESS; low, high: ADDRESS);
  399. VAR type: CHAR; a: ADDRESS; size: SIZE; len: SIZE;
  400. BEGIN
  401. IF ~OnHeapOrStack(adr, low, high) THEN
  402. SkipType(refs, offset);
  403. w.String("INVALID ADR:"); w.Address(adr);
  404. RETURN;
  405. END;
  406. type := GetChar(refs, offset);
  407. CASE type OF
  408. sfTypeNone:
  409. w.String("NONE");
  410. | sfTypePointerToRecord, sfTypeANY, sfTypeOBJECT:
  411. WriteBasicValue(w,type, adr, size);
  412. SYSTEM.GET(adr, a);
  413. IF a = 0 THEN
  414. w.String("NIL");
  415. ELSIF CheckHeapAddress(a) THEN
  416. SYSTEM.GET(a + Heaps.TypeDescOffset, a);
  417. w.String(" (");
  418. WriteType(w,a);
  419. w.String(")");
  420. ELSE
  421. w.String("(UNKNOWN)");
  422. END;
  423. | sfTypePointerToArray:
  424. WriteBasicValue(w, sfTypeANY, adr, size);
  425. SYSTEM.GET(adr, a);
  426. IF ~OnHeapOrStack(a,low,high) THEN w.String(" (INVALID)") END;
  427. SkipType(refs, offset)
  428. | sfTypeOpenArray:
  429. IF (refs[offset] = sfTypeCHAR) OR (refs[offset] = sfTypeCHAR8) THEN (* ARRAY OF CHAR *)
  430. SYSTEM.GET(adr, a);
  431. WriteValueString(w, a, MaxString, low, high);
  432. ELSE
  433. w.String("... (NO STRING)")
  434. END;
  435. SkipType(refs, offset);
  436. | sfTypeStaticArray:
  437. len := GetSize(refs, offset);
  438. IF (refs[offset] = sfTypeCHAR) OR (refs[offset] = sfTypeCHAR8) THEN (* ARRAY x OF CHAR *)
  439. WriteValueString(w, adr, len, low, high);
  440. ELSE
  441. w.String("... (NO STRING)");
  442. END;
  443. SkipType(refs, offset);
  444. | sfTypeDynamicArray:
  445. w.String("... (DYNAMIC ARRAY)");
  446. SkipType(refs, offset);
  447. | sfTypeMathOpenArray:
  448. w.String("... (MATH OPEN ARRAY)");
  449. SkipType(refs, offset);
  450. | sfTypeMathStaticArray:
  451. w.String("... (MATH STATIC ARRAY)");
  452. SkipSize(offset); SkipType(refs, offset);
  453. | sfTypeMathTensor:
  454. w.String("...(MATH TENSOR)");
  455. SkipType(refs, offset);
  456. | sfTypeRecord:
  457. w.String("...");
  458. w.String("(");
  459. a := GetAddress(refs, offset);
  460. WriteType(w,a);
  461. w.String(")");
  462. | sfTypeDelegate:
  463. w.String("(DELEGATE)");
  464. WHILE refs[offset] = sfVariable DO SkipVariable(refs, offset) END;
  465. SkipType(refs, offset);
  466. | sfTypePORT:
  467. WriteBasicValue(w, type, adr, size);
  468. SkipChar(offset);
  469. ELSE
  470. WriteBasicValue(w, type, adr, size);
  471. END;
  472. w.Update;
  473. END WriteValue;
  474. PROCEDURE WriteVariable*(w: Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT; base: ADDRESS; low, high: ADDRESS);
  475. VAR name: ARRAY 128 OF CHAR; adr: LONGINT; prevScope: SIZE; c: CHAR;
  476. BEGIN
  477. IF ~Expect(GetChar(refs, offset) = sfVariable) THEN RETURN END;
  478. prevScope := GetSize(refs, offset);
  479. GetString(refs, offset, name);
  480. w.String(Sep); w.String(name); w.Char("=");
  481. c := GetChar(refs, offset);
  482. IF c = sfRelative THEN
  483. adr := base + GetSize(refs, offset)
  484. ELSIF c = sfIndirect THEN
  485. adr := base + GetSize(refs, offset);
  486. w.Address(adr); w.String("->");
  487. IF ~OnHeapOrStack(adr,low,high) THEN w.String(" (INVALID)");
  488. SkipType(refs,offset);
  489. RETURN;
  490. END;
  491. SYSTEM.GET(adr, adr);
  492. ELSE (* absolute *)
  493. adr := GetAddress(refs, offset);
  494. END;
  495. WriteValue(w, refs, offset, adr, low, high);
  496. END WriteVariable;
  497. (* write variables taking meta information from stream in stream at offset, potentially stored at base address
  498. *)
  499. PROCEDURE WriteVariables*(w: Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT; base: ADDRESS; low, high: ADDRESS);
  500. VAR count: LONGINT;
  501. BEGIN
  502. WHILE refs[offset] = sfVariable DO
  503. WriteVariable(w, refs, offset, base, low, high); w.Ln;
  504. (*INC(count); *)
  505. END;
  506. IF count > 0 THEN w.Ln; Wait(w); END;
  507. END WriteVariables;
  508. (* skip type metadata in stream *)
  509. PROCEDURE SkipType*(refs: Modules.Bytes; VAR offset: LONGINT);
  510. VAR size: SIZE; adr: LONGINT; c: CHAR;
  511. BEGIN
  512. c := GetChar(refs, offset);
  513. CASE c OF
  514. sfTypeNone .. sfTypeSIZE:
  515. | sfTypePointerToRecord:
  516. | sfTypePointerToArray: SkipType(refs, offset);
  517. | sfTypeOpenArray: SkipType(refs, offset);
  518. | sfTypeStaticArray: SkipSize(offset); SkipType(refs, offset);
  519. | sfTypeDynamicArray: SkipType(refs, offset);
  520. | sfTypeMathOpenArray: SkipType(refs, offset);
  521. | sfTypeMathStaticArray: SkipSize(offset); SkipType(refs, offset);
  522. | sfTypeMathTensor: SkipType(refs, offset);
  523. | sfTypeRecord: SkipSize(offset);
  524. | sfTypeDelegate:
  525. WHILE refs[offset] = sfVariable DO SkipVariable(refs, offset) END;
  526. SkipType(refs, offset);
  527. | sfTypeENUM:
  528. | sfTypePORT: SkipChar(offset);
  529. ELSE (* ?? *)
  530. END;
  531. END SkipType;
  532. (* skip procedure metadata in stream *)
  533. PROCEDURE SkipProcedure*(refs: Modules.Bytes; VAR offset: LONGINT);
  534. BEGIN
  535. IF ~Expect(GetChar(refs, offset) = sfProcedure) THEN RETURN END;
  536. SkipSize(offset);
  537. SkipString(refs, offset);
  538. SkipAddress(offset);
  539. SkipAddress(offset);
  540. WHILE (refs[offset] = sfVariable) DO SkipVariable(refs, offset) END;
  541. SkipType(refs, offset);
  542. SkipScope(refs, offset);
  543. END SkipProcedure;
  544. (* skip variable metadata in stream *)
  545. PROCEDURE SkipVariable*(refs: Modules.Bytes; VAR offset: LONGINT);
  546. BEGIN
  547. IF ~Expect(GetChar(refs, offset) = sfVariable) THEN RETURN END;
  548. SkipSize(offset);
  549. SkipString(refs, offset);
  550. SkipChar(offset);
  551. SkipAddress(offset);
  552. SkipType(refs, offset);
  553. END SkipVariable;
  554. (* skip type declaration meta data in stream *)
  555. PROCEDURE SkipTypeDeclaration*(refs: Modules.Bytes; VAR offset: LONGINT);
  556. BEGIN
  557. IF ~Expect(GetChar(refs, offset) = sfTypeDeclaration) THEN RETURN END;
  558. SkipSize(offset);
  559. SkipString(refs, offset);
  560. SkipAddress(offset);
  561. IF refs[offset] = sfScopeBegin THEN SkipScope(refs, offset) END;
  562. END SkipTypeDeclaration;
  563. (* skip type declaration meta data in stream *)
  564. PROCEDURE SkipModule*(refs: Modules.Bytes; VAR offset: LONGINT);
  565. BEGIN
  566. IF ~Expect(GetChar(refs, offset) = sfModule) THEN RETURN END;
  567. SkipSize(offset);
  568. SkipString(refs, offset);
  569. IF refs[offset] = sfScopeBegin THEN SkipScope(refs, offset) END;
  570. END SkipModule;
  571. (* skip a scope in stream *)
  572. PROCEDURE SkipScope*(refs: Modules.Bytes; VAR offset: LONGINT);
  573. BEGIN
  574. IF ~Expect(GetChar(refs, offset) = sfScopeBegin) THEN RETURN END;
  575. WHILE (refs[offset] = sfVariable) DO SkipVariable(refs, offset) END;
  576. WHILE (refs[offset] = sfProcedure) DO SkipProcedure(refs, offset) END;
  577. WHILE (refs[offset] = sfTypeDeclaration) DO SkipTypeDeclaration(refs, offset) END;
  578. IF ~Expect(GetChar(refs, offset) = sfScopeEnd) THEN RETURN END;
  579. END SkipScope;
  580. TYPE
  581. Search = RECORD
  582. name: ARRAY 256 OF CHAR; (* for search by name *)
  583. nameOffset: LONGINT; (* to incrementally search through scopes *)
  584. minLevel: LONGINT; (* in order to stop scope search *)
  585. pc: ADDRESS; (* for search by address *)
  586. pos: LONGINT; (* symbol position in stream, -1 if not found *)
  587. found: BOOLEAN; (* if found *)
  588. END;
  589. (* check if stream contains the string part stored in search record with respective offset *)
  590. PROCEDURE FindString(refs: Modules.Bytes; VAR offset: LONGINT; level: LONGINT; VAR find: Search);
  591. VAR ofs: LONGINT;
  592. BEGIN
  593. IF find.minLevel > level THEN
  594. SkipString(refs, offset)
  595. ELSE
  596. ofs := find.nameOffset;
  597. WHILE (refs[offset] # 0X) & (find.name[ofs] = refs[offset]) DO
  598. INC(offset); INC(ofs);
  599. END;
  600. IF (refs[offset] = 0X) THEN
  601. IF find.name[ofs] = 0X THEN
  602. find.found := TRUE;
  603. ELSIF find.name[ofs] = "." THEN
  604. find.minLevel := level+1;
  605. find.nameOffset := ofs+1;
  606. END;
  607. END;
  608. WHILE(refs[offset] # 0X) DO INC(offset) END;
  609. INC(offset);
  610. END;
  611. END FindString;
  612. (* find a symbol by name or pc starting from the procedure stream section *)
  613. PROCEDURE FindInProcedure(refs: Modules.Bytes; VAR offset: LONGINT; level: LONGINT; VAR find: Search);
  614. VAR name: ARRAY 128 OF CHAR; start, end, pos: LONGINT;
  615. BEGIN
  616. pos := offset;
  617. IF ~Expect(GetChar(refs, offset) = sfProcedure) THEN RETURN END;
  618. SkipSize(offset);
  619. FindString(refs, offset, level, find);
  620. start := GetAddress(refs, offset);
  621. end := GetAddress(refs, offset);
  622. find.found := find.found OR (start <= find.pc) & (find.pc < end);
  623. IF find.found THEN
  624. find.pos := pos;
  625. RETURN;
  626. END;
  627. WHILE (refs[offset] = sfVariable) DO
  628. IF find.minLevel <= level+1 THEN
  629. FindInVariable(refs, offset, level+1, find);
  630. IF find.found THEN RETURN END;
  631. ELSE
  632. SkipVariable(refs, offset)
  633. END;
  634. END;
  635. SkipType(refs, offset);
  636. FindInScope(refs, offset, level+1, find);
  637. END FindInProcedure;
  638. (* find a symbol by name or pc starting from the variable stream section *)
  639. PROCEDURE FindInVariable(refs: Modules.Bytes; VAR offset: LONGINT; level: LONGINT; VAR find: Search);
  640. VAR name: ARRAY 128 OF CHAR; pos: LONGINT;
  641. BEGIN
  642. pos := offset;
  643. IF ~Expect(GetChar(refs, offset) = sfVariable) THEN RETURN END;
  644. SkipSize(offset);
  645. FindString(refs, offset, level, find);
  646. IF find.found THEN
  647. find.pos := pos;
  648. RETURN;
  649. END;
  650. SkipChar(offset);
  651. SkipSize(offset);
  652. SkipType(refs, offset);
  653. END FindInVariable;
  654. (* find a symbol by name or pc starting from the type declaration stream section *)
  655. PROCEDURE FindInTypeDeclaration(refs: Modules.Bytes; VAR offset: LONGINT; level: LONGINT; VAR find: Search);
  656. VAR name: ARRAY 128 OF CHAR; adr, pos: LONGINT;
  657. BEGIN
  658. pos := offset;
  659. IF ~Expect(GetChar(refs, offset) = sfTypeDeclaration) THEN RETURN END;
  660. SkipSize(offset);
  661. FindString(refs, offset, level, find);
  662. IF find.found THEN
  663. find.pos := pos;
  664. RETURN;
  665. END;
  666. SkipAddress(offset);
  667. IF refs[offset] = sfScopeBegin THEN FindInScope(refs, offset, level+1, find) END;
  668. END FindInTypeDeclaration;
  669. PROCEDURE FindInModule(refs: Modules.Bytes; VAR offset: LONGINT; level: LONGINT; VAR find: Search);
  670. VAR pos: LONGINT;
  671. BEGIN
  672. pos := offset;
  673. IF ~Expect(GetChar(refs, offset) = sfModule) THEN RETURN END;
  674. SkipSize(offset);
  675. FindString(refs, offset, level, find);
  676. IF find.found THEN
  677. find.pos := pos;
  678. RETURN;
  679. END;
  680. FindInScope(refs, offset, level+1, find);
  681. END FindInModule;
  682. (* find a symbol by name or pc in a scope in the stream *)
  683. PROCEDURE FindInScope(refs: Modules.Bytes; VAR offset: LONGINT; level: LONGINT; VAR find: Search);
  684. VAR no,i: LONGINT;
  685. BEGIN
  686. IF ~Expect(GetChar(refs, offset) = sfScopeBegin) THEN RETURN END;
  687. WHILE ~find.found &(refs[offset] = sfVariable) & (find.minLevel <= level) DO (* Variable *)
  688. FindInVariable(refs, offset, level, find);
  689. END;
  690. WHILE ~find.found & (refs[offset] = sfProcedure) & (find.minLevel <= level) DO (* Procedure *)
  691. FindInProcedure(refs, offset, level, find);
  692. END;
  693. WHILE ~find.found & (refs[offset] = sfTypeDeclaration) & (find.minLevel <= level) DO (* TypeDeclaration *)
  694. FindInTypeDeclaration(refs, offset,level, find);
  695. END;
  696. IF find.found OR (find.minLevel > level) THEN RETURN END;
  697. IF ~Expect(GetChar(refs, offset) = sfScopeEnd) THEN RETURN END;
  698. END FindInScope;
  699. PROCEDURE InitSearch(VAR search: Search);
  700. BEGIN
  701. search.found := FALSE;
  702. search.pos := -1;
  703. search.name := "";
  704. search.nameOffset := 0;
  705. search.minLevel := 0;
  706. search.pc := 0;
  707. END InitSearch;
  708. (* Find a symbol in the stream starting at offset.
  709. If name is supposed to contain the referred to symbol, choose skipFirstSymbol = FALSE
  710. Example FindByName(m.refs, 0, "Reflection.FindByName", FALSE)
  711. otherwise choose skipFirstSymbol = TRUE
  712. Example FindByName(m.refs, 0, "FindByName", TRUE);
  713. *)
  714. PROCEDURE FindByName*(refs: Modules.Bytes; offset: LONGINT; CONST name: ARRAY OF CHAR; skipFirstSymbol: BOOLEAN): SIZE;
  715. VAR search: Search;
  716. BEGIN
  717. InitSearch(search);
  718. COPY(name, search.name);
  719. IF skipFirstSymbol THEN search.minLevel := 1 END;
  720. CASE refs[offset] OF
  721. sfModule: FindInModule(refs, offset, 0, search);
  722. |sfVariable: FindInVariable(refs, offset, 0, search);
  723. |sfProcedure: FindInProcedure(refs, offset, 0, search);
  724. |sfTypeDeclaration: FindInTypeDeclaration(refs, offset, 0, search);
  725. ELSE (* wrong position in stream *)
  726. END;
  727. RETURN search.pos;
  728. END FindByName;
  729. PROCEDURE FindByAdr*(refs: Modules.Bytes; offset: SIZE; pc: ADDRESS): SIZE;
  730. VAR search: Search;
  731. BEGIN
  732. InitSearch(search);
  733. search.pc := pc;
  734. CASE refs[offset] OF
  735. sfModule: FindInModule(refs, offset, 0, search);
  736. |sfVariable: FindInVariable(refs, offset, 0, search);
  737. |sfProcedure: FindInProcedure(refs, offset, 0, search);
  738. |sfTypeDeclaration: FindInTypeDeclaration(refs, offset, 0, search);
  739. ELSE (* wrong position in stream *)
  740. END;
  741. RETURN search.pos;
  742. END FindByAdr;
  743. (** service procedures *)
  744. (** Find procedure name and write it. *)
  745. PROCEDURE WriteProc*(w: Streams.Writer; pc: ADDRESS);
  746. VAR refs: Modules.Bytes; refpos: LONGINT; base: ADDRESS;
  747. BEGIN
  748. WriteProc0(w, Modules.ThisModuleByAdr0(pc), pc, -1, refs, refpos, base)
  749. END WriteProc;
  750. (** Write the state of the specified module. *)
  751. PROCEDURE ModuleState*(w: Streams.Writer; mod: Modules.Module);
  752. VAR offset: LONGINT; base: ADDRESS; refs: Modules.Bytes;
  753. BEGIN
  754. IF mod = NIL THEN RETURN END;
  755. refs := mod.refs;
  756. offset := 0;
  757. w.String("State "); w.String(mod.name); w.Char(":"); w.Ln; Wait(w);
  758. IF (GetChar(refs, offset) = sfModule) THEN
  759. SkipSize(offset);
  760. SkipString(refs, offset);
  761. IF (GetChar(refs, offset) = sfScopeBegin) THEN
  762. WriteVariables(w, refs, offset, 0, 0, 0)
  763. END;
  764. END;
  765. END ModuleState;
  766. PROCEDURE CheckBP(bp: ADDRESS): ADDRESS;
  767. VAR n: ADDRESS;
  768. BEGIN
  769. IF bp # NIL THEN
  770. SYSTEM.GET(bp, n);
  771. IF ODD(n) THEN INC(bp, SIZEOF(ADDRESS)) END;
  772. END;
  773. RETURN bp;
  774. END CheckBP;
  775. (* Display call trackback. *)
  776. PROCEDURE StackTraceBack*(w: Streams.Writer; pc, bp: ADDRESS; low,high: ADDRESS; long, overflow: BOOLEAN);
  777. VAR count,offset: LONGINT; stacklow: ADDRESS; base: ADDRESS; m: Modules.Module; refs: Modules.Bytes;
  778. BEGIN
  779. count := 0; (* frame count *)
  780. REPEAT
  781. m := Modules.ThisModuleByAdr0(pc);
  782. IF (ShowAllProcs OR (m # NIL) OR (count = 0)) & (bp # 0) & (bp >= low) & (bp < high) THEN
  783. IF CheckHeapAddress( pc ) THEN
  784. WriteProc0(w, m, pc, bp, refs, offset, base); w.Ln;Wait(w); w.Update;
  785. IF long & (~overflow OR (count > 0)) THEN (* show variables *)
  786. IF offset >= 0 THEN
  787. WriteVariables(w,refs,offset, base, low, high);
  788. SkipType(refs, offset);
  789. IF Expect(GetChar(refs, offset) = sfScopeBegin) THEN
  790. WriteVariables(w,refs,offset, base, low, high);
  791. END;
  792. END;
  793. IF (m # NIL) & (base # m.sb) & (count = 0) THEN ModuleState(w, m) END
  794. END;
  795. ELSE
  796. w.String( "Unknown external procedure, pc = " ); w.Address( pc ); w.Ln; Wait(w);
  797. END;
  798. bp := CheckBP(bp);
  799. SYSTEM.GET(bp + SIZEOF(ADDRESS), pc); (* return addr from stack *)
  800. SYSTEM.GET(bp, bp); (* follow dynamic link *)
  801. INC(count)
  802. ELSE
  803. bp := 0
  804. END;
  805. UNTIL (bp = 0) OR (count = MaxFrames);
  806. IF bp # 0 THEN w.String("...") END
  807. END StackTraceBack;
  808. (** Write a process's state in one line. *)
  809. PROCEDURE WriteProcess*(w: Streams.Writer; p: Objects.Process);
  810. VAR adr: ADDRESS; mode: LONGINT; m: Modules.Module;
  811. BEGIN
  812. IF p # NIL THEN
  813. w.Int(p.id, 5);
  814. mode := p.mode;
  815. IF (mode >= Objects.Ready) & (mode <= Objects.Terminated) THEN
  816. adr := (mode-Objects.Ready)*4;
  817. FOR adr := adr TO adr+3 DO w.Char(modes[adr]) END
  818. ELSE
  819. w.Char(" "); w.Int(mode, 1)
  820. END;
  821. w.Int(p.procID, 2);
  822. w.Int(p.priority, 2);
  823. w.Update;
  824. w.Address (SYSTEM.VAL(ADDRESS, p.obj));
  825. IF p.obj # NIL THEN
  826. SYSTEM.GET(SYSTEM.VAL(ADDRESS, p.obj) - SIZEOF(ADDRESS), adr);
  827. w.Char(":"); WriteType(w, adr)
  828. END;
  829. w.Update;
  830. w.Char(" "); WriteProc(w, p.state.PC);
  831. IF p.mode = Objects.AwaitingLock THEN
  832. adr := SYSTEM.VAL(ADDRESS, p.waitingOn);
  833. w.Address (adr);
  834. w.Update;
  835. IF adr # 0 THEN (* can be 0 when snapshot is taken *)
  836. SYSTEM.GET(adr - SIZEOF(ADDRESS), adr);
  837. IF adr = SYSTEM.TYPECODE(Modules.Module) THEN
  838. w.Char("-");
  839. m := SYSTEM.VAL(Modules.Module, adr);
  840. w.String(m.name)
  841. ELSE
  842. w.Char(":"); WriteType(w, adr)
  843. END;
  844. w.Update;
  845. END
  846. ELSIF p.mode = Objects.AwaitingCond THEN
  847. w.Char(" "); WriteProc(w, SYSTEM.VAL(ADDRESS, p.condition));
  848. w.Address (p.condFP)
  849. END;
  850. w.Char(" "); w.Set(p.flags)
  851. END
  852. END WriteProcess;
  853. (* for interface compatibility *)
  854. PROCEDURE GetVariableAdr*(fp, pc: ADDRESS; CONST name: ARRAY OF CHAR): SIZE;
  855. BEGIN
  856. RETURN -1;
  857. END GetVariableAdr;
  858. PROCEDURE GetProcedureName*(pc: ADDRESS; VAR name: ARRAY OF CHAR; VAR startpc: ADDRESS);
  859. VAR m: Modules.Module; offset: LONGINT;
  860. BEGIN
  861. name := "";
  862. m := Modules.ThisModuleByAdr0(pc);
  863. IF m # NIL THEN
  864. offset := FindByAdr(m.refs,0,pc);
  865. IF offset >= 0 THEN
  866. GetFullName(m.refs, offset, name);
  867. IF GetChar(m.refs, offset) = sfProcedure THEN
  868. SkipSize(offset);
  869. SkipString(m.refs,offset);
  870. startpc := GetAddress(m.refs, offset);
  871. END;
  872. END;
  873. END;
  874. END GetProcedureName;
  875. TYPE
  876. Variable* = RECORD
  877. adr-: ADDRESS;
  878. type-, size-, n-, tdadr-: LONGINT
  879. END;
  880. PROCEDURE FindVar*(mod: Modules.Module; CONST name: ARRAY OF CHAR; VAR v: Variable): BOOLEAN;
  881. BEGIN
  882. END FindVar;
  883. PROCEDURE WriteVar*(w: Streams.Writer; v: Variable; VAR col: LONGINT);
  884. BEGIN
  885. END WriteVar;
  886. PROCEDURE ReportType(w:Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT);
  887. VAR size: SIZE; adr: LONGINT; c: CHAR;
  888. BEGIN
  889. c := GetChar(refs, offset);
  890. CASE c OF
  891. sfTypeNone: w.String("no type");
  892. | sfTypePointerToRecord: w.String("POINTER TO RECORD");
  893. | sfTypePointerToArray: w.String("POINTER TO "); ReportType(w, refs, offset);
  894. | sfTypeOpenArray: w.String("ARRAY OF "); ReportType(w, refs, offset);
  895. | sfTypeStaticArray: w.String("ARRAY "); w.Int(GetSize(refs, offset),1 ); w.String(" OF "); ReportType(w, refs, offset);
  896. | sfTypeDynamicArray: w.String("DARRAY OF "); ReportType(w,refs, offset);
  897. | sfTypeMathOpenArray: w.String("ARRAY [*] OF "); ReportType(w, refs, offset);
  898. | sfTypeMathStaticArray: w.String("ARRAY ["); w.Int(GetSize(refs, offset),1); w.String("] OF "); ReportType(w, refs, offset);
  899. | sfTypeMathTensor: w.String("ARRAY [?] OF "); ReportType(w, refs, offset);
  900. | sfTypeRecord: w.String("RECORD "); w.Address(GetAddress(refs, offset));
  901. | sfTypeDelegate:
  902. w.String("PROCEDURE (");
  903. WHILE refs[offset] = sfVariable DO ReportVariable(w, refs, offset) END;
  904. w.String("):"); ReportType(w, refs, offset);
  905. | sfTypeBOOLEAN: w.String("BOOLEAN");
  906. | sfTypeCHAR: w.String("CHAR");
  907. | sfTypeCHAR8: w.String("CHAR8");
  908. | sfTypeCHAR16: w.String("CHAR16");
  909. | sfTypeCHAR32: w.String("CHAR32");
  910. | sfTypeSHORTINT: w.String("SHORTINT");
  911. | sfTypeINTEGER: w.String("INTEGER");
  912. | sfTypeLONGINT: w.String("LONGINT");
  913. | sfTypeHUGEINT: w.String("HUGEINT");
  914. | sfTypeWORD: w.String("WORD");
  915. | sfTypeLONGWORD: w.String("LONGWORD");
  916. | sfTypeSIGNED8: w.String("SIGNED8");
  917. | sfTypeSIGNED16: w.String("SIGNED16");
  918. | sfTypeSIGNED32: w.String("SIGNED32");
  919. | sfTypeSIGNED64: w.String("SIGNED64");
  920. | sfTypeUNSIGNED8: w.String("UNSIGNED8");
  921. | sfTypeUNSIGNED16: w.String("UNSIGNED16");
  922. | sfTypeUNSIGNED32: w.String("UNSIGNED32");
  923. | sfTypeUNSIGNED64: w.String("UNSIGNED64");
  924. | sfTypeREAL: w.String("REAL");
  925. | sfTypeLONGREAL: w.String("LONGREAL");
  926. | sfTypeCOMPLEX: w.String("COMPLEX");
  927. | sfTypeLONGCOMPLEX: w.String("LONGCOMPLEX");
  928. | sfTypeSET: w.String("SET");
  929. | sfTypeANY: w.String("ANY");
  930. | sfTypeOBJECT: w.String("OBJECT");
  931. | sfTypeBYTE: w.String("BYTE");
  932. | sfTypeRANGE: w.String("RANGE");
  933. | sfTypeADDRESS: w.String("ADDRESS");
  934. | sfTypeSIZE: w.String("SIZE");
  935. | sfTypePORT: w.String("PORT"); IF GetChar(refs,offset) = sfIN THEN w.String("IN") ELSE w.String("OUT") END;
  936. ELSE w.String("????? TYPE ?????");
  937. END;
  938. END ReportType;
  939. PROCEDURE ReportProcedure(w: Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT);
  940. VAR name: Name; start, end: LONGINT;
  941. BEGIN
  942. w.Int(offset,1); w.String(":");
  943. w.String("PROCEDURE ");
  944. IF ~Expect(GetChar(refs, offset) = sfProcedure) THEN RETURN END;
  945. SkipSize(offset);
  946. GetString(refs, offset, name);
  947. w.String(name);
  948. start := GetAddress(refs, offset);
  949. end := GetAddress(refs, offset);
  950. w.String("[@"); w.Address(start); w.String(" - "); w.Address(end); w.String("]");
  951. w.String("("); w.Ln;
  952. WHILE refs[offset] = sfVariable DO
  953. ReportVariable(w, refs, offset);
  954. END;
  955. w.String(")");
  956. w.String(":");
  957. ReportType(w, refs, offset);
  958. w.Ln;
  959. ReportScope(w, refs, offset);
  960. END ReportProcedure;
  961. PROCEDURE ReportVariable(w: Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT);
  962. VAR name: ARRAY 128 OF CHAR; adr: ADDRESS; size: SIZE;
  963. BEGIN
  964. w.Int(offset,1); w.String(":");
  965. w.String("VAR ");
  966. IF ~Expect(GetChar(refs, offset) = sfVariable) THEN RETURN END;
  967. SkipSize(offset);
  968. GetString(refs, offset, name);
  969. w.String(name);
  970. IF GetChar(refs, offset) = sfRelative THEN
  971. size := GetSize(refs, offset);
  972. w.String("[@"); w.Int(size,1); w.String("]");
  973. ELSE (* absolute *)
  974. adr := GetAddress(refs, offset);
  975. w.String("[@"); w.Address(adr); w.String("]");
  976. END;
  977. w.String(":");
  978. ReportType(w, refs, offset);
  979. w.Ln;
  980. END ReportVariable;
  981. PROCEDURE ReportTypeDeclaration(w: Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT);
  982. VAR name: ARRAY 128 OF CHAR; adr: LONGINT;
  983. BEGIN
  984. w.Int(offset,1); w.String(":");
  985. w.String("TYPE ");
  986. IF ~Expect(GetChar(refs, offset) = sfTypeDeclaration) THEN RETURN END;
  987. SkipSize(offset);
  988. GetString(refs, offset, name);
  989. w.String(name);
  990. adr := GetAddress(refs, offset);
  991. w.String(" ");
  992. w.Address(adr);
  993. w.Ln;
  994. IF refs[offset] = sfScopeBegin THEN ReportScope(w, refs, offset) END;
  995. END ReportTypeDeclaration;
  996. PROCEDURE ReportScope(w:Streams.Writer; refs: Modules.Bytes; VAR offset: LONGINT);
  997. BEGIN
  998. IF ~Expect(GetChar(refs, offset) = sfScopeBegin) THEN RETURN END;
  999. w.Int(offset,1); w.String(": Scope"); w.Ln;
  1000. WHILE (refs[offset] = sfVariable) DO (* Variable *)
  1001. ReportVariable(w, refs, offset);
  1002. END;
  1003. WHILE (refs[offset] = sfProcedure) DO (* Procedure *)
  1004. ReportProcedure(w, refs, offset);
  1005. END;
  1006. WHILE (refs[offset] = sfTypeDeclaration) DO (* TypeDeclaration *)
  1007. ReportTypeDeclaration(w, refs, offset);
  1008. END;
  1009. IF ~Expect(GetChar(refs, offset) = sfScopeEnd) THEN RETURN END;
  1010. w.String("END"); w.Ln;
  1011. END ReportScope;
  1012. PROCEDURE ReportModule(w: Streams.Writer; refs: Modules.Bytes; offset: LONGINT);
  1013. VAR name: Name;
  1014. BEGIN
  1015. w.String("MODULE ");
  1016. IF ~Expect(GetChar(refs, offset) = sfModule) THEN RETURN END;
  1017. SkipSize(offset);
  1018. GetString(refs, offset, name);
  1019. w.String(name);
  1020. ReportScope(w, refs, offset);
  1021. END ReportModule;
  1022. PROCEDURE Report*(w:Streams.Writer; refs: Modules.Bytes; offset: LONGINT);
  1023. BEGIN
  1024. CASE refs[offset] OF
  1025. sfModule: ReportModule(w, refs, offset);
  1026. |sfVariable: ReportVariable(w, refs, offset);
  1027. |sfProcedure: ReportProcedure(w, refs, offset);
  1028. |sfTypeDeclaration: ReportTypeDeclaration(w, refs, offset);
  1029. ELSE (* wrong position in stream *)
  1030. END;
  1031. END Report;
  1032. BEGIN
  1033. modes := " rdy run awl awc awe rip"; (* 4 characters per mode from Objects.Ready to Objects.Terminated *)
  1034. END Reflection.
  1035. 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 ~