|
@@ -50,27 +50,14 @@ IMPLEMENTATION MODULE Express;
|
|
|
IMPORT Compiler, Scanner, Errors, CodeGen, SymTab, Pass1, Doubles;
|
|
IMPORT Compiler, Scanner, Errors, CodeGen, SymTab, Pass1, Doubles;
|
|
|
FROM SYSTEM IMPORT ADR, MOVE; (* ADDRESS/WORD/RecordPtr come via DEF imports (leak rule) *)
|
|
FROM SYSTEM IMPORT ADR, MOVE; (* ADDRESS/WORD/RecordPtr come via DEF imports (leak rule) *)
|
|
|
|
|
|
|
|
-(* Desc/DescPtr come from EXPRESS.DEF; Words is module-local.
|
|
|
|
|
- Head/HeadPtr: the 5-word descriptor head (typ,mode,value,extra,kind).
|
|
|
|
|
- Proven from MCD: global curDesc (word2) is a pointer accessed ONLY at
|
|
|
|
|
- fields 0-4 (149 accesses, never 5+); temp slots reserve 10 bytes = 5
|
|
|
|
|
- words; all copy blocks move 10 bytes. Full descs (low/high) go through
|
|
|
|
|
- full-typed params/locals. curDesc pointer itself is never stored
|
|
|
|
|
- (link-time init). *)
|
|
|
|
|
|
|
+(* Desc/DescPtr/Head/Node come from EXPRESS.DEF; Words is module-local. *)
|
|
|
TYPE Words = POINTER TO ARRAY [0..9] OF WORD;
|
|
TYPE Words = POINTER TO ARRAY [0..9] OF WORD;
|
|
|
- HeadPtr = POINTER TO Head;
|
|
|
|
|
- Head = RECORD
|
|
|
|
|
- typ: ADDRESS;
|
|
|
|
|
- mode: CARDINAL;
|
|
|
|
|
- value: CARDINAL;
|
|
|
|
|
- extra: CARDINAL;
|
|
|
|
|
- kind: CARDINAL;
|
|
|
|
|
- END;
|
|
|
|
|
|
|
|
|
|
VAR
|
|
VAR
|
|
|
curDesc: HeadPtr; (* word2: pointer to current descriptor head *)
|
|
curDesc: HeadPtr; (* word2: pointer to current descriptor head *)
|
|
|
spillTop: CARDINAL; (* word3 *)
|
|
spillTop: CARDINAL; (* word3 *)
|
|
|
spillFlag: CARDINAL; (* word4 *)
|
|
spillFlag: CARDINAL; (* word4 *)
|
|
|
|
|
+ scopeSave: SymTab.T1; (* word5: saves SYMTAB.currentScope across GetSym *)
|
|
|
constMode: CARDINAL; (* word6 *)
|
|
constMode: CARDINAL; (* word6 *)
|
|
|
spare7: CARDINAL; (* word7: use TBD *)
|
|
spare7: CARDINAL; (* word7: use TBD *)
|
|
|
assignActive: CARDINAL; (* word8 *)
|
|
assignActive: CARDINAL; (* word8 *)
|
|
@@ -80,7 +67,7 @@ VAR
|
|
|
(* Forward refs to group-defined procedures used before definition *)
|
|
(* Forward refs to group-defined procedures used before definition *)
|
|
|
PROCEDURE ParseDesignatorTail; FORWARD;
|
|
PROCEDURE ParseDesignatorTail; FORWARD;
|
|
|
PROCEDURE ParseTypeCast(kind: CARDINAL); FORWARD;
|
|
PROCEDURE ParseTypeCast(kind: CARDINAL); FORWARD;
|
|
|
-PROCEDURE ParseFuncCall(idx: CARDINAL): CARDINAL; FORWARD;
|
|
|
|
|
|
|
+PROCEDURE ParseFuncCall(idx: CARDINAL): RecordPtr; FORWARD;
|
|
|
PROCEDURE ExpandStdProc43(code: CARDINAL); FORWARD; (* FIXME: 0-arg call site *)
|
|
PROCEDURE ExpandStdProc43(code: CARDINAL); FORWARD; (* FIXME: 0-arg call site *)
|
|
|
PROCEDURE ExpandStdProc44(first: CARDINAL); FORWARD;
|
|
PROCEDURE ExpandStdProc44(first: CARDINAL); FORWARD;
|
|
|
PROCEDURE ExpandStdProc45(std: CARDINAL); FORWARD; (* FIXME: 0-arg call site *)
|
|
PROCEDURE ExpandStdProc45(std: CARDINAL); FORWARD; (* FIXME: 0-arg call site *)
|
|
@@ -95,7 +82,7 @@ PROCEDURE ParseSetOrCastTail; FORWARD;
|
|
|
PROCEDURE IsSet(t2, t1: Compiler.RecordPtr): BOOLEAN; FORWARD;
|
|
PROCEDURE IsSet(t2, t1: Compiler.RecordPtr): BOOLEAN; FORWARD;
|
|
|
PROCEDURE BaseTypeOf(t2, t1: Compiler.RecordPtr): BOOLEAN; FORWARD;
|
|
PROCEDURE BaseTypeOf(t2, t1: Compiler.RecordPtr): BOOLEAN; FORWARD;
|
|
|
PROCEDURE CheckAssignable; FORWARD;
|
|
PROCEDURE CheckAssignable; FORWARD;
|
|
|
-PROCEDURE ParseSelector(sel: Compiler.RecordPtr; needVal: BOOLEAN; base: Compiler.RecordPtr); FORWARD;
|
|
|
|
|
|
|
+PROCEDURE ParseSelector(sel: NodePtr; needVal: BOOLEAN; base: CARDINAL); FORWARD;
|
|
|
PROCEDURE GetTypeDesc(src: ADDRESS; dest: ADDRESS; mode: CARDINAL); FORWARD;
|
|
PROCEDURE GetTypeDesc(src: ADDRESS; dest: ADDRESS; mode: CARDINAL); FORWARD;
|
|
|
PROCEDURE CheckAssignmentCompat(dst: ADDRESS); FORWARD;
|
|
PROCEDURE CheckAssignmentCompat(dst: ADDRESS); FORWARD;
|
|
|
|
|
|
|
@@ -105,20 +92,47 @@ PROCEDURE CheckAssignmentCompat(dst: ADDRESS); FORWARD;
|
|
|
|
|
|
|
|
(* FIXME-NYC stubs (signatures per call sites; bodies TBD by MCD audit;
|
|
(* FIXME-NYC stubs (signatures per call sites; bodies TBD by MCD audit;
|
|
|
these 6 may merge with PushExprDesc/PopExprDesc/etc. once mapping lands). *)
|
|
these 6 may merge with PushExprDesc/PopExprDesc/etc. once mapping lands). *)
|
|
|
-PROCEDURE PushOperand;
|
|
|
|
|
|
|
+PROCEDURE PushOperand(d: HeadPtr);
|
|
|
BEGIN HALT; END PushOperand;
|
|
BEGIN HALT; END PushOperand;
|
|
|
-PROCEDURE PopOperand;
|
|
|
|
|
|
|
+PROCEDURE PopOperand(d: HeadPtr);
|
|
|
BEGIN HALT; END PopOperand;
|
|
BEGIN HALT; END PopOperand;
|
|
|
-PROCEDURE CheckAndStore;
|
|
|
|
|
-BEGIN HALT; END CheckAndStore;
|
|
|
|
|
-PROCEDURE GetRangeBase;
|
|
|
|
|
|
|
+PROCEDURE GetRangeBase(v: CARDINAL);
|
|
|
BEGIN HALT; END GetRangeBase;
|
|
BEGIN HALT; END GetRangeBase;
|
|
|
-PROCEDURE IsPointer(t: CARDINAL): BOOLEAN;
|
|
|
|
|
|
|
+PROCEDURE IsPointer(t: RecordPtr): BOOLEAN;
|
|
|
BEGIN HALT; END IsPointer;
|
|
BEGIN HALT; END IsPointer;
|
|
|
PROCEDURE TypeKindOf(): CARDINAL;
|
|
PROCEDURE TypeKindOf(): CARDINAL;
|
|
|
BEGIN HALT; END TypeKindOf;
|
|
BEGIN HALT; END TypeKindOf;
|
|
|
|
|
+(* proc23 @002a stub — ~LookupField (tiny predicate; TBD by MCD audit). *)
|
|
|
|
|
+PROCEDURE LookupField(t: RecordPtr): BOOLEAN;
|
|
|
|
|
+BEGIN HALT; END LookupField;
|
|
|
|
|
+(* DEF-export stubs (signatures exact per DEF; bodies TBD by MCD audit). *)
|
|
|
|
|
+PROCEDURE CentralError(ok: BOOLEAN; code: CARDINAL);
|
|
|
|
|
+BEGIN HALT; END CentralError;
|
|
|
|
|
+PROCEDURE EmitOp(subOp, typeKind: CARDINAL);
|
|
|
|
|
+BEGIN HALT; END EmitOp;
|
|
|
|
|
+(* proc6 @0047 stub — 0-arg curDesc helper (name TBD by MCD audit). *)
|
|
|
|
|
+PROCEDURE Proc6;
|
|
|
|
|
+BEGIN HALT; END Proc6;
|
|
|
|
|
+PROCEDURE NormalizeOperand(d: HeadPtr);
|
|
|
|
|
+BEGIN HALT; END NormalizeOperand;
|
|
|
|
|
+PROCEDURE LoadIndirect(d: HeadPtr);
|
|
|
|
|
+BEGIN HALT; END LoadIndirect;
|
|
|
|
|
+PROCEDURE BoolCondHelper;
|
|
|
|
|
+BEGIN HALT; END BoolCondHelper;
|
|
|
|
|
+PROCEDURE OpSetTest(allowed: BITSET; errCode: CARDINAL);
|
|
|
|
|
+BEGIN HALT; END OpSetTest;
|
|
|
|
|
+(* proc29 @01eb stub — ~ParseActualList (0-arg; TBD by MCD audit). *)
|
|
|
|
|
+PROCEDURE ParseActualList;
|
|
|
|
|
+BEGIN HALT; END ParseActualList;
|
|
|
|
|
+(* proc28 @009e — ~EmitAddress (takes head). *)
|
|
|
|
|
+PROCEDURE EmitAddress(d: HeadPtr);
|
|
|
|
|
+BEGIN HALT; END EmitAddress;
|
|
|
|
|
+(* proc22 stub — ~CheckAndStore (VAR ADDRESS takes any pointer var,
|
|
|
|
|
+ probed: HeadPtr + NodePtr vars; TBD by MCD audit). *)
|
|
|
|
|
+PROCEDURE CheckAndStore(VAR a: ADDRESS);
|
|
|
|
|
+BEGIN HALT; END CheckAndStore;
|
|
|
|
|
|
|
|
-PROCEDURE PushExprDesc(dst: DescPtr; src: DescPtr);
|
|
|
|
|
|
|
+PROCEDURE PushExprDesc(dst: HeadPtr; src: DescPtr);
|
|
|
VAR aligned: CARDINAL; (* local word-2 *)
|
|
VAR aligned: CARDINAL; (* local word-2 *)
|
|
|
BEGIN
|
|
BEGIN
|
|
|
(*{004a}*) (* aligned := (src^.extra + 1) DIV 2 * 2 *)
|
|
(*{004a}*) (* aligned := (src^.extra + 1) DIV 2 * 2 *)
|
|
@@ -152,7 +166,7 @@ END PushExprDesc;
|
|
|
(* (body moved inside PopExprDesc below) *)
|
|
(* (body moved inside PopExprDesc below) *)
|
|
|
|
|
|
|
|
(* proc5 @0318 (REV @00c0) — ~PopExprDesc *)
|
|
(* proc5 @0318 (REV @00c0) — ~PopExprDesc *)
|
|
|
-PROCEDURE PopExprDesc(d: DescPtr);
|
|
|
|
|
|
|
+PROCEDURE PopExprDesc(d: RecordPtr);
|
|
|
VAR
|
|
VAR
|
|
|
isOrd: CARDINAL; (* local word-2: ORD(IsOrdinal), used in arithmetic *)
|
|
isOrd: CARDINAL; (* local word-2: ORD(IsOrdinal), used in arithmetic *)
|
|
|
neg: BOOLEAN; (* local word-3 *)
|
|
neg: BOOLEAN; (* local word-3 *)
|
|
@@ -178,27 +192,27 @@ VAR
|
|
|
|
|
|
|
|
BEGIN
|
|
BEGIN
|
|
|
(*{0318}*) (* only descriptors with kind-bit 7 set need pop work *)
|
|
(*{0318}*) (* only descriptors with kind-bit 7 set need pop work *)
|
|
|
- IF NOT (7 IN BITSET(d^.kind)) THEN RETURN END;
|
|
|
|
|
|
|
+ IF NOT (7 IN BITSET(d^.word4)) THEN RETURN END;
|
|
|
(*{0320}*) (* classify *)
|
|
(*{0320}*) (* classify *)
|
|
|
- isOrd := ORD(IsOrdinal(d^.typ));
|
|
|
|
|
|
|
+ isOrd := ORD(IsOrdinal(d^.word0));
|
|
|
neg := INTEGER(isOrd) < 0;
|
|
neg := INTEGER(isOrd) < 0;
|
|
|
- hasRange := 3 IN BITSET(d^.kind);
|
|
|
|
|
- IF hasRange THEN lo := d^.low; hi := d^.high END;
|
|
|
|
|
|
|
+ hasRange := 3 IN BITSET(d^.word4);
|
|
|
|
|
+ IF hasRange THEN lo := CARDINAL(d^.word5); hi := CARDINAL(d^.high) END;
|
|
|
(*{0336}*) (* constant-expression branch *)
|
|
(*{0336}*) (* constant-expression branch *)
|
|
|
IF curDesc^.mode = 0 THEN
|
|
IF curDesc^.mode = 0 THEN
|
|
|
IF neg THEN
|
|
IF neg THEN
|
|
|
- IF (curDesc^.typ = Compiler.IntType) OR (INTEGER(curDesc^.value) >= 0) THEN
|
|
|
|
|
|
|
+ IF (RecordPtr(curDesc^.typ) = Compiler.IntType) OR (INTEGER(curDesc^.value) >= 0) THEN
|
|
|
Errors.ReportError(70);
|
|
Errors.ReportError(70);
|
|
|
END;
|
|
END;
|
|
|
IF hasRange AND (INTEGER(curDesc^.value) >= lo) AND (INTEGER(curDesc^.value) <= hi) THEN
|
|
IF hasRange AND (INTEGER(curDesc^.value) >= lo) AND (INTEGER(curDesc^.value) <= hi) THEN
|
|
|
Errors.ReportError(72);
|
|
Errors.ReportError(72);
|
|
|
END;
|
|
END;
|
|
|
ELSE
|
|
ELSE
|
|
|
- IF curDesc^.typ <> Compiler.IntType THEN
|
|
|
|
|
|
|
+ IF RecordPtr(curDesc^.typ) <> Compiler.IntType THEN
|
|
|
Errors.ReportError(71);
|
|
Errors.ReportError(71);
|
|
|
END;
|
|
END;
|
|
|
- IF hasRange AND (curDesc^.value >= CARDINAL(lo))
|
|
|
|
|
- AND (curDesc^.value <= CARDINAL(hi)) THEN
|
|
|
|
|
|
|
+ IF hasRange AND (CARDINAL(curDesc^.value) >= CARDINAL(lo))
|
|
|
|
|
+ AND (CARDINAL(curDesc^.value) <= CARDINAL(hi)) THEN
|
|
|
Errors.ReportError(72);
|
|
Errors.ReportError(72);
|
|
|
END;
|
|
END;
|
|
|
END;
|
|
END;
|
|
@@ -207,12 +221,12 @@ BEGIN
|
|
|
(*{0378}*) (* codegen branch, range-check flag bit 8 *)
|
|
(*{0378}*) (* codegen branch, range-check flag bit 8 *)
|
|
|
IF 8 IN Scanner.scanOpt THEN
|
|
IF 8 IN Scanner.scanOpt THEN
|
|
|
emitConv := FALSE;
|
|
emitConv := FALSE;
|
|
|
- IF ABS(INTEGER(ORD(IsOrdinal(curDesc^.typ)) - isOrd)) = 2 THEN
|
|
|
|
|
|
|
+ IF ABS(INTEGER(ORD(IsOrdinal(RecordPtr(curDesc^.typ))) - isOrd)) = 2 THEN
|
|
|
CodeGen.EmitStandardOp(2);
|
|
CodeGen.EmitStandardOp(2);
|
|
|
curDesc^.mode := 2; emitConv := TRUE;
|
|
curDesc^.mode := 2; emitConv := TRUE;
|
|
|
END;
|
|
END;
|
|
|
IF hasRange THEN
|
|
IF hasRange THEN
|
|
|
- sub := curDesc^.typ; (* local-8 *)
|
|
|
|
|
|
|
+ sub := RecordPtr(curDesc^.typ); (* local-8 *)
|
|
|
emitConv := emitConv OR (sub^.word4 > 1);
|
|
emitConv := emitConv OR (sub^.word4 > 1);
|
|
|
IF NOT emitConv THEN
|
|
IF NOT emitConv THEN
|
|
|
IF neg THEN
|
|
IF neg THEN
|
|
@@ -249,7 +263,6 @@ BEGIN
|
|
|
OR ((t1 = Compiler.AddressType) AND (t2 = Compiler.CardType))
|
|
OR ((t1 = Compiler.AddressType) AND (t2 = Compiler.CardType))
|
|
|
OR (96 IN BITSET(t2^.word4));
|
|
OR (96 IN BITSET(t2^.word4));
|
|
|
END IsSet;
|
|
END IsSet;
|
|
|
-END IsSet;
|
|
|
|
|
|
|
|
|
|
(* proc34 @041d (REV @01c5) — ~BaseTypeOf: single OR-chain.
|
|
(* proc34 @041d (REV @01c5) — ~BaseTypeOf: single OR-chain.
|
|
|
word18=WordType. Last arm: CARDINAL(word3)<=2 unsigned (a4). *)
|
|
word18=WordType. Last arm: CARDINAL(word3)<=2 unsigned (a4). *)
|
|
@@ -264,55 +277,55 @@ BEGIN
|
|
|
OR ((t2 = Compiler.CardType) AND (t1 = Compiler.IntType))
|
|
OR ((t2 = Compiler.CardType) AND (t1 = Compiler.IntType))
|
|
|
OR ((t2 = Compiler.WordType) AND (CARDINAL(t1^.word3) <= 2));
|
|
OR ((t2 = Compiler.WordType) AND (CARDINAL(t1^.word3) <= 2));
|
|
|
END BaseTypeOf;
|
|
END BaseTypeOf;
|
|
|
-END BaseTypeOf;
|
|
|
|
|
|
|
|
|
|
(* proc35 @0212 — ~FoldConstOp *)
|
|
(* proc35 @0212 — ~FoldConstOp *)
|
|
|
-PROCEDURE FoldConstOp(resTyp: RecordPtr);
|
|
|
|
|
|
|
+PROCEDURE FoldConstOp(resTyp: DescPtr);
|
|
|
BEGIN
|
|
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;
|
|
|
|
|
|
|
+ (*{046a}*) (* resTyp side CARDINAL constant *)
|
|
|
|
|
+ IF (resTyp^.typ = Compiler.CardType)
|
|
|
|
|
+ AND ((RecordPtr(curDesc^.typ) = Compiler.AddressType)
|
|
|
|
|
+ OR ((RecordPtr(curDesc^.typ) = Compiler.IntType) AND (resTyp^.mode = 0))
|
|
|
|
|
+ OR (INTEGER(resTyp^.value) >= 0)) THEN
|
|
|
|
|
+ resTyp^.typ := curDesc^.typ;
|
|
|
RETURN;
|
|
RETURN;
|
|
|
END;
|
|
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 *)
|
|
|
|
|
|
|
+ (*{0492}*) (* mirrored: curDesc side CARDINAL constant *)
|
|
|
|
|
+ IF (RecordPtr(curDesc^.typ) = Compiler.CardType)
|
|
|
|
|
+ AND ((resTyp^.typ = Compiler.AddressType)
|
|
|
|
|
+ OR ((resTyp^.typ = Compiler.IntType) AND (curDesc^.mode = 0))
|
|
|
|
|
+ OR (INTEGER(curDesc^.value) >= 0)) THEN
|
|
|
|
|
+ curDesc^.typ := NodePtr(resTyp^.typ);
|
|
|
RETURN;
|
|
RETURN;
|
|
|
END;
|
|
END;
|
|
|
- (*{0260}*) (* incompatible operand types *)
|
|
|
|
|
- IF NOT IsSet(resTyp^.typ, curDesc^.typ) THEN
|
|
|
|
|
- Errors.ReportIncompatibleTypes(resTyp^.typ, curDesc^.typ, 0);
|
|
|
|
|
|
|
+ (*{04b8}*) (* incompatible operand types *)
|
|
|
|
|
+ IF NOT IsSet(resTyp^.typ, RecordPtr(curDesc^.typ)) THEN
|
|
|
|
|
+ Errors.ReportIncompatibleTypes(SymTab.T1(resTyp^.typ), SymTab.T1(curDesc^.typ), "");
|
|
|
END;
|
|
END;
|
|
|
END FoldConstOp;
|
|
END FoldConstOp;
|
|
|
|
|
|
|
|
-(* proc7 @0275 — ~ConstToCard *)
|
|
|
|
|
-PROCEDURE ConstToCard(c: DescPtr; errPos: CARDINAL);
|
|
|
|
|
|
|
+(* proc7 @04cd (REV @0275) — ~ConstToCard: big-OR IF-THEN. c is a TYPE
|
|
|
|
|
+ node (callers pass CardType/buf.typ: RecordPtr); word0/word4/word2. *)
|
|
|
|
|
+PROCEDURE ConstToCard(c: RecordPtr; errPos: CARDINAL);
|
|
|
BEGIN
|
|
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);
|
|
|
|
|
|
|
+ (*{04cd}*)
|
|
|
|
|
+ IF ((c^.word0 <> Compiler.IntType) AND (c^.word4 <> 1))
|
|
|
|
|
+ OR (c^.word2 <> Compiler.IntType)
|
|
|
|
|
+ OR (curDesc^.mode <> 0)
|
|
|
|
|
+ OR (RecordPtr(curDesc^.typ) <> Compiler.CardType)
|
|
|
|
|
+ OR (INTEGER(curDesc^.value) < 0) THEN
|
|
|
|
|
+ IF NOT IsSet(c^.word0, RecordPtr(curDesc^.typ)) THEN
|
|
|
|
|
+ Errors.ReportAssignMismatch(SymTab.T1(c^.word0), SymTab.T1(curDesc^.typ), errPos);
|
|
|
|
|
+ END;
|
|
|
END;
|
|
END;
|
|
|
END ConstToCard;
|
|
END ConstToCard;
|
|
|
|
|
|
|
|
-(* proc8 @02ac — ~ConstToInt *)
|
|
|
|
|
-PROCEDURE ConstToInt(c: DescPtr; errPos: CARDINAL);
|
|
|
|
|
|
|
+(* proc8 @0504 (REV @02ac) — ~ConstToInt: opaque type-value check.
|
|
|
|
|
+ c/ctx: ADDRESS (callers pass CardType/sel/value/44/base — all fit). *)
|
|
|
|
|
+PROCEDURE ConstToInt(c: ADDRESS; ctx: ADDRESS);
|
|
|
BEGIN
|
|
BEGIN
|
|
|
- (*{02ac}*) (* INTEGER context: base-type check only *)
|
|
|
|
|
- IF NOT BaseTypeOf(c^.typ, curDesc^.typ) THEN
|
|
|
|
|
- Errors.ReportAssignMismatch(c^.typ, curDesc^.typ, errPos);
|
|
|
|
|
|
|
+ (*{0504}*)
|
|
|
|
|
+ IF NOT BaseTypeOf(c, RecordPtr(curDesc^.typ)) THEN
|
|
|
|
|
+ Errors.ReportAssignMismatch(SymTab.T1(c), SymTab.T1(curDesc^.typ), ctx);
|
|
|
END;
|
|
END;
|
|
|
END ConstToInt;
|
|
END ConstToInt;
|
|
|
|
|
|
|
@@ -320,122 +333,125 @@ END ConstToInt;
|
|
|
PROCEDURE MatchOpClass(allowed: BITSET; errCode: CARDINAL);
|
|
PROCEDURE MatchOpClass(allowed: BITSET; errCode: CARDINAL);
|
|
|
BEGIN
|
|
BEGIN
|
|
|
(*{02be}*) (* operator class check on current expression type *)
|
|
(*{02be}*) (* operator class check on current expression type *)
|
|
|
- IF NOT (curDesc^.typ^.word4 IN allowed) THEN
|
|
|
|
|
- Errors.ReportTypeMismatch(errCode, curDesc^.typ, allowed);
|
|
|
|
|
|
|
+ IF NOT (curDesc^.typ^.w4 IN allowed) THEN
|
|
|
|
|
+ Errors.ReportTypeMismatch(allowed, curDesc^.typ, errCode);
|
|
|
END;
|
|
END;
|
|
|
END MatchOpClass;
|
|
END MatchOpClass;
|
|
|
|
|
|
|
|
-(* proc21 @02d0 — ~ParseDesignatorBase *)
|
|
|
|
|
-PROCEDURE ParseDesignatorBase(finA, finB, probeA, probeB: CARDINAL): BOOLEAN;
|
|
|
|
|
|
|
+(* proc21 @0528 (REV @02d0) — ~ParseDesignatorBase. Params reordered: MCD
|
|
|
|
|
+ first CondInsert uses param2, second param1 (last two formals probeB,
|
|
|
|
|
+ probeA). Results assigned (MCD stores call results). f1/f2 are node
|
|
|
|
|
+ pointers advanced via ^.word5. LookupField=proc23 (stubbed, TBD). *)
|
|
|
|
|
+PROCEDURE ParseDesignatorBase(finA, finB, probeB, probeA: CARDINAL): BOOLEAN;
|
|
|
VAR
|
|
VAR
|
|
|
|
|
+ f1, f2: RecordPtr; (* local-2, local-3 *)
|
|
|
|
|
+ slotA, slotB: ADDRESS; (* local-4, local-5: TBD role, ADR-passed *)
|
|
|
found1, found2: BOOLEAN; (* local-6, local-7 *)
|
|
found1, found2: BOOLEAN; (* local-6, local-7 *)
|
|
|
- w8, w9: CARDINAL; (* local-8, local-9 *)
|
|
|
|
|
- f1, f2: CARDINAL; (* local-2, local-3 *)
|
|
|
|
|
|
|
+ w8, w9: BOOLEAN; (* local-8, local-9 *)
|
|
|
BEGIN
|
|
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));
|
|
|
|
|
|
|
+ (*{0528}*) (* double PASS1.CondInsert probe for qualified pair *)
|
|
|
|
|
+ found1 := Pass1.CondInsert(probeB, slotA, f1, w8);
|
|
|
|
|
+ found2 := Pass1.CondInsert(probeA, slotB, f2, w9);
|
|
|
(*{02e6}*) (* walk while both found *)
|
|
(*{02e6}*) (* walk while both found *)
|
|
|
WHILE found1 AND found2 DO
|
|
WHILE found1 AND found2 DO
|
|
|
IF w8 <> w9 THEN RETURN FALSE END;
|
|
IF w8 <> w9 THEN RETURN FALSE END;
|
|
|
(* FIXME: LookupField internal helper — decompile from @02f4 *)
|
|
(* FIXME: LookupField internal helper — decompile from @02f4 *)
|
|
|
WHILE LookupField(f1) AND LookupField(f2) DO
|
|
WHILE LookupField(f1) AND LookupField(f2) DO
|
|
|
- f1 := f1^.word5; f2 := f2^.word5;
|
|
|
|
|
|
|
+ f1 := RecordPtr(f1^.word5); f2 := RecordPtr(f2^.word5);
|
|
|
END;
|
|
END;
|
|
|
IF f1 <> f2 THEN RETURN FALSE 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));
|
|
|
|
|
|
|
+ found1 := Pass1.InsertEntry(probeB, slotA, f1, w8);
|
|
|
|
|
+ found2 := Pass1.InsertEntry(probeA, slotB, f2, w9);
|
|
|
END;
|
|
END;
|
|
|
(*{0324}*) (* match iff same head and same tail selector *)
|
|
(*{0324}*) (* match iff same head and same tail selector *)
|
|
|
RETURN (found1 = found2) AND (finA = finB);
|
|
RETURN (found1 = found2) AND (finA = finB);
|
|
|
END ParseDesignatorBase;
|
|
END ParseDesignatorBase;
|
|
|
|
|
|
|
|
-(* proc36 @032f — ~CheckAssignable *)
|
|
|
|
|
|
|
+(* proc36 @0587 (REV @032f) — ~CheckAssignable: empty-string forcing. *)
|
|
|
PROCEDURE CheckAssignable();
|
|
PROCEDURE CheckAssignable();
|
|
|
VAR save: CARDINAL; (* local-2 *)
|
|
VAR save: CARDINAL; (* local-2 *)
|
|
|
BEGIN
|
|
BEGIN
|
|
|
- (*{032f}*) (* void context: discard pending load, force ADDRESS-typed empty desc *)
|
|
|
|
|
- IF (curDesc^.mode = 0) AND (curDesc^.typ = Compiler.AddressType) THEN
|
|
|
|
|
|
|
+ (*{0587}*)
|
|
|
|
|
+ IF (curDesc^.mode = 0) AND (RecordPtr(curDesc^.typ) = Compiler.CharType) THEN
|
|
|
CodeGen.DiscardPending();
|
|
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();
|
|
|
|
|
|
|
+ curDesc^.typ := NodePtr(Compiler.charArrayDesc);
|
|
|
|
|
+ save := CARDINAL(curDesc^.value);
|
|
|
|
|
+ Scanner.Allocate(curDesc^.value, 2);
|
|
|
|
|
+ curDesc^.value^[0] := CHR(save);
|
|
|
|
|
+ curDesc^.extra := 0;
|
|
|
|
|
+ PushOperand(curDesc);
|
|
|
END;
|
|
END;
|
|
|
END CheckAssignable;
|
|
END CheckAssignable;
|
|
|
|
|
|
|
|
-(* proc20 @0358 — ~ParseSelector *)
|
|
|
|
|
-PROCEDURE ParseSelector(sel: RecordPtr; needVal: BOOLEAN; base: RecordPtr);
|
|
|
|
|
|
|
+(* proc20 @05b0 (REV @0358) — ~ParseSelector(sel, needVal, base).
|
|
|
|
|
+ base: CARDINAL (error-code/follow ctx). t: NodePtr view (w5: RecordPtr
|
|
|
|
|
+ for ^.word3 chains, w2: DescPtr for ^.high/low). Full MCD decode. *)
|
|
|
|
|
+PROCEDURE ParseSelector(sel: NodePtr; needVal: BOOLEAN; base: CARDINAL);
|
|
|
VAR
|
|
VAR
|
|
|
- t: RecordPtr; (* local-2 *)
|
|
|
|
|
|
|
+ t: NodePtr; (* local-2 *)
|
|
|
flags: CARDINAL; (* local-3 *)
|
|
flags: CARDINAL; (* local-3 *)
|
|
|
BEGIN
|
|
BEGIN
|
|
|
- (*{0358}*) (* selector only if previous type is structured *)
|
|
|
|
|
- IF sel^.kind = 11 THEN CheckAssignable() END;
|
|
|
|
|
|
|
+ (*{05b0}*)
|
|
|
|
|
+ IF sel^.w4 = 11 THEN CheckAssignable() END;
|
|
|
t := curDesc^.typ;
|
|
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
|
|
|
|
|
|
|
+ IF LookupField(RecordPtr(sel)) THEN
|
|
|
|
|
+ (*{05c2}*) (* address/word indirection *)
|
|
|
|
|
+ IF CARDINAL(sel^.w5) = CARDINAL(Compiler.WordType) THEN
|
|
|
|
|
+ IF LookupField(RecordPtr(t)) THEN
|
|
|
|
|
+ flags := CARDINAL(t^.w5^.word3);
|
|
|
|
|
+ IF LookupField(t^.w5) AND ODD(flags) THEN
|
|
|
|
|
+ LoadIndirect(curDesc);
|
|
|
CodeGen.QueueConst(1);
|
|
CodeGen.QueueConst(1);
|
|
|
CodeGen.EmitTypedOp(7, 0);
|
|
CodeGen.EmitTypedOp(7, 0);
|
|
|
CodeGen.QueueConst(2);
|
|
CodeGen.QueueConst(2);
|
|
|
CodeGen.EmitTypedOp(9, 0);
|
|
CodeGen.EmitTypedOp(9, 0);
|
|
|
ELSE
|
|
ELSE
|
|
|
- EmitAddress() (*FIXME: dropped sel*);
|
|
|
|
|
|
|
+ EmitAddress(curDesc);
|
|
|
CodeGen.QueueConst(flags DIV 2);
|
|
CodeGen.QueueConst(flags DIV 2);
|
|
|
CodeGen.EmitTypedOp(8, 0);
|
|
CodeGen.EmitTypedOp(8, 0);
|
|
|
CodeGen.QueueConst((flags - 1) DIV 2);
|
|
CodeGen.QueueConst((flags - 1) DIV 2);
|
|
|
CodeGen.EmitTypedOp(6, 0);
|
|
CodeGen.EmitTypedOp(6, 0);
|
|
|
END;
|
|
END;
|
|
|
- ELSIF (t^.kind <= 9) THEN
|
|
|
|
|
|
|
+ RETURN;
|
|
|
|
|
+ ELSIF (t^.w4 <= 9) THEN
|
|
|
IF needVal THEN
|
|
IF needVal THEN
|
|
|
- IF (t^.word3 <> 1) OR (curDesc^.kind <> 5) THEN
|
|
|
|
|
- Errors.ReportError(95);
|
|
|
|
|
- END;
|
|
|
|
|
|
|
+ CentralError((CARDINAL(t^.w3) <> 1) OR (curDesc^.kind <> 5), 95);
|
|
|
ELSE
|
|
ELSE
|
|
|
- IF (curDesc^.mode = 1) THEN Errors.ReportError(35) END;
|
|
|
|
|
|
|
+ CentralError(curDesc^.mode = 1, 35);
|
|
|
|
|
+ CodeGen.DiscardPending();
|
|
|
|
|
+ NormalizeOperand(curDesc);
|
|
|
END;
|
|
END;
|
|
|
- CodeGen.DiscardPending();
|
|
|
|
|
- EmitAddress();
|
|
|
|
|
- CodeGen.QueueConst((t^.word3 - 1) DIV 2);
|
|
|
|
|
END;
|
|
END;
|
|
|
|
|
+ CodeGen.QueueConst((CARDINAL(t^.w3) - 1) DIV 2);
|
|
|
RETURN;
|
|
RETURN;
|
|
|
END;
|
|
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;
|
|
|
|
|
|
|
+ (*{0634}*) (* REPEAT match-loop *)
|
|
|
|
|
+ REPEAT
|
|
|
|
|
+ MatchOpClass(BITSET{11}, base);
|
|
|
|
|
+ EmitAddress(curDesc);
|
|
|
|
|
+ sel := NodePtr(sel^.w5);
|
|
|
|
|
+ curDesc^.typ := NodePtr(curDesc^.typ^.w5);
|
|
|
|
|
+ UNTIL NOT LookupField(RecordPtr(sel));
|
|
|
|
|
+ CentralError(sel = curDesc^.typ, 64);
|
|
|
|
|
+ RETURN;
|
|
|
|
|
+ ELSE (*{0659}*) (* not-found path *)
|
|
|
|
|
+ CheckAndStore(sel);
|
|
|
|
|
+ IF needVal THEN
|
|
|
|
|
+ CentralError((sel = t)
|
|
|
|
|
+ OR ((RecordPtr(sel) = Compiler.AddressType) AND (t^.w4 = 5))
|
|
|
|
|
+ OR ((sel^.w4 = 5) AND (RecordPtr(t) = Compiler.AddressType))
|
|
|
|
|
+ OR (((RecordPtr(sel) = Compiler.WordType) OR (RecordPtr(sel) = Compiler.ByteType))
|
|
|
|
|
+ AND (CARDINAL(t^.w3) <= 2)), 65);
|
|
|
|
|
+ CentralError((CARDINAL(t^.w3) <> 1) OR (curDesc^.kind <> 5), 95);
|
|
|
|
|
+ RETURN;
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ IF (RecordPtr(t) = Compiler.charArrayDesc) AND IsPointer(RecordPtr(sel)) THEN
|
|
|
|
|
+ CentralError((Scanner.StrLen(curDesc^.value, 128) - 1)
|
|
|
|
|
+ = (sel^.w2^.high - sel^.w2^.low), 45);
|
|
|
END;
|
|
END;
|
|
|
|
|
+ ConstToInt(sel, base);
|
|
|
|
|
+ PopExprDesc(RecordPtr(sel));
|
|
|
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;
|
|
|
END ParseSelector;
|
|
END ParseSelector;
|
|
|
(* EXPRESS group 2 — @0358..0c0c: designator tail, const eval, term/factor,
|
|
(* EXPRESS group 2 — @0358..0c0c: designator tail, const eval, term/factor,
|
|
@@ -443,73 +459,75 @@ END ParseSelector;
|
|
|
|
|
|
|
|
(*{0510} PROCEDURE ParseDesignatorTail *)
|
|
(*{0510} PROCEDURE ParseDesignatorTail *)
|
|
|
PROCEDURE ParseDesignatorTail;
|
|
PROCEDURE ParseDesignatorTail;
|
|
|
-VAR buf: Desc; more: BOOLEAN;
|
|
|
|
|
|
|
+VAR buf: Head; more: BOOLEAN; savedTyp: RecordPtr;
|
|
|
BEGIN
|
|
BEGIN
|
|
|
- buf := curDesc; constMode := 0; EvalConstExpr; (*{0512-0517}*)
|
|
|
|
|
|
|
+ buf := curDesc^; constMode := 0; EvalConstExpr; (*{0512-0517}*)
|
|
|
LOOP
|
|
LOOP
|
|
|
IF (Scanner.curSym # 3) & ((Scanner.curSym-44) > 5) THEN EXIT END; (*{0519-0525}*)
|
|
IF (Scanner.curSym # 3) & ((Scanner.curSym-44) > 5) THEN EXIT END; (*{0519-0525}*)
|
|
|
IF Scanner.AcceptSy(44) THEN (*{0528-052b} '(' actuals/indexqual *)
|
|
IF Scanner.AcceptSy(44) THEN (*{0528-052b} '(' actuals/indexqual *)
|
|
|
- NormalizeOperand; more := FALSE; (*{052e-0530}*)
|
|
|
|
|
|
|
+ NormalizeOperand(curDesc); (*FIXME-ARG*) more := FALSE; (*{052e-0530}*)
|
|
|
LOOP
|
|
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;
|
|
|
|
|
|
|
+ MatchOpClass(BITSET{11}, 44); (*{0538}*)
|
|
|
|
|
+ IF more THEN (*{053b}*)
|
|
|
|
|
+ EmitAddress(curDesc); CodeGen.QueueConst(1);
|
|
|
|
|
+ CodeGen.EmitTypedOp(6, 0); CodeGen.EmitTypedOp(8, 0); (*{053e-054a}*)
|
|
|
END;
|
|
END;
|
|
|
- buf := curDesc; ParseExpression; (*{054c-0550}*)
|
|
|
|
|
- IF curDesc^.value = 0 THEN (*{0554-0556} typeless actual *)
|
|
|
|
|
- ConstToInt(Compiler.CardType, 44); PopExprDesc; (*{0559-055e}*)
|
|
|
|
|
|
|
+ buf := curDesc^; BoolCondHelper; savedTyp := RecordPtr(buf.typ); (*{054c-0550}*)
|
|
|
|
|
+ IF CARDINAL(buf.typ^.w2) = 0 THEN (*{0554-0556} typeless actual *)
|
|
|
|
|
+ ConstToInt(Compiler.CardType, 44); PopExprDesc(Compiler.CardType); (*{0559-055e}*)
|
|
|
IF 8 IN Scanner.scanOpt THEN (*{0561}*)
|
|
IF 8 IN Scanner.scanOpt THEN (*{0561}*)
|
|
|
- EmitAddress; CodeGen.QueueConst(0); CodeGen.EmitStandardOp(0); (*{0567-056d}*)
|
|
|
|
|
|
|
+ EmitAddress(curDesc); CodeGen.QueueConst(0); CodeGen.EmitStandardOp(0); (*{0567-056d}*)
|
|
|
END;
|
|
END;
|
|
|
- curDesc^.extra := curDesc^.extra-2; (*{0570-0575}*)
|
|
|
|
|
|
|
+ buf.extra := buf.extra-2; (*{0570-0575}*)
|
|
|
ELSE (*{0578} typed actual *)
|
|
ELSE (*{0578} typed actual *)
|
|
|
- ConstToInt(curDesc^.value, 44); ConstToCard(curDesc^.value, curDesc^.value); (*{0579-057f}*)
|
|
|
|
|
- CodeGen.QueueConst(curDesc^.raw[5]); CodeGen.EmitTypedOp(7, 0); (*{0580-0587}*)
|
|
|
|
|
|
|
+ ConstToInt(savedTyp^.word2, 44); PopExprDesc(savedTyp^.word2); (*{0579-057f}*)
|
|
|
|
|
+ CodeGen.QueueConst(CARDINAL(savedTyp^.word2^.word5)); CodeGen.EmitTypedOp(7, 0); (*{0580-0587}*)
|
|
|
END;
|
|
END;
|
|
|
IF more THEN CodeGen.EmitTypedOp(6, 0) END; (*{0589-058e}*)
|
|
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}*)
|
|
|
|
|
|
|
+ curDesc^ := buf; (*{0590-0592}*)
|
|
|
|
|
+ curDesc^.typ := NodePtr(savedTyp^.word5); (*{07ec}*)
|
|
|
|
|
+ Scanner.TestSet(BITSET{1,6}); (*{07f0} statement, no result *)
|
|
|
|
|
+ IF Scanner.AcceptSy(6) THEN (*{07f4}*)
|
|
|
|
|
+ IF NOT Scanner.AcceptSy(44) THEN EXIT END; (*{07f9} exit via jump_stack *)
|
|
|
|
|
+ ELSE Scanner.GetSym; (*{0803}*)
|
|
|
END;
|
|
END;
|
|
|
- more := TRUE; (*{05ad-05ae}*)
|
|
|
|
|
|
|
+ more := TRUE; (*{0805}*)
|
|
|
END;
|
|
END;
|
|
|
curDesc^.kind := 5; constMode := 1; (*{05b1-055b} handler exit *)
|
|
curDesc^.kind := 5; constMode := 1; (*{05b1-055b} handler exit *)
|
|
|
ELSIF Scanner.AcceptSy(46) THEN (*{05b8-05bb} '[' subscript *)
|
|
ELSIF Scanner.AcceptSy(46) THEN (*{05b8-05bb} '[' subscript *)
|
|
|
- PushOperand; (*{05be}*)
|
|
|
|
|
- IF (Compiler.rangeCheckEnabled # 0) & (8 IN Scanner.scanOpt) THEN (*{05c0-05c8}*)
|
|
|
|
|
|
|
+ PushOperand(curDesc); (*FIXME-ARG*) (*{05be}*)
|
|
|
|
|
+ IF Compiler.rangeCheckEnabled & (8 IN Scanner.scanOpt) THEN (*{05c0-05c8}*)
|
|
|
CodeGen.EmitStandardOp(6); (*{05ca-05c4}*)
|
|
CodeGen.EmitStandardOp(6); (*{05ca-05c4}*)
|
|
|
END;
|
|
END;
|
|
|
- IF curDesc^.typ = Compiler.AddressType THEN curDesc^.typ := Compiler.WordType ELSE (*{05cd-05d9}*)
|
|
|
|
|
- IF ~ MatchOpClass(32, 46) THEN (*{05db-05df}*) END;
|
|
|
|
|
- curDesc^.typ := curDesc^.value; (*{05e1-05e4}*)
|
|
|
|
|
|
|
+ IF RecordPtr(curDesc^.typ) = Compiler.AddressType THEN curDesc^.typ := NodePtr(Compiler.WordType) ELSE (*{05cd-05d9}*)
|
|
|
|
|
+ MatchOpClass(BITSET{5}, 46); (*{05db-05df}*)
|
|
|
|
|
+ curDesc^.typ := NodePtr(curDesc^.value); (*{05e1-05e4}*)
|
|
|
END;
|
|
END;
|
|
|
curDesc^.kind := 2; curDesc^.extra := 0; constMode := 1; (*{05e5-05ec}*)
|
|
curDesc^.kind := 2; curDesc^.extra := 0; constMode := 1; (*{05e5-05ec}*)
|
|
|
ELSE (*{05ef} '.'-field / deref tail *)
|
|
ELSE (*{05ef} '.'-field / deref tail *)
|
|
|
- IF curDesc^.kind # 2 THEN (*{05f1-05f3}*)
|
|
|
|
|
- NormalizeOperand; curDesc^.kind := 2; curDesc^.extra := 0; (*{05f5-05fc}*)
|
|
|
|
|
|
|
+ IF curDesc^.kind <> 2 THEN (*{05f1-05f3}*)
|
|
|
|
|
+ NormalizeOperand(curDesc); curDesc^.kind := 2; curDesc^.extra := 0; (*{05f5-05fc}*)
|
|
|
END;
|
|
END;
|
|
|
- SymTabSave := SymTab.identClass; (*{05fd-0602} FIXME: no such SymTab export *)
|
|
|
|
|
- IF ~ MatchOpClass(1024, 3) THEN (*{0604-0608}*) END;
|
|
|
|
|
- curDesc^.typ := 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}*)
|
|
|
|
|
|
|
+ scopeSave^.link0 := ADDRESS(SymTab.currentScope); (*{0855-0858} stash *)
|
|
|
|
|
+ scopeSave := SymTab.T1(SymTab.currentScope); (*{0859-085a} redirect to slot *)
|
|
|
|
|
+ MatchOpClass(BITSET{10}, 3); (*{085c-0860}*)
|
|
|
|
|
+ scopeSave^.link1 := ADDRESS(curDesc^.typ^.w5); (*{0861-0865} *)
|
|
|
|
|
+ Scanner.GetSym; Scanner.NeedID; (*{0866-0868}*)
|
|
|
|
|
+ IF Scanner.scopeCur <> scopeSave THEN (*{086a-086e}*)
|
|
|
|
|
+ Errors.ReportErrorWithText(2, Scanner.tokBuf); (*{0870-0875}*)
|
|
|
END;
|
|
END;
|
|
|
- curDesc^.extra := Scanner.curNode+curDesc^.raw[5]; (*{061f-0626} FIXME: word8=curNode pun *)
|
|
|
|
|
- curDesc^.typ := Scanner.litType; SymTab.identClass := SymTabSave; (*{0627-062d}*)
|
|
|
|
|
- Scanner.GetSym; (*{062f}*)
|
|
|
|
|
- WHILE Scanner.curSym = 3 DO (*{0631-0635}*)
|
|
|
|
|
- IF curDesc^.extra > 510 THEN (*{063b-063d}*)
|
|
|
|
|
- CodeGen.QueueConst(curDesc^.extra); CodeGen.EmitTypedOp(6, 0); (*{063f-0645}*)
|
|
|
|
|
- END;
|
|
|
|
|
- curDesc^.extra := 0; (*{0647-0649}*)
|
|
|
|
|
|
|
+ curDesc^.extra := curDesc^.extra + CARDINAL(Scanner.curNode^.word5); (*{0877-087e}*)
|
|
|
|
|
+ curDesc^.typ := NodePtr(Scanner.litType); (*{087f-0882}*)
|
|
|
|
|
+ SymTab.currentScope := ADDRESS(scopeSave^.link0); (*{0883-0885} restore *)
|
|
|
|
|
+ Scanner.GetSym; (*{0887}*)
|
|
|
|
|
+ (*{0889} loop-back on curSym=3 to scopeSave block: outer LOOP (audit) *)
|
|
|
|
|
+ IF curDesc^.extra > 510 THEN (*{088f-0895}*)
|
|
|
|
|
+ CodeGen.QueueConst(curDesc^.extra); CodeGen.EmitTypedOp(6, 0);
|
|
|
END;
|
|
END;
|
|
|
- constMode := 1; (*{064a-064b}*)
|
|
|
|
|
|
|
+ curDesc^.extra := 0; (*{08a0-08a1}*)
|
|
|
|
|
+ constMode := 1; (*{08a2-08a3}*)
|
|
|
END;
|
|
END;
|
|
|
- CheckAndStore; (*{064c} local proc22 *)
|
|
|
|
|
|
|
+ CheckAndStore(curDesc); (*{08a4} *)
|
|
|
END; (*{064f} back to {0519}*)
|
|
END; (*{064f} back to {0519}*)
|
|
|
curDesc^.mode := 1; (*{0652-0654} result flag *)
|
|
curDesc^.mode := 1; (*{0652-0654} result flag *)
|
|
|
END ParseDesignatorTail;
|
|
END ParseDesignatorTail;
|
|
@@ -519,126 +537,134 @@ PROCEDURE EvalConstExpr;
|
|
|
VAR lit: CARDINAL;
|
|
VAR lit: CARDINAL;
|
|
|
BEGIN
|
|
BEGIN
|
|
|
Scanner.PushWith; Scanner.ExpectKd(4); (*{0472-0475}*)
|
|
Scanner.PushWith; Scanner.ExpectKd(4); (*{0472-0475}*)
|
|
|
- curDesc^.extra := Scanner.curNode; lit := Scanner.curNode; (*{0477-047f} FIXME: word8 pun *)
|
|
|
|
|
- IF (Scanner.follSet & 262) = 0 THEN (*{0480-0488} ident/number path *)
|
|
|
|
|
|
|
+ curDesc^.extra := CARDINAL(Scanner.curNode^.word5); lit := CARDINAL(Scanner.curNode^.high); (*{06cf-06d7}*)
|
|
|
|
|
+ IF (Scanner.follSet * BITSET{1,2,8} = BITSET{}) THEN (*{06d8} ident/number path *)
|
|
|
IF lit = 0 THEN curDesc^.kind := 1; (*{048a-0491}*)
|
|
IF lit = 0 THEN curDesc^.kind := 1; (*{048a-0491}*)
|
|
|
ELSIF lit = spillFlag THEN curDesc^.kind := 0; (*{0493-049b} nil *)
|
|
ELSIF lit = spillFlag THEN curDesc^.kind := 0; (*{0493-049b} nil *)
|
|
|
ELSE
|
|
ELSE
|
|
|
- curDesc^.value := spillFlag-lit; curDesc^.kind := 4; (*{049d-04a4} deref const *)
|
|
|
|
|
- IF (4 IN Scanner.follSet) & (Scanner.litType <= 9) THEN (*{04a5-04b0}*)
|
|
|
|
|
- CodeGen.SetPendingOp(1, curDesc^.kind, curDesc^.value, curDesc^.extra); (*{04b2-04b9}*)
|
|
|
|
|
|
|
+ curDesc^.value := ADDRESS(spillFlag-lit); curDesc^.kind := 4; (*{049d-04a4} deref const *)
|
|
|
|
|
+ IF (4 IN Scanner.follSet) & (Scanner.litType^.word4 <= 9) THEN (*{04a5-04b0}*)
|
|
|
|
|
+ CodeGen.SetPendingOp(1, curDesc^.kind, CARDINAL(curDesc^.value), curDesc^.extra); (*{04b2-04b9}*)
|
|
|
curDesc^.kind := 2; curDesc^.extra := 0; (*{04bb-04c0}*)
|
|
curDesc^.kind := 2; curDesc^.extra := 0; (*{04bb-04c0}*)
|
|
|
END;
|
|
END;
|
|
|
END;
|
|
END;
|
|
|
ELSIF 8 IN Scanner.follSet THEN (*{04c3-04c7} cardinal const *)
|
|
ELSIF 8 IN Scanner.follSet THEN (*{04c3-04c7} cardinal const *)
|
|
|
CodeGen.QueueConst(curDesc^.extra); curDesc^.kind := 2; curDesc^.extra := 0; constMode := 1; (*{04c9-04d4}*)
|
|
CodeGen.QueueConst(curDesc^.extra); curDesc^.kind := 2; curDesc^.extra := 0; constMode := 1; (*{04c9-04d4}*)
|
|
|
ELSIF 1 IN Scanner.follSet THEN (*{04d7-04db} integer const *)
|
|
ELSIF 1 IN Scanner.follSet THEN (*{04d7-04db} integer const *)
|
|
|
- curDesc^.value := lit; curDesc^.kind := 3; (*{04dd-04e2}*)
|
|
|
|
|
|
|
+ curDesc^.value := ADDRESS(lit); curDesc^.kind := 3; (*{04dd-04e2}*)
|
|
|
ELSE (*{04e5} string/char const *)
|
|
ELSE (*{04e5} string/char const *)
|
|
|
- PushStringConst; (* local proc2 {04e9} *)
|
|
|
|
|
|
|
+ PushOperand(HeadPtr(ADR(Scanner.scopeCur^.link2))); (*{073d-0741} *)
|
|
|
curDesc^.kind := 2; constMode := 1; (*{04ea-04ee}*)
|
|
curDesc^.kind := 2; constMode := 1; (*{04ea-04ee}*)
|
|
|
IF curDesc^.extra > 510 THEN (*{04ef-04f5} long string -> static *)
|
|
IF curDesc^.extra > 510 THEN (*{04ef-04f5} long string -> static *)
|
|
|
CodeGen.QueueConst(curDesc^.extra); CodeGen.EmitTypedOp(6, 0); (*{04f7-04fd}*)
|
|
CodeGen.QueueConst(curDesc^.extra); CodeGen.EmitTypedOp(6, 0); (*{04f7-04fd}*)
|
|
|
curDesc^.extra := 0; (*{04ff-0501}*)
|
|
curDesc^.extra := 0; (*{04ff-0501}*)
|
|
|
END;
|
|
END;
|
|
|
END;
|
|
END;
|
|
|
- CheckAndStore(Scanner.litType, 1); (*{0502-050a} local proc22 *)
|
|
|
|
|
|
|
+ curDesc^.typ := NodePtr(Scanner.litType); curDesc^.mode := 1; (*{075a-0760}*)
|
|
|
|
|
+ CheckAndStore(curDesc); (*{0762} local proc22 *)
|
|
|
Scanner.GetSym; (*{050c}*)
|
|
Scanner.GetSym; (*{050c}*)
|
|
|
END EvalConstExpr;
|
|
END EvalConstExpr;
|
|
|
|
|
|
|
|
-(*{0657} PROCEDURE ParseFactor(p1..p5) — 5 params *)
|
|
|
|
|
-PROCEDURE ParseFactor(p1, p2, p3, p4, p5: CARDINAL);
|
|
|
|
|
-VAR a, b: CARDINAL;
|
|
|
|
|
|
|
+(*{08af} PROCEDURE ParseFactor — 5 params (MCD order: F1..F5).
|
|
|
|
|
+ F2: ADDRESS (slot+6 VAR), F3: NodePtr, F4: BOOLEAN, F1/F5: CARDINAL.
|
|
|
|
|
+ (FIXME-NEST: MCD nests proc38 in proc37 (ec); move in nesting pass.) *)
|
|
|
|
|
+PROCEDURE ParseFactor(p1: CARDINAL; p2: ADDRESS; p3: NodePtr; p4: BOOLEAN; p5: CARDINAL);
|
|
|
|
|
+VAR a: NodePtr; b: BOOLEAN; (* local-2, -3 *)
|
|
|
BEGIN
|
|
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}*)
|
|
|
|
|
|
|
+ IF Pass1.InsertEntry(p1, p2, a, b) THEN (*{08b1} PASS1.proc3 *)
|
|
|
|
|
+ ParseFactor(p1, p2, a, b, p5); (*{08bc} recursive *)
|
|
|
|
|
+ Scanner.ExpectSy(1); (*{08c4}*)
|
|
|
|
|
+ END;
|
|
|
|
|
+ IF p4 THEN ParseDesignatorTail; NormalizeOperand(curDesc); (*{08c7}*)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ Scanner.PushWith; (*{08cf}*)
|
|
|
|
|
+ IF (Scanner.identKd = 5) AND (p3^.w4 = 9) THEN (*{08d1} stdfunc misuse *)
|
|
|
|
|
+ CentralError(ParseDesignatorBase(CARDINAL(p3^.w2), CARDINAL(Scanner.litType), CARDINAL(p3^.w5), CARDINAL(Scanner.curNode^.high)), 67);
|
|
|
|
|
+ ParseActualList; Scanner.GetSym; RETURN; (*{08e8}*)
|
|
|
END;
|
|
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}*)
|
|
|
|
|
|
|
+ BoolCondHelper; (*{08f1} native proc12 *)
|
|
|
END;
|
|
END;
|
|
|
- BoolCondHelper; (*{0699} local proc12 *)
|
|
|
|
|
- ParseSelector(p3, p2, p1); (*{069b-069e} local proc20 *)
|
|
|
|
|
|
|
+ ParseSelector(p3, p4, p5); (*{08f2} *)
|
|
|
END ParseFactor;
|
|
END ParseFactor;
|
|
|
|
|
|
|
|
-(*{06a2} PROCEDURE ParseTerm(t, flag) — 2 params *)
|
|
|
|
|
|
|
+(*{08fa} PROCEDURE ParseTerm(flag, t) — 2 CARDINAL params.
|
|
|
|
|
+ Locals feed proc38 (F2: ADDRESS, F3: NodePtr, F4: BOOLEAN) + CondInsert VARs. *)
|
|
|
PROCEDURE ParseTerm(flag, t: CARDINAL);
|
|
PROCEDURE ParseTerm(flag, t: CARDINAL);
|
|
|
-VAR a, b, c: CARDINAL;
|
|
|
|
|
|
|
+VAR a: ADDRESS; b: NodePtr; c: BOOLEAN;
|
|
|
BEGIN
|
|
BEGIN
|
|
|
- IF Pass1.CondInsert(flag, a, b, c) THEN (*{06a4-06ab} PASS1.proc2 *)
|
|
|
|
|
- ParseFactor(flag, a, b, c, t); (*{06ad-06b3} nested proc38 *)
|
|
|
|
|
|
|
+ IF Pass1.CondInsert(flag, a, b, c) THEN (*{08fc} PASS1.proc2 *)
|
|
|
|
|
+ ParseFactor(flag, a, b, c, t); (*{0907} nested proc38 *)
|
|
|
END;
|
|
END;
|
|
|
- Scanner.ExpectSy(5); (*{06b6-06b8} '*' expected *)
|
|
|
|
|
|
|
+ Scanner.ExpectSy(5); (*{090e} '*' expected *)
|
|
|
END ParseTerm;
|
|
END ParseTerm;
|
|
|
|
|
|
|
|
(*{0704} PROCEDURE ParseSetCons(s, flag) — 2 params; set constructor *)
|
|
(*{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;
|
|
|
|
|
|
|
+PROCEDURE ParseSetCons(flag: BOOLEAN; s: BOOLEAN);
|
|
|
|
|
+VAR lo, hi: HeadPtr; mod: CARDINAL; res: RecordPtr; first, bad: BOOLEAN; aux: CARDINAL;
|
|
|
op, k1, k2, m: CARDINAL;
|
|
op, k1, k2, m: CARDINAL;
|
|
|
BEGIN
|
|
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}*)
|
|
|
|
|
|
|
+ (* FIXME-RESERVE: MCD reserves 10B to lo/hi slots, but HeadPtr locals
|
|
|
|
|
+ have no reserve source; record-args can't single-push (probed).
|
|
|
|
|
+ proc40 full audit must resolve (alias? uplevel?). *)
|
|
|
|
|
+ GetRangeBase(0); (*{070c} FIXME-UPLEVEL: MCD outer-frame-4 arg (proc39 local) *)
|
|
|
|
|
+ lo^.mode := 0; lo^.typ := NodePtr(Compiler.CardType); (*{0712-0717}*)
|
|
|
mod := Scanner.EnterMod("TEXTS", 4); (*{071d-0728}*)
|
|
mod := Scanner.EnterMod("TEXTS", 4); (*{071d-0728}*)
|
|
|
res := ParseFuncCall(mod); (*{072c-072f} nested proc41 *)
|
|
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}*)
|
|
|
|
|
|
|
+ IF NOT s THEN Scanner.TestR40(BITSET{3}) END; (*{0988}*)
|
|
|
|
|
+ IF Scanner.AcceptSy(43) & s & Scanner.AcceptSy(5) THEN (*{0991}*)
|
|
|
ELSE RETURN END; (*{0744} empty set *)
|
|
ELSE RETURN END; (*{0744} empty set *)
|
|
|
Scanner.PushWith; first := TRUE; (*{0747-074a}*)
|
|
Scanner.PushWith; first := TRUE; (*{0747-074a}*)
|
|
|
IF (Scanner.identKd = 4) & (Scanner.litType = res) THEN (*{074b-0755}*)
|
|
IF (Scanner.identKd = 4) & (Scanner.litType = res) THEN (*{074b-0755}*)
|
|
|
EvalConstExpr; lo := curDesc; (*{0757-075a}*)
|
|
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}*)
|
|
|
|
|
|
|
+ IF 20 IN BITSET(lo^.kind) THEN (*{09b5}*)
|
|
|
|
|
+ PushOperand(lo); PushExprDesc(lo, DescPtr(Compiler.CardType)); PopOperand(lo); (*{09bc-09c3}*)
|
|
|
END;
|
|
END;
|
|
|
|
|
+ IF s THEN Scanner.TestSet(BITSET{1,5}) ELSE Scanner.TestSet(BITSET{1}) END; (*{09c4}*)
|
|
|
|
|
+ first := Scanner.AcceptSy(1); (*{09d0}*)
|
|
|
first := FALSE;
|
|
first := FALSE;
|
|
|
END;
|
|
END;
|
|
|
bad := FALSE; (*{077c-077e}*)
|
|
bad := FALSE; (*{077c-077e}*)
|
|
|
WHILE first DO (*{077e-085e} element loop *)
|
|
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^.typ OF (*{0798-0817} switch on type tag 90..101 *)
|
|
|
|
|
- 90: ;
|
|
|
|
|
- 91: ;
|
|
|
|
|
- 92: bad := curDesc^.typ # Compiler.CharType; m := 1; (*{07a1-07a5}*)
|
|
|
|
|
|
|
+ CodeGen.EmitSystemCall(20); PushOperand(curDesc); (*FIXME-ARG*) (*{0781-0786}*)
|
|
|
|
|
+ IF flag THEN BoolCondHelper ELSE ParseDesignatorTail END; (*{09e0}*)
|
|
|
|
|
+ NormalizeOperand(curDesc); (*FIXME-ARG*) op := 2; m := 7; k1 := mod; Proc6; (*{09e9} *)
|
|
|
|
|
+ CASE curDesc^.typ^.w4 OF (*{09f0} callswitch; labels TBD by audit *)
|
|
|
|
|
+ 90, 91:
|
|
|
|
|
+ | 92: bad := RecordPtr(curDesc^.typ) # Compiler.CharType; m := 1; (*{07a1-07a5}*)
|
|
|
| 93..96: m := m+3; ParseTypeCast(6); (*{07a6-07af}*)
|
|
| 93..96: m := m+3; ParseTypeCast(6); (*{07a6-07af}*)
|
|
|
| 97: m := 5; ParseTypeCast(11); (*{07b2-07b5}*)
|
|
| 97: m := 5; ParseTypeCast(11); (*{07b2-07b5}*)
|
|
|
- | 98: IF curDesc^.typ = Compiler.LongrealType THEN (*{07b8-07bc} LONGREAL *)
|
|
|
|
|
|
|
+ | 98: IF RecordPtr(curDesc^.typ) = Compiler.LongrealType THEN (*{07b8-07bc} LONGREAL *)
|
|
|
ParseTypeCast(22); ParseTypeCast(65523);
|
|
ParseTypeCast(22); ParseTypeCast(65523);
|
|
|
mod := Scanner.EnterMod("DOUBLES", 6); (*{07c8-07d5}*)
|
|
mod := Scanner.EnterMod("DOUBLES", 6); (*{07c8-07d5}*)
|
|
|
aux := mod; m := 14; k1 := 1; (*{07d6-07dc}*)
|
|
aux := mod; m := 14; k1 := 1; (*{07d6-07dc}*)
|
|
|
ELSE ParseTypeCast(13); ParseTypeCast(65531); m := 6; (*{07df-07e6}*)
|
|
ELSE ParseTypeCast(13); ParseTypeCast(65531); m := 6; (*{07df-07e6}*)
|
|
|
END;
|
|
END;
|
|
|
- | 101: IF ~ IsPointer(curDesc^.typ) THEN bad := TRUE END; (*{07ea-07ef}*)
|
|
|
|
|
- EmitAddress; op := 3; m := 2; (*{07f0-07f6}*)
|
|
|
|
|
|
|
+ | 101: IF ~ IsPointer(RecordPtr(curDesc^.typ)) THEN bad := TRUE END; (*{07ea-07ef}*)
|
|
|
|
|
+ EmitAddress(curDesc); (*FIXME-ARG*) op := 3; m := 2; (*{07f0-07f6}*)
|
|
|
ELSE bad := TRUE; (*{0817}*)
|
|
ELSE bad := TRUE; (*{0817}*)
|
|
|
END;
|
|
END;
|
|
|
- IF bad THEN (*{0819-082d} elem/type mismatch *)
|
|
|
|
|
- IF curDesc^.typ # 0 THEN
|
|
|
|
|
- Errors.ReportErrorWithText(curDesc^.typ+7, curDesc^.typ);
|
|
|
|
|
- ELSE Errors.ReportErrorWithText(hi, "this type"); (*{082f-0843}*)
|
|
|
|
|
|
|
+ IF bad THEN (*{0a71} elem/type mismatch *)
|
|
|
|
|
+ IF CARDINAL(curDesc^.typ^.w0) <> 0 THEN
|
|
|
|
|
+ Errors.ReportErrorWithText(ORD(flag)+7, curDesc^.typ^.w0^.link1^);
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ Str9Ptr(hi)^ := "this type"; (*{0a87} FIXME: copy-string shape TBD *)
|
|
|
|
|
+ Errors.ReportErrorWithText(ORD(flag)+7, Str9Ptr(hi)^);
|
|
|
END;
|
|
END;
|
|
|
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}*)
|
|
|
|
|
|
|
+ CodeGen.SetPendingOp(9, 3, k1, k2+ORD(flag)*m); (*{0a9d}*)
|
|
|
|
|
+ CodeGen.EmitExtCall3(19, op, 0); (*{0aa7}*)
|
|
|
|
|
+ Scanner.TestSet(BITSET{1,5}); first := Scanner.AcceptSy(1); (*{0aae}*)
|
|
|
END;
|
|
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}*)
|
|
|
|
|
|
|
+ Scanner.GetSym; (*{0ab8} loop exit *)
|
|
|
|
|
+ IF s THEN (*{0aba} close: emit count *)
|
|
|
|
|
+ CodeGen.EmitSystemCall(20); PushOperand(lo); (*{0abd}*)
|
|
|
|
|
+ CodeGen.SetPendingOp(9, 3, mod, 7*(ORD(flag)+1)); (*{0ac4}*)
|
|
|
|
|
+ CodeGen.EmitExtCall3(19, 1, 0); (*{0acd}*)
|
|
|
END;
|
|
END;
|
|
|
END ParseSetCons;
|
|
END ParseSetCons;
|
|
|
|
|
|
|
|
(*{06bb} PROCEDURE ParseFuncCall(idx) : CARDINAL — stdproc table walk *)
|
|
(*{06bb} PROCEDURE ParseFuncCall(idx) : CARDINAL — stdproc table walk *)
|
|
|
-PROCEDURE ParseFuncCall(idx: CARDINAL): CARDINAL;
|
|
|
|
|
|
|
+PROCEDURE ParseFuncCall(idx: CARDINAL): RecordPtr;
|
|
|
VAR e: CARDINAL;
|
|
VAR e: CARDINAL;
|
|
|
BEGIN
|
|
BEGIN
|
|
|
e := SymTab.word8^[idx]; (*{06bd-06c2} FIXME: SymTab has no word8 export *)
|
|
e := SymTab.word8^[idx]; (*{06bd-06c2} FIXME: SymTab has no word8 export *)
|
|
@@ -693,7 +719,7 @@ VAR save: CARDINAL;
|
|
|
BEGIN
|
|
BEGIN
|
|
|
save := curDesc^.extra; (*{08e6-08e8}*)
|
|
save := curDesc^.extra; (*{08e6-08e8}*)
|
|
|
IF Scanner.AcceptSy(1) THEN (*{08e9-08ec}*)
|
|
IF Scanner.AcceptSy(1) THEN (*{08e9-08ec}*)
|
|
|
- PushOperand; (*{08ee}*)
|
|
|
|
|
|
|
+ PushOperand(curDesc); (*FIXME-ARG*) (*{08ee}*)
|
|
|
IF ~ MatchOpClass(1024, 1) THEN (*{08f1-08f5}*) END;
|
|
IF ~ MatchOpClass(1024, 1) THEN (*{08f1-08f5}*) END;
|
|
|
IF first # 0 THEN CentralError(TRUE (*FIXME: cond TBD*), 63) END; (*{08f6-08fd} GetConstVal guard *)
|
|
IF first # 0 THEN CentralError(TRUE (*FIXME: cond TBD*), 63) END; (*{08f6-08fd} GetConstVal guard *)
|
|
|
GetConstVal; ConstToCard(curDesc^.value, 1); (*{08fe-0902}*)
|
|
GetConstVal; ConstToCard(curDesc^.value, 1); (*{08fe-0902}*)
|
|
@@ -725,7 +751,7 @@ BEGIN
|
|
|
CentralError(TRUE (*FIXME: cond TBD*), 56-std);
|
|
CentralError(TRUE (*FIXME: cond TBD*), 56-std);
|
|
|
END;
|
|
END;
|
|
|
IF 6 # found[3] THEN CodeGen.EmitSystemCall(20) END; (*{0978-097e} address *)
|
|
IF 6 # found[3] THEN CodeGen.EmitSystemCall(20) END; (*{0978-097e} address *)
|
|
|
- ParseDesignatorTail; NormalizeOperand; (*{097f-0981}*)
|
|
|
|
|
|
|
+ ParseDesignatorTail; NormalizeOperand(curDesc); (*FIXME-ARG*) (*{097f-0981}*)
|
|
|
IF ~ MatchOpClass(32, FRAME^.tag-4) THEN (*{0984-0988} FIXME: raw frame *) END;
|
|
IF ~ MatchOpClass(32, FRAME^.tag-4) THEN (*{0984-0988} FIXME: raw frame *) END;
|
|
|
ExpandStdProc44(1); (*{098c-098e} call_with_frame proc44 *)
|
|
ExpandStdProc44(1); (*{098c-098e} call_with_frame proc44 *)
|
|
|
IF 6 IN found[3] THEN CodeGen.EmitMiscOp(5, found[5]); (*{098f-0998} dispose *)
|
|
IF 6 IN found[3] THEN CodeGen.EmitMiscOp(5, found[5]); (*{098f-0998} dispose *)
|
|
@@ -738,10 +764,10 @@ PROCEDURE ExpandStdProc46;
|
|
|
BEGIN
|
|
BEGIN
|
|
|
IF (48 IN curDesc^.kind) OR ((curDesc^.kind = 2) & (Compiler.rangeCheckEnabled # 0)) THEN (*{09a4-09b3}*)
|
|
IF (48 IN curDesc^.kind) OR ((curDesc^.kind = 2) & (Compiler.rangeCheckEnabled # 0)) THEN (*{09a4-09b3}*)
|
|
|
IF (curDesc^.kind # 5) OR (curDesc^.typ # 1) THEN CentralError(TRUE (*FIXME: cond TBD*), 96) END; (*{09b5-09c0}*)
|
|
IF (curDesc^.kind # 5) OR (curDesc^.typ # 1) THEN CentralError(TRUE (*FIXME: cond TBD*), 96) END; (*{09b5-09c0}*)
|
|
|
- NormalizeOperand; curDesc^.kind := 2; curDesc^.extra := 0; (*{09c3-09ca}*)
|
|
|
|
|
|
|
+ NormalizeOperand(curDesc); (*FIXME-ARG*) curDesc^.kind := 2; curDesc^.extra := 0; (*{09c3-09ca}*)
|
|
|
END;
|
|
END;
|
|
|
IF curDesc^.kind = 2 THEN CodeGen.EmitStandardOp(8) END; (*{09cb-09d2} ORD-class emit *)
|
|
IF curDesc^.kind = 2 THEN CodeGen.EmitStandardOp(8) END; (*{09cb-09d2} ORD-class emit *)
|
|
|
- PushOperand; (*{09d4-09dc} copy desc, push *)
|
|
|
|
|
|
|
+ PushOperand(curDesc); (*FIXME-ARG*) (*{09d4-09dc} copy desc, push *)
|
|
|
END ExpandStdProc46;
|
|
END ExpandStdProc46;
|
|
|
|
|
|
|
|
(*{09e0} PROCEDURE ParseSetOrCastTail *)
|
|
(*{09e0} PROCEDURE ParseSetOrCastTail *)
|
|
@@ -770,14 +796,14 @@ BEGIN
|
|
|
END;
|
|
END;
|
|
|
IF buf.raw[0] = 0 THEN curDesc^.typ := Compiler.CardType ELSE curDesc^.typ := buf.raw[0] END; (*{0a2c-0a3b}*)
|
|
IF buf.raw[0] = 0 THEN curDesc^.typ := Compiler.CardType ELSE curDesc^.typ := buf.raw[0] END; (*{0a2c-0a3b}*)
|
|
|
IF curDesc^.kind = 0 THEN EmitOp ELSE EmitOp END; (*{0a3d-0a4d} proc6/7 *)
|
|
IF curDesc^.kind = 0 THEN EmitOp ELSE EmitOp END; (*{0a3d-0a4d} proc6/7 *)
|
|
|
- curDesc^.mode := 2; PushExprDesc; PopOperand; (*{0a4e-0a56} proc5/3 FIXME arity *)
|
|
|
|
|
|
|
+ curDesc^.mode := 2; PushExprDesc; PopOperand(curDesc); (*FIXME-ARG*) (*{0a4e-0a56} proc5/3 FIXME arity *)
|
|
|
| 98, 99:
|
|
| 98, 99:
|
|
|
ParseDesignatorTail;
|
|
ParseDesignatorTail;
|
|
|
IF ~ MatchOpClass(16, t2) THEN (*{0a59-0a5d}*) END;
|
|
IF ~ MatchOpClass(16, t2) THEN (*{0a59-0a5d}*) END;
|
|
|
ExpandStdProc46; Scanner.ExpectSy(1); (*{0a5d-0a60}*)
|
|
ExpandStdProc46; Scanner.ExpectSy(1); (*{0a5d-0a60}*)
|
|
|
ParseExpression; ConstToCard(buf.raw[0], curDesc^.value); ConstToCard(buf.raw[0], curDesc^.value); (*{0a62-0a6a}*)
|
|
ParseExpression; ConstToCard(buf.raw[0], curDesc^.value); ConstToCard(buf.raw[0], curDesc^.value); (*{0a62-0a6a}*)
|
|
|
CodeGen.EmitStandardOp(5); (*{0a6b-0a6d}*)
|
|
CodeGen.EmitStandardOp(5); (*{0a6b-0a6d}*)
|
|
|
- EmitTypedOp(4, t3-2); PopOperand; (*{0a6f-0a77} proc6/3 *)
|
|
|
|
|
|
|
+ EmitTypedOp(4, t3-2); PopOperand(curDesc); (*FIXME-ARG*) (*{0a6f-0a77} proc6/3 *)
|
|
|
| 100: Errors.ReportError(34); (*{0a78-0a7a} illegal *)
|
|
| 100: Errors.ReportError(34); (*{0a78-0a7a} illegal *)
|
|
|
END;
|
|
END;
|
|
|
Scanner.ExpectSy(5); (*{0a92-0a93}*)
|
|
Scanner.ExpectSy(5); (*{0a92-0a93}*)
|
|
@@ -786,7 +812,7 @@ BEGIN
|
|
|
Scanner.ExpectSy(43);
|
|
Scanner.ExpectSy(43);
|
|
|
CASE t3 OF (*{0a9c,0b79} switch 90..105 *)
|
|
CASE t3 OF (*{0a9c,0b79} switch 90..105 *)
|
|
|
90..95:
|
|
90..95:
|
|
|
- ParseExpression; EmitOp; (*{0aa1} proc12/6 *)
|
|
|
|
|
|
|
+ ParseExpression; Proc6; (*FIXME-PROC6*) (*{0aa1} proc12/6 *)
|
|
|
k := TypeKindOf(); (*{0aa1-0aa3} local proc27 *)
|
|
k := TypeKindOf(); (*{0aa1-0aa3} local proc27 *)
|
|
|
IF ~ MatchOpClass(388, t2) THEN (*{0aa4-0aa8}*) END;
|
|
IF ~ MatchOpClass(388, t2) THEN (*{0aa4-0aa8}*) END;
|
|
|
IF t3 # 4 THEN CodeGen.EmitTypedOp(13+t3, k); (*{0aac-0ab2}*)
|
|
IF t3 # 4 THEN CodeGen.EmitTypedOp(13+t3, k); (*{0aac-0ab2}*)
|
|
@@ -797,7 +823,7 @@ BEGIN
|
|
|
END;
|
|
END;
|
|
|
| 96: ParseExpression;
|
|
| 96: ParseExpression;
|
|
|
IF ~ MatchOpClass(7, t2) THEN (*{0ac7-0aca}*) END;
|
|
IF ~ MatchOpClass(7, t2) THEN (*{0ac7-0aca}*) END;
|
|
|
- | 97: ParseExpression; EmitOp;
|
|
|
|
|
|
|
+ | 97: ParseExpression; Proc6; (*FIXME-PROC6*)
|
|
|
IF ~ MatchOpClass(4, t2) THEN (*{0acd-0ad0}*) END;
|
|
IF ~ MatchOpClass(4, t2) THEN (*{0acd-0ad0}*) END;
|
|
|
| 98: ParseExpression;
|
|
| 98: ParseExpression;
|
|
|
IF ~ MatchOpClass(7, t2) THEN (*{0ad2-0ad5}*) END;
|
|
IF ~ MatchOpClass(7, t2) THEN (*{0ad2-0ad5}*) END;
|
|
@@ -805,7 +831,7 @@ BEGIN
|
|
|
| 99:
|
|
| 99:
|
|
|
save5 := CodeGen.emitEnabled; CodeGen.emitEnabled := 0; (*{0add-0ae1} FIXME: no word5 export *)
|
|
save5 := CodeGen.emitEnabled; CodeGen.emitEnabled := 0; (*{0add-0ae1} FIXME: no word5 export *)
|
|
|
ParseDesignatorTail; CodeGen.emitEnabled := save5; (*{0ae3-0ae5}*)
|
|
ParseDesignatorTail; CodeGen.emitEnabled := save5; (*{0ae3-0ae5}*)
|
|
|
- IF ~ MatchOpClass(2048, t2) THEN (*{0ae7-0aeb}*) END;
|
|
|
|
|
|
|
+ IF ~ MatchOpClass(BITSET{11}, t2) THEN (*{0ae7-0aeb}*) END;
|
|
|
IF curDesc^.value = 0 THEN EmitAddress (*{0aec-0af4} local proc28 *)
|
|
IF curDesc^.value = 0 THEN EmitAddress (*{0aec-0af4} local proc28 *)
|
|
|
ELSE CodeGen.QueueConst(curDesc^.value); (*{0af7-0afd}*)
|
|
ELSE CodeGen.QueueConst(curDesc^.value); (*{0af7-0afd}*)
|
|
|
END;
|
|
END;
|
|
@@ -813,7 +839,7 @@ BEGIN
|
|
|
IF constMode # 0 THEN (*{0b01}*)
|
|
IF constMode # 0 THEN (*{0b01}*)
|
|
|
ELSIF curDesc^.kind > 9 THEN CentralError(TRUE (*FIXME: cond TBD*), 97); (*{0b02-0b0b}*)
|
|
ELSIF curDesc^.kind > 9 THEN CentralError(TRUE (*FIXME: cond TBD*), 97); (*{0b02-0b0b}*)
|
|
|
END;
|
|
END;
|
|
|
- NormalizeOperand; (*{0b0c-0b0e}*)
|
|
|
|
|
|
|
+ NormalizeOperand(curDesc); (*FIXME-ARG*) (*{0b0c-0b0e}*)
|
|
|
| 101, 102:
|
|
| 101, 102:
|
|
|
Scanner.PushWith; (*{0b0f}*)
|
|
Scanner.PushWith; (*{0b0f}*)
|
|
|
IF (Scanner.identKd = 3) & (t3 = 12) THEN (*{0b11-0b1a}*)
|
|
IF (Scanner.identKd = 3) & (t3 = 12) THEN (*{0b11-0b1a}*)
|
|
@@ -822,7 +848,7 @@ BEGIN
|
|
|
ELSE (*{0b27} address-builtin path *)
|
|
ELSE (*{0b27} address-builtin path *)
|
|
|
save5 := CodeGen.emitEnabled; CodeGen.emitEnabled := 0; (*{0b27-0b2b}*)
|
|
save5 := CodeGen.emitEnabled; CodeGen.emitEnabled := 0; (*{0b27-0b2b}*)
|
|
|
ParseDesignatorTail; CodeGen.emitEnabled := 1; (*{0b2d-0b2f}*)
|
|
ParseDesignatorTail; CodeGen.emitEnabled := 1; (*{0b2d-0b2f}*)
|
|
|
- LoadIndirect; (*{0b31} local proc11 *)
|
|
|
|
|
|
|
+ LoadIndirect(curDesc); (*FIXME-ARG*) (*{0b31} local proc11 *)
|
|
|
END;
|
|
END;
|
|
|
| 103..105:
|
|
| 103..105:
|
|
|
Scanner.PushWith; Scanner.ExpectKd(3); (*{0b34-0b37}*)
|
|
Scanner.PushWith; Scanner.ExpectKd(3); (*{0b34-0b37}*)
|
|
@@ -961,7 +987,7 @@ BEGIN
|
|
|
acc2 := {1}; (*{0ce9-0cea}*)
|
|
acc2 := {1}; (*{0ce9-0cea}*)
|
|
|
END;
|
|
END;
|
|
|
END;
|
|
END;
|
|
|
- Scanner.TestSet(130); (*{0ceb-0ced} FIXME: CARDINAL set pun *)
|
|
|
|
|
|
|
+ Scanner.TestSet(BITSET{1,7}); (*{0ceb-0ced} FIXME: CARDINAL set pun *)
|
|
|
IF ~ Scanner.AcceptSy(1) THEN (*{0cef-0cf3} *)
|
|
IF ~ Scanner.AcceptSy(1) THEN (*{0cef-0cf3} *)
|
|
|
Scanner.GetSym; (*{0cf5}*)
|
|
Scanner.GetSym; (*{0cf5}*)
|
|
|
END;
|
|
END;
|
|
@@ -1258,7 +1284,7 @@ BEGIN
|
|
|
ELSIF (t = NIL) OR ((buf.raw[2] >= 0) AND (curDesc^.value > buf.raw[2])) THEN
|
|
ELSIF (t = NIL) OR ((buf.raw[2] >= 0) AND (curDesc^.value > buf.raw[2])) THEN
|
|
|
curDesc^.typ := Compiler.CardType; (* CARD result *) (*{11ca-11de} FIXME: group wrote word6 *)
|
|
curDesc^.typ := Compiler.CardType; (* CARD result *) (*{11ca-11de} FIXME: group wrote word6 *)
|
|
|
END;
|
|
END;
|
|
|
- IF curDesc^.typ = Compiler.CardType THEN (*{11df-11e4}*)
|
|
|
|
|
|
|
+ IF RecordPtr(curDesc^.typ) = Compiler.CardType THEN (*{11df-11e4}*)
|
|
|
IF buf.raw[0] = Compiler.CardType THEN
|
|
IF buf.raw[0] = Compiler.CardType THEN
|
|
|
curDesc^.value := buf.raw[2] - curDesc^.value; (* isub_checked *) (*{11e6-11ec} FIXME *)
|
|
curDesc^.value := buf.raw[2] - curDesc^.value; (* isub_checked *) (*{11e6-11ec} FIXME *)
|
|
|
ELSE
|
|
ELSE
|
|
@@ -1408,7 +1434,7 @@ END GetTypeDesc;
|
|
|
|
|
|
|
|
PROCEDURE CheckAssignmentCompat(dst: ADDRESS);
|
|
PROCEDURE CheckAssignmentCompat(dst: ADDRESS);
|
|
|
BEGIN
|
|
BEGIN
|
|
|
- IF ~ BaseTypeOf(dst, curDesc^.typ) THEN (* proc34 FIXME: 2-param vs use *)
|
|
|
|
|
|
|
+ IF ~ BaseTypeOf(dst, RecordPtr(curDesc^.typ)) THEN (* proc34 FIXME: 2-param vs use *)
|
|
|
Errors.ReportIncompatibleTypes(dst, curDesc^.typ, " assignment"); (*{1456-1469} FIXME T1 pun *)
|
|
Errors.ReportIncompatibleTypes(dst, curDesc^.typ, " assignment"); (*{1456-1469} FIXME T1 pun *)
|
|
|
END;
|
|
END;
|
|
|
END CheckAssignmentCompat;
|
|
END CheckAssignmentCompat;
|