M2cP.mod 66 KB

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