FoxInterpreterSymbols.Mod 36 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570
  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 Address(): ADDRESS;
  263. BEGIN
  264. RETURN address;
  265. END Address;
  266. PROCEDURE & InitProcedure(c: Result; CONST name: ARRAY OF CHAR; CONST p: Modules.ProcedureEntry);
  267. BEGIN
  268. InitSymbol(name); proc := p;
  269. caller := c;
  270. END InitProcedure;
  271. PROCEDURE Pars*();
  272. BEGIN
  273. index := 0;
  274. NEW(stack); (* can optimize this *)
  275. END Pars;
  276. PROCEDURE PushAddress*(adr: ADDRESS); (* for self pointer *)
  277. BEGIN
  278. stack.PushA(adr);
  279. END PushAddress;
  280. PROCEDURE Push*(o: Result): BOOLEAN;
  281. VAR type: Modules.EntryType;
  282. s: SHORTINT; i: INTEGER; l: LONGINT; h: HUGEINT;
  283. r: REAL; x: LONGREAL;
  284. b: BOOLEAN;
  285. set: SET;
  286. var: BOOLEAN;
  287. v:Value;
  288. BEGIN
  289. IF (proc.parameters = NIL) OR (index >= LEN(proc.parameters)) THEN RETURN FALSE END;
  290. type := proc.parameters[index].type;
  291. var := 1 IN proc.parameters[index].flags;
  292. INC(index);
  293. IF var THEN
  294. IF type.subclass = 0X THEN
  295. CASE type.class OF
  296. sfTypeCHAR .. sfTypePointerToArray:
  297. (*! check type ! *)
  298. stack.PushA(o.Address());
  299. RETURN TRUE;
  300. ELSE
  301. RETURN FALSE
  302. END;
  303. ELSIF type.subclass = sfTypeOpenArray THEN
  304. CASE type.class OF
  305. sfTypeCHAR, sfTypeCHAR8:
  306. IF o IS StringValue THEN
  307. stack.PushSz(LEN(o(StringValue).value));
  308. stack.PushA(ADDRESSOF(o(StringValue).value[0]));
  309. RETURN TRUE;
  310. END;
  311. END;
  312. END;
  313. ELSE
  314. v := o.Evaluate();
  315. IF v = NIL THEN RETURN FALSE END;
  316. WITH v: Value DO
  317. IF type.subclass = 0X THEN
  318. CASE type.class OF
  319. sfTypeSHORTINT,sfTypeSIGNED8 :
  320. IF v.GetInt(h) THEN
  321. s:= SHORTINT(h); stack.PushS(s);
  322. RETURN TRUE;
  323. END;
  324. | sfTypeINTEGER,sfTypeSIGNED16 :
  325. IF v.GetInt(h) THEN
  326. i:= INTEGER(h); stack.PushI(i);
  327. RETURN TRUE;
  328. END;
  329. | sfTypeLONGINT,sfTypeSIGNED32:
  330. IF v.GetInt(h) THEN
  331. l:= LONGINT(h); stack.PushL(l);
  332. RETURN TRUE;
  333. END;
  334. | sfTypeHUGEINT,sfTypeSIGNED64:
  335. IF v.GetInt(h) THEN
  336. stack.PushH(h);
  337. RETURN TRUE;
  338. END;
  339. |sfTypeREAL:
  340. IF v.GetReal(x) THEN
  341. r := REAL(x);stack.PushR(r);
  342. RETURN TRUE;
  343. END;
  344. |sfTypeLONGREAL:
  345. IF v.GetReal(x) THEN
  346. stack.PushX(x);
  347. RETURN TRUE;
  348. END;
  349. |sfTypeBOOLEAN:
  350. IF v.GetBoolean(b) THEN
  351. stack.PushB(b);
  352. RETURN TRUE
  353. END;
  354. |sfTypeSET:
  355. IF v.GetSet(set) THEN
  356. stack.PushSet(set);
  357. RETURN TRUE
  358. END;
  359. END;
  360. ELSIF type.subclass = sfTypeOpenArray THEN
  361. CASE type.class OF
  362. sfTypeCHAR, sfTypeCHAR8:
  363. IF v IS StringValue THEN
  364. stack.PushSz(LEN(v(StringValue).value));
  365. stack.PushA(ADDRESSOF(v(StringValue).value[0]));
  366. RETURN TRUE;
  367. END;
  368. END;
  369. END;
  370. END;
  371. END;
  372. RETURN FALSE;
  373. END Push;
  374. PROCEDURE Check*(): BOOLEAN;
  375. BEGIN
  376. RETURN (proc.parameters = NIL) & (index = 0) OR (index = LEN(proc.parameters));
  377. END Check;
  378. PROCEDURE Evaluate(): Value;
  379. VAR
  380. type: Modules.EntryType;
  381. int: IntegerValue;
  382. real: RealValue;
  383. bool: BooleanValue;
  384. set: SetValue;
  385. any: AnyValue;
  386. BEGIN
  387. type := proc.returnType;
  388. CASE type.class OF
  389. sfTypeSHORTINT,sfTypeSIGNED8 :
  390. NEW(int, SHORTINT(stack.CallH(address)));
  391. RETURN int;
  392. | sfTypeINTEGER,sfTypeSIGNED16 :
  393. NEW(int, INTEGER(stack.CallH(address)));
  394. RETURN int;
  395. | sfTypeLONGINT,sfTypeSIGNED32:
  396. NEW(int, LONGINT(stack.CallH(address)));
  397. RETURN int;
  398. | sfTypeHUGEINT,sfTypeSIGNED64:
  399. NEW(int, stack.CallH(address));
  400. RETURN int;
  401. |sfTypeREAL:
  402. NEW(real, stack.CallR(address));
  403. RETURN real
  404. |sfTypeLONGREAL:
  405. NEW(real, stack.CallX(address));
  406. RETURN real;
  407. |sfTypeBOOLEAN:
  408. NEW(bool, SYSTEM.VAL(BOOLEAN, stack.CallH(address)));
  409. RETURN bool;
  410. |sfTypeSET:
  411. NEW(set, SYSTEM.VAL(SET, stack.CallH(address)));
  412. RETURN set;
  413. | sfTypeANY, sfTypeOBJECT, sfTypePointerToRecord: (* pointers are passed as varpars *)
  414. stack.Call(address);
  415. RETURN NIL;
  416. | 0X:
  417. stack.Call(address);
  418. RETURN NIL;
  419. END;
  420. RETURN NIL;
  421. END Evaluate;
  422. END ProcedureResult;
  423. FieldResult* = OBJECT (SymbolResult)
  424. VAR field: Modules.FieldEntry;
  425. address: ADDRESS;
  426. PROCEDURE & InitField(CONST name: ARRAY OF CHAR; CONST f: Modules.FieldEntry);
  427. BEGIN
  428. InitSymbol(name); field := f;
  429. END InitField;
  430. PROCEDURE Address(): ADDRESS;
  431. BEGIN
  432. RETURN address;
  433. END Address;
  434. PROCEDURE Evaluate(): Value;
  435. VAR
  436. s: SHORTINT;
  437. i: INTEGER;
  438. l: LONGINT;
  439. h: HUGEINT;
  440. int: IntegerValue;
  441. a: ANY;
  442. any: AnyValue;
  443. BEGIN
  444. CASE field.type.class OF
  445. sfTypeSHORTINT,sfTypeSIGNED8 :
  446. SYSTEM.GET(address, s);
  447. NEW(int, s);
  448. RETURN int;
  449. | sfTypeINTEGER,sfTypeSIGNED16 :
  450. SYSTEM.GET(address, i);
  451. NEW(int, i);
  452. RETURN int;
  453. | sfTypeLONGINT,sfTypeSIGNED32:
  454. SYSTEM.GET(address, l);
  455. NEW(int, l);
  456. RETURN int;
  457. | sfTypeHUGEINT,sfTypeSIGNED64:
  458. SYSTEM.GET(address, h);
  459. NEW(int,LONGINT(h));
  460. RETURN int;
  461. | sfTypePointerToRecord, sfTypeANY, sfTypeOBJECT:
  462. SYSTEM.GET(address, a);
  463. NEW(any, a);
  464. RETURN any;
  465. ELSE
  466. HALT(100);
  467. END;
  468. END Evaluate;
  469. PROCEDURE SetV(v: Value): BOOLEAN;
  470. VAR
  471. s: SHORTINT; i: INTEGER; l: LONGINT; h: HUGEINT;
  472. r: REAL; x: LONGREAL;
  473. b: BOOLEAN;
  474. set: SET;
  475. BEGIN
  476. CASE field.type.class OF
  477. sfTypeSHORTINT, sfTypeSIGNED8:
  478. IF v.GetInt(h) THEN
  479. s:= SHORTINT(h); SYSTEM.PUT(address, s);
  480. RETURN TRUE;
  481. END;
  482. |sfTypeINTEGER, sfTypeSIGNED16:
  483. IF v.GetInt(h) THEN
  484. i:= INTEGER(h); SYSTEM.PUT(address, i);
  485. RETURN TRUE;
  486. END;
  487. |sfTypeLONGINT, sfTypeSIGNED32:
  488. IF v.GetInt(h) THEN
  489. l:= LONGINT(h); SYSTEM.PUT(address, l);
  490. RETURN TRUE;
  491. END;
  492. |sfTypeHUGEINT, sfTypeSIGNED64:
  493. IF v.GetInt(h) THEN
  494. SYSTEM.PUT(address, h);
  495. RETURN TRUE
  496. END;
  497. |sfTypeREAL:
  498. IF v.GetReal(x) THEN
  499. r := REAL(x); SYSTEM.PUT(address, r);
  500. RETURN TRUE
  501. END;
  502. |sfTypeLONGREAL:
  503. IF v.GetReal(x) THEN
  504. SYSTEM.PUT(address,x);
  505. RETURN TRUE
  506. END;
  507. |sfTypeBOOLEAN:
  508. IF v.GetBoolean(b) THEN
  509. SYSTEM.PUT(address,b);
  510. RETURN TRUE
  511. END;
  512. |sfTypeSET:
  513. IF v.GetSet(set) THEN
  514. SYSTEM.PUT(address,set);
  515. RETURN TRUE
  516. END;
  517. END;
  518. END SetV;
  519. PROCEDURE Find(CONST name: ARRAY OF CHAR): Result;
  520. VAR type, value: ADDRESS;
  521. VAR typeInfo: Modules.TypeDesc; num: LONGINT;
  522. proc: ProcedureResult; f: FieldResult;
  523. BEGIN
  524. IF (field.type.class = sfTypePointerToRecord)
  525. OR (field.type.class = sfTypeANY)
  526. OR (field.type.class = sfTypeOBJECT)
  527. THEN
  528. SYSTEM.GET(address, value);
  529. SYSTEM.GET(value-SIZEOF(ADDRESS), type); (* type desc *)
  530. RETURN FindInType(SELF, value, type, name);
  531. (*
  532. SYSTEM.GET(type-SIZEOF(ADDRESS), typeInfo); (* type info*)
  533. IF FindProc(typeInfo.procedures, name,num) THEN
  534. NEW(proc, SELF, name, typeInfo.procedures[num]);
  535. proc.address := typeInfo.procedures[num].address;
  536. RETURN proc
  537. ELSIF FindField(typeInfo.fields, name, num) THEN
  538. NEW(f, name, typeInfo.fields[num]);
  539. f.address := value + typeInfo.fields[num].offset;
  540. RETURN f;
  541. ELSE HALT(101);
  542. END;
  543. *)
  544. ELSIF field.type.class = sfTypeRecord THEN
  545. type := field.type.type;
  546. RETURN FindInType(SELF, address, type, name);
  547. (*
  548. SYSTEM.GET(type-SIZEOF(ADDRESS), typeInfo); (* type info*)
  549. IF FindProc(typeInfo.procedures, name,num) THEN
  550. NEW(proc, SELF, name, typeInfo.procedures[num]);
  551. proc.address := typeInfo.procedures[num].address;
  552. RETURN proc
  553. ELSIF FindField(typeInfo.fields, name, num) THEN
  554. NEW(f, name, typeInfo.fields[num]);
  555. f.address := address + typeInfo.fields[num].offset;
  556. RETURN f;
  557. ELSE HALT(101);
  558. END;
  559. *)
  560. ELSE HALT(100);
  561. END;
  562. END Find;
  563. END FieldResult;
  564. (* traverse types and supertypes for first occurence of symbol name *)
  565. PROCEDURE FindInType(scope: Result; address: ADDRESS; type: ADDRESS; CONST name: ARRAY OF CHAR): Result;
  566. VAR tag: ADDRESS; typeInfo: Modules.TypeDesc; i, num: LONGINT;
  567. proc: ProcedureResult; f: FieldResult;
  568. BEGIN
  569. FOR i := 15 TO 0 BY -1 DO
  570. SYSTEM.GET(type-(2+i)*SIZEOF(ADDRESS), tag);
  571. IF tag # NIL THEN
  572. SYSTEM.GET(tag-SIZEOF(ADDRESS), typeInfo);
  573. IF FindProc(typeInfo.procedures, name,num) THEN
  574. NEW(proc, scope, name, typeInfo.procedures[num]);
  575. proc.address := typeInfo.procedures[num].address;
  576. RETURN proc
  577. ELSIF FindField(typeInfo.fields, name, num) THEN
  578. NEW(f, name, typeInfo.fields[num]);
  579. f.address := address + typeInfo.fields[num].offset;
  580. RETURN f;
  581. END;
  582. END;
  583. END;
  584. RETURN NIL;
  585. END FindInType;
  586. TYPE
  587. Value*= OBJECT(Result)
  588. PROCEDURE & InitValue;
  589. BEGIN InitObject
  590. END InitValue;
  591. PROCEDURE Evaluate(): Value;
  592. BEGIN
  593. RETURN SELF;
  594. END Evaluate;
  595. PROCEDURE GetInt*(VAR h: HUGEINT): BOOLEAN;
  596. BEGIN
  597. RETURN FALSE;
  598. END GetInt;
  599. PROCEDURE GetAddress*(VAR a: ADDRESS): BOOLEAN;
  600. BEGIN
  601. RETURN FALSE;
  602. END GetAddress;
  603. PROCEDURE GetReal*(VAR x: LONGREAL): BOOLEAN;
  604. BEGIN
  605. RETURN FALSE;
  606. END GetReal;
  607. PROCEDURE GetBoolean*(VAR x: BOOLEAN): BOOLEAN;
  608. BEGIN
  609. RETURN FALSE;
  610. END GetBoolean;
  611. PROCEDURE GetSet*(VAR x: SET): BOOLEAN;
  612. BEGIN
  613. RETURN FALSE;
  614. END GetSet;
  615. PROCEDURE GetChar*(VAR x: CHAR): BOOLEAN;
  616. BEGIN
  617. RETURN FALSE;
  618. END GetChar;
  619. PROCEDURE GetRange*(VAR x: RANGE): BOOLEAN;
  620. BEGIN
  621. RETURN FALSE;
  622. END GetRange;
  623. PROCEDURE WriteValue*(w: Streams.Writer);
  624. BEGIN
  625. END WriteValue;
  626. PROCEDURE GetString*(VAR w: ARRAY OF CHAR);
  627. VAR stringWriter: Streams.StringWriter;
  628. BEGIN
  629. NEW(stringWriter, 128);
  630. WriteValue(stringWriter); stringWriter.Update;
  631. stringWriter.Get(w);
  632. END GetString;
  633. END Value;
  634. CONST StrValue="value";
  635. TYPE
  636. AnyValue*=OBJECT(Value)
  637. VAR value*:ANY;
  638. PROCEDURE & InitAny*(value: ANY);
  639. BEGIN InitValue; SELF.value := value; type := "AnyValue";
  640. END InitAny;
  641. PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
  642. BEGIN Enumerate^(enum); enum(StrValue,FALSE);
  643. END Enumerate;
  644. PROCEDURE GetAddress(VAR a: ADDRESS): BOOLEAN;
  645. BEGIN
  646. a := value; RETURN TRUE;
  647. END GetAddress;
  648. PROCEDURE WriteValue(w: Streams.Writer);
  649. BEGIN w.Address(value);
  650. END WriteValue;
  651. PROCEDURE Address(): ADDRESS;
  652. BEGIN
  653. RETURN ADDRESSOF(value)
  654. END Address;
  655. PROCEDURE Find(CONST name: ARRAY OF CHAR): Result;
  656. VAR type, v, address: ADDRESS;
  657. VAR typeInfo: Modules.TypeDesc; num: LONGINT;
  658. proc: ProcedureResult; f: FieldResult;
  659. BEGIN
  660. IF value # NIL THEN
  661. address := value;
  662. SYSTEM.GET(address-SIZEOF(ADDRESS), type); (* type desc *)
  663. RETURN FindInType(SELF, address, type, name);
  664. (*
  665. SYSTEM.GET(type-SIZEOF(ADDRESS), typeInfo); (* type info*)
  666. IF FindProc(typeInfo.procedures, name,num) THEN
  667. NEW(proc, SELF, name, typeInfo.procedures[num]);
  668. proc.address := typeInfo.procedures[num].address;
  669. RETURN proc
  670. ELSIF FindField(typeInfo.fields, name, num) THEN
  671. NEW(f, name, typeInfo.fields[num]);
  672. f.address := address + typeInfo.fields[num].offset;
  673. RETURN f;
  674. ELSE HALT(101);
  675. END;
  676. *)
  677. ELSE
  678. RETURN NIL;
  679. END;
  680. END Find;
  681. END AnyValue;
  682. AddressValue*=OBJECT(Value)
  683. VAR value*:ADDRESS;
  684. PROCEDURE & InitAny*(value: ADDRESS);
  685. BEGIN InitValue; SELF.value := value; type := "AnyValue";
  686. END InitAny;
  687. PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
  688. BEGIN Enumerate^(enum); enum(StrValue,FALSE);
  689. END Enumerate;
  690. PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  691. VAR int: LONGINT;
  692. BEGIN
  693. IF name = StrValue THEN c.GetInteger(int); value := int;
  694. ELSE Set^(name, index, c);
  695. END;
  696. END Set;
  697. PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  698. BEGIN
  699. IF name = StrValue THEN c.SetInteger(value);
  700. ELSE Get^(name, index, c);
  701. END;
  702. END Get;
  703. PROCEDURE GetAddress(VAR a: ADDRESS): BOOLEAN;
  704. BEGIN
  705. a := value; RETURN TRUE;
  706. END GetAddress;
  707. PROCEDURE WriteValue(w: Streams.Writer);
  708. BEGIN w.Address(value);
  709. END WriteValue;
  710. PROCEDURE Address(): ADDRESS;
  711. BEGIN
  712. RETURN ADDRESSOF(value)
  713. END Address;
  714. END AddressValue;
  715. IntegerValue*=OBJECT(Value)
  716. VAR value*: HUGEINT;
  717. PROCEDURE & InitInteger*(value: HUGEINT);
  718. BEGIN InitValue; SELF.value := value; type := "IntegerValue";
  719. END InitInteger;
  720. PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
  721. BEGIN Enumerate^(enum); enum(StrValue,FALSE);
  722. END Enumerate;
  723. PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  724. VAR val: LONGINT;
  725. BEGIN
  726. IF name = StrValue THEN c.GetInteger(val); value := val;
  727. ELSE Set^(name, index, c);
  728. END;
  729. END Set;
  730. PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  731. BEGIN
  732. IF name = StrValue THEN c.SetInteger(LONGINT(value));
  733. ELSE Get^(name, index, c);
  734. END;
  735. END Get;
  736. PROCEDURE GetInt(VAR v: HUGEINT): BOOLEAN;
  737. BEGIN
  738. v := value; RETURN TRUE;
  739. END GetInt;
  740. PROCEDURE GetReal(VAR x: LONGREAL): BOOLEAN;
  741. BEGIN
  742. x := value; RETURN TRUE;
  743. END GetReal;
  744. PROCEDURE WriteValue(w: Streams.Writer);
  745. BEGIN w.Int(value,0);
  746. END WriteValue;
  747. PROCEDURE Address(): ADDRESS;
  748. BEGIN
  749. RETURN ADDRESSOF(value)
  750. END Address;
  751. END IntegerValue;
  752. RealValue*=OBJECT(Value)
  753. VAR value*: LONGREAL;
  754. PROCEDURE & InitReal*(value: LONGREAL);
  755. BEGIN InitValue; SELF.value := value; type := "RealValue";
  756. END InitReal;
  757. PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
  758. BEGIN Enumerate^(enum); enum(StrValue,FALSE);
  759. END Enumerate;
  760. PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  761. BEGIN
  762. IF name = StrValue THEN c.GetFloat(value);
  763. ELSE Set^(name, index, c);
  764. END;
  765. END Set;
  766. PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  767. BEGIN
  768. IF name = StrValue THEN c.SetFloat(value);
  769. ELSE Get^(name, index, c);
  770. END;
  771. END Get;
  772. PROCEDURE GetReal(VAR x: LONGREAL): BOOLEAN;
  773. BEGIN
  774. x := value; RETURN TRUE;
  775. END GetReal;
  776. PROCEDURE WriteValue(w: Streams.Writer);
  777. BEGIN w.Float(value,40);
  778. END WriteValue;
  779. PROCEDURE Address(): ADDRESS;
  780. BEGIN
  781. RETURN ADDRESSOF(value)
  782. END Address;
  783. END RealValue;
  784. BooleanValue*=OBJECT(Value)
  785. VAR value*: BOOLEAN;
  786. PROCEDURE & InitBoolean*(value: BOOLEAN);
  787. BEGIN InitValue; SELF.value := value; type := "BooleanValue";
  788. END InitBoolean;
  789. PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
  790. BEGIN Enumerate^(enum); enum(StrValue,FALSE);
  791. END Enumerate;
  792. PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  793. BEGIN
  794. IF name = StrValue THEN c.GetBoolean(value);
  795. ELSE Set^(name, index, c);
  796. END;
  797. END Set;
  798. PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  799. BEGIN
  800. IF name = StrValue THEN c.SetBoolean(value);
  801. ELSE Get^(name, index, c);
  802. END;
  803. END Get;
  804. PROCEDURE GetBoolean(VAR x: BOOLEAN): BOOLEAN;
  805. BEGIN
  806. x := value; RETURN TRUE;
  807. END GetBoolean;
  808. PROCEDURE WriteValue(w: Streams.Writer);
  809. BEGIN IF value THEN w.String("TRUE") ELSE w.String("FALSE") END
  810. END WriteValue;
  811. PROCEDURE Address(): ADDRESS;
  812. BEGIN
  813. RETURN ADDRESSOF(value)
  814. END Address;
  815. END BooleanValue;
  816. StringValue*=OBJECT(Value)
  817. VAR value*: Strings.String;
  818. PROCEDURE & InitString*(CONST value: ARRAY OF CHAR);
  819. BEGIN InitValue; SELF.value := Strings.NewString(value); type := "StringValue";
  820. END InitString;
  821. PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
  822. BEGIN Enumerate^(enum); enum(StrValue,FALSE);
  823. END Enumerate;
  824. PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  825. BEGIN
  826. IF name = StrValue THEN c.GetString(value);
  827. ELSE Set^(name, index, c);
  828. END;
  829. END Set;
  830. PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  831. BEGIN
  832. IF name = StrValue THEN c.SetString(value);
  833. ELSE Get^(name, index, c);
  834. END;
  835. END Get;
  836. PROCEDURE WriteValue(w: Streams.Writer);
  837. BEGIN (*w.String('"');*) w.String(value^); (*w.String('"');*)
  838. END WriteValue;
  839. PROCEDURE Address(): ADDRESS;
  840. BEGIN
  841. RETURN value;
  842. END Address;
  843. END StringValue;
  844. SetValue*=OBJECT(Value)
  845. VAR value*: SET;
  846. PROCEDURE & InitSet*(value: SET);
  847. BEGIN InitValue; SELF.value := value; type := "SetValue"
  848. END InitSet;
  849. PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
  850. BEGIN Enumerate^(enum); enum(StrValue,FALSE);
  851. END Enumerate;
  852. PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  853. BEGIN
  854. IF name = StrValue THEN c.GetSet(value);
  855. ELSE Set^(name, index, c);
  856. END;
  857. END Set;
  858. PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  859. BEGIN
  860. IF name = StrValue THEN c.SetSet(value);
  861. ELSE Get^(name, index, c);
  862. END;
  863. END Get;
  864. PROCEDURE GetSet(VAR x: SET): BOOLEAN;
  865. BEGIN
  866. x:= value; RETURN TRUE;
  867. END GetSet;
  868. PROCEDURE WriteValue(w: Streams.Writer);
  869. BEGIN
  870. w.Set(value)
  871. END WriteValue;
  872. PROCEDURE Address(): ADDRESS;
  873. BEGIN
  874. RETURN ADDRESSOF(value)
  875. END Address;
  876. END SetValue;
  877. RangeValue*=OBJECT(Value)
  878. VAR value*: RANGE;
  879. PROCEDURE & InitRange*(r: RANGE);
  880. BEGIN InitValue; value := r; type := "RangeValue"
  881. END InitRange;
  882. PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
  883. BEGIN Enumerate^(enum); enum(StrValue,FALSE);
  884. END Enumerate;
  885. PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  886. BEGIN
  887. IF name = StrValue THEN c.GetRange(value);
  888. ELSE Set^(name, index, c);
  889. END;
  890. END Set;
  891. PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  892. BEGIN
  893. IF name = StrValue THEN c.SetRange(value);
  894. ELSE Get^(name, index, c);
  895. END;
  896. END Get;
  897. PROCEDURE GetRange(VAR x: RANGE): BOOLEAN;
  898. BEGIN
  899. x := value; RETURN TRUE;
  900. END GetRange;
  901. PROCEDURE WriteValue(w: Streams.Writer);
  902. BEGIN
  903. 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;
  904. END WriteValue;
  905. PROCEDURE Address(): ADDRESS;
  906. BEGIN
  907. RETURN ADDRESSOF(value)
  908. END Address;
  909. END RangeValue;
  910. CharValue*=OBJECT(Value)
  911. VAR value: CHAR;
  912. PROCEDURE & InitChar*(c: CHAR);
  913. BEGIN InitValue; value := c; type := "CharValue";
  914. END InitChar;
  915. PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
  916. BEGIN Enumerate^(enum); enum(StrValue,FALSE);
  917. END Enumerate;
  918. PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  919. BEGIN
  920. IF name = StrValue THEN c.GetChar(value);
  921. ELSE Set^(name, index, c);
  922. END;
  923. END Set;
  924. PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  925. BEGIN
  926. IF name = StrValue THEN c.SetChar(value);
  927. ELSE Get^(name, index, c);
  928. END;
  929. END Get;
  930. PROCEDURE GetChar(VAR c: CHAR): BOOLEAN;
  931. BEGIN
  932. c := value; RETURN TRUE;
  933. END GetChar;
  934. PROCEDURE WriteValue(w: Streams.Writer);
  935. BEGIN
  936. w.Hex(ORD(value),2); w.String("X");
  937. END WriteValue;
  938. PROCEDURE Address(): ADDRESS;
  939. BEGIN
  940. RETURN ADDRESSOF(value)
  941. END Address;
  942. END CharValue;
  943. EnumValue*=OBJECT(Value)
  944. VAR value: LONGINT; translation: PersistentObjects.Translation;
  945. PROCEDURE & InitEnumValue*(trans: PersistentObjects.Translation; v: LONGINT);
  946. BEGIN InitValue; value := v; translation := trans; type := "EnumValue";
  947. END InitEnumValue;
  948. PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
  949. BEGIN Enumerate^(enum); enum(StrValue,FALSE);
  950. END Enumerate;
  951. PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  952. BEGIN
  953. IF name = StrValue THEN c.GetEnum(translation, value);
  954. ELSE Set^(name, index, c);
  955. END;
  956. END Set;
  957. PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  958. BEGIN
  959. IF name = StrValue THEN c.SetEnum(translation, value);
  960. ELSE Get^(name, index, c);
  961. END;
  962. END Get;
  963. PROCEDURE WriteValue(w: Streams.Writer);
  964. VAR str: ARRAY 32 OF CHAR;
  965. BEGIN
  966. IF translation.Name(value, str) THEN w.String(str) ELSE w.String("unknown") END;
  967. END WriteValue;
  968. PROCEDURE Address(): ADDRESS;
  969. BEGIN
  970. RETURN ADDRESSOF(value)
  971. END Address;
  972. END EnumValue;
  973. MathArrayValue*=OBJECT(Value)
  974. VAR values: ARRAY [*] OF Value;
  975. PROCEDURE &InitMathArrayValue*(len: LONGINT);
  976. BEGIN
  977. InitValue;
  978. NEW(values, len);
  979. type := "MathArrayValue";
  980. END InitMathArrayValue;
  981. PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
  982. BEGIN Enumerate^(enum); enum(StrValue,FALSE);
  983. END Enumerate;
  984. PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  985. BEGIN
  986. IF name = StrValue THEN values[index] := ContentGetValue(c)
  987. ELSE Set^(name, index, c);
  988. END;
  989. END Set;
  990. PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  991. BEGIN
  992. IF name = StrValue THEN c.SetObject(values[index],"Value");
  993. ELSE Get^(name, index, c);
  994. END;
  995. END Get;
  996. PROCEDURE SetValue*(at: LONGINT; value: Value);
  997. BEGIN
  998. values[at] := value;
  999. END SetValue;
  1000. PROCEDURE GetValue*(at: LONGINT): Value;
  1001. BEGIN
  1002. RETURN values[at]
  1003. END GetValue;
  1004. PROCEDURE WriteValue*(w: Streams.Writer);
  1005. VAR i: LONGINT; max: LONGINT;
  1006. BEGIN
  1007. w.String("[ ");
  1008. max := LEN(values,0)-1;
  1009. FOR i := 0 TO max DO
  1010. values[i].WriteValue(w);
  1011. IF i < max THEN
  1012. w.String(", ");
  1013. END;
  1014. END;
  1015. w.String("] ");
  1016. END WriteValue;
  1017. END MathArrayValue;
  1018. (* object value represented as ANY wrapped in Value ? *)
  1019. Symbol*= OBJECT
  1020. VAR
  1021. name: StringPool.Index;
  1022. item-: Item;
  1023. PROCEDURE & InitSymbol(name: StringPool.Index; index: LONGINT);
  1024. BEGIN
  1025. SELF.name := name; SELF.item := item;
  1026. END InitSymbol;
  1027. PROCEDURE GetName(VAR name: ARRAY OF CHAR);
  1028. BEGIN
  1029. StringPool.GetString(SELF.name, name);
  1030. END GetName;
  1031. END Symbol;
  1032. Container* = OBJECT (Item)
  1033. VAR
  1034. symbols-: Basic.List;
  1035. lookup-: Basic.HashTableInt;
  1036. (* New scope. Note that it is possible that a scope is registered with an alias *)
  1037. PROCEDURE & InitContainer*;
  1038. BEGIN
  1039. InitObject();
  1040. NEW(lookup, 16); NEW(symbols, 16);
  1041. type := "Container";
  1042. END InitContainer;
  1043. PROCEDURE Enumerate(enum: PersistentObjects.Enumerator);
  1044. VAR i: LONGINT; symbol: Symbol; o: ANY; name: ARRAY 256 OF CHAR;
  1045. BEGIN Enumerate^(enum);
  1046. FOR i := 0 TO symbols.Length()-1 DO
  1047. o := symbols.Get(i);
  1048. symbol := o(Symbol);
  1049. symbol.GetName(name);
  1050. enum(name, FALSE);
  1051. END;
  1052. END Enumerate;
  1053. PROCEDURE Set(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  1054. BEGIN
  1055. IF FALSE THEN
  1056. ELSE Set^(name, index, c);
  1057. END;
  1058. END Set;
  1059. PROCEDURE Get(CONST name: ARRAY OF CHAR; index: LONGINT; c: Content);
  1060. VAR item: Item;
  1061. BEGIN
  1062. item := Find(name);
  1063. IF item # NIL THEN c.SetObject(item,"Item")
  1064. ELSE Get^(name, index, c);
  1065. END;
  1066. END Get;
  1067. PROCEDURE GetItem*(index: LONGINT): Item;
  1068. BEGIN
  1069. RETURN symbols.Get(index)(Symbol).item
  1070. END GetItem;
  1071. (* Enter a symbol with its name *)
  1072. PROCEDURE Enter1*(item: Item; name: StringPool.Index);
  1073. VAR any: ANY; symbol: Symbol;
  1074. BEGIN
  1075. any := lookup.Get(name);
  1076. IF any # NIL THEN
  1077. symbol := any(Symbol)
  1078. ELSE
  1079. NEW(symbol, name, symbols.Length());
  1080. symbols.Add(symbol);
  1081. lookup.Put(symbol.name, symbol);
  1082. END;
  1083. symbol.item := item
  1084. END Enter1;
  1085. (* Enter a symbol with its name *)
  1086. PROCEDURE Enter*(item: Item; CONST name: ARRAY OF CHAR);
  1087. BEGIN
  1088. Enter1(item, StringPool.GetIndex1(name))
  1089. END Enter;
  1090. PROCEDURE Find1*(id: LONGINT): Item;
  1091. VAR any: ANY;
  1092. BEGIN
  1093. any := lookup.Get(id);
  1094. IF any # NIL THEN RETURN any(Symbol).item ELSE RETURN NIL END
  1095. END Find1;
  1096. (* Find a symbol with name *)
  1097. PROCEDURE Find*(CONST name: ARRAY OF CHAR): Item;
  1098. BEGIN
  1099. RETURN Find1(StringPool.GetIndex1(name))
  1100. END Find;
  1101. END Container;
  1102. Scope* = OBJECT
  1103. VAR
  1104. outer-: Scope;
  1105. object-: Object;
  1106. level: LONGINT;
  1107. PROCEDURE & InitScope*(outer: Scope; object: Object);
  1108. BEGIN
  1109. SELF.outer := outer;
  1110. IF outer = NIL THEN level := 0 ELSE level := outer.level + 1 END;
  1111. ASSERT(object # NIL);
  1112. SELF.object := object
  1113. END InitScope;
  1114. PROCEDURE Enter*(object: Object): Scope;
  1115. VAR scope: Scope;
  1116. BEGIN
  1117. NEW(scope, SELF, object);
  1118. RETURN scope
  1119. END Enter;
  1120. PROCEDURE FindObject*(CONST name: ARRAY OF CHAR; index: LONGINT; VAR in: Object): Object;
  1121. VAR object: Object;
  1122. BEGIN
  1123. in := SELF.object;
  1124. object := FindInObject(in, name, index);
  1125. IF (object = NIL) & (outer # NIL) THEN
  1126. object := outer.FindObject(name, index, in)
  1127. END;
  1128. RETURN object
  1129. END FindObject;
  1130. PROCEDURE FindObject1*(name: StringPool.Index; index: LONGINT; VAR in: Object): Object;
  1131. VAR str: ARRAY 256 OF CHAR;
  1132. BEGIN
  1133. StringPool.GetString(name, str);
  1134. RETURN FindObject(str,index, in);
  1135. END FindObject1;
  1136. PROCEDURE Leave*(): Scope;
  1137. BEGIN
  1138. RETURN outer
  1139. END Leave;
  1140. PROCEDURE Dump*(log: Streams.Writer);
  1141. BEGIN
  1142. IF object # NIL THEN object.Dump(log,"scope object") END;
  1143. log.Ln;
  1144. IF outer # NIL THEN outer.Dump(log) END;
  1145. END Dump;
  1146. END Scope;
  1147. PROCEDURE Indent(w: Streams.Writer; level: LONGINT);
  1148. BEGIN
  1149. WHILE level> 0 DO w.Char(TAB); DEC(level) END;
  1150. END Indent;
  1151. PROCEDURE Test*(context: Commands.Context);
  1152. VAR scope, inner: Scope; container: Container; integer: IntegerValue; float: RealValue; string: StringValue;
  1153. BEGIN
  1154. NEW(container);
  1155. container.Enter(integer, "integer");
  1156. container.Enter(float,"float");
  1157. container.Enter(string,"string");
  1158. NEW(scope, NIL, container);
  1159. NEW(container);
  1160. inner := scope.Enter(container);
  1161. scope.Dump(context.out);
  1162. (*scope.Write(context.out);*)
  1163. END Test;
  1164. PROCEDURE ContentGetValue(c: Content): Value;
  1165. VAR o: Object;
  1166. BEGIN
  1167. c.GetObject(o); IF o = NIL THEN RETURN NIL ELSE RETURN o(Value) END;
  1168. END ContentGetValue;
  1169. PROCEDURE NewIntegerValue(value: LONGINT): IntegerValue;
  1170. VAR obj: IntegerValue;
  1171. BEGIN
  1172. NEW(obj, value); RETURN obj
  1173. END NewIntegerValue;
  1174. PROCEDURE NewFloatValue(value: LONGREAL): RealValue;
  1175. VAR obj: RealValue;
  1176. BEGIN
  1177. NEW(obj, value); RETURN obj
  1178. END NewFloatValue;
  1179. PROCEDURE NewBooleanValue(value: BOOLEAN): BooleanValue;
  1180. VAR obj: BooleanValue;
  1181. BEGIN
  1182. NEW(obj, value); RETURN obj
  1183. END NewBooleanValue;
  1184. PROCEDURE NewStringValue(CONST value: ARRAY OF CHAR): StringValue;
  1185. VAR obj: StringValue;
  1186. BEGIN
  1187. NEW(obj, value); RETURN obj
  1188. END NewStringValue;
  1189. PROCEDURE NewNameValue(CONST value: ARRAY OF CHAR): StringValue;
  1190. VAR obj: StringValue;
  1191. BEGIN
  1192. NEW(obj, value); RETURN obj
  1193. END NewNameValue;
  1194. PROCEDURE NewRangeValue(value: RANGE): RangeValue;
  1195. VAR obj: RangeValue;
  1196. BEGIN
  1197. NEW(obj, value); RETURN obj
  1198. END NewRangeValue;
  1199. PROCEDURE NewCharValue(value: CHAR): CharValue;
  1200. VAR obj: CharValue;
  1201. BEGIN
  1202. NEW(obj, value); RETURN obj
  1203. END NewCharValue;
  1204. PROCEDURE NewSetValue(value: SET): SetValue;
  1205. VAR obj: SetValue;
  1206. BEGIN
  1207. NEW(obj, value); RETURN obj
  1208. END NewSetValue;
  1209. PROCEDURE NewEnumValue(translation: PersistentObjects.Translation; value: LONGINT): EnumValue;
  1210. VAR obj: EnumValue;
  1211. BEGIN
  1212. NEW(obj, translation, value);
  1213. END NewEnumValue;
  1214. PROCEDURE FindInObject*(in: Object; CONST name: ARRAY OF CHAR; index: LONGINT): Object;
  1215. VAR content: Content;
  1216. TYPE Class=PersistentObjects.Class;
  1217. BEGIN
  1218. NEW(content);
  1219. in.Get(name, index, content);
  1220. IF content.success THEN
  1221. CASE content.class OF
  1222. |Class.String: RETURN NewStringValue(content.string^);
  1223. |Class.Object: RETURN content.object
  1224. |Class.Name: RETURN NewNameValue(content.name);
  1225. |Class.Boolean: RETURN NewBooleanValue(content.boolean);
  1226. |Class.Integer: RETURN NewIntegerValue(content.integer);
  1227. |Class.Float: RETURN NewFloatValue(content.float);
  1228. |Class.Enum: RETURN NewEnumValue(content.translation,content.integer)
  1229. |Class.Range: RETURN NewRangeValue(content.range)
  1230. |Class.Set: RETURN NewSetValue(content.set)
  1231. |Class.Char: RETURN NewCharValue(content.char)
  1232. END
  1233. END;
  1234. RETURN NIL
  1235. END FindInObject;
  1236. TYPE
  1237. ObjectFilter* = OBJECT
  1238. VAR
  1239. content: Content;
  1240. object: Object;
  1241. found: Container;
  1242. attribute, value: ARRAY 256 OF CHAR;
  1243. PROCEDURE & InitObjectFilter*;
  1244. BEGIN
  1245. NEW(content); NEW(found);
  1246. END InitObjectFilter;
  1247. PROCEDURE AddFiltered(obj: Object);
  1248. BEGIN
  1249. IF obj # NIL THEN
  1250. obj.Get(attribute, -1, content);
  1251. IF content.success & content.Equals(value) THEN
  1252. found.Enter(obj,"any");
  1253. END;
  1254. END;
  1255. END AddFiltered;
  1256. PROCEDURE Enumerate(CONST name: ARRAY OF CHAR; array: BOOLEAN);
  1257. VAR obj: Object; index: LONGINT;
  1258. BEGIN
  1259. object.Get(name,-1, content);
  1260. IF content.success & (content.class = PersistentObjects.Class.Object) THEN
  1261. IF array THEN
  1262. index := 0;
  1263. REPEAT
  1264. object.Get(name, index, content);
  1265. obj := content.object;
  1266. AddFiltered(obj);
  1267. INC(index);
  1268. UNTIL obj = NIL;
  1269. ELSE
  1270. AddFiltered(content.object)
  1271. END;
  1272. END;
  1273. END Enumerate;
  1274. PROCEDURE Filter*(obj: Object; attribute, value: ARRAY OF CHAR): Container;
  1275. BEGIN
  1276. NEW(found);
  1277. object := obj;
  1278. COPY(attribute, SELF.attribute);
  1279. COPY(value, SELF.value);
  1280. obj.Enumerate(Enumerate);
  1281. RETURN found
  1282. END Filter;
  1283. END ObjectFilter;
  1284. PROCEDURE FindType(CONST types: POINTER TO ARRAY OF Modules.TypeDesc; CONST name: ARRAY OF CHAR): Modules.TypeDesc;
  1285. VAR i: LONGINT;
  1286. BEGIN
  1287. IF types = NIL THEN RETURN NIL END;
  1288. FOR i := 0 TO LEN(types)-1 DO
  1289. IF types[i].name = name THEN
  1290. RETURN types[i];
  1291. END;
  1292. END;
  1293. RETURN NIL;
  1294. END FindType;
  1295. PROCEDURE FindField(CONST types: POINTER TO ARRAY OF Modules.FieldEntry; CONST name: ARRAY OF CHAR; VAR num: LONGINT): BOOLEAN;
  1296. BEGIN
  1297. IF types = NIL THEN RETURN FALSE END;
  1298. FOR num := 0 TO LEN(types)-1 DO
  1299. IF types[num].name^ = name THEN
  1300. RETURN TRUE;
  1301. END;
  1302. END;
  1303. RETURN FALSE;
  1304. END FindField;
  1305. PROCEDURE FindProc(CONST types: POINTER TO ARRAY OF Modules.ProcedureEntry; CONST name: ARRAY OF CHAR; VAR num: LONGINT): BOOLEAN;
  1306. BEGIN
  1307. IF types = NIL THEN RETURN FALSE END;
  1308. FOR num := 0 TO LEN(types)-1 DO
  1309. IF types[num].name^ = name THEN
  1310. RETURN TRUE;
  1311. END;
  1312. END;
  1313. RETURN FALSE;
  1314. END FindProc;
  1315. PROCEDURE GetModule*(CONST name: ARRAY OF CHAR): ModuleResult;
  1316. VAR msg: ARRAY 128 OF CHAR; res: LONGINT; mod:ModuleResult; m: Modules.Module;
  1317. BEGIN
  1318. m := Modules.ThisModule(name, res, msg);
  1319. IF m # NIL THEN
  1320. NEW(mod, name, m);
  1321. ELSE
  1322. mod := NIL;
  1323. END;
  1324. RETURN mod;
  1325. END GetModule;
  1326. PROCEDURE FindInObject1*(in: Object; name: StringPool.Index; index: LONGINT): Object;
  1327. VAR str: ARRAY 256 OF CHAR;
  1328. BEGIN
  1329. StringPool.GetString(name, str);
  1330. RETURN FindInObject(in,str,index);
  1331. END FindInObject1;
  1332. END FoxInterpreterSymbols.
  1333. SystemTools.FreeDownTo FoxInterpreterSymbols ~
  1334. FoxInterpreterSymbols.Test ~