|
@@ -0,0 +1,1489 @@
|
|
|
|
|
+(* 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.
|
|
|
|
|
+
|
|
|
|
|
+ Numbered-module mappings applied (verified against .DEF orders):
|
|
|
|
|
+ - Compiler.word6..26 = IntType..compilationActive (DEF order = word order).
|
|
|
|
|
+ - Scanner.word2/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.proc5/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 ---- *)
|
|
|
|
|
+(*FIXME-NYC*) PROCEDURE CentralError(code: CARDINAL); FORWARD; (* proc1 *)
|
|
|
|
|
+(*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;
|
|
|
|
|
+(* Forward refs to group-defined procedures used before definition *)
|
|
|
|
|
+PROCEDURE ParseExpression; FORWARD;
|
|
|
|
|
+PROCEDURE ParseDesignatorTail; FORWARD;
|
|
|
|
|
+PROCEDURE ParseTerm(a, b: CARDINAL); FORWARD; (* FIXME arity: 3-arg call sites *)
|
|
|
|
|
+PROCEDURE ParseSetCons(s, flag: CARDINAL); FORWARD; (* FIXME: 1-arg call site *)
|
|
|
|
|
+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(src: DescPtr; dst: DescPtr); FORWARD; (* FIXME arities *)
|
|
|
|
|
+PROCEDURE ConstToCard(errPos: CARDINAL; c: DescPtr); FORWARD;
|
|
|
|
|
+PROCEDURE ConstToInt(errPos: CARDINAL; c: DescPtr); FORWARD;
|
|
|
|
|
+PROCEDURE MatchOpClass(errCode: CARDINAL; allowed: BITSET); 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; op: CARDINAL); FORWARD; (* FIXME: 1-arg site *)
|
|
|
|
|
+PROCEDURE FoldRelation(): ADDRESS; FORWARD;
|
|
|
|
|
+PROCEDURE ParseFactor(p1, p2, p3, p4, p5: CARDINAL); FORWARD;
|
|
|
|
|
+PROCEDURE EvalConstExpr; FORWARD;
|
|
|
|
|
+PROCEDURE ParseSetOrCastTail; FORWARD;
|
|
|
|
|
+PROCEDURE ParseAssignment; FORWARD;
|
|
|
|
|
+PROCEDURE IsOrdinal(t: Compiler.RecordPtr): BOOLEAN; FORWARD;
|
|
|
|
|
+PROCEDURE IsSet(t1, t2: Compiler.RecordPtr): BOOLEAN; FORWARD;
|
|
|
|
|
+PROCEDURE BaseTypeOf(t1, t2: Compiler.RecordPtr): BOOLEAN; FORWARD;
|
|
|
|
|
+PROCEDURE CheckAssignable; FORWARD;
|
|
|
|
|
+PROCEDURE ParseSelector(needVal: BOOLEAN; base: Compiler.RecordPtr; sel: Compiler.RecordPtr); FORWARD;
|
|
|
|
|
+PROCEDURE ParseDesignatorBase(VAR ok1, ok2: BOOLEAN; VAR id1, id2: CARDINAL; p1, p2: CARDINAL): BOOLEAN; FORWARD; (* FIXME: 3/4-arg sites *)
|
|
|
|
|
+PROCEDURE GetTypeDesc(dest: ADDRESS; mode: CARDINAL; src: ADDRESS); FORWARD;
|
|
|
|
|
+PROCEDURE CheckAssignmentCompat(dst: ADDRESS); FORWARD;
|
|
|
|
|
+
|
|
|
|
|
+(* EXPRESS group 1 — descriptors, predicates, const-fold, designator base, selector *)
|
|
|
|
|
+
|
|
|
|
|
+(* proc4 @004a — ~PushExprDesc *)
|
|
|
|
|
+PROCEDURE PushExprDesc(src: DescPtr; dst: 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.scanOptions 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(t1, t2: 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(t1, t2^.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(t1, t2: 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(errPos: CARDINAL; c: DescPtr);
|
|
|
|
|
+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(errPos: CARDINAL; c: DescPtr);
|
|
|
|
|
+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(errCode: CARDINAL; allowed: BITSET);
|
|
|
|
|
+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(VAR ok1, ok2: BOOLEAN;
|
|
|
|
|
+ VAR id1, id2: CARDINAL; p1, p2: 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(p2, ADR(w8), ADR(f1), ADR(found1));
|
|
|
|
|
+ Pass1.CondInsert(p1, 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(p2, ADR(w8), ADR(f1), ADR(found1));
|
|
|
|
|
+ Pass1.InsertEntry(p1, ADR(w9), ADR(f2), ADR(found2));
|
|
|
|
|
+ END;
|
|
|
|
|
+ {/* 0324 */} (* match iff same head and same tail selector *)
|
|
|
|
|
+ RETURN (found1 = found2) AND (p2 = p1);
|
|
|
|
|
+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(needVal: BOOLEAN; base: RecordPtr; sel: 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.AcceptSymbol(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.TestSymbolRange40(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; g6 := 0; EvalConstExpr; (*{0512-0517}*)
|
|
|
|
|
+ LOOP
|
|
|
|
|
+ IF (Scanner.curSymbol # 3) & ((Scanner.curSymbol-44) > 5) THEN EXIT END; (*{0519-0525}*)
|
|
|
|
|
+ IF Scanner.AcceptSymbol(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[2] = 0 THEN (*{0554-0556} typeless actual *)
|
|
|
|
|
+ ConstToInt(Compiler.CardType, 44); PopExprDesc; (*{0559-055e}*)
|
|
|
|
|
+ IF 8 IN Scanner.scanOptions THEN (*{0561}*)
|
|
|
|
|
+ EmitAddress; CodeGen.QueueConst(0); CodeGen.EmitStandardOp(0); (*{0567-056d}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ curDesc[3] := curDesc[3]-2; (*{0570-0575}*)
|
|
|
|
|
+ ELSE (*{0578} typed actual *)
|
|
|
|
|
+ ConstToInt(curDesc[2], 44); ConstToCard(curDesc[2], curDesc[2]); (*{0579-057f}*)
|
|
|
|
|
+ CodeGen.QueueConst(curDesc[5]); CodeGen.EmitTypedOp(7, 0); (*{0580-0587}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ IF more THEN CodeGen.EmitTypedOp(6, 0) END; (*{0589-058e}*)
|
|
|
|
|
+ curDesc := buf; (*{0590-0592}*)
|
|
|
|
|
+ IF ~ Scanner.TestSymbolInSet(66) THEN EXIT END; (*{0594-0598}*)
|
|
|
|
|
+ IF ~ Scanner.AcceptSymbol(6) THEN (*{059c-059e}*)
|
|
|
|
|
+ IF Scanner.AcceptSymbol(44) THEN EXIT END; (*{05a1-05a8}*)
|
|
|
|
|
+ ELSE Scanner.GetSym; (*{05ab}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ more := TRUE; (*{05ad-05ae}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ curDesc[4] := 5; g6 := 1; (*{05b1-055b} handler exit *)
|
|
|
|
|
+ ELSIF Scanner.AcceptSymbol(46) THEN (*{05b8-05bb} '[' subscript *)
|
|
|
|
|
+ PushOperand; (*{05be}*)
|
|
|
|
|
+ IF (Compiler.rangeCheckEnabled # 0) & (8 IN Scanner.scanOptions) THEN (*{05c0-05c8}*)
|
|
|
|
|
+ CodeGen.EmitStandardOp(6); (*{05ca-05c4}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ IF curDesc[0] = Compiler.AddressType THEN curDesc[0] := Compiler.WordType ELSE (*{05cd-05d9}*)
|
|
|
|
|
+ IF ~ MatchOpClass(32, 46) THEN (*{05db-05df}*) END;
|
|
|
|
|
+ curDesc[0] := curDesc[2]; (*{05e1-05e4}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ curDesc[4] := 2; curDesc[3] := 0; g6 := 1; (*{05e5-05ec}*)
|
|
|
|
|
+ ELSE (*{05ef} '.'-field / deref tail *)
|
|
|
|
|
+ IF curDesc[4] # 2 THEN (*{05f1-05f3}*)
|
|
|
|
|
+ NormalizeOperand; curDesc[4] := 2; curDesc[3] := 0; (*{05f5-05fc}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ SymTabSave := SymTab.identClass; (*{05fd-0602} FIXME: no such SymTab export *)
|
|
|
|
|
+ IF ~ MatchOpClass(1024, 3) THEN (*{0604-0608}*) END;
|
|
|
|
|
+ curDesc[0] := curDesc[5]; Scanner.GetSym; Scanner.NeedIdentifier; (*{0609-0612}*)
|
|
|
|
|
+ IF Scanner.word13 (*FIXME*) # SymTabSave THEN (*{0614-0616} FIXME: word13 TBD *)
|
|
|
|
|
+ Errors.ReportErrorWithText(2, Scanner.tokenBuffer); (*{0618-061d}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ curDesc[3] := Scanner.curNode+curDesc[5]; (*{061f-0626} FIXME: word8=curNode pun *)
|
|
|
|
|
+ curDesc[0] := Scanner.literalType; SymTab.identClass := SymTabSave; (*{0627-062d}*)
|
|
|
|
|
+ Scanner.GetSym; (*{062f}*)
|
|
|
|
|
+ WHILE Scanner.curSymbol = 3 DO (*{0631-0635}*)
|
|
|
|
|
+ IF curDesc[3] > 510 THEN (*{063b-063d}*)
|
|
|
|
|
+ CodeGen.QueueConst(curDesc[3]); CodeGen.EmitTypedOp(6, 0); (*{063f-0645}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ curDesc[3] := 0; (*{0647-0649}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ g6 := 1; (*{064a-064b}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ CheckAndStore; (*{064c} local proc22 *)
|
|
|
|
|
+ END; (*{064f} back to {0519}*)
|
|
|
|
|
+ curDesc[1] := 1; (*{0652-0654} result flag *)
|
|
|
|
|
+END ParseDesignatorTail;
|
|
|
|
|
+
|
|
|
|
|
+(*{0470} PROCEDURE EvalConstExpr *)
|
|
|
|
|
+PROCEDURE EvalConstExpr;
|
|
|
|
|
+VAR lit: CARDINAL;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ Scanner.PushWithScope; Scanner.ExpectIdentKind(4); (*{0472-0475}*)
|
|
|
|
|
+ curDesc[3] := Scanner.curNode; lit := Scanner.curNode; (*{0477-047f} FIXME: word8 pun *)
|
|
|
|
|
+ IF (Scanner.followSet & 262) = 0 THEN (*{0480-0488} ident/number path *)
|
|
|
|
|
+ IF lit = 0 THEN curDesc[4] := 1; (*{048a-0491}*)
|
|
|
|
|
+ ELSIF lit = spillFlag THEN curDesc[4] := 0; (*{0493-049b} nil *)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ curDesc[2] := spillFlag-lit; curDesc[4] := 4; (*{049d-04a4} deref const *)
|
|
|
|
|
+ IF (4 IN Scanner.followSet) & (Scanner.literalType <= 9) THEN (*{04a5-04b0}*)
|
|
|
|
|
+ CodeGen.SetPendingOp(1, curDesc[4], curDesc[2], curDesc[3]); (*{04b2-04b9}*)
|
|
|
|
|
+ curDesc[4] := 2; curDesc[3] := 0; (*{04bb-04c0}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ END;
|
|
|
|
|
+ ELSIF 8 IN Scanner.followSet THEN (*{04c3-04c7} cardinal const *)
|
|
|
|
|
+ CodeGen.QueueConst(curDesc[3]); curDesc[4] := 2; curDesc[3] := 0; g6 := 1; (*{04c9-04d4}*)
|
|
|
|
|
+ ELSIF 1 IN Scanner.followSet THEN (*{04d7-04db} integer const *)
|
|
|
|
|
+ curDesc[2] := lit; curDesc[4] := 3; (*{04dd-04e2}*)
|
|
|
|
|
+ ELSE (*{04e5} string/char const *)
|
|
|
|
|
+ PushStringConst; (* local proc2 {04e9} *)
|
|
|
|
|
+ curDesc[4] := 2; g6 := 1; (*{04ea-04ee}*)
|
|
|
|
|
+ IF curDesc[3] > 510 THEN (*{04ef-04f5} long string -> static *)
|
|
|
|
|
+ CodeGen.QueueConst(curDesc[3]); CodeGen.EmitTypedOp(6, 0); (*{04f7-04fd}*)
|
|
|
|
|
+ curDesc[3] := 0; (*{04ff-0501}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ END;
|
|
|
|
|
+ CheckAndStore(Scanner.literalType, 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.ExpectSymbol(1); (*{066c-066d}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ IF p2 # 0 THEN ParseDesignatorTail; NormalizeOperand; END; (*{066f-0675}*)
|
|
|
|
|
+ Scanner.PushWithScope; (*{0677}*)
|
|
|
|
|
+ IF (Scanner.identKind = 5) & (p3 = 9) THEN (*{0679-0683} stdfunc misuse *)
|
|
|
|
|
+ CentralError(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(t, flag: 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.ExpectSymbol(5); (*{06b6-06b8} '*' expected *)
|
|
|
|
|
+END ParseTerm;
|
|
|
|
|
+
|
|
|
|
|
+(*{0704} PROCEDURE ParseSetCons(s, flag) — 2 params; set constructor *)
|
|
|
|
|
+PROCEDURE ParseSetCons(s, flag: 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.EnterModuleSymbol("TEXTS", 4); (*{071d-0728}*)
|
|
|
|
|
+ res := ParseFuncCall(mod); (*{072c-072f} nested proc41 *)
|
|
|
|
|
+ IF s = 0 THEN Scanner.TestSymbolRange40(8) END; (*{0730-0735}*)
|
|
|
|
|
+ IF Scanner.AcceptSymbol(43) & (s # 0) & Scanner.AcceptSymbol(5) THEN (*{0737-0743}*)
|
|
|
|
|
+ ELSE RETURN END; (*{0744} empty set *)
|
|
|
|
|
+ Scanner.PushWithScope; first := TRUE; (*{0747-074a}*)
|
|
|
|
|
+ IF (Scanner.identKind = 4) & (Scanner.literalType = 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.TestSymbolInSet(34) THEN ELSE Scanner.TestSymbolInSet(2) END; (*{076f-0776}*)
|
|
|
|
|
+ Scanner.AcceptSymbol(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[0] OF (*{0798-0817} switch on type tag 90..101 *)
|
|
|
|
|
+ 90: ;
|
|
|
|
|
+ 91: ;
|
|
|
|
|
+ 92: bad := curDesc[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[0] = Compiler.LongrealType THEN (*{07b8-07bc} LONGREAL *)
|
|
|
|
|
+ ParseTypeCast(22); ParseTypeCast(65523);
|
|
|
|
|
+ mod := Scanner.EnterModuleSymbol("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[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[0] # 0 THEN
|
|
|
|
|
+ Errors.ReportErrorWithText(curDesc[0]+7, curDesc[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.TestSymbolInSet(34) THEN Scanner.AcceptSymbol(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.AcceptSymbol(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[3]; (*{08e6-08e8}*)
|
|
|
|
|
+ IF Scanner.AcceptSymbol(1) THEN (*{08e9-08ec}*)
|
|
|
|
|
+ PushOperand; (*{08ee}*)
|
|
|
|
|
+ IF ~ MatchOpClass(1024, 1) THEN (*{08f1-08f5}*) END;
|
|
|
|
|
+ IF first # 0 THEN CentralError(63) END; (*{08f6-08fd} GetConstVal guard *)
|
|
|
|
|
+ GetConstVal; ConstToCard(curDesc[2], 1); (*{08fe-0902}*)
|
|
|
|
|
+ LOOP (*{0903-0912} ','-separated consts *)
|
|
|
|
|
+ IF first # 0 THEN CentralError(63) END; (*{090a-0911}*)
|
|
|
|
|
+ GetConstVal;
|
|
|
|
|
+ IF ~ Scanner.AcceptSymbol(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.FindIdent(id, pat, 9 IN Scanner.scanOptions); (*{0944-094e}*)
|
|
|
|
|
+ id := STACK[0]; (*{0950-0952} FIXME: raw stack *)
|
|
|
|
|
+ IF id = 0 THEN CentralError(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(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[4]) OR ((curDesc[4] = 2) & (Compiler.rangeCheckEnabled # 0)) THEN (*{09a4-09b3}*)
|
|
|
|
|
+ IF (curDesc[4] # 5) OR (curDesc[0] # 1) THEN CentralError(96) END; (*{09b5-09c0}*)
|
|
|
|
|
+ NormalizeOperand; curDesc[4] := 2; curDesc[3] := 0; (*{09c3-09ca}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ IF curDesc[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.literalType; 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.ExpectSymbol(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.AcceptSymbol(1) THEN (*{0a1d-0a20}*)
|
|
|
|
|
+ ParseExpression; ConstToCard(Compiler.CardType, t2);
|
|
|
|
|
+ ELSE CodeGen.QueueConst(1); (*{0a29-0a2a}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ IF buf.raw[0] = 0 THEN curDesc[0] := Compiler.CardType ELSE curDesc[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.ExpectSymbol(1); (*{0a5d-0a60}*)
|
|
|
|
|
+ ParseExpression; ConstToCard(buf.raw[0], curDesc[2]); ConstToCard(buf.raw[0], curDesc[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.ExpectSymbol(5); (*{0a92-0a93}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ ELSE (*{0a98} t3 > 3: conversion/builtin head *)
|
|
|
|
|
+ Scanner.ExpectSymbol(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[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[2] = 0 THEN EmitAddress (*{0aec-0af4} local proc28 *)
|
|
|
|
|
+ ELSE CodeGen.QueueConst(curDesc[2]); (*{0af7-0afd}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ | 100: ParseDesignatorTail; (*{0b00} CAP-class? *)
|
|
|
|
|
+ IF g6 # 0 THEN (*{0b01}*)
|
|
|
|
|
+ ELSIF curDesc[4] > 9 THEN CentralError(97); (*{0b02-0b0b}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ NormalizeOperand; (*{0b0c-0b0e}*)
|
|
|
|
|
+ | 101, 102:
|
|
|
|
|
+ Scanner.PushWithScope; (*{0b0f}*)
|
|
|
|
|
+ IF (Scanner.identKind = 3) & (t3 = 12) THEN (*{0b11-0b1a}*)
|
|
|
|
|
+ Scanner.ExpectIdentKind(3); Scanner.GetSym; (*{0b1c-0b1f}*)
|
|
|
|
|
+ ExpandStdProc44(Scanner.literalType); (*{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.PushWithScope; Scanner.ExpectIdentKind(3); (*{0b34-0b37}*)
|
|
|
|
|
+ t4 := Scanner.literalType; (*{0b39-0b3b}*)
|
|
|
|
|
+ curDesc[0] := t2; (*{0b3c-0b3e}*)
|
|
|
|
|
+ IF t3 = 13 THEN (*{0b3f-0b43} VAL-class *)
|
|
|
|
|
+ IF ~ MatchOpClass(7, t2) THEN (*{0b44-0b47}*) END;
|
|
|
|
|
+ Scanner.GetSym; Scanner.ExpectSymbol(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.ExpectSymbol(5); (*{0ba0-0ba1} close *)
|
|
|
|
|
+ END;
|
|
|
|
|
+ ELSE (*{0ba5} typed head: index/select *)
|
|
|
|
|
+ IF (t2[2] # 0) OR (t2[6] # 0) THEN Scanner.TestSymbolRange40(8) END; (*{0ba5-0bb2}*)
|
|
|
|
|
+ IF Scanner.AcceptSymbol(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[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 *)
|
|
|
|
|
+PROCEDURE LoadOperand;
|
|
|
|
|
+VAR savedNode: ADDRESS;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ IF 6 IN Scanner.followSet THEN (*{0bd4}*)
|
|
|
|
|
+ ParseSetOrCastTail; (* proc39 *) (*{0bda}*)
|
|
|
|
|
+ RETURN;
|
|
|
|
|
+ END;
|
|
|
|
|
+ CodeGen.EmitSystemCall(20); (*{0bde}*)
|
|
|
|
|
+ savedNode := Scanner.curNode; (*{0be3}*)
|
|
|
|
|
+ Scanner.GetSym; (*{0be6}*)
|
|
|
|
|
+ IF (curDesc.word2 # 0) OR (curDesc.word6 # 0) THEN (*{0be8-0bf0}*)
|
|
|
|
|
+ Scanner.TestSymbolRange40(8); (*{0bf2}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ IF Scanner.AcceptSymbol(43) THEN (*{0bf5} '(' *)
|
|
|
|
|
+ ParseTerm(savedNode, curDesc.word6, savedNode); (* proc37; FIXME: 3-arg call, signature TBD *)
|
|
|
|
|
+ END;
|
|
|
|
|
+ EmitOperand31(savedNode); (* proc31; FIXME: NYC — decompile *)
|
|
|
|
|
+ curDesc.word0 := savedNode; (*{0c03-0c06}*)
|
|
|
|
|
+ curDesc.word1 := 2; (*{0c07-0c09}*)
|
|
|
|
|
+END LoadOperand;
|
|
|
|
|
+
|
|
|
|
|
+(* proc19 @0c0c — ~StoreOperand *)
|
|
|
|
|
+PROCEDURE StoreOperand;
|
|
|
|
|
+VAR mark: ADDRESS; savedSp: CARDINAL; savedDesc: Desc; size: CARDINAL;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ Scanner.GetStackMark(mark); (*{0c0e}*)
|
|
|
|
|
+ savedSp := spillTop; (*{0c11} global3 *)
|
|
|
|
|
+ savedDesc := curDesc; (*{0c13-0c15}*)
|
|
|
|
|
+ IF 36 IN curDesc.word4 THEN (*{0c16-0c1b}*)
|
|
|
|
|
+ EmitDescriptor2(curDesc); (* proc2; FIXME: NYC *)
|
|
|
|
|
+ PushExprDesc(mark, Compiler.ProcType); (* proc4; FIXME *)
|
|
|
|
|
+ PopExprDesc(mark); (* proc3; FIXME *)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ mark^ := curDesc; (*{0c28-0c2b} copy block 10 *)
|
|
|
|
|
+ END;
|
|
|
|
|
+ CodeGen.EmitSystemCall(20); (*{0c2c}*)
|
|
|
|
|
+ ParseTerm(savedDesc, savedDesc, savedDesc); (* proc37; FIXME arity *)
|
|
|
|
|
+ EmitDescriptor2(curDesc); (* proc2 *)
|
|
|
|
|
+ CodeGen.EmitStandardOp(13); (*{0c39}*)
|
|
|
|
|
+ curDesc.word0 := savedDesc.word2; (*{0c3c-0c3f}*)
|
|
|
|
|
+ curDesc.word1 := 2; (*{0c40-0c42}*)
|
|
|
|
|
+ size := 0; (*{0c43-0c44}*)
|
|
|
|
|
+ IF savedDesc.word2 # 0 THEN (*{0c45-0c47}*)
|
|
|
|
|
+ size := savedDesc.word2 + savedDesc.word3; (*{0c4a-0c4d}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ CodeGen.EmitExtCall3(19, savedDesc.word5, size); (*{0c4e-0c52}*)
|
|
|
|
|
+ size := (size + 1) DIV 2 * 2; (*{0c54-0c5a}*)
|
|
|
|
|
+ CodeGen.EmitExtCall3(size DIV 256, 0, 0);
|
|
|
|
|
+ spillTop := savedSp; (*{0c5d-0c5e}*)
|
|
|
|
|
+END StoreOperand;
|
|
|
|
|
+
|
|
|
|
|
+(* proc47 @0c61 — ~FoldRelation: spill LONGREAL operand to temp, return it *)
|
|
|
|
|
+PROCEDURE FoldRelation(): ADDRESS;
|
|
|
|
|
+VAR tmp: ADDRESS;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ Scanner.Allocate(tmp, 8); (*{0c63-0c67}*)
|
|
|
|
|
+ tmp := curDesc.word2; (*{0c69} FIXME: LONGREAL pun, TBD *)
|
|
|
|
|
+ RETURN tmp;
|
|
|
|
|
+END FoldRelation;
|
|
|
|
|
+
|
|
|
|
|
+(* proc51 @0c74 — ~CheckRelationTypes: set-constructor relation check *)
|
|
|
|
|
+PROCEDURE CheckRelationTypes(t1: ADDRESS; op: CARDINAL);
|
|
|
|
|
+VAR buf: Desc;
|
|
|
|
|
+ acc, acc2: BITSET;
|
|
|
|
|
+ bothConst, anyConst: BOOLEAN;
|
|
|
|
|
+ lo, hi: CARDINAL;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ acc := {}; acc2 := {};
|
|
|
|
|
+ IF ~ Scanner.AcceptSymbol(7) THEN (*{0c7d-0c81}*)
|
|
|
|
|
+ RETURN;
|
|
|
|
|
+ END;
|
|
|
|
|
+ BoolCondHelper; (* proc12 *) (*{0c83}*)
|
|
|
|
|
+ ConstToCard(t1, 0); (* proc7 *) (*{0c84-0c86}*)
|
|
|
|
|
+ PopExprDesc(t1); (* proc5 *) (*{0c88-0c8a}*)
|
|
|
|
|
+ IF ~ Scanner.AcceptSymbol(4) THEN (*{0c8b-0c8e} single element *)
|
|
|
|
|
+ anyConst := curDesc.word1 # 0; (*{0cc9-0ccc}*)
|
|
|
|
|
+ IF anyConst THEN CodeGen.EmitStandardOp(5); (*{0cd0}*)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ CodeGen.DiscardPending; (*{0cd5}*)
|
|
|
|
|
+ acc := acc + BITSET{Power2(curDesc.word2)}; (*{0cd7-0cdc} FIXME: Power2 NYC *)
|
|
|
|
|
+ END;
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ buf := curDesc; (*{0c90-0c93}*)
|
|
|
|
|
+ BoolCondHelper; (*{0c94}*)
|
|
|
|
|
+ ConstToCard(t1, 0); (*{0c95-0c97}*)
|
|
|
|
|
+ PopExprDesc(t1); (*{0c99-0c9b}*)
|
|
|
|
|
+ bothConst := (curDesc.word1 # 0) OR (buf.mode # 0); (*{0c9c-0ca4}*)
|
|
|
|
|
+ IF bothConst THEN
|
|
|
|
|
+ CodeGen.EmitStandardOp(26); (*{0ca8-0caa} set AND folded *)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ CodeGen.DiscardPending; (*{0cae}*)
|
|
|
|
|
+ CodeGen.DiscardPending; (*{0cb0}*)
|
|
|
|
|
+ lo := buf.value; hi := curDesc.word2; (*{0cb2-0cb7}*)
|
|
|
|
|
+ WHILE lo <= hi DO (*{0cb8-0cbb}*)
|
|
|
|
|
+ acc := acc + BITSET{Power2(lo)}; (*{0cbd-0cc1}*)
|
|
|
|
|
+ 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.TestSymbolInSet(130); (*{0ceb-0ced} relop set *)
|
|
|
|
|
+ IF ~ Scanner.AcceptSymbol(1) THEN (*{0cef-0cf3} *)
|
|
|
|
|
+ Scanner.GetSym; (*{0cf5}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ IF acc2 # {} THEN (*{0cf7-0cf8}*)
|
|
|
|
|
+ IF acc # {} THEN (*{0cfa-0cfc}*)
|
|
|
|
|
+ CodeGen.QueueConst(acc); (*{0cff-0d00} FIXME: BITSET arg pun *)
|
|
|
|
|
+ CodeGen.EmitTypedOp(6, 4); (*{0d02-0d04}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ curDesc.word1 := 2; (*{0d06-0d08}*)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ CodeGen.QueueConst(acc); (*{0d0b-0d0d}*)
|
|
|
|
|
+ curDesc.word1 := 0; (*{0d0e-0d10} const set *)
|
|
|
|
|
+ curDesc.word2 := acc; (*{0d11-0d13} FIXME: BITSET pun *)
|
|
|
|
|
+ END;
|
|
|
|
|
+ curDesc.word0 := t1; (*{0d14-0d16} result type *)
|
|
|
|
|
+END CheckRelationTypes;
|
|
|
|
|
+
|
|
|
|
|
+(* proc50 @0d1a — ~EmitCompare: factor-level dispatch (NOT/paren/const/call/var) *)
|
|
|
|
|
+PROCEDURE EmitCompare;
|
|
|
|
|
+VAR t: ADDRESS;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ IF Scanner.curSymbol = 66 THEN (* NOT *) (*{0d1c-0d21}*)
|
|
|
|
|
+ Scanner.GetSym; (*{0d23}*)
|
|
|
|
|
+ EmitCompare; (* with_frame proc50 *) (*{0d25}*)
|
|
|
|
|
+ ConstToCard(Compiler.BooleanType, 66); (* proc7; FIXME: group wrote word14 *)
|
|
|
|
|
+ IF curDesc.word1 = 0 THEN (*{0d2d-0d30}*)
|
|
|
|
|
+ CodeGen.DiscardPending; (*{0d32}*)
|
|
|
|
|
+ curDesc.word2 := NOT curDesc.word2; (*{0d34-0d39} FIXME: CARDINAL NOT pun *)
|
|
|
|
|
+ EmitDescriptor2(curDesc); (* proc2 *)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ CodeGen.EmitStandardOp(3); (*{0d3d-0d3f}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ RETURN;
|
|
|
|
|
+ END;
|
|
|
|
|
+ IF Scanner.curSymbol IN BITSET{43..47} THEN (*{0d43-0d49}*)
|
|
|
|
|
+ IF Scanner.AcceptSymbol(43) THEN (* '(' expr ')' *) (*{0d4b-0d4f}*)
|
|
|
|
|
+ BoolCondHelper; (* proc12 *) (*{0d51}*)
|
|
|
|
|
+ Scanner.ExpectSymbol(5); (*{0d52-0d53} ')' *)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ Scanner.GetSym; (*{0d57}*)
|
|
|
|
|
+ CheckRelationTypes(Compiler.BitsetType); (* proc51; FIXME: group wrote word15 *)
|
|
|
|
|
+ END;
|
|
|
|
|
+ RETURN;
|
|
|
|
|
+ END;
|
|
|
|
|
+ Scanner.PushWithScope; (*{0d5f}*)
|
|
|
|
|
+ t := Scanner.literalType; (*{0d61-0d63}*)
|
|
|
|
|
+ curDesc.word0 := t; (*{0d64-0d66}*)
|
|
|
|
|
+ IF ~ Scanner.isLiteral THEN (*{0d67-0d69}*)
|
|
|
|
|
+ curDesc.word1 := 0; (*{0d6b-0d6d}*)
|
|
|
|
|
+ IF t = Compiler.charArrayDesc THEN (* FIXME: group wrote word12=CHAR const? *)
|
|
|
|
|
+ Scanner.CopyStringToHeap(curDesc, Scanner.tokenBuffer); (*{0d74-0d7b} FIXME: arg order *)
|
|
|
|
|
+ curDesc.word3 := 0; (*{0d7e-0d80}*)
|
|
|
|
|
+ ELSIF t^.word4 IN BITSET{384} THEN (*{0d83-0d89} REAL/LONGREAL class *)
|
|
|
|
|
+ IF t^.word3 = 8 THEN (*{0d8b-0d8f} LONGREAL *)
|
|
|
|
|
+ FoldRelation(); (* proc47; FIXME: group passed longrealValue, dropped *)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ curDesc.word2 := Scanner.cardValue; (*{0d99-0d9d}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ curDesc.word2 := Scanner.cardValue; (*{0da1-0da4}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ EmitDescriptor2(curDesc); (* proc2 *) (*{0da5}*)
|
|
|
|
|
+ Scanner.GetSym; (*{0da7}*)
|
|
|
|
|
+ RETURN;
|
|
|
|
|
+ END;
|
|
|
|
|
+ CASE Scanner.identKind OF (*{0dab-0daf} word9 *)
|
|
|
|
|
+ | 1: (* const *) (*{0daf}*)
|
|
|
|
|
+ curDesc.word1 := 0; (*{0db0-0db2}*)
|
|
|
|
|
+ curDesc.word2 := curDesc.word2; (*{0db3-0db7} FIXME: const value copy TBD *)
|
|
|
|
|
+ EmitDescriptor2(curDesc); (* proc2 *) (*{0db9-0dba}*)
|
|
|
|
|
+ Scanner.GetSym; (*{0dbb}*)
|
|
|
|
|
+ | 3: (* parenthesised / builtin *) (*{0dbe}*)
|
|
|
|
|
+ Scanner.GetSym; (*{0dbe}*)
|
|
|
|
|
+ Scanner.TestSymbolRange40(40); (*{0dc0-0dc2}*)
|
|
|
|
|
+ IF Scanner.AcceptSymbol(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}*)
|
|
|
|
|
+ IF (t^.word3 + 1) DIV 2 # (curDesc.word0^.word3 + 1) DIV 2 THEN
|
|
|
|
|
+ Errors.ReportError(66); (*{0de2-0e00}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ curDesc.word0 := t; (*{0df1-0df4}*)
|
|
|
|
|
+ curDesc.word1 := 2; (*{0df5-0df7}*)
|
|
|
|
|
+ Scanner.ExpectSymbol(5); (*{0df8} ')' *)
|
|
|
|
|
+ END;
|
|
|
|
|
+ | 4: (* designator *) (*{0dfb}*)
|
|
|
|
|
+ ParseDesignatorTail; (* proc15 *) (*{0dfb}*)
|
|
|
|
|
+ IF Scanner.curSymbol = 43 THEN (* '(' call *) (*{0dfc-0e01}*)
|
|
|
|
|
+ Scanner.GetSym; (*{0e03}*)
|
|
|
|
|
+ MatchOpClass(512, 43); (* proc9 *) (*{0e05-0e0a}*)
|
|
|
|
|
+ IF t^.word2 # 0 THEN Errors.ReportError(60) END; (*{0e0b-0e10}*)
|
|
|
|
|
+ StoreOperand; (* proc19 *) (*{0e11}*)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ EmitDescriptor2(curDesc); (* proc2 *) (*{0e15-0e16}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ | 5: (* variable load path *) (*{0e18}*)
|
|
|
|
|
+ IF t # 0 THEN Errors.ReportError(60) END; (*{0e18-0e1c}*)
|
|
|
|
|
+ LoadOperand; (* proc18 *) (*{0e1d}*)
|
|
|
|
|
+ | 0: (* illegal *) (*{0e20}*)
|
|
|
|
|
+ Errors.ReportErrorWithText(128, Scanner.tokenBuffer); (*{0e20-0e25}*)
|
|
|
|
|
+ | 2:
|
|
|
|
|
+ Errors.ReportError(22); (*{0e3b-0e3d}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ CheckAndStore(); (* proc22; FIXME: group wrote proc22 CheckFollowSet *)
|
|
|
|
|
+END EmitCompare;
|
|
|
|
|
+
|
|
|
|
|
+(* proc49 @0e45 — ~EmitRangeCheck: AND-chains, mul/div/mod const-fold *)
|
|
|
|
|
+PROCEDURE EmitRangeCheck;
|
|
|
|
|
+VAR buf: Desc;
|
|
|
|
|
+ op: CARDINAL;
|
|
|
|
|
+ rkind: CARDINAL;
|
|
|
|
|
+ savePend: CARDINAL;
|
|
|
|
|
+ saveMode: CARDINAL;
|
|
|
|
|
+ isZero: BOOLEAN;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ EmitCompare; (* nested proc50 *) (*{0e4a}*)
|
|
|
|
|
+ IF ~(Scanner.curSymbol IN BITSET{51..57}) THEN (*{0e4c-0e54}*)
|
|
|
|
|
+ RETURN;
|
|
|
|
|
+ END;
|
|
|
|
|
+ EmitOp(); (* proc6 *) (*{0e57}*)
|
|
|
|
|
+ op := Scanner.curSymbol; (*{0e58-0e5b}*)
|
|
|
|
|
+ IF op = 64 THEN (* AND *) (*{0e5b-0e5f}*)
|
|
|
|
|
+ ConstToCard(Compiler.BooleanType, 64); (* proc7 *) (*{0e61-0e63}*)
|
|
|
|
|
+ Scanner.GetSym; (*{0e65}*)
|
|
|
|
|
+ IF curDesc.word1 = 0 THEN (*{0e67-0e6a}*)
|
|
|
|
|
+ CodeGen.DiscardPending; (*{0e6c}*)
|
|
|
|
|
+ savePend := CodeGen.pendMode; saveMode := curDesc.word2; (*{0e6e-0e84}*)
|
|
|
|
|
+ CodeGen.pendMode := savePend AND saveMode; (*{0e85-0e8c} FIXME: BITSET pun *)
|
|
|
|
|
+ EmitCompare; (*{0e8a}*)
|
|
|
|
|
+ ConstToCard(Compiler.BooleanType, 64); (*{0e8c-0e90}*)
|
|
|
|
|
+ CodeGen.pendMode := savePend; (*{0e92-0e93}*)
|
|
|
|
|
+ IF saveMode = 0 THEN (*{0e94-0e96}*)
|
|
|
|
|
+ curDesc.word1 := 0; curDesc.word2 := 0; (*{0e98-0e9d}*)
|
|
|
|
|
+ EmitDescriptor2(curDesc); (* proc2 *) (*{0e9e-0ea4}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ CodeGen.EmitStandardOp(11); (*{0e92}*)
|
|
|
|
|
+ CodeGen.OpenFixup(saveMode, TRUE); (* proc12 *) (*{0e95-0e99}*)
|
|
|
|
|
+ EmitCompare; (*{0e9a}*)
|
|
|
|
|
+ ConstToCard(Compiler.BooleanType, 64); (*{0e9c-0ea0}*)
|
|
|
|
|
+ CodeGen.InsertFixup(saveMode, TRUE); (* proc14 *) (*{0ea1-0ea3}*)
|
|
|
|
|
+ Errors.ReportError(91); (*{0ea5-0ea7}*)
|
|
|
|
|
+ curDesc.word1 := 2; (*{0ea8-0eaa}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ RETURN;
|
|
|
|
|
+ END;
|
|
|
|
|
+ buf := curDesc; (*{0eae-0eb1}*)
|
|
|
|
|
+ IF op = 60 THEN rkind := 404; (* IN *) (*{0eb2-0eb6}*)
|
|
|
|
|
+ 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); (*FIXME: rkind result TBD*) (* proc35; FIXME: folded kind TBD *)
|
|
|
|
|
+ rkind := TypeKindOf(rkind); (* proc27; FIXME *)
|
|
|
|
|
+ IF op = 63 THEN op := 61 END; (*{0ede-0ee2}*)
|
|
|
|
|
+ IF (curDesc.word1 = 0) AND (buf.mode = 0) THEN (*{0ee7-0eef} both const *)
|
|
|
|
|
+ CodeGen.DiscardPending; (*{0ef2}*)
|
|
|
|
|
+ CodeGen.DiscardPending; (*{0ef4}*)
|
|
|
|
|
+ IF op = 60 THEN (* '*' *) (*{0ef6-0efa}*)
|
|
|
|
|
+ CASE buf.typ^.word4 OF (*{0efc-0efd}*)
|
|
|
|
|
+ 0: curDesc.word2 := buf.value * curDesc.word2; (* umul_checked *) (*{0eff-0f06}*)
|
|
|
|
|
+ | 1: curDesc.word2 := buf.value * curDesc.word2; (* imul *) (*{0f07-0f0e}*)
|
|
|
|
|
+ | 2: curDesc.word2 := buf.value * curDesc.word2; (* dmul *) (*{0f0f-0f19} FIXME: double pun *)
|
|
|
|
|
+ | 3: curDesc.word2 := buf.value * curDesc.word2; (* real_mul *) (*{0f1a-0f23}*)
|
|
|
|
|
+ | 4: curDesc.word2 := buf.value AND curDesc.word2; (* and *) (*{0f25-0f2c} FIXME: CARDINAL AND pun *)
|
|
|
|
|
+ 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.word2 = 0 THEN isZero := curDesc.word2 = 0 END; (*{0f59-0f5d}*)
|
|
|
|
|
+ ELSIF rkind <= 3 THEN
|
|
|
|
|
+ isZero := curDesc.word2 = 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.typ^.word4 OF (*{0f90-0f91}*)
|
|
|
|
|
+ 0: curDesc.word2 := buf.value DIV curDesc.word2; (* udiv *) (*{0f93-0f9a}*)
|
|
|
|
|
+ | 1: curDesc.word2 := buf.value DIV curDesc.word2; (* idiv *) (*{0f9b-0fa2}*)
|
|
|
|
|
+ | 2: curDesc.word2 := buf.value DIV curDesc.word2; (* ddiv *) (*{0fa3-0fad} FIXME *)
|
|
|
|
|
+ | 3: curDesc.word2 := buf.value DIV curDesc.word2; (* real_div *) (*{0fae-0fb8} FIXME *)
|
|
|
|
|
+ | 4: curDesc.word2 := BITSET(buf.value) / curDesc.word2; (* xor *) (*{0fb9-0fc0} FIXME *)
|
|
|
|
|
+ END;
|
|
|
|
|
+ FoldLongDiv(buf); (* FIXME: Doubles.qdiv + proc47 *)
|
|
|
|
|
+ ELSIF rkind = 2 THEN (*{0fe2-0fe5} LONGINT MOD *)
|
|
|
|
|
+ curDesc.word2 := buf.value MOD curDesc.word2; (*{0fe7-0fef} FIXME *)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ curDesc.word2 := buf.value MOD curDesc.word2; (*{0ff3-0ff9} umod *)
|
|
|
|
|
+ END;
|
|
|
|
|
+ EmitDescriptor2(curDesc); (* proc2 *) (*{0ffa-0ffb}*)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ curDesc.word1 := 2; (*{0ffe-1000}*)
|
|
|
|
|
+ IF (3 IN Scanner.scanOptions) 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;
|
|
|
|
|
+
|
|
|
|
|
+(* proc48 @1025 — ~ParseSimpleExpression *)
|
|
|
|
|
+PROCEDURE ParseSimpleExpression;
|
|
|
|
|
+VAR buf: Desc;
|
|
|
|
|
+ op: CARDINAL;
|
|
|
|
|
+ t: ADDRESS;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ IF Scanner.curSymbol IN BITSET{58..60} THEN (* unary +/- *) (*{102a-1030}*)
|
|
|
|
|
+ IF Scanner.AcceptSymbol(59) THEN (* '-' *) (*{1032-1036}*)
|
|
|
|
|
+ EmitRangeCheck; (* nested proc49 *) (*{1038}*)
|
|
|
|
|
+ EmitOp(); (* proc6 *) (*{103a}*)
|
|
|
|
|
+ MatchOpClass(388, 59); (* proc9 *) (*{103b-1040}*)
|
|
|
|
|
+ t := TypeKindOf(t) (*FIXME: type TBD*); (* proc27; FIXME: t uninitialized here, TBD *)
|
|
|
|
|
+ IF t = 0 THEN t := Compiler.CardType; ConstToCard(t, 59); END; (*{1044-104c} FIXME: group wrote word6=INTEGER? CARD fallback per text *)
|
|
|
|
|
+ IF curDesc.word1 = 0 THEN (* const negation *) (*{104d-1050}*)
|
|
|
|
|
+ CodeGen.DiscardPending; (*{1052}*)
|
|
|
|
|
+ CASE t^.word4 OF (*{1054-1076}*)
|
|
|
|
|
+ 2: curDesc.word2 := curDesc.word2; (* long_negate FIXME *)
|
|
|
|
|
+ | 3: curDesc.word2 := curDesc.word2; (* FIXME *)
|
|
|
|
|
+ | 5: curDesc.word2 := curDesc.word2; (* FIXME: Doubles.qneg *)
|
|
|
|
|
+ | 4: curDesc.word2 := curDesc.word2; (* complement+inc FIXME *)
|
|
|
|
|
+ END;
|
|
|
|
|
+ curDesc.word0 := Compiler.CardType; (*{108b-108e} FIXME: group wrote word6 *)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ CodeGen.EmitTypedOp(11, t^.word4); (* unary minus *) (*{1093-1095}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ Scanner.GetSym; (*{1099} '+' skip *)
|
|
|
|
|
+ EmitRangeCheck; (*{109b}*)
|
|
|
|
|
+ EmitOp(); (* proc6 *) (*{109d}*)
|
|
|
|
|
+ MatchOpClass(388, 58); (* proc9 '+' *) (*{109e-10a3}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ EmitRangeCheck; (*{10a6}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ WHILE Scanner.curSymbol IN BITSET{51..57} DO (* +,-,OR *) (*{10a8-10b0}*)
|
|
|
|
|
+ op := Scanner.curSymbol; (*{10b3-10b5}*)
|
|
|
|
|
+ EmitOp(); (* proc6 *) (*{10b6}*)
|
|
|
|
|
+ IF op = 65 THEN (* OR *) (*{10b7-10bb} FIXME: 65 outside 51..57; loop-exit OR? TBD *)
|
|
|
|
|
+ ConstToCard(Compiler.BooleanType, 65); (* proc7 *) (*{10bd-10c1}*)
|
|
|
|
|
+ Scanner.GetSym; (*{10c2}*)
|
|
|
|
|
+ IF curDesc.word1 = 0 THEN (*{10c4-10c7}*)
|
|
|
|
|
+ CodeGen.DiscardPending; (*{10c9}*)
|
|
|
|
|
+ savePend := saveMode; (* FIXME: undeclared in this scope; group24 cross-talk TBD *)
|
|
|
|
|
+ EmitRangeCheck; (*{10d8}*)
|
|
|
|
|
+ ConstToCard(Compiler.BooleanType, 65); (*{10da-10de}*)
|
|
|
|
|
+ IF saveMode # 0 THEN (*{10e2-10e3}*)
|
|
|
|
|
+ curDesc.word1 := 0; curDesc.word2 := 1; (*{10e5-10eb}*)
|
|
|
|
|
+ EmitDescriptor2(curDesc); (* proc2 *) (*{10ec}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ CodeGen.EmitStandardOp(12); (*{10ef-10f0}*)
|
|
|
|
|
+ CodeGen.OpenFixup(saveMode, TRUE); (* proc12 *) (*{10f2-10f5} FIXME: undeclared *)
|
|
|
|
|
+ EmitRangeCheck; (*{10f7}*)
|
|
|
|
|
+ ConstToCard(Compiler.BooleanType, 65); (*{10f9-10fd}*)
|
|
|
|
|
+ CodeGen.InsertFixup(saveMode, TRUE); (* proc14 *) (*{10fe-1100}*)
|
|
|
|
|
+ Errors.ReportError(91); (*{1102-1104}*)
|
|
|
|
|
+ curDesc.word1 := 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); (*FIXME: t result TBD*) (* proc35; FIXME: folded kind TBD *)
|
|
|
|
|
+ t := TypeKindOf(t) (*FIXME: type TBD*); (* proc27; FIXME *)
|
|
|
|
|
+ IF (curDesc.word1 = 0) AND (buf.mode = 0) THEN (*{1124-112c}*)
|
|
|
|
|
+ CodeGen.DiscardPending; (*{112e}*)
|
|
|
|
|
+ CodeGen.DiscardPending; (*{1130}*)
|
|
|
|
|
+ IF op = 58 THEN (* '+' *) (*{1132-1136}*)
|
|
|
|
|
+ CASE t^.word4 OF (*{1138-1139}*)
|
|
|
|
|
+ 0: curDesc.word2 := buf.value + curDesc.word2; (* uadd_checked *) (*{113b-1142}*)
|
|
|
|
|
+ | 1: curDesc.word2 := buf.value + curDesc.word2; (* iadd_checked *) (*{1143-114a}*)
|
|
|
|
|
+ | 2: curDesc.word2 := buf.value + curDesc.word2; (* dadd FIXME *) (*{114b-1155}*)
|
|
|
|
|
+ | 3: curDesc.word2 := buf.value + curDesc.word2; (* real_add FIXME *) (*{1156-1160}*)
|
|
|
|
|
+ | 4: curDesc.word2 := buf.value OR curDesc.word2; (* or; FIXME pun *) (*{1161-1168}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ FoldLongAdd(buf); (* FIXME: Doubles.qadd + proc47 *)
|
|
|
|
|
+ ELSIF t = NIL THEN (* '-' family *) (*{118a-118b}*)
|
|
|
|
|
+ CASE buf.typ^.word4 OF
|
|
|
|
|
+ 2: curDesc.word2 := buf.value - curDesc.word2; (* dsub FIXME *)
|
|
|
|
|
+ | 3: curDesc.word2 := buf.value - curDesc.word2; (* real_sub FIXME *)
|
|
|
|
|
+ | 4: curDesc.word2 := buf.value - curDesc.word2; (* diff FIXME *)
|
|
|
|
|
+ | 5: curDesc.word2 := buf.value - curDesc.word2; (* FIXME: Doubles.qsub *)
|
|
|
|
|
+ END;
|
|
|
|
|
+ ELSIF (t = 0) OR ((buf.value >= 0) AND (curDesc.word2 > buf.value)) THEN
|
|
|
|
|
+ curDesc.word0 := Compiler.CardType; (* CARD result *) (*{11ca-11de}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ IF curDesc.word0 = Compiler.CardType THEN (*{11df-11e4}*)
|
|
|
|
|
+ IF buf.typ = Compiler.CardType THEN
|
|
|
|
|
+ curDesc.word2 := buf.value - curDesc.word2; (* isub_checked *) (*{11e6-11ec}*)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ curDesc.word2 := buf.value - curDesc.word2; (* usub_checked *) (*{11ef-11f5}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ END;
|
|
|
|
|
+ EmitDescriptor2(curDesc); (* proc2 *) (*{11f6}*)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ curDesc.word1 := 2; (*{11fa-11fc}*)
|
|
|
|
|
+ IF (3 IN Scanner.scanOptions) AND (t^.word4 <= 1) THEN
|
|
|
|
|
+ CodeGen.EmitExtendedOp(op - 52, t^.word4); (* checked *) (*{1208-120c}*)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ CodeGen.EmitTypedOp(op - 52, t^.word4); (* plain *) (*{1210-1214}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ END;
|
|
|
|
|
+ END;
|
|
|
|
|
+ END;
|
|
|
|
|
+END ParseSimpleExpression;
|
|
|
|
|
+
|
|
|
|
|
+(* EXPRES @1221 — ~ParseExpression *)
|
|
|
|
|
+PROCEDURE ParseExpression;
|
|
|
|
|
+VAR buf: Desc;
|
|
|
|
|
+ op: CARDINAL;
|
|
|
|
|
+ cls: CARDINAL;
|
|
|
|
|
+ rkind: CARDINAL;
|
|
|
|
|
+ cres: CARDINAL;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ ParseSimpleExpression; (* nested proc48 *) (*{1226}*)
|
|
|
|
|
+ op := Scanner.curSymbol; (*{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.AcceptSymbol(51); (* '=' consume *) (*{123d-1241}*)
|
|
|
|
|
+ IF Scanner.curSymbol = 0 THEN (*{1241} literal rhs fast path? FIXME *)
|
|
|
|
|
+ ParseSimpleExpression; (*{1243}*)
|
|
|
|
|
+ MatchOpClass(16, 51); (* proc9 '=' *) (*{1245-124a}*)
|
|
|
|
|
+ FoldConstOp(buf); (* proc35 both sides *) (*{124c-1257}*)
|
|
|
|
|
+ IF (curDesc.word1 = 0) AND (buf.mode = 0) THEN (*{125a}*)
|
|
|
|
|
+ CodeGen.DiscardPending; (*{125c}*)
|
|
|
|
|
+ CodeGen.DiscardPending; (*{125e}*)
|
|
|
|
|
+ curDesc.word2 := BITSET(buf.value) * curDesc.word2; (* IN-fold FIXME pun *) (*{1260-1266}*)
|
|
|
|
|
+ EmitDescriptor2(curDesc); (* proc2 *) (*{1267-1268}*)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ curDesc.word1 := 2; (*{126b-126d}*)
|
|
|
|
|
+ CodeGen.EmitStandardOp(4); (* '=' compare *) (*{126e-1270}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ ELSIF IsOrdinalType(curDesc.word0) THEN (* proc26; FIXME: NYC *)
|
|
|
|
|
+ ExpectBoolOrSet(); (* proc25; FIXME: NYC, group passed (1) *)
|
|
|
|
|
+ Scanner.GetSym; (*{127d}*)
|
|
|
|
|
+ ParseSimpleExpression; (*{127f}*)
|
|
|
|
|
+ CheckAssignable(buf); (* proc36 *) (*{1281-1283} FIXME: CheckAssignable() takes none *)
|
|
|
|
|
+ IF ~ IsOrdinalType(curDesc.word0) THEN (*{1284-1289}*)
|
|
|
|
|
+ FoldConstOp(buf); (* proc35 *) (*{128a-128c}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ EmitSetMember(buf); (*FIXME: NYC*) (* 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.word1 := 2; (*{1302-1304}*)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ IF op <= 53 THEN cls := 501; (* =,#,IN class *) (*{12a5-12ac}*)
|
|
|
|
|
+ ELSIF op <= 55 THEN cls := 389; (* <,<= class *) (*{12b1-12ba}*)
|
|
|
|
|
+ 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 := BaseTypeOf(buf); (* proc27; FIXME: BaseTypeOf takes 2 *)
|
|
|
|
|
+ IF (curDesc.word1 = 0) AND (buf.mode = 0) THEN (*{12d2-12da}*)
|
|
|
|
|
+ CodeGen.DiscardPending; (*{12dc}*)
|
|
|
|
|
+ CodeGen.DiscardPending; (*{12de}*)
|
|
|
|
|
+ cres := 0; (*{12e0-12e2}*)
|
|
|
|
|
+ CASE buf.typ^.word4 OF (*{12e2-12e3}*)
|
|
|
|
|
+ 0: (* CARDINAL unsigned *) (*{12e5}*)
|
|
|
|
|
+ IF buf.value > curDesc.word2 THEN cres := 2;
|
|
|
|
|
+ ELSIF buf.value < curDesc.word2 THEN cres := 1; END; (*{12e5-12f8}*)
|
|
|
|
|
+ | 1: (* INTEGER signed *) (*{12fa}*)
|
|
|
|
|
+ IF buf.value > curDesc.word2 THEN cres := 2;
|
|
|
|
|
+ ELSIF buf.value < curDesc.word2 THEN cres := 1; END; (*{12fa-130d}*)
|
|
|
|
|
+ | 2: (* LONGINT *) (*{130f}*)
|
|
|
|
|
+ IF buf.value > curDesc.word2 THEN cres := 2;
|
|
|
|
|
+ ELSIF buf.value < curDesc.word2 THEN cres := 1; END; (* FIXME: dcompare *)
|
|
|
|
|
+ | 3: (* REAL *) (*{132a}*)
|
|
|
|
|
+ IF buf.value > curDesc.word2 THEN cres := 2;
|
|
|
|
|
+ ELSIF buf.value < curDesc.word2 THEN cres := 1; END; (* FIXME: real_compare *)
|
|
|
|
|
+ | 4: (* BITSET/WORD set equality limbs *) (*{1345}*)
|
|
|
|
|
+ IF buf.value # curDesc.word2 THEN
|
|
|
|
|
+ IF BITSET(buf.value) * BITSET(NOT curDesc.word2) = {} THEN cres := 2;
|
|
|
|
|
+ ELSIF BITSET(curDesc.word2) * BITSET(NOT buf.value) = {} THEN cres := 1; END;
|
|
|
|
|
+ END; (*{1349-1366} FIXME: CARDINAL BITSET/NOT puns *)
|
|
|
|
|
+ END;
|
|
|
|
|
+ CASE buf.typ^.word0 OF (* LONGREAL tail *) (*{1368} FIXME *)
|
|
|
|
|
+ NIL: ;
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ cres := cres; (* FIXME: Doubles.qcp LONGREAL compare *)
|
|
|
|
|
+ END;
|
|
|
|
|
+ CASE op OF (* map cres -> boolean *) (*{139d-13bc}*)
|
|
|
|
|
+ 51: curDesc.word2 := ORD(cres = 0); (* '=' *) (*{13a0}*)
|
|
|
|
|
+ | 52: curDesc.word2 := ORD(cres # 0); (* '#' *) (*{13a5}*)
|
|
|
|
|
+ | 53: curDesc.word2 := ORD(cres = 1); (* '<' *) (*{13aa}*)
|
|
|
|
|
+ | 54: curDesc.word2 := ORD(cres = 2); (* '<=' *) (*{13b0} FIXME: inverted limbs? *)
|
|
|
|
|
+ | 55: curDesc.word2 := ORD(cres # 2); (* '>' *) (*{13b6}*)
|
|
|
|
|
+ ELSE curDesc.word2 := ORD(cres # 1); (* '>=' / IN *) (*{13cd-13d1}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ EmitDescriptor2(curDesc); (* proc2 *) (*{13d2-13d3}*)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ curDesc.word1 := 2; (*{13d6-13d8}*)
|
|
|
|
|
+ CodeGen.EmitTypedOp(op - 52, rkind); (* general relop; FIXME: rkind pun *) (*{13d9-13dd}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ END;
|
|
|
|
|
+ curDesc.word0 := Compiler.BooleanType; (* BOOLEAN result *) (*{13df-13e2} FIXME: group wrote word14 *)
|
|
|
|
|
+END ParseExpression;
|
|
|
|
|
+
|
|
|
|
|
+(* proc13 @13f3 — ~GetConstVal *)
|
|
|
|
|
+PROCEDURE GetConstVal;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ BoolCondHelper; (* proc12 *) (*{13f5}*)
|
|
|
|
|
+ IF curDesc.word1 # 0 THEN Errors.ReportError(25) END; (*{13f6-13fb}*)
|
|
|
|
|
+ CodeGen.DiscardPending; (*{13fc-13fe}*)
|
|
|
|
|
+END GetConstVal;
|
|
|
|
|
+
|
|
|
|
|
+(* proc14 @1400 — ~GetTypeDesc *)
|
|
|
|
|
+PROCEDURE GetTypeDesc(dest: ADDRESS; mode: CARDINAL; src: ADDRESS);
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ GetConstVal; (* proc13 *) (*{1402}*)
|
|
|
|
|
+ EmitOp(); (* proc6 *) (*{1403}*)
|
|
|
|
|
+ ConstToCard(src, 0); (* proc7 *) (*{1404-1406}*)
|
|
|
|
|
+ PopExprDesc(src); (* proc5 *) (*{1407-1408} FIXME: PopExprDesc takes DescPtr *)
|
|
|
|
|
+ IF (curDesc.word0 # Compiler.CardType) OR (curDesc.word2 < 0) THEN
|
|
|
|
|
+ Errors.ReportError(80); (*{1409-1416} FIXME: group wrote word7=CARDINAL? kept *)
|
|
|
|
|
+ END;
|
|
|
|
|
+ dest^.word0 := curDesc.word2; (*{1417-141e} FIXME: ADDRESS deref TBD *)
|
|
|
|
|
+ IF Scanner.AcceptSymbol(4) THEN (* ',' second bound *) (*{141f-1422}*)
|
|
|
|
|
+ GetConstVal; (*{1424}*)
|
|
|
|
|
+ EmitOp(); (*{1426}*)
|
|
|
|
|
+ ConstToCard(src, 0); (*{1427-0429}*)
|
|
|
|
|
+ PopExprDesc(src); (*{042a}*)
|
|
|
|
|
+ IF (curDesc.word0 # Compiler.CardType) OR (curDesc.word2 < 0) THEN
|
|
|
|
|
+ Errors.ReportError(80); (*{142b-1438}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ IF curDesc.word2 < dest^.word0 THEN Errors.ReportError(46) END; (*{143a-1440} FIXME *)
|
|
|
|
|
+ dest^.word0 := curDesc.word2; (*{1441-1444} upper bound *)
|
|
|
|
|
+ END;
|
|
|
|
|
+END GetTypeDesc;
|
|
|
|
|
+
|
|
|
|
|
+(* ASSIGN check entry @144c *)
|
|
|
|
|
+PROCEDURE CheckAssignmentCompat(dst: ADDRESS);
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ IF ~ BaseTypeOf(dst, curDesc.word0) THEN (* proc34; FIXME: BaseTypeOf takes 2 *)
|
|
|
|
|
+ Errors.ReportIncompatibleTypes(dst, curDesc.word0, " assignment"); (*{1456-1469} FIXME: T1 pun *)
|
|
|
|
|
+ END;
|
|
|
|
|
+END CheckAssignmentCompat;
|
|
|
|
|
+
|
|
|
|
|
+(* ASSIGN main entry @1471 *)
|
|
|
|
|
+PROCEDURE ParseAssignment;
|
|
|
|
|
+VAR saved: Desc;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ assignActive := 1; (*{1473-1474} global8 *)
|
|
|
|
|
+ IF curDesc.word4 > 9 THEN (*{1475-1480} set-ctor rhs? *)
|
|
|
|
|
+ EmitDescriptor2(curDesc); (* FIXME: proc2 via proc10? *)
|
|
|
|
|
+ ELSIF curDesc.word4 = 4 THEN (*{1480-1484} string/const rhs? *)
|
|
|
|
|
+ EmitDescriptor2(curDesc); (* FIXME: proc10 *)
|
|
|
|
|
+ END;
|
|
|
|
|
+ curDesc.word4 := 2; curDesc.word3 := 0; (*{1488-1490}*)
|
|
|
|
|
+ saved := curDesc; (*{148e-1491}*)
|
|
|
|
|
+ IF (Scanner.identKind = 5) AND (curDesc.word0^.word4 = 9) THEN (* func result? *) (*{1492-149d}*)
|
|
|
|
|
+ ParseDesignatorBase(saved.typ, saved.value, saved.low, saved.high); (* proc21; FIXME arity *)
|
|
|
|
|
+ CheckForwardRef(); (* proc29; FIXME: NYC *)
|
|
|
|
|
+ PopExprDesc(saved); (* proc3; FIXME *)
|
|
|
|
|
+ Scanner.GetSym; (*{14b1}*)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ BoolCondHelper; (* proc12 *) (*{14b7}*)
|
|
|
|
|
+ CheckAssignable2(saved.typ); (* proc26; FIXME: NYC *)
|
|
|
|
|
+ IF ~ CheckAssignable2(saved.typ) THEN (*{14bc}*)
|
|
|
|
|
+ CheckAssignable2(saved.typ); (* proc52 nested; FIXME: NYC *)
|
|
|
|
|
+ END;
|
|
|
|
|
+ IF (curDesc.word0 # saved.typ) AND (curDesc.word1 # 0) THEN (*{14cb-14d5}*)
|
|
|
|
|
+ Errors.DerefAliasType(0); (*FIXME: arg*) (* proc25; FIXME: NYC *)
|
|
|
|
|
+ END;
|
|
|
|
|
+ IF (curDesc.word2 # 0) AND (saved.value # 0) THEN (*{14da-14e4}*)
|
|
|
|
|
+ IF saved.value - saved.low = curDesc.word2 - curDesc.word5 THEN (*{14e6-14f8}*)
|
|
|
|
|
+ PopExprDesc(saved); (* proc3; FIXME *)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ EmitSetOrArrayAssign(saved); (* proc11 pair; FIXME: NYC *)
|
|
|
|
|
+ CodeGen.EmitStandardOp(18); (*{1503-1505}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ CheckAssignable2(saved.typ); (*{1509-150b}*)
|
|
|
|
|
+ PopExprDesc(saved); (* proc5 *) (*{150d-150f} FIXME *)
|
|
|
|
|
+ PopExprDesc(saved); (* proc3 *) (*{1510-1511} FIXME *)
|
|
|
|
|
+ END;
|
|
|
|
|
+ END;
|
|
|
|
|
+ assignActive := 0; (*{1512-1513}*)
|
|
|
|
|
+END ParseAssignment;
|
|
|
|
|
+
|
|
|
|
|
+(* proc0 @1516 (module init) *)
|
|
|
|
|
+(* global9 -> global5 copy; global8 := 0 *)
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ exprPool := SymTab.stringPoolPtr; (* FIXME: which string pool? TBD *)
|
|
|
|
|
+ assignActive := 0;
|
|
|
|
|
+END;
|
|
|
|
|
+END Express.
|