FoxInterpreterSymbols.Mod 35 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528
  1. MODULE FoxInterpreterSymbols; (** AUTHOR ""; PURPOSE ""; *)
  2. IMPORT Strings, Basic := FoxBasic, StringPool, Streams, Commands, PersistentObjects, Modules, Machine, SYSTEM;
  3. CONST
  4. TAB = 09X;
  5. CONST
  6. sfTypeNone = 0X;
  7. sfTypeCHAR = 01X;
  8. sfTypeCHAR8 = 02X;
  9. sfTypeCHAR16 = 03X;
  10. sfTypeCHAR32 = 04X;
  11. sfTypeRANGE = 05X;
  12. sfTypeSHORTINT = 06X;
  13. sfTypeINTEGER = 07X;
  14. sfTypeLONGINT = 08X;
  15. sfTypeHUGEINT = 09X;
  16. sfTypeWORD = 0AX;
  17. sfTypeLONGWORD = 0BX;
  18. sfTypeSIGNED8 = 0CX;
  19. sfTypeSIGNED16 = 0DX;
  20. sfTypeSIGNED32 = 0EX;
  21. sfTypeSIGNED64 = 0FX;
  22. sfTypeUNSIGNED8 = 10X;
  23. sfTypeUNSIGNED16 = 11X;
  24. sfTypeUNSIGNED32 = 12X;
  25. sfTypeUNSIGNED64 = 13X;
  26. sfTypeREAL = 14X;
  27. sfTypeLONGREAL = 15X;
  28. sfTypeCOMPLEX = 16X;
  29. sfTypeLONGCOMPLEX = 17X;
  30. sfTypeBOOLEAN = 18X;
  31. sfTypeSET = 19X;
  32. sfTypeANY = 1AX;
  33. sfTypeOBJECT = 1BX;
  34. sfTypeBYTE = 1CX;
  35. sfTypeADDRESS = 1DX;
  36. sfTypeSIZE = 1EX;
  37. sfTypePointerToRecord = 20X;
  38. sfTypePointerToArray = 21X;
  39. sfTypeOpenArray = 22X;
  40. sfTypeStaticArray = 23X;
  41. sfTypeRecord = 24X;
  42. TYPE
  43. Item*= PersistentObjects.Object;
  44. Object* = PersistentObjects.Object;
  45. Content* = PersistentObjects.Content;
  46. TYPE
  47. Result*= OBJECT (Item)
  48. PROCEDURE Evaluate*(): Value;
  49. BEGIN
  50. RETURN NIL;
  51. END Evaluate;
  52. PROCEDURE SetV*(v: Value): BOOLEAN;
  53. BEGIN
  54. RETURN FALSE;
  55. END SetV;
  56. PROCEDURE Find*(CONST name: ARRAY OF CHAR): Result;
  57. BEGIN
  58. RETURN NIL;
  59. END Find;
  60. PROCEDURE Address*(): ADDRESS;
  61. BEGIN
  62. RETURN NIL;
  63. END Address;
  64. PROCEDURE Trace*;
  65. BEGIN
  66. END Trace;
  67. END Result;
  68. SymbolResult*=OBJECT(Result)
  69. VAR name: ARRAY 32 OF CHAR;
  70. PROCEDURE InitSymbol(CONST n: ARRAY OF CHAR);
  71. BEGIN
  72. COPY(n, name);
  73. END InitSymbol;
  74. END SymbolResult;
  75. ModuleResult*= OBJECT(SymbolResult)
  76. VAR
  77. self: Modules.TypeDesc;
  78. PROCEDURE & InitModule(CONST name: ARRAY OF CHAR; m: Modules.Module);
  79. BEGIN
  80. InitSymbol(name);
  81. ASSERT(m # NIL);
  82. self := FindType(m.typeInfo, "@Self");
  83. ASSERT(self # NIL);
  84. END InitModule;
  85. PROCEDURE Find(CONST name: ARRAY OF CHAR): Result;
  86. VAR num: LONGINT;
  87. proc: ProcedureResult;
  88. field: FieldResult;
  89. BEGIN
  90. IF FindProc(self.procedures, name,num) THEN
  91. NEW(proc, SELF, name, self.procedures[num]);
  92. proc.address := self.procedures[num].address;
  93. RETURN proc
  94. ELSIF FindField(self.fields, name, num) THEN
  95. NEW(field, name, self.fields[num]);
  96. field.address := self.fields[num].offset;
  97. RETURN field;
  98. END;
  99. RETURN NIL;
  100. END Find;
  101. END ModuleResult;
  102. Callstack = OBJECT
  103. VAR
  104. data: ARRAY 1024 OF CHAR;
  105. pos: LONGINT;
  106. size: LONGINT;
  107. H: HUGEINT; (* result in register *)
  108. retType: Modules.FieldEntry;
  109. parameters: POINTER TO ARRAY OF Modules.FieldEntry;
  110. pPos: LONGINT;
  111. PROCEDURE & Init;
  112. BEGIN
  113. pos := 1024; size := 0;
  114. END Init;
  115. PROCEDURE Next(s: SIZE): ADDRESS;
  116. BEGIN
  117. DEC(pos, s); INC(size, s);
  118. RETURN ADDRESSOF(data[pos]);
  119. END Next;
  120. PROCEDURE PushH(h: HUGEINT);
  121. VAR p: POINTER {UNSAFE} TO RECORD h: HUGEINT END;
  122. BEGIN
  123. p := Next(SIZEOF(HUGEINT));
  124. p.h := h;
  125. END PushH;
  126. PROCEDURE PushL(i: LONGINT);
  127. VAR p: POINTER {UNSAFE} TO RECORD i: LONGINT END;
  128. BEGIN
  129. p := Next(SIZEOF(LONGINT));
  130. p.i := i;
  131. END PushL;
  132. PROCEDURE PushI(i: INTEGER);
  133. BEGIN
  134. PushL(i);
  135. END PushI;
  136. PROCEDURE PushS(i: SHORTINT);
  137. BEGIN
  138. PushL(i);
  139. END PushS;
  140. PROCEDURE PushB(b: BOOLEAN);
  141. VAR p: POINTER {UNSAFE} TO RECORD b: BOOLEAN END;
  142. BEGIN
  143. p := Next(SIZEOF(LONGINT));
  144. p.b := b;
  145. END PushB;
  146. PROCEDURE PushC(c: CHAR);
  147. BEGIN
  148. PushL(ORD(c));
  149. END PushC;
  150. PROCEDURE PushSet(set: SET);
  151. VAR p: POINTER {UNSAFE} TO RECORD s:SET END;
  152. BEGIN
  153. p := Next(SIZEOF(SET));
  154. p.s := set;
  155. END PushSet;
  156. PROCEDURE PushR(r: REAL);
  157. VAR p: POINTER {UNSAFE} TO RECORD r: REAL END;
  158. BEGIN
  159. p := Next(SIZEOF(REAL));
  160. p.r := r;
  161. END PushR;
  162. PROCEDURE PushX(x: LONGREAL);
  163. VAR p: POINTER {UNSAFE} TO RECORD x: LONGREAL END;
  164. BEGIN
  165. p := Next(SIZEOF(LONGREAL));
  166. p.x := x;
  167. END PushX;
  168. PROCEDURE PushA(a: ADDRESS);
  169. VAR p: POINTER {UNSAFE} TO RECORD a: ADDRESS END;
  170. BEGIN
  171. p := Next(SIZEOF(ADDRESS));
  172. p.a := a;
  173. END PushA;
  174. PROCEDURE PushSz(s: SIZE);
  175. VAR p: POINTER {UNSAFE} TO RECORD s: SIZE END;
  176. BEGIN
  177. p := Next(SIZEOF(SIZE));
  178. p.s := s;
  179. END PushSz;
  180. PROCEDURE Call(adr: ADDRESS);
  181. TYPE
  182. P = PROCEDURE();
  183. VAR
  184. esp: ADDRESS;
  185. p: P;
  186. BEGIN
  187. p := SYSTEM.VAL(P, adr);
  188. esp := Machine.CurrentSP();
  189. Machine.SetSP(esp-size);
  190. IF size > 0 THEN
  191. SYSTEM.MOVE(ADDRESS OF data[pos], esp-size, size);
  192. END;
  193. p();
  194. Machine.SetSP(esp);
  195. END Call;
  196. PROCEDURE CallH(adr: ADDRESS): HUGEINT;
  197. TYPE
  198. P = PROCEDURE(): HUGEINT;
  199. VAR
  200. res: HUGEINT; esp: ADDRESS;
  201. p: P;
  202. BEGIN
  203. p := SYSTEM.VAL(P, adr);
  204. esp := Machine.CurrentSP();
  205. Machine.SetSP(esp-size);
  206. IF size > 0 THEN
  207. SYSTEM.MOVE(ADDRESS OF data[pos], esp-size, size);
  208. END;
  209. res := p();
  210. Machine.SetSP(esp);
  211. RETURN res;
  212. END CallH;
  213. PROCEDURE CallR(adr: ADDRESS): REAL;
  214. TYPE
  215. P = PROCEDURE(): REAL;
  216. VAR
  217. res: REAL; esp: ADDRESS;
  218. p: P;
  219. BEGIN
  220. p := SYSTEM.VAL(P, adr);
  221. esp := Machine.CurrentSP();
  222. Machine.SetSP(esp-size);
  223. IF size > 0 THEN
  224. SYSTEM.MOVE(ADDRESS OF data[pos], esp-size, size);
  225. END;
  226. res := p();
  227. Machine.SetSP(esp);
  228. RETURN res;
  229. END CallR;
  230. PROCEDURE CallX(adr: ADDRESS): LONGREAL;
  231. TYPE
  232. P = PROCEDURE(): LONGREAL;
  233. VAR
  234. res: LONGREAL; esp: ADDRESS;
  235. p: P;
  236. BEGIN
  237. p := SYSTEM.VAL(P, adr);
  238. esp := Machine.CurrentSP();
  239. Machine.SetSP(esp-size);
  240. IF size > 0 THEN
  241. SYSTEM.MOVE(ADDRESS OF data[pos], esp-size, size);
  242. END;
  243. res := p();
  244. Machine.SetSP(esp);
  245. RETURN res;
  246. END CallX;
  247. END Callstack;
  248. ProcedureResult*= OBJECT(SymbolResult)
  249. VAR
  250. proc: Modules.ProcedureEntry;
  251. address: ADDRESS;
  252. stack: Callstack;
  253. index: LONGINT;
  254. caller-: Result;
  255. PROCEDURE ReturnsPointer*(): BOOLEAN;
  256. BEGIN
  257. CASE proc.returnType.class
  258. OF sfTypeANY, sfTypeOBJECT, sfTypePointerToRecord: RETURN TRUE
  259. ELSE RETURN FALSE
  260. END;
  261. END ReturnsPointer;
  262. PROCEDURE & InitProcedure(c: Result; CONST name: ARRAY OF CHAR; CONST p: Modules.ProcedureEntry);
  263. BEGIN
  264. InitSymbol(name); proc := p;
  265. caller := c;
  266. END InitProcedure;
  267. PROCEDURE Pars*();
  268. BEGIN
  269. index := 0;
  270. NEW(stack); (* can optimize this *)
  271. END Pars;
  272. PROCEDURE PushAddress*(adr: ADDRESS); (* for self pointer *)
  273. BEGIN
  274. stack.PushA(adr);
  275. END PushAddress;
  276. PROCEDURE Push*(v: Value): BOOLEAN;
  277. VAR type: Modules.EntryType;
  278. s: SHORTINT; i: INTEGER; l: LONGINT; h: HUGEINT;
  279. r: REAL; x: LONGREAL;
  280. b: BOOLEAN;
  281. set: SET;
  282. BEGIN
  283. IF (proc.parameters = NIL) OR (index >= LEN(proc.parameters)) THEN RETURN FALSE END;
  284. type := proc.parameters[index].type;
  285. INC(index);
  286. IF type.subclass = 0X THEN
  287. CASE type.class OF
  288. sfTypeSHORTINT,sfTypeSIGNED8 :
  289. IF v.GetInt(h) THEN
  290. s:= SHORTINT(h); stack.PushS(s);
  291. RETURN TRUE;
  292. END;
  293. | sfTypeINTEGER,sfTypeSIGNED16 :
  294. IF v.GetInt(h) THEN
  295. i:= INTEGER(h); stack.PushI(i);
  296. RETURN TRUE;
  297. END;
  298. | sfTypeLONGINT,sfTypeSIGNED32:
  299. IF v.GetInt(h) THEN
  300. l:= LONGINT(h); stack.PushL(l);
  301. RETURN TRUE;
  302. END;
  303. | sfTypeHUGEINT,sfTypeSIGNED64:
  304. IF v.GetInt(h) THEN
  305. stack.PushH(h);
  306. RETURN TRUE;
  307. END;
  308. |sfTypeREAL:
  309. IF v.GetReal(x) THEN
  310. r := REAL(x);stack.PushR(r);
  311. RETURN TRUE;
  312. END;
  313. |sfTypeLONGREAL:
  314. IF v.GetReal(x) THEN
  315. stack.PushX(x);
  316. RETURN TRUE;
  317. END;
  318. |sfTypeBOOLEAN:
  319. IF v.GetBoolean(b) THEN
  320. stack.PushB(b);
  321. RETURN TRUE
  322. END;
  323. |sfTypeSET:
  324. IF v.GetSet(set) THEN
  325. stack.PushSet(set);
  326. RETURN TRUE
  327. END;
  328. END;
  329. ELSIF type.subclass = sfTypeOpenArray THEN
  330. CASE type.class OF
  331. sfTypeCHAR, sfTypeCHAR8:
  332. IF v IS StringValue THEN
  333. stack.PushSz(LEN(v(StringValue).value));
  334. stack.PushA(ADDRESSOF(v(StringValue).value[0]));
  335. END;
  336. END;
  337. RETURN TRUE;
  338. END;
  339. RETURN FALSE;
  340. END Push;
  341. PROCEDURE Check*(): BOOLEAN;
  342. BEGIN
  343. RETURN (proc.parameters = NIL) & (index = 0) OR (index = LEN(proc.parameters));
  344. END Check;
  345. PROCEDURE Evaluate(): Value;
  346. VAR
  347. type: Modules.EntryType;
  348. int: IntegerValue;
  349. real: RealValue;
  350. bool: BooleanValue;
  351. set: SetValue;
  352. any: AnyValue;
  353. BEGIN
  354. stack.Call(address);
  355. type := proc.returnType;
  356. CASE type.class OF
  357. sfTypeSHORTINT,sfTypeSIGNED8 :
  358. NEW(int, SHORTINT(stack.CallH(address)));
  359. RETURN int;
  360. | sfTypeINTEGER,sfTypeSIGNED16 :
  361. NEW(int, INTEGER(stack.CallH(address)));
  362. RETURN int;
  363. | sfTypeLONGINT,sfTypeSIGNED32:
  364. NEW(int, LONGINT(stack.CallH(address)));
  365. RETURN int;
  366. | sfTypeHUGEINT,sfTypeSIGNED64:
  367. NEW(int, stack.CallH(address));
  368. RETURN int;
  369. |sfTypeREAL:
  370. NEW(real, stack.CallR(address));
  371. RETURN real
  372. |sfTypeLONGREAL:
  373. NEW(real, stack.CallX(address));
  374. RETURN real;
  375. |sfTypeBOOLEAN:
  376. NEW(bool, SYSTEM.VAL(BOOLEAN, stack.CallH(address)));
  377. RETURN bool;
  378. |sfTypeSET:
  379. NEW(set, SYSTEM.VAL(SET, stack.CallH(address)));
  380. RETURN set;
  381. | sfTypeANY, sfTypeOBJECT, sfTypePointerToRecord: (* pointers are passed as varpars *)
  382. RETURN NIL;
  383. | 0X: RETURN NIL;
  384. END;
  385. RETURN NIL;
  386. END Evaluate;
  387. END ProcedureResult;
  388. FieldResult* = OBJECT (SymbolResult)
  389. VAR field: Modules.FieldEntry;
  390. address: ADDRESS;
  391. PROCEDURE & InitField(CONST name: ARRAY OF CHAR; CONST f: Modules.FieldEntry);
  392. BEGIN
  393. InitSymbol(name); field := f;
  394. END InitField;
  395. PROCEDURE Evaluate(): Value;
  396. VAR
  397. s: SHORTINT;
  398. i: INTEGER;
  399. l: LONGINT;
  400. h: HUGEINT;
  401. int: IntegerValue;
  402. a: ANY;
  403. any: AnyValue;
  404. BEGIN
  405. CASE field.type.class OF
  406. sfTypeSHORTINT,sfTypeSIGNED8 :
  407. SYSTEM.GET(address, s);
  408. NEW(int, s);
  409. RETURN int;
  410. | sfTypeINTEGER,sfTypeSIGNED16 :
  411. SYSTEM.GET(address, i);
  412. NEW(int, i);
  413. RETURN int;
  414. | sfTypeLONGINT,sfTypeSIGNED32:
  415. SYSTEM.GET(address, l);
  416. NEW(int, l);
  417. RETURN int;
  418. | sfTypeHUGEINT,sfTypeSIGNED64:
  419. SYSTEM.GET(address, h);
  420. NEW(int,LONGINT(h));
  421. RETURN int;
  422. | sfTypePointerToRecord, sfTypeANY, sfTypeOBJECT:
  423. SYSTEM.GET(address, a);
  424. NEW(any, a);
  425. RETURN any;
  426. ELSE
  427. HALT(100);
  428. END;
  429. END Evaluate;
  430. PROCEDURE SetV(v: Value): BOOLEAN;
  431. VAR
  432. s: SHORTINT; i: INTEGER; l: LONGINT; h: HUGEINT;
  433. r: REAL; x: LONGREAL;
  434. b: BOOLEAN;
  435. set: SET;
  436. BEGIN
  437. CASE field.type.class OF
  438. sfTypeSHORTINT, sfTypeSIGNED8:
  439. IF v.GetInt(h) THEN
  440. s:= SHORTINT(h); SYSTEM.PUT(address, s);
  441. RETURN TRUE;
  442. END;
  443. |sfTypeINTEGER, sfTypeSIGNED16:
  444. IF v.GetInt(h) THEN
  445. i:= INTEGER(h); SYSTEM.PUT(address, i);
  446. RETURN TRUE;
  447. END;
  448. |sfTypeLONGINT, sfTypeSIGNED32:
  449. IF v.GetInt(h) THEN
  450. l:= LONGINT(h); SYSTEM.PUT(address, l);
  451. RETURN TRUE;
  452. END;
  453. |sfTypeHUGEINT, sfTypeSIGNED64:
  454. IF v.GetInt(h) THEN
  455. SYSTEM.PUT(address, h);
  456. RETURN TRUE
  457. END;
  458. |sfTypeREAL:
  459. IF v.GetReal(x) THEN
  460. r := REAL(x); SYSTEM.PUT(address, r);
  461. RETURN TRUE
  462. END;
  463. |sfTypeLONGREAL:
  464. IF v.GetReal(x) THEN
  465. SYSTEM.PUT(address,x);
  466. RETURN TRUE
  467. END;
  468. |sfTypeBOOLEAN:
  469. IF v.GetBoolean(b) THEN
  470. SYSTEM.PUT(address,b);
  471. RETURN TRUE
  472. END;
  473. |sfTypeSET:
  474. IF v.GetSet(set) THEN
  475. SYSTEM.PUT(address,set);
  476. RETURN TRUE
  477. END;
  478. END;
  479. END SetV;
  480. PROCEDURE Find(CONST name: ARRAY OF CHAR): Result;
  481. VAR type, value: ADDRESS;
  482. VAR typeInfo: Modules.TypeDesc; num: LONGINT;
  483. proc: ProcedureResult; f: FieldResult;
  484. BEGIN
  485. IF (field.type.class = sfTypePointerToRecord)
  486. OR (field.type.class = sfTypeANY)
  487. OR (field.type.class = sfTypeOBJECT)
  488. THEN
  489. SYSTEM.GET(address, value);
  490. SYSTEM.GET(value-SIZEOF(ADDRESS), type); (* type desc *)
  491. RETURN FindInType(SELF, value, type, name);
  492. (*
  493. SYSTEM.GET(type-SIZEOF(ADDRESS), typeInfo); (* type info*)
  494. IF FindProc(typeInfo.procedures, name,num) THEN
  495. NEW(proc, SELF, name, typeInfo.procedures[num]);
  496. proc.address := typeInfo.procedures[num].address;
  497. RETURN proc
  498. ELSIF FindField(typeInfo.fields, name, num) THEN
  499. NEW(f, name, typeInfo.fields[num]);
  500. f.address := value + typeInfo.fields[num].offset;
  501. RETURN f;
  502. ELSE HALT(101);
  503. END;
  504. *)
  505. ELSIF field.type.class = sfTypeRecord THEN
  506. type := field.type.type;
  507. RETURN FindInType(SELF, address, type, name);
  508. (*
  509. SYSTEM.GET(type-SIZEOF(ADDRESS), typeInfo); (* type info*)
  510. IF FindProc(typeInfo.procedures, name,num) THEN
  511. NEW(proc, SELF, name, typeInfo.procedures[num]);
  512. proc.address := typeInfo.procedures[num].address;
  513. RETURN proc
  514. ELSIF FindField(typeInfo.fields, name, num) THEN
  515. NEW(f, name, typeInfo.fields[num]);
  516. f.address := address + typeInfo.fields[num].offset;
  517. RETURN f;
  518. ELSE HALT(101);
  519. END;
  520. *)
  521. ELSE HALT(100);
  522. END;
  523. END Find;
  524. END FieldResult;
  525. (* traverse types and supertypes for first occurence of symbol name *)
  526. PROCEDURE FindInType(scope: Result; address: ADDRESS; type: ADDRESS; CONST name: ARRAY OF CHAR): Result;
  527. VAR tag: ADDRESS; typeInfo: Modules.TypeDesc; i, num: LONGINT;
  528. proc: ProcedureResult; f: FieldResult;
  529. BEGIN
  530. FOR i := 15 TO 0 BY -1 DO
  531. SYSTEM.GET(type-(2+i)*SIZEOF(ADDRESS), tag);
  532. IF tag # NIL THEN
  533. SYSTEM.GET(tag-SIZEOF(ADDRESS), typeInfo);
  534. IF FindProc(typeInfo.procedures, name,num) THEN
  535. NEW(proc, scope, name, typeInfo.procedures[num]);
  536. proc.address := typeInfo.procedures[num].address;
  537. RETURN proc
  538. ELSIF FindField(typeInfo.fields, name, num) THEN
  539. NEW(f, name, typeInfo.fields[num]);
  540. f.address := address + typeInfo.fields[num].offset;
  541. RETURN f;
  542. END;
  543. END;
  544. END;
  545. RETURN NIL;
  546. END FindInType;
  547. TYPE
  548. Value*= OBJECT(Result)
  549. PROCEDURE & InitValue;
  550. BEGIN InitObject
  551. END InitValue;
  552. PROCEDURE Evaluate(): Value;
  553. BEGIN
  554. RETURN SELF;
  555. END Evaluate;
  556. PROCEDURE GetInt*(VAR h: HUGEINT): BOOLEAN;
  557. BEGIN
  558. RETURN FALSE;
  559. END GetInt;
  560. PROCEDURE GetAddress*(VAR a: ADDRESS): BOOLEAN;
  561. BEGIN
  562. RETURN FALSE;
  563. END GetAddress;
  564. PROCEDURE GetReal*(VAR x: LONGREAL): BOOLEAN;
  565. BEGIN
  566. RETURN FALSE;
  567. END GetReal;
  568. PROCEDURE GetBoolean*(VAR x: BOOLEAN): BOOLEAN;
  569. BEGIN
  570. RETURN FALSE;
  571. END GetBoolean;
  572. PROCEDURE GetSet*(VAR x: SET): BOOLEAN;
  573. BEGIN
  574. RETURN FALSE;
  575. END GetSet;
  576. PROCEDURE GetChar*(VAR x: CHAR): BOOLEAN;
  577. BEGIN
  578. RETURN FALSE;
  579. END GetChar;
  580. PROCEDURE GetRange*(VAR x: RANGE): BOOLEAN;
  581. BEGIN
  582. RETURN FALSE;
  583. END GetRange;
  584. PROCEDURE WriteValue*(w: Streams.Writer);
  585. BEGIN
  586. END WriteValue;
  587. PROCEDURE GetString*(VAR w: ARRAY OF CHAR);
  588. VAR stringWriter: Streams.StringWriter;
  589. BEGIN
  590. NEW(stringWriter, 128);
  591. WriteValue(stringWriter); stringWriter.Update;
  592. stringWriter.Get(w);
  593. END GetString;
  594. END Value;
  595. CONST StrValue="value";
  596. TYPE
  597. AnyValue*=OBJECT(Value)
  598. VAR value*:ANY;
  599. PROCEDURE & InitAny*(value: ANY);
  600. BEGIN InitValue; SELF.value := value; type := "AnyValue";
  601. END InitAny;
  602. PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
  603. BEGIN Enumerate^(enum); enum(StrValue,FALSE);
  604. END Enumerate;
  605. PROCEDURE GetAddress(VAR a: ADDRESS): BOOLEAN;
  606. BEGIN
  607. a := value; RETURN TRUE;
  608. END GetAddress;
  609. PROCEDURE WriteValue(w: Streams.Writer);
  610. BEGIN w.Address(value);
  611. END WriteValue;
  612. PROCEDURE Address(): ADDRESS;
  613. BEGIN
  614. RETURN ADDRESSOF(value)
  615. END Address;
  616. PROCEDURE Find(CONST name: ARRAY OF CHAR): Result;
  617. VAR type, v, address: ADDRESS;
  618. VAR typeInfo: Modules.TypeDesc; num: LONGINT;
  619. proc: ProcedureResult; f: FieldResult;
  620. BEGIN
  621. IF value # NIL THEN
  622. address := value;
  623. SYSTEM.GET(address-SIZEOF(ADDRESS), type); (* type desc *)
  624. RETURN FindInType(SELF, address, type, name);
  625. (*
  626. SYSTEM.GET(type-SIZEOF(ADDRESS), typeInfo); (* type info*)
  627. IF FindProc(typeInfo.procedures, name,num) THEN
  628. NEW(proc, SELF, name, typeInfo.procedures[num]);
  629. proc.address := typeInfo.procedures[num].address;
  630. RETURN proc
  631. ELSIF FindField(typeInfo.fields, name, num) THEN
  632. NEW(f, name, typeInfo.fields[num]);
  633. f.address := address + typeInfo.fields[num].offset;
  634. RETURN f;
  635. ELSE HALT(101);
  636. END;
  637. *)
  638. ELSE
  639. RETURN NIL;
  640. END;
  641. END Find;
  642. END AnyValue;
  643. AddressValue*=OBJECT(Value)
  644. VAR value*:ADDRESS;
  645. PROCEDURE & InitAny*(value: ADDRESS);
  646. BEGIN InitValue; SELF.value := value; type := "AnyValue";
  647. END InitAny;
  648. PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
  649. BEGIN Enumerate^(enum); enum(StrValue,FALSE);
  650. END Enumerate;
  651. PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  652. VAR int: LONGINT;
  653. BEGIN
  654. IF name = StrValue THEN c.GetInteger(int); value := int;
  655. ELSE Set^(name, index, c);
  656. END;
  657. END Set;
  658. PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  659. BEGIN
  660. IF name = StrValue THEN c.SetInteger(value);
  661. ELSE Get^(name, index, c);
  662. END;
  663. END Get;
  664. PROCEDURE GetAddress(VAR a: ADDRESS): BOOLEAN;
  665. BEGIN
  666. a := value; RETURN TRUE;
  667. END GetAddress;
  668. PROCEDURE WriteValue(w: Streams.Writer);
  669. BEGIN w.Address(value);
  670. END WriteValue;
  671. PROCEDURE Address(): ADDRESS;
  672. BEGIN
  673. RETURN ADDRESSOF(value)
  674. END Address;
  675. END AddressValue;
  676. IntegerValue*=OBJECT(Value)
  677. VAR value*: HUGEINT;
  678. PROCEDURE & InitInteger*(value: HUGEINT);
  679. BEGIN InitValue; SELF.value := value; type := "IntegerValue";
  680. END InitInteger;
  681. PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
  682. BEGIN Enumerate^(enum); enum(StrValue,FALSE);
  683. END Enumerate;
  684. PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  685. VAR val: LONGINT;
  686. BEGIN
  687. IF name = StrValue THEN c.GetInteger(val); value := val;
  688. ELSE Set^(name, index, c);
  689. END;
  690. END Set;
  691. PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  692. BEGIN
  693. IF name = StrValue THEN c.SetInteger(LONGINT(value));
  694. ELSE Get^(name, index, c);
  695. END;
  696. END Get;
  697. PROCEDURE GetInt(VAR v: HUGEINT): BOOLEAN;
  698. BEGIN
  699. v := value; RETURN TRUE;
  700. END GetInt;
  701. PROCEDURE GetReal(VAR x: LONGREAL): BOOLEAN;
  702. BEGIN
  703. x := value; RETURN TRUE;
  704. END GetReal;
  705. PROCEDURE WriteValue(w: Streams.Writer);
  706. BEGIN w.Int(value,0);
  707. END WriteValue;
  708. PROCEDURE Address(): ADDRESS;
  709. BEGIN
  710. RETURN ADDRESSOF(value)
  711. END Address;
  712. END IntegerValue;
  713. RealValue*=OBJECT(Value)
  714. VAR value*: LONGREAL;
  715. PROCEDURE & InitReal*(value: LONGREAL);
  716. BEGIN InitValue; SELF.value := value; type := "RealValue";
  717. END InitReal;
  718. PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
  719. BEGIN Enumerate^(enum); enum(StrValue,FALSE);
  720. END Enumerate;
  721. PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  722. BEGIN
  723. IF name = StrValue THEN c.GetFloat(value);
  724. ELSE Set^(name, index, c);
  725. END;
  726. END Set;
  727. PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  728. BEGIN
  729. IF name = StrValue THEN c.SetFloat(value);
  730. ELSE Get^(name, index, c);
  731. END;
  732. END Get;
  733. PROCEDURE GetReal(VAR x: LONGREAL): BOOLEAN;
  734. BEGIN
  735. x := value; RETURN TRUE;
  736. END GetReal;
  737. PROCEDURE WriteValue(w: Streams.Writer);
  738. BEGIN w.Float(value,40);
  739. END WriteValue;
  740. PROCEDURE Address(): ADDRESS;
  741. BEGIN
  742. RETURN ADDRESSOF(value)
  743. END Address;
  744. END RealValue;
  745. BooleanValue*=OBJECT(Value)
  746. VAR value*: BOOLEAN;
  747. PROCEDURE & InitBoolean*(value: BOOLEAN);
  748. BEGIN InitValue; SELF.value := value; type := "BooleanValue";
  749. END InitBoolean;
  750. PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
  751. BEGIN Enumerate^(enum); enum(StrValue,FALSE);
  752. END Enumerate;
  753. PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  754. BEGIN
  755. IF name = StrValue THEN c.GetBoolean(value);
  756. ELSE Set^(name, index, c);
  757. END;
  758. END Set;
  759. PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  760. BEGIN
  761. IF name = StrValue THEN c.SetBoolean(value);
  762. ELSE Get^(name, index, c);
  763. END;
  764. END Get;
  765. PROCEDURE GetBoolean(VAR x: BOOLEAN): BOOLEAN;
  766. BEGIN
  767. x := value; RETURN TRUE;
  768. END GetBoolean;
  769. PROCEDURE WriteValue(w: Streams.Writer);
  770. BEGIN IF value THEN w.String("TRUE") ELSE w.String("FALSE") END
  771. END WriteValue;
  772. PROCEDURE Address(): ADDRESS;
  773. BEGIN
  774. RETURN ADDRESSOF(value)
  775. END Address;
  776. END BooleanValue;
  777. StringValue*=OBJECT(Value)
  778. VAR value*: Strings.String;
  779. PROCEDURE & InitString*(CONST value: ARRAY OF CHAR);
  780. BEGIN InitValue; SELF.value := Strings.NewString(value); type := "StringValue";
  781. END InitString;
  782. PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
  783. BEGIN Enumerate^(enum); enum(StrValue,FALSE);
  784. END Enumerate;
  785. PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  786. BEGIN
  787. IF name = StrValue THEN c.GetString(value);
  788. ELSE Set^(name, index, c);
  789. END;
  790. END Set;
  791. PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  792. BEGIN
  793. IF name = StrValue THEN c.SetString(value);
  794. ELSE Get^(name, index, c);
  795. END;
  796. END Get;
  797. PROCEDURE WriteValue(w: Streams.Writer);
  798. BEGIN (*w.String('"');*) w.String(value^); (*w.String('"');*)
  799. END WriteValue;
  800. PROCEDURE Address(): ADDRESS;
  801. BEGIN
  802. RETURN value;
  803. END Address;
  804. END StringValue;
  805. SetValue*=OBJECT(Value)
  806. VAR value*: SET;
  807. PROCEDURE & InitSet*(value: SET);
  808. BEGIN InitValue; SELF.value := value; type := "SetValue"
  809. END InitSet;
  810. PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
  811. BEGIN Enumerate^(enum); enum(StrValue,FALSE);
  812. END Enumerate;
  813. PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  814. BEGIN
  815. IF name = StrValue THEN c.GetSet(value);
  816. ELSE Set^(name, index, c);
  817. END;
  818. END Set;
  819. PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  820. BEGIN
  821. IF name = StrValue THEN c.SetSet(value);
  822. ELSE Get^(name, index, c);
  823. END;
  824. END Get;
  825. PROCEDURE GetSet(VAR x: SET): BOOLEAN;
  826. BEGIN
  827. x:= value; RETURN TRUE;
  828. END GetSet;
  829. PROCEDURE WriteValue(w: Streams.Writer);
  830. BEGIN
  831. w.Set(value)
  832. END WriteValue;
  833. PROCEDURE Address(): ADDRESS;
  834. BEGIN
  835. RETURN ADDRESSOF(value)
  836. END Address;
  837. END SetValue;
  838. RangeValue*=OBJECT(Value)
  839. VAR value*: RANGE;
  840. PROCEDURE & InitRange*(r: RANGE);
  841. BEGIN InitValue; value := r; type := "RangeValue"
  842. END InitRange;
  843. PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
  844. BEGIN Enumerate^(enum); enum(StrValue,FALSE);
  845. END Enumerate;
  846. PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  847. BEGIN
  848. IF name = StrValue THEN c.GetRange(value);
  849. ELSE Set^(name, index, c);
  850. END;
  851. END Set;
  852. PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  853. BEGIN
  854. IF name = StrValue THEN c.SetRange(value);
  855. ELSE Get^(name, index, c);
  856. END;
  857. END Get;
  858. PROCEDURE GetRange(VAR x: RANGE): BOOLEAN;
  859. BEGIN
  860. x := value; RETURN TRUE;
  861. END GetRange;
  862. PROCEDURE WriteValue(w: Streams.Writer);
  863. BEGIN
  864. w.Int(FIRST(value),0); w.String(" .. "); w.Int(LAST(value),0); IF STEP(value) # 1 THEN w.String(" BY "); w.Int(STEP(value),0) END;
  865. END WriteValue;
  866. PROCEDURE Address(): ADDRESS;
  867. BEGIN
  868. RETURN ADDRESSOF(value)
  869. END Address;
  870. END RangeValue;
  871. CharValue*=OBJECT(Value)
  872. VAR value: CHAR;
  873. PROCEDURE & InitChar*(c: CHAR);
  874. BEGIN InitValue; value := c; type := "CharValue";
  875. END InitChar;
  876. PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
  877. BEGIN Enumerate^(enum); enum(StrValue,FALSE);
  878. END Enumerate;
  879. PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  880. BEGIN
  881. IF name = StrValue THEN c.GetChar(value);
  882. ELSE Set^(name, index, c);
  883. END;
  884. END Set;
  885. PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  886. BEGIN
  887. IF name = StrValue THEN c.SetChar(value);
  888. ELSE Get^(name, index, c);
  889. END;
  890. END Get;
  891. PROCEDURE GetChar(VAR c: CHAR): BOOLEAN;
  892. BEGIN
  893. c := value; RETURN TRUE;
  894. END GetChar;
  895. PROCEDURE WriteValue(w: Streams.Writer);
  896. BEGIN
  897. w.Hex(ORD(value),2); w.String("X");
  898. END WriteValue;
  899. PROCEDURE Address(): ADDRESS;
  900. BEGIN
  901. RETURN ADDRESSOF(value)
  902. END Address;
  903. END CharValue;
  904. EnumValue*=OBJECT(Value)
  905. VAR value: LONGINT; translation: PersistentObjects.Translation;
  906. PROCEDURE & InitEnumValue*(trans: PersistentObjects.Translation; v: LONGINT);
  907. BEGIN InitValue; value := v; translation := trans; type := "EnumValue";
  908. END InitEnumValue;
  909. PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
  910. BEGIN Enumerate^(enum); enum(StrValue,FALSE);
  911. END Enumerate;
  912. PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  913. BEGIN
  914. IF name = StrValue THEN c.GetEnum(translation, value);
  915. ELSE Set^(name, index, c);
  916. END;
  917. END Set;
  918. PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  919. BEGIN
  920. IF name = StrValue THEN c.SetEnum(translation, value);
  921. ELSE Get^(name, index, c);
  922. END;
  923. END Get;
  924. PROCEDURE WriteValue(w: Streams.Writer);
  925. VAR str: ARRAY 32 OF CHAR;
  926. BEGIN
  927. IF translation.Name(value, str) THEN w.String(str) ELSE w.String("unknown") END;
  928. END WriteValue;
  929. PROCEDURE Address(): ADDRESS;
  930. BEGIN
  931. RETURN ADDRESSOF(value)
  932. END Address;
  933. END EnumValue;
  934. MathArrayValue*=OBJECT(Value)
  935. VAR values: ARRAY [*] OF Value;
  936. PROCEDURE &InitMathArrayValue*(len: LONGINT);
  937. BEGIN
  938. InitValue;
  939. NEW(values, len);
  940. type := "MathArrayValue";
  941. END InitMathArrayValue;
  942. PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
  943. BEGIN Enumerate^(enum); enum(StrValue,FALSE);
  944. END Enumerate;
  945. PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  946. BEGIN
  947. IF name = StrValue THEN values[index] := ContentGetValue(c)
  948. ELSE Set^(name, index, c);
  949. END;
  950. END Set;
  951. PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  952. BEGIN
  953. IF name = StrValue THEN c.SetObject(values[index],"Value");
  954. ELSE Get^(name, index, c);
  955. END;
  956. END Get;
  957. PROCEDURE SetValue*(at: LONGINT; value: Value);
  958. BEGIN
  959. values[at] := value;
  960. END SetValue;
  961. PROCEDURE GetValue*(at: LONGINT): Value;
  962. BEGIN
  963. RETURN values[at]
  964. END GetValue;
  965. PROCEDURE WriteValue*(w: Streams.Writer);
  966. VAR i: LONGINT; max: LONGINT;
  967. BEGIN
  968. w.String("[ ");
  969. max := LEN(values,0)-1;
  970. FOR i := 0 TO max DO
  971. values[i].WriteValue(w);
  972. IF i < max THEN
  973. w.String(", ");
  974. END;
  975. END;
  976. w.String("] ");
  977. END WriteValue;
  978. END MathArrayValue;
  979. (* object value represented as ANY wrapped in Value ? *)
  980. Symbol*= OBJECT
  981. VAR
  982. name: StringPool.Index;
  983. item-: Item;
  984. PROCEDURE & InitSymbol(name: StringPool.Index; index: LONGINT);
  985. BEGIN
  986. SELF.name := name; SELF.item := item;
  987. END InitSymbol;
  988. PROCEDURE GetName(VAR name: ARRAY OF CHAR);
  989. BEGIN
  990. StringPool.GetString(SELF.name, name);
  991. END GetName;
  992. END Symbol;
  993. Container* = OBJECT (Item)
  994. VAR
  995. symbols-: Basic.List;
  996. lookup-: Basic.HashTableInt;
  997. (* New scope. Note that it is possible that a scope is registered with an alias *)
  998. PROCEDURE & InitContainer*;
  999. BEGIN
  1000. InitObject();
  1001. NEW(lookup, 16); NEW(symbols, 16);
  1002. type := "Container";
  1003. END InitContainer;
  1004. PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
  1005. VAR i: LONGINT; symbol: Symbol; o: ANY; name: ARRAY 256 OF CHAR;
  1006. BEGIN Enumerate^(enum);
  1007. FOR i := 0 TO symbols.Length()-1 DO
  1008. o := symbols.Get(i);
  1009. symbol := o(Symbol);
  1010. symbol.GetName(name);
  1011. enum(name, FALSE);
  1012. END;
  1013. END Enumerate;
  1014. PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  1015. BEGIN
  1016. IF FALSE THEN
  1017. ELSE Set^(name, index, c);
  1018. END;
  1019. END Set;
  1020. PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  1021. VAR item: Item;
  1022. BEGIN
  1023. item := Find(name);
  1024. IF item # NIL THEN c.SetObject(item,"Item")
  1025. ELSE Get^(name, index, c);
  1026. END;
  1027. END Get;
  1028. PROCEDURE GetItem*(index: LONGINT): Item;
  1029. BEGIN
  1030. RETURN symbols.Get(index)(Symbol).item
  1031. END GetItem;
  1032. (* Enter a symbol with its name *)
  1033. PROCEDURE Enter1*(item: Item; name: StringPool.Index);
  1034. VAR any: ANY; symbol: Symbol;
  1035. BEGIN
  1036. any := lookup.Get(name);
  1037. IF any # NIL THEN
  1038. symbol := any(Symbol)
  1039. ELSE
  1040. NEW(symbol, name, symbols.Length());
  1041. symbols.Add(symbol);
  1042. lookup.Put(symbol.name, symbol);
  1043. END;
  1044. symbol.item := item
  1045. END Enter1;
  1046. (* Enter a symbol with its name *)
  1047. PROCEDURE Enter*(item: Item; CONST name: ARRAY OF CHAR);
  1048. BEGIN
  1049. Enter1(item, StringPool.GetIndex1(name))
  1050. END Enter;
  1051. PROCEDURE Find1*(id: LONGINT): Item;
  1052. VAR any: ANY;
  1053. BEGIN
  1054. any := lookup.Get(id);
  1055. IF any # NIL THEN RETURN any(Symbol).item ELSE RETURN NIL END
  1056. END Find1;
  1057. (* Find a symbol with name *)
  1058. PROCEDURE Find*(CONST name: ARRAY OF CHAR): Item;
  1059. BEGIN
  1060. RETURN Find1(StringPool.GetIndex1(name))
  1061. END Find;
  1062. END Container;
  1063. Scope* = OBJECT
  1064. VAR
  1065. outer-: Scope;
  1066. object-: Object;
  1067. level: LONGINT;
  1068. PROCEDURE & InitScope*(outer: Scope; object: Object);
  1069. BEGIN
  1070. SELF.outer := outer;
  1071. IF outer = NIL THEN level := 0 ELSE level := outer.level + 1 END;
  1072. ASSERT(object # NIL);
  1073. SELF.object := object
  1074. END InitScope;
  1075. PROCEDURE Enter*(object: Object): Scope;
  1076. VAR scope: Scope;
  1077. BEGIN
  1078. NEW(scope, SELF, object);
  1079. RETURN scope
  1080. END Enter;
  1081. PROCEDURE FindObject*(CONST name: ARRAY OF CHAR; index: LONGINT; VAR in: Object): Object;
  1082. VAR object: Object;
  1083. BEGIN
  1084. in := SELF.object;
  1085. object := FindInObject(in, name, index);
  1086. IF (object = NIL) & (outer # NIL) THEN
  1087. object := outer.FindObject(name, index, in)
  1088. END;
  1089. RETURN object
  1090. END FindObject;
  1091. PROCEDURE FindObject1*(name: StringPool.Index; index: LONGINT; VAR in: Object): Object;
  1092. VAR str: ARRAY 256 OF CHAR;
  1093. BEGIN
  1094. StringPool.GetString(name, str);
  1095. RETURN FindObject(str,index, in);
  1096. END FindObject1;
  1097. PROCEDURE Leave*(): Scope;
  1098. BEGIN
  1099. RETURN outer
  1100. END Leave;
  1101. PROCEDURE Dump*(log: Streams.Writer);
  1102. BEGIN
  1103. IF object # NIL THEN object.Dump(log,"scope object") END;
  1104. log.Ln;
  1105. IF outer # NIL THEN outer.Dump(log) END;
  1106. END Dump;
  1107. END Scope;
  1108. PROCEDURE Indent(w: Streams.Writer; level: LONGINT);
  1109. BEGIN
  1110. WHILE level> 0 DO w.Char(TAB); DEC(level) END;
  1111. END Indent;
  1112. PROCEDURE Test*(context: Commands.Context);
  1113. VAR scope, inner: Scope; container: Container; integer: IntegerValue; float: RealValue; string: StringValue;
  1114. BEGIN
  1115. NEW(container);
  1116. container.Enter(integer, "integer");
  1117. container.Enter(float,"float");
  1118. container.Enter(string,"string");
  1119. NEW(scope, NIL, container);
  1120. NEW(container);
  1121. inner := scope.Enter(container);
  1122. scope.Dump(context.out);
  1123. (*scope.Write(context.out);*)
  1124. END Test;
  1125. PROCEDURE ContentGetValue(c: Content): Value;
  1126. VAR o: Object;
  1127. BEGIN
  1128. c.GetObject(o); IF o = NIL THEN RETURN NIL ELSE RETURN o(Value) END;
  1129. END ContentGetValue;
  1130. PROCEDURE NewIntegerValue(value: LONGINT): IntegerValue;
  1131. VAR obj: IntegerValue;
  1132. BEGIN
  1133. NEW(obj, value); RETURN obj
  1134. END NewIntegerValue;
  1135. PROCEDURE NewFloatValue(value: LONGREAL): RealValue;
  1136. VAR obj: RealValue;
  1137. BEGIN
  1138. NEW(obj, value); RETURN obj
  1139. END NewFloatValue;
  1140. PROCEDURE NewBooleanValue(value: BOOLEAN): BooleanValue;
  1141. VAR obj: BooleanValue;
  1142. BEGIN
  1143. NEW(obj, value); RETURN obj
  1144. END NewBooleanValue;
  1145. PROCEDURE NewStringValue(CONST value: ARRAY OF CHAR): StringValue;
  1146. VAR obj: StringValue;
  1147. BEGIN
  1148. NEW(obj, value); RETURN obj
  1149. END NewStringValue;
  1150. PROCEDURE NewNameValue(CONST value: ARRAY OF CHAR): StringValue;
  1151. VAR obj: StringValue;
  1152. BEGIN
  1153. NEW(obj, value); RETURN obj
  1154. END NewNameValue;
  1155. PROCEDURE NewRangeValue(value: RANGE): RangeValue;
  1156. VAR obj: RangeValue;
  1157. BEGIN
  1158. NEW(obj, value); RETURN obj
  1159. END NewRangeValue;
  1160. PROCEDURE NewCharValue(value: CHAR): CharValue;
  1161. VAR obj: CharValue;
  1162. BEGIN
  1163. NEW(obj, value); RETURN obj
  1164. END NewCharValue;
  1165. PROCEDURE NewSetValue(value: SET): SetValue;
  1166. VAR obj: SetValue;
  1167. BEGIN
  1168. NEW(obj, value); RETURN obj
  1169. END NewSetValue;
  1170. PROCEDURE NewEnumValue(translation: PersistentObjects.Translation; value: LONGINT): EnumValue;
  1171. VAR obj: EnumValue;
  1172. BEGIN
  1173. NEW(obj, translation, value);
  1174. END NewEnumValue;
  1175. PROCEDURE FindInObject*(in: Object; CONST name: ARRAY OF CHAR; index: LONGINT): Object;
  1176. VAR content: Content;
  1177. TYPE Class=PersistentObjects.Class;
  1178. BEGIN
  1179. NEW(content);
  1180. in.Get(name, index, content);
  1181. IF content.success THEN
  1182. CASE content.class OF
  1183. |Class.String: RETURN NewStringValue(content.string^);
  1184. |Class.Object: RETURN content.object
  1185. |Class.Name: RETURN NewNameValue(content.name);
  1186. |Class.Boolean: RETURN NewBooleanValue(content.boolean);
  1187. |Class.Integer: RETURN NewIntegerValue(content.integer);
  1188. |Class.Float: RETURN NewFloatValue(content.float);
  1189. |Class.Enum: RETURN NewEnumValue(content.translation,content.integer)
  1190. |Class.Range: RETURN NewRangeValue(content.range)
  1191. |Class.Set: RETURN NewSetValue(content.set)
  1192. |Class.Char: RETURN NewCharValue(content.char)
  1193. END
  1194. END;
  1195. RETURN NIL
  1196. END FindInObject;
  1197. TYPE
  1198. ObjectFilter* = OBJECT
  1199. VAR
  1200. content: Content;
  1201. object: Object;
  1202. found: Container;
  1203. attribute, value: ARRAY 256 OF CHAR;
  1204. PROCEDURE & InitObjectFilter*;
  1205. BEGIN
  1206. NEW(content); NEW(found);
  1207. END InitObjectFilter;
  1208. PROCEDURE AddFiltered(obj: Object);
  1209. BEGIN
  1210. IF obj # NIL THEN
  1211. obj.Get(attribute, -1, content);
  1212. IF content.success & content.Equals(value) THEN
  1213. found.Enter(obj,"any");
  1214. END;
  1215. END;
  1216. END AddFiltered;
  1217. PROCEDURE Enumerate(CONST name: ARRAY OF CHAR; array: BOOLEAN);
  1218. VAR obj: Object; index: LONGINT;
  1219. BEGIN
  1220. object.Get(name,-1, content);
  1221. IF content.success & (content.class = PersistentObjects.Class.Object) THEN
  1222. IF array THEN
  1223. index := 0;
  1224. REPEAT
  1225. object.Get(name, index, content);
  1226. obj := content.object;
  1227. AddFiltered(obj);
  1228. INC(index);
  1229. UNTIL obj = NIL;
  1230. ELSE
  1231. AddFiltered(content.object)
  1232. END;
  1233. END;
  1234. END Enumerate;
  1235. PROCEDURE Filter*(obj: Object; attribute, value: ARRAY OF CHAR): Container;
  1236. BEGIN
  1237. NEW(found);
  1238. object := obj;
  1239. COPY(attribute, SELF.attribute);
  1240. COPY(value, SELF.value);
  1241. obj.Enumerate(Enumerate);
  1242. RETURN found
  1243. END Filter;
  1244. END ObjectFilter;
  1245. PROCEDURE FindType(CONST types: POINTER TO ARRAY OF Modules.TypeDesc; CONST name: ARRAY OF CHAR): Modules.TypeDesc;
  1246. VAR i: LONGINT;
  1247. BEGIN
  1248. IF types = NIL THEN RETURN NIL END;
  1249. FOR i := 0 TO LEN(types)-1 DO
  1250. IF types[i].name = name THEN
  1251. RETURN types[i];
  1252. END;
  1253. END;
  1254. RETURN NIL;
  1255. END FindType;
  1256. PROCEDURE FindField(CONST types: POINTER TO ARRAY OF Modules.FieldEntry; CONST name: ARRAY OF CHAR; VAR num: LONGINT): BOOLEAN;
  1257. BEGIN
  1258. IF types = NIL THEN RETURN FALSE END;
  1259. FOR num := 0 TO LEN(types)-1 DO
  1260. IF types[num].name^ = name THEN
  1261. RETURN TRUE;
  1262. END;
  1263. END;
  1264. RETURN FALSE;
  1265. END FindField;
  1266. PROCEDURE FindProc(CONST types: POINTER TO ARRAY OF Modules.ProcedureEntry; CONST name: ARRAY OF CHAR; VAR num: LONGINT): BOOLEAN;
  1267. BEGIN
  1268. IF types = NIL THEN RETURN FALSE END;
  1269. FOR num := 0 TO LEN(types)-1 DO
  1270. IF types[num].name^ = name THEN
  1271. RETURN TRUE;
  1272. END;
  1273. END;
  1274. RETURN FALSE;
  1275. END FindProc;
  1276. PROCEDURE GetModule*(CONST name: ARRAY OF CHAR): ModuleResult;
  1277. VAR msg: ARRAY 128 OF CHAR; res: LONGINT; mod:ModuleResult; m: Modules.Module;
  1278. BEGIN
  1279. m := Modules.ThisModule(name, res, msg);
  1280. IF m # NIL THEN
  1281. NEW(mod, name, m);
  1282. ELSE
  1283. mod := NIL;
  1284. END;
  1285. RETURN mod;
  1286. END GetModule;
  1287. PROCEDURE FindInObject1*(in: Object; name: StringPool.Index; index: LONGINT): Object;
  1288. VAR str: ARRAY 256 OF CHAR;
  1289. BEGIN
  1290. StringPool.GetString(name, str);
  1291. RETURN FindInObject(in,str,index);
  1292. END FindInObject1;
  1293. END FoxInterpreterSymbols.
  1294. SystemTools.FreeDownTo FoxInterpreterSymbols ~
  1295. FoxInterpreterSymbols.Test ~