(* EXPRESS.MOD — DRAFT v1, assembled 2026-10-02, NOT verified. Reconstructed from Reversing-Turbo-Modula2-main/MCode_disassembly/express.txt (3898 lines) by three parallel passes (groups 1 @004a-0358, 2 @0358-0c0c, 3 @0bd2-1516). Does NOT yet recompile to the original MCD; verification via unassemble.c diff is still required (see src/compiler/README.md). Descriptor model (reconciled): one 10-word operand descriptor. Groups used three notations for it — group1 named fields, groups 2/3 numeric (.wordN / [N]) — unified here as Desc with both: named fields AND a raw words view. word0=typ, word1=mode (0=const,1=?,2=computed), word2=value, word3=extra, word4=kind/class, word5=low, word6=high, words7-9=w7..w9. Globals: word2 curDesc, word3 spillTop, word4 spillFlag, word6 constMode, word7 spare7 (use TBD), word8 assignActive, word9 exprPool. NOTE: group1's words 3/4 (exprSpare3/exprFlag4, heap-top bookkeeping) and groups 2/3's words 3/4 (spill save slots) are unified as spillTop/spillFlag; both readings involve saving a top — MCD diff decides. Frame mechanics (proven 2026-10-03 from MCode_specification/Stack.mod: NewFrame puts fp^[3]=LAST pushed word; opcode 03H=LoadParam(3) printed as "param1"): "param1" = LAST pushed word, so multi-param body readings assuming param1=formal1 are backwards; call sites from pushes stay order-correct. Applied: MatchOpClass(allowed, errCode) [was swapped], CentralError(ok, code) [was 1-param]. Full per-proc signature audit PENDING. Numbered-module mappings applied (verified against .DEF orders): - Compiler.IntType..26 = IntType..compilationActive (DEF order = word order). - Scanner.scanOpt/5/6/7/8/9/10/11/12 = scanOptions/curSymbol/isLiteral/ cardValue/curNode/identKind/followSet/tokenBuffer/literalType. Scanner.word13: unknown, kept + FIXME. - CodeGen.word5 = emitEnabled. Doubles.qcp/6/7/8/9/11 = qcp/qadd/qsub/qmul/qdiv/qneg (DEF order = proc order). - Single-arg BaseTypeOf(X) calls = TypeKindOf (proc27); two-arg keeps BaseTypeOf (proc34). ParseCondValue() = BoolCondHelper (proc12). - Errors.ReportErrorWithText 3rd args were HIGH() bounds — stripped. Newly discovered EXPRESS-internal procedures (not in FRONTEND.md map): proc1 CentralError, proc2/3 PushOperand/PopOperand, proc6 EmitOp, proc10 NormalizeOperand, proc11 LoadIndirect, proc12 BoolCondHelper, proc22 CheckAndStore, proc25 GetRangeBase, proc26 IsPointer, proc27 TypeKindOf, proc28 EmitAddress, proc29 ParseActualList, proc31 EmitIndexed, AAAAAA = Z80 stubs. Declared FORWARD = work list. Pass1.CondInsert/InsertEntry referenced but PASS1 has no source yet. Known invalid-but-faithful constructs (pun notes, verification must resolve): CARDINAL<->BITSET/ADDRESS punning, CARDINAL word3/word5 arithmetic on type nodes, BITSET{51..57}-style membership tests on CARDINAL curSymbol, CARDINAL class masks passed as BITSET, LONGREAL double-word puns (marked FIXME-LONGREAL), raw STACK[n]/FRAME^.tag reads kept verbatim. *) IMPLEMENTATION MODULE Express; IMPORT Compiler, Scanner, Errors, CodeGen, SymTab, Pass1, Doubles; FROM SYSTEM IMPORT ADDRESS, ADR, MOVE, WORD; (* 10-word operand descriptor: named view + raw words view (same layout). *) TYPE DescPtr = POINTER TO Desc; Desc = RECORD CASE : BOOLEAN OF | TRUE: typ: ADDRESS; (* word0: type descriptor *) mode: CARDINAL; (* word1: 0=const *) value: CARDINAL; (* word2: const value / offset *) extra: CARDINAL; (* word3 *) kind: CARDINAL; (* word4: type class tag *) low: CARDINAL; (* word5 *) high: CARDINAL; (* word6 *) w7: CARDINAL; w8: CARDINAL; w9: CARDINAL; | FALSE: raw: ARRAY [0..9] OF WORD; END; END; Words = POINTER TO ARRAY [0..9] OF WORD; VAR curDesc: Desc; (* word2: current operand descriptor *) spillTop: CARDINAL; (* word3 *) spillFlag: CARDINAL; (* word4 *) constMode: CARDINAL; (* word6 *) spare7: CARDINAL; (* word7: use TBD *) assignActive: CARDINAL; (* word8 *) exprPool: ADDRESS; (* word9 *) (* ---- unresolved EXPRESS-internal helpers: FORWARD = work list ---- *) 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 *) (*FIXME-NYC*) PROCEDURE PushOperand; FORWARD; (* proc2 *) (*FIXME-NYC*) PROCEDURE PopOperand; FORWARD; (* proc3 *) (*FIXME-NYC*) PROCEDURE EmitOp; FORWARD; (* proc6 *) (*FIXME-NYC*) PROCEDURE NormalizeOperand; FORWARD; (* proc10 *) (*FIXME-NYC*) PROCEDURE LoadIndirect; FORWARD; (* proc11 *) (*FIXME-NYC*) PROCEDURE BoolCondHelper; FORWARD; (* proc12 *) (*FIXME-NYC*) PROCEDURE CheckAndStore; FORWARD; (* proc22, arity TBD *) (*FIXME-NYC*) PROCEDURE GetRangeBase; FORWARD; (* proc25 *) (*FIXME-NYC*) PROCEDURE IsPointer(t: CARDINAL): BOOLEAN; FORWARD; (* proc26 *) (*FIXME-NYC*) PROCEDURE TypeKindOf(): CARDINAL; FORWARD; (* proc27 *) (*FIXME-NYC*) PROCEDURE EmitAddress; FORWARD; (* proc28 *) (*FIXME-NYC*) PROCEDURE ParseActualList; FORWARD; (* proc29 *) (*FIXME-NYC*) PROCEDURE EmitIndexed(idx: CARDINAL); FORWARD; (* proc31 *) (*FIXME-NYC*) PROCEDURE PushStringConst; FORWARD; (*FIXME-NYC*) PROCEDURE LookupField(n: CARDINAL): BOOLEAN; FORWARD; (*FIXME-NYC*) PROCEDURE Power2(e: CARDINAL): CARDINAL; FORWARD; (*FIXME-NYC*) PROCEDURE ExpectBoolOrSet; FORWARD; (*FIXME-NYC*) PROCEDURE EmitSetMember(d: Desc): Desc; FORWARD; (*FIXME-NYC*) PROCEDURE IsOrdinalType(t: ADDRESS): BOOLEAN; FORWARD; (*FIXME-NYC*) PROCEDURE CheckForwardRef; FORWARD; (*FIXME-NYC*) PROCEDURE CheckAssignable2(t: ADDRESS); FORWARD; (*FIXME-NYC*) PROCEDURE EmitOperand31(n: ADDRESS); FORWARD; (*FIXME-NYC*) PROCEDURE EmitDescriptor2(d: Desc); FORWARD; (* proc2 *) (*FIXME-NYC*) PROCEDURE FoldLongRelation(d: Desc); FORWARD; (* DOUBLES.qmul + proc47 *) (*FIXME-NYC*) PROCEDURE FoldLongDiv(d: Desc); FORWARD; (* DOUBLES.qdiv + proc47 *) (*FIXME-NYC*) PROCEDURE FoldLongAdd(d: Desc); FORWARD; (* DOUBLES.qadd + proc47 *) (*FIXME-NYC*) PROCEDURE EmitSetOrArrayAssign(d: Desc); FORWARD; (* proc11 pair *) (* Forward refs to group-defined procedures used before definition *) PROCEDURE ParseExpression; FORWARD; PROCEDURE ParseDesignatorTail; FORWARD; PROCEDURE ParseTerm(flag, t: CARDINAL); FORWARD; (* audit SWAP; 3-arg call sites still FIXME *) PROCEDURE ParseSetCons(flag, s: CARDINAL); FORWARD; (* audit SWAP; 1-arg call site still FIXME *) PROCEDURE ParseTypeCast(kind: CARDINAL); FORWARD; PROCEDURE ParseFuncCall(idx: CARDINAL): CARDINAL; FORWARD; PROCEDURE ExpandStdProc43(code: CARDINAL); FORWARD; (* FIXME: 0-arg call site *) PROCEDURE ExpandStdProc44(first: CARDINAL); FORWARD; PROCEDURE ExpandStdProc45(std: CARDINAL); FORWARD; (* FIXME: 0-arg call site *) PROCEDURE ExpandStdProc46; FORWARD; PROCEDURE GetConstVal; FORWARD; PROCEDURE PopExprDesc(d: DescPtr); FORWARD; (* FIXME: 0-arg call sites *) PROCEDURE PushExprDesc(dst: DescPtr; src: DescPtr); FORWARD; (* audit SWAP; arities still FIXME *) PROCEDURE ConstToCard(c: DescPtr; errPos: CARDINAL); FORWARD; PROCEDURE ConstToInt(c: DescPtr; errPos: CARDINAL); FORWARD; PROCEDURE MatchOpClass(allowed: BITSET; errCode: CARDINAL); FORWARD; PROCEDURE FoldConstOp(resTyp: DescPtr); FORWARD; (* FIXME: kind-result sites *) PROCEDURE EmitCompare; FORWARD; PROCEDURE EmitRangeCheck; FORWARD; PROCEDURE ParseSimpleExpression; FORWARD; PROCEDURE LoadOperand; FORWARD; PROCEDURE StoreOperand; FORWARD; PROCEDURE CheckRelationTypes(t1: ADDRESS); FORWARD; (* audit: op unused in body *) PROCEDURE FoldRelation(): ADDRESS; FORWARD; 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 *) PROCEDURE EvalConstExpr; FORWARD; PROCEDURE ParseSetOrCastTail; FORWARD; PROCEDURE ParseAssignment; FORWARD; PROCEDURE IsOrdinal(t: Compiler.RecordPtr): BOOLEAN; FORWARD; PROCEDURE IsSet(t2, t1: Compiler.RecordPtr): BOOLEAN; FORWARD; PROCEDURE BaseTypeOf(t2, t1: Compiler.RecordPtr): BOOLEAN; FORWARD; PROCEDURE CheckAssignable; FORWARD; PROCEDURE ParseSelector(sel: Compiler.RecordPtr; needVal: BOOLEAN; base: Compiler.RecordPtr); FORWARD; 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 *) PROCEDURE GetTypeDesc(src: ADDRESS; dest: ADDRESS; mode: CARDINAL); FORWARD; PROCEDURE CheckAssignmentCompat(dst: ADDRESS); FORWARD; (* EXPRESS group 1 — descriptors, predicates, const-fold, designator base, selector *) (* proc4 @004a — ~PushExprDesc *) PROCEDURE PushExprDesc(dst: DescPtr; src: DescPtr); VAR aligned: CARDINAL; (* local word-2 *) BEGIN {/* 004a */} (* aligned := (src^.extra + 1) DIV 2 * 2 *) aligned := (src^.extra + 1) DIV 2 * 2; {/* 0054 */} (* if temp mark held, reserve space, check against SymTab pool *) IF spillFlag <> 0 THEN DEC(spillTop, aligned); IF spillTop < SymTab.stringPoolPtr THEN Errors.ReportError(81); END; spillTop := SymTab.stringPoolPtr; (* sync mark: 006a..006b *) END; {/* 006d */} (* init new descriptor *) dst^.mode := 1; IF spillFlag = 0 THEN dst^.kind := 0 ELSE dst^.kind := dst^.kind END; dst^.extra := spillTop; dst^.typ := src^.typ; {/* 007e */} (* if fresh mark, claim space, overflow check 83 *) IF spillFlag = 0 THEN INC(spillTop, aligned); IF spillTop > SymTab.stringPoolPtr THEN Errors.ReportError(83); END; spillTop := SymTab.stringPoolPtr; END; END PushExprDesc; (* proc32 @0095 — ~IsOrdinal *) PROCEDURE IsOrdinal(t: RecordPtr): BOOLEAN; BEGIN {/* 0095 */} (* subrange with CARDINAL bounds is not plain ordinal here *) IF (t^.word4 = 1) AND (t^.word5 >= 0) AND (t^.word6 >= 0) THEN RETURN FALSE; END; {/* 00ac */} (* unwrap alias: t := t^.word2 *) t := t^.word2; {/* 00af */} (* INTEGER is ordinal *) IF t = Compiler.IntType THEN RETURN TRUE; END; {/* 00ba */} (* otherwise ordinal iff class tag nonzero *) RETURN t^.word4 <> 0; END IsOrdinal; (* proc5 @00c0 — ~PopExprDesc *) PROCEDURE PopExprDesc(d: DescPtr); VAR isOrd: BOOLEAN; (* local word-2 *) neg: BOOLEAN; (* local word-3 *) hasRange: BOOLEAN; (* local word-4 *) emitConv: BOOLEAN; (* local word-5 *) lo, hi: INTEGER; (* local word-6, word-7 *) sub: RecordPtr; (* local word-8 *) BEGIN {/* 00c0 */} (* only descriptors with kind-bit 7 set need pop work *) IF NOT (7 IN BITSET(d^.kind)) THEN RETURN END; {/* 00c8 */} (* classify *) isOrd := IsOrdinal(d^.typ); neg := isOrd < 0; hasRange := 3 IN BITSET(d^.kind); IF hasRange THEN lo := d^.low; hi := d^.high END; {/* 00de */} (* constant-expression branch *) IF curDesc.mode = 0 THEN IF neg THEN IF (curDesc.typ = Compiler.CardType) OR (curDesc.value >= 0) THEN Errors.ReportError(70); END; IF hasRange AND (curDesc.value >= lo) AND (curDesc.value <= hi) THEN Errors.ReportError(72); END; ELSE IF curDesc.typ <> Compiler.CardType THEN Errors.ReportError(71); END; IF hasRange AND (curDesc.value >= CARDINAL(lo)) AND (curDesc.value <= CARDINAL(hi)) THEN Errors.ReportError(72); END; END; RETURN; END; {/* 0120 */} (* codegen branch, range-check flag bit 8 *) IF 8 IN Scanner.scanOpt THEN emitConv := FALSE; IF IsOrdinal(curDesc.typ) - isOrd = 2 THEN CodeGen.EmitStandardOp(2); curDesc.mode := 1; emitConv := TRUE; END; IF hasRange THEN sub := curDesc.typ; (* local-8 *) IF emitConv OR (sub^.kind > 1) THEN emitConv := TRUE END; IF NOT emitConv THEN IF neg THEN IF (sub^.low > d^.low) OR (sub^.high < d^.high) THEN emitConv := TRUE; END; ELSE IF (CARDINAL(sub^.low) < CARDINAL(lo)) OR (CARDINAL(sub^.high) > CARDINAL(hi)) THEN emitConv := TRUE; END; END; END; IF emitConv THEN CodeGen.QueueConst(hi - lo); CodeGen.QueueConst(lo); CodeGen.EmitTypedOp(0, ORD(NOT neg)); curDesc.mode := 1; END; END; END; END PopExprDesc; (* proc33 @017d — ~IsSet *) PROCEDURE IsSet(t2, t1: RecordPtr): BOOLEAN; BEGIN {/* 017d */} (* set-compatibility: identity, subrange unwrap, BITSET/CARD compat *) IF (t2 = t1) THEN RETURN TRUE END; IF (t2^.word4 = 1) AND IsSet(t2^.word2, t1) THEN RETURN TRUE END; IF (t1^.word4 = 1) AND IsSet(t2, t1^.word2) THEN RETURN TRUE END; IF (t2 = Compiler.BitsetType) AND (t1 = Compiler.CardType) THEN RETURN TRUE END; IF (t1^.word4 IN BITSET(96H)) OR (t2^.word4 IN BITSET(96H)) THEN RETURN TRUE; END; IF (t1 = Compiler.BitsetType) AND (t2 = Compiler.CardType) THEN RETURN TRUE END; IF (t2^.word4 IN BITSET(96H)) OR (t1^.word4 IN BITSET(96H)) THEN RETURN TRUE; END; RETURN FALSE; (* fct_leave 82H *) END IsSet; (* proc34 @01c5 — ~BaseTypeOf *) PROCEDURE BaseTypeOf(t2, t1: RecordPtr): BOOLEAN; BEGIN {/* 01c5 */} (* base-type compatibility for assignment / param passing *) IF (t2 = t1) THEN RETURN TRUE END; IF (t2 = t1) OR IsSet(t2, t1) THEN RETURN TRUE END; IF (t2^.word4 = 1) AND (BaseTypeOf(t2^.word2, t1)) THEN RETURN TRUE END; IF (t1^.word4 = 1) AND (BaseTypeOf(t1, t2^.word2)) THEN RETURN TRUE END; IF (t2 = Compiler.CardType) AND (t1 = Compiler.IntType) THEN RETURN TRUE END; IF (t2 = Compiler.IntType) AND (t1 = Compiler.CardType) THEN RETURN TRUE END; IF (t2 = Compiler.WordType) AND (t1^.word3 <= 2) THEN RETURN TRUE END; RETURN FALSE; (* fct_leave 82H *) END BaseTypeOf; (* proc35 @0212 — ~FoldConstOp *) PROCEDURE FoldConstOp(resTyp: RecordPtr); BEGIN {/* 0212 */} (* both sides CARDINAL/INTEGER constants: keep resTyp *) IF (resTyp^.typ = Compiler.IntType) AND ((curDesc.typ = Compiler.RealType) OR ((curDesc.typ = Compiler.CardType) AND (resTyp^.mode = 0)) OR (resTyp^.value >= 0)) THEN curDesc.typ := resTyp^.typ; RETURN; END; {/* 023a */} (* mirrored: curDesc side constant *) IF (curDesc.typ = Compiler.IntType) AND ((resTyp^.typ = Compiler.RealType) OR ((resTyp^.typ = Compiler.CardType) AND (curDesc.mode = 0)) OR (curDesc.value >= 0)) THEN curDesc.typ := resTyp^.typ; (* 025a..025e *) RETURN; END; {/* 0260 */} (* incompatible operand types *) IF NOT IsSet(resTyp^.typ, curDesc.typ) THEN Errors.ReportIncompatibleTypes(resTyp^.typ, curDesc.typ, 0); END; END FoldConstOp; (* proc7 @0275 — ~ConstToCard *) PROCEDURE ConstToCard(c: DescPtr; errPos: CARDINAL); BEGIN {/* 0275 */} (* CARDINAL context: reject INTEGER/alias mismatches, negatives *) IF (c^.typ <> Compiler.CardType) AND (c^.kind <> 1) AND (c^.value <> Compiler.CardType) THEN IF curDesc.mode <> 0 THEN RETURN END; IF curDesc.typ <> Compiler.IntType THEN RETURN END; IF curDesc.value < 0 THEN RETURN END; END; {/* 029c */} (* must be set-compatible with target element type *) IF NOT IsSet(c^.typ, curDesc.typ) THEN Errors.ReportAssignMismatch(c^.typ, curDesc.typ, errPos); END; END ConstToCard; (* proc8 @02ac — ~ConstToInt *) PROCEDURE ConstToInt(c: DescPtr; errPos: CARDINAL); BEGIN {/* 02ac */} (* INTEGER context: base-type check only *) IF NOT BaseTypeOf(c^.typ, curDesc.typ) THEN Errors.ReportAssignMismatch(c^.typ, curDesc.typ, errPos); END; END ConstToInt; (* proc9 @02be — ~MatchOpClass *) PROCEDURE MatchOpClass(allowed: BITSET; errCode: CARDINAL); BEGIN {/* 02be */} (* operator class check on current expression type *) IF NOT (curDesc.typ^.word4 IN allowed) THEN Errors.ReportTypeMismatch(errCode, curDesc.typ, allowed); END; END MatchOpClass; (* proc21 @02d0 — ~ParseDesignatorBase *) PROCEDURE ParseDesignatorBase(finA, finB, probeA, probeB: CARDINAL): BOOLEAN; VAR found1, found2: BOOLEAN; (* local-6, local-7 *) w8, w9: CARDINAL; (* local-8, local-9 *) f1, f2: CARDINAL; (* local-2, local-3 *) BEGIN {/* 02d0 */} (* double PASS1.CondInsert probe for qualified pair *) Pass1.CondInsert(probeB, ADR(w8), ADR(f1), ADR(found1)); Pass1.CondInsert(probeA, ADR(w9), ADR(f2), ADR(found2)); {/* 02e6 */} (* walk while both found *) WHILE found1 AND found2 DO IF w8 <> w9 THEN RETURN FALSE END; (* FIXME: LookupField internal helper — decompile from @02f4 *) WHILE LookupField(f1) AND LookupField(f2) DO f1 := f1^.word5; f2 := f2^.word5; END; IF f1 <> f2 THEN RETURN FALSE END; Pass1.InsertEntry(probeB, ADR(w8), ADR(f1), ADR(found1)); Pass1.InsertEntry(probeA, ADR(w9), ADR(f2), ADR(found2)); END; {/* 0324 */} (* match iff same head and same tail selector *) RETURN (found1 = found2) AND (finA = finB); END ParseDesignatorBase; (* proc36 @032f — ~CheckAssignable *) PROCEDURE CheckAssignable(); VAR save: CARDINAL; (* local-2 *) BEGIN {/* 032f */} (* void context: discard pending load, force ADDRESS-typed empty desc *) IF (curDesc.mode = 0) AND (curDesc.typ = Compiler.AddressType) THEN CodeGen.DiscardPending(); curDesc.typ := Compiler.CharType; curDesc.value := save; Scanner.Allocate(ADR(curDesc.extra), 2); curDesc.value := 0; curDesc.extra[0] := CHR(0); curDesc.typ := 0; curDesc.mode := 0; EmitAddress(); END; END CheckAssignable; (* proc20 @0358 — ~ParseSelector *) PROCEDURE ParseSelector(sel: RecordPtr; needVal: BOOLEAN; base: RecordPtr); VAR t: RecordPtr; (* local-2 *) flags: CARDINAL; (* local-3 *) BEGIN {/* 0358 */} (* selector only if previous type is structured *) IF sel^.kind = 11 THEN CheckAssignable() END; t := curDesc.typ; IF NOT LookupField(sel) THEN RETURN END; {/* 036a */} (* address/word indirection *) IF sel^.typ = Compiler.AddressType THEN IF LookupField(t) THEN flags := t^.word3; IF LookupField(t) AND NOT (1 IN BITSET(flags)) THEN CodeGen.QueueConst(1); CodeGen.EmitTypedOp(7, 0); CodeGen.QueueConst(2); CodeGen.EmitTypedOp(9, 0); ELSE EmitAddress() (*FIXME: dropped sel*); CodeGen.QueueConst(flags DIV 2); CodeGen.EmitTypedOp(8, 0); CodeGen.QueueConst((flags - 1) DIV 2); CodeGen.EmitTypedOp(6, 0); END; ELSIF (t^.kind <= 9) THEN IF needVal THEN IF (t^.word3 <> 1) OR (curDesc.kind <> 5) THEN Errors.ReportError(95); END; ELSE IF (curDesc.mode = 1) THEN Errors.ReportError(35) END; END; CodeGen.DiscardPending(); EmitAddress(); CodeGen.QueueConst((t^.word3 - 1) DIV 2); END; RETURN; END; {/* 03dc */} (* set-membership / index loop *) WHILE 2048H IN BITSET(sel^.kind) DO EmitAddress() (*FIXME: dropped sel*); sel := sel^.word5; IF NOT LookupField(sel) THEN IF sel^.typ = curDesc.typ THEN Errors.ReportError(64) END; END; END; {/* 0401 */} (* dispatch on selector class *) IF Scanner.AcceptSy(5) THEN IF (sel = t) OR ((sel = Compiler.BitsetType) AND (t^.kind = 5)) THEN ELSIF (sel^.kind = 5) AND (t = Compiler.BitsetType) THEN ELSIF (sel = Compiler.WordType) OR (sel = Compiler.AddressType) THEN ELSE Errors.ReportError(65); END; IF (t^.word3 <> 1) OR (curDesc.kind <> 5) THEN Errors.ReportError(95); END; ELSIF t = Compiler.CharType THEN IF NOT Scanner.TestR40(sel^.value, 128) THEN DEC(sel^.value); END; IF sel^.value - sel^.word5 + sel^.word5 <> sel^.value THEN Errors.ReportError(45); END; ELSE ConstToInt(sel, t); PopExprDesc(sel); END; END ParseSelector; (* EXPRESS group 2 — @0358..0c0c: designator tail, const eval, term/factor, set/func/cast, std-proc expansion, set-or-cast tail *) (*{0510} PROCEDURE ParseDesignatorTail *) PROCEDURE ParseDesignatorTail; VAR buf: Desc; more: BOOLEAN; BEGIN buf := curDesc; constMode := 0; EvalConstExpr; (*{0512-0517}*) LOOP IF (Scanner.curSym # 3) & ((Scanner.curSym-44) > 5) THEN EXIT END; (*{0519-0525}*) IF Scanner.AcceptSy(44) THEN (*{0528-052b} '(' actuals/indexqual *) NormalizeOperand; more := FALSE; (*{052e-0530}*) LOOP IF ~ MatchOpClass(2048, 44) THEN (*{0538}*) IF more THEN (*{053b}*) EmitAddress; CodeGen.QueueConst(1); CodeGen.EmitTypedOp(6, 0); CodeGen.EmitTypedOp(8, 0); (*{053e-054a}*) END; END; buf := curDesc; ParseExpression; (*{054c-0550}*) IF curDesc.raw[2] = 0 THEN (*{0554-0556} typeless actual *) ConstToInt(Compiler.CardType, 44); PopExprDesc; (*{0559-055e}*) IF 8 IN Scanner.scanOpt THEN (*{0561}*) EmitAddress; CodeGen.QueueConst(0); CodeGen.EmitStandardOp(0); (*{0567-056d}*) END; curDesc.raw[3] := curDesc.raw[3]-2; (*{0570-0575}*) ELSE (*{0578} typed actual *) ConstToInt(curDesc.raw[2], 44); ConstToCard(curDesc.raw[2], curDesc.raw[2]); (*{0579-057f}*) CodeGen.QueueConst(curDesc.raw[5]); CodeGen.EmitTypedOp(7, 0); (*{0580-0587}*) END; IF more THEN CodeGen.EmitTypedOp(6, 0) END; (*{0589-058e}*) curDesc := buf; (*{0590-0592}*) IF ~ Scanner.TestSet(66) THEN EXIT END; (*{0594-0598}*) IF ~ Scanner.AcceptSy(6) THEN (*{059c-059e}*) IF Scanner.AcceptSy(44) THEN EXIT END; (*{05a1-05a8}*) ELSE Scanner.GetSym; (*{05ab}*) END; more := TRUE; (*{05ad-05ae}*) END; curDesc.raw[4] := 5; constMode := 1; (*{05b1-055b} handler exit *) ELSIF Scanner.AcceptSy(46) THEN (*{05b8-05bb} '[' subscript *) PushOperand; (*{05be}*) IF (Compiler.rangeCheckEnabled # 0) & (8 IN Scanner.scanOpt) THEN (*{05c0-05c8}*) CodeGen.EmitStandardOp(6); (*{05ca-05c4}*) END; IF curDesc.raw[0] = Compiler.AddressType THEN curDesc.raw[0] := Compiler.WordType ELSE (*{05cd-05d9}*) IF ~ MatchOpClass(32, 46) THEN (*{05db-05df}*) END; curDesc.raw[0] := curDesc.raw[2]; (*{05e1-05e4}*) END; curDesc.raw[4] := 2; curDesc.raw[3] := 0; constMode := 1; (*{05e5-05ec}*) ELSE (*{05ef} '.'-field / deref tail *) IF curDesc.raw[4] # 2 THEN (*{05f1-05f3}*) NormalizeOperand; curDesc.raw[4] := 2; curDesc.raw[3] := 0; (*{05f5-05fc}*) END; SymTabSave := SymTab.identClass; (*{05fd-0602} FIXME: no such SymTab export *) IF ~ MatchOpClass(1024, 3) THEN (*{0604-0608}*) END; curDesc.raw[0] := curDesc.raw[5]; Scanner.GetSym; Scanner.NeedID; (*{0609-0612}*) IF Scanner.word13 (*FIXME*) # SymTabSave THEN (*{0614-0616} FIXME: word13 TBD *) Errors.ReportErrorWithText(2, Scanner.tokBuf); (*{0618-061d}*) END; curDesc.raw[3] := Scanner.curNode+curDesc.raw[5]; (*{061f-0626} FIXME: word8=curNode pun *) curDesc.raw[0] := Scanner.litType; SymTab.identClass := SymTabSave; (*{0627-062d}*) Scanner.GetSym; (*{062f}*) WHILE Scanner.curSym = 3 DO (*{0631-0635}*) IF curDesc.raw[3] > 510 THEN (*{063b-063d}*) CodeGen.QueueConst(curDesc.raw[3]); CodeGen.EmitTypedOp(6, 0); (*{063f-0645}*) END; curDesc.raw[3] := 0; (*{0647-0649}*) END; constMode := 1; (*{064a-064b}*) END; CheckAndStore; (*{064c} local proc22 *) END; (*{064f} back to {0519}*) curDesc.raw[1] := 1; (*{0652-0654} result flag *) END ParseDesignatorTail; (*{0470} PROCEDURE EvalConstExpr *) PROCEDURE EvalConstExpr; VAR lit: CARDINAL; BEGIN Scanner.PushWith; Scanner.ExpectKd(4); (*{0472-0475}*) curDesc.raw[3] := Scanner.curNode; lit := Scanner.curNode; (*{0477-047f} FIXME: word8 pun *) IF (Scanner.follSet & 262) = 0 THEN (*{0480-0488} ident/number path *) IF lit = 0 THEN curDesc.raw[4] := 1; (*{048a-0491}*) ELSIF lit = spillFlag THEN curDesc.raw[4] := 0; (*{0493-049b} nil *) ELSE curDesc.raw[2] := spillFlag-lit; curDesc.raw[4] := 4; (*{049d-04a4} deref const *) IF (4 IN Scanner.follSet) & (Scanner.litType <= 9) THEN (*{04a5-04b0}*) CodeGen.SetPendingOp(1, curDesc.raw[4], curDesc.raw[2], curDesc.raw[3]); (*{04b2-04b9}*) curDesc.raw[4] := 2; curDesc.raw[3] := 0; (*{04bb-04c0}*) END; END; ELSIF 8 IN Scanner.follSet THEN (*{04c3-04c7} cardinal const *) CodeGen.QueueConst(curDesc.raw[3]); curDesc.raw[4] := 2; curDesc.raw[3] := 0; constMode := 1; (*{04c9-04d4}*) ELSIF 1 IN Scanner.follSet THEN (*{04d7-04db} integer const *) curDesc.raw[2] := lit; curDesc.raw[4] := 3; (*{04dd-04e2}*) ELSE (*{04e5} string/char const *) PushStringConst; (* local proc2 {04e9} *) curDesc.raw[4] := 2; constMode := 1; (*{04ea-04ee}*) IF curDesc.raw[3] > 510 THEN (*{04ef-04f5} long string -> static *) CodeGen.QueueConst(curDesc.raw[3]); CodeGen.EmitTypedOp(6, 0); (*{04f7-04fd}*) curDesc.raw[3] := 0; (*{04ff-0501}*) END; END; CheckAndStore(Scanner.litType, 1); (*{0502-050a} local proc22 *) Scanner.GetSym; (*{050c}*) END EvalConstExpr; (*{0657} PROCEDURE ParseFactor(p1..p5) — 5 params *) PROCEDURE ParseFactor(p1, p2, p3, p4, p5: CARDINAL); VAR a, b: CARDINAL; BEGIN IF Pass1.InsertEntry(p5, a, b) THEN (*{0659-0661} PASS1.proc3 *) ParseFactor(p5, p4, a, b, p1); (*{0664-066a} call_with_frame self; FIXME: group wrote FRAME^.tag *) Scanner.ExpectSy(1); (*{066c-066d}*) END; IF p2 # 0 THEN ParseDesignatorTail; NormalizeOperand; END; (*{066f-0675}*) Scanner.PushWith; (*{0677}*) IF (Scanner.identKd = 5) & (p3 = 9) THEN (*{0679-0683} stdfunc misuse *) CentralError(TRUE (*FIXME: cond TBD*), 67); ParseActualList; Scanner.GetSym; RETURN; (*{068a-0697}*) END; BoolCondHelper; (*{0699} local proc12 *) ParseSelector(p3, p2, p1); (*{069b-069e} local proc20 *) END ParseFactor; (*{06a2} PROCEDURE ParseTerm(t, flag) — 2 params *) PROCEDURE ParseTerm(flag, t: CARDINAL); VAR a, b, c: CARDINAL; BEGIN IF Pass1.CondInsert(flag, a, b, c) THEN (*{06a4-06ab} PASS1.proc2 *) ParseFactor(flag, a, b, c, t); (*{06ad-06b3} nested proc38 *) END; Scanner.ExpectSy(5); (*{06b6-06b8} '*' expected *) END ParseTerm; (*{0704} PROCEDURE ParseSetCons(s, flag) — 2 params; set constructor *) PROCEDURE ParseSetCons(flag, s: CARDINAL); VAR lo, hi: Desc; mod, res: CARDINAL; first, bad: BOOLEAN; aux: Desc; op, k1, k2, m: CARDINAL; BEGIN lo := curDesc; hi := curDesc; (*{0706-070b} reserve *) GetRangeBase(); (*{070c-0711} local proc25; FIXME: group passed FRAME^.tag-4 *) lo.raw[1] := 0; lo.raw[0] := Compiler.CardType; (*{0712-0717}*) mod := Scanner.EnterMod("TEXTS", 4); (*{071d-0728}*) res := ParseFuncCall(mod); (*{072c-072f} nested proc41 *) IF s = 0 THEN Scanner.TestR40(8) END; (*{0730-0735}*) IF Scanner.AcceptSy(43) & (s # 0) & Scanner.AcceptSy(5) THEN (*{0737-0743}*) ELSE RETURN END; (*{0744} empty set *) Scanner.PushWith; first := TRUE; (*{0747-074a}*) IF (Scanner.identKd = 4) & (Scanner.litType = res) THEN (*{074b-0755}*) EvalConstExpr; lo := curDesc; (*{0757-075a}*) IF 20 IN lo.raw[4] THEN (*{075d-0761}*) PushOperand; PushExprDesc(Compiler.CardType); PopOperand; (*{0764-076b}*) END; IF s # 0 THEN (*{076c-076e}*) IF Scanner.TestSet(34) THEN ELSE Scanner.TestSet(2) END; (*{076f-0776}*) Scanner.AcceptSy(1); (*{0778-077b}*) END; first := FALSE; END; bad := FALSE; (*{077c-077e}*) WHILE first DO (*{077e-085e} element loop *) CodeGen.EmitSystemCall(20); PushOperand; (*{0781-0786}*) IF flag # 0 THEN ParseExpression ELSE ParseDesignatorTail END; (*{0788-078e}*) NormalizeOperand; op := 2; m := 7; aux := lo; EmitOp; (*{078f-0797} local proc6 *) CASE curDesc.raw[0] OF (*{0798-0817} switch on type tag 90..101 *) 90: ; 91: ; 92: bad := curDesc.raw[0] # Compiler.CharType; m := 1; (*{07a1-07a5}*) | 93..96: m := m+3; ParseTypeCast(6); (*{07a6-07af}*) | 97: m := 5; ParseTypeCast(11); (*{07b2-07b5}*) | 98: IF curDesc.raw[0] = Compiler.LongrealType THEN (*{07b8-07bc} LONGREAL *) ParseTypeCast(22); ParseTypeCast(65523); mod := Scanner.EnterMod("DOUBLES", 6); (*{07c8-07d5}*) aux := mod; m := 14; k1 := 1; (*{07d6-07dc}*) ELSE ParseTypeCast(13); ParseTypeCast(65531); m := 6; (*{07df-07e6}*) END; | 101: IF ~ IsPointer(curDesc.raw[0]) THEN bad := TRUE END; (*{07ea-07ef}*) EmitAddress; op := 3; m := 2; (*{07f0-07f6}*) ELSE bad := TRUE; (*{0817}*) END; IF bad THEN (*{0819-082d} elem/type mismatch *) IF curDesc.raw[0] # 0 THEN Errors.ReportErrorWithText(curDesc.raw[0]+7, curDesc.raw[0]); ELSE Errors.ReportErrorWithText(hi, "this type"); (*{082f-0843}*) END; END; CodeGen.SetPendingOp(9, 3, k1, k2+flag+1); (*{0845-084d}*) CodeGen.EmitExtCall3(19, op, 0); (*{084f-0854}*) IF Scanner.TestSet(34) THEN Scanner.AcceptSy(1) ELSE EXIT END; (*{0856-085d}*) END; Scanner.GetSym; (*{0860} happy exit *) IF s # 0 THEN (*{0862-0863} close: emit count *) CodeGen.EmitSystemCall(20); PushOperand; (*{0865-086b}*) CodeGen.SetPendingOp(9, 3, res, 7+flag+1); (*{086c-0872}*) CodeGen.EmitExtCall3(19, 1, 0); (*{0875-0879}*) END; END ParseSetCons; (*{06bb} PROCEDURE ParseFuncCall(idx) : CARDINAL — stdproc table walk *) PROCEDURE ParseFuncCall(idx: CARDINAL): CARDINAL; VAR e: CARDINAL; BEGIN e := SymTab.word8^[idx]; (*{06bd-06c2} FIXME: SymTab has no word8 export *) WHILE e # 0 DO (*{06c4}*) IF STACK[1] = 16 THEN RETURN STACK[2] END; (*{06c6-06cf} FIXME: raw stack *) e := STACK[0]; (*{06d1-06d6}*) END; RETURN 0; (*{06d6-06d8}*) END ParseFuncCall; (*{06da} PROCEDURE ParseTypeCast(kind) — 1 param *) PROCEDURE ParseTypeCast(kind: CARDINAL); VAR d: CARDINAL; BEGIN IF FRAME^.tag # 0 THEN (*{06dc-06de} FIXME: raw frame; parenthesized operand present *) d := FRAME^.tag-4; INC(d); (*{06e0-06e6}*) IF Scanner.AcceptSy(2) THEN (*{06e7-06ea}*) BoolCondHelper; (*{06ec} local proc12 *) IF kind >= 0 THEN ConstToCard(Compiler.CardType, 2); (*{06ee-06f5}*) ELSE ConstToInt(Compiler.IntType, 2); (*{06f8-06fb}*) END; ELSE CodeGen.QueueConst(kind); (*{06fe-0700}*) END; END; END ParseTypeCast; (*{087f} PROCEDURE ExpandStdProc43(code) — scalar transfer const builder *) PROCEDURE ExpandStdProc43(code: CARDINAL); VAR buf, tmp: Desc; k, i: CARDINAL; BEGIN buf := curDesc; tmp := curDesc; (*{0881-0888} reserve *) k := TypeKindOf(); (*{0889-088a} local proc27 *) IF k <= 1 THEN (*{088b-088d} short ordinal: bias into const *) CodeGen.QueueConst(code-k*32768); RETURN; (*{088f-0896}*) END; i := 0; (*{089a-089c}*) REPEAT buf[i] := 65535; INC(i); UNTIL i > 3; (*{089c-08a8} all-bits *) IF code # 0 THEN buf.raw[3] := 32767; (*{08aa-08b3} max CARDINAL *) ELSIF k = 2 THEN buf.raw[0] := 8000H; buf.raw[1] := 0; (*{08b5-08c0} MIN(LONGINT) *) END; IF k = 5 THEN (*{08c2-08c4} LONGREAL: convert via temp *) tmp := buf; (* copy 8 {08c7-08c9} *) tmp := LONGREAL(buf); (*{08cc-08d1} FIXME: conversion sketch *) CodeGen.QueueLongConst(3, tmp); (*{08d2-08d7} kind 3 *) ELSE CodeGen.QueueLongConst(2, buf); (*{08db-08df} kind 2 *) END; END ExpandStdProc43; (*{08e4} PROCEDURE ExpandStdProc44(first) — const list collector *) PROCEDURE ExpandStdProc44(first: CARDINAL); VAR save: CARDINAL; BEGIN save := curDesc.raw[3]; (*{08e6-08e8}*) IF Scanner.AcceptSy(1) THEN (*{08e9-08ec}*) PushOperand; (*{08ee}*) IF ~ MatchOpClass(1024, 1) THEN (*{08f1-08f5}*) END; IF first # 0 THEN CentralError(TRUE (*FIXME: cond TBD*), 63) END; (*{08f6-08fd} GetConstVal guard *) GetConstVal; ConstToCard(curDesc.raw[2], 1); (*{08fe-0902}*) LOOP (*{0903-0912} ','-separated consts *) IF first # 0 THEN CentralError(TRUE (*FIXME: cond TBD*), 63) END; (*{090a-0911}*) GetConstVal; IF ~ Scanner.AcceptSy(1) THEN EXIT END; (*{0917-091e}*) END; END; CodeGen.QueueConst(save); (*{0920-0922} restore base *) END ExpandStdProc44; (*{0926} PROCEDURE ExpandStdProc45(std) — DEALLOCATE(addr) *) PROCEDURE ExpandStdProc45(std: CARDINAL); VAR pat: ARRAY [0..10] OF CHAR; anchor, id, found: CARDINAL; BEGIN pat := "DEALLOCATE"; (*{092b-093a} copy string *) anchor := SymTab.word9; (*{0941-0943} FIXME: SymTab has no word9 export *) LOOP (*{0944} FindIdent retry loop, error 54/56 *) id := anchor; found := Scanner.FindIden(id, pat, 9 IN Scanner.scanOpt); (*{0944-094e}*) id := STACK[0]; (*{0950-0952} FIXME: raw stack *) IF id = 0 THEN CentralError(TRUE (*FIXME: cond TBD*), 54-std) END; (*{0953-0959} unknown *) IF found # 0 THEN IF found[4] # 5 THEN (*{095a-0965} not a var? *) ELSE EXIT END; END; END; IF ~ ParseDesignatorBase(found, Compiler.allocateSignature, found) THEN (*{0968-096d}*) CentralError(TRUE (*FIXME: cond TBD*), 56-std); END; IF 6 # found[3] THEN CodeGen.EmitSystemCall(20) END; (*{0978-097e} address *) ParseDesignatorTail; NormalizeOperand; (*{097f-0981}*) IF ~ MatchOpClass(32, FRAME^.tag-4) THEN (*{0984-0988} FIXME: raw frame *) END; ExpandStdProc44(1); (*{098c-098e} call_with_frame proc44 *) IF 6 IN found[3] THEN CodeGen.EmitMiscOp(5, found[5]); (*{098f-0998} dispose *) ELSE EmitIndexed(found); (*{099c-099e} local proc31 *) END; END ExpandStdProc45; (*{09a2} PROCEDURE ExpandStdProc46() — MIN/MAX-operand validator *) PROCEDURE ExpandStdProc46; BEGIN IF (48 IN curDesc.raw[4]) OR ((curDesc.raw[4] = 2) & (Compiler.rangeCheckEnabled # 0)) THEN (*{09a4-09b3}*) IF (curDesc.raw[4] # 5) OR (curDesc.raw[0] # 1) THEN CentralError(TRUE (*FIXME: cond TBD*), 96) END; (*{09b5-09c0}*) NormalizeOperand; curDesc.raw[4] := 2; curDesc.raw[3] := 0; (*{09c3-09ca}*) END; IF curDesc.raw[4] = 2 THEN CodeGen.EmitStandardOp(8) END; (*{09cb-09d2} ORD-class emit *) PushOperand; (*{09d4-09dc} copy desc, push *) END ExpandStdProc46; (*{09e0} PROCEDURE ParseSetOrCastTail *) PROCEDURE ParseSetOrCastTail; VAR t2: CARDINAL; t3: CARDINAL; t4: CARDINAL; buf: Desc; save5: CARDINAL; ok, flag: BOOLEAN; m, k: CARDINAL; BEGIN buf := curDesc; (*{09e4-09e6} reserve *) t2 := Scanner.curNode; t4 := Scanner.litType; t3 := STACK[5]; (*{09e7-09ed} FIXME: raw stack *) Scanner.GetSym; (*{09ee}*) IF 7 IN t2 THEN (*{09f1-09f4} set/type-constructor context *) IF t4 = 0 THEN (*{09fb-09fc} untyped head *) IF t3 <= 3 THEN (*{09fd-09fe} small selector *) IF (t3 >= 2) & ODD(t3) THEN ParseSetCons(t3 & 1); (*{0a00-0a06} nested proc40 *) ELSE (*{0a0a} parenthesized type context *) Scanner.ExpectSy(43); CASE t3 OF (*{0a0e,0a7d} switch 94..100 *) 94, 95: ExpandStdProc45; | 96, 97: ParseDesignatorTail; IF ~ MatchOpClass(7, t2) THEN (*{0a18-0a1c}*) END; ExpandStdProc46; IF Scanner.AcceptSy(1) THEN (*{0a1d-0a20}*) ParseExpression; ConstToCard(Compiler.CardType, t2); ELSE CodeGen.QueueConst(1); (*{0a29-0a2a}*) END; IF buf.raw[0] = 0 THEN curDesc.raw[0] := Compiler.CardType ELSE curDesc.raw[0] := buf.raw[0] END; (*{0a2c-0a3b}*) IF curDesc.raw[4] = 0 THEN EmitOp ELSE EmitOp END; (*{0a3d-0a4d} proc6/7 *) curDesc.raw[1] := 2; PushExprDesc; PopOperand; (*{0a4e-0a56} proc5/3 FIXME arity *) | 98, 99: ParseDesignatorTail; IF ~ MatchOpClass(16, t2) THEN (*{0a59-0a5d}*) END; ExpandStdProc46; Scanner.ExpectSy(1); (*{0a5d-0a60}*) ParseExpression; ConstToCard(buf.raw[0], curDesc.raw[2]); ConstToCard(buf.raw[0], curDesc.raw[2]); (*{0a62-0a6a}*) CodeGen.EmitStandardOp(5); (*{0a6b-0a6d}*) EmitTypedOp(4, t3-2); PopOperand; (*{0a6f-0a77} proc6/3 *) | 100: Errors.ReportError(34); (*{0a78-0a7a} illegal *) END; Scanner.ExpectSy(5); (*{0a92-0a93}*) END; ELSE (*{0a98} t3 > 3: conversion/builtin head *) Scanner.ExpectSy(43); CASE t3 OF (*{0a9c,0b79} switch 90..105 *) 90..95: ParseExpression; EmitOp; (*{0aa1} proc12/6 *) k := TypeKindOf(); (*{0aa1-0aa3} local proc27 *) IF ~ MatchOpClass(388, t2) THEN (*{0aa4-0aa8}*) END; IF t3 # 4 THEN CodeGen.EmitTypedOp(13+t3, k); (*{0aac-0ab2}*) ELSE m := curDesc.raw[0]; (*{0ab6-0ab8}*) IF k = 0 THEN ConstToCard(Compiler.IntType, t2) END; (*{0aba-0ac0}*) CodeGen.EmitTypedOp(12, k); (*{0ac1-0ac5}*) END; | 96: ParseExpression; IF ~ MatchOpClass(7, t2) THEN (*{0ac7-0aca}*) END; | 97: ParseExpression; EmitOp; IF ~ MatchOpClass(4, t2) THEN (*{0acd-0ad0}*) END; | 98: ParseExpression; IF ~ MatchOpClass(7, t2) THEN (*{0ad2-0ad5}*) END; CodeGen.QueueConst(1); CodeGen.EmitTypedOp(8, 4); (*{0ad5-0ada}*) | 99: save5 := CodeGen.emitEnabled; CodeGen.emitEnabled := 0; (*{0add-0ae1} FIXME: no word5 export *) ParseDesignatorTail; CodeGen.emitEnabled := save5; (*{0ae3-0ae5}*) IF ~ MatchOpClass(2048, t2) THEN (*{0ae7-0aeb}*) END; IF curDesc.raw[2] = 0 THEN EmitAddress (*{0aec-0af4} local proc28 *) ELSE CodeGen.QueueConst(curDesc.raw[2]); (*{0af7-0afd}*) END; | 100: ParseDesignatorTail; (*{0b00} CAP-class? *) IF constMode # 0 THEN (*{0b01}*) ELSIF curDesc.raw[4] > 9 THEN CentralError(TRUE (*FIXME: cond TBD*), 97); (*{0b02-0b0b}*) END; NormalizeOperand; (*{0b0c-0b0e}*) | 101, 102: Scanner.PushWith; (*{0b0f}*) IF (Scanner.identKd = 3) & (t3 = 12) THEN (*{0b11-0b1a}*) Scanner.ExpectKd(3); Scanner.GetSym; (*{0b1c-0b1f}*) ExpandStdProc44(Scanner.litType); (*{0b20} nested proc44 *) ELSE (*{0b27} address-builtin path *) save5 := CodeGen.emitEnabled; CodeGen.emitEnabled := 0; (*{0b27-0b2b}*) ParseDesignatorTail; CodeGen.emitEnabled := 1; (*{0b2d-0b2f}*) LoadIndirect; (*{0b31} local proc11 *) END; | 103..105: Scanner.PushWith; Scanner.ExpectKd(3); (*{0b34-0b37}*) t4 := Scanner.litType; (*{0b39-0b3b}*) curDesc.raw[0] := t2; (*{0b3c-0b3e}*) IF t3 = 13 THEN (*{0b3f-0b43} VAL-class *) IF ~ MatchOpClass(7, t2) THEN (*{0b44-0b47}*) END; Scanner.GetSym; Scanner.ExpectSy(1); (*{0b47-0b4b}*) ParseExpression; ConstToCard(Compiler.CardType, t2); PopExprDesc; (*{0b4c-0b55}*) ELSIF MatchOpClass(391, t2) & (t4 <= 1) THEN (*{0b57-0b5e}*) IF t3 = 15 THEN CodeGen.QueueConst(t4) (*{0b60-0b67} MIN of long? *) ELSE CodeGen.QueueConst(t4) END; (*{0b6b-0b6d}*) Scanner.GetSym; ELSIF t3 = 15 THEN ExpandStdProc43; Scanner.GetSym; (*{0b71-0b76}*) END; END; Scanner.ExpectSy(5); (*{0ba0-0ba1} close *) END; ELSE (*{0ba5} typed head: index/select *) IF (t2[2] # 0) OR (t2[6] # 0) THEN Scanner.TestR40(8) END; (*{0ba5-0bb2}*) IF Scanner.AcceptSy(43) THEN ParseTerm(t2[6], t2); END; (*{0bb4-0bbb}*) IF t3 = 8 THEN CodeGen.EmitTypedOp(13, 3); (*{0bbd-0bc6} bit select *) ELSE CodeGen.EmitMiscOp(5, t3); (*{0bc8-0bca} field/method *) END; END; ELSE (*{09f4} non-set head already handled above; join *) END; curDesc.raw[0] := t4; (*{0bcc-0bce} publish result type *) END ParseSetOrCastTail; (* EXPRESS group 3 — @0bd2..1516: operands, relations, simple expr, ParseExpression, const/type getters, assignment, init *) (* proc18 @0bd2 — ~LoadOperand *) (* EXPRESS group 3 — @0bd2..1516 *) PROCEDURE LoadOperand; VAR savedNode: ADDRESS; BEGIN IF 6 IN Scanner.follSet THEN (*{0bd4}*) ParseSetOrCastTail; (* proc39 *) (*{0bda}*) RETURN; END; CodeGen.EmitSystemCall(20); (*{0bde}*) savedNode := Scanner.curNode; (*{0be3} FIXME: ADDRESS := RecordPtr pun *) Scanner.GetSym; (*{0be6}*) IF (curDesc.raw[2] # 0) OR (curDesc.raw[6] # 0) THEN (*{0be8-0bf0}*) Scanner.TestR40(8); (*{0bf2} FIXME: CARDINAL set pun *) END; IF Scanner.AcceptSy(43) THEN (*{0bf5} '(' *) ParseTerm(savedNode, curDesc.raw[6], savedNode); (* proc37; FIXME: 3 args vs (flag,t) *) END; EmitOperand31(savedNode); (* proc31 FIXME *) curDesc.raw[0] := savedNode; (*{0c03-0c06} FIXME pun *) curDesc.raw[1] := 2; (*{0c07-0c09}*) END LoadOperand; PROCEDURE StoreOperand; VAR mark: ADDRESS; savedSp: CARDINAL; savedDesc: Desc; size: CARDINAL; BEGIN Scanner.GetStack(mark); (*{0c0e}*) savedSp := spillTop; (*{0c11} *) savedDesc := curDesc; (*{0c13-0c15}*) IF 36 IN curDesc.raw[4] THEN (*{0c16-0c1b} FIXME set TBD *) EmitDescriptor2(curDesc); (* proc2 FIXME *) PushExprDesc(mark, Compiler.ProcType); (* proc4 FIXME: (dst,src) roles TBD *) PopExprDesc(mark); (* proc3 FIXME: ADDRESS arg *) ELSE mark^ := curDesc; (*{0c28-0c2b} FIXME: ADDRESS-deref block copy *) END; CodeGen.EmitSystemCall(20); (*{0c2c}*) ParseTerm(savedDesc.raw[0], savedDesc.raw[0], savedDesc.raw[0]); (* proc37 FIXME arity/shape *) EmitDescriptor2(curDesc); (* proc2 *) CodeGen.EmitStandardOp(13); (*{0c39}*) curDesc.raw[0] := savedDesc.raw[2]; (*{0c3c-0c3f} FIXME *) curDesc.raw[1] := 2; (*{0c40-0c42}*) size := 0; (*{0c43-0c44}*) IF savedDesc.raw[2] # 0 THEN (*{0c45-0c47}*) size := savedDesc.raw[2] + savedDesc.raw[3]; (*{0c4a-0c4d}*) END; CodeGen.EmitExtCall3(19, savedDesc.raw[5], size); (*{0c4e-0c52}*) size := (size + 1) DIV 2 * 2; (*{0c54-0c5a}*) CodeGen.EmitExtCall3(size DIV 256, 0, 0); spillTop := savedSp; (*{0c5d-0c5e}*) END StoreOperand; PROCEDURE FoldRelation(): ADDRESS; VAR tmp: ADDRESS; BEGIN Scanner.Allocate(tmp, 8); (*{0c63-0c67}*) tmp := curDesc.raw[2]; (*{0c69} FIXME: LONGREAL pun *) RETURN tmp; END FoldRelation; PROCEDURE CheckRelationTypes(t1: ADDRESS); VAR buf: Desc; acc, acc2: BITSET; bothConst, anyConst: BOOLEAN; lo, hi: CARDINAL; BEGIN acc := {}; acc2 := {}; IF ~ Scanner.AcceptSy(7) THEN (*{0c7d-0c81}*) RETURN; END; BoolCondHelper; (* proc12 *) (*{0c83}*) ConstToCard(t1, 0); (* proc7 *) (*{0c84-0c86}*) PopExprDesc(t1); (* proc5 FIXME: ADDRESS arg *) (*{0c88-0c8a}*) IF ~ Scanner.AcceptSy(4) THEN (*{0c8b-0c8e} single element *) anyConst := curDesc.raw[1] # 0; (*{0cc9-0ccc}*) IF anyConst THEN CodeGen.EmitStandardOp(5); (*{0cd0}*) ELSE CodeGen.DiscardPending; (*{0cd5}*) acc := acc + BITSET{Power2(curDesc.raw[2])}; (*{0cd7-0cdc} FIXME *) END; ELSE buf := curDesc; (*{0c90-0c93}*) BoolCondHelper; (*{0c94}*) ConstToCard(t1, 0); (*{0c95-0c97}*) PopExprDesc(t1); (*{0c99-0c9b} FIXME *) bothConst := (curDesc.raw[1] # 0) OR (buf.raw[1] # 0); (*{0c9c-0ca4}*) IF bothConst THEN CodeGen.EmitStandardOp(26); (*{0ca8-0caa} set AND folded *) ELSE CodeGen.DiscardPending; (*{0cae}*) CodeGen.DiscardPending; (*{0cb0}*) lo := buf.raw[2]; hi := curDesc.raw[2]; (*{0cb2-0cb7}*) WHILE lo <= hi DO (*{0cb8-0cbb}*) acc := acc + BITSET{Power2(lo)}; (*{0cbd-0cc1} FIXME *) INC(lo); (*{0cc2-0cc5}*) END; END; END; IF anyConst THEN (*{0cdd-0ce0}*) IF acc2 # {} THEN (*{0ce0-0ce3}*) CodeGen.EmitTypedOp(6, 4); (*{0ce3-0ce5}*) ELSE acc2 := {1}; (*{0ce9-0cea}*) END; END; Scanner.TestSet(130); (*{0ceb-0ced} FIXME: CARDINAL set pun *) IF ~ Scanner.AcceptSy(1) THEN (*{0cef-0cf3} *) Scanner.GetSym; (*{0cf5}*) END; IF acc2 # {} THEN (*{0cf7-0cf8}*) IF acc # {} THEN (*{0cfa-0cfc}*) CodeGen.QueueConst(CARDINAL(acc)); (*{0cff-0d00} FIXME pun *) CodeGen.EmitTypedOp(6, 4); (*{0d02-0d04}*) END; curDesc.raw[1] := 2; (*{0d06-0d08}*) ELSE CodeGen.QueueConst(CARDINAL(acc)); (*{0d0b-0d0d} FIXME *) curDesc.raw[1] := 0; (*{0d0e-0d10} const set *) curDesc.raw[2] := CARDINAL(acc); (*{0d11-0d13} FIXME *) END; curDesc.raw[0] := t1; (*{0d14-0d16} FIXME pun *) END CheckRelationTypes; PROCEDURE EmitCompare; VAR t: ADDRESS; BEGIN IF Scanner.curSym = 66 THEN (* NOT *) (*{0d1c-0d21}*) Scanner.GetSym; (*{0d23}*) EmitCompare; (* with_frame proc50 *) (*{0d25}*) ConstToCard(Compiler.BooleanType, 66); (* proc7 *) (*{0d28-0d2c}*) IF curDesc.raw[1] = 0 THEN (*{0d2d-0d30}*) CodeGen.DiscardPending; (*{0d32}*) curDesc.raw[2] := NOT curDesc.raw[2]; (*{0d34-0d39} FIXME pun *) EmitDescriptor2(curDesc); (* proc2 *) (*{0d3a-0d3d}*) ELSE CodeGen.EmitStandardOp(3); (*{0d3d-0d3f}*) END; RETURN; END; IF Scanner.curSym IN BITSET{43..47} THEN (*{0d43-0d49} FIXME set TBD *) IF Scanner.AcceptSy(43) THEN (* '(' expr ')' *) (*{0d4b-0d4f}*) BoolCondHelper; (* proc12 *) (*{0d51}*) Scanner.ExpectSy(5); (*{0d52-0d53} ')' *) ELSE Scanner.GetSym; (*{0d57}*) CheckRelationTypes(Compiler.BitsetType); (* proc51 *) (*{0d59-0d5b}*) END; RETURN; END; Scanner.PushWith; (*{0d5f}*) t := Scanner.litType; (*{0d61-0d63} FIXME: ADDRESS := RecordPtr pun *) curDesc.raw[0] := t; (*{0d64-0d66} FIXME *) IF ~ Scanner.isLit THEN (*{0d67-0d69}*) curDesc.raw[1] := 0; (*{0d6b-0d6d}*) IF t = Compiler.charArrayDesc THEN (*{0d6e-0d72} FIXME: group hedged CHAR/str *) Scanner.CopyStr(curDesc, Scanner.tokBuf); (*{0d74-0d7b} FIXME: (dest,src) vs DEF order *) curDesc.raw[3] := 0; (*{0d7e-0d80}*) ELSIF Words(t)^[4] IN BITSET{384} THEN (*{0d83-0d89} FIXME set TBD *) IF Words(t)^[3] = 8 THEN (*{0d8b-0d8f} LONGREAL *) FoldRelation(); (* proc47; result dropped FIXME *) ELSE curDesc.raw[2] := Scanner.cardVal; (*{0d99-0d9d}*) END; ELSE curDesc.raw[2] := Scanner.cardVal; (*{0da1-0da4}*) END; EmitDescriptor2(curDesc); (* proc2 *) (*{0da5}*) Scanner.GetSym; (*{0da7}*) RETURN; END; CASE Scanner.identKd OF (*{0dab-0daf} *) | 1: (* const *) (*{0daf}*) curDesc.raw[1] := 0; (*{0db0-0db2}*) curDesc.raw[2] := curDesc.raw[2]; (*{0db3-0db7} FIXME: const value copy TBD *) EmitDescriptor2(curDesc); (* proc2 *) (*{0db9-0dba}*) Scanner.GetSym; (*{0dbb}*) | 3: (* parenthesised / builtin *) (*{0dbe}*) Scanner.GetSym; (*{0dbe}*) Scanner.TestR40(40); (*{0dc0-0dc2} FIXME arity *) IF Scanner.AcceptSy(45) THEN (*{0dc4-0dc8}*) MatchOpClass(16, 45); (* proc9 *) (*{0dca-0dce}*) CheckRelationTypes(t); (* nested proc51 *) (*{0dcf-0dd0}*) ELSE MatchOpClass(511, 43); (* proc9 *) (*{0dd4-0dd9}*) Scanner.GetSym; (*{0dda}*) BoolCondHelper; (* proc12 *) (*{0ddc}*) MatchOpClass(511, 0); (* proc9 *) (*{0ddd-0de1} FIXME errCode 0 *) IF (Words(t)^[3] + 1) DIV 2 # (Words(curDesc.raw[0])^[3] + 1) DIV 2 THEN Errors.ReportError(66); (*{0de2-0e00} FIXME pun *) END; curDesc.raw[0] := t; (*{0df1-0df4} FIXME *) curDesc.raw[1] := 2; (*{0df5-0df7}*) Scanner.ExpectSy(5); (*{0df8} ')' *) END; | 4: (* designator *) (*{0dfb}*) ParseDesignatorTail; (* proc15 *) (*{0dfb}*) IF Scanner.curSym = 43 THEN (* '(' call *) (*{0dfc-0e01}*) Scanner.GetSym; (*{0e03}*) MatchOpClass(512, 43); (* proc9 *) (*{0e05-0e0a}*) IF Words(t)^[2] # 0 THEN Errors.ReportError(60) END; (*{0e0b-0e10} FIXME *) StoreOperand; (* proc19 *) (*{0e11}*) ELSE EmitDescriptor2(curDesc); (* proc2 *) (*{0e15-0e16}*) END; | 5: (* variable load path *) (*{0e18}*) IF t # NIL THEN Errors.ReportError(60) END; (*{0e18-0e1c} FIXME *) LoadOperand; (* proc18 *) (*{0e1d}*) | 0: (* illegal *) (*{0e20}*) Errors.ReportErrorWithText(128, Scanner.tokBuf); (*{0e20-0e25} *) | 2: Errors.ReportError(22); (*{0e3b-0e3d} *) END; CheckAndStore(); (* proc22 FIXME arity *) (*{0e3f-0e40}*) END EmitCompare; PROCEDURE EmitRangeCheck; VAR buf: Desc; op: CARDINAL; rkind: CARDINAL; savePend: CARDINAL; saveMode: CARDINAL; isZero: BOOLEAN; BEGIN EmitCompare; (* nested proc50 *) (*{0e4a}*) IF ~(Scanner.curSym IN BITSET{51..57}) THEN (*{0e4c-0e54} FIXME set *) RETURN; END; EmitOp(); (* proc6 *) (*{0e57}*) op := Scanner.curSym; (*{0e58-0e5b}*) IF op = 64 THEN (* AND *) (*{0e5b-0e5f}*) ConstToCard(Compiler.BooleanType, 64); (* proc7 *) (*{0e61-0e63}*) Scanner.GetSym; (*{0e65}*) IF curDesc.raw[1] = 0 THEN (*{0e67-0e6a}*) CodeGen.DiscardPending; (*{0e6c}*) savePend := CodeGen.pendMode; saveMode := curDesc.raw[2]; (*{0e6e-0e84} *) CodeGen.pendMode := savePend AND saveMode; (*{0e85-0e8c} FIXME pun *) EmitCompare; (*{0e8a}*) ConstToCard(Compiler.BooleanType, 64); (*{0e8c-0e90}*) CodeGen.pendMode := savePend; (*{0e92-0e93}*) IF saveMode = 0 THEN (*{0e94-0e96}*) curDesc.raw[1] := 0; curDesc.raw[2] := 0; (*{0e98-0e9d}*) EmitDescriptor2(curDesc); (* proc2 *) (*{0e9e-0ea4}*) END; ELSE CodeGen.EmitStandardOp(11); (*{0e92}*) CodeGen.OpenFixup(saveMode, TRUE); (* proc12 *) (*{0e95-0e99} FIXME: CARDINAL VAR pun *) EmitCompare; (*{0e9a}*) ConstToCard(Compiler.BooleanType, 64); (*{0e9c-0ea0}*) CodeGen.InsertFixup(saveMode, TRUE); (* proc14 *) (*{0ea1-0ea3} FIXME *) Errors.ReportError(91); (*{0ea5-0ea7}*) curDesc.raw[1] := 2; (*{0ea8-0eaa}*) END; RETURN; END; buf := curDesc; (*{0eae-0eb1}*) IF op = 60 THEN rkind := 404; (* IN *) (*{0eb2-0eb6} FIXME magic *) ELSIF op = 63 THEN rkind := 272; ELSE rkind := 132; END; (*{0eca-0ecc} *) MatchOpClass(rkind, op); (* proc9 *) (*{0ecd-0ecf}*) Scanner.GetSym; (*{0ed0-0ed1}*) EmitCompare; (*{0ed2}*) EmitOp(); (* proc6 *) (*{0ed4}*) MatchOpClass(rkind, op); (* proc9 *) (*{0ed5-0ed7}*) FoldConstOp(buf); (* proc35 FIXME: kind result TBD *) (*{0ed8-0ed9}*) rkind := TypeKindOf(); (* proc27 FIXME: 0-arg vs use *) (*{0edb}*) IF op = 63 THEN op := 61 END; (*{0ede-0ee2}*) IF (curDesc.raw[1] = 0) AND (buf.raw[1] = 0) THEN (*{0ee7-0eef} both const *) CodeGen.DiscardPending; (*{0ef2}*) CodeGen.DiscardPending; (*{0ef4}*) IF op = 60 THEN (* '*' *) (*{0ef6-0efa}*) CASE buf.raw[0] OF (* FIXME: ADDRESS case-selector pun; kinds below TBD *) 0: curDesc.raw[2] := buf.raw[2] * curDesc.raw[2]; (* umul_checked *) (*{0eff-0f06} FIXME arith pun *) | 1: curDesc.raw[2] := buf.raw[2] * curDesc.raw[2]; (* imul *) (*{0f07-0f0e} FIXME *) | 2: curDesc.raw[2] := buf.raw[2] * curDesc.raw[2]; (* dmul FIXME *) (*{0f0f-0f19} *) | 3: curDesc.raw[2] := buf.raw[2] * curDesc.raw[2]; (* real_mul FIXME *) (*{0f1a-0f23} *) | 4: curDesc.raw[2] := buf.raw[2] AND curDesc.raw[2]; (* and FIXME *) (*{0f25-0f2c} *) END; FoldLongRelation(buf); (* FIXME: DOUBLES.qmul + proc47 *) ELSIF op = 61 THEN (* '/' zero check + div family *) (*{0f4e-0f52}*) IF rkind <= 1 THEN (*{0f54-0f57}*) IF curDesc.raw[2] = 0 THEN isZero := curDesc.raw[2] = 0 END; (*{0f59-0f5d} FIXME *) ELSIF rkind <= 3 THEN isZero := curDesc.raw[2] = 0; (* FIXME: real_compare *) ELSIF rkind = 5 THEN isZero := FALSE; (* FIXME: Doubles.qcp LONGREAL compare *) END; IF isZero THEN Errors.ReportError(76) END; (*{0f89-0f8e} div by zero *) CASE buf.raw[0] OF (*{0f90-0f91} FIXME pun *) 0: curDesc.raw[2] := buf.raw[2] DIV curDesc.raw[2]; (* udiv *) (*{0f93-0f9a} FIXME *) | 1: curDesc.raw[2] := buf.raw[2] DIV curDesc.raw[2]; (* idiv *) (*{0f9b-0fa2} FIXME *) | 2: curDesc.raw[2] := buf.raw[2] DIV curDesc.raw[2]; (* ddiv FIXME *) (*{0fa3-0fad} *) | 3: curDesc.raw[2] := buf.raw[2] DIV curDesc.raw[2]; (* real_div FIXME *) (*{0fae-0fb8} *) | 4: curDesc.raw[2] := BITSET(buf.raw[2]) / curDesc.raw[2]; (* xor FIXME *) (*{0fb9-0fc0} *) END; FoldLongDiv(buf); (* FIXME: Doubles.qdiv + proc47 *) ELSIF rkind = 2 THEN (*{0fe2-0fe5} LONGINT MOD *) curDesc.raw[2] := buf.raw[2] MOD curDesc.raw[2]; (*{0fe7-0fef} FIXME *) ELSE curDesc.raw[2] := buf.raw[2] MOD curDesc.raw[2]; (*{0ff3-0ff9} umod *) END; EmitDescriptor2(curDesc); (* proc2 *) (*{0ffa-0ffb}*) ELSE curDesc.raw[1] := 2; (*{0ffe-1000}*) IF (3 IN Scanner.scanOpt) AND (op = 60) AND (rkind = 0) THEN (*{1001-100e}*) CodeGen.EmitExtendedOp(op - 52, rkind); (* checked *) (*{1011-1015}*) ELSE CodeGen.EmitTypedOp(op - 52, rkind); (* plain *) (*{1019-101d}*) END; END; END EmitRangeCheck; PROCEDURE ParseSimpleExpression; VAR buf: Desc; op: CARDINAL; t: ADDRESS; savePend, saveMode: CARDINAL; BEGIN IF Scanner.curSym IN BITSET{58..60} THEN (* unary +/- *) (*{102a-1030} FIXME *) IF Scanner.AcceptSy(59) THEN (* '-' *) (*{1032-1036}*) EmitRangeCheck; (* nested proc49 *) (*{1038}*) EmitOp(); (* proc6 *) (*{103a}*) MatchOpClass(388, 59); (* proc9 *) (*{103b-1040}*) t := TypeKindOf(); (* proc27 FIXME: 0-arg; t role TBD *) (*{1041-1043}*) IF t = NIL THEN t := Compiler.CardType; ConstToCard(t, 59); END; (*{1044-104c} FIXME *) IF curDesc.raw[1] = 0 THEN (* const negation *) (*{104d-1050}*) CodeGen.DiscardPending; (*{1052}*) CASE Words(t)^[4] OF (*{1054-1076} FIXME pun *) 2: curDesc.raw[2] := curDesc.raw[2]; (* long_negate FIXME *) | 3: curDesc.raw[2] := curDesc.raw[2]; (* FIXME *) | 5: curDesc.raw[2] := curDesc.raw[2]; (* FIXME: Doubles.qneg *) | 4: curDesc.raw[2] := curDesc.raw[2]; (* complement+inc FIXME *) END; curDesc.raw[0] := Compiler.CardType; (*{108b-108e} FIXME *) ELSE CodeGen.EmitTypedOp(11, Words(t)^[4]); (* unary minus *) (*{1093-1095} FIXME *) END; ELSE Scanner.GetSym; (*{1099} '+' skip *) EmitRangeCheck; (*{109b}*) EmitOp(); (* proc6 *) (*{109d}*) MatchOpClass(388, 58); (* proc9 '+' *) (*{109e-10a3}*) END; ELSE EmitRangeCheck; (*{10a6}*) END; WHILE Scanner.curSym IN BITSET{51..57} DO (* +,-,OR *) (*{10a8-10b0} FIXME *) op := Scanner.curSym; (*{10b3-10b5}*) EmitOp(); (* proc6 *) (*{10b6}*) IF op = 65 THEN (* OR *) (*{10b7-10bb} FIXME: 65 outside 51..57 loop? TBD *) ConstToCard(Compiler.BooleanType, 65); (* proc7 *) (*{10bd-10c1}*) Scanner.GetSym; (*{10c2}*) IF curDesc.raw[1] = 0 THEN (*{10c4-10c7}*) CodeGen.DiscardPending; (*{10c9}*) savePend := CodeGen.pendMode; saveMode := curDesc.raw[2]; (*{10cb-10d6} *) CodeGen.pendMode := savePend OR (NOT saveMode); (*{10d1-10d6} FIXME pun *) EmitRangeCheck; (*{10d8}*) ConstToCard(Compiler.BooleanType, 65); (*{10da-10de}*) CodeGen.pendMode := savePend; (*{10df-10e0}*) IF saveMode # 0 THEN (*{10e2-10e3}*) curDesc.raw[1] := 0; curDesc.raw[2] := 1; (*{10e5-10eb}*) EmitDescriptor2(curDesc); (* proc2 *) (*{10ec}*) END; ELSE CodeGen.EmitStandardOp(12); (*{10ef-10f0}*) CodeGen.OpenFixup(saveMode, TRUE); (* proc12 *) (*{10f2-10f5} FIXME pun *) EmitRangeCheck; (*{10f7}*) ConstToCard(Compiler.BooleanType, 65); (*{10f9-10fd}*) CodeGen.InsertFixup(saveMode, TRUE); (* proc14 *) (*{10fe-1100} FIXME *) Errors.ReportError(91); (*{1102-1104}*) curDesc.raw[1] := 2; (*{1105-1107}*) END; ELSE buf := curDesc; (*{110b-110e}*) MatchOpClass(404, op); (* proc9 *) (*{110f-1114}*) Scanner.GetSym; (*{1115}*) EmitRangeCheck; (*{1116}*) EmitOp(); (* proc6 *) (*{1118}*) MatchOpClass(404, op); (* proc9 *) (*{1119-111e}*) FoldConstOp(buf); (* proc35 FIXME: kind result TBD *) (*{111f}*) t := TypeKindOf(); (* proc27 FIXME *) (*{1121}*) IF (curDesc.raw[1] = 0) AND (buf.raw[1] = 0) THEN (*{1124-112c}*) CodeGen.DiscardPending; (*{112e}*) CodeGen.DiscardPending; (*{1130}*) IF op = 58 THEN (* '+' *) (*{1132-1136}*) CASE Words(t)^[4] OF (*{1138-1139} FIXME pun *) 0: curDesc.raw[2] := buf.raw[2] + curDesc.raw[2]; (* uadd_checked *) (*{113b-1142} FIXME *) | 1: curDesc.raw[2] := buf.raw[2] + curDesc.raw[2]; (* iadd_checked *) (*{1143-114a} FIXME *) | 2: curDesc.raw[2] := buf.raw[2] + curDesc.raw[2]; (* dadd FIXME *) (*{114b-1155} *) | 3: curDesc.raw[2] := buf.raw[2] + curDesc.raw[2]; (* real_add FIXME *) (*{1156-1160} *) | 4: curDesc.raw[2] := buf.raw[2] OR curDesc.raw[2]; (* or; FIXME pun *) (*{1161-1168} *) END; FoldLongAdd(buf); (* FIXME: Doubles.qadd + proc47 *) ELSIF t = NIL THEN (* '-' family *) (*{118a-118b}*) CASE buf.raw[0] OF (* FIXME pun *) 2: curDesc.raw[2] := buf.raw[2] - curDesc.raw[2]; (* dsub FIXME *) | 3: curDesc.raw[2] := buf.raw[2] - curDesc.raw[2]; (* real_sub FIXME *) | 4: curDesc.raw[2] := buf.raw[2] - curDesc.raw[2]; (* diff FIXME *) | 5: curDesc.raw[2] := buf.raw[2] - curDesc.raw[2]; (* FIXME: Doubles.qsub *) END; ELSIF (t = NIL) OR ((buf.raw[2] >= 0) AND (curDesc.raw[2] > buf.raw[2])) THEN curDesc.raw[0] := Compiler.CardType; (* CARD result *) (*{11ca-11de} FIXME: group wrote word6 *) END; IF curDesc.raw[0] = Compiler.CardType THEN (*{11df-11e4}*) IF buf.raw[0] = Compiler.CardType THEN curDesc.raw[2] := buf.raw[2] - curDesc.raw[2]; (* isub_checked *) (*{11e6-11ec} FIXME *) ELSE curDesc.raw[2] := buf.raw[2] - curDesc.raw[2]; (* usub_checked *) (*{11ef-11f5} FIXME *) END; END; EmitDescriptor2(curDesc); (* proc2 *) (*{11f6}*) ELSE curDesc.raw[1] := 2; (*{11fa-11fc}*) IF (3 IN Scanner.scanOpt) AND (Words(t)^[4] <= 1) THEN CodeGen.EmitExtendedOp(op - 52, Words(t)^[4]); (* checked *) (*{1208-120c} FIXME *) ELSE CodeGen.EmitTypedOp(op - 52, Words(t)^[4]); (* plain *) (*{1210-1214} FIXME *) END; END; END; END; END ParseSimpleExpression; PROCEDURE ParseExpression; VAR buf: Desc; op: CARDINAL; cls: CARDINAL; rkind: CARDINAL; cres: CARDINAL; BEGIN ParseSimpleExpression; (* nested proc48 *) (*{1226}*) op := Scanner.curSym; (*{1228-122b}*) IF (op < 51) OR (op > 57) THEN (*{122b-1238} not a relop *) IF op # 0 THEN Errors.ReportError(75) END; (*{13e4} shared exit *) RETURN; END; EmitOp(); (* proc6 *) (*{1239}*) buf := curDesc; (*{123a-123d}*) Scanner.AcceptSy(51); (* '=' consume *) (*{123d-1241}*) IF Scanner.curSym = 0 THEN (*{1241} FIXME: literal-rhs fast path? *) ParseSimpleExpression; (*{1243}*) MatchOpClass(16, 51); (* proc9 '=' *) (*{1245-124a}*) FoldConstOp(buf); (* proc35 both sides *) (*{124c-1257} FIXME kind TBD *) IF (curDesc.raw[1] = 0) AND (buf.raw[1] = 0) THEN (*{125a}*) CodeGen.DiscardPending; (*{125c}*) CodeGen.DiscardPending; (*{125e}*) curDesc.raw[2] := buf.raw[2]; (* IN-fold FIXME pun *) (*{1260-1266}*) EmitDescriptor2(curDesc); (* proc2 *) (*{1267-1268}*) ELSE curDesc.raw[1] := 2; (*{126b-126d}*) CodeGen.EmitStandardOp(4); (* '=' compare *) (*{126e-1270}*) END; ELSIF IsOrdinalType(curDesc.raw[0]) THEN (* proc26 FIXME NYC *) ExpectBoolOrSet(); (* proc25 FIXME NYC *) Scanner.GetSym; (*{127d}*) ParseSimpleExpression; (*{127f}*) CheckAssignable(buf); (* proc36 FIXME: 0-arg vs Desc arg *) IF ~ IsOrdinalType(curDesc.raw[0]) THEN (*{1284-1289}*) FoldConstOp(buf); (* proc35 *) (*{128a-128c}*) END; buf := EmitSetMember(buf); (* proc11 pair FIXME NYC *) CodeGen.EmitStandardOp(7); (* IN test *) (*{1292-1294}*) CodeGen.EmitSystemCall(23); (*{1296-1298} bounds trap *) CodeGen.EmitTypedOp(op - 52, 0); (*{1299-1301}*) curDesc.raw[1] := 2; (*{1302-1304}*) ELSE IF op <= 53 THEN cls := 501; (* =,#,IN class *) (*{12a5-12ac} FIXME magic *) ELSIF op <= 55 THEN cls := 389; (* <,<= class *) (*{12b1-12ba} FIXME *) ELSE cls := 405; END; (* >,>= class *) (*{12bd-12c1} *) MatchOpClass(cls, op); (* proc9 *) (*{12c1-12c4}*) Scanner.GetSym; (*{12c5}*) ParseSimpleExpression; (*{12c6}*) EmitOp(); (* proc6 *) (*{12c8}*) MatchOpClass(cls, op); (* proc9 *) (*{12c9-12cb}*) FoldConstOp(buf); (* proc35 *) (*{12cc-12cd}*) rkind := TypeKindOf(); (* proc27 FIXME *) (*{12cf-12d1}*) IF (curDesc.raw[1] = 0) AND (buf.raw[1] = 0) THEN (*{12d2-12da}*) CodeGen.DiscardPending; (*{12dc}*) CodeGen.DiscardPending; (*{12de}*) cres := 0; (*{12e0-12e2}*) CASE Words(buf.raw[0])^[4] OF (*{12e2-12e3} FIXME pun *) 0: (* CARDINAL unsigned *) (*{12e5}*) IF buf.raw[2] > curDesc.raw[2] THEN cres := 2; ELSIF buf.raw[2] < curDesc.raw[2] THEN cres := 1; END; (*{12e5-12f8} *) | 1: (* INTEGER signed *) (*{12fa}*) IF buf.raw[2] > curDesc.raw[2] THEN cres := 2; ELSIF buf.raw[2] < curDesc.raw[2] THEN cres := 1; END; (*{12fa-130d} *) | 2: (* LONGINT *) (*{130f}*) IF buf.raw[2] > curDesc.raw[2] THEN cres := 2; ELSIF buf.raw[2] < curDesc.raw[2] THEN cres := 1; END; (* FIXME: dcompare *) | 3: (* REAL *) (*{132a}*) IF buf.raw[2] > curDesc.raw[2] THEN cres := 2; ELSIF buf.raw[2] < curDesc.raw[2] THEN cres := 1; END; (* FIXME: real_compare *) | 4: (* BITSET/WORD set equality limbs *) (*{1345}*) IF buf.raw[2] # curDesc.raw[2] THEN IF BITSET(buf.raw[2]) * BITSET(NOT curDesc.raw[2]) = {} THEN cres := 2; ELSIF BITSET(curDesc.raw[2]) * BITSET(NOT buf.raw[2]) = {} THEN cres := 1; END; END; (*{1349-1366} FIXME: CARDINAL BITSET/NOT puns *) END; CASE buf.raw[0] OF (* LONGREAL tail *) (*{1368} FIXME: ADDRESS case pun *) NIL: ; ELSE cres := cres; (* FIXME: Doubles.qcp LONGREAL compare *) END; CASE op OF (* map cres -> boolean *) (*{139d-13bc}*) 51: curDesc.raw[2] := ORD(cres = 0); (* '=' *) (*{13a0}*) | 52: curDesc.raw[2] := ORD(cres # 0); (* '#' *) (*{13a5}*) | 53: curDesc.raw[2] := ORD(cres = 1); (* '<' *) (*{13aa}*) | 54: curDesc.raw[2] := ORD(cres = 2); (* '<=' *) (*{13b0} FIXME limbs *) | 55: curDesc.raw[2] := ORD(cres # 2); (* '>' *) (*{13b6}*) ELSE curDesc.raw[2] := ORD(cres # 1); (* '>=' / IN *) (*{13cd-13d1}*) END; EmitDescriptor2(curDesc); (* proc2 *) (*{13d2-13d3}*) ELSE curDesc.raw[1] := 2; (*{13d6-13d8}*) CodeGen.EmitTypedOp(op - 52, rkind); (* general relop; FIXME pun *) (*{13d9-13dd}*) END; END; curDesc.raw[0] := Compiler.BooleanType; (* BOOLEAN result *) (*{13df-13e2} *) END ParseExpression; PROCEDURE GetConstVal; BEGIN BoolCondHelper; (* proc12 *) (*{13f5}*) IF curDesc.raw[1] # 0 THEN Errors.ReportError(25) END; (*{13f6-13fb}*) CodeGen.DiscardPending; (*{13fc-13fe}*) END GetConstVal; PROCEDURE GetTypeDesc(src: ADDRESS; dest: ADDRESS; mode: CARDINAL); BEGIN GetConstVal; (* proc13 *) (*{1402}*) EmitOp(); (* proc6 *) (*{1403}*) ConstToCard(src, 0); (* proc7 *) (*{1404-1406} FIXME: (c,errPos) vs call shape *) PopExprDesc(src); (* proc5 FIXME: DescPtr vs ADDRESS *) IF (curDesc.raw[0] # Compiler.CardType) OR (curDesc.raw[2] < 0) THEN Errors.ReportError(80); (*{1409-1416} *) END; Words(dest)^[0] := curDesc.raw[2]; (*{1417-141e} FIXME pun *) IF Scanner.AcceptSy(4) THEN (* ',' second bound *) (*{141f-1422}*) GetConstVal; (*{1424}*) EmitOp(); (*{1426}*) ConstToCard(src, 0); (*{1427-0429} *) PopExprDesc(src); (*{042a} *) IF (curDesc.raw[0] # Compiler.CardType) OR (curDesc.raw[2] < 0) THEN Errors.ReportError(80); (*{142b-1438} *) END; IF curDesc.raw[2] < Words(dest)^[0] THEN Errors.ReportError(46) END; (*{143a-1440} FIXME *) Words(dest)^[0] := curDesc.raw[2]; (*{1441-1444} upper bound *) END; END GetTypeDesc; PROCEDURE CheckAssignmentCompat(dst: ADDRESS); BEGIN IF ~ BaseTypeOf(dst, curDesc.raw[0]) THEN (* proc34 FIXME: 2-param vs use *) Errors.ReportIncompatibleTypes(dst, curDesc.raw[0], " assignment"); (*{1456-1469} FIXME T1 pun *) END; END CheckAssignmentCompat; PROCEDURE ParseAssignment; VAR saved: Desc; BEGIN assignActive := 1; (*{1473-1474} global8 *) IF curDesc.raw[4] > 9 THEN (*{1475-1480} set-ctor rhs? *) EmitDescriptor2(curDesc); (* FIXME: proc2 via proc10? *) ELSIF curDesc.raw[4] = 4 THEN (*{1480-1484} string/const rhs? *) EmitDescriptor2(curDesc); (* FIXME: proc10 *) END; curDesc.raw[4] := 2; curDesc.raw[3] := 0; (*{1488-1490}*) saved := curDesc; (*{148e-1491}*) IF (Scanner.identKd = 5) AND (Words(curDesc.raw[0])^[4] = 9) THEN (* func result? *) (*{1492-149d} FIXME *) ParseDesignatorBase(saved.raw[0], saved.raw[2], saved.raw[5], saved.raw[6]); (* proc21; FIXME: 4-formal roles TBD *) CheckForwardRef(); (* proc29 FIXME NYC *) PopExprDesc(saved); (* proc3 FIXME: Desc value vs DescPtr *) Scanner.GetSym; (*{14b1}*) ELSE BoolCondHelper; (* proc12 *) (*{14b7}*) CheckAssignable2(saved.raw[0]); (* proc26 FIXME NYC *) IF ~ CheckAssignable2(saved.raw[0]) THEN (*{14bc}*) CheckAssignable2(saved.raw[0]); (* proc52 nested FIXME NYC *) END; IF (curDesc.raw[0] # saved.raw[0]) AND (curDesc.raw[1] # 0) THEN (*{14cb-14d5}*) Errors.DerefAliasType(0); (* proc25 FIXME NYC: arg TBD *) END; IF (curDesc.raw[2] # 0) AND (saved.raw[2] # 0) THEN (*{14da-14e4}*) IF saved.raw[2] - saved.raw[5] = curDesc.raw[2] - curDesc.raw[5] THEN (*{14e6-14f8}*) PopExprDesc(saved); (* proc3 FIXME *) ELSE EmitSetOrArrayAssign(saved); (* proc11 pair FIXME NYC *) CodeGen.EmitStandardOp(18); (*{1503-1505}*) END; ELSE CheckAssignable2(saved.raw[0]); (*{1509-150b}*) PopExprDesc(saved); (* proc5 *) (*{1510-1511} FIXME *) PopExprDesc(saved); (* proc3 *) (*{1511} FIXME *) END; END; assignActive := 0; (*{1512-1513}*) END ParseAssignment; BEGIN (* proc0 @1516 module init: global9 -> global5 copy; global8 := 0 *) exprPool := SymTab.stringPoolPtr; (* FIXME: which string pool? TBD *) assignActive := 0; END Express.