EXPRESS.MOD 65 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490
  1. (* EXPRESS.MOD — DRAFT v1, assembled 2026-10-02, NOT verified.
  2. Reconstructed from Reversing-Turbo-Modula2-main/MCode_disassembly/express.txt
  3. (3898 lines) by three parallel passes (groups 1 @004a-0358, 2 @0358-0c0c,
  4. 3 @0bd2-1516). Does NOT yet recompile to the original MCD; verification
  5. via unassemble.c diff is still required (see src/compiler/README.md).
  6. Descriptor model (reconciled): one 10-word operand descriptor. Groups used
  7. three notations for it — group1 named fields, groups 2/3 numeric (.wordN /
  8. [N]) — unified here as Desc with both: named fields AND a raw words view.
  9. word0=typ, word1=mode (0=const,1=?,2=computed), word2=value, word3=extra,
  10. word4=kind/class, word5=low, word6=high, words7-9=w7..w9.
  11. Globals: word2 curDesc, word3 spillTop, word4 spillFlag, word6 constMode,
  12. word7 spare7 (use TBD), word8 assignActive, word9 exprPool.
  13. NOTE: group1's words 3/4 (exprSpare3/exprFlag4, heap-top bookkeeping) and
  14. groups 2/3's words 3/4 (spill save slots) are unified as spillTop/spillFlag;
  15. both readings involve saving a top — MCD diff decides.
  16. Frame mechanics (proven 2026-10-03 from MCode_specification/Stack.mod:
  17. NewFrame puts fp^[3]=LAST pushed word; opcode 03H=LoadParam(3) printed
  18. as "param1"): "param1" = LAST pushed word, so multi-param body readings
  19. assuming param1=formal1 are backwards; call sites from pushes stay
  20. order-correct. Applied: MatchOpClass(allowed, errCode) [was swapped],
  21. CentralError(ok, code) [was 1-param]. Full per-proc signature audit PENDING.
  22. Numbered-module mappings applied (verified against .DEF orders):
  23. - Compiler.IntType..26 = IntType..compilationActive (DEF order = word order).
  24. - Scanner.scanOpt/5/6/7/8/9/10/11/12 = scanOptions/curSymbol/isLiteral/
  25. cardValue/curNode/identKind/followSet/tokenBuffer/literalType.
  26. Scanner.word13: unknown, kept + FIXME.
  27. - CodeGen.word5 = emitEnabled. Doubles.qcp/6/7/8/9/11 =
  28. qcp/qadd/qsub/qmul/qdiv/qneg (DEF order = proc order).
  29. - Single-arg BaseTypeOf(X) calls = TypeKindOf (proc27); two-arg keeps
  30. BaseTypeOf (proc34). ParseCondValue() = BoolCondHelper (proc12).
  31. - Errors.ReportErrorWithText 3rd args were HIGH() bounds — stripped.
  32. Newly discovered EXPRESS-internal procedures (not in FRONTEND.md map):
  33. proc1 CentralError, proc2/3 PushOperand/PopOperand, proc6 EmitOp,
  34. proc10 NormalizeOperand, proc11 LoadIndirect, proc12 BoolCondHelper,
  35. proc22 CheckAndStore, proc25 GetRangeBase, proc26 IsPointer,
  36. proc27 TypeKindOf, proc28 EmitAddress, proc29 ParseActualList,
  37. proc31 EmitIndexed, AAAAAA = Z80 stubs. Declared FORWARD = work list.
  38. Pass1.CondInsert/InsertEntry referenced but PASS1 has no source yet.
  39. Known invalid-but-faithful constructs (pun notes, verification must resolve):
  40. CARDINAL<->BITSET/ADDRESS punning, CARDINAL word3/word5 arithmetic on
  41. type nodes, BITSET{51..57}-style membership tests on CARDINAL curSymbol,
  42. CARDINAL class masks passed as BITSET, LONGREAL double-word puns
  43. (marked FIXME-LONGREAL), raw STACK[n]/FRAME^.tag reads kept verbatim. *)
  44. IMPLEMENTATION MODULE Express;
  45. IMPORT Compiler, Scanner, Errors, CodeGen, SymTab, Pass1, Doubles;
  46. FROM SYSTEM IMPORT ADDRESS, ADR, MOVE, WORD;
  47. (* 10-word operand descriptor: named view + raw words view (same layout). *)
  48. TYPE DescPtr = POINTER TO Desc;
  49. Desc = RECORD
  50. CASE : BOOLEAN OF
  51. | TRUE:
  52. typ: ADDRESS; (* word0: type descriptor *)
  53. mode: CARDINAL; (* word1: 0=const *)
  54. value: CARDINAL; (* word2: const value / offset *)
  55. extra: CARDINAL; (* word3 *)
  56. kind: CARDINAL; (* word4: type class tag *)
  57. low: CARDINAL; (* word5 *)
  58. high: CARDINAL; (* word6 *)
  59. w7: CARDINAL;
  60. w8: CARDINAL;
  61. w9: CARDINAL;
  62. | FALSE:
  63. raw: ARRAY [0..9] OF WORD;
  64. END;
  65. END;
  66. Words = POINTER TO ARRAY [0..9] OF WORD;
  67. VAR
  68. curDesc: Desc; (* word2: current operand descriptor *)
  69. spillTop: CARDINAL; (* word3 *)
  70. spillFlag: CARDINAL; (* word4 *)
  71. constMode: CARDINAL; (* word6 *)
  72. spare7: CARDINAL; (* word7: use TBD *)
  73. assignActive: CARDINAL; (* word8 *)
  74. exprPool: ADDRESS; (* word9 *)
  75. (* ---- unresolved EXPRESS-internal helpers: FORWARD = work list ---- *)
  76. PROCEDURE CentralError(ok: BOOLEAN; code: CARDINAL); FORWARD; (* proc1: proven (cond, code) via STMT @058a [bool,20] frame evidence; 1-arg call sites below need re-read *)
  77. (*FIXME-NYC*) PROCEDURE PushOperand; FORWARD; (* proc2 *)
  78. (*FIXME-NYC*) PROCEDURE PopOperand; FORWARD; (* proc3 *)
  79. (*FIXME-NYC*) PROCEDURE EmitOp; FORWARD; (* proc6 *)
  80. (*FIXME-NYC*) PROCEDURE NormalizeOperand; FORWARD; (* proc10 *)
  81. (*FIXME-NYC*) PROCEDURE LoadIndirect; FORWARD; (* proc11 *)
  82. (*FIXME-NYC*) PROCEDURE BoolCondHelper; FORWARD; (* proc12 *)
  83. (*FIXME-NYC*) PROCEDURE CheckAndStore; FORWARD; (* proc22, arity TBD *)
  84. (*FIXME-NYC*) PROCEDURE GetRangeBase; FORWARD; (* proc25 *)
  85. (*FIXME-NYC*) PROCEDURE IsPointer(t: CARDINAL): BOOLEAN; FORWARD; (* proc26 *)
  86. (*FIXME-NYC*) PROCEDURE TypeKindOf(): CARDINAL; FORWARD; (* proc27 *)
  87. (*FIXME-NYC*) PROCEDURE EmitAddress; FORWARD; (* proc28 *)
  88. (*FIXME-NYC*) PROCEDURE ParseActualList; FORWARD; (* proc29 *)
  89. (*FIXME-NYC*) PROCEDURE EmitIndexed(idx: CARDINAL); FORWARD; (* proc31 *)
  90. (*FIXME-NYC*) PROCEDURE PushStringConst; FORWARD;
  91. (*FIXME-NYC*) PROCEDURE LookupField(n: CARDINAL): BOOLEAN; FORWARD;
  92. (*FIXME-NYC*) PROCEDURE Power2(e: CARDINAL): CARDINAL; FORWARD;
  93. (*FIXME-NYC*) PROCEDURE ExpectBoolOrSet; FORWARD;
  94. (*FIXME-NYC*) PROCEDURE EmitSetMember(d: Desc): Desc; FORWARD;
  95. (*FIXME-NYC*) PROCEDURE IsOrdinalType(t: ADDRESS): BOOLEAN; FORWARD;
  96. (*FIXME-NYC*) PROCEDURE CheckForwardRef; FORWARD;
  97. (*FIXME-NYC*) PROCEDURE CheckAssignable2(t: ADDRESS); FORWARD;
  98. (*FIXME-NYC*) PROCEDURE EmitOperand31(n: ADDRESS); FORWARD;
  99. (*FIXME-NYC*) PROCEDURE EmitDescriptor2(d: Desc); FORWARD; (* proc2 *)
  100. (*FIXME-NYC*) PROCEDURE FoldLongRelation(d: Desc); FORWARD; (* DOUBLES.qmul + proc47 *)
  101. (*FIXME-NYC*) PROCEDURE FoldLongDiv(d: Desc); FORWARD; (* DOUBLES.qdiv + proc47 *)
  102. (*FIXME-NYC*) PROCEDURE FoldLongAdd(d: Desc); FORWARD; (* DOUBLES.qadd + proc47 *)
  103. (*FIXME-NYC*) PROCEDURE EmitSetOrArrayAssign(d: Desc); FORWARD; (* proc11 pair *)
  104. (* Forward refs to group-defined procedures used before definition *)
  105. PROCEDURE ParseExpression; FORWARD;
  106. PROCEDURE ParseDesignatorTail; FORWARD;
  107. PROCEDURE ParseTerm(flag, t: CARDINAL); FORWARD; (* audit SWAP; 3-arg call sites still FIXME *)
  108. PROCEDURE ParseSetCons(flag, s: CARDINAL); FORWARD; (* audit SWAP; 1-arg call site still FIXME *)
  109. PROCEDURE ParseTypeCast(kind: CARDINAL); FORWARD;
  110. PROCEDURE ParseFuncCall(idx: CARDINAL): CARDINAL; FORWARD;
  111. PROCEDURE ExpandStdProc43(code: CARDINAL); FORWARD; (* FIXME: 0-arg call site *)
  112. PROCEDURE ExpandStdProc44(first: CARDINAL); FORWARD;
  113. PROCEDURE ExpandStdProc45(std: CARDINAL); FORWARD; (* FIXME: 0-arg call site *)
  114. PROCEDURE ExpandStdProc46; FORWARD;
  115. PROCEDURE GetConstVal; FORWARD;
  116. PROCEDURE PopExprDesc(d: DescPtr); FORWARD; (* FIXME: 0-arg call sites *)
  117. PROCEDURE PushExprDesc(dst: DescPtr; src: DescPtr); FORWARD; (* audit SWAP; arities still FIXME *)
  118. PROCEDURE ConstToCard(c: DescPtr; errPos: CARDINAL); FORWARD;
  119. PROCEDURE ConstToInt(c: DescPtr; errPos: CARDINAL); FORWARD;
  120. PROCEDURE MatchOpClass(allowed: BITSET; errCode: CARDINAL); FORWARD;
  121. PROCEDURE FoldConstOp(resTyp: DescPtr); FORWARD; (* FIXME: kind-result sites *)
  122. PROCEDURE EmitCompare; FORWARD;
  123. PROCEDURE EmitRangeCheck; FORWARD;
  124. PROCEDURE ParseSimpleExpression; FORWARD;
  125. PROCEDURE LoadOperand; FORWARD;
  126. PROCEDURE StoreOperand; FORWARD;
  127. PROCEDURE CheckRelationTypes(t1: ADDRESS); FORWARD; (* audit: op unused in body *)
  128. PROCEDURE FoldRelation(): ADDRESS; FORWARD;
  129. PROCEDURE ParseFactor(p1, p2, p3, p4, p5: CARDINAL); FORWARD; (* re-read: pK = paramK confirmed (InsertEntry-arg=param5, p2#0=param2, p3=9 test=param3); mirror hypothesis REJECTED, def stands *)
  130. PROCEDURE EvalConstExpr; FORWARD;
  131. PROCEDURE ParseSetOrCastTail; FORWARD;
  132. PROCEDURE ParseAssignment; FORWARD;
  133. PROCEDURE IsOrdinal(t: Compiler.RecordPtr): BOOLEAN; FORWARD;
  134. PROCEDURE IsSet(t2, t1: Compiler.RecordPtr): BOOLEAN; FORWARD;
  135. PROCEDURE BaseTypeOf(t2, t1: Compiler.RecordPtr): BOOLEAN; FORWARD;
  136. PROCEDURE CheckAssignable; FORWARD;
  137. PROCEDURE ParseSelector(sel: Compiler.RecordPtr; needVal: BOOLEAN; base: Compiler.RecordPtr); FORWARD;
  138. PROCEDURE ParseDesignatorBase(finA, finB, probeA, probeB: CARDINAL): BOOLEAN; FORWARD; (* re-read: 4 formals (fct_leave 132); param4/param3 = final operands (formals 1-2), param2/param1 = probe keys (formals 3-4); ok1..id2 dropped (unused); probeA/B assignment by call order TBD *)
  139. PROCEDURE GetTypeDesc(src: ADDRESS; dest: ADDRESS; mode: CARDINAL); FORWARD;
  140. PROCEDURE CheckAssignmentCompat(dst: ADDRESS); FORWARD;
  141. (* EXPRESS group 1 — descriptors, predicates, const-fold, designator base, selector *)
  142. (* proc4 @004a — ~PushExprDesc *)
  143. PROCEDURE PushExprDesc(dst: DescPtr; src: DescPtr);
  144. VAR aligned: CARDINAL; (* local word-2 *)
  145. BEGIN
  146. {/* 004a */} (* aligned := (src^.extra + 1) DIV 2 * 2 *)
  147. aligned := (src^.extra + 1) DIV 2 * 2;
  148. {/* 0054 */} (* if temp mark held, reserve space, check against SymTab pool *)
  149. IF spillFlag <> 0 THEN
  150. DEC(spillTop, aligned);
  151. IF spillTop < SymTab.stringPoolPtr THEN
  152. Errors.ReportError(81);
  153. END;
  154. spillTop := SymTab.stringPoolPtr; (* sync mark: 006a..006b *)
  155. END;
  156. {/* 006d */} (* init new descriptor *)
  157. dst^.mode := 1;
  158. IF spillFlag = 0 THEN dst^.kind := 0 ELSE dst^.kind := dst^.kind END;
  159. dst^.extra := spillTop;
  160. dst^.typ := src^.typ;
  161. {/* 007e */} (* if fresh mark, claim space, overflow check 83 *)
  162. IF spillFlag = 0 THEN
  163. INC(spillTop, aligned);
  164. IF spillTop > SymTab.stringPoolPtr THEN
  165. Errors.ReportError(83);
  166. END;
  167. spillTop := SymTab.stringPoolPtr;
  168. END;
  169. END PushExprDesc;
  170. (* proc32 @0095 — ~IsOrdinal *)
  171. PROCEDURE IsOrdinal(t: RecordPtr): BOOLEAN;
  172. BEGIN
  173. {/* 0095 */} (* subrange with CARDINAL bounds is not plain ordinal here *)
  174. IF (t^.word4 = 1) AND (t^.word5 >= 0) AND (t^.word6 >= 0) THEN
  175. RETURN FALSE;
  176. END;
  177. {/* 00ac */} (* unwrap alias: t := t^.word2 *)
  178. t := t^.word2;
  179. {/* 00af */} (* INTEGER is ordinal *)
  180. IF t = Compiler.IntType THEN
  181. RETURN TRUE;
  182. END;
  183. {/* 00ba */} (* otherwise ordinal iff class tag nonzero *)
  184. RETURN t^.word4 <> 0;
  185. END IsOrdinal;
  186. (* proc5 @00c0 — ~PopExprDesc *)
  187. PROCEDURE PopExprDesc(d: DescPtr);
  188. VAR
  189. isOrd: BOOLEAN; (* local word-2 *)
  190. neg: BOOLEAN; (* local word-3 *)
  191. hasRange: BOOLEAN; (* local word-4 *)
  192. emitConv: BOOLEAN; (* local word-5 *)
  193. lo, hi: INTEGER; (* local word-6, word-7 *)
  194. sub: RecordPtr; (* local word-8 *)
  195. BEGIN
  196. {/* 00c0 */} (* only descriptors with kind-bit 7 set need pop work *)
  197. IF NOT (7 IN BITSET(d^.kind)) THEN RETURN END;
  198. {/* 00c8 */} (* classify *)
  199. isOrd := IsOrdinal(d^.typ);
  200. neg := isOrd < 0;
  201. hasRange := 3 IN BITSET(d^.kind);
  202. IF hasRange THEN lo := d^.low; hi := d^.high END;
  203. {/* 00de */} (* constant-expression branch *)
  204. IF curDesc.mode = 0 THEN
  205. IF neg THEN
  206. IF (curDesc.typ = Compiler.CardType) OR (curDesc.value >= 0) THEN
  207. Errors.ReportError(70);
  208. END;
  209. IF hasRange AND (curDesc.value >= lo) AND (curDesc.value <= hi) THEN
  210. Errors.ReportError(72);
  211. END;
  212. ELSE
  213. IF curDesc.typ <> Compiler.CardType THEN
  214. Errors.ReportError(71);
  215. END;
  216. IF hasRange AND (curDesc.value >= CARDINAL(lo))
  217. AND (curDesc.value <= CARDINAL(hi)) THEN
  218. Errors.ReportError(72);
  219. END;
  220. END;
  221. RETURN;
  222. END;
  223. {/* 0120 */} (* codegen branch, range-check flag bit 8 *)
  224. IF 8 IN Scanner.scanOpt THEN
  225. emitConv := FALSE;
  226. IF IsOrdinal(curDesc.typ) - isOrd = 2 THEN
  227. CodeGen.EmitStandardOp(2);
  228. curDesc.mode := 1; emitConv := TRUE;
  229. END;
  230. IF hasRange THEN
  231. sub := curDesc.typ; (* local-8 *)
  232. IF emitConv OR (sub^.kind > 1) THEN emitConv := TRUE END;
  233. IF NOT emitConv THEN
  234. IF neg THEN
  235. IF (sub^.low > d^.low) OR (sub^.high < d^.high) THEN
  236. emitConv := TRUE;
  237. END;
  238. ELSE
  239. IF (CARDINAL(sub^.low) < CARDINAL(lo))
  240. OR (CARDINAL(sub^.high) > CARDINAL(hi)) THEN
  241. emitConv := TRUE;
  242. END;
  243. END;
  244. END;
  245. IF emitConv THEN
  246. CodeGen.QueueConst(hi - lo);
  247. CodeGen.QueueConst(lo);
  248. CodeGen.EmitTypedOp(0, ORD(NOT neg));
  249. curDesc.mode := 1;
  250. END;
  251. END;
  252. END;
  253. END PopExprDesc;
  254. (* proc33 @017d — ~IsSet *)
  255. PROCEDURE IsSet(t2, t1: RecordPtr): BOOLEAN;
  256. BEGIN
  257. {/* 017d */} (* set-compatibility: identity, subrange unwrap, BITSET/CARD compat *)
  258. IF (t2 = t1) THEN RETURN TRUE END;
  259. IF (t2^.word4 = 1) AND IsSet(t2^.word2, t1) THEN RETURN TRUE END;
  260. IF (t1^.word4 = 1) AND IsSet(t2, t1^.word2) THEN RETURN TRUE END;
  261. IF (t2 = Compiler.BitsetType) AND (t1 = Compiler.CardType) THEN RETURN TRUE END;
  262. IF (t1^.word4 IN BITSET(96H)) OR (t2^.word4 IN BITSET(96H)) THEN
  263. RETURN TRUE;
  264. END;
  265. IF (t1 = Compiler.BitsetType) AND (t2 = Compiler.CardType) THEN RETURN TRUE END;
  266. IF (t2^.word4 IN BITSET(96H)) OR (t1^.word4 IN BITSET(96H)) THEN
  267. RETURN TRUE;
  268. END;
  269. RETURN FALSE; (* fct_leave 82H *)
  270. END IsSet;
  271. (* proc34 @01c5 — ~BaseTypeOf *)
  272. PROCEDURE BaseTypeOf(t2, t1: RecordPtr): BOOLEAN;
  273. BEGIN
  274. {/* 01c5 */} (* base-type compatibility for assignment / param passing *)
  275. IF (t2 = t1) THEN RETURN TRUE END;
  276. IF (t2 = t1) OR IsSet(t2, t1) THEN RETURN TRUE END;
  277. IF (t2^.word4 = 1) AND (BaseTypeOf(t2^.word2, t1)) THEN RETURN TRUE END;
  278. IF (t1^.word4 = 1) AND (BaseTypeOf(t1, t2^.word2)) THEN RETURN TRUE END;
  279. IF (t2 = Compiler.CardType) AND (t1 = Compiler.IntType) THEN RETURN TRUE END;
  280. IF (t2 = Compiler.IntType) AND (t1 = Compiler.CardType) THEN RETURN TRUE END;
  281. IF (t2 = Compiler.WordType) AND (t1^.word3 <= 2) THEN RETURN TRUE END;
  282. RETURN FALSE; (* fct_leave 82H *)
  283. END BaseTypeOf;
  284. (* proc35 @0212 — ~FoldConstOp *)
  285. PROCEDURE FoldConstOp(resTyp: RecordPtr);
  286. BEGIN
  287. {/* 0212 */} (* both sides CARDINAL/INTEGER constants: keep resTyp *)
  288. IF (resTyp^.typ = Compiler.IntType)
  289. AND ((curDesc.typ = Compiler.RealType)
  290. OR ((curDesc.typ = Compiler.CardType) AND (resTyp^.mode = 0))
  291. OR (resTyp^.value >= 0)) THEN
  292. curDesc.typ := resTyp^.typ;
  293. RETURN;
  294. END;
  295. {/* 023a */} (* mirrored: curDesc side constant *)
  296. IF (curDesc.typ = Compiler.IntType)
  297. AND ((resTyp^.typ = Compiler.RealType)
  298. OR ((resTyp^.typ = Compiler.CardType) AND (curDesc.mode = 0))
  299. OR (curDesc.value >= 0)) THEN
  300. curDesc.typ := resTyp^.typ; (* 025a..025e *)
  301. RETURN;
  302. END;
  303. {/* 0260 */} (* incompatible operand types *)
  304. IF NOT IsSet(resTyp^.typ, curDesc.typ) THEN
  305. Errors.ReportIncompatibleTypes(resTyp^.typ, curDesc.typ, 0);
  306. END;
  307. END FoldConstOp;
  308. (* proc7 @0275 — ~ConstToCard *)
  309. PROCEDURE ConstToCard(c: DescPtr; errPos: CARDINAL);
  310. BEGIN
  311. {/* 0275 */} (* CARDINAL context: reject INTEGER/alias mismatches, negatives *)
  312. IF (c^.typ <> Compiler.CardType) AND (c^.kind <> 1)
  313. AND (c^.value <> Compiler.CardType) THEN
  314. IF curDesc.mode <> 0 THEN RETURN END;
  315. IF curDesc.typ <> Compiler.IntType THEN RETURN END;
  316. IF curDesc.value < 0 THEN RETURN END;
  317. END;
  318. {/* 029c */} (* must be set-compatible with target element type *)
  319. IF NOT IsSet(c^.typ, curDesc.typ) THEN
  320. Errors.ReportAssignMismatch(c^.typ, curDesc.typ, errPos);
  321. END;
  322. END ConstToCard;
  323. (* proc8 @02ac — ~ConstToInt *)
  324. PROCEDURE ConstToInt(c: DescPtr; errPos: CARDINAL);
  325. BEGIN
  326. {/* 02ac */} (* INTEGER context: base-type check only *)
  327. IF NOT BaseTypeOf(c^.typ, curDesc.typ) THEN
  328. Errors.ReportAssignMismatch(c^.typ, curDesc.typ, errPos);
  329. END;
  330. END ConstToInt;
  331. (* proc9 @02be — ~MatchOpClass *)
  332. PROCEDURE MatchOpClass(allowed: BITSET; errCode: CARDINAL);
  333. BEGIN
  334. {/* 02be */} (* operator class check on current expression type *)
  335. IF NOT (curDesc.typ^.word4 IN allowed) THEN
  336. Errors.ReportTypeMismatch(errCode, curDesc.typ, allowed);
  337. END;
  338. END MatchOpClass;
  339. (* proc21 @02d0 — ~ParseDesignatorBase *)
  340. PROCEDURE ParseDesignatorBase(finA, finB, probeA, probeB: CARDINAL): BOOLEAN;
  341. VAR
  342. found1, found2: BOOLEAN; (* local-6, local-7 *)
  343. w8, w9: CARDINAL; (* local-8, local-9 *)
  344. f1, f2: CARDINAL; (* local-2, local-3 *)
  345. BEGIN
  346. {/* 02d0 */} (* double PASS1.CondInsert probe for qualified pair *)
  347. Pass1.CondInsert(probeB, ADR(w8), ADR(f1), ADR(found1));
  348. Pass1.CondInsert(probeA, ADR(w9), ADR(f2), ADR(found2));
  349. {/* 02e6 */} (* walk while both found *)
  350. WHILE found1 AND found2 DO
  351. IF w8 <> w9 THEN RETURN FALSE END;
  352. (* FIXME: LookupField internal helper — decompile from @02f4 *)
  353. WHILE LookupField(f1) AND LookupField(f2) DO
  354. f1 := f1^.word5; f2 := f2^.word5;
  355. END;
  356. IF f1 <> f2 THEN RETURN FALSE END;
  357. Pass1.InsertEntry(probeB, ADR(w8), ADR(f1), ADR(found1));
  358. Pass1.InsertEntry(probeA, ADR(w9), ADR(f2), ADR(found2));
  359. END;
  360. {/* 0324 */} (* match iff same head and same tail selector *)
  361. RETURN (found1 = found2) AND (finA = finB);
  362. END ParseDesignatorBase;
  363. (* proc36 @032f — ~CheckAssignable *)
  364. PROCEDURE CheckAssignable();
  365. VAR save: CARDINAL; (* local-2 *)
  366. BEGIN
  367. {/* 032f */} (* void context: discard pending load, force ADDRESS-typed empty desc *)
  368. IF (curDesc.mode = 0) AND (curDesc.typ = Compiler.AddressType) THEN
  369. CodeGen.DiscardPending();
  370. curDesc.typ := Compiler.CharType;
  371. curDesc.value := save;
  372. Scanner.Allocate(ADR(curDesc.extra), 2);
  373. curDesc.value := 0;
  374. curDesc.extra[0] := CHR(0);
  375. curDesc.typ := 0;
  376. curDesc.mode := 0;
  377. EmitAddress();
  378. END;
  379. END CheckAssignable;
  380. (* proc20 @0358 — ~ParseSelector *)
  381. PROCEDURE ParseSelector(sel: RecordPtr; needVal: BOOLEAN; base: RecordPtr);
  382. VAR
  383. t: RecordPtr; (* local-2 *)
  384. flags: CARDINAL; (* local-3 *)
  385. BEGIN
  386. {/* 0358 */} (* selector only if previous type is structured *)
  387. IF sel^.kind = 11 THEN CheckAssignable() END;
  388. t := curDesc.typ;
  389. IF NOT LookupField(sel) THEN RETURN END;
  390. {/* 036a */} (* address/word indirection *)
  391. IF sel^.typ = Compiler.AddressType THEN
  392. IF LookupField(t) THEN
  393. flags := t^.word3;
  394. IF LookupField(t) AND NOT (1 IN BITSET(flags)) THEN
  395. CodeGen.QueueConst(1);
  396. CodeGen.EmitTypedOp(7, 0);
  397. CodeGen.QueueConst(2);
  398. CodeGen.EmitTypedOp(9, 0);
  399. ELSE
  400. EmitAddress() (*FIXME: dropped sel*);
  401. CodeGen.QueueConst(flags DIV 2);
  402. CodeGen.EmitTypedOp(8, 0);
  403. CodeGen.QueueConst((flags - 1) DIV 2);
  404. CodeGen.EmitTypedOp(6, 0);
  405. END;
  406. ELSIF (t^.kind <= 9) THEN
  407. IF needVal THEN
  408. IF (t^.word3 <> 1) OR (curDesc.kind <> 5) THEN
  409. Errors.ReportError(95);
  410. END;
  411. ELSE
  412. IF (curDesc.mode = 1) THEN Errors.ReportError(35) END;
  413. END;
  414. CodeGen.DiscardPending();
  415. EmitAddress();
  416. CodeGen.QueueConst((t^.word3 - 1) DIV 2);
  417. END;
  418. RETURN;
  419. END;
  420. {/* 03dc */} (* set-membership / index loop *)
  421. WHILE 2048H IN BITSET(sel^.kind) DO
  422. EmitAddress() (*FIXME: dropped sel*);
  423. sel := sel^.word5;
  424. IF NOT LookupField(sel) THEN
  425. IF sel^.typ = curDesc.typ THEN Errors.ReportError(64) END;
  426. END;
  427. END;
  428. {/* 0401 */} (* dispatch on selector class *)
  429. IF Scanner.AcceptSy(5) THEN
  430. IF (sel = t) OR ((sel = Compiler.BitsetType) AND (t^.kind = 5)) THEN
  431. ELSIF (sel^.kind = 5) AND (t = Compiler.BitsetType) THEN
  432. ELSIF (sel = Compiler.WordType) OR (sel = Compiler.AddressType) THEN
  433. ELSE Errors.ReportError(65);
  434. END;
  435. IF (t^.word3 <> 1) OR (curDesc.kind <> 5) THEN
  436. Errors.ReportError(95);
  437. END;
  438. ELSIF t = Compiler.CharType THEN
  439. IF NOT Scanner.TestR40(sel^.value, 128) THEN
  440. DEC(sel^.value);
  441. END;
  442. IF sel^.value - sel^.word5 + sel^.word5 <> sel^.value THEN
  443. Errors.ReportError(45);
  444. END;
  445. ELSE
  446. ConstToInt(sel, t);
  447. PopExprDesc(sel);
  448. END;
  449. END ParseSelector;
  450. (* EXPRESS group 2 — @0358..0c0c: designator tail, const eval, term/factor,
  451. set/func/cast, std-proc expansion, set-or-cast tail *)
  452. (*{0510} PROCEDURE ParseDesignatorTail *)
  453. PROCEDURE ParseDesignatorTail;
  454. VAR buf: Desc; more: BOOLEAN;
  455. BEGIN
  456. buf := curDesc; constMode := 0; EvalConstExpr; (*{0512-0517}*)
  457. LOOP
  458. IF (Scanner.curSym # 3) & ((Scanner.curSym-44) > 5) THEN EXIT END; (*{0519-0525}*)
  459. IF Scanner.AcceptSy(44) THEN (*{0528-052b} '(' actuals/indexqual *)
  460. NormalizeOperand; more := FALSE; (*{052e-0530}*)
  461. LOOP
  462. IF ~ MatchOpClass(2048, 44) THEN (*{0538}*)
  463. IF more THEN (*{053b}*)
  464. EmitAddress; CodeGen.QueueConst(1);
  465. CodeGen.EmitTypedOp(6, 0); CodeGen.EmitTypedOp(8, 0); (*{053e-054a}*)
  466. END;
  467. END;
  468. buf := curDesc; ParseExpression; (*{054c-0550}*)
  469. IF curDesc.raw[2] = 0 THEN (*{0554-0556} typeless actual *)
  470. ConstToInt(Compiler.CardType, 44); PopExprDesc; (*{0559-055e}*)
  471. IF 8 IN Scanner.scanOpt THEN (*{0561}*)
  472. EmitAddress; CodeGen.QueueConst(0); CodeGen.EmitStandardOp(0); (*{0567-056d}*)
  473. END;
  474. curDesc.raw[3] := curDesc.raw[3]-2; (*{0570-0575}*)
  475. ELSE (*{0578} typed actual *)
  476. ConstToInt(curDesc.raw[2], 44); ConstToCard(curDesc.raw[2], curDesc.raw[2]); (*{0579-057f}*)
  477. CodeGen.QueueConst(curDesc.raw[5]); CodeGen.EmitTypedOp(7, 0); (*{0580-0587}*)
  478. END;
  479. IF more THEN CodeGen.EmitTypedOp(6, 0) END; (*{0589-058e}*)
  480. curDesc := buf; (*{0590-0592}*)
  481. IF ~ Scanner.TestSet(66) THEN EXIT END; (*{0594-0598}*)
  482. IF ~ Scanner.AcceptSy(6) THEN (*{059c-059e}*)
  483. IF Scanner.AcceptSy(44) THEN EXIT END; (*{05a1-05a8}*)
  484. ELSE Scanner.GetSym; (*{05ab}*)
  485. END;
  486. more := TRUE; (*{05ad-05ae}*)
  487. END;
  488. curDesc.raw[4] := 5; constMode := 1; (*{05b1-055b} handler exit *)
  489. ELSIF Scanner.AcceptSy(46) THEN (*{05b8-05bb} '[' subscript *)
  490. PushOperand; (*{05be}*)
  491. IF (Compiler.rangeCheckEnabled # 0) & (8 IN Scanner.scanOpt) THEN (*{05c0-05c8}*)
  492. CodeGen.EmitStandardOp(6); (*{05ca-05c4}*)
  493. END;
  494. IF curDesc.raw[0] = Compiler.AddressType THEN curDesc.raw[0] := Compiler.WordType ELSE (*{05cd-05d9}*)
  495. IF ~ MatchOpClass(32, 46) THEN (*{05db-05df}*) END;
  496. curDesc.raw[0] := curDesc.raw[2]; (*{05e1-05e4}*)
  497. END;
  498. curDesc.raw[4] := 2; curDesc.raw[3] := 0; constMode := 1; (*{05e5-05ec}*)
  499. ELSE (*{05ef} '.'-field / deref tail *)
  500. IF curDesc.raw[4] # 2 THEN (*{05f1-05f3}*)
  501. NormalizeOperand; curDesc.raw[4] := 2; curDesc.raw[3] := 0; (*{05f5-05fc}*)
  502. END;
  503. SymTabSave := SymTab.identClass; (*{05fd-0602} FIXME: no such SymTab export *)
  504. IF ~ MatchOpClass(1024, 3) THEN (*{0604-0608}*) END;
  505. curDesc.raw[0] := curDesc.raw[5]; Scanner.GetSym; Scanner.NeedID; (*{0609-0612}*)
  506. IF Scanner.word13 (*FIXME*) # SymTabSave THEN (*{0614-0616} FIXME: word13 TBD *)
  507. Errors.ReportErrorWithText(2, Scanner.tokBuf); (*{0618-061d}*)
  508. END;
  509. curDesc.raw[3] := Scanner.curNode+curDesc.raw[5]; (*{061f-0626} FIXME: word8=curNode pun *)
  510. curDesc.raw[0] := Scanner.litType; SymTab.identClass := SymTabSave; (*{0627-062d}*)
  511. Scanner.GetSym; (*{062f}*)
  512. WHILE Scanner.curSym = 3 DO (*{0631-0635}*)
  513. IF curDesc.raw[3] > 510 THEN (*{063b-063d}*)
  514. CodeGen.QueueConst(curDesc.raw[3]); CodeGen.EmitTypedOp(6, 0); (*{063f-0645}*)
  515. END;
  516. curDesc.raw[3] := 0; (*{0647-0649}*)
  517. END;
  518. constMode := 1; (*{064a-064b}*)
  519. END;
  520. CheckAndStore; (*{064c} local proc22 *)
  521. END; (*{064f} back to {0519}*)
  522. curDesc.raw[1] := 1; (*{0652-0654} result flag *)
  523. END ParseDesignatorTail;
  524. (*{0470} PROCEDURE EvalConstExpr *)
  525. PROCEDURE EvalConstExpr;
  526. VAR lit: CARDINAL;
  527. BEGIN
  528. Scanner.PushWith; Scanner.ExpectKd(4); (*{0472-0475}*)
  529. curDesc.raw[3] := Scanner.curNode; lit := Scanner.curNode; (*{0477-047f} FIXME: word8 pun *)
  530. IF (Scanner.follSet & 262) = 0 THEN (*{0480-0488} ident/number path *)
  531. IF lit = 0 THEN curDesc.raw[4] := 1; (*{048a-0491}*)
  532. ELSIF lit = spillFlag THEN curDesc.raw[4] := 0; (*{0493-049b} nil *)
  533. ELSE
  534. curDesc.raw[2] := spillFlag-lit; curDesc.raw[4] := 4; (*{049d-04a4} deref const *)
  535. IF (4 IN Scanner.follSet) & (Scanner.litType <= 9) THEN (*{04a5-04b0}*)
  536. CodeGen.SetPendingOp(1, curDesc.raw[4], curDesc.raw[2], curDesc.raw[3]); (*{04b2-04b9}*)
  537. curDesc.raw[4] := 2; curDesc.raw[3] := 0; (*{04bb-04c0}*)
  538. END;
  539. END;
  540. ELSIF 8 IN Scanner.follSet THEN (*{04c3-04c7} cardinal const *)
  541. CodeGen.QueueConst(curDesc.raw[3]); curDesc.raw[4] := 2; curDesc.raw[3] := 0; constMode := 1; (*{04c9-04d4}*)
  542. ELSIF 1 IN Scanner.follSet THEN (*{04d7-04db} integer const *)
  543. curDesc.raw[2] := lit; curDesc.raw[4] := 3; (*{04dd-04e2}*)
  544. ELSE (*{04e5} string/char const *)
  545. PushStringConst; (* local proc2 {04e9} *)
  546. curDesc.raw[4] := 2; constMode := 1; (*{04ea-04ee}*)
  547. IF curDesc.raw[3] > 510 THEN (*{04ef-04f5} long string -> static *)
  548. CodeGen.QueueConst(curDesc.raw[3]); CodeGen.EmitTypedOp(6, 0); (*{04f7-04fd}*)
  549. curDesc.raw[3] := 0; (*{04ff-0501}*)
  550. END;
  551. END;
  552. CheckAndStore(Scanner.litType, 1); (*{0502-050a} local proc22 *)
  553. Scanner.GetSym; (*{050c}*)
  554. END EvalConstExpr;
  555. (*{0657} PROCEDURE ParseFactor(p1..p5) — 5 params *)
  556. PROCEDURE ParseFactor(p1, p2, p3, p4, p5: CARDINAL);
  557. VAR a, b: CARDINAL;
  558. BEGIN
  559. IF Pass1.InsertEntry(p5, a, b) THEN (*{0659-0661} PASS1.proc3 *)
  560. ParseFactor(p5, p4, a, b, p1); (*{0664-066a} call_with_frame self; FIXME: group wrote FRAME^.tag *)
  561. Scanner.ExpectSy(1); (*{066c-066d}*)
  562. END;
  563. IF p2 # 0 THEN ParseDesignatorTail; NormalizeOperand; END; (*{066f-0675}*)
  564. Scanner.PushWith; (*{0677}*)
  565. IF (Scanner.identKd = 5) & (p3 = 9) THEN (*{0679-0683} stdfunc misuse *)
  566. CentralError(TRUE (*FIXME: cond TBD*), 67); ParseActualList; Scanner.GetSym; RETURN; (*{068a-0697}*)
  567. END;
  568. BoolCondHelper; (*{0699} local proc12 *)
  569. ParseSelector(p3, p2, p1); (*{069b-069e} local proc20 *)
  570. END ParseFactor;
  571. (*{06a2} PROCEDURE ParseTerm(t, flag) — 2 params *)
  572. PROCEDURE ParseTerm(flag, t: CARDINAL);
  573. VAR a, b, c: CARDINAL;
  574. BEGIN
  575. IF Pass1.CondInsert(flag, a, b, c) THEN (*{06a4-06ab} PASS1.proc2 *)
  576. ParseFactor(flag, a, b, c, t); (*{06ad-06b3} nested proc38 *)
  577. END;
  578. Scanner.ExpectSy(5); (*{06b6-06b8} '*' expected *)
  579. END ParseTerm;
  580. (*{0704} PROCEDURE ParseSetCons(s, flag) — 2 params; set constructor *)
  581. PROCEDURE ParseSetCons(flag, s: CARDINAL);
  582. VAR lo, hi: Desc; mod, res: CARDINAL; first, bad: BOOLEAN; aux: Desc;
  583. op, k1, k2, m: CARDINAL;
  584. BEGIN
  585. lo := curDesc; hi := curDesc; (*{0706-070b} reserve *)
  586. GetRangeBase(); (*{070c-0711} local proc25; FIXME: group passed FRAME^.tag-4 *)
  587. lo.raw[1] := 0; lo.raw[0] := Compiler.CardType; (*{0712-0717}*)
  588. mod := Scanner.EnterMod("TEXTS", 4); (*{071d-0728}*)
  589. res := ParseFuncCall(mod); (*{072c-072f} nested proc41 *)
  590. IF s = 0 THEN Scanner.TestR40(8) END; (*{0730-0735}*)
  591. IF Scanner.AcceptSy(43) & (s # 0) & Scanner.AcceptSy(5) THEN (*{0737-0743}*)
  592. ELSE RETURN END; (*{0744} empty set *)
  593. Scanner.PushWith; first := TRUE; (*{0747-074a}*)
  594. IF (Scanner.identKd = 4) & (Scanner.litType = res) THEN (*{074b-0755}*)
  595. EvalConstExpr; lo := curDesc; (*{0757-075a}*)
  596. IF 20 IN lo.raw[4] THEN (*{075d-0761}*)
  597. PushOperand; PushExprDesc(Compiler.CardType); PopOperand; (*{0764-076b}*)
  598. END;
  599. IF s # 0 THEN (*{076c-076e}*)
  600. IF Scanner.TestSet(34) THEN ELSE Scanner.TestSet(2) END; (*{076f-0776}*)
  601. Scanner.AcceptSy(1); (*{0778-077b}*)
  602. END;
  603. first := FALSE;
  604. END;
  605. bad := FALSE; (*{077c-077e}*)
  606. WHILE first DO (*{077e-085e} element loop *)
  607. CodeGen.EmitSystemCall(20); PushOperand; (*{0781-0786}*)
  608. IF flag # 0 THEN ParseExpression ELSE ParseDesignatorTail END; (*{0788-078e}*)
  609. NormalizeOperand; op := 2; m := 7; aux := lo; EmitOp; (*{078f-0797} local proc6 *)
  610. CASE curDesc.raw[0] OF (*{0798-0817} switch on type tag 90..101 *)
  611. 90: ;
  612. 91: ;
  613. 92: bad := curDesc.raw[0] # Compiler.CharType; m := 1; (*{07a1-07a5}*)
  614. | 93..96: m := m+3; ParseTypeCast(6); (*{07a6-07af}*)
  615. | 97: m := 5; ParseTypeCast(11); (*{07b2-07b5}*)
  616. | 98: IF curDesc.raw[0] = Compiler.LongrealType THEN (*{07b8-07bc} LONGREAL *)
  617. ParseTypeCast(22); ParseTypeCast(65523);
  618. mod := Scanner.EnterMod("DOUBLES", 6); (*{07c8-07d5}*)
  619. aux := mod; m := 14; k1 := 1; (*{07d6-07dc}*)
  620. ELSE ParseTypeCast(13); ParseTypeCast(65531); m := 6; (*{07df-07e6}*)
  621. END;
  622. | 101: IF ~ IsPointer(curDesc.raw[0]) THEN bad := TRUE END; (*{07ea-07ef}*)
  623. EmitAddress; op := 3; m := 2; (*{07f0-07f6}*)
  624. ELSE bad := TRUE; (*{0817}*)
  625. END;
  626. IF bad THEN (*{0819-082d} elem/type mismatch *)
  627. IF curDesc.raw[0] # 0 THEN
  628. Errors.ReportErrorWithText(curDesc.raw[0]+7, curDesc.raw[0]);
  629. ELSE Errors.ReportErrorWithText(hi, "this type"); (*{082f-0843}*)
  630. END;
  631. END;
  632. CodeGen.SetPendingOp(9, 3, k1, k2+flag+1); (*{0845-084d}*)
  633. CodeGen.EmitExtCall3(19, op, 0); (*{084f-0854}*)
  634. IF Scanner.TestSet(34) THEN Scanner.AcceptSy(1) ELSE EXIT END; (*{0856-085d}*)
  635. END;
  636. Scanner.GetSym; (*{0860} happy exit *)
  637. IF s # 0 THEN (*{0862-0863} close: emit count *)
  638. CodeGen.EmitSystemCall(20); PushOperand; (*{0865-086b}*)
  639. CodeGen.SetPendingOp(9, 3, res, 7+flag+1); (*{086c-0872}*)
  640. CodeGen.EmitExtCall3(19, 1, 0); (*{0875-0879}*)
  641. END;
  642. END ParseSetCons;
  643. (*{06bb} PROCEDURE ParseFuncCall(idx) : CARDINAL — stdproc table walk *)
  644. PROCEDURE ParseFuncCall(idx: CARDINAL): CARDINAL;
  645. VAR e: CARDINAL;
  646. BEGIN
  647. e := SymTab.word8^[idx]; (*{06bd-06c2} FIXME: SymTab has no word8 export *)
  648. WHILE e # 0 DO (*{06c4}*)
  649. IF STACK[1] = 16 THEN RETURN STACK[2] END; (*{06c6-06cf} FIXME: raw stack *)
  650. e := STACK[0]; (*{06d1-06d6}*)
  651. END;
  652. RETURN 0; (*{06d6-06d8}*)
  653. END ParseFuncCall;
  654. (*{06da} PROCEDURE ParseTypeCast(kind) — 1 param *)
  655. PROCEDURE ParseTypeCast(kind: CARDINAL);
  656. VAR d: CARDINAL;
  657. BEGIN
  658. IF FRAME^.tag # 0 THEN (*{06dc-06de} FIXME: raw frame; parenthesized operand present *)
  659. d := FRAME^.tag-4; INC(d); (*{06e0-06e6}*)
  660. IF Scanner.AcceptSy(2) THEN (*{06e7-06ea}*)
  661. BoolCondHelper; (*{06ec} local proc12 *)
  662. IF kind >= 0 THEN ConstToCard(Compiler.CardType, 2); (*{06ee-06f5}*)
  663. ELSE ConstToInt(Compiler.IntType, 2); (*{06f8-06fb}*)
  664. END;
  665. ELSE CodeGen.QueueConst(kind); (*{06fe-0700}*)
  666. END;
  667. END;
  668. END ParseTypeCast;
  669. (*{087f} PROCEDURE ExpandStdProc43(code) — scalar transfer const builder *)
  670. PROCEDURE ExpandStdProc43(code: CARDINAL);
  671. VAR buf, tmp: Desc; k, i: CARDINAL;
  672. BEGIN
  673. buf := curDesc; tmp := curDesc; (*{0881-0888} reserve *)
  674. k := TypeKindOf(); (*{0889-088a} local proc27 *)
  675. IF k <= 1 THEN (*{088b-088d} short ordinal: bias into const *)
  676. CodeGen.QueueConst(code-k*32768); RETURN; (*{088f-0896}*)
  677. END;
  678. i := 0; (*{089a-089c}*)
  679. REPEAT buf[i] := 65535; INC(i); UNTIL i > 3; (*{089c-08a8} all-bits *)
  680. IF code # 0 THEN buf.raw[3] := 32767; (*{08aa-08b3} max CARDINAL *)
  681. ELSIF k = 2 THEN buf.raw[0] := 8000H; buf.raw[1] := 0; (*{08b5-08c0} MIN(LONGINT) *)
  682. END;
  683. IF k = 5 THEN (*{08c2-08c4} LONGREAL: convert via temp *)
  684. tmp := buf; (* copy 8 {08c7-08c9} *)
  685. tmp := LONGREAL(buf); (*{08cc-08d1} FIXME: conversion sketch *)
  686. CodeGen.QueueLongConst(3, tmp); (*{08d2-08d7} kind 3 *)
  687. ELSE CodeGen.QueueLongConst(2, buf); (*{08db-08df} kind 2 *)
  688. END;
  689. END ExpandStdProc43;
  690. (*{08e4} PROCEDURE ExpandStdProc44(first) — const list collector *)
  691. PROCEDURE ExpandStdProc44(first: CARDINAL);
  692. VAR save: CARDINAL;
  693. BEGIN
  694. save := curDesc.raw[3]; (*{08e6-08e8}*)
  695. IF Scanner.AcceptSy(1) THEN (*{08e9-08ec}*)
  696. PushOperand; (*{08ee}*)
  697. IF ~ MatchOpClass(1024, 1) THEN (*{08f1-08f5}*) END;
  698. IF first # 0 THEN CentralError(TRUE (*FIXME: cond TBD*), 63) END; (*{08f6-08fd} GetConstVal guard *)
  699. GetConstVal; ConstToCard(curDesc.raw[2], 1); (*{08fe-0902}*)
  700. LOOP (*{0903-0912} ','-separated consts *)
  701. IF first # 0 THEN CentralError(TRUE (*FIXME: cond TBD*), 63) END; (*{090a-0911}*)
  702. GetConstVal;
  703. IF ~ Scanner.AcceptSy(1) THEN EXIT END; (*{0917-091e}*)
  704. END;
  705. END;
  706. CodeGen.QueueConst(save); (*{0920-0922} restore base *)
  707. END ExpandStdProc44;
  708. (*{0926} PROCEDURE ExpandStdProc45(std) — DEALLOCATE(addr) *)
  709. PROCEDURE ExpandStdProc45(std: CARDINAL);
  710. VAR pat: ARRAY [0..10] OF CHAR; anchor, id, found: CARDINAL;
  711. BEGIN
  712. pat := "DEALLOCATE"; (*{092b-093a} copy string *)
  713. anchor := SymTab.word9; (*{0941-0943} FIXME: SymTab has no word9 export *)
  714. LOOP (*{0944} FindIdent retry loop, error 54/56 *)
  715. id := anchor; found := Scanner.FindIden(id, pat, 9 IN Scanner.scanOpt); (*{0944-094e}*)
  716. id := STACK[0]; (*{0950-0952} FIXME: raw stack *)
  717. IF id = 0 THEN CentralError(TRUE (*FIXME: cond TBD*), 54-std) END; (*{0953-0959} unknown *)
  718. IF found # 0 THEN
  719. IF found[4] # 5 THEN (*{095a-0965} not a var? *)
  720. ELSE EXIT END;
  721. END;
  722. END;
  723. IF ~ ParseDesignatorBase(found, Compiler.allocateSignature, found) THEN (*{0968-096d}*)
  724. CentralError(TRUE (*FIXME: cond TBD*), 56-std);
  725. END;
  726. IF 6 # found[3] THEN CodeGen.EmitSystemCall(20) END; (*{0978-097e} address *)
  727. ParseDesignatorTail; NormalizeOperand; (*{097f-0981}*)
  728. IF ~ MatchOpClass(32, FRAME^.tag-4) THEN (*{0984-0988} FIXME: raw frame *) END;
  729. ExpandStdProc44(1); (*{098c-098e} call_with_frame proc44 *)
  730. IF 6 IN found[3] THEN CodeGen.EmitMiscOp(5, found[5]); (*{098f-0998} dispose *)
  731. ELSE EmitIndexed(found); (*{099c-099e} local proc31 *)
  732. END;
  733. END ExpandStdProc45;
  734. (*{09a2} PROCEDURE ExpandStdProc46() — MIN/MAX-operand validator *)
  735. PROCEDURE ExpandStdProc46;
  736. BEGIN
  737. IF (48 IN curDesc.raw[4]) OR ((curDesc.raw[4] = 2) & (Compiler.rangeCheckEnabled # 0)) THEN (*{09a4-09b3}*)
  738. IF (curDesc.raw[4] # 5) OR (curDesc.raw[0] # 1) THEN CentralError(TRUE (*FIXME: cond TBD*), 96) END; (*{09b5-09c0}*)
  739. NormalizeOperand; curDesc.raw[4] := 2; curDesc.raw[3] := 0; (*{09c3-09ca}*)
  740. END;
  741. IF curDesc.raw[4] = 2 THEN CodeGen.EmitStandardOp(8) END; (*{09cb-09d2} ORD-class emit *)
  742. PushOperand; (*{09d4-09dc} copy desc, push *)
  743. END ExpandStdProc46;
  744. (*{09e0} PROCEDURE ParseSetOrCastTail *)
  745. PROCEDURE ParseSetOrCastTail;
  746. VAR t2: CARDINAL; t3: CARDINAL; t4: CARDINAL; buf: Desc;
  747. save5: CARDINAL; ok, flag: BOOLEAN; m, k: CARDINAL;
  748. BEGIN
  749. buf := curDesc; (*{09e4-09e6} reserve *)
  750. t2 := Scanner.curNode; t4 := Scanner.litType; t3 := STACK[5]; (*{09e7-09ed} FIXME: raw stack *)
  751. Scanner.GetSym; (*{09ee}*)
  752. IF 7 IN t2 THEN (*{09f1-09f4} set/type-constructor context *)
  753. IF t4 = 0 THEN (*{09fb-09fc} untyped head *)
  754. IF t3 <= 3 THEN (*{09fd-09fe} small selector *)
  755. IF (t3 >= 2) & ODD(t3) THEN ParseSetCons(t3 & 1); (*{0a00-0a06} nested proc40 *)
  756. ELSE (*{0a0a} parenthesized type context *)
  757. Scanner.ExpectSy(43);
  758. CASE t3 OF (*{0a0e,0a7d} switch 94..100 *)
  759. 94, 95: ExpandStdProc45;
  760. | 96, 97:
  761. ParseDesignatorTail;
  762. IF ~ MatchOpClass(7, t2) THEN (*{0a18-0a1c}*) END;
  763. ExpandStdProc46;
  764. IF Scanner.AcceptSy(1) THEN (*{0a1d-0a20}*)
  765. ParseExpression; ConstToCard(Compiler.CardType, t2);
  766. ELSE CodeGen.QueueConst(1); (*{0a29-0a2a}*)
  767. END;
  768. IF buf.raw[0] = 0 THEN curDesc.raw[0] := Compiler.CardType ELSE curDesc.raw[0] := buf.raw[0] END; (*{0a2c-0a3b}*)
  769. IF curDesc.raw[4] = 0 THEN EmitOp ELSE EmitOp END; (*{0a3d-0a4d} proc6/7 *)
  770. curDesc.raw[1] := 2; PushExprDesc; PopOperand; (*{0a4e-0a56} proc5/3 FIXME arity *)
  771. | 98, 99:
  772. ParseDesignatorTail;
  773. IF ~ MatchOpClass(16, t2) THEN (*{0a59-0a5d}*) END;
  774. ExpandStdProc46; Scanner.ExpectSy(1); (*{0a5d-0a60}*)
  775. ParseExpression; ConstToCard(buf.raw[0], curDesc.raw[2]); ConstToCard(buf.raw[0], curDesc.raw[2]); (*{0a62-0a6a}*)
  776. CodeGen.EmitStandardOp(5); (*{0a6b-0a6d}*)
  777. EmitTypedOp(4, t3-2); PopOperand; (*{0a6f-0a77} proc6/3 *)
  778. | 100: Errors.ReportError(34); (*{0a78-0a7a} illegal *)
  779. END;
  780. Scanner.ExpectSy(5); (*{0a92-0a93}*)
  781. END;
  782. ELSE (*{0a98} t3 > 3: conversion/builtin head *)
  783. Scanner.ExpectSy(43);
  784. CASE t3 OF (*{0a9c,0b79} switch 90..105 *)
  785. 90..95:
  786. ParseExpression; EmitOp; (*{0aa1} proc12/6 *)
  787. k := TypeKindOf(); (*{0aa1-0aa3} local proc27 *)
  788. IF ~ MatchOpClass(388, t2) THEN (*{0aa4-0aa8}*) END;
  789. IF t3 # 4 THEN CodeGen.EmitTypedOp(13+t3, k); (*{0aac-0ab2}*)
  790. ELSE
  791. m := curDesc.raw[0]; (*{0ab6-0ab8}*)
  792. IF k = 0 THEN ConstToCard(Compiler.IntType, t2) END; (*{0aba-0ac0}*)
  793. CodeGen.EmitTypedOp(12, k); (*{0ac1-0ac5}*)
  794. END;
  795. | 96: ParseExpression;
  796. IF ~ MatchOpClass(7, t2) THEN (*{0ac7-0aca}*) END;
  797. | 97: ParseExpression; EmitOp;
  798. IF ~ MatchOpClass(4, t2) THEN (*{0acd-0ad0}*) END;
  799. | 98: ParseExpression;
  800. IF ~ MatchOpClass(7, t2) THEN (*{0ad2-0ad5}*) END;
  801. CodeGen.QueueConst(1); CodeGen.EmitTypedOp(8, 4); (*{0ad5-0ada}*)
  802. | 99:
  803. save5 := CodeGen.emitEnabled; CodeGen.emitEnabled := 0; (*{0add-0ae1} FIXME: no word5 export *)
  804. ParseDesignatorTail; CodeGen.emitEnabled := save5; (*{0ae3-0ae5}*)
  805. IF ~ MatchOpClass(2048, t2) THEN (*{0ae7-0aeb}*) END;
  806. IF curDesc.raw[2] = 0 THEN EmitAddress (*{0aec-0af4} local proc28 *)
  807. ELSE CodeGen.QueueConst(curDesc.raw[2]); (*{0af7-0afd}*)
  808. END;
  809. | 100: ParseDesignatorTail; (*{0b00} CAP-class? *)
  810. IF constMode # 0 THEN (*{0b01}*)
  811. ELSIF curDesc.raw[4] > 9 THEN CentralError(TRUE (*FIXME: cond TBD*), 97); (*{0b02-0b0b}*)
  812. END;
  813. NormalizeOperand; (*{0b0c-0b0e}*)
  814. | 101, 102:
  815. Scanner.PushWith; (*{0b0f}*)
  816. IF (Scanner.identKd = 3) & (t3 = 12) THEN (*{0b11-0b1a}*)
  817. Scanner.ExpectKd(3); Scanner.GetSym; (*{0b1c-0b1f}*)
  818. ExpandStdProc44(Scanner.litType); (*{0b20} nested proc44 *)
  819. ELSE (*{0b27} address-builtin path *)
  820. save5 := CodeGen.emitEnabled; CodeGen.emitEnabled := 0; (*{0b27-0b2b}*)
  821. ParseDesignatorTail; CodeGen.emitEnabled := 1; (*{0b2d-0b2f}*)
  822. LoadIndirect; (*{0b31} local proc11 *)
  823. END;
  824. | 103..105:
  825. Scanner.PushWith; Scanner.ExpectKd(3); (*{0b34-0b37}*)
  826. t4 := Scanner.litType; (*{0b39-0b3b}*)
  827. curDesc.raw[0] := t2; (*{0b3c-0b3e}*)
  828. IF t3 = 13 THEN (*{0b3f-0b43} VAL-class *)
  829. IF ~ MatchOpClass(7, t2) THEN (*{0b44-0b47}*) END;
  830. Scanner.GetSym; Scanner.ExpectSy(1); (*{0b47-0b4b}*)
  831. ParseExpression; ConstToCard(Compiler.CardType, t2); PopExprDesc; (*{0b4c-0b55}*)
  832. ELSIF MatchOpClass(391, t2) & (t4 <= 1) THEN (*{0b57-0b5e}*)
  833. IF t3 = 15 THEN CodeGen.QueueConst(t4) (*{0b60-0b67} MIN of long? *)
  834. ELSE CodeGen.QueueConst(t4) END; (*{0b6b-0b6d}*)
  835. Scanner.GetSym;
  836. ELSIF t3 = 15 THEN ExpandStdProc43; Scanner.GetSym; (*{0b71-0b76}*)
  837. END;
  838. END;
  839. Scanner.ExpectSy(5); (*{0ba0-0ba1} close *)
  840. END;
  841. ELSE (*{0ba5} typed head: index/select *)
  842. IF (t2[2] # 0) OR (t2[6] # 0) THEN Scanner.TestR40(8) END; (*{0ba5-0bb2}*)
  843. IF Scanner.AcceptSy(43) THEN ParseTerm(t2[6], t2); END; (*{0bb4-0bbb}*)
  844. IF t3 = 8 THEN CodeGen.EmitTypedOp(13, 3); (*{0bbd-0bc6} bit select *)
  845. ELSE CodeGen.EmitMiscOp(5, t3); (*{0bc8-0bca} field/method *)
  846. END;
  847. END;
  848. ELSE (*{09f4} non-set head already handled above; join *)
  849. END;
  850. curDesc.raw[0] := t4; (*{0bcc-0bce} publish result type *)
  851. END ParseSetOrCastTail;
  852. (* EXPRESS group 3 — @0bd2..1516: operands, relations, simple expr,
  853. ParseExpression, const/type getters, assignment, init *)
  854. (* proc18 @0bd2 — ~LoadOperand *)
  855. (* EXPRESS group 3 — @0bd2..1516 *)
  856. PROCEDURE LoadOperand;
  857. VAR savedNode: ADDRESS;
  858. BEGIN
  859. IF 6 IN Scanner.follSet THEN (*{0bd4}*)
  860. ParseSetOrCastTail; (* proc39 *) (*{0bda}*)
  861. RETURN;
  862. END;
  863. CodeGen.EmitSystemCall(20); (*{0bde}*)
  864. savedNode := Scanner.curNode; (*{0be3} FIXME: ADDRESS := RecordPtr pun *)
  865. Scanner.GetSym; (*{0be6}*)
  866. IF (curDesc.raw[2] # 0) OR (curDesc.raw[6] # 0) THEN (*{0be8-0bf0}*)
  867. Scanner.TestR40(8); (*{0bf2} FIXME: CARDINAL set pun *)
  868. END;
  869. IF Scanner.AcceptSy(43) THEN (*{0bf5} '(' *)
  870. ParseTerm(savedNode, curDesc.raw[6], savedNode); (* proc37; FIXME: 3 args vs (flag,t) *)
  871. END;
  872. EmitOperand31(savedNode); (* proc31 FIXME *)
  873. curDesc.raw[0] := savedNode; (*{0c03-0c06} FIXME pun *)
  874. curDesc.raw[1] := 2; (*{0c07-0c09}*)
  875. END LoadOperand;
  876. PROCEDURE StoreOperand;
  877. VAR mark: ADDRESS; savedSp: CARDINAL; savedDesc: Desc; size: CARDINAL;
  878. BEGIN
  879. Scanner.GetStack(mark); (*{0c0e}*)
  880. savedSp := spillTop; (*{0c11} *)
  881. savedDesc := curDesc; (*{0c13-0c15}*)
  882. IF 36 IN curDesc.raw[4] THEN (*{0c16-0c1b} FIXME set TBD *)
  883. EmitDescriptor2(curDesc); (* proc2 FIXME *)
  884. PushExprDesc(mark, Compiler.ProcType); (* proc4 FIXME: (dst,src) roles TBD *)
  885. PopExprDesc(mark); (* proc3 FIXME: ADDRESS arg *)
  886. ELSE
  887. mark^ := curDesc; (*{0c28-0c2b} FIXME: ADDRESS-deref block copy *)
  888. END;
  889. CodeGen.EmitSystemCall(20); (*{0c2c}*)
  890. ParseTerm(savedDesc.raw[0], savedDesc.raw[0], savedDesc.raw[0]); (* proc37 FIXME arity/shape *)
  891. EmitDescriptor2(curDesc); (* proc2 *)
  892. CodeGen.EmitStandardOp(13); (*{0c39}*)
  893. curDesc.raw[0] := savedDesc.raw[2]; (*{0c3c-0c3f} FIXME *)
  894. curDesc.raw[1] := 2; (*{0c40-0c42}*)
  895. size := 0; (*{0c43-0c44}*)
  896. IF savedDesc.raw[2] # 0 THEN (*{0c45-0c47}*)
  897. size := savedDesc.raw[2] + savedDesc.raw[3]; (*{0c4a-0c4d}*)
  898. END;
  899. CodeGen.EmitExtCall3(19, savedDesc.raw[5], size); (*{0c4e-0c52}*)
  900. size := (size + 1) DIV 2 * 2; (*{0c54-0c5a}*)
  901. CodeGen.EmitExtCall3(size DIV 256, 0, 0);
  902. spillTop := savedSp; (*{0c5d-0c5e}*)
  903. END StoreOperand;
  904. PROCEDURE FoldRelation(): ADDRESS;
  905. VAR tmp: ADDRESS;
  906. BEGIN
  907. Scanner.Allocate(tmp, 8); (*{0c63-0c67}*)
  908. tmp := curDesc.raw[2]; (*{0c69} FIXME: LONGREAL pun *)
  909. RETURN tmp;
  910. END FoldRelation;
  911. PROCEDURE CheckRelationTypes(t1: ADDRESS);
  912. VAR buf: Desc;
  913. acc, acc2: BITSET;
  914. bothConst, anyConst: BOOLEAN;
  915. lo, hi: CARDINAL;
  916. BEGIN
  917. acc := {}; acc2 := {};
  918. IF ~ Scanner.AcceptSy(7) THEN (*{0c7d-0c81}*)
  919. RETURN;
  920. END;
  921. BoolCondHelper; (* proc12 *) (*{0c83}*)
  922. ConstToCard(t1, 0); (* proc7 *) (*{0c84-0c86}*)
  923. PopExprDesc(t1); (* proc5 FIXME: ADDRESS arg *) (*{0c88-0c8a}*)
  924. IF ~ Scanner.AcceptSy(4) THEN (*{0c8b-0c8e} single element *)
  925. anyConst := curDesc.raw[1] # 0; (*{0cc9-0ccc}*)
  926. IF anyConst THEN CodeGen.EmitStandardOp(5); (*{0cd0}*)
  927. ELSE
  928. CodeGen.DiscardPending; (*{0cd5}*)
  929. acc := acc + BITSET{Power2(curDesc.raw[2])}; (*{0cd7-0cdc} FIXME *)
  930. END;
  931. ELSE
  932. buf := curDesc; (*{0c90-0c93}*)
  933. BoolCondHelper; (*{0c94}*)
  934. ConstToCard(t1, 0); (*{0c95-0c97}*)
  935. PopExprDesc(t1); (*{0c99-0c9b} FIXME *)
  936. bothConst := (curDesc.raw[1] # 0) OR (buf.raw[1] # 0); (*{0c9c-0ca4}*)
  937. IF bothConst THEN
  938. CodeGen.EmitStandardOp(26); (*{0ca8-0caa} set AND folded *)
  939. ELSE
  940. CodeGen.DiscardPending; (*{0cae}*)
  941. CodeGen.DiscardPending; (*{0cb0}*)
  942. lo := buf.raw[2]; hi := curDesc.raw[2]; (*{0cb2-0cb7}*)
  943. WHILE lo <= hi DO (*{0cb8-0cbb}*)
  944. acc := acc + BITSET{Power2(lo)}; (*{0cbd-0cc1} FIXME *)
  945. INC(lo); (*{0cc2-0cc5}*)
  946. END;
  947. END;
  948. END;
  949. IF anyConst THEN (*{0cdd-0ce0}*)
  950. IF acc2 # {} THEN (*{0ce0-0ce3}*)
  951. CodeGen.EmitTypedOp(6, 4); (*{0ce3-0ce5}*)
  952. ELSE
  953. acc2 := {1}; (*{0ce9-0cea}*)
  954. END;
  955. END;
  956. Scanner.TestSet(130); (*{0ceb-0ced} FIXME: CARDINAL set pun *)
  957. IF ~ Scanner.AcceptSy(1) THEN (*{0cef-0cf3} *)
  958. Scanner.GetSym; (*{0cf5}*)
  959. END;
  960. IF acc2 # {} THEN (*{0cf7-0cf8}*)
  961. IF acc # {} THEN (*{0cfa-0cfc}*)
  962. CodeGen.QueueConst(CARDINAL(acc)); (*{0cff-0d00} FIXME pun *)
  963. CodeGen.EmitTypedOp(6, 4); (*{0d02-0d04}*)
  964. END;
  965. curDesc.raw[1] := 2; (*{0d06-0d08}*)
  966. ELSE
  967. CodeGen.QueueConst(CARDINAL(acc)); (*{0d0b-0d0d} FIXME *)
  968. curDesc.raw[1] := 0; (*{0d0e-0d10} const set *)
  969. curDesc.raw[2] := CARDINAL(acc); (*{0d11-0d13} FIXME *)
  970. END;
  971. curDesc.raw[0] := t1; (*{0d14-0d16} FIXME pun *)
  972. END CheckRelationTypes;
  973. PROCEDURE EmitCompare;
  974. VAR t: ADDRESS;
  975. BEGIN
  976. IF Scanner.curSym = 66 THEN (* NOT *) (*{0d1c-0d21}*)
  977. Scanner.GetSym; (*{0d23}*)
  978. EmitCompare; (* with_frame proc50 *) (*{0d25}*)
  979. ConstToCard(Compiler.BooleanType, 66); (* proc7 *) (*{0d28-0d2c}*)
  980. IF curDesc.raw[1] = 0 THEN (*{0d2d-0d30}*)
  981. CodeGen.DiscardPending; (*{0d32}*)
  982. curDesc.raw[2] := NOT curDesc.raw[2]; (*{0d34-0d39} FIXME pun *)
  983. EmitDescriptor2(curDesc); (* proc2 *) (*{0d3a-0d3d}*)
  984. ELSE
  985. CodeGen.EmitStandardOp(3); (*{0d3d-0d3f}*)
  986. END;
  987. RETURN;
  988. END;
  989. IF Scanner.curSym IN BITSET{43..47} THEN (*{0d43-0d49} FIXME set TBD *)
  990. IF Scanner.AcceptSy(43) THEN (* '(' expr ')' *) (*{0d4b-0d4f}*)
  991. BoolCondHelper; (* proc12 *) (*{0d51}*)
  992. Scanner.ExpectSy(5); (*{0d52-0d53} ')' *)
  993. ELSE
  994. Scanner.GetSym; (*{0d57}*)
  995. CheckRelationTypes(Compiler.BitsetType); (* proc51 *) (*{0d59-0d5b}*)
  996. END;
  997. RETURN;
  998. END;
  999. Scanner.PushWith; (*{0d5f}*)
  1000. t := Scanner.litType; (*{0d61-0d63} FIXME: ADDRESS := RecordPtr pun *)
  1001. curDesc.raw[0] := t; (*{0d64-0d66} FIXME *)
  1002. IF ~ Scanner.isLit THEN (*{0d67-0d69}*)
  1003. curDesc.raw[1] := 0; (*{0d6b-0d6d}*)
  1004. IF t = Compiler.charArrayDesc THEN (*{0d6e-0d72} FIXME: group hedged CHAR/str *)
  1005. Scanner.CopyStr(curDesc, Scanner.tokBuf); (*{0d74-0d7b} FIXME: (dest,src) vs DEF order *)
  1006. curDesc.raw[3] := 0; (*{0d7e-0d80}*)
  1007. ELSIF Words(t)^[4] IN BITSET{384} THEN (*{0d83-0d89} FIXME set TBD *)
  1008. IF Words(t)^[3] = 8 THEN (*{0d8b-0d8f} LONGREAL *)
  1009. FoldRelation(); (* proc47; result dropped FIXME *)
  1010. ELSE
  1011. curDesc.raw[2] := Scanner.cardVal; (*{0d99-0d9d}*)
  1012. END;
  1013. ELSE
  1014. curDesc.raw[2] := Scanner.cardVal; (*{0da1-0da4}*)
  1015. END;
  1016. EmitDescriptor2(curDesc); (* proc2 *) (*{0da5}*)
  1017. Scanner.GetSym; (*{0da7}*)
  1018. RETURN;
  1019. END;
  1020. CASE Scanner.identKd OF (*{0dab-0daf} *)
  1021. | 1: (* const *) (*{0daf}*)
  1022. curDesc.raw[1] := 0; (*{0db0-0db2}*)
  1023. curDesc.raw[2] := curDesc.raw[2]; (*{0db3-0db7} FIXME: const value copy TBD *)
  1024. EmitDescriptor2(curDesc); (* proc2 *) (*{0db9-0dba}*)
  1025. Scanner.GetSym; (*{0dbb}*)
  1026. | 3: (* parenthesised / builtin *) (*{0dbe}*)
  1027. Scanner.GetSym; (*{0dbe}*)
  1028. Scanner.TestR40(40); (*{0dc0-0dc2} FIXME arity *)
  1029. IF Scanner.AcceptSy(45) THEN (*{0dc4-0dc8}*)
  1030. MatchOpClass(16, 45); (* proc9 *) (*{0dca-0dce}*)
  1031. CheckRelationTypes(t); (* nested proc51 *) (*{0dcf-0dd0}*)
  1032. ELSE
  1033. MatchOpClass(511, 43); (* proc9 *) (*{0dd4-0dd9}*)
  1034. Scanner.GetSym; (*{0dda}*)
  1035. BoolCondHelper; (* proc12 *) (*{0ddc}*)
  1036. MatchOpClass(511, 0); (* proc9 *) (*{0ddd-0de1} FIXME errCode 0 *)
  1037. IF (Words(t)^[3] + 1) DIV 2 # (Words(curDesc.raw[0])^[3] + 1) DIV 2 THEN
  1038. Errors.ReportError(66); (*{0de2-0e00} FIXME pun *)
  1039. END;
  1040. curDesc.raw[0] := t; (*{0df1-0df4} FIXME *)
  1041. curDesc.raw[1] := 2; (*{0df5-0df7}*)
  1042. Scanner.ExpectSy(5); (*{0df8} ')' *)
  1043. END;
  1044. | 4: (* designator *) (*{0dfb}*)
  1045. ParseDesignatorTail; (* proc15 *) (*{0dfb}*)
  1046. IF Scanner.curSym = 43 THEN (* '(' call *) (*{0dfc-0e01}*)
  1047. Scanner.GetSym; (*{0e03}*)
  1048. MatchOpClass(512, 43); (* proc9 *) (*{0e05-0e0a}*)
  1049. IF Words(t)^[2] # 0 THEN Errors.ReportError(60) END; (*{0e0b-0e10} FIXME *)
  1050. StoreOperand; (* proc19 *) (*{0e11}*)
  1051. ELSE
  1052. EmitDescriptor2(curDesc); (* proc2 *) (*{0e15-0e16}*)
  1053. END;
  1054. | 5: (* variable load path *) (*{0e18}*)
  1055. IF t # NIL THEN Errors.ReportError(60) END; (*{0e18-0e1c} FIXME *)
  1056. LoadOperand; (* proc18 *) (*{0e1d}*)
  1057. | 0: (* illegal *) (*{0e20}*)
  1058. Errors.ReportErrorWithText(128, Scanner.tokBuf); (*{0e20-0e25} *)
  1059. | 2:
  1060. Errors.ReportError(22); (*{0e3b-0e3d} *)
  1061. END;
  1062. CheckAndStore(); (* proc22 FIXME arity *) (*{0e3f-0e40}*)
  1063. END EmitCompare;
  1064. PROCEDURE EmitRangeCheck;
  1065. VAR buf: Desc;
  1066. op: CARDINAL;
  1067. rkind: CARDINAL;
  1068. savePend: CARDINAL;
  1069. saveMode: CARDINAL;
  1070. isZero: BOOLEAN;
  1071. BEGIN
  1072. EmitCompare; (* nested proc50 *) (*{0e4a}*)
  1073. IF ~(Scanner.curSym IN BITSET{51..57}) THEN (*{0e4c-0e54} FIXME set *)
  1074. RETURN;
  1075. END;
  1076. EmitOp(); (* proc6 *) (*{0e57}*)
  1077. op := Scanner.curSym; (*{0e58-0e5b}*)
  1078. IF op = 64 THEN (* AND *) (*{0e5b-0e5f}*)
  1079. ConstToCard(Compiler.BooleanType, 64); (* proc7 *) (*{0e61-0e63}*)
  1080. Scanner.GetSym; (*{0e65}*)
  1081. IF curDesc.raw[1] = 0 THEN (*{0e67-0e6a}*)
  1082. CodeGen.DiscardPending; (*{0e6c}*)
  1083. savePend := CodeGen.pendMode; saveMode := curDesc.raw[2]; (*{0e6e-0e84} *)
  1084. CodeGen.pendMode := savePend AND saveMode; (*{0e85-0e8c} FIXME pun *)
  1085. EmitCompare; (*{0e8a}*)
  1086. ConstToCard(Compiler.BooleanType, 64); (*{0e8c-0e90}*)
  1087. CodeGen.pendMode := savePend; (*{0e92-0e93}*)
  1088. IF saveMode = 0 THEN (*{0e94-0e96}*)
  1089. curDesc.raw[1] := 0; curDesc.raw[2] := 0; (*{0e98-0e9d}*)
  1090. EmitDescriptor2(curDesc); (* proc2 *) (*{0e9e-0ea4}*)
  1091. END;
  1092. ELSE
  1093. CodeGen.EmitStandardOp(11); (*{0e92}*)
  1094. CodeGen.OpenFixup(saveMode, TRUE); (* proc12 *) (*{0e95-0e99} FIXME: CARDINAL VAR pun *)
  1095. EmitCompare; (*{0e9a}*)
  1096. ConstToCard(Compiler.BooleanType, 64); (*{0e9c-0ea0}*)
  1097. CodeGen.InsertFixup(saveMode, TRUE); (* proc14 *) (*{0ea1-0ea3} FIXME *)
  1098. Errors.ReportError(91); (*{0ea5-0ea7}*)
  1099. curDesc.raw[1] := 2; (*{0ea8-0eaa}*)
  1100. END;
  1101. RETURN;
  1102. END;
  1103. buf := curDesc; (*{0eae-0eb1}*)
  1104. IF op = 60 THEN rkind := 404; (* IN *) (*{0eb2-0eb6} FIXME magic *)
  1105. ELSIF op = 63 THEN rkind := 272;
  1106. ELSE rkind := 132; END; (*{0eca-0ecc} *)
  1107. MatchOpClass(rkind, op); (* proc9 *) (*{0ecd-0ecf}*)
  1108. Scanner.GetSym; (*{0ed0-0ed1}*)
  1109. EmitCompare; (*{0ed2}*)
  1110. EmitOp(); (* proc6 *) (*{0ed4}*)
  1111. MatchOpClass(rkind, op); (* proc9 *) (*{0ed5-0ed7}*)
  1112. FoldConstOp(buf); (* proc35 FIXME: kind result TBD *) (*{0ed8-0ed9}*)
  1113. rkind := TypeKindOf(); (* proc27 FIXME: 0-arg vs use *) (*{0edb}*)
  1114. IF op = 63 THEN op := 61 END; (*{0ede-0ee2}*)
  1115. IF (curDesc.raw[1] = 0) AND (buf.raw[1] = 0) THEN (*{0ee7-0eef} both const *)
  1116. CodeGen.DiscardPending; (*{0ef2}*)
  1117. CodeGen.DiscardPending; (*{0ef4}*)
  1118. IF op = 60 THEN (* '*' *) (*{0ef6-0efa}*)
  1119. CASE buf.raw[0] OF (* FIXME: ADDRESS case-selector pun; kinds below TBD *)
  1120. 0: curDesc.raw[2] := buf.raw[2] * curDesc.raw[2]; (* umul_checked *) (*{0eff-0f06} FIXME arith pun *)
  1121. | 1: curDesc.raw[2] := buf.raw[2] * curDesc.raw[2]; (* imul *) (*{0f07-0f0e} FIXME *)
  1122. | 2: curDesc.raw[2] := buf.raw[2] * curDesc.raw[2]; (* dmul FIXME *) (*{0f0f-0f19} *)
  1123. | 3: curDesc.raw[2] := buf.raw[2] * curDesc.raw[2]; (* real_mul FIXME *) (*{0f1a-0f23} *)
  1124. | 4: curDesc.raw[2] := buf.raw[2] AND curDesc.raw[2]; (* and FIXME *) (*{0f25-0f2c} *)
  1125. END;
  1126. FoldLongRelation(buf); (* FIXME: DOUBLES.qmul + proc47 *)
  1127. ELSIF op = 61 THEN (* '/' zero check + div family *) (*{0f4e-0f52}*)
  1128. IF rkind <= 1 THEN (*{0f54-0f57}*)
  1129. IF curDesc.raw[2] = 0 THEN isZero := curDesc.raw[2] = 0 END; (*{0f59-0f5d} FIXME *)
  1130. ELSIF rkind <= 3 THEN
  1131. isZero := curDesc.raw[2] = 0; (* FIXME: real_compare *)
  1132. ELSIF rkind = 5 THEN
  1133. isZero := FALSE; (* FIXME: Doubles.qcp LONGREAL compare *)
  1134. END;
  1135. IF isZero THEN Errors.ReportError(76) END; (*{0f89-0f8e} div by zero *)
  1136. CASE buf.raw[0] OF (*{0f90-0f91} FIXME pun *)
  1137. 0: curDesc.raw[2] := buf.raw[2] DIV curDesc.raw[2]; (* udiv *) (*{0f93-0f9a} FIXME *)
  1138. | 1: curDesc.raw[2] := buf.raw[2] DIV curDesc.raw[2]; (* idiv *) (*{0f9b-0fa2} FIXME *)
  1139. | 2: curDesc.raw[2] := buf.raw[2] DIV curDesc.raw[2]; (* ddiv FIXME *) (*{0fa3-0fad} *)
  1140. | 3: curDesc.raw[2] := buf.raw[2] DIV curDesc.raw[2]; (* real_div FIXME *) (*{0fae-0fb8} *)
  1141. | 4: curDesc.raw[2] := BITSET(buf.raw[2]) / curDesc.raw[2]; (* xor FIXME *) (*{0fb9-0fc0} *)
  1142. END;
  1143. FoldLongDiv(buf); (* FIXME: Doubles.qdiv + proc47 *)
  1144. ELSIF rkind = 2 THEN (*{0fe2-0fe5} LONGINT MOD *)
  1145. curDesc.raw[2] := buf.raw[2] MOD curDesc.raw[2]; (*{0fe7-0fef} FIXME *)
  1146. ELSE
  1147. curDesc.raw[2] := buf.raw[2] MOD curDesc.raw[2]; (*{0ff3-0ff9} umod *)
  1148. END;
  1149. EmitDescriptor2(curDesc); (* proc2 *) (*{0ffa-0ffb}*)
  1150. ELSE
  1151. curDesc.raw[1] := 2; (*{0ffe-1000}*)
  1152. IF (3 IN Scanner.scanOpt) AND (op = 60) AND (rkind = 0) THEN (*{1001-100e}*)
  1153. CodeGen.EmitExtendedOp(op - 52, rkind); (* checked *) (*{1011-1015}*)
  1154. ELSE
  1155. CodeGen.EmitTypedOp(op - 52, rkind); (* plain *) (*{1019-101d}*)
  1156. END;
  1157. END;
  1158. END EmitRangeCheck;
  1159. PROCEDURE ParseSimpleExpression;
  1160. VAR buf: Desc;
  1161. op: CARDINAL;
  1162. t: ADDRESS;
  1163. savePend, saveMode: CARDINAL;
  1164. BEGIN
  1165. IF Scanner.curSym IN BITSET{58..60} THEN (* unary +/- *) (*{102a-1030} FIXME *)
  1166. IF Scanner.AcceptSy(59) THEN (* '-' *) (*{1032-1036}*)
  1167. EmitRangeCheck; (* nested proc49 *) (*{1038}*)
  1168. EmitOp(); (* proc6 *) (*{103a}*)
  1169. MatchOpClass(388, 59); (* proc9 *) (*{103b-1040}*)
  1170. t := TypeKindOf(); (* proc27 FIXME: 0-arg; t role TBD *) (*{1041-1043}*)
  1171. IF t = NIL THEN t := Compiler.CardType; ConstToCard(t, 59); END; (*{1044-104c} FIXME *)
  1172. IF curDesc.raw[1] = 0 THEN (* const negation *) (*{104d-1050}*)
  1173. CodeGen.DiscardPending; (*{1052}*)
  1174. CASE Words(t)^[4] OF (*{1054-1076} FIXME pun *)
  1175. 2: curDesc.raw[2] := curDesc.raw[2]; (* long_negate FIXME *)
  1176. | 3: curDesc.raw[2] := curDesc.raw[2]; (* FIXME *)
  1177. | 5: curDesc.raw[2] := curDesc.raw[2]; (* FIXME: Doubles.qneg *)
  1178. | 4: curDesc.raw[2] := curDesc.raw[2]; (* complement+inc FIXME *)
  1179. END;
  1180. curDesc.raw[0] := Compiler.CardType; (*{108b-108e} FIXME *)
  1181. ELSE
  1182. CodeGen.EmitTypedOp(11, Words(t)^[4]); (* unary minus *) (*{1093-1095} FIXME *)
  1183. END;
  1184. ELSE
  1185. Scanner.GetSym; (*{1099} '+' skip *)
  1186. EmitRangeCheck; (*{109b}*)
  1187. EmitOp(); (* proc6 *) (*{109d}*)
  1188. MatchOpClass(388, 58); (* proc9 '+' *) (*{109e-10a3}*)
  1189. END;
  1190. ELSE
  1191. EmitRangeCheck; (*{10a6}*)
  1192. END;
  1193. WHILE Scanner.curSym IN BITSET{51..57} DO (* +,-,OR *) (*{10a8-10b0} FIXME *)
  1194. op := Scanner.curSym; (*{10b3-10b5}*)
  1195. EmitOp(); (* proc6 *) (*{10b6}*)
  1196. IF op = 65 THEN (* OR *) (*{10b7-10bb} FIXME: 65 outside 51..57 loop? TBD *)
  1197. ConstToCard(Compiler.BooleanType, 65); (* proc7 *) (*{10bd-10c1}*)
  1198. Scanner.GetSym; (*{10c2}*)
  1199. IF curDesc.raw[1] = 0 THEN (*{10c4-10c7}*)
  1200. CodeGen.DiscardPending; (*{10c9}*)
  1201. savePend := CodeGen.pendMode; saveMode := curDesc.raw[2]; (*{10cb-10d6} *)
  1202. CodeGen.pendMode := savePend OR (NOT saveMode); (*{10d1-10d6} FIXME pun *)
  1203. EmitRangeCheck; (*{10d8}*)
  1204. ConstToCard(Compiler.BooleanType, 65); (*{10da-10de}*)
  1205. CodeGen.pendMode := savePend; (*{10df-10e0}*)
  1206. IF saveMode # 0 THEN (*{10e2-10e3}*)
  1207. curDesc.raw[1] := 0; curDesc.raw[2] := 1; (*{10e5-10eb}*)
  1208. EmitDescriptor2(curDesc); (* proc2 *) (*{10ec}*)
  1209. END;
  1210. ELSE
  1211. CodeGen.EmitStandardOp(12); (*{10ef-10f0}*)
  1212. CodeGen.OpenFixup(saveMode, TRUE); (* proc12 *) (*{10f2-10f5} FIXME pun *)
  1213. EmitRangeCheck; (*{10f7}*)
  1214. ConstToCard(Compiler.BooleanType, 65); (*{10f9-10fd}*)
  1215. CodeGen.InsertFixup(saveMode, TRUE); (* proc14 *) (*{10fe-1100} FIXME *)
  1216. Errors.ReportError(91); (*{1102-1104}*)
  1217. curDesc.raw[1] := 2; (*{1105-1107}*)
  1218. END;
  1219. ELSE
  1220. buf := curDesc; (*{110b-110e}*)
  1221. MatchOpClass(404, op); (* proc9 *) (*{110f-1114}*)
  1222. Scanner.GetSym; (*{1115}*)
  1223. EmitRangeCheck; (*{1116}*)
  1224. EmitOp(); (* proc6 *) (*{1118}*)
  1225. MatchOpClass(404, op); (* proc9 *) (*{1119-111e}*)
  1226. FoldConstOp(buf); (* proc35 FIXME: kind result TBD *) (*{111f}*)
  1227. t := TypeKindOf(); (* proc27 FIXME *) (*{1121}*)
  1228. IF (curDesc.raw[1] = 0) AND (buf.raw[1] = 0) THEN (*{1124-112c}*)
  1229. CodeGen.DiscardPending; (*{112e}*)
  1230. CodeGen.DiscardPending; (*{1130}*)
  1231. IF op = 58 THEN (* '+' *) (*{1132-1136}*)
  1232. CASE Words(t)^[4] OF (*{1138-1139} FIXME pun *)
  1233. 0: curDesc.raw[2] := buf.raw[2] + curDesc.raw[2]; (* uadd_checked *) (*{113b-1142} FIXME *)
  1234. | 1: curDesc.raw[2] := buf.raw[2] + curDesc.raw[2]; (* iadd_checked *) (*{1143-114a} FIXME *)
  1235. | 2: curDesc.raw[2] := buf.raw[2] + curDesc.raw[2]; (* dadd FIXME *) (*{114b-1155} *)
  1236. | 3: curDesc.raw[2] := buf.raw[2] + curDesc.raw[2]; (* real_add FIXME *) (*{1156-1160} *)
  1237. | 4: curDesc.raw[2] := buf.raw[2] OR curDesc.raw[2]; (* or; FIXME pun *) (*{1161-1168} *)
  1238. END;
  1239. FoldLongAdd(buf); (* FIXME: Doubles.qadd + proc47 *)
  1240. ELSIF t = NIL THEN (* '-' family *) (*{118a-118b}*)
  1241. CASE buf.raw[0] OF (* FIXME pun *)
  1242. 2: curDesc.raw[2] := buf.raw[2] - curDesc.raw[2]; (* dsub FIXME *)
  1243. | 3: curDesc.raw[2] := buf.raw[2] - curDesc.raw[2]; (* real_sub FIXME *)
  1244. | 4: curDesc.raw[2] := buf.raw[2] - curDesc.raw[2]; (* diff FIXME *)
  1245. | 5: curDesc.raw[2] := buf.raw[2] - curDesc.raw[2]; (* FIXME: Doubles.qsub *)
  1246. END;
  1247. ELSIF (t = NIL) OR ((buf.raw[2] >= 0) AND (curDesc.raw[2] > buf.raw[2])) THEN
  1248. curDesc.raw[0] := Compiler.CardType; (* CARD result *) (*{11ca-11de} FIXME: group wrote word6 *)
  1249. END;
  1250. IF curDesc.raw[0] = Compiler.CardType THEN (*{11df-11e4}*)
  1251. IF buf.raw[0] = Compiler.CardType THEN
  1252. curDesc.raw[2] := buf.raw[2] - curDesc.raw[2]; (* isub_checked *) (*{11e6-11ec} FIXME *)
  1253. ELSE
  1254. curDesc.raw[2] := buf.raw[2] - curDesc.raw[2]; (* usub_checked *) (*{11ef-11f5} FIXME *)
  1255. END;
  1256. END;
  1257. EmitDescriptor2(curDesc); (* proc2 *) (*{11f6}*)
  1258. ELSE
  1259. curDesc.raw[1] := 2; (*{11fa-11fc}*)
  1260. IF (3 IN Scanner.scanOpt) AND (Words(t)^[4] <= 1) THEN
  1261. CodeGen.EmitExtendedOp(op - 52, Words(t)^[4]); (* checked *) (*{1208-120c} FIXME *)
  1262. ELSE
  1263. CodeGen.EmitTypedOp(op - 52, Words(t)^[4]); (* plain *) (*{1210-1214} FIXME *)
  1264. END;
  1265. END;
  1266. END;
  1267. END;
  1268. END ParseSimpleExpression;
  1269. PROCEDURE ParseExpression;
  1270. VAR buf: Desc;
  1271. op: CARDINAL;
  1272. cls: CARDINAL;
  1273. rkind: CARDINAL;
  1274. cres: CARDINAL;
  1275. BEGIN
  1276. ParseSimpleExpression; (* nested proc48 *) (*{1226}*)
  1277. op := Scanner.curSym; (*{1228-122b}*)
  1278. IF (op < 51) OR (op > 57) THEN (*{122b-1238} not a relop *)
  1279. IF op # 0 THEN Errors.ReportError(75) END; (*{13e4} shared exit *)
  1280. RETURN;
  1281. END;
  1282. EmitOp(); (* proc6 *) (*{1239}*)
  1283. buf := curDesc; (*{123a-123d}*)
  1284. Scanner.AcceptSy(51); (* '=' consume *) (*{123d-1241}*)
  1285. IF Scanner.curSym = 0 THEN (*{1241} FIXME: literal-rhs fast path? *)
  1286. ParseSimpleExpression; (*{1243}*)
  1287. MatchOpClass(16, 51); (* proc9 '=' *) (*{1245-124a}*)
  1288. FoldConstOp(buf); (* proc35 both sides *) (*{124c-1257} FIXME kind TBD *)
  1289. IF (curDesc.raw[1] = 0) AND (buf.raw[1] = 0) THEN (*{125a}*)
  1290. CodeGen.DiscardPending; (*{125c}*)
  1291. CodeGen.DiscardPending; (*{125e}*)
  1292. curDesc.raw[2] := buf.raw[2]; (* IN-fold FIXME pun *) (*{1260-1266}*)
  1293. EmitDescriptor2(curDesc); (* proc2 *) (*{1267-1268}*)
  1294. ELSE
  1295. curDesc.raw[1] := 2; (*{126b-126d}*)
  1296. CodeGen.EmitStandardOp(4); (* '=' compare *) (*{126e-1270}*)
  1297. END;
  1298. ELSIF IsOrdinalType(curDesc.raw[0]) THEN (* proc26 FIXME NYC *)
  1299. ExpectBoolOrSet(); (* proc25 FIXME NYC *)
  1300. Scanner.GetSym; (*{127d}*)
  1301. ParseSimpleExpression; (*{127f}*)
  1302. CheckAssignable(buf); (* proc36 FIXME: 0-arg vs Desc arg *)
  1303. IF ~ IsOrdinalType(curDesc.raw[0]) THEN (*{1284-1289}*)
  1304. FoldConstOp(buf); (* proc35 *) (*{128a-128c}*)
  1305. END;
  1306. buf := EmitSetMember(buf); (* proc11 pair FIXME NYC *)
  1307. CodeGen.EmitStandardOp(7); (* IN test *) (*{1292-1294}*)
  1308. CodeGen.EmitSystemCall(23); (*{1296-1298} bounds trap *)
  1309. CodeGen.EmitTypedOp(op - 52, 0); (*{1299-1301}*)
  1310. curDesc.raw[1] := 2; (*{1302-1304}*)
  1311. ELSE
  1312. IF op <= 53 THEN cls := 501; (* =,#,IN class *) (*{12a5-12ac} FIXME magic *)
  1313. ELSIF op <= 55 THEN cls := 389; (* <,<= class *) (*{12b1-12ba} FIXME *)
  1314. ELSE cls := 405; END; (* >,>= class *) (*{12bd-12c1} *)
  1315. MatchOpClass(cls, op); (* proc9 *) (*{12c1-12c4}*)
  1316. Scanner.GetSym; (*{12c5}*)
  1317. ParseSimpleExpression; (*{12c6}*)
  1318. EmitOp(); (* proc6 *) (*{12c8}*)
  1319. MatchOpClass(cls, op); (* proc9 *) (*{12c9-12cb}*)
  1320. FoldConstOp(buf); (* proc35 *) (*{12cc-12cd}*)
  1321. rkind := TypeKindOf(); (* proc27 FIXME *) (*{12cf-12d1}*)
  1322. IF (curDesc.raw[1] = 0) AND (buf.raw[1] = 0) THEN (*{12d2-12da}*)
  1323. CodeGen.DiscardPending; (*{12dc}*)
  1324. CodeGen.DiscardPending; (*{12de}*)
  1325. cres := 0; (*{12e0-12e2}*)
  1326. CASE Words(buf.raw[0])^[4] OF (*{12e2-12e3} FIXME pun *)
  1327. 0: (* CARDINAL unsigned *) (*{12e5}*)
  1328. IF buf.raw[2] > curDesc.raw[2] THEN cres := 2;
  1329. ELSIF buf.raw[2] < curDesc.raw[2] THEN cres := 1; END; (*{12e5-12f8} *)
  1330. | 1: (* INTEGER signed *) (*{12fa}*)
  1331. IF buf.raw[2] > curDesc.raw[2] THEN cres := 2;
  1332. ELSIF buf.raw[2] < curDesc.raw[2] THEN cres := 1; END; (*{12fa-130d} *)
  1333. | 2: (* LONGINT *) (*{130f}*)
  1334. IF buf.raw[2] > curDesc.raw[2] THEN cres := 2;
  1335. ELSIF buf.raw[2] < curDesc.raw[2] THEN cres := 1; END; (* FIXME: dcompare *)
  1336. | 3: (* REAL *) (*{132a}*)
  1337. IF buf.raw[2] > curDesc.raw[2] THEN cres := 2;
  1338. ELSIF buf.raw[2] < curDesc.raw[2] THEN cres := 1; END; (* FIXME: real_compare *)
  1339. | 4: (* BITSET/WORD set equality limbs *) (*{1345}*)
  1340. IF buf.raw[2] # curDesc.raw[2] THEN
  1341. IF BITSET(buf.raw[2]) * BITSET(NOT curDesc.raw[2]) = {} THEN cres := 2;
  1342. ELSIF BITSET(curDesc.raw[2]) * BITSET(NOT buf.raw[2]) = {} THEN cres := 1; END;
  1343. END; (*{1349-1366} FIXME: CARDINAL BITSET/NOT puns *)
  1344. END;
  1345. CASE buf.raw[0] OF (* LONGREAL tail *) (*{1368} FIXME: ADDRESS case pun *)
  1346. NIL: ;
  1347. ELSE
  1348. cres := cres; (* FIXME: Doubles.qcp LONGREAL compare *)
  1349. END;
  1350. CASE op OF (* map cres -> boolean *) (*{139d-13bc}*)
  1351. 51: curDesc.raw[2] := ORD(cres = 0); (* '=' *) (*{13a0}*)
  1352. | 52: curDesc.raw[2] := ORD(cres # 0); (* '#' *) (*{13a5}*)
  1353. | 53: curDesc.raw[2] := ORD(cres = 1); (* '<' *) (*{13aa}*)
  1354. | 54: curDesc.raw[2] := ORD(cres = 2); (* '<=' *) (*{13b0} FIXME limbs *)
  1355. | 55: curDesc.raw[2] := ORD(cres # 2); (* '>' *) (*{13b6}*)
  1356. ELSE curDesc.raw[2] := ORD(cres # 1); (* '>=' / IN *) (*{13cd-13d1}*)
  1357. END;
  1358. EmitDescriptor2(curDesc); (* proc2 *) (*{13d2-13d3}*)
  1359. ELSE
  1360. curDesc.raw[1] := 2; (*{13d6-13d8}*)
  1361. CodeGen.EmitTypedOp(op - 52, rkind); (* general relop; FIXME pun *) (*{13d9-13dd}*)
  1362. END;
  1363. END;
  1364. curDesc.raw[0] := Compiler.BooleanType; (* BOOLEAN result *) (*{13df-13e2} *)
  1365. END ParseExpression;
  1366. PROCEDURE GetConstVal;
  1367. BEGIN
  1368. BoolCondHelper; (* proc12 *) (*{13f5}*)
  1369. IF curDesc.raw[1] # 0 THEN Errors.ReportError(25) END; (*{13f6-13fb}*)
  1370. CodeGen.DiscardPending; (*{13fc-13fe}*)
  1371. END GetConstVal;
  1372. PROCEDURE GetTypeDesc(src: ADDRESS; dest: ADDRESS; mode: CARDINAL);
  1373. BEGIN
  1374. GetConstVal; (* proc13 *) (*{1402}*)
  1375. EmitOp(); (* proc6 *) (*{1403}*)
  1376. ConstToCard(src, 0); (* proc7 *) (*{1404-1406} FIXME: (c,errPos) vs call shape *)
  1377. PopExprDesc(src); (* proc5 FIXME: DescPtr vs ADDRESS *)
  1378. IF (curDesc.raw[0] # Compiler.CardType) OR (curDesc.raw[2] < 0) THEN
  1379. Errors.ReportError(80); (*{1409-1416} *)
  1380. END;
  1381. Words(dest)^[0] := curDesc.raw[2]; (*{1417-141e} FIXME pun *)
  1382. IF Scanner.AcceptSy(4) THEN (* ',' second bound *) (*{141f-1422}*)
  1383. GetConstVal; (*{1424}*)
  1384. EmitOp(); (*{1426}*)
  1385. ConstToCard(src, 0); (*{1427-0429} *)
  1386. PopExprDesc(src); (*{042a} *)
  1387. IF (curDesc.raw[0] # Compiler.CardType) OR (curDesc.raw[2] < 0) THEN
  1388. Errors.ReportError(80); (*{142b-1438} *)
  1389. END;
  1390. IF curDesc.raw[2] < Words(dest)^[0] THEN Errors.ReportError(46) END; (*{143a-1440} FIXME *)
  1391. Words(dest)^[0] := curDesc.raw[2]; (*{1441-1444} upper bound *)
  1392. END;
  1393. END GetTypeDesc;
  1394. PROCEDURE CheckAssignmentCompat(dst: ADDRESS);
  1395. BEGIN
  1396. IF ~ BaseTypeOf(dst, curDesc.raw[0]) THEN (* proc34 FIXME: 2-param vs use *)
  1397. Errors.ReportIncompatibleTypes(dst, curDesc.raw[0], " assignment"); (*{1456-1469} FIXME T1 pun *)
  1398. END;
  1399. END CheckAssignmentCompat;
  1400. PROCEDURE ParseAssignment;
  1401. VAR saved: Desc;
  1402. BEGIN
  1403. assignActive := 1; (*{1473-1474} global8 *)
  1404. IF curDesc.raw[4] > 9 THEN (*{1475-1480} set-ctor rhs? *)
  1405. EmitDescriptor2(curDesc); (* FIXME: proc2 via proc10? *)
  1406. ELSIF curDesc.raw[4] = 4 THEN (*{1480-1484} string/const rhs? *)
  1407. EmitDescriptor2(curDesc); (* FIXME: proc10 *)
  1408. END;
  1409. curDesc.raw[4] := 2; curDesc.raw[3] := 0; (*{1488-1490}*)
  1410. saved := curDesc; (*{148e-1491}*)
  1411. IF (Scanner.identKd = 5) AND (Words(curDesc.raw[0])^[4] = 9) THEN (* func result? *) (*{1492-149d} FIXME *)
  1412. ParseDesignatorBase(saved.raw[0], saved.raw[2], saved.raw[5], saved.raw[6]); (* proc21; FIXME: 4-formal roles TBD *)
  1413. CheckForwardRef(); (* proc29 FIXME NYC *)
  1414. PopExprDesc(saved); (* proc3 FIXME: Desc value vs DescPtr *)
  1415. Scanner.GetSym; (*{14b1}*)
  1416. ELSE
  1417. BoolCondHelper; (* proc12 *) (*{14b7}*)
  1418. CheckAssignable2(saved.raw[0]); (* proc26 FIXME NYC *)
  1419. IF ~ CheckAssignable2(saved.raw[0]) THEN (*{14bc}*)
  1420. CheckAssignable2(saved.raw[0]); (* proc52 nested FIXME NYC *)
  1421. END;
  1422. IF (curDesc.raw[0] # saved.raw[0]) AND (curDesc.raw[1] # 0) THEN (*{14cb-14d5}*)
  1423. Errors.DerefAliasType(0); (* proc25 FIXME NYC: arg TBD *)
  1424. END;
  1425. IF (curDesc.raw[2] # 0) AND (saved.raw[2] # 0) THEN (*{14da-14e4}*)
  1426. IF saved.raw[2] - saved.raw[5] = curDesc.raw[2] - curDesc.raw[5] THEN (*{14e6-14f8}*)
  1427. PopExprDesc(saved); (* proc3 FIXME *)
  1428. ELSE
  1429. EmitSetOrArrayAssign(saved); (* proc11 pair FIXME NYC *)
  1430. CodeGen.EmitStandardOp(18); (*{1503-1505}*)
  1431. END;
  1432. ELSE
  1433. CheckAssignable2(saved.raw[0]); (*{1509-150b}*)
  1434. PopExprDesc(saved); (* proc5 *) (*{1510-1511} FIXME *)
  1435. PopExprDesc(saved); (* proc3 *) (*{1511} FIXME *)
  1436. END;
  1437. END;
  1438. assignActive := 0; (*{1512-1513}*)
  1439. END ParseAssignment;
  1440. BEGIN (* proc0 @1516 module init: global9 -> global5 copy; global8 := 0 *)
  1441. exprPool := SymTab.stringPoolPtr; (* FIXME: which string pool? TBD *)
  1442. assignActive := 0;
  1443. END Express.