|
|
@@ -87,3469 +87,3504 @@ Listing:
|
|
|
68 twoPhaseParse: BOOLEAN;
|
|
|
69 procNest: CARDINAL;
|
|
|
70
|
|
|
- 71 (* Result slot for the expression-AST builder (slice 2). Every
|
|
|
- 72 Expr/SimExpr/Term/Fact leaves its node here; the combination
|
|
|
- 73 productions save it into locals before parsing the next operand.
|
|
|
- 74 `astIsLit` in Fact is per-invocation, so a nested Fact cannot make
|
|
|
- 75 an outer non-literal Fact look literal. *)
|
|
|
- 76 astCur: AST.Node;
|
|
|
- 77
|
|
|
- 78 (* Actual-argument nodes collected by ActParam for the call being
|
|
|
- 79 parsed by ArgList (slice 4). Fact resets the count before the
|
|
|
- 80 optional ArgList and then folds the nodes into an NkCall. *)
|
|
|
- 81 astNArgs: CARDINAL;
|
|
|
- 82 astArgs: ARRAY [0 .. 31] OF AST.Node;
|
|
|
- 83
|
|
|
- 84 (* Statement-AST result slot (slice 5): the most recently parsed
|
|
|
- 85 statement. StatSeq folds these into an NkBlock. *)
|
|
|
- 86 astStmt: AST.Node;
|
|
|
- 87
|
|
|
- 88 (* Declaration-AST result slot (slice 6): the most recently built
|
|
|
- 89 declaration; DeclSeq folds these into an NkDeclSeq. *)
|
|
|
- 90 astDecl: AST.Node;
|
|
|
+ 71 (* Two-phase parse spans (milestone 2a): one entry per outermost body
|
|
|
+ 72 shadow-skipped while twoPhaseParse is on — procedure name and the
|
|
|
+ 73 buffer offset its body starts at (the lookahead token's nextPos).
|
|
|
+ 74 Per-parse; nothing consumes the table yet. *)
|
|
|
+ 75 nSpans: CARDINAL;
|
|
|
+ 76 spanName: ARRAY [0 .. 1023] OF SymTab.Name;
|
|
|
+ 77 spanStart: ARRAY [0 .. 1023] OF M2S.INT32;
|
|
|
+ 78
|
|
|
+ 79 (* Result slot for the expression-AST builder (slice 2). Every
|
|
|
+ 80 Expr/SimExpr/Term/Fact leaves its node here; the combination
|
|
|
+ 81 productions save it into locals before parsing the next operand.
|
|
|
+ 82 `astIsLit` in Fact is per-invocation, so a nested Fact cannot make
|
|
|
+ 83 an outer non-literal Fact look literal. *)
|
|
|
+ 84 astCur: AST.Node;
|
|
|
+ 85
|
|
|
+ 86 (* Actual-argument nodes collected by ActParam for the call being
|
|
|
+ 87 parsed by ArgList (slice 4). Fact resets the count before the
|
|
|
+ 88 optional ArgList and then folds the nodes into an NkCall. *)
|
|
|
+ 89 astNArgs: CARDINAL;
|
|
|
+ 90 astArgs: ARRAY [0 .. 31] OF AST.Node;
|
|
|
91
|
|
|
- 92 (* The local declarations of the most recent Block (a procedure body);
|
|
|
- 93 ProcDecl stores them as the proc node's child 2. *)
|
|
|
- 94 astBlkDecls: AST.Node;
|
|
|
+ 92 (* Statement-AST result slot (slice 5): the most recently parsed
|
|
|
+ 93 statement. StatSeq folds these into an NkBlock. *)
|
|
|
+ 94 astStmt: AST.Node;
|
|
|
95
|
|
|
- 96 (* Unit-AST root (slice 7): NkUnit(name, decls, body). *)
|
|
|
- 97 astUnit: AST.Node;
|
|
|
- 98
|
|
|
- 99 (* Import accumulator (slice 11): `{ Import }` appends NkImport
|
|
|
- 100 nodes here; each unit stores them as NkUnit child[3]. *)
|
|
|
- 101 astImp, astImpTail: AST.Node;
|
|
|
- 102
|
|
|
- 103 (* Class-AST accumulators (slice 13): the class node currently being
|
|
|
- 104 parsed and its parent/field/method lists. Classes are not nested
|
|
|
- 105 inside one another, so module-level state is safe. *)
|
|
|
- 106 astCls, astClsP, astClsPTail, astClsF, astClsFTail,
|
|
|
- 107 astClsM, astClsMTail, astMethod: AST.Node;
|
|
|
- 108
|
|
|
- 109 (* Class of the method named by the last `obj.Method` designator
|
|
|
- 110 (InvalidType when the callee is an ordinary procedure). Set by
|
|
|
- 111 Design, consumed by the following ArgList. *)
|
|
|
- 112 methCls: SymTab.TypeIndex;
|
|
|
- 113 (* Class of the type of the innermost `TypeName{...}` brace
|
|
|
- 114 constructor (ClSet or ClArray); dispatches BraceElem. *)
|
|
|
- 115 braceCls: INTEGER;
|
|
|
- 116 (* Module-level VAR declarations whose type was still an unresolved
|
|
|
- 117 forward alias at declaration time; emitted once the TYPE block
|
|
|
- 118 completes (module scope only). *)
|
|
|
- 119 nPendVar: CARDINAL;
|
|
|
- 120 pendVarName: ARRAY [0 .. 255] OF SymTab.Name;
|
|
|
- 121 pendVarT: ARRAY [0 .. 255] OF SymTab.TypeIndex;
|
|
|
- 122 (* Forward module-level variables referenced from a procedure body. *)
|
|
|
- 123 (* GOTO/labels: the label and goto names of the procedure being parsed,
|
|
|
- 124 reset per procedure and checked at its END. *)
|
|
|
- 125 nLab, nGot: CARDINAL;
|
|
|
- 126 labNm, gotNm: ARRAY [0 .. 255] OF SymTab.Name;
|
|
|
- 127
|
|
|
- 128 (* Generics (Increment 1): the last refining module seen — instance
|
|
|
- 129 name, generic name, and the actual type parameters. *)
|
|
|
- 130 refInst, refGen: SymTab.Name;
|
|
|
- 131 refN: CARDINAL;
|
|
|
- 132 refActual: ARRAY [0 .. 15] OF SymTab.TypeIndex;
|
|
|
- 133 isGen: BOOLEAN;
|
|
|
- 134
|
|
|
- 135 (* Generics (Increment 2): instantiation re-parse context. When the
|
|
|
- 136 driver re-parses a generic's source to instantiate it as `instName`,
|
|
|
- 137 instActive is TRUE, the module is renamed, and each type formal is
|
|
|
- 138 bound to the corresponding instActual entry. *)
|
|
|
- 139 instActive: BOOLEAN;
|
|
|
- 140 instName: SymTab.Name;
|
|
|
- 141 instActual: ARRAY [0 .. 15] OF SymTab.TypeIndex;
|
|
|
- 142 instN: CARDINAL;
|
|
|
- 143 instFk: CARDINAL; (* formal cursor while binding during re-parse *)
|
|
|
- 144
|
|
|
- 145 (* Identity of the last-parsed unit and refinement, for the driver's
|
|
|
- 146 generic registry and its re-parse decision. *)
|
|
|
- 147 unitName: SymTab.Name;
|
|
|
- 148 unitWasGen: BOOLEAN;
|
|
|
- 149 unitWasDef: BOOLEAN;
|
|
|
- 150 refSeen: BOOLEAN;
|
|
|
- 151 refIsDef: BOOLEAN;
|
|
|
+ 96 (* Declaration-AST result slot (slice 6): the most recently built
|
|
|
+ 97 declaration; DeclSeq folds these into an NkDeclSeq. *)
|
|
|
+ 98 astDecl: AST.Node;
|
|
|
+ 99
|
|
|
+ 100 (* The local declarations of the most recent Block (a procedure body);
|
|
|
+ 101 ProcDecl stores them as the proc node's child 2. *)
|
|
|
+ 102 astBlkDecls: AST.Node;
|
|
|
+ 103
|
|
|
+ 104 (* Unit-AST root (slice 7): NkUnit(name, decls, body). *)
|
|
|
+ 105 astUnit: AST.Node;
|
|
|
+ 106
|
|
|
+ 107 (* Import accumulator (slice 11): `{ Import }` appends NkImport
|
|
|
+ 108 nodes here; each unit stores them as NkUnit child[3]. *)
|
|
|
+ 109 astImp, astImpTail: AST.Node;
|
|
|
+ 110
|
|
|
+ 111 (* Class-AST accumulators (slice 13): the class node currently being
|
|
|
+ 112 parsed and its parent/field/method lists. Classes are not nested
|
|
|
+ 113 inside one another, so module-level state is safe. *)
|
|
|
+ 114 astCls, astClsP, astClsPTail, astClsF, astClsFTail,
|
|
|
+ 115 astClsM, astClsMTail, astMethod: AST.Node;
|
|
|
+ 116
|
|
|
+ 117 (* Class of the method named by the last `obj.Method` designator
|
|
|
+ 118 (InvalidType when the callee is an ordinary procedure). Set by
|
|
|
+ 119 Design, consumed by the following ArgList. *)
|
|
|
+ 120 methCls: SymTab.TypeIndex;
|
|
|
+ 121 (* Class of the type of the innermost `TypeName{...}` brace
|
|
|
+ 122 constructor (ClSet or ClArray); dispatches BraceElem. *)
|
|
|
+ 123 braceCls: INTEGER;
|
|
|
+ 124 (* Module-level VAR declarations whose type was still an unresolved
|
|
|
+ 125 forward alias at declaration time; emitted once the TYPE block
|
|
|
+ 126 completes (module scope only). *)
|
|
|
+ 127 nPendVar: CARDINAL;
|
|
|
+ 128 pendVarName: ARRAY [0 .. 255] OF SymTab.Name;
|
|
|
+ 129 pendVarT: ARRAY [0 .. 255] OF SymTab.TypeIndex;
|
|
|
+ 130 (* Forward module-level variables referenced from a procedure body. *)
|
|
|
+ 131 (* GOTO/labels: the label and goto names of the procedure being parsed,
|
|
|
+ 132 reset per procedure and checked at its END. *)
|
|
|
+ 133 nLab, nGot: CARDINAL;
|
|
|
+ 134 labNm, gotNm: ARRAY [0 .. 255] OF SymTab.Name;
|
|
|
+ 135
|
|
|
+ 136 (* Generics (Increment 1): the last refining module seen — instance
|
|
|
+ 137 name, generic name, and the actual type parameters. *)
|
|
|
+ 138 refInst, refGen: SymTab.Name;
|
|
|
+ 139 refN: CARDINAL;
|
|
|
+ 140 refActual: ARRAY [0 .. 15] OF SymTab.TypeIndex;
|
|
|
+ 141 isGen: BOOLEAN;
|
|
|
+ 142
|
|
|
+ 143 (* Generics (Increment 2): instantiation re-parse context. When the
|
|
|
+ 144 driver re-parses a generic's source to instantiate it as `instName`,
|
|
|
+ 145 instActive is TRUE, the module is renamed, and each type formal is
|
|
|
+ 146 bound to the corresponding instActual entry. *)
|
|
|
+ 147 instActive: BOOLEAN;
|
|
|
+ 148 instName: SymTab.Name;
|
|
|
+ 149 instActual: ARRAY [0 .. 15] OF SymTab.TypeIndex;
|
|
|
+ 150 instN: CARDINAL;
|
|
|
+ 151 instFk: CARDINAL; (* formal cursor while binding during re-parse *)
|
|
|
152
|
|
|
- 153
|
|
|
- 154 PROCEDURE CopyNm (src: ARRAY OF CHAR; VAR dst: SymTab.Name);
|
|
|
- 155 VAR i: CARDINAL;
|
|
|
- 156 BEGIN
|
|
|
- 157 i := 0;
|
|
|
- 158 WHILE (i <= HIGH(dst)) AND (i <= HIGH(src)) AND (src[i] # CHR(0)) DO
|
|
|
- 159 dst[i] := src[i]; INC(i)
|
|
|
- 160 END;
|
|
|
- 161 IF i <= HIGH(dst) THEN dst[i] := CHR(0) END
|
|
|
- 162 END CopyNm;
|
|
|
- 163
|
|
|
- 164 PROCEDURE InInst () : BOOLEAN;
|
|
|
- 165 BEGIN RETURN instActive END InInst;
|
|
|
- 166
|
|
|
- 167 PROCEDURE InstNameGet (VAR nm: SymTab.Name);
|
|
|
- 168 BEGIN CopyNm(instName, nm) END InstNameGet;
|
|
|
- 169
|
|
|
- 170 PROCEDURE InstActualGet (i: CARDINAL) : SymTab.TypeIndex;
|
|
|
- 171 BEGIN
|
|
|
- 172 IF i >= instN THEN RETURN SymTab.InvalidType END;
|
|
|
- 173 RETURN instActual[i]
|
|
|
- 174 END InstActualGet;
|
|
|
- 175
|
|
|
- 176 PROCEDURE InstBegin (name: ARRAY OF CHAR);
|
|
|
- 177 BEGIN instActive := TRUE; CopyNm(name, instName); instN := 0;
|
|
|
- 178 instFk := 0 END InstBegin;
|
|
|
- 179
|
|
|
- 180 PROCEDURE InstAddActual (t: SymTab.TypeIndex);
|
|
|
- 181 BEGIN
|
|
|
- 182 IF instN <= HIGH(instActual) THEN instActual[instN] := t; INC(instN) END
|
|
|
- 183 END InstAddActual;
|
|
|
- 184
|
|
|
- 185 PROCEDURE InstEnd;
|
|
|
- 186 BEGIN instActive := FALSE; instN := 0 END InstEnd;
|
|
|
+ 153 (* Identity of the last-parsed unit and refinement, for the driver's
|
|
|
+ 154 generic registry and its re-parse decision. *)
|
|
|
+ 155 unitName: SymTab.Name;
|
|
|
+ 156 unitWasGen: BOOLEAN;
|
|
|
+ 157 unitWasDef: BOOLEAN;
|
|
|
+ 158 refSeen: BOOLEAN;
|
|
|
+ 159 refIsDef: BOOLEAN;
|
|
|
+ 160
|
|
|
+ 161
|
|
|
+ 162 PROCEDURE CopyNm (src: ARRAY OF CHAR; VAR dst: SymTab.Name);
|
|
|
+ 163 VAR i: CARDINAL;
|
|
|
+ 164 BEGIN
|
|
|
+ 165 i := 0;
|
|
|
+ 166 WHILE (i <= HIGH(dst)) AND (i <= HIGH(src)) AND (src[i] # CHR(0)) DO
|
|
|
+ 167 dst[i] := src[i]; INC(i)
|
|
|
+ 168 END;
|
|
|
+ 169 IF i <= HIGH(dst) THEN dst[i] := CHR(0) END
|
|
|
+ 170 END CopyNm;
|
|
|
+ 171
|
|
|
+ 172 PROCEDURE InInst () : BOOLEAN;
|
|
|
+ 173 BEGIN RETURN instActive END InInst;
|
|
|
+ 174
|
|
|
+ 175 PROCEDURE InstNameGet (VAR nm: SymTab.Name);
|
|
|
+ 176 BEGIN CopyNm(instName, nm) END InstNameGet;
|
|
|
+ 177
|
|
|
+ 178 PROCEDURE InstActualGet (i: CARDINAL) : SymTab.TypeIndex;
|
|
|
+ 179 BEGIN
|
|
|
+ 180 IF i >= instN THEN RETURN SymTab.InvalidType END;
|
|
|
+ 181 RETURN instActual[i]
|
|
|
+ 182 END InstActualGet;
|
|
|
+ 183
|
|
|
+ 184 PROCEDURE InstBegin (name: ARRAY OF CHAR);
|
|
|
+ 185 BEGIN instActive := TRUE; CopyNm(name, instName); instN := 0;
|
|
|
+ 186 instFk := 0 END InstBegin;
|
|
|
187
|
|
|
- 188 PROCEDURE UnitNameGet (VAR nm: SymTab.Name);
|
|
|
- 189 BEGIN CopyNm(unitName, nm) END UnitNameGet;
|
|
|
- 190
|
|
|
- 191 PROCEDURE UnitIsGeneric () : BOOLEAN;
|
|
|
- 192 BEGIN RETURN unitWasGen END UnitIsGeneric;
|
|
|
- 193
|
|
|
- 194 PROCEDURE UnitIsDefModule () : BOOLEAN;
|
|
|
- 195 BEGIN RETURN unitWasDef END UnitIsDefModule;
|
|
|
- 196
|
|
|
- 197 PROCEDURE RefineSeen () : BOOLEAN;
|
|
|
- 198 BEGIN RETURN refSeen END RefineSeen;
|
|
|
- 199
|
|
|
- 200 PROCEDURE RefineIsDef () : BOOLEAN;
|
|
|
- 201 BEGIN RETURN refIsDef END RefineIsDef;
|
|
|
- 202
|
|
|
- 203 PROCEDURE RefineInst (VAR nm: SymTab.Name);
|
|
|
- 204 BEGIN CopyNm(refInst, nm) END RefineInst;
|
|
|
- 205
|
|
|
- 206 PROCEDURE RefineGen (VAR nm: SymTab.Name);
|
|
|
- 207 BEGIN CopyNm(refGen, nm) END RefineGen;
|
|
|
- 208
|
|
|
- 209 PROCEDURE RefineActualCount () : CARDINAL;
|
|
|
- 210 BEGIN RETURN refN END RefineActualCount;
|
|
|
- 211
|
|
|
- 212 PROCEDURE RefineActualGet (i: CARDINAL) : SymTab.TypeIndex;
|
|
|
- 213 BEGIN
|
|
|
- 214 IF i >= refN THEN RETURN SymTab.InvalidType END;
|
|
|
- 215 RETURN refActual[i]
|
|
|
- 216 END RefineActualGet;
|
|
|
- 217
|
|
|
- 218 PROCEDURE NoteLabel (nm: ARRAY OF CHAR);
|
|
|
- 219 (* Record a statement label; duplicate is 200. *)
|
|
|
- 220 VAR i: CARDINAL;
|
|
|
+ 188 PROCEDURE InstAddActual (t: SymTab.TypeIndex);
|
|
|
+ 189 BEGIN
|
|
|
+ 190 IF instN <= HIGH(instActual) THEN instActual[instN] := t; INC(instN) END
|
|
|
+ 191 END InstAddActual;
|
|
|
+ 192
|
|
|
+ 193 PROCEDURE InstEnd;
|
|
|
+ 194 BEGIN instActive := FALSE; instN := 0 END InstEnd;
|
|
|
+ 195
|
|
|
+ 196 PROCEDURE UnitNameGet (VAR nm: SymTab.Name);
|
|
|
+ 197 BEGIN CopyNm(unitName, nm) END UnitNameGet;
|
|
|
+ 198
|
|
|
+ 199 PROCEDURE UnitIsGeneric () : BOOLEAN;
|
|
|
+ 200 BEGIN RETURN unitWasGen END UnitIsGeneric;
|
|
|
+ 201
|
|
|
+ 202 PROCEDURE UnitIsDefModule () : BOOLEAN;
|
|
|
+ 203 BEGIN RETURN unitWasDef END UnitIsDefModule;
|
|
|
+ 204
|
|
|
+ 205 PROCEDURE RefineSeen () : BOOLEAN;
|
|
|
+ 206 BEGIN RETURN refSeen END RefineSeen;
|
|
|
+ 207
|
|
|
+ 208 PROCEDURE RefineIsDef () : BOOLEAN;
|
|
|
+ 209 BEGIN RETURN refIsDef END RefineIsDef;
|
|
|
+ 210
|
|
|
+ 211 PROCEDURE RefineInst (VAR nm: SymTab.Name);
|
|
|
+ 212 BEGIN CopyNm(refInst, nm) END RefineInst;
|
|
|
+ 213
|
|
|
+ 214 PROCEDURE RefineGen (VAR nm: SymTab.Name);
|
|
|
+ 215 BEGIN CopyNm(refGen, nm) END RefineGen;
|
|
|
+ 216
|
|
|
+ 217 PROCEDURE RefineActualCount () : CARDINAL;
|
|
|
+ 218 BEGIN RETURN refN END RefineActualCount;
|
|
|
+ 219
|
|
|
+ 220 PROCEDURE RefineActualGet (i: CARDINAL) : SymTab.TypeIndex;
|
|
|
221 BEGIN
|
|
|
- 222 i := 0;
|
|
|
- 223 WHILE i < nLab DO
|
|
|
- 224 IF SymTab.Equal(labNm[i], nm) THEN SemError(200); RETURN END;
|
|
|
- 225 INC(i)
|
|
|
- 226 END;
|
|
|
- 227 IF nLab <= HIGH(labNm) THEN
|
|
|
- 228 CopyNm(nm, labNm[nLab]); INC(nLab)
|
|
|
- 229 END
|
|
|
- 230 END NoteLabel;
|
|
|
- 231
|
|
|
- 232 PROCEDURE NoteGoto (nm: ARRAY OF CHAR);
|
|
|
- 233 VAR i: CARDINAL;
|
|
|
- 234 BEGIN
|
|
|
- 235 i := 0;
|
|
|
- 236 WHILE i < nGot DO
|
|
|
- 237 IF SymTab.Equal(gotNm[i], nm) THEN RETURN END;
|
|
|
- 238 INC(i)
|
|
|
- 239 END;
|
|
|
- 240 IF nGot <= HIGH(gotNm) THEN
|
|
|
- 241 CopyNm(nm, gotNm[nGot]); INC(nGot)
|
|
|
- 242 END
|
|
|
- 243 END NoteGoto;
|
|
|
- 244
|
|
|
- 245 PROCEDURE CheckGotos;
|
|
|
- 246 (* At a procedure's END: every GOTO must name a label in that procedure. *)
|
|
|
- 247 VAR i, j: CARDINAL; found: BOOLEAN;
|
|
|
- 248 BEGIN
|
|
|
- 249 i := 0;
|
|
|
- 250 WHILE i < nGot DO
|
|
|
- 251 found := FALSE; j := 0;
|
|
|
- 252 WHILE (j < nLab) AND NOT found DO
|
|
|
- 253 IF SymTab.Equal(labNm[j], gotNm[i]) THEN found := TRUE END;
|
|
|
- 254 INC(j)
|
|
|
- 255 END;
|
|
|
- 256 IF NOT found THEN SemError(201) END;
|
|
|
- 257 INC(i)
|
|
|
- 258 END
|
|
|
- 259 END CheckGotos;
|
|
|
- 260
|
|
|
- 261 PROCEDURE FlushPend;
|
|
|
- 262 (* Emit module-level globals whose forward type is now resolved. *)
|
|
|
- 263 VAR k: CARDINAL;
|
|
|
- 264 BEGIN
|
|
|
- 265 k := 0;
|
|
|
- 266 WHILE k < nPendVar DO
|
|
|
- 267 INC(k)
|
|
|
- 268 END;
|
|
|
- 269 nPendVar := 0
|
|
|
- 270 END FlushPend;
|
|
|
- 271
|
|
|
- 272 PROCEDURE AstAppend (kind: INTEGER; VAR head, tail: AST.Node;
|
|
|
- 273 item: AST.Node);
|
|
|
- 274 (* Appends `item` to a chunked sequence: each node holds up to
|
|
|
- 275 AST.MaxChild-1 items; child[MaxChild-1] continues into the next
|
|
|
- 276 chunk. Unbounded, so blocks/decl sequences are not capped at 8. *)
|
|
|
- 277 VAR n: AST.Node;
|
|
|
- 278 BEGIN
|
|
|
- 279 IF item = AST.NoNode THEN RETURN END;
|
|
|
- 280 IF head = AST.NoNode THEN
|
|
|
- 281 head := AST.MakeNode(kind); tail := head
|
|
|
- 282 END;
|
|
|
- 283 IF AST.NChild(tail) >= AST.MaxChild - 1 THEN
|
|
|
- 284 n := AST.MakeNode(kind);
|
|
|
- 285 AST.SetChild(tail, AST.MaxChild - 1, n);
|
|
|
- 286 tail := n
|
|
|
- 287 END;
|
|
|
- 288 AST.SetChild(tail, AST.NChild(tail), item)
|
|
|
- 289 END AstAppend;
|
|
|
- 290
|
|
|
- 291 PROCEDURE AstCallNode (callee: AST.Node) : AST.Node;
|
|
|
- 292 (* Builds NkCall(callee, actuals...) from astArgs/astNArgs. The actuals
|
|
|
- 293 are a chunked sequence (AstAppend): a call can have more than
|
|
|
- 294 MaxChild-1 arguments (the generic ArgList has 9), and SetChild would
|
|
|
- 295 silently drop the tail. NkBlock marks the continuation chunks. *)
|
|
|
- 296 VAR n, tail: AST.Node; j: CARDINAL;
|
|
|
- 297 BEGIN
|
|
|
- 298 n := AST.MakeNode(AST.NkCall);
|
|
|
- 299 AST.SetChild(n, 0, callee);
|
|
|
- 300 tail := n;
|
|
|
- 301 j := 0;
|
|
|
- 302 WHILE j < astNArgs DO
|
|
|
- 303 AstAppend(AST.NkBlock, n, tail, astArgs[j]);
|
|
|
- 304 INC(j)
|
|
|
- 305 END;
|
|
|
- 306 RETURN n
|
|
|
- 307 END AstCallNode;
|
|
|
- 308
|
|
|
- 309
|
|
|
- 310
|
|
|
- 311 PROCEDURE GetUnit (): AST.Node;
|
|
|
- 312 (* The most recently parsed unit's AST root (for the Lower comparison). *)
|
|
|
- 313 BEGIN
|
|
|
- 314 RETURN astUnit
|
|
|
- 315 END GetUnit;
|
|
|
+ 222 IF i >= refN THEN RETURN SymTab.InvalidType END;
|
|
|
+ 223 RETURN refActual[i]
|
|
|
+ 224 END RefineActualGet;
|
|
|
+ 225
|
|
|
+ 226 PROCEDURE NoteLabel (nm: ARRAY OF CHAR);
|
|
|
+ 227 (* Record a statement label; duplicate is 200. *)
|
|
|
+ 228 VAR i: CARDINAL;
|
|
|
+ 229 BEGIN
|
|
|
+ 230 i := 0;
|
|
|
+ 231 WHILE i < nLab DO
|
|
|
+ 232 IF SymTab.Equal(labNm[i], nm) THEN SemError(200); RETURN END;
|
|
|
+ 233 INC(i)
|
|
|
+ 234 END;
|
|
|
+ 235 IF nLab <= HIGH(labNm) THEN
|
|
|
+ 236 CopyNm(nm, labNm[nLab]); INC(nLab)
|
|
|
+ 237 END
|
|
|
+ 238 END NoteLabel;
|
|
|
+ 239
|
|
|
+ 240 PROCEDURE NoteGoto (nm: ARRAY OF CHAR);
|
|
|
+ 241 VAR i: CARDINAL;
|
|
|
+ 242 BEGIN
|
|
|
+ 243 i := 0;
|
|
|
+ 244 WHILE i < nGot DO
|
|
|
+ 245 IF SymTab.Equal(gotNm[i], nm) THEN RETURN END;
|
|
|
+ 246 INC(i)
|
|
|
+ 247 END;
|
|
|
+ 248 IF nGot <= HIGH(gotNm) THEN
|
|
|
+ 249 CopyNm(nm, gotNm[nGot]); INC(nGot)
|
|
|
+ 250 END
|
|
|
+ 251 END NoteGoto;
|
|
|
+ 252
|
|
|
+ 253 PROCEDURE CheckGotos;
|
|
|
+ 254 (* At a procedure's END: every GOTO must name a label in that procedure. *)
|
|
|
+ 255 VAR i, j: CARDINAL; found: BOOLEAN;
|
|
|
+ 256 BEGIN
|
|
|
+ 257 i := 0;
|
|
|
+ 258 WHILE i < nGot DO
|
|
|
+ 259 found := FALSE; j := 0;
|
|
|
+ 260 WHILE (j < nLab) AND NOT found DO
|
|
|
+ 261 IF SymTab.Equal(labNm[j], gotNm[i]) THEN found := TRUE END;
|
|
|
+ 262 INC(j)
|
|
|
+ 263 END;
|
|
|
+ 264 IF NOT found THEN SemError(201) END;
|
|
|
+ 265 INC(i)
|
|
|
+ 266 END
|
|
|
+ 267 END CheckGotos;
|
|
|
+ 268
|
|
|
+ 269 PROCEDURE FlushPend;
|
|
|
+ 270 (* Emit module-level globals whose forward type is now resolved. *)
|
|
|
+ 271 VAR k: CARDINAL;
|
|
|
+ 272 BEGIN
|
|
|
+ 273 k := 0;
|
|
|
+ 274 WHILE k < nPendVar DO
|
|
|
+ 275 INC(k)
|
|
|
+ 276 END;
|
|
|
+ 277 nPendVar := 0
|
|
|
+ 278 END FlushPend;
|
|
|
+ 279
|
|
|
+ 280 PROCEDURE AstAppend (kind: INTEGER; VAR head, tail: AST.Node;
|
|
|
+ 281 item: AST.Node);
|
|
|
+ 282 (* Appends `item` to a chunked sequence: each node holds up to
|
|
|
+ 283 AST.MaxChild-1 items; child[MaxChild-1] continues into the next
|
|
|
+ 284 chunk. Unbounded, so blocks/decl sequences are not capped at 8. *)
|
|
|
+ 285 VAR n: AST.Node;
|
|
|
+ 286 BEGIN
|
|
|
+ 287 IF item = AST.NoNode THEN RETURN END;
|
|
|
+ 288 IF head = AST.NoNode THEN
|
|
|
+ 289 head := AST.MakeNode(kind); tail := head
|
|
|
+ 290 END;
|
|
|
+ 291 IF AST.NChild(tail) >= AST.MaxChild - 1 THEN
|
|
|
+ 292 n := AST.MakeNode(kind);
|
|
|
+ 293 AST.SetChild(tail, AST.MaxChild - 1, n);
|
|
|
+ 294 tail := n
|
|
|
+ 295 END;
|
|
|
+ 296 AST.SetChild(tail, AST.NChild(tail), item)
|
|
|
+ 297 END AstAppend;
|
|
|
+ 298
|
|
|
+ 299 PROCEDURE AstCallNode (callee: AST.Node) : AST.Node;
|
|
|
+ 300 (* Builds NkCall(callee, actuals...) from astArgs/astNArgs. The actuals
|
|
|
+ 301 are a chunked sequence (AstAppend): a call can have more than
|
|
|
+ 302 MaxChild-1 arguments (the generic ArgList has 9), and SetChild would
|
|
|
+ 303 silently drop the tail. NkBlock marks the continuation chunks. *)
|
|
|
+ 304 VAR n, tail: AST.Node; j: CARDINAL;
|
|
|
+ 305 BEGIN
|
|
|
+ 306 n := AST.MakeNode(AST.NkCall);
|
|
|
+ 307 AST.SetChild(n, 0, callee);
|
|
|
+ 308 tail := n;
|
|
|
+ 309 j := 0;
|
|
|
+ 310 WHILE j < astNArgs DO
|
|
|
+ 311 AstAppend(AST.NkBlock, n, tail, astArgs[j]);
|
|
|
+ 312 INC(j)
|
|
|
+ 313 END;
|
|
|
+ 314 RETURN n
|
|
|
+ 315 END AstCallNode;
|
|
|
316
|
|
|
- 317 PROCEDURE SetTwoPhase (b: BOOLEAN);
|
|
|
- 318 (* Driver switch for the two-phase parse probe (milestone 1). *)
|
|
|
- 319 BEGIN
|
|
|
- 320 twoPhaseParse := b
|
|
|
- 321 END SetTwoPhase;
|
|
|
- 322
|
|
|
- 323 PROCEDURE TokIs (kw: ARRAY OF CHAR): BOOLEAN;
|
|
|
- 324 (* The current lookahead token's source text equals kw. Compares text,
|
|
|
- 325 not token codes, so grammar renumbering cannot desync the skipper. *)
|
|
|
- 326 VAR tok: ARRAY [0 .. 63] OF CHAR;
|
|
|
+ 317
|
|
|
+ 318
|
|
|
+ 319 PROCEDURE GetUnit (): AST.Node;
|
|
|
+ 320 (* The most recently parsed unit's AST root (for the Lower comparison). *)
|
|
|
+ 321 BEGIN
|
|
|
+ 322 RETURN astUnit
|
|
|
+ 323 END GetUnit;
|
|
|
+ 324
|
|
|
+ 325 PROCEDURE SetTwoPhase (b: BOOLEAN);
|
|
|
+ 326 (* Driver switch for the two-phase parse probe (milestone 1). *)
|
|
|
327 BEGIN
|
|
|
- 328 M2S.GetName(M2S.nextPos, M2S.nextLen, tok);
|
|
|
- 329 RETURN SymTab.Equal(tok, kw)
|
|
|
- 330 END TokIs;
|
|
|
- 331
|
|
|
- 332 PROCEDURE Adv;
|
|
|
- 333 (* Advance one token: exactly the parser frame's Get for a grammar
|
|
|
- 334 without pragmas (its pragma branch is empty and the scanner never
|
|
|
- 335 returns a token above maxT, so the repeat loop runs once). A
|
|
|
- 336 separate name because the frame's Get is declared later in this
|
|
|
- 337 module: a bare Get here would bind the imported M2S.Get (which takes
|
|
|
- 338 a parameter) under single-pass compilers. *)
|
|
|
- 339 BEGIN
|
|
|
- 340 M2S.Get(sym);
|
|
|
- 341 INC(errDist)
|
|
|
- 342 END Adv;
|
|
|
- 343
|
|
|
- 344 PROCEDURE ProbeBody (pn: SymTab.Name);
|
|
|
- 345 (* Shadow-skip the body starting at the current token: consume tokens
|
|
|
- 346 counting block openers until the matching END, check the procedure
|
|
|
- 347 name after it, then restore the exact scanner/parser state. The
|
|
|
- 348 body then parses normally, so a correct skipper is output-neutral;
|
|
|
- 349 a wrong one reports to StdOut (never into the listing). *)
|
|
|
- 350 VAR savedSym, savedErr, depth, guard: CARDINAL;
|
|
|
- 351 nm: SymTab.Name;
|
|
|
- 352 ok: BOOLEAN;
|
|
|
- 353 BEGIN
|
|
|
- 354 savedSym := sym; savedErr := errDist;
|
|
|
- 355 M2S.PushPos;
|
|
|
- 356 depth := 0; guard := 0; ok := TRUE;
|
|
|
- 357 LOOP
|
|
|
- 358 IF sym = 0 THEN ok := FALSE; EXIT END;
|
|
|
- 359 IF TokIs("END") THEN
|
|
|
- 360 IF depth = 0 THEN EXIT END;
|
|
|
- 361 DEC(depth)
|
|
|
- 362 ELSIF TokIs("MODULE") OR TokIs("PROCEDURE") OR TokIs("CLASS")
|
|
|
- 363 OR TokIs("RECORD") OR TokIs("IF") OR TokIs("CASE")
|
|
|
- 364 OR TokIs("WHILE") OR TokIs("FOR") OR TokIs("LOOP")
|
|
|
- 365 OR TokIs("WITH") THEN
|
|
|
- 366 INC(depth)
|
|
|
- 367 END;
|
|
|
- 368 Adv;
|
|
|
- 369 INC(guard);
|
|
|
- 370 IF guard > 1000000 THEN ok := FALSE; EXIT END
|
|
|
- 371 END;
|
|
|
- 372 IF ok THEN
|
|
|
- 373 Adv;
|
|
|
- 374 M2S.GetName(M2S.nextPos, M2S.nextLen, nm);
|
|
|
- 375 IF (sym = 0) OR NOT SymTab.Equal(nm, pn) THEN ok := FALSE END
|
|
|
- 376 END;
|
|
|
- 377 M2S.PopPos;
|
|
|
- 378 sym := savedSym; errDist := savedErr;
|
|
|
- 379 IF NOT ok THEN
|
|
|
- 380 FileIO.WriteString(FileIO.StdOut, "twophase probe mismatch in ");
|
|
|
- 381 FileIO.WriteString(FileIO.StdOut, pn);
|
|
|
- 382 FileIO.WriteLn(FileIO.StdOut)
|
|
|
- 383 END
|
|
|
- 384 END ProbeBody;
|
|
|
- 385
|
|
|
- 386 CHARACTERS
|
|
|
- 387 eol = CHR(13) .
|
|
|
- 388 lf = CHR(10) .
|
|
|
- 389 letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" .
|
|
|
- 390 digit = "0123456789" .
|
|
|
- 391 hexDigit = digit + "ABCDEFabcdef" .
|
|
|
- 392 noQuote1 = ANY - "'" - eol .
|
|
|
- 393 noQuote2 = ANY - '"' - eol .
|
|
|
- 394
|
|
|
- 395 IGNORE CHR(9) .. CHR(13)
|
|
|
- 396
|
|
|
- 397 COMMENTS FROM "(*" TO "*)" NESTED
|
|
|
- 398 COMMENTS FROM "//" TO lf
|
|
|
- 399
|
|
|
- 400 TOKENS
|
|
|
- 401 ident = letter { letter | digit | "_" } .
|
|
|
- 402 integer = digit { digit }
|
|
|
- 403 | digit { digit } CONTEXT("..")
|
|
|
- 404 | "0x" hexDigit { hexDigit }
|
|
|
- 405 | "0X" hexDigit { hexDigit } .
|
|
|
- 406 real = digit { digit } "." { digit }
|
|
|
- 407 [ ( "E" | "e" ) [ "+" | "-" ] digit { digit } ] .
|
|
|
- 408 string = "'" { noQuote1 } "'"
|
|
|
- 409 | '"' { noQuote2 } '"' .
|
|
|
- 410 charConst = digit { digit } ( "C" | "c" ) .
|
|
|
- 411 ustring = ( "U" | "u" ) ( "'" { noQuote1 } "'" | '"' { noQuote2 } '"' ) .
|
|
|
- 412
|
|
|
- 413 PRODUCTIONS
|
|
|
- 414 M2
|
|
|
- 415 = (. twoPhase := TRUE; astCur := AST.NoNode; astStmt := AST.NoNode; astDecl := AST.NoNode; astImp := AST.NoNode; astImpTail := AST.NoNode;
|
|
|
- 416 astImp := AST.NoNode;
|
|
|
- 417 astImpTail := AST.NoNode;
|
|
|
- 418 procNest := 0; .)
|
|
|
- 419 Unit "." .
|
|
|
- 420 (* Units: program modules compile fully; DEFINITION and
|
|
|
- 421 IMPLEMENTATION modules parse + check now but lower in step 4
|
|
|
- 422 (each ends with one 230); same for nested local modules. *)
|
|
|
- 423 (* Generics (Increment 1): formal and actual parameters. Formals are
|
|
|
- 424 TYPE parameters only; actuals are type identifiers. *)
|
|
|
- 425 GenericFormals
|
|
|
- 426 = "(" GenericFormal { ";" GenericFormal } ")" .
|
|
|
- 427 GenericFormal (. VAR nm: SymTab.Name; .)
|
|
|
- 428 = GetIdent<nm> (. IF instActive THEN
|
|
|
- 429 IF NOT SymTab.EnterTypeParamBound(nm,
|
|
|
- 430 InstActualGet(instFk)) THEN
|
|
|
- 431 SemError(200) END
|
|
|
- 432 ELSIF NOT SymTab.EnterTypeParam(nm) THEN
|
|
|
- 433 SemError(200) END;
|
|
|
- 434 INC(instFk); .)
|
|
|
- 435 { "," GetIdent<nm> (. IF instActive THEN
|
|
|
- 436 IF NOT SymTab.EnterTypeParamBound(nm,
|
|
|
- 437 InstActualGet(instFk)) THEN
|
|
|
- 438 SemError(200) END
|
|
|
- 439 ELSIF NOT SymTab.EnterTypeParam(nm) THEN
|
|
|
- 440 SemError(200) END;
|
|
|
- 441 INC(instFk); .) }
|
|
|
- 442 ":" "TYPE" .
|
|
|
- 443 Actuals
|
|
|
- 444 = Actual { "," Actual } .
|
|
|
- 445 Actual (. VAR at: SymTab.TypeIndex; .)
|
|
|
- 446 = TypeIdent<at> (. IF refN <= HIGH(refActual) THEN
|
|
|
- 447 refActual[refN] := at; INC(refN)
|
|
|
- 448 END; .) .
|
|
|
- 449 Unit
|
|
|
- 450 = (. isGen := FALSE; .)
|
|
|
- 451 [ "GENERIC" (. isGen := TRUE; .) ]
|
|
|
- 452 ( DefUnit | ImplUnit | ProgModule ) .
|
|
|
- 453 (* Step 4.3: one session compiles DEFINITION, its IMPLEMENTATION
|
|
|
- 454 and one program (last) into one image. Units share the symbol
|
|
|
- 455 table; imports materialize exported names. *)
|
|
|
- 456 DefUnit (. VAR m1, m2, pn: SymTab.Name;
|
|
|
- 457 g: SymTab.Name;
|
|
|
- 458 astSeq, astTail, astProc: AST.Node; .)
|
|
|
- 459 = (. refN := 0; refSeen := FALSE; .)
|
|
|
- 460 "DEFINITION" "MODULE"
|
|
|
- 461 GetIdent<m1> (. IF instActive THEN InstNameGet(m1) END;
|
|
|
- 462 IF instActive THEN
|
|
|
- 463 IF NOT SymTab.Reenter(m1,
|
|
|
- 464 SymTab.UnitDef) THEN
|
|
|
- 465 SemError(200) END
|
|
|
- 466 ELSIF NOT SymTab.BeginDef(m1) THEN
|
|
|
- 467 SemError(200) END;
|
|
|
- 468 QbeGen.SetModule(m1);
|
|
|
- 469 CopyNm(m1, unitName);
|
|
|
- 470 unitWasGen := isGen
|
|
|
- 471 AND NOT instActive;
|
|
|
- 472 unitWasDef := TRUE; .)
|
|
|
- 473 [ GenericFormals ]
|
|
|
- 474 ( ";"
|
|
|
- 475 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
- 476 astImp, astImpTail, astDecl); .) }
|
|
|
- 477 [ "EXPORT" [ "QUALIFIED" ] (. (* definition-module export
|
|
|
- 478 list: parsed, and the
|
|
|
- 479 names are already exported
|
|
|
- 480 by the module scope *) .)
|
|
|
- 481 GetIdent<pn> { "," GetIdent<pn> } ";" ]
|
|
|
- 482 (. astSeq := AST.NoNode;
|
|
|
- 483 astTail := AST.NoNode; .)
|
|
|
- 484 { ConstBlock (. AstAppend(AST.NkDeclSeq,
|
|
|
- 485 astSeq, astTail, astDecl); .)
|
|
|
- 486 | TypeBlock<TRUE> (. AstAppend(AST.NkDeclSeq,
|
|
|
- 487 astSeq, astTail, astDecl); .)
|
|
|
- 488 | VarBlock (. AstAppend(AST.NkDeclSeq,
|
|
|
- 489 astSeq, astTail, astDecl); .)
|
|
|
- 490 | ProcHeading<pn, SymTab.InvalidType> ";"
|
|
|
- 491 (. (* a heading only: record it so
|
|
|
- 492 Lower can replay it *)
|
|
|
- 493 astProc := AST.MakeNode(AST.NkProcDecl);
|
|
|
- 494 AST.SetOp(astProc, 0);
|
|
|
- 495 AST.SetChild(astProc, 0,
|
|
|
- 496 AST.MakeLeaf(AST.NkIdent, pn));
|
|
|
- 497 AstAppend(AST.NkDeclSeq,
|
|
|
- 498 astSeq, astTail, astProc);
|
|
|
- 499 Lower.NoteProcNode(astProc);
|
|
|
- 500 Lower.ScopeLeave;
|
|
|
- 501 SymTab.CloseProc;
|
|
|
- 502 QbeGen.AbortFunc; .) }
|
|
|
- 503 (. astUnit := AST.MakeNode(AST.NkUnit);
|
|
|
- 504 AST.SetChild(astUnit, 0,
|
|
|
- 505 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
- 506 AST.SetChild(astUnit, 1, astSeq);
|
|
|
- 507 AST.SetChild(astUnit, 3, astImp);
|
|
|
- 508 astDecl := AST.NoNode;
|
|
|
- 509 astStmt := AST.NoNode; .)
|
|
|
- 510 "END"
|
|
|
- 511 GetIdent<m2> (. IF instActive THEN InstNameGet(m2) END;
|
|
|
- 512 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
- 513 SemError(202) END;
|
|
|
- 514 SymTab.EndUnit; .)
|
|
|
- 515 | "=" GetIdent<g> [ "(" Actuals ")" ] ";"
|
|
|
- 516 (. CopyNm(m1, refInst);
|
|
|
- 517 CopyNm(g, refGen);
|
|
|
- 518 refSeen := TRUE; refIsDef := TRUE;
|
|
|
- 519 astUnit := AST.MakeNode(AST.NkUnit);
|
|
|
- 520 AST.SetChild(astUnit, 0,
|
|
|
- 521 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
- 522 astDecl := AST.NoNode;
|
|
|
- 523 astStmt := AST.NoNode; .)
|
|
|
- 524 "END"
|
|
|
- 525 GetIdent<m2> (. IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
- 526 SemError(202) END;
|
|
|
- 527 SymTab.EndUnit; .) ) .
|
|
|
- 528 ImplUnit (. VAR m1, m2: SymTab.Name;
|
|
|
- 529 g: SymTab.Name;
|
|
|
- 530 k: CARDINAL;
|
|
|
- 531 fname: SymTab.Name;
|
|
|
- 532 unres: BOOLEAN;
|
|
|
- 533 astNode: AST.Node; .)
|
|
|
- 534 = (. refN := 0; refSeen := FALSE; .)
|
|
|
- 535 "IMPLEMENTATION" "MODULE"
|
|
|
- 536 GetIdent<m1> (. IF instActive THEN InstNameGet(m1) END;
|
|
|
- 537 IF instActive THEN
|
|
|
- 538 IF NOT SymTab.Reenter(m1,
|
|
|
- 539 SymTab.UnitImpl) THEN
|
|
|
- 540 SemError(201) END
|
|
|
- 541 ELSIF NOT SymTab.BeginImpl(m1) THEN
|
|
|
- 542 SemError(201) END;
|
|
|
- 543 astStmt := AST.NoNode;
|
|
|
- 544 astDecl := AST.NoNode;
|
|
|
- 545 astImp := AST.NoNode;
|
|
|
- 546 astImpTail := AST.NoNode;
|
|
|
- 547 nPendVar := 0;
|
|
|
- 548 CopyNm(m1, unitName);
|
|
|
- 549 unitWasGen := isGen AND NOT instActive;
|
|
|
- 550 unitWasDef := FALSE;
|
|
|
- 551 QbeGen.SetModule(m1); .)
|
|
|
- 552 [ GenericFormals ]
|
|
|
- 553 ( ";"
|
|
|
- 554 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
- 555 astImp, astImpTail, astDecl); .) }
|
|
|
- 556 DeclSeq (. astStmt := AST.NoNode; .)
|
|
|
- 557 [ "BEGIN" (. FlushPend;
|
|
|
- 558 k := 0;
|
|
|
- 559 WHILE k < SymTab.FwdPending() DO
|
|
|
- 560 SymTab.FwdInfo(k, fname, unres);
|
|
|
- 561 IF unres THEN SemError(201) END;
|
|
|
- 562 INC(k)
|
|
|
- 563 END;
|
|
|
- 564 SymTab.FwdClear;
|
|
|
- 565
|
|
|
- 566 nLab := 0; nGot := 0; .)
|
|
|
- 567 [ StatSeq ] ]
|
|
|
- 568 "END"
|
|
|
- 569 GetIdent<m2> (. IF instActive THEN InstNameGet(m2) END;
|
|
|
- 570 FlushPend;
|
|
|
- 571 k := 0;
|
|
|
- 572 WHILE k < SymTab.FwdPending() DO
|
|
|
- 573 SymTab.FwdInfo(k, fname, unres);
|
|
|
- 574 IF unres THEN SemError(201) END;
|
|
|
- 575 INC(k)
|
|
|
- 576 END;
|
|
|
- 577 SymTab.FwdClear;
|
|
|
- 578
|
|
|
- 579 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
- 580 AST.SetChild(astNode, 0,
|
|
|
- 581 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
- 582 AST.SetChild(astNode, 1, astDecl);
|
|
|
- 583 AST.SetChild(astNode, 2, astStmt);
|
|
|
- 584 AST.SetChild(astNode, 3, astImp);
|
|
|
- 585 astUnit := astNode;
|
|
|
- 586 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
- 587 SemError(202) END;
|
|
|
- 588 CheckGotos;
|
|
|
- 589 SymTab.EndUnit; .)
|
|
|
- 590 | "=" GetIdent<g> [ "(" Actuals ")" ] ";"
|
|
|
- 591 (. CopyNm(m1, refInst);
|
|
|
- 592 CopyNm(g, refGen);
|
|
|
- 593 refSeen := TRUE; refIsDef := FALSE;
|
|
|
- 594 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
- 595 AST.SetChild(astNode, 0,
|
|
|
- 596 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
- 597 astDecl := AST.NoNode;
|
|
|
- 598 astStmt := AST.NoNode; .)
|
|
|
- 599 "END"
|
|
|
- 600 GetIdent<m2> (. IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
- 601 SemError(202) END;
|
|
|
- 602 SymTab.EndUnit; .) ) .
|
|
|
- 603 ProgModule (. VAR m1, m2: SymTab.Name;
|
|
|
- 604 k: CARDINAL;
|
|
|
- 605 fname: SymTab.Name;
|
|
|
- 606 unres: BOOLEAN;
|
|
|
- 607 astNode: AST.Node; .)
|
|
|
- 608 = "MODULE"
|
|
|
- 609 GetIdent<m1> (. IF NOT SymTab.BeginProg(m1) THEN
|
|
|
- 610 SemError(200) END;
|
|
|
- 611 astStmt := AST.NoNode;
|
|
|
- 612 astDecl := AST.NoNode;
|
|
|
- 613 astImp := AST.NoNode;
|
|
|
- 614 astImpTail := AST.NoNode;
|
|
|
- 615 nPendVar := 0;
|
|
|
- 616 QbeGen.SetModule(m1); .)
|
|
|
- 617 [ Priority ]
|
|
|
- 618 ";"
|
|
|
- 619 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
- 620 astImp, astImpTail, astDecl); .) }
|
|
|
- 621 DeclSeq (. astStmt := AST.NoNode; .)
|
|
|
- 622 [ "BEGIN" (. FlushPend;
|
|
|
- 623 k := 0;
|
|
|
- 624 WHILE k < SymTab.FwdPending() DO
|
|
|
- 625 SymTab.FwdInfo(k, fname, unres);
|
|
|
- 626 IF unres THEN SemError(201) END;
|
|
|
- 627 INC(k)
|
|
|
- 628 END;
|
|
|
- 629 SymTab.FwdClear;
|
|
|
- 630
|
|
|
- 631 nLab := 0; nGot := 0; .)
|
|
|
- 632 [ StatSeq ] ]
|
|
|
- 633 "END"
|
|
|
- 634 GetIdent<m2> (. IF instActive THEN InstNameGet(m2) END;
|
|
|
- 635 FlushPend;
|
|
|
- 636 k := 0;
|
|
|
- 637 WHILE k < SymTab.FwdPending() DO
|
|
|
- 638 SymTab.FwdInfo(k, fname, unres);
|
|
|
- 639 IF unres THEN SemError(201) END;
|
|
|
- 640 INC(k)
|
|
|
- 641 END;
|
|
|
- 642 SymTab.FwdClear;
|
|
|
- 643
|
|
|
- 644 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
- 645 SemError(202) END;
|
|
|
- 646 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
- 647 AST.SetChild(astNode, 0,
|
|
|
- 648 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
- 649 AST.SetChild(astNode, 1, astDecl);
|
|
|
- 650 AST.SetChild(astNode, 2, astStmt);
|
|
|
- 651 AST.SetChild(astNode, 3, astImp);
|
|
|
- 652 astUnit := astNode;
|
|
|
- 653 CheckGotos;
|
|
|
- 654 SymTab.EndUnit; .) .
|
|
|
- 655 DeclSeq (. VAR astSeq, astTail: AST.Node; .)
|
|
|
- 656 = (. astSeq := AST.NoNode;
|
|
|
- 657 astTail := AST.NoNode; .)
|
|
|
- 658 { (. astDecl := AST.NoNode; .)
|
|
|
- 659 ( ConstBlock | TypeBlock<FALSE> | VarBlock | ProcDecl ";"
|
|
|
- 660 | NestedModule ";" | ClassItem ";" )
|
|
|
- 661 (. AstAppend(AST.NkDeclSeq,
|
|
|
- 662 astSeq, astTail, astDecl); .) }
|
|
|
- 663 (. astDecl := astSeq; .) .
|
|
|
- 664 (* Local module, Wirth form. Declarations lower like top-level ones
|
|
|
- 665 (same QBE module prefix); a BEGIN body becomes an init function
|
|
|
- 666 that main calls; the EXPORT list is hoisted into the enclosing
|
|
|
- 667 scope at END. *)
|
|
|
- 668 NestedModule (. VAR m1, m2: SymTab.Name;
|
|
|
- 669 expNames: ARRAY [0 .. 63] OF SymTab.Name;
|
|
|
- 670 expCount, k: CARDINAL;
|
|
|
- 671 astNode, nImp, nImpTail:
|
|
|
- 672 AST.Node; .)
|
|
|
- 673 = "MODULE"
|
|
|
- 674 GetIdent<m1> (. IF NOT SymTab.Enter(m1,
|
|
|
- 675 SymTab.KindModule) THEN
|
|
|
- 676 SemError(200) END;
|
|
|
- 677 SymTab.PushScope;
|
|
|
- 678 expCount := 0;
|
|
|
- 679 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
- 680 AST.SetChild(astNode, 0,
|
|
|
- 681 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
- 682 astStmt := AST.NoNode;
|
|
|
- 683 astDecl := AST.NoNode;
|
|
|
- 684 nImp := AST.NoNode;
|
|
|
- 685 nImpTail := AST.NoNode; .)
|
|
|
- 686 [ Priority ]
|
|
|
- 687 ";"
|
|
|
- 688 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
- 689 nImp, nImpTail, astDecl); .) }
|
|
|
- 690 [ "EXPORT" [ "QUALIFIED" ]
|
|
|
- 691 GetIdent<expNames[expCount]> (. INC(expCount); .)
|
|
|
- 692 { "," GetIdent<expNames[expCount]>
|
|
|
- 693 (. INC(expCount); .) }
|
|
|
- 694 ";" ]
|
|
|
- 695 DeclSeq (. astStmt := AST.NoNode; .)
|
|
|
- 696 [ "BEGIN" (. astStmt := AST.NoNode;
|
|
|
- 697 .)
|
|
|
- 698 [ StatSeq ] ]
|
|
|
- 699 "END"
|
|
|
- 700 GetIdent<m2> (. AST.SetChild(astNode, 1, astDecl);
|
|
|
- 701 AST.SetChild(astNode, 2, astStmt);
|
|
|
- 702 AST.SetChild(astNode, 3, nImp);
|
|
|
- 703 astDecl := astNode;
|
|
|
- 704 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
- 705 SemError(202) END;
|
|
|
- 706 k := 0;
|
|
|
- 707 WHILE k < expCount DO
|
|
|
- 708 SymTab.ExportUp(expNames[k]);
|
|
|
- 709 INC(k)
|
|
|
- 710 END;
|
|
|
- 711 SymTab.PopScope; .) .
|
|
|
- 712 Priority
|
|
|
- 713 = "[" integer "]" (. SemError(230); .) .
|
|
|
- 714 (* Imports (4.3): FROM materializes the names (unqualified use);
|
|
|
- 715 plain IMPORT only demands the module exists — qualified `L.x`
|
|
|
- 716 materializes on first use (Design). *)
|
|
|
- 717 (* Unknown modules stay unchecked stubs (legacy, so hand-written
|
|
|
- 718 import lines don't fail); a known module's missing export is
|
|
|
- 719 201. *)
|
|
|
- 720 Import (. VAR n: SymTab.Name;
|
|
|
- 721 astImport: AST.Node; .)
|
|
|
- 722 = "FROM"
|
|
|
- 723 GetIdent<n> (. astImport := AST.MakeNode(AST.NkImport);
|
|
|
- 724 AST.SetChild(astImport, 0,
|
|
|
- 725 AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
- 726 "IMPORT"
|
|
|
- 727 ImpList<n, astImport> ";" (. astDecl := astImport; .)
|
|
|
- 728 | "IMPORT" (. astImport := AST.MakeNode(AST.NkImport); .)
|
|
|
- 729 ImpModList<astImport> ";" (. astDecl := astImport; .) .
|
|
|
- 730 ImpList<mod: SymTab.Name; node: AST.Node>
|
|
|
- 731 (. VAR n: SymTab.Name; .)
|
|
|
- 732 = ImpName<mod, node>
|
|
|
- 733 { "," ImpName<mod, node> } .
|
|
|
- 734 (* Pervasive built-ins imported from SYSTEM (e.g. TSIZE) are
|
|
|
- 735 accepted and ignored: the built-in applies regardless. *)
|
|
|
- 736 ImpName<mod: SymTab.Name; node: AST.Node>
|
|
|
- 737 (. VAR n: SymTab.Name; .)
|
|
|
- 738 = GetIdent<n> (. AST.SetChild(node, AST.NChild(node),
|
|
|
- 739 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
- 740 IF SymTab.Equal(mod, "libc") THEN
|
|
|
- 741 (* intrinsic C library:
|
|
|
- 742 permissive external *)
|
|
|
- 743 IF NOT SymTab.DeclareCProc(n) THEN
|
|
|
- 744 SemError(201) END;
|
|
|
- 745 Lower.NoteCProc(n)
|
|
|
- 746 ELSIF SymTab.ModKnown(mod) THEN
|
|
|
- 747 IF NOT SymTab.ImportFrom(mod, n) THEN
|
|
|
- 748 SemError(201)
|
|
|
- 749 ELSE Lower.NoteImportedProc(n)
|
|
|
- 750 END
|
|
|
- 751 END; .)
|
|
|
- 752 | ( "TSIZE" | "SIZE" | "ADR" | "HIGH" | "LEN"
|
|
|
- 753 | "CHR" | "ORD" | "ORDL" | "VAL" | "ABS" | "CAP"
|
|
|
- 754 | "UCHR" | "CHR8" | "UORD"
|
|
|
- 755 | "INC" | "DEC" ) .
|
|
|
- 756 ImpModList<node: AST.Node> (. VAR n: SymTab.Name; .)
|
|
|
- 757 = GetIdent<n> (. AST.SetChild(node, AST.NChild(node),
|
|
|
- 758 AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
- 759 { "," GetIdent<n> (. AST.SetChild(node, AST.NChild(node),
|
|
|
- 760 AST.MakeLeaf(AST.NkIdent, n)); .) } .
|
|
|
- 761 (* Opaque TYPE declarations (definition modules). The targetless
|
|
|
- 762 alias resolves to InvalidType until step 4 completes it. *)
|
|
|
- 763 (* Scalar-phase TYPEs: named types, integer subranges, enumerations.
|
|
|
- 764 Opaque "TYPE T;" needs isDef (definition units); elsewhere 231.
|
|
|
- 765 Composite forms (ARRAY/RECORD/SET/POINTER) arrive with step 3. *)
|
|
|
- 766 TypeBlock<isDef: BOOLEAN> (. VAR astSeq, astTail: AST.Node; .)
|
|
|
- 767 = "TYPE" (. SymTab.BeginTypeBlock;
|
|
|
- 768 astSeq := AST.NoNode;
|
|
|
- 769 astTail := AST.NoNode; .)
|
|
|
- 770 { (. astDecl := AST.NoNode; .)
|
|
|
- 771 ( TypeItem<isDef> ";" | ClassItem ";" )
|
|
|
- 772 (. AstAppend(AST.NkDeclSeq,
|
|
|
- 773 astSeq, astTail, astDecl); .) }
|
|
|
- 774 (. SymTab.EndTypeBlock;
|
|
|
- 775 astDecl := astSeq; .) .
|
|
|
- 776 TypeItem<isDef: BOOLEAN> (. VAR n: SymTab.Name;
|
|
|
- 777 t, op: SymTab.TypeIndex;
|
|
|
- 778 astNode: AST.Node; .)
|
|
|
- 779 = GetIdent<n> (. op := SymTab.OpaqueBase(n);
|
|
|
- 780 IF op = SymTab.InvalidType THEN
|
|
|
- 781 IF NOT SymTab.Enter(n,
|
|
|
- 782 SymTab.KindType) THEN
|
|
|
- 783 SemError(200) END
|
|
|
- 784 END; .)
|
|
|
- 785 ( "=" Type<t, FALSE> (. astNode := AST.MakeNode(AST.NkTypeDecl);
|
|
|
- 786 AST.SetChild(astNode, 0,
|
|
|
- 787 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
- 788 AST.SetTy(astNode, t);
|
|
|
- 789 astDecl := astNode;
|
|
|
- 790 IF op # SymTab.InvalidType THEN
|
|
|
- 791 SymTab.SetTarget(op, t)
|
|
|
- 792 ELSE SymTab.SetSymType(n, t)
|
|
|
- 793 END; .)
|
|
|
- 794 | (. IF op # SymTab.InvalidType THEN
|
|
|
- 795 (* stays opaque *)
|
|
|
- 796 ELSIF NOT isDef THEN
|
|
|
- 797 SemError(231)
|
|
|
- 798 ELSE SymTab.SetSymType(n,
|
|
|
- 799 SymTab.NewAlias()) END; .) ) .
|
|
|
- 800 Type<VAR t: SymTab.TypeIndex; allowOpen: BOOLEAN>
|
|
|
- 801 = TypeIdent<t> [ Subrange<t> ] (* anchored subrange: T[lo..hi] *)
|
|
|
- 802 | Subrange<t>
|
|
|
- 803 | Enum<t>
|
|
|
- 804 | ArrayType<t, allowOpen>
|
|
|
- 805 | SetType<t>
|
|
|
- 806 | RecordType<t>
|
|
|
- 807 | PointerType<t>
|
|
|
- 808 | ProcType<t> .
|
|
|
- 809 PointerType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex; .)
|
|
|
- 810 = "POINTER" "TO" Type<base, FALSE>(. t := SymTab.NewPtr(base); .) .
|
|
|
- 811 (* Procedure types (step 8.5): PROCEDURE (params): result. Values
|
|
|
- 812 are code pointers; params are collected into the descriptor. *)
|
|
|
- 813 ProcType<VAR t: SymTab.TypeIndex> (. VAR res, pt: SymTab.TypeIndex;
|
|
|
- 814 isV: BOOLEAN; .)
|
|
|
- 815 = "PROCEDURE" (. res := SymTab.InvalidType;
|
|
|
- 816 t := SymTab.NewProcType(res); .)
|
|
|
- 817 [ "(" [ ProcTypeSection<t> { ";" ProcTypeSection<t> } ] ")" ]
|
|
|
- 818 [ ":" TypeIdent<res> (. SymTab.SetProcTypeRes(t, res); .) ] .
|
|
|
- 819 ProcTypeSection<t: SymTab.TypeIndex> (. VAR pt: SymTab.TypeIndex;
|
|
|
- 820 isV: BOOLEAN;
|
|
|
- 821 cnt, k: CARDINAL;
|
|
|
- 822 names: ARRAY [0 .. 15] OF SymTab.Name; .)
|
|
|
- 823 = (. isV := FALSE; cnt := 0; .)
|
|
|
- 824 [ "VAR" (. isV := TRUE; .) ]
|
|
|
- 825 ( GetIdent<names[cnt]> (. INC(cnt); .)
|
|
|
- 826 { "," GetIdent<names[cnt]> (. INC(cnt); .) }
|
|
|
- 827 ( ":" Type<pt, TRUE> (. k := 0;
|
|
|
- 828 WHILE k < cnt DO
|
|
|
- 829 SymTab.ProcTypeAdd(t, isV, pt);
|
|
|
- 830 INC(k)
|
|
|
- 831 END; .)
|
|
|
- 832 | (. (* type-only parameter list:
|
|
|
- 833 each name is a type (GNU
|
|
|
- 834 shorthand used by the
|
|
|
- 835 Coco/R scanner frame) *)
|
|
|
- 836 k := 0;
|
|
|
- 837 WHILE k < cnt DO
|
|
|
- 838 IF SymTab.Lookup(names[k])
|
|
|
- 839 AND ((SymTab.SymKind(names[k]) = SymTab.KindType)
|
|
|
- 840 OR (SymTab.SymKind(names[k]) = SymTab.KindPredef)) THEN
|
|
|
- 841 pt := SymTab.SymType(names[k])
|
|
|
- 842 ELSE SemError(201);
|
|
|
- 843 pt := SymTab.InvalidType
|
|
|
- 844 END;
|
|
|
- 845 SymTab.ProcTypeAdd(t, isV, pt);
|
|
|
- 846 INC(k)
|
|
|
- 847 END; .) )
|
|
|
- 848 | Type<pt, TRUE> (. (* unnamed parameter (PIM):
|
|
|
- 849 e.g. PROCEDURE (VAR ARRAY OF REAL) *)
|
|
|
- 850 SymTab.ProcTypeAdd(t, isV, pt); .) ) .
|
|
|
- 851 (* Arrays: "OF" without bounds is an open formal (allowed only
|
|
|
- 852 where allowOpen); "[lo..hi, ...]" nests bounded levels inside
|
|
|
- 853 out. Bounds are folded literals (int/char); anything else 230.
|
|
|
- 854 Bare-type indices ("ARRAY Color OF") wait for enum ordinals. *)
|
|
|
- 855 ArrayType<VAR t: SymTab.TypeIndex; allowOpen: BOOLEAN>
|
|
|
- 856 (. VAR elem: SymTab.TypeIndex;
|
|
|
- 857 ok: BOOLEAN;
|
|
|
- 858 bnds, bndh: ARRAY [0 .. 7] OF INTEGER;
|
|
|
- 859 nb, k: CARDINAL;
|
|
|
- 860 idx: SymTab.TypeIndex;
|
|
|
- 861 ilo, ihi: INTEGER; .)
|
|
|
- 862 = "ARRAY"
|
|
|
- 863 ( "OF" Type<elem, FALSE> (. IF NOT allowOpen THEN
|
|
|
- 864 SemError(230) END;
|
|
|
- 865 t := SymTab.NewOpenArray(elem); .)
|
|
|
- 866 | TypeIdent<idx> [ Subrange<idx> ]
|
|
|
- 867 "OF" Type<elem, FALSE> (. (* index-type array: the index
|
|
|
- 868 type's ordinal bounds give the
|
|
|
- 869 [lo..hi] pair *)
|
|
|
- 870 IF SymTab.TypeBounds(idx, ilo,
|
|
|
- 871 ihi)
|
|
|
- 872 THEN t := SymTab.NewArrayB(elem,
|
|
|
- 873 ilo, ihi)
|
|
|
- 874 ELSE SemError(230);
|
|
|
- 875 t := SymTab.InvalidType
|
|
|
- 876 END; .)
|
|
|
- 877 | "[" (. SymTab.BoundBegin; ok := TRUE; .)
|
|
|
- 878 BoundPair<ok>
|
|
|
- 879 { "," BoundPair<ok> }
|
|
|
- 880 "]" (. (* snapshot before the element
|
|
|
- 881 type, which reuses the bound
|
|
|
- 882 buffer for a nested ARRAY *)
|
|
|
- 883 nb := SymTab.BoundCount();
|
|
|
- 884 k := 0;
|
|
|
- 885 WHILE k < nb DO
|
|
|
- 886 bnds[k] := SymTab.BoundLo(k);
|
|
|
- 887 bndh[k] := SymTab.BoundHi(k);
|
|
|
- 888 INC(k)
|
|
|
- 889 END; .)
|
|
|
- 890 "OF" Type<elem, FALSE>
|
|
|
- 891 (. IF ok THEN
|
|
|
- 892 k := nb;
|
|
|
- 893 WHILE k > 0 DO
|
|
|
- 894 DEC(k);
|
|
|
- 895 elem := SymTab.NewArrayB(
|
|
|
- 896 elem, bnds[k], bndh[k])
|
|
|
- 897 END;
|
|
|
- 898 t := elem
|
|
|
- 899 ELSE t := SymTab.InvalidType
|
|
|
- 900 END; .) ) .
|
|
|
- 901 BoundPair<VAR ok: BOOLEAN> (. VAR tlo, thi: SymTab.TypeIndex;
|
|
|
- 902 qlo, qhi: QbeGen.QVal;
|
|
|
- 903 lo, hi: INTEGER;
|
|
|
- 904 cl, cl2: INTEGER; .)
|
|
|
- 905 = Expr<tlo, qlo> ".." Expr<thi, qhi>
|
|
|
- 906 (. IF (tlo = SymTab.InvalidType)
|
|
|
- 907 OR (thi = SymTab.InvalidType) THEN
|
|
|
- 908 ok := FALSE
|
|
|
- 909 ELSE cl := SymTab.ClassOf(tlo);
|
|
|
- 910 cl2 := SymTab.ClassOf(thi);
|
|
|
- 911 IF ((cl # SymTab.ClInt)
|
|
|
- 912 AND (cl # SymTab.ClChar))
|
|
|
- 913 OR ((cl2 # SymTab.ClInt)
|
|
|
- 914 AND (cl2 # SymTab.ClChar)) THEN
|
|
|
- 915 SemError(230); ok := FALSE
|
|
|
- 916 ELSIF NOT SymTab.ConstInt(qlo, lo)
|
|
|
- 917 OR NOT SymTab.ConstInt(qhi, hi)
|
|
|
- 918 OR (lo > hi) THEN
|
|
|
- 919 SemError(230); ok := FALSE
|
|
|
- 920 ELSIF NOT SymTab.BoundAdd(lo, hi) THEN
|
|
|
- 921 SemError(230); ok := FALSE
|
|
|
- 922 END;
|
|
|
- 923 END; .) .
|
|
|
- 924 (* Sets: multi-word masks over bases ≤ 256 values (bool, char,
|
|
|
- 925 bounded subranges; enums wait for ordinals, INTEGER is
|
|
|
- 926 unbounded). Literals are SET OF [0..255]; assignment and
|
|
|
- 927 comparison across suitable bases are lenient (masks over min
|
|
|
- 928 words + zero-check extras), out-of-span literals are 222. *)
|
|
|
- 929 SetType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex;
|
|
|
- 930 blo, bhi, bspan: INTEGER;
|
|
|
- 931 bcls: INTEGER; .)
|
|
|
- 932 = "SET" "OF" Type<base, FALSE>
|
|
|
- 933 (. IF base = SymTab.InvalidType THEN
|
|
|
- 934 t := SymTab.InvalidType
|
|
|
- 935 ELSE bcls :=
|
|
|
- 936 SymTab.ClassOf(base);
|
|
|
- 937 IF bcls = SymTab.ClBool THEN
|
|
|
- 938 blo := 0; bspan := 2
|
|
|
- 939 ELSIF bcls = SymTab.ClChar THEN
|
|
|
- 940 blo := 0; bspan := 256
|
|
|
- 941 ELSIF bcls = SymTab.ClEnum THEN
|
|
|
- 942 blo := 0;
|
|
|
- 943 bspan := VAL(INTEGER,
|
|
|
- 944 SymTab.EnumCount(base))
|
|
|
- 945 ELSIF SymTab.SubBounds(base,
|
|
|
- 946 blo, bhi) THEN
|
|
|
- 947 bspan := bhi - blo + 1
|
|
|
- 948 ELSE bspan := 0 END;
|
|
|
- 949 IF (bspan <= 0)
|
|
|
- 950 OR (bspan > 65536) THEN
|
|
|
- 951 SemError(230);
|
|
|
- 952 t := SymTab.InvalidType
|
|
|
- 953 ELSE t := SymTab.NewSet(base)
|
|
|
- 954 END
|
|
|
- 955 END; .) .
|
|
|
- 956 (* Records: flat blobs; array fields are pointers to static
|
|
|
- 957 descriptors (locked amendment), nested records inline. Field
|
|
|
- 958 offsets static and declaration-ordered. *)
|
|
|
- 959 (* Field list: plain fields and (optionally) one variant part. The
|
|
|
- 960 variant part is a `CASE ... END` item; because it starts with the
|
|
|
- 961 CASE keyword it is unambiguously distinguishable from a field
|
|
|
- 962 (which starts with an identifier). *)
|
|
|
- 963 RecordType<VAR t: SymTab.TypeIndex> (. VAR t2: SymTab.TypeIndex;
|
|
|
- 964 tagOk: BOOLEAN; .)
|
|
|
- 965 = "RECORD" (. t := SymTab.NewRecord(); .)
|
|
|
- 966 [ RecItem<t> { ";" [ RecItem<t> ] } ]
|
|
|
- 967 "END" (. SymTab.LayoutRecord(t); .) .
|
|
|
- 968 RecItem<rec: SymTab.TypeIndex> (. VAR tt: SymTab.TypeIndex; .)
|
|
|
- 969 = RecField<rec>
|
|
|
- 970 | CaseField<rec> (. SymTab.MarkVariant(rec); .) .
|
|
|
- 971 (* A variant part: CASE tag : Type OF variants. The layout overlays
|
|
|
- 972 every branch from the tag slot (see SymTab.ComputeOffsets). *)
|
|
|
- 973 CaseField<rec: SymTab.TypeIndex> (. VAR tagT: SymTab.TypeIndex;
|
|
|
- 974 tagN: SymTab.Name; .)
|
|
|
- 975 = "CASE" (. SymTab.ResetFields(rec); .)
|
|
|
- 976 GetIdent<tagN> (. IF NOT SymTab.FieldPending(rec,
|
|
|
- 977 tagN) THEN
|
|
|
- 978 SemError(200) END; .)
|
|
|
- 979 ":" Type<tagT, FALSE> (. IF (tagT # SymTab.InvalidType)
|
|
|
- 980 AND NOT SymTab.IsOrdinal(tagT) THEN
|
|
|
- 981 SemError(224)
|
|
|
- 982 END;
|
|
|
- 983 SymTab.FixPendingF(rec, tagT);
|
|
|
- 984 SymTab.SetVariantTag(rec, tagN); .)
|
|
|
- 985 "OF"
|
|
|
- 986 RecFieldList<rec>
|
|
|
- 987 { "|" (. SymTab.ResetFields(rec); .)
|
|
|
- 988 RecFieldList<rec> }
|
|
|
- 989 "END" .
|
|
|
- 990 RecFieldList<rec: SymTab.TypeIndex> (. VAR lt, lq: SymTab.TypeIndex;
|
|
|
- 991 lv1, lv2: QbeGen.QVal; .)
|
|
|
- 992 = VarLabel<lt, lv1> [ ".." VarLabel<lq, lv2> ] ":"
|
|
|
- 993 RecField<rec> { ";" [ RecField<rec> ] } .
|
|
|
- 994 (* Variant case label: a constant (or a constant range). Values are
|
|
|
- 995 not interpreted (the layout overlays regardless). *)
|
|
|
- 996 VarLabel<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 997 (. VAR lname: SymTab.Name; .)
|
|
|
- 998 = ( ident (. LexName(lname);
|
|
|
- 999 QbeGen.CopyOp("0", q);
|
|
|
- 1000 t := SymTab.IntType(); .)
|
|
|
- 1001 | integer (. LexString(lname);
|
|
|
- 1002 QbeGen.CopyOp("0", q);
|
|
|
- 1003 t := SymTab.IntType(); .)
|
|
|
- 1004 | charConst (. LexString(lname);
|
|
|
- 1005 QbeGen.CopyOp("0", q);
|
|
|
- 1006 t := SymTab.CharType(); .) ) .
|
|
|
- 1007 RecField<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name;
|
|
|
- 1008 t2: SymTab.TypeIndex; .)
|
|
|
- 1009 = RecIdents<rec> ":" Type<t2, FALSE>(. SymTab.FixPendingF(rec, t2); .) .
|
|
|
- 1010 RecIdents<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name; .)
|
|
|
- 1011 = GetIdent<n> (. IF NOT SymTab.FieldPending(rec,
|
|
|
- 1012 n) THEN
|
|
|
+ 328 twoPhaseParse := b
|
|
|
+ 329 END SetTwoPhase;
|
|
|
+ 330
|
|
|
+ 331 PROCEDURE TokIs (kw: ARRAY OF CHAR): BOOLEAN;
|
|
|
+ 332 (* The current lookahead token's source text equals kw. Compares text,
|
|
|
+ 333 not token codes, so grammar renumbering cannot desync the skipper. *)
|
|
|
+ 334 VAR tok: ARRAY [0 .. 63] OF CHAR;
|
|
|
+ 335 BEGIN
|
|
|
+ 336 M2S.GetName(M2S.nextPos, M2S.nextLen, tok);
|
|
|
+ 337 RETURN SymTab.Equal(tok, kw)
|
|
|
+ 338 END TokIs;
|
|
|
+ 339
|
|
|
+ 340 PROCEDURE Adv;
|
|
|
+ 341 (* Advance one token: exactly the parser frame's Get for a grammar
|
|
|
+ 342 without pragmas (its pragma branch is empty and the scanner never
|
|
|
+ 343 returns a token above maxT, so the repeat loop runs once). A
|
|
|
+ 344 separate name because the frame's Get is declared later in this
|
|
|
+ 345 module: a bare Get here would bind the imported M2S.Get (which takes
|
|
|
+ 346 a parameter) under single-pass compilers. *)
|
|
|
+ 347 BEGIN
|
|
|
+ 348 M2S.Get(sym);
|
|
|
+ 349 INC(errDist)
|
|
|
+ 350 END Adv;
|
|
|
+ 351
|
|
|
+ 352 PROCEDURE NoteSpan (pn: SymTab.Name; start: M2S.INT32);
|
|
|
+ 353 (* Records an outermost body span for the re-parse pass (milestone 2).
|
|
|
+ 354 Diagnostic only for now: nothing consumes the table yet. Declared
|
|
|
+ 355 before its caller: V3 resolves single-pass (declaration before use),
|
|
|
+ 356 with no forward tolerance for procedure calls. *)
|
|
|
+ 357 BEGIN
|
|
|
+ 358 IF nSpans > HIGH(spanName) THEN RETURN END;
|
|
|
+ 359 CopyNm(pn, spanName[nSpans]);
|
|
|
+ 360 spanStart[nSpans] := start;
|
|
|
+ 361 INC(nSpans)
|
|
|
+ 362 END NoteSpan;
|
|
|
+ 363
|
|
|
+ 364 PROCEDURE ProbeBody (pn: SymTab.Name);
|
|
|
+ 365 (* Shadow-skip the body starting at the current token: consume tokens
|
|
|
+ 366 counting block openers until the matching END, check the procedure
|
|
|
+ 367 name after it, record the body span for the re-parse pass, verify
|
|
|
+ 368 SeekTo repositions exactly, then restore the exact scanner/parser
|
|
|
+ 369 state. The body then parses normally, so a correct skipper is
|
|
|
+ 370 output-neutral; a wrong one reports to StdOut (never into the
|
|
|
+ 371 listing). The SeekTo check's side effects are discarded by the
|
|
|
+ 372 trailing PopPos, so it is output-neutral too. *)
|
|
|
+ 373 VAR savedSym, savedErr, depth, guard: CARDINAL;
|
|
|
+ 374 nm: SymTab.Name;
|
|
|
+ 375 ok, sok: BOOLEAN;
|
|
|
+ 376 start: M2S.INT32;
|
|
|
+ 377 BEGIN
|
|
|
+ 378 savedSym := sym; savedErr := errDist; start := M2S.nextPos;
|
|
|
+ 379 M2S.PushPos;
|
|
|
+ 380 depth := 0; guard := 0; ok := TRUE;
|
|
|
+ 381 LOOP
|
|
|
+ 382 IF sym = 0 THEN ok := FALSE; EXIT END;
|
|
|
+ 383 IF TokIs("END") THEN
|
|
|
+ 384 IF depth = 0 THEN EXIT END;
|
|
|
+ 385 DEC(depth)
|
|
|
+ 386 ELSIF TokIs("MODULE") OR TokIs("PROCEDURE") OR TokIs("CLASS")
|
|
|
+ 387 OR TokIs("RECORD") OR TokIs("IF") OR TokIs("CASE")
|
|
|
+ 388 OR TokIs("WHILE") OR TokIs("FOR") OR TokIs("LOOP")
|
|
|
+ 389 OR TokIs("WITH") THEN
|
|
|
+ 390 INC(depth)
|
|
|
+ 391 END;
|
|
|
+ 392 Adv;
|
|
|
+ 393 INC(guard);
|
|
|
+ 394 IF guard > 1000000 THEN ok := FALSE; EXIT END
|
|
|
+ 395 END;
|
|
|
+ 396 IF ok THEN
|
|
|
+ 397 Adv;
|
|
|
+ 398 M2S.GetName(M2S.nextPos, M2S.nextLen, nm);
|
|
|
+ 399 IF (sym = 0) OR NOT SymTab.Equal(nm, pn) THEN ok := FALSE END
|
|
|
+ 400 END;
|
|
|
+ 401 IF ok THEN NoteSpan(pn, start) END;
|
|
|
+ 402 sok := TRUE;
|
|
|
+ 403 IF ok THEN
|
|
|
+ 404 M2S.SeekTo(start);
|
|
|
+ 405 Adv;
|
|
|
+ 406 IF (sym # savedSym) OR (M2S.nextPos # start) THEN sok := FALSE END
|
|
|
+ 407 END;
|
|
|
+ 408 M2S.PopPos;
|
|
|
+ 409 sym := savedSym; errDist := savedErr;
|
|
|
+ 410 IF NOT ok THEN
|
|
|
+ 411 FileIO.WriteString(FileIO.StdOut, "twophase probe mismatch in ");
|
|
|
+ 412 FileIO.WriteString(FileIO.StdOut, pn);
|
|
|
+ 413 FileIO.WriteLn(FileIO.StdOut)
|
|
|
+ 414 ELSIF NOT sok THEN
|
|
|
+ 415 FileIO.WriteString(FileIO.StdOut, "twophase seek mismatch in ");
|
|
|
+ 416 FileIO.WriteString(FileIO.StdOut, pn);
|
|
|
+ 417 FileIO.WriteLn(FileIO.StdOut)
|
|
|
+ 418 END
|
|
|
+ 419 END ProbeBody;
|
|
|
+ 420
|
|
|
+ 421 CHARACTERS
|
|
|
+ 422 eol = CHR(13) .
|
|
|
+ 423 lf = CHR(10) .
|
|
|
+ 424 letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" .
|
|
|
+ 425 digit = "0123456789" .
|
|
|
+ 426 hexDigit = digit + "ABCDEFabcdef" .
|
|
|
+ 427 noQuote1 = ANY - "'" - eol .
|
|
|
+ 428 noQuote2 = ANY - '"' - eol .
|
|
|
+ 429
|
|
|
+ 430 IGNORE CHR(9) .. CHR(13)
|
|
|
+ 431
|
|
|
+ 432 COMMENTS FROM "(*" TO "*)" NESTED
|
|
|
+ 433 COMMENTS FROM "//" TO lf
|
|
|
+ 434
|
|
|
+ 435 TOKENS
|
|
|
+ 436 ident = letter { letter | digit | "_" } .
|
|
|
+ 437 integer = digit { digit }
|
|
|
+ 438 | digit { digit } CONTEXT("..")
|
|
|
+ 439 | "0x" hexDigit { hexDigit }
|
|
|
+ 440 | "0X" hexDigit { hexDigit } .
|
|
|
+ 441 real = digit { digit } "." { digit }
|
|
|
+ 442 [ ( "E" | "e" ) [ "+" | "-" ] digit { digit } ] .
|
|
|
+ 443 string = "'" { noQuote1 } "'"
|
|
|
+ 444 | '"' { noQuote2 } '"' .
|
|
|
+ 445 charConst = digit { digit } ( "C" | "c" ) .
|
|
|
+ 446 ustring = ( "U" | "u" ) ( "'" { noQuote1 } "'" | '"' { noQuote2 } '"' ) .
|
|
|
+ 447
|
|
|
+ 448 PRODUCTIONS
|
|
|
+ 449 M2
|
|
|
+ 450 = (. twoPhase := TRUE; astCur := AST.NoNode; astStmt := AST.NoNode; astDecl := AST.NoNode; astImp := AST.NoNode; astImpTail := AST.NoNode;
|
|
|
+ 451 astImp := AST.NoNode;
|
|
|
+ 452 astImpTail := AST.NoNode;
|
|
|
+ 453 procNest := 0; nSpans := 0; .)
|
|
|
+ 454 Unit "." .
|
|
|
+ 455 (* Units: program modules compile fully; DEFINITION and
|
|
|
+ 456 IMPLEMENTATION modules parse + check now but lower in step 4
|
|
|
+ 457 (each ends with one 230); same for nested local modules. *)
|
|
|
+ 458 (* Generics (Increment 1): formal and actual parameters. Formals are
|
|
|
+ 459 TYPE parameters only; actuals are type identifiers. *)
|
|
|
+ 460 GenericFormals
|
|
|
+ 461 = "(" GenericFormal { ";" GenericFormal } ")" .
|
|
|
+ 462 GenericFormal (. VAR nm: SymTab.Name; .)
|
|
|
+ 463 = GetIdent<nm> (. IF instActive THEN
|
|
|
+ 464 IF NOT SymTab.EnterTypeParamBound(nm,
|
|
|
+ 465 InstActualGet(instFk)) THEN
|
|
|
+ 466 SemError(200) END
|
|
|
+ 467 ELSIF NOT SymTab.EnterTypeParam(nm) THEN
|
|
|
+ 468 SemError(200) END;
|
|
|
+ 469 INC(instFk); .)
|
|
|
+ 470 { "," GetIdent<nm> (. IF instActive THEN
|
|
|
+ 471 IF NOT SymTab.EnterTypeParamBound(nm,
|
|
|
+ 472 InstActualGet(instFk)) THEN
|
|
|
+ 473 SemError(200) END
|
|
|
+ 474 ELSIF NOT SymTab.EnterTypeParam(nm) THEN
|
|
|
+ 475 SemError(200) END;
|
|
|
+ 476 INC(instFk); .) }
|
|
|
+ 477 ":" "TYPE" .
|
|
|
+ 478 Actuals
|
|
|
+ 479 = Actual { "," Actual } .
|
|
|
+ 480 Actual (. VAR at: SymTab.TypeIndex; .)
|
|
|
+ 481 = TypeIdent<at> (. IF refN <= HIGH(refActual) THEN
|
|
|
+ 482 refActual[refN] := at; INC(refN)
|
|
|
+ 483 END; .) .
|
|
|
+ 484 Unit
|
|
|
+ 485 = (. isGen := FALSE; .)
|
|
|
+ 486 [ "GENERIC" (. isGen := TRUE; .) ]
|
|
|
+ 487 ( DefUnit | ImplUnit | ProgModule ) .
|
|
|
+ 488 (* Step 4.3: one session compiles DEFINITION, its IMPLEMENTATION
|
|
|
+ 489 and one program (last) into one image. Units share the symbol
|
|
|
+ 490 table; imports materialize exported names. *)
|
|
|
+ 491 DefUnit (. VAR m1, m2, pn: SymTab.Name;
|
|
|
+ 492 g: SymTab.Name;
|
|
|
+ 493 astSeq, astTail, astProc: AST.Node; .)
|
|
|
+ 494 = (. refN := 0; refSeen := FALSE; .)
|
|
|
+ 495 "DEFINITION" "MODULE"
|
|
|
+ 496 GetIdent<m1> (. IF instActive THEN InstNameGet(m1) END;
|
|
|
+ 497 IF instActive THEN
|
|
|
+ 498 IF NOT SymTab.Reenter(m1,
|
|
|
+ 499 SymTab.UnitDef) THEN
|
|
|
+ 500 SemError(200) END
|
|
|
+ 501 ELSIF NOT SymTab.BeginDef(m1) THEN
|
|
|
+ 502 SemError(200) END;
|
|
|
+ 503 QbeGen.SetModule(m1);
|
|
|
+ 504 CopyNm(m1, unitName);
|
|
|
+ 505 unitWasGen := isGen
|
|
|
+ 506 AND NOT instActive;
|
|
|
+ 507 unitWasDef := TRUE; .)
|
|
|
+ 508 [ GenericFormals ]
|
|
|
+ 509 ( ";"
|
|
|
+ 510 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 511 astImp, astImpTail, astDecl); .) }
|
|
|
+ 512 [ "EXPORT" [ "QUALIFIED" ] (. (* definition-module export
|
|
|
+ 513 list: parsed, and the
|
|
|
+ 514 names are already exported
|
|
|
+ 515 by the module scope *) .)
|
|
|
+ 516 GetIdent<pn> { "," GetIdent<pn> } ";" ]
|
|
|
+ 517 (. astSeq := AST.NoNode;
|
|
|
+ 518 astTail := AST.NoNode; .)
|
|
|
+ 519 { ConstBlock (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 520 astSeq, astTail, astDecl); .)
|
|
|
+ 521 | TypeBlock<TRUE> (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 522 astSeq, astTail, astDecl); .)
|
|
|
+ 523 | VarBlock (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 524 astSeq, astTail, astDecl); .)
|
|
|
+ 525 | ProcHeading<pn, SymTab.InvalidType> ";"
|
|
|
+ 526 (. (* a heading only: record it so
|
|
|
+ 527 Lower can replay it *)
|
|
|
+ 528 astProc := AST.MakeNode(AST.NkProcDecl);
|
|
|
+ 529 AST.SetOp(astProc, 0);
|
|
|
+ 530 AST.SetChild(astProc, 0,
|
|
|
+ 531 AST.MakeLeaf(AST.NkIdent, pn));
|
|
|
+ 532 AstAppend(AST.NkDeclSeq,
|
|
|
+ 533 astSeq, astTail, astProc);
|
|
|
+ 534 Lower.NoteProcNode(astProc);
|
|
|
+ 535 Lower.ScopeLeave;
|
|
|
+ 536 SymTab.CloseProc;
|
|
|
+ 537 QbeGen.AbortFunc; .) }
|
|
|
+ 538 (. astUnit := AST.MakeNode(AST.NkUnit);
|
|
|
+ 539 AST.SetChild(astUnit, 0,
|
|
|
+ 540 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
+ 541 AST.SetChild(astUnit, 1, astSeq);
|
|
|
+ 542 AST.SetChild(astUnit, 3, astImp);
|
|
|
+ 543 astDecl := AST.NoNode;
|
|
|
+ 544 astStmt := AST.NoNode; .)
|
|
|
+ 545 "END"
|
|
|
+ 546 GetIdent<m2> (. IF instActive THEN InstNameGet(m2) END;
|
|
|
+ 547 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
+ 548 SemError(202) END;
|
|
|
+ 549 SymTab.EndUnit; .)
|
|
|
+ 550 | "=" GetIdent<g> [ "(" Actuals ")" ] ";"
|
|
|
+ 551 (. CopyNm(m1, refInst);
|
|
|
+ 552 CopyNm(g, refGen);
|
|
|
+ 553 refSeen := TRUE; refIsDef := TRUE;
|
|
|
+ 554 astUnit := AST.MakeNode(AST.NkUnit);
|
|
|
+ 555 AST.SetChild(astUnit, 0,
|
|
|
+ 556 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
+ 557 astDecl := AST.NoNode;
|
|
|
+ 558 astStmt := AST.NoNode; .)
|
|
|
+ 559 "END"
|
|
|
+ 560 GetIdent<m2> (. IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
+ 561 SemError(202) END;
|
|
|
+ 562 SymTab.EndUnit; .) ) .
|
|
|
+ 563 ImplUnit (. VAR m1, m2: SymTab.Name;
|
|
|
+ 564 g: SymTab.Name;
|
|
|
+ 565 k: CARDINAL;
|
|
|
+ 566 fname: SymTab.Name;
|
|
|
+ 567 unres: BOOLEAN;
|
|
|
+ 568 astNode: AST.Node; .)
|
|
|
+ 569 = (. refN := 0; refSeen := FALSE; .)
|
|
|
+ 570 "IMPLEMENTATION" "MODULE"
|
|
|
+ 571 GetIdent<m1> (. IF instActive THEN InstNameGet(m1) END;
|
|
|
+ 572 IF instActive THEN
|
|
|
+ 573 IF NOT SymTab.Reenter(m1,
|
|
|
+ 574 SymTab.UnitImpl) THEN
|
|
|
+ 575 SemError(201) END
|
|
|
+ 576 ELSIF NOT SymTab.BeginImpl(m1) THEN
|
|
|
+ 577 SemError(201) END;
|
|
|
+ 578 astStmt := AST.NoNode;
|
|
|
+ 579 astDecl := AST.NoNode;
|
|
|
+ 580 astImp := AST.NoNode;
|
|
|
+ 581 astImpTail := AST.NoNode;
|
|
|
+ 582 nPendVar := 0;
|
|
|
+ 583 CopyNm(m1, unitName);
|
|
|
+ 584 unitWasGen := isGen AND NOT instActive;
|
|
|
+ 585 unitWasDef := FALSE;
|
|
|
+ 586 QbeGen.SetModule(m1); .)
|
|
|
+ 587 [ GenericFormals ]
|
|
|
+ 588 ( ";"
|
|
|
+ 589 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 590 astImp, astImpTail, astDecl); .) }
|
|
|
+ 591 DeclSeq (. astStmt := AST.NoNode; .)
|
|
|
+ 592 [ "BEGIN" (. FlushPend;
|
|
|
+ 593 k := 0;
|
|
|
+ 594 WHILE k < SymTab.FwdPending() DO
|
|
|
+ 595 SymTab.FwdInfo(k, fname, unres);
|
|
|
+ 596 IF unres THEN SemError(201) END;
|
|
|
+ 597 INC(k)
|
|
|
+ 598 END;
|
|
|
+ 599 SymTab.FwdClear;
|
|
|
+ 600
|
|
|
+ 601 nLab := 0; nGot := 0; .)
|
|
|
+ 602 [ StatSeq ] ]
|
|
|
+ 603 "END"
|
|
|
+ 604 GetIdent<m2> (. IF instActive THEN InstNameGet(m2) END;
|
|
|
+ 605 FlushPend;
|
|
|
+ 606 k := 0;
|
|
|
+ 607 WHILE k < SymTab.FwdPending() DO
|
|
|
+ 608 SymTab.FwdInfo(k, fname, unres);
|
|
|
+ 609 IF unres THEN SemError(201) END;
|
|
|
+ 610 INC(k)
|
|
|
+ 611 END;
|
|
|
+ 612 SymTab.FwdClear;
|
|
|
+ 613
|
|
|
+ 614 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
+ 615 AST.SetChild(astNode, 0,
|
|
|
+ 616 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
+ 617 AST.SetChild(astNode, 1, astDecl);
|
|
|
+ 618 AST.SetChild(astNode, 2, astStmt);
|
|
|
+ 619 AST.SetChild(astNode, 3, astImp);
|
|
|
+ 620 astUnit := astNode;
|
|
|
+ 621 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
+ 622 SemError(202) END;
|
|
|
+ 623 CheckGotos;
|
|
|
+ 624 SymTab.EndUnit; .)
|
|
|
+ 625 | "=" GetIdent<g> [ "(" Actuals ")" ] ";"
|
|
|
+ 626 (. CopyNm(m1, refInst);
|
|
|
+ 627 CopyNm(g, refGen);
|
|
|
+ 628 refSeen := TRUE; refIsDef := FALSE;
|
|
|
+ 629 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
+ 630 AST.SetChild(astNode, 0,
|
|
|
+ 631 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
+ 632 astDecl := AST.NoNode;
|
|
|
+ 633 astStmt := AST.NoNode; .)
|
|
|
+ 634 "END"
|
|
|
+ 635 GetIdent<m2> (. IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
+ 636 SemError(202) END;
|
|
|
+ 637 SymTab.EndUnit; .) ) .
|
|
|
+ 638 ProgModule (. VAR m1, m2: SymTab.Name;
|
|
|
+ 639 k: CARDINAL;
|
|
|
+ 640 fname: SymTab.Name;
|
|
|
+ 641 unres: BOOLEAN;
|
|
|
+ 642 astNode: AST.Node; .)
|
|
|
+ 643 = "MODULE"
|
|
|
+ 644 GetIdent<m1> (. IF NOT SymTab.BeginProg(m1) THEN
|
|
|
+ 645 SemError(200) END;
|
|
|
+ 646 astStmt := AST.NoNode;
|
|
|
+ 647 astDecl := AST.NoNode;
|
|
|
+ 648 astImp := AST.NoNode;
|
|
|
+ 649 astImpTail := AST.NoNode;
|
|
|
+ 650 nPendVar := 0;
|
|
|
+ 651 QbeGen.SetModule(m1); .)
|
|
|
+ 652 [ Priority ]
|
|
|
+ 653 ";"
|
|
|
+ 654 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 655 astImp, astImpTail, astDecl); .) }
|
|
|
+ 656 DeclSeq (. astStmt := AST.NoNode; .)
|
|
|
+ 657 [ "BEGIN" (. FlushPend;
|
|
|
+ 658 k := 0;
|
|
|
+ 659 WHILE k < SymTab.FwdPending() DO
|
|
|
+ 660 SymTab.FwdInfo(k, fname, unres);
|
|
|
+ 661 IF unres THEN SemError(201) END;
|
|
|
+ 662 INC(k)
|
|
|
+ 663 END;
|
|
|
+ 664 SymTab.FwdClear;
|
|
|
+ 665
|
|
|
+ 666 nLab := 0; nGot := 0; .)
|
|
|
+ 667 [ StatSeq ] ]
|
|
|
+ 668 "END"
|
|
|
+ 669 GetIdent<m2> (. IF instActive THEN InstNameGet(m2) END;
|
|
|
+ 670 FlushPend;
|
|
|
+ 671 k := 0;
|
|
|
+ 672 WHILE k < SymTab.FwdPending() DO
|
|
|
+ 673 SymTab.FwdInfo(k, fname, unres);
|
|
|
+ 674 IF unres THEN SemError(201) END;
|
|
|
+ 675 INC(k)
|
|
|
+ 676 END;
|
|
|
+ 677 SymTab.FwdClear;
|
|
|
+ 678
|
|
|
+ 679 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
+ 680 SemError(202) END;
|
|
|
+ 681 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
+ 682 AST.SetChild(astNode, 0,
|
|
|
+ 683 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
+ 684 AST.SetChild(astNode, 1, astDecl);
|
|
|
+ 685 AST.SetChild(astNode, 2, astStmt);
|
|
|
+ 686 AST.SetChild(astNode, 3, astImp);
|
|
|
+ 687 astUnit := astNode;
|
|
|
+ 688 CheckGotos;
|
|
|
+ 689 SymTab.EndUnit; .) .
|
|
|
+ 690 DeclSeq (. VAR astSeq, astTail: AST.Node; .)
|
|
|
+ 691 = (. astSeq := AST.NoNode;
|
|
|
+ 692 astTail := AST.NoNode; .)
|
|
|
+ 693 { (. astDecl := AST.NoNode; .)
|
|
|
+ 694 ( ConstBlock | TypeBlock<FALSE> | VarBlock | ProcDecl ";"
|
|
|
+ 695 | NestedModule ";" | ClassItem ";" )
|
|
|
+ 696 (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 697 astSeq, astTail, astDecl); .) }
|
|
|
+ 698 (. astDecl := astSeq; .) .
|
|
|
+ 699 (* Local module, Wirth form. Declarations lower like top-level ones
|
|
|
+ 700 (same QBE module prefix); a BEGIN body becomes an init function
|
|
|
+ 701 that main calls; the EXPORT list is hoisted into the enclosing
|
|
|
+ 702 scope at END. *)
|
|
|
+ 703 NestedModule (. VAR m1, m2: SymTab.Name;
|
|
|
+ 704 expNames: ARRAY [0 .. 63] OF SymTab.Name;
|
|
|
+ 705 expCount, k: CARDINAL;
|
|
|
+ 706 astNode, nImp, nImpTail:
|
|
|
+ 707 AST.Node; .)
|
|
|
+ 708 = "MODULE"
|
|
|
+ 709 GetIdent<m1> (. IF NOT SymTab.Enter(m1,
|
|
|
+ 710 SymTab.KindModule) THEN
|
|
|
+ 711 SemError(200) END;
|
|
|
+ 712 SymTab.PushScope;
|
|
|
+ 713 expCount := 0;
|
|
|
+ 714 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
+ 715 AST.SetChild(astNode, 0,
|
|
|
+ 716 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
+ 717 astStmt := AST.NoNode;
|
|
|
+ 718 astDecl := AST.NoNode;
|
|
|
+ 719 nImp := AST.NoNode;
|
|
|
+ 720 nImpTail := AST.NoNode; .)
|
|
|
+ 721 [ Priority ]
|
|
|
+ 722 ";"
|
|
|
+ 723 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 724 nImp, nImpTail, astDecl); .) }
|
|
|
+ 725 [ "EXPORT" [ "QUALIFIED" ]
|
|
|
+ 726 GetIdent<expNames[expCount]> (. INC(expCount); .)
|
|
|
+ 727 { "," GetIdent<expNames[expCount]>
|
|
|
+ 728 (. INC(expCount); .) }
|
|
|
+ 729 ";" ]
|
|
|
+ 730 DeclSeq (. astStmt := AST.NoNode; .)
|
|
|
+ 731 [ "BEGIN" (. astStmt := AST.NoNode;
|
|
|
+ 732 .)
|
|
|
+ 733 [ StatSeq ] ]
|
|
|
+ 734 "END"
|
|
|
+ 735 GetIdent<m2> (. AST.SetChild(astNode, 1, astDecl);
|
|
|
+ 736 AST.SetChild(astNode, 2, astStmt);
|
|
|
+ 737 AST.SetChild(astNode, 3, nImp);
|
|
|
+ 738 astDecl := astNode;
|
|
|
+ 739 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
+ 740 SemError(202) END;
|
|
|
+ 741 k := 0;
|
|
|
+ 742 WHILE k < expCount DO
|
|
|
+ 743 SymTab.ExportUp(expNames[k]);
|
|
|
+ 744 INC(k)
|
|
|
+ 745 END;
|
|
|
+ 746 SymTab.PopScope; .) .
|
|
|
+ 747 Priority
|
|
|
+ 748 = "[" integer "]" (. SemError(230); .) .
|
|
|
+ 749 (* Imports (4.3): FROM materializes the names (unqualified use);
|
|
|
+ 750 plain IMPORT only demands the module exists — qualified `L.x`
|
|
|
+ 751 materializes on first use (Design). *)
|
|
|
+ 752 (* Unknown modules stay unchecked stubs (legacy, so hand-written
|
|
|
+ 753 import lines don't fail); a known module's missing export is
|
|
|
+ 754 201. *)
|
|
|
+ 755 Import (. VAR n: SymTab.Name;
|
|
|
+ 756 astImport: AST.Node; .)
|
|
|
+ 757 = "FROM"
|
|
|
+ 758 GetIdent<n> (. astImport := AST.MakeNode(AST.NkImport);
|
|
|
+ 759 AST.SetChild(astImport, 0,
|
|
|
+ 760 AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
+ 761 "IMPORT"
|
|
|
+ 762 ImpList<n, astImport> ";" (. astDecl := astImport; .)
|
|
|
+ 763 | "IMPORT" (. astImport := AST.MakeNode(AST.NkImport); .)
|
|
|
+ 764 ImpModList<astImport> ";" (. astDecl := astImport; .) .
|
|
|
+ 765 ImpList<mod: SymTab.Name; node: AST.Node>
|
|
|
+ 766 (. VAR n: SymTab.Name; .)
|
|
|
+ 767 = ImpName<mod, node>
|
|
|
+ 768 { "," ImpName<mod, node> } .
|
|
|
+ 769 (* Pervasive built-ins imported from SYSTEM (e.g. TSIZE) are
|
|
|
+ 770 accepted and ignored: the built-in applies regardless. *)
|
|
|
+ 771 ImpName<mod: SymTab.Name; node: AST.Node>
|
|
|
+ 772 (. VAR n: SymTab.Name; .)
|
|
|
+ 773 = GetIdent<n> (. AST.SetChild(node, AST.NChild(node),
|
|
|
+ 774 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
+ 775 IF SymTab.Equal(mod, "libc") THEN
|
|
|
+ 776 (* intrinsic C library:
|
|
|
+ 777 permissive external *)
|
|
|
+ 778 IF NOT SymTab.DeclareCProc(n) THEN
|
|
|
+ 779 SemError(201) END;
|
|
|
+ 780 Lower.NoteCProc(n)
|
|
|
+ 781 ELSIF SymTab.ModKnown(mod) THEN
|
|
|
+ 782 IF NOT SymTab.ImportFrom(mod, n) THEN
|
|
|
+ 783 SemError(201)
|
|
|
+ 784 ELSE Lower.NoteImportedProc(n)
|
|
|
+ 785 END
|
|
|
+ 786 END; .)
|
|
|
+ 787 | ( "TSIZE" | "SIZE" | "ADR" | "HIGH" | "LEN"
|
|
|
+ 788 | "CHR" | "ORD" | "ORDL" | "VAL" | "ABS" | "CAP"
|
|
|
+ 789 | "UCHR" | "CHR8" | "UORD"
|
|
|
+ 790 | "INC" | "DEC" ) .
|
|
|
+ 791 ImpModList<node: AST.Node> (. VAR n: SymTab.Name; .)
|
|
|
+ 792 = GetIdent<n> (. AST.SetChild(node, AST.NChild(node),
|
|
|
+ 793 AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
+ 794 { "," GetIdent<n> (. AST.SetChild(node, AST.NChild(node),
|
|
|
+ 795 AST.MakeLeaf(AST.NkIdent, n)); .) } .
|
|
|
+ 796 (* Opaque TYPE declarations (definition modules). The targetless
|
|
|
+ 797 alias resolves to InvalidType until step 4 completes it. *)
|
|
|
+ 798 (* Scalar-phase TYPEs: named types, integer subranges, enumerations.
|
|
|
+ 799 Opaque "TYPE T;" needs isDef (definition units); elsewhere 231.
|
|
|
+ 800 Composite forms (ARRAY/RECORD/SET/POINTER) arrive with step 3. *)
|
|
|
+ 801 TypeBlock<isDef: BOOLEAN> (. VAR astSeq, astTail: AST.Node; .)
|
|
|
+ 802 = "TYPE" (. SymTab.BeginTypeBlock;
|
|
|
+ 803 astSeq := AST.NoNode;
|
|
|
+ 804 astTail := AST.NoNode; .)
|
|
|
+ 805 { (. astDecl := AST.NoNode; .)
|
|
|
+ 806 ( TypeItem<isDef> ";" | ClassItem ";" )
|
|
|
+ 807 (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 808 astSeq, astTail, astDecl); .) }
|
|
|
+ 809 (. SymTab.EndTypeBlock;
|
|
|
+ 810 astDecl := astSeq; .) .
|
|
|
+ 811 TypeItem<isDef: BOOLEAN> (. VAR n: SymTab.Name;
|
|
|
+ 812 t, op: SymTab.TypeIndex;
|
|
|
+ 813 astNode: AST.Node; .)
|
|
|
+ 814 = GetIdent<n> (. op := SymTab.OpaqueBase(n);
|
|
|
+ 815 IF op = SymTab.InvalidType THEN
|
|
|
+ 816 IF NOT SymTab.Enter(n,
|
|
|
+ 817 SymTab.KindType) THEN
|
|
|
+ 818 SemError(200) END
|
|
|
+ 819 END; .)
|
|
|
+ 820 ( "=" Type<t, FALSE> (. astNode := AST.MakeNode(AST.NkTypeDecl);
|
|
|
+ 821 AST.SetChild(astNode, 0,
|
|
|
+ 822 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
+ 823 AST.SetTy(astNode, t);
|
|
|
+ 824 astDecl := astNode;
|
|
|
+ 825 IF op # SymTab.InvalidType THEN
|
|
|
+ 826 SymTab.SetTarget(op, t)
|
|
|
+ 827 ELSE SymTab.SetSymType(n, t)
|
|
|
+ 828 END; .)
|
|
|
+ 829 | (. IF op # SymTab.InvalidType THEN
|
|
|
+ 830 (* stays opaque *)
|
|
|
+ 831 ELSIF NOT isDef THEN
|
|
|
+ 832 SemError(231)
|
|
|
+ 833 ELSE SymTab.SetSymType(n,
|
|
|
+ 834 SymTab.NewAlias()) END; .) ) .
|
|
|
+ 835 Type<VAR t: SymTab.TypeIndex; allowOpen: BOOLEAN>
|
|
|
+ 836 = TypeIdent<t> [ Subrange<t> ] (* anchored subrange: T[lo..hi] *)
|
|
|
+ 837 | Subrange<t>
|
|
|
+ 838 | Enum<t>
|
|
|
+ 839 | ArrayType<t, allowOpen>
|
|
|
+ 840 | SetType<t>
|
|
|
+ 841 | RecordType<t>
|
|
|
+ 842 | PointerType<t>
|
|
|
+ 843 | ProcType<t> .
|
|
|
+ 844 PointerType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex; .)
|
|
|
+ 845 = "POINTER" "TO" Type<base, FALSE>(. t := SymTab.NewPtr(base); .) .
|
|
|
+ 846 (* Procedure types (step 8.5): PROCEDURE (params): result. Values
|
|
|
+ 847 are code pointers; params are collected into the descriptor. *)
|
|
|
+ 848 ProcType<VAR t: SymTab.TypeIndex> (. VAR res, pt: SymTab.TypeIndex;
|
|
|
+ 849 isV: BOOLEAN; .)
|
|
|
+ 850 = "PROCEDURE" (. res := SymTab.InvalidType;
|
|
|
+ 851 t := SymTab.NewProcType(res); .)
|
|
|
+ 852 [ "(" [ ProcTypeSection<t> { ";" ProcTypeSection<t> } ] ")" ]
|
|
|
+ 853 [ ":" TypeIdent<res> (. SymTab.SetProcTypeRes(t, res); .) ] .
|
|
|
+ 854 ProcTypeSection<t: SymTab.TypeIndex> (. VAR pt: SymTab.TypeIndex;
|
|
|
+ 855 isV: BOOLEAN;
|
|
|
+ 856 cnt, k: CARDINAL;
|
|
|
+ 857 names: ARRAY [0 .. 15] OF SymTab.Name; .)
|
|
|
+ 858 = (. isV := FALSE; cnt := 0; .)
|
|
|
+ 859 [ "VAR" (. isV := TRUE; .) ]
|
|
|
+ 860 ( GetIdent<names[cnt]> (. INC(cnt); .)
|
|
|
+ 861 { "," GetIdent<names[cnt]> (. INC(cnt); .) }
|
|
|
+ 862 ( ":" Type<pt, TRUE> (. k := 0;
|
|
|
+ 863 WHILE k < cnt DO
|
|
|
+ 864 SymTab.ProcTypeAdd(t, isV, pt);
|
|
|
+ 865 INC(k)
|
|
|
+ 866 END; .)
|
|
|
+ 867 | (. (* type-only parameter list:
|
|
|
+ 868 each name is a type (GNU
|
|
|
+ 869 shorthand used by the
|
|
|
+ 870 Coco/R scanner frame) *)
|
|
|
+ 871 k := 0;
|
|
|
+ 872 WHILE k < cnt DO
|
|
|
+ 873 IF SymTab.Lookup(names[k])
|
|
|
+ 874 AND ((SymTab.SymKind(names[k]) = SymTab.KindType)
|
|
|
+ 875 OR (SymTab.SymKind(names[k]) = SymTab.KindPredef)) THEN
|
|
|
+ 876 pt := SymTab.SymType(names[k])
|
|
|
+ 877 ELSE SemError(201);
|
|
|
+ 878 pt := SymTab.InvalidType
|
|
|
+ 879 END;
|
|
|
+ 880 SymTab.ProcTypeAdd(t, isV, pt);
|
|
|
+ 881 INC(k)
|
|
|
+ 882 END; .) )
|
|
|
+ 883 | Type<pt, TRUE> (. (* unnamed parameter (PIM):
|
|
|
+ 884 e.g. PROCEDURE (VAR ARRAY OF REAL) *)
|
|
|
+ 885 SymTab.ProcTypeAdd(t, isV, pt); .) ) .
|
|
|
+ 886 (* Arrays: "OF" without bounds is an open formal (allowed only
|
|
|
+ 887 where allowOpen); "[lo..hi, ...]" nests bounded levels inside
|
|
|
+ 888 out. Bounds are folded literals (int/char); anything else 230.
|
|
|
+ 889 Bare-type indices ("ARRAY Color OF") wait for enum ordinals. *)
|
|
|
+ 890 ArrayType<VAR t: SymTab.TypeIndex; allowOpen: BOOLEAN>
|
|
|
+ 891 (. VAR elem: SymTab.TypeIndex;
|
|
|
+ 892 ok: BOOLEAN;
|
|
|
+ 893 bnds, bndh: ARRAY [0 .. 7] OF INTEGER;
|
|
|
+ 894 nb, k: CARDINAL;
|
|
|
+ 895 idx: SymTab.TypeIndex;
|
|
|
+ 896 ilo, ihi: INTEGER; .)
|
|
|
+ 897 = "ARRAY"
|
|
|
+ 898 ( "OF" Type<elem, FALSE> (. IF NOT allowOpen THEN
|
|
|
+ 899 SemError(230) END;
|
|
|
+ 900 t := SymTab.NewOpenArray(elem); .)
|
|
|
+ 901 | TypeIdent<idx> [ Subrange<idx> ]
|
|
|
+ 902 "OF" Type<elem, FALSE> (. (* index-type array: the index
|
|
|
+ 903 type's ordinal bounds give the
|
|
|
+ 904 [lo..hi] pair *)
|
|
|
+ 905 IF SymTab.TypeBounds(idx, ilo,
|
|
|
+ 906 ihi)
|
|
|
+ 907 THEN t := SymTab.NewArrayB(elem,
|
|
|
+ 908 ilo, ihi)
|
|
|
+ 909 ELSE SemError(230);
|
|
|
+ 910 t := SymTab.InvalidType
|
|
|
+ 911 END; .)
|
|
|
+ 912 | "[" (. SymTab.BoundBegin; ok := TRUE; .)
|
|
|
+ 913 BoundPair<ok>
|
|
|
+ 914 { "," BoundPair<ok> }
|
|
|
+ 915 "]" (. (* snapshot before the element
|
|
|
+ 916 type, which reuses the bound
|
|
|
+ 917 buffer for a nested ARRAY *)
|
|
|
+ 918 nb := SymTab.BoundCount();
|
|
|
+ 919 k := 0;
|
|
|
+ 920 WHILE k < nb DO
|
|
|
+ 921 bnds[k] := SymTab.BoundLo(k);
|
|
|
+ 922 bndh[k] := SymTab.BoundHi(k);
|
|
|
+ 923 INC(k)
|
|
|
+ 924 END; .)
|
|
|
+ 925 "OF" Type<elem, FALSE>
|
|
|
+ 926 (. IF ok THEN
|
|
|
+ 927 k := nb;
|
|
|
+ 928 WHILE k > 0 DO
|
|
|
+ 929 DEC(k);
|
|
|
+ 930 elem := SymTab.NewArrayB(
|
|
|
+ 931 elem, bnds[k], bndh[k])
|
|
|
+ 932 END;
|
|
|
+ 933 t := elem
|
|
|
+ 934 ELSE t := SymTab.InvalidType
|
|
|
+ 935 END; .) ) .
|
|
|
+ 936 BoundPair<VAR ok: BOOLEAN> (. VAR tlo, thi: SymTab.TypeIndex;
|
|
|
+ 937 qlo, qhi: QbeGen.QVal;
|
|
|
+ 938 lo, hi: INTEGER;
|
|
|
+ 939 cl, cl2: INTEGER; .)
|
|
|
+ 940 = Expr<tlo, qlo> ".." Expr<thi, qhi>
|
|
|
+ 941 (. IF (tlo = SymTab.InvalidType)
|
|
|
+ 942 OR (thi = SymTab.InvalidType) THEN
|
|
|
+ 943 ok := FALSE
|
|
|
+ 944 ELSE cl := SymTab.ClassOf(tlo);
|
|
|
+ 945 cl2 := SymTab.ClassOf(thi);
|
|
|
+ 946 IF ((cl # SymTab.ClInt)
|
|
|
+ 947 AND (cl # SymTab.ClChar))
|
|
|
+ 948 OR ((cl2 # SymTab.ClInt)
|
|
|
+ 949 AND (cl2 # SymTab.ClChar)) THEN
|
|
|
+ 950 SemError(230); ok := FALSE
|
|
|
+ 951 ELSIF NOT SymTab.ConstInt(qlo, lo)
|
|
|
+ 952 OR NOT SymTab.ConstInt(qhi, hi)
|
|
|
+ 953 OR (lo > hi) THEN
|
|
|
+ 954 SemError(230); ok := FALSE
|
|
|
+ 955 ELSIF NOT SymTab.BoundAdd(lo, hi) THEN
|
|
|
+ 956 SemError(230); ok := FALSE
|
|
|
+ 957 END;
|
|
|
+ 958 END; .) .
|
|
|
+ 959 (* Sets: multi-word masks over bases ≤ 256 values (bool, char,
|
|
|
+ 960 bounded subranges; enums wait for ordinals, INTEGER is
|
|
|
+ 961 unbounded). Literals are SET OF [0..255]; assignment and
|
|
|
+ 962 comparison across suitable bases are lenient (masks over min
|
|
|
+ 963 words + zero-check extras), out-of-span literals are 222. *)
|
|
|
+ 964 SetType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex;
|
|
|
+ 965 blo, bhi, bspan: INTEGER;
|
|
|
+ 966 bcls: INTEGER; .)
|
|
|
+ 967 = "SET" "OF" Type<base, FALSE>
|
|
|
+ 968 (. IF base = SymTab.InvalidType THEN
|
|
|
+ 969 t := SymTab.InvalidType
|
|
|
+ 970 ELSE bcls :=
|
|
|
+ 971 SymTab.ClassOf(base);
|
|
|
+ 972 IF bcls = SymTab.ClBool THEN
|
|
|
+ 973 blo := 0; bspan := 2
|
|
|
+ 974 ELSIF bcls = SymTab.ClChar THEN
|
|
|
+ 975 blo := 0; bspan := 256
|
|
|
+ 976 ELSIF bcls = SymTab.ClEnum THEN
|
|
|
+ 977 blo := 0;
|
|
|
+ 978 bspan := VAL(INTEGER,
|
|
|
+ 979 SymTab.EnumCount(base))
|
|
|
+ 980 ELSIF SymTab.SubBounds(base,
|
|
|
+ 981 blo, bhi) THEN
|
|
|
+ 982 bspan := bhi - blo + 1
|
|
|
+ 983 ELSE bspan := 0 END;
|
|
|
+ 984 IF (bspan <= 0)
|
|
|
+ 985 OR (bspan > 65536) THEN
|
|
|
+ 986 SemError(230);
|
|
|
+ 987 t := SymTab.InvalidType
|
|
|
+ 988 ELSE t := SymTab.NewSet(base)
|
|
|
+ 989 END
|
|
|
+ 990 END; .) .
|
|
|
+ 991 (* Records: flat blobs; array fields are pointers to static
|
|
|
+ 992 descriptors (locked amendment), nested records inline. Field
|
|
|
+ 993 offsets static and declaration-ordered. *)
|
|
|
+ 994 (* Field list: plain fields and (optionally) one variant part. The
|
|
|
+ 995 variant part is a `CASE ... END` item; because it starts with the
|
|
|
+ 996 CASE keyword it is unambiguously distinguishable from a field
|
|
|
+ 997 (which starts with an identifier). *)
|
|
|
+ 998 RecordType<VAR t: SymTab.TypeIndex> (. VAR t2: SymTab.TypeIndex;
|
|
|
+ 999 tagOk: BOOLEAN; .)
|
|
|
+ 1000 = "RECORD" (. t := SymTab.NewRecord(); .)
|
|
|
+ 1001 [ RecItem<t> { ";" [ RecItem<t> ] } ]
|
|
|
+ 1002 "END" (. SymTab.LayoutRecord(t); .) .
|
|
|
+ 1003 RecItem<rec: SymTab.TypeIndex> (. VAR tt: SymTab.TypeIndex; .)
|
|
|
+ 1004 = RecField<rec>
|
|
|
+ 1005 | CaseField<rec> (. SymTab.MarkVariant(rec); .) .
|
|
|
+ 1006 (* A variant part: CASE tag : Type OF variants. The layout overlays
|
|
|
+ 1007 every branch from the tag slot (see SymTab.ComputeOffsets). *)
|
|
|
+ 1008 CaseField<rec: SymTab.TypeIndex> (. VAR tagT: SymTab.TypeIndex;
|
|
|
+ 1009 tagN: SymTab.Name; .)
|
|
|
+ 1010 = "CASE" (. SymTab.ResetFields(rec); .)
|
|
|
+ 1011 GetIdent<tagN> (. IF NOT SymTab.FieldPending(rec,
|
|
|
+ 1012 tagN) THEN
|
|
|
1013 SemError(200) END; .)
|
|
|
- 1014 { "," GetIdent<n> (. IF NOT SymTab.FieldPending(rec,
|
|
|
- 1015 n) THEN
|
|
|
- 1016 SemError(200) END; .) } .
|
|
|
- 1017 TypeIdent<VAR t: SymTab.TypeIndex> (. VAR n, qid: SymTab.Name;
|
|
|
- 1018 k: INTEGER;
|
|
|
- 1019 dotted: BOOLEAN; .)
|
|
|
- 1020 = GetIdent<n> (. dotted := FALSE;
|
|
|
- 1021 IF NOT SymTab.Lookup(n) THEN
|
|
|
- 1022 k := -1;
|
|
|
- 1023 t := SymTab.ForwardType(n);
|
|
|
- 1024 IF t = SymTab.InvalidType THEN
|
|
|
- 1025 SemError(201)
|
|
|
- 1026 END
|
|
|
- 1027 ELSE k := SymTab.SymKind(n);
|
|
|
- 1028 IF (k = SymTab.KindType)
|
|
|
- 1029 OR (k = SymTab.KindPredef) THEN
|
|
|
- 1030 t := SymTab.SymType(n)
|
|
|
- 1031 ELSE t := SymTab.InvalidType
|
|
|
- 1032 END
|
|
|
- 1033 END; .)
|
|
|
- 1034 [ "." GetIdent<qid> (. dotted := TRUE;
|
|
|
- 1035 IF k = SymTab.KindModule THEN
|
|
|
- 1036 t := SymTab.QualType(n, qid);
|
|
|
- 1037 IF t = SymTab.InvalidType THEN
|
|
|
- 1038 SemError(201)
|
|
|
- 1039 END
|
|
|
- 1040 ELSE SemError(221);
|
|
|
- 1041 t := SymTab.InvalidType
|
|
|
- 1042 END; .) ]
|
|
|
- 1043 (. IF NOT dotted THEN
|
|
|
- 1044 IF (k = SymTab.KindModule)
|
|
|
- 1045 OR ((k # SymTab.KindType)
|
|
|
- 1046 AND (k # SymTab.KindPredef)
|
|
|
- 1047 AND (k # SymTab.KindImport)
|
|
|
- 1048 AND (k # -1)) THEN
|
|
|
- 1049 SemError(221)
|
|
|
- 1050 END
|
|
|
- 1051 END; .) .
|
|
|
- 1052 Subrange<VAR t: SymTab.TypeIndex> (. VAR tlo, thi: SymTab.TypeIndex;
|
|
|
- 1053 qlo, qhi: QbeGen.QVal;
|
|
|
- 1054 lo, hi: INTEGER; .)
|
|
|
- 1055 = "[" Expr<tlo, qlo> ".." Expr<thi, qhi>
|
|
|
- 1056 (. IF (tlo = SymTab.InvalidType)
|
|
|
- 1057 OR (thi = SymTab.InvalidType) THEN
|
|
|
- 1058 t := SymTab.InvalidType
|
|
|
- 1059 ELSIF NOT SymTab.IsOrdinal(tlo)
|
|
|
- 1060 OR NOT SymTab.IsOrdinal(thi) THEN
|
|
|
- 1061 SemError(230);
|
|
|
- 1062 t := SymTab.InvalidType
|
|
|
- 1063 ELSIF NOT SymTab.ConstInt(qlo, lo)
|
|
|
- 1064 OR NOT SymTab.ConstInt(qhi, hi)
|
|
|
- 1065 OR (lo > hi) THEN
|
|
|
- 1066 SemError(230);
|
|
|
- 1067 t := SymTab.InvalidType
|
|
|
- 1068 ELSE t := SymTab.NewSubR(lo, hi)
|
|
|
- 1069 END; .)
|
|
|
- 1070 "]" .
|
|
|
- 1071 Enum<VAR t: SymTab.TypeIndex> (. VAR n: SymTab.Name;
|
|
|
- 1072 ord: INTEGER;
|
|
|
- 1073 qv: QbeGen.QVal; .)
|
|
|
- 1074 = "(" (. t := SymTab.NewEnum();
|
|
|
- 1075 ord := 0; .)
|
|
|
- 1076 GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
- 1077 SymTab.KindConst) THEN
|
|
|
- 1078 SemError(200) END;
|
|
|
- 1079 SymTab.SetSymType(n, t);
|
|
|
- 1080 QbeGen.IntStr(ord, qv);
|
|
|
- 1081 SymTab.SetSymVal(n, qv);
|
|
|
- 1082 Lower.NoteVar(n,
|
|
|
- 1083 SymTab.KindConst, t);
|
|
|
- 1084 Lower.NoteConstVal(qv);
|
|
|
- 1085 INC(ord); .)
|
|
|
- 1086 { "," GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
- 1087 SymTab.KindConst) THEN
|
|
|
- 1088 SemError(200) END;
|
|
|
- 1089 SymTab.SetSymType(n, t);
|
|
|
- 1090 QbeGen.IntStr(ord, qv);
|
|
|
- 1091 SymTab.SetSymVal(n, qv);
|
|
|
- 1092 Lower.NoteVar(n,
|
|
|
- 1093 SymTab.KindConst, t);
|
|
|
- 1094 Lower.NoteConstVal(qv);
|
|
|
- 1095 INC(ord); .) }
|
|
|
- 1096 ")" (. SymTab.SetEnumCount(t,
|
|
|
- 1097 VAL(CARDINAL, ord)); .) .
|
|
|
- 1098 (* Clarion-form classes (docs/OOP.txt): declaration + single
|
|
|
- 1099 inheritance + IMPLEMENTATION blocks. Scopes and member checks
|
|
|
- 1100 now; lowering (vtable, dispatch, THIS) later — one 230 per
|
|
|
- 1101 class/impl block. Methods end with ";" per the Table example
|
|
|
- 1102 (not "," as in the sketch). No underscores in identifiers. *)
|
|
|
- 1103 (* Single CLASS item in both loops: separating declaration from
|
|
|
- 1104 IMPLEMENTATION at the loop level needs 2-token lookahead
|
|
|
- 1105 (CLASS ident vs CLASS IMPLEMENTATION), which LL(1) cannot do.
|
|
|
- 1106 The second token decides after CLASS is consumed. A misplaced
|
|
|
- 1107 CLASS IMPLEMENTATION inside TYPE still parses (harmless: the
|
|
|
- 1108 whole unit ends 230 until lowering). *)
|
|
|
- 1109 ClassItem
|
|
|
- 1110 = "CLASS" ( "IMPLEMENTATION" ClassImplRest | ClassRest ) .
|
|
|
- 1111 ClassRest (. VAR cn, m2, pn: SymTab.Name;
|
|
|
- 1112 ct: SymTab.TypeIndex; .)
|
|
|
- 1113 = GetIdent<cn> (. IF NOT SymTab.Enter(cn,
|
|
|
- 1114 SymTab.KindType) THEN
|
|
|
- 1115 SemError(200) END;
|
|
|
- 1116 ct := SymTab.NewClass();
|
|
|
- 1117 SymTab.SetSymType(cn, ct);
|
|
|
- 1118 SymTab.PushClassScope(ct);
|
|
|
- 1119 astCls := AST.MakeNode(AST.NkClassDecl);
|
|
|
- 1120 AST.SetChild(astCls, 0,
|
|
|
- 1121 AST.MakeLeaf(AST.NkIdent, cn));
|
|
|
- 1122 astClsP := AST.NoNode;
|
|
|
- 1123 astClsPTail := AST.NoNode;
|
|
|
- 1124 astClsF := AST.NoNode;
|
|
|
- 1125 astClsFTail := AST.NoNode;
|
|
|
- 1126 astClsM := AST.NoNode;
|
|
|
- 1127 astClsMTail := AST.NoNode; .)
|
|
|
- 1128 [ Parents<ct> ]
|
|
|
- 1129 ";"
|
|
|
- 1130 { ClassField<ct> ";" }
|
|
|
- 1131 { MethodHeading<pn, SymTab.InvalidType> ";"
|
|
|
- 1132 (. Lower.ScopeLeave;
|
|
|
- 1133 SymTab.CloseProc;
|
|
|
- 1134 QbeGen.AbortFunc; .) }
|
|
|
- 1135 "END"
|
|
|
- 1136 GetIdent<m2> (. IF NOT SymTab.Equal(cn, m2) THEN
|
|
|
- 1137 SemError(202) END;
|
|
|
- 1138 SymTab.LayoutClass(ct);
|
|
|
- 1139 SymTab.PopScope;
|
|
|
- 1140 AST.SetChild(astCls, 1, astClsP);
|
|
|
- 1141 AST.SetChild(astCls, 2, astClsF);
|
|
|
- 1142 AST.SetChild(astCls, 3, astClsM);
|
|
|
- 1143 astDecl := astCls; .) .
|
|
|
- 1144 Parents<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name; .)
|
|
|
- 1145 = "(" Parent1<ct>
|
|
|
- 1146 { "," GetIdent<p> (. SemError(230); .) }
|
|
|
- 1147 ")" .
|
|
|
- 1148 Parent1<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name;
|
|
|
- 1149 pt: SymTab.TypeIndex; .)
|
|
|
- 1150 = GetIdent<p> (. IF NOT SymTab.Lookup(p) THEN
|
|
|
- 1151 SemError(201)
|
|
|
- 1152 ELSE pt := SymTab.SymType(p);
|
|
|
- 1153 IF SymTab.ClassOf(pt) #
|
|
|
- 1154 SymTab.ClClass THEN
|
|
|
- 1155 SemError(230)
|
|
|
- 1156 ELSE SymTab.SetParent(ct, pt)
|
|
|
- 1157 END
|
|
|
- 1158 END;
|
|
|
- 1159 AstAppend(AST.NkFieldDecl,
|
|
|
- 1160 astClsP, astClsPTail,
|
|
|
- 1161 AST.MakeLeaf(AST.NkIdent, p)); .) .
|
|
|
- 1162 ClassField<ct: SymTab.TypeIndex> (. VAR n, rhs: SymTab.Name;
|
|
|
- 1163 t: SymTab.TypeIndex;
|
|
|
- 1164 astNode: AST.Node; .)
|
|
|
- 1165 = GetIdent<n>
|
|
|
- 1166 ( "=" GetIdent<rhs> (. IF NOT SymTab.Enter(n,
|
|
|
- 1167 SymTab.KindConst) THEN
|
|
|
- 1168 SemError(200) END;
|
|
|
- 1169 astNode := AST.MakeNode(AST.NkConstDecl);
|
|
|
- 1170 AST.SetChild(astNode, 0,
|
|
|
- 1171 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
- 1172 AST.SetChild(astNode, 1,
|
|
|
- 1173 AST.MakeLeaf(AST.NkIdent, rhs));
|
|
|
- 1174 AstAppend(AST.NkFieldDecl,
|
|
|
- 1175 astClsF, astClsFTail, astNode);
|
|
|
- 1176 IF SymTab.Lookup(rhs) THEN
|
|
|
- 1177 SymTab.SetSymType(n,
|
|
|
- 1178 SymTab.SymType(rhs))
|
|
|
- 1179 END; .)
|
|
|
- 1180 | (. IF NOT SymTab.FieldPending(ct,
|
|
|
- 1181 n) THEN
|
|
|
- 1182 SemError(200) END;
|
|
|
- 1183 astNode := AST.MakeNode(AST.NkVarDecl);
|
|
|
- 1184 AST.SetChild(astNode, 0,
|
|
|
- 1185 AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
- 1186 { "," GetIdent<n> (. IF NOT SymTab.FieldPending(ct,
|
|
|
- 1187 n) THEN
|
|
|
- 1188 SemError(200) END;
|
|
|
- 1189 AST.SetChild(astNode,
|
|
|
- 1190 AST.NChild(astNode),
|
|
|
- 1191 AST.MakeLeaf(AST.NkIdent, n)); .) }
|
|
|
- 1192 ":" Type<t, FALSE> (. SymTab.FixPendingF(ct, t);
|
|
|
- 1193 AST.SetTy(astNode, t);
|
|
|
+ 1014 ":" Type<tagT, FALSE> (. IF (tagT # SymTab.InvalidType)
|
|
|
+ 1015 AND NOT SymTab.IsOrdinal(tagT) THEN
|
|
|
+ 1016 SemError(224)
|
|
|
+ 1017 END;
|
|
|
+ 1018 SymTab.FixPendingF(rec, tagT);
|
|
|
+ 1019 SymTab.SetVariantTag(rec, tagN); .)
|
|
|
+ 1020 "OF"
|
|
|
+ 1021 RecFieldList<rec>
|
|
|
+ 1022 { "|" (. SymTab.ResetFields(rec); .)
|
|
|
+ 1023 RecFieldList<rec> }
|
|
|
+ 1024 "END" .
|
|
|
+ 1025 RecFieldList<rec: SymTab.TypeIndex> (. VAR lt, lq: SymTab.TypeIndex;
|
|
|
+ 1026 lv1, lv2: QbeGen.QVal; .)
|
|
|
+ 1027 = VarLabel<lt, lv1> [ ".." VarLabel<lq, lv2> ] ":"
|
|
|
+ 1028 RecField<rec> { ";" [ RecField<rec> ] } .
|
|
|
+ 1029 (* Variant case label: a constant (or a constant range). Values are
|
|
|
+ 1030 not interpreted (the layout overlays regardless). *)
|
|
|
+ 1031 VarLabel<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 1032 (. VAR lname: SymTab.Name; .)
|
|
|
+ 1033 = ( ident (. LexName(lname);
|
|
|
+ 1034 QbeGen.CopyOp("0", q);
|
|
|
+ 1035 t := SymTab.IntType(); .)
|
|
|
+ 1036 | integer (. LexString(lname);
|
|
|
+ 1037 QbeGen.CopyOp("0", q);
|
|
|
+ 1038 t := SymTab.IntType(); .)
|
|
|
+ 1039 | charConst (. LexString(lname);
|
|
|
+ 1040 QbeGen.CopyOp("0", q);
|
|
|
+ 1041 t := SymTab.CharType(); .) ) .
|
|
|
+ 1042 RecField<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name;
|
|
|
+ 1043 t2: SymTab.TypeIndex; .)
|
|
|
+ 1044 = RecIdents<rec> ":" Type<t2, FALSE>(. SymTab.FixPendingF(rec, t2); .) .
|
|
|
+ 1045 RecIdents<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name; .)
|
|
|
+ 1046 = GetIdent<n> (. IF NOT SymTab.FieldPending(rec,
|
|
|
+ 1047 n) THEN
|
|
|
+ 1048 SemError(200) END; .)
|
|
|
+ 1049 { "," GetIdent<n> (. IF NOT SymTab.FieldPending(rec,
|
|
|
+ 1050 n) THEN
|
|
|
+ 1051 SemError(200) END; .) } .
|
|
|
+ 1052 TypeIdent<VAR t: SymTab.TypeIndex> (. VAR n, qid: SymTab.Name;
|
|
|
+ 1053 k: INTEGER;
|
|
|
+ 1054 dotted: BOOLEAN; .)
|
|
|
+ 1055 = GetIdent<n> (. dotted := FALSE;
|
|
|
+ 1056 IF NOT SymTab.Lookup(n) THEN
|
|
|
+ 1057 k := -1;
|
|
|
+ 1058 t := SymTab.ForwardType(n);
|
|
|
+ 1059 IF t = SymTab.InvalidType THEN
|
|
|
+ 1060 SemError(201)
|
|
|
+ 1061 END
|
|
|
+ 1062 ELSE k := SymTab.SymKind(n);
|
|
|
+ 1063 IF (k = SymTab.KindType)
|
|
|
+ 1064 OR (k = SymTab.KindPredef) THEN
|
|
|
+ 1065 t := SymTab.SymType(n)
|
|
|
+ 1066 ELSE t := SymTab.InvalidType
|
|
|
+ 1067 END
|
|
|
+ 1068 END; .)
|
|
|
+ 1069 [ "." GetIdent<qid> (. dotted := TRUE;
|
|
|
+ 1070 IF k = SymTab.KindModule THEN
|
|
|
+ 1071 t := SymTab.QualType(n, qid);
|
|
|
+ 1072 IF t = SymTab.InvalidType THEN
|
|
|
+ 1073 SemError(201)
|
|
|
+ 1074 END
|
|
|
+ 1075 ELSE SemError(221);
|
|
|
+ 1076 t := SymTab.InvalidType
|
|
|
+ 1077 END; .) ]
|
|
|
+ 1078 (. IF NOT dotted THEN
|
|
|
+ 1079 IF (k = SymTab.KindModule)
|
|
|
+ 1080 OR ((k # SymTab.KindType)
|
|
|
+ 1081 AND (k # SymTab.KindPredef)
|
|
|
+ 1082 AND (k # SymTab.KindImport)
|
|
|
+ 1083 AND (k # -1)) THEN
|
|
|
+ 1084 SemError(221)
|
|
|
+ 1085 END
|
|
|
+ 1086 END; .) .
|
|
|
+ 1087 Subrange<VAR t: SymTab.TypeIndex> (. VAR tlo, thi: SymTab.TypeIndex;
|
|
|
+ 1088 qlo, qhi: QbeGen.QVal;
|
|
|
+ 1089 lo, hi: INTEGER; .)
|
|
|
+ 1090 = "[" Expr<tlo, qlo> ".." Expr<thi, qhi>
|
|
|
+ 1091 (. IF (tlo = SymTab.InvalidType)
|
|
|
+ 1092 OR (thi = SymTab.InvalidType) THEN
|
|
|
+ 1093 t := SymTab.InvalidType
|
|
|
+ 1094 ELSIF NOT SymTab.IsOrdinal(tlo)
|
|
|
+ 1095 OR NOT SymTab.IsOrdinal(thi) THEN
|
|
|
+ 1096 SemError(230);
|
|
|
+ 1097 t := SymTab.InvalidType
|
|
|
+ 1098 ELSIF NOT SymTab.ConstInt(qlo, lo)
|
|
|
+ 1099 OR NOT SymTab.ConstInt(qhi, hi)
|
|
|
+ 1100 OR (lo > hi) THEN
|
|
|
+ 1101 SemError(230);
|
|
|
+ 1102 t := SymTab.InvalidType
|
|
|
+ 1103 ELSE t := SymTab.NewSubR(lo, hi)
|
|
|
+ 1104 END; .)
|
|
|
+ 1105 "]" .
|
|
|
+ 1106 Enum<VAR t: SymTab.TypeIndex> (. VAR n: SymTab.Name;
|
|
|
+ 1107 ord: INTEGER;
|
|
|
+ 1108 qv: QbeGen.QVal; .)
|
|
|
+ 1109 = "(" (. t := SymTab.NewEnum();
|
|
|
+ 1110 ord := 0; .)
|
|
|
+ 1111 GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
+ 1112 SymTab.KindConst) THEN
|
|
|
+ 1113 SemError(200) END;
|
|
|
+ 1114 SymTab.SetSymType(n, t);
|
|
|
+ 1115 QbeGen.IntStr(ord, qv);
|
|
|
+ 1116 SymTab.SetSymVal(n, qv);
|
|
|
+ 1117 Lower.NoteVar(n,
|
|
|
+ 1118 SymTab.KindConst, t);
|
|
|
+ 1119 Lower.NoteConstVal(qv);
|
|
|
+ 1120 INC(ord); .)
|
|
|
+ 1121 { "," GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
+ 1122 SymTab.KindConst) THEN
|
|
|
+ 1123 SemError(200) END;
|
|
|
+ 1124 SymTab.SetSymType(n, t);
|
|
|
+ 1125 QbeGen.IntStr(ord, qv);
|
|
|
+ 1126 SymTab.SetSymVal(n, qv);
|
|
|
+ 1127 Lower.NoteVar(n,
|
|
|
+ 1128 SymTab.KindConst, t);
|
|
|
+ 1129 Lower.NoteConstVal(qv);
|
|
|
+ 1130 INC(ord); .) }
|
|
|
+ 1131 ")" (. SymTab.SetEnumCount(t,
|
|
|
+ 1132 VAL(CARDINAL, ord)); .) .
|
|
|
+ 1133 (* Clarion-form classes (docs/OOP.txt): declaration + single
|
|
|
+ 1134 inheritance + IMPLEMENTATION blocks. Scopes and member checks
|
|
|
+ 1135 now; lowering (vtable, dispatch, THIS) later — one 230 per
|
|
|
+ 1136 class/impl block. Methods end with ";" per the Table example
|
|
|
+ 1137 (not "," as in the sketch). No underscores in identifiers. *)
|
|
|
+ 1138 (* Single CLASS item in both loops: separating declaration from
|
|
|
+ 1139 IMPLEMENTATION at the loop level needs 2-token lookahead
|
|
|
+ 1140 (CLASS ident vs CLASS IMPLEMENTATION), which LL(1) cannot do.
|
|
|
+ 1141 The second token decides after CLASS is consumed. A misplaced
|
|
|
+ 1142 CLASS IMPLEMENTATION inside TYPE still parses (harmless: the
|
|
|
+ 1143 whole unit ends 230 until lowering). *)
|
|
|
+ 1144 ClassItem
|
|
|
+ 1145 = "CLASS" ( "IMPLEMENTATION" ClassImplRest | ClassRest ) .
|
|
|
+ 1146 ClassRest (. VAR cn, m2, pn: SymTab.Name;
|
|
|
+ 1147 ct: SymTab.TypeIndex; .)
|
|
|
+ 1148 = GetIdent<cn> (. IF NOT SymTab.Enter(cn,
|
|
|
+ 1149 SymTab.KindType) THEN
|
|
|
+ 1150 SemError(200) END;
|
|
|
+ 1151 ct := SymTab.NewClass();
|
|
|
+ 1152 SymTab.SetSymType(cn, ct);
|
|
|
+ 1153 SymTab.PushClassScope(ct);
|
|
|
+ 1154 astCls := AST.MakeNode(AST.NkClassDecl);
|
|
|
+ 1155 AST.SetChild(astCls, 0,
|
|
|
+ 1156 AST.MakeLeaf(AST.NkIdent, cn));
|
|
|
+ 1157 astClsP := AST.NoNode;
|
|
|
+ 1158 astClsPTail := AST.NoNode;
|
|
|
+ 1159 astClsF := AST.NoNode;
|
|
|
+ 1160 astClsFTail := AST.NoNode;
|
|
|
+ 1161 astClsM := AST.NoNode;
|
|
|
+ 1162 astClsMTail := AST.NoNode; .)
|
|
|
+ 1163 [ Parents<ct> ]
|
|
|
+ 1164 ";"
|
|
|
+ 1165 { ClassField<ct> ";" }
|
|
|
+ 1166 { MethodHeading<pn, SymTab.InvalidType> ";"
|
|
|
+ 1167 (. Lower.ScopeLeave;
|
|
|
+ 1168 SymTab.CloseProc;
|
|
|
+ 1169 QbeGen.AbortFunc; .) }
|
|
|
+ 1170 "END"
|
|
|
+ 1171 GetIdent<m2> (. IF NOT SymTab.Equal(cn, m2) THEN
|
|
|
+ 1172 SemError(202) END;
|
|
|
+ 1173 SymTab.LayoutClass(ct);
|
|
|
+ 1174 SymTab.PopScope;
|
|
|
+ 1175 AST.SetChild(astCls, 1, astClsP);
|
|
|
+ 1176 AST.SetChild(astCls, 2, astClsF);
|
|
|
+ 1177 AST.SetChild(astCls, 3, astClsM);
|
|
|
+ 1178 astDecl := astCls; .) .
|
|
|
+ 1179 Parents<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name; .)
|
|
|
+ 1180 = "(" Parent1<ct>
|
|
|
+ 1181 { "," GetIdent<p> (. SemError(230); .) }
|
|
|
+ 1182 ")" .
|
|
|
+ 1183 Parent1<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name;
|
|
|
+ 1184 pt: SymTab.TypeIndex; .)
|
|
|
+ 1185 = GetIdent<p> (. IF NOT SymTab.Lookup(p) THEN
|
|
|
+ 1186 SemError(201)
|
|
|
+ 1187 ELSE pt := SymTab.SymType(p);
|
|
|
+ 1188 IF SymTab.ClassOf(pt) #
|
|
|
+ 1189 SymTab.ClClass THEN
|
|
|
+ 1190 SemError(230)
|
|
|
+ 1191 ELSE SymTab.SetParent(ct, pt)
|
|
|
+ 1192 END
|
|
|
+ 1193 END;
|
|
|
1194 AstAppend(AST.NkFieldDecl,
|
|
|
- 1195 astClsF, astClsFTail, astNode); .) ) .
|
|
|
- 1196 MethodHeading<VAR pn: SymTab.Name; ct: SymTab.TypeIndex>
|
|
|
- 1197 (. VAR wantVirt: BOOLEAN; .)
|
|
|
- 1198 = (. wantVirt := FALSE; .)
|
|
|
- 1199 [ "VIRTUAL" (. wantVirt := TRUE; .) ]
|
|
|
- 1200 ProcHeading<pn, ct> (. IF wantVirt THEN
|
|
|
- 1201 SymTab.MarkVirtual END;
|
|
|
- 1202 astMethod := AST.MakeNode(AST.NkProcDecl);
|
|
|
- 1203 AST.SetChild(astMethod, 0,
|
|
|
- 1204 AST.MakeLeaf(AST.NkIdent, pn));
|
|
|
- 1205 IF wantVirt THEN
|
|
|
- 1206 AST.SetOp(astMethod, 3)
|
|
|
- 1207 ELSE AST.SetOp(astMethod, 0)
|
|
|
- 1208 END;
|
|
|
+ 1195 astClsP, astClsPTail,
|
|
|
+ 1196 AST.MakeLeaf(AST.NkIdent, p)); .) .
|
|
|
+ 1197 ClassField<ct: SymTab.TypeIndex> (. VAR n, rhs: SymTab.Name;
|
|
|
+ 1198 t: SymTab.TypeIndex;
|
|
|
+ 1199 astNode: AST.Node; .)
|
|
|
+ 1200 = GetIdent<n>
|
|
|
+ 1201 ( "=" GetIdent<rhs> (. IF NOT SymTab.Enter(n,
|
|
|
+ 1202 SymTab.KindConst) THEN
|
|
|
+ 1203 SemError(200) END;
|
|
|
+ 1204 astNode := AST.MakeNode(AST.NkConstDecl);
|
|
|
+ 1205 AST.SetChild(astNode, 0,
|
|
|
+ 1206 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
+ 1207 AST.SetChild(astNode, 1,
|
|
|
+ 1208 AST.MakeLeaf(AST.NkIdent, rhs));
|
|
|
1209 AstAppend(AST.NkFieldDecl,
|
|
|
- 1210 astClsM, astClsMTail, astMethod); .) .
|
|
|
- 1211 ClassImplRest (. VAR cn, m2: SymTab.Name;
|
|
|
- 1212 ct: SymTab.TypeIndex; .)
|
|
|
- 1213 = GetIdent<cn> (. IF NOT SymTab.Lookup(cn) THEN
|
|
|
- 1214 SemError(201);
|
|
|
- 1215 ct := SymTab.InvalidType
|
|
|
- 1216 ELSE ct := SymTab.SymType(cn);
|
|
|
- 1217 IF SymTab.ClassOf(ct) #
|
|
|
- 1218 SymTab.ClClass THEN
|
|
|
- 1219 SemError(230);
|
|
|
- 1220 ct := SymTab.InvalidType
|
|
|
- 1221 END
|
|
|
- 1222 END;
|
|
|
- 1223 astCls := AST.MakeNode(AST.NkClassDecl);
|
|
|
- 1224 AST.SetOp(astCls, 1);
|
|
|
- 1225 AST.SetChild(astCls, 0,
|
|
|
- 1226 AST.MakeLeaf(AST.NkIdent, cn));
|
|
|
- 1227 astClsM := AST.NoNode;
|
|
|
- 1228 astClsMTail := AST.NoNode;
|
|
|
- 1229 astStmt := AST.NoNode;
|
|
|
- 1230 IF ct #
|
|
|
- 1231 SymTab.InvalidType THEN
|
|
|
- 1232 IF NOT SymTab.PushClassMembers(
|
|
|
- 1233 ct) THEN
|
|
|
- 1234 SemError(230) END;
|
|
|
- 1235 SymTab.PushImplClass(ct)
|
|
|
- 1236 END; .)
|
|
|
- 1237 ";" { MethodImpl<ct> ";" }
|
|
|
- 1238 (. astStmt := AST.NoNode; .)
|
|
|
- 1239 [ "BEGIN" (. astStmt := AST.MakeNode(AST.NkBlock);
|
|
|
- 1240 .)
|
|
|
- 1241 [ StatSeq ] ]
|
|
|
- 1242 "END"
|
|
|
- 1243 GetIdent<m2> (. IF NOT SymTab.Equal(cn, m2) THEN
|
|
|
- 1244 SemError(202) END;
|
|
|
- 1245 SymTab.PopImplClass;
|
|
|
- 1246 SymTab.PopScope;
|
|
|
- 1247 AST.SetChild(astCls, 1, AST.NoNode);
|
|
|
- 1248 AST.SetChild(astCls, 2, astStmt);
|
|
|
- 1249 AST.SetChild(astCls, 3, astClsM);
|
|
|
- 1250 astDecl := astCls; .) .
|
|
|
- 1251 MethodImpl<ct: SymTab.TypeIndex> (. VAR pn: SymTab.Name;
|
|
|
- 1252 thisQ: QbeGen.QVal;
|
|
|
- 1253 methRes: SymTab.TypeIndex; .)
|
|
|
- 1254 = MethodHeading<pn, ct> ";"
|
|
|
- 1255 (. IF (ct #
|
|
|
- 1256 SymTab.InvalidType)
|
|
|
- 1257 AND NOT SymTab.MethodExists(ct,
|
|
|
- 1258 pn) THEN
|
|
|
- 1259 SemError(201) END; .)
|
|
|
- 1260 ( "FORWARD" (. AST.SetOp(astMethod, 1);
|
|
|
- 1261 SymTab.MarkFwd;
|
|
|
- 1262 QbeGen.AbortFunc;
|
|
|
- 1263 Lower.ScopeLeave;
|
|
|
- 1264 SymTab.CloseProc; .)
|
|
|
- 1265 | (.
|
|
|
- 1266 (* bind the receiver: bare
|
|
|
- 1267 field names resolve
|
|
|
- 1268 against THIS *)
|
|
|
- 1269 QbeGen.CopyOp("@", thisQ);
|
|
|
- 1270 QbeGen.PushWith(thisQ); .)
|
|
|
- 1271 Block<pn> (. AST.SetChild(astMethod, 1, astStmt);
|
|
|
- 1272 AST.SetChild(astMethod, 2, astBlkDecls);
|
|
|
- 1273 QbeGen.PopWith;
|
|
|
- 1274 methRes := SymTab.CurRes();
|
|
|
- 1275 Lower.ScopeLeave;
|
|
|
- 1276 SymTab.CloseProc;
|
|
|
- 1277 QbeGen.EndFunc(methRes); .) ) .
|
|
|
- 1278 ConstBlock (. VAR astSeq, astTail: AST.Node; .)
|
|
|
- 1279 = "CONST" (. astSeq := AST.NoNode;
|
|
|
- 1280 astTail := AST.NoNode; .)
|
|
|
- 1281 { ConstDecl ";" (. AstAppend(AST.NkDeclSeq,
|
|
|
- 1282 astSeq, astTail, astDecl); .) }
|
|
|
- 1283 (. astDecl := astSeq; .) .
|
|
|
- 1284 ConstDecl (. VAR n: SymTab.Name;
|
|
|
- 1285 t: SymTab.TypeIndex;
|
|
|
- 1286 qv: QbeGen.QVal;
|
|
|
- 1287 cls: INTEGER;
|
|
|
- 1288 astNode: AST.Node; .)
|
|
|
- 1289 = GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
- 1290 SymTab.KindConst) THEN
|
|
|
- 1291 SemError(200) END; .)
|
|
|
- 1292 "="
|
|
|
- 1293 Expr<t, qv> (. astNode := AST.MakeNode(AST.NkConstDecl);
|
|
|
- 1294 AST.SetChild(astNode, 0,
|
|
|
- 1295 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
- 1296 AST.SetChild(astNode, 1, astCur);
|
|
|
- 1297 AST.SetTy(astNode, t);
|
|
|
- 1298 astDecl := astNode;
|
|
|
- 1299 Lower.NoteVar(n, SymTab.KindConst, t);
|
|
|
- 1300 Lower.NoteConstVal(qv);
|
|
|
- 1301 SymTab.SetSymType(n, t);
|
|
|
- 1302 cls := SymTab.ClassOf(t);
|
|
|
- 1303 IF (cls = SymTab.ClArray)
|
|
|
- 1304 OR (cls = SymTab.ClRecord)
|
|
|
- 1305 OR (cls = SymTab.ClClass)
|
|
|
- 1306 OR (cls = SymTab.ClStr)
|
|
|
- 1307 OR (cls = SymTab.ClUStr) THEN
|
|
|
- 1308 (* an aggregate/string
|
|
|
- 1309 constant: qv is its
|
|
|
- 1310 descriptor address; no
|
|
|
- 1311 scalar data *)
|
|
|
- 1312 SymTab.SetSymVal(n, qv)
|
|
|
- 1313 ELSIF NOT QbeGen.IsImm(qv) THEN
|
|
|
- 1314 SemError(230)
|
|
|
- 1315 ELSE
|
|
|
- 1316 SymTab.SetSymVal(n, qv);
|
|
|
- 1317 END; .) .
|
|
|
- 1318 VarBlock (. VAR astSeq, astTail: AST.Node; .)
|
|
|
- 1319 = "VAR" (. astSeq := AST.NoNode;
|
|
|
- 1320 astTail := AST.NoNode; .)
|
|
|
- 1321 { VarDecl ";" (. AstAppend(AST.NkDeclSeq,
|
|
|
- 1322 astSeq, astTail, astDecl); .) }
|
|
|
- 1323 (. astDecl := astSeq; .) .
|
|
|
- 1324 VarDecl (. VAR nm: SymTab.Name;
|
|
|
- 1325 t: SymTab.TypeIndex;
|
|
|
- 1326 i: CARDINAL;
|
|
|
- 1327 cls: INTEGER;
|
|
|
- 1328 astNode, astTail: AST.Node; .)
|
|
|
- 1329 = VarIdents ":"
|
|
|
- 1330 Type<t, FALSE> (. astNode := AST.MakeNode(AST.NkVarDecl);
|
|
|
- 1331 astTail := astNode;
|
|
|
- 1332 i := 0;
|
|
|
- 1333 WHILE i < SymTab.PendCount() DO
|
|
|
- 1334 SymTab.PendName(i, nm);
|
|
|
- 1335 Lower.NoteVar(nm, SymTab.KindVar, t);
|
|
|
- 1336 (* chunked: a VAR list can
|
|
|
- 1337 exceed AST.MaxChild *)
|
|
|
- 1338 AstAppend(AST.NkBlock,
|
|
|
- 1339 astNode, astTail,
|
|
|
- 1340 AST.MakeLeaf(AST.NkIdent, nm));
|
|
|
- 1341 INC(i)
|
|
|
- 1342 END;
|
|
|
- 1343 AST.SetTy(astNode, t);
|
|
|
- 1344 astDecl := astNode;
|
|
|
- 1345 cls := SymTab.ClassOf(t);
|
|
|
- 1346 IF (t # SymTab.InvalidType)
|
|
|
- 1347 AND NOT SymTab.IsUnresolved(t)
|
|
|
- 1348 AND (cls # SymTab.ClInt)
|
|
|
- 1349 AND (cls # SymTab.ClBool)
|
|
|
- 1350 AND (cls # SymTab.ClChar)
|
|
|
- 1351 AND (cls # SymTab.ClReal)
|
|
|
- 1352 AND (cls # SymTab.ClArray)
|
|
|
- 1353 AND (cls # SymTab.ClSet)
|
|
|
- 1354 AND (cls # SymTab.ClRecord)
|
|
|
- 1355 AND (cls # SymTab.ClPtr)
|
|
|
- 1356 AND (cls # SymTab.ClLong)
|
|
|
- 1357 AND (cls # SymTab.ClProc)
|
|
|
- 1358 AND (cls # SymTab.ClUChar)
|
|
|
- 1359 AND (cls # SymTab.ClUStr)
|
|
|
- 1360 AND (cls # SymTab.ClEnum)
|
|
|
- 1361 AND (cls # SymTab.ClClass) THEN
|
|
|
- 1362 SemError(230) END;
|
|
|
- 1363 IF QbeGen.LocFull() THEN
|
|
|
- 1364 SemError(233) END;
|
|
|
- 1365 i := 0;
|
|
|
- 1366 IF SymTab.IsUnresolved(t)
|
|
|
- 1367 AND NOT SymTab.InProc() THEN
|
|
|
- 1368 (* a forward-typed global:
|
|
|
- 1369 defer emission until the
|
|
|
- 1370 TYPE block completes *)
|
|
|
- 1371 AST.SetOp(astNode, 1);
|
|
|
- 1372 WHILE i < SymTab.PendCount() DO
|
|
|
- 1373 SymTab.PendName(i, nm);
|
|
|
- 1374 IF nPendVar <=
|
|
|
- 1375 HIGH(pendVarName) THEN
|
|
|
- 1376 pendVarName[nPendVar] := nm;
|
|
|
- 1377 pendVarT[nPendVar] := t;
|
|
|
- 1378 INC(nPendVar)
|
|
|
- 1379 END;
|
|
|
- 1380 INC(i)
|
|
|
- 1381 END
|
|
|
- 1382 ELSE
|
|
|
- 1383 WHILE i < SymTab.PendCount() DO
|
|
|
- 1384 SymTab.PendName(i, nm);
|
|
|
- 1385 INC(i)
|
|
|
- 1386 END
|
|
|
- 1387 END;
|
|
|
- 1388 (* a plain VAR list, not a
|
|
|
- 1389 heading: the signature
|
|
|
- 1390 result is discarded *)
|
|
|
- 1391 IF NOT SymTab.FixPending(t) THEN
|
|
|
- 1392 END; .) .
|
|
|
- 1393 VarIdents (. VAR n: SymTab.Name; .)
|
|
|
- 1394 = GetIdent<n> (. IF NOT SymTab.EnterPending(n,
|
|
|
- 1395 SymTab.KindVar) THEN
|
|
|
- 1396 SemError(200) END; .)
|
|
|
- 1397 { ","
|
|
|
- 1398 GetIdent<n> (. IF NOT SymTab.EnterPending(n,
|
|
|
- 1399 SymTab.KindVar) THEN
|
|
|
- 1400 SemError(200) END; .) } .
|
|
|
- 1401 ParIdents<isV: BOOLEAN> (. VAR n: SymTab.Name; .)
|
|
|
- 1402 = GetIdent<n> (. IF NOT SymTab.EnterParam(n, isV) THEN
|
|
|
- 1403 SemError(200) END; .)
|
|
|
- 1404 { "," GetIdent<n> (. IF NOT SymTab.EnterParam(n, isV) THEN
|
|
|
- 1405 SemError(200) END; .) } .
|
|
|
- 1406 (* Procedure headings enter scopes/params/result and buffer the
|
|
|
- 1407 QBE header; bodies lower to functions (4.1, module level only).
|
|
|
- 1408 FORWARD marks; the body heading re-enters (signature compare
|
|
|
- 1409 deferred). Nested procedures parse + check, lowering = 4.2. *)
|
|
|
- 1410 ProcHeading<VAR pn: SymTab.Name; methCls: SymTab.TypeIndex>
|
|
|
- 1411 (. VAR t: SymTab.TypeIndex;
|
|
|
- 1412 mg: QbeGen.QVal; .)
|
|
|
- 1413 = "PROCEDURE"
|
|
|
- 1414 GetIdent<pn> (. IF methCls #
|
|
|
- 1415 SymTab.InvalidType THEN
|
|
|
- 1416 (* a method: resume the
|
|
|
- 1417 declared symbol (reuse
|
|
|
- 1418 its uid) *)
|
|
|
- 1419 IF NOT SymTab.ResumeMethod(
|
|
|
- 1420 methCls, pn) THEN
|
|
|
- 1421 SemError(200) END
|
|
|
- 1422 ELSIF NOT SymTab.EnterProc(pn) THEN
|
|
|
- 1423 IF NOT SymTab.ReenterProc(pn) THEN
|
|
|
- 1424 IF NOT SymTab.ResumeProc(pn) THEN
|
|
|
- 1425 SemError(200) END
|
|
|
- 1426 END
|
|
|
- 1427 END;
|
|
|
- 1428 Lower.ScopeEnter;
|
|
|
- 1429 Lower.NoteProc(pn,
|
|
|
- 1430 SymTab.ProcUid(pn),
|
|
|
- 1431 SymTab.InvalidType,
|
|
|
- 1432 SymTab.ProcDepthOf(pn),
|
|
|
- 1433 FALSE);
|
|
|
- 1434 QbeGen.BeginFunc("");
|
|
|
- 1435 IF methCls #
|
|
|
- 1436 SymTab.InvalidType THEN
|
|
|
- 1437 (* hidden THIS receiver:
|
|
|
- 1438 a VAR param of the
|
|
|
- 1439 class type, pushed as
|
|
|
- 1440 the WITH base *)
|
|
|
- 1441 IF NOT SymTab.EnterThisParam(
|
|
|
- 1442 methCls) THEN
|
|
|
- 1443 SemError(200) END;
|
|
|
- 1444 IF NOT QbeGen.FuncParam(
|
|
|
- 1445 "THIS", TRUE,
|
|
|
- 1446 methCls) THEN
|
|
|
- 1447 SemError(233) END
|
|
|
- 1448 END; .)
|
|
|
- 1449 [ FormalParams ]
|
|
|
- 1450 [ ":" TypeIdent<t> (. IF NOT SymTab.SetProcRes(t) THEN
|
|
|
- 1451 SemError(235) END;
|
|
|
- 1452 Lower.SetProcRes(t); .) ] .
|
|
|
- 1453 FormalParams
|
|
|
- 1454 = "(" [ ParamSection { ";" ParamSection } ] ")" .
|
|
|
- 1455 ParamSection (. VAR t: SymTab.TypeIndex;
|
|
|
- 1456 nm: SymTab.Name;
|
|
|
- 1457 i: CARDINAL;
|
|
|
- 1458 isV: BOOLEAN; .)
|
|
|
- 1459 = (. isV := FALSE; .)
|
|
|
- 1460 [ "VAR" (. isV := TRUE; .) ]
|
|
|
- 1461 ParIdents<isV> ":" Type<t, TRUE> (. i := 0;
|
|
|
- 1462 WHILE i < SymTab.PendCount() DO
|
|
|
- 1463 SymTab.PendName(i, nm);
|
|
|
- 1464 Lower.NoteParam(nm, t, isV);
|
|
|
- 1465 Lower.NoteVar(nm, SymTab.KindParam, t);
|
|
|
- 1466 (* value open arrays are
|
|
|
- 1467 passed as descriptor
|
|
|
- 1468 addresses (no copy):
|
|
|
- 1469 same representation as
|
|
|
- 1470 VAR formals *)
|
|
|
- 1471 IF NOT QbeGen.FuncParam(nm,
|
|
|
- 1472 isV
|
|
|
- 1473 OR SymTab.IsOpenArray(t),
|
|
|
- 1474 t) THEN
|
|
|
- 1475 SemError(233) END;
|
|
|
- 1476 INC(i)
|
|
|
- 1477 END;
|
|
|
- 1478 IF NOT SymTab.FixPending(t) THEN
|
|
|
- 1479 SemError(235) END; .) .
|
|
|
- 1480 (* Nested procedures lower like top-level ones (4.2): the
|
|
|
- 1481 static link gives them their parent's frame. Methods keep
|
|
|
- 1482 parse-now/230-later. *)
|
|
|
- 1483 ProcDecl (. VAR pn: SymTab.Name;
|
|
|
- 1484 astNode: AST.Node; .)
|
|
|
- 1485 = ProcHeading<pn, SymTab.InvalidType> ";"
|
|
|
- 1486 (. astNode := AST.MakeNode(AST.NkProcDecl);
|
|
|
- 1487 AST.SetOp(astNode, 0);
|
|
|
- 1488 AST.SetChild(astNode, 0,
|
|
|
- 1489 AST.MakeLeaf(AST.NkIdent, pn));
|
|
|
- 1490 Lower.NoteProcNode(astNode); .)
|
|
|
- 1491 ( "FORWARD" (. AST.SetOp(astNode, 1);
|
|
|
- 1492 astDecl := astNode;
|
|
|
- 1493 Lower.ScopeLeave;
|
|
|
- 1494 SymTab.MarkFwd;
|
|
|
- 1495 SymTab.CloseProc;
|
|
|
- 1496 QbeGen.AbortFunc; .)
|
|
|
- 1497 | "EXTERNAL" (. AST.SetOp(astNode, 2);
|
|
|
- 1498 astDecl := astNode;
|
|
|
- 1499 Lower.MarkProcExternal;
|
|
|
- 1500 Lower.ScopeLeave;
|
|
|
- 1501 SymTab.MarkExternal("");
|
|
|
- 1502 SymTab.CloseProc;
|
|
|
- 1503 QbeGen.AbortFunc; .)
|
|
|
- 1504 |
|
|
|
- 1505 Block<pn> (. AST.SetChild(astNode, 1, astStmt);
|
|
|
- 1506 AST.SetChild(astNode, 2, astBlkDecls);
|
|
|
- 1507 astDecl := astNode;
|
|
|
- 1508 Lower.ScopeLeave;
|
|
|
- 1509 SymTab.CloseProc;
|
|
|
- 1510 QbeGen.EndFunc(
|
|
|
- 1511 SymTab.ProcRes(pn)); .) ) .
|
|
|
- 1512 Block<pn: SymTab.Name> (. VAR m2: SymTab.Name; .)
|
|
|
- 1513 = (. IF twoPhaseParse AND (procNest = 0) THEN
|
|
|
- 1514 ProbeBody(pn) END;
|
|
|
- 1515 INC(procNest); .)
|
|
|
- 1516 DeclSeq (. astBlkDecls := astDecl;
|
|
|
- 1517 astStmt := AST.NoNode;
|
|
|
- 1518 nLab := 0; nGot := 0; .)
|
|
|
- 1519 [ "BEGIN" (. (* an empty body is still a
|
|
|
- 1520 body: mark it so Lower
|
|
|
- 1521 does not read it as a
|
|
|
- 1522 definition heading *)
|
|
|
- 1523 IF astStmt = AST.NoNode THEN
|
|
|
- 1524 astStmt :=
|
|
|
- 1525 AST.MakeNode(AST.NkBlock)
|
|
|
- 1526 END; .)
|
|
|
- 1527 [ StatSeq ] ]
|
|
|
- 1528 "END"
|
|
|
- 1529 GetIdent<m2> (. IF NOT SymTab.Equal(pn, m2) THEN
|
|
|
- 1530 SemError(202) END;
|
|
|
- 1531 DEC(procNest);
|
|
|
- 1532 CheckGotos; .) .
|
|
|
- 1533 StatSeq (. VAR astSeq, astTail: AST.Node; .)
|
|
|
- 1534 = (. astSeq := AST.NoNode;
|
|
|
- 1535 astTail := AST.NoNode; .)
|
|
|
- 1536 Statement (. AstAppend(AST.NkBlock,
|
|
|
- 1537 astSeq, astTail, astStmt); .)
|
|
|
- 1538 { ";" [ Statement (. AstAppend(AST.NkBlock,
|
|
|
- 1539 astSeq, astTail, astStmt); .) ] }
|
|
|
- 1540 (. astStmt := astSeq; .) .
|
|
|
- 1541 (* Trailing/empty statements (`a; ; b`, Coco/R's generated `;;`)
|
|
|
- 1542 are accepted: the statement after ';' is optional. *)
|
|
|
- 1543 Statement (. VAR lx: QbeGen.QVal; lxnm: SymTab.Name; .)
|
|
|
- 1544 = (. astStmt := AST.NoNode; .)
|
|
|
- 1545 ( AssOrCall
|
|
|
- 1546 | IfStat
|
|
|
- 1547 | WhileStat
|
|
|
- 1548 | RepeatStat
|
|
|
- 1549 | LoopStat
|
|
|
- 1550 | ForStat
|
|
|
- 1551 | CaseStat
|
|
|
- 1552 | WithStat
|
|
|
- 1553 | ReturnStat
|
|
|
- 1554 | HaltStat
|
|
|
- 1555 | NewStat
|
|
|
- 1556 | DisposeStat
|
|
|
- 1557 | IncDecStat
|
|
|
- 1558 | InclExclStat
|
|
|
- 1559 | "EXIT" (. IF NOT QbeGen.TopLoop(lx) THEN
|
|
|
- 1560 SemError(230) END;
|
|
|
- 1561 astStmt := AST.MakeNode(AST.NkExit); .)
|
|
|
- 1562 | "GOTO" GetIdent<lxnm> (. NoteGoto(lxnm);
|
|
|
- 1563 astStmt := AST.MakeNode(AST.NkGoto);
|
|
|
- 1564 AST.SetChild(astStmt, 0,
|
|
|
- 1565 AST.MakeLeaf(AST.NkIdent, lxnm)); .) ) .
|
|
|
- 1566 (* INCL(set, elem) / EXCL(set, elem): PIM set-element builtins. *)
|
|
|
- 1567 InclExclStat (. VAR at, et2: SymTab.TypeIndex;
|
|
|
- 1568 dk: INTEGER;
|
|
|
- 1569 qd, qe: QbeGen.QVal;
|
|
|
- 1570 qn: SymTab.Name;
|
|
|
- 1571 sfx, isInc: BOOLEAN;
|
|
|
- 1572 astNode, astD: AST.Node; .)
|
|
|
- 1573 = ( "INCL" (. isInc := TRUE; .)
|
|
|
- 1574 | "EXCL" (. isInc := FALSE; .) )
|
|
|
- 1575 "(" Design<at, dk, qd, qn, sfx> (. astD := astCur; .) ","
|
|
|
- 1576 Expr<et2, qe> ")"
|
|
|
- 1577 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 1578 IF isInc THEN
|
|
|
- 1579 AST.SetChild(astNode, 0,
|
|
|
- 1580 AST.MakeLeaf(AST.NkIdent, "INCL"))
|
|
|
- 1581 ELSE AST.SetChild(astNode, 0,
|
|
|
- 1582 AST.MakeLeaf(AST.NkIdent, "EXCL"))
|
|
|
- 1583 END;
|
|
|
- 1584 IF astD # AST.NoNode THEN
|
|
|
- 1585 AST.SetChild(astNode, 1, astD) END;
|
|
|
- 1586 IF astCur # AST.NoNode THEN
|
|
|
- 1587 AST.SetChild(astNode, 2, astCur) END;
|
|
|
- 1588 astStmt := astNode; .)
|
|
|
- 1589 (. IF (at # SymTab.InvalidType)
|
|
|
- 1590 AND (SymTab.ClassOf(at) # SymTab.ClSet) THEN
|
|
|
- 1591 SemError(222)
|
|
|
- 1592 END; .) .
|
|
|
- 1593 (* INC(v [,step]) / DEC(v [,step]) as builtin statements over an
|
|
|
- 1594 integer designator. *)
|
|
|
- 1595 IncDecStat (. VAR dt, et2: SymTab.TypeIndex;
|
|
|
- 1596 dk: INTEGER;
|
|
|
- 1597 qd, qv, qn2, qstep:
|
|
|
- 1598 QbeGen.QVal;
|
|
|
- 1599 qn: SymTab.Name;
|
|
|
- 1600 sfx, isInc: BOOLEAN;
|
|
|
- 1601 astNode, astD, astStep:
|
|
|
- 1602 AST.Node; .)
|
|
|
- 1603 = (. isInc := TRUE; .)
|
|
|
- 1604 ( "INC" (. isInc := TRUE; .)
|
|
|
- 1605 | "DEC" (. isInc := FALSE; .) )
|
|
|
- 1606 "(" (. astStep := AST.NoNode; .)
|
|
|
- 1607 Design<dt, dk, qd, qn, sfx> (. astD := astCur; .)
|
|
|
- 1608 [ "," Expr<et2, qstep> (. astStep := astCur; .) ]
|
|
|
- 1609 ")" (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 1610 IF isInc THEN
|
|
|
- 1611 AST.SetChild(astNode, 0,
|
|
|
- 1612 AST.MakeLeaf(AST.NkIdent, "INC"))
|
|
|
- 1613 ELSE AST.SetChild(astNode, 0,
|
|
|
- 1614 AST.MakeLeaf(AST.NkIdent, "DEC"))
|
|
|
- 1615 END;
|
|
|
- 1616 IF astD # AST.NoNode THEN
|
|
|
- 1617 AST.SetChild(astNode, 1, astD) END;
|
|
|
- 1618 IF astStep # AST.NoNode THEN
|
|
|
- 1619 AST.SetChild(astNode, 2, astStep) END;
|
|
|
- 1620 astStmt := astNode; .) (. IF dt = SymTab.InvalidType THEN
|
|
|
- 1621 ELSIF (dk # SymTab.KindVar)
|
|
|
- 1622 AND (dk # SymTab.KindParam)
|
|
|
- 1623 AND (dk # SymTab.KindField) THEN
|
|
|
- 1624 SemError(210)
|
|
|
- 1625 ELSIF NOT SymTab.IsIntFamily(dt) THEN
|
|
|
- 1626 SemError(211)
|
|
|
+ 1210 astClsF, astClsFTail, astNode);
|
|
|
+ 1211 IF SymTab.Lookup(rhs) THEN
|
|
|
+ 1212 SymTab.SetSymType(n,
|
|
|
+ 1213 SymTab.SymType(rhs))
|
|
|
+ 1214 END; .)
|
|
|
+ 1215 | (. IF NOT SymTab.FieldPending(ct,
|
|
|
+ 1216 n) THEN
|
|
|
+ 1217 SemError(200) END;
|
|
|
+ 1218 astNode := AST.MakeNode(AST.NkVarDecl);
|
|
|
+ 1219 AST.SetChild(astNode, 0,
|
|
|
+ 1220 AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
+ 1221 { "," GetIdent<n> (. IF NOT SymTab.FieldPending(ct,
|
|
|
+ 1222 n) THEN
|
|
|
+ 1223 SemError(200) END;
|
|
|
+ 1224 AST.SetChild(astNode,
|
|
|
+ 1225 AST.NChild(astNode),
|
|
|
+ 1226 AST.MakeLeaf(AST.NkIdent, n)); .) }
|
|
|
+ 1227 ":" Type<t, FALSE> (. SymTab.FixPendingF(ct, t);
|
|
|
+ 1228 AST.SetTy(astNode, t);
|
|
|
+ 1229 AstAppend(AST.NkFieldDecl,
|
|
|
+ 1230 astClsF, astClsFTail, astNode); .) ) .
|
|
|
+ 1231 MethodHeading<VAR pn: SymTab.Name; ct: SymTab.TypeIndex>
|
|
|
+ 1232 (. VAR wantVirt: BOOLEAN; .)
|
|
|
+ 1233 = (. wantVirt := FALSE; .)
|
|
|
+ 1234 [ "VIRTUAL" (. wantVirt := TRUE; .) ]
|
|
|
+ 1235 ProcHeading<pn, ct> (. IF wantVirt THEN
|
|
|
+ 1236 SymTab.MarkVirtual END;
|
|
|
+ 1237 astMethod := AST.MakeNode(AST.NkProcDecl);
|
|
|
+ 1238 AST.SetChild(astMethod, 0,
|
|
|
+ 1239 AST.MakeLeaf(AST.NkIdent, pn));
|
|
|
+ 1240 IF wantVirt THEN
|
|
|
+ 1241 AST.SetOp(astMethod, 3)
|
|
|
+ 1242 ELSE AST.SetOp(astMethod, 0)
|
|
|
+ 1243 END;
|
|
|
+ 1244 AstAppend(AST.NkFieldDecl,
|
|
|
+ 1245 astClsM, astClsMTail, astMethod); .) .
|
|
|
+ 1246 ClassImplRest (. VAR cn, m2: SymTab.Name;
|
|
|
+ 1247 ct: SymTab.TypeIndex; .)
|
|
|
+ 1248 = GetIdent<cn> (. IF NOT SymTab.Lookup(cn) THEN
|
|
|
+ 1249 SemError(201);
|
|
|
+ 1250 ct := SymTab.InvalidType
|
|
|
+ 1251 ELSE ct := SymTab.SymType(cn);
|
|
|
+ 1252 IF SymTab.ClassOf(ct) #
|
|
|
+ 1253 SymTab.ClClass THEN
|
|
|
+ 1254 SemError(230);
|
|
|
+ 1255 ct := SymTab.InvalidType
|
|
|
+ 1256 END
|
|
|
+ 1257 END;
|
|
|
+ 1258 astCls := AST.MakeNode(AST.NkClassDecl);
|
|
|
+ 1259 AST.SetOp(astCls, 1);
|
|
|
+ 1260 AST.SetChild(astCls, 0,
|
|
|
+ 1261 AST.MakeLeaf(AST.NkIdent, cn));
|
|
|
+ 1262 astClsM := AST.NoNode;
|
|
|
+ 1263 astClsMTail := AST.NoNode;
|
|
|
+ 1264 astStmt := AST.NoNode;
|
|
|
+ 1265 IF ct #
|
|
|
+ 1266 SymTab.InvalidType THEN
|
|
|
+ 1267 IF NOT SymTab.PushClassMembers(
|
|
|
+ 1268 ct) THEN
|
|
|
+ 1269 SemError(230) END;
|
|
|
+ 1270 SymTab.PushImplClass(ct)
|
|
|
+ 1271 END; .)
|
|
|
+ 1272 ";" { MethodImpl<ct> ";" }
|
|
|
+ 1273 (. astStmt := AST.NoNode; .)
|
|
|
+ 1274 [ "BEGIN" (. astStmt := AST.MakeNode(AST.NkBlock);
|
|
|
+ 1275 .)
|
|
|
+ 1276 [ StatSeq ] ]
|
|
|
+ 1277 "END"
|
|
|
+ 1278 GetIdent<m2> (. IF NOT SymTab.Equal(cn, m2) THEN
|
|
|
+ 1279 SemError(202) END;
|
|
|
+ 1280 SymTab.PopImplClass;
|
|
|
+ 1281 SymTab.PopScope;
|
|
|
+ 1282 AST.SetChild(astCls, 1, AST.NoNode);
|
|
|
+ 1283 AST.SetChild(astCls, 2, astStmt);
|
|
|
+ 1284 AST.SetChild(astCls, 3, astClsM);
|
|
|
+ 1285 astDecl := astCls; .) .
|
|
|
+ 1286 MethodImpl<ct: SymTab.TypeIndex> (. VAR pn: SymTab.Name;
|
|
|
+ 1287 thisQ: QbeGen.QVal;
|
|
|
+ 1288 methRes: SymTab.TypeIndex; .)
|
|
|
+ 1289 = MethodHeading<pn, ct> ";"
|
|
|
+ 1290 (. IF (ct #
|
|
|
+ 1291 SymTab.InvalidType)
|
|
|
+ 1292 AND NOT SymTab.MethodExists(ct,
|
|
|
+ 1293 pn) THEN
|
|
|
+ 1294 SemError(201) END; .)
|
|
|
+ 1295 ( "FORWARD" (. AST.SetOp(astMethod, 1);
|
|
|
+ 1296 SymTab.MarkFwd;
|
|
|
+ 1297 QbeGen.AbortFunc;
|
|
|
+ 1298 Lower.ScopeLeave;
|
|
|
+ 1299 SymTab.CloseProc; .)
|
|
|
+ 1300 | (.
|
|
|
+ 1301 (* bind the receiver: bare
|
|
|
+ 1302 field names resolve
|
|
|
+ 1303 against THIS *)
|
|
|
+ 1304 QbeGen.CopyOp("@", thisQ);
|
|
|
+ 1305 QbeGen.PushWith(thisQ); .)
|
|
|
+ 1306 Block<pn> (. AST.SetChild(astMethod, 1, astStmt);
|
|
|
+ 1307 AST.SetChild(astMethod, 2, astBlkDecls);
|
|
|
+ 1308 QbeGen.PopWith;
|
|
|
+ 1309 methRes := SymTab.CurRes();
|
|
|
+ 1310 Lower.ScopeLeave;
|
|
|
+ 1311 SymTab.CloseProc;
|
|
|
+ 1312 QbeGen.EndFunc(methRes); .) ) .
|
|
|
+ 1313 ConstBlock (. VAR astSeq, astTail: AST.Node; .)
|
|
|
+ 1314 = "CONST" (. astSeq := AST.NoNode;
|
|
|
+ 1315 astTail := AST.NoNode; .)
|
|
|
+ 1316 { ConstDecl ";" (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 1317 astSeq, astTail, astDecl); .) }
|
|
|
+ 1318 (. astDecl := astSeq; .) .
|
|
|
+ 1319 ConstDecl (. VAR n: SymTab.Name;
|
|
|
+ 1320 t: SymTab.TypeIndex;
|
|
|
+ 1321 qv: QbeGen.QVal;
|
|
|
+ 1322 cls: INTEGER;
|
|
|
+ 1323 astNode: AST.Node; .)
|
|
|
+ 1324 = GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
+ 1325 SymTab.KindConst) THEN
|
|
|
+ 1326 SemError(200) END; .)
|
|
|
+ 1327 "="
|
|
|
+ 1328 Expr<t, qv> (. astNode := AST.MakeNode(AST.NkConstDecl);
|
|
|
+ 1329 AST.SetChild(astNode, 0,
|
|
|
+ 1330 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
+ 1331 AST.SetChild(astNode, 1, astCur);
|
|
|
+ 1332 AST.SetTy(astNode, t);
|
|
|
+ 1333 astDecl := astNode;
|
|
|
+ 1334 Lower.NoteVar(n, SymTab.KindConst, t);
|
|
|
+ 1335 Lower.NoteConstVal(qv);
|
|
|
+ 1336 SymTab.SetSymType(n, t);
|
|
|
+ 1337 cls := SymTab.ClassOf(t);
|
|
|
+ 1338 IF (cls = SymTab.ClArray)
|
|
|
+ 1339 OR (cls = SymTab.ClRecord)
|
|
|
+ 1340 OR (cls = SymTab.ClClass)
|
|
|
+ 1341 OR (cls = SymTab.ClStr)
|
|
|
+ 1342 OR (cls = SymTab.ClUStr) THEN
|
|
|
+ 1343 (* an aggregate/string
|
|
|
+ 1344 constant: qv is its
|
|
|
+ 1345 descriptor address; no
|
|
|
+ 1346 scalar data *)
|
|
|
+ 1347 SymTab.SetSymVal(n, qv)
|
|
|
+ 1348 ELSIF NOT QbeGen.IsImm(qv) THEN
|
|
|
+ 1349 SemError(230)
|
|
|
+ 1350 ELSE
|
|
|
+ 1351 SymTab.SetSymVal(n, qv);
|
|
|
+ 1352 END; .) .
|
|
|
+ 1353 VarBlock (. VAR astSeq, astTail: AST.Node; .)
|
|
|
+ 1354 = "VAR" (. astSeq := AST.NoNode;
|
|
|
+ 1355 astTail := AST.NoNode; .)
|
|
|
+ 1356 { VarDecl ";" (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 1357 astSeq, astTail, astDecl); .) }
|
|
|
+ 1358 (. astDecl := astSeq; .) .
|
|
|
+ 1359 VarDecl (. VAR nm: SymTab.Name;
|
|
|
+ 1360 t: SymTab.TypeIndex;
|
|
|
+ 1361 i: CARDINAL;
|
|
|
+ 1362 cls: INTEGER;
|
|
|
+ 1363 astNode, astTail: AST.Node; .)
|
|
|
+ 1364 = VarIdents ":"
|
|
|
+ 1365 Type<t, FALSE> (. astNode := AST.MakeNode(AST.NkVarDecl);
|
|
|
+ 1366 astTail := astNode;
|
|
|
+ 1367 i := 0;
|
|
|
+ 1368 WHILE i < SymTab.PendCount() DO
|
|
|
+ 1369 SymTab.PendName(i, nm);
|
|
|
+ 1370 Lower.NoteVar(nm, SymTab.KindVar, t);
|
|
|
+ 1371 (* chunked: a VAR list can
|
|
|
+ 1372 exceed AST.MaxChild *)
|
|
|
+ 1373 AstAppend(AST.NkBlock,
|
|
|
+ 1374 astNode, astTail,
|
|
|
+ 1375 AST.MakeLeaf(AST.NkIdent, nm));
|
|
|
+ 1376 INC(i)
|
|
|
+ 1377 END;
|
|
|
+ 1378 AST.SetTy(astNode, t);
|
|
|
+ 1379 astDecl := astNode;
|
|
|
+ 1380 cls := SymTab.ClassOf(t);
|
|
|
+ 1381 IF (t # SymTab.InvalidType)
|
|
|
+ 1382 AND NOT SymTab.IsUnresolved(t)
|
|
|
+ 1383 AND (cls # SymTab.ClInt)
|
|
|
+ 1384 AND (cls # SymTab.ClBool)
|
|
|
+ 1385 AND (cls # SymTab.ClChar)
|
|
|
+ 1386 AND (cls # SymTab.ClReal)
|
|
|
+ 1387 AND (cls # SymTab.ClArray)
|
|
|
+ 1388 AND (cls # SymTab.ClSet)
|
|
|
+ 1389 AND (cls # SymTab.ClRecord)
|
|
|
+ 1390 AND (cls # SymTab.ClPtr)
|
|
|
+ 1391 AND (cls # SymTab.ClLong)
|
|
|
+ 1392 AND (cls # SymTab.ClProc)
|
|
|
+ 1393 AND (cls # SymTab.ClUChar)
|
|
|
+ 1394 AND (cls # SymTab.ClUStr)
|
|
|
+ 1395 AND (cls # SymTab.ClEnum)
|
|
|
+ 1396 AND (cls # SymTab.ClClass) THEN
|
|
|
+ 1397 SemError(230) END;
|
|
|
+ 1398 IF QbeGen.LocFull() THEN
|
|
|
+ 1399 SemError(233) END;
|
|
|
+ 1400 i := 0;
|
|
|
+ 1401 IF SymTab.IsUnresolved(t)
|
|
|
+ 1402 AND NOT SymTab.InProc() THEN
|
|
|
+ 1403 (* a forward-typed global:
|
|
|
+ 1404 defer emission until the
|
|
|
+ 1405 TYPE block completes *)
|
|
|
+ 1406 AST.SetOp(astNode, 1);
|
|
|
+ 1407 WHILE i < SymTab.PendCount() DO
|
|
|
+ 1408 SymTab.PendName(i, nm);
|
|
|
+ 1409 IF nPendVar <=
|
|
|
+ 1410 HIGH(pendVarName) THEN
|
|
|
+ 1411 pendVarName[nPendVar] := nm;
|
|
|
+ 1412 pendVarT[nPendVar] := t;
|
|
|
+ 1413 INC(nPendVar)
|
|
|
+ 1414 END;
|
|
|
+ 1415 INC(i)
|
|
|
+ 1416 END
|
|
|
+ 1417 ELSE
|
|
|
+ 1418 WHILE i < SymTab.PendCount() DO
|
|
|
+ 1419 SymTab.PendName(i, nm);
|
|
|
+ 1420 INC(i)
|
|
|
+ 1421 END
|
|
|
+ 1422 END;
|
|
|
+ 1423 (* a plain VAR list, not a
|
|
|
+ 1424 heading: the signature
|
|
|
+ 1425 result is discarded *)
|
|
|
+ 1426 IF NOT SymTab.FixPending(t) THEN
|
|
|
+ 1427 END; .) .
|
|
|
+ 1428 VarIdents (. VAR n: SymTab.Name; .)
|
|
|
+ 1429 = GetIdent<n> (. IF NOT SymTab.EnterPending(n,
|
|
|
+ 1430 SymTab.KindVar) THEN
|
|
|
+ 1431 SemError(200) END; .)
|
|
|
+ 1432 { ","
|
|
|
+ 1433 GetIdent<n> (. IF NOT SymTab.EnterPending(n,
|
|
|
+ 1434 SymTab.KindVar) THEN
|
|
|
+ 1435 SemError(200) END; .) } .
|
|
|
+ 1436 ParIdents<isV: BOOLEAN> (. VAR n: SymTab.Name; .)
|
|
|
+ 1437 = GetIdent<n> (. IF NOT SymTab.EnterParam(n, isV) THEN
|
|
|
+ 1438 SemError(200) END; .)
|
|
|
+ 1439 { "," GetIdent<n> (. IF NOT SymTab.EnterParam(n, isV) THEN
|
|
|
+ 1440 SemError(200) END; .) } .
|
|
|
+ 1441 (* Procedure headings enter scopes/params/result and buffer the
|
|
|
+ 1442 QBE header; bodies lower to functions (4.1, module level only).
|
|
|
+ 1443 FORWARD marks; the body heading re-enters (signature compare
|
|
|
+ 1444 deferred). Nested procedures parse + check, lowering = 4.2. *)
|
|
|
+ 1445 ProcHeading<VAR pn: SymTab.Name; methCls: SymTab.TypeIndex>
|
|
|
+ 1446 (. VAR t: SymTab.TypeIndex;
|
|
|
+ 1447 mg: QbeGen.QVal; .)
|
|
|
+ 1448 = "PROCEDURE"
|
|
|
+ 1449 GetIdent<pn> (. IF methCls #
|
|
|
+ 1450 SymTab.InvalidType THEN
|
|
|
+ 1451 (* a method: resume the
|
|
|
+ 1452 declared symbol (reuse
|
|
|
+ 1453 its uid) *)
|
|
|
+ 1454 IF NOT SymTab.ResumeMethod(
|
|
|
+ 1455 methCls, pn) THEN
|
|
|
+ 1456 SemError(200) END
|
|
|
+ 1457 ELSIF NOT SymTab.EnterProc(pn) THEN
|
|
|
+ 1458 IF NOT SymTab.ReenterProc(pn) THEN
|
|
|
+ 1459 IF NOT SymTab.ResumeProc(pn) THEN
|
|
|
+ 1460 SemError(200) END
|
|
|
+ 1461 END
|
|
|
+ 1462 END;
|
|
|
+ 1463 Lower.ScopeEnter;
|
|
|
+ 1464 Lower.NoteProc(pn,
|
|
|
+ 1465 SymTab.ProcUid(pn),
|
|
|
+ 1466 SymTab.InvalidType,
|
|
|
+ 1467 SymTab.ProcDepthOf(pn),
|
|
|
+ 1468 FALSE);
|
|
|
+ 1469 QbeGen.BeginFunc("");
|
|
|
+ 1470 IF methCls #
|
|
|
+ 1471 SymTab.InvalidType THEN
|
|
|
+ 1472 (* hidden THIS receiver:
|
|
|
+ 1473 a VAR param of the
|
|
|
+ 1474 class type, pushed as
|
|
|
+ 1475 the WITH base *)
|
|
|
+ 1476 IF NOT SymTab.EnterThisParam(
|
|
|
+ 1477 methCls) THEN
|
|
|
+ 1478 SemError(200) END;
|
|
|
+ 1479 IF NOT QbeGen.FuncParam(
|
|
|
+ 1480 "THIS", TRUE,
|
|
|
+ 1481 methCls) THEN
|
|
|
+ 1482 SemError(233) END
|
|
|
+ 1483 END; .)
|
|
|
+ 1484 [ FormalParams ]
|
|
|
+ 1485 [ ":" TypeIdent<t> (. IF NOT SymTab.SetProcRes(t) THEN
|
|
|
+ 1486 SemError(235) END;
|
|
|
+ 1487 Lower.SetProcRes(t); .) ] .
|
|
|
+ 1488 FormalParams
|
|
|
+ 1489 = "(" [ ParamSection { ";" ParamSection } ] ")" .
|
|
|
+ 1490 ParamSection (. VAR t: SymTab.TypeIndex;
|
|
|
+ 1491 nm: SymTab.Name;
|
|
|
+ 1492 i: CARDINAL;
|
|
|
+ 1493 isV: BOOLEAN; .)
|
|
|
+ 1494 = (. isV := FALSE; .)
|
|
|
+ 1495 [ "VAR" (. isV := TRUE; .) ]
|
|
|
+ 1496 ParIdents<isV> ":" Type<t, TRUE> (. i := 0;
|
|
|
+ 1497 WHILE i < SymTab.PendCount() DO
|
|
|
+ 1498 SymTab.PendName(i, nm);
|
|
|
+ 1499 Lower.NoteParam(nm, t, isV);
|
|
|
+ 1500 Lower.NoteVar(nm, SymTab.KindParam, t);
|
|
|
+ 1501 (* value open arrays are
|
|
|
+ 1502 passed as descriptor
|
|
|
+ 1503 addresses (no copy):
|
|
|
+ 1504 same representation as
|
|
|
+ 1505 VAR formals *)
|
|
|
+ 1506 IF NOT QbeGen.FuncParam(nm,
|
|
|
+ 1507 isV
|
|
|
+ 1508 OR SymTab.IsOpenArray(t),
|
|
|
+ 1509 t) THEN
|
|
|
+ 1510 SemError(233) END;
|
|
|
+ 1511 INC(i)
|
|
|
+ 1512 END;
|
|
|
+ 1513 IF NOT SymTab.FixPending(t) THEN
|
|
|
+ 1514 SemError(235) END; .) .
|
|
|
+ 1515 (* Nested procedures lower like top-level ones (4.2): the
|
|
|
+ 1516 static link gives them their parent's frame. Methods keep
|
|
|
+ 1517 parse-now/230-later. *)
|
|
|
+ 1518 ProcDecl (. VAR pn: SymTab.Name;
|
|
|
+ 1519 astNode: AST.Node; .)
|
|
|
+ 1520 = ProcHeading<pn, SymTab.InvalidType> ";"
|
|
|
+ 1521 (. astNode := AST.MakeNode(AST.NkProcDecl);
|
|
|
+ 1522 AST.SetOp(astNode, 0);
|
|
|
+ 1523 AST.SetChild(astNode, 0,
|
|
|
+ 1524 AST.MakeLeaf(AST.NkIdent, pn));
|
|
|
+ 1525 Lower.NoteProcNode(astNode); .)
|
|
|
+ 1526 ( "FORWARD" (. AST.SetOp(astNode, 1);
|
|
|
+ 1527 astDecl := astNode;
|
|
|
+ 1528 Lower.ScopeLeave;
|
|
|
+ 1529 SymTab.MarkFwd;
|
|
|
+ 1530 SymTab.CloseProc;
|
|
|
+ 1531 QbeGen.AbortFunc; .)
|
|
|
+ 1532 | "EXTERNAL" (. AST.SetOp(astNode, 2);
|
|
|
+ 1533 astDecl := astNode;
|
|
|
+ 1534 Lower.MarkProcExternal;
|
|
|
+ 1535 Lower.ScopeLeave;
|
|
|
+ 1536 SymTab.MarkExternal("");
|
|
|
+ 1537 SymTab.CloseProc;
|
|
|
+ 1538 QbeGen.AbortFunc; .)
|
|
|
+ 1539 |
|
|
|
+ 1540 Block<pn> (. AST.SetChild(astNode, 1, astStmt);
|
|
|
+ 1541 AST.SetChild(astNode, 2, astBlkDecls);
|
|
|
+ 1542 astDecl := astNode;
|
|
|
+ 1543 Lower.ScopeLeave;
|
|
|
+ 1544 SymTab.CloseProc;
|
|
|
+ 1545 QbeGen.EndFunc(
|
|
|
+ 1546 SymTab.ProcRes(pn)); .) ) .
|
|
|
+ 1547 Block<pn: SymTab.Name> (. VAR m2: SymTab.Name; .)
|
|
|
+ 1548 = (. IF twoPhaseParse AND (procNest = 0) THEN
|
|
|
+ 1549 ProbeBody(pn) END;
|
|
|
+ 1550 INC(procNest); .)
|
|
|
+ 1551 DeclSeq (. astBlkDecls := astDecl;
|
|
|
+ 1552 astStmt := AST.NoNode;
|
|
|
+ 1553 nLab := 0; nGot := 0; .)
|
|
|
+ 1554 [ "BEGIN" (. (* an empty body is still a
|
|
|
+ 1555 body: mark it so Lower
|
|
|
+ 1556 does not read it as a
|
|
|
+ 1557 definition heading *)
|
|
|
+ 1558 IF astStmt = AST.NoNode THEN
|
|
|
+ 1559 astStmt :=
|
|
|
+ 1560 AST.MakeNode(AST.NkBlock)
|
|
|
+ 1561 END; .)
|
|
|
+ 1562 [ StatSeq ] ]
|
|
|
+ 1563 "END"
|
|
|
+ 1564 GetIdent<m2> (. IF NOT SymTab.Equal(pn, m2) THEN
|
|
|
+ 1565 SemError(202) END;
|
|
|
+ 1566 DEC(procNest);
|
|
|
+ 1567 CheckGotos; .) .
|
|
|
+ 1568 StatSeq (. VAR astSeq, astTail: AST.Node; .)
|
|
|
+ 1569 = (. astSeq := AST.NoNode;
|
|
|
+ 1570 astTail := AST.NoNode; .)
|
|
|
+ 1571 Statement (. AstAppend(AST.NkBlock,
|
|
|
+ 1572 astSeq, astTail, astStmt); .)
|
|
|
+ 1573 { ";" [ Statement (. AstAppend(AST.NkBlock,
|
|
|
+ 1574 astSeq, astTail, astStmt); .) ] }
|
|
|
+ 1575 (. astStmt := astSeq; .) .
|
|
|
+ 1576 (* Trailing/empty statements (`a; ; b`, Coco/R's generated `;;`)
|
|
|
+ 1577 are accepted: the statement after ';' is optional. *)
|
|
|
+ 1578 Statement (. VAR lx: QbeGen.QVal; lxnm: SymTab.Name; .)
|
|
|
+ 1579 = (. astStmt := AST.NoNode; .)
|
|
|
+ 1580 ( AssOrCall
|
|
|
+ 1581 | IfStat
|
|
|
+ 1582 | WhileStat
|
|
|
+ 1583 | RepeatStat
|
|
|
+ 1584 | LoopStat
|
|
|
+ 1585 | ForStat
|
|
|
+ 1586 | CaseStat
|
|
|
+ 1587 | WithStat
|
|
|
+ 1588 | ReturnStat
|
|
|
+ 1589 | HaltStat
|
|
|
+ 1590 | NewStat
|
|
|
+ 1591 | DisposeStat
|
|
|
+ 1592 | IncDecStat
|
|
|
+ 1593 | InclExclStat
|
|
|
+ 1594 | "EXIT" (. IF NOT QbeGen.TopLoop(lx) THEN
|
|
|
+ 1595 SemError(230) END;
|
|
|
+ 1596 astStmt := AST.MakeNode(AST.NkExit); .)
|
|
|
+ 1597 | "GOTO" GetIdent<lxnm> (. NoteGoto(lxnm);
|
|
|
+ 1598 astStmt := AST.MakeNode(AST.NkGoto);
|
|
|
+ 1599 AST.SetChild(astStmt, 0,
|
|
|
+ 1600 AST.MakeLeaf(AST.NkIdent, lxnm)); .) ) .
|
|
|
+ 1601 (* INCL(set, elem) / EXCL(set, elem): PIM set-element builtins. *)
|
|
|
+ 1602 InclExclStat (. VAR at, et2: SymTab.TypeIndex;
|
|
|
+ 1603 dk: INTEGER;
|
|
|
+ 1604 qd, qe: QbeGen.QVal;
|
|
|
+ 1605 qn: SymTab.Name;
|
|
|
+ 1606 sfx, isInc: BOOLEAN;
|
|
|
+ 1607 astNode, astD: AST.Node; .)
|
|
|
+ 1608 = ( "INCL" (. isInc := TRUE; .)
|
|
|
+ 1609 | "EXCL" (. isInc := FALSE; .) )
|
|
|
+ 1610 "(" Design<at, dk, qd, qn, sfx> (. astD := astCur; .) ","
|
|
|
+ 1611 Expr<et2, qe> ")"
|
|
|
+ 1612 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 1613 IF isInc THEN
|
|
|
+ 1614 AST.SetChild(astNode, 0,
|
|
|
+ 1615 AST.MakeLeaf(AST.NkIdent, "INCL"))
|
|
|
+ 1616 ELSE AST.SetChild(astNode, 0,
|
|
|
+ 1617 AST.MakeLeaf(AST.NkIdent, "EXCL"))
|
|
|
+ 1618 END;
|
|
|
+ 1619 IF astD # AST.NoNode THEN
|
|
|
+ 1620 AST.SetChild(astNode, 1, astD) END;
|
|
|
+ 1621 IF astCur # AST.NoNode THEN
|
|
|
+ 1622 AST.SetChild(astNode, 2, astCur) END;
|
|
|
+ 1623 astStmt := astNode; .)
|
|
|
+ 1624 (. IF (at # SymTab.InvalidType)
|
|
|
+ 1625 AND (SymTab.ClassOf(at) # SymTab.ClSet) THEN
|
|
|
+ 1626 SemError(222)
|
|
|
1627 END; .) .
|
|
|
- 1628 (* NEW/DISPOSE as builtin statements (no call syntax until step 4).
|
|
|
- 1629 Targets are pointer designators; DISPOSE nils afterwards (safer
|
|
|
- 1630 than Wirth-undefined; documented). DISPOSE is shallow. *)
|
|
|
- 1631 NewStat (. VAR dt: SymTab.TypeIndex;
|
|
|
- 1632 dk: INTEGER;
|
|
|
- 1633 qd, qm: QbeGen.QVal;
|
|
|
+ 1628 (* INC(v [,step]) / DEC(v [,step]) as builtin statements over an
|
|
|
+ 1629 integer designator. *)
|
|
|
+ 1630 IncDecStat (. VAR dt, et2: SymTab.TypeIndex;
|
|
|
+ 1631 dk: INTEGER;
|
|
|
+ 1632 qd, qv, qn2, qstep:
|
|
|
+ 1633 QbeGen.QVal;
|
|
|
1634 qn: SymTab.Name;
|
|
|
- 1635 sfx: BOOLEAN;
|
|
|
- 1636 bt: SymTab.TypeIndex;
|
|
|
- 1637 astNode, astD: AST.Node; .)
|
|
|
- 1638 = "NEW" "(" Design<dt, dk, qd, qn, sfx> (. astD := astCur; .) ")"
|
|
|
- 1639 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 1640 AST.SetChild(astNode, 0,
|
|
|
- 1641 AST.MakeLeaf(AST.NkIdent, "NEW"));
|
|
|
- 1642 IF astD # AST.NoNode THEN
|
|
|
- 1643 AST.SetChild(astNode, 1, astD) END;
|
|
|
- 1644 astStmt := astNode; .)
|
|
|
- 1645 (. IF dt = SymTab.InvalidType THEN
|
|
|
- 1646 ELSIF (dk # SymTab.KindVar)
|
|
|
- 1647 AND (dk # SymTab.KindParam)
|
|
|
- 1648 AND (dk # SymTab.KindField) THEN
|
|
|
- 1649 SemError(210)
|
|
|
- 1650 ELSIF SymTab.ClassOf(dt) #
|
|
|
- 1651 SymTab.ClPtr THEN
|
|
|
- 1652 SemError(219)
|
|
|
- 1653 END; .) .
|
|
|
- 1654 DisposeStat (. VAR dt: SymTab.TypeIndex;
|
|
|
- 1655 dk: INTEGER;
|
|
|
- 1656 qd, qv: QbeGen.QVal;
|
|
|
- 1657 qn: SymTab.Name;
|
|
|
- 1658 sfx: BOOLEAN;
|
|
|
- 1659 astNode, astD: AST.Node; .)
|
|
|
- 1660 = "DISPOSE" "(" Design<dt, dk, qd, qn, sfx> (. astD := astCur; .) ")"
|
|
|
- 1661 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 1662 AST.SetChild(astNode, 0,
|
|
|
- 1663 AST.MakeLeaf(AST.NkIdent, "DISPOSE"));
|
|
|
- 1664 IF astD # AST.NoNode THEN
|
|
|
- 1665 AST.SetChild(astNode, 1, astD) END;
|
|
|
- 1666 astStmt := astNode; .)
|
|
|
- 1667 (. IF dt = SymTab.InvalidType THEN
|
|
|
- 1668 ELSIF (dk # SymTab.KindVar)
|
|
|
- 1669 AND (dk # SymTab.KindParam)
|
|
|
- 1670 AND (dk # SymTab.KindField) THEN
|
|
|
- 1671 SemError(210)
|
|
|
- 1672 ELSIF SymTab.ClassOf(dt) #
|
|
|
- 1673 SymTab.ClPtr THEN
|
|
|
- 1674 SemError(219)
|
|
|
- 1675 END; .) .
|
|
|
- 1676 (* WITH pushes each record's fields (inner wins) plus its base
|
|
|
- 1677 address; field designators resolve through both stacks. *)
|
|
|
- 1678 WithStat (. VAR nW: CARDINAL;
|
|
|
- 1679 astNode: AST.Node; .)
|
|
|
- 1680 = "WITH" (. nW := 0;
|
|
|
- 1681 astNode := AST.MakeNode(AST.NkWith); .)
|
|
|
- 1682 WithItem<nW, astNode> { "," WithItem<nW, astNode> }
|
|
|
- 1683 "DO" (. astStmt := AST.NoNode; .)
|
|
|
- 1684 [ StatSeq ] "END" (. AST.SetChild(astNode,
|
|
|
- 1685 AST.NChild(astNode), astStmt);
|
|
|
- 1686 astStmt := astNode;
|
|
|
- 1687 WHILE nW > 0 DO
|
|
|
- 1688 SymTab.PopScope;
|
|
|
- 1689 QbeGen.PopWith;
|
|
|
- 1690 DEC(nW)
|
|
|
- 1691 END; .) .
|
|
|
- 1692 WithItem<VAR nW: CARDINAL; wnode: AST.Node>
|
|
|
- 1693 (. VAR dt: SymTab.TypeIndex;
|
|
|
- 1694 dk: INTEGER;
|
|
|
- 1695 qd, qe: QbeGen.QVal;
|
|
|
- 1696 qn: SymTab.Name;
|
|
|
- 1697 sfx: BOOLEAN; .)
|
|
|
- 1698 = Design<dt, dk, qd, qn, sfx>
|
|
|
- 1699 (. IF astCur # AST.NoNode THEN
|
|
|
- 1700 AST.SetChild(wnode,
|
|
|
- 1701 AST.NChild(wnode), astCur) END;
|
|
|
- 1702 IF dt = SymTab.InvalidType THEN
|
|
|
- 1703 ELSIF (SymTab.ClassOf(dt) #
|
|
|
- 1704 SymTab.ClRecord)
|
|
|
- 1705 AND (SymTab.ClassOf(dt) #
|
|
|
- 1706 SymTab.ClClass) THEN
|
|
|
- 1707 SemError(215)
|
|
|
- 1708 ELSIF SymTab.PushRecord(dt) THEN
|
|
|
- 1709 QbeGen.PushWith(qd);
|
|
|
- 1710 INC(nW)
|
|
|
- 1711 END; .) .
|
|
|
- 1712 (* Assignment or procedure-statement call (4.1, module level).
|
|
|
- 1713 Bare `P;` is a syntax error; function-as-statement is 233. *)
|
|
|
- 1714 AssOrCall (. VAR dt, et: SymTab.TypeIndex;
|
|
|
- 1715 dk: INTEGER;
|
|
|
- 1716 qd, qe, qt, ql: QbeGen.QVal;
|
|
|
- 1717 qn: SymTab.Name;
|
|
|
- 1718 ct2, res0: SymTab.TypeIndex;
|
|
|
- 1719 q2, mg0: QbeGen.QVal;
|
|
|
- 1720 isR, conv, wconv: BOOLEAN;
|
|
|
- 1721 called, sfx: BOOLEAN;
|
|
|
- 1722 astLhs, astRes: AST.Node; mname: SymTab.Name; isM: BOOLEAN;
|
|
|
- 1723 n: SymTab.Name; astLab, astNode: AST.Node; .)
|
|
|
- 1724 = GetIdent<n>
|
|
|
- 1725 ( ":" (. NoteLabel(n);
|
|
|
- 1726 astNode := AST.MakeNode(AST.NkLabel);
|
|
|
- 1727 AST.SetChild(astNode, 0,
|
|
|
- 1728 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
- 1729 astLab := AST.MakeNode(AST.NkBlock);
|
|
|
- 1730 AST.SetChild(astLab, 0, astNode); .)
|
|
|
- 1731 Statement (. IF astStmt # AST.NoNode THEN
|
|
|
- 1732 AST.SetChild(astLab, 1, astStmt) END;
|
|
|
- 1733 astStmt := astLab; .)
|
|
|
- 1734 | DesignTail<n, dt, dk, qd, qn, sfx>
|
|
|
- 1735 (. astLhs := astCur; astNArgs := 0; .)
|
|
|
- 1736 ( ":="
|
|
|
- 1737 Expr<et, qe> (. astStmt := AST.MakeBin(
|
|
|
- 1738 AST.NkAssign, 0, astLhs, astCur);
|
|
|
- 1739 IF (dt # SymTab.InvalidType)
|
|
|
- 1740 AND (dk # SymTab.KindVar)
|
|
|
- 1741 AND (dk # SymTab.KindParam)
|
|
|
- 1742 AND (dk # SymTab.KindField) THEN
|
|
|
- 1743 SemError(210)
|
|
|
- 1744 ELSIF NOT SymTab.Assignable(et,
|
|
|
- 1745 dt) THEN
|
|
|
- 1746 SemError(210)
|
|
|
- 1747 ELSIF (dt # SymTab.InvalidType)
|
|
|
- 1748 AND (SymTab.ClassOf(dt) =
|
|
|
- 1749 SymTab.ClClass) THEN
|
|
|
- 1750 SemError(230) END;
|
|
|
- 1751 isR := (dt #
|
|
|
- 1752 SymTab.InvalidType)
|
|
|
- 1753 AND (SymTab.ClassOf(dt)
|
|
|
- 1754 = SymTab.ClReal);
|
|
|
- 1755 conv := isR
|
|
|
- 1756 AND SymTab.IsIntFamily(et);
|
|
|
- 1757 wconv := (dt #
|
|
|
- 1758 SymTab.InvalidType)
|
|
|
- 1759 AND SymTab.IsLongFamily(dt)
|
|
|
- 1760 AND SymTab.IsIntFamily(et);
|
|
|
- 1761 IF ((dk = SymTab.KindVar)
|
|
|
- 1762 OR (dk = SymTab.KindParam)
|
|
|
- 1763 OR (dk = SymTab.KindField))
|
|
|
- 1764 AND (dt # SymTab.InvalidType)
|
|
|
- 1765 AND (et # SymTab.InvalidType)
|
|
|
- 1766 AND (SymTab.ClassOf(dt) #
|
|
|
- 1767 SymTab.ClClass) THEN
|
|
|
- 1768 END; .)
|
|
|
- 1769 | ArgList<qn, dt, qd, TRUE, TRUE, methCls, ct2, q2, called>
|
|
|
- 1770 (. astRes := AstCallNode(astLhs);
|
|
|
- 1771 sfx := FALSE; .)
|
|
|
- 1772 ( { ResultComp<ct2, q2, sfx, astRes, mname, methCls, isM> }
|
|
|
- 1773 ":=" Expr<et, qe> (. astStmt := AST.MakeBin(
|
|
|
- 1774 AST.NkAssign, 0, astRes, astCur);
|
|
|
- 1775 IF NOT sfx THEN
|
|
|
- 1776 SemError(233)
|
|
|
- 1777 ELSIF (ct2 # SymTab.InvalidType)
|
|
|
- 1778 AND NOT SymTab.Assignable(et, ct2) THEN
|
|
|
- 1779 SemError(210)
|
|
|
- 1780 END; .)
|
|
|
- 1781 | (. IF ct2 #
|
|
|
- 1782 SymTab.InvalidType THEN
|
|
|
- 1783 SemError(233) END;
|
|
|
- 1784 astStmt := astRes; .) )
|
|
|
- 1785 | (* bare `P;`: proper parameterless
|
|
|
- 1786 procedure call; anything else
|
|
|
- 1787 here is 233 (was a bare syntax
|
|
|
- 1788 error before 4.2) *)
|
|
|
- 1789 (. astStmt := AstCallNode(astLhs);
|
|
|
- 1790 IF (dk = SymTab.KindProc)
|
|
|
- 1791 AND NOT sfx THEN
|
|
|
- 1792 res0 := SymTab.ProcRes(qn);
|
|
|
- 1793 IF res0 #
|
|
|
- 1794 SymTab.InvalidType THEN
|
|
|
- 1795 SemError(233)
|
|
|
- 1796 ELSIF SymTab.ProcNPar(qn) #
|
|
|
- 1797 0 THEN
|
|
|
- 1798 SemError(233)
|
|
|
- 1799 END
|
|
|
- 1800 ELSE SemError(233)
|
|
|
- 1801 END; .) ) ) .
|
|
|
- 1802 (* Actual-parameter list shared by statement and expression calls.
|
|
|
- 1803 want selects CallEnd's result handling; t/q carry the call
|
|
|
- 1804 value (statement calls discard). Arity/type failures are 233;
|
|
|
- 1805 evaluation code still emits so the .ssa stays assembleable. *)
|
|
|
- 1806 ArgList<pn: SymTab.Name; pt: SymTab.TypeIndex; callee: QbeGen.QVal;
|
|
|
- 1807 want: BOOLEAN; soft: BOOLEAN; methCls: SymTab.TypeIndex;
|
|
|
- 1808 VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
|
|
|
- 1809 VAR called: BOOLEAN> (. VAR i, np: CARDINAL;
|
|
|
- 1810 vs: INTEGER;
|
|
|
- 1811 res: SymTab.TypeIndex;
|
|
|
- 1812 mg: QbeGen.QVal;
|
|
|
- 1813 ok, ind, isMeth, va: BOOLEAN; .)
|
|
|
- 1814 = "(" (. called := TRUE;
|
|
|
- 1815 ok := TRUE;
|
|
|
- 1816 ind := FALSE;
|
|
|
- 1817 isMeth := methCls #
|
|
|
- 1818 SymTab.InvalidType;
|
|
|
- 1819 IF isMeth THEN
|
|
|
- 1820 res := SymTab.ClassMethodRes(methCls, pn)
|
|
|
- 1821 ELSIF SymTab.SymKind(pn) = SymTab.KindProc THEN
|
|
|
- 1822 res := SymTab.ProcRes(pn)
|
|
|
- 1823 ELSIF (pt # SymTab.InvalidType)
|
|
|
- 1824 AND (SymTab.ClassOf(pt) = SymTab.ClProc) THEN
|
|
|
- 1825 ind := TRUE;
|
|
|
- 1826 res := SymTab.ProcTypeRes(pt)
|
|
|
- 1827 ELSE SemError(233);
|
|
|
- 1828 ok := FALSE;
|
|
|
- 1829 res := SymTab.InvalidType
|
|
|
- 1830 END;
|
|
|
- 1831 i := 0; .)
|
|
|
- 1832 [ ActParam<pn, pt, ind, methCls, i> (. INC(i); .)
|
|
|
- 1833 { "," ActParam<pn, pt, ind, methCls, i> (. INC(i); .) } ]
|
|
|
- 1834 ")" (. IF ok THEN
|
|
|
- 1835 IF isMeth THEN
|
|
|
- 1836 np := SymTab.ClassMethodNPar(
|
|
|
- 1837 methCls, pn)
|
|
|
- 1838 ELSIF ind THEN
|
|
|
- 1839 np := SymTab.ProcTypeNPar(pt)
|
|
|
- 1840 ELSE np := SymTab.ProcNPar(pn)
|
|
|
- 1841 END;
|
|
|
- 1842 va := (NOT isMeth) AND (NOT ind)
|
|
|
- 1843 AND (SymTab.SymKind(pn) =
|
|
|
- 1844 SymTab.KindProc)
|
|
|
- 1845 AND SymTab.Varargs(pn);
|
|
|
- 1846 IF (i # np) AND NOT va THEN
|
|
|
- 1847 SemError(233); ok := FALSE
|
|
|
- 1848 END
|
|
|
- 1849 END;
|
|
|
- 1850 IF NOT ok THEN
|
|
|
- 1851 t := SymTab.InvalidType;
|
|
|
- 1852 QbeGen.CopyOp("0", q)
|
|
|
- 1853 ELSIF want THEN
|
|
|
- 1854 IF res =
|
|
|
- 1855 SymTab.InvalidType THEN
|
|
|
- 1856 IF NOT soft THEN SemError(233) END;
|
|
|
- 1857 t := SymTab.InvalidType;
|
|
|
- 1858 QbeGen.CopyOp("0", q)
|
|
|
- 1859 ELSE t := res;
|
|
|
- 1860 QbeGen.CopyOp("@", q)
|
|
|
- 1861 END
|
|
|
- 1862 ELSE
|
|
|
- 1863 IF res #
|
|
|
- 1864 SymTab.InvalidType THEN
|
|
|
- 1865 SemError(233)
|
|
|
- 1866 END;
|
|
|
- 1867 t := SymTab.InvalidType;
|
|
|
- 1868 QbeGen.CopyOp("0", q);
|
|
|
- 1869 END; .) .
|
|
|
- 1870 (* One actual: VAR formals take recorded designator addresses
|
|
|
- 1871 (233 otherwise); value formals take converted expressions. *)
|
|
|
- 1872 ActParam<pn: SymTab.Name; pt: SymTab.TypeIndex; ind: BOOLEAN;
|
|
|
- 1873 methCls: SymTab.TypeIndex; i: CARDINAL>
|
|
|
- 1874 (. VAR at, ft: SymTab.TypeIndex;
|
|
|
- 1875 qe, qa, qt: QbeGen.QVal;
|
|
|
- 1876 isV, conv, va: BOOLEAN;
|
|
|
- 1877 cl: CHAR;
|
|
|
- 1878 savedN, aj: CARDINAL;
|
|
|
- 1879 savedArgs: ARRAY [0 .. 31]
|
|
|
- 1880 OF AST.Node;
|
|
|
- 1881 astActual: AST.Node; .)
|
|
|
- 1882 = (. (* Parsing the actual can clobber
|
|
|
- 1883 the enclosing call's argument
|
|
|
- 1884 list (Factor resets astNArgs),
|
|
|
- 1885 so save/restore it. *)
|
|
|
- 1886 savedN := astNArgs; aj := 0;
|
|
|
- 1887 WHILE aj <= HIGH(astArgs) DO
|
|
|
- 1888 savedArgs[aj] := astArgs[aj];
|
|
|
- 1889 INC(aj)
|
|
|
- 1890 END; .)
|
|
|
- 1891 Expr<at, qe> (. astActual := astCur;
|
|
|
- 1892 astNArgs := savedN; aj := 0;
|
|
|
- 1893 WHILE aj <= HIGH(astArgs) DO
|
|
|
- 1894 astArgs[aj] := savedArgs[aj];
|
|
|
- 1895 INC(aj)
|
|
|
- 1896 END;
|
|
|
- 1897 IF astNArgs <= HIGH(astArgs) THEN
|
|
|
- 1898 astArgs[astNArgs] := astCur;
|
|
|
- 1899 INC(astNArgs)
|
|
|
- 1900 END;
|
|
|
- 1901 va := (NOT ind)
|
|
|
- 1902 AND (methCls =
|
|
|
- 1903 SymTab.InvalidType)
|
|
|
- 1904 AND (SymTab.SymKind(pn) =
|
|
|
- 1905 SymTab.KindProc)
|
|
|
- 1906 AND SymTab.Varargs(pn);
|
|
|
- 1907 IF ind THEN
|
|
|
- 1908 ft :=
|
|
|
- 1909 SymTab.ProcTypeParamType(pt,
|
|
|
- 1910 i);
|
|
|
- 1911 isV :=
|
|
|
- 1912 SymTab.ProcTypeParamIsVar(pt,
|
|
|
- 1913 i)
|
|
|
- 1914 ELSIF methCls #
|
|
|
- 1915 SymTab.InvalidType THEN
|
|
|
- 1916 ft :=
|
|
|
- 1917 SymTab.ClassMethodParamType(
|
|
|
- 1918 methCls, pn, i);
|
|
|
- 1919 isV :=
|
|
|
- 1920 SymTab.ClassMethodParamIsVar(
|
|
|
- 1921 methCls, pn, i)
|
|
|
- 1922 ELSE
|
|
|
- 1923 ft := SymTab.ParamType(pn, i);
|
|
|
- 1924 isV := SymTab.ParamIsVar(pn, i)
|
|
|
- 1925 END;
|
|
|
- 1926 IF (at = SymTab.InvalidType) THEN
|
|
|
- 1927 ELSIF ft = SymTab.InvalidType THEN
|
|
|
- 1928 ELSIF isV THEN
|
|
|
- 1929 IF (SymTab.ClassOf(at) = SymTab.ClChar)
|
|
|
- 1930 AND (SymTab.ClassOf(ft) = SymTab.ClArray)
|
|
|
- 1931 AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
|
|
|
- 1932 AND QbeGen.IsImm(qe) THEN
|
|
|
- 1933 ELSIF (AST.Kind(astActual) #
|
|
|
- 1934 AST.NkDesignator)
|
|
|
- 1935 AND (AST.Kind(astActual) # AST.NkStrLit) THEN
|
|
|
- 1936 SemError(233)
|
|
|
- 1937 ELSIF NOT SymTab.VarParamOk(at, ft) THEN
|
|
|
- 1938 SemError(233)
|
|
|
- 1939 END
|
|
|
- 1940 ELSE
|
|
|
- 1941 IF (SymTab.ClassOf(at) = SymTab.ClChar)
|
|
|
- 1942 AND (SymTab.ClassOf(ft) = SymTab.ClArray)
|
|
|
- 1943 AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
|
|
|
- 1944 AND QbeGen.IsImm(qe) THEN
|
|
|
- 1945 ELSIF NOT SymTab.Assignable(at, ft) THEN
|
|
|
- 1946 SemError(233)
|
|
|
- 1947 END
|
|
|
- 1948 END; .) .
|
|
|
- 1949 IfStat (. VAR t: SymTab.TypeIndex;
|
|
|
- 1950 q: QbeGen.QVal;
|
|
|
- 1951 hasElse: BOOLEAN;
|
|
|
- 1952 astCond, astIf, astLast,
|
|
|
- 1953 astNode: AST.Node; .)
|
|
|
- 1954 = "IF" (. hasElse := FALSE; .)
|
|
|
- 1955 Expr<t, q> (. astCond := astCur; astStmt := AST.NoNode;
|
|
|
- 1956 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
- 1957 SemError(214) END; .)
|
|
|
- 1958 "THEN" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkIf);
|
|
|
- 1959 AST.SetChild(astNode, 0, astCond);
|
|
|
- 1960 AST.SetChild(astNode, 1, astStmt);
|
|
|
- 1961 astIf := astNode;
|
|
|
- 1962 astLast := astNode; .)
|
|
|
- 1963 { "ELSIF"
|
|
|
- 1964 Expr<t, q> (. astCond := astCur; astStmt := AST.NoNode;
|
|
|
- 1965 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
- 1966 SemError(214) END; .)
|
|
|
- 1967 "THEN" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkIf);
|
|
|
- 1968 AST.SetChild(astNode, 0, astCond);
|
|
|
- 1969 AST.SetChild(astNode, 1, astStmt);
|
|
|
- 1970 AST.SetChild(astLast, 2, astNode);
|
|
|
- 1971 astLast := astNode; .) }
|
|
|
- 1972 [ "ELSE" (. hasElse := TRUE;
|
|
|
- 1973 astStmt := AST.NoNode; .)
|
|
|
- 1974 [ StatSeq ] (. AST.SetChild(astLast, 2, astStmt); .) ]
|
|
|
- 1975 "END" (. astStmt := astIf; .) .
|
|
|
- 1976 WhileStat (. VAR t: SymTab.TypeIndex;
|
|
|
- 1977 q: QbeGen.QVal;
|
|
|
- 1978 astCond, astNode: AST.Node; .)
|
|
|
- 1979 = "WHILE" (. astStmt := AST.NoNode; .)
|
|
|
- 1980 Expr<t, q> (. astCond := astCur;
|
|
|
- 1981 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
- 1982 SemError(214) END; .)
|
|
|
- 1983 "DO" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkWhile);
|
|
|
- 1984 AST.SetChild(astNode, 0, astCond);
|
|
|
- 1985 AST.SetChild(astNode, 1, astStmt);
|
|
|
- 1986 astStmt := astNode; .)
|
|
|
- 1987 "END" .
|
|
|
- 1988 RepeatStat (. VAR t: SymTab.TypeIndex;
|
|
|
- 1989 q: QbeGen.QVal;
|
|
|
- 1990 astCond, astBody, astNode:
|
|
|
- 1991 AST.Node; .)
|
|
|
- 1992 = "REPEAT" (. astStmt := AST.NoNode; .)
|
|
|
- 1993 [ StatSeq ] (. astBody := astStmt; .)
|
|
|
- 1994 "UNTIL" Expr<t, q> (. astCond := astCur;
|
|
|
- 1995 astNode := AST.MakeNode(AST.NkRepeat);
|
|
|
- 1996 AST.SetChild(astNode, 0, astBody);
|
|
|
- 1997 AST.SetChild(astNode, 1, astCond);
|
|
|
- 1998 astStmt := astNode;
|
|
|
- 1999 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
- 2000 SemError(214) END; .) .
|
|
|
- 2001 LoopStat (. VAR lEnd: QbeGen.QVal; astNode: AST.Node; .)
|
|
|
- 2002 = "LOOP" (. astStmt := AST.NoNode;
|
|
|
- 2003 QbeGen.NewLabel(lEnd);
|
|
|
- 2004 QbeGen.PushLoop(lEnd); .)
|
|
|
- 2005 [ StatSeq ]
|
|
|
- 2006 "END" (. astNode := AST.MakeNode(AST.NkLoop);
|
|
|
- 2007 AST.SetChild(astNode, 0, astStmt);
|
|
|
- 2008 astStmt := astNode;
|
|
|
- 2009 QbeGen.PopLoop; .) .
|
|
|
- 2010 (* FOR with static-sign BY (literal, non-zero; 220 otherwise).
|
|
|
- 2011 Runtime direction would need a compare-select; the literal
|
|
|
- 2012 sign picks cslew/csegew at "DO" time. *)
|
|
|
- 2013 ForStat (. VAR lv: SymTab.Name;
|
|
|
- 2014 tlo, thi, tby:
|
|
|
- 2015 SymTab.TypeIndex;
|
|
|
- 2016 qlo, qhi, qby, qt, qk, qb:
|
|
|
- 2017 QbeGen.QVal;
|
|
|
- 2018 lTop, lBody, lEnd:
|
|
|
- 2019 QbeGen.QVal;
|
|
|
- 2020 by: INTEGER;
|
|
|
- 2021 ok: BOOLEAN;
|
|
|
- 2022 astVar, astLo, astHi, astBy,
|
|
|
- 2023 astNode: AST.Node; .)
|
|
|
- 2024 = "FOR" (. by := 1; .)
|
|
|
- 2025 GetIdent<lv> (. astVar := AST.MakeLeaf(AST.NkIdent, lv);
|
|
|
- 2026 astStmt := AST.NoNode;
|
|
|
- 2027 astBy := AST.NoNode;
|
|
|
- 2028 ok := SymTab.Lookup(lv);
|
|
|
- 2029 IF NOT ok THEN
|
|
|
- 2030 SemError(201)
|
|
|
- 2031 ELSIF (SymTab.SymKind(lv) #
|
|
|
- 2032 SymTab.KindVar)
|
|
|
- 2033 AND (SymTab.SymKind(lv) #
|
|
|
- 2034 SymTab.KindParam) THEN
|
|
|
- 2035 SemError(220); ok := FALSE
|
|
|
- 2036 ELSIF NOT SymTab.IsIntFamily(
|
|
|
- 2037 SymTab.SymType(lv)) THEN
|
|
|
- 2038 SemError(220); ok := FALSE
|
|
|
- 2039 END; .)
|
|
|
- 2040 ":=" Expr<tlo, qlo> (. astLo := astCur;
|
|
|
- 2041 IF NOT SymTab.IsIntFamily(tlo) THEN
|
|
|
- 2042 SemError(220); ok := FALSE
|
|
|
- 2043 END; .)
|
|
|
- 2044 "TO" Expr<thi, qhi> (. astHi := astCur;
|
|
|
- 2045 IF NOT SymTab.IsIntFamily(thi) THEN
|
|
|
- 2046 SemError(220); ok := FALSE
|
|
|
- 2047 END; .)
|
|
|
- 2048 [ "BY" Expr<tby, qby> (. astBy := astCur;
|
|
|
- 2049 IF (tby #
|
|
|
- 2050 SymTab.InvalidType)
|
|
|
- 2051 AND NOT SymTab.IsIntFamily(tby) THEN
|
|
|
- 2052 SemError(220); ok := FALSE
|
|
|
- 2053 END;
|
|
|
- 2054 IF NOT SymTab.ConstInt(qby, by) THEN
|
|
|
- 2055 SemError(230); by := 1
|
|
|
- 2056 ELSIF by = 0 THEN
|
|
|
- 2057 SemError(220); by := 1
|
|
|
- 2058 END; .) ]
|
|
|
- 2059 "DO"
|
|
|
- 2060 [ StatSeq ]
|
|
|
- 2061 "END" (. astNode := AST.MakeNode(AST.NkFor);
|
|
|
- 2062 AST.SetChild(astNode, 0, astVar);
|
|
|
- 2063 AST.SetChild(astNode, 1, astLo);
|
|
|
- 2064 AST.SetChild(astNode, 2, astHi);
|
|
|
- 2065 AST.SetChild(astNode, 3, astBy);
|
|
|
- 2066 AST.SetChild(astNode, 4, astStmt);
|
|
|
- 2067 astStmt := astNode;
|
|
|
- 2068 .) .
|
|
|
- 2069 CaseStat (. VAR tsel: SymTab.TypeIndex;
|
|
|
- 2070 qsel, lEnd: QbeGen.QVal;
|
|
|
- 2071 arm, astNode, astArms,
|
|
|
- 2072 astArmsTail: AST.Node; .)
|
|
|
- 2073 = "CASE" Expr<tsel, qsel> (. astNode := AST.MakeNode(AST.NkCase);
|
|
|
- 2074 AST.SetChild(astNode, 0, astCur);
|
|
|
- 2075 astArms := AST.NoNode;
|
|
|
- 2076 astArmsTail := AST.NoNode;
|
|
|
- 2077 .)
|
|
|
- 2078 "OF" CaseAlt<tsel, qsel, lEnd, astArms, astArmsTail>
|
|
|
- 2079 { "|" CaseAlt<tsel, qsel, lEnd, astArms, astArmsTail> }
|
|
|
- 2080 [ "ELSE" (. astStmt := AST.NoNode; .)
|
|
|
- 2081 [ StatSeq ] (. arm := AST.MakeNode(AST.NkCaseArm);
|
|
|
- 2082 AST.SetOp(arm, 1);
|
|
|
- 2083 AST.SetChild(arm, 0, astStmt);
|
|
|
- 2084 AstAppend(AST.NkBlock,
|
|
|
- 2085 astArms, astArmsTail, arm); .) ]
|
|
|
- 2086 "END" (. AST.SetChild(astNode, 1, astArms);
|
|
|
- 2087 astStmt := astNode;
|
|
|
- 2088 .) .
|
|
|
- 2089 (* Compare-chain lowering: each alternative ends its match-tests
|
|
|
- 2090 with "jmp lAfter", so the no-match fallthrough skips the body:
|
|
|
- 2091 "cmp; jnz(lBody,lF); lF: ... ; jmp lAfter; lBody: S; jmp lEnd;
|
|
|
- 2092 lAfter:". Falls into the next alternative, ELSE, or END. *)
|
|
|
- 2093 CaseAlt<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
|
|
|
- 2094 lEnd: QbeGen.QVal; VAR arms, armsTail: AST.Node>
|
|
|
- 2095 (. VAR arm: AST.Node; .)
|
|
|
- 2096 = (. arm := AST.MakeNode(AST.NkCaseArm); .)
|
|
|
- 2097 CaseLabel<tsel, qsel, arm>
|
|
|
- 2098 { "," CaseLabel<tsel, qsel, arm> }
|
|
|
- 2099 ":" (. astStmt := AST.NoNode; .)
|
|
|
- 2100 [ StatSeq ] (. AST.SetChild(arm, AST.NChild(arm),
|
|
|
- 2101 astStmt);
|
|
|
- 2102 AstAppend(AST.NkBlock,
|
|
|
- 2103 arms, armsTail, arm);
|
|
|
- 2104 .) .
|
|
|
- 2105 CaseLabel<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
|
|
|
- 2106 arm: AST.Node>
|
|
|
- 2107 (. VAR t2, t3: SymTab.TypeIndex;
|
|
|
- 2108 q2, q3, qc, qd, qe:
|
|
|
- 2109 QbeGen.QVal;
|
|
|
- 2110 astLab: AST.Node;
|
|
|
- 2111 lNext: QbeGen.QVal; .)
|
|
|
- 2112 = Expr<t2, q2> (. astLab := astCur;
|
|
|
- 2113 IF (t2 #
|
|
|
- 2114 SymTab.InvalidType)
|
|
|
- 2115 AND (tsel #
|
|
|
- 2116 SymTab.InvalidType)
|
|
|
- 2117 AND ((SymTab.ClassOf(t2) =
|
|
|
- 2118 SymTab.ClSet)
|
|
|
- 2119 OR (SymTab.ClassOf(tsel) =
|
|
|
- 2120 SymTab.ClSet)) THEN
|
|
|
- 2121 SemError(230)
|
|
|
- 2122 ELSIF (t2 #
|
|
|
- 2123 SymTab.InvalidType)
|
|
|
- 2124 AND (tsel #
|
|
|
- 2125 SymTab.InvalidType)
|
|
|
- 2126 AND NOT SymTab.EqCheck(t2,
|
|
|
- 2127 tsel) THEN
|
|
|
- 2128 SemError(213) END;
|
|
|
- 2129 IF NOT QbeGen.IsImm(q2) THEN
|
|
|
- 2130 SemError(230)
|
|
|
- 2131 END; .)
|
|
|
- 2132 [ ".." Expr<t3, q3> (. astLab := AST.MakeBin(
|
|
|
- 2133 AST.NkSubrange, 0, astLab, astCur);
|
|
|
- 2134 IF (t3 #
|
|
|
- 2135 SymTab.InvalidType)
|
|
|
- 2136 AND (tsel #
|
|
|
- 2137 SymTab.InvalidType)
|
|
|
- 2138 AND NOT SymTab.EqCheck(t3,
|
|
|
- 2139 tsel) THEN
|
|
|
- 2140 SemError(213) END;
|
|
|
- 2141 IF NOT QbeGen.IsImm(q3) THEN
|
|
|
- 2142 SemError(230)
|
|
|
- 2143 END; .) ]
|
|
|
- 2144 (. AST.SetChild(arm,
|
|
|
- 2145 AST.NChild(arm), astLab); .) .
|
|
|
- 2146 ReturnStat (. VAR t: SymTab.TypeIndex;
|
|
|
- 2147 q, qt: QbeGen.QVal;
|
|
|
- 2148 res: SymTab.TypeIndex;
|
|
|
- 2149 hadE, conv: BOOLEAN;
|
|
|
- 2150 astVal, astNode: AST.Node; .)
|
|
|
- 2151 = "RETURN" (. hadE := FALSE; astStmt := AST.NoNode; .)
|
|
|
- 2152 [ Expr<t, q> (. hadE := TRUE; astVal := astCur; .) ]
|
|
|
- 2153 (. astNode := AST.MakeNode(AST.NkReturn);
|
|
|
- 2154 IF hadE THEN
|
|
|
- 2155 AST.SetChild(astNode, 0, astVal)
|
|
|
- 2156 END;
|
|
|
- 2157 astStmt := astNode;
|
|
|
- 2158 conv := FALSE;
|
|
|
- 2159 IF NOT SymTab.InProc() THEN
|
|
|
- 2160 SemError(232)
|
|
|
- 2161 ELSE res := SymTab.CurRes();
|
|
|
- 2162 IF NOT hadE THEN
|
|
|
- 2163 IF res #
|
|
|
- 2164 SymTab.InvalidType THEN
|
|
|
- 2165 SemError(232)
|
|
|
- 2166 END
|
|
|
- 2167 ELSIF (res =
|
|
|
- 2168 SymTab.InvalidType)
|
|
|
- 2169 OR (t #
|
|
|
- 2170 SymTab.InvalidType)
|
|
|
- 2171 AND NOT SymTab.Assignable(t,
|
|
|
- 2172 res) THEN
|
|
|
- 2173 SemError(232)
|
|
|
- 2174 END
|
|
|
- 2175 END; .) .
|
|
|
- 2176 HaltStat (. VAR t: SymTab.TypeIndex;
|
|
|
- 2177 q: QbeGen.QVal;
|
|
|
- 2178 astVal, astNode: AST.Node; .)
|
|
|
- 2179 = "HALT" (. astVal := AST.NoNode; .)
|
|
|
- 2180 [ "(" Expr<t, q> (. astVal := astCur; .) ")" ]
|
|
|
- 2181 (. astNode := AST.MakeNode(AST.NkHalt);
|
|
|
- 2182 IF astVal # AST.NoNode THEN
|
|
|
- 2183 AST.SetChild(astNode, 0, astVal)
|
|
|
- 2184 END;
|
|
|
- 2185 astStmt := astNode;
|
|
|
- 2186 .) .
|
|
|
- 2187 (* Designator: scalar loads, array addresses, and index suffixes.
|
|
|
- 2188 Each index descends one level (bounds-checked, trap on breach);
|
|
|
- 2189 nested levels reload the inner descriptor address. q ends as the
|
|
|
- 2190 value (scalars), the descriptor address (plain arrays), or the
|
|
|
- 2191 element address (indexed); sfx marks the indexed form. *)
|
|
|
- 2192 Design<VAR t: SymTab.TypeIndex; VAR k: INTEGER;
|
|
|
- 2193 VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
|
|
|
- 2194 (. VAR n: SymTab.Name; .)
|
|
|
- 2195 = GetIdent<n> DesignTail<n, t, k, q, qn, sfx> .
|
|
|
- 2196 (* The part of Design after the identifier: resolve it and walk the
|
|
|
- 2197 selectors. Split out so a statement can decide between a label
|
|
|
- 2198 (`ident :`) and a designator (`ident := ...`) with one token. *)
|
|
|
- 2199 DesignTail<VAR n: SymTab.Name; VAR t: SymTab.TypeIndex; VAR k: INTEGER;
|
|
|
- 2200 VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
|
|
|
- 2201 (. VAR fn, mal: SymTab.Name;
|
|
|
- 2202 cls: INTEGER;
|
|
|
- 2203 ic: SymTab.TypeIndex;
|
|
|
- 2204 curT, it, eT, bt:
|
|
|
- 2205 SymTab.TypeIndex;
|
|
|
- 2206 iq, ql, qlo, qhi, qe:
|
|
|
- 2207 QbeGen.QVal;
|
|
|
- 2208 lo, hi: INTEGER;
|
|
|
- 2209 fo: INTEGER;
|
|
|
- 2210 isOpen: BOOLEAN;
|
|
|
- 2211 qb, cv: QbeGen.QVal;
|
|
|
- 2212 fid, fref: INTEGER;
|
|
|
- 2213 r: BOOLEAN;
|
|
|
- 2214 astDes, astSel: AST.Node;
|
|
|
- 2215 fwd: BOOLEAN; .)
|
|
|
- 2216 = (. methCls := SymTab.InvalidType;
|
|
|
- 2217 QbeGen.CopyOp(n, qn);
|
|
|
- 2218 sfx := FALSE; fwd := FALSE;
|
|
|
- 2219 fid := 0; fref := 0;
|
|
|
- 2220 IF NOT SymTab.Lookup(n) THEN
|
|
|
- 2221 (* a bare method name inside
|
|
|
- 2222 a CLASS IMPLEMENTATION
|
|
|
- 2223 is a sibling call on
|
|
|
- 2224 THIS *)
|
|
|
- 2225 ic := SymTab.CurImplClass();
|
|
|
- 2226 IF (ic #
|
|
|
- 2227 SymTab.InvalidType)
|
|
|
- 2228 AND SymTab.MethodExists(ic, n) THEN
|
|
|
- 2229 sfx := FALSE;
|
|
|
- 2230 QbeGen.CopyOp("@", q);
|
|
|
- 2231 methCls := ic;
|
|
|
- 2232 k := SymTab.KindProc;
|
|
|
- 2233 t := SymTab.InvalidType
|
|
|
- 2234 ELSIF SymTab.InProc() THEN
|
|
|
- 2235 (* not declared yet: a
|
|
|
- 2236 forward reference to a
|
|
|
- 2237 module-level variable
|
|
|
- 2238 declared further down. *)
|
|
|
- 2239 k := SymTab.KindVar;
|
|
|
- 2240 r := SymTab.FwdVarRef(n, k,
|
|
|
- 2241 fref, t);
|
|
|
- 2242 QbeGen.CopyOp("@", q);
|
|
|
- 2243 sfx := TRUE; fwd := TRUE
|
|
|
- 2244 ELSE
|
|
|
- 2245 SemError(201);
|
|
|
- 2246 t :=
|
|
|
- 2247 SymTab.InvalidType;
|
|
|
- 2248 k := -1;
|
|
|
- 2249 QbeGen.CopyOp("0", q)
|
|
|
- 2250 END
|
|
|
- 2251 ELSE
|
|
|
- 2252 t := SymTab.SymType(n);
|
|
|
- 2253 k := SymTab.SymKind(n);
|
|
|
- 2254 IF k = SymTab.KindConst THEN
|
|
|
- 2255 IF SymTab.Equal(n,
|
|
|
- 2256 "TRUE") THEN
|
|
|
- 2257 t := SymTab.BoolType();
|
|
|
- 2258 QbeGen.CopyOp("1", q)
|
|
|
- 2259 ELSIF SymTab.Equal(n,
|
|
|
- 2260 "FALSE") THEN
|
|
|
- 2261 t := SymTab.BoolType();
|
|
|
- 2262 QbeGen.CopyOp("0", q)
|
|
|
- 2263 ELSIF SymTab.Equal(n,
|
|
|
- 2264 "NIL") THEN
|
|
|
- 2265 QbeGen.CopyOp("0", q)
|
|
|
- 2266 ELSE
|
|
|
- 2267 cls :=
|
|
|
- 2268 SymTab.ClassOf(t);
|
|
|
- 2269 IF (t #
|
|
|
- 2270 SymTab.InvalidType)
|
|
|
- 2271 AND ((cls = SymTab.ClInt)
|
|
|
- 2272 OR (cls
|
|
|
- 2273 = SymTab.ClChar)
|
|
|
- 2274 OR (cls
|
|
|
- 2275 = SymTab.ClEnum)
|
|
|
- 2276 OR (cls
|
|
|
- 2277 = SymTab.ClReal)
|
|
|
- 2278 OR (cls
|
|
|
- 2279 = SymTab.ClLong)
|
|
|
- 2280 OR (cls
|
|
|
- 2281 = SymTab.ClNil)) THEN
|
|
|
- 2282 IF cls = SymTab.ClNil THEN
|
|
|
- 2283 QbeGen.CopyOp("0", q)
|
|
|
- 2284 ELSIF ((cls
|
|
|
- 2285 = SymTab.ClInt)
|
|
|
- 2286 OR (cls
|
|
|
- 2287 = SymTab.ClChar)
|
|
|
- 2288 OR (cls
|
|
|
- 2289 = SymTab.ClEnum)
|
|
|
- 2290 OR (cls
|
|
|
- 2291 = SymTab.ClLong))
|
|
|
- 2292 AND SymTab.GetSymVal(n, cv)
|
|
|
- 2293 AND QbeGen.IsImm(cv) THEN
|
|
|
- 2294 QbeGen.CopyOp(cv, q)
|
|
|
- 2295 ELSE
|
|
|
- 2296 QbeGen.LoadVar(n,
|
|
|
- 2297 cls = SymTab.ClReal,
|
|
|
- 2298 q)
|
|
|
- 2299 END
|
|
|
- 2300 ELSIF (cls = SymTab.ClArray)
|
|
|
- 2301 OR (cls = SymTab.ClRecord)
|
|
|
- 2302 OR (cls = SymTab.ClClass)
|
|
|
- 2303 OR (cls = SymTab.ClStr)
|
|
|
- 2304 OR (cls = SymTab.ClUStr) THEN
|
|
|
- 2305 (* aggregate constant:
|
|
|
- 2306 its value IS the
|
|
|
- 2307 descriptor address *)
|
|
|
- 2308 IF SymTab.GetSymVal(n, cv) THEN
|
|
|
- 2309 QbeGen.CopyOp(cv, q)
|
|
|
- 2310 ELSE
|
|
|
- 2311 QbeGen.CopyOp("0", q)
|
|
|
- 2312 END
|
|
|
- 2313 ELSE
|
|
|
- 2314 IF t #
|
|
|
- 2315 SymTab.InvalidType THEN
|
|
|
- 2316 SemError(230)
|
|
|
- 2317 END;
|
|
|
- 2318 QbeGen.CopyOp("0", q)
|
|
|
- 2319 END
|
|
|
- 2320 END
|
|
|
- 2321 ELSIF (k = SymTab.KindVar)
|
|
|
- 2322 OR (k = SymTab.KindParam) THEN
|
|
|
- 2323 cls := SymTab.ClassOf(t);
|
|
|
- 2324 IF (cls # SymTab.ClInt)
|
|
|
- 2325 AND (cls # SymTab.ClBool)
|
|
|
- 2326 AND (cls # SymTab.ClChar)
|
|
|
- 2327 AND (cls # SymTab.ClUChar)
|
|
|
- 2328 AND (cls # SymTab.ClEnum)
|
|
|
- 2329 AND (cls # SymTab.ClReal)
|
|
|
- 2330 AND (cls # SymTab.ClPtr)
|
|
|
- 2331 AND (cls # SymTab.ClProc)
|
|
|
- 2332 AND (cls # SymTab.ClLong)
|
|
|
- 2333 AND (cls # SymTab.ClArray)
|
|
|
- 2334 AND (cls # SymTab.ClSet)
|
|
|
- 2335 AND (cls # SymTab.ClRecord)
|
|
|
- 2336 AND (cls # SymTab.ClUStr)
|
|
|
- 2337 AND (cls # SymTab.ClClass) THEN
|
|
|
- 2338 SemError(230);
|
|
|
- 2339 QbeGen.CopyOp("0", q)
|
|
|
- 2340 ELSE QbeGen.CopyOp("@", q)
|
|
|
- 2341 END
|
|
|
- 2342 ELSE QbeGen.CopyOp("0", q);
|
|
|
- 2343 IF k = SymTab.KindImport THEN
|
|
|
- 2344 SemError(230)
|
|
|
- 2345 ELSIF k =
|
|
|
- 2346 SymTab.KindProc THEN
|
|
|
- 2347 (* bare procedure name:
|
|
|
- 2348 a following ArgList
|
|
|
- 2349 makes it a call;
|
|
|
- 2350 otherwise Fact
|
|
|
- 2351 reports 230 *)
|
|
|
- 2352 ELSE
|
|
|
- 2353 IF k = SymTab.KindField THEN
|
|
|
- 2354 IF QbeGen.TopWith(qb) THEN
|
|
|
- 2355 sfx := TRUE
|
|
|
- 2356 ELSE SemError(230);
|
|
|
- 2357 QbeGen.CopyOp("0", q)
|
|
|
- 2358 END
|
|
|
- 2359 END
|
|
|
- 2360 END
|
|
|
- 2361 END
|
|
|
- 2362 END; .)
|
|
|
- 2363 (. astDes := AST.MakeNode(AST.NkDesignator);
|
|
|
- 2364 AST.SetChild(astDes, AST.NChild(astDes), AST.MakeLeaf(AST.NkIdent, n));
|
|
|
- 2365 IF fwd THEN AST.SetOp(astDes, 1) END;
|
|
|
- 2366 IF fwd THEN Check.NoteForward(fref, astDes) END; .)
|
|
|
- 2367 { "[" Expr<it, iq>
|
|
|
- 2368 (. AST.SetChild(astDes, AST.NChild(astDes),
|
|
|
- 2369 AST.MakeUn(AST.NkSelector, AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
- 2370 ELSIF SymTab.ClassOf(t) #
|
|
|
- 2371 SymTab.ClArray THEN
|
|
|
- 2372 SemError(217);
|
|
|
- 2373 t := SymTab.InvalidType
|
|
|
- 2374 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
- 2375 AND (SymTab.ClassOf(it) #
|
|
|
- 2376 SymTab.ClChar)
|
|
|
- 2377 AND (SymTab.ClassOf(it) #
|
|
|
- 2378 SymTab.ClEnum) THEN
|
|
|
- 2379 SemError(218);
|
|
|
- 2380 t := SymTab.InvalidType
|
|
|
- 2381 ELSE
|
|
|
- 2382 eT := SymTab.ArrayElem(t);
|
|
|
- 2383 t := eT; sfx := TRUE
|
|
|
- 2384 END; .)
|
|
|
- 2385 { "," Expr<it, iq>
|
|
|
- 2386 (. AST.SetChild(astDes, AST.NChild(astDes),
|
|
|
- 2387 AST.MakeUn(AST.NkSelector, AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
- 2388 ELSIF SymTab.ClassOf(t) #
|
|
|
- 2389 SymTab.ClArray THEN
|
|
|
- 2390 SemError(217);
|
|
|
- 2391 t := SymTab.InvalidType
|
|
|
- 2392 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
- 2393 AND (SymTab.ClassOf(it) #
|
|
|
- 2394 SymTab.ClChar)
|
|
|
- 2395 AND (SymTab.ClassOf(it) #
|
|
|
- 2396 SymTab.ClEnum) THEN
|
|
|
- 2397 SemError(218);
|
|
|
- 2398 t := SymTab.InvalidType
|
|
|
- 2399 ELSE
|
|
|
- 2400 eT := SymTab.ArrayElem(t);
|
|
|
- 2401 t := eT; sfx := TRUE
|
|
|
- 2402 END; .) }
|
|
|
- 2403 "]"
|
|
|
- 2404 | "." GetIdent<fn>
|
|
|
- 2405 (. astSel := AST.MakeNode(AST.NkSelector);
|
|
|
- 2406 AST.SetOp(astSel, AST.SelField);
|
|
|
- 2407 AST.SetChild(astSel, 0, AST.MakeLeaf(AST.NkIdent, fn));
|
|
|
- 2408 AST.SetChild(astDes, AST.NChild(astDes), astSel); IF k = SymTab.KindModule THEN
|
|
|
- 2409 (* qualified L.x: materialize
|
|
|
- 2410 the export, then load it *)
|
|
|
- 2411 IF NOT SymTab.MaterializeAlias(n,
|
|
|
- 2412 fn, mal) THEN
|
|
|
- 2413 SemError(201);
|
|
|
- 2414 t := SymTab.InvalidType;
|
|
|
- 2415 QbeGen.CopyOp("0", q)
|
|
|
- 2416 ELSE
|
|
|
- 2417 QbeGen.CopyOp(mal, qn);
|
|
|
- 2418 t := SymTab.SymType(mal);
|
|
|
- 2419 k := SymTab.SymKind(mal);
|
|
|
- 2420 sfx := FALSE;
|
|
|
- 2421 IF k = SymTab.KindProc THEN
|
|
|
- 2422 (* call: ArgList supplies
|
|
|
- 2423 the value *)
|
|
|
- 2424 QbeGen.CopyOp("0", q)
|
|
|
- 2425 END
|
|
|
- 2426 END
|
|
|
- 2427 ELSIF t = SymTab.InvalidType THEN
|
|
|
- 2428 ELSIF (SymTab.ClassOf(t) #
|
|
|
- 2429 SymTab.ClRecord)
|
|
|
- 2430 AND (SymTab.ClassOf(t) #
|
|
|
- 2431 SymTab.ClClass) THEN
|
|
|
- 2432 SemError(215);
|
|
|
+ 1635 sfx, isInc: BOOLEAN;
|
|
|
+ 1636 astNode, astD, astStep:
|
|
|
+ 1637 AST.Node; .)
|
|
|
+ 1638 = (. isInc := TRUE; .)
|
|
|
+ 1639 ( "INC" (. isInc := TRUE; .)
|
|
|
+ 1640 | "DEC" (. isInc := FALSE; .) )
|
|
|
+ 1641 "(" (. astStep := AST.NoNode; .)
|
|
|
+ 1642 Design<dt, dk, qd, qn, sfx> (. astD := astCur; .)
|
|
|
+ 1643 [ "," Expr<et2, qstep> (. astStep := astCur; .) ]
|
|
|
+ 1644 ")" (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 1645 IF isInc THEN
|
|
|
+ 1646 AST.SetChild(astNode, 0,
|
|
|
+ 1647 AST.MakeLeaf(AST.NkIdent, "INC"))
|
|
|
+ 1648 ELSE AST.SetChild(astNode, 0,
|
|
|
+ 1649 AST.MakeLeaf(AST.NkIdent, "DEC"))
|
|
|
+ 1650 END;
|
|
|
+ 1651 IF astD # AST.NoNode THEN
|
|
|
+ 1652 AST.SetChild(astNode, 1, astD) END;
|
|
|
+ 1653 IF astStep # AST.NoNode THEN
|
|
|
+ 1654 AST.SetChild(astNode, 2, astStep) END;
|
|
|
+ 1655 astStmt := astNode; .) (. IF dt = SymTab.InvalidType THEN
|
|
|
+ 1656 ELSIF (dk # SymTab.KindVar)
|
|
|
+ 1657 AND (dk # SymTab.KindParam)
|
|
|
+ 1658 AND (dk # SymTab.KindField) THEN
|
|
|
+ 1659 SemError(210)
|
|
|
+ 1660 ELSIF NOT SymTab.IsIntFamily(dt) THEN
|
|
|
+ 1661 SemError(211)
|
|
|
+ 1662 END; .) .
|
|
|
+ 1663 (* NEW/DISPOSE as builtin statements (no call syntax until step 4).
|
|
|
+ 1664 Targets are pointer designators; DISPOSE nils afterwards (safer
|
|
|
+ 1665 than Wirth-undefined; documented). DISPOSE is shallow. *)
|
|
|
+ 1666 NewStat (. VAR dt: SymTab.TypeIndex;
|
|
|
+ 1667 dk: INTEGER;
|
|
|
+ 1668 qd, qm: QbeGen.QVal;
|
|
|
+ 1669 qn: SymTab.Name;
|
|
|
+ 1670 sfx: BOOLEAN;
|
|
|
+ 1671 bt: SymTab.TypeIndex;
|
|
|
+ 1672 astNode, astD: AST.Node; .)
|
|
|
+ 1673 = "NEW" "(" Design<dt, dk, qd, qn, sfx> (. astD := astCur; .) ")"
|
|
|
+ 1674 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 1675 AST.SetChild(astNode, 0,
|
|
|
+ 1676 AST.MakeLeaf(AST.NkIdent, "NEW"));
|
|
|
+ 1677 IF astD # AST.NoNode THEN
|
|
|
+ 1678 AST.SetChild(astNode, 1, astD) END;
|
|
|
+ 1679 astStmt := astNode; .)
|
|
|
+ 1680 (. IF dt = SymTab.InvalidType THEN
|
|
|
+ 1681 ELSIF (dk # SymTab.KindVar)
|
|
|
+ 1682 AND (dk # SymTab.KindParam)
|
|
|
+ 1683 AND (dk # SymTab.KindField) THEN
|
|
|
+ 1684 SemError(210)
|
|
|
+ 1685 ELSIF SymTab.ClassOf(dt) #
|
|
|
+ 1686 SymTab.ClPtr THEN
|
|
|
+ 1687 SemError(219)
|
|
|
+ 1688 END; .) .
|
|
|
+ 1689 DisposeStat (. VAR dt: SymTab.TypeIndex;
|
|
|
+ 1690 dk: INTEGER;
|
|
|
+ 1691 qd, qv: QbeGen.QVal;
|
|
|
+ 1692 qn: SymTab.Name;
|
|
|
+ 1693 sfx: BOOLEAN;
|
|
|
+ 1694 astNode, astD: AST.Node; .)
|
|
|
+ 1695 = "DISPOSE" "(" Design<dt, dk, qd, qn, sfx> (. astD := astCur; .) ")"
|
|
|
+ 1696 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 1697 AST.SetChild(astNode, 0,
|
|
|
+ 1698 AST.MakeLeaf(AST.NkIdent, "DISPOSE"));
|
|
|
+ 1699 IF astD # AST.NoNode THEN
|
|
|
+ 1700 AST.SetChild(astNode, 1, astD) END;
|
|
|
+ 1701 astStmt := astNode; .)
|
|
|
+ 1702 (. IF dt = SymTab.InvalidType THEN
|
|
|
+ 1703 ELSIF (dk # SymTab.KindVar)
|
|
|
+ 1704 AND (dk # SymTab.KindParam)
|
|
|
+ 1705 AND (dk # SymTab.KindField) THEN
|
|
|
+ 1706 SemError(210)
|
|
|
+ 1707 ELSIF SymTab.ClassOf(dt) #
|
|
|
+ 1708 SymTab.ClPtr THEN
|
|
|
+ 1709 SemError(219)
|
|
|
+ 1710 END; .) .
|
|
|
+ 1711 (* WITH pushes each record's fields (inner wins) plus its base
|
|
|
+ 1712 address; field designators resolve through both stacks. *)
|
|
|
+ 1713 WithStat (. VAR nW: CARDINAL;
|
|
|
+ 1714 astNode: AST.Node; .)
|
|
|
+ 1715 = "WITH" (. nW := 0;
|
|
|
+ 1716 astNode := AST.MakeNode(AST.NkWith); .)
|
|
|
+ 1717 WithItem<nW, astNode> { "," WithItem<nW, astNode> }
|
|
|
+ 1718 "DO" (. astStmt := AST.NoNode; .)
|
|
|
+ 1719 [ StatSeq ] "END" (. AST.SetChild(astNode,
|
|
|
+ 1720 AST.NChild(astNode), astStmt);
|
|
|
+ 1721 astStmt := astNode;
|
|
|
+ 1722 WHILE nW > 0 DO
|
|
|
+ 1723 SymTab.PopScope;
|
|
|
+ 1724 QbeGen.PopWith;
|
|
|
+ 1725 DEC(nW)
|
|
|
+ 1726 END; .) .
|
|
|
+ 1727 WithItem<VAR nW: CARDINAL; wnode: AST.Node>
|
|
|
+ 1728 (. VAR dt: SymTab.TypeIndex;
|
|
|
+ 1729 dk: INTEGER;
|
|
|
+ 1730 qd, qe: QbeGen.QVal;
|
|
|
+ 1731 qn: SymTab.Name;
|
|
|
+ 1732 sfx: BOOLEAN; .)
|
|
|
+ 1733 = Design<dt, dk, qd, qn, sfx>
|
|
|
+ 1734 (. IF astCur # AST.NoNode THEN
|
|
|
+ 1735 AST.SetChild(wnode,
|
|
|
+ 1736 AST.NChild(wnode), astCur) END;
|
|
|
+ 1737 IF dt = SymTab.InvalidType THEN
|
|
|
+ 1738 ELSIF (SymTab.ClassOf(dt) #
|
|
|
+ 1739 SymTab.ClRecord)
|
|
|
+ 1740 AND (SymTab.ClassOf(dt) #
|
|
|
+ 1741 SymTab.ClClass) THEN
|
|
|
+ 1742 SemError(215)
|
|
|
+ 1743 ELSIF SymTab.PushRecord(dt) THEN
|
|
|
+ 1744 QbeGen.PushWith(qd);
|
|
|
+ 1745 INC(nW)
|
|
|
+ 1746 END; .) .
|
|
|
+ 1747 (* Assignment or procedure-statement call (4.1, module level).
|
|
|
+ 1748 Bare `P;` is a syntax error; function-as-statement is 233. *)
|
|
|
+ 1749 AssOrCall (. VAR dt, et: SymTab.TypeIndex;
|
|
|
+ 1750 dk: INTEGER;
|
|
|
+ 1751 qd, qe, qt, ql: QbeGen.QVal;
|
|
|
+ 1752 qn: SymTab.Name;
|
|
|
+ 1753 ct2, res0: SymTab.TypeIndex;
|
|
|
+ 1754 q2, mg0: QbeGen.QVal;
|
|
|
+ 1755 isR, conv, wconv: BOOLEAN;
|
|
|
+ 1756 called, sfx: BOOLEAN;
|
|
|
+ 1757 astLhs, astRes: AST.Node; mname: SymTab.Name; isM: BOOLEAN;
|
|
|
+ 1758 n: SymTab.Name; astLab, astNode: AST.Node; .)
|
|
|
+ 1759 = GetIdent<n>
|
|
|
+ 1760 ( ":" (. NoteLabel(n);
|
|
|
+ 1761 astNode := AST.MakeNode(AST.NkLabel);
|
|
|
+ 1762 AST.SetChild(astNode, 0,
|
|
|
+ 1763 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
+ 1764 astLab := AST.MakeNode(AST.NkBlock);
|
|
|
+ 1765 AST.SetChild(astLab, 0, astNode); .)
|
|
|
+ 1766 Statement (. IF astStmt # AST.NoNode THEN
|
|
|
+ 1767 AST.SetChild(astLab, 1, astStmt) END;
|
|
|
+ 1768 astStmt := astLab; .)
|
|
|
+ 1769 | DesignTail<n, dt, dk, qd, qn, sfx>
|
|
|
+ 1770 (. astLhs := astCur; astNArgs := 0; .)
|
|
|
+ 1771 ( ":="
|
|
|
+ 1772 Expr<et, qe> (. astStmt := AST.MakeBin(
|
|
|
+ 1773 AST.NkAssign, 0, astLhs, astCur);
|
|
|
+ 1774 IF (dt # SymTab.InvalidType)
|
|
|
+ 1775 AND (dk # SymTab.KindVar)
|
|
|
+ 1776 AND (dk # SymTab.KindParam)
|
|
|
+ 1777 AND (dk # SymTab.KindField) THEN
|
|
|
+ 1778 SemError(210)
|
|
|
+ 1779 ELSIF NOT SymTab.Assignable(et,
|
|
|
+ 1780 dt) THEN
|
|
|
+ 1781 SemError(210)
|
|
|
+ 1782 ELSIF (dt # SymTab.InvalidType)
|
|
|
+ 1783 AND (SymTab.ClassOf(dt) =
|
|
|
+ 1784 SymTab.ClClass) THEN
|
|
|
+ 1785 SemError(230) END;
|
|
|
+ 1786 isR := (dt #
|
|
|
+ 1787 SymTab.InvalidType)
|
|
|
+ 1788 AND (SymTab.ClassOf(dt)
|
|
|
+ 1789 = SymTab.ClReal);
|
|
|
+ 1790 conv := isR
|
|
|
+ 1791 AND SymTab.IsIntFamily(et);
|
|
|
+ 1792 wconv := (dt #
|
|
|
+ 1793 SymTab.InvalidType)
|
|
|
+ 1794 AND SymTab.IsLongFamily(dt)
|
|
|
+ 1795 AND SymTab.IsIntFamily(et);
|
|
|
+ 1796 IF ((dk = SymTab.KindVar)
|
|
|
+ 1797 OR (dk = SymTab.KindParam)
|
|
|
+ 1798 OR (dk = SymTab.KindField))
|
|
|
+ 1799 AND (dt # SymTab.InvalidType)
|
|
|
+ 1800 AND (et # SymTab.InvalidType)
|
|
|
+ 1801 AND (SymTab.ClassOf(dt) #
|
|
|
+ 1802 SymTab.ClClass) THEN
|
|
|
+ 1803 END; .)
|
|
|
+ 1804 | ArgList<qn, dt, qd, TRUE, TRUE, methCls, ct2, q2, called>
|
|
|
+ 1805 (. astRes := AstCallNode(astLhs);
|
|
|
+ 1806 sfx := FALSE; .)
|
|
|
+ 1807 ( { ResultComp<ct2, q2, sfx, astRes, mname, methCls, isM> }
|
|
|
+ 1808 ":=" Expr<et, qe> (. astStmt := AST.MakeBin(
|
|
|
+ 1809 AST.NkAssign, 0, astRes, astCur);
|
|
|
+ 1810 IF NOT sfx THEN
|
|
|
+ 1811 SemError(233)
|
|
|
+ 1812 ELSIF (ct2 # SymTab.InvalidType)
|
|
|
+ 1813 AND NOT SymTab.Assignable(et, ct2) THEN
|
|
|
+ 1814 SemError(210)
|
|
|
+ 1815 END; .)
|
|
|
+ 1816 | (. IF ct2 #
|
|
|
+ 1817 SymTab.InvalidType THEN
|
|
|
+ 1818 SemError(233) END;
|
|
|
+ 1819 astStmt := astRes; .) )
|
|
|
+ 1820 | (* bare `P;`: proper parameterless
|
|
|
+ 1821 procedure call; anything else
|
|
|
+ 1822 here is 233 (was a bare syntax
|
|
|
+ 1823 error before 4.2) *)
|
|
|
+ 1824 (. astStmt := AstCallNode(astLhs);
|
|
|
+ 1825 IF (dk = SymTab.KindProc)
|
|
|
+ 1826 AND NOT sfx THEN
|
|
|
+ 1827 res0 := SymTab.ProcRes(qn);
|
|
|
+ 1828 IF res0 #
|
|
|
+ 1829 SymTab.InvalidType THEN
|
|
|
+ 1830 SemError(233)
|
|
|
+ 1831 ELSIF SymTab.ProcNPar(qn) #
|
|
|
+ 1832 0 THEN
|
|
|
+ 1833 SemError(233)
|
|
|
+ 1834 END
|
|
|
+ 1835 ELSE SemError(233)
|
|
|
+ 1836 END; .) ) ) .
|
|
|
+ 1837 (* Actual-parameter list shared by statement and expression calls.
|
|
|
+ 1838 want selects CallEnd's result handling; t/q carry the call
|
|
|
+ 1839 value (statement calls discard). Arity/type failures are 233;
|
|
|
+ 1840 evaluation code still emits so the .ssa stays assembleable. *)
|
|
|
+ 1841 ArgList<pn: SymTab.Name; pt: SymTab.TypeIndex; callee: QbeGen.QVal;
|
|
|
+ 1842 want: BOOLEAN; soft: BOOLEAN; methCls: SymTab.TypeIndex;
|
|
|
+ 1843 VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
|
|
|
+ 1844 VAR called: BOOLEAN> (. VAR i, np: CARDINAL;
|
|
|
+ 1845 vs: INTEGER;
|
|
|
+ 1846 res: SymTab.TypeIndex;
|
|
|
+ 1847 mg: QbeGen.QVal;
|
|
|
+ 1848 ok, ind, isMeth, va: BOOLEAN; .)
|
|
|
+ 1849 = "(" (. called := TRUE;
|
|
|
+ 1850 ok := TRUE;
|
|
|
+ 1851 ind := FALSE;
|
|
|
+ 1852 isMeth := methCls #
|
|
|
+ 1853 SymTab.InvalidType;
|
|
|
+ 1854 IF isMeth THEN
|
|
|
+ 1855 res := SymTab.ClassMethodRes(methCls, pn)
|
|
|
+ 1856 ELSIF SymTab.SymKind(pn) = SymTab.KindProc THEN
|
|
|
+ 1857 res := SymTab.ProcRes(pn)
|
|
|
+ 1858 ELSIF (pt # SymTab.InvalidType)
|
|
|
+ 1859 AND (SymTab.ClassOf(pt) = SymTab.ClProc) THEN
|
|
|
+ 1860 ind := TRUE;
|
|
|
+ 1861 res := SymTab.ProcTypeRes(pt)
|
|
|
+ 1862 ELSE SemError(233);
|
|
|
+ 1863 ok := FALSE;
|
|
|
+ 1864 res := SymTab.InvalidType
|
|
|
+ 1865 END;
|
|
|
+ 1866 i := 0; .)
|
|
|
+ 1867 [ ActParam<pn, pt, ind, methCls, i> (. INC(i); .)
|
|
|
+ 1868 { "," ActParam<pn, pt, ind, methCls, i> (. INC(i); .) } ]
|
|
|
+ 1869 ")" (. IF ok THEN
|
|
|
+ 1870 IF isMeth THEN
|
|
|
+ 1871 np := SymTab.ClassMethodNPar(
|
|
|
+ 1872 methCls, pn)
|
|
|
+ 1873 ELSIF ind THEN
|
|
|
+ 1874 np := SymTab.ProcTypeNPar(pt)
|
|
|
+ 1875 ELSE np := SymTab.ProcNPar(pn)
|
|
|
+ 1876 END;
|
|
|
+ 1877 va := (NOT isMeth) AND (NOT ind)
|
|
|
+ 1878 AND (SymTab.SymKind(pn) =
|
|
|
+ 1879 SymTab.KindProc)
|
|
|
+ 1880 AND SymTab.Varargs(pn);
|
|
|
+ 1881 IF (i # np) AND NOT va THEN
|
|
|
+ 1882 SemError(233); ok := FALSE
|
|
|
+ 1883 END
|
|
|
+ 1884 END;
|
|
|
+ 1885 IF NOT ok THEN
|
|
|
+ 1886 t := SymTab.InvalidType;
|
|
|
+ 1887 QbeGen.CopyOp("0", q)
|
|
|
+ 1888 ELSIF want THEN
|
|
|
+ 1889 IF res =
|
|
|
+ 1890 SymTab.InvalidType THEN
|
|
|
+ 1891 IF NOT soft THEN SemError(233) END;
|
|
|
+ 1892 t := SymTab.InvalidType;
|
|
|
+ 1893 QbeGen.CopyOp("0", q)
|
|
|
+ 1894 ELSE t := res;
|
|
|
+ 1895 QbeGen.CopyOp("@", q)
|
|
|
+ 1896 END
|
|
|
+ 1897 ELSE
|
|
|
+ 1898 IF res #
|
|
|
+ 1899 SymTab.InvalidType THEN
|
|
|
+ 1900 SemError(233)
|
|
|
+ 1901 END;
|
|
|
+ 1902 t := SymTab.InvalidType;
|
|
|
+ 1903 QbeGen.CopyOp("0", q);
|
|
|
+ 1904 END; .) .
|
|
|
+ 1905 (* One actual: VAR formals take recorded designator addresses
|
|
|
+ 1906 (233 otherwise); value formals take converted expressions. *)
|
|
|
+ 1907 ActParam<pn: SymTab.Name; pt: SymTab.TypeIndex; ind: BOOLEAN;
|
|
|
+ 1908 methCls: SymTab.TypeIndex; i: CARDINAL>
|
|
|
+ 1909 (. VAR at, ft: SymTab.TypeIndex;
|
|
|
+ 1910 qe, qa, qt: QbeGen.QVal;
|
|
|
+ 1911 isV, conv, va: BOOLEAN;
|
|
|
+ 1912 cl: CHAR;
|
|
|
+ 1913 savedN, aj: CARDINAL;
|
|
|
+ 1914 savedArgs: ARRAY [0 .. 31]
|
|
|
+ 1915 OF AST.Node;
|
|
|
+ 1916 astActual: AST.Node; .)
|
|
|
+ 1917 = (. (* Parsing the actual can clobber
|
|
|
+ 1918 the enclosing call's argument
|
|
|
+ 1919 list (Factor resets astNArgs),
|
|
|
+ 1920 so save/restore it. *)
|
|
|
+ 1921 savedN := astNArgs; aj := 0;
|
|
|
+ 1922 WHILE aj <= HIGH(astArgs) DO
|
|
|
+ 1923 savedArgs[aj] := astArgs[aj];
|
|
|
+ 1924 INC(aj)
|
|
|
+ 1925 END; .)
|
|
|
+ 1926 Expr<at, qe> (. astActual := astCur;
|
|
|
+ 1927 astNArgs := savedN; aj := 0;
|
|
|
+ 1928 WHILE aj <= HIGH(astArgs) DO
|
|
|
+ 1929 astArgs[aj] := savedArgs[aj];
|
|
|
+ 1930 INC(aj)
|
|
|
+ 1931 END;
|
|
|
+ 1932 IF astNArgs <= HIGH(astArgs) THEN
|
|
|
+ 1933 astArgs[astNArgs] := astCur;
|
|
|
+ 1934 INC(astNArgs)
|
|
|
+ 1935 END;
|
|
|
+ 1936 va := (NOT ind)
|
|
|
+ 1937 AND (methCls =
|
|
|
+ 1938 SymTab.InvalidType)
|
|
|
+ 1939 AND (SymTab.SymKind(pn) =
|
|
|
+ 1940 SymTab.KindProc)
|
|
|
+ 1941 AND SymTab.Varargs(pn);
|
|
|
+ 1942 IF ind THEN
|
|
|
+ 1943 ft :=
|
|
|
+ 1944 SymTab.ProcTypeParamType(pt,
|
|
|
+ 1945 i);
|
|
|
+ 1946 isV :=
|
|
|
+ 1947 SymTab.ProcTypeParamIsVar(pt,
|
|
|
+ 1948 i)
|
|
|
+ 1949 ELSIF methCls #
|
|
|
+ 1950 SymTab.InvalidType THEN
|
|
|
+ 1951 ft :=
|
|
|
+ 1952 SymTab.ClassMethodParamType(
|
|
|
+ 1953 methCls, pn, i);
|
|
|
+ 1954 isV :=
|
|
|
+ 1955 SymTab.ClassMethodParamIsVar(
|
|
|
+ 1956 methCls, pn, i)
|
|
|
+ 1957 ELSE
|
|
|
+ 1958 ft := SymTab.ParamType(pn, i);
|
|
|
+ 1959 isV := SymTab.ParamIsVar(pn, i)
|
|
|
+ 1960 END;
|
|
|
+ 1961 IF (at = SymTab.InvalidType) THEN
|
|
|
+ 1962 ELSIF ft = SymTab.InvalidType THEN
|
|
|
+ 1963 ELSIF isV THEN
|
|
|
+ 1964 IF (SymTab.ClassOf(at) = SymTab.ClChar)
|
|
|
+ 1965 AND (SymTab.ClassOf(ft) = SymTab.ClArray)
|
|
|
+ 1966 AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
|
|
|
+ 1967 AND QbeGen.IsImm(qe) THEN
|
|
|
+ 1968 ELSIF (AST.Kind(astActual) #
|
|
|
+ 1969 AST.NkDesignator)
|
|
|
+ 1970 AND (AST.Kind(astActual) # AST.NkStrLit) THEN
|
|
|
+ 1971 SemError(233)
|
|
|
+ 1972 ELSIF NOT SymTab.VarParamOk(at, ft) THEN
|
|
|
+ 1973 SemError(233)
|
|
|
+ 1974 END
|
|
|
+ 1975 ELSE
|
|
|
+ 1976 IF (SymTab.ClassOf(at) = SymTab.ClChar)
|
|
|
+ 1977 AND (SymTab.ClassOf(ft) = SymTab.ClArray)
|
|
|
+ 1978 AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
|
|
|
+ 1979 AND QbeGen.IsImm(qe) THEN
|
|
|
+ 1980 ELSIF NOT SymTab.Assignable(at, ft) THEN
|
|
|
+ 1981 SemError(233)
|
|
|
+ 1982 END
|
|
|
+ 1983 END; .) .
|
|
|
+ 1984 IfStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ 1985 q: QbeGen.QVal;
|
|
|
+ 1986 hasElse: BOOLEAN;
|
|
|
+ 1987 astCond, astIf, astLast,
|
|
|
+ 1988 astNode: AST.Node; .)
|
|
|
+ 1989 = "IF" (. hasElse := FALSE; .)
|
|
|
+ 1990 Expr<t, q> (. astCond := astCur; astStmt := AST.NoNode;
|
|
|
+ 1991 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
+ 1992 SemError(214) END; .)
|
|
|
+ 1993 "THEN" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkIf);
|
|
|
+ 1994 AST.SetChild(astNode, 0, astCond);
|
|
|
+ 1995 AST.SetChild(astNode, 1, astStmt);
|
|
|
+ 1996 astIf := astNode;
|
|
|
+ 1997 astLast := astNode; .)
|
|
|
+ 1998 { "ELSIF"
|
|
|
+ 1999 Expr<t, q> (. astCond := astCur; astStmt := AST.NoNode;
|
|
|
+ 2000 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
+ 2001 SemError(214) END; .)
|
|
|
+ 2002 "THEN" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkIf);
|
|
|
+ 2003 AST.SetChild(astNode, 0, astCond);
|
|
|
+ 2004 AST.SetChild(astNode, 1, astStmt);
|
|
|
+ 2005 AST.SetChild(astLast, 2, astNode);
|
|
|
+ 2006 astLast := astNode; .) }
|
|
|
+ 2007 [ "ELSE" (. hasElse := TRUE;
|
|
|
+ 2008 astStmt := AST.NoNode; .)
|
|
|
+ 2009 [ StatSeq ] (. AST.SetChild(astLast, 2, astStmt); .) ]
|
|
|
+ 2010 "END" (. astStmt := astIf; .) .
|
|
|
+ 2011 WhileStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ 2012 q: QbeGen.QVal;
|
|
|
+ 2013 astCond, astNode: AST.Node; .)
|
|
|
+ 2014 = "WHILE" (. astStmt := AST.NoNode; .)
|
|
|
+ 2015 Expr<t, q> (. astCond := astCur;
|
|
|
+ 2016 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
+ 2017 SemError(214) END; .)
|
|
|
+ 2018 "DO" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkWhile);
|
|
|
+ 2019 AST.SetChild(astNode, 0, astCond);
|
|
|
+ 2020 AST.SetChild(astNode, 1, astStmt);
|
|
|
+ 2021 astStmt := astNode; .)
|
|
|
+ 2022 "END" .
|
|
|
+ 2023 RepeatStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ 2024 q: QbeGen.QVal;
|
|
|
+ 2025 astCond, astBody, astNode:
|
|
|
+ 2026 AST.Node; .)
|
|
|
+ 2027 = "REPEAT" (. astStmt := AST.NoNode; .)
|
|
|
+ 2028 [ StatSeq ] (. astBody := astStmt; .)
|
|
|
+ 2029 "UNTIL" Expr<t, q> (. astCond := astCur;
|
|
|
+ 2030 astNode := AST.MakeNode(AST.NkRepeat);
|
|
|
+ 2031 AST.SetChild(astNode, 0, astBody);
|
|
|
+ 2032 AST.SetChild(astNode, 1, astCond);
|
|
|
+ 2033 astStmt := astNode;
|
|
|
+ 2034 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
+ 2035 SemError(214) END; .) .
|
|
|
+ 2036 LoopStat (. VAR lEnd: QbeGen.QVal; astNode: AST.Node; .)
|
|
|
+ 2037 = "LOOP" (. astStmt := AST.NoNode;
|
|
|
+ 2038 QbeGen.NewLabel(lEnd);
|
|
|
+ 2039 QbeGen.PushLoop(lEnd); .)
|
|
|
+ 2040 [ StatSeq ]
|
|
|
+ 2041 "END" (. astNode := AST.MakeNode(AST.NkLoop);
|
|
|
+ 2042 AST.SetChild(astNode, 0, astStmt);
|
|
|
+ 2043 astStmt := astNode;
|
|
|
+ 2044 QbeGen.PopLoop; .) .
|
|
|
+ 2045 (* FOR with static-sign BY (literal, non-zero; 220 otherwise).
|
|
|
+ 2046 Runtime direction would need a compare-select; the literal
|
|
|
+ 2047 sign picks cslew/csegew at "DO" time. *)
|
|
|
+ 2048 ForStat (. VAR lv: SymTab.Name;
|
|
|
+ 2049 tlo, thi, tby:
|
|
|
+ 2050 SymTab.TypeIndex;
|
|
|
+ 2051 qlo, qhi, qby, qt, qk, qb:
|
|
|
+ 2052 QbeGen.QVal;
|
|
|
+ 2053 lTop, lBody, lEnd:
|
|
|
+ 2054 QbeGen.QVal;
|
|
|
+ 2055 by: INTEGER;
|
|
|
+ 2056 ok: BOOLEAN;
|
|
|
+ 2057 astVar, astLo, astHi, astBy,
|
|
|
+ 2058 astNode: AST.Node; .)
|
|
|
+ 2059 = "FOR" (. by := 1; .)
|
|
|
+ 2060 GetIdent<lv> (. astVar := AST.MakeLeaf(AST.NkIdent, lv);
|
|
|
+ 2061 astStmt := AST.NoNode;
|
|
|
+ 2062 astBy := AST.NoNode;
|
|
|
+ 2063 ok := SymTab.Lookup(lv);
|
|
|
+ 2064 IF NOT ok THEN
|
|
|
+ 2065 SemError(201)
|
|
|
+ 2066 ELSIF (SymTab.SymKind(lv) #
|
|
|
+ 2067 SymTab.KindVar)
|
|
|
+ 2068 AND (SymTab.SymKind(lv) #
|
|
|
+ 2069 SymTab.KindParam) THEN
|
|
|
+ 2070 SemError(220); ok := FALSE
|
|
|
+ 2071 ELSIF NOT SymTab.IsIntFamily(
|
|
|
+ 2072 SymTab.SymType(lv)) THEN
|
|
|
+ 2073 SemError(220); ok := FALSE
|
|
|
+ 2074 END; .)
|
|
|
+ 2075 ":=" Expr<tlo, qlo> (. astLo := astCur;
|
|
|
+ 2076 IF NOT SymTab.IsIntFamily(tlo) THEN
|
|
|
+ 2077 SemError(220); ok := FALSE
|
|
|
+ 2078 END; .)
|
|
|
+ 2079 "TO" Expr<thi, qhi> (. astHi := astCur;
|
|
|
+ 2080 IF NOT SymTab.IsIntFamily(thi) THEN
|
|
|
+ 2081 SemError(220); ok := FALSE
|
|
|
+ 2082 END; .)
|
|
|
+ 2083 [ "BY" Expr<tby, qby> (. astBy := astCur;
|
|
|
+ 2084 IF (tby #
|
|
|
+ 2085 SymTab.InvalidType)
|
|
|
+ 2086 AND NOT SymTab.IsIntFamily(tby) THEN
|
|
|
+ 2087 SemError(220); ok := FALSE
|
|
|
+ 2088 END;
|
|
|
+ 2089 IF NOT SymTab.ConstInt(qby, by) THEN
|
|
|
+ 2090 SemError(230); by := 1
|
|
|
+ 2091 ELSIF by = 0 THEN
|
|
|
+ 2092 SemError(220); by := 1
|
|
|
+ 2093 END; .) ]
|
|
|
+ 2094 "DO"
|
|
|
+ 2095 [ StatSeq ]
|
|
|
+ 2096 "END" (. astNode := AST.MakeNode(AST.NkFor);
|
|
|
+ 2097 AST.SetChild(astNode, 0, astVar);
|
|
|
+ 2098 AST.SetChild(astNode, 1, astLo);
|
|
|
+ 2099 AST.SetChild(astNode, 2, astHi);
|
|
|
+ 2100 AST.SetChild(astNode, 3, astBy);
|
|
|
+ 2101 AST.SetChild(astNode, 4, astStmt);
|
|
|
+ 2102 astStmt := astNode;
|
|
|
+ 2103 .) .
|
|
|
+ 2104 CaseStat (. VAR tsel: SymTab.TypeIndex;
|
|
|
+ 2105 qsel, lEnd: QbeGen.QVal;
|
|
|
+ 2106 arm, astNode, astArms,
|
|
|
+ 2107 astArmsTail: AST.Node; .)
|
|
|
+ 2108 = "CASE" Expr<tsel, qsel> (. astNode := AST.MakeNode(AST.NkCase);
|
|
|
+ 2109 AST.SetChild(astNode, 0, astCur);
|
|
|
+ 2110 astArms := AST.NoNode;
|
|
|
+ 2111 astArmsTail := AST.NoNode;
|
|
|
+ 2112 .)
|
|
|
+ 2113 "OF" CaseAlt<tsel, qsel, lEnd, astArms, astArmsTail>
|
|
|
+ 2114 { "|" CaseAlt<tsel, qsel, lEnd, astArms, astArmsTail> }
|
|
|
+ 2115 [ "ELSE" (. astStmt := AST.NoNode; .)
|
|
|
+ 2116 [ StatSeq ] (. arm := AST.MakeNode(AST.NkCaseArm);
|
|
|
+ 2117 AST.SetOp(arm, 1);
|
|
|
+ 2118 AST.SetChild(arm, 0, astStmt);
|
|
|
+ 2119 AstAppend(AST.NkBlock,
|
|
|
+ 2120 astArms, astArmsTail, arm); .) ]
|
|
|
+ 2121 "END" (. AST.SetChild(astNode, 1, astArms);
|
|
|
+ 2122 astStmt := astNode;
|
|
|
+ 2123 .) .
|
|
|
+ 2124 (* Compare-chain lowering: each alternative ends its match-tests
|
|
|
+ 2125 with "jmp lAfter", so the no-match fallthrough skips the body:
|
|
|
+ 2126 "cmp; jnz(lBody,lF); lF: ... ; jmp lAfter; lBody: S; jmp lEnd;
|
|
|
+ 2127 lAfter:". Falls into the next alternative, ELSE, or END. *)
|
|
|
+ 2128 CaseAlt<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
|
|
|
+ 2129 lEnd: QbeGen.QVal; VAR arms, armsTail: AST.Node>
|
|
|
+ 2130 (. VAR arm: AST.Node; .)
|
|
|
+ 2131 = (. arm := AST.MakeNode(AST.NkCaseArm); .)
|
|
|
+ 2132 CaseLabel<tsel, qsel, arm>
|
|
|
+ 2133 { "," CaseLabel<tsel, qsel, arm> }
|
|
|
+ 2134 ":" (. astStmt := AST.NoNode; .)
|
|
|
+ 2135 [ StatSeq ] (. AST.SetChild(arm, AST.NChild(arm),
|
|
|
+ 2136 astStmt);
|
|
|
+ 2137 AstAppend(AST.NkBlock,
|
|
|
+ 2138 arms, armsTail, arm);
|
|
|
+ 2139 .) .
|
|
|
+ 2140 CaseLabel<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
|
|
|
+ 2141 arm: AST.Node>
|
|
|
+ 2142 (. VAR t2, t3: SymTab.TypeIndex;
|
|
|
+ 2143 q2, q3, qc, qd, qe:
|
|
|
+ 2144 QbeGen.QVal;
|
|
|
+ 2145 astLab: AST.Node;
|
|
|
+ 2146 lNext: QbeGen.QVal; .)
|
|
|
+ 2147 = Expr<t2, q2> (. astLab := astCur;
|
|
|
+ 2148 IF (t2 #
|
|
|
+ 2149 SymTab.InvalidType)
|
|
|
+ 2150 AND (tsel #
|
|
|
+ 2151 SymTab.InvalidType)
|
|
|
+ 2152 AND ((SymTab.ClassOf(t2) =
|
|
|
+ 2153 SymTab.ClSet)
|
|
|
+ 2154 OR (SymTab.ClassOf(tsel) =
|
|
|
+ 2155 SymTab.ClSet)) THEN
|
|
|
+ 2156 SemError(230)
|
|
|
+ 2157 ELSIF (t2 #
|
|
|
+ 2158 SymTab.InvalidType)
|
|
|
+ 2159 AND (tsel #
|
|
|
+ 2160 SymTab.InvalidType)
|
|
|
+ 2161 AND NOT SymTab.EqCheck(t2,
|
|
|
+ 2162 tsel) THEN
|
|
|
+ 2163 SemError(213) END;
|
|
|
+ 2164 IF NOT QbeGen.IsImm(q2) THEN
|
|
|
+ 2165 SemError(230)
|
|
|
+ 2166 END; .)
|
|
|
+ 2167 [ ".." Expr<t3, q3> (. astLab := AST.MakeBin(
|
|
|
+ 2168 AST.NkSubrange, 0, astLab, astCur);
|
|
|
+ 2169 IF (t3 #
|
|
|
+ 2170 SymTab.InvalidType)
|
|
|
+ 2171 AND (tsel #
|
|
|
+ 2172 SymTab.InvalidType)
|
|
|
+ 2173 AND NOT SymTab.EqCheck(t3,
|
|
|
+ 2174 tsel) THEN
|
|
|
+ 2175 SemError(213) END;
|
|
|
+ 2176 IF NOT QbeGen.IsImm(q3) THEN
|
|
|
+ 2177 SemError(230)
|
|
|
+ 2178 END; .) ]
|
|
|
+ 2179 (. AST.SetChild(arm,
|
|
|
+ 2180 AST.NChild(arm), astLab); .) .
|
|
|
+ 2181 ReturnStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ 2182 q, qt: QbeGen.QVal;
|
|
|
+ 2183 res: SymTab.TypeIndex;
|
|
|
+ 2184 hadE, conv: BOOLEAN;
|
|
|
+ 2185 astVal, astNode: AST.Node; .)
|
|
|
+ 2186 = "RETURN" (. hadE := FALSE; astStmt := AST.NoNode; .)
|
|
|
+ 2187 [ Expr<t, q> (. hadE := TRUE; astVal := astCur; .) ]
|
|
|
+ 2188 (. astNode := AST.MakeNode(AST.NkReturn);
|
|
|
+ 2189 IF hadE THEN
|
|
|
+ 2190 AST.SetChild(astNode, 0, astVal)
|
|
|
+ 2191 END;
|
|
|
+ 2192 astStmt := astNode;
|
|
|
+ 2193 conv := FALSE;
|
|
|
+ 2194 IF NOT SymTab.InProc() THEN
|
|
|
+ 2195 SemError(232)
|
|
|
+ 2196 ELSE res := SymTab.CurRes();
|
|
|
+ 2197 IF NOT hadE THEN
|
|
|
+ 2198 IF res #
|
|
|
+ 2199 SymTab.InvalidType THEN
|
|
|
+ 2200 SemError(232)
|
|
|
+ 2201 END
|
|
|
+ 2202 ELSIF (res =
|
|
|
+ 2203 SymTab.InvalidType)
|
|
|
+ 2204 OR (t #
|
|
|
+ 2205 SymTab.InvalidType)
|
|
|
+ 2206 AND NOT SymTab.Assignable(t,
|
|
|
+ 2207 res) THEN
|
|
|
+ 2208 SemError(232)
|
|
|
+ 2209 END
|
|
|
+ 2210 END; .) .
|
|
|
+ 2211 HaltStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ 2212 q: QbeGen.QVal;
|
|
|
+ 2213 astVal, astNode: AST.Node; .)
|
|
|
+ 2214 = "HALT" (. astVal := AST.NoNode; .)
|
|
|
+ 2215 [ "(" Expr<t, q> (. astVal := astCur; .) ")" ]
|
|
|
+ 2216 (. astNode := AST.MakeNode(AST.NkHalt);
|
|
|
+ 2217 IF astVal # AST.NoNode THEN
|
|
|
+ 2218 AST.SetChild(astNode, 0, astVal)
|
|
|
+ 2219 END;
|
|
|
+ 2220 astStmt := astNode;
|
|
|
+ 2221 .) .
|
|
|
+ 2222 (* Designator: scalar loads, array addresses, and index suffixes.
|
|
|
+ 2223 Each index descends one level (bounds-checked, trap on breach);
|
|
|
+ 2224 nested levels reload the inner descriptor address. q ends as the
|
|
|
+ 2225 value (scalars), the descriptor address (plain arrays), or the
|
|
|
+ 2226 element address (indexed); sfx marks the indexed form. *)
|
|
|
+ 2227 Design<VAR t: SymTab.TypeIndex; VAR k: INTEGER;
|
|
|
+ 2228 VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
|
|
|
+ 2229 (. VAR n: SymTab.Name; .)
|
|
|
+ 2230 = GetIdent<n> DesignTail<n, t, k, q, qn, sfx> .
|
|
|
+ 2231 (* The part of Design after the identifier: resolve it and walk the
|
|
|
+ 2232 selectors. Split out so a statement can decide between a label
|
|
|
+ 2233 (`ident :`) and a designator (`ident := ...`) with one token. *)
|
|
|
+ 2234 DesignTail<VAR n: SymTab.Name; VAR t: SymTab.TypeIndex; VAR k: INTEGER;
|
|
|
+ 2235 VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
|
|
|
+ 2236 (. VAR fn, mal: SymTab.Name;
|
|
|
+ 2237 cls: INTEGER;
|
|
|
+ 2238 ic: SymTab.TypeIndex;
|
|
|
+ 2239 curT, it, eT, bt:
|
|
|
+ 2240 SymTab.TypeIndex;
|
|
|
+ 2241 iq, ql, qlo, qhi, qe:
|
|
|
+ 2242 QbeGen.QVal;
|
|
|
+ 2243 lo, hi: INTEGER;
|
|
|
+ 2244 fo: INTEGER;
|
|
|
+ 2245 isOpen: BOOLEAN;
|
|
|
+ 2246 qb, cv: QbeGen.QVal;
|
|
|
+ 2247 fid, fref: INTEGER;
|
|
|
+ 2248 r: BOOLEAN;
|
|
|
+ 2249 astDes, astSel: AST.Node;
|
|
|
+ 2250 fwd: BOOLEAN; .)
|
|
|
+ 2251 = (. methCls := SymTab.InvalidType;
|
|
|
+ 2252 QbeGen.CopyOp(n, qn);
|
|
|
+ 2253 sfx := FALSE; fwd := FALSE;
|
|
|
+ 2254 fid := 0; fref := 0;
|
|
|
+ 2255 IF NOT SymTab.Lookup(n) THEN
|
|
|
+ 2256 (* a bare method name inside
|
|
|
+ 2257 a CLASS IMPLEMENTATION
|
|
|
+ 2258 is a sibling call on
|
|
|
+ 2259 THIS *)
|
|
|
+ 2260 ic := SymTab.CurImplClass();
|
|
|
+ 2261 IF (ic #
|
|
|
+ 2262 SymTab.InvalidType)
|
|
|
+ 2263 AND SymTab.MethodExists(ic, n) THEN
|
|
|
+ 2264 sfx := FALSE;
|
|
|
+ 2265 QbeGen.CopyOp("@", q);
|
|
|
+ 2266 methCls := ic;
|
|
|
+ 2267 k := SymTab.KindProc;
|
|
|
+ 2268 t := SymTab.InvalidType
|
|
|
+ 2269 ELSIF SymTab.InProc() THEN
|
|
|
+ 2270 (* not declared yet: a
|
|
|
+ 2271 forward reference to a
|
|
|
+ 2272 module-level variable
|
|
|
+ 2273 declared further down. *)
|
|
|
+ 2274 k := SymTab.KindVar;
|
|
|
+ 2275 r := SymTab.FwdVarRef(n, k,
|
|
|
+ 2276 fref, t);
|
|
|
+ 2277 QbeGen.CopyOp("@", q);
|
|
|
+ 2278 sfx := TRUE; fwd := TRUE
|
|
|
+ 2279 ELSE
|
|
|
+ 2280 SemError(201);
|
|
|
+ 2281 t :=
|
|
|
+ 2282 SymTab.InvalidType;
|
|
|
+ 2283 k := -1;
|
|
|
+ 2284 QbeGen.CopyOp("0", q)
|
|
|
+ 2285 END
|
|
|
+ 2286 ELSE
|
|
|
+ 2287 t := SymTab.SymType(n);
|
|
|
+ 2288 k := SymTab.SymKind(n);
|
|
|
+ 2289 IF k = SymTab.KindConst THEN
|
|
|
+ 2290 IF SymTab.Equal(n,
|
|
|
+ 2291 "TRUE") THEN
|
|
|
+ 2292 t := SymTab.BoolType();
|
|
|
+ 2293 QbeGen.CopyOp("1", q)
|
|
|
+ 2294 ELSIF SymTab.Equal(n,
|
|
|
+ 2295 "FALSE") THEN
|
|
|
+ 2296 t := SymTab.BoolType();
|
|
|
+ 2297 QbeGen.CopyOp("0", q)
|
|
|
+ 2298 ELSIF SymTab.Equal(n,
|
|
|
+ 2299 "NIL") THEN
|
|
|
+ 2300 QbeGen.CopyOp("0", q)
|
|
|
+ 2301 ELSE
|
|
|
+ 2302 cls :=
|
|
|
+ 2303 SymTab.ClassOf(t);
|
|
|
+ 2304 IF (t #
|
|
|
+ 2305 SymTab.InvalidType)
|
|
|
+ 2306 AND ((cls = SymTab.ClInt)
|
|
|
+ 2307 OR (cls
|
|
|
+ 2308 = SymTab.ClChar)
|
|
|
+ 2309 OR (cls
|
|
|
+ 2310 = SymTab.ClEnum)
|
|
|
+ 2311 OR (cls
|
|
|
+ 2312 = SymTab.ClReal)
|
|
|
+ 2313 OR (cls
|
|
|
+ 2314 = SymTab.ClLong)
|
|
|
+ 2315 OR (cls
|
|
|
+ 2316 = SymTab.ClNil)) THEN
|
|
|
+ 2317 IF cls = SymTab.ClNil THEN
|
|
|
+ 2318 QbeGen.CopyOp("0", q)
|
|
|
+ 2319 ELSIF ((cls
|
|
|
+ 2320 = SymTab.ClInt)
|
|
|
+ 2321 OR (cls
|
|
|
+ 2322 = SymTab.ClChar)
|
|
|
+ 2323 OR (cls
|
|
|
+ 2324 = SymTab.ClEnum)
|
|
|
+ 2325 OR (cls
|
|
|
+ 2326 = SymTab.ClLong))
|
|
|
+ 2327 AND SymTab.GetSymVal(n, cv)
|
|
|
+ 2328 AND QbeGen.IsImm(cv) THEN
|
|
|
+ 2329 QbeGen.CopyOp(cv, q)
|
|
|
+ 2330 ELSE
|
|
|
+ 2331 QbeGen.LoadVar(n,
|
|
|
+ 2332 cls = SymTab.ClReal,
|
|
|
+ 2333 q)
|
|
|
+ 2334 END
|
|
|
+ 2335 ELSIF (cls = SymTab.ClArray)
|
|
|
+ 2336 OR (cls = SymTab.ClRecord)
|
|
|
+ 2337 OR (cls = SymTab.ClClass)
|
|
|
+ 2338 OR (cls = SymTab.ClStr)
|
|
|
+ 2339 OR (cls = SymTab.ClUStr) THEN
|
|
|
+ 2340 (* aggregate constant:
|
|
|
+ 2341 its value IS the
|
|
|
+ 2342 descriptor address *)
|
|
|
+ 2343 IF SymTab.GetSymVal(n, cv) THEN
|
|
|
+ 2344 QbeGen.CopyOp(cv, q)
|
|
|
+ 2345 ELSE
|
|
|
+ 2346 QbeGen.CopyOp("0", q)
|
|
|
+ 2347 END
|
|
|
+ 2348 ELSE
|
|
|
+ 2349 IF t #
|
|
|
+ 2350 SymTab.InvalidType THEN
|
|
|
+ 2351 SemError(230)
|
|
|
+ 2352 END;
|
|
|
+ 2353 QbeGen.CopyOp("0", q)
|
|
|
+ 2354 END
|
|
|
+ 2355 END
|
|
|
+ 2356 ELSIF (k = SymTab.KindVar)
|
|
|
+ 2357 OR (k = SymTab.KindParam) THEN
|
|
|
+ 2358 cls := SymTab.ClassOf(t);
|
|
|
+ 2359 IF (cls # SymTab.ClInt)
|
|
|
+ 2360 AND (cls # SymTab.ClBool)
|
|
|
+ 2361 AND (cls # SymTab.ClChar)
|
|
|
+ 2362 AND (cls # SymTab.ClUChar)
|
|
|
+ 2363 AND (cls # SymTab.ClEnum)
|
|
|
+ 2364 AND (cls # SymTab.ClReal)
|
|
|
+ 2365 AND (cls # SymTab.ClPtr)
|
|
|
+ 2366 AND (cls # SymTab.ClProc)
|
|
|
+ 2367 AND (cls # SymTab.ClLong)
|
|
|
+ 2368 AND (cls # SymTab.ClArray)
|
|
|
+ 2369 AND (cls # SymTab.ClSet)
|
|
|
+ 2370 AND (cls # SymTab.ClRecord)
|
|
|
+ 2371 AND (cls # SymTab.ClUStr)
|
|
|
+ 2372 AND (cls # SymTab.ClClass) THEN
|
|
|
+ 2373 SemError(230);
|
|
|
+ 2374 QbeGen.CopyOp("0", q)
|
|
|
+ 2375 ELSE QbeGen.CopyOp("@", q)
|
|
|
+ 2376 END
|
|
|
+ 2377 ELSE QbeGen.CopyOp("0", q);
|
|
|
+ 2378 IF k = SymTab.KindImport THEN
|
|
|
+ 2379 SemError(230)
|
|
|
+ 2380 ELSIF k =
|
|
|
+ 2381 SymTab.KindProc THEN
|
|
|
+ 2382 (* bare procedure name:
|
|
|
+ 2383 a following ArgList
|
|
|
+ 2384 makes it a call;
|
|
|
+ 2385 otherwise Fact
|
|
|
+ 2386 reports 230 *)
|
|
|
+ 2387 ELSE
|
|
|
+ 2388 IF k = SymTab.KindField THEN
|
|
|
+ 2389 IF QbeGen.TopWith(qb) THEN
|
|
|
+ 2390 sfx := TRUE
|
|
|
+ 2391 ELSE SemError(230);
|
|
|
+ 2392 QbeGen.CopyOp("0", q)
|
|
|
+ 2393 END
|
|
|
+ 2394 END
|
|
|
+ 2395 END
|
|
|
+ 2396 END
|
|
|
+ 2397 END; .)
|
|
|
+ 2398 (. astDes := AST.MakeNode(AST.NkDesignator);
|
|
|
+ 2399 AST.SetChild(astDes, AST.NChild(astDes), AST.MakeLeaf(AST.NkIdent, n));
|
|
|
+ 2400 IF fwd THEN AST.SetOp(astDes, 1) END;
|
|
|
+ 2401 IF fwd THEN Check.NoteForward(fref, astDes) END; .)
|
|
|
+ 2402 { "[" Expr<it, iq>
|
|
|
+ 2403 (. AST.SetChild(astDes, AST.NChild(astDes),
|
|
|
+ 2404 AST.MakeUn(AST.NkSelector, AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
+ 2405 ELSIF SymTab.ClassOf(t) #
|
|
|
+ 2406 SymTab.ClArray THEN
|
|
|
+ 2407 SemError(217);
|
|
|
+ 2408 t := SymTab.InvalidType
|
|
|
+ 2409 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
+ 2410 AND (SymTab.ClassOf(it) #
|
|
|
+ 2411 SymTab.ClChar)
|
|
|
+ 2412 AND (SymTab.ClassOf(it) #
|
|
|
+ 2413 SymTab.ClEnum) THEN
|
|
|
+ 2414 SemError(218);
|
|
|
+ 2415 t := SymTab.InvalidType
|
|
|
+ 2416 ELSE
|
|
|
+ 2417 eT := SymTab.ArrayElem(t);
|
|
|
+ 2418 t := eT; sfx := TRUE
|
|
|
+ 2419 END; .)
|
|
|
+ 2420 { "," Expr<it, iq>
|
|
|
+ 2421 (. AST.SetChild(astDes, AST.NChild(astDes),
|
|
|
+ 2422 AST.MakeUn(AST.NkSelector, AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
+ 2423 ELSIF SymTab.ClassOf(t) #
|
|
|
+ 2424 SymTab.ClArray THEN
|
|
|
+ 2425 SemError(217);
|
|
|
+ 2426 t := SymTab.InvalidType
|
|
|
+ 2427 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
+ 2428 AND (SymTab.ClassOf(it) #
|
|
|
+ 2429 SymTab.ClChar)
|
|
|
+ 2430 AND (SymTab.ClassOf(it) #
|
|
|
+ 2431 SymTab.ClEnum) THEN
|
|
|
+ 2432 SemError(218);
|
|
|
2433 t := SymTab.InvalidType
|
|
|
- 2434 ELSIF (SymTab.ClassOf(t) =
|
|
|
- 2435 SymTab.ClClass)
|
|
|
- 2436 AND SymTab.MethodExists(t, fn) THEN
|
|
|
- 2437 (* obj.Method: bind the
|
|
|
- 2438 method and pass obj as
|
|
|
- 2439 the hidden receiver; q
|
|
|
- 2440 already holds the
|
|
|
- 2441 object's address *)
|
|
|
- 2442 QbeGen.CopyOp(fn, n);
|
|
|
- 2443 QbeGen.CopyOp(fn, qn);
|
|
|
- 2444 methCls := t;
|
|
|
- 2445 k := SymTab.KindProc;
|
|
|
- 2446 t := SymTab.InvalidType
|
|
|
- 2447 ELSIF NOT SymTab.FieldExists(t,
|
|
|
- 2448 fn) THEN
|
|
|
- 2449 SemError(216);
|
|
|
- 2450 t := SymTab.InvalidType
|
|
|
- 2451 ELSE
|
|
|
- 2452 t := SymTab.FieldType(t, fn);
|
|
|
- 2453 sfx := TRUE
|
|
|
- 2454 END; .)
|
|
|
- 2455 | "^"
|
|
|
- 2456 (. astSel := AST.MakeNode(AST.NkSelector);
|
|
|
- 2457 AST.SetOp(astSel, AST.SelDeref);
|
|
|
- 2458 AST.SetChild(astDes, AST.NChild(astDes), astSel); IF t = SymTab.InvalidType THEN
|
|
|
- 2459 ELSIF SymTab.ClassOf(t) #
|
|
|
- 2460 SymTab.ClPtr THEN
|
|
|
- 2461 SemError(219);
|
|
|
- 2462 t := SymTab.InvalidType
|
|
|
- 2463 ELSE
|
|
|
- 2464 bt := SymTab.PtrBase(t);
|
|
|
- 2465 IF bt = SymTab.InvalidType THEN
|
|
|
- 2466 ELSE
|
|
|
- 2467 t := bt;
|
|
|
- 2468 sfx := TRUE
|
|
|
- 2469 END
|
|
|
- 2470 END; .) } (. astCur := astDes; .) .
|
|
|
- 2471 (* Result suffix (ISO component after a function call): `F()^`,
|
|
|
- 2472 `F()[i]`, `F().field`. The call result is in t/q with sfx FALSE
|
|
|
- 2473 (a value, or a descriptor address for aggregates); each component
|
|
|
- 2474 descends one level exactly like the Design components. *)
|
|
|
- 2475 ResultComp<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
|
|
|
- 2476 VAR sfx: BOOLEAN; VAR node: AST.Node;
|
|
|
- 2477 VAR mname: SymTab.Name; VAR methCls: SymTab.TypeIndex;
|
|
|
- 2478 VAR isM: BOOLEAN> (. VAR it, eT, bt: SymTab.TypeIndex;
|
|
|
- 2479 iq, ql, qlo, qhi, qe, qb:
|
|
|
- 2480 QbeGen.QVal;
|
|
|
- 2481 lo, hi, fo: INTEGER;
|
|
|
- 2482 isOpen: BOOLEAN;
|
|
|
- 2483 fname: SymTab.Name;
|
|
|
- 2484 astWrap, astSel: AST.Node; .)
|
|
|
- 2485 = "[" Expr<it, iq>
|
|
|
- 2486 (. isM := FALSE;
|
|
|
- 2487 IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
- 2488 astWrap := AST.MakeNode(
|
|
|
- 2489 AST.NkDesignator);
|
|
|
- 2490 AST.SetChild(astWrap, 0, node);
|
|
|
- 2491 node := astWrap
|
|
|
- 2492 END;
|
|
|
- 2493 AST.SetChild(node, AST.NChild(node),
|
|
|
- 2494 AST.MakeUn(AST.NkSelector,
|
|
|
- 2495 AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
- 2496 ELSIF SymTab.ClassOf(t) #
|
|
|
- 2497 SymTab.ClArray THEN
|
|
|
- 2498 SemError(217);
|
|
|
- 2499 t := SymTab.InvalidType
|
|
|
- 2500 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
- 2501 AND (SymTab.ClassOf(it) # SymTab.ClChar)
|
|
|
- 2502 AND (SymTab.ClassOf(it) # SymTab.ClEnum) THEN
|
|
|
- 2503 SemError(218);
|
|
|
- 2504 t := SymTab.InvalidType
|
|
|
- 2505 ELSE
|
|
|
- 2506 eT := SymTab.ArrayElem(t);
|
|
|
- 2507 t := eT; sfx := TRUE
|
|
|
- 2508 END; .)
|
|
|
- 2509 "]"
|
|
|
- 2510 | "." GetIdent<fname>
|
|
|
- 2511 (. isM := FALSE;
|
|
|
- 2512 IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
- 2513 astWrap := AST.MakeNode(
|
|
|
- 2514 AST.NkDesignator);
|
|
|
- 2515 AST.SetChild(astWrap, 0, node);
|
|
|
- 2516 node := astWrap
|
|
|
- 2517 END;
|
|
|
- 2518 AST.SetChild(node, AST.NChild(node),
|
|
|
- 2519 AST.MakeUn(AST.NkSelector,
|
|
|
- 2520 AST.SelField,
|
|
|
- 2521 AST.MakeLeaf(AST.NkIdent,
|
|
|
- 2522 fname))); IF t = SymTab.InvalidType THEN
|
|
|
- 2523 ELSIF (SymTab.ClassOf(t) #
|
|
|
- 2524 SymTab.ClRecord)
|
|
|
- 2525 AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN
|
|
|
- 2526 SemError(215);
|
|
|
- 2527 t := SymTab.InvalidType
|
|
|
- 2528 ELSIF (SymTab.ClassOf(t) =
|
|
|
- 2529 SymTab.ClClass)
|
|
|
- 2530 AND SymTab.MethodExists(t, fname) THEN
|
|
|
- 2531 (* a method on the call result:
|
|
|
- 2532 a following ArgList makes
|
|
|
- 2533 the call *)
|
|
|
- 2534 mname := fname;
|
|
|
- 2535 methCls := t; isM := TRUE;
|
|
|
- 2536 t := SymTab.InvalidType
|
|
|
- 2537 ELSIF NOT SymTab.FieldExists(t,
|
|
|
- 2538 fname) THEN
|
|
|
- 2539 SemError(216);
|
|
|
- 2540 t := SymTab.InvalidType
|
|
|
- 2541 ELSE
|
|
|
- 2542 t := SymTab.FieldType(t, fname);
|
|
|
- 2543 sfx := TRUE
|
|
|
- 2544 END; .)
|
|
|
- 2545 | "^" (. isM := FALSE;
|
|
|
- 2546 IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
- 2547 astWrap := AST.MakeNode(
|
|
|
- 2548 AST.NkDesignator);
|
|
|
- 2549 AST.SetChild(astWrap, 0, node);
|
|
|
- 2550 node := astWrap
|
|
|
- 2551 END;
|
|
|
- 2552 astSel := AST.MakeNode(AST.NkSelector);
|
|
|
- 2553 AST.SetOp(astSel, AST.SelDeref);
|
|
|
- 2554 AST.SetChild(node,
|
|
|
- 2555 AST.NChild(node), astSel); IF t = SymTab.InvalidType THEN
|
|
|
- 2556 ELSIF SymTab.ClassOf(t) #
|
|
|
- 2557 SymTab.ClPtr THEN
|
|
|
- 2558 SemError(219);
|
|
|
- 2559 t := SymTab.InvalidType
|
|
|
- 2560 ELSE
|
|
|
- 2561 bt := SymTab.PtrBase(t);
|
|
|
- 2562 IF bt # SymTab.InvalidType THEN
|
|
|
- 2563 t := bt; sfx := TRUE
|
|
|
- 2564 END
|
|
|
- 2565 END; .) .
|
|
|
- 2566 Expr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 2567 (. VAR t2: SymTab.TypeIndex;
|
|
|
- 2568 op: INTEGER;
|
|
|
- 2569 q2, qt, wl: QbeGen.QVal;
|
|
|
- 2570 astA, astB: AST.Node;
|
|
|
- 2571 astOp: INTEGER;
|
|
|
- 2572 astMade: BOOLEAN;
|
|
|
- 2573 isR: BOOLEAN; .)
|
|
|
- 2574 = SimExpr<t, q> (. astA := astCur; astMade := FALSE; .)
|
|
|
- 2575 [ Rel<op> SimExpr<t2, q2>
|
|
|
- 2576 (. astB := astCur; astMade := TRUE;
|
|
|
- 2577 astOp := AST.OpEq;
|
|
|
- 2578 IF op = SymTab.OpNeq1 THEN astOp := AST.OpNe
|
|
|
- 2579 ELSIF op = SymTab.OpNeq2 THEN astOp := AST.OpNe
|
|
|
- 2580 ELSIF op = SymTab.OpLt THEN astOp := AST.OpLt
|
|
|
- 2581 ELSIF op = SymTab.OpLe THEN astOp := AST.OpLe
|
|
|
- 2582 ELSIF op = SymTab.OpGt THEN astOp := AST.OpGt
|
|
|
- 2583 ELSIF op = SymTab.OpGe THEN astOp := AST.OpGe
|
|
|
- 2584 ELSIF op = SymTab.OpIn THEN astOp := AST.OpIn
|
|
|
- 2585 END;
|
|
|
- 2586 IF op = SymTab.OpIn THEN
|
|
|
- 2587 IF SymTab.InCheck(t, t2) THEN
|
|
|
- 2588 IF (t = SymTab.InvalidType)
|
|
|
- 2589 OR (t2 = SymTab.InvalidType) THEN
|
|
|
- 2590 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
|
|
|
- 2591 ELSE
|
|
|
- 2592 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
- 2593 END
|
|
|
- 2594 ELSE SemError(222); t := SymTab.InvalidType;
|
|
|
- 2595 QbeGen.CopyOp("0", q)
|
|
|
- 2596 END
|
|
|
- 2597 ELSIF SymTab.RelCheck(t, t2, op) THEN
|
|
|
- 2598 IF (t = SymTab.InvalidType)
|
|
|
- 2599 OR (t2 = SymTab.InvalidType) THEN
|
|
|
- 2600 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
|
|
|
- 2601 ELSIF (SymTab.ClassOf(t) = SymTab.ClPtr)
|
|
|
- 2602 OR (SymTab.ClassOf(t2) = SymTab.ClPtr) THEN
|
|
|
- 2603 IF (op # SymTab.OpEq) AND (op # SymTab.OpNeq1)
|
|
|
- 2604 AND (op # SymTab.OpNeq2) THEN
|
|
|
- 2605 SemError(213); t := SymTab.InvalidType;
|
|
|
- 2606 QbeGen.CopyOp("0", q)
|
|
|
- 2607 ELSE
|
|
|
- 2608 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
- 2609 END
|
|
|
- 2610 ELSIF (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
- 2611 OR (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
- 2612 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
- 2613 ELSIF SymTab.StrCompat(t, t2) THEN
|
|
|
- 2614 QbeGen.StrEq(op, q, q2, qt);
|
|
|
- 2615 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
|
|
|
- 2616 ELSIF SymTab.IsLongFamily(t)
|
|
|
- 2617 OR SymTab.IsLongFamily(t2) THEN
|
|
|
- 2618 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
- 2619 ELSE
|
|
|
- 2620 t := SymTab.BoolType();
|
|
|
- 2621 QbeGen.CopyOp("@", q)
|
|
|
- 2622 END
|
|
|
- 2623 ELSE SemError(213); t := SymTab.InvalidType;
|
|
|
- 2624 QbeGen.CopyOp("0", q)
|
|
|
- 2625 END;
|
|
|
- 2626 astCur := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB); .) ]
|
|
|
- 2627 (. IF NOT astMade THEN astCur := astA END; .)
|
|
|
- 2628 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
- 2629 Rel<VAR op: INTEGER>
|
|
|
- 2630 = "=" (. op := SymTab.OpEq; .)
|
|
|
- 2631 | "#" (. op := SymTab.OpNeq1; .)
|
|
|
- 2632 | "<" (. op := SymTab.OpLt; .)
|
|
|
- 2633 | "<=" (. op := SymTab.OpLe; .)
|
|
|
- 2634 | ">" (. op := SymTab.OpGt; .)
|
|
|
- 2635 | ">=" (. op := SymTab.OpGe; .)
|
|
|
- 2636 | "IN" (. op := SymTab.OpIn; .) .
|
|
|
- 2637 SimExpr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 2638 (. VAR t2, res2, lt, rt:
|
|
|
- 2639 SymTab.TypeIndex;
|
|
|
- 2640 op: INTEGER;
|
|
|
- 2641 q2, qt, wq, qf, q2a, q2b:
|
|
|
- 2642 QbeGen.QVal;
|
|
|
- 2643 neg, isR, isL, folded:
|
|
|
- 2644 BOOLEAN;
|
|
|
- 2645 fok: BOOLEAN;
|
|
|
- 2646 lw, rw, mw: CARDINAL;
|
|
|
- 2647 lTrue, lNext, lDone, qr, qs: QbeGen.QVal;
|
|
|
- 2648 astA, astB: AST.Node;
|
|
|
- 2649 astSign, astOp: INTEGER; .)
|
|
|
- 2650 = (. neg := FALSE; astSign := 0; .)
|
|
|
- 2651 [ "+" (. neg := TRUE; astSign := 1; .)
|
|
|
- 2652 | "-" (. neg := TRUE; astSign := -1; .) ]
|
|
|
- 2653 Term<t, q> (. astA := astCur;
|
|
|
- 2654 IF neg AND QbeGen.IsImm(q) THEN
|
|
|
- 2655 QbeGen.NegFold(q, q)
|
|
|
- 2656 END;
|
|
|
- 2657 IF astSign < 0 THEN
|
|
|
- 2658 astCur := AST.MakeUn(
|
|
|
- 2659 AST.NkUnary, AST.OpSub, astA);
|
|
|
- 2660 astA := astCur
|
|
|
- 2661 END; .)
|
|
|
- 2662 { AddOp<op>
|
|
|
- 2663 Term<t2, q2> (. astB := astCur; .)
|
|
|
- 2664 (. astOp := AST.OpAdd;
|
|
|
- 2665 IF op = SymTab.OpSub THEN astOp := AST.OpSub
|
|
|
- 2666 ELSIF op = SymTab.OpOr THEN astOp := AST.OpOr END;
|
|
|
- 2667 astA := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB);
|
|
|
- 2668 astCur := astA;
|
|
|
- 2669 IF op = SymTab.OpOr THEN
|
|
|
- 2670 (* short-circuit: if q is true the RHS is skipped *)
|
|
|
- 2671 IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
|
|
|
- 2672 t := SymTab.BoolType()
|
|
|
- 2673 ELSE SemError(212); t := SymTab.InvalidType END;
|
|
|
- 2674 IF t # SymTab.InvalidType THEN
|
|
|
- 2675 QbeGen.CopyOp("@", q)
|
|
|
- 2676 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 2677 END
|
|
|
- 2678 ELSIF (op = SymTab.OpAdd)
|
|
|
- 2679 AND (SymTab.UStrCompat(t, t2)
|
|
|
- 2680 OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
|
|
|
- 2681 AND (SymTab.ClassOf(t2) = SymTab.ClUStr))
|
|
|
- 2682 OR ((SymTab.ClassOf(t) = SymTab.ClUStr)
|
|
|
- 2683 AND (SymTab.ClassOf(t2) = SymTab.ClUChar))
|
|
|
- 2684 OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
|
|
|
- 2685 AND (SymTab.ClassOf(t2) = SymTab.ClUChar))) THEN
|
|
|
- 2686 (* UString concatenation: a UCHAR operand becomes a
|
|
|
- 2687 1-codepoint UString; the result is a descriptor in the
|
|
|
- 2688 shim's concat buffer. Work on copies so neither
|
|
|
- 2689 operand is clobbered. *)
|
|
|
- 2690 t := SymTab.NewUStr();
|
|
|
- 2691 QbeGen.CopyOp("@", q)
|
|
|
- 2692 ELSIF (op = SymTab.OpAdd)
|
|
|
- 2693 AND (SymTab.StrCompat(t, t2)
|
|
|
- 2694 OR (SymTab.IsStrType(t)
|
|
|
- 2695 AND (SymTab.ClassOf(t2) = SymTab.ClChar))
|
|
|
- 2696 OR ((SymTab.ClassOf(t) = SymTab.ClChar)
|
|
|
- 2697 AND SymTab.IsStrType(t2))) THEN
|
|
|
- 2698 (* string concatenation; a CHAR operand becomes a
|
|
|
- 2699 1-character string literal. When both operands are
|
|
|
- 2700 constants, fold to a single string literal so a
|
|
|
- 2701 constructor element stays compile-time. *)
|
|
|
- 2702 QbeGen.StrFold(q, q2, SymTab.ClassOf(t), SymTab.ClassOf(t2),
|
|
|
- 2703 qt, fok);
|
|
|
- 2704 IF fok THEN QbeGen.CopyOp(qt, q)
|
|
|
- 2705 ELSE QbeGen.CopyOp("@", q)
|
|
|
- 2706 END;
|
|
|
- 2707 t := SymTab.NewStr()
|
|
|
- 2708 ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
|
|
|
- 2709 AND (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
- 2710 AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
- 2711 lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
|
|
|
- 2712 mw := lw;
|
|
|
- 2713 IF rw > mw THEN mw := rw END;
|
|
|
- 2714 t := SymTab.NewSet(
|
|
|
- 2715 SymTab.NewSubR(0,
|
|
|
- 2716 VAL(INTEGER, mw) * 32 - 1));
|
|
|
- 2717 QbeGen.CopyOp("@", q)
|
|
|
- 2718 ELSE
|
|
|
- 2719 IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN
|
|
|
- 2720 lt := t; rt := t2; t := res2
|
|
|
- 2721 ELSE SemError(211); t := SymTab.InvalidType END;
|
|
|
- 2722 IF t # SymTab.InvalidType THEN
|
|
|
- 2723 isL := SymTab.IsLongFamily(t);
|
|
|
- 2724 isR := SymTab.ClassOf(t) = SymTab.ClReal;
|
|
|
- 2725 folded := FALSE;
|
|
|
- 2726 IF (NOT isL) AND (NOT isR)
|
|
|
- 2727 AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
|
|
|
- 2728 IF op = SymTab.OpAdd THEN
|
|
|
- 2729 folded := QbeGen.Fold2(0, q, q2, qf)
|
|
|
- 2730 ELSE
|
|
|
- 2731 folded := QbeGen.Fold2(1, q, q2, qf)
|
|
|
- 2732 END
|
|
|
- 2733 END;
|
|
|
- 2734 IF folded THEN QbeGen.CopyOp(qf, q)
|
|
|
- 2735 ELSE
|
|
|
- 2736 QbeGen.CopyOp("@", q)
|
|
|
- 2737 END
|
|
|
- 2738 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 2739 END
|
|
|
- 2740 END; .) }
|
|
|
- 2741 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
- 2742 AddOp<VAR op: INTEGER>
|
|
|
- 2743 = "+" (. op := SymTab.OpAdd; .)
|
|
|
- 2744 | "-" (. op := SymTab.OpSub; .)
|
|
|
- 2745 | "OR" (. op := SymTab.OpOr; .) .
|
|
|
- 2746 Term<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 2747 (. VAR t2, res2, lt, rt:
|
|
|
- 2748 SymTab.TypeIndex;
|
|
|
- 2749 op: INTEGER;
|
|
|
- 2750 q2, qt, wq, qf:
|
|
|
- 2751 QbeGen.QVal;
|
|
|
- 2752 isR, isL, folded: BOOLEAN;
|
|
|
- 2753 lw, rw, mw: CARDINAL;
|
|
|
- 2754 lNext, lFalse, lDone, qr, qs: QbeGen.QVal;
|
|
|
- 2755 astA, astB: AST.Node;
|
|
|
- 2756 astOp: INTEGER; .)
|
|
|
- 2757 = Fact<t, q> (. astA := astCur; .) { MulOp<op>
|
|
|
- 2758 Fact<t2, q2> (. astB := astCur; .)
|
|
|
- 2759 (. astOp := AST.OpMul;
|
|
|
- 2760 IF op = SymTab.OpSlash THEN astOp := AST.OpDiv
|
|
|
- 2761 ELSIF op = SymTab.OpDiv THEN astOp := AST.OpDiv
|
|
|
- 2762 ELSIF op = SymTab.OpMod THEN astOp := AST.OpMod
|
|
|
- 2763 ELSIF op = SymTab.OpAnd THEN astOp := AST.OpAnd END;
|
|
|
- 2764 astA := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB);
|
|
|
- 2765 astCur := astA;
|
|
|
- 2766 IF op = SymTab.OpAnd THEN
|
|
|
- 2767 (* short-circuit: if q is false the RHS is skipped *)
|
|
|
- 2768 IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
|
|
|
- 2769 t := SymTab.BoolType()
|
|
|
- 2770 ELSE SemError(212); t := SymTab.InvalidType END;
|
|
|
- 2771 IF t # SymTab.InvalidType THEN QbeGen.CopyOp("@", q)
|
|
|
- 2772 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 2773 END
|
|
|
- 2774 ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
|
|
|
- 2775 AND (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
- 2776 AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
- 2777 lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
|
|
|
- 2778 mw := lw;
|
|
|
- 2779 IF rw > mw THEN mw := rw END;
|
|
|
- 2780 t := SymTab.NewSet(
|
|
|
- 2781 SymTab.NewSubR(0,
|
|
|
- 2782 VAL(INTEGER, mw) * 32 - 1));
|
|
|
- 2783 QbeGen.CopyOp("@", q)
|
|
|
- 2784 ELSE
|
|
|
- 2785 IF SymTab.ArithCheck(t, t2,
|
|
|
- 2786 (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
|
|
|
- 2787 res2) THEN
|
|
|
- 2788 lt := t; rt := t2; t := res2
|
|
|
- 2789 ELSE SemError(211); t := SymTab.InvalidType END;
|
|
|
- 2790 IF t # SymTab.InvalidType THEN
|
|
|
- 2791 isL := SymTab.IsLongFamily(t);
|
|
|
- 2792 isR := SymTab.ClassOf(t) = SymTab.ClReal;
|
|
|
- 2793 folded := FALSE;
|
|
|
- 2794 IF (NOT isL) AND (NOT isR)
|
|
|
- 2795 AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
|
|
|
- 2796 IF op = SymTab.OpTimes THEN
|
|
|
- 2797 folded := QbeGen.Fold2(2, q, q2, qf)
|
|
|
- 2798 ELSIF op = SymTab.OpDiv THEN
|
|
|
- 2799 folded := QbeGen.Fold2(3, q, q2, qf)
|
|
|
- 2800 ELSIF op = SymTab.OpMod THEN
|
|
|
- 2801 folded := QbeGen.Fold2(4, q, q2, qf)
|
|
|
- 2802 END
|
|
|
- 2803 END;
|
|
|
- 2804 IF folded THEN QbeGen.CopyOp(qf, q)
|
|
|
- 2805 ELSE
|
|
|
- 2806 QbeGen.CopyOp("@", q)
|
|
|
- 2807 END
|
|
|
- 2808 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 2809 END
|
|
|
- 2810 END; .) }
|
|
|
- 2811 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
- 2812 MulOp<VAR op: INTEGER>
|
|
|
- 2813 = "*" (. op := SymTab.OpTimes; .)
|
|
|
- 2814 | "/" (. op := SymTab.OpSlash; .)
|
|
|
- 2815 | "DIV" (. op := SymTab.OpDiv; .)
|
|
|
- 2816 | "MOD" (. op := SymTab.OpMod; .)
|
|
|
- 2817 | ( "AND" | "&" ) (. op := SymTab.OpAnd; .) .
|
|
|
- 2818 Fact<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 2819 (. VAR s: ARRAY [0 .. 255] OF CHAR;
|
|
|
- 2820 et, dt, t2, st, ct2, et2:
|
|
|
- 2821 SymTab.TypeIndex;
|
|
|
- 2822 dk: INTEGER;
|
|
|
- 2823 qd, q2, sq, qa, qm0, qr, qt:
|
|
|
- 2824 QbeGen.QVal;
|
|
|
- 2825 qn, vn: SymTab.Name;
|
|
|
- 2826 vt: SymTab.TypeIndex;
|
|
|
- 2827 c1, c2: INTEGER;
|
|
|
- 2828 lo, hi: INTEGER;
|
|
|
- 2829 isMax: BOOLEAN;
|
|
|
- 2830 called, isHigh, sfx, isCh,
|
|
|
- 2831 isU, uok, isStr: BOOLEAN;
|
|
|
- 2832 ucp: INTEGER; astIsLit: BOOLEAN;
|
|
|
- 2833 astD: AST.Node;
|
|
|
- 2834 astCall: BOOLEAN;
|
|
|
- 2835 astNode, astNot: AST.Node;
|
|
|
- 2836 j: CARDINAL;
|
|
|
- 2837 astArg2: AST.Node;
|
|
|
- 2838 astBrace: AST.Node;
|
|
|
- 2839 astRes: AST.Node; mname: SymTab.Name; isM: BOOLEAN; .)
|
|
|
- 2840 = (. astIsLit := FALSE; .)
|
|
|
- 2841 ( integer (. LexString(s);
|
|
|
- 2842 QbeGen.NormInt(s, q); IF twoPhase THEN astIsLit := TRUE; astCur := AST.MakeLeaf(AST.NkIntLit, s) END;
|
|
|
- 2843 t := SymTab.IntType(); .)
|
|
|
- 2844 | charConst (. LexString(s);
|
|
|
- 2845 QbeGen.NormLit(s, q, isCh);
|
|
|
- 2846 IF twoPhase THEN
|
|
|
- 2847 astIsLit := TRUE;
|
|
|
- 2848 astCur := AST.MakeLeaf(
|
|
|
- 2849 AST.NkCharLit, s)
|
|
|
- 2850 END;
|
|
|
- 2851 t := SymTab.CharType(); .)
|
|
|
- 2852 | real (. LexString(s);
|
|
|
- 2853 QbeGen.NormReal(s, q);
|
|
|
- 2854 IF twoPhase THEN
|
|
|
- 2855 astIsLit := TRUE;
|
|
|
- 2856 astCur := AST.MakeLeaf(
|
|
|
- 2857 AST.NkRealLit, s)
|
|
|
- 2858 END;
|
|
|
- 2859 t := SymTab.RealType(); .)
|
|
|
- 2860 | string (. LexString(s);
|
|
|
- 2861 IF twoPhase THEN
|
|
|
- 2862 astIsLit := TRUE;
|
|
|
- 2863 astCur := AST.MakeLeaf(
|
|
|
- 2864 AST.NkStrLit, s)
|
|
|
- 2865 END;
|
|
|
- 2866 IF SymTab.StrLen(s) = 3 THEN
|
|
|
- 2867 t := SymTab.CharType();
|
|
|
- 2868 QbeGen.IntStr(
|
|
|
- 2869 QbeGen.CharVal(s), q)
|
|
|
- 2870 ELSE t := SymTab.NewStr();
|
|
|
- 2871 QbeGen.DeclStr(s, q);
|
|
|
- 2872 (* a literal's value IS its
|
|
|
- 2873 static descriptor address *)
|
|
|
- 2874 END; .)
|
|
|
- 2875 | ustring (. LexString(s);
|
|
|
- 2876 IF twoPhase THEN
|
|
|
- 2877 astIsLit := TRUE;
|
|
|
- 2878 astCur := AST.MakeLeaf(
|
|
|
- 2879 AST.NkStrLit, s)
|
|
|
- 2880 END;
|
|
|
- 2881 QbeGen.DeclUStr(s, q, isU, ucp,
|
|
|
- 2882 uok);
|
|
|
- 2883 IF NOT uok THEN
|
|
|
- 2884 SemError(234);
|
|
|
- 2885 t := SymTab.InvalidType
|
|
|
- 2886 ELSIF isU THEN
|
|
|
- 2887 t := SymTab.UCharType();
|
|
|
- 2888 QbeGen.IntStr(ucp, q)
|
|
|
- 2889 ELSE
|
|
|
- 2890 t := SymTab.NewUStr();
|
|
|
- 2891 END; .)
|
|
|
- 2892 | Design<dt, dk, qd, qn, sfx> (. astD := astCur; astCall := FALSE; astBrace := AST.NoNode;
|
|
|
- 2893 astNArgs := 0; called := FALSE;
|
|
|
- 2894 t := dt;
|
|
|
- 2895 IF dk = SymTab.KindConst THEN
|
|
|
- 2896 QbeGen.CopyOp(qd, q)
|
|
|
- 2897 ELSE QbeGen.CopyOp("@", q)
|
|
|
- 2898 END; .)
|
|
|
- 2899 [ TypedBraceLit<dt, q> (. t := dt; astCall := TRUE;
|
|
|
- 2900 astBrace := astCur; .) ]
|
|
|
- 2901 [ ArgList<qn, dt, qd, TRUE, FALSE, methCls, ct2, q2, called>
|
|
|
- 2902 (. astCall := TRUE;
|
|
|
- 2903 astNode := AstCallNode(astD);
|
|
|
- 2904 astRes := astNode;
|
|
|
- 2905 t := ct2;
|
|
|
- 2906 QbeGen.CopyOp(q2, q);
|
|
|
- 2907 sfx := FALSE; .)
|
|
|
- 2908 { ResultComp<t, q, sfx, astRes, mname, methCls, isM>
|
|
|
- 2909 [ (. astNArgs := 0; .)
|
|
|
- 2910 ArgList<mname, t, q, TRUE, FALSE, methCls, ct2, q2, called>
|
|
|
- 2911 (. astNode := AstCallNode(astRes);
|
|
|
- 2912 astRes := astNode;
|
|
|
- 2913 t := ct2;
|
|
|
- 2914 QbeGen.CopyOp(q2, q);
|
|
|
- 2915 sfx := FALSE; .) ] }
|
|
|
- 2916 (. IF sfx THEN
|
|
|
- 2917 IF t = SymTab.InvalidType THEN
|
|
|
- 2918 QbeGen.CopyOp("0", q)
|
|
|
- 2919 ELSIF (SymTab.ClassOf(t) #
|
|
|
- 2920 SymTab.ClRecord)
|
|
|
- 2921 AND (SymTab.ClassOf(t) # SymTab.ClSet)
|
|
|
- 2922 AND (SymTab.ClassOf(t) # SymTab.ClArray)
|
|
|
- 2923 AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN
|
|
|
- 2924 QbeGen.CopyOp("@", q)
|
|
|
- 2925 END
|
|
|
- 2926 END; .) ]
|
|
|
- 2927 (. IF called THEN
|
|
|
- 2928 astCur := astRes
|
|
|
- 2929 ELSIF astCall THEN
|
|
|
- 2930 astCur := astBrace
|
|
|
- 2931 ELSE astCur := astD
|
|
|
- 2932 END;
|
|
|
- 2933 astIsLit := TRUE;
|
|
|
- 2934 IF NOT called
|
|
|
- 2935 AND (dk = SymTab.KindProc) THEN
|
|
|
- 2936 (* bare zero-arg function
|
|
|
- 2937 call (parentheses may be
|
|
|
- 2938 omitted); a proper or
|
|
|
- 2939 parameterised proc here
|
|
|
- 2940 is 230 *)
|
|
|
- 2941 IF (SymTab.ProcNPar(qn) = 0)
|
|
|
- 2942 AND (SymTab.ProcRes(qn) # SymTab.InvalidType) THEN
|
|
|
- 2943 t := SymTab.ProcRes(qn);
|
|
|
- 2944 QbeGen.CopyOp("@", q);
|
|
|
- 2945 astCur := AST.MakeNode(AST.NkCall);
|
|
|
- 2946 AST.SetChild(astCur, 0, astD)
|
|
|
- 2947 ELSE
|
|
|
- 2948 t := SymTab.ProcTypeOf(qn);
|
|
|
- 2949 QbeGen.CopyOp("@", q)
|
|
|
- 2950 END
|
|
|
- 2951 END; .)
|
|
|
- 2952 | ( "HIGH" (. isHigh := TRUE; .)
|
|
|
- 2953 | ( "LEN" | "LENGTH" ) (. isHigh := FALSE; .) )
|
|
|
- 2954 "(" ( Design<dt, dk, qd, qn, sfx> (. isStr := FALSE;
|
|
|
- 2955 isU := FALSE; .)
|
|
|
- 2956 | string (. LexString(s); astCur := AST.MakeLeaf(AST.NkStrLit, s);
|
|
|
- 2957 isStr := TRUE;
|
|
|
- 2958 isU := FALSE;
|
|
|
- 2959 IF SymTab.StrLen(s) = 3 THEN
|
|
|
- 2960 dt := SymTab.CharType();
|
|
|
- 2961 QbeGen.IntStr(QbeGen.CharVal(s),
|
|
|
- 2962 qd)
|
|
|
- 2963 ELSE
|
|
|
- 2964 dt := SymTab.NewStr();
|
|
|
- 2965 QbeGen.DeclStr(s, qd);
|
|
|
- 2966 END;
|
|
|
- 2967 dk := -1;
|
|
|
- 2968 qn[0] := CHR(0); .)
|
|
|
- 2969 | ustring (. LexString(s); astCur := AST.MakeLeaf(AST.NkStrLit, s);
|
|
|
- 2970 QbeGen.DeclUStr(s, qd, isU, ucp,
|
|
|
- 2971 uok);
|
|
|
- 2972 isStr := FALSE;
|
|
|
- 2973 IF NOT uok THEN
|
|
|
- 2974 SemError(234);
|
|
|
- 2975 dt := SymTab.InvalidType
|
|
|
- 2976 ELSIF isU THEN
|
|
|
- 2977 (* one codepoint: a UCHAR;
|
|
|
- 2978 LEN is 1, HIGH is 0 *)
|
|
|
- 2979 dt := SymTab.UCharType();
|
|
|
- 2980 QbeGen.IntStr(ucp, qd)
|
|
|
- 2981 ELSE
|
|
|
- 2982 dt := SymTab.NewUStr();
|
|
|
- 2983 END;
|
|
|
- 2984 dk := -1;
|
|
|
- 2985 qn[0] := CHR(0); .) )
|
|
|
- 2986 ")"
|
|
|
- 2987 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 2988 IF isHigh THEN AST.SetChild(astNode, 0,
|
|
|
- 2989 AST.MakeLeaf(AST.NkIdent, "HIGH"))
|
|
|
- 2990 ELSE AST.SetChild(astNode, 0,
|
|
|
- 2991 AST.MakeLeaf(AST.NkIdent, "LEN")) END;
|
|
|
- 2992 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 2993 astCur := astNode; astIsLit := TRUE;
|
|
|
- 2994 IF (dt # SymTab.InvalidType)
|
|
|
- 2995 AND (SymTab.ClassOf(dt) = SymTab.ClUStr) THEN
|
|
|
- 2996 (* UString: the count is
|
|
|
- 2997 the descriptor header *)
|
|
|
- 2998 t := SymTab.IntType();
|
|
|
- 2999 QbeGen.CopyOp("@", q)
|
|
|
- 3000 ELSIF (dt # SymTab.InvalidType)
|
|
|
- 3001 AND (SymTab.ClassOf(dt) = SymTab.ClUChar) THEN
|
|
|
- 3002 (* single UCHAR codepoint *)
|
|
|
- 3003 IF isHigh THEN
|
|
|
- 3004 QbeGen.CopyOp("0", qr)
|
|
|
- 3005 ELSE
|
|
|
- 3006 QbeGen.CopyOp("1", qr)
|
|
|
- 3007 END;
|
|
|
- 3008 t := SymTab.IntType();
|
|
|
- 3009 QbeGen.CopyOp(qr, q)
|
|
|
- 3010 ELSIF isStr THEN
|
|
|
- 3011 (* fold: content length at
|
|
|
- 3012 compile time *)
|
|
|
- 3013 IF SymTab.StrLen(s) = 3 THEN
|
|
|
- 3014 c1 := 1
|
|
|
- 3015 ELSE
|
|
|
- 3016 c1 :=
|
|
|
- 3017 SymTab.StrLen(s) - 2
|
|
|
- 3018 END;
|
|
|
- 3019 IF isHigh THEN
|
|
|
- 3020 DEC(c1)
|
|
|
- 3021 END;
|
|
|
- 3022 QbeGen.IntStr(c1, qr);
|
|
|
- 3023 t := SymTab.IntType();
|
|
|
- 3024 QbeGen.CopyOp(qr, q)
|
|
|
- 3025 ELSIF dt = SymTab.InvalidType THEN
|
|
|
- 3026 t := SymTab.InvalidType;
|
|
|
- 3027 QbeGen.CopyOp("0", q)
|
|
|
- 3028 ELSIF SymTab.ClassOf(dt) #
|
|
|
- 3029 SymTab.ClArray THEN
|
|
|
- 3030 SemError(217);
|
|
|
- 3031 t := SymTab.InvalidType;
|
|
|
- 3032 QbeGen.CopyOp("0", q)
|
|
|
- 3033 ELSE
|
|
|
- 3034 IF SymTab.IsOpenArray(dt) THEN
|
|
|
- 3035 t := SymTab.IntType();
|
|
|
- 3036 QbeGen.CopyOp("@", q)
|
|
|
- 3037 ELSE
|
|
|
- 3038 IF isHigh THEN
|
|
|
- 3039 QbeGen.IntStr(
|
|
|
- 3040 SymTab.ArrayHi(dt), qr)
|
|
|
- 3041 ELSE
|
|
|
- 3042 QbeGen.IntStr(VAL(
|
|
|
- 3043 INTEGER,
|
|
|
- 3044 SymTab.ArrayLen(dt)),
|
|
|
- 3045 qr)
|
|
|
- 3046 END;
|
|
|
- 3047 t := SymTab.IntType();
|
|
|
- 3048 QbeGen.CopyOp(qr, q)
|
|
|
- 3049 END
|
|
|
- 3050 END; .)
|
|
|
- 3051 | ( "SIZE" | "TSIZE" ) "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
- 3052 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3053 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "SIZE"));
|
|
|
- 3054 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3055 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3056 (. IF dt = SymTab.InvalidType THEN
|
|
|
- 3057 t := SymTab.InvalidType;
|
|
|
- 3058 QbeGen.CopyOp("0", q)
|
|
|
- 3059 ELSE
|
|
|
- 3060 QbeGen.IntStr(VAL(INTEGER,
|
|
|
- 3061 SymTab.ObjectSize(dt)), q);
|
|
|
- 3062 t := SymTab.IntType()
|
|
|
- 3063 END; .)
|
|
|
- 3064 | ( "SHIFT" (. isMax := FALSE; .)
|
|
|
- 3065 | "ROTATE" (. isMax := TRUE; .) )
|
|
|
- 3066 "(" Expr<et, q> (. astArg2 := astCur; .) "," Expr<et2, q2> ")"
|
|
|
- 3067 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3068 IF isMax THEN AST.SetChild(astNode, 0,
|
|
|
- 3069 AST.MakeLeaf(AST.NkIdent, "ROTATE"))
|
|
|
- 3070 ELSE AST.SetChild(astNode, 0,
|
|
|
- 3071 AST.MakeLeaf(AST.NkIdent, "SHIFT")) END;
|
|
|
- 3072 IF astArg2 # AST.NoNode THEN AST.SetChild(astNode, 1, astArg2) END;
|
|
|
- 3073 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
- 3074 astCur := astNode; astIsLit := TRUE;
|
|
|
- 3075 (* set shift/rotate: isMax
|
|
|
- 3076 doubles as "rotate" *)
|
|
|
- 3077 IF (et # SymTab.InvalidType)
|
|
|
- 3078 AND (SymTab.ClassOf(et) =
|
|
|
- 3079 SymTab.ClSet) THEN
|
|
|
- 3080 t := et;
|
|
|
- 3081 QbeGen.CopyOp("@", q)
|
|
|
- 3082 ELSE SemError(230);
|
|
|
- 3083 t := SymTab.InvalidType;
|
|
|
- 3084 QbeGen.CopyOp("0", q)
|
|
|
- 3085 END; .)
|
|
|
- 3086 | ( "MIN" (. isMax := FALSE; .)
|
|
|
- 3087 | "MAX" (. isMax := TRUE; .) )
|
|
|
- 3088 "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
- 3089 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3090 IF isMax THEN AST.SetChild(astNode, 0,
|
|
|
- 3091 AST.MakeLeaf(AST.NkIdent, "MAX"))
|
|
|
- 3092 ELSE AST.SetChild(astNode, 0,
|
|
|
- 3093 AST.MakeLeaf(AST.NkIdent, "MIN")) END;
|
|
|
- 3094 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3095 astCur := astNode; astIsLit := TRUE;
|
|
|
- 3096 IF (dt # SymTab.InvalidType)
|
|
|
- 3097 AND (SymTab.ClassOf(dt) = SymTab.ClReal) THEN
|
|
|
- 3098 (* REAL/LONGREAL: the
|
|
|
- 3099 implementation bounds *)
|
|
|
- 3100 IF isMax THEN
|
|
|
- 3101 QbeGen.NormReal(
|
|
|
- 3102 "3.402823e38", q)
|
|
|
- 3103 ELSE QbeGen.NormReal(
|
|
|
- 3104 "-3.402823e38", q)
|
|
|
- 3105 END;
|
|
|
- 3106 t := SymTab.RealType()
|
|
|
- 3107 ELSIF (dt #
|
|
|
- 3108 SymTab.InvalidType)
|
|
|
- 3109 AND (SymTab.ClassOf(dt) =
|
|
|
- 3110 SymTab.ClLong) THEN
|
|
|
- 3111 IF isMax THEN
|
|
|
- 3112 QbeGen.CopyOp(
|
|
|
- 3113 "9223372036854775807", q)
|
|
|
- 3114 ELSE QbeGen.CopyOp(
|
|
|
- 3115 "-9223372036854775808", q)
|
|
|
- 3116 END;
|
|
|
- 3117 t := SymTab.LongType()
|
|
|
- 3118 ELSIF SymTab.TypeBounds(dt, lo,
|
|
|
- 3119 hi) THEN
|
|
|
- 3120 IF isMax THEN
|
|
|
- 3121 QbeGen.IntStr(hi, q)
|
|
|
- 3122 ELSE QbeGen.IntStr(lo, q)
|
|
|
- 3123 END;
|
|
|
- 3124 t := SymTab.IntType()
|
|
|
- 3125 ELSE SemError(230);
|
|
|
- 3126 t := SymTab.InvalidType;
|
|
|
- 3127 QbeGen.CopyOp("0", q)
|
|
|
- 3128 END; .)
|
|
|
- 3129 | "ADR" "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
- 3130 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3131 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ADR"));
|
|
|
- 3132 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3133 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3134 (. IF dt = SymTab.InvalidType THEN
|
|
|
- 3135 t := SymTab.InvalidType;
|
|
|
- 3136 QbeGen.CopyOp("0", q)
|
|
|
- 3137 ELSE
|
|
|
- 3138 IF sfx
|
|
|
- 3139 OR (dk = SymTab.KindVar)
|
|
|
- 3140 OR (dk = SymTab.KindParam) THEN
|
|
|
- 3141 QbeGen.CopyOp("@", q)
|
|
|
- 3142 ELSE SemError(230);
|
|
|
- 3143 QbeGen.CopyOp("0", q)
|
|
|
- 3144 END;
|
|
|
- 3145 t := SymTab.AddrType()
|
|
|
- 3146 END; .)
|
|
|
- 3147 | "CHR" "(" Expr<et, q> ")"
|
|
|
- 3148 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3149 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CHR"));
|
|
|
- 3150 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3151 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3152 (. IF (et # SymTab.InvalidType)
|
|
|
- 3153 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
- 3154 SemError(211) END;
|
|
|
- 3155 t := SymTab.CharType(); .)
|
|
|
- 3156 | ( "ORD" | "ORDL" ) "(" Expr<et, q> ")"
|
|
|
- 3157 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3158 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ORD"));
|
|
|
- 3159 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3160 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3161 (. IF et # SymTab.InvalidType THEN
|
|
|
- 3162 IF (SymTab.ClassOf(et) #
|
|
|
- 3163 SymTab.ClChar)
|
|
|
- 3164 AND (SymTab.ClassOf(et) #
|
|
|
- 3165 SymTab.ClBool)
|
|
|
- 3166 AND (SymTab.ClassOf(et) #
|
|
|
- 3167 SymTab.ClEnum)
|
|
|
- 3168 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
- 3169 SemError(211) END
|
|
|
- 3170 END;
|
|
|
- 3171 t := SymTab.IntType(); .)
|
|
|
- 3172 | "CAP" "(" Expr<et, q> ")"
|
|
|
- 3173 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3174 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CAP"));
|
|
|
- 3175 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3176 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3177 (. QbeGen.CopyOp("@", q);
|
|
|
- 3178 t := SymTab.CharType(); .)
|
|
|
- 3179 | "UCHR" "(" Expr<et, q> ")"
|
|
|
- 3180 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3181 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "UCHR"));
|
|
|
- 3182 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3183 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3184 (. (* UCHR: the UCHAR constructor.
|
|
|
- 3185 CHAR -> UCHAR (identity);
|
|
|
- 3186 INTEGER familly -> UCHAR
|
|
|
- 3187 (codepoint value). *)
|
|
|
- 3188 IF (et # SymTab.InvalidType)
|
|
|
- 3189 AND (SymTab.ClassOf(et) # SymTab.ClChar)
|
|
|
- 3190 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
- 3191 SemError(211) END;
|
|
|
- 3192 t := SymTab.UCharType(); .)
|
|
|
- 3193 | "CHR8" "(" Expr<et, q> ")"
|
|
|
- 3194 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3195 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CHR8"));
|
|
|
- 3196 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3197 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3198 (. IF (et # SymTab.InvalidType)
|
|
|
- 3199 AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
|
|
|
- 3200 SemError(211) END;
|
|
|
- 3201 t := SymTab.CharType(); .)
|
|
|
- 3202 | "UORD" "(" Expr<et, q> ")"
|
|
|
- 3203 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3204 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "UORD"));
|
|
|
- 3205 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3206 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3207 (. (* UORD(u): the codepoint as a
|
|
|
- 3208 32-bit ordinal (INTEGER),
|
|
|
- 3209 cf. ORD for CHAR. *)
|
|
|
- 3210 IF (et # SymTab.InvalidType)
|
|
|
- 3211 AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
|
|
|
- 3212 SemError(211) END;
|
|
|
- 3213 t := SymTab.IntType(); .)
|
|
|
- 3214 | "ABS" "(" Expr<et, q> ")"
|
|
|
+ 2434 ELSE
|
|
|
+ 2435 eT := SymTab.ArrayElem(t);
|
|
|
+ 2436 t := eT; sfx := TRUE
|
|
|
+ 2437 END; .) }
|
|
|
+ 2438 "]"
|
|
|
+ 2439 | "." GetIdent<fn>
|
|
|
+ 2440 (. astSel := AST.MakeNode(AST.NkSelector);
|
|
|
+ 2441 AST.SetOp(astSel, AST.SelField);
|
|
|
+ 2442 AST.SetChild(astSel, 0, AST.MakeLeaf(AST.NkIdent, fn));
|
|
|
+ 2443 AST.SetChild(astDes, AST.NChild(astDes), astSel); IF k = SymTab.KindModule THEN
|
|
|
+ 2444 (* qualified L.x: materialize
|
|
|
+ 2445 the export, then load it *)
|
|
|
+ 2446 IF NOT SymTab.MaterializeAlias(n,
|
|
|
+ 2447 fn, mal) THEN
|
|
|
+ 2448 SemError(201);
|
|
|
+ 2449 t := SymTab.InvalidType;
|
|
|
+ 2450 QbeGen.CopyOp("0", q)
|
|
|
+ 2451 ELSE
|
|
|
+ 2452 QbeGen.CopyOp(mal, qn);
|
|
|
+ 2453 t := SymTab.SymType(mal);
|
|
|
+ 2454 k := SymTab.SymKind(mal);
|
|
|
+ 2455 sfx := FALSE;
|
|
|
+ 2456 IF k = SymTab.KindProc THEN
|
|
|
+ 2457 (* call: ArgList supplies
|
|
|
+ 2458 the value *)
|
|
|
+ 2459 QbeGen.CopyOp("0", q)
|
|
|
+ 2460 END
|
|
|
+ 2461 END
|
|
|
+ 2462 ELSIF t = SymTab.InvalidType THEN
|
|
|
+ 2463 ELSIF (SymTab.ClassOf(t) #
|
|
|
+ 2464 SymTab.ClRecord)
|
|
|
+ 2465 AND (SymTab.ClassOf(t) #
|
|
|
+ 2466 SymTab.ClClass) THEN
|
|
|
+ 2467 SemError(215);
|
|
|
+ 2468 t := SymTab.InvalidType
|
|
|
+ 2469 ELSIF (SymTab.ClassOf(t) =
|
|
|
+ 2470 SymTab.ClClass)
|
|
|
+ 2471 AND SymTab.MethodExists(t, fn) THEN
|
|
|
+ 2472 (* obj.Method: bind the
|
|
|
+ 2473 method and pass obj as
|
|
|
+ 2474 the hidden receiver; q
|
|
|
+ 2475 already holds the
|
|
|
+ 2476 object's address *)
|
|
|
+ 2477 QbeGen.CopyOp(fn, n);
|
|
|
+ 2478 QbeGen.CopyOp(fn, qn);
|
|
|
+ 2479 methCls := t;
|
|
|
+ 2480 k := SymTab.KindProc;
|
|
|
+ 2481 t := SymTab.InvalidType
|
|
|
+ 2482 ELSIF NOT SymTab.FieldExists(t,
|
|
|
+ 2483 fn) THEN
|
|
|
+ 2484 SemError(216);
|
|
|
+ 2485 t := SymTab.InvalidType
|
|
|
+ 2486 ELSE
|
|
|
+ 2487 t := SymTab.FieldType(t, fn);
|
|
|
+ 2488 sfx := TRUE
|
|
|
+ 2489 END; .)
|
|
|
+ 2490 | "^"
|
|
|
+ 2491 (. astSel := AST.MakeNode(AST.NkSelector);
|
|
|
+ 2492 AST.SetOp(astSel, AST.SelDeref);
|
|
|
+ 2493 AST.SetChild(astDes, AST.NChild(astDes), astSel); IF t = SymTab.InvalidType THEN
|
|
|
+ 2494 ELSIF SymTab.ClassOf(t) #
|
|
|
+ 2495 SymTab.ClPtr THEN
|
|
|
+ 2496 SemError(219);
|
|
|
+ 2497 t := SymTab.InvalidType
|
|
|
+ 2498 ELSE
|
|
|
+ 2499 bt := SymTab.PtrBase(t);
|
|
|
+ 2500 IF bt = SymTab.InvalidType THEN
|
|
|
+ 2501 ELSE
|
|
|
+ 2502 t := bt;
|
|
|
+ 2503 sfx := TRUE
|
|
|
+ 2504 END
|
|
|
+ 2505 END; .) } (. astCur := astDes; .) .
|
|
|
+ 2506 (* Result suffix (ISO component after a function call): `F()^`,
|
|
|
+ 2507 `F()[i]`, `F().field`. The call result is in t/q with sfx FALSE
|
|
|
+ 2508 (a value, or a descriptor address for aggregates); each component
|
|
|
+ 2509 descends one level exactly like the Design components. *)
|
|
|
+ 2510 ResultComp<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
|
|
|
+ 2511 VAR sfx: BOOLEAN; VAR node: AST.Node;
|
|
|
+ 2512 VAR mname: SymTab.Name; VAR methCls: SymTab.TypeIndex;
|
|
|
+ 2513 VAR isM: BOOLEAN> (. VAR it, eT, bt: SymTab.TypeIndex;
|
|
|
+ 2514 iq, ql, qlo, qhi, qe, qb:
|
|
|
+ 2515 QbeGen.QVal;
|
|
|
+ 2516 lo, hi, fo: INTEGER;
|
|
|
+ 2517 isOpen: BOOLEAN;
|
|
|
+ 2518 fname: SymTab.Name;
|
|
|
+ 2519 astWrap, astSel: AST.Node; .)
|
|
|
+ 2520 = "[" Expr<it, iq>
|
|
|
+ 2521 (. isM := FALSE;
|
|
|
+ 2522 IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
+ 2523 astWrap := AST.MakeNode(
|
|
|
+ 2524 AST.NkDesignator);
|
|
|
+ 2525 AST.SetChild(astWrap, 0, node);
|
|
|
+ 2526 node := astWrap
|
|
|
+ 2527 END;
|
|
|
+ 2528 AST.SetChild(node, AST.NChild(node),
|
|
|
+ 2529 AST.MakeUn(AST.NkSelector,
|
|
|
+ 2530 AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
+ 2531 ELSIF SymTab.ClassOf(t) #
|
|
|
+ 2532 SymTab.ClArray THEN
|
|
|
+ 2533 SemError(217);
|
|
|
+ 2534 t := SymTab.InvalidType
|
|
|
+ 2535 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
+ 2536 AND (SymTab.ClassOf(it) # SymTab.ClChar)
|
|
|
+ 2537 AND (SymTab.ClassOf(it) # SymTab.ClEnum) THEN
|
|
|
+ 2538 SemError(218);
|
|
|
+ 2539 t := SymTab.InvalidType
|
|
|
+ 2540 ELSE
|
|
|
+ 2541 eT := SymTab.ArrayElem(t);
|
|
|
+ 2542 t := eT; sfx := TRUE
|
|
|
+ 2543 END; .)
|
|
|
+ 2544 "]"
|
|
|
+ 2545 | "." GetIdent<fname>
|
|
|
+ 2546 (. isM := FALSE;
|
|
|
+ 2547 IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
+ 2548 astWrap := AST.MakeNode(
|
|
|
+ 2549 AST.NkDesignator);
|
|
|
+ 2550 AST.SetChild(astWrap, 0, node);
|
|
|
+ 2551 node := astWrap
|
|
|
+ 2552 END;
|
|
|
+ 2553 AST.SetChild(node, AST.NChild(node),
|
|
|
+ 2554 AST.MakeUn(AST.NkSelector,
|
|
|
+ 2555 AST.SelField,
|
|
|
+ 2556 AST.MakeLeaf(AST.NkIdent,
|
|
|
+ 2557 fname))); IF t = SymTab.InvalidType THEN
|
|
|
+ 2558 ELSIF (SymTab.ClassOf(t) #
|
|
|
+ 2559 SymTab.ClRecord)
|
|
|
+ 2560 AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN
|
|
|
+ 2561 SemError(215);
|
|
|
+ 2562 t := SymTab.InvalidType
|
|
|
+ 2563 ELSIF (SymTab.ClassOf(t) =
|
|
|
+ 2564 SymTab.ClClass)
|
|
|
+ 2565 AND SymTab.MethodExists(t, fname) THEN
|
|
|
+ 2566 (* a method on the call result:
|
|
|
+ 2567 a following ArgList makes
|
|
|
+ 2568 the call *)
|
|
|
+ 2569 mname := fname;
|
|
|
+ 2570 methCls := t; isM := TRUE;
|
|
|
+ 2571 t := SymTab.InvalidType
|
|
|
+ 2572 ELSIF NOT SymTab.FieldExists(t,
|
|
|
+ 2573 fname) THEN
|
|
|
+ 2574 SemError(216);
|
|
|
+ 2575 t := SymTab.InvalidType
|
|
|
+ 2576 ELSE
|
|
|
+ 2577 t := SymTab.FieldType(t, fname);
|
|
|
+ 2578 sfx := TRUE
|
|
|
+ 2579 END; .)
|
|
|
+ 2580 | "^" (. isM := FALSE;
|
|
|
+ 2581 IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
+ 2582 astWrap := AST.MakeNode(
|
|
|
+ 2583 AST.NkDesignator);
|
|
|
+ 2584 AST.SetChild(astWrap, 0, node);
|
|
|
+ 2585 node := astWrap
|
|
|
+ 2586 END;
|
|
|
+ 2587 astSel := AST.MakeNode(AST.NkSelector);
|
|
|
+ 2588 AST.SetOp(astSel, AST.SelDeref);
|
|
|
+ 2589 AST.SetChild(node,
|
|
|
+ 2590 AST.NChild(node), astSel); IF t = SymTab.InvalidType THEN
|
|
|
+ 2591 ELSIF SymTab.ClassOf(t) #
|
|
|
+ 2592 SymTab.ClPtr THEN
|
|
|
+ 2593 SemError(219);
|
|
|
+ 2594 t := SymTab.InvalidType
|
|
|
+ 2595 ELSE
|
|
|
+ 2596 bt := SymTab.PtrBase(t);
|
|
|
+ 2597 IF bt # SymTab.InvalidType THEN
|
|
|
+ 2598 t := bt; sfx := TRUE
|
|
|
+ 2599 END
|
|
|
+ 2600 END; .) .
|
|
|
+ 2601 Expr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 2602 (. VAR t2: SymTab.TypeIndex;
|
|
|
+ 2603 op: INTEGER;
|
|
|
+ 2604 q2, qt, wl: QbeGen.QVal;
|
|
|
+ 2605 astA, astB: AST.Node;
|
|
|
+ 2606 astOp: INTEGER;
|
|
|
+ 2607 astMade: BOOLEAN;
|
|
|
+ 2608 isR: BOOLEAN; .)
|
|
|
+ 2609 = SimExpr<t, q> (. astA := astCur; astMade := FALSE; .)
|
|
|
+ 2610 [ Rel<op> SimExpr<t2, q2>
|
|
|
+ 2611 (. astB := astCur; astMade := TRUE;
|
|
|
+ 2612 astOp := AST.OpEq;
|
|
|
+ 2613 IF op = SymTab.OpNeq1 THEN astOp := AST.OpNe
|
|
|
+ 2614 ELSIF op = SymTab.OpNeq2 THEN astOp := AST.OpNe
|
|
|
+ 2615 ELSIF op = SymTab.OpLt THEN astOp := AST.OpLt
|
|
|
+ 2616 ELSIF op = SymTab.OpLe THEN astOp := AST.OpLe
|
|
|
+ 2617 ELSIF op = SymTab.OpGt THEN astOp := AST.OpGt
|
|
|
+ 2618 ELSIF op = SymTab.OpGe THEN astOp := AST.OpGe
|
|
|
+ 2619 ELSIF op = SymTab.OpIn THEN astOp := AST.OpIn
|
|
|
+ 2620 END;
|
|
|
+ 2621 IF op = SymTab.OpIn THEN
|
|
|
+ 2622 IF SymTab.InCheck(t, t2) THEN
|
|
|
+ 2623 IF (t = SymTab.InvalidType)
|
|
|
+ 2624 OR (t2 = SymTab.InvalidType) THEN
|
|
|
+ 2625 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
|
|
|
+ 2626 ELSE
|
|
|
+ 2627 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
+ 2628 END
|
|
|
+ 2629 ELSE SemError(222); t := SymTab.InvalidType;
|
|
|
+ 2630 QbeGen.CopyOp("0", q)
|
|
|
+ 2631 END
|
|
|
+ 2632 ELSIF SymTab.RelCheck(t, t2, op) THEN
|
|
|
+ 2633 IF (t = SymTab.InvalidType)
|
|
|
+ 2634 OR (t2 = SymTab.InvalidType) THEN
|
|
|
+ 2635 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
|
|
|
+ 2636 ELSIF (SymTab.ClassOf(t) = SymTab.ClPtr)
|
|
|
+ 2637 OR (SymTab.ClassOf(t2) = SymTab.ClPtr) THEN
|
|
|
+ 2638 IF (op # SymTab.OpEq) AND (op # SymTab.OpNeq1)
|
|
|
+ 2639 AND (op # SymTab.OpNeq2) THEN
|
|
|
+ 2640 SemError(213); t := SymTab.InvalidType;
|
|
|
+ 2641 QbeGen.CopyOp("0", q)
|
|
|
+ 2642 ELSE
|
|
|
+ 2643 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
+ 2644 END
|
|
|
+ 2645 ELSIF (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
+ 2646 OR (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
+ 2647 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
+ 2648 ELSIF SymTab.StrCompat(t, t2) THEN
|
|
|
+ 2649 QbeGen.StrEq(op, q, q2, qt);
|
|
|
+ 2650 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
|
|
|
+ 2651 ELSIF SymTab.IsLongFamily(t)
|
|
|
+ 2652 OR SymTab.IsLongFamily(t2) THEN
|
|
|
+ 2653 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
+ 2654 ELSE
|
|
|
+ 2655 t := SymTab.BoolType();
|
|
|
+ 2656 QbeGen.CopyOp("@", q)
|
|
|
+ 2657 END
|
|
|
+ 2658 ELSE SemError(213); t := SymTab.InvalidType;
|
|
|
+ 2659 QbeGen.CopyOp("0", q)
|
|
|
+ 2660 END;
|
|
|
+ 2661 astCur := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB); .) ]
|
|
|
+ 2662 (. IF NOT astMade THEN astCur := astA END; .)
|
|
|
+ 2663 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
+ 2664 Rel<VAR op: INTEGER>
|
|
|
+ 2665 = "=" (. op := SymTab.OpEq; .)
|
|
|
+ 2666 | "#" (. op := SymTab.OpNeq1; .)
|
|
|
+ 2667 | "<" (. op := SymTab.OpLt; .)
|
|
|
+ 2668 | "<=" (. op := SymTab.OpLe; .)
|
|
|
+ 2669 | ">" (. op := SymTab.OpGt; .)
|
|
|
+ 2670 | ">=" (. op := SymTab.OpGe; .)
|
|
|
+ 2671 | "IN" (. op := SymTab.OpIn; .) .
|
|
|
+ 2672 SimExpr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 2673 (. VAR t2, res2, lt, rt:
|
|
|
+ 2674 SymTab.TypeIndex;
|
|
|
+ 2675 op: INTEGER;
|
|
|
+ 2676 q2, qt, wq, qf, q2a, q2b:
|
|
|
+ 2677 QbeGen.QVal;
|
|
|
+ 2678 neg, isR, isL, folded:
|
|
|
+ 2679 BOOLEAN;
|
|
|
+ 2680 fok: BOOLEAN;
|
|
|
+ 2681 lw, rw, mw: CARDINAL;
|
|
|
+ 2682 lTrue, lNext, lDone, qr, qs: QbeGen.QVal;
|
|
|
+ 2683 astA, astB: AST.Node;
|
|
|
+ 2684 astSign, astOp: INTEGER; .)
|
|
|
+ 2685 = (. neg := FALSE; astSign := 0; .)
|
|
|
+ 2686 [ "+" (. neg := TRUE; astSign := 1; .)
|
|
|
+ 2687 | "-" (. neg := TRUE; astSign := -1; .) ]
|
|
|
+ 2688 Term<t, q> (. astA := astCur;
|
|
|
+ 2689 IF neg AND QbeGen.IsImm(q) THEN
|
|
|
+ 2690 QbeGen.NegFold(q, q)
|
|
|
+ 2691 END;
|
|
|
+ 2692 IF astSign < 0 THEN
|
|
|
+ 2693 astCur := AST.MakeUn(
|
|
|
+ 2694 AST.NkUnary, AST.OpSub, astA);
|
|
|
+ 2695 astA := astCur
|
|
|
+ 2696 END; .)
|
|
|
+ 2697 { AddOp<op>
|
|
|
+ 2698 Term<t2, q2> (. astB := astCur; .)
|
|
|
+ 2699 (. astOp := AST.OpAdd;
|
|
|
+ 2700 IF op = SymTab.OpSub THEN astOp := AST.OpSub
|
|
|
+ 2701 ELSIF op = SymTab.OpOr THEN astOp := AST.OpOr END;
|
|
|
+ 2702 astA := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB);
|
|
|
+ 2703 astCur := astA;
|
|
|
+ 2704 IF op = SymTab.OpOr THEN
|
|
|
+ 2705 (* short-circuit: if q is true the RHS is skipped *)
|
|
|
+ 2706 IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
|
|
|
+ 2707 t := SymTab.BoolType()
|
|
|
+ 2708 ELSE SemError(212); t := SymTab.InvalidType END;
|
|
|
+ 2709 IF t # SymTab.InvalidType THEN
|
|
|
+ 2710 QbeGen.CopyOp("@", q)
|
|
|
+ 2711 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 2712 END
|
|
|
+ 2713 ELSIF (op = SymTab.OpAdd)
|
|
|
+ 2714 AND (SymTab.UStrCompat(t, t2)
|
|
|
+ 2715 OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
|
|
|
+ 2716 AND (SymTab.ClassOf(t2) = SymTab.ClUStr))
|
|
|
+ 2717 OR ((SymTab.ClassOf(t) = SymTab.ClUStr)
|
|
|
+ 2718 AND (SymTab.ClassOf(t2) = SymTab.ClUChar))
|
|
|
+ 2719 OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
|
|
|
+ 2720 AND (SymTab.ClassOf(t2) = SymTab.ClUChar))) THEN
|
|
|
+ 2721 (* UString concatenation: a UCHAR operand becomes a
|
|
|
+ 2722 1-codepoint UString; the result is a descriptor in the
|
|
|
+ 2723 shim's concat buffer. Work on copies so neither
|
|
|
+ 2724 operand is clobbered. *)
|
|
|
+ 2725 t := SymTab.NewUStr();
|
|
|
+ 2726 QbeGen.CopyOp("@", q)
|
|
|
+ 2727 ELSIF (op = SymTab.OpAdd)
|
|
|
+ 2728 AND (SymTab.StrCompat(t, t2)
|
|
|
+ 2729 OR (SymTab.IsStrType(t)
|
|
|
+ 2730 AND (SymTab.ClassOf(t2) = SymTab.ClChar))
|
|
|
+ 2731 OR ((SymTab.ClassOf(t) = SymTab.ClChar)
|
|
|
+ 2732 AND SymTab.IsStrType(t2))) THEN
|
|
|
+ 2733 (* string concatenation; a CHAR operand becomes a
|
|
|
+ 2734 1-character string literal. When both operands are
|
|
|
+ 2735 constants, fold to a single string literal so a
|
|
|
+ 2736 constructor element stays compile-time. *)
|
|
|
+ 2737 QbeGen.StrFold(q, q2, SymTab.ClassOf(t), SymTab.ClassOf(t2),
|
|
|
+ 2738 qt, fok);
|
|
|
+ 2739 IF fok THEN QbeGen.CopyOp(qt, q)
|
|
|
+ 2740 ELSE QbeGen.CopyOp("@", q)
|
|
|
+ 2741 END;
|
|
|
+ 2742 t := SymTab.NewStr()
|
|
|
+ 2743 ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
|
|
|
+ 2744 AND (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
+ 2745 AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
+ 2746 lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
|
|
|
+ 2747 mw := lw;
|
|
|
+ 2748 IF rw > mw THEN mw := rw END;
|
|
|
+ 2749 t := SymTab.NewSet(
|
|
|
+ 2750 SymTab.NewSubR(0,
|
|
|
+ 2751 VAL(INTEGER, mw) * 32 - 1));
|
|
|
+ 2752 QbeGen.CopyOp("@", q)
|
|
|
+ 2753 ELSE
|
|
|
+ 2754 IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN
|
|
|
+ 2755 lt := t; rt := t2; t := res2
|
|
|
+ 2756 ELSE SemError(211); t := SymTab.InvalidType END;
|
|
|
+ 2757 IF t # SymTab.InvalidType THEN
|
|
|
+ 2758 isL := SymTab.IsLongFamily(t);
|
|
|
+ 2759 isR := SymTab.ClassOf(t) = SymTab.ClReal;
|
|
|
+ 2760 folded := FALSE;
|
|
|
+ 2761 IF (NOT isL) AND (NOT isR)
|
|
|
+ 2762 AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
|
|
|
+ 2763 IF op = SymTab.OpAdd THEN
|
|
|
+ 2764 folded := QbeGen.Fold2(0, q, q2, qf)
|
|
|
+ 2765 ELSE
|
|
|
+ 2766 folded := QbeGen.Fold2(1, q, q2, qf)
|
|
|
+ 2767 END
|
|
|
+ 2768 END;
|
|
|
+ 2769 IF folded THEN QbeGen.CopyOp(qf, q)
|
|
|
+ 2770 ELSE
|
|
|
+ 2771 QbeGen.CopyOp("@", q)
|
|
|
+ 2772 END
|
|
|
+ 2773 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 2774 END
|
|
|
+ 2775 END; .) }
|
|
|
+ 2776 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
+ 2777 AddOp<VAR op: INTEGER>
|
|
|
+ 2778 = "+" (. op := SymTab.OpAdd; .)
|
|
|
+ 2779 | "-" (. op := SymTab.OpSub; .)
|
|
|
+ 2780 | "OR" (. op := SymTab.OpOr; .) .
|
|
|
+ 2781 Term<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 2782 (. VAR t2, res2, lt, rt:
|
|
|
+ 2783 SymTab.TypeIndex;
|
|
|
+ 2784 op: INTEGER;
|
|
|
+ 2785 q2, qt, wq, qf:
|
|
|
+ 2786 QbeGen.QVal;
|
|
|
+ 2787 isR, isL, folded: BOOLEAN;
|
|
|
+ 2788 lw, rw, mw: CARDINAL;
|
|
|
+ 2789 lNext, lFalse, lDone, qr, qs: QbeGen.QVal;
|
|
|
+ 2790 astA, astB: AST.Node;
|
|
|
+ 2791 astOp: INTEGER; .)
|
|
|
+ 2792 = Fact<t, q> (. astA := astCur; .) { MulOp<op>
|
|
|
+ 2793 Fact<t2, q2> (. astB := astCur; .)
|
|
|
+ 2794 (. astOp := AST.OpMul;
|
|
|
+ 2795 IF op = SymTab.OpSlash THEN astOp := AST.OpDiv
|
|
|
+ 2796 ELSIF op = SymTab.OpDiv THEN astOp := AST.OpDiv
|
|
|
+ 2797 ELSIF op = SymTab.OpMod THEN astOp := AST.OpMod
|
|
|
+ 2798 ELSIF op = SymTab.OpAnd THEN astOp := AST.OpAnd END;
|
|
|
+ 2799 astA := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB);
|
|
|
+ 2800 astCur := astA;
|
|
|
+ 2801 IF op = SymTab.OpAnd THEN
|
|
|
+ 2802 (* short-circuit: if q is false the RHS is skipped *)
|
|
|
+ 2803 IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
|
|
|
+ 2804 t := SymTab.BoolType()
|
|
|
+ 2805 ELSE SemError(212); t := SymTab.InvalidType END;
|
|
|
+ 2806 IF t # SymTab.InvalidType THEN QbeGen.CopyOp("@", q)
|
|
|
+ 2807 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 2808 END
|
|
|
+ 2809 ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
|
|
|
+ 2810 AND (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
+ 2811 AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
+ 2812 lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
|
|
|
+ 2813 mw := lw;
|
|
|
+ 2814 IF rw > mw THEN mw := rw END;
|
|
|
+ 2815 t := SymTab.NewSet(
|
|
|
+ 2816 SymTab.NewSubR(0,
|
|
|
+ 2817 VAL(INTEGER, mw) * 32 - 1));
|
|
|
+ 2818 QbeGen.CopyOp("@", q)
|
|
|
+ 2819 ELSE
|
|
|
+ 2820 IF SymTab.ArithCheck(t, t2,
|
|
|
+ 2821 (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
|
|
|
+ 2822 res2) THEN
|
|
|
+ 2823 lt := t; rt := t2; t := res2
|
|
|
+ 2824 ELSE SemError(211); t := SymTab.InvalidType END;
|
|
|
+ 2825 IF t # SymTab.InvalidType THEN
|
|
|
+ 2826 isL := SymTab.IsLongFamily(t);
|
|
|
+ 2827 isR := SymTab.ClassOf(t) = SymTab.ClReal;
|
|
|
+ 2828 folded := FALSE;
|
|
|
+ 2829 IF (NOT isL) AND (NOT isR)
|
|
|
+ 2830 AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
|
|
|
+ 2831 IF op = SymTab.OpTimes THEN
|
|
|
+ 2832 folded := QbeGen.Fold2(2, q, q2, qf)
|
|
|
+ 2833 ELSIF op = SymTab.OpDiv THEN
|
|
|
+ 2834 folded := QbeGen.Fold2(3, q, q2, qf)
|
|
|
+ 2835 ELSIF op = SymTab.OpMod THEN
|
|
|
+ 2836 folded := QbeGen.Fold2(4, q, q2, qf)
|
|
|
+ 2837 END
|
|
|
+ 2838 END;
|
|
|
+ 2839 IF folded THEN QbeGen.CopyOp(qf, q)
|
|
|
+ 2840 ELSE
|
|
|
+ 2841 QbeGen.CopyOp("@", q)
|
|
|
+ 2842 END
|
|
|
+ 2843 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 2844 END
|
|
|
+ 2845 END; .) }
|
|
|
+ 2846 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
+ 2847 MulOp<VAR op: INTEGER>
|
|
|
+ 2848 = "*" (. op := SymTab.OpTimes; .)
|
|
|
+ 2849 | "/" (. op := SymTab.OpSlash; .)
|
|
|
+ 2850 | "DIV" (. op := SymTab.OpDiv; .)
|
|
|
+ 2851 | "MOD" (. op := SymTab.OpMod; .)
|
|
|
+ 2852 | ( "AND" | "&" ) (. op := SymTab.OpAnd; .) .
|
|
|
+ 2853 Fact<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 2854 (. VAR s: ARRAY [0 .. 255] OF CHAR;
|
|
|
+ 2855 et, dt, t2, st, ct2, et2:
|
|
|
+ 2856 SymTab.TypeIndex;
|
|
|
+ 2857 dk: INTEGER;
|
|
|
+ 2858 qd, q2, sq, qa, qm0, qr, qt:
|
|
|
+ 2859 QbeGen.QVal;
|
|
|
+ 2860 qn, vn: SymTab.Name;
|
|
|
+ 2861 vt: SymTab.TypeIndex;
|
|
|
+ 2862 c1, c2: INTEGER;
|
|
|
+ 2863 lo, hi: INTEGER;
|
|
|
+ 2864 isMax: BOOLEAN;
|
|
|
+ 2865 called, isHigh, sfx, isCh,
|
|
|
+ 2866 isU, uok, isStr: BOOLEAN;
|
|
|
+ 2867 ucp: INTEGER; astIsLit: BOOLEAN;
|
|
|
+ 2868 astD: AST.Node;
|
|
|
+ 2869 astCall: BOOLEAN;
|
|
|
+ 2870 astNode, astNot: AST.Node;
|
|
|
+ 2871 j: CARDINAL;
|
|
|
+ 2872 astArg2: AST.Node;
|
|
|
+ 2873 astBrace: AST.Node;
|
|
|
+ 2874 astRes: AST.Node; mname: SymTab.Name; isM: BOOLEAN; .)
|
|
|
+ 2875 = (. astIsLit := FALSE; .)
|
|
|
+ 2876 ( integer (. LexString(s);
|
|
|
+ 2877 QbeGen.NormInt(s, q); IF twoPhase THEN astIsLit := TRUE; astCur := AST.MakeLeaf(AST.NkIntLit, s) END;
|
|
|
+ 2878 t := SymTab.IntType(); .)
|
|
|
+ 2879 | charConst (. LexString(s);
|
|
|
+ 2880 QbeGen.NormLit(s, q, isCh);
|
|
|
+ 2881 IF twoPhase THEN
|
|
|
+ 2882 astIsLit := TRUE;
|
|
|
+ 2883 astCur := AST.MakeLeaf(
|
|
|
+ 2884 AST.NkCharLit, s)
|
|
|
+ 2885 END;
|
|
|
+ 2886 t := SymTab.CharType(); .)
|
|
|
+ 2887 | real (. LexString(s);
|
|
|
+ 2888 QbeGen.NormReal(s, q);
|
|
|
+ 2889 IF twoPhase THEN
|
|
|
+ 2890 astIsLit := TRUE;
|
|
|
+ 2891 astCur := AST.MakeLeaf(
|
|
|
+ 2892 AST.NkRealLit, s)
|
|
|
+ 2893 END;
|
|
|
+ 2894 t := SymTab.RealType(); .)
|
|
|
+ 2895 | string (. LexString(s);
|
|
|
+ 2896 IF twoPhase THEN
|
|
|
+ 2897 astIsLit := TRUE;
|
|
|
+ 2898 astCur := AST.MakeLeaf(
|
|
|
+ 2899 AST.NkStrLit, s)
|
|
|
+ 2900 END;
|
|
|
+ 2901 IF SymTab.StrLen(s) = 3 THEN
|
|
|
+ 2902 t := SymTab.CharType();
|
|
|
+ 2903 QbeGen.IntStr(
|
|
|
+ 2904 QbeGen.CharVal(s), q)
|
|
|
+ 2905 ELSE t := SymTab.NewStr();
|
|
|
+ 2906 QbeGen.DeclStr(s, q);
|
|
|
+ 2907 (* a literal's value IS its
|
|
|
+ 2908 static descriptor address *)
|
|
|
+ 2909 END; .)
|
|
|
+ 2910 | ustring (. LexString(s);
|
|
|
+ 2911 IF twoPhase THEN
|
|
|
+ 2912 astIsLit := TRUE;
|
|
|
+ 2913 astCur := AST.MakeLeaf(
|
|
|
+ 2914 AST.NkStrLit, s)
|
|
|
+ 2915 END;
|
|
|
+ 2916 QbeGen.DeclUStr(s, q, isU, ucp,
|
|
|
+ 2917 uok);
|
|
|
+ 2918 IF NOT uok THEN
|
|
|
+ 2919 SemError(234);
|
|
|
+ 2920 t := SymTab.InvalidType
|
|
|
+ 2921 ELSIF isU THEN
|
|
|
+ 2922 t := SymTab.UCharType();
|
|
|
+ 2923 QbeGen.IntStr(ucp, q)
|
|
|
+ 2924 ELSE
|
|
|
+ 2925 t := SymTab.NewUStr();
|
|
|
+ 2926 END; .)
|
|
|
+ 2927 | Design<dt, dk, qd, qn, sfx> (. astD := astCur; astCall := FALSE; astBrace := AST.NoNode;
|
|
|
+ 2928 astNArgs := 0; called := FALSE;
|
|
|
+ 2929 t := dt;
|
|
|
+ 2930 IF dk = SymTab.KindConst THEN
|
|
|
+ 2931 QbeGen.CopyOp(qd, q)
|
|
|
+ 2932 ELSE QbeGen.CopyOp("@", q)
|
|
|
+ 2933 END; .)
|
|
|
+ 2934 [ TypedBraceLit<dt, q> (. t := dt; astCall := TRUE;
|
|
|
+ 2935 astBrace := astCur; .) ]
|
|
|
+ 2936 [ ArgList<qn, dt, qd, TRUE, FALSE, methCls, ct2, q2, called>
|
|
|
+ 2937 (. astCall := TRUE;
|
|
|
+ 2938 astNode := AstCallNode(astD);
|
|
|
+ 2939 astRes := astNode;
|
|
|
+ 2940 t := ct2;
|
|
|
+ 2941 QbeGen.CopyOp(q2, q);
|
|
|
+ 2942 sfx := FALSE; .)
|
|
|
+ 2943 { ResultComp<t, q, sfx, astRes, mname, methCls, isM>
|
|
|
+ 2944 [ (. astNArgs := 0; .)
|
|
|
+ 2945 ArgList<mname, t, q, TRUE, FALSE, methCls, ct2, q2, called>
|
|
|
+ 2946 (. astNode := AstCallNode(astRes);
|
|
|
+ 2947 astRes := astNode;
|
|
|
+ 2948 t := ct2;
|
|
|
+ 2949 QbeGen.CopyOp(q2, q);
|
|
|
+ 2950 sfx := FALSE; .) ] }
|
|
|
+ 2951 (. IF sfx THEN
|
|
|
+ 2952 IF t = SymTab.InvalidType THEN
|
|
|
+ 2953 QbeGen.CopyOp("0", q)
|
|
|
+ 2954 ELSIF (SymTab.ClassOf(t) #
|
|
|
+ 2955 SymTab.ClRecord)
|
|
|
+ 2956 AND (SymTab.ClassOf(t) # SymTab.ClSet)
|
|
|
+ 2957 AND (SymTab.ClassOf(t) # SymTab.ClArray)
|
|
|
+ 2958 AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN
|
|
|
+ 2959 QbeGen.CopyOp("@", q)
|
|
|
+ 2960 END
|
|
|
+ 2961 END; .) ]
|
|
|
+ 2962 (. IF called THEN
|
|
|
+ 2963 astCur := astRes
|
|
|
+ 2964 ELSIF astCall THEN
|
|
|
+ 2965 astCur := astBrace
|
|
|
+ 2966 ELSE astCur := astD
|
|
|
+ 2967 END;
|
|
|
+ 2968 astIsLit := TRUE;
|
|
|
+ 2969 IF NOT called
|
|
|
+ 2970 AND (dk = SymTab.KindProc) THEN
|
|
|
+ 2971 (* bare zero-arg function
|
|
|
+ 2972 call (parentheses may be
|
|
|
+ 2973 omitted); a proper or
|
|
|
+ 2974 parameterised proc here
|
|
|
+ 2975 is 230 *)
|
|
|
+ 2976 IF (SymTab.ProcNPar(qn) = 0)
|
|
|
+ 2977 AND (SymTab.ProcRes(qn) # SymTab.InvalidType) THEN
|
|
|
+ 2978 t := SymTab.ProcRes(qn);
|
|
|
+ 2979 QbeGen.CopyOp("@", q);
|
|
|
+ 2980 astCur := AST.MakeNode(AST.NkCall);
|
|
|
+ 2981 AST.SetChild(astCur, 0, astD)
|
|
|
+ 2982 ELSE
|
|
|
+ 2983 t := SymTab.ProcTypeOf(qn);
|
|
|
+ 2984 QbeGen.CopyOp("@", q)
|
|
|
+ 2985 END
|
|
|
+ 2986 END; .)
|
|
|
+ 2987 | ( "HIGH" (. isHigh := TRUE; .)
|
|
|
+ 2988 | ( "LEN" | "LENGTH" ) (. isHigh := FALSE; .) )
|
|
|
+ 2989 "(" ( Design<dt, dk, qd, qn, sfx> (. isStr := FALSE;
|
|
|
+ 2990 isU := FALSE; .)
|
|
|
+ 2991 | string (. LexString(s); astCur := AST.MakeLeaf(AST.NkStrLit, s);
|
|
|
+ 2992 isStr := TRUE;
|
|
|
+ 2993 isU := FALSE;
|
|
|
+ 2994 IF SymTab.StrLen(s) = 3 THEN
|
|
|
+ 2995 dt := SymTab.CharType();
|
|
|
+ 2996 QbeGen.IntStr(QbeGen.CharVal(s),
|
|
|
+ 2997 qd)
|
|
|
+ 2998 ELSE
|
|
|
+ 2999 dt := SymTab.NewStr();
|
|
|
+ 3000 QbeGen.DeclStr(s, qd);
|
|
|
+ 3001 END;
|
|
|
+ 3002 dk := -1;
|
|
|
+ 3003 qn[0] := CHR(0); .)
|
|
|
+ 3004 | ustring (. LexString(s); astCur := AST.MakeLeaf(AST.NkStrLit, s);
|
|
|
+ 3005 QbeGen.DeclUStr(s, qd, isU, ucp,
|
|
|
+ 3006 uok);
|
|
|
+ 3007 isStr := FALSE;
|
|
|
+ 3008 IF NOT uok THEN
|
|
|
+ 3009 SemError(234);
|
|
|
+ 3010 dt := SymTab.InvalidType
|
|
|
+ 3011 ELSIF isU THEN
|
|
|
+ 3012 (* one codepoint: a UCHAR;
|
|
|
+ 3013 LEN is 1, HIGH is 0 *)
|
|
|
+ 3014 dt := SymTab.UCharType();
|
|
|
+ 3015 QbeGen.IntStr(ucp, qd)
|
|
|
+ 3016 ELSE
|
|
|
+ 3017 dt := SymTab.NewUStr();
|
|
|
+ 3018 END;
|
|
|
+ 3019 dk := -1;
|
|
|
+ 3020 qn[0] := CHR(0); .) )
|
|
|
+ 3021 ")"
|
|
|
+ 3022 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3023 IF isHigh THEN AST.SetChild(astNode, 0,
|
|
|
+ 3024 AST.MakeLeaf(AST.NkIdent, "HIGH"))
|
|
|
+ 3025 ELSE AST.SetChild(astNode, 0,
|
|
|
+ 3026 AST.MakeLeaf(AST.NkIdent, "LEN")) END;
|
|
|
+ 3027 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3028 astCur := astNode; astIsLit := TRUE;
|
|
|
+ 3029 IF (dt # SymTab.InvalidType)
|
|
|
+ 3030 AND (SymTab.ClassOf(dt) = SymTab.ClUStr) THEN
|
|
|
+ 3031 (* UString: the count is
|
|
|
+ 3032 the descriptor header *)
|
|
|
+ 3033 t := SymTab.IntType();
|
|
|
+ 3034 QbeGen.CopyOp("@", q)
|
|
|
+ 3035 ELSIF (dt # SymTab.InvalidType)
|
|
|
+ 3036 AND (SymTab.ClassOf(dt) = SymTab.ClUChar) THEN
|
|
|
+ 3037 (* single UCHAR codepoint *)
|
|
|
+ 3038 IF isHigh THEN
|
|
|
+ 3039 QbeGen.CopyOp("0", qr)
|
|
|
+ 3040 ELSE
|
|
|
+ 3041 QbeGen.CopyOp("1", qr)
|
|
|
+ 3042 END;
|
|
|
+ 3043 t := SymTab.IntType();
|
|
|
+ 3044 QbeGen.CopyOp(qr, q)
|
|
|
+ 3045 ELSIF isStr THEN
|
|
|
+ 3046 (* fold: content length at
|
|
|
+ 3047 compile time *)
|
|
|
+ 3048 IF SymTab.StrLen(s) = 3 THEN
|
|
|
+ 3049 c1 := 1
|
|
|
+ 3050 ELSE
|
|
|
+ 3051 c1 :=
|
|
|
+ 3052 SymTab.StrLen(s) - 2
|
|
|
+ 3053 END;
|
|
|
+ 3054 IF isHigh THEN
|
|
|
+ 3055 DEC(c1)
|
|
|
+ 3056 END;
|
|
|
+ 3057 QbeGen.IntStr(c1, qr);
|
|
|
+ 3058 t := SymTab.IntType();
|
|
|
+ 3059 QbeGen.CopyOp(qr, q)
|
|
|
+ 3060 ELSIF dt = SymTab.InvalidType THEN
|
|
|
+ 3061 t := SymTab.InvalidType;
|
|
|
+ 3062 QbeGen.CopyOp("0", q)
|
|
|
+ 3063 ELSIF SymTab.ClassOf(dt) #
|
|
|
+ 3064 SymTab.ClArray THEN
|
|
|
+ 3065 SemError(217);
|
|
|
+ 3066 t := SymTab.InvalidType;
|
|
|
+ 3067 QbeGen.CopyOp("0", q)
|
|
|
+ 3068 ELSE
|
|
|
+ 3069 IF SymTab.IsOpenArray(dt) THEN
|
|
|
+ 3070 t := SymTab.IntType();
|
|
|
+ 3071 QbeGen.CopyOp("@", q)
|
|
|
+ 3072 ELSE
|
|
|
+ 3073 IF isHigh THEN
|
|
|
+ 3074 QbeGen.IntStr(
|
|
|
+ 3075 SymTab.ArrayHi(dt), qr)
|
|
|
+ 3076 ELSE
|
|
|
+ 3077 QbeGen.IntStr(VAL(
|
|
|
+ 3078 INTEGER,
|
|
|
+ 3079 SymTab.ArrayLen(dt)),
|
|
|
+ 3080 qr)
|
|
|
+ 3081 END;
|
|
|
+ 3082 t := SymTab.IntType();
|
|
|
+ 3083 QbeGen.CopyOp(qr, q)
|
|
|
+ 3084 END
|
|
|
+ 3085 END; .)
|
|
|
+ 3086 | ( "SIZE" | "TSIZE" ) "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
+ 3087 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3088 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "SIZE"));
|
|
|
+ 3089 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3090 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3091 (. IF dt = SymTab.InvalidType THEN
|
|
|
+ 3092 t := SymTab.InvalidType;
|
|
|
+ 3093 QbeGen.CopyOp("0", q)
|
|
|
+ 3094 ELSE
|
|
|
+ 3095 QbeGen.IntStr(VAL(INTEGER,
|
|
|
+ 3096 SymTab.ObjectSize(dt)), q);
|
|
|
+ 3097 t := SymTab.IntType()
|
|
|
+ 3098 END; .)
|
|
|
+ 3099 | ( "SHIFT" (. isMax := FALSE; .)
|
|
|
+ 3100 | "ROTATE" (. isMax := TRUE; .) )
|
|
|
+ 3101 "(" Expr<et, q> (. astArg2 := astCur; .) "," Expr<et2, q2> ")"
|
|
|
+ 3102 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3103 IF isMax THEN AST.SetChild(astNode, 0,
|
|
|
+ 3104 AST.MakeLeaf(AST.NkIdent, "ROTATE"))
|
|
|
+ 3105 ELSE AST.SetChild(astNode, 0,
|
|
|
+ 3106 AST.MakeLeaf(AST.NkIdent, "SHIFT")) END;
|
|
|
+ 3107 IF astArg2 # AST.NoNode THEN AST.SetChild(astNode, 1, astArg2) END;
|
|
|
+ 3108 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
+ 3109 astCur := astNode; astIsLit := TRUE;
|
|
|
+ 3110 (* set shift/rotate: isMax
|
|
|
+ 3111 doubles as "rotate" *)
|
|
|
+ 3112 IF (et # SymTab.InvalidType)
|
|
|
+ 3113 AND (SymTab.ClassOf(et) =
|
|
|
+ 3114 SymTab.ClSet) THEN
|
|
|
+ 3115 t := et;
|
|
|
+ 3116 QbeGen.CopyOp("@", q)
|
|
|
+ 3117 ELSE SemError(230);
|
|
|
+ 3118 t := SymTab.InvalidType;
|
|
|
+ 3119 QbeGen.CopyOp("0", q)
|
|
|
+ 3120 END; .)
|
|
|
+ 3121 | ( "MIN" (. isMax := FALSE; .)
|
|
|
+ 3122 | "MAX" (. isMax := TRUE; .) )
|
|
|
+ 3123 "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
+ 3124 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3125 IF isMax THEN AST.SetChild(astNode, 0,
|
|
|
+ 3126 AST.MakeLeaf(AST.NkIdent, "MAX"))
|
|
|
+ 3127 ELSE AST.SetChild(astNode, 0,
|
|
|
+ 3128 AST.MakeLeaf(AST.NkIdent, "MIN")) END;
|
|
|
+ 3129 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3130 astCur := astNode; astIsLit := TRUE;
|
|
|
+ 3131 IF (dt # SymTab.InvalidType)
|
|
|
+ 3132 AND (SymTab.ClassOf(dt) = SymTab.ClReal) THEN
|
|
|
+ 3133 (* REAL/LONGREAL: the
|
|
|
+ 3134 implementation bounds *)
|
|
|
+ 3135 IF isMax THEN
|
|
|
+ 3136 QbeGen.NormReal(
|
|
|
+ 3137 "3.402823e38", q)
|
|
|
+ 3138 ELSE QbeGen.NormReal(
|
|
|
+ 3139 "-3.402823e38", q)
|
|
|
+ 3140 END;
|
|
|
+ 3141 t := SymTab.RealType()
|
|
|
+ 3142 ELSIF (dt #
|
|
|
+ 3143 SymTab.InvalidType)
|
|
|
+ 3144 AND (SymTab.ClassOf(dt) =
|
|
|
+ 3145 SymTab.ClLong) THEN
|
|
|
+ 3146 IF isMax THEN
|
|
|
+ 3147 QbeGen.CopyOp(
|
|
|
+ 3148 "9223372036854775807", q)
|
|
|
+ 3149 ELSE QbeGen.CopyOp(
|
|
|
+ 3150 "-9223372036854775808", q)
|
|
|
+ 3151 END;
|
|
|
+ 3152 t := SymTab.LongType()
|
|
|
+ 3153 ELSIF SymTab.TypeBounds(dt, lo,
|
|
|
+ 3154 hi) THEN
|
|
|
+ 3155 IF isMax THEN
|
|
|
+ 3156 QbeGen.IntStr(hi, q)
|
|
|
+ 3157 ELSE QbeGen.IntStr(lo, q)
|
|
|
+ 3158 END;
|
|
|
+ 3159 t := SymTab.IntType()
|
|
|
+ 3160 ELSE SemError(230);
|
|
|
+ 3161 t := SymTab.InvalidType;
|
|
|
+ 3162 QbeGen.CopyOp("0", q)
|
|
|
+ 3163 END; .)
|
|
|
+ 3164 | "ADR" "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
+ 3165 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3166 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ADR"));
|
|
|
+ 3167 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3168 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3169 (. IF dt = SymTab.InvalidType THEN
|
|
|
+ 3170 t := SymTab.InvalidType;
|
|
|
+ 3171 QbeGen.CopyOp("0", q)
|
|
|
+ 3172 ELSE
|
|
|
+ 3173 IF sfx
|
|
|
+ 3174 OR (dk = SymTab.KindVar)
|
|
|
+ 3175 OR (dk = SymTab.KindParam) THEN
|
|
|
+ 3176 QbeGen.CopyOp("@", q)
|
|
|
+ 3177 ELSE SemError(230);
|
|
|
+ 3178 QbeGen.CopyOp("0", q)
|
|
|
+ 3179 END;
|
|
|
+ 3180 t := SymTab.AddrType()
|
|
|
+ 3181 END; .)
|
|
|
+ 3182 | "CHR" "(" Expr<et, q> ")"
|
|
|
+ 3183 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3184 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CHR"));
|
|
|
+ 3185 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3186 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3187 (. IF (et # SymTab.InvalidType)
|
|
|
+ 3188 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
+ 3189 SemError(211) END;
|
|
|
+ 3190 t := SymTab.CharType(); .)
|
|
|
+ 3191 | ( "ORD" | "ORDL" ) "(" Expr<et, q> ")"
|
|
|
+ 3192 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3193 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ORD"));
|
|
|
+ 3194 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3195 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3196 (. IF et # SymTab.InvalidType THEN
|
|
|
+ 3197 IF (SymTab.ClassOf(et) #
|
|
|
+ 3198 SymTab.ClChar)
|
|
|
+ 3199 AND (SymTab.ClassOf(et) #
|
|
|
+ 3200 SymTab.ClBool)
|
|
|
+ 3201 AND (SymTab.ClassOf(et) #
|
|
|
+ 3202 SymTab.ClEnum)
|
|
|
+ 3203 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
+ 3204 SemError(211) END
|
|
|
+ 3205 END;
|
|
|
+ 3206 t := SymTab.IntType(); .)
|
|
|
+ 3207 | "CAP" "(" Expr<et, q> ")"
|
|
|
+ 3208 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3209 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CAP"));
|
|
|
+ 3210 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3211 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3212 (. QbeGen.CopyOp("@", q);
|
|
|
+ 3213 t := SymTab.CharType(); .)
|
|
|
+ 3214 | "UCHR" "(" Expr<et, q> ")"
|
|
|
3215 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3216 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ABS"));
|
|
|
+ 3216 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "UCHR"));
|
|
|
3217 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
3218 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3219 (. IF (et # SymTab.InvalidType)
|
|
|
- 3220 AND NOT SymTab.IsIntFamily(et)
|
|
|
- 3221 AND (SymTab.ClassOf(et) #
|
|
|
- 3222 SymTab.ClReal) THEN
|
|
|
- 3223 SemError(211)
|
|
|
- 3224 ELSE QbeGen.CopyOp("@", q)
|
|
|
- 3225 END;
|
|
|
- 3226 t := et; .)
|
|
|
- 3227 | "VAL" "(" GetIdent<vn> (. astArg2 := AST.MakeLeaf(AST.NkIdent, vn); .) "," Expr<et, q> ")"
|
|
|
- 3228 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3229 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "VAL"));
|
|
|
- 3230 IF astArg2 # AST.NoNode THEN AST.SetChild(astNode, 1, astArg2) END;
|
|
|
- 3231 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
+ 3219 (. (* UCHR: the UCHAR constructor.
|
|
|
+ 3220 CHAR -> UCHAR (identity);
|
|
|
+ 3221 INTEGER familly -> UCHAR
|
|
|
+ 3222 (codepoint value). *)
|
|
|
+ 3223 IF (et # SymTab.InvalidType)
|
|
|
+ 3224 AND (SymTab.ClassOf(et) # SymTab.ClChar)
|
|
|
+ 3225 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
+ 3226 SemError(211) END;
|
|
|
+ 3227 t := SymTab.UCharType(); .)
|
|
|
+ 3228 | "CHR8" "(" Expr<et, q> ")"
|
|
|
+ 3229 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3230 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CHR8"));
|
|
|
+ 3231 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
3232 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3233 (. IF NOT SymTab.Lookup(vn) THEN
|
|
|
- 3234 SemError(201);
|
|
|
- 3235 t := SymTab.InvalidType
|
|
|
- 3236 ELSE vt := SymTab.SymType(vn);
|
|
|
- 3237 IF vt = SymTab.InvalidType THEN
|
|
|
- 3238 t := SymTab.InvalidType
|
|
|
- 3239 ELSIF et =
|
|
|
- 3240 SymTab.InvalidType THEN
|
|
|
- 3241 t := vt
|
|
|
- 3242 ELSE
|
|
|
- 3243 c1 := SymTab.ClassOf(et);
|
|
|
- 3244 c2 := SymTab.ClassOf(vt);
|
|
|
- 3245 IF (c1 = SymTab.ClInt)
|
|
|
- 3246 AND (c2 = SymTab.ClLong) THEN
|
|
|
- 3247 QbeGen.WidenLong(q, qa);
|
|
|
- 3248 QbeGen.CopyOp(qa, q);
|
|
|
- 3249 t := vt
|
|
|
- 3250 ELSIF (c1 = SymTab.ClLong)
|
|
|
- 3251 AND (c2 = SymTab.ClInt) THEN
|
|
|
- 3252 QbeGen.NarrowLong(q, qa);
|
|
|
- 3253 QbeGen.CopyOp(qa, q);
|
|
|
- 3254 t := vt
|
|
|
- 3255 ELSIF (c1 = SymTab.ClInt)
|
|
|
- 3256 AND (c2 = SymTab.ClReal) THEN
|
|
|
- 3257 QbeGen.ConvIR(q, qa);
|
|
|
- 3258 QbeGen.CopyOp(qa, q);
|
|
|
- 3259 t := vt
|
|
|
- 3260 ELSIF (c1 = SymTab.ClLong)
|
|
|
- 3261 AND (c2 = SymTab.ClReal) THEN
|
|
|
- 3262 QbeGen.ConvLR(q, qa);
|
|
|
- 3263 QbeGen.CopyOp(qa, q);
|
|
|
- 3264 t := vt
|
|
|
- 3265 ELSIF (c1 = SymTab.ClReal)
|
|
|
- 3266 AND (c2 = SymTab.ClInt) THEN
|
|
|
- 3267 QbeGen.ConvRI(q, qa);
|
|
|
- 3268 QbeGen.CopyOp(qa, q);
|
|
|
- 3269 t := vt
|
|
|
- 3270 ELSIF (c1 = SymTab.ClReal)
|
|
|
- 3271 AND (c2 = SymTab.ClLong) THEN
|
|
|
- 3272 QbeGen.ConvRL(q, qa);
|
|
|
- 3273 QbeGen.CopyOp(qa, q);
|
|
|
- 3274 t := vt
|
|
|
- 3275 ELSIF ((c1 = SymTab.ClInt)
|
|
|
- 3276 OR (c1 =
|
|
|
- 3277 SymTab.ClChar)
|
|
|
- 3278 OR (c1 =
|
|
|
- 3279 SymTab.ClBool)
|
|
|
- 3280 OR (c1 =
|
|
|
- 3281 SymTab.ClEnum))
|
|
|
- 3282 AND ((c2 = SymTab.ClInt)
|
|
|
- 3283 OR (c2 =
|
|
|
- 3284 SymTab.ClChar)
|
|
|
- 3285 OR (c2 =
|
|
|
- 3286 SymTab.ClBool)
|
|
|
- 3287 OR (c2 =
|
|
|
- 3288 SymTab.ClEnum)) THEN
|
|
|
+ 3233 (. IF (et # SymTab.InvalidType)
|
|
|
+ 3234 AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
|
|
|
+ 3235 SemError(211) END;
|
|
|
+ 3236 t := SymTab.CharType(); .)
|
|
|
+ 3237 | "UORD" "(" Expr<et, q> ")"
|
|
|
+ 3238 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3239 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "UORD"));
|
|
|
+ 3240 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3241 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3242 (. (* UORD(u): the codepoint as a
|
|
|
+ 3243 32-bit ordinal (INTEGER),
|
|
|
+ 3244 cf. ORD for CHAR. *)
|
|
|
+ 3245 IF (et # SymTab.InvalidType)
|
|
|
+ 3246 AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
|
|
|
+ 3247 SemError(211) END;
|
|
|
+ 3248 t := SymTab.IntType(); .)
|
|
|
+ 3249 | "ABS" "(" Expr<et, q> ")"
|
|
|
+ 3250 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3251 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ABS"));
|
|
|
+ 3252 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3253 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3254 (. IF (et # SymTab.InvalidType)
|
|
|
+ 3255 AND NOT SymTab.IsIntFamily(et)
|
|
|
+ 3256 AND (SymTab.ClassOf(et) #
|
|
|
+ 3257 SymTab.ClReal) THEN
|
|
|
+ 3258 SemError(211)
|
|
|
+ 3259 ELSE QbeGen.CopyOp("@", q)
|
|
|
+ 3260 END;
|
|
|
+ 3261 t := et; .)
|
|
|
+ 3262 | "VAL" "(" GetIdent<vn> (. astArg2 := AST.MakeLeaf(AST.NkIdent, vn); .) "," Expr<et, q> ")"
|
|
|
+ 3263 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3264 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "VAL"));
|
|
|
+ 3265 IF astArg2 # AST.NoNode THEN AST.SetChild(astNode, 1, astArg2) END;
|
|
|
+ 3266 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
+ 3267 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3268 (. IF NOT SymTab.Lookup(vn) THEN
|
|
|
+ 3269 SemError(201);
|
|
|
+ 3270 t := SymTab.InvalidType
|
|
|
+ 3271 ELSE vt := SymTab.SymType(vn);
|
|
|
+ 3272 IF vt = SymTab.InvalidType THEN
|
|
|
+ 3273 t := SymTab.InvalidType
|
|
|
+ 3274 ELSIF et =
|
|
|
+ 3275 SymTab.InvalidType THEN
|
|
|
+ 3276 t := vt
|
|
|
+ 3277 ELSE
|
|
|
+ 3278 c1 := SymTab.ClassOf(et);
|
|
|
+ 3279 c2 := SymTab.ClassOf(vt);
|
|
|
+ 3280 IF (c1 = SymTab.ClInt)
|
|
|
+ 3281 AND (c2 = SymTab.ClLong) THEN
|
|
|
+ 3282 QbeGen.WidenLong(q, qa);
|
|
|
+ 3283 QbeGen.CopyOp(qa, q);
|
|
|
+ 3284 t := vt
|
|
|
+ 3285 ELSIF (c1 = SymTab.ClLong)
|
|
|
+ 3286 AND (c2 = SymTab.ClInt) THEN
|
|
|
+ 3287 QbeGen.NarrowLong(q, qa);
|
|
|
+ 3288 QbeGen.CopyOp(qa, q);
|
|
|
3289 t := vt
|
|
|
- 3290 ELSIF (c1 = SymTab.ClPtr)
|
|
|
- 3291 AND (c2 = SymTab.ClPtr) THEN
|
|
|
- 3292 t := vt
|
|
|
- 3293 ELSIF (c1 = SymTab.ClReal)
|
|
|
- 3294 AND (c2 = SymTab.ClReal) THEN
|
|
|
- 3295 t := vt
|
|
|
- 3296 ELSE SemError(230);
|
|
|
- 3297 t := SymTab.InvalidType
|
|
|
- 3298 END
|
|
|
- 3299 END
|
|
|
- 3300 END; .)
|
|
|
- 3301 | "(" Expr<et, q> ")" (. t := et; astIsLit := TRUE; .)
|
|
|
- 3302 | SetLit<st, sq> (. astIsLit := TRUE; t := st;
|
|
|
- 3303 QbeGen.CopyOp(sq, q); .)
|
|
|
- 3304 | ( "NOT" | "~" ) Fact<t2, q2> (. astNot := astCur;
|
|
|
- 3305 IF SymTab.BoolCheck(t2) THEN
|
|
|
- 3306 t := SymTab.BoolType()
|
|
|
- 3307 ELSE SemError(212);
|
|
|
- 3308 t := SymTab.InvalidType END;
|
|
|
- 3309 IF t # SymTab.InvalidType THEN
|
|
|
- 3310 QbeGen.CopyOp("@", q)
|
|
|
- 3311 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 3312 END;
|
|
|
- 3313 astIsLit := TRUE;
|
|
|
- 3314 astCur := AST.MakeUn(
|
|
|
- 3315 AST.NkUnary, AST.OpNot, astNot); .)
|
|
|
- 3316 )
|
|
|
- 3317 (. IF NOT astIsLit THEN astCur := AST.NoNode END; .)
|
|
|
- 3318 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
- 3319 (* Set literals are SET OF [0..255] (8 words); elements validated
|
|
|
- 3320 0..255 statically when foldable (222 otherwise), runtime trap
|
|
|
- 3321 for computed elements. Ranges always lower via SetRange. *)
|
|
|
- 3322 SetLit<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 3323 (. VAR astNode: AST.Node; .)
|
|
|
- 3324 = "{" (. t := SymTab.NewSet(
|
|
|
- 3325 SymTab.NewSubR(0, 255));
|
|
|
- 3326 astNode := AST.MakeNode(AST.NkSetLit);
|
|
|
- 3327 QbeGen.NewSetTemp(8, q);
|
|
|
- 3328 QbeGen.SetZero(q, 8); .)
|
|
|
- 3329 [ SetElem<t, q, astNode> { "," SetElem<t, q, astNode> } ]
|
|
|
- 3330 "}" (. astCur := astNode; .) .
|
|
|
- 3331 (* Typed brace constructor: TypeName{ elems } — BITSET{0} (a set)
|
|
|
- 3332 or ArrayName{...} (an array constructor, GNU Modula-2). The
|
|
|
- 3333 declared type sets the width (set) or element type (array). *)
|
|
|
- 3334 TypedBraceLit<vt: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 3335 (. VAR nw: CARDINAL;
|
|
|
- 3336 astNode, astTail: AST.Node;
|
|
|
- 3337 savedCls: INTEGER; .)
|
|
|
- 3338 = "{" (. savedCls := braceCls;
|
|
|
- 3339 astNode := AST.MakeNode(AST.NkBraceLit);
|
|
|
- 3340 AST.SetTy(astNode, vt);
|
|
|
- 3341 astTail := astNode;
|
|
|
- 3342 IF vt = SymTab.InvalidType THEN
|
|
|
- 3343 braceCls := -1
|
|
|
- 3344 ELSE braceCls :=
|
|
|
- 3345 SymTab.ClassOf(vt)
|
|
|
- 3346 END;
|
|
|
- 3347 IF braceCls = SymTab.ClSet THEN
|
|
|
- 3348 IF vt = SymTab.InvalidType THEN
|
|
|
- 3349 nw := 8
|
|
|
- 3350 ELSE nw := SymTab.SetWords(vt);
|
|
|
- 3351 IF nw = 0 THEN nw := 8 END
|
|
|
- 3352 END;
|
|
|
- 3353 QbeGen.NewSetTemp(nw, q);
|
|
|
- 3354 QbeGen.SetZero(q, nw)
|
|
|
- 3355 ELSIF (braceCls =
|
|
|
- 3356 SymTab.ClArray)
|
|
|
- 3357 OR (braceCls =
|
|
|
- 3358 SymTab.ClRecord)
|
|
|
- 3359 OR (braceCls =
|
|
|
- 3360 SymTab.ClClass) THEN
|
|
|
- 3361 QbeGen.CtorBegin(vt)
|
|
|
- 3362 ELSE
|
|
|
- 3363 IF vt # SymTab.InvalidType THEN
|
|
|
- 3364 SemError(230) END;
|
|
|
- 3365 braceCls := -1
|
|
|
- 3366 END; .)
|
|
|
- 3367 [ BraceElem<vt, q, astNode, astTail>
|
|
|
- 3368 { "," BraceElem<vt, q, astNode, astTail> } ]
|
|
|
- 3369 "}" (. IF (braceCls = SymTab.ClArray)
|
|
|
- 3370 OR (braceCls =
|
|
|
- 3371 SymTab.ClRecord)
|
|
|
- 3372 OR (braceCls =
|
|
|
- 3373 SymTab.ClClass) THEN
|
|
|
- 3374 QbeGen.CtorEnd(q)
|
|
|
- 3375 ELSIF braceCls # SymTab.ClSet THEN
|
|
|
- 3376 QbeGen.CopyOp("0", q)
|
|
|
- 3377 END;
|
|
|
- 3378 braceCls := savedCls; .)
|
|
|
- 3379 (. astCur := astNode; .) .
|
|
|
- 3380 BraceElem<vt: SymTab.TypeIndex; VAR sq: QbeGen.QVal;
|
|
|
- 3381 VAR node, tail: AST.Node>
|
|
|
- 3382 (. VAR et, et2: SymTab.TypeIndex;
|
|
|
- 3383 qe, q2: QbeGen.QVal;
|
|
|
- 3384 v, v2, reps, k: INTEGER;
|
|
|
- 3385 elem: SymTab.TypeIndex;
|
|
|
- 3386 lo: INTEGER;
|
|
|
- 3387 span: CARDINAL;
|
|
|
- 3388 cl, cl2: INTEGER;
|
|
|
- 3389 hasR, hasB: BOOLEAN;
|
|
|
- 3390 astEl: AST.Node; .)
|
|
|
- 3391 = (. hasR := FALSE; hasB := FALSE;
|
|
|
- 3392 reps := 1; .)
|
|
|
- 3393 Expr<et, qe> (. astEl := astCur; .)
|
|
|
- 3394 [ ".." Expr<et2, q2> (. astEl := AST.MakeBin(
|
|
|
- 3395 AST.NkSubrange, 0, astEl, astCur);
|
|
|
- 3396 hasR := TRUE; .) ]
|
|
|
- 3397 [ "BY" Expr<et2, q2> (. hasB := TRUE; .) ]
|
|
|
- 3398 (. IF braceCls = SymTab.ClSet THEN
|
|
|
- 3399 IF hasB THEN SemError(230) END;
|
|
|
- 3400 lo := SymTab.SetBaseLo(vt);
|
|
|
- 3401 span := SymTab.SetCount(vt);
|
|
|
- 3402 IF (et = SymTab.InvalidType)
|
|
|
- 3403 OR (hasR AND (et2 =
|
|
|
- 3404 SymTab.InvalidType)) THEN
|
|
|
- 3405 ELSE cl :=
|
|
|
- 3406 SymTab.ClassOf(et);
|
|
|
- 3407 IF hasR THEN
|
|
|
- 3408 cl2 :=
|
|
|
- 3409 SymTab.ClassOf(et2)
|
|
|
- 3410 ELSE cl2 := SymTab.ClInt
|
|
|
- 3411 END;
|
|
|
- 3412 IF NOT SymTab.SetElemClassOk(cl)
|
|
|
- 3413 OR (hasR AND NOT
|
|
|
- 3414 SymTab.SetElemClassOk(cl2))
|
|
|
- 3415 THEN
|
|
|
- 3416 SemError(222)
|
|
|
- 3417 ELSIF hasR
|
|
|
- 3418 AND SymTab.ConstInt(qe, v)
|
|
|
- 3419 AND SymTab.ConstInt(q2,
|
|
|
- 3420 v2)
|
|
|
- 3421 AND ((v < lo)
|
|
|
- 3422 OR (v2 < lo)
|
|
|
- 3423 OR (v >= lo +
|
|
|
- 3424 VAL(INTEGER, span))
|
|
|
- 3425 OR (v2 >= lo +
|
|
|
- 3426 VAL(INTEGER, span))
|
|
|
- 3427 OR (v > v2)) THEN
|
|
|
- 3428 SemError(222)
|
|
|
- 3429 ELSIF hasR THEN
|
|
|
- 3430 QbeGen.SetRange(sq, qe, q2,
|
|
|
- 3431 lo, span)
|
|
|
- 3432 ELSIF SymTab.ConstInt(qe,
|
|
|
- 3433 v)
|
|
|
- 3434 AND ((v < lo)
|
|
|
- 3435 OR (v >= lo +
|
|
|
- 3436 VAL(INTEGER,
|
|
|
- 3437 span))) THEN
|
|
|
- 3438 SemError(222)
|
|
|
- 3439 ELSE QbeGen.SetBit(sq, qe,
|
|
|
- 3440 lo, span)
|
|
|
- 3441 END
|
|
|
- 3442 END
|
|
|
- 3443 ELSIF (braceCls = SymTab.ClArray)
|
|
|
- 3444 OR (braceCls =
|
|
|
- 3445 SymTab.ClRecord)
|
|
|
- 3446 OR (braceCls =
|
|
|
- 3447 SymTab.ClClass) THEN
|
|
|
- 3448 IF hasR THEN SemError(230) END;
|
|
|
- 3449 reps := 1;
|
|
|
- 3450 IF hasB THEN
|
|
|
- 3451 IF SymTab.ConstInt(q2, v2)
|
|
|
- 3452 AND (v2 >= 1) THEN
|
|
|
- 3453 reps := v2
|
|
|
- 3454 ELSE SemError(230)
|
|
|
- 3455 END
|
|
|
- 3456 END;
|
|
|
- 3457 k := 0;
|
|
|
- 3458 WHILE k < reps DO
|
|
|
- 3459 QbeGen.CtorElem(qe);
|
|
|
- 3460 INC(k)
|
|
|
- 3461 END
|
|
|
- 3462 END; .)
|
|
|
- 3463 (. (* the BY form repeats the
|
|
|
- 3464 element; keep the AST in
|
|
|
- 3465 step with CtorElem *)
|
|
|
- 3466 k := 0;
|
|
|
- 3467 WHILE k < reps DO
|
|
|
- 3468 AstAppend(AST.NkBlock,
|
|
|
- 3469 node, tail, astEl);
|
|
|
- 3470 INC(k)
|
|
|
- 3471 END; .) .
|
|
|
- 3472 SetElem<st: SymTab.TypeIndex; sq: QbeGen.QVal; node: AST.Node> (. VAR et, et2: SymTab.TypeIndex;
|
|
|
- 3473 qe, q2: QbeGen.QVal;
|
|
|
- 3474 v, v2: INTEGER;
|
|
|
- 3475 lo: INTEGER;
|
|
|
- 3476 span: CARDINAL;
|
|
|
- 3477 cl, cl2: INTEGER;
|
|
|
- 3478 hasR: BOOLEAN;
|
|
|
- 3479 astEl: AST.Node; .)
|
|
|
- 3480 = (. hasR := FALSE; .)
|
|
|
- 3481 Expr<et, qe> (. astEl := astCur; .)
|
|
|
- 3482 [ ".." Expr<et2, q2> (. astEl := AST.MakeBin(
|
|
|
- 3483 AST.NkSubrange, 0, astEl, astCur);
|
|
|
- 3484 hasR := TRUE; .) ]
|
|
|
- 3485 (. lo := SymTab.SetBaseLo(st);
|
|
|
- 3486 span := SymTab.SetCount(st);
|
|
|
- 3487 IF (et = SymTab.InvalidType)
|
|
|
- 3488 OR (hasR AND (et2 =
|
|
|
- 3489 SymTab.InvalidType)) THEN
|
|
|
- 3490 ELSE cl :=
|
|
|
- 3491 SymTab.ClassOf(et);
|
|
|
- 3492 IF hasR THEN
|
|
|
- 3493 cl2 :=
|
|
|
- 3494 SymTab.ClassOf(et2)
|
|
|
- 3495 ELSE cl2 := SymTab.ClInt
|
|
|
- 3496 END;
|
|
|
- 3497 IF NOT SymTab.SetElemClassOk(cl)
|
|
|
- 3498 OR (hasR AND NOT
|
|
|
- 3499 SymTab.SetElemClassOk(cl2))
|
|
|
- 3500 THEN
|
|
|
- 3501 SemError(222)
|
|
|
- 3502 ELSIF hasR
|
|
|
- 3503 AND SymTab.ConstInt(qe, v)
|
|
|
- 3504 AND SymTab.ConstInt(q2,
|
|
|
- 3505 v2)
|
|
|
- 3506 AND ((v < lo)
|
|
|
- 3507 OR (v2 < lo)
|
|
|
- 3508 OR (v >= lo +
|
|
|
- 3509 VAL(INTEGER, span))
|
|
|
- 3510 OR (v2 >= lo +
|
|
|
- 3511 VAL(INTEGER, span))
|
|
|
- 3512 OR (v > v2)) THEN
|
|
|
- 3513 SemError(222)
|
|
|
- 3514 ELSIF hasR THEN
|
|
|
- 3515 QbeGen.SetRange(sq, qe, q2,
|
|
|
- 3516 lo, span)
|
|
|
- 3517 ELSIF SymTab.ConstInt(qe,
|
|
|
- 3518 v)
|
|
|
- 3519 AND ((v < lo)
|
|
|
- 3520 OR (v >= lo +
|
|
|
- 3521 VAL(INTEGER,
|
|
|
- 3522 span))) THEN
|
|
|
- 3523 SemError(222)
|
|
|
- 3524 ELSE QbeGen.SetBit(sq, qe,
|
|
|
- 3525 lo, span)
|
|
|
- 3526 END
|
|
|
- 3527 END; .)
|
|
|
- 3528 (. AST.SetChild(node,
|
|
|
- 3529 AST.NChild(node), astEl); .) .
|
|
|
- 3530 GetIdent<VAR n: SymTab.Name>
|
|
|
- 3531 = ident (. LexName(n); .) .
|
|
|
- 3532
|
|
|
- 3533 END M2.
|
|
|
+ 3290 ELSIF (c1 = SymTab.ClInt)
|
|
|
+ 3291 AND (c2 = SymTab.ClReal) THEN
|
|
|
+ 3292 QbeGen.ConvIR(q, qa);
|
|
|
+ 3293 QbeGen.CopyOp(qa, q);
|
|
|
+ 3294 t := vt
|
|
|
+ 3295 ELSIF (c1 = SymTab.ClLong)
|
|
|
+ 3296 AND (c2 = SymTab.ClReal) THEN
|
|
|
+ 3297 QbeGen.ConvLR(q, qa);
|
|
|
+ 3298 QbeGen.CopyOp(qa, q);
|
|
|
+ 3299 t := vt
|
|
|
+ 3300 ELSIF (c1 = SymTab.ClReal)
|
|
|
+ 3301 AND (c2 = SymTab.ClInt) THEN
|
|
|
+ 3302 QbeGen.ConvRI(q, qa);
|
|
|
+ 3303 QbeGen.CopyOp(qa, q);
|
|
|
+ 3304 t := vt
|
|
|
+ 3305 ELSIF (c1 = SymTab.ClReal)
|
|
|
+ 3306 AND (c2 = SymTab.ClLong) THEN
|
|
|
+ 3307 QbeGen.ConvRL(q, qa);
|
|
|
+ 3308 QbeGen.CopyOp(qa, q);
|
|
|
+ 3309 t := vt
|
|
|
+ 3310 ELSIF ((c1 = SymTab.ClInt)
|
|
|
+ 3311 OR (c1 =
|
|
|
+ 3312 SymTab.ClChar)
|
|
|
+ 3313 OR (c1 =
|
|
|
+ 3314 SymTab.ClBool)
|
|
|
+ 3315 OR (c1 =
|
|
|
+ 3316 SymTab.ClEnum))
|
|
|
+ 3317 AND ((c2 = SymTab.ClInt)
|
|
|
+ 3318 OR (c2 =
|
|
|
+ 3319 SymTab.ClChar)
|
|
|
+ 3320 OR (c2 =
|
|
|
+ 3321 SymTab.ClBool)
|
|
|
+ 3322 OR (c2 =
|
|
|
+ 3323 SymTab.ClEnum)) THEN
|
|
|
+ 3324 t := vt
|
|
|
+ 3325 ELSIF (c1 = SymTab.ClPtr)
|
|
|
+ 3326 AND (c2 = SymTab.ClPtr) THEN
|
|
|
+ 3327 t := vt
|
|
|
+ 3328 ELSIF (c1 = SymTab.ClReal)
|
|
|
+ 3329 AND (c2 = SymTab.ClReal) THEN
|
|
|
+ 3330 t := vt
|
|
|
+ 3331 ELSE SemError(230);
|
|
|
+ 3332 t := SymTab.InvalidType
|
|
|
+ 3333 END
|
|
|
+ 3334 END
|
|
|
+ 3335 END; .)
|
|
|
+ 3336 | "(" Expr<et, q> ")" (. t := et; astIsLit := TRUE; .)
|
|
|
+ 3337 | SetLit<st, sq> (. astIsLit := TRUE; t := st;
|
|
|
+ 3338 QbeGen.CopyOp(sq, q); .)
|
|
|
+ 3339 | ( "NOT" | "~" ) Fact<t2, q2> (. astNot := astCur;
|
|
|
+ 3340 IF SymTab.BoolCheck(t2) THEN
|
|
|
+ 3341 t := SymTab.BoolType()
|
|
|
+ 3342 ELSE SemError(212);
|
|
|
+ 3343 t := SymTab.InvalidType END;
|
|
|
+ 3344 IF t # SymTab.InvalidType THEN
|
|
|
+ 3345 QbeGen.CopyOp("@", q)
|
|
|
+ 3346 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 3347 END;
|
|
|
+ 3348 astIsLit := TRUE;
|
|
|
+ 3349 astCur := AST.MakeUn(
|
|
|
+ 3350 AST.NkUnary, AST.OpNot, astNot); .)
|
|
|
+ 3351 )
|
|
|
+ 3352 (. IF NOT astIsLit THEN astCur := AST.NoNode END; .)
|
|
|
+ 3353 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
+ 3354 (* Set literals are SET OF [0..255] (8 words); elements validated
|
|
|
+ 3355 0..255 statically when foldable (222 otherwise), runtime trap
|
|
|
+ 3356 for computed elements. Ranges always lower via SetRange. *)
|
|
|
+ 3357 SetLit<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 3358 (. VAR astNode: AST.Node; .)
|
|
|
+ 3359 = "{" (. t := SymTab.NewSet(
|
|
|
+ 3360 SymTab.NewSubR(0, 255));
|
|
|
+ 3361 astNode := AST.MakeNode(AST.NkSetLit);
|
|
|
+ 3362 QbeGen.NewSetTemp(8, q);
|
|
|
+ 3363 QbeGen.SetZero(q, 8); .)
|
|
|
+ 3364 [ SetElem<t, q, astNode> { "," SetElem<t, q, astNode> } ]
|
|
|
+ 3365 "}" (. astCur := astNode; .) .
|
|
|
+ 3366 (* Typed brace constructor: TypeName{ elems } — BITSET{0} (a set)
|
|
|
+ 3367 or ArrayName{...} (an array constructor, GNU Modula-2). The
|
|
|
+ 3368 declared type sets the width (set) or element type (array). *)
|
|
|
+ 3369 TypedBraceLit<vt: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 3370 (. VAR nw: CARDINAL;
|
|
|
+ 3371 astNode, astTail: AST.Node;
|
|
|
+ 3372 savedCls: INTEGER; .)
|
|
|
+ 3373 = "{" (. savedCls := braceCls;
|
|
|
+ 3374 astNode := AST.MakeNode(AST.NkBraceLit);
|
|
|
+ 3375 AST.SetTy(astNode, vt);
|
|
|
+ 3376 astTail := astNode;
|
|
|
+ 3377 IF vt = SymTab.InvalidType THEN
|
|
|
+ 3378 braceCls := -1
|
|
|
+ 3379 ELSE braceCls :=
|
|
|
+ 3380 SymTab.ClassOf(vt)
|
|
|
+ 3381 END;
|
|
|
+ 3382 IF braceCls = SymTab.ClSet THEN
|
|
|
+ 3383 IF vt = SymTab.InvalidType THEN
|
|
|
+ 3384 nw := 8
|
|
|
+ 3385 ELSE nw := SymTab.SetWords(vt);
|
|
|
+ 3386 IF nw = 0 THEN nw := 8 END
|
|
|
+ 3387 END;
|
|
|
+ 3388 QbeGen.NewSetTemp(nw, q);
|
|
|
+ 3389 QbeGen.SetZero(q, nw)
|
|
|
+ 3390 ELSIF (braceCls =
|
|
|
+ 3391 SymTab.ClArray)
|
|
|
+ 3392 OR (braceCls =
|
|
|
+ 3393 SymTab.ClRecord)
|
|
|
+ 3394 OR (braceCls =
|
|
|
+ 3395 SymTab.ClClass) THEN
|
|
|
+ 3396 QbeGen.CtorBegin(vt)
|
|
|
+ 3397 ELSE
|
|
|
+ 3398 IF vt # SymTab.InvalidType THEN
|
|
|
+ 3399 SemError(230) END;
|
|
|
+ 3400 braceCls := -1
|
|
|
+ 3401 END; .)
|
|
|
+ 3402 [ BraceElem<vt, q, astNode, astTail>
|
|
|
+ 3403 { "," BraceElem<vt, q, astNode, astTail> } ]
|
|
|
+ 3404 "}" (. IF (braceCls = SymTab.ClArray)
|
|
|
+ 3405 OR (braceCls =
|
|
|
+ 3406 SymTab.ClRecord)
|
|
|
+ 3407 OR (braceCls =
|
|
|
+ 3408 SymTab.ClClass) THEN
|
|
|
+ 3409 QbeGen.CtorEnd(q)
|
|
|
+ 3410 ELSIF braceCls # SymTab.ClSet THEN
|
|
|
+ 3411 QbeGen.CopyOp("0", q)
|
|
|
+ 3412 END;
|
|
|
+ 3413 braceCls := savedCls; .)
|
|
|
+ 3414 (. astCur := astNode; .) .
|
|
|
+ 3415 BraceElem<vt: SymTab.TypeIndex; VAR sq: QbeGen.QVal;
|
|
|
+ 3416 VAR node, tail: AST.Node>
|
|
|
+ 3417 (. VAR et, et2: SymTab.TypeIndex;
|
|
|
+ 3418 qe, q2: QbeGen.QVal;
|
|
|
+ 3419 v, v2, reps, k: INTEGER;
|
|
|
+ 3420 elem: SymTab.TypeIndex;
|
|
|
+ 3421 lo: INTEGER;
|
|
|
+ 3422 span: CARDINAL;
|
|
|
+ 3423 cl, cl2: INTEGER;
|
|
|
+ 3424 hasR, hasB: BOOLEAN;
|
|
|
+ 3425 astEl: AST.Node; .)
|
|
|
+ 3426 = (. hasR := FALSE; hasB := FALSE;
|
|
|
+ 3427 reps := 1; .)
|
|
|
+ 3428 Expr<et, qe> (. astEl := astCur; .)
|
|
|
+ 3429 [ ".." Expr<et2, q2> (. astEl := AST.MakeBin(
|
|
|
+ 3430 AST.NkSubrange, 0, astEl, astCur);
|
|
|
+ 3431 hasR := TRUE; .) ]
|
|
|
+ 3432 [ "BY" Expr<et2, q2> (. hasB := TRUE; .) ]
|
|
|
+ 3433 (. IF braceCls = SymTab.ClSet THEN
|
|
|
+ 3434 IF hasB THEN SemError(230) END;
|
|
|
+ 3435 lo := SymTab.SetBaseLo(vt);
|
|
|
+ 3436 span := SymTab.SetCount(vt);
|
|
|
+ 3437 IF (et = SymTab.InvalidType)
|
|
|
+ 3438 OR (hasR AND (et2 =
|
|
|
+ 3439 SymTab.InvalidType)) THEN
|
|
|
+ 3440 ELSE cl :=
|
|
|
+ 3441 SymTab.ClassOf(et);
|
|
|
+ 3442 IF hasR THEN
|
|
|
+ 3443 cl2 :=
|
|
|
+ 3444 SymTab.ClassOf(et2)
|
|
|
+ 3445 ELSE cl2 := SymTab.ClInt
|
|
|
+ 3446 END;
|
|
|
+ 3447 IF NOT SymTab.SetElemClassOk(cl)
|
|
|
+ 3448 OR (hasR AND NOT
|
|
|
+ 3449 SymTab.SetElemClassOk(cl2))
|
|
|
+ 3450 THEN
|
|
|
+ 3451 SemError(222)
|
|
|
+ 3452 ELSIF hasR
|
|
|
+ 3453 AND SymTab.ConstInt(qe, v)
|
|
|
+ 3454 AND SymTab.ConstInt(q2,
|
|
|
+ 3455 v2)
|
|
|
+ 3456 AND ((v < lo)
|
|
|
+ 3457 OR (v2 < lo)
|
|
|
+ 3458 OR (v >= lo +
|
|
|
+ 3459 VAL(INTEGER, span))
|
|
|
+ 3460 OR (v2 >= lo +
|
|
|
+ 3461 VAL(INTEGER, span))
|
|
|
+ 3462 OR (v > v2)) THEN
|
|
|
+ 3463 SemError(222)
|
|
|
+ 3464 ELSIF hasR THEN
|
|
|
+ 3465 QbeGen.SetRange(sq, qe, q2,
|
|
|
+ 3466 lo, span)
|
|
|
+ 3467 ELSIF SymTab.ConstInt(qe,
|
|
|
+ 3468 v)
|
|
|
+ 3469 AND ((v < lo)
|
|
|
+ 3470 OR (v >= lo +
|
|
|
+ 3471 VAL(INTEGER,
|
|
|
+ 3472 span))) THEN
|
|
|
+ 3473 SemError(222)
|
|
|
+ 3474 ELSE QbeGen.SetBit(sq, qe,
|
|
|
+ 3475 lo, span)
|
|
|
+ 3476 END
|
|
|
+ 3477 END
|
|
|
+ 3478 ELSIF (braceCls = SymTab.ClArray)
|
|
|
+ 3479 OR (braceCls =
|
|
|
+ 3480 SymTab.ClRecord)
|
|
|
+ 3481 OR (braceCls =
|
|
|
+ 3482 SymTab.ClClass) THEN
|
|
|
+ 3483 IF hasR THEN SemError(230) END;
|
|
|
+ 3484 reps := 1;
|
|
|
+ 3485 IF hasB THEN
|
|
|
+ 3486 IF SymTab.ConstInt(q2, v2)
|
|
|
+ 3487 AND (v2 >= 1) THEN
|
|
|
+ 3488 reps := v2
|
|
|
+ 3489 ELSE SemError(230)
|
|
|
+ 3490 END
|
|
|
+ 3491 END;
|
|
|
+ 3492 k := 0;
|
|
|
+ 3493 WHILE k < reps DO
|
|
|
+ 3494 QbeGen.CtorElem(qe);
|
|
|
+ 3495 INC(k)
|
|
|
+ 3496 END
|
|
|
+ 3497 END; .)
|
|
|
+ 3498 (. (* the BY form repeats the
|
|
|
+ 3499 element; keep the AST in
|
|
|
+ 3500 step with CtorElem *)
|
|
|
+ 3501 k := 0;
|
|
|
+ 3502 WHILE k < reps DO
|
|
|
+ 3503 AstAppend(AST.NkBlock,
|
|
|
+ 3504 node, tail, astEl);
|
|
|
+ 3505 INC(k)
|
|
|
+ 3506 END; .) .
|
|
|
+ 3507 SetElem<st: SymTab.TypeIndex; sq: QbeGen.QVal; node: AST.Node> (. VAR et, et2: SymTab.TypeIndex;
|
|
|
+ 3508 qe, q2: QbeGen.QVal;
|
|
|
+ 3509 v, v2: INTEGER;
|
|
|
+ 3510 lo: INTEGER;
|
|
|
+ 3511 span: CARDINAL;
|
|
|
+ 3512 cl, cl2: INTEGER;
|
|
|
+ 3513 hasR: BOOLEAN;
|
|
|
+ 3514 astEl: AST.Node; .)
|
|
|
+ 3515 = (. hasR := FALSE; .)
|
|
|
+ 3516 Expr<et, qe> (. astEl := astCur; .)
|
|
|
+ 3517 [ ".." Expr<et2, q2> (. astEl := AST.MakeBin(
|
|
|
+ 3518 AST.NkSubrange, 0, astEl, astCur);
|
|
|
+ 3519 hasR := TRUE; .) ]
|
|
|
+ 3520 (. lo := SymTab.SetBaseLo(st);
|
|
|
+ 3521 span := SymTab.SetCount(st);
|
|
|
+ 3522 IF (et = SymTab.InvalidType)
|
|
|
+ 3523 OR (hasR AND (et2 =
|
|
|
+ 3524 SymTab.InvalidType)) THEN
|
|
|
+ 3525 ELSE cl :=
|
|
|
+ 3526 SymTab.ClassOf(et);
|
|
|
+ 3527 IF hasR THEN
|
|
|
+ 3528 cl2 :=
|
|
|
+ 3529 SymTab.ClassOf(et2)
|
|
|
+ 3530 ELSE cl2 := SymTab.ClInt
|
|
|
+ 3531 END;
|
|
|
+ 3532 IF NOT SymTab.SetElemClassOk(cl)
|
|
|
+ 3533 OR (hasR AND NOT
|
|
|
+ 3534 SymTab.SetElemClassOk(cl2))
|
|
|
+ 3535 THEN
|
|
|
+ 3536 SemError(222)
|
|
|
+ 3537 ELSIF hasR
|
|
|
+ 3538 AND SymTab.ConstInt(qe, v)
|
|
|
+ 3539 AND SymTab.ConstInt(q2,
|
|
|
+ 3540 v2)
|
|
|
+ 3541 AND ((v < lo)
|
|
|
+ 3542 OR (v2 < lo)
|
|
|
+ 3543 OR (v >= lo +
|
|
|
+ 3544 VAL(INTEGER, span))
|
|
|
+ 3545 OR (v2 >= lo +
|
|
|
+ 3546 VAL(INTEGER, span))
|
|
|
+ 3547 OR (v > v2)) THEN
|
|
|
+ 3548 SemError(222)
|
|
|
+ 3549 ELSIF hasR THEN
|
|
|
+ 3550 QbeGen.SetRange(sq, qe, q2,
|
|
|
+ 3551 lo, span)
|
|
|
+ 3552 ELSIF SymTab.ConstInt(qe,
|
|
|
+ 3553 v)
|
|
|
+ 3554 AND ((v < lo)
|
|
|
+ 3555 OR (v >= lo +
|
|
|
+ 3556 VAL(INTEGER,
|
|
|
+ 3557 span))) THEN
|
|
|
+ 3558 SemError(222)
|
|
|
+ 3559 ELSE QbeGen.SetBit(sq, qe,
|
|
|
+ 3560 lo, span)
|
|
|
+ 3561 END
|
|
|
+ 3562 END; .)
|
|
|
+ 3563 (. AST.SetChild(node,
|
|
|
+ 3564 AST.NChild(node), astEl); .) .
|
|
|
+ 3565 GetIdent<VAR n: SymTab.Name>
|
|
|
+ 3566 = ident (. LexName(n); .) .
|
|
|
+ 3567
|
|
|
+ 3568 END M2.
|
|
|
|
|
|
0 errors
|
|
|
|
