SimpleMP.mod 27 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187
  1. IMPLEMENTATION MODULE SimpleMP;
  2. (* Parser generated by Coco/R - assuming ISO IO library will be available. *)
  3. IMPORT SimpleMS, FileIO;
  4. IMPORT SymTab, CodeGen;
  5. CONST
  6. maxT = 66;
  7. minErrDist = 2; (* minimal distance (good tokens) between two errors *)
  8. setsize = 16; (* sets are stored in 16 bits *)
  9. TYPE
  10. SymbolSet = ARRAY [0 .. maxT DIV setsize] OF BITSET;
  11. VAR
  12. symSet: ARRAY [0 .. 4] OF SymbolSet; (*symSet[0] = allSyncSyms*)
  13. errDist: CARDINAL; (* number of symbols recognized since last error *)
  14. sym: CARDINAL; (* current input symbol *)
  15. PROCEDURE SemError (errNo: INTEGER);
  16. BEGIN
  17. IF errDist >= minErrDist THEN
  18. SimpleMS.Error(errNo, SimpleMS.line, SimpleMS.col, SimpleMS.pos);
  19. END;
  20. errDist := 0;
  21. END SemError;
  22. PROCEDURE SynError (errNo: INTEGER);
  23. BEGIN
  24. IF errDist >= minErrDist THEN
  25. SimpleMS.Error(errNo, SimpleMS.nextLine, SimpleMS.nextCol, SimpleMS.nextPos);
  26. END;
  27. errDist := 0;
  28. END SynError;
  29. PROCEDURE Get;
  30. VAR
  31. s: ARRAY [0 .. 31] OF CHAR;
  32. BEGIN
  33. REPEAT
  34. SimpleMS.Get(sym);
  35. IF sym <= maxT THEN
  36. INC(errDist);
  37. ELSE
  38. END;
  39. UNTIL sym <= maxT
  40. END Get;
  41. PROCEDURE In (VAR s: SymbolSet; x: CARDINAL): BOOLEAN;
  42. BEGIN
  43. RETURN x MOD setsize IN s[x DIV setsize];
  44. END In;
  45. PROCEDURE Expect (n: CARDINAL);
  46. BEGIN
  47. IF sym = n THEN Get ELSE SynError(n) END
  48. END Expect;
  49. PROCEDURE ExpectWeak (n, follow: CARDINAL);
  50. BEGIN
  51. IF sym = n
  52. THEN Get
  53. ELSE SynError(n); WHILE ~ In(symSet[follow], sym) DO Get END
  54. END
  55. END ExpectWeak;
  56. PROCEDURE WeakSeparator (n, syFol, repFol: CARDINAL): BOOLEAN;
  57. VAR
  58. s: SymbolSet;
  59. i: CARDINAL;
  60. BEGIN
  61. IF sym = n
  62. THEN Get; RETURN TRUE
  63. ELSIF In(symSet[repFol], sym) THEN RETURN FALSE
  64. ELSE
  65. i := 0;
  66. WHILE i <= maxT DIV setsize DO
  67. s[i] := symSet[0, i] + symSet[syFol, i] + symSet[repFol, i]; INC(i)
  68. END;
  69. SynError(n); WHILE ~ In(s, sym) DO Get END;
  70. RETURN In(symSet[syFol], sym)
  71. END
  72. END WeakSeparator;
  73. PROCEDURE LexName (VAR Lex: ARRAY OF CHAR);
  74. BEGIN
  75. SimpleMS.GetName(SimpleMS.pos, SimpleMS.len, Lex)
  76. END LexName;
  77. PROCEDURE LexString (VAR Lex: ARRAY OF CHAR);
  78. BEGIN
  79. SimpleMS.GetString(SimpleMS.pos, SimpleMS.len, Lex)
  80. END LexString;
  81. PROCEDURE LookAheadName (VAR Lex: ARRAY OF CHAR);
  82. BEGIN
  83. SimpleMS.GetName(SimpleMS.nextPos, SimpleMS.nextLen, Lex)
  84. END LookAheadName;
  85. PROCEDURE LookAheadString (VAR Lex: ARRAY OF CHAR);
  86. BEGIN
  87. SimpleMS.GetString(SimpleMS.nextPos, SimpleMS.nextLen, Lex)
  88. END LookAheadString;
  89. PROCEDURE Successful (): BOOLEAN;
  90. BEGIN
  91. RETURN SimpleMS.errors = 0
  92. END Successful;
  93. (* ----- FORWARD not needed in multipass compilers
  94. PROCEDURE Elem (VAR t: SymTab.TypeIndex); FORWARD;
  95. PROCEDURE SetLit (VAR t: SymTab.TypeIndex); FORWARD;
  96. PROCEDURE MulOp (VAR op: INTEGER); FORWARD;
  97. PROCEDURE Fact (VAR t: SymTab.TypeIndex); FORWARD;
  98. PROCEDURE AddOp (VAR op: INTEGER); FORWARD;
  99. PROCEDURE Term (VAR t: SymTab.TypeIndex); FORWARD;
  100. PROCEDURE Rel (VAR op: INTEGER); FORWARD;
  101. PROCEDURE SimExpr (VAR t: SymTab.TypeIndex); FORWARD;
  102. PROCEDURE Labels (sel: SymTab.TypeIndex); FORWARD;
  103. PROCEDURE LabelList (sel: SymTab.TypeIndex); FORWARD;
  104. PROCEDURE Case (sel: SymTab.TypeIndex); FORWARD;
  105. PROCEDURE Design (VAR t: SymTab.TypeIndex; VAR k: INTEGER); FORWARD;
  106. PROCEDURE WithStat; FORWARD;
  107. PROCEDURE ForStat; FORWARD;
  108. PROCEDURE LoopStat; FORWARD;
  109. PROCEDURE RepeatStat; FORWARD;
  110. PROCEDURE WhileStat; FORWARD;
  111. PROCEDURE CaseStat; FORWARD;
  112. PROCEDURE IfStat; FORWARD;
  113. PROCEDURE Assign; FORWARD;
  114. PROCEDURE Stat; FORWARD;
  115. PROCEDURE FieldIdents (rt: SymTab.TypeIndex); FORWARD;
  116. PROCEDURE Field (rt: SymTab.TypeIndex); FORWARD;
  117. PROCEDURE FieldSeq (rt: SymTab.TypeIndex); FORWARD;
  118. PROCEDURE Enum (VAR t: SymTab.TypeIndex); FORWARD;
  119. PROCEDURE PointerType (VAR t: SymTab.TypeIndex); FORWARD;
  120. PROCEDURE SetType (VAR t: SymTab.TypeIndex); FORWARD;
  121. PROCEDURE RecordType (VAR t: SymTab.TypeIndex); FORWARD;
  122. PROCEDURE ArrayType (VAR t: SymTab.TypeIndex); FORWARD;
  123. PROCEDURE SimpleType (VAR t: SymTab.TypeIndex); FORWARD;
  124. PROCEDURE QualIdent (VAR t: SymTab.TypeIndex); FORWARD;
  125. PROCEDURE VarIdents; FORWARD;
  126. PROCEDURE Type (VAR t: SymTab.TypeIndex); FORWARD;
  127. PROCEDURE Expr (VAR t: SymTab.TypeIndex); FORWARD;
  128. PROCEDURE ConstExpr (VAR t: SymTab.TypeIndex); FORWARD;
  129. PROCEDURE VarDecl; FORWARD;
  130. PROCEDURE TypeDecl; FORWARD;
  131. PROCEDURE ConstDecl; FORWARD;
  132. PROCEDURE StatSeq; FORWARD;
  133. PROCEDURE Declaration; FORWARD;
  134. PROCEDURE ImportList; FORWARD;
  135. PROCEDURE Block; FORWARD;
  136. PROCEDURE Import; FORWARD;
  137. PROCEDURE GetIdent (VAR n: SymTab.Name); FORWARD;
  138. PROCEDURE SimpleMod2; FORWARD;
  139. ----- *)
  140. PROCEDURE Elem (VAR t: SymTab.TypeIndex);
  141. VAR t2: SymTab.TypeIndex;
  142. BEGIN
  143. Expr(t);
  144. IF (sym = 19) THEN
  145. Get;
  146. CodeGen.Emit("..");
  147. Expr(t2);
  148. IF ~SymTab.SetElemCheck(t, t2) THEN
  149. SemError(222) END;;
  150. END;
  151. END Elem;
  152. PROCEDURE SetLit (VAR t: SymTab.TypeIndex);
  153. VAR first, et: SymTab.TypeIndex;
  154. BEGIN
  155. Expect(64);
  156. CodeGen.Emit("{");
  157. t := SymTab.SetFor(SymTab.IntType());;
  158. IF In(symSet[1], sym) THEN
  159. Elem(et);
  160. first := et; t := SymTab.SetFor(et);;
  161. WHILE (sym = 10) DO
  162. Get;
  163. CodeGen.Emit(", ");
  164. Elem(et);
  165. IF ~SymTab.SetElemCheck(first, et) THEN
  166. SemError(222) END;;
  167. END;
  168. END;
  169. Expect(65);
  170. CodeGen.Emit("}");
  171. END SetLit;
  172. PROCEDURE MulOp (VAR op: INTEGER);
  173. BEGIN
  174. CASE sym OF
  175. 56 :
  176. Get;
  177. CodeGen.Emit(" * "); op := SymTab.OpTimes;;
  178. | 57 :
  179. Get;
  180. CodeGen.Emit(" / "); op := SymTab.OpSlash;;
  181. | 58 :
  182. Get;
  183. CodeGen.Emit(" DIV "); op := SymTab.OpDiv;;
  184. | 59 :
  185. Get;
  186. CodeGen.Emit(" MOD "); op := SymTab.OpMod;;
  187. | 60 :
  188. Get;
  189. CodeGen.Emit(" AND "); op := SymTab.OpAnd;;
  190. | 61 :
  191. Get;
  192. CodeGen.Emit(" & "); op := SymTab.OpAnd;;
  193. ELSE SynError(67);
  194. END;
  195. END MulOp;
  196. PROCEDURE Fact (VAR t: SymTab.TypeIndex);
  197. VAR s: ARRAY [0 .. 255] OF CHAR;
  198. t2, et, dt, st: SymTab.TypeIndex;
  199. dk: INTEGER;
  200. BEGIN
  201. CASE sym OF
  202. 2 :
  203. Get;
  204. LexString(s); CodeGen.Emit(s);
  205. t := SymTab.IntType();;
  206. | 3 :
  207. Get;
  208. LexString(s); CodeGen.Emit(s);
  209. t := SymTab.RealType();;
  210. | 4 :
  211. Get;
  212. LexString(s); CodeGen.Emit(s);
  213. IF SymTab.StrLen(s) <= 3 THEN
  214. t := SymTab.CharType()
  215. ELSE t := SymTab.NewStr() END;;
  216. | 1 :
  217. Design(dt, dk);
  218. t := dt;;
  219. | 21 :
  220. Get;
  221. CodeGen.Emit("(");
  222. Expr(et);
  223. Expect(22);
  224. CodeGen.Emit(")"); t := et;;
  225. | 62, 63 :
  226. IF (sym = 62) THEN
  227. Get;
  228. CodeGen.Emit("NOT ");
  229. ELSE
  230. Get;
  231. CodeGen.Emit("~");
  232. END;
  233. Fact(t2);
  234. IF SymTab.BoolCheck(t2) THEN
  235. t := SymTab.BoolType()
  236. ELSE SemError(212);
  237. t := SymTab.InvalidType END;;
  238. | 64 :
  239. SetLit(st);
  240. t := st;;
  241. ELSE SynError(68);
  242. END;
  243. END Fact;
  244. PROCEDURE AddOp (VAR op: INTEGER);
  245. BEGIN
  246. IF (sym = 53) THEN
  247. Get;
  248. CodeGen.Emit(" + "); op := SymTab.OpAdd;;
  249. ELSIF (sym = 54) THEN
  250. Get;
  251. CodeGen.Emit(" - "); op := SymTab.OpSub;;
  252. ELSIF (sym = 55) THEN
  253. Get;
  254. CodeGen.Emit(" OR "); op := SymTab.OpOr;;
  255. ELSE SynError(69);
  256. END;
  257. END AddOp;
  258. PROCEDURE Term (VAR t: SymTab.TypeIndex);
  259. VAR t2, res2: SymTab.TypeIndex;
  260. op: INTEGER;
  261. BEGIN
  262. Fact(t);
  263. WHILE In(symSet[2], sym) DO
  264. MulOp(op);
  265. Fact(t2);
  266. IF op = SymTab.OpAnd THEN
  267. IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
  268. t := SymTab.BoolType()
  269. ELSE SemError(212); t := SymTab.InvalidType END
  270. ELSE
  271. IF SymTab.ArithCheck(t, t2,
  272. (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
  273. res2) THEN t := res2
  274. ELSE SemError(211); t := SymTab.InvalidType END
  275. END;;
  276. END;
  277. END Term;
  278. PROCEDURE Rel (VAR op: INTEGER);
  279. BEGIN
  280. CASE sym OF
  281. 16 :
  282. Get;
  283. CodeGen.Emit(" = "); op := SymTab.OpEq;;
  284. | 46 :
  285. Get;
  286. CodeGen.Emit(" # "); op := SymTab.OpNeq1;;
  287. | 47 :
  288. Get;
  289. CodeGen.Emit(" <> "); op := SymTab.OpNeq2;;
  290. | 48 :
  291. Get;
  292. CodeGen.Emit(" < "); op := SymTab.OpLt;;
  293. | 49 :
  294. Get;
  295. CodeGen.Emit(" <= "); op := SymTab.OpLe;;
  296. | 50 :
  297. Get;
  298. CodeGen.Emit(" > "); op := SymTab.OpGt;;
  299. | 51 :
  300. Get;
  301. CodeGen.Emit(" >= "); op := SymTab.OpGe;;
  302. | 52 :
  303. Get;
  304. CodeGen.Emit(" IN "); op := SymTab.OpIn;;
  305. ELSE SynError(70);
  306. END;
  307. END Rel;
  308. PROCEDURE SimExpr (VAR t: SymTab.TypeIndex);
  309. VAR t2, res2: SymTab.TypeIndex;
  310. op: INTEGER;
  311. BEGIN
  312. IF (sym = 53) OR (sym = 54) THEN
  313. IF (sym = 53) THEN
  314. Get;
  315. CodeGen.Emit("+");
  316. ELSE
  317. Get;
  318. CodeGen.Emit("-");
  319. END;
  320. END;
  321. Term(t);
  322. WHILE (sym = 53) OR (sym = 54) OR (sym = 55) DO
  323. AddOp(op);
  324. Term(t2);
  325. IF op = SymTab.OpOr THEN
  326. IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
  327. t := SymTab.BoolType()
  328. ELSE SemError(212); t := SymTab.InvalidType END
  329. ELSE
  330. IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN t := res2
  331. ELSE SemError(211); t := SymTab.InvalidType END
  332. END;;
  333. END;
  334. END SimExpr;
  335. PROCEDURE Labels (sel: SymTab.TypeIndex);
  336. VAR t, t2: SymTab.TypeIndex;
  337. BEGIN
  338. ConstExpr(t);
  339. IF ~SymTab.EqCheck(t, sel) THEN
  340. SemError(213) END;;
  341. IF (sym = 19) THEN
  342. Get;
  343. CodeGen.Emit("..");
  344. ConstExpr(t2);
  345. IF ~SymTab.EqCheck(t2, sel) THEN
  346. SemError(213) END;;
  347. END;
  348. END Labels;
  349. PROCEDURE LabelList (sel: SymTab.TypeIndex);
  350. BEGIN
  351. Labels(sel);
  352. WHILE (sym = 10) DO
  353. Get;
  354. CodeGen.Emit(", ");
  355. Labels(sel);
  356. END;
  357. END LabelList;
  358. PROCEDURE Case (sel: SymTab.TypeIndex);
  359. BEGIN
  360. IF In(symSet[1], sym) THEN
  361. LabelList(sel);
  362. Expect(17);
  363. CodeGen.Emit(" : ");
  364. StatSeq;
  365. END;
  366. END Case;
  367. PROCEDURE Design (VAR t: SymTab.TypeIndex; VAR k: INTEGER);
  368. VAR n, m: SymTab.Name;
  369. it: SymTab.TypeIndex;
  370. BEGIN
  371. GetIdent(n);
  372. IF ~SymTab.Lookup(n) THEN
  373. SemError(201);
  374. t := SymTab.InvalidType; k := -1
  375. ELSE t := SymTab.SymType(n);
  376. k := SymTab.SymKind(n) END;;
  377. WHILE (sym = 7) OR (sym = 18) OR (sym = 45) DO
  378. IF (sym = 7) THEN
  379. Get;
  380. CodeGen.Emit(".");
  381. GetIdent(m);
  382. IF t = SymTab.InvalidType THEN
  383. ELSIF SymTab.ClassOf(t) #
  384. SymTab.ClRecord THEN
  385. SemError(215);
  386. t := SymTab.InvalidType
  387. ELSIF ~SymTab.FieldExists(t, m) THEN
  388. SemError(216);
  389. t := SymTab.InvalidType
  390. ELSE t := SymTab.FieldType(t, m)
  391. END;;
  392. ELSIF (sym = 18) THEN
  393. Get;
  394. CodeGen.Emit("[");
  395. Expr(it);
  396. IF t = SymTab.InvalidType THEN
  397. ELSIF SymTab.ClassOf(t) #
  398. SymTab.ClArray THEN
  399. SemError(217);
  400. t := SymTab.InvalidType
  401. ELSIF (it #
  402. SymTab.InvalidType)
  403. & ~SymTab.IsIntFamily(it) THEN
  404. SemError(218);
  405. t := SymTab.InvalidType
  406. ELSE t :=
  407. SymTab.ArrayElem(t) END;;
  408. WHILE (sym = 10) DO
  409. Get;
  410. CodeGen.Emit(", ");
  411. Expr(it);
  412. IF (it # SymTab.InvalidType)
  413. & ~SymTab.IsIntFamily(it) THEN
  414. SemError(218) END;;
  415. END;
  416. Expect(20);
  417. CodeGen.Emit("]");
  418. ELSE
  419. Get;
  420. CodeGen.Emit("^");
  421. IF t = SymTab.InvalidType THEN
  422. ELSIF SymTab.ClassOf(t) #
  423. SymTab.ClPtr THEN
  424. SemError(219);
  425. t := SymTab.InvalidType
  426. ELSE t := SymTab.PtrBase(t)
  427. END;;
  428. END;
  429. END;
  430. END Design;
  431. PROCEDURE WithStat;
  432. VAR dt: SymTab.TypeIndex;
  433. dk: INTEGER;
  434. pushed: BOOLEAN;
  435. BEGIN
  436. Expect(44);
  437. CodeGen.Emit("WITH ");
  438. Design(dt, dk);
  439. pushed := FALSE;
  440. IF dt # SymTab.InvalidType THEN
  441. pushed :=
  442. SymTab.PushRecord(dt);
  443. IF ~pushed THEN
  444. SemError(215)
  445. END
  446. END;;
  447. Expect(38);
  448. CodeGen.Emit(" DO");
  449. CodeGen.Brk; CodeGen.Ind;;
  450. StatSeq;
  451. Expect(12);
  452. IF pushed THEN
  453. SymTab.PopScope
  454. END;
  455. CodeGen.Ded; CodeGen.Brk;
  456. CodeGen.Emit("END");
  457. END WithStat;
  458. PROCEDURE ForStat;
  459. VAR n: SymTab.Name;
  460. lo, hi, by: SymTab.TypeIndex;
  461. BEGIN
  462. Expect(42);
  463. CodeGen.Emit("FOR ");
  464. GetIdent(n);
  465. IF ~SymTab.Lookup(n) THEN
  466. SemError(201)
  467. ELSIF (SymTab.SymKind(n) #
  468. SymTab.KindVar)
  469. & (SymTab.SymKind(n) #
  470. SymTab.KindField) THEN
  471. SemError(220)
  472. ELSIF (SymTab.SymType(n) #
  473. SymTab.InvalidType)
  474. & ~SymTab.IsIntFamily(
  475. SymTab.SymType(n)) THEN
  476. SemError(220) END;;
  477. Expect(30);
  478. CodeGen.Emit(" := ");
  479. Expr(lo);
  480. IF (lo # SymTab.InvalidType)
  481. & ~SymTab.IsIntFamily(lo) THEN
  482. SemError(220) END;;
  483. Expect(28);
  484. CodeGen.Emit(" TO ");
  485. Expr(hi);
  486. IF (hi # SymTab.InvalidType)
  487. & ~SymTab.IsIntFamily(hi) THEN
  488. SemError(220) END;;
  489. IF (sym = 43) THEN
  490. Get;
  491. CodeGen.Emit(" BY ");
  492. ConstExpr(by);
  493. IF (by # SymTab.InvalidType)
  494. & ~SymTab.IsIntFamily(by) THEN
  495. SemError(220) END;;
  496. END;
  497. Expect(38);
  498. CodeGen.Emit(" DO");
  499. CodeGen.Brk; CodeGen.Ind;;
  500. StatSeq;
  501. Expect(12);
  502. CodeGen.Ded; CodeGen.Brk;
  503. CodeGen.Emit("END");
  504. END ForStat;
  505. PROCEDURE LoopStat;
  506. BEGIN
  507. Expect(41);
  508. CodeGen.Emit("LOOP");
  509. CodeGen.Brk; CodeGen.Ind;;
  510. StatSeq;
  511. Expect(12);
  512. CodeGen.Ded; CodeGen.Brk;
  513. CodeGen.Emit("END");
  514. END LoopStat;
  515. PROCEDURE RepeatStat;
  516. VAR t: SymTab.TypeIndex;
  517. BEGIN
  518. Expect(39);
  519. CodeGen.Emit("REPEAT");
  520. CodeGen.Brk; CodeGen.Ind;;
  521. StatSeq;
  522. Expect(40);
  523. CodeGen.Ded; CodeGen.Brk;
  524. CodeGen.Emit("UNTIL ");
  525. Expr(t);
  526. IF ~SymTab.BoolCheck(t) THEN
  527. SemError(214) END;;
  528. END RepeatStat;
  529. PROCEDURE WhileStat;
  530. VAR t: SymTab.TypeIndex;
  531. BEGIN
  532. Expect(37);
  533. CodeGen.Emit("WHILE ");
  534. Expr(t);
  535. IF ~SymTab.BoolCheck(t) THEN
  536. SemError(214) END;;
  537. Expect(38);
  538. CodeGen.Emit(" DO");
  539. CodeGen.Brk; CodeGen.Ind;;
  540. StatSeq;
  541. Expect(12);
  542. CodeGen.Ded; CodeGen.Brk;
  543. CodeGen.Emit("END");
  544. END WhileStat;
  545. PROCEDURE CaseStat;
  546. VAR st: SymTab.TypeIndex;
  547. BEGIN
  548. Expect(35);
  549. CodeGen.Emit("CASE ");
  550. Expr(st);
  551. Expect(24);
  552. CodeGen.Emit(" OF");
  553. CodeGen.Brk; CodeGen.Ind;;
  554. Case(st);
  555. WHILE (sym = 36) DO
  556. Get;
  557. CodeGen.Brk; CodeGen.Emit("| ");
  558. Case(st);
  559. END;
  560. IF (sym = 34) THEN
  561. Get;
  562. CodeGen.Ded; CodeGen.Brk;
  563. CodeGen.Emit("ELSE ");
  564. CodeGen.Ind; CodeGen.Brk;;
  565. StatSeq;
  566. END;
  567. Expect(12);
  568. CodeGen.Ded; CodeGen.Brk;
  569. CodeGen.Emit("END");
  570. END CaseStat;
  571. PROCEDURE IfStat;
  572. VAR t: SymTab.TypeIndex;
  573. BEGIN
  574. Expect(31);
  575. CodeGen.Emit("IF ");
  576. Expr(t);
  577. IF ~SymTab.BoolCheck(t) THEN
  578. SemError(214) END;;
  579. Expect(32);
  580. CodeGen.Emit(" THEN");
  581. CodeGen.Brk; CodeGen.Ind;;
  582. StatSeq;
  583. WHILE (sym = 33) DO
  584. Get;
  585. CodeGen.Ded; CodeGen.Brk;
  586. CodeGen.Emit("ELSIF ");
  587. Expr(t);
  588. IF ~SymTab.BoolCheck(t) THEN
  589. SemError(214) END;;
  590. Expect(32);
  591. CodeGen.Emit(" THEN");
  592. CodeGen.Brk; CodeGen.Ind;;
  593. StatSeq;
  594. END;
  595. IF (sym = 34) THEN
  596. Get;
  597. CodeGen.Ded; CodeGen.Brk;
  598. CodeGen.Emit("ELSE");
  599. CodeGen.Ind; CodeGen.Brk;;
  600. StatSeq;
  601. END;
  602. Expect(12);
  603. CodeGen.Ded; CodeGen.Brk;
  604. CodeGen.Emit("END");
  605. END IfStat;
  606. PROCEDURE Assign;
  607. VAR dt, et: SymTab.TypeIndex;
  608. dk: INTEGER;
  609. BEGIN
  610. Design(dt, dk);
  611. Expect(30);
  612. CodeGen.Emit(" := ");
  613. Expr(et);
  614. IF (dt # SymTab.InvalidType)
  615. & (dk # SymTab.KindVar)
  616. & (dk # SymTab.KindField)
  617. & (dk # SymTab.KindImport) THEN
  618. SemError(210)
  619. ELSIF ~SymTab.Assignable(et, dt) THEN
  620. SemError(210) END;;
  621. END Assign;
  622. PROCEDURE Stat;
  623. BEGIN
  624. IF In(symSet[3], sym) THEN
  625. CASE sym OF
  626. 1 :
  627. Assign;
  628. | 31 :
  629. IfStat;
  630. | 35 :
  631. CaseStat;
  632. | 37 :
  633. WhileStat;
  634. | 39 :
  635. RepeatStat;
  636. | 41 :
  637. LoopStat;
  638. | 42 :
  639. ForStat;
  640. | 44 :
  641. WithStat;
  642. | 29 :
  643. Get;
  644. CodeGen.Emit("EXIT");
  645. END;
  646. END;
  647. END Stat;
  648. PROCEDURE FieldIdents (rt: SymTab.TypeIndex);
  649. VAR n: SymTab.Name;
  650. BEGIN
  651. GetIdent(n);
  652. IF ~SymTab.FieldPending(rt, n)
  653. THEN SemError(200) END;
  654. WHILE (sym = 10) DO
  655. Get;
  656. CodeGen.Emit(", ");
  657. GetIdent(n);
  658. IF ~SymTab.FieldPending(rt, n)
  659. THEN SemError(200) END;
  660. END;
  661. END FieldIdents;
  662. PROCEDURE Field (rt: SymTab.TypeIndex);
  663. VAR et: SymTab.TypeIndex;
  664. BEGIN
  665. IF (sym = 1) THEN
  666. FieldIdents(rt);
  667. Expect(17);
  668. CodeGen.Emit(" : ");
  669. Type(et);
  670. SymTab.FixPendingF(rt, et);;
  671. END;
  672. END Field;
  673. PROCEDURE FieldSeq (rt: SymTab.TypeIndex);
  674. BEGIN
  675. Field(rt);
  676. WHILE (sym = 6) DO
  677. Get;
  678. CodeGen.Emit(";"); CodeGen.Brk;;
  679. Field(rt);
  680. END;
  681. END FieldSeq;
  682. PROCEDURE Enum (VAR t: SymTab.TypeIndex);
  683. VAR n: SymTab.Name;
  684. BEGIN
  685. Expect(21);
  686. CodeGen.Emit("(");
  687. t := SymTab.NewEnum();;
  688. GetIdent(n);
  689. IF ~SymTab.Enter(n,
  690. SymTab.KindConst)
  691. THEN SemError(200) END;
  692. SymTab.SetSymType(n, t);;
  693. WHILE (sym = 10) DO
  694. Get;
  695. CodeGen.Emit(", ");
  696. GetIdent(n);
  697. IF ~SymTab.Enter(n,
  698. SymTab.KindConst)
  699. THEN SemError(200) END;
  700. SymTab.SetSymType(n, t);;
  701. END;
  702. Expect(22);
  703. CodeGen.Emit(")");
  704. END Enum;
  705. PROCEDURE PointerType (VAR t: SymTab.TypeIndex);
  706. VAR b: SymTab.TypeIndex;
  707. BEGIN
  708. Expect(27);
  709. CodeGen.Emit("POINTER ");
  710. Expect(28);
  711. CodeGen.Emit("TO ");
  712. Type(b);
  713. t := SymTab.NewPtr(b);;
  714. END PointerType;
  715. PROCEDURE SetType (VAR t: SymTab.TypeIndex);
  716. VAR s: SymTab.TypeIndex;
  717. BEGIN
  718. Expect(26);
  719. CodeGen.Emit("SET ");
  720. Expect(24);
  721. CodeGen.Emit("OF ");
  722. SimpleType(s);
  723. IF (s # SymTab.InvalidType)
  724. & (SymTab.ClassOf(s) #
  725. SymTab.ClInt)
  726. & (SymTab.ClassOf(s) #
  727. SymTab.ClChar)
  728. & (SymTab.ClassOf(s) #
  729. SymTab.ClEnum) THEN
  730. SemError(224) END;
  731. t := SymTab.NewSet(s);;
  732. END SetType;
  733. PROCEDURE RecordType (VAR t: SymTab.TypeIndex);
  734. BEGIN
  735. Expect(25);
  736. CodeGen.Emit("RECORD");
  737. CodeGen.Ind; CodeGen.Brk;
  738. t := SymTab.NewRecord();;
  739. FieldSeq(t);
  740. Expect(12);
  741. CodeGen.Ded; CodeGen.Brk;
  742. CodeGen.Emit("END");
  743. END RecordType;
  744. PROCEDURE ArrayType (VAR t: SymTab.TypeIndex);
  745. VAR s, s2, e: SymTab.TypeIndex;
  746. BEGIN
  747. Expect(23);
  748. CodeGen.Emit("ARRAY ");
  749. SimpleType(s);
  750. IF (s # SymTab.InvalidType)
  751. & (SymTab.ClassOf(s) #
  752. SymTab.ClInt)
  753. & (SymTab.ClassOf(s) #
  754. SymTab.ClChar)
  755. & (SymTab.ClassOf(s) #
  756. SymTab.ClEnum) THEN
  757. SemError(224) END;;
  758. WHILE (sym = 10) DO
  759. Get;
  760. CodeGen.Emit(", ");
  761. SimpleType(s2);
  762. IF (s2 # SymTab.InvalidType)
  763. & (SymTab.ClassOf(s2) #
  764. SymTab.ClInt)
  765. & (SymTab.ClassOf(s2) #
  766. SymTab.ClChar)
  767. & (SymTab.ClassOf(s2) #
  768. SymTab.ClEnum) THEN
  769. SemError(224) END;;
  770. END;
  771. Expect(24);
  772. CodeGen.Emit(" OF ");
  773. Type(e);
  774. t := SymTab.NewArray(e);;
  775. END ArrayType;
  776. PROCEDURE SimpleType (VAR t: SymTab.TypeIndex);
  777. VAR t1, t2: SymTab.TypeIndex;
  778. BEGIN
  779. IF (sym = 1) THEN
  780. QualIdent(t);
  781. IF (sym = 18) THEN
  782. Get;
  783. CodeGen.Emit("[");
  784. ConstExpr(t1);
  785. IF (t1 # SymTab.InvalidType)
  786. & (SymTab.ClassOf(t1) #
  787. SymTab.ClInt)
  788. & (SymTab.ClassOf(t1) #
  789. SymTab.ClChar)
  790. & (SymTab.ClassOf(t1) #
  791. SymTab.ClEnum) THEN
  792. SemError(224) END;;
  793. Expect(19);
  794. CodeGen.Emit("..");
  795. ConstExpr(t2);
  796. IF (t2 # SymTab.InvalidType)
  797. & (SymTab.ClassOf(t2) #
  798. SymTab.ClInt)
  799. & (SymTab.ClassOf(t2) #
  800. SymTab.ClChar)
  801. & (SymTab.ClassOf(t2) #
  802. SymTab.ClEnum) THEN
  803. SemError(224) END;;
  804. Expect(20);
  805. CodeGen.Emit("]");
  806. t := SymTab.NewSub(t1);;
  807. END;
  808. ELSIF (sym = 18) THEN
  809. Get;
  810. CodeGen.Emit("[");
  811. ConstExpr(t1);
  812. IF (t1 # SymTab.InvalidType)
  813. & (SymTab.ClassOf(t1) #
  814. SymTab.ClInt)
  815. & (SymTab.ClassOf(t1) #
  816. SymTab.ClChar)
  817. & (SymTab.ClassOf(t1) #
  818. SymTab.ClEnum) THEN
  819. SemError(224) END;;
  820. Expect(19);
  821. CodeGen.Emit("..");
  822. ConstExpr(t2);
  823. IF (t2 # SymTab.InvalidType)
  824. & (SymTab.ClassOf(t2) #
  825. SymTab.ClInt)
  826. & (SymTab.ClassOf(t2) #
  827. SymTab.ClChar)
  828. & (SymTab.ClassOf(t2) #
  829. SymTab.ClEnum) THEN
  830. SemError(224) END;;
  831. Expect(20);
  832. CodeGen.Emit("]");
  833. t := SymTab.NewSub(t1);;
  834. ELSIF (sym = 21) THEN
  835. Enum(t);
  836. ELSE SynError(71);
  837. END;
  838. END SimpleType;
  839. PROCEDURE QualIdent (VAR t: SymTab.TypeIndex);
  840. VAR n, m: SymTab.Name;
  841. BEGIN
  842. GetIdent(n);
  843. IF ~SymTab.Lookup(n) THEN
  844. SemError(201);
  845. t := SymTab.InvalidType
  846. ELSIF (SymTab.SymKind(n) #
  847. SymTab.KindType)
  848. & (SymTab.SymKind(n) #
  849. SymTab.KindPredef)
  850. & (SymTab.SymKind(n) #
  851. SymTab.KindImport) THEN
  852. SemError(221);
  853. t := SymTab.InvalidType
  854. ELSE t := SymTab.SymType(n) END;;
  855. WHILE (sym = 7) DO
  856. Get;
  857. CodeGen.Emit(".");
  858. t := SymTab.InvalidType;;
  859. GetIdent(m);
  860. END;
  861. END QualIdent;
  862. PROCEDURE VarIdents;
  863. VAR n: SymTab.Name;
  864. BEGIN
  865. GetIdent(n);
  866. IF ~SymTab.EnterPending(n,
  867. SymTab.KindVar)
  868. THEN SemError(200) END;
  869. WHILE (sym = 10) DO
  870. Get;
  871. CodeGen.Emit(", ");
  872. GetIdent(n);
  873. IF ~SymTab.EnterPending(n,
  874. SymTab.KindVar)
  875. THEN SemError(200) END;
  876. END;
  877. END VarIdents;
  878. PROCEDURE Type (VAR t: SymTab.TypeIndex);
  879. BEGIN
  880. IF (sym = 1) OR (sym = 18) OR (sym = 21) THEN
  881. SimpleType(t);
  882. ELSIF (sym = 23) THEN
  883. ArrayType(t);
  884. ELSIF (sym = 25) THEN
  885. RecordType(t);
  886. ELSIF (sym = 26) THEN
  887. SetType(t);
  888. ELSIF (sym = 27) THEN
  889. PointerType(t);
  890. ELSE SynError(72);
  891. END;
  892. END Type;
  893. PROCEDURE Expr (VAR t: SymTab.TypeIndex);
  894. VAR t2: SymTab.TypeIndex;
  895. op: INTEGER;
  896. BEGIN
  897. SimExpr(t);
  898. IF In(symSet[4], sym) THEN
  899. Rel(op);
  900. SimExpr(t2);
  901. IF op = SymTab.OpIn THEN
  902. IF SymTab.InCheck(t, t2) THEN t := SymTab.BoolType()
  903. ELSE SemError(222); t := SymTab.InvalidType END
  904. ELSE
  905. IF SymTab.RelCheck(t, t2, op) THEN
  906. t := SymTab.BoolType()
  907. ELSE SemError(213); t := SymTab.InvalidType END
  908. END;;
  909. END;
  910. END Expr;
  911. PROCEDURE ConstExpr (VAR t: SymTab.TypeIndex);
  912. BEGIN
  913. Expr(t);
  914. END ConstExpr;
  915. PROCEDURE VarDecl;
  916. VAR t: SymTab.TypeIndex;
  917. BEGIN
  918. VarIdents;
  919. Expect(17);
  920. CodeGen.Emit(" : ");
  921. Type(t);
  922. SymTab.FixPending(t);;
  923. END VarDecl;
  924. PROCEDURE TypeDecl;
  925. VAR n: SymTab.Name;
  926. t0, t1: SymTab.TypeIndex;
  927. BEGIN
  928. GetIdent(n);
  929. IF ~SymTab.Enter(n, SymTab.KindType)
  930. THEN SemError(200) END;
  931. t0 := SymTab.NewAlias();
  932. SymTab.SetSymType(n, t0);;
  933. Expect(16);
  934. CodeGen.Emit(" = ");
  935. Type(t1);
  936. IF t1 = t0 THEN SemError(223);
  937. SymTab.SetTarget(t0,
  938. SymTab.InvalidType)
  939. ELSE SymTab.SetTarget(t0, t1) END;;
  940. END TypeDecl;
  941. PROCEDURE ConstDecl;
  942. VAR n: SymTab.Name;
  943. t: SymTab.TypeIndex;
  944. BEGIN
  945. GetIdent(n);
  946. IF ~SymTab.Enter(n, SymTab.KindConst)
  947. THEN SemError(200) END;
  948. Expect(16);
  949. CodeGen.Emit(" = ");
  950. ConstExpr(t);
  951. SymTab.SetSymType(n, t);;
  952. END ConstDecl;
  953. PROCEDURE StatSeq;
  954. BEGIN
  955. Stat;
  956. WHILE (sym = 6) DO
  957. Get;
  958. CodeGen.Emit(";");
  959. CodeGen.Brk;;
  960. Stat;
  961. END;
  962. END StatSeq;
  963. PROCEDURE Declaration;
  964. BEGIN
  965. IF (sym = 13) THEN
  966. Get;
  967. CodeGen.Emit("CONST"); CodeGen.Ind;;
  968. WHILE (sym = 1) DO
  969. CodeGen.Brk;;
  970. ConstDecl;
  971. Expect(6);
  972. CodeGen.Emit(";");
  973. END;
  974. CodeGen.Ded; CodeGen.Brk;;
  975. ELSIF (sym = 14) THEN
  976. Get;
  977. CodeGen.Emit("TYPE"); CodeGen.Ind;;
  978. WHILE (sym = 1) DO
  979. CodeGen.Brk;;
  980. TypeDecl;
  981. Expect(6);
  982. CodeGen.Emit(";");
  983. END;
  984. CodeGen.Ded; CodeGen.Brk;;
  985. ELSIF (sym = 15) THEN
  986. Get;
  987. CodeGen.Emit("VAR"); CodeGen.Ind;;
  988. WHILE (sym = 1) DO
  989. CodeGen.Brk;;
  990. VarDecl;
  991. Expect(6);
  992. CodeGen.Emit(";");
  993. END;
  994. CodeGen.Ded; CodeGen.Brk;;
  995. ELSE SynError(73);
  996. END;
  997. END Declaration;
  998. PROCEDURE ImportList;
  999. VAR n: SymTab.Name;
  1000. BEGIN
  1001. GetIdent(n);
  1002. IF ~SymTab.Enter(n, SymTab.KindImport)
  1003. THEN SemError(200) END;
  1004. WHILE (sym = 10) DO
  1005. Get;
  1006. CodeGen.Emit(", ");
  1007. GetIdent(n);
  1008. IF ~SymTab.Enter(n, SymTab.KindImport)
  1009. THEN SemError(200) END;
  1010. END;
  1011. END ImportList;
  1012. PROCEDURE Block;
  1013. BEGIN
  1014. WHILE (sym = 13) OR (sym = 14) OR (sym = 15) DO
  1015. Declaration;
  1016. END;
  1017. IF (sym = 11) THEN
  1018. Get;
  1019. CodeGen.Emit("BEGIN");
  1020. CodeGen.Ind; CodeGen.Brk;;
  1021. StatSeq;
  1022. END;
  1023. Expect(12);
  1024. CodeGen.Ded; CodeGen.Brk;
  1025. CodeGen.Emit("END ");
  1026. END Block;
  1027. PROCEDURE Import;
  1028. VAR n: SymTab.Name;
  1029. BEGIN
  1030. IF (sym = 8) THEN
  1031. Get;
  1032. CodeGen.Emit("FROM ");
  1033. GetIdent(n);
  1034. IF ~SymTab.Enter(n, SymTab.KindImport)
  1035. THEN SemError(200) END;
  1036. Expect(9);
  1037. CodeGen.Emit(" IMPORT ");
  1038. ImportList;
  1039. Expect(6);
  1040. CodeGen.Emit(";"); CodeGen.Brk;;
  1041. ELSIF (sym = 9) THEN
  1042. Get;
  1043. CodeGen.Emit("IMPORT ");
  1044. ImportList;
  1045. Expect(6);
  1046. CodeGen.Emit(";"); CodeGen.Brk;;
  1047. ELSE SynError(74);
  1048. END;
  1049. END Import;
  1050. PROCEDURE GetIdent (VAR n: SymTab.Name);
  1051. BEGIN
  1052. Expect(1);
  1053. LexName(n); CodeGen.Emit(n);;
  1054. END GetIdent;
  1055. PROCEDURE SimpleMod2;
  1056. VAR m1, m2: SymTab.Name;
  1057. BEGIN
  1058. Expect(5);
  1059. CodeGen.Emit("MODULE ");
  1060. GetIdent(m1);
  1061. SymTab.Init; CodeGen.OpenModule(m1);
  1062. CodeGen.Emit("MODULE ");
  1063. CodeGen.Emit(m1);
  1064. IF ~SymTab.Enter(m1, SymTab.KindModule)
  1065. THEN SemError(200) END;
  1066. Expect(6);
  1067. CodeGen.Emit(";"); CodeGen.Brk;;
  1068. WHILE (sym = 8) OR (sym = 9) DO
  1069. Import;
  1070. END;
  1071. Block;
  1072. GetIdent(m2);
  1073. IF ~SymTab.Equal(m1, m2)
  1074. THEN SemError(202) END;
  1075. Expect(7);
  1076. CodeGen.Emit(".");
  1077. CodeGen.Close;
  1078. SymTab.PrintTable;;
  1079. END SimpleMod2;
  1080. PROCEDURE Parse;
  1081. BEGIN
  1082. SimpleMS.Reset; Get;
  1083. SimpleMod2;
  1084. END Parse;
  1085. BEGIN
  1086. errDist := minErrDist;
  1087. symSet[ 0, 0] := BITSET{0};
  1088. symSet[ 0, 1] := BITSET{};
  1089. symSet[ 0, 2] := BITSET{};
  1090. symSet[ 0, 3] := BITSET{};
  1091. symSet[ 0, 4] := BITSET{};
  1092. symSet[ 1, 0] := BITSET{1, 2, 3, 4};
  1093. symSet[ 1, 1] := BITSET{5};
  1094. symSet[ 1, 2] := BITSET{};
  1095. symSet[ 1, 3] := BITSET{5, 6, 14, 15};
  1096. symSet[ 1, 4] := BITSET{0};
  1097. symSet[ 2, 0] := BITSET{};
  1098. symSet[ 2, 1] := BITSET{};
  1099. symSet[ 2, 2] := BITSET{};
  1100. symSet[ 2, 3] := BITSET{8, 9, 10, 11, 12, 13};
  1101. symSet[ 2, 4] := BITSET{};
  1102. symSet[ 3, 0] := BITSET{1};
  1103. symSet[ 3, 1] := BITSET{13, 15};
  1104. symSet[ 3, 2] := BITSET{3, 5, 7, 9, 10, 12};
  1105. symSet[ 3, 3] := BITSET{};
  1106. symSet[ 3, 4] := BITSET{};
  1107. symSet[ 4, 0] := BITSET{};
  1108. symSet[ 4, 1] := BITSET{0};
  1109. symSet[ 4, 2] := BITSET{14, 15};
  1110. symSet[ 4, 3] := BITSET{0, 1, 2, 3, 4};
  1111. symSet[ 4, 4] := BITSET{};
  1112. END SimpleMP.