Generic.Reflection.Mod 37 KB

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