M2cP.mod 62 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575
  1. IMPLEMENTATION MODULE M2cP;
  2. (* Parser generated by Coco/R - assuming ISO IO library will be available. *)
  3. IMPORT M2cS, FileIO;
  4. IMPORT SymTab, MGen;
  5. CONST
  6. maxT = 74;
  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 .. 6] 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. M2cS.Error(errNo, M2cS.line, M2cS.col, M2cS.pos);
  19. END;
  20. errDist := 0;
  21. END SemError;
  22. PROCEDURE SynError (errNo: INTEGER);
  23. BEGIN
  24. IF errDist >= minErrDist THEN
  25. M2cS.Error(errNo, M2cS.nextLine, M2cS.nextCol, M2cS.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. M2cS.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. M2cS.GetName(M2cS.pos, M2cS.len, Lex)
  76. END LexName;
  77. PROCEDURE LexString (VAR Lex: ARRAY OF CHAR);
  78. BEGIN
  79. M2cS.GetString(M2cS.pos, M2cS.len, Lex)
  80. END LexString;
  81. PROCEDURE LookAheadName (VAR Lex: ARRAY OF CHAR);
  82. BEGIN
  83. M2cS.GetName(M2cS.nextPos, M2cS.nextLen, Lex)
  84. END LookAheadName;
  85. PROCEDURE LookAheadString (VAR Lex: ARRAY OF CHAR);
  86. BEGIN
  87. M2cS.GetString(M2cS.nextPos, M2cS.nextLen, Lex)
  88. END LookAheadString;
  89. PROCEDURE Successful (): BOOLEAN;
  90. BEGIN
  91. RETURN M2cS.errors = 0
  92. END Successful;
  93. (* ----- FORWARD not needed in multipass compilers
  94. PROCEDURE Elem (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
  95. VAR lx2: MGen.LitStr; VAR hasR: BOOLEAN); FORWARD;
  96. PROCEDURE SetLit (VAR t: SymTab.TypeIndex); FORWARD;
  97. PROCEDURE MulOp (VAR op: INTEGER); FORWARD;
  98. PROCEDURE Fact (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
  99. VAR v: BOOLEAN; VAR vn: SymTab.Name); FORWARD;
  100. PROCEDURE AddOp (VAR op: INTEGER); FORWARD;
  101. PROCEDURE Term (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
  102. VAR v: BOOLEAN; VAR vn: SymTab.Name); FORWARD;
  103. PROCEDURE Rel (VAR op: INTEGER); FORWARD;
  104. PROCEDURE SimExpr (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
  105. VAR v: BOOLEAN; VAR vn: SymTab.Name); FORWARD;
  106. PROCEDURE ByLit (VAR v: INTEGER); FORWARD;
  107. PROCEDURE Labels (sel: SymTab.TypeIndex; tmp: INTEGER; bodyL: INTEGER); FORWARD;
  108. PROCEDURE LabelList (sel: SymTab.TypeIndex; tmp: INTEGER;
  109. VAR lB: INTEGER; VAR lN: INTEGER); FORWARD;
  110. PROCEDURE Case (sel: SymTab.TypeIndex; tmp: INTEGER; endL: INTEGER); FORWARD;
  111. PROCEDURE CallTail (pn: SymTab.Name; sfx: BOOLEAN; inExpr: BOOLEAN;
  112. VAR ok: BOOLEAN; hasDead: BOOLEAN); FORWARD;
  113. PROCEDURE DesignTail (VAR t: SymTab.TypeIndex; VAR k: INTEGER;
  114. VAR bn: SymTab.Name; doLoad: BOOLEAN; VAR lx: MGen.LitStr;
  115. VAR sfx: BOOLEAN); FORWARD;
  116. PROCEDURE DesignHead (VAR t: SymTab.TypeIndex; VAR k: INTEGER;
  117. VAR bn: SymTab.Name; doLoad: BOOLEAN; VAR lx: MGen.LitStr); FORWARD;
  118. PROCEDURE WriteStrStat; FORWARD;
  119. PROCEDURE WriteIntStat; FORWARD;
  120. PROCEDURE DispStat; FORWARD;
  121. PROCEDURE NewStat; FORWARD;
  122. PROCEDURE ReturnStat; FORWARD;
  123. PROCEDURE WithStat; FORWARD;
  124. PROCEDURE ForStat; FORWARD;
  125. PROCEDURE LoopStat; FORWARD;
  126. PROCEDURE RepeatStat; FORWARD;
  127. PROCEDURE WhileStat; FORWARD;
  128. PROCEDURE CaseStat; FORWARD;
  129. PROCEDURE IfStat; FORWARD;
  130. PROCEDURE AssignOrCall; FORWARD;
  131. PROCEDURE Stat; FORWARD;
  132. PROCEDURE FieldIdents (rt: SymTab.TypeIndex); FORWARD;
  133. PROCEDURE Field (rt: SymTab.TypeIndex); FORWARD;
  134. PROCEDURE FieldSeq (rt: SymTab.TypeIndex); FORWARD;
  135. PROCEDURE Enum (VAR t: SymTab.TypeIndex); FORWARD;
  136. PROCEDURE PointerType (VAR t: SymTab.TypeIndex); FORWARD;
  137. PROCEDURE SetType (VAR t: SymTab.TypeIndex); FORWARD;
  138. PROCEDURE RecordType (VAR t: SymTab.TypeIndex); FORWARD;
  139. PROCEDURE ArrayType (VAR t: SymTab.TypeIndex); FORWARD;
  140. PROCEDURE SimpleType (VAR t: SymTab.TypeIndex); FORWARD;
  141. PROCEDURE FPSection; FORWARD;
  142. PROCEDURE QualIdent (VAR t: SymTab.TypeIndex); FORWARD;
  143. PROCEDURE FormalParams; FORWARD;
  144. PROCEDURE VarIdents; FORWARD;
  145. PROCEDURE Type (VAR t: SymTab.TypeIndex); FORWARD;
  146. PROCEDURE Expr (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
  147. VAR v: BOOLEAN; VAR vn: SymTab.Name); FORWARD;
  148. PROCEDURE ConstExpr (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr); FORWARD;
  149. PROCEDURE ProcedureDecl; FORWARD;
  150. PROCEDURE VarDecl; FORWARD;
  151. PROCEDURE TypeDecl; FORWARD;
  152. PROCEDURE ConstDecl; FORWARD;
  153. PROCEDURE StatSeq; FORWARD;
  154. PROCEDURE Declaration; FORWARD;
  155. PROCEDURE ImportList; FORWARD;
  156. PROCEDURE Block (isProc: BOOLEAN); FORWARD;
  157. PROCEDURE Import; FORWARD;
  158. PROCEDURE GetIdent (VAR n: SymTab.Name); FORWARD;
  159. PROCEDURE M2c; FORWARD;
  160. ----- *)
  161. PROCEDURE Elem (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
  162. VAR lx2: MGen.LitStr; VAR hasR: BOOLEAN);
  163. VAR t2: SymTab.TypeIndex;
  164. vD, vD2: BOOLEAN;
  165. vnD, vnD2: SymTab.Name;
  166. BEGIN
  167. Expr(t, lx, vD, vnD);
  168. hasR := FALSE;
  169. lx2[0] := 0C;;
  170. IF (sym = 23) THEN
  171. Get;
  172. Expr(t2, lx2, vD2, vnD2);
  173. IF ~SymTab.SetElemCheck(t, t2) THEN
  174. SemError(222) END;
  175. hasR := TRUE;;
  176. END;
  177. END Elem;
  178. PROCEDURE SetLit (VAR t: SymTab.TypeIndex);
  179. VAR first, et: SymTab.TypeIndex;
  180. lxE, lxE2: MGen.LitStr;
  181. vE, vE2: BOOLEAN;
  182. vnE, vnE2: SymTab.Name;
  183. hasR: BOOLEAN;
  184. BEGIN
  185. Expect(72);
  186. MGen.PushInt(0);
  187. t := SymTab.SetFor(SymTab.IntType());;
  188. IF In(symSet[1], sym) THEN
  189. Elem(et, lxE, lxE2, hasR);
  190. first := et;
  191. t := SymTab.SetFor(et);
  192. IF hasR THEN
  193. MGen.PushInt(1); MGen.Add;
  194. MGen.FieldMask
  195. ELSE MGen.Power2 END;
  196. MGen.Or;;
  197. WHILE (sym = 10) DO
  198. Get;
  199. Elem(et, lxE, lxE2, hasR);
  200. IF ~SymTab.SetElemCheck(first, et) THEN
  201. SemError(222) END;
  202. IF hasR THEN
  203. MGen.PushInt(1); MGen.Add;
  204. MGen.FieldMask
  205. ELSE MGen.Power2 END;
  206. MGen.Or;;
  207. END;
  208. END;
  209. Expect(73);
  210. END SetLit;
  211. PROCEDURE MulOp (VAR op: INTEGER);
  212. BEGIN
  213. CASE sym OF
  214. 63 :
  215. Get;
  216. op := SymTab.OpTimes;;
  217. | 64 :
  218. Get;
  219. op := SymTab.OpSlash;;
  220. | 65 :
  221. Get;
  222. op := SymTab.OpDiv;;
  223. | 66 :
  224. Get;
  225. op := SymTab.OpMod;;
  226. | 67 :
  227. Get;
  228. op := SymTab.OpAnd;;
  229. | 68 :
  230. Get;
  231. op := SymTab.OpAnd;;
  232. ELSE SynError(75);
  233. END;
  234. END MulOp;
  235. PROCEDURE Fact (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
  236. VAR v: BOOLEAN; VAR vn: SymTab.Name);
  237. VAR s: ARRAY [0 .. 255] OF CHAR;
  238. t2, et, dt, st: SymTab.TypeIndex;
  239. dk: INTEGER;
  240. bnF: SymTab.Name;
  241. lxD, lx2: MGen.LitStr;
  242. v2: BOOLEAN;
  243. vn2: SymTab.Name;
  244. vi: INTEGER;
  245. c: CARDINAL;
  246. b: LONGCARD;
  247. sfxF: BOOLEAN;
  248. okF: BOOLEAN;
  249. BEGIN
  250. CASE sym OF
  251. 2 :
  252. Get;
  253. LexString(s);
  254. MGen.CopyName(s, lx);
  255. v := FALSE;
  256. IF MGen.ParseInt(s, vi) THEN
  257. MGen.PushInt(vi)
  258. ELSIF MGen.ParseCard(s, c) THEN
  259. MGen.PushBits(
  260. VAL(LONGCARD, c))
  261. ELSE MGen.PushInt(0)
  262. END;
  263. t := SymTab.IntType();;
  264. | 3 :
  265. Get;
  266. LexString(s);
  267. MGen.CopyName(s, lx);
  268. v := FALSE;
  269. IF MGen.ParseReal(s, b) THEN
  270. MGen.PushBits(b)
  271. ELSE MGen.PushBits(0H)
  272. END;
  273. t := SymTab.RealType();;
  274. | 4 :
  275. Get;
  276. LexString(s);
  277. v := FALSE;
  278. IF SymTab.StrLen(s) <= 3 THEN
  279. t := SymTab.CharType();
  280. MGen.CopyName(s, lx);
  281. MGen.PushInt(
  282. MGen.CharOrd(s))
  283. ELSE t := SymTab.NewStr();
  284. MGen.CopyName(s, lx);
  285. MGen.EmitString(s)
  286. END;;
  287. | 69 :
  288. Get;
  289. Expect(19);
  290. DesignHead(dt, dk, bnF, FALSE, lxD);
  291. DesignTail(dt, dk, bnF, FALSE, lxD, sfxF);
  292. Expect(20);
  293. lx[0] := 0C; v := FALSE;
  294. IF dt = SymTab.InvalidType THEN
  295. IF sfxF THEN MGen.Drop END;
  296. MGen.PushInt(0);
  297. t := SymTab.InvalidType
  298. ELSIF SymTab.ClassOf(dt)
  299. # SymTab.ClArray THEN
  300. SemError(217);
  301. IF sfxF THEN MGen.Drop END;
  302. MGen.PushInt(0);
  303. t := SymTab.InvalidType
  304. ELSIF SymTab.IsOpen(dt) THEN
  305. IF sfxF THEN MGen.Drop END;
  306. IF (dk = SymTab.KindParam)
  307. OR (dk
  308. = SymTab.KindVarPar) THEN
  309. IF SymTab.CurDepth()
  310. = SymTab.SymDepth(bnF) THEN
  311. MGen.LoadLocal(
  312. SymTab.SymSlot(bnF) + 1)
  313. ELSE
  314. MGen.FrameAddr(
  315. SymTab.SymSlot(bnF) + 1,
  316. VAL(CARDINAL,
  317. SymTab.CurDepth() - 1
  318. - SymTab.SymDepth(bnF)));
  319. MGen.LoadIndir
  320. END;
  321. MGen.PushInt(1);
  322. MGen.Sub;
  323. t := SymTab.IntType()
  324. ELSE
  325. MGen.PushInt(0);
  326. t := SymTab.InvalidType
  327. END
  328. ELSE
  329. IF sfxF THEN MGen.Drop END;
  330. MGen.PushInt(
  331. SymTab.ArrayHi(dt));
  332. t := SymTab.IntType()
  333. END;;
  334. | 1 :
  335. DesignHead(dt, dk, bnF, TRUE, lxD);
  336. DesignTail(dt, dk, bnF, TRUE, lxD, sfxF);
  337. t := dt;
  338. MGen.CopyName(lxD, lx);
  339. IF sfxF
  340. & (t # SymTab.InvalidType)
  341. & (SymTab.ClassOf(t)
  342. # SymTab.ClArray)
  343. & (SymTab.ClassOf(t)
  344. # SymTab.ClRecord) THEN
  345. IF (SymTab.ClassOf(t)
  346. = SymTab.ClChar)
  347. OR (SymTab.ClassOf(t)
  348. = SymTab.ClBool) THEN
  349. MGen.LoadByte
  350. ELSE MGen.LoadIndir
  351. END
  352. END;
  353. v := ~sfxF
  354. & ((dk = SymTab.KindVar)
  355. OR (dk = SymTab.KindParam)
  356. OR (dk
  357. = SymTab.KindVarPar));
  358. MGen.CopyName(bnF, vn);;
  359. IF (sym = 19) THEN
  360. CallTail(bnF, sfxF, TRUE, okF, TRUE);
  361. IF okF THEN
  362. IF SymTab.SymKind(bnF)
  363. = SymTab.KindProc THEN
  364. t := SymTab.ProcRet(bnF)
  365. ELSE
  366. t := SymTab.InvalidType
  367. END
  368. ELSE t := SymTab.InvalidType
  369. END;
  370. lx[0] := 0C; v := FALSE;;
  371. END;
  372. | 19 :
  373. Get;
  374. Expr(et, lx, v, vn);
  375. Expect(20);
  376. t := et;;
  377. | 70, 71 :
  378. IF (sym = 70) THEN
  379. Get;
  380. ELSE
  381. Get;
  382. END;
  383. Fact(t2, lx2, v2, vn2);
  384. lx[0] := 0C; v := FALSE;
  385. IF SymTab.BoolCheck(t2) THEN
  386. t := SymTab.BoolType()
  387. ELSE SemError(212);
  388. t := SymTab.InvalidType END;
  389. MGen.Not;;
  390. | 72 :
  391. SetLit(st);
  392. lx[0] := 0C; v := FALSE;
  393. t := st;;
  394. ELSE SynError(76);
  395. END;
  396. END Fact;
  397. PROCEDURE AddOp (VAR op: INTEGER);
  398. BEGIN
  399. IF (sym = 61) THEN
  400. Get;
  401. op := SymTab.OpAdd;;
  402. ELSIF (sym = 46) THEN
  403. Get;
  404. op := SymTab.OpSub;;
  405. ELSIF (sym = 62) THEN
  406. Get;
  407. op := SymTab.OpOr;;
  408. ELSE SynError(77);
  409. END;
  410. END AddOp;
  411. PROCEDURE Term (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
  412. VAR v: BOOLEAN; VAR vn: SymTab.Name);
  413. VAR t2, res2: SymTab.TypeIndex;
  414. op: INTEGER;
  415. lx2: MGen.LitStr;
  416. v2: BOOLEAN;
  417. vn2: SymTab.Name;
  418. isR: BOOLEAN;
  419. mt: INTEGER;
  420. BEGIN
  421. Fact(t, lx, v, vn);
  422. WHILE In(symSet[2], sym) DO
  423. MulOp(op);
  424. Fact(t2, lx2, v2, vn2);
  425. lx[0] := 0C; v := FALSE;
  426. IF op = SymTab.OpAnd THEN
  427. IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
  428. t := SymTab.BoolType()
  429. ELSE SemError(212); t := SymTab.InvalidType END;
  430. MGen.And
  431. ELSIF (op = SymTab.OpTimes)
  432. & (t # SymTab.InvalidType)
  433. & (t2 # SymTab.InvalidType)
  434. & (SymTab.ClassOf(t) = SymTab.ClSet)
  435. & (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
  436. MGen.And
  437. ELSE
  438. IF SymTab.ArithCheck(t, t2,
  439. (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
  440. res2) THEN t := res2
  441. ELSE SemError(211); t := SymTab.InvalidType END;
  442. isR := (t # SymTab.InvalidType)
  443. & (SymTab.ClassOf(t) = SymTab.ClReal);
  444. IF op = SymTab.OpTimes THEN
  445. IF isR THEN MGen.RealMul ELSE MGen.MulU END
  446. ELSIF op = SymTab.OpSlash THEN
  447. IF isR THEN MGen.RealDiv ELSE MGen.DivI END
  448. ELSIF op = SymTab.OpDiv THEN
  449. MGen.DivI
  450. ELSE
  451. mt := MGen.TempGlobal();
  452. MGen.ModI(mt)
  453. END
  454. END;;
  455. END;
  456. END Term;
  457. PROCEDURE Rel (VAR op: INTEGER);
  458. BEGIN
  459. CASE sym OF
  460. 16 :
  461. Get;
  462. op := SymTab.OpEq;;
  463. | 54 :
  464. Get;
  465. op := SymTab.OpNeq1;;
  466. | 55 :
  467. Get;
  468. op := SymTab.OpNeq2;;
  469. | 56 :
  470. Get;
  471. op := SymTab.OpLt;;
  472. | 57 :
  473. Get;
  474. op := SymTab.OpLe;;
  475. | 58 :
  476. Get;
  477. op := SymTab.OpGt;;
  478. | 59 :
  479. Get;
  480. op := SymTab.OpGe;;
  481. | 60 :
  482. Get;
  483. op := SymTab.OpIn;;
  484. ELSE SynError(78);
  485. END;
  486. END Rel;
  487. PROCEDURE SimExpr (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
  488. VAR v: BOOLEAN; VAR vn: SymTab.Name);
  489. VAR t2, res2: SymTab.TypeIndex;
  490. op: INTEGER;
  491. lx2: MGen.LitStr;
  492. v2: BOOLEAN;
  493. vn2: SymTab.Name;
  494. neg, isR: BOOLEAN;
  495. BEGIN
  496. neg := FALSE;;
  497. IF (sym = 46) OR (sym = 61) THEN
  498. IF (sym = 61) THEN
  499. Get;
  500. ELSE
  501. Get;
  502. neg := TRUE;;
  503. END;
  504. END;
  505. Term(t, lx, v, vn);
  506. IF neg THEN
  507. v := FALSE;
  508. IF MGen.IsLit(lx) THEN
  509. MGen.NegFold(lx, lx)
  510. ELSE lx[0] := 0C
  511. END;
  512. IF SymTab.ClassOf(t)
  513. = SymTab.ClReal THEN
  514. MGen.NegReal
  515. ELSE MGen.NegInt
  516. END
  517. END;;
  518. WHILE (sym = 46) OR (sym = 61) OR (sym = 62) DO
  519. AddOp(op);
  520. Term(t2, lx2, v2, vn2);
  521. lx[0] := 0C; v := FALSE;
  522. IF op = SymTab.OpOr THEN
  523. IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
  524. t := SymTab.BoolType()
  525. ELSE SemError(212); t := SymTab.InvalidType END;
  526. MGen.Or
  527. ELSIF (t # SymTab.InvalidType)
  528. & (t2 # SymTab.InvalidType)
  529. & (SymTab.ClassOf(t) = SymTab.ClSet)
  530. & (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
  531. IF op = SymTab.OpAdd THEN
  532. MGen.Or
  533. ELSE
  534. MGen.PushBits(0FFFFFFFFFFFFFFFFH);
  535. MGen.BitXor;
  536. MGen.And
  537. END
  538. ELSE
  539. IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN t := res2
  540. ELSE SemError(211); t := SymTab.InvalidType END;
  541. isR := (t # SymTab.InvalidType)
  542. & (SymTab.ClassOf(t) = SymTab.ClReal);
  543. IF op = SymTab.OpAdd THEN
  544. IF isR THEN MGen.RealAdd ELSE MGen.Add END
  545. ELSE
  546. IF isR THEN MGen.RealSub ELSE MGen.Sub END
  547. END
  548. END;;
  549. END;
  550. END SimExpr;
  551. PROCEDURE ByLit (VAR v: INTEGER);
  552. VAR s: ARRAY [0 .. 255] OF CHAR;
  553. BEGIN
  554. IF (sym = 2) THEN
  555. Get;
  556. LexString(s);
  557. IF ~MGen.ParseInt(s, v) THEN
  558. v := 1
  559. END;;
  560. ELSIF (sym = 46) THEN
  561. Get;
  562. Expect(2);
  563. LexString(s);
  564. IF MGen.ParseInt(s, v) THEN
  565. v := -v
  566. ELSE v := -1
  567. END;;
  568. ELSE SynError(79);
  569. END;
  570. END ByLit;
  571. PROCEDURE Labels (sel: SymTab.TypeIndex; tmp: INTEGER; bodyL: INTEGER);
  572. VAR t, t2: SymTab.TypeIndex;
  573. lx1, lx2: MGen.LitStr;
  574. v1, v2: BOOLEAN;
  575. vn1, vn2: SymTab.Name;
  576. ta, tb, chunk: INTEGER;
  577. r, hasRange: BOOLEAN;
  578. BEGIN
  579. ConstExpr(t, lx1);
  580. IF ~SymTab.EqCheck(t, sel) THEN
  581. SemError(213) END;
  582. r := (SymTab.ClassOf(sel)
  583. = SymTab.ClReal)
  584. & (SymTab.ClassOf(t)
  585. = SymTab.ClReal);
  586. ta := MGen.TempGlobal();
  587. MGen.StoreTemp(ta);
  588. hasRange := FALSE;;
  589. IF (sym = 23) THEN
  590. Get;
  591. ConstExpr(t2, lx2);
  592. IF ~SymTab.EqCheck(t2, sel) THEN
  593. SemError(213) END;
  594. tb := MGen.TempGlobal();
  595. MGen.StoreTemp(tb);
  596. hasRange := TRUE;;
  597. END;
  598. IF hasRange THEN
  599. MGen.LoadTemp(tmp);
  600. MGen.LoadTemp(ta);
  601. IF r THEN MGen.RealGe
  602. ELSE MGen.IGe END;
  603. MGen.LoadTemp(tmp);
  604. MGen.LoadTemp(tb);
  605. IF r THEN MGen.RealLe
  606. ELSE MGen.ILe END;
  607. MGen.And
  608. ELSE
  609. MGen.LoadTemp(tmp);
  610. MGen.LoadTemp(ta);
  611. IF r THEN MGen.RealEq
  612. ELSE MGen.Eq END
  613. END;
  614. chunk := MGen.NewLabel();
  615. MGen.Jz(chunk);
  616. MGen.Jmp(bodyL);
  617. MGen.DefLabel(chunk);;
  618. END Labels;
  619. PROCEDURE LabelList (sel: SymTab.TypeIndex; tmp: INTEGER;
  620. VAR lB: INTEGER; VAR lN: INTEGER);
  621. BEGIN
  622. lB := MGen.NewLabel();
  623. lN := MGen.NewLabel();;
  624. Labels(sel, tmp, lB);
  625. WHILE (sym = 10) DO
  626. Get;
  627. Labels(sel, tmp, lB);
  628. END;
  629. MGen.Jmp(lN);;
  630. END LabelList;
  631. PROCEDURE Case (sel: SymTab.TypeIndex; tmp: INTEGER; endL: INTEGER);
  632. VAR lB, lN: INTEGER;
  633. BEGIN
  634. IF In(symSet[1], sym) THEN
  635. LabelList(sel, tmp, lB, lN);
  636. Expect(17);
  637. MGen.DefLabel(lB);;
  638. StatSeq;
  639. MGen.Jmp(endL);
  640. MGen.DefLabel(lN);;
  641. END;
  642. END Case;
  643. PROCEDURE CallTail (pn: SymTab.Name; sfx: BOOLEAN; inExpr: BOOLEAN;
  644. VAR ok: BOOLEAN; hasDead: BOOLEAN);
  645. VAR t: SymTab.TypeIndex;
  646. lx: MGen.LitStr;
  647. v: BOOLEAN;
  648. vn: SymTab.Name;
  649. BEGIN
  650. Expect(19);
  651. ok := FALSE;
  652. IF hasDead THEN MGen.Drop END;
  653. MGen.ActBegin(pn);;
  654. IF In(symSet[1], sym) THEN
  655. Expr(t, lx, v, vn);
  656. IF MGen.ActValue(t, v, vn) # 0 THEN
  657. SemError(233)
  658. END;;
  659. WHILE (sym = 10) DO
  660. Get;
  661. Expr(t, lx, v, vn);
  662. IF MGen.ActValue(t, v, vn) # 0 THEN
  663. SemError(233)
  664. END;;
  665. END;
  666. END;
  667. Expect(20);
  668. IF MGen.ActEnd(pn, sfx, inExpr) # 0
  669. THEN SemError(233)
  670. ELSE ok := TRUE
  671. END;;
  672. END CallTail;
  673. PROCEDURE DesignTail (VAR t: SymTab.TypeIndex; VAR k: INTEGER;
  674. VAR bn: SymTab.Name; doLoad: BOOLEAN; VAR lx: MGen.LitStr;
  675. VAR sfx: BOOLEAN);
  676. VAR m: SymTab.Name;
  677. it: SymTab.TypeIndex;
  678. lxI: MGen.LitStr;
  679. vI: BOOLEAN;
  680. vnI: SymTab.Name;
  681. loA: INTEGER;
  682. elemT: SymTab.TypeIndex;
  683. esl, ebytes: CARDINAL;
  684. firstT: BOOLEAN;
  685. clsI: INTEGER;
  686. BEGIN
  687. sfx := FALSE;;
  688. WHILE (sym = 7) OR (sym = 22) OR (sym = 53) DO
  689. IF (sym = 7) THEN
  690. Get;
  691. firstT := ~sfx;
  692. sfx := TRUE; lx[0] := 0C;
  693. IF ~doLoad & firstT THEN
  694. IF (k = SymTab.KindVar)
  695. OR (k = SymTab.KindParam)
  696. OR (k
  697. = SymTab.KindVarPar) THEN
  698. MGen.PushAddr(bn)
  699. ELSIF k
  700. = SymTab.KindField THEN
  701. MGen.WithAddr(bn)
  702. ELSE MGen.PushInt(0)
  703. END
  704. END;;
  705. GetIdent(m);
  706. IF t = SymTab.InvalidType THEN
  707. IF ~doLoad & firstT THEN
  708. MGen.Drop
  709. ELSIF doLoad THEN
  710. MGen.Drop; MGen.PushInt(0)
  711. END
  712. ELSIF SymTab.ClassOf(t) #
  713. SymTab.ClRecord THEN
  714. SemError(215);
  715. t := SymTab.InvalidType;
  716. IF doLoad THEN
  717. MGen.Drop; MGen.PushInt(0)
  718. ELSIF firstT THEN
  719. MGen.Drop
  720. END
  721. ELSIF ~SymTab.FieldExists(t, m) THEN
  722. SemError(216);
  723. t := SymTab.InvalidType;
  724. IF doLoad THEN
  725. MGen.Drop; MGen.PushInt(0)
  726. ELSIF firstT THEN
  727. MGen.Drop
  728. END
  729. ELSE
  730. loA := SymTab.FieldOffset(t, m);
  731. elemT := SymTab.FieldType(t, m);
  732. IF loA < 0 THEN
  733. SemError(216);
  734. t := SymTab.InvalidType;
  735. IF doLoad THEN
  736. MGen.Drop; MGen.PushInt(0)
  737. ELSIF firstT THEN
  738. MGen.Drop
  739. END
  740. ELSE
  741. MGen.FieldAdd(
  742. VAL(CARDINAL, loA));
  743. t := elemT
  744. END
  745. END;;
  746. ELSIF (sym = 22) THEN
  747. Get;
  748. firstT := ~sfx;
  749. sfx := TRUE; lx[0] := 0C;
  750. IF ~doLoad & firstT THEN
  751. IF (k = SymTab.KindVar)
  752. OR (k = SymTab.KindParam)
  753. OR (k
  754. = SymTab.KindVarPar) THEN
  755. MGen.PushAddr(bn)
  756. ELSIF k
  757. = SymTab.KindField THEN
  758. MGen.WithAddr(bn)
  759. ELSE MGen.PushInt(0)
  760. END
  761. END;;
  762. Expr(it, lxI, vI, vnI);
  763. IF t = SymTab.InvalidType THEN
  764. MGen.Drop;
  765. IF doLoad THEN
  766. MGen.Drop; MGen.PushInt(0)
  767. ELSE
  768. IF ~firstT THEN
  769. ELSE MGen.Drop
  770. END
  771. END
  772. ELSIF SymTab.ClassOf(t) #
  773. SymTab.ClArray THEN
  774. SemError(217);
  775. t := SymTab.InvalidType;
  776. MGen.Drop;
  777. IF doLoad THEN
  778. MGen.Drop; MGen.PushInt(0)
  779. ELSE
  780. IF ~firstT THEN
  781. ELSE MGen.Drop
  782. END
  783. END
  784. ELSE
  785. clsI := SymTab.ClassOf(it);
  786. IF (it
  787. # SymTab.InvalidType)
  788. & (clsI # SymTab.ClInt)
  789. & (clsI # SymTab.ClChar)
  790. & (clsI # SymTab.ClEnum)
  791. & (clsI
  792. # SymTab.ClBool) THEN
  793. SemError(218);
  794. t := SymTab.InvalidType;
  795. MGen.Drop;
  796. IF doLoad THEN
  797. MGen.Drop; MGen.PushInt(0)
  798. ELSE
  799. IF ~firstT THEN
  800. ELSE MGen.Drop
  801. END
  802. END
  803. ELSE
  804. loA := SymTab.ArrayLo(t);
  805. elemT := SymTab.ArrayElem(t);
  806. esl := SymTab.TypeSlots(elemT);
  807. IF esl = 0 THEN
  808. SemError(230);
  809. esl := 1
  810. END;
  811. IF (SymTab.ClassOf(elemT)
  812. = SymTab.ClChar)
  813. OR (SymTab.ClassOf(elemT)
  814. = SymTab.ClBool) THEN
  815. ebytes := 1
  816. ELSE ebytes := esl * 8
  817. END;
  818. MGen.IdxScale(loA, ebytes);
  819. t := elemT
  820. END
  821. END;;
  822. WHILE (sym = 10) DO
  823. Get;
  824. Expr(it, lxI, vI, vnI);
  825. IF t = SymTab.InvalidType THEN
  826. MGen.Drop;
  827. IF doLoad THEN
  828. MGen.Drop; MGen.PushInt(0);
  829. t := SymTab.InvalidType
  830. END
  831. ELSIF SymTab.ClassOf(t) #
  832. SymTab.ClArray THEN
  833. SemError(217);
  834. t := SymTab.InvalidType;
  835. MGen.Drop;
  836. IF doLoad THEN
  837. MGen.Drop; MGen.PushInt(0)
  838. END
  839. ELSE
  840. clsI := SymTab.ClassOf(it);
  841. IF (it
  842. # SymTab.InvalidType)
  843. & (clsI # SymTab.ClInt)
  844. & (clsI # SymTab.ClChar)
  845. & (clsI # SymTab.ClEnum)
  846. & (clsI
  847. # SymTab.ClBool) THEN
  848. SemError(218);
  849. t := SymTab.InvalidType;
  850. MGen.Drop;
  851. IF doLoad THEN
  852. MGen.Drop; MGen.PushInt(0)
  853. END
  854. ELSE
  855. loA := SymTab.ArrayLo(t);
  856. elemT := SymTab.ArrayElem(t);
  857. esl := SymTab.TypeSlots(elemT);
  858. IF esl = 0 THEN
  859. SemError(230);
  860. esl := 1
  861. END;
  862. IF (SymTab.ClassOf(elemT)
  863. = SymTab.ClChar)
  864. OR (SymTab.ClassOf(elemT)
  865. = SymTab.ClBool) THEN
  866. ebytes := 1
  867. ELSE ebytes := esl * 8
  868. END;
  869. MGen.IdxScale(loA, ebytes);
  870. t := elemT
  871. END
  872. END;;
  873. END;
  874. Expect(24);
  875. ELSE
  876. Get;
  877. firstT := ~sfx;
  878. sfx := TRUE; lx[0] := 0C;
  879. IF ~doLoad & firstT THEN
  880. IF (k = SymTab.KindVar)
  881. OR (k = SymTab.KindParam)
  882. OR (k
  883. = SymTab.KindVarPar) THEN
  884. MGen.PushAddr(bn)
  885. ELSIF k
  886. = SymTab.KindField THEN
  887. MGen.WithAddr(bn)
  888. ELSE MGen.PushInt(0)
  889. END
  890. END;;
  891. IF t = SymTab.InvalidType THEN
  892. IF doLoad THEN
  893. MGen.Drop; MGen.PushInt(0)
  894. ELSIF firstT THEN
  895. MGen.Drop
  896. END
  897. ELSIF SymTab.ClassOf(t) #
  898. SymTab.ClPtr THEN
  899. SemError(219);
  900. t := SymTab.InvalidType;
  901. IF doLoad THEN
  902. MGen.Drop; MGen.PushInt(0)
  903. ELSIF firstT THEN
  904. MGen.Drop
  905. END
  906. ELSE
  907. elemT := SymTab.PtrBase(t);
  908. t := elemT;
  909. IF doLoad THEN
  910. IF ~(firstT
  911. & ((k
  912. = SymTab.KindVar)
  913. OR (k
  914. = SymTab.KindParam)
  915. OR (k
  916. = SymTab.KindVarPar)))
  917. THEN
  918. MGen.LoadIndir
  919. END
  920. ELSE
  921. MGen.LoadIndir
  922. END
  923. END;;
  924. END;
  925. END;
  926. END DesignTail;
  927. PROCEDURE DesignHead (VAR t: SymTab.TypeIndex; VAR k: INTEGER;
  928. VAR bn: SymTab.Name; doLoad: BOOLEAN; VAR lx: MGen.LitStr);
  929. VAR n: SymTab.Name;
  930. cls: INTEGER;
  931. BEGIN
  932. GetIdent(n);
  933. MGen.CopyName(n, bn);
  934. lx[0] := 0C;
  935. IF ~SymTab.Lookup(n) THEN
  936. SemError(201);
  937. t := SymTab.InvalidType; k := -1;
  938. IF doLoad THEN
  939. MGen.PushInt(0)
  940. END
  941. ELSE
  942. t := SymTab.SymType(n);
  943. k := SymTab.SymKind(n);
  944. IF k = SymTab.KindConst THEN
  945. IF SymTab.Equal(n, "TRUE") THEN
  946. t := SymTab.BoolType();
  947. MGen.CopyName("TRUE", lx);
  948. IF doLoad THEN
  949. MGen.PushInt(1)
  950. END
  951. ELSIF SymTab.Equal(n,
  952. "FALSE") THEN
  953. t := SymTab.BoolType();
  954. MGen.CopyName("FALSE", lx);
  955. IF doLoad THEN
  956. MGen.PushInt(0)
  957. END
  958. ELSE
  959. cls :=
  960. SymTab.ClassOf(t);
  961. IF (t #
  962. SymTab.InvalidType)
  963. & (cls # SymTab.ClStr)
  964. & ((cls = SymTab.ClInt)
  965. OR (cls = SymTab.ClReal)
  966. OR (cls = SymTab.ClBool)
  967. OR (cls = SymTab.ClChar)
  968. OR (cls
  969. = SymTab.ClEnum)) THEN
  970. IF doLoad THEN
  971. MGen.LoadVar(n)
  972. END
  973. ELSIF doLoad THEN
  974. MGen.PushInt(0)
  975. END
  976. END
  977. ELSIF (k = SymTab.KindVar)
  978. OR (k = SymTab.KindParam)
  979. OR (k
  980. = SymTab.KindVarPar) THEN
  981. cls := SymTab.ClassOf(t);
  982. IF (cls = SymTab.ClInt)
  983. OR (cls = SymTab.ClReal)
  984. OR (cls = SymTab.ClBool)
  985. OR (cls = SymTab.ClChar)
  986. OR (cls
  987. = SymTab.ClEnum)
  988. OR (cls
  989. = SymTab.ClSet)
  990. OR (cls
  991. = SymTab.ClPtr) THEN
  992. IF doLoad THEN
  993. MGen.PushVar(n)
  994. END
  995. ELSIF (cls
  996. = SymTab.ClArray)
  997. OR (cls
  998. = SymTab.ClRecord) THEN
  999. IF doLoad THEN
  1000. MGen.PushAddr(n)
  1001. END
  1002. ELSIF t
  1003. = SymTab.InvalidType THEN
  1004. IF doLoad THEN
  1005. MGen.PushInt(0)
  1006. END
  1007. ELSE SemError(230);
  1008. IF doLoad THEN
  1009. MGen.PushInt(0)
  1010. END
  1011. END
  1012. ELSE
  1013. IF doLoad THEN
  1014. IF k = SymTab.KindField THEN
  1015. MGen.WithAddr(n);
  1016. cls := SymTab.ClassOf(t);
  1017. IF (t
  1018. = SymTab.InvalidType)
  1019. OR (cls
  1020. = SymTab.ClArray)
  1021. OR (cls
  1022. = SymTab.ClRecord) THEN
  1023. ELSE
  1024. IF (cls
  1025. = SymTab.ClChar)
  1026. OR (cls
  1027. = SymTab.ClBool) THEN
  1028. MGen.LoadByte
  1029. ELSE MGen.LoadIndir
  1030. END
  1031. END
  1032. ELSE MGen.PushInt(0)
  1033. END
  1034. END;
  1035. IF k = SymTab.KindField THEN
  1036. ELSIF k
  1037. = SymTab.KindImport THEN
  1038. SemError(230)
  1039. END
  1040. END
  1041. END;;
  1042. END DesignHead;
  1043. PROCEDURE WriteStrStat;
  1044. VAR t: SymTab.TypeIndex;
  1045. lx: MGen.LitStr;
  1046. v: BOOLEAN;
  1047. vn: SymTab.Name;
  1048. BEGIN
  1049. Expect(52);
  1050. Expect(19);
  1051. Expr(t, lx, v, vn);
  1052. Expect(20);
  1053. IF t = SymTab.InvalidType THEN
  1054. MGen.Drop
  1055. ELSIF (SymTab.ClassOf(t)
  1056. = SymTab.ClStr) THEN
  1057. MGen.PushInt(1);
  1058. MGen.SysCall
  1059. ELSIF (SymTab.ClassOf(t)
  1060. = SymTab.ClArray)
  1061. & (SymTab.ClassOf(
  1062. SymTab.ArrayElem(t))
  1063. = SymTab.ClChar) THEN
  1064. MGen.PushInt(1);
  1065. MGen.SysCall
  1066. ELSE
  1067. SemError(210);
  1068. MGen.Drop
  1069. END;;
  1070. END WriteStrStat;
  1071. PROCEDURE WriteIntStat;
  1072. VAR t: SymTab.TypeIndex;
  1073. lx: MGen.LitStr;
  1074. v: BOOLEAN;
  1075. vn: SymTab.Name;
  1076. BEGIN
  1077. Expect(51);
  1078. Expect(19);
  1079. Expr(t, lx, v, vn);
  1080. Expect(20);
  1081. IF t = SymTab.InvalidType THEN
  1082. MGen.Drop
  1083. ELSIF ~SymTab.IsIntFamily(t) THEN
  1084. SemError(210);
  1085. MGen.Drop
  1086. ELSE
  1087. MGen.CallPrint
  1088. END;;
  1089. END WriteIntStat;
  1090. PROCEDURE DispStat;
  1091. VAR dt: SymTab.TypeIndex;
  1092. dk: INTEGER;
  1093. bnD: SymTab.Name;
  1094. lxD: MGen.LitStr;
  1095. sfxD: BOOLEAN;
  1096. baseT: SymTab.TypeIndex;
  1097. slD: CARDINAL;
  1098. BEGIN
  1099. Expect(50);
  1100. Expect(19);
  1101. DesignHead(dt, dk, bnD, FALSE, lxD);
  1102. DesignTail(dt, dk, bnD, FALSE, lxD, sfxD);
  1103. Expect(20);
  1104. IF dt = SymTab.InvalidType THEN
  1105. IF sfxD THEN MGen.Drop END
  1106. ELSIF SymTab.ClassOf(dt)
  1107. # SymTab.ClPtr THEN
  1108. SemError(219);
  1109. IF sfxD THEN MGen.Drop END
  1110. ELSE
  1111. baseT := SymTab.PtrBase(dt);
  1112. slD := SymTab.TypeSlots(baseT);
  1113. IF slD = 0 THEN
  1114. SemError(230);
  1115. slD := 1
  1116. END;
  1117. IF ~sfxD THEN
  1118. IF (dk = SymTab.KindVar)
  1119. OR (dk
  1120. = SymTab.KindParam)
  1121. OR (dk
  1122. = SymTab.KindVarPar) THEN
  1123. MGen.PushAddr(bnD)
  1124. ELSIF dk
  1125. = SymTab.KindField THEN
  1126. MGen.WithAddr(bnD)
  1127. ELSE MGen.PushInt(0)
  1128. END
  1129. END;
  1130. MGen.PushBytes(slD * 8);
  1131. MGen.DeallocOp
  1132. END;;
  1133. END DispStat;
  1134. PROCEDURE NewStat;
  1135. VAR dt: SymTab.TypeIndex;
  1136. dk: INTEGER;
  1137. bnN: SymTab.Name;
  1138. lxN: MGen.LitStr;
  1139. sfxN: BOOLEAN;
  1140. baseT: SymTab.TypeIndex;
  1141. slN: CARDINAL;
  1142. BEGIN
  1143. Expect(49);
  1144. Expect(19);
  1145. DesignHead(dt, dk, bnN, FALSE, lxN);
  1146. DesignTail(dt, dk, bnN, FALSE, lxN, sfxN);
  1147. Expect(20);
  1148. IF dt = SymTab.InvalidType THEN
  1149. IF sfxN THEN MGen.Drop END
  1150. ELSIF SymTab.ClassOf(dt)
  1151. # SymTab.ClPtr THEN
  1152. SemError(219);
  1153. IF sfxN THEN MGen.Drop END
  1154. ELSE
  1155. baseT := SymTab.PtrBase(dt);
  1156. slN := SymTab.TypeSlots(baseT);
  1157. IF slN = 0 THEN
  1158. SemError(230);
  1159. slN := 1
  1160. END;
  1161. IF ~sfxN THEN
  1162. IF (dk = SymTab.KindVar)
  1163. OR (dk
  1164. = SymTab.KindParam)
  1165. OR (dk
  1166. = SymTab.KindVarPar) THEN
  1167. MGen.PushAddr(bnN)
  1168. ELSIF dk
  1169. = SymTab.KindField THEN
  1170. MGen.WithAddr(bnN)
  1171. ELSE MGen.PushInt(0)
  1172. END
  1173. END;
  1174. MGen.PushBytes(slN * 8);
  1175. MGen.AllocOp
  1176. END;;
  1177. END NewStat;
  1178. PROCEDURE ReturnStat;
  1179. VAR t: SymTab.TypeIndex;
  1180. lx: MGen.LitStr;
  1181. v: BOOLEAN;
  1182. vn: SymTab.Name;
  1183. hasE, doRet, conv: BOOLEAN;
  1184. BEGIN
  1185. Expect(48);
  1186. hasE := FALSE;;
  1187. IF In(symSet[1], sym) THEN
  1188. Expr(t, lx, v, vn);
  1189. hasE := TRUE;
  1190. doRet := FALSE;
  1191. IF ~SymTab.InProc() THEN
  1192. SemError(232)
  1193. ELSIF ~SymTab.InFunction() THEN
  1194. SemError(232)
  1195. ELSIF ~SymTab.Assignable(
  1196. t, SymTab.CurRet()) THEN
  1197. SemError(232)
  1198. ELSE doRet := TRUE
  1199. END;
  1200. conv := doRet
  1201. & SymTab.IsIntFamily(t)
  1202. & (SymTab.ClassOf(
  1203. SymTab.CurRet())
  1204. = SymTab.ClReal);
  1205. IF doRet THEN
  1206. IF conv THEN
  1207. MGen.IntToReal
  1208. END;
  1209. MGen.Leave(
  1210. SymTab.CurNPar(), TRUE)
  1211. ELSE MGen.Drop
  1212. END;;
  1213. END;
  1214. IF ~hasE THEN
  1215. IF ~SymTab.InProc() THEN
  1216. SemError(232)
  1217. ELSIF SymTab.InFunction() THEN
  1218. SemError(232)
  1219. ELSE MGen.Leave(
  1220. SymTab.CurNPar(), FALSE)
  1221. END
  1222. END;;
  1223. END ReturnStat;
  1224. PROCEDURE WithStat;
  1225. VAR dt: SymTab.TypeIndex;
  1226. dk: INTEGER;
  1227. bnW: SymTab.Name;
  1228. lxW: MGen.LitStr;
  1229. sfxW: BOOLEAN;
  1230. pushed: BOOLEAN;
  1231. BEGIN
  1232. Expect(47);
  1233. DesignHead(dt, dk, bnW, FALSE, lxW);
  1234. DesignTail(dt, dk, bnW, FALSE, lxW, sfxW);
  1235. pushed := FALSE;
  1236. IF dt = SymTab.InvalidType THEN
  1237. IF sfxW THEN MGen.Drop END
  1238. ELSIF SymTab.ClassOf(dt)
  1239. # SymTab.ClRecord THEN
  1240. SemError(215);
  1241. IF sfxW THEN MGen.Drop END
  1242. ELSE
  1243. IF ~sfxW THEN
  1244. IF (dk
  1245. = SymTab.KindVar)
  1246. OR (dk
  1247. = SymTab.KindParam)
  1248. OR (dk
  1249. = SymTab.KindVarPar) THEN
  1250. MGen.PushAddr(bnW)
  1251. ELSIF dk
  1252. = SymTab.KindField THEN
  1253. MGen.WithAddr(bnW)
  1254. ELSE MGen.PushInt(0)
  1255. END
  1256. END;
  1257. MGen.WithEnter(dt);
  1258. pushed :=
  1259. SymTab.PushRecord(dt);
  1260. IF ~pushed THEN
  1261. SemError(215)
  1262. END
  1263. END;;
  1264. Expect(40);
  1265. StatSeq;
  1266. Expect(12);
  1267. IF pushed THEN
  1268. SymTab.PopScope;
  1269. MGen.WithExit
  1270. END;;
  1271. END WithStat;
  1272. PROCEDURE ForStat;
  1273. VAR n, lv: SymTab.Name;
  1274. fk: INTEGER;
  1275. lo, hi: SymTab.TypeIndex;
  1276. lxLo, lxHi: MGen.LitStr;
  1277. vLo, vHi: BOOLEAN;
  1278. vnLo, vnHi: SymTab.Name;
  1279. byV, ht: INTEGER;
  1280. lTop, lChk, lEnd: INTEGER;
  1281. neg, storable: BOOLEAN;
  1282. BEGIN
  1283. Expect(44);
  1284. GetIdent(n);
  1285. IF ~SymTab.Lookup(n) THEN
  1286. SemError(201);
  1287. fk := -1
  1288. ELSIF (SymTab.SymKind(n) #
  1289. SymTab.KindVar)
  1290. & (SymTab.SymKind(n) #
  1291. SymTab.KindParam)
  1292. & (SymTab.SymKind(n) #
  1293. SymTab.KindVarPar)
  1294. & (SymTab.SymKind(n) #
  1295. SymTab.KindField) THEN
  1296. SemError(220);
  1297. fk := -1
  1298. ELSIF (SymTab.SymType(n) #
  1299. SymTab.InvalidType)
  1300. & ~SymTab.IsIntFamily(
  1301. SymTab.SymType(n)) THEN
  1302. SemError(220);
  1303. fk := -1
  1304. ELSE
  1305. fk := SymTab.SymKind(n)
  1306. END;
  1307. MGen.CopyName(n, lv);
  1308. storable := (fk = SymTab.KindVar)
  1309. OR (fk = SymTab.KindParam)
  1310. OR (fk = SymTab.KindVarPar);
  1311. IF storable THEN
  1312. MGen.StoreSetup(lv)
  1313. END;;
  1314. Expect(32);
  1315. Expr(lo, lxLo, vLo, vnLo);
  1316. IF (lo # SymTab.InvalidType)
  1317. & ~SymTab.IsIntFamily(lo) THEN
  1318. SemError(220) END;
  1319. IF storable THEN
  1320. MGen.StoreFinish(lv)
  1321. ELSE MGen.Drop
  1322. END;;
  1323. Expect(30);
  1324. Expr(hi, lxHi, vHi, vnHi);
  1325. IF (hi # SymTab.InvalidType)
  1326. & ~SymTab.IsIntFamily(hi) THEN
  1327. SemError(220) END;
  1328. ht := MGen.TempGlobal();
  1329. MGen.StoreTemp(ht);
  1330. byV := 1; neg := FALSE;;
  1331. IF (sym = 45) THEN
  1332. Get;
  1333. ByLit(byV);
  1334. neg := byV < 0;;
  1335. END;
  1336. Expect(40);
  1337. lTop := MGen.NewLabel();
  1338. lChk := MGen.NewLabel();
  1339. lEnd := MGen.NewLabel();
  1340. MGen.Jmp(lChk);
  1341. MGen.DefLabel(lTop);;
  1342. StatSeq;
  1343. Expect(12);
  1344. MGen.PushVar(lv);
  1345. MGen.PushInt(byV);
  1346. MGen.Add;
  1347. IF storable THEN
  1348. MGen.StoreFinish(lv)
  1349. ELSE MGen.Drop
  1350. END;
  1351. MGen.DefLabel(lChk);
  1352. MGen.PushVar(lv);
  1353. MGen.LoadTemp(ht);
  1354. IF neg THEN MGen.IGe
  1355. ELSE MGen.ILe END;
  1356. MGen.Jz(lEnd);
  1357. MGen.Jmp(lTop);
  1358. MGen.DefLabel(lEnd);;
  1359. END ForStat;
  1360. PROCEDURE LoopStat;
  1361. VAR topL, exitL: INTEGER;
  1362. BEGIN
  1363. Expect(43);
  1364. topL := MGen.NewLabel();
  1365. exitL := MGen.NewLabel();
  1366. MGen.DefLabel(topL);
  1367. MGen.PushLoop(exitL);;
  1368. StatSeq;
  1369. Expect(12);
  1370. MGen.Jmp(topL);
  1371. MGen.DefLabel(exitL);
  1372. MGen.PopLoop;;
  1373. END LoopStat;
  1374. PROCEDURE RepeatStat;
  1375. VAR t: SymTab.TypeIndex;
  1376. lxC: MGen.LitStr;
  1377. vC: BOOLEAN;
  1378. vnC: SymTab.Name;
  1379. topL: INTEGER;
  1380. BEGIN
  1381. Expect(41);
  1382. topL := MGen.NewLabel();
  1383. MGen.DefLabel(topL);;
  1384. StatSeq;
  1385. Expect(42);
  1386. Expr(t, lxC, vC, vnC);
  1387. IF ~SymTab.BoolCheck(t) THEN
  1388. SemError(214) END;
  1389. MGen.Jz(topL);;
  1390. END RepeatStat;
  1391. PROCEDURE WhileStat;
  1392. VAR t: SymTab.TypeIndex;
  1393. lxC: MGen.LitStr;
  1394. vC: BOOLEAN;
  1395. vnC: SymTab.Name;
  1396. topL, endL: INTEGER;
  1397. BEGIN
  1398. Expect(39);
  1399. topL := MGen.NewLabel();
  1400. endL := MGen.NewLabel();
  1401. MGen.DefLabel(topL);;
  1402. Expr(t, lxC, vC, vnC);
  1403. IF ~SymTab.BoolCheck(t) THEN
  1404. SemError(214) END;
  1405. MGen.Jz(endL);;
  1406. Expect(40);
  1407. StatSeq;
  1408. Expect(12);
  1409. MGen.Jmp(topL);
  1410. MGen.DefLabel(endL);;
  1411. END WhileStat;
  1412. PROCEDURE CaseStat;
  1413. VAR st: SymTab.TypeIndex;
  1414. lxS: MGen.LitStr;
  1415. vS: BOOLEAN;
  1416. vnS: SymTab.Name;
  1417. tmp, endL: INTEGER;
  1418. BEGIN
  1419. Expect(37);
  1420. Expr(st, lxS, vS, vnS);
  1421. tmp := MGen.TempGlobal();
  1422. MGen.StoreTemp(tmp);
  1423. endL := MGen.NewLabel();;
  1424. Expect(26);
  1425. Case(st, tmp, endL);
  1426. WHILE (sym = 38) DO
  1427. Get;
  1428. Case(st, tmp, endL);
  1429. END;
  1430. IF (sym = 36) THEN
  1431. Get;
  1432. StatSeq;
  1433. END;
  1434. Expect(12);
  1435. MGen.DefLabel(endL);;
  1436. END CaseStat;
  1437. PROCEDURE IfStat;
  1438. VAR t: SymTab.TypeIndex;
  1439. lxC: MGen.LitStr;
  1440. vC: BOOLEAN;
  1441. vnC: SymTab.Name;
  1442. elseL, endL: INTEGER;
  1443. hasElse: BOOLEAN;
  1444. BEGIN
  1445. Expect(33);
  1446. Expr(t, lxC, vC, vnC);
  1447. IF ~SymTab.BoolCheck(t) THEN
  1448. SemError(214) END;
  1449. elseL := MGen.NewLabel();
  1450. endL := MGen.NewLabel();
  1451. MGen.Jz(elseL);
  1452. hasElse := FALSE;;
  1453. Expect(34);
  1454. StatSeq;
  1455. WHILE (sym = 35) DO
  1456. Get;
  1457. MGen.Jmp(endL);
  1458. MGen.DefLabel(elseL);;
  1459. Expr(t, lxC, vC, vnC);
  1460. IF ~SymTab.BoolCheck(t) THEN
  1461. SemError(214) END;
  1462. elseL := MGen.NewLabel();
  1463. MGen.Jz(elseL);;
  1464. Expect(34);
  1465. StatSeq;
  1466. END;
  1467. IF (sym = 36) THEN
  1468. Get;
  1469. MGen.Jmp(endL);
  1470. MGen.DefLabel(elseL);
  1471. hasElse := TRUE;;
  1472. StatSeq;
  1473. END;
  1474. Expect(12);
  1475. IF ~hasElse THEN
  1476. MGen.DefLabel(elseL)
  1477. END;
  1478. MGen.DefLabel(endL);;
  1479. END IfStat;
  1480. PROCEDURE AssignOrCall;
  1481. VAR dt, et: SymTab.TypeIndex;
  1482. dk: INTEGER;
  1483. bn: SymTab.Name;
  1484. lxD, lxe: MGen.LitStr;
  1485. vE: BOOLEAN;
  1486. vnE: SymTab.Name;
  1487. sfx: BOOLEAN;
  1488. okC: BOOLEAN;
  1489. isR, conv,
  1490. storable, pushedDst,
  1491. pushedFld: BOOLEAN;
  1492. dstBytes, srcBytes: CARDINAL;
  1493. elemDt: SymTab.TypeIndex;
  1494. BEGIN
  1495. sfx := FALSE; pushedDst := FALSE;
  1496. pushedFld := FALSE;;
  1497. DesignHead(dt, dk, bn, FALSE, lxD);
  1498. IF (sym = 7) OR (sym = 22) OR (sym = 32) OR (sym = 53) THEN
  1499. DesignTail(dt, dk, bn, FALSE, lxD, sfx);
  1500. Expect(32);
  1501. storable :=
  1502. (dk = SymTab.KindVar)
  1503. OR (dk = SymTab.KindParam)
  1504. OR (dk = SymTab.KindVarPar);
  1505. IF (dk = SymTab.KindField)
  1506. & (~sfx)
  1507. & (dt # SymTab.InvalidType) THEN
  1508. MGen.WithAddr(bn);
  1509. pushedFld := TRUE
  1510. END;
  1511. IF storable & ~sfx
  1512. & (dt # SymTab.InvalidType)
  1513. & ((SymTab.ClassOf(dt)
  1514. = SymTab.ClArray)
  1515. OR (SymTab.ClassOf(dt)
  1516. = SymTab.ClRecord)) THEN
  1517. MGen.PushAddr(bn);
  1518. pushedDst := TRUE
  1519. END;
  1520. IF storable & ~sfx
  1521. & ~pushedDst THEN
  1522. IF (dt # SymTab.InvalidType)
  1523. & (SymTab.TypeSlots(dt)
  1524. > 1) THEN
  1525. ELSE MGen.StoreSetup(bn)
  1526. END
  1527. END;;
  1528. Expr(et, lxe, vE, vnE);
  1529. IF (dt # SymTab.InvalidType)
  1530. & (dk # SymTab.KindVar)
  1531. & (dk # SymTab.KindParam)
  1532. & (dk # SymTab.KindVarPar)
  1533. & (dk # SymTab.KindField)
  1534. & (dk # SymTab.KindImport) THEN
  1535. SemError(210)
  1536. ELSIF pushedDst THEN
  1537. IF et = SymTab.InvalidType THEN
  1538. MGen.Drop; MGen.Drop
  1539. ELSIF (SymTab.ClassOf(dt)
  1540. = SymTab.ClArray)
  1541. & (SymTab.ClassOf(
  1542. SymTab.ArrayElem(dt))
  1543. = SymTab.ClChar)
  1544. & (SymTab.ClassOf(et)
  1545. = SymTab.ClStr) THEN
  1546. srcBytes :=
  1547. MGen.StrLenOf(lxe) + 1;
  1548. dstBytes :=
  1549. SymTab.TypeSlots(dt) * 8;
  1550. IF srcBytes > dstBytes THEN
  1551. SemError(210);
  1552. MGen.Drop; MGen.Drop
  1553. ELSE
  1554. MGen.PushBytes(srcBytes);
  1555. MGen.CopyBlock
  1556. END
  1557. ELSIF ~SymTab.Assignable(et,
  1558. dt) THEN
  1559. SemError(210);
  1560. MGen.Drop; MGen.Drop
  1561. ELSE
  1562. dstBytes :=
  1563. SymTab.TypeSlots(dt) * 8;
  1564. MGen.PushBytes(dstBytes);
  1565. MGen.CopyBlock
  1566. END
  1567. ELSIF pushedFld THEN
  1568. IF et = SymTab.InvalidType THEN
  1569. MGen.Drop; MGen.Drop
  1570. ELSIF (SymTab.TypeSlots(dt) > 1) THEN
  1571. IF (SymTab.ClassOf(dt)
  1572. = SymTab.ClArray)
  1573. & (SymTab.ClassOf(
  1574. SymTab.ArrayElem(dt))
  1575. = SymTab.ClChar)
  1576. & (SymTab.ClassOf(et)
  1577. = SymTab.ClStr) THEN
  1578. srcBytes :=
  1579. MGen.StrLenOf(lxe) + 1;
  1580. dstBytes :=
  1581. SymTab.TypeSlots(dt) * 8;
  1582. IF srcBytes > dstBytes THEN
  1583. SemError(210);
  1584. MGen.Drop; MGen.Drop
  1585. ELSE
  1586. MGen.PushBytes(srcBytes);
  1587. MGen.CopyBlock
  1588. END
  1589. ELSIF ~SymTab.Assignable(et,
  1590. dt) THEN
  1591. SemError(210);
  1592. MGen.Drop; MGen.Drop
  1593. ELSE
  1594. dstBytes :=
  1595. SymTab.TypeSlots(dt) * 8;
  1596. MGen.PushBytes(dstBytes);
  1597. MGen.CopyBlock
  1598. END
  1599. ELSE
  1600. IF ~SymTab.Assignable(et,
  1601. dt) THEN
  1602. SemError(210);
  1603. MGen.Drop; MGen.Drop
  1604. ELSE
  1605. isR :=
  1606. (SymTab.ClassOf(dt)
  1607. = SymTab.ClReal);
  1608. conv := isR
  1609. & SymTab.IsIntFamily(et);
  1610. IF conv THEN
  1611. MGen.IntToReal
  1612. END;
  1613. IF (SymTab.ClassOf(dt)
  1614. = SymTab.ClChar)
  1615. OR (SymTab.ClassOf(dt)
  1616. = SymTab.ClBool) THEN
  1617. MGen.StoreByte
  1618. ELSE MGen.StoreIndir0
  1619. END
  1620. END
  1621. END
  1622. ELSIF (dt # SymTab.InvalidType)
  1623. & ~sfx
  1624. & (SymTab.TypeSlots(dt) > 1) THEN
  1625. IF ~SymTab.Assignable(et, dt) THEN
  1626. SemError(210)
  1627. ELSE SemError(230)
  1628. END
  1629. ELSIF ~SymTab.Assignable(et, dt) THEN
  1630. SemError(210) END;
  1631. IF dk = SymTab.KindImport THEN
  1632. SemError(230)
  1633. END;
  1634. isR := (dt # SymTab.InvalidType)
  1635. & ~pushedDst
  1636. & ~pushedFld
  1637. & (SymTab.ClassOf(dt)
  1638. = SymTab.ClReal);
  1639. conv := isR
  1640. & SymTab.IsIntFamily(et);
  1641. IF pushedDst THEN
  1642. ELSIF pushedFld THEN
  1643. ELSIF (dt # SymTab.InvalidType)
  1644. & sfx THEN
  1645. IF conv THEN
  1646. MGen.IntToReal
  1647. END;
  1648. IF (SymTab.ClassOf(dt)
  1649. = SymTab.ClChar)
  1650. OR (SymTab.ClassOf(dt)
  1651. = SymTab.ClBool) THEN
  1652. MGen.StoreByte
  1653. ELSE MGen.StoreIndir0
  1654. END
  1655. ELSIF storable & ~sfx THEN
  1656. IF (dt # SymTab.InvalidType)
  1657. & (SymTab.TypeSlots(dt)
  1658. > 1) THEN
  1659. MGen.Drop
  1660. ELSE
  1661. IF conv THEN
  1662. MGen.IntToReal
  1663. END;
  1664. MGen.StoreFinish(bn)
  1665. END
  1666. ELSE MGen.Drop
  1667. END;;
  1668. ELSIF (sym = 19) THEN
  1669. CallTail(bn, sfx, FALSE, okC, FALSE);
  1670. ELSIF In(symSet[3], sym) THEN
  1671. MGen.ActBegin(bn);
  1672. IF MGen.ActEnd(bn, FALSE, FALSE) # 0 THEN
  1673. SemError(233)
  1674. END;;
  1675. ELSE SynError(80);
  1676. END;
  1677. END AssignOrCall;
  1678. PROCEDURE Stat;
  1679. VAR lx: INTEGER;
  1680. BEGIN
  1681. IF In(symSet[4], sym) THEN
  1682. CASE sym OF
  1683. 1 :
  1684. AssignOrCall;
  1685. | 33 :
  1686. IfStat;
  1687. | 37 :
  1688. CaseStat;
  1689. | 39 :
  1690. WhileStat;
  1691. | 41 :
  1692. RepeatStat;
  1693. | 43 :
  1694. LoopStat;
  1695. | 44 :
  1696. ForStat;
  1697. | 47 :
  1698. WithStat;
  1699. | 48 :
  1700. ReturnStat;
  1701. | 49 :
  1702. NewStat;
  1703. | 50 :
  1704. DispStat;
  1705. | 51 :
  1706. WriteIntStat;
  1707. | 52 :
  1708. WriteStrStat;
  1709. | 31 :
  1710. Get;
  1711. IF MGen.TopLoop(lx) THEN
  1712. MGen.Jmp(lx)
  1713. ELSE SemError(230) END;;
  1714. END;
  1715. END;
  1716. END Stat;
  1717. PROCEDURE FieldIdents (rt: SymTab.TypeIndex);
  1718. VAR n: SymTab.Name;
  1719. BEGIN
  1720. GetIdent(n);
  1721. IF ~SymTab.FieldPending(rt, n)
  1722. THEN SemError(200) END;
  1723. WHILE (sym = 10) DO
  1724. Get;
  1725. GetIdent(n);
  1726. IF ~SymTab.FieldPending(rt, n)
  1727. THEN SemError(200) END;
  1728. END;
  1729. END FieldIdents;
  1730. PROCEDURE Field (rt: SymTab.TypeIndex);
  1731. VAR et: SymTab.TypeIndex;
  1732. BEGIN
  1733. IF (sym = 1) THEN
  1734. FieldIdents(rt);
  1735. Expect(17);
  1736. Type(et);
  1737. IF (et # SymTab.InvalidType)
  1738. & SymTab.IsOpen(et) THEN
  1739. SemError(230)
  1740. END;
  1741. SymTab.FixPendingF(rt, et);;
  1742. END;
  1743. END Field;
  1744. PROCEDURE FieldSeq (rt: SymTab.TypeIndex);
  1745. BEGIN
  1746. Field(rt);
  1747. WHILE (sym = 6) DO
  1748. Get;
  1749. Field(rt);
  1750. END;
  1751. END FieldSeq;
  1752. PROCEDURE Enum (VAR t: SymTab.TypeIndex);
  1753. VAR n: SymTab.Name;
  1754. ord: INTEGER;
  1755. BEGIN
  1756. Expect(19);
  1757. t := SymTab.NewEnum();
  1758. ord := 0;;
  1759. GetIdent(n);
  1760. IF ~SymTab.Enter(n,
  1761. SymTab.KindConst)
  1762. THEN SemError(200) END;
  1763. SymTab.SetSymType(n, t);
  1764. SymTab.EnumAdd(t);
  1765. MGen.DeclConstInt(n, ord);
  1766. INC(ord);;
  1767. WHILE (sym = 10) DO
  1768. Get;
  1769. GetIdent(n);
  1770. IF ~SymTab.Enter(n,
  1771. SymTab.KindConst)
  1772. THEN SemError(200) END;
  1773. SymTab.SetSymType(n, t);
  1774. SymTab.EnumAdd(t);
  1775. MGen.DeclConstInt(n, ord);
  1776. INC(ord);;
  1777. END;
  1778. Expect(20);
  1779. END Enum;
  1780. PROCEDURE PointerType (VAR t: SymTab.TypeIndex);
  1781. VAR b: SymTab.TypeIndex;
  1782. BEGIN
  1783. Expect(29);
  1784. Expect(30);
  1785. Type(b);
  1786. t := SymTab.NewPtr(b);;
  1787. END PointerType;
  1788. PROCEDURE SetType (VAR t: SymTab.TypeIndex);
  1789. VAR s: SymTab.TypeIndex;
  1790. BEGIN
  1791. Expect(28);
  1792. Expect(26);
  1793. SimpleType(s);
  1794. IF (s # SymTab.InvalidType)
  1795. & (SymTab.ClassOf(s) #
  1796. SymTab.ClInt)
  1797. & (SymTab.ClassOf(s) #
  1798. SymTab.ClChar)
  1799. & (SymTab.ClassOf(s) #
  1800. SymTab.ClEnum) THEN
  1801. SemError(224) END;
  1802. t := SymTab.NewSet(s);;
  1803. END SetType;
  1804. PROCEDURE RecordType (VAR t: SymTab.TypeIndex);
  1805. BEGIN
  1806. Expect(27);
  1807. t := SymTab.NewRecord();;
  1808. FieldSeq(t);
  1809. Expect(12);
  1810. END RecordType;
  1811. PROCEDURE ArrayType (VAR t: SymTab.TypeIndex);
  1812. VAR s, s2, e: SymTab.TypeIndex;
  1813. idx: ARRAY [0 .. 7] OF
  1814. SymTab.TypeIndex;
  1815. nc, kk: CARDINAL;
  1816. loA, hiA: INTEGER;
  1817. isOpenA: BOOLEAN;
  1818. BEGIN
  1819. Expect(25);
  1820. IF (sym = 1) OR (sym = 19) OR (sym = 22) OR (sym = 26) THEN
  1821. IF (sym = 1) OR (sym = 19) OR (sym = 22) THEN
  1822. SimpleType(s);
  1823. IF (s # SymTab.InvalidType)
  1824. & (SymTab.ClassOf(s) #
  1825. SymTab.ClInt)
  1826. & (SymTab.ClassOf(s) #
  1827. SymTab.ClChar)
  1828. & (SymTab.ClassOf(s) #
  1829. SymTab.ClEnum) THEN
  1830. SemError(224) END;
  1831. nc := 0; isOpenA := FALSE;
  1832. idx[nc] := s; INC(nc);;
  1833. WHILE (sym = 10) DO
  1834. Get;
  1835. SimpleType(s2);
  1836. IF (s2 # SymTab.InvalidType)
  1837. & (SymTab.ClassOf(s2) #
  1838. SymTab.ClInt)
  1839. & (SymTab.ClassOf(s2) #
  1840. SymTab.ClChar)
  1841. & (SymTab.ClassOf(s2) #
  1842. SymTab.ClEnum) THEN
  1843. SemError(224) END;
  1844. IF nc <= HIGH(idx) THEN
  1845. idx[nc] := s2; INC(nc)
  1846. END;;
  1847. END;
  1848. ELSE
  1849. nc := 0; isOpenA := TRUE;;
  1850. END;
  1851. END;
  1852. Expect(26);
  1853. Type(e);
  1854. IF isOpenA THEN
  1855. t := SymTab.NewOpen(e)
  1856. ELSE
  1857. t := e;
  1858. kk := nc;
  1859. WHILE kk > 0 DO
  1860. DEC(kk);
  1861. loA := SymTab.TypeLo(idx[kk]);
  1862. hiA := SymTab.TypeHi(idx[kk]);
  1863. IF SymTab.TypeLen(idx[kk]) = 0 THEN
  1864. IF idx[kk]
  1865. # SymTab.InvalidType THEN
  1866. SemError(230)
  1867. END;
  1868. loA := 0; hiA := -1
  1869. END;
  1870. t := SymTab.NewArrayB(t,
  1871. loA, hiA)
  1872. END
  1873. END;;
  1874. END ArrayType;
  1875. PROCEDURE SimpleType (VAR t: SymTab.TypeIndex);
  1876. VAR t1, t2: SymTab.TypeIndex;
  1877. lx1, lx2: MGen.LitStr;
  1878. vD: BOOLEAN;
  1879. vnD: SymTab.Name;
  1880. loI, hiI: INTEGER;
  1881. lok, hik: BOOLEAN;
  1882. BEGIN
  1883. IF (sym = 1) THEN
  1884. QualIdent(t);
  1885. IF (sym = 22) THEN
  1886. Get;
  1887. MGen.NoEmitEnter; lok := FALSE; hik := FALSE;
  1888. loI := 0; hiI := -1;;
  1889. ConstExpr(t1, lx1);
  1890. IF (t1 # SymTab.InvalidType)
  1891. & (SymTab.ClassOf(t1) #
  1892. SymTab.ClInt)
  1893. & (SymTab.ClassOf(t1) #
  1894. SymTab.ClChar)
  1895. & (SymTab.ClassOf(t1) #
  1896. SymTab.ClEnum) THEN
  1897. SemError(224) END;;
  1898. Expect(23);
  1899. ConstExpr(t2, lx2);
  1900. IF (t2 # SymTab.InvalidType)
  1901. & (SymTab.ClassOf(t2) #
  1902. SymTab.ClInt)
  1903. & (SymTab.ClassOf(t2) #
  1904. SymTab.ClChar)
  1905. & (SymTab.ClassOf(t2) #
  1906. SymTab.ClEnum) THEN
  1907. SemError(224) END;;
  1908. Expect(24);
  1909. IF (t1 # SymTab.InvalidType)
  1910. & (t2 # SymTab.InvalidType) THEN
  1911. IF MGen.IsLit(lx1) THEN
  1912. IF SymTab.ClassOf(t1)
  1913. = SymTab.ClChar THEN
  1914. loI := MGen.CharOrd(lx1);
  1915. lok := TRUE
  1916. ELSIF MGen.ParseInt(lx1, loI) THEN
  1917. lok := TRUE
  1918. END
  1919. END;
  1920. IF MGen.IsLit(lx2) THEN
  1921. IF SymTab.ClassOf(t2)
  1922. = SymTab.ClChar THEN
  1923. hiI := MGen.CharOrd(lx2);
  1924. hik := TRUE
  1925. ELSIF MGen.ParseInt(lx2, hiI) THEN
  1926. hik := TRUE
  1927. END
  1928. END
  1929. END;
  1930. IF lok & hik THEN
  1931. t := SymTab.NewSubB(t1, loI, hiI)
  1932. ELSE
  1933. t := SymTab.NewSub(t1);
  1934. IF (t1 # SymTab.InvalidType)
  1935. & (t2 # SymTab.InvalidType) THEN
  1936. SemError(230)
  1937. END
  1938. END;
  1939. MGen.NoEmitExit;;
  1940. END;
  1941. ELSIF (sym = 22) THEN
  1942. Get;
  1943. MGen.NoEmitEnter; lok := FALSE;
  1944. hik := FALSE; loI := 0; hiI := -1;;
  1945. ConstExpr(t1, lx1);
  1946. IF (t1 # SymTab.InvalidType)
  1947. & (SymTab.ClassOf(t1) #
  1948. SymTab.ClInt)
  1949. & (SymTab.ClassOf(t1) #
  1950. SymTab.ClChar)
  1951. & (SymTab.ClassOf(t1) #
  1952. SymTab.ClEnum) THEN
  1953. SemError(224) END;;
  1954. Expect(23);
  1955. ConstExpr(t2, lx2);
  1956. IF (t2 # SymTab.InvalidType)
  1957. & (SymTab.ClassOf(t2) #
  1958. SymTab.ClInt)
  1959. & (SymTab.ClassOf(t2) #
  1960. SymTab.ClChar)
  1961. & (SymTab.ClassOf(t2) #
  1962. SymTab.ClEnum) THEN
  1963. SemError(224) END;;
  1964. Expect(24);
  1965. IF (t1 # SymTab.InvalidType)
  1966. & (t2 # SymTab.InvalidType) THEN
  1967. IF MGen.IsLit(lx1) THEN
  1968. IF SymTab.ClassOf(t1)
  1969. = SymTab.ClChar THEN
  1970. loI := MGen.CharOrd(lx1);
  1971. lok := TRUE
  1972. ELSIF MGen.ParseInt(lx1,
  1973. loI) THEN
  1974. lok := TRUE
  1975. END
  1976. END;
  1977. IF MGen.IsLit(lx2) THEN
  1978. IF SymTab.ClassOf(t2)
  1979. = SymTab.ClChar THEN
  1980. hiI := MGen.CharOrd(lx2);
  1981. hik := TRUE
  1982. ELSIF MGen.ParseInt(lx2,
  1983. hiI) THEN
  1984. hik := TRUE
  1985. END
  1986. END
  1987. END;
  1988. IF lok & hik THEN
  1989. t := SymTab.NewSubB(t1, loI, hiI)
  1990. ELSE
  1991. t := SymTab.NewSub(t1);
  1992. IF (t1 # SymTab.InvalidType)
  1993. & (t2 # SymTab.InvalidType) THEN
  1994. SemError(230)
  1995. END
  1996. END;
  1997. MGen.NoEmitExit;;
  1998. ELSIF (sym = 19) THEN
  1999. Enum(t);
  2000. ELSE SynError(81);
  2001. END;
  2002. END SimpleType;
  2003. PROCEDURE FPSection;
  2004. VAR isV: BOOLEAN;
  2005. nn, i: CARDINAL;
  2006. pn: ARRAY [0 .. 15] OF SymTab.Name;
  2007. n: SymTab.Name;
  2008. t: SymTab.TypeIndex;
  2009. BEGIN
  2010. isV := FALSE; nn := 0;;
  2011. IF (sym = 15) THEN
  2012. Get;
  2013. isV := TRUE;;
  2014. END;
  2015. GetIdent(n);
  2016. IF nn <= HIGH(pn) THEN
  2017. MGen.CopyName(n, pn[nn])
  2018. END;
  2019. INC(nn);;
  2020. WHILE (sym = 10) DO
  2021. Get;
  2022. GetIdent(n);
  2023. IF nn <= HIGH(pn) THEN
  2024. MGen.CopyName(n, pn[nn])
  2025. END;
  2026. INC(nn);;
  2027. END;
  2028. Expect(17);
  2029. Type(t);
  2030. IF ~isV
  2031. & (t # SymTab.InvalidType)
  2032. & (SymTab.TypeSlots(t) > 1) THEN
  2033. SemError(230)
  2034. END;
  2035. i := 0;
  2036. WHILE i < nn DO
  2037. IF i <= HIGH(pn) THEN
  2038. IF ~SymTab.EnterParam(
  2039. pn[i], isV, t) THEN
  2040. SemError(200)
  2041. END
  2042. END;
  2043. INC(i)
  2044. END;;
  2045. END FPSection;
  2046. PROCEDURE QualIdent (VAR t: SymTab.TypeIndex);
  2047. VAR n, m: SymTab.Name;
  2048. BEGIN
  2049. GetIdent(n);
  2050. IF ~SymTab.Lookup(n) THEN
  2051. SemError(201);
  2052. t := SymTab.InvalidType
  2053. ELSIF (SymTab.SymKind(n) #
  2054. SymTab.KindType)
  2055. & (SymTab.SymKind(n) #
  2056. SymTab.KindPredef)
  2057. & (SymTab.SymKind(n) #
  2058. SymTab.KindImport) THEN
  2059. SemError(221);
  2060. t := SymTab.InvalidType
  2061. ELSE t := SymTab.SymType(n) END;;
  2062. WHILE (sym = 7) DO
  2063. Get;
  2064. GetIdent(m);
  2065. t := SymTab.InvalidType;;
  2066. END;
  2067. END QualIdent;
  2068. PROCEDURE FormalParams;
  2069. BEGIN
  2070. FPSection;
  2071. WHILE (sym = 6) DO
  2072. Get;
  2073. FPSection;
  2074. END;
  2075. END FormalParams;
  2076. PROCEDURE VarIdents;
  2077. VAR n: SymTab.Name;
  2078. BEGIN
  2079. GetIdent(n);
  2080. IF ~SymTab.EnterPending(n,
  2081. SymTab.KindVar)
  2082. THEN SemError(200) END;
  2083. WHILE (sym = 10) DO
  2084. Get;
  2085. GetIdent(n);
  2086. IF ~SymTab.EnterPending(n,
  2087. SymTab.KindVar)
  2088. THEN SemError(200) END;
  2089. END;
  2090. END VarIdents;
  2091. PROCEDURE Type (VAR t: SymTab.TypeIndex);
  2092. BEGIN
  2093. IF (sym = 1) OR (sym = 19) OR (sym = 22) THEN
  2094. SimpleType(t);
  2095. ELSIF (sym = 25) THEN
  2096. ArrayType(t);
  2097. ELSIF (sym = 27) THEN
  2098. RecordType(t);
  2099. ELSIF (sym = 28) THEN
  2100. SetType(t);
  2101. ELSIF (sym = 29) THEN
  2102. PointerType(t);
  2103. ELSE SynError(82);
  2104. END;
  2105. END Type;
  2106. PROCEDURE Expr (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr;
  2107. VAR v: BOOLEAN; VAR vn: SymTab.Name);
  2108. VAR t2: SymTab.TypeIndex;
  2109. tc, op: INTEGER;
  2110. lx2: MGen.LitStr;
  2111. v2: BOOLEAN;
  2112. vn2: SymTab.Name;
  2113. r: BOOLEAN;
  2114. BEGIN
  2115. SimExpr(t, lx, v, vn);
  2116. IF In(symSet[5], sym) THEN
  2117. Rel(op);
  2118. SimExpr(t2, lx2, v2, vn2);
  2119. lx[0] := 0C; v := FALSE;
  2120. IF op = SymTab.OpIn THEN
  2121. IF SymTab.InCheck(t, t2) THEN
  2122. t := SymTab.BoolType();
  2123. MGen.BitIn
  2124. ELSE SemError(222);
  2125. t := SymTab.InvalidType;
  2126. MGen.Drop; MGen.Drop; MGen.PushInt(0)
  2127. END
  2128. ELSIF (t # SymTab.InvalidType)
  2129. & (t2 # SymTab.InvalidType)
  2130. & (SymTab.ClassOf(t) = SymTab.ClArray)
  2131. & (SymTab.ClassOf(t2) = SymTab.ClArray)
  2132. & (SymTab.ClassOf(SymTab.ArrayElem(t)) = SymTab.ClChar)
  2133. & (SymTab.ClassOf(SymTab.ArrayElem(t2)) = SymTab.ClChar)
  2134. & ~SymTab.IsOpen(t) & ~SymTab.IsOpen(t2) THEN
  2135. t := SymTab.BoolType();
  2136. MGen.PushBytes(SymTab.TypeSlots(t) * 8);
  2137. MGen.PushBytes(SymTab.TypeSlots(t2) * 8);
  2138. MGen.StrComp;
  2139. IF op = SymTab.OpEq THEN MGen.Or; MGen.Not
  2140. ELSIF (op = SymTab.OpNeq1)
  2141. OR (op = SymTab.OpNeq2) THEN MGen.Or
  2142. ELSIF op = SymTab.OpLt THEN
  2143. MGen.Swap; MGen.Drop
  2144. ELSIF op = SymTab.OpLe THEN
  2145. MGen.Drop; MGen.Not
  2146. ELSIF op = SymTab.OpGt THEN
  2147. MGen.Drop
  2148. ELSE
  2149. MGen.Swap; MGen.Drop; MGen.Not
  2150. END
  2151. ELSIF (t # SymTab.InvalidType)
  2152. & (t2 # SymTab.InvalidType)
  2153. & ((SymTab.ClassOf(t) = SymTab.ClArray)
  2154. OR (SymTab.ClassOf(t) = SymTab.ClRecord)
  2155. OR (SymTab.ClassOf(t2) = SymTab.ClArray)
  2156. OR (SymTab.ClassOf(t2) = SymTab.ClRecord)) THEN
  2157. SemError(213); t := SymTab.InvalidType;
  2158. MGen.Drop; MGen.Drop; MGen.PushInt(0)
  2159. ELSE
  2160. tc := SymTab.ClassOf(t);
  2161. IF SymTab.RelCheck(t, t2, op) THEN
  2162. t := SymTab.BoolType()
  2163. ELSE SemError(213); t := SymTab.InvalidType END;
  2164. IF t # SymTab.InvalidType THEN
  2165. r := tc = SymTab.ClReal;
  2166. IF r THEN
  2167. IF op = SymTab.OpEq THEN MGen.RealEq
  2168. ELSIF (op = SymTab.OpNeq1)
  2169. OR (op = SymTab.OpNeq2) THEN MGen.RealNe
  2170. ELSIF op = SymTab.OpLt THEN MGen.RealLt
  2171. ELSIF op = SymTab.OpLe THEN MGen.RealLe
  2172. ELSIF op = SymTab.OpGt THEN MGen.RealGt
  2173. ELSE MGen.RealGe END
  2174. ELSE
  2175. IF op = SymTab.OpEq THEN MGen.Eq
  2176. ELSIF (op = SymTab.OpNeq1)
  2177. OR (op = SymTab.OpNeq2) THEN MGen.Neq
  2178. ELSIF op = SymTab.OpLt THEN MGen.ILt
  2179. ELSIF op = SymTab.OpLe THEN MGen.ILe
  2180. ELSIF op = SymTab.OpGt THEN MGen.IGt
  2181. ELSE MGen.IGe END
  2182. END
  2183. ELSE MGen.Drop; MGen.Drop; MGen.PushInt(0)
  2184. END
  2185. END;;
  2186. END;
  2187. END Expr;
  2188. PROCEDURE ConstExpr (VAR t: SymTab.TypeIndex; VAR lx: MGen.LitStr);
  2189. VAR vD: BOOLEAN;
  2190. vnD: SymTab.Name;
  2191. BEGIN
  2192. Expr(t, lx, vD, vnD);
  2193. END ConstExpr;
  2194. PROCEDURE ProcedureDecl;
  2195. VAR n, m: SymTab.Name;
  2196. rt: SymTab.TypeIndex;
  2197. hasR, ok: BOOLEAN;
  2198. endL: INTEGER;
  2199. BEGIN
  2200. Expect(18);
  2201. hasR := FALSE;;
  2202. GetIdent(n);
  2203. IF SymTab.IsForward(n) THEN
  2204. SymTab.ReuseProc(n)
  2205. ELSIF ~SymTab.EnterProc(n) THEN
  2206. SemError(200)
  2207. END;
  2208. SymTab.OpenProcScope;
  2209. endL := MGen.NewLabel();
  2210. MGen.Jmp(endL);;
  2211. IF (sym = 19) THEN
  2212. Get;
  2213. FormalParams;
  2214. Expect(20);
  2215. END;
  2216. IF (sym = 17) THEN
  2217. Get;
  2218. QualIdent(rt);
  2219. hasR := TRUE;;
  2220. END;
  2221. IF hasR THEN
  2222. ok := SymTab.SetProcRet(rt)
  2223. ELSE
  2224. ok := SymTab.SetProcRet(
  2225. SymTab.InvalidType)
  2226. END;
  2227. IF ~ok THEN SemError(231) END;
  2228. IF ~SymTab.VerifyProc() THEN
  2229. SemError(231)
  2230. END;;
  2231. Expect(6);
  2232. IF In(symSet[6], sym) THEN
  2233. Block(TRUE);
  2234. GetIdent(m);
  2235. IF ~SymTab.Equal(n, m) THEN
  2236. SemError(202) END;
  2237. MGen.DefLabel(endL);
  2238. SymTab.CloseProc;;
  2239. ELSIF (sym = 21) THEN
  2240. Get;
  2241. SymTab.SetForward;
  2242. SymTab.CloseProc;
  2243. MGen.DefLabel(endL);;
  2244. ELSE SynError(83);
  2245. END;
  2246. END ProcedureDecl;
  2247. PROCEDURE VarDecl;
  2248. VAR t: SymTab.TypeIndex;
  2249. i: CARDINAL;
  2250. nm: SymTab.Name;
  2251. cls: INTEGER;
  2252. sl: CARDINAL;
  2253. BEGIN
  2254. VarIdents;
  2255. Expect(17);
  2256. Type(t);
  2257. cls := SymTab.ClassOf(t);
  2258. IF (cls # SymTab.ClInt)
  2259. & (cls # SymTab.ClReal)
  2260. & (cls # SymTab.ClBool)
  2261. & (cls # SymTab.ClChar)
  2262. & (cls # SymTab.ClEnum)
  2263. & (cls # SymTab.ClSet)
  2264. & (cls # SymTab.ClArray)
  2265. & (cls # SymTab.ClRecord)
  2266. & (cls # SymTab.ClPtr) THEN
  2267. SemError(230)
  2268. END;
  2269. sl := SymTab.TypeSlots(t);
  2270. IF sl = 0 THEN
  2271. SemError(230);
  2272. sl := 1
  2273. END;
  2274. i := 0;
  2275. WHILE i < SymTab.PendCount() DO
  2276. SymTab.PendName(i, nm);
  2277. IF SymTab.SymDepth(nm) = 0 THEN
  2278. MGen.DeclVarSized(nm, sl)
  2279. END;
  2280. INC(i)
  2281. END;
  2282. SymTab.FixPending(t);;
  2283. END VarDecl;
  2284. PROCEDURE TypeDecl;
  2285. VAR n: SymTab.Name;
  2286. t0, t1: SymTab.TypeIndex;
  2287. BEGIN
  2288. GetIdent(n);
  2289. IF ~SymTab.Enter(n, SymTab.KindType)
  2290. THEN SemError(200) END;
  2291. t0 := SymTab.NewAlias();
  2292. SymTab.SetSymType(n, t0);;
  2293. Expect(16);
  2294. Type(t1);
  2295. IF t1 = t0 THEN SemError(223);
  2296. SymTab.SetTarget(t0,
  2297. SymTab.InvalidType)
  2298. ELSE SymTab.SetTarget(t0, t1) END;;
  2299. END TypeDecl;
  2300. PROCEDURE ConstDecl;
  2301. VAR n: SymTab.Name;
  2302. t: SymTab.TypeIndex;
  2303. lx: MGen.LitStr;
  2304. cls: INTEGER;
  2305. BEGIN
  2306. GetIdent(n);
  2307. IF ~SymTab.Enter(n, SymTab.KindConst)
  2308. THEN SemError(200) END;
  2309. Expect(16);
  2310. MGen.NoEmitEnter;;
  2311. ConstExpr(t, lx);
  2312. SymTab.SetSymType(n, t);
  2313. cls := SymTab.ClassOf(t);
  2314. IF cls = SymTab.ClStr THEN
  2315. SemError(230)
  2316. ELSIF ~MGen.IsLit(lx) THEN
  2317. SemError(230)
  2318. END;
  2319. MGen.DeclConst(n, lx, t);
  2320. MGen.NoEmitExit;;
  2321. END ConstDecl;
  2322. PROCEDURE StatSeq;
  2323. BEGIN
  2324. Stat;
  2325. WHILE (sym = 6) DO
  2326. Get;
  2327. Stat;
  2328. END;
  2329. END StatSeq;
  2330. PROCEDURE Declaration;
  2331. BEGIN
  2332. IF (sym = 13) THEN
  2333. Get;
  2334. WHILE (sym = 1) DO
  2335. ConstDecl;
  2336. Expect(6);
  2337. END;
  2338. ELSIF (sym = 14) THEN
  2339. Get;
  2340. WHILE (sym = 1) DO
  2341. TypeDecl;
  2342. Expect(6);
  2343. END;
  2344. ELSIF (sym = 15) THEN
  2345. Get;
  2346. WHILE (sym = 1) DO
  2347. VarDecl;
  2348. Expect(6);
  2349. END;
  2350. ELSIF (sym = 18) THEN
  2351. ProcedureDecl;
  2352. Expect(6);
  2353. ELSE SynError(84);
  2354. END;
  2355. END Declaration;
  2356. PROCEDURE ImportList;
  2357. VAR n: SymTab.Name;
  2358. BEGIN
  2359. GetIdent(n);
  2360. IF ~SymTab.Enter(n, SymTab.KindImport)
  2361. THEN SemError(200) END;
  2362. WHILE (sym = 10) DO
  2363. Get;
  2364. GetIdent(n);
  2365. IF ~SymTab.Enter(n, SymTab.KindImport)
  2366. THEN SemError(200) END;
  2367. END;
  2368. END ImportList;
  2369. PROCEDURE Block (isProc: BOOLEAN);
  2370. VAR began: BOOLEAN;
  2371. BEGIN
  2372. began := FALSE;;
  2373. WHILE (sym = 13) OR (sym = 14) OR (sym = 15) OR (sym = 18) DO
  2374. Declaration;
  2375. END;
  2376. IF (sym = 11) THEN
  2377. Get;
  2378. began := TRUE;
  2379. IF isProc THEN
  2380. MGen.ProcEntry(
  2381. SymTab.CurProc(),
  2382. SymTab.ProcNLocals())
  2383. ELSE MGen.BeginBody
  2384. END;;
  2385. StatSeq;
  2386. END;
  2387. Expect(12);
  2388. IF isProc THEN
  2389. IF ~began THEN
  2390. MGen.ProcEntry(
  2391. SymTab.CurProc(),
  2392. SymTab.ProcNLocals())
  2393. END;
  2394. IF SymTab.InFunction() THEN
  2395. MGen.PushInt(0)
  2396. END;
  2397. MGen.Leave(SymTab.CurNPar(),
  2398. SymTab.InFunction())
  2399. END;;
  2400. END Block;
  2401. PROCEDURE Import;
  2402. VAR n: SymTab.Name;
  2403. BEGIN
  2404. IF (sym = 8) THEN
  2405. Get;
  2406. GetIdent(n);
  2407. IF ~SymTab.Enter(n, SymTab.KindImport)
  2408. THEN SemError(200) END;
  2409. Expect(9);
  2410. ImportList;
  2411. Expect(6);
  2412. ELSIF (sym = 9) THEN
  2413. Get;
  2414. ImportList;
  2415. Expect(6);
  2416. ELSE SynError(85);
  2417. END;
  2418. END Import;
  2419. PROCEDURE GetIdent (VAR n: SymTab.Name);
  2420. BEGIN
  2421. Expect(1);
  2422. LexName(n);;
  2423. END GetIdent;
  2424. PROCEDURE M2c;
  2425. VAR m1, m2: SymTab.Name;
  2426. BEGIN
  2427. Expect(5);
  2428. GetIdent(m1);
  2429. SymTab.Init; MGen.OpenModule(m1);
  2430. IF ~SymTab.Enter(m1, SymTab.KindModule)
  2431. THEN SemError(200) END;
  2432. Expect(6);
  2433. WHILE (sym = 8) OR (sym = 9) DO
  2434. Import;
  2435. END;
  2436. Block(FALSE);
  2437. GetIdent(m2);
  2438. IF ~SymTab.Equal(m1, m2)
  2439. THEN SemError(202) END;
  2440. Expect(7);
  2441. IF SymTab.AnyForward() THEN
  2442. SemError(231)
  2443. END;
  2444. MGen.EndModule;
  2445. SymTab.PrintTable;;
  2446. END M2c;
  2447. PROCEDURE Parse;
  2448. BEGIN
  2449. M2cS.Reset; Get;
  2450. M2c;
  2451. END Parse;
  2452. BEGIN
  2453. errDist := minErrDist;
  2454. symSet[ 0, 0] := BITSET{0};
  2455. symSet[ 0, 1] := BITSET{};
  2456. symSet[ 0, 2] := BITSET{};
  2457. symSet[ 0, 3] := BITSET{};
  2458. symSet[ 0, 4] := BITSET{};
  2459. symSet[ 1, 0] := BITSET{1, 2, 3, 4};
  2460. symSet[ 1, 1] := BITSET{3};
  2461. symSet[ 1, 2] := BITSET{14};
  2462. symSet[ 1, 3] := BITSET{13};
  2463. symSet[ 1, 4] := BITSET{5, 6, 7, 8};
  2464. symSet[ 2, 0] := BITSET{};
  2465. symSet[ 2, 1] := BITSET{};
  2466. symSet[ 2, 2] := BITSET{};
  2467. symSet[ 2, 3] := BITSET{15};
  2468. symSet[ 2, 4] := BITSET{0, 1, 2, 3, 4};
  2469. symSet[ 3, 0] := BITSET{6, 12};
  2470. symSet[ 3, 1] := BITSET{};
  2471. symSet[ 3, 2] := BITSET{3, 4, 6, 10};
  2472. symSet[ 3, 3] := BITSET{};
  2473. symSet[ 3, 4] := BITSET{};
  2474. symSet[ 4, 0] := BITSET{1};
  2475. symSet[ 4, 1] := BITSET{15};
  2476. symSet[ 4, 2] := BITSET{1, 5, 7, 9, 11, 12, 15};
  2477. symSet[ 4, 3] := BITSET{0, 1, 2, 3, 4};
  2478. symSet[ 4, 4] := BITSET{};
  2479. symSet[ 5, 0] := BITSET{};
  2480. symSet[ 5, 1] := BITSET{0};
  2481. symSet[ 5, 2] := BITSET{};
  2482. symSet[ 5, 3] := BITSET{6, 7, 8, 9, 10, 11, 12};
  2483. symSet[ 5, 4] := BITSET{};
  2484. symSet[ 6, 0] := BITSET{11, 12, 13, 14, 15};
  2485. symSet[ 6, 1] := BITSET{2};
  2486. symSet[ 6, 2] := BITSET{};
  2487. symSet[ 6, 3] := BITSET{};
  2488. symSet[ 6, 4] := BITSET{};
  2489. END M2cP.