|
|
@@ -35,7 +35,7 @@ Listing:
|
|
|
11 Semantic errors reuse the V1/V2/Test2 family: 200 duplicate,
|
|
|
12 201 undeclared, 202 module name mismatch, 210 bad assignment,
|
|
|
13 211 bad arithmetic, 221 not a type, 230 not supported yet,
|
|
|
- 14 231 opaque type outside definition.
|
|
|
+ 14 231 opaque type outside definition, 237 RETRY outside EXCEPT.
|
|
|
15 Scalar-phase TYPEs (named, integer subrange, enum) check fully;
|
|
|
16 composite forms wait for step 3. Procedure headings (formals,
|
|
|
17 result, FORWARD) enter scopes now; bodies parse + check with one
|
|
|
@@ -118,4405 +118,4511 @@ Listing:
|
|
|
94 curProcNode: AST.Node;
|
|
|
95 (* The procedure whose body is being parsed, for __FUNCTION__. *)
|
|
|
96 curFun: SymTab.Name;
|
|
|
- 97
|
|
|
- 98 (* The last actual argument parsed by ActParam: folded value and type.
|
|
|
- 99 A conversion T(x) has exactly one actual, so these let Fact
|
|
|
- 100 constant-fold it (needed for `CONST c = T(x)`). *)
|
|
|
- 101 convQ: QbeGen.QVal;
|
|
|
- 102 convT: SymTab.TypeIndex;
|
|
|
- 103
|
|
|
- 104 (* Result slot for the expression-AST builder (slice 2). Every
|
|
|
- 105 Expr/SimExpr/Term/Fact leaves its node here; the combination
|
|
|
- 106 productions save it into locals before parsing the next operand.
|
|
|
- 107 `astIsLit` in Fact is per-invocation, so a nested Fact cannot make
|
|
|
- 108 an outer non-literal Fact look literal. *)
|
|
|
- 109 astCur: AST.Node;
|
|
|
- 110
|
|
|
- 111 (* Actual-argument nodes collected by ActParam for the call being
|
|
|
- 112 parsed by ArgList (slice 4). Fact resets the count before the
|
|
|
- 113 optional ArgList and then folds the nodes into an NkCall. *)
|
|
|
- 114 astNArgs: CARDINAL;
|
|
|
- 115 astArgs: ARRAY [0 .. 31] OF AST.Node;
|
|
|
- 116
|
|
|
- 117 (* Statement-AST result slot (slice 5): the most recently parsed
|
|
|
- 118 statement. StatSeq folds these into an NkBlock. *)
|
|
|
- 119 astStmt: AST.Node;
|
|
|
+ 97 (* TRUE while parsing the statement sequence of an EXCEPT handler.
|
|
|
+ 98 RETRY is only valid there. Block saves/restores it so a nested
|
|
|
+ 99 procedure body cannot inherit an outer handler. *)
|
|
|
+ 100 inHandler: BOOLEAN;
|
|
|
+ 101
|
|
|
+ 102 (* The last actual argument parsed by ActParam: folded value and type.
|
|
|
+ 103 A conversion T(x) has exactly one actual, so these let Fact
|
|
|
+ 104 constant-fold it (needed for `CONST c = T(x)`). *)
|
|
|
+ 105 convQ: QbeGen.QVal;
|
|
|
+ 106 convT: SymTab.TypeIndex;
|
|
|
+ 107
|
|
|
+ 108 (* Result slot for the expression-AST builder (slice 2). Every
|
|
|
+ 109 Expr/SimExpr/Term/Fact leaves its node here; the combination
|
|
|
+ 110 productions save it into locals before parsing the next operand.
|
|
|
+ 111 `astIsLit` in Fact is per-invocation, so a nested Fact cannot make
|
|
|
+ 112 an outer non-literal Fact look literal. *)
|
|
|
+ 113 astCur: AST.Node;
|
|
|
+ 114
|
|
|
+ 115 (* Actual-argument nodes collected by ActParam for the call being
|
|
|
+ 116 parsed by ArgList (slice 4). Fact resets the count before the
|
|
|
+ 117 optional ArgList and then folds the nodes into an NkCall. *)
|
|
|
+ 118 astNArgs: CARDINAL;
|
|
|
+ 119 astArgs: ARRAY [0 .. 31] OF AST.Node;
|
|
|
120
|
|
|
- 121 (* Declaration-AST result slot (slice 6): the most recently built
|
|
|
- 122 declaration; DeclSeq folds these into an NkDeclSeq. *)
|
|
|
- 123 astDecl: AST.Node;
|
|
|
+ 121 (* Statement-AST result slot (slice 5): the most recently parsed
|
|
|
+ 122 statement. StatSeq folds these into an NkBlock. *)
|
|
|
+ 123 astStmt: AST.Node;
|
|
|
124
|
|
|
- 125 (* The local declarations of the most recent Block (a procedure body);
|
|
|
- 126 ProcDecl stores them as the proc node's child 2. *)
|
|
|
- 127 astBlkDecls: AST.Node;
|
|
|
+ 125 (* Declaration-AST result slot (slice 6): the most recently built
|
|
|
+ 126 declaration; DeclSeq folds these into an NkDeclSeq. *)
|
|
|
+ 127 astDecl: AST.Node;
|
|
|
128
|
|
|
- 129 (* Unit-AST root (slice 7): NkUnit(name, decls, body). *)
|
|
|
- 130 astUnit: AST.Node;
|
|
|
- 131
|
|
|
- 132 (* Import accumulator (slice 11): `{ Import }` appends NkImport
|
|
|
- 133 nodes here; each unit stores them as NkUnit child[3]. *)
|
|
|
- 134 astImp, astImpTail: AST.Node;
|
|
|
+ 129 (* The local declarations of the most recent Block (a procedure body);
|
|
|
+ 130 ProcDecl stores them as the proc node's child 2. *)
|
|
|
+ 131 astBlkDecls: AST.Node;
|
|
|
+ 132
|
|
|
+ 133 (* Unit-AST root (slice 7): NkUnit(name, decls, body). *)
|
|
|
+ 134 astUnit: AST.Node;
|
|
|
135
|
|
|
- 136 (* Class-AST accumulators (slice 13): the class node currently being
|
|
|
- 137 parsed and its parent/field/method lists. Classes are not nested
|
|
|
- 138 inside one another, so module-level state is safe. *)
|
|
|
- 139 astCls, astClsP, astClsPTail, astClsF, astClsFTail,
|
|
|
- 140 astClsM, astClsMTail, astMethod: AST.Node;
|
|
|
- 141
|
|
|
- 142 (* Class of the method named by the last `obj.Method` designator
|
|
|
- 143 (InvalidType when the callee is an ordinary procedure). Set by
|
|
|
- 144 Design, consumed by the following ArgList. *)
|
|
|
- 145 methCls: SymTab.TypeIndex;
|
|
|
- 146 (* Class of the type of the innermost `TypeName{...}` brace
|
|
|
- 147 constructor (ClSet or ClArray); dispatches BraceElem. *)
|
|
|
- 148 braceCls: INTEGER;
|
|
|
- 149 (* Module-level VAR declarations whose type was still an unresolved
|
|
|
- 150 forward alias at declaration time; emitted once the TYPE block
|
|
|
- 151 completes (module scope only). *)
|
|
|
- 152 nPendVar: CARDINAL;
|
|
|
- 153 pendVarName: ARRAY [0 .. 255] OF SymTab.Name;
|
|
|
- 154 pendVarT: ARRAY [0 .. 255] OF SymTab.TypeIndex;
|
|
|
- 155 (* Forward module-level variables referenced from a procedure body. *)
|
|
|
- 156 (* GOTO/labels: the label and goto names of the procedure being parsed,
|
|
|
- 157 reset per procedure and checked at its END. *)
|
|
|
- 158 nLab, nGot: CARDINAL;
|
|
|
- 159 labNm, gotNm: ARRAY [0 .. 255] OF SymTab.Name;
|
|
|
- 160
|
|
|
- 161 (* Generics (Increment 1): the last refining module seen — instance
|
|
|
- 162 name, generic name, and the actual type parameters. *)
|
|
|
- 163 refInst, refGen: SymTab.Name;
|
|
|
- 164 refN: CARDINAL;
|
|
|
- 165 refActual: ARRAY [0 .. 15] OF SymTab.TypeIndex;
|
|
|
- 166 refKind: ARRAY [0 .. 15] OF INTEGER; (* 0 = type, 1 = value, 2 = proc *)
|
|
|
- 167 refVal: ARRAY [0 .. 15] OF SymTab.Name;
|
|
|
- 168 refMod: ARRAY [0 .. 15] OF SymTab.Name;
|
|
|
- 169 isGen: BOOLEAN;
|
|
|
- 170
|
|
|
- 171 (* Generics (Increment 2): instantiation re-parse context. When the
|
|
|
- 172 driver re-parses a generic's source to instantiate it as `instName`,
|
|
|
- 173 instActive is TRUE, the module is renamed, and each type formal is
|
|
|
- 174 bound to the corresponding instActual entry. *)
|
|
|
- 175 instActive: BOOLEAN;
|
|
|
- 176 instName: SymTab.Name;
|
|
|
- 177 instActual: ARRAY [0 .. 15] OF SymTab.TypeIndex;
|
|
|
- 178 instKind: ARRAY [0 .. 15] OF INTEGER;
|
|
|
- 179 instVal: ARRAY [0 .. 15] OF SymTab.Name;
|
|
|
- 180 instMod: ARRAY [0 .. 15] OF SymTab.Name;
|
|
|
- 181 instN: CARDINAL;
|
|
|
- 182 instFk: CARDINAL; (* formal cursor while binding during re-parse *)
|
|
|
- 183
|
|
|
- 184 (* Identity of the last-parsed unit and refinement, for the driver's
|
|
|
- 185 generic registry and its re-parse decision. *)
|
|
|
- 186 unitName: SymTab.Name;
|
|
|
- 187 unitWasGen: BOOLEAN;
|
|
|
- 188 unitWasDef: BOOLEAN;
|
|
|
- 189 refSeen: BOOLEAN;
|
|
|
- 190 refIsDef: BOOLEAN;
|
|
|
- 191
|
|
|
- 192
|
|
|
- 193 PROCEDURE CopyNm (src: ARRAY OF CHAR; VAR dst: SymTab.Name);
|
|
|
- 194 VAR i: CARDINAL;
|
|
|
- 195 BEGIN
|
|
|
- 196 i := 0;
|
|
|
- 197 WHILE (i <= HIGH(dst)) AND (i <= HIGH(src)) AND (src[i] # CHR(0)) DO
|
|
|
- 198 dst[i] := src[i]; INC(i)
|
|
|
- 199 END;
|
|
|
- 200 IF i <= HIGH(dst) THEN dst[i] := CHR(0) END
|
|
|
- 201 END CopyNm;
|
|
|
- 202
|
|
|
- 203 PROCEDURE InInst () : BOOLEAN;
|
|
|
- 204 BEGIN RETURN instActive END InInst;
|
|
|
- 205
|
|
|
- 206 PROCEDURE InstNameGet (VAR nm: SymTab.Name);
|
|
|
- 207 BEGIN CopyNm(instName, nm) END InstNameGet;
|
|
|
- 208
|
|
|
- 209 PROCEDURE InstActualGet (i: CARDINAL) : SymTab.TypeIndex;
|
|
|
- 210 BEGIN
|
|
|
- 211 IF i >= instN THEN RETURN SymTab.InvalidType END;
|
|
|
- 212 RETURN instActual[i]
|
|
|
- 213 END InstActualGet;
|
|
|
- 214
|
|
|
- 215 PROCEDURE InstBegin (name: ARRAY OF CHAR);
|
|
|
- 216 BEGIN instActive := TRUE; CopyNm(name, instName); instN := 0;
|
|
|
- 217 instFk := 0 END InstBegin;
|
|
|
+ 136 (* Import accumulator (slice 11): `{ Import }` appends NkImport
|
|
|
+ 137 nodes here; each unit stores them as NkUnit child[3]. *)
|
|
|
+ 138 astImp, astImpTail: AST.Node;
|
|
|
+ 139
|
|
|
+ 140 (* Class-AST accumulators (slice 13): the class node currently being
|
|
|
+ 141 parsed and its parent/field/method lists. Classes are not nested
|
|
|
+ 142 inside one another, so module-level state is safe. *)
|
|
|
+ 143 astCls, astClsP, astClsPTail, astClsF, astClsFTail,
|
|
|
+ 144 astClsM, astClsMTail, astMethod: AST.Node;
|
|
|
+ 145
|
|
|
+ 146 (* Class of the method named by the last `obj.Method` designator
|
|
|
+ 147 (InvalidType when the callee is an ordinary procedure). Set by
|
|
|
+ 148 Design, consumed by the following ArgList. *)
|
|
|
+ 149 methCls: SymTab.TypeIndex;
|
|
|
+ 150 (* Class of the type of the innermost `TypeName{...}` brace
|
|
|
+ 151 constructor (ClSet or ClArray); dispatches BraceElem. *)
|
|
|
+ 152 braceCls: INTEGER;
|
|
|
+ 153 (* Module-level VAR declarations whose type was still an unresolved
|
|
|
+ 154 forward alias at declaration time; emitted once the TYPE block
|
|
|
+ 155 completes (module scope only). *)
|
|
|
+ 156 nPendVar: CARDINAL;
|
|
|
+ 157 pendVarName: ARRAY [0 .. 255] OF SymTab.Name;
|
|
|
+ 158 pendVarT: ARRAY [0 .. 255] OF SymTab.TypeIndex;
|
|
|
+ 159 (* Forward module-level variables referenced from a procedure body. *)
|
|
|
+ 160 (* GOTO/labels: the label and goto names of the procedure being parsed,
|
|
|
+ 161 reset per procedure and checked at its END. *)
|
|
|
+ 162 nLab, nGot: CARDINAL;
|
|
|
+ 163 labNm, gotNm: ARRAY [0 .. 255] OF SymTab.Name;
|
|
|
+ 164
|
|
|
+ 165 (* Generics (Increment 1): the last refining module seen — instance
|
|
|
+ 166 name, generic name, and the actual type parameters. *)
|
|
|
+ 167 refInst, refGen: SymTab.Name;
|
|
|
+ 168 refN: CARDINAL;
|
|
|
+ 169 refActual: ARRAY [0 .. 15] OF SymTab.TypeIndex;
|
|
|
+ 170 refKind: ARRAY [0 .. 15] OF INTEGER; (* 0 = type, 1 = value, 2 = proc *)
|
|
|
+ 171 refVal: ARRAY [0 .. 15] OF SymTab.Name;
|
|
|
+ 172 refMod: ARRAY [0 .. 15] OF SymTab.Name;
|
|
|
+ 173 isGen: BOOLEAN;
|
|
|
+ 174
|
|
|
+ 175 (* Generics (Increment 2): instantiation re-parse context. When the
|
|
|
+ 176 driver re-parses a generic's source to instantiate it as `instName`,
|
|
|
+ 177 instActive is TRUE, the module is renamed, and each type formal is
|
|
|
+ 178 bound to the corresponding instActual entry. *)
|
|
|
+ 179 instActive: BOOLEAN;
|
|
|
+ 180 instName: SymTab.Name;
|
|
|
+ 181 instActual: ARRAY [0 .. 15] OF SymTab.TypeIndex;
|
|
|
+ 182 instKind: ARRAY [0 .. 15] OF INTEGER;
|
|
|
+ 183 instVal: ARRAY [0 .. 15] OF SymTab.Name;
|
|
|
+ 184 instMod: ARRAY [0 .. 15] OF SymTab.Name;
|
|
|
+ 185 instN: CARDINAL;
|
|
|
+ 186 instFk: CARDINAL; (* formal cursor while binding during re-parse *)
|
|
|
+ 187
|
|
|
+ 188 (* Identity of the last-parsed unit and refinement, for the driver's
|
|
|
+ 189 generic registry and its re-parse decision. *)
|
|
|
+ 190 unitName: SymTab.Name;
|
|
|
+ 191 unitWasGen: BOOLEAN;
|
|
|
+ 192 unitWasDef: BOOLEAN;
|
|
|
+ 193 refSeen: BOOLEAN;
|
|
|
+ 194 refIsDef: BOOLEAN;
|
|
|
+ 195
|
|
|
+ 196
|
|
|
+ 197 PROCEDURE CopyNm (src: ARRAY OF CHAR; VAR dst: SymTab.Name);
|
|
|
+ 198 VAR i: CARDINAL;
|
|
|
+ 199 BEGIN
|
|
|
+ 200 i := 0;
|
|
|
+ 201 WHILE (i <= HIGH(dst)) AND (i <= HIGH(src)) AND (src[i] # CHR(0)) DO
|
|
|
+ 202 dst[i] := src[i]; INC(i)
|
|
|
+ 203 END;
|
|
|
+ 204 IF i <= HIGH(dst) THEN dst[i] := CHR(0) END
|
|
|
+ 205 END CopyNm;
|
|
|
+ 206
|
|
|
+ 207 PROCEDURE WrapExcept (body, handler: AST.Node): AST.Node;
|
|
|
+ 208 (* M1: a body with an EXCEPT part is represented as one node so Lower
|
|
|
+ 209 can add handler codegen in one place later. The handler is retained
|
|
|
+ 210 in the AST even while M1 lowers only the body. *)
|
|
|
+ 211 VAR n: AST.Node;
|
|
|
+ 212 BEGIN
|
|
|
+ 213 n := AST.MakeNode(AST.NkExcept);
|
|
|
+ 214 AST.SetChild(n, 0, body);
|
|
|
+ 215 AST.SetChild(n, 1, handler);
|
|
|
+ 216 RETURN n
|
|
|
+ 217 END WrapExcept;
|
|
|
218
|
|
|
- 219 PROCEDURE InstActualKind (i: CARDINAL) : INTEGER;
|
|
|
- 220 BEGIN
|
|
|
- 221 IF i >= instN THEN RETURN 0 END;
|
|
|
- 222 RETURN instKind[i]
|
|
|
- 223 END InstActualKind;
|
|
|
+ 219 PROCEDURE InInst () : BOOLEAN;
|
|
|
+ 220 BEGIN RETURN instActive END InInst;
|
|
|
+ 221
|
|
|
+ 222 PROCEDURE InstNameGet (VAR nm: SymTab.Name);
|
|
|
+ 223 BEGIN CopyNm(instName, nm) END InstNameGet;
|
|
|
224
|
|
|
- 225 PROCEDURE InstActualVal (i: CARDINAL; VAR v: SymTab.Name);
|
|
|
- 226 VAR k: CARDINAL;
|
|
|
- 227 BEGIN
|
|
|
- 228 v[0] := CHR(0);
|
|
|
- 229 IF i >= instN THEN RETURN END;
|
|
|
- 230 k := 0;
|
|
|
- 231 WHILE (k <= HIGH(v)) AND (instVal[i][k] # CHR(0)) DO
|
|
|
- 232 v[k] := instVal[i][k]; INC(k)
|
|
|
- 233 END;
|
|
|
- 234 v[k] := CHR(0)
|
|
|
- 235 END InstActualVal;
|
|
|
- 236
|
|
|
- 237 PROCEDURE InstActualMod (i: CARDINAL; VAR m: SymTab.Name);
|
|
|
- 238 VAR k: CARDINAL;
|
|
|
- 239 BEGIN
|
|
|
- 240 m[0] := CHR(0);
|
|
|
- 241 IF i >= instN THEN RETURN END;
|
|
|
- 242 k := 0;
|
|
|
- 243 WHILE (k <= HIGH(m)) AND (instMod[i][k] # CHR(0)) DO
|
|
|
- 244 m[k] := instMod[i][k]; INC(k)
|
|
|
- 245 END;
|
|
|
- 246 m[k] := CHR(0)
|
|
|
- 247 END InstActualMod;
|
|
|
- 248
|
|
|
- 249 PROCEDURE InstAddActual (kind: INTEGER; t: SymTab.TypeIndex;
|
|
|
- 250 val, m: ARRAY OF CHAR);
|
|
|
- 251 VAR k: CARDINAL;
|
|
|
- 252 BEGIN
|
|
|
- 253 IF instN > HIGH(instActual) THEN RETURN END;
|
|
|
- 254 instKind[instN] := kind; instActual[instN] := t;
|
|
|
- 255 k := 0;
|
|
|
- 256 WHILE (k <= HIGH(instVal[instN])) AND (val[k] # CHR(0)) DO
|
|
|
- 257 instVal[instN][k] := val[k]; INC(k)
|
|
|
- 258 END;
|
|
|
- 259 instVal[instN][k] := CHR(0);
|
|
|
- 260 k := 0;
|
|
|
- 261 WHILE (k <= HIGH(instMod[instN])) AND (m[k] # CHR(0)) DO
|
|
|
- 262 instMod[instN][k] := m[k]; INC(k)
|
|
|
- 263 END;
|
|
|
- 264 instMod[instN][k] := CHR(0);
|
|
|
- 265 INC(instN)
|
|
|
- 266 END InstAddActual;
|
|
|
- 267
|
|
|
- 268 PROCEDURE InstEnd;
|
|
|
- 269 BEGIN instActive := FALSE; instN := 0 END InstEnd;
|
|
|
- 270
|
|
|
- 271 PROCEDURE UnitNameGet (VAR nm: SymTab.Name);
|
|
|
- 272 BEGIN CopyNm(unitName, nm) END UnitNameGet;
|
|
|
- 273
|
|
|
- 274 PROCEDURE UnitIsGeneric () : BOOLEAN;
|
|
|
- 275 BEGIN RETURN unitWasGen END UnitIsGeneric;
|
|
|
- 276
|
|
|
- 277 PROCEDURE UnitIsDefModule () : BOOLEAN;
|
|
|
- 278 BEGIN RETURN unitWasDef END UnitIsDefModule;
|
|
|
- 279
|
|
|
- 280 PROCEDURE IsTypeName (n: SymTab.Name): BOOLEAN;
|
|
|
- 281 (* TRUE when n denotes a type or a predeclared type name. Used by the
|
|
|
- 282 procedure-type parameter list to tell a type-only entry from a
|
|
|
- 283 parameter name. *)
|
|
|
- 284 BEGIN
|
|
|
- 285 RETURN SymTab.Lookup(n)
|
|
|
- 286 AND ((SymTab.SymKind(n) = SymTab.KindType)
|
|
|
- 287 OR (SymTab.SymKind(n) = SymTab.KindPredef))
|
|
|
- 288 END IsTypeName;
|
|
|
+ 225 PROCEDURE InstActualGet (i: CARDINAL) : SymTab.TypeIndex;
|
|
|
+ 226 BEGIN
|
|
|
+ 227 IF i >= instN THEN RETURN SymTab.InvalidType END;
|
|
|
+ 228 RETURN instActual[i]
|
|
|
+ 229 END InstActualGet;
|
|
|
+ 230
|
|
|
+ 231 PROCEDURE InstBegin (name: ARRAY OF CHAR);
|
|
|
+ 232 BEGIN instActive := TRUE; CopyNm(name, instName); instN := 0;
|
|
|
+ 233 instFk := 0 END InstBegin;
|
|
|
+ 234
|
|
|
+ 235 PROCEDURE InstActualKind (i: CARDINAL) : INTEGER;
|
|
|
+ 236 BEGIN
|
|
|
+ 237 IF i >= instN THEN RETURN 0 END;
|
|
|
+ 238 RETURN instKind[i]
|
|
|
+ 239 END InstActualKind;
|
|
|
+ 240
|
|
|
+ 241 PROCEDURE InstActualVal (i: CARDINAL; VAR v: SymTab.Name);
|
|
|
+ 242 VAR k: CARDINAL;
|
|
|
+ 243 BEGIN
|
|
|
+ 244 v[0] := CHR(0);
|
|
|
+ 245 IF i >= instN THEN RETURN END;
|
|
|
+ 246 k := 0;
|
|
|
+ 247 WHILE (k <= HIGH(v)) AND (instVal[i][k] # CHR(0)) DO
|
|
|
+ 248 v[k] := instVal[i][k]; INC(k)
|
|
|
+ 249 END;
|
|
|
+ 250 v[k] := CHR(0)
|
|
|
+ 251 END InstActualVal;
|
|
|
+ 252
|
|
|
+ 253 PROCEDURE InstActualMod (i: CARDINAL; VAR m: SymTab.Name);
|
|
|
+ 254 VAR k: CARDINAL;
|
|
|
+ 255 BEGIN
|
|
|
+ 256 m[0] := CHR(0);
|
|
|
+ 257 IF i >= instN THEN RETURN END;
|
|
|
+ 258 k := 0;
|
|
|
+ 259 WHILE (k <= HIGH(m)) AND (instMod[i][k] # CHR(0)) DO
|
|
|
+ 260 m[k] := instMod[i][k]; INC(k)
|
|
|
+ 261 END;
|
|
|
+ 262 m[k] := CHR(0)
|
|
|
+ 263 END InstActualMod;
|
|
|
+ 264
|
|
|
+ 265 PROCEDURE InstAddActual (kind: INTEGER; t: SymTab.TypeIndex;
|
|
|
+ 266 val, m: ARRAY OF CHAR);
|
|
|
+ 267 VAR k: CARDINAL;
|
|
|
+ 268 BEGIN
|
|
|
+ 269 IF instN > HIGH(instActual) THEN RETURN END;
|
|
|
+ 270 instKind[instN] := kind; instActual[instN] := t;
|
|
|
+ 271 k := 0;
|
|
|
+ 272 WHILE (k <= HIGH(instVal[instN])) AND (val[k] # CHR(0)) DO
|
|
|
+ 273 instVal[instN][k] := val[k]; INC(k)
|
|
|
+ 274 END;
|
|
|
+ 275 instVal[instN][k] := CHR(0);
|
|
|
+ 276 k := 0;
|
|
|
+ 277 WHILE (k <= HIGH(instMod[instN])) AND (m[k] # CHR(0)) DO
|
|
|
+ 278 instMod[instN][k] := m[k]; INC(k)
|
|
|
+ 279 END;
|
|
|
+ 280 instMod[instN][k] := CHR(0);
|
|
|
+ 281 INC(instN)
|
|
|
+ 282 END InstAddActual;
|
|
|
+ 283
|
|
|
+ 284 PROCEDURE InstEnd;
|
|
|
+ 285 BEGIN instActive := FALSE; instN := 0 END InstEnd;
|
|
|
+ 286
|
|
|
+ 287 PROCEDURE UnitNameGet (VAR nm: SymTab.Name);
|
|
|
+ 288 BEGIN CopyNm(unitName, nm) END UnitNameGet;
|
|
|
289
|
|
|
- 290 PROCEDURE RefineSeen () : BOOLEAN;
|
|
|
- 291 BEGIN RETURN refSeen END RefineSeen;
|
|
|
+ 290 PROCEDURE UnitIsGeneric () : BOOLEAN;
|
|
|
+ 291 BEGIN RETURN unitWasGen END UnitIsGeneric;
|
|
|
292
|
|
|
- 293 PROCEDURE RefineIsDef () : BOOLEAN;
|
|
|
- 294 BEGIN RETURN refIsDef END RefineIsDef;
|
|
|
+ 293 PROCEDURE UnitIsDefModule () : BOOLEAN;
|
|
|
+ 294 BEGIN RETURN unitWasDef END UnitIsDefModule;
|
|
|
295
|
|
|
- 296 PROCEDURE RefineInst (VAR nm: SymTab.Name);
|
|
|
- 297 BEGIN CopyNm(refInst, nm) END RefineInst;
|
|
|
- 298
|
|
|
- 299 PROCEDURE RefineGen (VAR nm: SymTab.Name);
|
|
|
- 300 BEGIN CopyNm(refGen, nm) END RefineGen;
|
|
|
- 301
|
|
|
- 302 PROCEDURE RefineActualCount () : CARDINAL;
|
|
|
- 303 BEGIN RETURN refN END RefineActualCount;
|
|
|
- 304
|
|
|
- 305 PROCEDURE RefineActualGet (i: CARDINAL) : SymTab.TypeIndex;
|
|
|
- 306 BEGIN
|
|
|
- 307 IF i >= refN THEN RETURN SymTab.InvalidType END;
|
|
|
- 308 RETURN refActual[i]
|
|
|
- 309 END RefineActualGet;
|
|
|
- 310
|
|
|
- 311 PROCEDURE RefineActualKind (i: CARDINAL) : INTEGER;
|
|
|
- 312 BEGIN
|
|
|
- 313 IF i >= refN THEN RETURN 0 END;
|
|
|
- 314 RETURN refKind[i]
|
|
|
- 315 END RefineActualKind;
|
|
|
- 316
|
|
|
- 317 PROCEDURE RefineActualMod (i: CARDINAL; VAR m: SymTab.Name);
|
|
|
- 318 VAR k: CARDINAL;
|
|
|
- 319 BEGIN
|
|
|
- 320 m[0] := CHR(0);
|
|
|
- 321 IF i >= refN THEN RETURN END;
|
|
|
- 322 k := 0;
|
|
|
- 323 WHILE (k <= HIGH(m)) AND (refMod[i][k] # CHR(0)) DO
|
|
|
- 324 m[k] := refMod[i][k]; INC(k)
|
|
|
- 325 END;
|
|
|
- 326 m[k] := CHR(0)
|
|
|
- 327 END RefineActualMod;
|
|
|
- 328
|
|
|
- 329 PROCEDURE RefineActualVal (i: CARDINAL; VAR v: SymTab.Name);
|
|
|
- 330 VAR k: CARDINAL;
|
|
|
- 331 BEGIN
|
|
|
- 332 v[0] := CHR(0);
|
|
|
- 333 IF i >= refN THEN RETURN END;
|
|
|
- 334 k := 0;
|
|
|
- 335 WHILE (k <= HIGH(v)) AND (refVal[i][k] # CHR(0)) DO
|
|
|
- 336 v[k] := refVal[i][k]; INC(k)
|
|
|
- 337 END;
|
|
|
- 338 v[k] := CHR(0)
|
|
|
- 339 END RefineActualVal;
|
|
|
- 340
|
|
|
- 341 PROCEDURE NoteLabel (nm: ARRAY OF CHAR);
|
|
|
- 342 (* Record a statement label; duplicate is 200. *)
|
|
|
- 343 VAR i: CARDINAL;
|
|
|
- 344 BEGIN
|
|
|
- 345 i := 0;
|
|
|
- 346 WHILE i < nLab DO
|
|
|
- 347 IF SymTab.Equal(labNm[i], nm) THEN SemError(200); RETURN END;
|
|
|
- 348 INC(i)
|
|
|
- 349 END;
|
|
|
- 350 IF nLab <= HIGH(labNm) THEN
|
|
|
- 351 CopyNm(nm, labNm[nLab]); INC(nLab)
|
|
|
- 352 ELSE SemError(230) (* label table full: implementation limit *)
|
|
|
- 353 END
|
|
|
- 354 END NoteLabel;
|
|
|
- 355
|
|
|
- 356 PROCEDURE NoteGoto (nm: ARRAY OF CHAR);
|
|
|
- 357 VAR i: CARDINAL;
|
|
|
- 358 BEGIN
|
|
|
- 359 i := 0;
|
|
|
- 360 WHILE i < nGot DO
|
|
|
- 361 IF SymTab.Equal(gotNm[i], nm) THEN RETURN END;
|
|
|
- 362 INC(i)
|
|
|
- 363 END;
|
|
|
- 364 IF nGot <= HIGH(gotNm) THEN
|
|
|
- 365 CopyNm(nm, gotNm[nGot]); INC(nGot)
|
|
|
- 366 ELSE SemError(230) (* GOTO table full: implementation limit *)
|
|
|
- 367 END
|
|
|
- 368 END NoteGoto;
|
|
|
- 369
|
|
|
- 370 PROCEDURE CheckGotos;
|
|
|
- 371 (* At a procedure's END: every GOTO must name a label in that procedure. *)
|
|
|
- 372 VAR i, j: CARDINAL; found: BOOLEAN;
|
|
|
- 373 BEGIN
|
|
|
- 374 i := 0;
|
|
|
- 375 WHILE i < nGot DO
|
|
|
- 376 found := FALSE; j := 0;
|
|
|
- 377 WHILE (j < nLab) AND NOT found DO
|
|
|
- 378 IF SymTab.Equal(labNm[j], gotNm[i]) THEN found := TRUE END;
|
|
|
- 379 INC(j)
|
|
|
- 380 END;
|
|
|
- 381 IF NOT found THEN SemError(201) END;
|
|
|
- 382 INC(i)
|
|
|
+ 296 PROCEDURE IsTypeName (n: SymTab.Name): BOOLEAN;
|
|
|
+ 297 (* TRUE when n denotes a type or a predeclared type name. Used by the
|
|
|
+ 298 procedure-type parameter list to tell a type-only entry from a
|
|
|
+ 299 parameter name. *)
|
|
|
+ 300 BEGIN
|
|
|
+ 301 RETURN SymTab.Lookup(n)
|
|
|
+ 302 AND ((SymTab.SymKind(n) = SymTab.KindType)
|
|
|
+ 303 OR (SymTab.SymKind(n) = SymTab.KindPredef))
|
|
|
+ 304 END IsTypeName;
|
|
|
+ 305
|
|
|
+ 306 PROCEDURE RefineSeen () : BOOLEAN;
|
|
|
+ 307 BEGIN RETURN refSeen END RefineSeen;
|
|
|
+ 308
|
|
|
+ 309 PROCEDURE RefineIsDef () : BOOLEAN;
|
|
|
+ 310 BEGIN RETURN refIsDef END RefineIsDef;
|
|
|
+ 311
|
|
|
+ 312 PROCEDURE RefineInst (VAR nm: SymTab.Name);
|
|
|
+ 313 BEGIN CopyNm(refInst, nm) END RefineInst;
|
|
|
+ 314
|
|
|
+ 315 PROCEDURE RefineGen (VAR nm: SymTab.Name);
|
|
|
+ 316 BEGIN CopyNm(refGen, nm) END RefineGen;
|
|
|
+ 317
|
|
|
+ 318 PROCEDURE RefineActualCount () : CARDINAL;
|
|
|
+ 319 BEGIN RETURN refN END RefineActualCount;
|
|
|
+ 320
|
|
|
+ 321 PROCEDURE RefineActualGet (i: CARDINAL) : SymTab.TypeIndex;
|
|
|
+ 322 BEGIN
|
|
|
+ 323 IF i >= refN THEN RETURN SymTab.InvalidType END;
|
|
|
+ 324 RETURN refActual[i]
|
|
|
+ 325 END RefineActualGet;
|
|
|
+ 326
|
|
|
+ 327 PROCEDURE RefineActualKind (i: CARDINAL) : INTEGER;
|
|
|
+ 328 BEGIN
|
|
|
+ 329 IF i >= refN THEN RETURN 0 END;
|
|
|
+ 330 RETURN refKind[i]
|
|
|
+ 331 END RefineActualKind;
|
|
|
+ 332
|
|
|
+ 333 PROCEDURE RefineActualMod (i: CARDINAL; VAR m: SymTab.Name);
|
|
|
+ 334 VAR k: CARDINAL;
|
|
|
+ 335 BEGIN
|
|
|
+ 336 m[0] := CHR(0);
|
|
|
+ 337 IF i >= refN THEN RETURN END;
|
|
|
+ 338 k := 0;
|
|
|
+ 339 WHILE (k <= HIGH(m)) AND (refMod[i][k] # CHR(0)) DO
|
|
|
+ 340 m[k] := refMod[i][k]; INC(k)
|
|
|
+ 341 END;
|
|
|
+ 342 m[k] := CHR(0)
|
|
|
+ 343 END RefineActualMod;
|
|
|
+ 344
|
|
|
+ 345 PROCEDURE RefineActualVal (i: CARDINAL; VAR v: SymTab.Name);
|
|
|
+ 346 VAR k: CARDINAL;
|
|
|
+ 347 BEGIN
|
|
|
+ 348 v[0] := CHR(0);
|
|
|
+ 349 IF i >= refN THEN RETURN END;
|
|
|
+ 350 k := 0;
|
|
|
+ 351 WHILE (k <= HIGH(v)) AND (refVal[i][k] # CHR(0)) DO
|
|
|
+ 352 v[k] := refVal[i][k]; INC(k)
|
|
|
+ 353 END;
|
|
|
+ 354 v[k] := CHR(0)
|
|
|
+ 355 END RefineActualVal;
|
|
|
+ 356
|
|
|
+ 357 PROCEDURE NoteLabel (nm: ARRAY OF CHAR);
|
|
|
+ 358 (* Record a statement label; duplicate is 200. *)
|
|
|
+ 359 VAR i: CARDINAL;
|
|
|
+ 360 BEGIN
|
|
|
+ 361 i := 0;
|
|
|
+ 362 WHILE i < nLab DO
|
|
|
+ 363 IF SymTab.Equal(labNm[i], nm) THEN SemError(200); RETURN END;
|
|
|
+ 364 INC(i)
|
|
|
+ 365 END;
|
|
|
+ 366 IF nLab <= HIGH(labNm) THEN
|
|
|
+ 367 CopyNm(nm, labNm[nLab]); INC(nLab)
|
|
|
+ 368 ELSE SemError(230) (* label table full: implementation limit *)
|
|
|
+ 369 END
|
|
|
+ 370 END NoteLabel;
|
|
|
+ 371
|
|
|
+ 372 PROCEDURE NoteGoto (nm: ARRAY OF CHAR);
|
|
|
+ 373 VAR i: CARDINAL;
|
|
|
+ 374 BEGIN
|
|
|
+ 375 i := 0;
|
|
|
+ 376 WHILE i < nGot DO
|
|
|
+ 377 IF SymTab.Equal(gotNm[i], nm) THEN RETURN END;
|
|
|
+ 378 INC(i)
|
|
|
+ 379 END;
|
|
|
+ 380 IF nGot <= HIGH(gotNm) THEN
|
|
|
+ 381 CopyNm(nm, gotNm[nGot]); INC(nGot)
|
|
|
+ 382 ELSE SemError(230) (* GOTO table full: implementation limit *)
|
|
|
383 END
|
|
|
- 384 END CheckGotos;
|
|
|
+ 384 END NoteGoto;
|
|
|
385
|
|
|
- 386 PROCEDURE FlushPend;
|
|
|
- 387 (* Emit module-level globals whose forward type is now resolved. *)
|
|
|
- 388 VAR k: CARDINAL;
|
|
|
+ 386 PROCEDURE CheckGotos;
|
|
|
+ 387 (* At a procedure's END: every GOTO must name a label in that procedure. *)
|
|
|
+ 388 VAR i, j: CARDINAL; found: BOOLEAN;
|
|
|
389 BEGIN
|
|
|
- 390 k := 0;
|
|
|
- 391 WHILE k < nPendVar DO
|
|
|
- 392 INC(k)
|
|
|
- 393 END;
|
|
|
- 394 nPendVar := 0
|
|
|
- 395 END FlushPend;
|
|
|
- 396
|
|
|
- 397 PROCEDURE AstAppend (kind: INTEGER; VAR head, tail: AST.Node;
|
|
|
- 398 item: AST.Node);
|
|
|
- 399 (* Appends `item` to a chunked sequence: each node holds up to
|
|
|
- 400 AST.MaxChild-1 items; child[MaxChild-1] continues into the next
|
|
|
- 401 chunk. Unbounded, so blocks/decl sequences are not capped at 8. *)
|
|
|
- 402 VAR n: AST.Node;
|
|
|
- 403 BEGIN
|
|
|
- 404 IF item = AST.NoNode THEN RETURN END;
|
|
|
- 405 IF head = AST.NoNode THEN
|
|
|
- 406 head := AST.MakeNode(kind); tail := head
|
|
|
- 407 END;
|
|
|
- 408 IF AST.NChild(tail) >= AST.MaxChild - 1 THEN
|
|
|
- 409 n := AST.MakeNode(kind);
|
|
|
- 410 AST.SetChild(tail, AST.MaxChild - 1, n);
|
|
|
- 411 tail := n
|
|
|
- 412 END;
|
|
|
- 413 AST.SetChild(tail, AST.NChild(tail), item)
|
|
|
- 414 END AstAppend;
|
|
|
- 415
|
|
|
- 416 PROCEDURE AstCallNode (callee: AST.Node) : AST.Node;
|
|
|
- 417 (* Builds NkCall(callee, actuals...) from astArgs/astNArgs. The actuals
|
|
|
- 418 are a chunked sequence (AstAppend): a call can have more than
|
|
|
- 419 MaxChild-1 arguments (the generic ArgList has 9), and SetChild would
|
|
|
- 420 silently drop the tail. NkBlock marks the continuation chunks. *)
|
|
|
- 421 VAR n, tail: AST.Node; j: CARDINAL;
|
|
|
- 422 BEGIN
|
|
|
- 423 n := AST.MakeNode(AST.NkCall);
|
|
|
- 424 AST.SetChild(n, 0, callee);
|
|
|
- 425 tail := n;
|
|
|
- 426 j := 0;
|
|
|
- 427 WHILE j < astNArgs DO
|
|
|
- 428 AstAppend(AST.NkBlock, n, tail, astArgs[j]);
|
|
|
- 429 INC(j)
|
|
|
- 430 END;
|
|
|
- 431 RETURN n
|
|
|
- 432 END AstCallNode;
|
|
|
- 433
|
|
|
- 434
|
|
|
- 435
|
|
|
- 436 PROCEDURE GetUnit (): AST.Node;
|
|
|
- 437 (* The most recently parsed unit's AST root (for the Lower comparison). *)
|
|
|
+ 390 i := 0;
|
|
|
+ 391 WHILE i < nGot DO
|
|
|
+ 392 found := FALSE; j := 0;
|
|
|
+ 393 WHILE (j < nLab) AND NOT found DO
|
|
|
+ 394 IF SymTab.Equal(labNm[j], gotNm[i]) THEN found := TRUE END;
|
|
|
+ 395 INC(j)
|
|
|
+ 396 END;
|
|
|
+ 397 IF NOT found THEN SemError(201) END;
|
|
|
+ 398 INC(i)
|
|
|
+ 399 END
|
|
|
+ 400 END CheckGotos;
|
|
|
+ 401
|
|
|
+ 402 PROCEDURE FlushPend;
|
|
|
+ 403 (* Emit module-level globals whose forward type is now resolved. *)
|
|
|
+ 404 VAR k: CARDINAL;
|
|
|
+ 405 BEGIN
|
|
|
+ 406 k := 0;
|
|
|
+ 407 WHILE k < nPendVar DO
|
|
|
+ 408 INC(k)
|
|
|
+ 409 END;
|
|
|
+ 410 nPendVar := 0
|
|
|
+ 411 END FlushPend;
|
|
|
+ 412
|
|
|
+ 413 PROCEDURE AstAppend (kind: INTEGER; VAR head, tail: AST.Node;
|
|
|
+ 414 item: AST.Node);
|
|
|
+ 415 (* Appends `item` to a chunked sequence: each node holds up to
|
|
|
+ 416 AST.MaxChild-1 items; child[MaxChild-1] continues into the next
|
|
|
+ 417 chunk. Unbounded, so blocks/decl sequences are not capped at 8. *)
|
|
|
+ 418 VAR n: AST.Node;
|
|
|
+ 419 BEGIN
|
|
|
+ 420 IF item = AST.NoNode THEN RETURN END;
|
|
|
+ 421 IF head = AST.NoNode THEN
|
|
|
+ 422 head := AST.MakeNode(kind); tail := head
|
|
|
+ 423 END;
|
|
|
+ 424 IF AST.NChild(tail) >= AST.MaxChild - 1 THEN
|
|
|
+ 425 n := AST.MakeNode(kind);
|
|
|
+ 426 AST.SetChild(tail, AST.MaxChild - 1, n);
|
|
|
+ 427 tail := n
|
|
|
+ 428 END;
|
|
|
+ 429 AST.SetChild(tail, AST.NChild(tail), item)
|
|
|
+ 430 END AstAppend;
|
|
|
+ 431
|
|
|
+ 432 PROCEDURE AstCallNode (callee: AST.Node) : AST.Node;
|
|
|
+ 433 (* Builds NkCall(callee, actuals...) from astArgs/astNArgs. The actuals
|
|
|
+ 434 are a chunked sequence (AstAppend): a call can have more than
|
|
|
+ 435 MaxChild-1 arguments (the generic ArgList has 9), and SetChild would
|
|
|
+ 436 silently drop the tail. NkBlock marks the continuation chunks. *)
|
|
|
+ 437 VAR n, tail: AST.Node; j: CARDINAL;
|
|
|
438 BEGIN
|
|
|
- 439 RETURN astUnit
|
|
|
- 440 END GetUnit;
|
|
|
- 441
|
|
|
- 442 PROCEDURE SetTwoPhase (b: BOOLEAN);
|
|
|
- 443 (* Driver switch for the two-phase parse probe (milestone 1). *)
|
|
|
- 444 BEGIN
|
|
|
- 445 twoPhaseParse := b
|
|
|
- 446 END SetTwoPhase;
|
|
|
- 447
|
|
|
- 448 PROCEDURE TokIs (kw: ARRAY OF CHAR): BOOLEAN;
|
|
|
- 449 (* The current lookahead token's source text equals kw. Compares text,
|
|
|
- 450 not token codes, so grammar renumbering cannot desync the skipper. *)
|
|
|
- 451 VAR tok: ARRAY [0 .. 63] OF CHAR;
|
|
|
- 452 BEGIN
|
|
|
- 453 M2S.GetName(M2S.nextPos, M2S.nextLen, tok);
|
|
|
- 454 RETURN SymTab.Equal(tok, kw)
|
|
|
- 455 END TokIs;
|
|
|
- 456
|
|
|
- 457 PROCEDURE Adv;
|
|
|
- 458 (* Advance one token: exactly the parser frame's Get for a grammar
|
|
|
- 459 without pragmas (its pragma branch is empty and the scanner never
|
|
|
- 460 returns a token above maxT, so the repeat loop runs once). A
|
|
|
- 461 separate name because the frame's Get is declared later in this
|
|
|
- 462 module: a bare Get here would bind the imported M2S.Get (which takes
|
|
|
- 463 a parameter) under single-pass compilers. *)
|
|
|
- 464 BEGIN
|
|
|
- 465 M2S.Get(sym);
|
|
|
- 466 INC(errDist)
|
|
|
- 467 END Adv;
|
|
|
- 468
|
|
|
- 469 PROCEDURE ConsCode (nm: ARRAY OF CHAR): INTEGER;
|
|
|
- 470 (* Constraint name -> code: 0 none, 1 ORDINAL, 2 INTEGER, 3 REAL. *)
|
|
|
- 471 BEGIN
|
|
|
- 472 IF SymTab.Equal(nm, "ORDINAL") THEN RETURN 1
|
|
|
- 473 ELSIF SymTab.Equal(nm, "INTEGER") THEN RETURN 2
|
|
|
- 474 ELSIF SymTab.Equal(nm, "REAL") THEN RETURN 3
|
|
|
- 475 ELSIF SymTab.Equal(nm, "POINTER") THEN RETURN 4
|
|
|
- 476 ELSIF SymTab.Equal(nm, "SCALAR") THEN RETURN 5
|
|
|
- 477 END;
|
|
|
- 478 RETURN 0
|
|
|
- 479 END ConsCode;
|
|
|
- 480
|
|
|
- 481 PROCEDURE ConsOk (cons: INTEGER; t: SymTab.TypeIndex): BOOLEAN;
|
|
|
- 482 (* TRUE when t satisfies the constraint code. *)
|
|
|
- 483 BEGIN
|
|
|
- 484 IF cons = 0 THEN RETURN TRUE
|
|
|
- 485 ELSIF cons = 1 THEN RETURN SymTab.IsOrdinal(t)
|
|
|
- 486 ELSIF cons = 2 THEN
|
|
|
- 487 RETURN (SymTab.ClassOf(t) = SymTab.ClInt)
|
|
|
- 488 OR (SymTab.ClassOf(t) = SymTab.ClByte)
|
|
|
- 489 OR (SymTab.ClassOf(t) = SymTab.ClSByte)
|
|
|
- 490 OR (SymTab.ClassOf(t) = SymTab.ClWord16)
|
|
|
- 491 OR (SymTab.ClassOf(t) = SymTab.ClSWord16)
|
|
|
- 492 ELSIF cons = 3 THEN RETURN SymTab.ClassOf(t) = SymTab.ClReal
|
|
|
- 493 ELSIF cons = 4 THEN RETURN SymTab.ClassOf(t) = SymTab.ClPtr
|
|
|
- 494 ELSIF cons = 5 THEN
|
|
|
- 495 RETURN (SymTab.ClassOf(t) = SymTab.ClInt)
|
|
|
- 496 OR (SymTab.ClassOf(t) = SymTab.ClChar)
|
|
|
- 497 OR (SymTab.ClassOf(t) = SymTab.ClBool)
|
|
|
- 498 OR (SymTab.ClassOf(t) = SymTab.ClEnum)
|
|
|
- 499 OR (SymTab.ClassOf(t) = SymTab.ClUChar)
|
|
|
- 500 OR (SymTab.ClassOf(t) = SymTab.ClByte)
|
|
|
- 501 OR (SymTab.ClassOf(t) = SymTab.ClSByte)
|
|
|
- 502 OR (SymTab.ClassOf(t) = SymTab.ClWord16)
|
|
|
- 503 OR (SymTab.ClassOf(t) = SymTab.ClSWord16)
|
|
|
- 504 OR (SymTab.ClassOf(t) = SymTab.ClReal)
|
|
|
- 505 END;
|
|
|
- 506 RETURN TRUE
|
|
|
- 507 END ConsOk;
|
|
|
- 508
|
|
|
- 509 PROCEDURE OrdClass (t: SymTab.TypeIndex): BOOLEAN;
|
|
|
- 510 (* TRUE for scalar ordinal classes (int/char/bool/enum/uchar); a
|
|
|
- 511 conversion between two of these is representation-preserving, so its
|
|
|
- 512 folded value equals the operand's. *)
|
|
|
- 513 VAR c: INTEGER;
|
|
|
- 514 BEGIN
|
|
|
- 515 c := SymTab.ClassOf(t);
|
|
|
- 516 RETURN (c = SymTab.ClInt) OR (c = SymTab.ClChar) OR (c = SymTab.ClBool)
|
|
|
- 517 OR (c = SymTab.ClEnum) OR (c = SymTab.ClUChar)
|
|
|
- 518 OR (c = SymTab.ClByte) OR (c = SymTab.ClSByte)
|
|
|
- 519 OR (c = SymTab.ClWord16) OR (c = SymTab.ClSWord16)
|
|
|
- 520 END OrdClass;
|
|
|
- 521
|
|
|
- 522 PROCEDURE NoteSpan (pn: SymTab.Name; start: M2S.INT32): BOOLEAN;
|
|
|
- 523 (* Records an outermost body span for the re-parse pass (milestone 2).
|
|
|
- 524 FALSE when the span table is full (an implementation limit): the
|
|
|
- 525 caller then parses the body inline instead of dropping it. *)
|
|
|
- 526 BEGIN
|
|
|
- 527 IF nSpans > HIGH(spanName) THEN RETURN FALSE END;
|
|
|
- 528 CopyNm(pn, spanName[nSpans]);
|
|
|
- 529 spanStart[nSpans] := start;
|
|
|
- 530 spanIdx[nSpans] := SymTab.DeferBody();
|
|
|
- 531 INC(nSpans);
|
|
|
- 532 RETURN TRUE
|
|
|
- 533 END NoteSpan;
|
|
|
- 534
|
|
|
- 535 PROCEDURE Openers (): BOOLEAN;
|
|
|
- 536 (* TRUE when the current token opens a block that must be closed by an
|
|
|
- 537 END (BEGIN is excluded: a block's BEGIN shares the declaration END;
|
|
|
- 538 REPEAT..UNTIL and EXIT/RETURN need no END). *)
|
|
|
- 539 BEGIN
|
|
|
- 540 RETURN TokIs("MODULE") OR TokIs("PROCEDURE") OR TokIs("CLASS")
|
|
|
- 541 OR TokIs("RECORD") OR TokIs("IF") OR TokIs("CASE")
|
|
|
- 542 OR TokIs("WHILE") OR TokIs("FOR") OR TokIs("LOOP")
|
|
|
- 543 OR TokIs("WITH")
|
|
|
- 544 END Openers;
|
|
|
- 545
|
|
|
- 546 PROCEDURE DeferSkip (pn: SymTab.Name): BOOLEAN;
|
|
|
- 547 (* Phase 1 of the deferral: skip the body starting at the current token
|
|
|
- 548 (the first token after the heading's ';') up to the matching END,
|
|
|
- 549 verify the END's name, and LEAVE the scanner positioned exactly at
|
|
|
- 550 that END (so Block's trailing "END" ident consumes it for real), with
|
|
|
- 551 the span recorded for the re-parse pass. On any inconsistency,
|
|
|
- 552 restore the scanner and return FALSE so the caller parses normally. *)
|
|
|
- 553 VAR depth, guard: CARDINAL;
|
|
|
- 554 nm: SymTab.Name;
|
|
|
- 555 ok: BOOLEAN;
|
|
|
- 556 start, endPos: M2S.INT32;
|
|
|
- 557 BEGIN
|
|
|
- 558 deferredBody := FALSE;
|
|
|
- 559 (* table full (an implementation limit): parse the body inline now,
|
|
|
- 560 before touching the scanner, with a clear error. *)
|
|
|
- 561 IF nSpans > HIGH(spanName) THEN
|
|
|
- 562 SemError(230);
|
|
|
- 563 RETURN FALSE
|
|
|
- 564 END;
|
|
|
- 565 start := M2S.nextPos;
|
|
|
- 566 M2S.PushPos;
|
|
|
- 567 depth := 0; guard := 0; ok := TRUE;
|
|
|
- 568 LOOP
|
|
|
- 569 IF sym = 0 THEN ok := FALSE; EXIT END;
|
|
|
- 570 IF TokIs("END") THEN
|
|
|
- 571 IF depth = 0 THEN EXIT END;
|
|
|
- 572 DEC(depth)
|
|
|
- 573 ELSIF Openers() THEN
|
|
|
- 574 INC(depth)
|
|
|
- 575 END;
|
|
|
- 576 Adv;
|
|
|
- 577 INC(guard);
|
|
|
- 578 IF guard > 1000000 THEN ok := FALSE; EXIT END
|
|
|
- 579 END;
|
|
|
- 580 IF ok THEN
|
|
|
- 581 (* sym is the matching END; check the name after it, then seek back
|
|
|
- 582 so Block sees END (its "END" ident then consumes it for real). *)
|
|
|
- 583 endPos := M2S.nextPos;
|
|
|
- 584 Adv;
|
|
|
- 585 M2S.GetName(M2S.nextPos, M2S.nextLen, nm);
|
|
|
- 586 IF (sym = 0) OR NOT SymTab.Equal(nm, pn) THEN ok := FALSE END;
|
|
|
- 587 IF ok THEN
|
|
|
- 588 M2S.SeekTo(endPos); Adv
|
|
|
- 589 END
|
|
|
- 590 END;
|
|
|
- 591 IF ok THEN
|
|
|
- 592 IF NOT NoteSpan(pn, start) THEN
|
|
|
- 593 (* defensive: capacity is checked at entry, so this is unreachable *)
|
|
|
- 594 SemError(230);
|
|
|
- 595 RETURN FALSE
|
|
|
- 596 END;
|
|
|
- 597 spanTy[nSpans - 1] := Lower.CurScopeProc();
|
|
|
- 598 spanNode[nSpans - 1] := curProcNode;
|
|
|
- 599 M2S.DropPos; (* keep the scanner at END; discard the snapshot *)
|
|
|
- 600 deferredBody := TRUE;
|
|
|
- 601 RETURN TRUE
|
|
|
- 602 ELSE
|
|
|
- 603 M2S.PopPos;
|
|
|
- 604 FileIO.WriteString(FileIO.StdOut, "twophase defer mismatch in ");
|
|
|
- 605 FileIO.WriteString(FileIO.StdOut, pn);
|
|
|
- 606 FileIO.WriteLn(FileIO.StdOut);
|
|
|
- 607 RETURN FALSE
|
|
|
- 608 END
|
|
|
- 609 END DeferSkip;
|
|
|
- 610
|
|
|
- 611 CHARACTERS
|
|
|
- 612 eol = CHR(13) .
|
|
|
- 613 lf = CHR(10) .
|
|
|
- 614 letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" .
|
|
|
- 615 digit = "0123456789" .
|
|
|
- 616 hexDigit = digit + "ABCDEFabcdef" .
|
|
|
- 617 noQuote1 = ANY - "'" - eol .
|
|
|
- 618 noQuote2 = ANY - '"' - eol .
|
|
|
- 619
|
|
|
- 620 IGNORE CHR(9) .. CHR(13)
|
|
|
- 621
|
|
|
- 622 COMMENTS FROM "(*" TO "*)" NESTED
|
|
|
- 623 COMMENTS FROM "//" TO lf
|
|
|
- 624
|
|
|
- 625 TOKENS
|
|
|
- 626 ident = ( letter | "_" ) { letter | digit | "_" } .
|
|
|
- 627 integer = digit { digit }
|
|
|
- 628 | digit { digit } CONTEXT("..")
|
|
|
- 629 | "0x" hexDigit { hexDigit }
|
|
|
- 630 | "0X" hexDigit { hexDigit } .
|
|
|
- 631 real = digit { digit } "." { digit }
|
|
|
- 632 [ ( "E" | "e" ) [ "+" | "-" ] digit { digit } ] .
|
|
|
- 633 string = "'" { noQuote1 } "'"
|
|
|
- 634 | '"' { noQuote2 } '"' .
|
|
|
- 635 charConst = digit { digit } ( "C" | "c" ) .
|
|
|
- 636 ustring = ( "U" | "u" ) ( "'" { noQuote1 } "'" | '"' { noQuote2 } '"' ) .
|
|
|
+ 439 n := AST.MakeNode(AST.NkCall);
|
|
|
+ 440 AST.SetChild(n, 0, callee);
|
|
|
+ 441 tail := n;
|
|
|
+ 442 j := 0;
|
|
|
+ 443 WHILE j < astNArgs DO
|
|
|
+ 444 AstAppend(AST.NkBlock, n, tail, astArgs[j]);
|
|
|
+ 445 INC(j)
|
|
|
+ 446 END;
|
|
|
+ 447 RETURN n
|
|
|
+ 448 END AstCallNode;
|
|
|
+ 449
|
|
|
+ 450
|
|
|
+ 451
|
|
|
+ 452 PROCEDURE GetUnit (): AST.Node;
|
|
|
+ 453 (* The most recently parsed unit's AST root (for the Lower comparison). *)
|
|
|
+ 454 BEGIN
|
|
|
+ 455 RETURN astUnit
|
|
|
+ 456 END GetUnit;
|
|
|
+ 457
|
|
|
+ 458 PROCEDURE SetTwoPhase (b: BOOLEAN);
|
|
|
+ 459 (* Driver switch for the two-phase parse probe (milestone 1). *)
|
|
|
+ 460 BEGIN
|
|
|
+ 461 twoPhaseParse := b
|
|
|
+ 462 END SetTwoPhase;
|
|
|
+ 463
|
|
|
+ 464 PROCEDURE TokIs (kw: ARRAY OF CHAR): BOOLEAN;
|
|
|
+ 465 (* The current lookahead token's source text equals kw. Compares text,
|
|
|
+ 466 not token codes, so grammar renumbering cannot desync the skipper. *)
|
|
|
+ 467 VAR tok: ARRAY [0 .. 63] OF CHAR;
|
|
|
+ 468 BEGIN
|
|
|
+ 469 M2S.GetName(M2S.nextPos, M2S.nextLen, tok);
|
|
|
+ 470 RETURN SymTab.Equal(tok, kw)
|
|
|
+ 471 END TokIs;
|
|
|
+ 472
|
|
|
+ 473 PROCEDURE Adv;
|
|
|
+ 474 (* Advance one token: exactly the parser frame's Get for a grammar
|
|
|
+ 475 without pragmas (its pragma branch is empty and the scanner never
|
|
|
+ 476 returns a token above maxT, so the repeat loop runs once). A
|
|
|
+ 477 separate name because the frame's Get is declared later in this
|
|
|
+ 478 module: a bare Get here would bind the imported M2S.Get (which takes
|
|
|
+ 479 a parameter) under single-pass compilers. *)
|
|
|
+ 480 BEGIN
|
|
|
+ 481 M2S.Get(sym);
|
|
|
+ 482 INC(errDist)
|
|
|
+ 483 END Adv;
|
|
|
+ 484
|
|
|
+ 485 PROCEDURE ConsCode (nm: ARRAY OF CHAR): INTEGER;
|
|
|
+ 486 (* Constraint name -> code: 0 none, 1 ORDINAL, 2 INTEGER, 3 REAL. *)
|
|
|
+ 487 BEGIN
|
|
|
+ 488 IF SymTab.Equal(nm, "ORDINAL") THEN RETURN 1
|
|
|
+ 489 ELSIF SymTab.Equal(nm, "INTEGER") THEN RETURN 2
|
|
|
+ 490 ELSIF SymTab.Equal(nm, "REAL") THEN RETURN 3
|
|
|
+ 491 ELSIF SymTab.Equal(nm, "POINTER") THEN RETURN 4
|
|
|
+ 492 ELSIF SymTab.Equal(nm, "SCALAR") THEN RETURN 5
|
|
|
+ 493 END;
|
|
|
+ 494 RETURN 0
|
|
|
+ 495 END ConsCode;
|
|
|
+ 496
|
|
|
+ 497 PROCEDURE ConsOk (cons: INTEGER; t: SymTab.TypeIndex): BOOLEAN;
|
|
|
+ 498 (* TRUE when t satisfies the constraint code. *)
|
|
|
+ 499 BEGIN
|
|
|
+ 500 IF cons = 0 THEN RETURN TRUE
|
|
|
+ 501 ELSIF cons = 1 THEN RETURN SymTab.IsOrdinal(t)
|
|
|
+ 502 ELSIF cons = 2 THEN
|
|
|
+ 503 RETURN (SymTab.ClassOf(t) = SymTab.ClInt)
|
|
|
+ 504 OR (SymTab.ClassOf(t) = SymTab.ClByte)
|
|
|
+ 505 OR (SymTab.ClassOf(t) = SymTab.ClSByte)
|
|
|
+ 506 OR (SymTab.ClassOf(t) = SymTab.ClWord16)
|
|
|
+ 507 OR (SymTab.ClassOf(t) = SymTab.ClSWord16)
|
|
|
+ 508 ELSIF cons = 3 THEN RETURN SymTab.ClassOf(t) = SymTab.ClReal
|
|
|
+ 509 ELSIF cons = 4 THEN RETURN SymTab.ClassOf(t) = SymTab.ClPtr
|
|
|
+ 510 ELSIF cons = 5 THEN
|
|
|
+ 511 RETURN (SymTab.ClassOf(t) = SymTab.ClInt)
|
|
|
+ 512 OR (SymTab.ClassOf(t) = SymTab.ClChar)
|
|
|
+ 513 OR (SymTab.ClassOf(t) = SymTab.ClBool)
|
|
|
+ 514 OR (SymTab.ClassOf(t) = SymTab.ClEnum)
|
|
|
+ 515 OR (SymTab.ClassOf(t) = SymTab.ClUChar)
|
|
|
+ 516 OR (SymTab.ClassOf(t) = SymTab.ClByte)
|
|
|
+ 517 OR (SymTab.ClassOf(t) = SymTab.ClSByte)
|
|
|
+ 518 OR (SymTab.ClassOf(t) = SymTab.ClWord16)
|
|
|
+ 519 OR (SymTab.ClassOf(t) = SymTab.ClSWord16)
|
|
|
+ 520 OR (SymTab.ClassOf(t) = SymTab.ClReal)
|
|
|
+ 521 END;
|
|
|
+ 522 RETURN TRUE
|
|
|
+ 523 END ConsOk;
|
|
|
+ 524
|
|
|
+ 525 PROCEDURE OrdClass (t: SymTab.TypeIndex): BOOLEAN;
|
|
|
+ 526 (* TRUE for scalar ordinal classes (int/char/bool/enum/uchar); a
|
|
|
+ 527 conversion between two of these is representation-preserving, so its
|
|
|
+ 528 folded value equals the operand's. *)
|
|
|
+ 529 VAR c: INTEGER;
|
|
|
+ 530 BEGIN
|
|
|
+ 531 c := SymTab.ClassOf(t);
|
|
|
+ 532 RETURN (c = SymTab.ClInt) OR (c = SymTab.ClChar) OR (c = SymTab.ClBool)
|
|
|
+ 533 OR (c = SymTab.ClEnum) OR (c = SymTab.ClUChar)
|
|
|
+ 534 OR (c = SymTab.ClByte) OR (c = SymTab.ClSByte)
|
|
|
+ 535 OR (c = SymTab.ClWord16) OR (c = SymTab.ClSWord16)
|
|
|
+ 536 END OrdClass;
|
|
|
+ 537
|
|
|
+ 538 PROCEDURE NoteSpan (pn: SymTab.Name; start: M2S.INT32): BOOLEAN;
|
|
|
+ 539 (* Records an outermost body span for the re-parse pass (milestone 2).
|
|
|
+ 540 FALSE when the span table is full (an implementation limit): the
|
|
|
+ 541 caller then parses the body inline instead of dropping it. *)
|
|
|
+ 542 BEGIN
|
|
|
+ 543 IF nSpans > HIGH(spanName) THEN RETURN FALSE END;
|
|
|
+ 544 CopyNm(pn, spanName[nSpans]);
|
|
|
+ 545 spanStart[nSpans] := start;
|
|
|
+ 546 spanIdx[nSpans] := SymTab.DeferBody();
|
|
|
+ 547 INC(nSpans);
|
|
|
+ 548 RETURN TRUE
|
|
|
+ 549 END NoteSpan;
|
|
|
+ 550
|
|
|
+ 551 PROCEDURE Openers (): BOOLEAN;
|
|
|
+ 552 (* TRUE when the current token opens a block that must be closed by an
|
|
|
+ 553 END (BEGIN is excluded: a block's BEGIN shares the declaration END;
|
|
|
+ 554 REPEAT..UNTIL and EXIT/RETURN need no END). *)
|
|
|
+ 555 BEGIN
|
|
|
+ 556 RETURN TokIs("MODULE") OR TokIs("PROCEDURE") OR TokIs("CLASS")
|
|
|
+ 557 OR TokIs("RECORD") OR TokIs("IF") OR TokIs("CASE")
|
|
|
+ 558 OR TokIs("WHILE") OR TokIs("FOR") OR TokIs("LOOP")
|
|
|
+ 559 OR TokIs("WITH")
|
|
|
+ 560 END Openers;
|
|
|
+ 561
|
|
|
+ 562 PROCEDURE DeferSkip (pn: SymTab.Name): BOOLEAN;
|
|
|
+ 563 (* Phase 1 of the deferral: skip the body starting at the current token
|
|
|
+ 564 (the first token after the heading's ';') up to the matching END,
|
|
|
+ 565 verify the END's name, and LEAVE the scanner positioned exactly at
|
|
|
+ 566 that END (so Block's trailing "END" ident consumes it for real), with
|
|
|
+ 567 the span recorded for the re-parse pass. On any inconsistency,
|
|
|
+ 568 restore the scanner and return FALSE so the caller parses normally. *)
|
|
|
+ 569 VAR depth, guard: CARDINAL;
|
|
|
+ 570 nm: SymTab.Name;
|
|
|
+ 571 ok: BOOLEAN;
|
|
|
+ 572 start, endPos: M2S.INT32;
|
|
|
+ 573 BEGIN
|
|
|
+ 574 deferredBody := FALSE;
|
|
|
+ 575 (* table full (an implementation limit): parse the body inline now,
|
|
|
+ 576 before touching the scanner, with a clear error. *)
|
|
|
+ 577 IF nSpans > HIGH(spanName) THEN
|
|
|
+ 578 SemError(230);
|
|
|
+ 579 RETURN FALSE
|
|
|
+ 580 END;
|
|
|
+ 581 start := M2S.nextPos;
|
|
|
+ 582 M2S.PushPos;
|
|
|
+ 583 depth := 0; guard := 0; ok := TRUE;
|
|
|
+ 584 LOOP
|
|
|
+ 585 IF sym = 0 THEN ok := FALSE; EXIT END;
|
|
|
+ 586 IF TokIs("END") THEN
|
|
|
+ 587 IF depth = 0 THEN EXIT END;
|
|
|
+ 588 DEC(depth)
|
|
|
+ 589 ELSIF Openers() THEN
|
|
|
+ 590 INC(depth)
|
|
|
+ 591 END;
|
|
|
+ 592 Adv;
|
|
|
+ 593 INC(guard);
|
|
|
+ 594 IF guard > 1000000 THEN ok := FALSE; EXIT END
|
|
|
+ 595 END;
|
|
|
+ 596 IF ok THEN
|
|
|
+ 597 (* sym is the matching END; check the name after it, then seek back
|
|
|
+ 598 so Block sees END (its "END" ident then consumes it for real). *)
|
|
|
+ 599 endPos := M2S.nextPos;
|
|
|
+ 600 Adv;
|
|
|
+ 601 M2S.GetName(M2S.nextPos, M2S.nextLen, nm);
|
|
|
+ 602 IF (sym = 0) OR NOT SymTab.Equal(nm, pn) THEN ok := FALSE END;
|
|
|
+ 603 IF ok THEN
|
|
|
+ 604 M2S.SeekTo(endPos); Adv
|
|
|
+ 605 END
|
|
|
+ 606 END;
|
|
|
+ 607 IF ok THEN
|
|
|
+ 608 IF NOT NoteSpan(pn, start) THEN
|
|
|
+ 609 (* defensive: capacity is checked at entry, so this is unreachable *)
|
|
|
+ 610 SemError(230);
|
|
|
+ 611 RETURN FALSE
|
|
|
+ 612 END;
|
|
|
+ 613 spanTy[nSpans - 1] := Lower.CurScopeProc();
|
|
|
+ 614 spanNode[nSpans - 1] := curProcNode;
|
|
|
+ 615 M2S.DropPos; (* keep the scanner at END; discard the snapshot *)
|
|
|
+ 616 deferredBody := TRUE;
|
|
|
+ 617 RETURN TRUE
|
|
|
+ 618 ELSE
|
|
|
+ 619 M2S.PopPos;
|
|
|
+ 620 FileIO.WriteString(FileIO.StdOut, "twophase defer mismatch in ");
|
|
|
+ 621 FileIO.WriteString(FileIO.StdOut, pn);
|
|
|
+ 622 FileIO.WriteLn(FileIO.StdOut);
|
|
|
+ 623 RETURN FALSE
|
|
|
+ 624 END
|
|
|
+ 625 END DeferSkip;
|
|
|
+ 626
|
|
|
+ 627 CHARACTERS
|
|
|
+ 628 eol = CHR(13) .
|
|
|
+ 629 lf = CHR(10) .
|
|
|
+ 630 letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" .
|
|
|
+ 631 digit = "0123456789" .
|
|
|
+ 632 hexDigit = digit + "ABCDEFabcdef" .
|
|
|
+ 633 noQuote1 = ANY - "'" - eol .
|
|
|
+ 634 noQuote2 = ANY - '"' - eol .
|
|
|
+ 635
|
|
|
+ 636 IGNORE CHR(9) .. CHR(13)
|
|
|
637
|
|
|
- 638 PRODUCTIONS
|
|
|
- 639 M2
|
|
|
- 640 = (. astCur := AST.NoNode; astStmt := AST.NoNode; astDecl := AST.NoNode; astImp := AST.NoNode; astImpTail := AST.NoNode;
|
|
|
- 641 astImp := AST.NoNode;
|
|
|
- 642 astImpTail := AST.NoNode;
|
|
|
- 643 nSpans := 0;
|
|
|
- 644 SymTab.DeferReset; .)
|
|
|
- 645 Unit "." (. IF SymTab.TypesOverflow() THEN
|
|
|
- 646 SemError(230) (* MaxTypes *)
|
|
|
- 647 END; .) .
|
|
|
- 648 (* Units: program modules compile fully; DEFINITION and
|
|
|
- 649 IMPLEMENTATION modules parse + check now but lower in step 4
|
|
|
- 650 (each ends with one 230); same for nested local modules. *)
|
|
|
- 651 (* Generics (Increment 1): formal and actual parameters. Formals are
|
|
|
- 652 TYPE parameters only; actuals are type identifiers. *)
|
|
|
- 653 GenericFormals
|
|
|
- 654 = "(" GenericFormal { ";" GenericFormal } ")" .
|
|
|
- 655 GenericFormal (. VAR nm: SymTab.Name; vt: SymTab.TypeIndex;
|
|
|
- 656 names: ARRAY [0 .. 15] OF SymTab.Name;
|
|
|
- 657 nn, k: CARDINAL;
|
|
|
- 658 mmod: SymTab.Name;
|
|
|
- 659 quid, qdep: CARDINAL;
|
|
|
- 660 qres: SymTab.TypeIndex;
|
|
|
- 661 qext: BOOLEAN;
|
|
|
- 662 cons: INTEGER;
|
|
|
- 663 cn: SymTab.Name;
|
|
|
- 664 isTypeFormal: BOOLEAN; .)
|
|
|
- 665 = (. nn := 0; .)
|
|
|
- 666 GetIdent<nm> (. k := 0;
|
|
|
- 667 WHILE (k <= HIGH(names[nn])) AND (nm[k] # CHR(0)) DO
|
|
|
- 668 names[nn][k] := nm[k]; INC(k) END;
|
|
|
- 669 names[nn][k] := CHR(0); INC(nn); .)
|
|
|
- 670 { "," GetIdent<nm> (. k := 0;
|
|
|
- 671 WHILE (k <= HIGH(names[nn])) AND (nm[k] # CHR(0)) DO
|
|
|
- 672 names[nn][k] := nm[k]; INC(k) END;
|
|
|
- 673 names[nn][k] := CHR(0); INC(nn); .) }
|
|
|
- 674 ":" (. vt := SymTab.InvalidType; isTypeFormal := FALSE; .)
|
|
|
- 675 ( "TYPE" (. isTypeFormal := TRUE; .)
|
|
|
- 676 [ "(" GetIdent<cn> ")" (. cons := ConsCode(cn); .) ]
|
|
|
- 677 | ProcType<vt> (. isTypeFormal := FALSE; .)
|
|
|
- 678 | TypeIdent<vt> ) (. k := 0;
|
|
|
- 679 WHILE k < nn DO
|
|
|
- 680 IF isTypeFormal THEN
|
|
|
- 681 IF instActive THEN
|
|
|
- 682 (* constraint: a type
|
|
|
- 683 formal needs a type
|
|
|
- 684 actual that satisfies
|
|
|
- 685 the declared constraint *)
|
|
|
- 686 IF InstActualKind(instFk) # 0 THEN
|
|
|
- 687 SemError(233)
|
|
|
- 688 ELSIF NOT ConsOk(cons, InstActualGet(instFk)) THEN
|
|
|
- 689 SemError(233)
|
|
|
- 690 ELSIF NOT SymTab.EnterTypeParamBound(names[k], InstActualGet(instFk)) THEN
|
|
|
- 691 SemError(200) END
|
|
|
- 692 ELSIF NOT SymTab.EnterTypeParam(names[k]) THEN
|
|
|
- 693 SemError(200) END
|
|
|
- 694 ELSIF SymTab.ClassOf(vt) = SymTab.ClProc THEN
|
|
|
- 695 (* procedure formal *)
|
|
|
- 696 IF instActive THEN
|
|
|
- 697 IF InstActualKind(instFk) # 2 THEN
|
|
|
- 698 SemError(233) END;
|
|
|
- 699 InstActualMod(instFk, mmod);
|
|
|
- 700 InstActualVal(instFk, nm);
|
|
|
- 701 IF NOT SymTab.AliasProc(names[k], mmod, nm) THEN
|
|
|
- 702 SemError(201)
|
|
|
- 703 ELSIF SymTab.QualProcInfo(mmod, nm, quid, qdep, qres, qext) THEN
|
|
|
- 704 Lower.AliasProc(names[k], quid, qres, qdep, qext)
|
|
|
- 705 END
|
|
|
- 706 ELSE
|
|
|
- 707 (* template: a callable
|
|
|
- 708 placeholder of the
|
|
|
- 709 formal's proc type *)
|
|
|
- 710 IF NOT SymTab.Enter(names[k], SymTab.KindVar) THEN
|
|
|
- 711 SemError(200) END;
|
|
|
- 712 SymTab.SetSymType(names[k], vt)
|
|
|
- 713 END
|
|
|
- 714 ELSE
|
|
|
- 715 (* constraint: a value
|
|
|
- 716 formal needs a value
|
|
|
- 717 actual *)
|
|
|
- 718 IF instActive AND (InstActualKind(instFk) # 1) THEN
|
|
|
- 719 SemError(233) END;
|
|
|
- 720 IF NOT SymTab.Enter(names[k], SymTab.KindConst) THEN
|
|
|
- 721 SemError(200) END;
|
|
|
- 722 SymTab.SetSymType(names[k], vt);
|
|
|
- 723 IF instActive THEN
|
|
|
- 724 InstActualVal(instFk, nm);
|
|
|
- 725 SymTab.SetSymVal(names[k], nm)
|
|
|
- 726 ELSE SymTab.SetSymVal(names[k], "0")
|
|
|
- 727 END
|
|
|
- 728 END;
|
|
|
- 729 INC(instFk); INC(k)
|
|
|
- 730 END; .) .
|
|
|
- 731 Actuals
|
|
|
- 732 = Actual { "," Actual } .
|
|
|
- 733 Actual (. VAR at: SymTab.TypeIndex;
|
|
|
- 734 nm: SymTab.Name;
|
|
|
- 735 s: ARRAY [0 .. 255] OF CHAR;
|
|
|
- 736 qv: QbeGen.QVal;
|
|
|
- 737 isCh, isV: BOOLEAN;
|
|
|
- 738 aKind: INTEGER;
|
|
|
- 739 amod: SymTab.Name;
|
|
|
- 740 nm2: SymTab.Name;
|
|
|
- 741 qu, qd: CARDINAL;
|
|
|
- 742 qr: SymTab.TypeIndex;
|
|
|
- 743 qe: BOOLEAN;
|
|
|
- 744 k: CARDINAL; .)
|
|
|
- 745 = (. isV := FALSE; at := SymTab.InvalidType;
|
|
|
- 746 nm[0] := CHR(0); nm2[0] := CHR(0);
|
|
|
- 747 aKind := 0; amod[0] := CHR(0); .)
|
|
|
- 748 ( integer (. LexString(s); QbeGen.NormInt(s, qv);
|
|
|
- 749 isV := TRUE; aKind := 1; at := SymTab.IntType();
|
|
|
- 750 CopyNm(qv, nm); .)
|
|
|
- 751 | charConst (. LexString(s); QbeGen.NormLit(s, qv, isCh);
|
|
|
- 752 isV := TRUE; aKind := 1; at := SymTab.CharType();
|
|
|
- 753 CopyNm(qv, nm); .)
|
|
|
- 754 | GetIdent<nm> [ "." GetIdent<nm2> ]
|
|
|
- 755 (. isV := FALSE; at := SymTab.InvalidType;
|
|
|
- 756 aKind := 0; amod[0] := CHR(0);
|
|
|
- 757 IF nm2[0] # CHR(0) THEN
|
|
|
- 758 (* qualified actual Mod.Name:
|
|
|
- 759 a nested instance's type
|
|
|
- 760 (Mod.Type) or a procedure
|
|
|
- 761 (Mod.Proc); no import
|
|
|
- 762 needed *)
|
|
|
- 763 IF SymTab.QualProcInfo(nm, nm2,
|
|
|
- 764 qu, qd, qr, qe) THEN
|
|
|
- 765 aKind := 2
|
|
|
- 766 ELSE at := SymTab.QualType(nm, nm2);
|
|
|
- 767 IF at # SymTab.InvalidType THEN
|
|
|
- 768 aKind := 0
|
|
|
- 769 ELSE SemError(201);
|
|
|
- 770 aKind := 0; at := SymTab.InvalidType
|
|
|
- 771 END
|
|
|
- 772 END;
|
|
|
- 773 CopyNm(nm, amod);
|
|
|
- 774 CopyNm(nm2, nm)
|
|
|
- 775 ELSIF SymTab.Lookup(nm)
|
|
|
- 776 AND ((SymTab.SymKind(nm) = SymTab.KindType)
|
|
|
- 777 OR (SymTab.SymKind(nm) = SymTab.KindPredef)) THEN
|
|
|
- 778 at := SymTab.SymType(nm)
|
|
|
- 779 ELSIF SymTab.Lookup(nm)
|
|
|
- 780 AND (SymTab.SymKind(nm) = SymTab.KindProc) THEN
|
|
|
- 781 aKind := 2; at := SymTab.SymType(nm);
|
|
|
- 782 IF NOT SymTab.SymMod(nm, amod) THEN
|
|
|
- 783 amod[0] := CHR(0) END
|
|
|
- 784 ELSIF SymTab.Lookup(nm)
|
|
|
- 785 AND (SymTab.SymKind(nm) = SymTab.KindConst) THEN
|
|
|
- 786 isV := TRUE; aKind := 1; at := SymTab.SymType(nm);
|
|
|
- 787 IF NOT SymTab.GetSymVal(nm, s) THEN s[0] := CHR(0) END;
|
|
|
- 788 CopyNm(s, nm)
|
|
|
- 789 ELSE SemError(201)
|
|
|
- 790 END; .) )
|
|
|
- 791 (. IF refN <= HIGH(refActual) THEN
|
|
|
- 792 IF aKind = 0 THEN
|
|
|
- 793 IF isV THEN refKind[refN] := 1
|
|
|
- 794 ELSE refKind[refN] := 0 END
|
|
|
- 795 ELSE refKind[refN] := aKind END;
|
|
|
- 796 refActual[refN] := at;
|
|
|
- 797 k := 0;
|
|
|
- 798 WHILE (k <= HIGH(refVal[refN])) AND (nm[k] # CHR(0)) DO
|
|
|
- 799 refVal[refN][k] := nm[k]; INC(k) END;
|
|
|
- 800 refVal[refN][k] := CHR(0);
|
|
|
- 801 k := 0;
|
|
|
- 802 WHILE (k <= HIGH(refMod[refN])) AND (amod[k] # CHR(0)) DO
|
|
|
- 803 refMod[refN][k] := amod[k]; INC(k) END;
|
|
|
- 804 refMod[refN][k] := CHR(0);
|
|
|
- 805 INC(refN)
|
|
|
- 806 END; .) .
|
|
|
- 807 Unit
|
|
|
- 808 = (. isGen := FALSE;
|
|
|
- 809 allowDefer := FALSE;
|
|
|
- 810 allowFwdType := FALSE;
|
|
|
- 811 repassing := FALSE; .)
|
|
|
- 812 [ "GENERIC" (. isGen := TRUE; .) ]
|
|
|
- 813 ( DefUnit | ImplUnit | ProgModule ) .
|
|
|
- 814 (* Step 4.3: one session compiles DEFINITION, its IMPLEMENTATION
|
|
|
- 815 and one program (last) into one image. Units share the symbol
|
|
|
- 816 table; imports materialize exported names. *)
|
|
|
- 817 DefUnit (. VAR m1, m2, pn: SymTab.Name;
|
|
|
- 818 g: SymTab.Name;
|
|
|
- 819 astSeq, astTail, astProc: AST.Node; .)
|
|
|
- 820 = (. refN := 0; refSeen := FALSE; .)
|
|
|
- 821 "DEFINITION" "MODULE"
|
|
|
- 822 [ "FOR" string ] (* ISO foreign module: FOR "C" *)
|
|
|
- 823 GetIdent<m1> (. IF instActive THEN InstNameGet(m1) END;
|
|
|
- 824 IF instActive THEN
|
|
|
- 825 IF NOT SymTab.Reenter(m1,
|
|
|
- 826 SymTab.UnitDef) THEN
|
|
|
- 827 SemError(200) END
|
|
|
- 828 ELSIF NOT SymTab.BeginDef(m1) THEN
|
|
|
- 829 SemError(200) END;
|
|
|
- 830 QbeGen.SetModule(m1);
|
|
|
- 831 CopyNm(m1, unitName);
|
|
|
- 832 unitWasGen := isGen
|
|
|
- 833 AND NOT instActive;
|
|
|
- 834 unitWasDef := TRUE; .)
|
|
|
- 835 [ GenericFormals ]
|
|
|
- 836 ( ";"
|
|
|
- 837 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
- 838 astImp, astImpTail, astDecl); .) }
|
|
|
- 839 [ "EXPORT" [ "QUALIFIED" | "UNQUALIFIED" ] (. (* definition-module export
|
|
|
- 840 list: parsed, and the
|
|
|
- 841 names are already exported
|
|
|
- 842 by the module scope *) .)
|
|
|
- 843 GetIdent<pn> { "," GetIdent<pn> } ";" ]
|
|
|
- 844 (. astSeq := AST.NoNode;
|
|
|
- 845 astTail := AST.NoNode; .)
|
|
|
- 846 { ConstBlock (. AstAppend(AST.NkDeclSeq,
|
|
|
- 847 astSeq, astTail, astDecl); .)
|
|
|
- 848 | TypeBlock<TRUE> (. AstAppend(AST.NkDeclSeq,
|
|
|
- 849 astSeq, astTail, astDecl); .)
|
|
|
- 850 | VarBlock (. AstAppend(AST.NkDeclSeq,
|
|
|
- 851 astSeq, astTail, astDecl); .)
|
|
|
- 852 | ProcHeading<pn, SymTab.InvalidType> ";"
|
|
|
- 853 (. (* a heading only: record it so
|
|
|
- 854 Lower can replay it *)
|
|
|
- 855 astProc := AST.MakeNode(AST.NkProcDecl);
|
|
|
- 856 AST.SetOp(astProc, 0);
|
|
|
- 857 AST.SetChild(astProc, 0,
|
|
|
- 858 AST.MakeLeaf(AST.NkIdent, pn));
|
|
|
- 859 AstAppend(AST.NkDeclSeq,
|
|
|
- 860 astSeq, astTail, astProc);
|
|
|
- 861 Lower.NoteProcNode(astProc);
|
|
|
- 862 Lower.ScopeLeave;
|
|
|
- 863 SymTab.CloseProc;
|
|
|
- 864 QbeGen.AbortFunc; .) }
|
|
|
- 865 (. astUnit := AST.MakeNode(AST.NkUnit);
|
|
|
- 866 AST.SetChild(astUnit, 0,
|
|
|
- 867 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
- 868 AST.SetChild(astUnit, 1, astSeq);
|
|
|
- 869 AST.SetChild(astUnit, 3, astImp);
|
|
|
- 870 astDecl := AST.NoNode;
|
|
|
- 871 astStmt := AST.NoNode; .)
|
|
|
- 872 "END"
|
|
|
- 873 GetIdent<m2> (. IF instActive THEN InstNameGet(m2) END;
|
|
|
- 874 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
- 875 SemError(202) END;
|
|
|
- 876 SymTab.EndUnit; .)
|
|
|
- 877 | "=" GetIdent<g> [ "(" Actuals ")" ] ";"
|
|
|
- 878 (. CopyNm(m1, refInst);
|
|
|
- 879 CopyNm(g, refGen);
|
|
|
- 880 refSeen := TRUE; refIsDef := TRUE;
|
|
|
- 881 astUnit := AST.MakeNode(AST.NkUnit);
|
|
|
+ 638 COMMENTS FROM "(*" TO "*)" NESTED
|
|
|
+ 639 COMMENTS FROM "//" TO lf
|
|
|
+ 640
|
|
|
+ 641 TOKENS
|
|
|
+ 642 ident = ( letter | "_" ) { letter | digit | "_" } .
|
|
|
+ 643 integer = digit { digit }
|
|
|
+ 644 | digit { digit } CONTEXT("..")
|
|
|
+ 645 | "0x" hexDigit { hexDigit }
|
|
|
+ 646 | "0X" hexDigit { hexDigit } .
|
|
|
+ 647 real = digit { digit } "." { digit }
|
|
|
+ 648 [ ( "E" | "e" ) [ "+" | "-" ] digit { digit } ] .
|
|
|
+ 649 string = "'" { noQuote1 } "'"
|
|
|
+ 650 | '"' { noQuote2 } '"' .
|
|
|
+ 651 charConst = digit { digit } ( "C" | "c" ) .
|
|
|
+ 652 ustring = ( "U" | "u" ) ( "'" { noQuote1 } "'" | '"' { noQuote2 } '"' ) .
|
|
|
+ 653
|
|
|
+ 654 PRODUCTIONS
|
|
|
+ 655 M2
|
|
|
+ 656 = (. astCur := AST.NoNode; astStmt := AST.NoNode; astDecl := AST.NoNode; astImp := AST.NoNode; astImpTail := AST.NoNode;
|
|
|
+ 657 astImp := AST.NoNode;
|
|
|
+ 658 astImpTail := AST.NoNode;
|
|
|
+ 659 nSpans := 0;
|
|
|
+ 660 SymTab.DeferReset; .)
|
|
|
+ 661 Unit "." (. IF SymTab.TypesOverflow() THEN
|
|
|
+ 662 SemError(230) (* MaxTypes *)
|
|
|
+ 663 END; .) .
|
|
|
+ 664 (* Units: program modules compile fully; DEFINITION and
|
|
|
+ 665 IMPLEMENTATION modules parse + check now but lower in step 4
|
|
|
+ 666 (each ends with one 230); same for nested local modules. *)
|
|
|
+ 667 (* Generics (Increment 1): formal and actual parameters. Formals are
|
|
|
+ 668 TYPE parameters only; actuals are type identifiers. *)
|
|
|
+ 669 GenericFormals
|
|
|
+ 670 = "(" GenericFormal { ";" GenericFormal } ")" .
|
|
|
+ 671 GenericFormal (. VAR nm: SymTab.Name; vt: SymTab.TypeIndex;
|
|
|
+ 672 names: ARRAY [0 .. 15] OF SymTab.Name;
|
|
|
+ 673 nn, k: CARDINAL;
|
|
|
+ 674 mmod: SymTab.Name;
|
|
|
+ 675 quid, qdep: CARDINAL;
|
|
|
+ 676 qres: SymTab.TypeIndex;
|
|
|
+ 677 qext: BOOLEAN;
|
|
|
+ 678 cons: INTEGER;
|
|
|
+ 679 cn: SymTab.Name;
|
|
|
+ 680 isTypeFormal: BOOLEAN; .)
|
|
|
+ 681 = (. nn := 0; .)
|
|
|
+ 682 GetIdent<nm> (. k := 0;
|
|
|
+ 683 WHILE (k <= HIGH(names[nn])) AND (nm[k] # CHR(0)) DO
|
|
|
+ 684 names[nn][k] := nm[k]; INC(k) END;
|
|
|
+ 685 names[nn][k] := CHR(0); INC(nn); .)
|
|
|
+ 686 { "," GetIdent<nm> (. k := 0;
|
|
|
+ 687 WHILE (k <= HIGH(names[nn])) AND (nm[k] # CHR(0)) DO
|
|
|
+ 688 names[nn][k] := nm[k]; INC(k) END;
|
|
|
+ 689 names[nn][k] := CHR(0); INC(nn); .) }
|
|
|
+ 690 ":" (. vt := SymTab.InvalidType; isTypeFormal := FALSE; .)
|
|
|
+ 691 ( "TYPE" (. isTypeFormal := TRUE; .)
|
|
|
+ 692 [ "(" GetIdent<cn> ")" (. cons := ConsCode(cn); .) ]
|
|
|
+ 693 | ProcType<vt> (. isTypeFormal := FALSE; .)
|
|
|
+ 694 | TypeIdent<vt> ) (. k := 0;
|
|
|
+ 695 WHILE k < nn DO
|
|
|
+ 696 IF isTypeFormal THEN
|
|
|
+ 697 IF instActive THEN
|
|
|
+ 698 (* constraint: a type
|
|
|
+ 699 formal needs a type
|
|
|
+ 700 actual that satisfies
|
|
|
+ 701 the declared constraint *)
|
|
|
+ 702 IF InstActualKind(instFk) # 0 THEN
|
|
|
+ 703 SemError(233)
|
|
|
+ 704 ELSIF NOT ConsOk(cons, InstActualGet(instFk)) THEN
|
|
|
+ 705 SemError(233)
|
|
|
+ 706 ELSIF NOT SymTab.EnterTypeParamBound(names[k], InstActualGet(instFk)) THEN
|
|
|
+ 707 SemError(200) END
|
|
|
+ 708 ELSIF NOT SymTab.EnterTypeParam(names[k]) THEN
|
|
|
+ 709 SemError(200) END
|
|
|
+ 710 ELSIF SymTab.ClassOf(vt) = SymTab.ClProc THEN
|
|
|
+ 711 (* procedure formal *)
|
|
|
+ 712 IF instActive THEN
|
|
|
+ 713 IF InstActualKind(instFk) # 2 THEN
|
|
|
+ 714 SemError(233) END;
|
|
|
+ 715 InstActualMod(instFk, mmod);
|
|
|
+ 716 InstActualVal(instFk, nm);
|
|
|
+ 717 IF NOT SymTab.AliasProc(names[k], mmod, nm) THEN
|
|
|
+ 718 SemError(201)
|
|
|
+ 719 ELSIF SymTab.QualProcInfo(mmod, nm, quid, qdep, qres, qext) THEN
|
|
|
+ 720 Lower.AliasProc(names[k], quid, qres, qdep, qext)
|
|
|
+ 721 END
|
|
|
+ 722 ELSE
|
|
|
+ 723 (* template: a callable
|
|
|
+ 724 placeholder of the
|
|
|
+ 725 formal's proc type *)
|
|
|
+ 726 IF NOT SymTab.Enter(names[k], SymTab.KindVar) THEN
|
|
|
+ 727 SemError(200) END;
|
|
|
+ 728 SymTab.SetSymType(names[k], vt)
|
|
|
+ 729 END
|
|
|
+ 730 ELSE
|
|
|
+ 731 (* constraint: a value
|
|
|
+ 732 formal needs a value
|
|
|
+ 733 actual *)
|
|
|
+ 734 IF instActive AND (InstActualKind(instFk) # 1) THEN
|
|
|
+ 735 SemError(233) END;
|
|
|
+ 736 IF NOT SymTab.Enter(names[k], SymTab.KindConst) THEN
|
|
|
+ 737 SemError(200) END;
|
|
|
+ 738 SymTab.SetSymType(names[k], vt);
|
|
|
+ 739 IF instActive THEN
|
|
|
+ 740 InstActualVal(instFk, nm);
|
|
|
+ 741 SymTab.SetSymVal(names[k], nm)
|
|
|
+ 742 ELSE SymTab.SetSymVal(names[k], "0")
|
|
|
+ 743 END
|
|
|
+ 744 END;
|
|
|
+ 745 INC(instFk); INC(k)
|
|
|
+ 746 END; .) .
|
|
|
+ 747 Actuals
|
|
|
+ 748 = Actual { "," Actual } .
|
|
|
+ 749 Actual (. VAR at: SymTab.TypeIndex;
|
|
|
+ 750 nm: SymTab.Name;
|
|
|
+ 751 s: ARRAY [0 .. 255] OF CHAR;
|
|
|
+ 752 qv: QbeGen.QVal;
|
|
|
+ 753 isCh, isV: BOOLEAN;
|
|
|
+ 754 aKind: INTEGER;
|
|
|
+ 755 amod: SymTab.Name;
|
|
|
+ 756 nm2: SymTab.Name;
|
|
|
+ 757 qu, qd: CARDINAL;
|
|
|
+ 758 qr: SymTab.TypeIndex;
|
|
|
+ 759 qe: BOOLEAN;
|
|
|
+ 760 k: CARDINAL; .)
|
|
|
+ 761 = (. isV := FALSE; at := SymTab.InvalidType;
|
|
|
+ 762 nm[0] := CHR(0); nm2[0] := CHR(0);
|
|
|
+ 763 aKind := 0; amod[0] := CHR(0); .)
|
|
|
+ 764 ( integer (. LexString(s); QbeGen.NormInt(s, qv);
|
|
|
+ 765 isV := TRUE; aKind := 1; at := SymTab.IntType();
|
|
|
+ 766 CopyNm(qv, nm); .)
|
|
|
+ 767 | charConst (. LexString(s); QbeGen.NormLit(s, qv, isCh);
|
|
|
+ 768 isV := TRUE; aKind := 1; at := SymTab.CharType();
|
|
|
+ 769 CopyNm(qv, nm); .)
|
|
|
+ 770 | GetIdent<nm> [ "." GetIdent<nm2> ]
|
|
|
+ 771 (. isV := FALSE; at := SymTab.InvalidType;
|
|
|
+ 772 aKind := 0; amod[0] := CHR(0);
|
|
|
+ 773 IF nm2[0] # CHR(0) THEN
|
|
|
+ 774 (* qualified actual Mod.Name:
|
|
|
+ 775 a nested instance's type
|
|
|
+ 776 (Mod.Type) or a procedure
|
|
|
+ 777 (Mod.Proc); no import
|
|
|
+ 778 needed *)
|
|
|
+ 779 IF SymTab.QualProcInfo(nm, nm2,
|
|
|
+ 780 qu, qd, qr, qe) THEN
|
|
|
+ 781 aKind := 2
|
|
|
+ 782 ELSE at := SymTab.QualType(nm, nm2);
|
|
|
+ 783 IF at # SymTab.InvalidType THEN
|
|
|
+ 784 aKind := 0
|
|
|
+ 785 ELSE SemError(201);
|
|
|
+ 786 aKind := 0; at := SymTab.InvalidType
|
|
|
+ 787 END
|
|
|
+ 788 END;
|
|
|
+ 789 CopyNm(nm, amod);
|
|
|
+ 790 CopyNm(nm2, nm)
|
|
|
+ 791 ELSIF SymTab.Lookup(nm)
|
|
|
+ 792 AND ((SymTab.SymKind(nm) = SymTab.KindType)
|
|
|
+ 793 OR (SymTab.SymKind(nm) = SymTab.KindPredef)) THEN
|
|
|
+ 794 at := SymTab.SymType(nm)
|
|
|
+ 795 ELSIF SymTab.Lookup(nm)
|
|
|
+ 796 AND (SymTab.SymKind(nm) = SymTab.KindProc) THEN
|
|
|
+ 797 aKind := 2; at := SymTab.SymType(nm);
|
|
|
+ 798 IF NOT SymTab.SymMod(nm, amod) THEN
|
|
|
+ 799 amod[0] := CHR(0) END
|
|
|
+ 800 ELSIF SymTab.Lookup(nm)
|
|
|
+ 801 AND (SymTab.SymKind(nm) = SymTab.KindConst) THEN
|
|
|
+ 802 isV := TRUE; aKind := 1; at := SymTab.SymType(nm);
|
|
|
+ 803 IF NOT SymTab.GetSymVal(nm, s) THEN s[0] := CHR(0) END;
|
|
|
+ 804 CopyNm(s, nm)
|
|
|
+ 805 ELSE SemError(201)
|
|
|
+ 806 END; .) )
|
|
|
+ 807 (. IF refN <= HIGH(refActual) THEN
|
|
|
+ 808 IF aKind = 0 THEN
|
|
|
+ 809 IF isV THEN refKind[refN] := 1
|
|
|
+ 810 ELSE refKind[refN] := 0 END
|
|
|
+ 811 ELSE refKind[refN] := aKind END;
|
|
|
+ 812 refActual[refN] := at;
|
|
|
+ 813 k := 0;
|
|
|
+ 814 WHILE (k <= HIGH(refVal[refN])) AND (nm[k] # CHR(0)) DO
|
|
|
+ 815 refVal[refN][k] := nm[k]; INC(k) END;
|
|
|
+ 816 refVal[refN][k] := CHR(0);
|
|
|
+ 817 k := 0;
|
|
|
+ 818 WHILE (k <= HIGH(refMod[refN])) AND (amod[k] # CHR(0)) DO
|
|
|
+ 819 refMod[refN][k] := amod[k]; INC(k) END;
|
|
|
+ 820 refMod[refN][k] := CHR(0);
|
|
|
+ 821 INC(refN)
|
|
|
+ 822 END; .) .
|
|
|
+ 823 Unit
|
|
|
+ 824 = (. isGen := FALSE;
|
|
|
+ 825 allowDefer := FALSE;
|
|
|
+ 826 allowFwdType := FALSE;
|
|
|
+ 827 repassing := FALSE; .)
|
|
|
+ 828 [ "GENERIC" (. isGen := TRUE; .) ]
|
|
|
+ 829 ( DefUnit | ImplUnit | ProgModule ) .
|
|
|
+ 830 (* Step 4.3: one session compiles DEFINITION, its IMPLEMENTATION
|
|
|
+ 831 and one program (last) into one image. Units share the symbol
|
|
|
+ 832 table; imports materialize exported names. *)
|
|
|
+ 833 DefUnit (. VAR m1, m2, pn: SymTab.Name;
|
|
|
+ 834 g: SymTab.Name;
|
|
|
+ 835 astSeq, astTail, astProc: AST.Node; .)
|
|
|
+ 836 = (. refN := 0; refSeen := FALSE; .)
|
|
|
+ 837 "DEFINITION" "MODULE"
|
|
|
+ 838 [ "FOR" string ] (* ISO foreign module: FOR "C" *)
|
|
|
+ 839 GetIdent<m1> (. IF instActive THEN InstNameGet(m1) END;
|
|
|
+ 840 IF instActive THEN
|
|
|
+ 841 IF NOT SymTab.Reenter(m1,
|
|
|
+ 842 SymTab.UnitDef) THEN
|
|
|
+ 843 SemError(200) END
|
|
|
+ 844 ELSIF NOT SymTab.BeginDef(m1) THEN
|
|
|
+ 845 SemError(200) END;
|
|
|
+ 846 QbeGen.SetModule(m1);
|
|
|
+ 847 CopyNm(m1, unitName);
|
|
|
+ 848 unitWasGen := isGen
|
|
|
+ 849 AND NOT instActive;
|
|
|
+ 850 unitWasDef := TRUE; .)
|
|
|
+ 851 [ GenericFormals ]
|
|
|
+ 852 ( ";"
|
|
|
+ 853 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 854 astImp, astImpTail, astDecl); .) }
|
|
|
+ 855 [ "EXPORT" [ "QUALIFIED" | "UNQUALIFIED" ] (. (* definition-module export
|
|
|
+ 856 list: parsed, and the
|
|
|
+ 857 names are already exported
|
|
|
+ 858 by the module scope *) .)
|
|
|
+ 859 GetIdent<pn> { "," GetIdent<pn> } ";" ]
|
|
|
+ 860 (. astSeq := AST.NoNode;
|
|
|
+ 861 astTail := AST.NoNode; .)
|
|
|
+ 862 { ConstBlock (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 863 astSeq, astTail, astDecl); .)
|
|
|
+ 864 | TypeBlock<TRUE> (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 865 astSeq, astTail, astDecl); .)
|
|
|
+ 866 | VarBlock (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 867 astSeq, astTail, astDecl); .)
|
|
|
+ 868 | ProcHeading<pn, SymTab.InvalidType> ";"
|
|
|
+ 869 (. (* a heading only: record it so
|
|
|
+ 870 Lower can replay it *)
|
|
|
+ 871 astProc := AST.MakeNode(AST.NkProcDecl);
|
|
|
+ 872 AST.SetOp(astProc, 0);
|
|
|
+ 873 AST.SetChild(astProc, 0,
|
|
|
+ 874 AST.MakeLeaf(AST.NkIdent, pn));
|
|
|
+ 875 AstAppend(AST.NkDeclSeq,
|
|
|
+ 876 astSeq, astTail, astProc);
|
|
|
+ 877 Lower.NoteProcNode(astProc);
|
|
|
+ 878 Lower.ScopeLeave;
|
|
|
+ 879 SymTab.CloseProc;
|
|
|
+ 880 QbeGen.AbortFunc; .) }
|
|
|
+ 881 (. astUnit := AST.MakeNode(AST.NkUnit);
|
|
|
882 AST.SetChild(astUnit, 0,
|
|
|
883 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
- 884 astDecl := AST.NoNode;
|
|
|
- 885 astStmt := AST.NoNode; .)
|
|
|
- 886 "END"
|
|
|
- 887 GetIdent<m2> (. IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
- 888 SemError(202) END;
|
|
|
- 889 SymTab.EndUnit; .) ) .
|
|
|
- 890 ImplUnit (. VAR m1, m2: SymTab.Name;
|
|
|
- 891 g: SymTab.Name;
|
|
|
- 892 k: CARDINAL;
|
|
|
- 893 rp: CARDINAL;
|
|
|
- 894 rpOk: BOOLEAN;
|
|
|
- 895 rErrs: INTEGER;
|
|
|
- 896 rDecl, rStmt: AST.Node;
|
|
|
- 897 rnm: SymTab.Name;
|
|
|
- 898 rSym, rErr: CARDINAL;
|
|
|
- 899 fname: SymTab.Name;
|
|
|
- 900 unres: BOOLEAN;
|
|
|
- 901 astNode: AST.Node; .)
|
|
|
- 902 = (. refN := 0; refSeen := FALSE; .)
|
|
|
- 903 "IMPLEMENTATION" "MODULE"
|
|
|
- 904 [ "FOR" string ] (* ISO foreign module: FOR "C" *)
|
|
|
- 905 GetIdent<m1> (. IF instActive THEN InstNameGet(m1) END;
|
|
|
- 906 IF instActive THEN
|
|
|
- 907 IF NOT SymTab.Reenter(m1,
|
|
|
- 908 SymTab.UnitImpl) THEN
|
|
|
- 909 SemError(201) END
|
|
|
- 910 ELSIF NOT SymTab.BeginImpl(m1) THEN
|
|
|
- 911 SemError(201) END;
|
|
|
- 912 astStmt := AST.NoNode;
|
|
|
- 913 astDecl := AST.NoNode;
|
|
|
- 914 astImp := AST.NoNode;
|
|
|
- 915 astImpTail := AST.NoNode;
|
|
|
- 916 nPendVar := 0;
|
|
|
- 917 CopyNm(m1, unitName);
|
|
|
- 918 unitWasGen := isGen AND NOT instActive;
|
|
|
- 919 unitWasDef := FALSE;
|
|
|
- 920 QbeGen.SetModule(m1); .)
|
|
|
- 921 [ GenericFormals ]
|
|
|
- 922 ( ";"
|
|
|
- 923 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
- 924 astImp, astImpTail, astDecl); .) }
|
|
|
- 925 DeclSeq (. astStmt := AST.NoNode; .)
|
|
|
- 926 [ "BEGIN" (. FlushPend;
|
|
|
- 927 k := 0;
|
|
|
- 928 WHILE k < SymTab.FwdPending() DO
|
|
|
- 929 SymTab.FwdInfo(k, fname, unres);
|
|
|
- 930 IF unres THEN SemError(201) END;
|
|
|
- 931 INC(k)
|
|
|
- 932 END;
|
|
|
- 933 SymTab.FwdClear;
|
|
|
- 934
|
|
|
- 935 nLab := 0; nGot := 0; .)
|
|
|
- 936 [ StatSeq ] ]
|
|
|
- 937 (. IF twoPhaseParse THEN
|
|
|
- 938 rSym := sym; rErr := errDist;
|
|
|
- 939 rDecl := astDecl; rStmt := astStmt;
|
|
|
- 940 M2S.PushPos;
|
|
|
- 941 repassing := TRUE;
|
|
|
- 942 rp := 0;
|
|
|
- 943 WHILE rp < nSpans DO
|
|
|
- 944 k := 0;
|
|
|
- 945 WHILE (k <= HIGH(rnm))
|
|
|
- 946 AND (spanName[rp][k] # CHR(0)) DO
|
|
|
- 947 rnm[k] := spanName[rp][k]; INC(k)
|
|
|
- 948 END;
|
|
|
- 949 rnm[k] := CHR(0);
|
|
|
- 950 M2S.SeekTo(spanStart[rp]);
|
|
|
- 951 Adv;
|
|
|
- 952 rpOk := SymTab.ReenterDeferred(spanIdx[rp]);
|
|
|
- 953 IF NOT rpOk THEN
|
|
|
- 954 FileIO.WriteString(FileIO.StdOut,
|
|
|
- 955 "twophase reenter failed");
|
|
|
- 956 FileIO.WriteLn(FileIO.StdOut)
|
|
|
- 957 END;
|
|
|
- 958 Lower.ReenterScopeProc(spanTy[rp]);
|
|
|
- 959 QbeGen.BeginFunc("");
|
|
|
- 960 CopyNm(rnm, curFun);
|
|
|
- 961 Block(rnm);
|
|
|
- 962 AST.SetChild(spanNode[rp], 1, astStmt);
|
|
|
- 963 AST.SetChild(spanNode[rp], 2, astBlkDecls);
|
|
|
- 964 Lower.ScopeLeave;
|
|
|
- 965 SymTab.CloseProc;
|
|
|
- 966 QbeGen.EndFunc(SymTab.ProcRes(rnm));
|
|
|
- 967 INC(rp)
|
|
|
- 968 END;
|
|
|
- 969 curFun[0] := CHR(0);
|
|
|
- 970 SymTab.OrderCheckOff; rErrs := M2S.errors;
|
|
|
- 971 repassing := FALSE;
|
|
|
- 972 M2S.PopPos;
|
|
|
- 973 sym := rSym; errDist := rErr;
|
|
|
- 974 M2S.errors := rErrs;
|
|
|
- 975
|
|
|
- 976 astDecl := rDecl; astStmt := rStmt
|
|
|
- 977 END; .)
|
|
|
- 978 "END"
|
|
|
- 979 GetIdent<m2> (. IF instActive THEN InstNameGet(m2) END;
|
|
|
- 980 FlushPend;
|
|
|
- 981 k := 0;
|
|
|
- 982 WHILE k < SymTab.FwdPending() DO
|
|
|
- 983 SymTab.FwdInfo(k, fname, unres);
|
|
|
- 984 IF unres THEN SemError(201) END;
|
|
|
- 985 INC(k)
|
|
|
- 986 END;
|
|
|
- 987 SymTab.FwdClear;
|
|
|
- 988
|
|
|
- 989 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
- 990 AST.SetChild(astNode, 0,
|
|
|
- 991 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
- 992 AST.SetChild(astNode, 1, astDecl);
|
|
|
- 993 AST.SetChild(astNode, 2, astStmt);
|
|
|
- 994 AST.SetChild(astNode, 3, astImp);
|
|
|
- 995 astUnit := astNode;
|
|
|
- 996 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
- 997 SemError(202) END;
|
|
|
- 998 CheckGotos;
|
|
|
- 999 SymTab.EndUnit; .)
|
|
|
- 1000 | "=" GetIdent<g> [ "(" Actuals ")" ] ";"
|
|
|
- 1001 (. CopyNm(m1, refInst);
|
|
|
- 1002 CopyNm(g, refGen);
|
|
|
- 1003 refSeen := TRUE; refIsDef := FALSE;
|
|
|
- 1004 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
- 1005 AST.SetChild(astNode, 0,
|
|
|
- 1006 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
- 1007 astDecl := AST.NoNode;
|
|
|
- 1008 astStmt := AST.NoNode; .)
|
|
|
- 1009 { Import (. (* refinement unit import *) .) }
|
|
|
- 1010 "END"
|
|
|
- 1011 GetIdent<m2> (. IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
- 1012 SemError(202) END;
|
|
|
- 1013 SymTab.EndUnit; .) ) .
|
|
|
- 1014 ProgModule (. VAR m1, m2: SymTab.Name;
|
|
|
- 1015 k: CARDINAL;
|
|
|
- 1016 rp: CARDINAL;
|
|
|
- 1017 rpOk: BOOLEAN;
|
|
|
- 1018 rErrs: INTEGER;
|
|
|
- 1019 rDecl, rStmt: AST.Node;
|
|
|
- 1020 rnm: SymTab.Name;
|
|
|
- 1021 rSym, rErr: CARDINAL;
|
|
|
- 1022 fname: SymTab.Name;
|
|
|
- 1023 unres: BOOLEAN;
|
|
|
- 1024 astNode: AST.Node; .)
|
|
|
- 1025 = "MODULE"
|
|
|
- 1026 GetIdent<m1> (. IF NOT SymTab.BeginProg(m1) THEN
|
|
|
- 1027 SemError(200) END;
|
|
|
- 1028 astStmt := AST.NoNode;
|
|
|
- 1029 astDecl := AST.NoNode;
|
|
|
- 1030 astImp := AST.NoNode;
|
|
|
- 1031 astImpTail := AST.NoNode;
|
|
|
- 1032 nPendVar := 0;
|
|
|
- 1033 QbeGen.SetModule(m1);
|
|
|
- 1034 CopyNm(m1, unitName); .)
|
|
|
- 1035 [ Priority ]
|
|
|
- 1036 ";"
|
|
|
- 1037 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
- 1038 astImp, astImpTail, astDecl); .) }
|
|
|
- 1039 DeclSeq (. astStmt := AST.NoNode; .)
|
|
|
- 1040 [ "BEGIN" (. FlushPend;
|
|
|
- 1041 k := 0;
|
|
|
- 1042 WHILE k < SymTab.FwdPending() DO
|
|
|
- 1043 SymTab.FwdInfo(k, fname, unres);
|
|
|
- 1044 IF unres THEN SemError(201) END;
|
|
|
- 1045 INC(k)
|
|
|
- 1046 END;
|
|
|
- 1047 SymTab.FwdClear;
|
|
|
- 1048
|
|
|
- 1049 nLab := 0; nGot := 0; .)
|
|
|
- 1050 [ StatSeq ] ]
|
|
|
- 1051 (. IF twoPhaseParse THEN
|
|
|
- 1052 rSym := sym; rErr := errDist;
|
|
|
- 1053 rDecl := astDecl; rStmt := astStmt;
|
|
|
- 1054 M2S.PushPos;
|
|
|
- 1055 repassing := TRUE;
|
|
|
- 1056 rp := 0;
|
|
|
- 1057 WHILE rp < nSpans DO
|
|
|
- 1058 k := 0;
|
|
|
- 1059 WHILE (k <= HIGH(rnm))
|
|
|
- 1060 AND (spanName[rp][k] # CHR(0)) DO
|
|
|
- 1061 rnm[k] := spanName[rp][k]; INC(k)
|
|
|
- 1062 END;
|
|
|
- 1063 rnm[k] := CHR(0);
|
|
|
- 1064 M2S.SeekTo(spanStart[rp]);
|
|
|
- 1065 Adv;
|
|
|
- 1066 rpOk := SymTab.ReenterDeferred(spanIdx[rp]);
|
|
|
- 1067 IF NOT rpOk THEN
|
|
|
- 1068 FileIO.WriteString(FileIO.StdOut,
|
|
|
- 1069 "twophase reenter failed");
|
|
|
- 1070 FileIO.WriteLn(FileIO.StdOut)
|
|
|
- 1071 END;
|
|
|
- 1072 Lower.ReenterScopeProc(spanTy[rp]);
|
|
|
- 1073 QbeGen.BeginFunc("");
|
|
|
- 1074 CopyNm(rnm, curFun);
|
|
|
- 1075 Block(rnm);
|
|
|
- 1076 AST.SetChild(spanNode[rp], 1, astStmt);
|
|
|
- 1077 AST.SetChild(spanNode[rp], 2, astBlkDecls);
|
|
|
- 1078 Lower.ScopeLeave;
|
|
|
- 1079 SymTab.CloseProc;
|
|
|
- 1080 QbeGen.EndFunc(SymTab.ProcRes(rnm));
|
|
|
- 1081 INC(rp)
|
|
|
- 1082 END;
|
|
|
- 1083 curFun[0] := CHR(0);
|
|
|
- 1084 SymTab.OrderCheckOff; rErrs := M2S.errors;
|
|
|
- 1085 repassing := FALSE;
|
|
|
- 1086 M2S.PopPos;
|
|
|
- 1087 sym := rSym; errDist := rErr;
|
|
|
- 1088 M2S.errors := rErrs;
|
|
|
- 1089
|
|
|
- 1090 astDecl := rDecl; astStmt := rStmt
|
|
|
- 1091 END; .)
|
|
|
- 1092 "END"
|
|
|
- 1093 GetIdent<m2> (. IF instActive THEN InstNameGet(m2) END;
|
|
|
- 1094 FlushPend;
|
|
|
- 1095 k := 0;
|
|
|
- 1096 WHILE k < SymTab.FwdPending() DO
|
|
|
- 1097 SymTab.FwdInfo(k, fname, unres);
|
|
|
- 1098 IF unres THEN SemError(201) END;
|
|
|
- 1099 INC(k)
|
|
|
- 1100 END;
|
|
|
- 1101 SymTab.FwdClear;
|
|
|
- 1102
|
|
|
- 1103 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
- 1104 SemError(202) END;
|
|
|
- 1105 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
- 1106 AST.SetChild(astNode, 0,
|
|
|
- 1107 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
- 1108 AST.SetChild(astNode, 1, astDecl);
|
|
|
- 1109 AST.SetChild(astNode, 2, astStmt);
|
|
|
- 1110 AST.SetChild(astNode, 3, astImp);
|
|
|
- 1111 astUnit := astNode;
|
|
|
- 1112 CheckGotos;
|
|
|
- 1113 SymTab.EndUnit; .) .
|
|
|
- 1114 DeclSeq (. VAR astSeq, astTail: AST.Node; .)
|
|
|
- 1115 = (. astSeq := AST.NoNode;
|
|
|
- 1116 astTail := AST.NoNode; .)
|
|
|
- 1117 { (. astDecl := AST.NoNode; .)
|
|
|
- 1118 ( ConstBlock | TypeBlock<FALSE> | VarBlock | ProcDecl ";"
|
|
|
- 1119 | NestedModule ";" | ClassItem ";" )
|
|
|
- 1120 (. AstAppend(AST.NkDeclSeq,
|
|
|
- 1121 astSeq, astTail, astDecl); .) }
|
|
|
- 1122 (. astDecl := astSeq; .) .
|
|
|
- 1123 (* Local module, Wirth form. Declarations lower like top-level ones
|
|
|
- 1124 (same QBE module prefix); a BEGIN body becomes an init function
|
|
|
- 1125 that main calls; the EXPORT list is hoisted into the enclosing
|
|
|
- 1126 scope at END. *)
|
|
|
- 1127 NestedModule (. VAR m1, m2: SymTab.Name;
|
|
|
- 1128 expNames: ARRAY [0 .. 63] OF SymTab.Name;
|
|
|
- 1129 expCount, k: CARDINAL;
|
|
|
- 1130 astNode, nImp, nImpTail:
|
|
|
- 1131 AST.Node; .)
|
|
|
- 1132 = "MODULE"
|
|
|
- 1133 GetIdent<m1> (. IF NOT SymTab.Enter(m1,
|
|
|
- 1134 SymTab.KindModule) THEN
|
|
|
- 1135 SemError(200) END;
|
|
|
- 1136 SymTab.PushScope;
|
|
|
- 1137 expCount := 0;
|
|
|
- 1138 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
- 1139 AST.SetChild(astNode, 0,
|
|
|
- 1140 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
- 1141 astStmt := AST.NoNode;
|
|
|
- 1142 astDecl := AST.NoNode;
|
|
|
- 1143 nImp := AST.NoNode;
|
|
|
- 1144 nImpTail := AST.NoNode; .)
|
|
|
- 1145 [ Priority ]
|
|
|
- 1146 ";"
|
|
|
- 1147 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
- 1148 nImp, nImpTail, astDecl); .) }
|
|
|
- 1149 [ "EXPORT" [ "QUALIFIED" | "UNQUALIFIED" ]
|
|
|
- 1150 GetIdent<expNames[expCount]> (. INC(expCount); .)
|
|
|
- 1151 { "," GetIdent<expNames[expCount]>
|
|
|
- 1152 (. INC(expCount); .) }
|
|
|
- 1153 ";" ]
|
|
|
- 1154 DeclSeq (. astStmt := AST.NoNode; .)
|
|
|
- 1155 [ "BEGIN" (. astStmt := AST.NoNode;
|
|
|
- 1156 .)
|
|
|
- 1157 [ StatSeq ] ]
|
|
|
- 1158 "END"
|
|
|
- 1159 GetIdent<m2> (. AST.SetChild(astNode, 1, astDecl);
|
|
|
- 1160 AST.SetChild(astNode, 2, astStmt);
|
|
|
- 1161 AST.SetChild(astNode, 3, nImp);
|
|
|
- 1162 astDecl := astNode;
|
|
|
- 1163 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
- 1164 SemError(202) END;
|
|
|
- 1165 k := 0;
|
|
|
- 1166 WHILE k < expCount DO
|
|
|
- 1167 SymTab.ExportUp(expNames[k]);
|
|
|
- 1168 INC(k)
|
|
|
- 1169 END;
|
|
|
- 1170 SymTab.PopScope; .) .
|
|
|
- 1171 Priority
|
|
|
- 1172 = "[" integer "]" (. SemError(230); .) .
|
|
|
- 1173 (* Imports (4.3): FROM materializes the names (unqualified use);
|
|
|
- 1174 plain IMPORT only demands the module exists — qualified `L.x`
|
|
|
- 1175 materializes on first use (Design). *)
|
|
|
- 1176 (* Unknown modules stay unchecked stubs (legacy, so hand-written
|
|
|
- 1177 import lines don't fail); a known module's missing export is
|
|
|
- 1178 201. *)
|
|
|
- 1179 Import (. VAR n: SymTab.Name;
|
|
|
- 1180 astImport: AST.Node; .)
|
|
|
- 1181 = "FROM"
|
|
|
- 1182 GetIdent<n> (. astImport := AST.MakeNode(AST.NkImport);
|
|
|
- 1183 AST.SetChild(astImport, 0,
|
|
|
- 1184 AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
- 1185 "IMPORT"
|
|
|
- 1186 ImpList<n, astImport> ";" (. astDecl := astImport; .)
|
|
|
- 1187 | "IMPORT" (. astImport := AST.MakeNode(AST.NkImport); .)
|
|
|
- 1188 ImpModList<astImport> ";" (. astDecl := astImport; .) .
|
|
|
- 1189 ImpList<mod: SymTab.Name; node: AST.Node>
|
|
|
- 1190 (. VAR n: SymTab.Name; .)
|
|
|
- 1191 = ImpName<mod, node>
|
|
|
- 1192 { "," ImpName<mod, node> } .
|
|
|
- 1193 (* Pervasive built-ins imported from SYSTEM (e.g. TSIZE) are
|
|
|
- 1194 accepted and ignored: the built-in applies regardless. *)
|
|
|
- 1195 ImpName<mod: SymTab.Name; node: AST.Node>
|
|
|
- 1196 (. VAR n: SymTab.Name; .)
|
|
|
- 1197 = GetIdent<n> (. AST.SetChild(node, AST.NChild(node),
|
|
|
- 1198 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
- 1199 IF SymTab.Equal(mod, "libc") THEN
|
|
|
- 1200 (* intrinsic C library:
|
|
|
- 1201 permissive external *)
|
|
|
- 1202 IF NOT SymTab.DeclareCProc(n) THEN
|
|
|
- 1203 SemError(201) END;
|
|
|
- 1204 Lower.NoteCProc(n)
|
|
|
- 1205 ELSIF SymTab.ModKnown(mod)
|
|
|
- 1206 AND NOT SymTab.Equal(mod,
|
|
|
- 1207 "SYSTEM") THEN
|
|
|
- 1208 IF NOT SymTab.ImportFrom(mod, n) THEN
|
|
|
- 1209 SemError(201)
|
|
|
- 1210 ELSE Lower.NoteImportedProc(n)
|
|
|
- 1211 END
|
|
|
- 1212 END; .)
|
|
|
- 1213 | ( "TSIZE" | "SIZE" | "ADR" | "HIGH" | "LEN"
|
|
|
- 1214 | "CHR" | "ORD" | "VAL" | "ABS" | "CAP"
|
|
|
- 1215 | "ODD" | "TRUNC" | "FLOAT"
|
|
|
- 1216 | "UCHR" | "CHR8" | "UORD"
|
|
|
- 1217 | "INC" | "DEC"
|
|
|
- 1218 | "SHIFT" | "ROTATE" | "CAST" | "CONVERT" | "MIN" | "MAX"
|
|
|
- 1219 | "INCL" | "EXCL" | "NEW" | "DISPOSE" | "LOC" ) .
|
|
|
- 1220 ImpModList<node: AST.Node> (. VAR n: SymTab.Name; .)
|
|
|
- 1221 = GetIdent<n> (. AST.SetChild(node, AST.NChild(node),
|
|
|
- 1222 AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
- 1223 { "," GetIdent<n> (. AST.SetChild(node, AST.NChild(node),
|
|
|
- 1224 AST.MakeLeaf(AST.NkIdent, n)); .) } .
|
|
|
- 1225 (* Opaque TYPE declarations (definition modules). The targetless
|
|
|
- 1226 alias resolves to InvalidType until step 4 completes it. *)
|
|
|
- 1227 (* Scalar-phase TYPEs: named types, integer subranges, enumerations.
|
|
|
- 1228 Opaque "TYPE T;" needs isDef (definition units); elsewhere 231.
|
|
|
- 1229 Composite forms (ARRAY/RECORD/SET/POINTER) arrive with step 3. *)
|
|
|
- 1230 TypeBlock<isDef: BOOLEAN> (. VAR astSeq, astTail: AST.Node; .)
|
|
|
- 1231 = "TYPE" (. SymTab.BeginTypeBlock;
|
|
|
- 1232 astSeq := AST.NoNode;
|
|
|
- 1233 astTail := AST.NoNode; .)
|
|
|
- 1234 { (. astDecl := AST.NoNode; .)
|
|
|
- 1235 ( TypeItem<isDef> ";" | ClassItem ";" )
|
|
|
- 1236 (. AstAppend(AST.NkDeclSeq,
|
|
|
- 1237 astSeq, astTail, astDecl); .) }
|
|
|
- 1238 (. SymTab.EndTypeBlock;
|
|
|
- 1239 astDecl := astSeq; .) .
|
|
|
- 1240 TypeItem<isDef: BOOLEAN> (. VAR n: SymTab.Name;
|
|
|
- 1241 t, op: SymTab.TypeIndex;
|
|
|
- 1242 astNode: AST.Node; .)
|
|
|
- 1243 = GetIdent<n> (. op := SymTab.OpaqueBase(n);
|
|
|
- 1244 IF op = SymTab.InvalidType THEN
|
|
|
- 1245 IF NOT SymTab.Enter(n,
|
|
|
- 1246 SymTab.KindType) THEN
|
|
|
- 1247 SemError(200) END
|
|
|
- 1248 END; .)
|
|
|
- 1249 ( "=" Type<t, FALSE> (. astNode := AST.MakeNode(AST.NkTypeDecl);
|
|
|
- 1250 AST.SetChild(astNode, 0,
|
|
|
- 1251 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
- 1252 AST.SetTy(astNode, t);
|
|
|
- 1253 astDecl := astNode;
|
|
|
- 1254 IF op # SymTab.InvalidType THEN
|
|
|
- 1255 SymTab.SetTarget(op, t)
|
|
|
- 1256 ELSE SymTab.SetSymType(n, t)
|
|
|
- 1257 END;
|
|
|
- 1258 IF SymTab.EnterEnumLits(t) > 0 THEN END; .)
|
|
|
- 1259 | (. IF op # SymTab.InvalidType THEN
|
|
|
- 1260 (* stays opaque *)
|
|
|
- 1261 ELSIF NOT isDef THEN
|
|
|
- 1262 SemError(231)
|
|
|
- 1263 ELSE SymTab.SetSymType(n,
|
|
|
- 1264 SymTab.NewAlias()) END; .) ) .
|
|
|
- 1265 Type<VAR t: SymTab.TypeIndex; allowOpen: BOOLEAN>
|
|
|
- 1266 = TypeIdent<t> [ Subrange<t> ] (* anchored subrange: T[lo..hi] *)
|
|
|
- 1267 | Subrange<t>
|
|
|
- 1268 | Enum<t>
|
|
|
- 1269 | ArrayType<t, allowOpen>
|
|
|
- 1270 | SetType<t>
|
|
|
- 1271 | PackSetType<t>
|
|
|
- 1272 | RecordType<t>
|
|
|
- 1273 | PointerType<t>
|
|
|
- 1274 | ProcType<t> .
|
|
|
- 1275 PointerType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex; .)
|
|
|
- 1276 = "POINTER" "TO" (. allowFwdType := TRUE; .)
|
|
|
- 1277 Type<base, FALSE> (. allowFwdType := FALSE;
|
|
|
- 1278 t := SymTab.NewPtr(base); .) .
|
|
|
- 1279 (* Procedure types (step 8.5): PROCEDURE (params): result. Values
|
|
|
- 1280 are code pointers; params are collected into the descriptor. *)
|
|
|
- 1281 ProcType<VAR t: SymTab.TypeIndex> (. VAR res, pt: SymTab.TypeIndex;
|
|
|
- 1282 isV: BOOLEAN; .)
|
|
|
- 1283 = ( "PROCEDURE" | "PROC" ) (. allowFwdType := FALSE;
|
|
|
- 1284 res := SymTab.InvalidType;
|
|
|
- 1285 t := SymTab.NewProcType(res); .)
|
|
|
- 1286 [ "(" [ ProcTypeSection<t>
|
|
|
- 1287 { (";" | ",") ProcTypeSection<t> } ] ")" ]
|
|
|
- 1288 [ ":" ( TypeIdent<res> (. SymTab.SetProcTypeRes(t, res); .)
|
|
|
- 1289 | "PROC" (. (* PROC as a result type: the
|
|
|
- 1290 pervasive procedure value
|
|
|
- 1291 type (ISO/PIM) *)
|
|
|
- 1292 SymTab.SetProcTypeRes(t,
|
|
|
- 1293 SymTab.AddrType()); .) ) ] .
|
|
|
- 1294 ProcTypeSection<t: SymTab.TypeIndex> (. VAR pt: SymTab.TypeIndex;
|
|
|
- 1295 isV: BOOLEAN;
|
|
|
- 1296 cnt, k: CARDINAL;
|
|
|
- 1297 names: ARRAY [0 .. 15] OF SymTab.Name; .)
|
|
|
- 1298 = (. isV := FALSE; cnt := 0; .)
|
|
|
- 1299 [ "VAR" (. isV := TRUE; .) ]
|
|
|
- 1300 ( GetIdent<names[cnt]> (. INC(cnt); .)
|
|
|
- 1301 { "," ( GetIdent<names[cnt]> (. INC(cnt); .)
|
|
|
- 1302 | (. (* a comma followed by a type
|
|
|
- 1303 (possibly VAR) ends the name
|
|
|
- 1304 list: the collected names
|
|
|
- 1305 were types, not names *)
|
|
|
- 1306 k := 0;
|
|
|
- 1307 WHILE k < cnt DO
|
|
|
- 1308 SymTab.ProcTypeAdd(t, isV,
|
|
|
- 1309 SymTab.SymType(names[k]));
|
|
|
- 1310 INC(k)
|
|
|
- 1311 END;
|
|
|
- 1312 cnt := 0; .)
|
|
|
- 1313 [ "VAR" (. isV := TRUE; .) ]
|
|
|
- 1314 Type<pt, TRUE> (. SymTab.ProcTypeAdd(t, isV, pt); .) ) }
|
|
|
- 1315 ( ":" Type<pt, TRUE> (. k := 0;
|
|
|
- 1316 WHILE k < cnt DO
|
|
|
- 1317 SymTab.ProcTypeAdd(t, isV, pt);
|
|
|
- 1318 INC(k)
|
|
|
- 1319 END; .)
|
|
|
- 1320 | (. (* type-only parameter list:
|
|
|
- 1321 each collected name is a
|
|
|
- 1322 type (CHAR, a declared type,
|
|
|
- 1323 ... or the GNU shorthand) *)
|
|
|
- 1324 k := 0;
|
|
|
- 1325 WHILE k < cnt DO
|
|
|
- 1326 IF IsTypeName(names[k]) THEN
|
|
|
- 1327 pt := SymTab.SymType(names[k])
|
|
|
- 1328 ELSE SemError(201);
|
|
|
- 1329 pt := SymTab.InvalidType
|
|
|
- 1330 END;
|
|
|
- 1331 SymTab.ProcTypeAdd(t, isV, pt);
|
|
|
- 1332 INC(k)
|
|
|
- 1333 END; .) )
|
|
|
- 1334 | Type<pt, TRUE> (. (* unnamed parameter (PIM):
|
|
|
- 1335 e.g. PROCEDURE (VAR ARRAY OF REAL) *)
|
|
|
- 1336 SymTab.ProcTypeAdd(t, isV, pt); .) ) .
|
|
|
- 1337 (* Arrays: "OF" without bounds is an open formal (allowed only
|
|
|
- 1338 where allowOpen); "[lo..hi, ...]" nests bounded levels inside
|
|
|
- 1339 out. The PIM/ISO multi-index form repeats the bracket group
|
|
|
- 1340 ("ARRAY [lo..hi], [lo..hi] OF T"); the bounds of every group
|
|
|
- 1341 nest in the same inside-out order as the comma list. Bounds are
|
|
|
- 1342 folded literals (int/char); anything else 230. Bare-type indices
|
|
|
- 1343 ("ARRAY Color OF") wait for enum ordinals. *)
|
|
|
- 1344 ArrayType<VAR t: SymTab.TypeIndex; allowOpen: BOOLEAN>
|
|
|
- 1345 (. VAR elem: SymTab.TypeIndex;
|
|
|
- 1346 eb: SymTab.Name;
|
|
|
- 1347 ok: BOOLEAN;
|
|
|
- 1348 bnds, bndh: ARRAY [0 .. 7] OF INTEGER;
|
|
|
- 1349 nb, k: CARDINAL;
|
|
|
- 1350 idx: SymTab.TypeIndex;
|
|
|
- 1351 ilo, ihi: INTEGER; .)
|
|
|
- 1352 = "ARRAY" (. allowFwdType := FALSE; .)
|
|
|
- 1353 ( "OF"
|
|
|
- 1354 Type<elem, FALSE> (. LexName(eb); (* the element ident *)
|
|
|
- 1355 IF NOT allowOpen THEN
|
|
|
- 1356 SemError(230) END;
|
|
|
- 1357 t := SymTab.NewOpenArray(elem);
|
|
|
- 1358 IF SymTab.Equal(eb, "BYTE") THEN
|
|
|
- 1359 SymTab.MarkByteBuf(t) END; .)
|
|
|
- 1360 | TypeIdent<idx> [ Subrange<idx> ]
|
|
|
- 1361 "OF" Type<elem, FALSE> (. (* index-type array: the index
|
|
|
- 1362 type's ordinal bounds give the
|
|
|
- 1363 [lo..hi] pair *)
|
|
|
- 1364 IF SymTab.TypeBounds(idx, ilo,
|
|
|
- 1365 ihi)
|
|
|
- 1366 THEN t := SymTab.NewArrayB(elem,
|
|
|
- 1367 ilo, ihi)
|
|
|
- 1368 ELSE SemError(230);
|
|
|
- 1369 t := SymTab.InvalidType
|
|
|
- 1370 END; .)
|
|
|
- 1371 | "[" (. SymTab.BoundBegin; ok := TRUE;
|
|
|
- 1372 nb := 0; .)
|
|
|
- 1373 BoundPair<ok>
|
|
|
- 1374 { "," BoundPair<ok> }
|
|
|
- 1375 "]" (. (* snapshot this bracket group
|
|
|
- 1376 before the element type, which
|
|
|
- 1377 reuses the bound buffer for a
|
|
|
- 1378 nested ARRAY *)
|
|
|
- 1379 IF nb + SymTab.BoundCount() >
|
|
|
- 1380 HIGH(bnds) + 1 THEN
|
|
|
- 1381 SemError(230); ok := FALSE
|
|
|
- 1382 ELSE
|
|
|
- 1383 k := 0;
|
|
|
- 1384 WHILE k < SymTab.BoundCount() DO
|
|
|
- 1385 bnds[nb] := SymTab.BoundLo(k);
|
|
|
- 1386 bndh[nb] := SymTab.BoundHi(k);
|
|
|
- 1387 INC(k); INC(nb)
|
|
|
- 1388 END
|
|
|
- 1389 END; .)
|
|
|
- 1390 { "," "[" (. SymTab.BoundBegin; .)
|
|
|
- 1391 BoundPair<ok>
|
|
|
- 1392 { "," BoundPair<ok> }
|
|
|
- 1393 "]" (. IF nb + SymTab.BoundCount() >
|
|
|
- 1394 HIGH(bnds) + 1 THEN
|
|
|
- 1395 SemError(230); ok := FALSE
|
|
|
- 1396 ELSE
|
|
|
- 1397 k := 0;
|
|
|
- 1398 WHILE k < SymTab.BoundCount() DO
|
|
|
- 1399 bnds[nb] := SymTab.BoundLo(k);
|
|
|
- 1400 bndh[nb] := SymTab.BoundHi(k);
|
|
|
- 1401 INC(k); INC(nb)
|
|
|
- 1402 END
|
|
|
- 1403 END; .) }
|
|
|
- 1404 "OF" Type<elem, FALSE>
|
|
|
- 1405 (. IF ok THEN
|
|
|
- 1406 k := nb;
|
|
|
- 1407 WHILE k > 0 DO
|
|
|
- 1408 DEC(k);
|
|
|
- 1409 elem := SymTab.NewArrayB(
|
|
|
- 1410 elem, bnds[k], bndh[k])
|
|
|
- 1411 END;
|
|
|
- 1412 t := elem
|
|
|
- 1413 ELSE t := SymTab.InvalidType
|
|
|
- 1414 END; .) ) .
|
|
|
- 1415 BoundPair<VAR ok: BOOLEAN> (. VAR tlo, thi: SymTab.TypeIndex;
|
|
|
- 1416 qlo, qhi: QbeGen.QVal;
|
|
|
- 1417 lo, hi: INTEGER;
|
|
|
- 1418 cl, cl2: INTEGER; .)
|
|
|
- 1419 = Expr<tlo, qlo> ".." Expr<thi, qhi>
|
|
|
- 1420 (. IF (tlo = SymTab.InvalidType)
|
|
|
- 1421 OR (thi = SymTab.InvalidType) THEN
|
|
|
- 1422 ok := FALSE
|
|
|
- 1423 ELSE cl := SymTab.ClassOf(tlo);
|
|
|
- 1424 cl2 := SymTab.ClassOf(thi);
|
|
|
- 1425 IF ((cl # SymTab.ClInt)
|
|
|
- 1426 AND (cl # SymTab.ClChar)
|
|
|
- 1427 AND (cl # SymTab.ClBool)
|
|
|
- 1428 AND (cl # SymTab.ClEnum)
|
|
|
- 1429 AND (cl # SymTab.ClByte)
|
|
|
- 1430 AND (cl # SymTab.ClSByte)
|
|
|
- 1431 AND (cl # SymTab.ClWord16)
|
|
|
- 1432 AND (cl # SymTab.ClSWord16))
|
|
|
- 1433 OR ((cl2 # SymTab.ClInt)
|
|
|
- 1434 AND (cl2 # SymTab.ClChar)
|
|
|
- 1435 AND (cl2 # SymTab.ClBool)
|
|
|
- 1436 AND (cl2 # SymTab.ClEnum)
|
|
|
- 1437 AND (cl2 # SymTab.ClByte)
|
|
|
- 1438 AND (cl2 # SymTab.ClSByte)
|
|
|
- 1439 AND (cl2 # SymTab.ClWord16)
|
|
|
- 1440 AND (cl2 # SymTab.ClSWord16)) THEN
|
|
|
- 1441 SemError(230); ok := FALSE
|
|
|
- 1442 ELSIF NOT SymTab.ConstInt(qlo, lo)
|
|
|
- 1443 OR NOT SymTab.ConstInt(qhi, hi)
|
|
|
- 1444 OR (lo > hi) THEN
|
|
|
- 1445 SemError(230); ok := FALSE
|
|
|
- 1446 ELSIF NOT SymTab.BoundAdd(lo, hi) THEN
|
|
|
- 1447 SemError(230); ok := FALSE
|
|
|
- 1448 END;
|
|
|
- 1449 END; .) .
|
|
|
- 1450 (* Sets: multi-word masks over bases ≤ 256 values (bool, char,
|
|
|
- 1451 bounded subranges; enums wait for ordinals, INTEGER is
|
|
|
- 1452 unbounded). Literals are SET OF [0..255]; assignment and
|
|
|
- 1453 comparison across suitable bases are lenient (masks over min
|
|
|
- 1454 words + zero-check extras), out-of-span literals are 222. *)
|
|
|
- 1455 SetType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex;
|
|
|
- 1456 blo, bhi, bspan: INTEGER;
|
|
|
- 1457 bcls: INTEGER; .)
|
|
|
- 1458 = "SET" (. allowFwdType := FALSE; .)
|
|
|
- 1459 "OF" Type<base, FALSE>
|
|
|
- 1460 (. IF base = SymTab.InvalidType THEN
|
|
|
- 1461 t := SymTab.InvalidType
|
|
|
- 1462 ELSIF SymTab.Unresolved(base) THEN
|
|
|
- 1463 (* an opaque/formal base: defer
|
|
|
- 1464 the span check until the
|
|
|
- 1465 base is completed *)
|
|
|
- 1466 t := SymTab.NewSet(base)
|
|
|
- 1467 ELSE bcls :=
|
|
|
- 1468 SymTab.ClassOf(base);
|
|
|
- 1469 (* a subrange keeps its own
|
|
|
- 1470 span even when its base is
|
|
|
- 1471 CHAR/BOOLEAN/an enum *)
|
|
|
- 1472 IF SymTab.SubBounds(base,
|
|
|
- 1473 blo, bhi) THEN
|
|
|
- 1474 bspan := bhi - blo + 1
|
|
|
- 1475 ELSIF bcls = SymTab.ClBool THEN
|
|
|
- 1476 blo := 0; bspan := 2
|
|
|
- 1477 ELSIF bcls = SymTab.ClChar THEN
|
|
|
- 1478 blo := 0; bspan := 256
|
|
|
- 1479 ELSIF bcls = SymTab.ClByte THEN
|
|
|
- 1480 blo := 0; bspan := 256
|
|
|
- 1481 ELSIF bcls = SymTab.ClSByte THEN
|
|
|
- 1482 blo := -128; bspan := 256
|
|
|
- 1483 ELSIF bcls = SymTab.ClWord16 THEN
|
|
|
- 1484 blo := 0; bspan := 65536
|
|
|
- 1485 ELSIF bcls = SymTab.ClSWord16 THEN
|
|
|
- 1486 blo := -32768; bspan := 65536
|
|
|
- 1487 ELSIF bcls = SymTab.ClEnum THEN
|
|
|
- 1488 blo := 0;
|
|
|
- 1489 bspan := VAL(INTEGER,
|
|
|
- 1490 SymTab.EnumCount(base))
|
|
|
- 1491 ELSE bspan := 0 END;
|
|
|
- 1492 IF (bspan <= 0)
|
|
|
- 1493 OR (bspan > 65536) THEN
|
|
|
- 1494 SemError(230);
|
|
|
- 1495 t := SymTab.InvalidType
|
|
|
- 1496 ELSE t := SymTab.NewSet(base)
|
|
|
- 1497 END
|
|
|
- 1498 END; .) .
|
|
|
- 1499 (* PACKEDSET: same base rules as SET, but 1/2/4-byte storage. V3
|
|
|
- 1500 limits the span to 32 bits (SetBytes 1..4); wider packed sets are
|
|
|
- 1501 an implementation limit (230). *)
|
|
|
- 1502 PackSetType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex;
|
|
|
- 1503 blo, bhi, bspan: INTEGER;
|
|
|
- 1504 bcls: INTEGER; .)
|
|
|
- 1505 = "PACKEDSET" (. allowFwdType := FALSE; .)
|
|
|
- 1506 "OF" Type<base, FALSE>
|
|
|
- 1507 (. IF base = SymTab.InvalidType THEN
|
|
|
- 1508 t := SymTab.InvalidType
|
|
|
- 1509 ELSIF SymTab.Unresolved(base) THEN
|
|
|
- 1510 t := SymTab.NewPackSet(base)
|
|
|
- 1511 ELSE bcls :=
|
|
|
- 1512 SymTab.ClassOf(base);
|
|
|
- 1513 IF SymTab.SubBounds(base,
|
|
|
- 1514 blo, bhi) THEN
|
|
|
- 1515 bspan := bhi - blo + 1
|
|
|
- 1516 ELSIF bcls = SymTab.ClBool THEN
|
|
|
- 1517 blo := 0; bspan := 2
|
|
|
- 1518 ELSIF bcls = SymTab.ClChar THEN
|
|
|
- 1519 blo := 0; bspan := 256
|
|
|
- 1520 ELSIF bcls = SymTab.ClByte THEN
|
|
|
- 1521 blo := 0; bspan := 256
|
|
|
- 1522 ELSIF bcls = SymTab.ClSByte THEN
|
|
|
- 1523 blo := -128; bspan := 256
|
|
|
- 1524 ELSIF bcls = SymTab.ClWord16 THEN
|
|
|
- 1525 blo := 0; bspan := 65536
|
|
|
- 1526 ELSIF bcls = SymTab.ClSWord16 THEN
|
|
|
- 1527 blo := -32768; bspan := 65536
|
|
|
- 1528 ELSIF bcls = SymTab.ClEnum THEN
|
|
|
- 1529 blo := 0;
|
|
|
- 1530 bspan := VAL(INTEGER,
|
|
|
- 1531 SymTab.EnumCount(base))
|
|
|
- 1532 ELSE bspan := 0 END;
|
|
|
- 1533 IF (bspan <= 0)
|
|
|
- 1534 OR (bspan > 32) THEN
|
|
|
- 1535 SemError(230);
|
|
|
- 1536 t := SymTab.InvalidType
|
|
|
- 1537 ELSE t := SymTab.NewPackSet(base)
|
|
|
- 1538 END
|
|
|
- 1539 END; .) .
|
|
|
- 1540 (* Records: flat blobs; array fields are pointers to static
|
|
|
- 1541 descriptors (locked amendment), nested records inline. Field
|
|
|
- 1542 offsets static and declaration-ordered. *)
|
|
|
- 1543 (* Field list: plain fields and (optionally) one variant part. The
|
|
|
- 1544 variant part is a `CASE ... END` item; because it starts with the
|
|
|
- 1545 CASE keyword it is unambiguously distinguishable from a field
|
|
|
- 1546 (which starts with an identifier). *)
|
|
|
- 1547 RecordType<VAR t: SymTab.TypeIndex> (. VAR t2: SymTab.TypeIndex;
|
|
|
- 1548 tagOk: BOOLEAN; .)
|
|
|
- 1549 = "RECORD" (. allowFwdType := FALSE;
|
|
|
- 1550 t := SymTab.NewRecord(); .)
|
|
|
- 1551 [ RecItem<t> { ";" [ RecItem<t> ] } ]
|
|
|
- 1552 "END" (. SymTab.LayoutRecord(t); .) .
|
|
|
- 1553 RecItem<rec: SymTab.TypeIndex> (. VAR tt: SymTab.TypeIndex; .)
|
|
|
- 1554 = RecField<rec>
|
|
|
- 1555 | CaseField<rec> (. SymTab.MarkVariant(rec); .) .
|
|
|
- 1556 (* A variant part: CASE [tag] : Type OF variants. gm2 extensions:
|
|
|
- 1557 an untagged inner CASE (no tag field), empty arms and ELSE arms. *)
|
|
|
- 1558 CaseField<rec: SymTab.TypeIndex> (. VAR tagT: SymTab.TypeIndex;
|
|
|
- 1559 tagN: SymTab.Name;
|
|
|
- 1560 tagged: BOOLEAN; .)
|
|
|
- 1561 = "CASE" (. SymTab.ResetFields(rec);
|
|
|
- 1562 tagged := FALSE; .)
|
|
|
- 1563 [ GetIdent<tagN> (. IF NOT SymTab.FieldPending(rec,
|
|
|
- 1564 tagN) THEN
|
|
|
- 1565 SemError(200) END;
|
|
|
- 1566 tagged := TRUE; .) ]
|
|
|
- 1567 ":" Type<tagT, FALSE> (. IF (tagT # SymTab.InvalidType)
|
|
|
- 1568 AND NOT SymTab.IsOrdinal(tagT) THEN
|
|
|
- 1569 SemError(224)
|
|
|
- 1570 END;
|
|
|
- 1571 IF tagged THEN
|
|
|
- 1572 SymTab.FixPendingF(rec, tagT);
|
|
|
- 1573 SymTab.SetVariantTag(rec, tagN)
|
|
|
- 1574 END; .)
|
|
|
- 1575 "OF"
|
|
|
- 1576 RecFieldList<rec>
|
|
|
- 1577 { "|" (. SymTab.ResetFields(rec); .)
|
|
|
- 1578 RecFieldList<rec> }
|
|
|
- 1579 [ "ELSE" ]
|
|
|
- 1580 "END" .
|
|
|
- 1581 (* A variant branch: `labels : fields` (fields and their trailing ";"
|
|
|
- 1582 optional, gm2), `ELSE`, or empty (the extra "|" separators gm2
|
|
|
- 1583 tolerates). A branch may itself contain a nested variant CASE. *)
|
|
|
- 1584 RecFieldList<rec: SymTab.TypeIndex> (. VAR lt, lq: SymTab.TypeIndex;
|
|
|
- 1585 lv1, lv2: QbeGen.QVal; .)
|
|
|
- 1586 = [ ( VarLabel<lt, lv1> [ ".." VarLabel<lq, lv2> ]
|
|
|
- 1587 { "," VarLabel<lt, lv1> [ ".." VarLabel<lq, lv2> ] }
|
|
|
- 1588 ":"
|
|
|
- 1589 [ ArmField<rec> { ";" [ ArmField<rec> ] } ]
|
|
|
- 1590 | "ELSE" ) ] .
|
|
|
- 1591 ArmField<rec: SymTab.TypeIndex>
|
|
|
- 1592 = RecField<rec>
|
|
|
- 1593 | CaseField<rec> (. SymTab.MarkVariant(rec); .) .
|
|
|
- 1594 (* Variant case label: a constant (or a constant range). Values are
|
|
|
- 1595 not interpreted (the layout overlays regardless). *)
|
|
|
- 1596 VarLabel<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 1597 (. VAR lname: SymTab.Name; .)
|
|
|
- 1598 = ( ident (. LexName(lname);
|
|
|
- 1599 QbeGen.CopyOp("0", q);
|
|
|
- 1600 t := SymTab.IntType(); .)
|
|
|
- 1601 | integer (. LexString(lname);
|
|
|
- 1602 QbeGen.CopyOp("0", q);
|
|
|
- 1603 t := SymTab.IntType(); .)
|
|
|
- 1604 | charConst (. LexString(lname);
|
|
|
- 1605 QbeGen.CopyOp("0", q);
|
|
|
- 1606 t := SymTab.CharType(); .) ) .
|
|
|
- 1607 RecField<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name;
|
|
|
- 1608 t2: SymTab.TypeIndex; .)
|
|
|
- 1609 = RecIdents<rec> ":" Type<t2, FALSE>(. SymTab.FixPendingF(rec, t2); .) .
|
|
|
- 1610 RecIdents<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name; .)
|
|
|
- 1611 = GetIdent<n> (. IF NOT SymTab.FieldPending(rec,
|
|
|
- 1612 n) THEN
|
|
|
- 1613 SemError(200) END; .)
|
|
|
- 1614 { "," GetIdent<n> (. IF NOT SymTab.FieldPending(rec,
|
|
|
- 1615 n) THEN
|
|
|
- 1616 SemError(200) END; .) } .
|
|
|
- 1617 TypeIdent<VAR t: SymTab.TypeIndex> (. VAR n, qid: SymTab.Name;
|
|
|
- 1618 k: INTEGER;
|
|
|
- 1619 dotted: BOOLEAN; .)
|
|
|
- 1620 = GetIdent<n> (. dotted := FALSE;
|
|
|
- 1621 IF NOT SymTab.Lookup(n) THEN
|
|
|
- 1622 (* declaration before use: an
|
|
|
- 1623 undeclared type is 201,
|
|
|
- 1624 except as a POINTER's base
|
|
|
- 1625 (allowFwdType) *)
|
|
|
- 1626 k := -1;
|
|
|
- 1627 IF allowFwdType THEN
|
|
|
- 1628 t := SymTab.ForwardType(n)
|
|
|
- 1629 ELSE t := SymTab.InvalidType
|
|
|
- 1630 END;
|
|
|
- 1631 IF t = SymTab.InvalidType THEN
|
|
|
- 1632 SemError(201)
|
|
|
- 1633 END
|
|
|
- 1634 ELSE k := SymTab.SymKind(n);
|
|
|
- 1635 IF (k = SymTab.KindType)
|
|
|
- 1636 OR (k = SymTab.KindPredef) THEN
|
|
|
- 1637 t := SymTab.SymType(n)
|
|
|
- 1638 ELSE t := SymTab.InvalidType
|
|
|
- 1639 END
|
|
|
- 1640 END; .)
|
|
|
- 1641 [ "." GetIdent<qid> (. dotted := TRUE;
|
|
|
- 1642 IF k = SymTab.KindModule THEN
|
|
|
- 1643 t := SymTab.QualType(n, qid);
|
|
|
- 1644 IF t = SymTab.InvalidType THEN
|
|
|
- 1645 SemError(201)
|
|
|
- 1646 END
|
|
|
- 1647 ELSE SemError(221);
|
|
|
- 1648 t := SymTab.InvalidType
|
|
|
- 1649 END; .) ]
|
|
|
- 1650 (. IF NOT dotted THEN
|
|
|
- 1651 IF (k = SymTab.KindModule)
|
|
|
- 1652 OR ((k # SymTab.KindType)
|
|
|
- 1653 AND (k # SymTab.KindPredef)
|
|
|
- 1654 AND (k # SymTab.KindImport)
|
|
|
- 1655 AND (k # -1)) THEN
|
|
|
- 1656 SemError(221)
|
|
|
- 1657 END
|
|
|
- 1658 END; .) .
|
|
|
- 1659 Subrange<VAR t: SymTab.TypeIndex> (. VAR tlo, thi: SymTab.TypeIndex;
|
|
|
- 1660 qlo, qhi: QbeGen.QVal;
|
|
|
- 1661 lo, hi: INTEGER; .)
|
|
|
- 1662 = "[" Expr<tlo, qlo> ".." Expr<thi, qhi>
|
|
|
- 1663 (. IF (tlo = SymTab.InvalidType)
|
|
|
- 1664 OR (thi = SymTab.InvalidType) THEN
|
|
|
- 1665 t := SymTab.InvalidType
|
|
|
- 1666 ELSIF NOT SymTab.IsOrdinal(tlo)
|
|
|
- 1667 OR NOT SymTab.IsOrdinal(thi) THEN
|
|
|
- 1668 SemError(230);
|
|
|
- 1669 t := SymTab.InvalidType
|
|
|
- 1670 ELSIF NOT SymTab.ConstInt(qlo, lo)
|
|
|
- 1671 OR NOT SymTab.ConstInt(qhi, hi)
|
|
|
- 1672 OR (lo > hi) THEN
|
|
|
- 1673 SemError(230);
|
|
|
- 1674 t := SymTab.InvalidType
|
|
|
- 1675 ELSE IF SymTab.SameType(tlo, thi) THEN
|
|
|
- 1676 (* keep the base type: ['A'..'Z']
|
|
|
- 1677 is character, [red..blue]
|
|
|
- 1678 that enumeration *)
|
|
|
- 1679 t := SymTab.NewSubB(lo, hi, tlo)
|
|
|
- 1680 ELSE t := SymTab.NewSubR(lo, hi)
|
|
|
- 1681 END
|
|
|
- 1682 END; .)
|
|
|
- 1683 "]" .
|
|
|
- 1684 Enum<VAR t: SymTab.TypeIndex> (. VAR n: SymTab.Name;
|
|
|
- 1685 ord: INTEGER;
|
|
|
- 1686 qv: QbeGen.QVal; .)
|
|
|
- 1687 = "(" (. t := SymTab.NewEnum();
|
|
|
- 1688 ord := 0; .)
|
|
|
- 1689 GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
- 1690 SymTab.KindConst) THEN
|
|
|
- 1691 SemError(200) END;
|
|
|
- 1692 SymTab.SetSymType(n, t);
|
|
|
- 1693 QbeGen.IntStr(ord, qv);
|
|
|
- 1694 SymTab.SetSymVal(n, qv);
|
|
|
- 1695 SymTab.NoteEnumLit(t, n);
|
|
|
- 1696 Lower.NoteVar(n,
|
|
|
- 1697 SymTab.KindConst, t);
|
|
|
- 1698 Lower.NoteConstVal(qv);
|
|
|
- 1699 INC(ord); .)
|
|
|
- 1700 { "," GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
- 1701 SymTab.KindConst) THEN
|
|
|
- 1702 SemError(200) END;
|
|
|
- 1703 SymTab.SetSymType(n, t);
|
|
|
- 1704 QbeGen.IntStr(ord, qv);
|
|
|
- 1705 SymTab.SetSymVal(n, qv);
|
|
|
- 1706 SymTab.NoteEnumLit(t, n);
|
|
|
- 1707 Lower.NoteVar(n,
|
|
|
- 1708 SymTab.KindConst, t);
|
|
|
- 1709 Lower.NoteConstVal(qv);
|
|
|
- 1710 INC(ord); .) }
|
|
|
- 1711 ")" (. SymTab.SetEnumCount(t,
|
|
|
- 1712 VAL(CARDINAL, ord)); .) .
|
|
|
- 1713 (* Clarion-form classes (docs/OOP.txt): declaration + single
|
|
|
- 1714 inheritance + IMPLEMENTATION blocks. Scopes and member checks
|
|
|
- 1715 now; lowering (vtable, dispatch, THIS) later — one 230 per
|
|
|
- 1716 class/impl block. Methods end with ";" per the Table example
|
|
|
- 1717 (not "," as in the sketch). No underscores in identifiers. *)
|
|
|
- 1718 (* Single CLASS item in both loops: separating declaration from
|
|
|
- 1719 IMPLEMENTATION at the loop level needs 2-token lookahead
|
|
|
- 1720 (CLASS ident vs CLASS IMPLEMENTATION), which LL(1) cannot do.
|
|
|
- 1721 The second token decides after CLASS is consumed. A misplaced
|
|
|
- 1722 CLASS IMPLEMENTATION inside TYPE still parses (harmless: the
|
|
|
- 1723 whole unit ends 230 until lowering). *)
|
|
|
- 1724 ClassItem
|
|
|
- 1725 = "CLASS" ( "IMPLEMENTATION" ClassImplRest | ClassRest ) .
|
|
|
- 1726 ClassRest (. VAR cn, m2, pn: SymTab.Name;
|
|
|
- 1727 ct: SymTab.TypeIndex; .)
|
|
|
- 1728 = GetIdent<cn> (. IF NOT SymTab.Enter(cn,
|
|
|
- 1729 SymTab.KindType) THEN
|
|
|
- 1730 SemError(200) END;
|
|
|
- 1731 ct := SymTab.NewClass();
|
|
|
- 1732 SymTab.SetSymType(cn, ct);
|
|
|
- 1733 SymTab.PushClassScope(ct);
|
|
|
- 1734 astCls := AST.MakeNode(AST.NkClassDecl);
|
|
|
- 1735 AST.SetChild(astCls, 0,
|
|
|
- 1736 AST.MakeLeaf(AST.NkIdent, cn));
|
|
|
- 1737 astClsP := AST.NoNode;
|
|
|
- 1738 astClsPTail := AST.NoNode;
|
|
|
- 1739 astClsF := AST.NoNode;
|
|
|
- 1740 astClsFTail := AST.NoNode;
|
|
|
- 1741 astClsM := AST.NoNode;
|
|
|
- 1742 astClsMTail := AST.NoNode; .)
|
|
|
- 1743 [ Parents<ct> ]
|
|
|
- 1744 ";"
|
|
|
- 1745 { ClassField<ct> ";" }
|
|
|
- 1746 { MethodHeading<pn, SymTab.InvalidType> ";"
|
|
|
- 1747 (. Lower.ScopeLeave;
|
|
|
- 1748 SymTab.CloseProc;
|
|
|
- 1749 QbeGen.AbortFunc; .) }
|
|
|
- 1750 "END"
|
|
|
- 1751 GetIdent<m2> (. IF NOT SymTab.Equal(cn, m2) THEN
|
|
|
- 1752 SemError(202) END;
|
|
|
- 1753 SymTab.LayoutClass(ct);
|
|
|
- 1754 SymTab.PopScope;
|
|
|
- 1755 AST.SetChild(astCls, 1, astClsP);
|
|
|
- 1756 AST.SetChild(astCls, 2, astClsF);
|
|
|
- 1757 AST.SetChild(astCls, 3, astClsM);
|
|
|
- 1758 astDecl := astCls; .) .
|
|
|
- 1759 Parents<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name; .)
|
|
|
- 1760 = "(" Parent1<ct>
|
|
|
- 1761 { "," GetIdent<p> (. SemError(230); .) }
|
|
|
- 1762 ")" .
|
|
|
- 1763 Parent1<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name;
|
|
|
- 1764 pt: SymTab.TypeIndex; .)
|
|
|
- 1765 = GetIdent<p> (. IF NOT SymTab.Lookup(p) THEN
|
|
|
- 1766 SemError(201)
|
|
|
- 1767 ELSE pt := SymTab.SymType(p);
|
|
|
- 1768 IF SymTab.ClassOf(pt) #
|
|
|
- 1769 SymTab.ClClass THEN
|
|
|
- 1770 SemError(230)
|
|
|
- 1771 ELSE SymTab.SetParent(ct, pt)
|
|
|
- 1772 END
|
|
|
- 1773 END;
|
|
|
- 1774 AstAppend(AST.NkFieldDecl,
|
|
|
- 1775 astClsP, astClsPTail,
|
|
|
- 1776 AST.MakeLeaf(AST.NkIdent, p)); .) .
|
|
|
- 1777 ClassField<ct: SymTab.TypeIndex> (. VAR n, rhs: SymTab.Name;
|
|
|
- 1778 t: SymTab.TypeIndex;
|
|
|
- 1779 astNode: AST.Node; .)
|
|
|
- 1780 = GetIdent<n>
|
|
|
- 1781 ( "=" GetIdent<rhs> (. IF NOT SymTab.Enter(n,
|
|
|
- 1782 SymTab.KindConst) THEN
|
|
|
- 1783 SemError(200) END;
|
|
|
- 1784 astNode := AST.MakeNode(AST.NkConstDecl);
|
|
|
- 1785 AST.SetChild(astNode, 0,
|
|
|
- 1786 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
- 1787 AST.SetChild(astNode, 1,
|
|
|
- 1788 AST.MakeLeaf(AST.NkIdent, rhs));
|
|
|
- 1789 AstAppend(AST.NkFieldDecl,
|
|
|
- 1790 astClsF, astClsFTail, astNode);
|
|
|
- 1791 IF SymTab.Lookup(rhs) THEN
|
|
|
- 1792 SymTab.SetSymType(n,
|
|
|
- 1793 SymTab.SymType(rhs))
|
|
|
- 1794 END; .)
|
|
|
- 1795 | (. IF NOT SymTab.FieldPending(ct,
|
|
|
- 1796 n) THEN
|
|
|
+ 884 AST.SetChild(astUnit, 1, astSeq);
|
|
|
+ 885 AST.SetChild(astUnit, 3, astImp);
|
|
|
+ 886 astDecl := AST.NoNode;
|
|
|
+ 887 astStmt := AST.NoNode; .)
|
|
|
+ 888 "END"
|
|
|
+ 889 GetIdent<m2> (. IF instActive THEN InstNameGet(m2) END;
|
|
|
+ 890 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
+ 891 SemError(202) END;
|
|
|
+ 892 SymTab.EndUnit; .)
|
|
|
+ 893 | "=" GetIdent<g> [ "(" Actuals ")" ] ";"
|
|
|
+ 894 (. CopyNm(m1, refInst);
|
|
|
+ 895 CopyNm(g, refGen);
|
|
|
+ 896 refSeen := TRUE; refIsDef := TRUE;
|
|
|
+ 897 astUnit := AST.MakeNode(AST.NkUnit);
|
|
|
+ 898 AST.SetChild(astUnit, 0,
|
|
|
+ 899 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
+ 900 astDecl := AST.NoNode;
|
|
|
+ 901 astStmt := AST.NoNode; .)
|
|
|
+ 902 "END"
|
|
|
+ 903 GetIdent<m2> (. IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
+ 904 SemError(202) END;
|
|
|
+ 905 SymTab.EndUnit; .) ) .
|
|
|
+ 906 ImplUnit (. VAR m1, m2: SymTab.Name;
|
|
|
+ 907 g: SymTab.Name;
|
|
|
+ 908 k: CARDINAL;
|
|
|
+ 909 rp: CARDINAL;
|
|
|
+ 910 rpOk: BOOLEAN;
|
|
|
+ 911 rErrs: INTEGER;
|
|
|
+ 912 rDecl, rStmt: AST.Node;
|
|
|
+ 913 rnm: SymTab.Name;
|
|
|
+ 914 rSym, rErr: CARDINAL;
|
|
|
+ 915 fname: SymTab.Name;
|
|
|
+ 916 unres: BOOLEAN;
|
|
|
+ 917 astNode: AST.Node;
|
|
|
+ 918 astBody, astHandler: AST.Node;
|
|
|
+ 919 hasExcept: BOOLEAN; .)
|
|
|
+ 920 = (. refN := 0; refSeen := FALSE;
|
|
|
+ 921 inHandler := FALSE;
|
|
|
+ 922 astHandler := AST.NoNode;
|
|
|
+ 923 hasExcept := FALSE; .)
|
|
|
+ 924 "IMPLEMENTATION" "MODULE"
|
|
|
+ 925 [ "FOR" string ] (* ISO foreign module: FOR "C" *)
|
|
|
+ 926 GetIdent<m1> (. IF instActive THEN InstNameGet(m1) END;
|
|
|
+ 927 IF instActive THEN
|
|
|
+ 928 IF NOT SymTab.Reenter(m1,
|
|
|
+ 929 SymTab.UnitImpl) THEN
|
|
|
+ 930 SemError(201) END
|
|
|
+ 931 ELSIF NOT SymTab.BeginImpl(m1) THEN
|
|
|
+ 932 SemError(201) END;
|
|
|
+ 933 astStmt := AST.NoNode;
|
|
|
+ 934 astDecl := AST.NoNode;
|
|
|
+ 935 astImp := AST.NoNode;
|
|
|
+ 936 astImpTail := AST.NoNode;
|
|
|
+ 937 nPendVar := 0;
|
|
|
+ 938 CopyNm(m1, unitName);
|
|
|
+ 939 unitWasGen := isGen AND NOT instActive;
|
|
|
+ 940 unitWasDef := FALSE;
|
|
|
+ 941 QbeGen.SetModule(m1); .)
|
|
|
+ 942 [ GenericFormals ]
|
|
|
+ 943 ( ";"
|
|
|
+ 944 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 945 astImp, astImpTail, astDecl); .) }
|
|
|
+ 946 DeclSeq (. astStmt := AST.NoNode; .)
|
|
|
+ 947 [ "BEGIN" (. FlushPend;
|
|
|
+ 948 k := 0;
|
|
|
+ 949 WHILE k < SymTab.FwdPending() DO
|
|
|
+ 950 SymTab.FwdInfo(k, fname, unres);
|
|
|
+ 951 IF unres THEN SemError(201) END;
|
|
|
+ 952 INC(k)
|
|
|
+ 953 END;
|
|
|
+ 954 SymTab.FwdClear;
|
|
|
+ 955
|
|
|
+ 956 nLab := 0; nGot := 0; .)
|
|
|
+ 957 [ StatSeq ] ]
|
|
|
+ 958 (. astBody := astStmt; .)
|
|
|
+ 959 [ "EXCEPT" (. (* M1: grammar/AST only; M2 removes
|
|
|
+ 960 this 230 and adds codegen. *)
|
|
|
+ 961 SemError(230);
|
|
|
+ 962 hasExcept := TRUE;
|
|
|
+ 963 inHandler := TRUE; .)
|
|
|
+ 964 [ StatSeq ] (. astHandler := astStmt;
|
|
|
+ 965 inHandler := FALSE .) ]
|
|
|
+ 966 (. IF twoPhaseParse THEN
|
|
|
+ 967 rSym := sym; rErr := errDist;
|
|
|
+ 968 rDecl := astDecl; rStmt := astBody;
|
|
|
+ 969 M2S.PushPos;
|
|
|
+ 970 repassing := TRUE;
|
|
|
+ 971 rp := 0;
|
|
|
+ 972 WHILE rp < nSpans DO
|
|
|
+ 973 k := 0;
|
|
|
+ 974 WHILE (k <= HIGH(rnm))
|
|
|
+ 975 AND (spanName[rp][k] # CHR(0)) DO
|
|
|
+ 976 rnm[k] := spanName[rp][k]; INC(k)
|
|
|
+ 977 END;
|
|
|
+ 978 rnm[k] := CHR(0);
|
|
|
+ 979 M2S.SeekTo(spanStart[rp]);
|
|
|
+ 980 Adv;
|
|
|
+ 981 rpOk := SymTab.ReenterDeferred(spanIdx[rp]);
|
|
|
+ 982 IF NOT rpOk THEN
|
|
|
+ 983 FileIO.WriteString(FileIO.StdOut,
|
|
|
+ 984 "twophase reenter failed");
|
|
|
+ 985 FileIO.WriteLn(FileIO.StdOut)
|
|
|
+ 986 END;
|
|
|
+ 987 Lower.ReenterScopeProc(spanTy[rp]);
|
|
|
+ 988 QbeGen.BeginFunc("");
|
|
|
+ 989 CopyNm(rnm, curFun);
|
|
|
+ 990 Block(rnm);
|
|
|
+ 991 AST.SetChild(spanNode[rp], 1, astStmt);
|
|
|
+ 992 AST.SetChild(spanNode[rp], 2, astBlkDecls);
|
|
|
+ 993 Lower.ScopeLeave;
|
|
|
+ 994 SymTab.CloseProc;
|
|
|
+ 995 QbeGen.EndFunc(SymTab.ProcRes(rnm));
|
|
|
+ 996 INC(rp)
|
|
|
+ 997 END;
|
|
|
+ 998 curFun[0] := CHR(0);
|
|
|
+ 999 SymTab.OrderCheckOff; rErrs := M2S.errors;
|
|
|
+ 1000 repassing := FALSE;
|
|
|
+ 1001 M2S.PopPos;
|
|
|
+ 1002 sym := rSym; errDist := rErr;
|
|
|
+ 1003 M2S.errors := rErrs;
|
|
|
+ 1004
|
|
|
+ 1005 astDecl := rDecl; astStmt := rStmt
|
|
|
+ 1006 END; .)
|
|
|
+ 1007 "END"
|
|
|
+ 1008 GetIdent<m2> (. IF instActive THEN InstNameGet(m2) END;
|
|
|
+ 1009 FlushPend;
|
|
|
+ 1010 k := 0;
|
|
|
+ 1011 WHILE k < SymTab.FwdPending() DO
|
|
|
+ 1012 SymTab.FwdInfo(k, fname, unres);
|
|
|
+ 1013 IF unres THEN SemError(201) END;
|
|
|
+ 1014 INC(k)
|
|
|
+ 1015 END;
|
|
|
+ 1016 SymTab.FwdClear;
|
|
|
+ 1017
|
|
|
+ 1018 IF hasExcept THEN
|
|
|
+ 1019 astStmt := WrapExcept(astBody,
|
|
|
+ 1020 astHandler)
|
|
|
+ 1021 END;
|
|
|
+ 1022 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
+ 1023 AST.SetChild(astNode, 0,
|
|
|
+ 1024 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
+ 1025 AST.SetChild(astNode, 1, astDecl);
|
|
|
+ 1026 AST.SetChild(astNode, 2, astStmt);
|
|
|
+ 1027 AST.SetChild(astNode, 3, astImp);
|
|
|
+ 1028 astUnit := astNode;
|
|
|
+ 1029 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
+ 1030 SemError(202) END;
|
|
|
+ 1031 CheckGotos;
|
|
|
+ 1032 SymTab.EndUnit; .)
|
|
|
+ 1033 | "=" GetIdent<g> [ "(" Actuals ")" ] ";"
|
|
|
+ 1034 (. CopyNm(m1, refInst);
|
|
|
+ 1035 CopyNm(g, refGen);
|
|
|
+ 1036 refSeen := TRUE; refIsDef := FALSE;
|
|
|
+ 1037 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
+ 1038 AST.SetChild(astNode, 0,
|
|
|
+ 1039 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
+ 1040 astDecl := AST.NoNode;
|
|
|
+ 1041 astStmt := AST.NoNode; .)
|
|
|
+ 1042 { Import (. (* refinement unit import *) .) }
|
|
|
+ 1043 "END"
|
|
|
+ 1044 GetIdent<m2> (. IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
+ 1045 SemError(202) END;
|
|
|
+ 1046 SymTab.EndUnit; .) ) .
|
|
|
+ 1047 ProgModule (. VAR m1, m2: SymTab.Name;
|
|
|
+ 1048 k: CARDINAL;
|
|
|
+ 1049 rp: CARDINAL;
|
|
|
+ 1050 rpOk: BOOLEAN;
|
|
|
+ 1051 rErrs: INTEGER;
|
|
|
+ 1052 rDecl, rStmt: AST.Node;
|
|
|
+ 1053 rnm: SymTab.Name;
|
|
|
+ 1054 rSym, rErr: CARDINAL;
|
|
|
+ 1055 fname: SymTab.Name;
|
|
|
+ 1056 unres: BOOLEAN;
|
|
|
+ 1057 astNode: AST.Node;
|
|
|
+ 1058 astBody, astHandler: AST.Node;
|
|
|
+ 1059 hasExcept: BOOLEAN; .)
|
|
|
+ 1060 = (. inHandler := FALSE;
|
|
|
+ 1061 astHandler := AST.NoNode;
|
|
|
+ 1062 hasExcept := FALSE; .)
|
|
|
+ 1063 "MODULE"
|
|
|
+ 1064 GetIdent<m1> (. IF NOT SymTab.BeginProg(m1) THEN
|
|
|
+ 1065 SemError(200) END;
|
|
|
+ 1066 astStmt := AST.NoNode;
|
|
|
+ 1067 astDecl := AST.NoNode;
|
|
|
+ 1068 astImp := AST.NoNode;
|
|
|
+ 1069 astImpTail := AST.NoNode;
|
|
|
+ 1070 nPendVar := 0;
|
|
|
+ 1071 QbeGen.SetModule(m1);
|
|
|
+ 1072 CopyNm(m1, unitName); .)
|
|
|
+ 1073 [ Priority ]
|
|
|
+ 1074 ";"
|
|
|
+ 1075 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 1076 astImp, astImpTail, astDecl); .) }
|
|
|
+ 1077 DeclSeq (. astStmt := AST.NoNode; .)
|
|
|
+ 1078 [ "BEGIN" (. FlushPend;
|
|
|
+ 1079 k := 0;
|
|
|
+ 1080 WHILE k < SymTab.FwdPending() DO
|
|
|
+ 1081 SymTab.FwdInfo(k, fname, unres);
|
|
|
+ 1082 IF unres THEN SemError(201) END;
|
|
|
+ 1083 INC(k)
|
|
|
+ 1084 END;
|
|
|
+ 1085 SymTab.FwdClear;
|
|
|
+ 1086
|
|
|
+ 1087 nLab := 0; nGot := 0; .)
|
|
|
+ 1088 [ StatSeq ] ]
|
|
|
+ 1089 (. astBody := astStmt; .)
|
|
|
+ 1090 [ "EXCEPT" (. (* M1: grammar/AST only; M2 removes
|
|
|
+ 1091 this 230 and adds codegen. *)
|
|
|
+ 1092 SemError(230);
|
|
|
+ 1093 hasExcept := TRUE;
|
|
|
+ 1094 inHandler := TRUE; .)
|
|
|
+ 1095 [ StatSeq ] (. astHandler := astStmt;
|
|
|
+ 1096 inHandler := FALSE .) ]
|
|
|
+ 1097 (. IF twoPhaseParse THEN
|
|
|
+ 1098 rSym := sym; rErr := errDist;
|
|
|
+ 1099 rDecl := astDecl; rStmt := astBody;
|
|
|
+ 1100 M2S.PushPos;
|
|
|
+ 1101 repassing := TRUE;
|
|
|
+ 1102 rp := 0;
|
|
|
+ 1103 WHILE rp < nSpans DO
|
|
|
+ 1104 k := 0;
|
|
|
+ 1105 WHILE (k <= HIGH(rnm))
|
|
|
+ 1106 AND (spanName[rp][k] # CHR(0)) DO
|
|
|
+ 1107 rnm[k] := spanName[rp][k]; INC(k)
|
|
|
+ 1108 END;
|
|
|
+ 1109 rnm[k] := CHR(0);
|
|
|
+ 1110 M2S.SeekTo(spanStart[rp]);
|
|
|
+ 1111 Adv;
|
|
|
+ 1112 rpOk := SymTab.ReenterDeferred(spanIdx[rp]);
|
|
|
+ 1113 IF NOT rpOk THEN
|
|
|
+ 1114 FileIO.WriteString(FileIO.StdOut,
|
|
|
+ 1115 "twophase reenter failed");
|
|
|
+ 1116 FileIO.WriteLn(FileIO.StdOut)
|
|
|
+ 1117 END;
|
|
|
+ 1118 Lower.ReenterScopeProc(spanTy[rp]);
|
|
|
+ 1119 QbeGen.BeginFunc("");
|
|
|
+ 1120 CopyNm(rnm, curFun);
|
|
|
+ 1121 Block(rnm);
|
|
|
+ 1122 AST.SetChild(spanNode[rp], 1, astStmt);
|
|
|
+ 1123 AST.SetChild(spanNode[rp], 2, astBlkDecls);
|
|
|
+ 1124 Lower.ScopeLeave;
|
|
|
+ 1125 SymTab.CloseProc;
|
|
|
+ 1126 QbeGen.EndFunc(SymTab.ProcRes(rnm));
|
|
|
+ 1127 INC(rp)
|
|
|
+ 1128 END;
|
|
|
+ 1129 curFun[0] := CHR(0);
|
|
|
+ 1130 SymTab.OrderCheckOff; rErrs := M2S.errors;
|
|
|
+ 1131 repassing := FALSE;
|
|
|
+ 1132 M2S.PopPos;
|
|
|
+ 1133 sym := rSym; errDist := rErr;
|
|
|
+ 1134 M2S.errors := rErrs;
|
|
|
+ 1135
|
|
|
+ 1136 astDecl := rDecl; astStmt := rStmt
|
|
|
+ 1137 END; .)
|
|
|
+ 1138 "END"
|
|
|
+ 1139 GetIdent<m2> (. IF instActive THEN InstNameGet(m2) END;
|
|
|
+ 1140 FlushPend;
|
|
|
+ 1141 k := 0;
|
|
|
+ 1142 WHILE k < SymTab.FwdPending() DO
|
|
|
+ 1143 SymTab.FwdInfo(k, fname, unres);
|
|
|
+ 1144 IF unres THEN SemError(201) END;
|
|
|
+ 1145 INC(k)
|
|
|
+ 1146 END;
|
|
|
+ 1147 SymTab.FwdClear;
|
|
|
+ 1148
|
|
|
+ 1149 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
+ 1150 SemError(202) END;
|
|
|
+ 1151 IF hasExcept THEN
|
|
|
+ 1152 astStmt := WrapExcept(astBody,
|
|
|
+ 1153 astHandler)
|
|
|
+ 1154 END;
|
|
|
+ 1155 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
+ 1156 AST.SetChild(astNode, 0,
|
|
|
+ 1157 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
+ 1158 AST.SetChild(astNode, 1, astDecl);
|
|
|
+ 1159 AST.SetChild(astNode, 2, astStmt);
|
|
|
+ 1160 AST.SetChild(astNode, 3, astImp);
|
|
|
+ 1161 astUnit := astNode;
|
|
|
+ 1162 CheckGotos;
|
|
|
+ 1163 SymTab.EndUnit; .) .
|
|
|
+ 1164 DeclSeq (. VAR astSeq, astTail: AST.Node; .)
|
|
|
+ 1165 = (. astSeq := AST.NoNode;
|
|
|
+ 1166 astTail := AST.NoNode; .)
|
|
|
+ 1167 { (. astDecl := AST.NoNode; .)
|
|
|
+ 1168 ( ConstBlock | TypeBlock<FALSE> | VarBlock | ProcDecl ";"
|
|
|
+ 1169 | NestedModule ";" | ClassItem ";" )
|
|
|
+ 1170 (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 1171 astSeq, astTail, astDecl); .) }
|
|
|
+ 1172 (. astDecl := astSeq; .) .
|
|
|
+ 1173 (* Local module, Wirth form. Declarations lower like top-level ones
|
|
|
+ 1174 (same QBE module prefix); a BEGIN body becomes an init function
|
|
|
+ 1175 that main calls; the EXPORT list is hoisted into the enclosing
|
|
|
+ 1176 scope at END. *)
|
|
|
+ 1177 NestedModule (. VAR m1, m2: SymTab.Name;
|
|
|
+ 1178 expNames: ARRAY [0 .. 63] OF SymTab.Name;
|
|
|
+ 1179 expCount, k: CARDINAL;
|
|
|
+ 1180 astNode, nImp, nImpTail:
|
|
|
+ 1181 AST.Node;
|
|
|
+ 1182 astBody, astHandler: AST.Node;
|
|
|
+ 1183 hasExcept: BOOLEAN; .)
|
|
|
+ 1184 = (. inHandler := FALSE;
|
|
|
+ 1185 astHandler := AST.NoNode;
|
|
|
+ 1186 hasExcept := FALSE; .)
|
|
|
+ 1187 "MODULE"
|
|
|
+ 1188 GetIdent<m1> (. IF NOT SymTab.Enter(m1,
|
|
|
+ 1189 SymTab.KindModule) THEN
|
|
|
+ 1190 SemError(200) END;
|
|
|
+ 1191 SymTab.PushScope;
|
|
|
+ 1192 expCount := 0;
|
|
|
+ 1193 astNode := AST.MakeNode(AST.NkUnit);
|
|
|
+ 1194 AST.SetChild(astNode, 0,
|
|
|
+ 1195 AST.MakeLeaf(AST.NkIdent, m1));
|
|
|
+ 1196 astStmt := AST.NoNode;
|
|
|
+ 1197 astDecl := AST.NoNode;
|
|
|
+ 1198 nImp := AST.NoNode;
|
|
|
+ 1199 nImpTail := AST.NoNode; .)
|
|
|
+ 1200 [ Priority ]
|
|
|
+ 1201 ";"
|
|
|
+ 1202 { Import (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 1203 nImp, nImpTail, astDecl); .) }
|
|
|
+ 1204 [ "EXPORT" [ "QUALIFIED" | "UNQUALIFIED" ]
|
|
|
+ 1205 GetIdent<expNames[expCount]> (. INC(expCount); .)
|
|
|
+ 1206 { "," GetIdent<expNames[expCount]>
|
|
|
+ 1207 (. INC(expCount); .) }
|
|
|
+ 1208 ";" ]
|
|
|
+ 1209 DeclSeq (. astStmt := AST.NoNode; .)
|
|
|
+ 1210 [ "BEGIN" (. astStmt := AST.NoNode;
|
|
|
+ 1211 .)
|
|
|
+ 1212 [ StatSeq ] ]
|
|
|
+ 1213 (. astBody := astStmt; .)
|
|
|
+ 1214 [ "EXCEPT" (. (* M1: grammar/AST only; M2 removes
|
|
|
+ 1215 this 230 and adds codegen. *)
|
|
|
+ 1216 SemError(230);
|
|
|
+ 1217 hasExcept := TRUE;
|
|
|
+ 1218 inHandler := TRUE; .)
|
|
|
+ 1219 [ StatSeq ] (. astHandler := astStmt;
|
|
|
+ 1220 inHandler := FALSE .) ]
|
|
|
+ 1221 "END"
|
|
|
+ 1222 GetIdent<m2> (. IF hasExcept THEN
|
|
|
+ 1223 astStmt := WrapExcept(astBody,
|
|
|
+ 1224 astHandler)
|
|
|
+ 1225 END;
|
|
|
+ 1226 AST.SetChild(astNode, 1, astDecl);
|
|
|
+ 1227 AST.SetChild(astNode, 2, astStmt);
|
|
|
+ 1228 AST.SetChild(astNode, 3, nImp);
|
|
|
+ 1229 astDecl := astNode;
|
|
|
+ 1230 IF NOT SymTab.Equal(m1, m2) THEN
|
|
|
+ 1231 SemError(202) END;
|
|
|
+ 1232 k := 0;
|
|
|
+ 1233 WHILE k < expCount DO
|
|
|
+ 1234 SymTab.ExportUp(expNames[k]);
|
|
|
+ 1235 INC(k)
|
|
|
+ 1236 END;
|
|
|
+ 1237 SymTab.PopScope; .) .
|
|
|
+ 1238 Priority
|
|
|
+ 1239 = "[" integer "]" (. SemError(230); .) .
|
|
|
+ 1240 (* Imports (4.3): FROM materializes the names (unqualified use);
|
|
|
+ 1241 plain IMPORT only demands the module exists — qualified `L.x`
|
|
|
+ 1242 materializes on first use (Design). *)
|
|
|
+ 1243 (* Unknown modules stay unchecked stubs (legacy, so hand-written
|
|
|
+ 1244 import lines don't fail); a known module's missing export is
|
|
|
+ 1245 201. *)
|
|
|
+ 1246 Import (. VAR n: SymTab.Name;
|
|
|
+ 1247 astImport: AST.Node; .)
|
|
|
+ 1248 = "FROM"
|
|
|
+ 1249 GetIdent<n> (. astImport := AST.MakeNode(AST.NkImport);
|
|
|
+ 1250 AST.SetChild(astImport, 0,
|
|
|
+ 1251 AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
+ 1252 "IMPORT"
|
|
|
+ 1253 ImpList<n, astImport> ";" (. astDecl := astImport; .)
|
|
|
+ 1254 | "IMPORT" (. astImport := AST.MakeNode(AST.NkImport); .)
|
|
|
+ 1255 ImpModList<astImport> ";" (. astDecl := astImport; .) .
|
|
|
+ 1256 ImpList<mod: SymTab.Name; node: AST.Node>
|
|
|
+ 1257 (. VAR n: SymTab.Name; .)
|
|
|
+ 1258 = ImpName<mod, node>
|
|
|
+ 1259 { "," ImpName<mod, node> } .
|
|
|
+ 1260 (* Pervasive built-ins imported from SYSTEM (e.g. TSIZE) are
|
|
|
+ 1261 accepted and ignored: the built-in applies regardless. *)
|
|
|
+ 1262 ImpName<mod: SymTab.Name; node: AST.Node>
|
|
|
+ 1263 (. VAR n: SymTab.Name; .)
|
|
|
+ 1264 = GetIdent<n> (. AST.SetChild(node, AST.NChild(node),
|
|
|
+ 1265 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
+ 1266 IF SymTab.Equal(mod, "libc") THEN
|
|
|
+ 1267 (* intrinsic C library:
|
|
|
+ 1268 permissive external *)
|
|
|
+ 1269 IF NOT SymTab.DeclareCProc(n) THEN
|
|
|
+ 1270 SemError(201) END;
|
|
|
+ 1271 Lower.NoteCProc(n)
|
|
|
+ 1272 ELSIF SymTab.ModKnown(mod)
|
|
|
+ 1273 AND NOT SymTab.Equal(mod,
|
|
|
+ 1274 "SYSTEM") THEN
|
|
|
+ 1275 IF NOT SymTab.ImportFrom(mod, n) THEN
|
|
|
+ 1276 SemError(201)
|
|
|
+ 1277 ELSE Lower.NoteImportedProc(n)
|
|
|
+ 1278 END
|
|
|
+ 1279 END; .)
|
|
|
+ 1280 | ( "TSIZE" | "SIZE" | "ADR" | "HIGH" | "LEN"
|
|
|
+ 1281 | "CHR" | "ORD" | "VAL" | "ABS" | "CAP"
|
|
|
+ 1282 | "ODD" | "TRUNC" | "FLOAT"
|
|
|
+ 1283 | "UCHR" | "CHR8" | "UORD"
|
|
|
+ 1284 | "INC" | "DEC"
|
|
|
+ 1285 | "SHIFT" | "ROTATE" | "CAST" | "CONVERT" | "MIN" | "MAX"
|
|
|
+ 1286 | "INCL" | "EXCL" | "NEW" | "DISPOSE" | "LOC" ) .
|
|
|
+ 1287 ImpModList<node: AST.Node> (. VAR n: SymTab.Name; .)
|
|
|
+ 1288 = GetIdent<n> (. AST.SetChild(node, AST.NChild(node),
|
|
|
+ 1289 AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
+ 1290 { "," GetIdent<n> (. AST.SetChild(node, AST.NChild(node),
|
|
|
+ 1291 AST.MakeLeaf(AST.NkIdent, n)); .) } .
|
|
|
+ 1292 (* Opaque TYPE declarations (definition modules). The targetless
|
|
|
+ 1293 alias resolves to InvalidType until step 4 completes it. *)
|
|
|
+ 1294 (* Scalar-phase TYPEs: named types, integer subranges, enumerations.
|
|
|
+ 1295 Opaque "TYPE T;" needs isDef (definition units); elsewhere 231.
|
|
|
+ 1296 Composite forms (ARRAY/RECORD/SET/POINTER) arrive with step 3. *)
|
|
|
+ 1297 TypeBlock<isDef: BOOLEAN> (. VAR astSeq, astTail: AST.Node; .)
|
|
|
+ 1298 = "TYPE" (. SymTab.BeginTypeBlock;
|
|
|
+ 1299 astSeq := AST.NoNode;
|
|
|
+ 1300 astTail := AST.NoNode; .)
|
|
|
+ 1301 { (. astDecl := AST.NoNode; .)
|
|
|
+ 1302 ( TypeItem<isDef> ";" | ClassItem ";" )
|
|
|
+ 1303 (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 1304 astSeq, astTail, astDecl); .) }
|
|
|
+ 1305 (. SymTab.EndTypeBlock;
|
|
|
+ 1306 astDecl := astSeq; .) .
|
|
|
+ 1307 TypeItem<isDef: BOOLEAN> (. VAR n: SymTab.Name;
|
|
|
+ 1308 t, op: SymTab.TypeIndex;
|
|
|
+ 1309 astNode: AST.Node; .)
|
|
|
+ 1310 = GetIdent<n> (. op := SymTab.OpaqueBase(n);
|
|
|
+ 1311 IF op = SymTab.InvalidType THEN
|
|
|
+ 1312 IF NOT SymTab.Enter(n,
|
|
|
+ 1313 SymTab.KindType) THEN
|
|
|
+ 1314 SemError(200) END
|
|
|
+ 1315 END; .)
|
|
|
+ 1316 ( "=" Type<t, FALSE> (. astNode := AST.MakeNode(AST.NkTypeDecl);
|
|
|
+ 1317 AST.SetChild(astNode, 0,
|
|
|
+ 1318 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
+ 1319 AST.SetTy(astNode, t);
|
|
|
+ 1320 astDecl := astNode;
|
|
|
+ 1321 IF op # SymTab.InvalidType THEN
|
|
|
+ 1322 SymTab.SetTarget(op, t)
|
|
|
+ 1323 ELSE SymTab.SetSymType(n, t)
|
|
|
+ 1324 END;
|
|
|
+ 1325 IF SymTab.EnterEnumLits(t) > 0 THEN END; .)
|
|
|
+ 1326 | (. IF op # SymTab.InvalidType THEN
|
|
|
+ 1327 (* stays opaque *)
|
|
|
+ 1328 ELSIF NOT isDef THEN
|
|
|
+ 1329 SemError(231)
|
|
|
+ 1330 ELSE SymTab.SetSymType(n,
|
|
|
+ 1331 SymTab.NewAlias()) END; .) ) .
|
|
|
+ 1332 Type<VAR t: SymTab.TypeIndex; allowOpen: BOOLEAN>
|
|
|
+ 1333 = TypeIdent<t> [ Subrange<t> ] (* anchored subrange: T[lo..hi] *)
|
|
|
+ 1334 | Subrange<t>
|
|
|
+ 1335 | Enum<t>
|
|
|
+ 1336 | ArrayType<t, allowOpen>
|
|
|
+ 1337 | SetType<t>
|
|
|
+ 1338 | PackSetType<t>
|
|
|
+ 1339 | RecordType<t>
|
|
|
+ 1340 | PointerType<t>
|
|
|
+ 1341 | ProcType<t> .
|
|
|
+ 1342 PointerType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex; .)
|
|
|
+ 1343 = "POINTER" "TO" (. allowFwdType := TRUE; .)
|
|
|
+ 1344 Type<base, FALSE> (. allowFwdType := FALSE;
|
|
|
+ 1345 t := SymTab.NewPtr(base); .) .
|
|
|
+ 1346 (* Procedure types (step 8.5): PROCEDURE (params): result. Values
|
|
|
+ 1347 are code pointers; params are collected into the descriptor. *)
|
|
|
+ 1348 ProcType<VAR t: SymTab.TypeIndex> (. VAR res, pt: SymTab.TypeIndex;
|
|
|
+ 1349 isV: BOOLEAN; .)
|
|
|
+ 1350 = ( "PROCEDURE" | "PROC" ) (. allowFwdType := FALSE;
|
|
|
+ 1351 res := SymTab.InvalidType;
|
|
|
+ 1352 t := SymTab.NewProcType(res); .)
|
|
|
+ 1353 [ "(" [ ProcTypeSection<t>
|
|
|
+ 1354 { (";" | ",") ProcTypeSection<t> } ] ")" ]
|
|
|
+ 1355 [ ":" ( TypeIdent<res> (. SymTab.SetProcTypeRes(t, res); .)
|
|
|
+ 1356 | "PROC" (. (* PROC as a result type: the
|
|
|
+ 1357 pervasive procedure value
|
|
|
+ 1358 type (ISO/PIM) *)
|
|
|
+ 1359 SymTab.SetProcTypeRes(t,
|
|
|
+ 1360 SymTab.AddrType()); .) ) ] .
|
|
|
+ 1361 ProcTypeSection<t: SymTab.TypeIndex> (. VAR pt: SymTab.TypeIndex;
|
|
|
+ 1362 isV: BOOLEAN;
|
|
|
+ 1363 cnt, k: CARDINAL;
|
|
|
+ 1364 names: ARRAY [0 .. 15] OF SymTab.Name; .)
|
|
|
+ 1365 = (. isV := FALSE; cnt := 0; .)
|
|
|
+ 1366 [ "VAR" (. isV := TRUE; .) ]
|
|
|
+ 1367 ( GetIdent<names[cnt]> (. INC(cnt); .)
|
|
|
+ 1368 { "," ( GetIdent<names[cnt]> (. INC(cnt); .)
|
|
|
+ 1369 | (. (* a comma followed by a type
|
|
|
+ 1370 (possibly VAR) ends the name
|
|
|
+ 1371 list: the collected names
|
|
|
+ 1372 were types, not names *)
|
|
|
+ 1373 k := 0;
|
|
|
+ 1374 WHILE k < cnt DO
|
|
|
+ 1375 SymTab.ProcTypeAdd(t, isV,
|
|
|
+ 1376 SymTab.SymType(names[k]));
|
|
|
+ 1377 INC(k)
|
|
|
+ 1378 END;
|
|
|
+ 1379 cnt := 0; .)
|
|
|
+ 1380 [ "VAR" (. isV := TRUE; .) ]
|
|
|
+ 1381 Type<pt, TRUE> (. SymTab.ProcTypeAdd(t, isV, pt); .) ) }
|
|
|
+ 1382 ( ":" Type<pt, TRUE> (. k := 0;
|
|
|
+ 1383 WHILE k < cnt DO
|
|
|
+ 1384 SymTab.ProcTypeAdd(t, isV, pt);
|
|
|
+ 1385 INC(k)
|
|
|
+ 1386 END; .)
|
|
|
+ 1387 | (. (* type-only parameter list:
|
|
|
+ 1388 each collected name is a
|
|
|
+ 1389 type (CHAR, a declared type,
|
|
|
+ 1390 ... or the GNU shorthand) *)
|
|
|
+ 1391 k := 0;
|
|
|
+ 1392 WHILE k < cnt DO
|
|
|
+ 1393 IF IsTypeName(names[k]) THEN
|
|
|
+ 1394 pt := SymTab.SymType(names[k])
|
|
|
+ 1395 ELSE SemError(201);
|
|
|
+ 1396 pt := SymTab.InvalidType
|
|
|
+ 1397 END;
|
|
|
+ 1398 SymTab.ProcTypeAdd(t, isV, pt);
|
|
|
+ 1399 INC(k)
|
|
|
+ 1400 END; .) )
|
|
|
+ 1401 | Type<pt, TRUE> (. (* unnamed parameter (PIM):
|
|
|
+ 1402 e.g. PROCEDURE (VAR ARRAY OF REAL) *)
|
|
|
+ 1403 SymTab.ProcTypeAdd(t, isV, pt); .) ) .
|
|
|
+ 1404 (* Arrays: "OF" without bounds is an open formal (allowed only
|
|
|
+ 1405 where allowOpen); "[lo..hi, ...]" nests bounded levels inside
|
|
|
+ 1406 out. The PIM/ISO multi-index form repeats the bracket group
|
|
|
+ 1407 ("ARRAY [lo..hi], [lo..hi] OF T"); the bounds of every group
|
|
|
+ 1408 nest in the same inside-out order as the comma list. Bounds are
|
|
|
+ 1409 folded literals (int/char); anything else 230. Bare-type indices
|
|
|
+ 1410 ("ARRAY Color OF") wait for enum ordinals. *)
|
|
|
+ 1411 ArrayType<VAR t: SymTab.TypeIndex; allowOpen: BOOLEAN>
|
|
|
+ 1412 (. VAR elem: SymTab.TypeIndex;
|
|
|
+ 1413 eb: SymTab.Name;
|
|
|
+ 1414 ok: BOOLEAN;
|
|
|
+ 1415 bnds, bndh: ARRAY [0 .. 7] OF INTEGER;
|
|
|
+ 1416 nb, k: CARDINAL;
|
|
|
+ 1417 idx: SymTab.TypeIndex;
|
|
|
+ 1418 ilo, ihi: INTEGER; .)
|
|
|
+ 1419 = "ARRAY" (. allowFwdType := FALSE; .)
|
|
|
+ 1420 ( "OF"
|
|
|
+ 1421 Type<elem, FALSE> (. LexName(eb); (* the element ident *)
|
|
|
+ 1422 IF NOT allowOpen THEN
|
|
|
+ 1423 SemError(230) END;
|
|
|
+ 1424 t := SymTab.NewOpenArray(elem);
|
|
|
+ 1425 IF SymTab.Equal(eb, "BYTE") THEN
|
|
|
+ 1426 SymTab.MarkByteBuf(t) END; .)
|
|
|
+ 1427 | TypeIdent<idx> [ Subrange<idx> ]
|
|
|
+ 1428 "OF" Type<elem, FALSE> (. (* index-type array: the index
|
|
|
+ 1429 type's ordinal bounds give the
|
|
|
+ 1430 [lo..hi] pair *)
|
|
|
+ 1431 IF SymTab.TypeBounds(idx, ilo,
|
|
|
+ 1432 ihi)
|
|
|
+ 1433 THEN t := SymTab.NewArrayB(elem,
|
|
|
+ 1434 ilo, ihi)
|
|
|
+ 1435 ELSE SemError(230);
|
|
|
+ 1436 t := SymTab.InvalidType
|
|
|
+ 1437 END; .)
|
|
|
+ 1438 | "[" (. SymTab.BoundBegin; ok := TRUE;
|
|
|
+ 1439 nb := 0; .)
|
|
|
+ 1440 BoundPair<ok>
|
|
|
+ 1441 { "," BoundPair<ok> }
|
|
|
+ 1442 "]" (. (* snapshot this bracket group
|
|
|
+ 1443 before the element type, which
|
|
|
+ 1444 reuses the bound buffer for a
|
|
|
+ 1445 nested ARRAY *)
|
|
|
+ 1446 IF nb + SymTab.BoundCount() >
|
|
|
+ 1447 HIGH(bnds) + 1 THEN
|
|
|
+ 1448 SemError(230); ok := FALSE
|
|
|
+ 1449 ELSE
|
|
|
+ 1450 k := 0;
|
|
|
+ 1451 WHILE k < SymTab.BoundCount() DO
|
|
|
+ 1452 bnds[nb] := SymTab.BoundLo(k);
|
|
|
+ 1453 bndh[nb] := SymTab.BoundHi(k);
|
|
|
+ 1454 INC(k); INC(nb)
|
|
|
+ 1455 END
|
|
|
+ 1456 END; .)
|
|
|
+ 1457 { "," "[" (. SymTab.BoundBegin; .)
|
|
|
+ 1458 BoundPair<ok>
|
|
|
+ 1459 { "," BoundPair<ok> }
|
|
|
+ 1460 "]" (. IF nb + SymTab.BoundCount() >
|
|
|
+ 1461 HIGH(bnds) + 1 THEN
|
|
|
+ 1462 SemError(230); ok := FALSE
|
|
|
+ 1463 ELSE
|
|
|
+ 1464 k := 0;
|
|
|
+ 1465 WHILE k < SymTab.BoundCount() DO
|
|
|
+ 1466 bnds[nb] := SymTab.BoundLo(k);
|
|
|
+ 1467 bndh[nb] := SymTab.BoundHi(k);
|
|
|
+ 1468 INC(k); INC(nb)
|
|
|
+ 1469 END
|
|
|
+ 1470 END; .) }
|
|
|
+ 1471 "OF" Type<elem, FALSE>
|
|
|
+ 1472 (. IF ok THEN
|
|
|
+ 1473 k := nb;
|
|
|
+ 1474 WHILE k > 0 DO
|
|
|
+ 1475 DEC(k);
|
|
|
+ 1476 elem := SymTab.NewArrayB(
|
|
|
+ 1477 elem, bnds[k], bndh[k])
|
|
|
+ 1478 END;
|
|
|
+ 1479 t := elem
|
|
|
+ 1480 ELSE t := SymTab.InvalidType
|
|
|
+ 1481 END; .) ) .
|
|
|
+ 1482 BoundPair<VAR ok: BOOLEAN> (. VAR tlo, thi: SymTab.TypeIndex;
|
|
|
+ 1483 qlo, qhi: QbeGen.QVal;
|
|
|
+ 1484 lo, hi: INTEGER;
|
|
|
+ 1485 cl, cl2: INTEGER; .)
|
|
|
+ 1486 = Expr<tlo, qlo> ".." Expr<thi, qhi>
|
|
|
+ 1487 (. IF (tlo = SymTab.InvalidType)
|
|
|
+ 1488 OR (thi = SymTab.InvalidType) THEN
|
|
|
+ 1489 ok := FALSE
|
|
|
+ 1490 ELSE cl := SymTab.ClassOf(tlo);
|
|
|
+ 1491 cl2 := SymTab.ClassOf(thi);
|
|
|
+ 1492 IF ((cl # SymTab.ClInt)
|
|
|
+ 1493 AND (cl # SymTab.ClChar)
|
|
|
+ 1494 AND (cl # SymTab.ClBool)
|
|
|
+ 1495 AND (cl # SymTab.ClEnum)
|
|
|
+ 1496 AND (cl # SymTab.ClByte)
|
|
|
+ 1497 AND (cl # SymTab.ClSByte)
|
|
|
+ 1498 AND (cl # SymTab.ClWord16)
|
|
|
+ 1499 AND (cl # SymTab.ClSWord16))
|
|
|
+ 1500 OR ((cl2 # SymTab.ClInt)
|
|
|
+ 1501 AND (cl2 # SymTab.ClChar)
|
|
|
+ 1502 AND (cl2 # SymTab.ClBool)
|
|
|
+ 1503 AND (cl2 # SymTab.ClEnum)
|
|
|
+ 1504 AND (cl2 # SymTab.ClByte)
|
|
|
+ 1505 AND (cl2 # SymTab.ClSByte)
|
|
|
+ 1506 AND (cl2 # SymTab.ClWord16)
|
|
|
+ 1507 AND (cl2 # SymTab.ClSWord16)) THEN
|
|
|
+ 1508 SemError(230); ok := FALSE
|
|
|
+ 1509 ELSIF NOT SymTab.ConstInt(qlo, lo)
|
|
|
+ 1510 OR NOT SymTab.ConstInt(qhi, hi)
|
|
|
+ 1511 OR (lo > hi) THEN
|
|
|
+ 1512 SemError(230); ok := FALSE
|
|
|
+ 1513 ELSIF NOT SymTab.BoundAdd(lo, hi) THEN
|
|
|
+ 1514 SemError(230); ok := FALSE
|
|
|
+ 1515 END;
|
|
|
+ 1516 END; .) .
|
|
|
+ 1517 (* Sets: multi-word masks over bases ≤ 256 values (bool, char,
|
|
|
+ 1518 bounded subranges; enums wait for ordinals, INTEGER is
|
|
|
+ 1519 unbounded). Literals are SET OF [0..255]; assignment and
|
|
|
+ 1520 comparison across suitable bases are lenient (masks over min
|
|
|
+ 1521 words + zero-check extras), out-of-span literals are 222. *)
|
|
|
+ 1522 SetType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex;
|
|
|
+ 1523 blo, bhi, bspan: INTEGER;
|
|
|
+ 1524 bcls: INTEGER; .)
|
|
|
+ 1525 = "SET" (. allowFwdType := FALSE; .)
|
|
|
+ 1526 "OF" Type<base, FALSE>
|
|
|
+ 1527 (. IF base = SymTab.InvalidType THEN
|
|
|
+ 1528 t := SymTab.InvalidType
|
|
|
+ 1529 ELSIF SymTab.Unresolved(base) THEN
|
|
|
+ 1530 (* an opaque/formal base: defer
|
|
|
+ 1531 the span check until the
|
|
|
+ 1532 base is completed *)
|
|
|
+ 1533 t := SymTab.NewSet(base)
|
|
|
+ 1534 ELSE bcls :=
|
|
|
+ 1535 SymTab.ClassOf(base);
|
|
|
+ 1536 (* a subrange keeps its own
|
|
|
+ 1537 span even when its base is
|
|
|
+ 1538 CHAR/BOOLEAN/an enum *)
|
|
|
+ 1539 IF SymTab.SubBounds(base,
|
|
|
+ 1540 blo, bhi) THEN
|
|
|
+ 1541 bspan := bhi - blo + 1
|
|
|
+ 1542 ELSIF bcls = SymTab.ClBool THEN
|
|
|
+ 1543 blo := 0; bspan := 2
|
|
|
+ 1544 ELSIF bcls = SymTab.ClChar THEN
|
|
|
+ 1545 blo := 0; bspan := 256
|
|
|
+ 1546 ELSIF bcls = SymTab.ClByte THEN
|
|
|
+ 1547 blo := 0; bspan := 256
|
|
|
+ 1548 ELSIF bcls = SymTab.ClSByte THEN
|
|
|
+ 1549 blo := -128; bspan := 256
|
|
|
+ 1550 ELSIF bcls = SymTab.ClWord16 THEN
|
|
|
+ 1551 blo := 0; bspan := 65536
|
|
|
+ 1552 ELSIF bcls = SymTab.ClSWord16 THEN
|
|
|
+ 1553 blo := -32768; bspan := 65536
|
|
|
+ 1554 ELSIF bcls = SymTab.ClEnum THEN
|
|
|
+ 1555 blo := 0;
|
|
|
+ 1556 bspan := VAL(INTEGER,
|
|
|
+ 1557 SymTab.EnumCount(base))
|
|
|
+ 1558 ELSE bspan := 0 END;
|
|
|
+ 1559 IF (bspan <= 0)
|
|
|
+ 1560 OR (bspan > 65536) THEN
|
|
|
+ 1561 SemError(230);
|
|
|
+ 1562 t := SymTab.InvalidType
|
|
|
+ 1563 ELSE t := SymTab.NewSet(base)
|
|
|
+ 1564 END
|
|
|
+ 1565 END; .) .
|
|
|
+ 1566 (* PACKEDSET: same base rules as SET, but 1/2/4-byte storage. V3
|
|
|
+ 1567 limits the span to 32 bits (SetBytes 1..4); wider packed sets are
|
|
|
+ 1568 an implementation limit (230). *)
|
|
|
+ 1569 PackSetType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex;
|
|
|
+ 1570 blo, bhi, bspan: INTEGER;
|
|
|
+ 1571 bcls: INTEGER; .)
|
|
|
+ 1572 = "PACKEDSET" (. allowFwdType := FALSE; .)
|
|
|
+ 1573 "OF" Type<base, FALSE>
|
|
|
+ 1574 (. IF base = SymTab.InvalidType THEN
|
|
|
+ 1575 t := SymTab.InvalidType
|
|
|
+ 1576 ELSIF SymTab.Unresolved(base) THEN
|
|
|
+ 1577 t := SymTab.NewPackSet(base)
|
|
|
+ 1578 ELSE bcls :=
|
|
|
+ 1579 SymTab.ClassOf(base);
|
|
|
+ 1580 IF SymTab.SubBounds(base,
|
|
|
+ 1581 blo, bhi) THEN
|
|
|
+ 1582 bspan := bhi - blo + 1
|
|
|
+ 1583 ELSIF bcls = SymTab.ClBool THEN
|
|
|
+ 1584 blo := 0; bspan := 2
|
|
|
+ 1585 ELSIF bcls = SymTab.ClChar THEN
|
|
|
+ 1586 blo := 0; bspan := 256
|
|
|
+ 1587 ELSIF bcls = SymTab.ClByte THEN
|
|
|
+ 1588 blo := 0; bspan := 256
|
|
|
+ 1589 ELSIF bcls = SymTab.ClSByte THEN
|
|
|
+ 1590 blo := -128; bspan := 256
|
|
|
+ 1591 ELSIF bcls = SymTab.ClWord16 THEN
|
|
|
+ 1592 blo := 0; bspan := 65536
|
|
|
+ 1593 ELSIF bcls = SymTab.ClSWord16 THEN
|
|
|
+ 1594 blo := -32768; bspan := 65536
|
|
|
+ 1595 ELSIF bcls = SymTab.ClEnum THEN
|
|
|
+ 1596 blo := 0;
|
|
|
+ 1597 bspan := VAL(INTEGER,
|
|
|
+ 1598 SymTab.EnumCount(base))
|
|
|
+ 1599 ELSE bspan := 0 END;
|
|
|
+ 1600 IF (bspan <= 0)
|
|
|
+ 1601 OR (bspan > 32) THEN
|
|
|
+ 1602 SemError(230);
|
|
|
+ 1603 t := SymTab.InvalidType
|
|
|
+ 1604 ELSE t := SymTab.NewPackSet(base)
|
|
|
+ 1605 END
|
|
|
+ 1606 END; .) .
|
|
|
+ 1607 (* Records: flat blobs; array fields are pointers to static
|
|
|
+ 1608 descriptors (locked amendment), nested records inline. Field
|
|
|
+ 1609 offsets static and declaration-ordered. *)
|
|
|
+ 1610 (* Field list: plain fields and (optionally) one variant part. The
|
|
|
+ 1611 variant part is a `CASE ... END` item; because it starts with the
|
|
|
+ 1612 CASE keyword it is unambiguously distinguishable from a field
|
|
|
+ 1613 (which starts with an identifier). *)
|
|
|
+ 1614 RecordType<VAR t: SymTab.TypeIndex> (. VAR t2: SymTab.TypeIndex;
|
|
|
+ 1615 tagOk: BOOLEAN; .)
|
|
|
+ 1616 = "RECORD" (. allowFwdType := FALSE;
|
|
|
+ 1617 t := SymTab.NewRecord(); .)
|
|
|
+ 1618 [ RecItem<t> { ";" [ RecItem<t> ] } ]
|
|
|
+ 1619 "END" (. SymTab.LayoutRecord(t); .) .
|
|
|
+ 1620 RecItem<rec: SymTab.TypeIndex> (. VAR tt: SymTab.TypeIndex; .)
|
|
|
+ 1621 = RecField<rec>
|
|
|
+ 1622 | CaseField<rec> (. SymTab.MarkVariant(rec); .) .
|
|
|
+ 1623 (* A variant part: CASE [tag] : Type OF variants. gm2 extensions:
|
|
|
+ 1624 an untagged inner CASE (no tag field), empty arms and ELSE arms. *)
|
|
|
+ 1625 CaseField<rec: SymTab.TypeIndex> (. VAR tagT: SymTab.TypeIndex;
|
|
|
+ 1626 tagN: SymTab.Name;
|
|
|
+ 1627 tagged: BOOLEAN; .)
|
|
|
+ 1628 = "CASE" (. SymTab.ResetFields(rec);
|
|
|
+ 1629 tagged := FALSE; .)
|
|
|
+ 1630 [ GetIdent<tagN> (. IF NOT SymTab.FieldPending(rec,
|
|
|
+ 1631 tagN) THEN
|
|
|
+ 1632 SemError(200) END;
|
|
|
+ 1633 tagged := TRUE; .) ]
|
|
|
+ 1634 ":" Type<tagT, FALSE> (. IF (tagT # SymTab.InvalidType)
|
|
|
+ 1635 AND NOT SymTab.IsOrdinal(tagT) THEN
|
|
|
+ 1636 SemError(224)
|
|
|
+ 1637 END;
|
|
|
+ 1638 IF tagged THEN
|
|
|
+ 1639 SymTab.FixPendingF(rec, tagT);
|
|
|
+ 1640 SymTab.SetVariantTag(rec, tagN)
|
|
|
+ 1641 END; .)
|
|
|
+ 1642 "OF"
|
|
|
+ 1643 RecFieldList<rec>
|
|
|
+ 1644 { "|" (. SymTab.ResetFields(rec); .)
|
|
|
+ 1645 RecFieldList<rec> }
|
|
|
+ 1646 [ "ELSE" ]
|
|
|
+ 1647 "END" .
|
|
|
+ 1648 (* A variant branch: `labels : fields` (fields and their trailing ";"
|
|
|
+ 1649 optional, gm2), `ELSE`, or empty (the extra "|" separators gm2
|
|
|
+ 1650 tolerates). A branch may itself contain a nested variant CASE. *)
|
|
|
+ 1651 RecFieldList<rec: SymTab.TypeIndex> (. VAR lt, lq: SymTab.TypeIndex;
|
|
|
+ 1652 lv1, lv2: QbeGen.QVal; .)
|
|
|
+ 1653 = [ ( VarLabel<lt, lv1> [ ".." VarLabel<lq, lv2> ]
|
|
|
+ 1654 { "," VarLabel<lt, lv1> [ ".." VarLabel<lq, lv2> ] }
|
|
|
+ 1655 ":"
|
|
|
+ 1656 [ ArmField<rec> { ";" [ ArmField<rec> ] } ]
|
|
|
+ 1657 | "ELSE" ) ] .
|
|
|
+ 1658 ArmField<rec: SymTab.TypeIndex>
|
|
|
+ 1659 = RecField<rec>
|
|
|
+ 1660 | CaseField<rec> (. SymTab.MarkVariant(rec); .) .
|
|
|
+ 1661 (* Variant case label: a constant (or a constant range). Values are
|
|
|
+ 1662 not interpreted (the layout overlays regardless). *)
|
|
|
+ 1663 VarLabel<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 1664 (. VAR lname: SymTab.Name; .)
|
|
|
+ 1665 = ( ident (. LexName(lname);
|
|
|
+ 1666 QbeGen.CopyOp("0", q);
|
|
|
+ 1667 t := SymTab.IntType(); .)
|
|
|
+ 1668 | integer (. LexString(lname);
|
|
|
+ 1669 QbeGen.CopyOp("0", q);
|
|
|
+ 1670 t := SymTab.IntType(); .)
|
|
|
+ 1671 | charConst (. LexString(lname);
|
|
|
+ 1672 QbeGen.CopyOp("0", q);
|
|
|
+ 1673 t := SymTab.CharType(); .) ) .
|
|
|
+ 1674 RecField<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name;
|
|
|
+ 1675 t2: SymTab.TypeIndex; .)
|
|
|
+ 1676 = RecIdents<rec> ":" Type<t2, FALSE>(. SymTab.FixPendingF(rec, t2); .) .
|
|
|
+ 1677 RecIdents<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name; .)
|
|
|
+ 1678 = GetIdent<n> (. IF NOT SymTab.FieldPending(rec,
|
|
|
+ 1679 n) THEN
|
|
|
+ 1680 SemError(200) END; .)
|
|
|
+ 1681 { "," GetIdent<n> (. IF NOT SymTab.FieldPending(rec,
|
|
|
+ 1682 n) THEN
|
|
|
+ 1683 SemError(200) END; .) } .
|
|
|
+ 1684 TypeIdent<VAR t: SymTab.TypeIndex> (. VAR n, qid: SymTab.Name;
|
|
|
+ 1685 k: INTEGER;
|
|
|
+ 1686 dotted: BOOLEAN; .)
|
|
|
+ 1687 = GetIdent<n> (. dotted := FALSE;
|
|
|
+ 1688 IF NOT SymTab.Lookup(n) THEN
|
|
|
+ 1689 (* declaration before use: an
|
|
|
+ 1690 undeclared type is 201,
|
|
|
+ 1691 except as a POINTER's base
|
|
|
+ 1692 (allowFwdType) *)
|
|
|
+ 1693 k := -1;
|
|
|
+ 1694 IF allowFwdType THEN
|
|
|
+ 1695 t := SymTab.ForwardType(n)
|
|
|
+ 1696 ELSE t := SymTab.InvalidType
|
|
|
+ 1697 END;
|
|
|
+ 1698 IF t = SymTab.InvalidType THEN
|
|
|
+ 1699 SemError(201)
|
|
|
+ 1700 END
|
|
|
+ 1701 ELSE k := SymTab.SymKind(n);
|
|
|
+ 1702 IF (k = SymTab.KindType)
|
|
|
+ 1703 OR (k = SymTab.KindPredef) THEN
|
|
|
+ 1704 t := SymTab.SymType(n)
|
|
|
+ 1705 ELSE t := SymTab.InvalidType
|
|
|
+ 1706 END
|
|
|
+ 1707 END; .)
|
|
|
+ 1708 [ "." GetIdent<qid> (. dotted := TRUE;
|
|
|
+ 1709 IF k = SymTab.KindModule THEN
|
|
|
+ 1710 t := SymTab.QualType(n, qid);
|
|
|
+ 1711 IF t = SymTab.InvalidType THEN
|
|
|
+ 1712 SemError(201)
|
|
|
+ 1713 END
|
|
|
+ 1714 ELSE SemError(221);
|
|
|
+ 1715 t := SymTab.InvalidType
|
|
|
+ 1716 END; .) ]
|
|
|
+ 1717 (. IF NOT dotted THEN
|
|
|
+ 1718 IF (k = SymTab.KindModule)
|
|
|
+ 1719 OR ((k # SymTab.KindType)
|
|
|
+ 1720 AND (k # SymTab.KindPredef)
|
|
|
+ 1721 AND (k # SymTab.KindImport)
|
|
|
+ 1722 AND (k # -1)) THEN
|
|
|
+ 1723 SemError(221)
|
|
|
+ 1724 END
|
|
|
+ 1725 END; .) .
|
|
|
+ 1726 Subrange<VAR t: SymTab.TypeIndex> (. VAR tlo, thi: SymTab.TypeIndex;
|
|
|
+ 1727 qlo, qhi: QbeGen.QVal;
|
|
|
+ 1728 lo, hi: INTEGER; .)
|
|
|
+ 1729 = "[" Expr<tlo, qlo> ".." Expr<thi, qhi>
|
|
|
+ 1730 (. IF (tlo = SymTab.InvalidType)
|
|
|
+ 1731 OR (thi = SymTab.InvalidType) THEN
|
|
|
+ 1732 t := SymTab.InvalidType
|
|
|
+ 1733 ELSIF NOT SymTab.IsOrdinal(tlo)
|
|
|
+ 1734 OR NOT SymTab.IsOrdinal(thi) THEN
|
|
|
+ 1735 SemError(230);
|
|
|
+ 1736 t := SymTab.InvalidType
|
|
|
+ 1737 ELSIF NOT SymTab.ConstInt(qlo, lo)
|
|
|
+ 1738 OR NOT SymTab.ConstInt(qhi, hi)
|
|
|
+ 1739 OR (lo > hi) THEN
|
|
|
+ 1740 SemError(230);
|
|
|
+ 1741 t := SymTab.InvalidType
|
|
|
+ 1742 ELSE IF SymTab.SameType(tlo, thi) THEN
|
|
|
+ 1743 (* keep the base type: ['A'..'Z']
|
|
|
+ 1744 is character, [red..blue]
|
|
|
+ 1745 that enumeration *)
|
|
|
+ 1746 t := SymTab.NewSubB(lo, hi, tlo)
|
|
|
+ 1747 ELSE t := SymTab.NewSubR(lo, hi)
|
|
|
+ 1748 END
|
|
|
+ 1749 END; .)
|
|
|
+ 1750 "]" .
|
|
|
+ 1751 Enum<VAR t: SymTab.TypeIndex> (. VAR n: SymTab.Name;
|
|
|
+ 1752 ord: INTEGER;
|
|
|
+ 1753 qv: QbeGen.QVal; .)
|
|
|
+ 1754 = "(" (. t := SymTab.NewEnum();
|
|
|
+ 1755 ord := 0; .)
|
|
|
+ 1756 GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
+ 1757 SymTab.KindConst) THEN
|
|
|
+ 1758 SemError(200) END;
|
|
|
+ 1759 SymTab.SetSymType(n, t);
|
|
|
+ 1760 QbeGen.IntStr(ord, qv);
|
|
|
+ 1761 SymTab.SetSymVal(n, qv);
|
|
|
+ 1762 SymTab.NoteEnumLit(t, n);
|
|
|
+ 1763 Lower.NoteVar(n,
|
|
|
+ 1764 SymTab.KindConst, t);
|
|
|
+ 1765 Lower.NoteConstVal(qv);
|
|
|
+ 1766 INC(ord); .)
|
|
|
+ 1767 { "," GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
+ 1768 SymTab.KindConst) THEN
|
|
|
+ 1769 SemError(200) END;
|
|
|
+ 1770 SymTab.SetSymType(n, t);
|
|
|
+ 1771 QbeGen.IntStr(ord, qv);
|
|
|
+ 1772 SymTab.SetSymVal(n, qv);
|
|
|
+ 1773 SymTab.NoteEnumLit(t, n);
|
|
|
+ 1774 Lower.NoteVar(n,
|
|
|
+ 1775 SymTab.KindConst, t);
|
|
|
+ 1776 Lower.NoteConstVal(qv);
|
|
|
+ 1777 INC(ord); .) }
|
|
|
+ 1778 ")" (. SymTab.SetEnumCount(t,
|
|
|
+ 1779 VAL(CARDINAL, ord)); .) .
|
|
|
+ 1780 (* Clarion-form classes (docs/OOP.txt): declaration + single
|
|
|
+ 1781 inheritance + IMPLEMENTATION blocks. Scopes and member checks
|
|
|
+ 1782 now; lowering (vtable, dispatch, THIS) later — one 230 per
|
|
|
+ 1783 class/impl block. Methods end with ";" per the Table example
|
|
|
+ 1784 (not "," as in the sketch). No underscores in identifiers. *)
|
|
|
+ 1785 (* Single CLASS item in both loops: separating declaration from
|
|
|
+ 1786 IMPLEMENTATION at the loop level needs 2-token lookahead
|
|
|
+ 1787 (CLASS ident vs CLASS IMPLEMENTATION), which LL(1) cannot do.
|
|
|
+ 1788 The second token decides after CLASS is consumed. A misplaced
|
|
|
+ 1789 CLASS IMPLEMENTATION inside TYPE still parses (harmless: the
|
|
|
+ 1790 whole unit ends 230 until lowering). *)
|
|
|
+ 1791 ClassItem
|
|
|
+ 1792 = "CLASS" ( "IMPLEMENTATION" ClassImplRest | ClassRest ) .
|
|
|
+ 1793 ClassRest (. VAR cn, m2, pn: SymTab.Name;
|
|
|
+ 1794 ct: SymTab.TypeIndex; .)
|
|
|
+ 1795 = GetIdent<cn> (. IF NOT SymTab.Enter(cn,
|
|
|
+ 1796 SymTab.KindType) THEN
|
|
|
1797 SemError(200) END;
|
|
|
- 1798 astNode := AST.MakeNode(AST.NkVarDecl);
|
|
|
- 1799 AST.SetChild(astNode, 0,
|
|
|
- 1800 AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
- 1801 { "," GetIdent<n> (. IF NOT SymTab.FieldPending(ct,
|
|
|
- 1802 n) THEN
|
|
|
- 1803 SemError(200) END;
|
|
|
- 1804 AST.SetChild(astNode,
|
|
|
- 1805 AST.NChild(astNode),
|
|
|
- 1806 AST.MakeLeaf(AST.NkIdent, n)); .) }
|
|
|
- 1807 ":" Type<t, FALSE> (. SymTab.FixPendingF(ct, t);
|
|
|
- 1808 AST.SetTy(astNode, t);
|
|
|
- 1809 AstAppend(AST.NkFieldDecl,
|
|
|
- 1810 astClsF, astClsFTail, astNode); .) ) .
|
|
|
- 1811 MethodHeading<VAR pn: SymTab.Name; ct: SymTab.TypeIndex>
|
|
|
- 1812 (. VAR wantVirt: BOOLEAN; .)
|
|
|
- 1813 = (. wantVirt := FALSE; .)
|
|
|
- 1814 [ "VIRTUAL" (. wantVirt := TRUE; .) ]
|
|
|
- 1815 ProcHeading<pn, ct> (. IF wantVirt THEN
|
|
|
- 1816 SymTab.MarkVirtual END;
|
|
|
- 1817 astMethod := AST.MakeNode(AST.NkProcDecl);
|
|
|
- 1818 AST.SetChild(astMethod, 0,
|
|
|
- 1819 AST.MakeLeaf(AST.NkIdent, pn));
|
|
|
- 1820 IF wantVirt THEN
|
|
|
- 1821 AST.SetOp(astMethod, 3)
|
|
|
- 1822 ELSE AST.SetOp(astMethod, 0)
|
|
|
- 1823 END;
|
|
|
- 1824 AstAppend(AST.NkFieldDecl,
|
|
|
- 1825 astClsM, astClsMTail, astMethod); .) .
|
|
|
- 1826 ClassImplRest (. VAR cn, m2: SymTab.Name;
|
|
|
- 1827 ct: SymTab.TypeIndex; .)
|
|
|
- 1828 = GetIdent<cn> (. IF NOT SymTab.Lookup(cn) THEN
|
|
|
- 1829 SemError(201);
|
|
|
- 1830 ct := SymTab.InvalidType
|
|
|
- 1831 ELSE ct := SymTab.SymType(cn);
|
|
|
- 1832 IF SymTab.ClassOf(ct) #
|
|
|
- 1833 SymTab.ClClass THEN
|
|
|
- 1834 SemError(230);
|
|
|
- 1835 ct := SymTab.InvalidType
|
|
|
- 1836 END
|
|
|
- 1837 END;
|
|
|
- 1838 astCls := AST.MakeNode(AST.NkClassDecl);
|
|
|
- 1839 AST.SetOp(astCls, 1);
|
|
|
- 1840 AST.SetChild(astCls, 0,
|
|
|
- 1841 AST.MakeLeaf(AST.NkIdent, cn));
|
|
|
- 1842 astClsM := AST.NoNode;
|
|
|
- 1843 astClsMTail := AST.NoNode;
|
|
|
- 1844 astStmt := AST.NoNode;
|
|
|
- 1845 IF ct #
|
|
|
- 1846 SymTab.InvalidType THEN
|
|
|
- 1847 IF NOT SymTab.PushClassMembers(
|
|
|
- 1848 ct) THEN
|
|
|
- 1849 SemError(230) END;
|
|
|
- 1850 SymTab.PushImplClass(ct)
|
|
|
- 1851 END; .)
|
|
|
- 1852 ";" { MethodImpl<ct> ";" }
|
|
|
- 1853 (. astStmt := AST.NoNode; .)
|
|
|
- 1854 [ "BEGIN" (. astStmt := AST.MakeNode(AST.NkBlock);
|
|
|
- 1855 .)
|
|
|
- 1856 [ StatSeq ] ]
|
|
|
- 1857 "END"
|
|
|
- 1858 GetIdent<m2> (. IF NOT SymTab.Equal(cn, m2) THEN
|
|
|
- 1859 SemError(202) END;
|
|
|
- 1860 SymTab.PopImplClass;
|
|
|
- 1861 SymTab.PopScope;
|
|
|
- 1862 AST.SetChild(astCls, 1, AST.NoNode);
|
|
|
- 1863 AST.SetChild(astCls, 2, astStmt);
|
|
|
- 1864 AST.SetChild(astCls, 3, astClsM);
|
|
|
- 1865 astDecl := astCls; .) .
|
|
|
- 1866 MethodImpl<ct: SymTab.TypeIndex> (. VAR pn: SymTab.Name;
|
|
|
- 1867 thisQ: QbeGen.QVal;
|
|
|
- 1868 methRes: SymTab.TypeIndex; .)
|
|
|
- 1869 = MethodHeading<pn, ct> ";"
|
|
|
- 1870 (. IF (ct #
|
|
|
- 1871 SymTab.InvalidType)
|
|
|
- 1872 AND NOT SymTab.MethodExists(ct,
|
|
|
- 1873 pn) THEN
|
|
|
- 1874 SemError(201) END; .)
|
|
|
- 1875 ( "FORWARD" (. AST.SetOp(astMethod, 1);
|
|
|
- 1876 SymTab.MarkFwd;
|
|
|
- 1877 QbeGen.AbortFunc;
|
|
|
- 1878 Lower.ScopeLeave;
|
|
|
- 1879 SymTab.CloseProc; .)
|
|
|
- 1880 | (.
|
|
|
- 1881 (* bind the receiver: bare
|
|
|
- 1882 field names resolve
|
|
|
- 1883 against THIS *)
|
|
|
- 1884 QbeGen.CopyOp("@", thisQ);
|
|
|
- 1885 QbeGen.PushWith(thisQ); .)
|
|
|
- 1886 Block<pn> (. AST.SetChild(astMethod, 1, astStmt);
|
|
|
- 1887 AST.SetChild(astMethod, 2, astBlkDecls);
|
|
|
- 1888 QbeGen.PopWith;
|
|
|
- 1889 methRes := SymTab.CurRes();
|
|
|
- 1890 Lower.ScopeLeave;
|
|
|
- 1891 SymTab.CloseProc;
|
|
|
- 1892 QbeGen.EndFunc(methRes); .) ) .
|
|
|
- 1893 ConstBlock (. VAR astSeq, astTail: AST.Node; .)
|
|
|
- 1894 = "CONST" (. astSeq := AST.NoNode;
|
|
|
- 1895 astTail := AST.NoNode; .)
|
|
|
- 1896 { ConstDecl ";" (. AstAppend(AST.NkDeclSeq,
|
|
|
- 1897 astSeq, astTail, astDecl); .) }
|
|
|
- 1898 (. astDecl := astSeq; .) .
|
|
|
- 1899 ConstDecl (. VAR n: SymTab.Name;
|
|
|
- 1900 t: SymTab.TypeIndex;
|
|
|
- 1901 qv: QbeGen.QVal;
|
|
|
- 1902 cls: INTEGER;
|
|
|
- 1903 mk: ARRAY [0 .. 15] OF CARDINAL;
|
|
|
- 1904 mw: CARDINAL;
|
|
|
- 1905 mlo: INTEGER;
|
|
|
- 1906 astNode: AST.Node; .)
|
|
|
- 1907 = GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
- 1908 SymTab.KindConst) THEN
|
|
|
- 1909 SemError(200) END; .)
|
|
|
- 1910 "="
|
|
|
- 1911 Expr<t, qv> (. astNode := AST.MakeNode(AST.NkConstDecl);
|
|
|
- 1912 AST.SetChild(astNode, 0,
|
|
|
- 1913 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
- 1914 AST.SetChild(astNode, 1, astCur);
|
|
|
- 1915 AST.SetTy(astNode, t);
|
|
|
- 1916 astDecl := astNode;
|
|
|
- 1917 Lower.NoteVar(n, SymTab.KindConst, t);
|
|
|
- 1918 Lower.NoteConstVal(qv);
|
|
|
- 1919 SymTab.SetSymType(n, t);
|
|
|
- 1920 cls := SymTab.ClassOf(t);
|
|
|
- 1921 IF cls = SymTab.ClSet THEN
|
|
|
- 1922 (* a SET CONST needs static
|
|
|
- 1923 data: fold its mask now
|
|
|
- 1924 (the grammar sees the
|
|
|
- 1925 element values) and let
|
|
|
- 1926 Lower re-emit it *)
|
|
|
- 1927 IF Lower.SetConstMaskOf(
|
|
|
- 1928 AST.Child(astNode, 1),
|
|
|
- 1929 mk, mw, mlo) THEN
|
|
|
- 1930 Lower.NoteSetMask(n, mk, mw,
|
|
|
- 1931 mlo);
|
|
|
- 1932 SymTab.SetSymVal(n, qv)
|
|
|
- 1933 ELSE
|
|
|
- 1934 SemError(230)
|
|
|
- 1935 END
|
|
|
- 1936 ELSIF (cls = SymTab.ClArray)
|
|
|
- 1937 OR (cls = SymTab.ClRecord)
|
|
|
- 1938 OR (cls = SymTab.ClClass)
|
|
|
- 1939 OR (cls = SymTab.ClStr)
|
|
|
- 1940 OR (cls = SymTab.ClUStr) THEN
|
|
|
- 1941 (* an aggregate/string
|
|
|
- 1942 constant: qv is its
|
|
|
- 1943 descriptor address; no
|
|
|
- 1944 scalar data *)
|
|
|
- 1945 SymTab.SetSymVal(n, qv)
|
|
|
- 1946 ELSIF NOT QbeGen.IsImm(qv) THEN
|
|
|
- 1947 SemError(230)
|
|
|
- 1948 ELSE
|
|
|
- 1949 SymTab.SetSymVal(n, qv);
|
|
|
- 1950 END; .) .
|
|
|
- 1951 VarBlock (. VAR astSeq, astTail: AST.Node; .)
|
|
|
- 1952 = "VAR" (. astSeq := AST.NoNode;
|
|
|
- 1953 astTail := AST.NoNode; .)
|
|
|
- 1954 { VarDecl ";" (. AstAppend(AST.NkDeclSeq,
|
|
|
- 1955 astSeq, astTail, astDecl); .) }
|
|
|
- 1956 (. astDecl := astSeq; .) .
|
|
|
- 1957 VarDecl (. VAR nm: SymTab.Name;
|
|
|
- 1958 t: SymTab.TypeIndex;
|
|
|
- 1959 i: CARDINAL;
|
|
|
- 1960 cls: INTEGER;
|
|
|
- 1961 astNode, astTail: AST.Node; .)
|
|
|
- 1962 = VarIdents ":"
|
|
|
- 1963 Type<t, FALSE> (. astNode := AST.MakeNode(AST.NkVarDecl);
|
|
|
- 1964 astTail := astNode;
|
|
|
- 1965 i := 0;
|
|
|
- 1966 WHILE i < SymTab.PendCount() DO
|
|
|
- 1967 SymTab.PendName(i, nm);
|
|
|
- 1968 Lower.NoteVar(nm, SymTab.KindVar, t);
|
|
|
- 1969 (* chunked: a VAR list can
|
|
|
- 1970 exceed AST.MaxChild *)
|
|
|
- 1971 AstAppend(AST.NkBlock,
|
|
|
- 1972 astNode, astTail,
|
|
|
- 1973 AST.MakeLeaf(AST.NkIdent, nm));
|
|
|
- 1974 INC(i)
|
|
|
- 1975 END;
|
|
|
- 1976 AST.SetTy(astNode, t);
|
|
|
- 1977 astDecl := astNode;
|
|
|
- 1978 cls := SymTab.ClassOf(t);
|
|
|
- 1979 IF (t # SymTab.InvalidType)
|
|
|
- 1980 AND NOT SymTab.IsUnresolved(t)
|
|
|
- 1981 AND (cls # SymTab.ClInt)
|
|
|
- 1982 AND (cls # SymTab.ClBool)
|
|
|
- 1983 AND (cls # SymTab.ClChar)
|
|
|
- 1984 AND (cls # SymTab.ClReal)
|
|
|
- 1985 AND (cls # SymTab.ClArray)
|
|
|
- 1986 AND (cls # SymTab.ClSet)
|
|
|
- 1987 AND (cls # SymTab.ClRecord)
|
|
|
- 1988 AND (cls # SymTab.ClPtr)
|
|
|
- 1989 AND (cls # SymTab.ClLong)
|
|
|
- 1990 AND (cls # SymTab.ClProc)
|
|
|
- 1991 AND (cls # SymTab.ClUChar)
|
|
|
- 1992 AND (cls # SymTab.ClUStr)
|
|
|
- 1993 AND (cls # SymTab.ClEnum)
|
|
|
- 1994 AND (cls # SymTab.ClByte)
|
|
|
- 1995 AND (cls # SymTab.ClSByte)
|
|
|
- 1996 AND (cls # SymTab.ClWord16)
|
|
|
- 1997 AND (cls # SymTab.ClSWord16)
|
|
|
- 1998 AND (cls # SymTab.ClClass) THEN
|
|
|
- 1999 SemError(230) END;
|
|
|
- 2000 IF QbeGen.LocFull() THEN
|
|
|
- 2001 SemError(233) END;
|
|
|
- 2002 i := 0;
|
|
|
- 2003 IF SymTab.IsUnresolved(t)
|
|
|
- 2004 AND NOT SymTab.InProc() THEN
|
|
|
- 2005 (* a forward-typed global:
|
|
|
- 2006 defer emission until the
|
|
|
- 2007 TYPE block completes *)
|
|
|
- 2008 AST.SetOp(astNode, 1);
|
|
|
- 2009 WHILE i < SymTab.PendCount() DO
|
|
|
- 2010 SymTab.PendName(i, nm);
|
|
|
- 2011 IF nPendVar <=
|
|
|
- 2012 HIGH(pendVarName) THEN
|
|
|
- 2013 pendVarName[nPendVar] := nm;
|
|
|
- 2014 pendVarT[nPendVar] := t;
|
|
|
- 2015 INC(nPendVar)
|
|
|
- 2016 END;
|
|
|
- 2017 INC(i)
|
|
|
- 2018 END
|
|
|
- 2019 ELSE
|
|
|
- 2020 WHILE i < SymTab.PendCount() DO
|
|
|
- 2021 SymTab.PendName(i, nm);
|
|
|
- 2022 INC(i)
|
|
|
- 2023 END
|
|
|
- 2024 END;
|
|
|
- 2025 (* a plain VAR list, not a
|
|
|
- 2026 heading: the signature
|
|
|
- 2027 result is discarded *)
|
|
|
- 2028 IF NOT SymTab.FixPending(t) THEN
|
|
|
- 2029 END; .) .
|
|
|
- 2030 VarIdents (. VAR n: SymTab.Name; .)
|
|
|
- 2031 = GetIdent<n> (. IF NOT SymTab.EnterPending(n,
|
|
|
- 2032 SymTab.KindVar) THEN
|
|
|
- 2033 SemError(200) END; .)
|
|
|
- 2034 { ","
|
|
|
- 2035 GetIdent<n> (. IF NOT SymTab.EnterPending(n,
|
|
|
- 2036 SymTab.KindVar) THEN
|
|
|
- 2037 SemError(200) END; .) } .
|
|
|
- 2038 ParIdents<isV: BOOLEAN> (. VAR n: SymTab.Name; .)
|
|
|
- 2039 = GetIdent<n> (. IF NOT SymTab.EnterParam(n, isV) THEN
|
|
|
- 2040 SemError(200) END; .)
|
|
|
- 2041 { "," GetIdent<n> (. IF NOT SymTab.EnterParam(n, isV) THEN
|
|
|
- 2042 SemError(200) END; .) } .
|
|
|
- 2043 (* Procedure headings enter scopes/params/result and buffer the
|
|
|
- 2044 QBE header; bodies lower to functions (4.1, module level only).
|
|
|
- 2045 FORWARD marks; the body heading re-enters (signature compare
|
|
|
- 2046 deferred). Nested procedures parse + check, lowering = 4.2. *)
|
|
|
- 2047 (* gm2 declaration pragmas: __BUILTIN__ (definition module) and
|
|
|
- 2048 __ATTRIBUTE__ __BUILTIN__ (( name )) (implementation). They
|
|
|
- 2049 annotate C built-ins; V3 parses and ignores them. *)
|
|
|
- 2050 ProcPragma
|
|
|
- 2051 = "__BUILTIN__"
|
|
|
- 2052 | "__ATTRIBUTE__" [ "__BUILTIN__" ] [ "(" "(" ident ")" ")" ] .
|
|
|
- 2053
|
|
|
- 2054 ProcHeading<VAR pn: SymTab.Name; methCls: SymTab.TypeIndex>
|
|
|
- 2055 (. VAR t: SymTab.TypeIndex;
|
|
|
- 2056 mg: QbeGen.QVal; .)
|
|
|
- 2057 = "PROCEDURE"
|
|
|
- 2058 [ ProcPragma ]
|
|
|
- 2059 GetIdent<pn> (. IF methCls #
|
|
|
- 2060 SymTab.InvalidType THEN
|
|
|
- 2061 (* a method: resume the
|
|
|
- 2062 declared symbol (reuse
|
|
|
- 2063 its uid) *)
|
|
|
- 2064 IF NOT SymTab.ResumeMethod(
|
|
|
- 2065 methCls, pn) THEN
|
|
|
- 2066 SemError(200) END
|
|
|
- 2067 ELSIF NOT SymTab.EnterProc(pn) THEN
|
|
|
- 2068 IF NOT SymTab.ReenterProc(pn) THEN
|
|
|
- 2069 IF NOT SymTab.ResumeProc(pn) THEN
|
|
|
- 2070 SemError(200) END
|
|
|
- 2071 END
|
|
|
- 2072 END;
|
|
|
- 2073 Lower.ScopeEnter;
|
|
|
- 2074 Lower.NoteProc(pn,
|
|
|
- 2075 SymTab.ProcUid(pn),
|
|
|
- 2076 SymTab.InvalidType,
|
|
|
- 2077 SymTab.ProcDepthOf(pn),
|
|
|
- 2078 FALSE);
|
|
|
- 2079 QbeGen.BeginFunc("");
|
|
|
- 2080 IF methCls #
|
|
|
- 2081 SymTab.InvalidType THEN
|
|
|
- 2082 (* hidden THIS receiver:
|
|
|
- 2083 a VAR param of the
|
|
|
- 2084 class type, pushed as
|
|
|
- 2085 the WITH base *)
|
|
|
- 2086 IF NOT SymTab.EnterThisParam(
|
|
|
- 2087 methCls) THEN
|
|
|
- 2088 SemError(200) END;
|
|
|
- 2089 IF NOT QbeGen.FuncParam(
|
|
|
- 2090 "THIS", TRUE,
|
|
|
- 2091 methCls) THEN
|
|
|
- 2092 SemError(233) END
|
|
|
- 2093 END; .)
|
|
|
- 2094 [ FormalParams ]
|
|
|
- 2095 [ ":" ( TypeIdent<t> (. IF NOT SymTab.SetProcRes(t) THEN
|
|
|
- 2096 SemError(235) END;
|
|
|
- 2097 Lower.SetProcRes(t); .)
|
|
|
- 2098 | "PROC" (. (* PROC result: the procedure
|
|
|
- 2099 value type *)
|
|
|
- 2100 IF NOT SymTab.SetProcRes(
|
|
|
- 2101 SymTab.AddrType()) THEN
|
|
|
- 2102 SemError(235) END;
|
|
|
- 2103 Lower.SetProcRes(
|
|
|
- 2104 SymTab.AddrType()); .) ) ] .
|
|
|
- 2105 FormalParams
|
|
|
- 2106 = "(" [ ParamSection { ";" ParamSection } ] ")" .
|
|
|
- 2107 ParamSection (. VAR t: SymTab.TypeIndex;
|
|
|
- 2108 nm: SymTab.Name;
|
|
|
- 2109 i: CARDINAL;
|
|
|
- 2110 isV: BOOLEAN; .)
|
|
|
- 2111 = (. isV := FALSE; .)
|
|
|
- 2112 [ "VAR" (. isV := TRUE; .) ]
|
|
|
- 2113 ParIdents<isV> ":" Type<t, TRUE> (. i := 0;
|
|
|
- 2114 WHILE i < SymTab.PendCount() DO
|
|
|
- 2115 SymTab.PendName(i, nm);
|
|
|
- 2116 Lower.NoteParam(nm, t, isV);
|
|
|
- 2117 Lower.NoteVar(nm, SymTab.KindParam, t);
|
|
|
- 2118 (* value open arrays are
|
|
|
- 2119 passed as descriptor
|
|
|
- 2120 addresses (no copy):
|
|
|
- 2121 same representation as
|
|
|
- 2122 VAR formals *)
|
|
|
- 2123 IF NOT QbeGen.FuncParam(nm,
|
|
|
- 2124 isV
|
|
|
- 2125 OR SymTab.IsOpenArray(t),
|
|
|
- 2126 t) THEN
|
|
|
- 2127 SemError(233) END;
|
|
|
- 2128 INC(i)
|
|
|
- 2129 END;
|
|
|
- 2130 IF NOT SymTab.FixPending(t) THEN
|
|
|
- 2131 SemError(235) END; .) .
|
|
|
- 2132 (* Nested procedures lower like top-level ones (4.2): the
|
|
|
- 2133 static link gives them their parent's frame. Methods keep
|
|
|
- 2134 parse-now/230-later. *)
|
|
|
- 2135 ProcDecl (. VAR pn: SymTab.Name;
|
|
|
- 2136 saveFun: SymTab.Name;
|
|
|
- 2137 astNode: AST.Node; .)
|
|
|
- 2138 = ProcHeading<pn, SymTab.InvalidType> ";"
|
|
|
- 2139 (. astNode := AST.MakeNode(AST.NkProcDecl);
|
|
|
- 2140 AST.SetOp(astNode, 0);
|
|
|
- 2141 AST.SetChild(astNode, 0,
|
|
|
- 2142 AST.MakeLeaf(AST.NkIdent, pn));
|
|
|
- 2143 Lower.NoteProcNode(astNode); .)
|
|
|
- 2144 ( "FORWARD" (. AST.SetOp(astNode, 1);
|
|
|
- 2145 astDecl := astNode;
|
|
|
- 2146 Lower.ScopeLeave;
|
|
|
- 2147 SymTab.MarkFwd;
|
|
|
- 2148 SymTab.CloseProc;
|
|
|
- 2149 QbeGen.AbortFunc; .)
|
|
|
- 2150 | "EXTERNAL" (. AST.SetOp(astNode, 2);
|
|
|
- 2151 astDecl := astNode;
|
|
|
- 2152 Lower.MarkProcExternal;
|
|
|
- 2153 Lower.ScopeLeave;
|
|
|
- 2154 SymTab.MarkExternal("");
|
|
|
- 2155 SymTab.CloseProc;
|
|
|
- 2156 QbeGen.AbortFunc; .)
|
|
|
- 2157 |
|
|
|
- 2158 (. allowDefer := TRUE; deferredBody := FALSE;
|
|
|
- 2159 curProcNode := astNode;
|
|
|
- 2160 saveFun := curFun;
|
|
|
- 2161 curFun := pn; .)
|
|
|
- 2162 Block<pn> (. curFun := saveFun;
|
|
|
- 2163 IF deferredBody THEN
|
|
|
- 2164 (* body skipped: close like
|
|
|
- 2165 FORWARD (no body node) *)
|
|
|
- 2166 astDecl := astNode;
|
|
|
- 2167 Lower.ScopeLeave;
|
|
|
- 2168 SymTab.CloseProc;
|
|
|
- 2169 QbeGen.AbortFunc
|
|
|
- 2170 ELSE
|
|
|
- 2171 AST.SetChild(astNode, 1, astStmt);
|
|
|
- 2172 AST.SetChild(astNode, 2, astBlkDecls);
|
|
|
- 2173 astDecl := astNode;
|
|
|
- 2174 Lower.ScopeLeave;
|
|
|
- 2175 SymTab.CloseProc;
|
|
|
- 2176 QbeGen.EndFunc(
|
|
|
- 2177 SymTab.ProcRes(pn))
|
|
|
- 2178 END; .) ) .
|
|
|
- 2179 Block<pn: SymTab.Name> (. VAR m2: SymTab.Name; dfr: BOOLEAN; .)
|
|
|
- 2180 = (. dfr := FALSE;
|
|
|
- 2181 IF allowDefer AND twoPhaseParse
|
|
|
- 2182 AND NOT repassing THEN
|
|
|
- 2183 dfr := DeferSkip(pn)
|
|
|
- 2184 END;
|
|
|
- 2185 allowDefer := FALSE;
|
|
|
- 2186 .)
|
|
|
- 2187 DeclSeq (. astBlkDecls := astDecl;
|
|
|
- 2188 astStmt := AST.NoNode;
|
|
|
- 2189 nLab := 0; nGot := 0; .)
|
|
|
- 2190 [ "BEGIN" (. (* an empty body is still a
|
|
|
- 2191 body: mark it so Lower
|
|
|
- 2192 does not read it as a
|
|
|
- 2193 definition heading *)
|
|
|
- 2194 IF NOT dfr THEN
|
|
|
- 2195 IF astStmt = AST.NoNode THEN
|
|
|
- 2196 astStmt :=
|
|
|
- 2197 AST.MakeNode(AST.NkBlock)
|
|
|
- 2198 END
|
|
|
- 2199 END; .)
|
|
|
- 2200 [ StatSeq ] ]
|
|
|
- 2201 "END"
|
|
|
- 2202 GetIdent<m2> (. IF NOT SymTab.Equal(pn, m2) THEN
|
|
|
- 2203 SemError(202) END;
|
|
|
- 2204 CheckGotos; .) .
|
|
|
- 2205 (* Two-phase, phase 2 (milestone 2c): re-parse every deferred module-
|
|
|
- 2206 level body once the unit's declarations are complete. Inlined at
|
|
|
- 2207 both call sites because a stand-alone epsilon production is
|
|
|
- 2208 "unreachable" to Coco/R (referenced only from actions). *)
|
|
|
- 2209 StatSeq (. VAR astSeq, astTail: AST.Node; .)
|
|
|
- 2210 = (. astSeq := AST.NoNode;
|
|
|
- 2211 astTail := AST.NoNode; .)
|
|
|
- 2212 Statement (. AstAppend(AST.NkBlock,
|
|
|
- 2213 astSeq, astTail, astStmt); .)
|
|
|
- 2214 { ";" [ Statement (. AstAppend(AST.NkBlock,
|
|
|
- 2215 astSeq, astTail, astStmt); .) ] }
|
|
|
- 2216 (. astStmt := astSeq; .) .
|
|
|
- 2217 (* Trailing/empty statements (`a; ; b`, Coco/R's generated `;;`)
|
|
|
- 2218 are accepted: the statement after ';' is optional. *)
|
|
|
- 2219 Statement (. VAR lx: QbeGen.QVal; lxnm: SymTab.Name; .)
|
|
|
- 2220 = (. astStmt := AST.NoNode; .)
|
|
|
- 2221 ( AssOrCall
|
|
|
- 2222 | IfStat
|
|
|
- 2223 | WhileStat
|
|
|
- 2224 | RepeatStat
|
|
|
- 2225 | LoopStat
|
|
|
- 2226 | ForStat
|
|
|
- 2227 | CaseStat
|
|
|
- 2228 | WithStat
|
|
|
- 2229 | ReturnStat
|
|
|
- 2230 | HaltStat
|
|
|
- 2231 | NewStat
|
|
|
- 2232 | DisposeStat
|
|
|
- 2233 | IncDecStat
|
|
|
- 2234 | InclExclStat
|
|
|
- 2235 | "EXIT" (. IF NOT QbeGen.TopLoop(lx) THEN
|
|
|
- 2236 SemError(230) END;
|
|
|
- 2237 astStmt := AST.MakeNode(AST.NkExit); .)
|
|
|
- 2238 | "GOTO" GetIdent<lxnm> (. NoteGoto(lxnm);
|
|
|
- 2239 astStmt := AST.MakeNode(AST.NkGoto);
|
|
|
- 2240 AST.SetChild(astStmt, 0,
|
|
|
- 2241 AST.MakeLeaf(AST.NkIdent, lxnm)); .) ) .
|
|
|
- 2242 (* INCL(set, elem) / EXCL(set, elem): PIM set-element builtins. *)
|
|
|
- 2243 InclExclStat (. VAR at, et2: SymTab.TypeIndex;
|
|
|
- 2244 dk: INTEGER;
|
|
|
- 2245 qd, qe: QbeGen.QVal;
|
|
|
- 2246 qn: SymTab.Name;
|
|
|
- 2247 sfx, isInc: BOOLEAN;
|
|
|
- 2248 astNode, astD: AST.Node; .)
|
|
|
- 2249 = ( "INCL" (. isInc := TRUE; .)
|
|
|
- 2250 | "EXCL" (. isInc := FALSE; .) )
|
|
|
- 2251 "(" Design<at, dk, qd, qn, sfx> (. astD := astCur; .) ","
|
|
|
- 2252 Expr<et2, qe> ")"
|
|
|
- 2253 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 2254 IF isInc THEN
|
|
|
- 2255 AST.SetChild(astNode, 0,
|
|
|
- 2256 AST.MakeLeaf(AST.NkIdent, "INCL"))
|
|
|
- 2257 ELSE AST.SetChild(astNode, 0,
|
|
|
- 2258 AST.MakeLeaf(AST.NkIdent, "EXCL"))
|
|
|
- 2259 END;
|
|
|
- 2260 IF astD # AST.NoNode THEN
|
|
|
- 2261 AST.SetChild(astNode, 1, astD) END;
|
|
|
- 2262 IF astCur # AST.NoNode THEN
|
|
|
- 2263 AST.SetChild(astNode, 2, astCur) END;
|
|
|
- 2264 astStmt := astNode; .)
|
|
|
- 2265 (. IF (at # SymTab.InvalidType)
|
|
|
- 2266 AND (SymTab.ClassOf(at) # SymTab.ClSet) THEN
|
|
|
- 2267 SemError(222)
|
|
|
- 2268 END; .) .
|
|
|
- 2269 (* INC(v [,step]) / DEC(v [,step]) as builtin statements over an
|
|
|
- 2270 integer designator. *)
|
|
|
- 2271 IncDecStat (. VAR dt, et2: SymTab.TypeIndex;
|
|
|
- 2272 dk: INTEGER;
|
|
|
- 2273 qd, qv, qn2, qstep:
|
|
|
- 2274 QbeGen.QVal;
|
|
|
- 2275 qn: SymTab.Name;
|
|
|
- 2276 sfx, isInc: BOOLEAN;
|
|
|
- 2277 astNode, astD, astStep:
|
|
|
- 2278 AST.Node; .)
|
|
|
- 2279 = (. isInc := TRUE; .)
|
|
|
- 2280 ( "INC" (. isInc := TRUE; .)
|
|
|
- 2281 | "DEC" (. isInc := FALSE; .) )
|
|
|
- 2282 "(" (. astStep := AST.NoNode; .)
|
|
|
- 2283 Design<dt, dk, qd, qn, sfx> (. astD := astCur; .)
|
|
|
- 2284 [ "," Expr<et2, qstep> (. astStep := astCur; .) ]
|
|
|
- 2285 ")" (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 2286 IF isInc THEN
|
|
|
- 2287 AST.SetChild(astNode, 0,
|
|
|
- 2288 AST.MakeLeaf(AST.NkIdent, "INC"))
|
|
|
- 2289 ELSE AST.SetChild(astNode, 0,
|
|
|
- 2290 AST.MakeLeaf(AST.NkIdent, "DEC"))
|
|
|
- 2291 END;
|
|
|
- 2292 IF astD # AST.NoNode THEN
|
|
|
- 2293 AST.SetChild(astNode, 1, astD) END;
|
|
|
- 2294 IF astStep # AST.NoNode THEN
|
|
|
- 2295 AST.SetChild(astNode, 2, astStep) END;
|
|
|
- 2296 astStmt := astNode; .) (. IF dt = SymTab.InvalidType THEN
|
|
|
- 2297 ELSIF (dk # SymTab.KindVar)
|
|
|
- 2298 AND (dk # SymTab.KindParam)
|
|
|
- 2299 AND (dk # SymTab.KindField) THEN
|
|
|
- 2300 SemError(210)
|
|
|
- 2301 ELSIF NOT SymTab.IsOrdinal(dt) THEN
|
|
|
- 2302 SemError(211)
|
|
|
- 2303 END; .) .
|
|
|
- 2304 (* NEW/DISPOSE as builtin statements (no call syntax until step 4).
|
|
|
- 2305 Targets are pointer designators; DISPOSE nils afterwards (safer
|
|
|
- 2306 than Wirth-undefined; documented). DISPOSE is shallow. *)
|
|
|
- 2307 NewStat (. VAR dt: SymTab.TypeIndex;
|
|
|
- 2308 dk: INTEGER;
|
|
|
- 2309 qd, qm: QbeGen.QVal;
|
|
|
- 2310 qn: SymTab.Name;
|
|
|
- 2311 sfx: BOOLEAN;
|
|
|
- 2312 bt: SymTab.TypeIndex;
|
|
|
- 2313 astNode, astD: AST.Node; .)
|
|
|
- 2314 = "NEW" "(" Design<dt, dk, qd, qn, sfx> (. astD := astCur; .) ")"
|
|
|
- 2315 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 2316 AST.SetChild(astNode, 0,
|
|
|
- 2317 AST.MakeLeaf(AST.NkIdent, "NEW"));
|
|
|
- 2318 IF astD # AST.NoNode THEN
|
|
|
- 2319 AST.SetChild(astNode, 1, astD) END;
|
|
|
- 2320 astStmt := astNode; .)
|
|
|
- 2321 (. IF dt = SymTab.InvalidType THEN
|
|
|
- 2322 ELSIF (dk # SymTab.KindVar)
|
|
|
- 2323 AND (dk # SymTab.KindParam)
|
|
|
- 2324 AND (dk # SymTab.KindField) THEN
|
|
|
- 2325 SemError(210)
|
|
|
- 2326 ELSIF SymTab.ClassOf(dt) #
|
|
|
- 2327 SymTab.ClPtr THEN
|
|
|
- 2328 SemError(219)
|
|
|
- 2329 END; .) .
|
|
|
- 2330 DisposeStat (. VAR dt: SymTab.TypeIndex;
|
|
|
- 2331 dk: INTEGER;
|
|
|
- 2332 qd, qv: QbeGen.QVal;
|
|
|
- 2333 qn: SymTab.Name;
|
|
|
- 2334 sfx: BOOLEAN;
|
|
|
- 2335 astNode, astD: AST.Node; .)
|
|
|
- 2336 = "DISPOSE" "(" Design<dt, dk, qd, qn, sfx> (. astD := astCur; .) ")"
|
|
|
- 2337 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 2338 AST.SetChild(astNode, 0,
|
|
|
- 2339 AST.MakeLeaf(AST.NkIdent, "DISPOSE"));
|
|
|
- 2340 IF astD # AST.NoNode THEN
|
|
|
- 2341 AST.SetChild(astNode, 1, astD) END;
|
|
|
- 2342 astStmt := astNode; .)
|
|
|
- 2343 (. IF dt = SymTab.InvalidType THEN
|
|
|
- 2344 ELSIF (dk # SymTab.KindVar)
|
|
|
- 2345 AND (dk # SymTab.KindParam)
|
|
|
- 2346 AND (dk # SymTab.KindField) THEN
|
|
|
- 2347 SemError(210)
|
|
|
- 2348 ELSIF SymTab.ClassOf(dt) #
|
|
|
- 2349 SymTab.ClPtr THEN
|
|
|
- 2350 SemError(219)
|
|
|
- 2351 END; .) .
|
|
|
- 2352 (* WITH pushes each record's fields (inner wins) plus its base
|
|
|
- 2353 address; field designators resolve through both stacks. *)
|
|
|
- 2354 WithStat (. VAR nW: CARDINAL;
|
|
|
- 2355 astNode: AST.Node; .)
|
|
|
- 2356 = "WITH" (. nW := 0;
|
|
|
- 2357 astNode := AST.MakeNode(AST.NkWith); .)
|
|
|
- 2358 WithItem<nW, astNode> { "," WithItem<nW, astNode> }
|
|
|
- 2359 "DO" (. astStmt := AST.NoNode; .)
|
|
|
- 2360 [ StatSeq ] "END" (. AST.SetChild(astNode,
|
|
|
- 2361 AST.NChild(astNode), astStmt);
|
|
|
- 2362 astStmt := astNode;
|
|
|
- 2363 WHILE nW > 0 DO
|
|
|
- 2364 SymTab.PopScope;
|
|
|
- 2365 QbeGen.PopWith;
|
|
|
- 2366 DEC(nW)
|
|
|
- 2367 END; .) .
|
|
|
- 2368 WithItem<VAR nW: CARDINAL; wnode: AST.Node>
|
|
|
- 2369 (. VAR dt: SymTab.TypeIndex;
|
|
|
- 2370 dk: INTEGER;
|
|
|
- 2371 qd, qe: QbeGen.QVal;
|
|
|
- 2372 qn: SymTab.Name;
|
|
|
- 2373 sfx: BOOLEAN; .)
|
|
|
- 2374 = Design<dt, dk, qd, qn, sfx>
|
|
|
- 2375 (. IF astCur # AST.NoNode THEN
|
|
|
- 2376 AST.SetChild(wnode,
|
|
|
- 2377 AST.NChild(wnode), astCur) END;
|
|
|
- 2378 IF dt = SymTab.InvalidType THEN
|
|
|
- 2379 ELSIF (SymTab.ClassOf(dt) #
|
|
|
- 2380 SymTab.ClRecord)
|
|
|
- 2381 AND (SymTab.ClassOf(dt) #
|
|
|
- 2382 SymTab.ClClass) THEN
|
|
|
- 2383 SemError(215)
|
|
|
- 2384 ELSIF SymTab.PushRecord(dt) THEN
|
|
|
- 2385 QbeGen.PushWith(qd);
|
|
|
- 2386 INC(nW)
|
|
|
- 2387 END; .) .
|
|
|
- 2388 (* Assignment or procedure-statement call (4.1, module level).
|
|
|
- 2389 Bare `P;` is a syntax error; function-as-statement is 233. *)
|
|
|
- 2390 AssOrCall (. VAR dt, et: SymTab.TypeIndex;
|
|
|
- 2391 dk: INTEGER;
|
|
|
- 2392 qd, qe, qt, ql: QbeGen.QVal;
|
|
|
- 2393 qn: SymTab.Name;
|
|
|
- 2394 ct2, res0: SymTab.TypeIndex;
|
|
|
- 2395 q2, mg0: QbeGen.QVal;
|
|
|
- 2396 isR, conv, wconv: BOOLEAN;
|
|
|
- 2397 called, sfx: BOOLEAN;
|
|
|
- 2398 astLhs, astRes: AST.Node; mname: SymTab.Name; isM: BOOLEAN;
|
|
|
- 2399 n: SymTab.Name; astLab, astNode: AST.Node; .)
|
|
|
- 2400 = GetIdent<n>
|
|
|
- 2401 ( ":" (. NoteLabel(n);
|
|
|
- 2402 astNode := AST.MakeNode(AST.NkLabel);
|
|
|
- 2403 AST.SetChild(astNode, 0,
|
|
|
- 2404 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
- 2405 astLab := AST.MakeNode(AST.NkBlock);
|
|
|
- 2406 AST.SetChild(astLab, 0, astNode); .)
|
|
|
- 2407 Statement (. IF astStmt # AST.NoNode THEN
|
|
|
- 2408 AST.SetChild(astLab, 1, astStmt) END;
|
|
|
- 2409 astStmt := astLab; .)
|
|
|
- 2410 | DesignTail<n, dt, dk, qd, qn, sfx>
|
|
|
- 2411 (. astLhs := astCur; astNArgs := 0; .)
|
|
|
- 2412 ( ":="
|
|
|
- 2413 Expr<et, qe> (. astStmt := AST.MakeBin(
|
|
|
- 2414 AST.NkAssign, 0, astLhs, astCur);
|
|
|
- 2415 IF (dt # SymTab.InvalidType)
|
|
|
- 2416 AND (dk # SymTab.KindVar)
|
|
|
- 2417 AND (dk # SymTab.KindParam)
|
|
|
- 2418 AND (dk # SymTab.KindField) THEN
|
|
|
- 2419 SemError(210)
|
|
|
- 2420 ELSIF NOT SymTab.Assignable(et,
|
|
|
- 2421 dt) THEN
|
|
|
- 2422 SemError(210)
|
|
|
- 2423 ELSIF (dt # SymTab.InvalidType)
|
|
|
- 2424 AND (SymTab.ClassOf(dt) =
|
|
|
- 2425 SymTab.ClClass) THEN
|
|
|
- 2426 SemError(230) END;
|
|
|
- 2427 isR := (dt #
|
|
|
- 2428 SymTab.InvalidType)
|
|
|
- 2429 AND (SymTab.ClassOf(dt)
|
|
|
- 2430 = SymTab.ClReal);
|
|
|
- 2431 conv := isR
|
|
|
- 2432 AND SymTab.IsIntFamily(et);
|
|
|
- 2433 wconv := (dt #
|
|
|
- 2434 SymTab.InvalidType)
|
|
|
- 2435 AND SymTab.IsLongFamily(dt)
|
|
|
- 2436 AND SymTab.IsIntFamily(et);
|
|
|
- 2437 IF ((dk = SymTab.KindVar)
|
|
|
- 2438 OR (dk = SymTab.KindParam)
|
|
|
- 2439 OR (dk = SymTab.KindField))
|
|
|
- 2440 AND (dt # SymTab.InvalidType)
|
|
|
- 2441 AND (et # SymTab.InvalidType)
|
|
|
- 2442 AND (SymTab.ClassOf(dt) #
|
|
|
- 2443 SymTab.ClClass) THEN
|
|
|
- 2444 END; .)
|
|
|
- 2445 | ArgList<qn, dt, qd, TRUE, TRUE, methCls, ct2, q2, called>
|
|
|
- 2446 (. astRes := AstCallNode(astLhs);
|
|
|
- 2447 sfx := FALSE; .)
|
|
|
- 2448 ( { ResultComp<ct2, q2, sfx, astRes, mname, methCls, isM> }
|
|
|
- 2449 ":=" Expr<et, qe> (. astStmt := AST.MakeBin(
|
|
|
- 2450 AST.NkAssign, 0, astRes, astCur);
|
|
|
- 2451 IF NOT sfx THEN
|
|
|
- 2452 SemError(233)
|
|
|
- 2453 ELSIF (ct2 # SymTab.InvalidType)
|
|
|
- 2454 AND NOT SymTab.Assignable(et, ct2) THEN
|
|
|
- 2455 SemError(210)
|
|
|
- 2456 END; .)
|
|
|
- 2457 | (. (* discarding the result of a
|
|
|
- 2458 foreign C varargs call
|
|
|
- 2459 (printf/snprintf) is accepted;
|
|
|
- 2460 an ordinary Modula-2 function
|
|
|
- 2461 used as a statement stays 233 *)
|
|
|
- 2462 IF (ct2 # SymTab.InvalidType)
|
|
|
- 2463 AND NOT SymTab.Varargs(qn) THEN
|
|
|
- 2464 SemError(233) END;
|
|
|
- 2465 astStmt := astRes; .) )
|
|
|
- 2466 | (* bare `P;`: proper parameterless
|
|
|
- 2467 procedure call; anything else
|
|
|
- 2468 here is 233 (was a bare syntax
|
|
|
- 2469 error before 4.2) *)
|
|
|
- 2470 (. astStmt := AstCallNode(astLhs);
|
|
|
- 2471 IF (dk = SymTab.KindProc)
|
|
|
- 2472 AND NOT sfx THEN
|
|
|
- 2473 res0 := SymTab.ProcRes(qn);
|
|
|
- 2474 IF res0 #
|
|
|
- 2475 SymTab.InvalidType THEN
|
|
|
- 2476 SemError(233)
|
|
|
- 2477 ELSIF SymTab.ProcNPar(qn) #
|
|
|
- 2478 0 THEN
|
|
|
- 2479 SemError(233)
|
|
|
- 2480 END
|
|
|
- 2481 ELSIF (dt # SymTab.InvalidType)
|
|
|
- 2482 AND (SymTab.ClassOf(dt) = SymTab.ClProc) THEN
|
|
|
- 2483 IF SymTab.ProcTypeRes(dt) #
|
|
|
- 2484 SymTab.InvalidType THEN
|
|
|
- 2485 SemError(233)
|
|
|
- 2486 ELSIF SymTab.ProcTypeNPar(dt) #
|
|
|
- 2487 0 THEN
|
|
|
- 2488 SemError(233)
|
|
|
- 2489 END
|
|
|
- 2490 ELSE SemError(233)
|
|
|
- 2491 END; .) ) ) .
|
|
|
- 2492 (* Actual-parameter list shared by statement and expression calls.
|
|
|
- 2493 want selects CallEnd's result handling; t/q carry the call
|
|
|
- 2494 value (statement calls discard). Arity/type failures are 233;
|
|
|
- 2495 evaluation code still emits so the .ssa stays assembleable. *)
|
|
|
- 2496 ArgList<pn: SymTab.Name; pt: SymTab.TypeIndex; callee: QbeGen.QVal;
|
|
|
- 2497 want: BOOLEAN; soft: BOOLEAN; methCls: SymTab.TypeIndex;
|
|
|
- 2498 VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
|
|
|
- 2499 VAR called: BOOLEAN> (. VAR i, np: CARDINAL;
|
|
|
- 2500 vs: INTEGER;
|
|
|
- 2501 res: SymTab.TypeIndex;
|
|
|
- 2502 mg: QbeGen.QVal;
|
|
|
- 2503 ok, ind, isMeth, va, isConv: BOOLEAN; .)
|
|
|
- 2504 = "(" (. called := TRUE;
|
|
|
- 2505 ok := TRUE;
|
|
|
- 2506 ind := FALSE;
|
|
|
- 2507 isConv := FALSE;
|
|
|
- 2508 isMeth := methCls #
|
|
|
- 2509 SymTab.InvalidType;
|
|
|
- 2510 IF isMeth THEN
|
|
|
- 2511 res := SymTab.ClassMethodRes(methCls, pn)
|
|
|
- 2512 ELSIF SymTab.SymKind(pn) = SymTab.KindProc THEN
|
|
|
- 2513 res := SymTab.ProcRes(pn)
|
|
|
- 2514 ELSIF (SymTab.SymKind(pn) = SymTab.KindType)
|
|
|
- 2515 OR (SymTab.SymKind(pn) = SymTab.KindPredef) THEN
|
|
|
- 2516 (* ISO type conversion T(x):
|
|
|
- 2517 one value, result is T *)
|
|
|
- 2518 isConv := TRUE;
|
|
|
- 2519 res := SymTab.SymType(pn)
|
|
|
- 2520 ELSIF (pt # SymTab.InvalidType)
|
|
|
- 2521 AND (SymTab.ClassOf(pt) = SymTab.ClProc) THEN
|
|
|
- 2522 ind := TRUE;
|
|
|
- 2523 res := SymTab.ProcTypeRes(pt)
|
|
|
- 2524 ELSE SemError(233);
|
|
|
- 2525 ok := FALSE;
|
|
|
- 2526 res := SymTab.InvalidType
|
|
|
- 2527 END;
|
|
|
- 2528 i := 0; .)
|
|
|
- 2529 [ ActParam<pn, pt, ind, methCls, i> (. INC(i); .)
|
|
|
- 2530 { "," ActParam<pn, pt, ind, methCls, i> (. INC(i); .) } ]
|
|
|
- 2531 ")" (. IF ok THEN
|
|
|
- 2532 IF isConv THEN
|
|
|
- 2533 (* a conversion takes
|
|
|
- 2534 exactly one value *)
|
|
|
- 2535 IF i # 1 THEN
|
|
|
- 2536 SemError(233); ok := FALSE
|
|
|
- 2537 END
|
|
|
- 2538 ELSE
|
|
|
- 2539 IF isMeth THEN
|
|
|
- 2540 np := SymTab.ClassMethodNPar(
|
|
|
- 2541 methCls, pn)
|
|
|
- 2542 ELSIF ind THEN
|
|
|
- 2543 np := SymTab.ProcTypeNPar(pt)
|
|
|
- 2544 ELSE np := SymTab.ProcNPar(pn)
|
|
|
- 2545 END;
|
|
|
- 2546 va := (NOT isMeth) AND (NOT ind)
|
|
|
- 2547 AND (SymTab.SymKind(pn) =
|
|
|
- 2548 SymTab.KindProc)
|
|
|
- 2549 AND SymTab.Varargs(pn);
|
|
|
- 2550 IF (i # np) AND NOT va THEN
|
|
|
- 2551 SemError(233); ok := FALSE
|
|
|
- 2552 END
|
|
|
- 2553 END
|
|
|
- 2554 END;
|
|
|
- 2555 IF NOT ok THEN
|
|
|
- 2556 t := SymTab.InvalidType;
|
|
|
- 2557 QbeGen.CopyOp("0", q)
|
|
|
- 2558 ELSIF want THEN
|
|
|
- 2559 IF res =
|
|
|
- 2560 SymTab.InvalidType THEN
|
|
|
- 2561 IF NOT soft THEN SemError(233) END;
|
|
|
- 2562 t := SymTab.InvalidType;
|
|
|
- 2563 QbeGen.CopyOp("0", q)
|
|
|
- 2564 ELSE t := res;
|
|
|
- 2565 QbeGen.CopyOp("@", q)
|
|
|
- 2566 END
|
|
|
- 2567 ELSE
|
|
|
- 2568 (* a function call used as
|
|
|
- 2569 a statement: allowed for
|
|
|
- 2570 a foreign C varargs proc
|
|
|
- 2571 (printf/snprintf), whose
|
|
|
- 2572 result is conventionally
|
|
|
- 2573 discarded; ordinary
|
|
|
- 2574 Modula-2 functions keep
|
|
|
- 2575 the 233 diagnostic *)
|
|
|
- 2576 IF (res # SymTab.InvalidType)
|
|
|
- 2577 AND NOT va THEN
|
|
|
- 2578 SemError(233)
|
|
|
- 2579 END;
|
|
|
- 2580 t := SymTab.InvalidType;
|
|
|
- 2581 QbeGen.CopyOp("0", q);
|
|
|
- 2582 END; .) .
|
|
|
- 2583 (* One actual: VAR formals take recorded designator addresses
|
|
|
- 2584 (233 otherwise); value formals take converted expressions. *)
|
|
|
- 2585 ActParam<pn: SymTab.Name; pt: SymTab.TypeIndex; ind: BOOLEAN;
|
|
|
- 2586 methCls: SymTab.TypeIndex; i: CARDINAL>
|
|
|
- 2587 (. VAR at, ft: SymTab.TypeIndex;
|
|
|
- 2588 qe, qa, qt: QbeGen.QVal;
|
|
|
- 2589 isV, conv, va: BOOLEAN;
|
|
|
- 2590 cl: CHAR;
|
|
|
- 2591 savedN, aj: CARDINAL;
|
|
|
- 2592 savedArgs: ARRAY [0 .. 31]
|
|
|
- 2593 OF AST.Node;
|
|
|
- 2594 astActual: AST.Node; .)
|
|
|
- 2595 = (. (* Parsing the actual can clobber
|
|
|
- 2596 the enclosing call's argument
|
|
|
- 2597 list (Factor resets astNArgs),
|
|
|
- 2598 so save/restore it. *)
|
|
|
- 2599 savedN := astNArgs; aj := 0;
|
|
|
- 2600 WHILE aj <= HIGH(astArgs) DO
|
|
|
- 2601 savedArgs[aj] := astArgs[aj];
|
|
|
- 2602 INC(aj)
|
|
|
- 2603 END; .)
|
|
|
- 2604 Expr<at, qe> (. QbeGen.CopyOp(qe, convQ); convT := at;
|
|
|
- 2605 astActual := astCur;
|
|
|
- 2606 astNArgs := savedN; aj := 0;
|
|
|
- 2607 WHILE aj <= HIGH(astArgs) DO
|
|
|
- 2608 astArgs[aj] := savedArgs[aj];
|
|
|
- 2609 INC(aj)
|
|
|
- 2610 END;
|
|
|
- 2611 IF astNArgs <= HIGH(astArgs) THEN
|
|
|
- 2612 astArgs[astNArgs] := astCur;
|
|
|
- 2613 INC(astNArgs)
|
|
|
- 2614 ELSE SemError(230)
|
|
|
- 2615 (* > 32 actuals: impl limit *)
|
|
|
- 2616 END;
|
|
|
- 2617 va := (NOT ind)
|
|
|
- 2618 AND (methCls =
|
|
|
- 2619 SymTab.InvalidType)
|
|
|
- 2620 AND (SymTab.SymKind(pn) =
|
|
|
- 2621 SymTab.KindProc)
|
|
|
- 2622 AND SymTab.Varargs(pn);
|
|
|
- 2623 IF ind THEN
|
|
|
- 2624 ft :=
|
|
|
- 2625 SymTab.ProcTypeParamType(pt,
|
|
|
- 2626 i);
|
|
|
- 2627 isV :=
|
|
|
- 2628 SymTab.ProcTypeParamIsVar(pt,
|
|
|
- 2629 i)
|
|
|
- 2630 ELSIF methCls #
|
|
|
- 2631 SymTab.InvalidType THEN
|
|
|
- 2632 ft :=
|
|
|
- 2633 SymTab.ClassMethodParamType(
|
|
|
- 2634 methCls, pn, i);
|
|
|
- 2635 isV :=
|
|
|
- 2636 SymTab.ClassMethodParamIsVar(
|
|
|
- 2637 methCls, pn, i)
|
|
|
- 2638 ELSE
|
|
|
- 2639 ft := SymTab.ParamType(pn, i);
|
|
|
- 2640 isV := SymTab.ParamIsVar(pn, i)
|
|
|
- 2641 END;
|
|
|
- 2642 IF (at = SymTab.InvalidType) THEN
|
|
|
- 2643 ELSIF ft = SymTab.InvalidType THEN
|
|
|
- 2644 ELSIF isV THEN
|
|
|
- 2645 IF (SymTab.ClassOf(at) = SymTab.ClChar)
|
|
|
- 2646 AND (SymTab.ClassOf(ft) = SymTab.ClArray)
|
|
|
- 2647 AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
|
|
|
- 2648 AND QbeGen.IsImm(qe) THEN
|
|
|
- 2649 ELSIF (AST.Kind(astActual) #
|
|
|
- 2650 AST.NkDesignator)
|
|
|
- 2651 AND (AST.Kind(astActual) # AST.NkStrLit) THEN
|
|
|
- 2652 SemError(233)
|
|
|
- 2653 ELSIF NOT SymTab.VarParamOk(at, ft)
|
|
|
- 2654 AND NOT SymTab.ByteBufOk(at, ft) THEN
|
|
|
- 2655 SemError(233)
|
|
|
- 2656 END
|
|
|
- 2657 ELSE
|
|
|
- 2658 IF (SymTab.ClassOf(at) = SymTab.ClChar)
|
|
|
- 2659 AND (SymTab.ClassOf(ft) = SymTab.ClArray)
|
|
|
- 2660 AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
|
|
|
- 2661 AND QbeGen.IsImm(qe) THEN
|
|
|
- 2662 ELSIF NOT SymTab.Assignable(at, ft)
|
|
|
- 2663 AND NOT SymTab.ByteBufOk(at, ft) THEN
|
|
|
- 2664 SemError(233)
|
|
|
- 2665 END
|
|
|
- 2666 END; .) .
|
|
|
- 2667 IfStat (. VAR t: SymTab.TypeIndex;
|
|
|
- 2668 q: QbeGen.QVal;
|
|
|
- 2669 hasElse: BOOLEAN;
|
|
|
- 2670 astCond, astIf, astLast,
|
|
|
- 2671 astNode: AST.Node; .)
|
|
|
- 2672 = "IF" (. hasElse := FALSE; .)
|
|
|
- 2673 Expr<t, q> (. astCond := astCur; astStmt := AST.NoNode;
|
|
|
- 2674 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
- 2675 SemError(214) END; .)
|
|
|
- 2676 "THEN" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkIf);
|
|
|
- 2677 AST.SetChild(astNode, 0, astCond);
|
|
|
- 2678 AST.SetChild(astNode, 1, astStmt);
|
|
|
- 2679 astIf := astNode;
|
|
|
- 2680 astLast := astNode; .)
|
|
|
- 2681 { "ELSIF"
|
|
|
- 2682 Expr<t, q> (. astCond := astCur; astStmt := AST.NoNode;
|
|
|
- 2683 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
- 2684 SemError(214) END; .)
|
|
|
- 2685 "THEN" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkIf);
|
|
|
- 2686 AST.SetChild(astNode, 0, astCond);
|
|
|
- 2687 AST.SetChild(astNode, 1, astStmt);
|
|
|
- 2688 AST.SetChild(astLast, 2, astNode);
|
|
|
- 2689 astLast := astNode; .) }
|
|
|
- 2690 [ "ELSE" (. hasElse := TRUE;
|
|
|
- 2691 astStmt := AST.NoNode; .)
|
|
|
- 2692 [ StatSeq ] (. AST.SetChild(astLast, 2, astStmt); .) ]
|
|
|
- 2693 "END" (. astStmt := astIf; .) .
|
|
|
- 2694 WhileStat (. VAR t: SymTab.TypeIndex;
|
|
|
- 2695 q: QbeGen.QVal;
|
|
|
- 2696 astCond, astNode: AST.Node; .)
|
|
|
- 2697 = "WHILE" (. astStmt := AST.NoNode; .)
|
|
|
- 2698 Expr<t, q> (. astCond := astCur;
|
|
|
- 2699 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
- 2700 SemError(214) END; .)
|
|
|
- 2701 "DO" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkWhile);
|
|
|
- 2702 AST.SetChild(astNode, 0, astCond);
|
|
|
- 2703 AST.SetChild(astNode, 1, astStmt);
|
|
|
- 2704 astStmt := astNode; .)
|
|
|
- 2705 "END" .
|
|
|
- 2706 RepeatStat (. VAR t: SymTab.TypeIndex;
|
|
|
- 2707 q: QbeGen.QVal;
|
|
|
- 2708 astCond, astBody, astNode:
|
|
|
- 2709 AST.Node; .)
|
|
|
- 2710 = "REPEAT" (. astStmt := AST.NoNode; .)
|
|
|
- 2711 [ StatSeq ] (. astBody := astStmt; .)
|
|
|
- 2712 "UNTIL" Expr<t, q> (. astCond := astCur;
|
|
|
- 2713 astNode := AST.MakeNode(AST.NkRepeat);
|
|
|
- 2714 AST.SetChild(astNode, 0, astBody);
|
|
|
- 2715 AST.SetChild(astNode, 1, astCond);
|
|
|
- 2716 astStmt := astNode;
|
|
|
- 2717 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
- 2718 SemError(214) END; .) .
|
|
|
- 2719 LoopStat (. VAR lEnd: QbeGen.QVal; astNode: AST.Node; .)
|
|
|
- 2720 = "LOOP" (. astStmt := AST.NoNode;
|
|
|
- 2721 QbeGen.NewLabel(lEnd);
|
|
|
- 2722 QbeGen.PushLoop(lEnd); .)
|
|
|
- 2723 [ StatSeq ]
|
|
|
- 2724 "END" (. astNode := AST.MakeNode(AST.NkLoop);
|
|
|
- 2725 AST.SetChild(astNode, 0, astStmt);
|
|
|
- 2726 astStmt := astNode;
|
|
|
- 2727 QbeGen.PopLoop; .) .
|
|
|
- 2728 (* FOR with static-sign BY (literal, non-zero; 220 otherwise).
|
|
|
- 2729 Runtime direction would need a compare-select; the literal
|
|
|
- 2730 sign picks cslew/csegew at "DO" time. *)
|
|
|
- 2731 ForStat (. VAR lv: SymTab.Name;
|
|
|
- 2732 tlo, thi, tby:
|
|
|
- 2733 SymTab.TypeIndex;
|
|
|
- 2734 qlo, qhi, qby, qt, qk, qb:
|
|
|
- 2735 QbeGen.QVal;
|
|
|
- 2736 lTop, lBody, lEnd:
|
|
|
- 2737 QbeGen.QVal;
|
|
|
- 2738 by: INTEGER;
|
|
|
- 2739 ok: BOOLEAN;
|
|
|
- 2740 astVar, astLo, astHi, astBy,
|
|
|
- 2741 astNode: AST.Node; .)
|
|
|
- 2742 = "FOR" (. by := 1; .)
|
|
|
- 2743 GetIdent<lv> (. astVar := AST.MakeLeaf(AST.NkIdent, lv);
|
|
|
- 2744 astStmt := AST.NoNode;
|
|
|
- 2745 astBy := AST.NoNode;
|
|
|
- 2746 ok := SymTab.Lookup(lv);
|
|
|
- 2747 IF NOT ok THEN
|
|
|
- 2748 SemError(201)
|
|
|
- 2749 ELSIF (SymTab.SymKind(lv) #
|
|
|
- 2750 SymTab.KindVar)
|
|
|
- 2751 AND (SymTab.SymKind(lv) #
|
|
|
- 2752 SymTab.KindParam) THEN
|
|
|
- 2753 SemError(220); ok := FALSE
|
|
|
- 2754 ELSIF NOT SymTab.IsOrdinal(
|
|
|
- 2755 SymTab.SymType(lv)) THEN
|
|
|
- 2756 SemError(220); ok := FALSE
|
|
|
- 2757 END; .)
|
|
|
- 2758 ":=" Expr<tlo, qlo> (. astLo := astCur;
|
|
|
- 2759 IF NOT SymTab.Assignable(tlo,
|
|
|
- 2760 SymTab.SymType(lv)) THEN
|
|
|
- 2761 SemError(220); ok := FALSE
|
|
|
- 2762 END; .)
|
|
|
- 2763 "TO" Expr<thi, qhi> (. astHi := astCur;
|
|
|
- 2764 IF NOT SymTab.Assignable(thi,
|
|
|
- 2765 SymTab.SymType(lv)) THEN
|
|
|
- 2766 SemError(220); ok := FALSE
|
|
|
- 2767 END; .)
|
|
|
- 2768 [ "BY" Expr<tby, qby> (. astBy := astCur;
|
|
|
- 2769 IF (tby #
|
|
|
- 2770 SymTab.InvalidType)
|
|
|
- 2771 AND NOT SymTab.IsIntFamily(tby) THEN
|
|
|
- 2772 SemError(220); ok := FALSE
|
|
|
- 2773 END;
|
|
|
- 2774 IF NOT SymTab.ConstInt(qby, by) THEN
|
|
|
- 2775 SemError(230); by := 1
|
|
|
- 2776 ELSIF by = 0 THEN
|
|
|
- 2777 SemError(220); by := 1
|
|
|
- 2778 END; .) ]
|
|
|
- 2779 "DO"
|
|
|
- 2780 [ StatSeq ]
|
|
|
- 2781 "END" (. astNode := AST.MakeNode(AST.NkFor);
|
|
|
- 2782 AST.SetChild(astNode, 0, astVar);
|
|
|
- 2783 AST.SetChild(astNode, 1, astLo);
|
|
|
- 2784 AST.SetChild(astNode, 2, astHi);
|
|
|
- 2785 AST.SetChild(astNode, 3, astBy);
|
|
|
- 2786 AST.SetChild(astNode, 4, astStmt);
|
|
|
- 2787 astStmt := astNode;
|
|
|
- 2788 .) .
|
|
|
- 2789 CaseStat (. VAR tsel: SymTab.TypeIndex;
|
|
|
- 2790 qsel, lEnd: QbeGen.QVal;
|
|
|
- 2791 arm, astNode, astArms,
|
|
|
- 2792 astArmsTail: AST.Node; .)
|
|
|
- 2793 = "CASE" Expr<tsel, qsel> (. astNode := AST.MakeNode(AST.NkCase);
|
|
|
- 2794 AST.SetChild(astNode, 0, astCur);
|
|
|
- 2795 astArms := AST.NoNode;
|
|
|
- 2796 astArmsTail := AST.NoNode;
|
|
|
- 2797 .)
|
|
|
- 2798 "OF" [ "|" ] CaseAlt<tsel, qsel, lEnd, astArms, astArmsTail>
|
|
|
- 2799 { "|" CaseAlt<tsel, qsel, lEnd, astArms, astArmsTail> }
|
|
|
- 2800 [ "ELSE" (. astStmt := AST.NoNode; .)
|
|
|
- 2801 [ StatSeq ] (. arm := AST.MakeNode(AST.NkCaseArm);
|
|
|
- 2802 AST.SetOp(arm, 1);
|
|
|
- 2803 AST.SetChild(arm, 0, astStmt);
|
|
|
- 2804 AstAppend(AST.NkBlock,
|
|
|
- 2805 astArms, astArmsTail, arm); .) ]
|
|
|
- 2806 "END" (. AST.SetChild(astNode, 1, astArms);
|
|
|
- 2807 astStmt := astNode;
|
|
|
- 2808 .) .
|
|
|
- 2809 (* Compare-chain lowering: each alternative ends its match-tests
|
|
|
- 2810 with "jmp lAfter", so the no-match fallthrough skips the body:
|
|
|
- 2811 "cmp; jnz(lBody,lF); lF: ... ; jmp lAfter; lBody: S; jmp lEnd;
|
|
|
- 2812 lAfter:". Falls into the next alternative, ELSE, or END. *)
|
|
|
- 2813 CaseAlt<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
|
|
|
- 2814 lEnd: QbeGen.QVal; VAR arms, armsTail: AST.Node>
|
|
|
- 2815 (. VAR arm: AST.Node; .)
|
|
|
- 2816 = (. arm := AST.MakeNode(AST.NkCaseArm); .)
|
|
|
- 2817 CaseLabel<tsel, qsel, arm>
|
|
|
- 2818 { "," CaseLabel<tsel, qsel, arm> }
|
|
|
- 2819 ":" (. astStmt := AST.NoNode; .)
|
|
|
- 2820 [ StatSeq ] (. AST.SetChild(arm, AST.NChild(arm),
|
|
|
- 2821 astStmt);
|
|
|
- 2822 AstAppend(AST.NkBlock,
|
|
|
- 2823 arms, armsTail, arm);
|
|
|
- 2824 .) .
|
|
|
- 2825 CaseLabel<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
|
|
|
- 2826 arm: AST.Node>
|
|
|
- 2827 (. VAR t2, t3: SymTab.TypeIndex;
|
|
|
- 2828 q2, q3, qc, qd, qe:
|
|
|
- 2829 QbeGen.QVal;
|
|
|
- 2830 astLab: AST.Node;
|
|
|
- 2831 lNext: QbeGen.QVal; .)
|
|
|
- 2832 = Expr<t2, q2> (. astLab := astCur;
|
|
|
- 2833 IF SymTab.IsEmptyStr(t2)
|
|
|
- 2834 AND (SymTab.ClassOf(tsel) =
|
|
|
- 2835 SymTab.ClChar) THEN
|
|
|
- 2836 (* ISO: '' as a CASE label
|
|
|
- 2837 is the terminator *)
|
|
|
- 2838 QbeGen.CopyOp("0", q2);
|
|
|
- 2839 t2 := SymTab.CharType()
|
|
|
- 2840 END;
|
|
|
- 2841 IF (t2 #
|
|
|
- 2842 SymTab.InvalidType)
|
|
|
- 2843 AND (tsel #
|
|
|
- 2844 SymTab.InvalidType)
|
|
|
- 2845 AND NOT SymTab.EqCheck(t2,
|
|
|
- 2846 tsel) THEN
|
|
|
- 2847 SemError(213) END;
|
|
|
- 2848 (* set labels are not immediates:
|
|
|
- 2849 the CASE chain uses CmpSet *)
|
|
|
- 2850 IF (SymTab.ClassOf(t2) # SymTab.ClSet)
|
|
|
- 2851 AND NOT QbeGen.IsImm(q2) THEN
|
|
|
- 2852 SemError(230)
|
|
|
- 2853 END; .)
|
|
|
- 2854 [ ".." Expr<t3, q3> (. astLab := AST.MakeBin(
|
|
|
- 2855 AST.NkSubrange, 0, astLab, astCur);
|
|
|
- 2856 IF SymTab.IsEmptyStr(t3)
|
|
|
- 2857 AND (SymTab.ClassOf(tsel) =
|
|
|
- 2858 SymTab.ClChar) THEN
|
|
|
- 2859 QbeGen.CopyOp("0", q3);
|
|
|
- 2860 t3 := SymTab.CharType()
|
|
|
- 2861 END;
|
|
|
- 2862 IF (t3 #
|
|
|
- 2863 SymTab.InvalidType)
|
|
|
- 2864 AND (tsel #
|
|
|
- 2865 SymTab.InvalidType)
|
|
|
- 2866 AND NOT SymTab.EqCheck(t3,
|
|
|
- 2867 tsel) THEN
|
|
|
- 2868 SemError(213) END;
|
|
|
- 2869 IF (SymTab.ClassOf(t3) # SymTab.ClSet)
|
|
|
- 2870 AND NOT QbeGen.IsImm(q3) THEN
|
|
|
- 2871 SemError(230)
|
|
|
- 2872 END; .) ]
|
|
|
- 2873 (. AST.SetChild(arm,
|
|
|
- 2874 AST.NChild(arm), astLab); .) .
|
|
|
- 2875 ReturnStat (. VAR t: SymTab.TypeIndex;
|
|
|
- 2876 q, qt: QbeGen.QVal;
|
|
|
- 2877 res: SymTab.TypeIndex;
|
|
|
- 2878 hadE, conv: BOOLEAN;
|
|
|
- 2879 astVal, astNode: AST.Node; .)
|
|
|
- 2880 = "RETURN" (. hadE := FALSE; astStmt := AST.NoNode; .)
|
|
|
- 2881 [ Expr<t, q> (. hadE := TRUE; astVal := astCur; .) ]
|
|
|
- 2882 (. astNode := AST.MakeNode(AST.NkReturn);
|
|
|
- 2883 IF hadE THEN
|
|
|
- 2884 AST.SetChild(astNode, 0, astVal)
|
|
|
- 2885 END;
|
|
|
- 2886 astStmt := astNode;
|
|
|
- 2887 conv := FALSE;
|
|
|
- 2888 IF NOT SymTab.InProc() THEN
|
|
|
- 2889 SemError(232)
|
|
|
- 2890 ELSE res := SymTab.CurRes();
|
|
|
- 2891 IF NOT hadE THEN
|
|
|
- 2892 IF res #
|
|
|
- 2893 SymTab.InvalidType THEN
|
|
|
- 2894 SemError(232)
|
|
|
- 2895 END
|
|
|
- 2896 ELSIF (res =
|
|
|
- 2897 SymTab.InvalidType)
|
|
|
- 2898 OR (t #
|
|
|
- 2899 SymTab.InvalidType)
|
|
|
- 2900 AND NOT SymTab.Assignable(t,
|
|
|
- 2901 res) THEN
|
|
|
- 2902 SemError(232)
|
|
|
- 2903 END
|
|
|
- 2904 END; .) .
|
|
|
- 2905 HaltStat (. VAR t: SymTab.TypeIndex;
|
|
|
- 2906 q: QbeGen.QVal;
|
|
|
- 2907 astVal, astNode: AST.Node; .)
|
|
|
- 2908 = "HALT" (. astVal := AST.NoNode; .)
|
|
|
- 2909 [ "(" Expr<t, q> (. astVal := astCur; .) ")" ]
|
|
|
- 2910 (. astNode := AST.MakeNode(AST.NkHalt);
|
|
|
- 2911 IF astVal # AST.NoNode THEN
|
|
|
- 2912 AST.SetChild(astNode, 0, astVal)
|
|
|
- 2913 END;
|
|
|
- 2914 astStmt := astNode;
|
|
|
- 2915 .) .
|
|
|
- 2916 (* Designator: scalar loads, array addresses, and index suffixes.
|
|
|
- 2917 Each index descends one level (bounds-checked, trap on breach);
|
|
|
- 2918 nested levels reload the inner descriptor address. q ends as the
|
|
|
- 2919 value (scalars), the descriptor address (plain arrays), or the
|
|
|
- 2920 element address (indexed); sfx marks the indexed form. *)
|
|
|
- 2921 Design<VAR t: SymTab.TypeIndex; VAR k: INTEGER;
|
|
|
- 2922 VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
|
|
|
- 2923 (. VAR n: SymTab.Name; .)
|
|
|
- 2924 = GetIdent<n> DesignTail<n, t, k, q, qn, sfx> .
|
|
|
- 2925 (* The part of Design after the identifier: resolve it and walk the
|
|
|
- 2926 selectors. Split out so a statement can decide between a label
|
|
|
- 2927 (`ident :`) and a designator (`ident := ...`) with one token. *)
|
|
|
- 2928 DesignTail<VAR n: SymTab.Name; VAR t: SymTab.TypeIndex; VAR k: INTEGER;
|
|
|
- 2929 VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
|
|
|
- 2930 (. VAR fn, mal: SymTab.Name;
|
|
|
- 2931 cls: INTEGER;
|
|
|
- 2932 ic: SymTab.TypeIndex;
|
|
|
- 2933 curT, it, eT, bt:
|
|
|
- 2934 SymTab.TypeIndex;
|
|
|
- 2935 iq, ql, qlo, qhi, qe:
|
|
|
- 2936 QbeGen.QVal;
|
|
|
- 2937 lo, hi: INTEGER;
|
|
|
- 2938 fo: INTEGER;
|
|
|
- 2939 isOpen: BOOLEAN;
|
|
|
- 2940 qb, cv: QbeGen.QVal;
|
|
|
- 2941 r: BOOLEAN;
|
|
|
- 2942 astDes, astSel: AST.Node; .)
|
|
|
- 2943 = (. methCls := SymTab.InvalidType;
|
|
|
- 2944 QbeGen.CopyOp(n, qn);
|
|
|
- 2945 sfx := FALSE;
|
|
|
- 2946 IF NOT SymTab.Lookup(n) THEN
|
|
|
- 2947 (* a bare method name inside
|
|
|
- 2948 a CLASS IMPLEMENTATION
|
|
|
- 2949 is a sibling call on
|
|
|
- 2950 THIS *)
|
|
|
- 2951 ic := SymTab.CurImplClass();
|
|
|
- 2952 IF (ic #
|
|
|
- 2953 SymTab.InvalidType)
|
|
|
- 2954 AND SymTab.MethodExists(ic, n) THEN
|
|
|
- 2955 sfx := FALSE;
|
|
|
- 2956 QbeGen.CopyOp("@", q);
|
|
|
- 2957 methCls := ic;
|
|
|
- 2958 k := SymTab.KindProc;
|
|
|
- 2959 t := SymTab.InvalidType
|
|
|
- 2960 ELSIF SymTab.InProc() THEN
|
|
|
- 2961 (* not declared anywhere
|
|
|
- 2962 in scope: with bodies
|
|
|
- 2963 parsed at unit end this
|
|
|
- 2964 is a genuine 201 (a
|
|
|
- 2965 nested-local forward is
|
|
|
- 2966 no longer tolerated). *)
|
|
|
- 2967 SemError(201);
|
|
|
- 2968 t := SymTab.InvalidType;
|
|
|
- 2969 k := -1;
|
|
|
- 2970 QbeGen.CopyOp("0", q)
|
|
|
- 2971 ELSE
|
|
|
- 2972 SemError(201);
|
|
|
- 2973 t :=
|
|
|
- 2974 SymTab.InvalidType;
|
|
|
- 2975 k := -1;
|
|
|
- 2976 QbeGen.CopyOp("0", q)
|
|
|
- 2977 END
|
|
|
- 2978 ELSE
|
|
|
- 2979 t := SymTab.SymType(n);
|
|
|
- 2980 k := SymTab.SymKind(n);
|
|
|
- 2981 IF k = SymTab.KindConst THEN
|
|
|
- 2982 IF SymTab.Equal(n,
|
|
|
- 2983 "TRUE") THEN
|
|
|
- 2984 t := SymTab.BoolType();
|
|
|
- 2985 QbeGen.CopyOp("1", q)
|
|
|
- 2986 ELSIF SymTab.Equal(n,
|
|
|
- 2987 "FALSE") THEN
|
|
|
- 2988 t := SymTab.BoolType();
|
|
|
- 2989 QbeGen.CopyOp("0", q)
|
|
|
- 2990 ELSIF SymTab.Equal(n,
|
|
|
- 2991 "NIL") THEN
|
|
|
- 2992 QbeGen.CopyOp("0", q)
|
|
|
- 2993 ELSE
|
|
|
- 2994 cls :=
|
|
|
- 2995 SymTab.ClassOf(t);
|
|
|
- 2996 IF (t #
|
|
|
- 2997 SymTab.InvalidType)
|
|
|
- 2998 AND ((cls = SymTab.ClInt)
|
|
|
- 2999 OR (cls
|
|
|
- 3000 = SymTab.ClChar)
|
|
|
- 3001 OR (cls
|
|
|
- 3002 = SymTab.ClEnum)
|
|
|
- 3003 OR (cls
|
|
|
- 3004 = SymTab.ClReal)
|
|
|
- 3005 OR (cls
|
|
|
- 3006 = SymTab.ClLong)
|
|
|
- 3007 OR (cls
|
|
|
- 3008 = SymTab.ClNil)
|
|
|
- 3009 OR (cls = SymTab.ClByte)
|
|
|
- 3010 OR (cls = SymTab.ClSByte)
|
|
|
- 3011 OR (cls = SymTab.ClWord16)
|
|
|
- 3012 OR (cls = SymTab.ClSWord16)
|
|
|
- 3013 OR (cls = SymTab.ClBool)) THEN
|
|
|
- 3014 IF cls = SymTab.ClNil THEN
|
|
|
- 3015 QbeGen.CopyOp("0", q)
|
|
|
- 3016 ELSIF ((cls
|
|
|
- 3017 = SymTab.ClInt)
|
|
|
- 3018 OR (cls
|
|
|
- 3019 = SymTab.ClChar)
|
|
|
- 3020 OR (cls
|
|
|
- 3021 = SymTab.ClEnum)
|
|
|
- 3022 OR (cls
|
|
|
- 3023 = SymTab.ClLong)
|
|
|
- 3024 OR (cls = SymTab.ClByte)
|
|
|
- 3025 OR (cls = SymTab.ClSByte)
|
|
|
- 3026 OR (cls = SymTab.ClWord16)
|
|
|
- 3027 OR (cls = SymTab.ClSWord16)
|
|
|
- 3028 OR (cls = SymTab.ClBool))
|
|
|
- 3029 AND SymTab.GetSymVal(n, cv)
|
|
|
- 3030 AND QbeGen.IsImm(cv) THEN
|
|
|
- 3031 QbeGen.CopyOp(cv, q)
|
|
|
- 3032 ELSE
|
|
|
- 3033 QbeGen.LoadVar(n,
|
|
|
- 3034 cls = SymTab.ClReal,
|
|
|
- 3035 q)
|
|
|
- 3036 END
|
|
|
- 3037 ELSIF (cls = SymTab.ClArray)
|
|
|
- 3038 OR (cls = SymTab.ClRecord)
|
|
|
- 3039 OR (cls = SymTab.ClClass)
|
|
|
- 3040 OR (cls = SymTab.ClStr)
|
|
|
- 3041 OR (cls = SymTab.ClUStr)
|
|
|
- 3042 OR (cls = SymTab.ClSet) THEN
|
|
|
- 3043 (* aggregate constant:
|
|
|
- 3044 its value IS the
|
|
|
- 3045 descriptor address *)
|
|
|
- 3046 IF SymTab.GetSymVal(n, cv) THEN
|
|
|
- 3047 QbeGen.CopyOp(cv, q)
|
|
|
- 3048 ELSE
|
|
|
- 3049 QbeGen.CopyOp("0", q)
|
|
|
- 3050 END
|
|
|
- 3051 ELSE
|
|
|
- 3052 IF t #
|
|
|
- 3053 SymTab.InvalidType THEN
|
|
|
- 3054 SemError(230)
|
|
|
- 3055 END;
|
|
|
- 3056 QbeGen.CopyOp("0", q)
|
|
|
- 3057 END
|
|
|
- 3058 END
|
|
|
- 3059 ELSIF (k = SymTab.KindVar)
|
|
|
- 3060 OR (k = SymTab.KindParam) THEN
|
|
|
- 3061 cls := SymTab.ClassOf(t);
|
|
|
- 3062 IF (cls # SymTab.ClInt)
|
|
|
- 3063 AND (cls # SymTab.ClBool)
|
|
|
- 3064 AND (cls # SymTab.ClChar)
|
|
|
- 3065 AND (cls # SymTab.ClUChar)
|
|
|
- 3066 AND (cls # SymTab.ClEnum)
|
|
|
- 3067 AND (cls # SymTab.ClReal)
|
|
|
- 3068 AND (cls # SymTab.ClPtr)
|
|
|
- 3069 AND (cls # SymTab.ClProc)
|
|
|
- 3070 AND (cls # SymTab.ClLong)
|
|
|
- 3071 AND (cls # SymTab.ClArray)
|
|
|
- 3072 AND (cls # SymTab.ClSet)
|
|
|
- 3073 AND (cls # SymTab.ClRecord)
|
|
|
- 3074 AND (cls # SymTab.ClUStr)
|
|
|
- 3075 AND (cls # SymTab.ClByte)
|
|
|
- 3076 AND (cls # SymTab.ClSByte)
|
|
|
- 3077 AND (cls # SymTab.ClWord16)
|
|
|
- 3078 AND (cls # SymTab.ClSWord16)
|
|
|
- 3079 AND (cls # SymTab.ClClass) THEN
|
|
|
- 3080 SemError(230);
|
|
|
- 3081 QbeGen.CopyOp("0", q)
|
|
|
- 3082 ELSE QbeGen.CopyOp("@", q)
|
|
|
- 3083 END
|
|
|
- 3084 ELSE QbeGen.CopyOp("0", q);
|
|
|
- 3085 IF k = SymTab.KindImport THEN
|
|
|
- 3086 SemError(230)
|
|
|
- 3087 ELSIF k =
|
|
|
- 3088 SymTab.KindProc THEN
|
|
|
- 3089 (* bare procedure name:
|
|
|
- 3090 a following ArgList
|
|
|
- 3091 makes it a call;
|
|
|
- 3092 otherwise Fact
|
|
|
- 3093 reports 230 *)
|
|
|
- 3094 ELSE
|
|
|
- 3095 IF k = SymTab.KindField THEN
|
|
|
- 3096 IF QbeGen.TopWith(qb) THEN
|
|
|
- 3097 sfx := TRUE
|
|
|
- 3098 ELSE SemError(230);
|
|
|
- 3099 QbeGen.CopyOp("0", q)
|
|
|
- 3100 END
|
|
|
- 3101 END
|
|
|
- 3102 END
|
|
|
- 3103 END
|
|
|
- 3104 END; .)
|
|
|
- 3105 (. astDes := AST.MakeNode(AST.NkDesignator);
|
|
|
- 3106 AST.SetChild(astDes, AST.NChild(astDes), AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
- 3107 { "[" Expr<it, iq>
|
|
|
- 3108 (. AST.SetChild(astDes, AST.NChild(astDes),
|
|
|
- 3109 AST.MakeUn(AST.NkSelector, AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
- 3110 ELSIF SymTab.ClassOf(t) #
|
|
|
- 3111 SymTab.ClArray THEN
|
|
|
- 3112 SemError(217);
|
|
|
- 3113 t := SymTab.InvalidType
|
|
|
- 3114 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
- 3115 AND (SymTab.ClassOf(it) #
|
|
|
- 3116 SymTab.ClChar)
|
|
|
- 3117 AND (SymTab.ClassOf(it) #
|
|
|
- 3118 SymTab.ClEnum)
|
|
|
- 3119 AND (SymTab.ClassOf(it) #
|
|
|
- 3120 SymTab.ClBool) THEN
|
|
|
- 3121 SemError(218);
|
|
|
- 3122 t := SymTab.InvalidType
|
|
|
- 3123 ELSE
|
|
|
- 3124 eT := SymTab.ArrayElem(t);
|
|
|
- 3125 t := eT; sfx := TRUE
|
|
|
- 3126 END; .)
|
|
|
- 3127 { "," Expr<it, iq>
|
|
|
- 3128 (. AST.SetChild(astDes, AST.NChild(astDes),
|
|
|
- 3129 AST.MakeUn(AST.NkSelector, AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
- 3130 ELSIF SymTab.ClassOf(t) #
|
|
|
- 3131 SymTab.ClArray THEN
|
|
|
- 3132 SemError(217);
|
|
|
- 3133 t := SymTab.InvalidType
|
|
|
- 3134 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
- 3135 AND (SymTab.ClassOf(it) #
|
|
|
- 3136 SymTab.ClChar)
|
|
|
- 3137 AND (SymTab.ClassOf(it) #
|
|
|
- 3138 SymTab.ClEnum)
|
|
|
- 3139 AND (SymTab.ClassOf(it) #
|
|
|
- 3140 SymTab.ClBool) THEN
|
|
|
- 3141 SemError(218);
|
|
|
- 3142 t := SymTab.InvalidType
|
|
|
- 3143 ELSE
|
|
|
- 3144 eT := SymTab.ArrayElem(t);
|
|
|
- 3145 t := eT; sfx := TRUE
|
|
|
- 3146 END; .) }
|
|
|
- 3147 "]"
|
|
|
- 3148 | "." GetIdent<fn>
|
|
|
- 3149 (. astSel := AST.MakeNode(AST.NkSelector);
|
|
|
- 3150 AST.SetOp(astSel, AST.SelField);
|
|
|
- 3151 AST.SetChild(astSel, 0, AST.MakeLeaf(AST.NkIdent, fn));
|
|
|
- 3152 AST.SetChild(astDes, AST.NChild(astDes), astSel); IF k = SymTab.KindModule THEN
|
|
|
- 3153 (* qualified L.x: materialize
|
|
|
- 3154 the export, then load it *)
|
|
|
- 3155 IF NOT SymTab.MaterializeAlias(n,
|
|
|
- 3156 fn, mal) THEN
|
|
|
- 3157 SemError(201);
|
|
|
- 3158 t := SymTab.InvalidType;
|
|
|
- 3159 QbeGen.CopyOp("0", q)
|
|
|
- 3160 ELSE
|
|
|
- 3161 QbeGen.CopyOp(mal, qn);
|
|
|
- 3162 t := SymTab.SymType(mal);
|
|
|
- 3163 k := SymTab.SymKind(mal);
|
|
|
- 3164 sfx := FALSE;
|
|
|
- 3165 IF k = SymTab.KindProc THEN
|
|
|
- 3166 (* call: ArgList supplies
|
|
|
- 3167 the value *)
|
|
|
- 3168 QbeGen.CopyOp("0", q)
|
|
|
- 3169 ELSIF k = SymTab.KindConst THEN
|
|
|
- 3170 IF SymTab.GetSymVal(mal,
|
|
|
- 3171 cv)
|
|
|
- 3172 THEN QbeGen.CopyOp(cv, q)
|
|
|
- 3173 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 3174 END
|
|
|
- 3175 END
|
|
|
- 3176 END
|
|
|
- 3177 ELSIF t = SymTab.InvalidType THEN
|
|
|
- 3178 ELSIF (SymTab.ClassOf(t) #
|
|
|
- 3179 SymTab.ClRecord)
|
|
|
- 3180 AND (SymTab.ClassOf(t) #
|
|
|
- 3181 SymTab.ClClass) THEN
|
|
|
- 3182 SemError(215);
|
|
|
- 3183 t := SymTab.InvalidType
|
|
|
- 3184 ELSIF (SymTab.ClassOf(t) =
|
|
|
- 3185 SymTab.ClClass)
|
|
|
- 3186 AND SymTab.MethodExists(t, fn) THEN
|
|
|
- 3187 (* obj.Method: bind the
|
|
|
- 3188 method and pass obj as
|
|
|
- 3189 the hidden receiver; q
|
|
|
- 3190 already holds the
|
|
|
- 3191 object's address *)
|
|
|
- 3192 QbeGen.CopyOp(fn, n);
|
|
|
- 3193 QbeGen.CopyOp(fn, qn);
|
|
|
- 3194 methCls := t;
|
|
|
- 3195 k := SymTab.KindProc;
|
|
|
- 3196 t := SymTab.InvalidType
|
|
|
- 3197 ELSIF NOT SymTab.FieldExists(t,
|
|
|
- 3198 fn) THEN
|
|
|
- 3199 SemError(216);
|
|
|
- 3200 t := SymTab.InvalidType
|
|
|
- 3201 ELSE
|
|
|
- 3202 t := SymTab.FieldType(t, fn);
|
|
|
- 3203 sfx := TRUE
|
|
|
- 3204 END; .)
|
|
|
- 3205 | "^"
|
|
|
- 3206 (. astSel := AST.MakeNode(AST.NkSelector);
|
|
|
- 3207 AST.SetOp(astSel, AST.SelDeref);
|
|
|
- 3208 AST.SetChild(astDes, AST.NChild(astDes), astSel); IF t = SymTab.InvalidType THEN
|
|
|
- 3209 ELSIF SymTab.ClassOf(t) #
|
|
|
- 3210 SymTab.ClPtr THEN
|
|
|
- 3211 SemError(219);
|
|
|
- 3212 t := SymTab.InvalidType
|
|
|
- 3213 ELSE
|
|
|
- 3214 bt := SymTab.PtrBase(t);
|
|
|
- 3215 IF bt = SymTab.InvalidType THEN
|
|
|
- 3216 ELSE
|
|
|
- 3217 t := bt;
|
|
|
- 3218 sfx := TRUE
|
|
|
- 3219 END
|
|
|
- 3220 END; .) } (. astCur := astDes; .) .
|
|
|
- 3221 (* Result suffix (ISO component after a function call): `F()^`,
|
|
|
- 3222 `F()[i]`, `F().field`. The call result is in t/q with sfx FALSE
|
|
|
- 3223 (a value, or a descriptor address for aggregates); each component
|
|
|
- 3224 descends one level exactly like the Design components. *)
|
|
|
- 3225 ResultComp<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
|
|
|
- 3226 VAR sfx: BOOLEAN; VAR node: AST.Node;
|
|
|
- 3227 VAR mname: SymTab.Name; VAR methCls: SymTab.TypeIndex;
|
|
|
- 3228 VAR isM: BOOLEAN> (. VAR it, eT, bt: SymTab.TypeIndex;
|
|
|
- 3229 iq, ql, qlo, qhi, qe, qb:
|
|
|
- 3230 QbeGen.QVal;
|
|
|
- 3231 lo, hi, fo: INTEGER;
|
|
|
- 3232 isOpen: BOOLEAN;
|
|
|
- 3233 fname: SymTab.Name;
|
|
|
- 3234 astWrap, astSel: AST.Node; .)
|
|
|
- 3235 = "[" Expr<it, iq>
|
|
|
- 3236 (. isM := FALSE;
|
|
|
- 3237 IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
- 3238 astWrap := AST.MakeNode(
|
|
|
- 3239 AST.NkDesignator);
|
|
|
- 3240 AST.SetChild(astWrap, 0, node);
|
|
|
- 3241 node := astWrap
|
|
|
- 3242 END;
|
|
|
- 3243 AST.SetChild(node, AST.NChild(node),
|
|
|
- 3244 AST.MakeUn(AST.NkSelector,
|
|
|
- 3245 AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
- 3246 ELSIF SymTab.ClassOf(t) #
|
|
|
- 3247 SymTab.ClArray THEN
|
|
|
- 3248 SemError(217);
|
|
|
- 3249 t := SymTab.InvalidType
|
|
|
- 3250 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
- 3251 AND (SymTab.ClassOf(it) # SymTab.ClChar)
|
|
|
- 3252 AND (SymTab.ClassOf(it) # SymTab.ClEnum)
|
|
|
- 3253 AND (SymTab.ClassOf(it) # SymTab.ClBool) THEN
|
|
|
- 3254 SemError(218);
|
|
|
- 3255 t := SymTab.InvalidType
|
|
|
- 3256 ELSE
|
|
|
- 3257 eT := SymTab.ArrayElem(t);
|
|
|
- 3258 t := eT; sfx := TRUE
|
|
|
- 3259 END; .)
|
|
|
- 3260 "]"
|
|
|
- 3261 | "." GetIdent<fname>
|
|
|
- 3262 (. isM := FALSE;
|
|
|
- 3263 IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
- 3264 astWrap := AST.MakeNode(
|
|
|
- 3265 AST.NkDesignator);
|
|
|
- 3266 AST.SetChild(astWrap, 0, node);
|
|
|
- 3267 node := astWrap
|
|
|
- 3268 END;
|
|
|
- 3269 AST.SetChild(node, AST.NChild(node),
|
|
|
- 3270 AST.MakeUn(AST.NkSelector,
|
|
|
- 3271 AST.SelField,
|
|
|
- 3272 AST.MakeLeaf(AST.NkIdent,
|
|
|
- 3273 fname))); IF t = SymTab.InvalidType THEN
|
|
|
- 3274 ELSIF (SymTab.ClassOf(t) #
|
|
|
- 3275 SymTab.ClRecord)
|
|
|
- 3276 AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN
|
|
|
- 3277 SemError(215);
|
|
|
- 3278 t := SymTab.InvalidType
|
|
|
- 3279 ELSIF (SymTab.ClassOf(t) =
|
|
|
- 3280 SymTab.ClClass)
|
|
|
- 3281 AND SymTab.MethodExists(t, fname) THEN
|
|
|
- 3282 (* a method on the call result:
|
|
|
- 3283 a following ArgList makes
|
|
|
- 3284 the call *)
|
|
|
- 3285 mname := fname;
|
|
|
- 3286 methCls := t; isM := TRUE;
|
|
|
- 3287 t := SymTab.InvalidType
|
|
|
- 3288 ELSIF NOT SymTab.FieldExists(t,
|
|
|
- 3289 fname) THEN
|
|
|
- 3290 SemError(216);
|
|
|
- 3291 t := SymTab.InvalidType
|
|
|
- 3292 ELSE
|
|
|
- 3293 t := SymTab.FieldType(t, fname);
|
|
|
- 3294 sfx := TRUE
|
|
|
- 3295 END; .)
|
|
|
- 3296 | "^" (. isM := FALSE;
|
|
|
- 3297 IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
- 3298 astWrap := AST.MakeNode(
|
|
|
- 3299 AST.NkDesignator);
|
|
|
- 3300 AST.SetChild(astWrap, 0, node);
|
|
|
- 3301 node := astWrap
|
|
|
- 3302 END;
|
|
|
- 3303 astSel := AST.MakeNode(AST.NkSelector);
|
|
|
- 3304 AST.SetOp(astSel, AST.SelDeref);
|
|
|
- 3305 AST.SetChild(node,
|
|
|
- 3306 AST.NChild(node), astSel); IF t = SymTab.InvalidType THEN
|
|
|
- 3307 ELSIF SymTab.ClassOf(t) #
|
|
|
- 3308 SymTab.ClPtr THEN
|
|
|
- 3309 SemError(219);
|
|
|
- 3310 t := SymTab.InvalidType
|
|
|
- 3311 ELSE
|
|
|
- 3312 bt := SymTab.PtrBase(t);
|
|
|
- 3313 IF bt # SymTab.InvalidType THEN
|
|
|
- 3314 t := bt; sfx := TRUE
|
|
|
- 3315 END
|
|
|
- 3316 END; .) .
|
|
|
- 3317 Expr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 3318 (. VAR t2: SymTab.TypeIndex;
|
|
|
- 3319 op: INTEGER;
|
|
|
- 3320 q2, qt, wl: QbeGen.QVal;
|
|
|
- 3321 astA, astB: AST.Node;
|
|
|
- 3322 astOp: INTEGER;
|
|
|
- 3323 astMade: BOOLEAN;
|
|
|
- 3324 isR: BOOLEAN;
|
|
|
- 3325 v1, v2: INTEGER;
|
|
|
- 3326 b: BOOLEAN; .)
|
|
|
- 3327 = SimExpr<t, q> (. astA := astCur; astMade := FALSE; .)
|
|
|
- 3328 [ Rel<op> SimExpr<t2, q2>
|
|
|
- 3329 (. astB := astCur; astMade := TRUE;
|
|
|
- 3330 astOp := AST.OpEq;
|
|
|
- 3331 IF op = SymTab.OpNeq1 THEN astOp := AST.OpNe
|
|
|
- 3332 ELSIF op = SymTab.OpNeq2 THEN astOp := AST.OpNe
|
|
|
- 3333 ELSIF op = SymTab.OpLt THEN astOp := AST.OpLt
|
|
|
- 3334 ELSIF op = SymTab.OpLe THEN astOp := AST.OpLe
|
|
|
- 3335 ELSIF op = SymTab.OpGt THEN astOp := AST.OpGt
|
|
|
- 3336 ELSIF op = SymTab.OpGe THEN astOp := AST.OpGe
|
|
|
- 3337 ELSIF op = SymTab.OpIn THEN astOp := AST.OpIn
|
|
|
- 3338 END;
|
|
|
- 3339 IF op = SymTab.OpIn THEN
|
|
|
- 3340 IF SymTab.InCheck(t, t2) THEN
|
|
|
- 3341 IF (t = SymTab.InvalidType)
|
|
|
- 3342 OR (t2 = SymTab.InvalidType) THEN
|
|
|
- 3343 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
|
|
|
- 3344 ELSE
|
|
|
- 3345 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
- 3346 END
|
|
|
- 3347 ELSE SemError(222); t := SymTab.InvalidType;
|
|
|
- 3348 QbeGen.CopyOp("0", q)
|
|
|
- 3349 END
|
|
|
- 3350 ELSIF SymTab.RelCheck(t, t2, op) THEN
|
|
|
- 3351 IF (t = SymTab.InvalidType)
|
|
|
- 3352 OR (t2 = SymTab.InvalidType) THEN
|
|
|
- 3353 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
|
|
|
- 3354 ELSIF SymTab.IsOrdinal(t) AND SymTab.IsOrdinal(t2)
|
|
|
- 3355 AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2)
|
|
|
- 3356 AND SymTab.ConstInt(q, v1)
|
|
|
- 3357 AND SymTab.ConstInt(q2, v2) THEN
|
|
|
- 3358 (* fold a relation of two ordinal constants (needed for
|
|
|
- 3359 ORD(boolean) in a CONST initialiser) *)
|
|
|
- 3360 IF op = SymTab.OpEq THEN b := v1 = v2
|
|
|
- 3361 ELSIF (op = SymTab.OpNeq1) OR (op = SymTab.OpNeq2) THEN
|
|
|
- 3362 b := v1 # v2
|
|
|
- 3363 ELSIF op = SymTab.OpLt THEN b := v1 < v2
|
|
|
- 3364 ELSIF op = SymTab.OpLe THEN b := v1 <= v2
|
|
|
- 3365 ELSIF op = SymTab.OpGt THEN b := v1 > v2
|
|
|
- 3366 ELSE b := v1 >= v2
|
|
|
- 3367 END;
|
|
|
- 3368 t := SymTab.BoolType();
|
|
|
- 3369 IF b THEN QbeGen.CopyOp("1", q)
|
|
|
- 3370 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 3371 END
|
|
|
- 3372 ELSIF (SymTab.ClassOf(t) = SymTab.ClPtr)
|
|
|
- 3373 OR (SymTab.ClassOf(t2) = SymTab.ClPtr) THEN
|
|
|
- 3374 IF (op # SymTab.OpEq) AND (op # SymTab.OpNeq1)
|
|
|
- 3375 AND (op # SymTab.OpNeq2) THEN
|
|
|
- 3376 SemError(213); t := SymTab.InvalidType;
|
|
|
- 3377 QbeGen.CopyOp("0", q)
|
|
|
- 3378 ELSE
|
|
|
- 3379 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
- 3380 END
|
|
|
- 3381 ELSIF (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
- 3382 OR (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
- 3383 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
- 3384 ELSIF SymTab.StrCompat(t, t2) THEN
|
|
|
- 3385 QbeGen.StrEq(op, q, q2, qt);
|
|
|
- 3386 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
|
|
|
- 3387 ELSIF SymTab.IsLongFamily(t)
|
|
|
- 3388 OR SymTab.IsLongFamily(t2) THEN
|
|
|
- 3389 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
- 3390 ELSE
|
|
|
- 3391 t := SymTab.BoolType();
|
|
|
- 3392 QbeGen.CopyOp("@", q)
|
|
|
- 3393 END
|
|
|
- 3394 ELSE SemError(213); t := SymTab.InvalidType;
|
|
|
- 3395 QbeGen.CopyOp("0", q)
|
|
|
- 3396 END;
|
|
|
- 3397 astCur := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB); .) ]
|
|
|
- 3398 (. IF NOT astMade THEN astCur := astA END; .)
|
|
|
- 3399 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
- 3400 Rel<VAR op: INTEGER>
|
|
|
- 3401 = "=" (. op := SymTab.OpEq; .)
|
|
|
- 3402 | "#" (. op := SymTab.OpNeq1; .)
|
|
|
- 3403 | "<" (. op := SymTab.OpLt; .)
|
|
|
- 3404 | "<=" (. op := SymTab.OpLe; .)
|
|
|
- 3405 | ">" (. op := SymTab.OpGt; .)
|
|
|
- 3406 | ">=" (. op := SymTab.OpGe; .)
|
|
|
- 3407 | "IN" (. op := SymTab.OpIn; .) .
|
|
|
- 3408 SimExpr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 3409 (. VAR t2, res2, lt, rt:
|
|
|
- 3410 SymTab.TypeIndex;
|
|
|
- 3411 op: INTEGER;
|
|
|
- 3412 q2, qt, wq, qf, q2a, q2b:
|
|
|
- 3413 QbeGen.QVal;
|
|
|
- 3414 neg, isR, isL, folded:
|
|
|
- 3415 BOOLEAN;
|
|
|
- 3416 fok: BOOLEAN;
|
|
|
- 3417 lw, rw, mw: CARDINAL;
|
|
|
- 3418 lTrue, lNext, lDone, qr, qs: QbeGen.QVal;
|
|
|
- 3419 astA, astB: AST.Node;
|
|
|
- 3420 astSign, astOp: INTEGER;
|
|
|
- 3421 v1, v2: INTEGER;
|
|
|
- 3422 s: ARRAY [0 .. 255] OF CHAR; .)
|
|
|
- 3423 = (. neg := FALSE; astSign := 0; .)
|
|
|
- 3424 [ "+" (. neg := TRUE; astSign := 1; .)
|
|
|
- 3425 | "-" (. neg := TRUE; astSign := -1; .) ]
|
|
|
- 3426 Term<t, q> (. astA := astCur;
|
|
|
- 3427 IF neg AND QbeGen.IsImm(q) THEN
|
|
|
- 3428 QbeGen.NegFold(q, q)
|
|
|
- 3429 END;
|
|
|
- 3430 IF astSign < 0 THEN
|
|
|
- 3431 astCur := AST.MakeUn(
|
|
|
- 3432 AST.NkUnary, AST.OpSub, astA);
|
|
|
- 3433 astA := astCur
|
|
|
- 3434 END; .)
|
|
|
- 3435 { AddOp<op>
|
|
|
- 3436 Term<t2, q2> (. astB := astCur; .)
|
|
|
- 3437 (. astOp := AST.OpAdd;
|
|
|
- 3438 IF op = SymTab.OpSub THEN astOp := AST.OpSub
|
|
|
- 3439 ELSIF op = SymTab.OpOr THEN astOp := AST.OpOr END;
|
|
|
- 3440 astA := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB);
|
|
|
- 3441 astCur := astA;
|
|
|
- 3442 IF op = SymTab.OpOr THEN
|
|
|
- 3443 (* short-circuit: if q is true the RHS is skipped *)
|
|
|
- 3444 IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
|
|
|
- 3445 t := SymTab.BoolType()
|
|
|
- 3446 ELSE SemError(212); t := SymTab.InvalidType END;
|
|
|
- 3447 IF t # SymTab.InvalidType THEN
|
|
|
- 3448 QbeGen.CopyOp("@", q)
|
|
|
- 3449 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 3450 END
|
|
|
- 3451 ELSIF (op = SymTab.OpAdd)
|
|
|
- 3452 AND (SymTab.ClassOf(t) = SymTab.ClChar)
|
|
|
- 3453 AND (SymTab.ClassOf(t2) = SymTab.ClChar)
|
|
|
- 3454 AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
|
|
|
- 3455 (* "W" + "o": two one-character string literals concatenate
|
|
|
- 3456 to a two-character string (they are CHAR-typed immediates) *)
|
|
|
- 3457 IF SymTab.ConstInt(q, v1) AND SymTab.ConstInt(q2, v2)
|
|
|
- 3458 AND (v1 >= 0) AND (v1 <= 255)
|
|
|
- 3459 AND (v2 >= 0) AND (v2 <= 255) THEN
|
|
|
- 3460 s[0] := '"'; s[1] := CHR(v1); s[2] := CHR(v2);
|
|
|
- 3461 s[3] := '"'; s[4] := CHR(0);
|
|
|
- 3462 QbeGen.DeclStr(s, qt); QbeGen.CopyOp(qt, q);
|
|
|
- 3463 t := SymTab.NewStr();
|
|
|
- 3464 astA := AST.MakeLeaf(AST.NkStrLit, s);
|
|
|
- 3465 astCur := astA
|
|
|
- 3466 ELSE SemError(211); t := SymTab.InvalidType;
|
|
|
- 3467 QbeGen.CopyOp("0", q)
|
|
|
- 3468 END
|
|
|
- 3469 ELSIF (op = SymTab.OpAdd)
|
|
|
- 3470 AND (SymTab.UStrCompat(t, t2)
|
|
|
- 3471 OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
|
|
|
- 3472 AND (SymTab.ClassOf(t2) = SymTab.ClUStr))
|
|
|
- 3473 OR ((SymTab.ClassOf(t) = SymTab.ClUStr)
|
|
|
- 3474 AND (SymTab.ClassOf(t2) = SymTab.ClUChar))
|
|
|
- 3475 OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
|
|
|
- 3476 AND (SymTab.ClassOf(t2) = SymTab.ClUChar))) THEN
|
|
|
- 3477 (* UString concatenation: a UCHAR operand becomes a
|
|
|
- 3478 1-codepoint UString; the result is a descriptor in the
|
|
|
- 3479 shim's concat buffer. Work on copies so neither
|
|
|
- 3480 operand is clobbered. *)
|
|
|
- 3481 t := SymTab.NewUStr();
|
|
|
- 3482 QbeGen.CopyOp("@", q)
|
|
|
- 3483 ELSIF (op = SymTab.OpAdd)
|
|
|
- 3484 AND (SymTab.StrCompat(t, t2)
|
|
|
- 3485 OR (SymTab.IsStrType(t)
|
|
|
- 3486 AND (SymTab.ClassOf(t2) = SymTab.ClChar))
|
|
|
- 3487 OR ((SymTab.ClassOf(t) = SymTab.ClChar)
|
|
|
- 3488 AND SymTab.IsStrType(t2))) THEN
|
|
|
- 3489 (* string concatenation; a CHAR operand becomes a
|
|
|
- 3490 1-character string literal. When both operands are
|
|
|
- 3491 constants, fold to a single string literal so a
|
|
|
- 3492 constructor element stays compile-time. *)
|
|
|
- 3493 QbeGen.StrFold(q, q2, SymTab.ClassOf(t), SymTab.ClassOf(t2),
|
|
|
- 3494 qt, fok);
|
|
|
- 3495 IF fok THEN QbeGen.CopyOp(qt, q)
|
|
|
- 3496 ELSE QbeGen.CopyOp("@", q)
|
|
|
- 3497 END;
|
|
|
- 3498 t := SymTab.NewStr()
|
|
|
- 3499 ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
|
|
|
- 3500 AND (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
- 3501 AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
- 3502 lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
|
|
|
- 3503 mw := lw;
|
|
|
- 3504 IF rw > mw THEN mw := rw END;
|
|
|
- 3505 t := SymTab.NewSet(
|
|
|
- 3506 SymTab.NewSubR(0,
|
|
|
- 3507 VAL(INTEGER, mw) * 32 - 1));
|
|
|
- 3508 QbeGen.CopyOp("@", q)
|
|
|
- 3509 ELSE
|
|
|
- 3510 IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN
|
|
|
- 3511 lt := t; rt := t2; t := res2
|
|
|
- 3512 ELSE SemError(211); t := SymTab.InvalidType END;
|
|
|
- 3513 IF t # SymTab.InvalidType THEN
|
|
|
- 3514 isL := SymTab.IsLongFamily(t);
|
|
|
- 3515 isR := SymTab.ClassOf(t) = SymTab.ClReal;
|
|
|
- 3516 folded := FALSE;
|
|
|
- 3517 IF (NOT isL) AND (NOT isR)
|
|
|
- 3518 AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
|
|
|
- 3519 IF op = SymTab.OpAdd THEN
|
|
|
- 3520 folded := QbeGen.Fold2(0, q, q2, qf)
|
|
|
- 3521 ELSE
|
|
|
- 3522 folded := QbeGen.Fold2(1, q, q2, qf)
|
|
|
- 3523 END
|
|
|
- 3524 END;
|
|
|
- 3525 IF folded THEN QbeGen.CopyOp(qf, q)
|
|
|
- 3526 ELSE
|
|
|
- 3527 QbeGen.CopyOp("@", q)
|
|
|
- 3528 END
|
|
|
- 3529 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 3530 END
|
|
|
- 3531 END; .) }
|
|
|
- 3532 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
- 3533 AddOp<VAR op: INTEGER>
|
|
|
- 3534 = "+" (. op := SymTab.OpAdd; .)
|
|
|
- 3535 | "-" (. op := SymTab.OpSub; .)
|
|
|
- 3536 | "OR" (. op := SymTab.OpOr; .) .
|
|
|
- 3537 Term<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 3538 (. VAR t2, res2, lt, rt:
|
|
|
- 3539 SymTab.TypeIndex;
|
|
|
- 3540 op: INTEGER;
|
|
|
- 3541 q2, qt, wq, qf:
|
|
|
- 3542 QbeGen.QVal;
|
|
|
- 3543 isR, isL, folded: BOOLEAN;
|
|
|
- 3544 lw, rw, mw: CARDINAL;
|
|
|
- 3545 lNext, lFalse, lDone, qr, qs: QbeGen.QVal;
|
|
|
- 3546 astA, astB: AST.Node;
|
|
|
- 3547 astOp: INTEGER; .)
|
|
|
- 3548 = Fact<t, q> (. astA := astCur; .) { MulOp<op>
|
|
|
- 3549 Fact<t2, q2> (. astB := astCur; .)
|
|
|
- 3550 (. astOp := AST.OpMul;
|
|
|
- 3551 IF op = SymTab.OpSlash THEN astOp := AST.OpDiv
|
|
|
- 3552 ELSIF op = SymTab.OpDiv THEN astOp := AST.OpDiv
|
|
|
- 3553 ELSIF op = SymTab.OpMod THEN astOp := AST.OpMod
|
|
|
- 3554 ELSIF op = SymTab.OpAnd THEN astOp := AST.OpAnd END;
|
|
|
- 3555 astA := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB);
|
|
|
- 3556 astCur := astA;
|
|
|
- 3557 IF op = SymTab.OpAnd THEN
|
|
|
- 3558 (* short-circuit: if q is false the RHS is skipped *)
|
|
|
- 3559 IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
|
|
|
- 3560 t := SymTab.BoolType()
|
|
|
- 3561 ELSE SemError(212); t := SymTab.InvalidType END;
|
|
|
- 3562 IF t # SymTab.InvalidType THEN QbeGen.CopyOp("@", q)
|
|
|
- 3563 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 3564 END
|
|
|
- 3565 ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
|
|
|
- 3566 AND (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
- 3567 AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
- 3568 lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
|
|
|
- 3569 mw := lw;
|
|
|
- 3570 IF rw > mw THEN mw := rw END;
|
|
|
- 3571 t := SymTab.NewSet(
|
|
|
- 3572 SymTab.NewSubR(0,
|
|
|
- 3573 VAL(INTEGER, mw) * 32 - 1));
|
|
|
- 3574 QbeGen.CopyOp("@", q)
|
|
|
- 3575 ELSE
|
|
|
- 3576 IF SymTab.ArithCheck(t, t2,
|
|
|
- 3577 (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
|
|
|
- 3578 res2) THEN
|
|
|
- 3579 lt := t; rt := t2; t := res2
|
|
|
- 3580 ELSE SemError(211); t := SymTab.InvalidType END;
|
|
|
- 3581 IF t # SymTab.InvalidType THEN
|
|
|
- 3582 isL := SymTab.IsLongFamily(t);
|
|
|
- 3583 isR := SymTab.ClassOf(t) = SymTab.ClReal;
|
|
|
- 3584 folded := FALSE;
|
|
|
- 3585 IF (NOT isL) AND (NOT isR)
|
|
|
- 3586 AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
|
|
|
- 3587 IF op = SymTab.OpTimes THEN
|
|
|
- 3588 folded := QbeGen.Fold2(2, q, q2, qf)
|
|
|
- 3589 ELSIF op = SymTab.OpDiv THEN
|
|
|
- 3590 folded := QbeGen.Fold2(3, q, q2, qf)
|
|
|
- 3591 ELSIF op = SymTab.OpMod THEN
|
|
|
- 3592 folded := QbeGen.Fold2(4, q, q2, qf)
|
|
|
- 3593 END
|
|
|
- 3594 END;
|
|
|
- 3595 IF folded THEN QbeGen.CopyOp(qf, q)
|
|
|
- 3596 ELSE
|
|
|
- 3597 QbeGen.CopyOp("@", q)
|
|
|
- 3598 END
|
|
|
- 3599 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 3600 END
|
|
|
- 3601 END; .) }
|
|
|
- 3602 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
- 3603 MulOp<VAR op: INTEGER>
|
|
|
- 3604 = "*" (. op := SymTab.OpTimes; .)
|
|
|
- 3605 | "/" (. op := SymTab.OpSlash; .)
|
|
|
- 3606 | "DIV" (. op := SymTab.OpDiv; .)
|
|
|
- 3607 | "MOD" (. op := SymTab.OpMod; .)
|
|
|
- 3608 | ( "AND" | "&" ) (. op := SymTab.OpAnd; .) .
|
|
|
- 3609 Fact<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 3610 (. VAR s: ARRAY [0 .. 255] OF CHAR;
|
|
|
- 3611 et, dt, t2, st, ct2, et2:
|
|
|
- 3612 SymTab.TypeIndex;
|
|
|
- 3613 dk: INTEGER;
|
|
|
- 3614 qd, q2, sq, qa, qm0, qr, qt:
|
|
|
- 3615 QbeGen.QVal;
|
|
|
- 3616 qn, vn: SymTab.Name;
|
|
|
- 3617 vt: SymTab.TypeIndex;
|
|
|
- 3618 c1, c2: INTEGER;
|
|
|
- 3619 lo, hi: INTEGER;
|
|
|
- 3620 isMax: BOOLEAN;
|
|
|
- 3621 called, isHigh, sfx, isCh,
|
|
|
- 3622 isU, uok, isStr: BOOLEAN;
|
|
|
- 3623 ucp: INTEGER; astIsLit: BOOLEAN;
|
|
|
- 3624 astD: AST.Node;
|
|
|
- 3625 astCall: BOOLEAN;
|
|
|
- 3626 astNode, astNot: AST.Node;
|
|
|
- 3627 j: CARDINAL;
|
|
|
- 3628 astArg2: AST.Node;
|
|
|
- 3629 astBrace: AST.Node;
|
|
|
- 3630 astRes: AST.Node; mname: SymTab.Name; isM: BOOLEAN;
|
|
|
- 3631 isConvF: BOOLEAN;
|
|
|
- 3632 fi, fj: CARDINAL; .)
|
|
|
- 3633 = (. astIsLit := FALSE; .)
|
|
|
- 3634 ( "__LINE__" (. QbeGen.IntStr(M2S.line, q);
|
|
|
- 3635 astIsLit := TRUE;
|
|
|
- 3636 astCur := AST.MakeLeaf(
|
|
|
- 3637 AST.NkIntLit, q);
|
|
|
- 3638 t := SymTab.IntType(); .)
|
|
|
- 3639 | "__FUNCTION__" (. (* fold to the current procedure
|
|
|
- 3640 (module name at unit level) *)
|
|
|
- 3641 s[0] := '"'; fi := 1; fj := 0;
|
|
|
- 3642 IF curFun[0] = CHR(0) THEN
|
|
|
- 3643 WHILE (unitName[fj] # CHR(0))
|
|
|
- 3644 AND (fi < HIGH(s)) DO
|
|
|
- 3645 s[fi] := unitName[fj];
|
|
|
- 3646 INC(fi); INC(fj)
|
|
|
- 3647 END
|
|
|
- 3648 ELSE
|
|
|
- 3649 WHILE (curFun[fj] # CHR(0))
|
|
|
- 3650 AND (fi < HIGH(s)) DO
|
|
|
- 3651 s[fi] := curFun[fj];
|
|
|
- 3652 INC(fi); INC(fj)
|
|
|
- 3653 END
|
|
|
- 3654 END;
|
|
|
- 3655 s[fi] := '"';
|
|
|
- 3656 s[fi + 1] := CHR(0);
|
|
|
- 3657 astIsLit := TRUE;
|
|
|
- 3658 astCur := AST.MakeLeaf(
|
|
|
- 3659 AST.NkStrLit, s);
|
|
|
- 3660 t := SymTab.NewStr();
|
|
|
- 3661 QbeGen.DeclStr(s, q); .)
|
|
|
- 3662 | "__FILE__" (. (* fold to the quoted file name *)
|
|
|
- 3663 s[0] := '"'; fi := 1; fj := 0;
|
|
|
- 3664 WHILE (M2S.fileName[fj] # CHR(0))
|
|
|
- 3665 AND (fi < HIGH(s)) DO
|
|
|
- 3666 s[fi] := M2S.fileName[fj];
|
|
|
- 3667 INC(fi); INC(fj)
|
|
|
- 3668 END;
|
|
|
- 3669 s[fi] := '"';
|
|
|
- 3670 s[fi + 1] := CHR(0);
|
|
|
- 3671 astIsLit := TRUE;
|
|
|
- 3672 astCur := AST.MakeLeaf(
|
|
|
- 3673 AST.NkStrLit, s);
|
|
|
- 3674 t := SymTab.NewStr();
|
|
|
- 3675 QbeGen.DeclStr(s, q); .)
|
|
|
- 3676 | integer (. LexString(s);
|
|
|
- 3677 QbeGen.NormInt(s, q); astIsLit := TRUE; astCur := AST.MakeLeaf(AST.NkIntLit, s);
|
|
|
- 3678 t := SymTab.IntType(); .)
|
|
|
- 3679 | charConst (. LexString(s);
|
|
|
- 3680 QbeGen.NormLit(s, q, isCh);
|
|
|
- 3681 astIsLit := TRUE;
|
|
|
- 3682 astCur := AST.MakeLeaf(
|
|
|
- 3683 AST.NkCharLit, s);
|
|
|
- 3684 t := SymTab.CharType(); .)
|
|
|
- 3685 | real (. LexString(s);
|
|
|
- 3686 QbeGen.NormReal(s, q);
|
|
|
- 3687 astIsLit := TRUE;
|
|
|
- 3688 astCur := AST.MakeLeaf(
|
|
|
- 3689 AST.NkRealLit, s);
|
|
|
- 3690 t := SymTab.RealType(); .)
|
|
|
- 3691 | string (. LexString(s);
|
|
|
- 3692 astIsLit := TRUE;
|
|
|
- 3693 astCur := AST.MakeLeaf(
|
|
|
- 3694 AST.NkStrLit, s);
|
|
|
- 3695 IF SymTab.StrLen(s) = 3 THEN
|
|
|
- 3696 t := SymTab.CharType();
|
|
|
- 3697 QbeGen.IntStr(
|
|
|
- 3698 QbeGen.CharVal(s), q)
|
|
|
- 3699 ELSIF SymTab.StrLen(s) = 2 THEN
|
|
|
- 3700 (* empty string: a string value
|
|
|
- 3701 for arrays, 0 for CHAR *)
|
|
|
- 3702 t := SymTab.NewEmptyStr();
|
|
|
- 3703 QbeGen.DeclStr(s, q)
|
|
|
- 3704 ELSE t := SymTab.NewStr();
|
|
|
- 3705 QbeGen.DeclStr(s, q);
|
|
|
- 3706 (* a literal's value IS its
|
|
|
- 3707 static descriptor address *)
|
|
|
- 3708 END; .)
|
|
|
- 3709 | ustring (. LexString(s);
|
|
|
- 3710 astIsLit := TRUE;
|
|
|
- 3711 astCur := AST.MakeLeaf(
|
|
|
- 3712 AST.NkStrLit, s);
|
|
|
- 3713 QbeGen.DeclUStr(s, q, isU, ucp,
|
|
|
- 3714 uok);
|
|
|
- 3715 IF NOT uok THEN
|
|
|
- 3716 SemError(234);
|
|
|
- 3717 t := SymTab.InvalidType
|
|
|
- 3718 ELSIF isU THEN
|
|
|
- 3719 t := SymTab.UCharType();
|
|
|
- 3720 QbeGen.IntStr(ucp, q)
|
|
|
- 3721 ELSE
|
|
|
- 3722 t := SymTab.NewUStr();
|
|
|
- 3723 END; .)
|
|
|
- 3724 | Design<dt, dk, qd, qn, sfx> (. astD := astCur; astCall := FALSE; astBrace := AST.NoNode;
|
|
|
- 3725 astNArgs := 0; called := FALSE;
|
|
|
- 3726 t := dt;
|
|
|
- 3727 IF dk = SymTab.KindConst THEN
|
|
|
- 3728 QbeGen.CopyOp(qd, q)
|
|
|
- 3729 ELSE QbeGen.CopyOp("@", q)
|
|
|
- 3730 END; .)
|
|
|
- 3731 [ TypedBraceLit<dt, q> (. t := dt; astCall := TRUE;
|
|
|
- 3732 astBrace := astCur; .) ]
|
|
|
- 3733 [ ArgList<qn, dt, qd, TRUE, FALSE, methCls, ct2, q2, called>
|
|
|
- 3734 (. astCall := TRUE;
|
|
|
- 3735 IF (SymTab.SymKind(qn) = SymTab.KindType)
|
|
|
- 3736 OR (SymTab.SymKind(qn) = SymTab.KindPredef) THEN
|
|
|
- 3737 (* T(x): emit as the VAL builtin so Lower's
|
|
|
- 3738 conversion rules apply unchanged *)
|
|
|
- 3739 astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3740 AST.SetChild(astNode, 0,
|
|
|
- 3741 AST.MakeLeaf(AST.NkIdent, "VAL"));
|
|
|
- 3742 AST.SetChild(astNode, 1,
|
|
|
- 3743 AST.MakeLeaf(AST.NkIdent, qn));
|
|
|
- 3744 IF astNArgs = 1 THEN
|
|
|
- 3745 AST.SetChild(astNode, 2, astArgs[0])
|
|
|
- 3746 END;
|
|
|
- 3747 isConvF := TRUE
|
|
|
- 3748 ELSE astNode := AstCallNode(astD)
|
|
|
- 3749 END;
|
|
|
- 3750 astRes := astNode;
|
|
|
- 3751 t := ct2;
|
|
|
- 3752 QbeGen.CopyOp(q2, q);
|
|
|
- 3753 IF isConvF AND QbeGen.IsImm(convQ)
|
|
|
- 3754 AND OrdClass(convT) AND OrdClass(ct2) THEN
|
|
|
- 3755 QbeGen.CopyOp(convQ, q)
|
|
|
- 3756 END;
|
|
|
- 3757 sfx := FALSE; .)
|
|
|
- 3758 { ResultComp<t, q, sfx, astRes, mname, methCls, isM>
|
|
|
- 3759 [ (. astNArgs := 0; .)
|
|
|
- 3760 ArgList<mname, t, q, TRUE, FALSE, methCls, ct2, q2, called>
|
|
|
- 3761 (. astNode := AstCallNode(astRes);
|
|
|
- 3762 astRes := astNode;
|
|
|
- 3763 t := ct2;
|
|
|
- 3764 QbeGen.CopyOp(q2, q);
|
|
|
- 3765 sfx := FALSE; .) ] }
|
|
|
- 3766 (. IF sfx THEN
|
|
|
- 3767 IF t = SymTab.InvalidType THEN
|
|
|
- 3768 QbeGen.CopyOp("0", q)
|
|
|
- 3769 ELSIF (SymTab.ClassOf(t) #
|
|
|
- 3770 SymTab.ClRecord)
|
|
|
- 3771 AND (SymTab.ClassOf(t) # SymTab.ClSet)
|
|
|
- 3772 AND (SymTab.ClassOf(t) # SymTab.ClArray)
|
|
|
- 3773 AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN
|
|
|
- 3774 QbeGen.CopyOp("@", q)
|
|
|
- 3775 END
|
|
|
- 3776 END; .) ]
|
|
|
- 3777 (. IF called THEN
|
|
|
- 3778 astCur := astRes
|
|
|
- 3779 ELSIF astCall THEN
|
|
|
- 3780 astCur := astBrace
|
|
|
- 3781 ELSE astCur := astD
|
|
|
- 3782 END;
|
|
|
- 3783 astIsLit := TRUE;
|
|
|
- 3784 IF NOT called
|
|
|
- 3785 AND (dk = SymTab.KindProc) THEN
|
|
|
- 3786 (* bare zero-arg function
|
|
|
- 3787 call (parentheses may be
|
|
|
- 3788 omitted); a proper or
|
|
|
- 3789 parameterised proc here
|
|
|
- 3790 is 230 *)
|
|
|
- 3791 IF (SymTab.ProcNPar(qn) = 0)
|
|
|
- 3792 AND (SymTab.ProcRes(qn) # SymTab.InvalidType) THEN
|
|
|
- 3793 t := SymTab.ProcRes(qn);
|
|
|
- 3794 QbeGen.CopyOp("@", q);
|
|
|
- 3795 astCur := AST.MakeNode(AST.NkCall);
|
|
|
- 3796 AST.SetChild(astCur, 0, astD)
|
|
|
- 3797 ELSE
|
|
|
- 3798 t := SymTab.ProcTypeOf(qn);
|
|
|
- 3799 QbeGen.CopyOp("@", q)
|
|
|
- 3800 END
|
|
|
- 3801 END; .)
|
|
|
- 3802 | ( "HIGH" (. isHigh := TRUE; .)
|
|
|
- 3803 | ( "LEN" | "LENGTH" ) (. isHigh := FALSE; .) )
|
|
|
- 3804 "(" ( Design<dt, dk, qd, qn, sfx> (. isStr := FALSE;
|
|
|
- 3805 isU := FALSE; .)
|
|
|
- 3806 | string (. LexString(s); astCur := AST.MakeLeaf(AST.NkStrLit, s);
|
|
|
- 3807 isStr := TRUE;
|
|
|
- 3808 isU := FALSE;
|
|
|
- 3809 IF SymTab.StrLen(s) = 3 THEN
|
|
|
- 3810 dt := SymTab.CharType();
|
|
|
- 3811 QbeGen.IntStr(QbeGen.CharVal(s),
|
|
|
- 3812 qd)
|
|
|
- 3813 ELSE
|
|
|
- 3814 dt := SymTab.NewStr();
|
|
|
- 3815 QbeGen.DeclStr(s, qd);
|
|
|
- 3816 END;
|
|
|
- 3817 dk := -1;
|
|
|
- 3818 qn[0] := CHR(0); .)
|
|
|
- 3819 | ustring (. LexString(s); astCur := AST.MakeLeaf(AST.NkStrLit, s);
|
|
|
- 3820 QbeGen.DeclUStr(s, qd, isU, ucp,
|
|
|
- 3821 uok);
|
|
|
- 3822 isStr := FALSE;
|
|
|
- 3823 IF NOT uok THEN
|
|
|
- 3824 SemError(234);
|
|
|
- 3825 dt := SymTab.InvalidType
|
|
|
- 3826 ELSIF isU THEN
|
|
|
- 3827 (* one codepoint: a UCHAR;
|
|
|
- 3828 LEN is 1, HIGH is 0 *)
|
|
|
- 3829 dt := SymTab.UCharType();
|
|
|
- 3830 QbeGen.IntStr(ucp, qd)
|
|
|
- 3831 ELSE
|
|
|
- 3832 dt := SymTab.NewUStr();
|
|
|
- 3833 END;
|
|
|
- 3834 dk := -1;
|
|
|
- 3835 qn[0] := CHR(0); .) )
|
|
|
- 3836 ")"
|
|
|
- 3837 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3838 IF isHigh THEN AST.SetChild(astNode, 0,
|
|
|
- 3839 AST.MakeLeaf(AST.NkIdent, "HIGH"))
|
|
|
- 3840 ELSE AST.SetChild(astNode, 0,
|
|
|
- 3841 AST.MakeLeaf(AST.NkIdent, "LEN")) END;
|
|
|
- 3842 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3843 astCur := astNode; astIsLit := TRUE;
|
|
|
- 3844 IF (dt # SymTab.InvalidType)
|
|
|
- 3845 AND (SymTab.ClassOf(dt) = SymTab.ClUStr) THEN
|
|
|
- 3846 (* UString: the count is
|
|
|
- 3847 the descriptor header *)
|
|
|
- 3848 t := SymTab.IntType();
|
|
|
- 3849 QbeGen.CopyOp("@", q)
|
|
|
- 3850 ELSIF (dt # SymTab.InvalidType)
|
|
|
- 3851 AND (SymTab.ClassOf(dt) = SymTab.ClUChar) THEN
|
|
|
- 3852 (* single UCHAR codepoint *)
|
|
|
- 3853 IF isHigh THEN
|
|
|
- 3854 QbeGen.CopyOp("0", qr)
|
|
|
- 3855 ELSE
|
|
|
- 3856 QbeGen.CopyOp("1", qr)
|
|
|
- 3857 END;
|
|
|
- 3858 t := SymTab.IntType();
|
|
|
- 3859 QbeGen.CopyOp(qr, q)
|
|
|
- 3860 ELSIF isStr THEN
|
|
|
- 3861 (* fold: content length at
|
|
|
- 3862 compile time *)
|
|
|
- 3863 IF SymTab.StrLen(s) = 3 THEN
|
|
|
- 3864 c1 := 1
|
|
|
- 3865 ELSE
|
|
|
- 3866 c1 :=
|
|
|
- 3867 SymTab.StrLen(s) - 2
|
|
|
- 3868 END;
|
|
|
- 3869 IF isHigh THEN
|
|
|
- 3870 DEC(c1)
|
|
|
- 3871 END;
|
|
|
- 3872 QbeGen.IntStr(c1, qr);
|
|
|
- 3873 t := SymTab.IntType();
|
|
|
- 3874 QbeGen.CopyOp(qr, q)
|
|
|
- 3875 ELSIF dt = SymTab.InvalidType THEN
|
|
|
- 3876 t := SymTab.InvalidType;
|
|
|
- 3877 QbeGen.CopyOp("0", q)
|
|
|
- 3878 ELSIF SymTab.ClassOf(dt) =
|
|
|
- 3879 SymTab.ClStr THEN
|
|
|
- 3880 (* HIGH/LEN of a string
|
|
|
- 3881 CONST: its pooled literal
|
|
|
- 3882 knows its length *)
|
|
|
- 3883 IF QbeGen.StrLitLen(qd, c1) THEN
|
|
|
- 3884 IF isHigh THEN DEC(c1) END;
|
|
|
- 3885 QbeGen.IntStr(VAL(INTEGER, c1),
|
|
|
- 3886 qr);
|
|
|
- 3887 t := SymTab.IntType();
|
|
|
- 3888 QbeGen.CopyOp(qr, q)
|
|
|
- 3889 ELSE SemError(217);
|
|
|
- 3890 t := SymTab.InvalidType;
|
|
|
- 3891 QbeGen.CopyOp("0", q)
|
|
|
- 3892 END
|
|
|
- 3893 ELSIF SymTab.ClassOf(dt) #
|
|
|
- 3894 SymTab.ClArray THEN
|
|
|
- 3895 SemError(217);
|
|
|
- 3896 t := SymTab.InvalidType;
|
|
|
- 3897 QbeGen.CopyOp("0", q)
|
|
|
- 3898 ELSE
|
|
|
- 3899 IF SymTab.IsOpenArray(dt) THEN
|
|
|
- 3900 t := SymTab.IntType();
|
|
|
- 3901 QbeGen.CopyOp("@", q)
|
|
|
- 3902 ELSE
|
|
|
- 3903 IF isHigh THEN
|
|
|
- 3904 QbeGen.IntStr(
|
|
|
- 3905 SymTab.ArrayHi(dt), qr)
|
|
|
- 3906 ELSE
|
|
|
- 3907 QbeGen.IntStr(VAL(
|
|
|
- 3908 INTEGER,
|
|
|
- 3909 SymTab.ArrayLen(dt)),
|
|
|
- 3910 qr)
|
|
|
- 3911 END;
|
|
|
- 3912 t := SymTab.IntType();
|
|
|
- 3913 QbeGen.CopyOp(qr, q)
|
|
|
- 3914 END
|
|
|
- 3915 END; .)
|
|
|
- 3916 | ( "SIZE" | "TSIZE" ) "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
- 3917 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3918 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "SIZE"));
|
|
|
- 3919 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3920 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3921 (. IF dt = SymTab.InvalidType THEN
|
|
|
- 3922 t := SymTab.InvalidType;
|
|
|
- 3923 QbeGen.CopyOp("0", q)
|
|
|
- 3924 ELSE
|
|
|
- 3925 QbeGen.IntStr(VAL(INTEGER,
|
|
|
- 3926 SymTab.ObjectSize(dt)), q);
|
|
|
- 3927 t := SymTab.IntType()
|
|
|
- 3928 END; .)
|
|
|
- 3929 | ( "SHIFT" (. isMax := FALSE; .)
|
|
|
- 3930 | "ROTATE" (. isMax := TRUE; .) )
|
|
|
- 3931 "(" Expr<et, q> (. astArg2 := astCur; .) "," Expr<et2, q2> ")"
|
|
|
- 3932 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3933 IF isMax THEN AST.SetChild(astNode, 0,
|
|
|
- 3934 AST.MakeLeaf(AST.NkIdent, "ROTATE"))
|
|
|
- 3935 ELSE AST.SetChild(astNode, 0,
|
|
|
- 3936 AST.MakeLeaf(AST.NkIdent, "SHIFT")) END;
|
|
|
- 3937 IF astArg2 # AST.NoNode THEN AST.SetChild(astNode, 1, astArg2) END;
|
|
|
- 3938 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
- 3939 astCur := astNode; astIsLit := TRUE;
|
|
|
- 3940 (* set shift/rotate: isMax
|
|
|
- 3941 doubles as "rotate" *)
|
|
|
- 3942 IF (et # SymTab.InvalidType)
|
|
|
- 3943 AND (SymTab.ClassOf(et) =
|
|
|
- 3944 SymTab.ClSet) THEN
|
|
|
- 3945 t := et;
|
|
|
- 3946 QbeGen.CopyOp("@", q)
|
|
|
- 3947 ELSE SemError(230);
|
|
|
- 3948 t := SymTab.InvalidType;
|
|
|
- 3949 QbeGen.CopyOp("0", q)
|
|
|
- 3950 END; .)
|
|
|
- 3951 | ( "MIN" (. isMax := FALSE; .)
|
|
|
- 3952 | "MAX" (. isMax := TRUE; .) )
|
|
|
- 3953 "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
- 3954 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3955 IF isMax THEN AST.SetChild(astNode, 0,
|
|
|
- 3956 AST.MakeLeaf(AST.NkIdent, "MAX"))
|
|
|
- 3957 ELSE AST.SetChild(astNode, 0,
|
|
|
- 3958 AST.MakeLeaf(AST.NkIdent, "MIN")) END;
|
|
|
- 3959 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3960 astCur := astNode; astIsLit := TRUE;
|
|
|
- 3961 IF (dt # SymTab.InvalidType)
|
|
|
- 3962 AND (SymTab.ClassOf(dt) = SymTab.ClReal) THEN
|
|
|
- 3963 (* REAL/LONGREAL: the
|
|
|
- 3964 implementation bounds *)
|
|
|
- 3965 IF isMax THEN
|
|
|
- 3966 QbeGen.NormReal(
|
|
|
- 3967 "3.402823e38", q)
|
|
|
- 3968 ELSE QbeGen.NormReal(
|
|
|
- 3969 "-3.402823e38", q)
|
|
|
- 3970 END;
|
|
|
- 3971 t := SymTab.RealType()
|
|
|
- 3972 ELSIF (dt #
|
|
|
- 3973 SymTab.InvalidType)
|
|
|
- 3974 AND (SymTab.ClassOf(dt) =
|
|
|
- 3975 SymTab.ClLong) THEN
|
|
|
- 3976 IF isMax THEN
|
|
|
- 3977 QbeGen.CopyOp(
|
|
|
- 3978 "9223372036854775807", q)
|
|
|
- 3979 ELSE QbeGen.CopyOp(
|
|
|
- 3980 "-9223372036854775808", q)
|
|
|
- 3981 END;
|
|
|
- 3982 t := SymTab.LongType()
|
|
|
- 3983 ELSIF SymTab.TypeBounds(dt, lo,
|
|
|
- 3984 hi) THEN
|
|
|
- 3985 IF isMax THEN
|
|
|
- 3986 QbeGen.IntStr(hi, q)
|
|
|
- 3987 ELSE QbeGen.IntStr(lo, q)
|
|
|
- 3988 END;
|
|
|
- 3989 (* a set's bounds are those
|
|
|
- 3990 of its base type *)
|
|
|
- 3991 IF SymTab.ClassOf(dt) =
|
|
|
- 3992 SymTab.ClSet THEN
|
|
|
- 3993 t := SymTab.SetBase(dt)
|
|
|
- 3994 ELSE t := SymTab.IntType()
|
|
|
- 3995 END
|
|
|
- 3996 ELSE SemError(230);
|
|
|
- 3997 t := SymTab.InvalidType;
|
|
|
- 3998 QbeGen.CopyOp("0", q)
|
|
|
- 3999 END; .)
|
|
|
- 4000 | "ADR" "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
- 4001 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 4002 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ADR"));
|
|
|
- 4003 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 4004 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 4005 (. IF dt = SymTab.InvalidType THEN
|
|
|
- 4006 t := SymTab.InvalidType;
|
|
|
- 4007 QbeGen.CopyOp("0", q)
|
|
|
- 4008 ELSE
|
|
|
- 4009 IF sfx
|
|
|
- 4010 OR (dk = SymTab.KindVar)
|
|
|
- 4011 OR (dk = SymTab.KindParam) THEN
|
|
|
- 4012 QbeGen.CopyOp("@", q)
|
|
|
- 4013 ELSE SemError(230);
|
|
|
- 4014 QbeGen.CopyOp("0", q)
|
|
|
- 4015 END;
|
|
|
- 4016 t := SymTab.AddrType()
|
|
|
- 4017 END; .)
|
|
|
- 4018 | "CHR" "(" Expr<et, q> ")"
|
|
|
- 4019 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 4020 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CHR"));
|
|
|
- 4021 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 4022 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 4023 (. IF (et # SymTab.InvalidType)
|
|
|
- 4024 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
- 4025 SemError(211) END;
|
|
|
- 4026 t := SymTab.CharType(); .)
|
|
|
- 4027 | "ORD" "(" Expr<et, q> ")"
|
|
|
- 4028 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 4029 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ORD"));
|
|
|
- 4030 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 4031 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 4032 (. IF et # SymTab.InvalidType THEN
|
|
|
- 4033 IF (SymTab.ClassOf(et) #
|
|
|
- 4034 SymTab.ClChar)
|
|
|
- 4035 AND (SymTab.ClassOf(et) #
|
|
|
- 4036 SymTab.ClBool)
|
|
|
- 4037 AND (SymTab.ClassOf(et) #
|
|
|
- 4038 SymTab.ClEnum)
|
|
|
- 4039 AND NOT SymTab.IsIntFamily(et)
|
|
|
- 4040 AND NOT SymTab.IsPackedSet(et) THEN
|
|
|
- 4041 SemError(211) END
|
|
|
- 4042 END;
|
|
|
- 4043 t := SymTab.IntType(); .)
|
|
|
- 4044 | "CAP" "(" Expr<et, q> ")"
|
|
|
- 4045 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 4046 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CAP"));
|
|
|
- 4047 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 4048 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 4049 (. IF QbeGen.IsImm(q)
|
|
|
- 4050 AND SymTab.ConstInt(q, lo) THEN
|
|
|
- 4051 IF (lo >= VAL(INTEGER, ORD("a"))) AND (lo <= VAL(INTEGER, ORD("z"))) THEN lo := lo - 32 END;
|
|
|
- 4052 QbeGen.IntStr(lo, q)
|
|
|
- 4053 ELSE QbeGen.CopyOp("@", q)
|
|
|
- 4054 END;
|
|
|
- 4055 t := SymTab.CharType(); .)
|
|
|
- 4056 | "UCHR" "(" Expr<et, q> ")"
|
|
|
- 4057 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 4058 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "UCHR"));
|
|
|
- 4059 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 4060 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 4061 (. (* UCHR: the UCHAR constructor.
|
|
|
- 4062 CHAR -> UCHAR (identity);
|
|
|
- 4063 INTEGER familly -> UCHAR
|
|
|
- 4064 (codepoint value). *)
|
|
|
- 4065 IF (et # SymTab.InvalidType)
|
|
|
- 4066 AND (SymTab.ClassOf(et) # SymTab.ClChar)
|
|
|
- 4067 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
- 4068 SemError(211) END;
|
|
|
- 4069 t := SymTab.UCharType(); .)
|
|
|
- 4070 | "CHR8" "(" Expr<et, q> ")"
|
|
|
- 4071 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 4072 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CHR8"));
|
|
|
- 4073 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 4074 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 4075 (. IF (et # SymTab.InvalidType)
|
|
|
- 4076 AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
|
|
|
- 4077 SemError(211) END;
|
|
|
- 4078 t := SymTab.CharType(); .)
|
|
|
- 4079 | "UORD" "(" Expr<et, q> ")"
|
|
|
- 4080 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 4081 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "UORD"));
|
|
|
- 4082 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 4083 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 4084 (. (* UORD(u): the codepoint as a
|
|
|
- 4085 32-bit ordinal (INTEGER),
|
|
|
- 4086 cf. ORD for CHAR. *)
|
|
|
- 4087 IF (et # SymTab.InvalidType)
|
|
|
- 4088 AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
|
|
|
- 4089 SemError(211) END;
|
|
|
- 4090 t := SymTab.IntType(); .)
|
|
|
- 4091 | "ABS" "(" Expr<et, q> ")"
|
|
|
- 4092 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 4093 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ABS"));
|
|
|
- 4094 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 4095 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 4096 (. IF (et # SymTab.InvalidType)
|
|
|
- 4097 AND NOT SymTab.IsIntFamily(et)
|
|
|
- 4098 AND (SymTab.ClassOf(et) #
|
|
|
- 4099 SymTab.ClReal) THEN
|
|
|
- 4100 SemError(211)
|
|
|
- 4101 ELSIF QbeGen.IsImm(q)
|
|
|
- 4102 AND SymTab.ConstInt(q, lo) THEN
|
|
|
- 4103 IF lo < 0 THEN lo := -lo END;
|
|
|
- 4104 QbeGen.IntStr(lo, q)
|
|
|
- 4105 ELSE QbeGen.CopyOp("@", q)
|
|
|
- 4106 END;
|
|
|
- 4107 t := et; .)
|
|
|
- 4108 | "ODD" "(" Expr<et, q> ")"
|
|
|
- 4109 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 4110 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ODD"));
|
|
|
- 4111 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 4112 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 4113 (. IF (et # SymTab.InvalidType)
|
|
|
- 4114 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
- 4115 SemError(211) END;
|
|
|
- 4116 t := SymTab.BoolType();
|
|
|
- 4117 IF QbeGen.IsImm(q)
|
|
|
- 4118 AND SymTab.ConstInt(q, lo) THEN
|
|
|
- 4119 IF (lo MOD 2) # 0 THEN
|
|
|
- 4120 QbeGen.CopyOp("1", q)
|
|
|
- 4121 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 4122 END
|
|
|
- 4123 ELSE QbeGen.CopyOp("@", q)
|
|
|
- 4124 END; .)
|
|
|
- 4125 | "TRUNC" "(" Expr<et, q> ")"
|
|
|
- 4126 (. (* TRUNC(x): real -> INTEGER, as the VAL builtin *)
|
|
|
- 4127 astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 4128 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "VAL"));
|
|
|
- 4129 AST.SetChild(astNode, 1, AST.MakeLeaf(AST.NkIdent, "INTEGER"));
|
|
|
- 4130 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
- 4131 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 4132 (. t := SymTab.IntType();
|
|
|
- 4133 QbeGen.CopyOp("@", q); .)
|
|
|
- 4134 | "FLOAT" "(" Expr<et, q> ")"
|
|
|
- 4135 (. (* FLOAT(i): integer -> REAL, as the VAL builtin *)
|
|
|
- 4136 astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 4137 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "VAL"));
|
|
|
- 4138 AST.SetChild(astNode, 1, AST.MakeLeaf(AST.NkIdent, "REAL"));
|
|
|
- 4139 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
- 4140 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 4141 (. t := SymTab.RealType();
|
|
|
- 4142 IF QbeGen.IsImm(q) AND SymTab.ConstInt(q, lo) THEN QbeGen.NormReal(q, qa); QbeGen.CopyOp(qa, q)
|
|
|
- 4143 ELSE QbeGen.CopyOp("@", q) END; .)
|
|
|
- 4144 | ( "VAL" | "CONVERT" | "CAST" ) "(" GetIdent<vn> (. astArg2 := AST.MakeLeaf(AST.NkIdent, vn); .) "," Expr<et, q> ")"
|
|
|
- 4145 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 4146 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "VAL"));
|
|
|
- 4147 IF astArg2 # AST.NoNode THEN AST.SetChild(astNode, 1, astArg2) END;
|
|
|
- 4148 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
- 4149 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 4150 (. IF NOT SymTab.Lookup(vn) THEN
|
|
|
- 4151 SemError(201);
|
|
|
- 4152 t := SymTab.InvalidType
|
|
|
- 4153 ELSE vt := SymTab.SymType(vn);
|
|
|
- 4154 IF vt = SymTab.InvalidType THEN
|
|
|
- 4155 t := SymTab.InvalidType
|
|
|
- 4156 ELSIF et =
|
|
|
- 4157 SymTab.InvalidType THEN
|
|
|
- 4158 t := vt
|
|
|
- 4159 ELSE
|
|
|
- 4160 c1 := SymTab.ClassOf(et);
|
|
|
- 4161 c2 := SymTab.ClassOf(vt);
|
|
|
- 4162 IF ((c1 = SymTab.ClInt)
|
|
|
- 4163 OR (c1 = SymTab.ClByte) OR (c1 = SymTab.ClSByte)
|
|
|
- 4164 OR (c1 = SymTab.ClWord16) OR (c1 = SymTab.ClSWord16))
|
|
|
- 4165 AND (c2 = SymTab.ClLong) THEN
|
|
|
- 4166 IF NOT QbeGen.IsImm(q) THEN QbeGen.WidenLong(q, qa); QbeGen.CopyOp(qa, q) END;
|
|
|
- 4167 t := vt
|
|
|
- 4168 ELSIF (c1 = SymTab.ClLong)
|
|
|
- 4169 AND ((c2 = SymTab.ClInt) OR (c2 = SymTab.ClByte)
|
|
|
- 4170 OR (c2 = SymTab.ClSByte) OR (c2 = SymTab.ClWord16)
|
|
|
- 4171 OR (c2 = SymTab.ClSWord16)) THEN
|
|
|
- 4172 IF NOT (QbeGen.IsImm(q) AND SymTab.ConstInt(q, lo)) THEN QbeGen.NarrowLong(q, qa); QbeGen.CopyOp(qa, q) END;
|
|
|
- 4173 t := vt
|
|
|
- 4174 ELSIF ((c1 = SymTab.ClInt)
|
|
|
- 4175 OR (c1 = SymTab.ClByte) OR (c1 = SymTab.ClSByte)
|
|
|
- 4176 OR (c1 = SymTab.ClWord16) OR (c1 = SymTab.ClSWord16))
|
|
|
- 4177 AND (c2 = SymTab.ClReal) THEN
|
|
|
- 4178 IF QbeGen.IsImm(q) AND SymTab.ConstInt(q, lo) THEN QbeGen.NormReal(q, qa) ELSE QbeGen.ConvIR(q, qa) END;
|
|
|
- 4179 QbeGen.CopyOp(qa, q);
|
|
|
- 4180 t := vt
|
|
|
- 4181 ELSIF (c1 = SymTab.ClLong)
|
|
|
- 4182 AND (c2 = SymTab.ClReal) THEN
|
|
|
- 4183 IF QbeGen.IsImm(q) AND SymTab.ConstInt(q, lo) THEN QbeGen.NormReal(q, qa) ELSE QbeGen.ConvLR(q, qa) END;
|
|
|
- 4184 QbeGen.CopyOp(qa, q);
|
|
|
- 4185 t := vt
|
|
|
- 4186 ELSIF (c1 = SymTab.ClReal)
|
|
|
- 4187 AND ((c2 = SymTab.ClInt) OR (c2 = SymTab.ClByte)
|
|
|
- 4188 OR (c2 = SymTab.ClSByte) OR (c2 = SymTab.ClWord16)
|
|
|
- 4189 OR (c2 = SymTab.ClSWord16)) THEN
|
|
|
- 4190 QbeGen.ConvRI(q, qa);
|
|
|
- 4191 QbeGen.CopyOp(qa, q);
|
|
|
- 4192 t := vt
|
|
|
- 4193 ELSIF (c1 = SymTab.ClReal)
|
|
|
- 4194 AND (c2 = SymTab.ClLong) THEN
|
|
|
- 4195 QbeGen.ConvRL(q, qa);
|
|
|
- 4196 QbeGen.CopyOp(qa, q);
|
|
|
- 4197 t := vt
|
|
|
- 4198 ELSIF (c1 = SymTab.ClLong)
|
|
|
- 4199 AND (c2 = SymTab.ClLong) THEN
|
|
|
- 4200 t := vt
|
|
|
- 4201 ELSIF ((c1 = SymTab.ClInt)
|
|
|
- 4202 OR (c1 =
|
|
|
- 4203 SymTab.ClChar)
|
|
|
- 4204 OR (c1 =
|
|
|
- 4205 SymTab.ClBool)
|
|
|
- 4206 OR (c1 =
|
|
|
- 4207 SymTab.ClByte)
|
|
|
- 4208 OR (c1 =
|
|
|
- 4209 SymTab.ClSByte)
|
|
|
- 4210 OR (c1 =
|
|
|
- 4211 SymTab.ClWord16)
|
|
|
- 4212 OR (c1 =
|
|
|
- 4213 SymTab.ClSWord16)
|
|
|
- 4214 OR (c1 =
|
|
|
- 4215 SymTab.ClEnum))
|
|
|
- 4216 AND ((c2 = SymTab.ClInt)
|
|
|
- 4217 OR (c2 =
|
|
|
- 4218 SymTab.ClChar)
|
|
|
- 4219 OR (c2 =
|
|
|
- 4220 SymTab.ClBool)
|
|
|
- 4221 OR (c2 =
|
|
|
- 4222 SymTab.ClByte)
|
|
|
- 4223 OR (c2 =
|
|
|
- 4224 SymTab.ClSByte)
|
|
|
- 4225 OR (c2 =
|
|
|
- 4226 SymTab.ClWord16)
|
|
|
- 4227 OR (c2 =
|
|
|
- 4228 SymTab.ClSWord16)
|
|
|
- 4229 OR (c2 =
|
|
|
- 4230 SymTab.ClEnum)) THEN
|
|
|
- 4231 t := vt
|
|
|
- 4232 ELSIF (c1 = SymTab.ClPtr)
|
|
|
- 4233 AND (c2 = SymTab.ClPtr) THEN
|
|
|
- 4234 t := vt
|
|
|
- 4235 ELSIF ((c1 = SymTab.ClProc)
|
|
|
- 4236 AND (c2 = SymTab.ClProc))
|
|
|
- 4237 OR ((c1 = SymTab.ClProc) AND (c2 = SymTab.ClPtr))
|
|
|
- 4238 OR ((c1 = SymTab.ClPtr) AND (c2 = SymTab.ClProc)) THEN
|
|
|
- 4239 t := vt
|
|
|
- 4240 ELSIF (c1 = SymTab.ClReal)
|
|
|
- 4241 AND (c2 = SymTab.ClReal) THEN
|
|
|
- 4242 t := vt
|
|
|
- 4243 ELSIF ((c1 = SymTab.ClSet) AND (c2 = SymTab.ClInt))
|
|
|
- 4244 OR ((c1 = SymTab.ClInt) AND (c2 = SymTab.ClSet)) THEN
|
|
|
- 4245 (* a set <-> its machine word (BITSET) *)
|
|
|
- 4246 t := vt
|
|
|
- 4247 ELSE SemError(230);
|
|
|
- 4248 t := SymTab.InvalidType
|
|
|
- 4249 END
|
|
|
- 4250 END
|
|
|
- 4251 END; .)
|
|
|
- 4252 | "(" Expr<et, q> ")" (. t := et; astIsLit := TRUE; .)
|
|
|
- 4253 | SetLit<st, sq> (. astIsLit := TRUE; t := st;
|
|
|
- 4254 QbeGen.CopyOp(sq, q); .)
|
|
|
- 4255 | ( "NOT" | "~" ) Fact<t2, q2> (. astNot := astCur;
|
|
|
- 4256 IF SymTab.BoolCheck(t2) THEN
|
|
|
- 4257 t := SymTab.BoolType()
|
|
|
- 4258 ELSE SemError(212);
|
|
|
- 4259 t := SymTab.InvalidType END;
|
|
|
- 4260 IF t # SymTab.InvalidType THEN
|
|
|
- 4261 QbeGen.CopyOp("@", q)
|
|
|
- 4262 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 4263 END;
|
|
|
- 4264 astIsLit := TRUE;
|
|
|
- 4265 astCur := AST.MakeUn(
|
|
|
- 4266 AST.NkUnary, AST.OpNot, astNot); .)
|
|
|
- 4267 )
|
|
|
- 4268 (. IF NOT astIsLit THEN astCur := AST.NoNode END; .)
|
|
|
- 4269 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
- 4270 (* Set literals are SET OF [0..255] (8 words); elements validated
|
|
|
- 4271 0..255 statically when foldable (222 otherwise), runtime trap
|
|
|
- 4272 for computed elements. Ranges always lower via SetRange. *)
|
|
|
- 4273 SetLit<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 4274 (. VAR astNode: AST.Node; .)
|
|
|
- 4275 = "{" (. t := SymTab.NewSet(
|
|
|
- 4276 SymTab.NewSubR(0, 255));
|
|
|
- 4277 astNode := AST.MakeNode(AST.NkSetLit);
|
|
|
- 4278 QbeGen.NewSetTemp(8, q);
|
|
|
- 4279 QbeGen.SetZero(q, 8); .)
|
|
|
- 4280 [ SetElem<t, q, astNode> { "," SetElem<t, q, astNode> } ]
|
|
|
- 4281 "}" (. astCur := astNode; .) .
|
|
|
- 4282 (* Typed brace constructor: TypeName{ elems } — BITSET{0} (a set)
|
|
|
- 4283 or ArrayName{...} (an array constructor, GNU Modula-2). The
|
|
|
- 4284 declared type sets the width (set) or element type (array). *)
|
|
|
- 4285 TypedBraceLit<vt: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 4286 (. VAR nw: CARDINAL;
|
|
|
- 4287 astNode, astTail: AST.Node;
|
|
|
- 4288 savedCls: INTEGER; .)
|
|
|
- 4289 = "{" (. savedCls := braceCls;
|
|
|
- 4290 astNode := AST.MakeNode(AST.NkBraceLit);
|
|
|
- 4291 AST.SetTy(astNode, vt);
|
|
|
- 4292 astTail := astNode;
|
|
|
- 4293 IF vt = SymTab.InvalidType THEN
|
|
|
- 4294 braceCls := -1
|
|
|
- 4295 ELSE braceCls :=
|
|
|
- 4296 SymTab.ClassOf(vt)
|
|
|
- 4297 END;
|
|
|
- 4298 IF braceCls = SymTab.ClSet THEN
|
|
|
- 4299 IF vt = SymTab.InvalidType THEN
|
|
|
- 4300 nw := 8
|
|
|
- 4301 ELSE nw := SymTab.SetWords(vt);
|
|
|
- 4302 IF nw = 0 THEN nw := 8 END
|
|
|
- 4303 END;
|
|
|
- 4304 QbeGen.NewSetTemp(nw, q);
|
|
|
- 4305 QbeGen.SetZero(q, nw)
|
|
|
- 4306 ELSIF (braceCls =
|
|
|
- 4307 SymTab.ClArray)
|
|
|
- 4308 OR (braceCls =
|
|
|
- 4309 SymTab.ClRecord)
|
|
|
- 4310 OR (braceCls =
|
|
|
- 4311 SymTab.ClClass) THEN
|
|
|
- 4312 QbeGen.CtorBegin(vt)
|
|
|
- 4313 ELSE
|
|
|
- 4314 IF vt # SymTab.InvalidType THEN
|
|
|
- 4315 SemError(230) END;
|
|
|
- 4316 braceCls := -1
|
|
|
- 4317 END; .)
|
|
|
- 4318 [ BraceElem<vt, q, astNode, astTail>
|
|
|
- 4319 { "," BraceElem<vt, q, astNode, astTail> } ]
|
|
|
- 4320 "}" (. IF (braceCls = SymTab.ClArray)
|
|
|
- 4321 OR (braceCls =
|
|
|
- 4322 SymTab.ClRecord)
|
|
|
- 4323 OR (braceCls =
|
|
|
- 4324 SymTab.ClClass) THEN
|
|
|
- 4325 QbeGen.CtorEnd(q)
|
|
|
- 4326 ELSIF braceCls # SymTab.ClSet THEN
|
|
|
- 4327 QbeGen.CopyOp("0", q)
|
|
|
- 4328 END;
|
|
|
- 4329 braceCls := savedCls; .)
|
|
|
- 4330 (. astCur := astNode; .) .
|
|
|
- 4331 BraceElem<vt: SymTab.TypeIndex; VAR sq: QbeGen.QVal;
|
|
|
- 4332 VAR node, tail: AST.Node>
|
|
|
- 4333 (. VAR et, et2: SymTab.TypeIndex;
|
|
|
- 4334 qe, q2: QbeGen.QVal;
|
|
|
- 4335 v, v2, reps, k: INTEGER;
|
|
|
- 4336 elem: SymTab.TypeIndex;
|
|
|
- 4337 lo: INTEGER;
|
|
|
- 4338 span: CARDINAL;
|
|
|
- 4339 cl, cl2: INTEGER;
|
|
|
- 4340 hasR, hasB: BOOLEAN;
|
|
|
- 4341 astEl: AST.Node; .)
|
|
|
- 4342 = (. hasR := FALSE; hasB := FALSE;
|
|
|
- 4343 reps := 1; .)
|
|
|
- 4344 Expr<et, qe> (. astEl := astCur; .)
|
|
|
- 4345 [ ".." Expr<et2, q2> (. astEl := AST.MakeBin(
|
|
|
- 4346 AST.NkSubrange, 0, astEl, astCur);
|
|
|
- 4347 hasR := TRUE; .) ]
|
|
|
- 4348 [ "BY" Expr<et2, q2> (. hasB := TRUE; .) ]
|
|
|
- 4349 (. IF braceCls = SymTab.ClSet THEN
|
|
|
- 4350 IF hasB THEN SemError(230) END;
|
|
|
- 4351 lo := SymTab.SetBaseLo(vt);
|
|
|
- 4352 span := SymTab.SetCount(vt);
|
|
|
- 4353 IF (et = SymTab.InvalidType)
|
|
|
- 4354 OR (hasR AND (et2 =
|
|
|
- 4355 SymTab.InvalidType)) THEN
|
|
|
- 4356 ELSE cl :=
|
|
|
- 4357 SymTab.ClassOf(et);
|
|
|
- 4358 IF hasR THEN
|
|
|
- 4359 cl2 :=
|
|
|
- 4360 SymTab.ClassOf(et2)
|
|
|
- 4361 ELSE cl2 := SymTab.ClInt
|
|
|
- 4362 END;
|
|
|
- 4363 IF NOT SymTab.SetElemClassOk(cl)
|
|
|
- 4364 OR (hasR AND NOT
|
|
|
- 4365 SymTab.SetElemClassOk(cl2))
|
|
|
- 4366 THEN
|
|
|
- 4367 SemError(222)
|
|
|
- 4368 ELSIF hasR
|
|
|
- 4369 AND SymTab.ConstInt(qe, v)
|
|
|
- 4370 AND SymTab.ConstInt(q2,
|
|
|
- 4371 v2)
|
|
|
- 4372 AND ((v < lo)
|
|
|
- 4373 OR (v2 < lo)
|
|
|
- 4374 OR (v >= lo +
|
|
|
- 4375 VAL(INTEGER, span))
|
|
|
- 4376 OR (v2 >= lo +
|
|
|
- 4377 VAL(INTEGER, span))
|
|
|
- 4378 OR (v > v2)) THEN
|
|
|
- 4379 SemError(222)
|
|
|
- 4380 ELSIF hasR THEN
|
|
|
- 4381 QbeGen.SetRange(sq, qe, q2,
|
|
|
- 4382 lo, span)
|
|
|
- 4383 ELSIF SymTab.ConstInt(qe,
|
|
|
- 4384 v)
|
|
|
- 4385 AND ((v < lo)
|
|
|
- 4386 OR (v >= lo +
|
|
|
- 4387 VAL(INTEGER,
|
|
|
- 4388 span))) THEN
|
|
|
- 4389 SemError(222)
|
|
|
- 4390 ELSE QbeGen.SetBit(sq, qe,
|
|
|
- 4391 lo, span)
|
|
|
- 4392 END
|
|
|
- 4393 END
|
|
|
- 4394 ELSIF (braceCls = SymTab.ClArray)
|
|
|
- 4395 OR (braceCls =
|
|
|
- 4396 SymTab.ClRecord)
|
|
|
- 4397 OR (braceCls =
|
|
|
- 4398 SymTab.ClClass) THEN
|
|
|
- 4399 IF hasR THEN SemError(230) END;
|
|
|
- 4400 reps := 1;
|
|
|
- 4401 IF hasB THEN
|
|
|
- 4402 IF SymTab.ConstInt(q2, v2)
|
|
|
- 4403 AND (v2 >= 1) THEN
|
|
|
- 4404 reps := v2
|
|
|
- 4405 ELSE SemError(230)
|
|
|
- 4406 END
|
|
|
- 4407 END;
|
|
|
- 4408 k := 0;
|
|
|
- 4409 WHILE k < reps DO
|
|
|
- 4410 QbeGen.CtorElem(qe);
|
|
|
- 4411 INC(k)
|
|
|
- 4412 END
|
|
|
- 4413 END; .)
|
|
|
- 4414 (. (* the BY form repeats the
|
|
|
- 4415 element; keep the AST in
|
|
|
- 4416 step with CtorElem *)
|
|
|
- 4417 k := 0;
|
|
|
- 4418 WHILE k < reps DO
|
|
|
- 4419 AstAppend(AST.NkBlock,
|
|
|
- 4420 node, tail, astEl);
|
|
|
- 4421 INC(k)
|
|
|
- 4422 END; .) .
|
|
|
- 4423 SetElem<st: SymTab.TypeIndex; sq: QbeGen.QVal; node: AST.Node> (. VAR et, et2: SymTab.TypeIndex;
|
|
|
- 4424 qe, q2: QbeGen.QVal;
|
|
|
- 4425 v, v2: INTEGER;
|
|
|
- 4426 lo: INTEGER;
|
|
|
- 4427 span: CARDINAL;
|
|
|
- 4428 cl, cl2: INTEGER;
|
|
|
- 4429 hasR: BOOLEAN;
|
|
|
- 4430 astEl: AST.Node; .)
|
|
|
- 4431 = (. hasR := FALSE; .)
|
|
|
- 4432 Expr<et, qe> (. astEl := astCur; .)
|
|
|
- 4433 [ ".." Expr<et2, q2> (. astEl := AST.MakeBin(
|
|
|
- 4434 AST.NkSubrange, 0, astEl, astCur);
|
|
|
- 4435 hasR := TRUE; .) ]
|
|
|
- 4436 (. lo := SymTab.SetBaseLo(st);
|
|
|
- 4437 span := SymTab.SetCount(st);
|
|
|
- 4438 IF (et = SymTab.InvalidType)
|
|
|
- 4439 OR (hasR AND (et2 =
|
|
|
- 4440 SymTab.InvalidType)) THEN
|
|
|
- 4441 ELSE cl :=
|
|
|
- 4442 SymTab.ClassOf(et);
|
|
|
- 4443 IF hasR THEN
|
|
|
- 4444 cl2 :=
|
|
|
- 4445 SymTab.ClassOf(et2)
|
|
|
- 4446 ELSE cl2 := SymTab.ClInt
|
|
|
- 4447 END;
|
|
|
- 4448 IF NOT SymTab.SetElemClassOk(cl)
|
|
|
- 4449 OR (hasR AND NOT
|
|
|
- 4450 SymTab.SetElemClassOk(cl2))
|
|
|
- 4451 THEN
|
|
|
- 4452 SemError(222)
|
|
|
- 4453 ELSIF hasR
|
|
|
- 4454 AND SymTab.ConstInt(qe, v)
|
|
|
- 4455 AND SymTab.ConstInt(q2,
|
|
|
- 4456 v2)
|
|
|
- 4457 AND ((v < lo)
|
|
|
- 4458 OR (v2 < lo)
|
|
|
- 4459 OR (v >= lo +
|
|
|
- 4460 VAL(INTEGER, span))
|
|
|
- 4461 OR (v2 >= lo +
|
|
|
- 4462 VAL(INTEGER, span))
|
|
|
- 4463 OR (v > v2)) THEN
|
|
|
- 4464 SemError(222)
|
|
|
- 4465 ELSIF hasR THEN
|
|
|
- 4466 QbeGen.SetRange(sq, qe, q2,
|
|
|
- 4467 lo, span)
|
|
|
- 4468 ELSIF SymTab.ConstInt(qe,
|
|
|
- 4469 v)
|
|
|
- 4470 AND ((v < lo)
|
|
|
- 4471 OR (v >= lo +
|
|
|
- 4472 VAL(INTEGER,
|
|
|
- 4473 span))) THEN
|
|
|
- 4474 SemError(222)
|
|
|
- 4475 ELSE QbeGen.SetBit(sq, qe,
|
|
|
- 4476 lo, span)
|
|
|
- 4477 END
|
|
|
- 4478 END; .)
|
|
|
- 4479 (. AST.SetChild(node,
|
|
|
- 4480 AST.NChild(node), astEl); .) .
|
|
|
- 4481 GetIdent<VAR n: SymTab.Name>
|
|
|
- 4482 = ident (. LexName(n); .) .
|
|
|
- 4483
|
|
|
- 4484 END M2.
|
|
|
+ 1798 ct := SymTab.NewClass();
|
|
|
+ 1799 SymTab.SetSymType(cn, ct);
|
|
|
+ 1800 SymTab.PushClassScope(ct);
|
|
|
+ 1801 astCls := AST.MakeNode(AST.NkClassDecl);
|
|
|
+ 1802 AST.SetChild(astCls, 0,
|
|
|
+ 1803 AST.MakeLeaf(AST.NkIdent, cn));
|
|
|
+ 1804 astClsP := AST.NoNode;
|
|
|
+ 1805 astClsPTail := AST.NoNode;
|
|
|
+ 1806 astClsF := AST.NoNode;
|
|
|
+ 1807 astClsFTail := AST.NoNode;
|
|
|
+ 1808 astClsM := AST.NoNode;
|
|
|
+ 1809 astClsMTail := AST.NoNode; .)
|
|
|
+ 1810 [ Parents<ct> ]
|
|
|
+ 1811 ";"
|
|
|
+ 1812 { ClassField<ct> ";" }
|
|
|
+ 1813 { MethodHeading<pn, SymTab.InvalidType> ";"
|
|
|
+ 1814 (. Lower.ScopeLeave;
|
|
|
+ 1815 SymTab.CloseProc;
|
|
|
+ 1816 QbeGen.AbortFunc; .) }
|
|
|
+ 1817 "END"
|
|
|
+ 1818 GetIdent<m2> (. IF NOT SymTab.Equal(cn, m2) THEN
|
|
|
+ 1819 SemError(202) END;
|
|
|
+ 1820 SymTab.LayoutClass(ct);
|
|
|
+ 1821 SymTab.PopScope;
|
|
|
+ 1822 AST.SetChild(astCls, 1, astClsP);
|
|
|
+ 1823 AST.SetChild(astCls, 2, astClsF);
|
|
|
+ 1824 AST.SetChild(astCls, 3, astClsM);
|
|
|
+ 1825 astDecl := astCls; .) .
|
|
|
+ 1826 Parents<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name; .)
|
|
|
+ 1827 = "(" Parent1<ct>
|
|
|
+ 1828 { "," GetIdent<p> (. SemError(230); .) }
|
|
|
+ 1829 ")" .
|
|
|
+ 1830 Parent1<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name;
|
|
|
+ 1831 pt: SymTab.TypeIndex; .)
|
|
|
+ 1832 = GetIdent<p> (. IF NOT SymTab.Lookup(p) THEN
|
|
|
+ 1833 SemError(201)
|
|
|
+ 1834 ELSE pt := SymTab.SymType(p);
|
|
|
+ 1835 IF SymTab.ClassOf(pt) #
|
|
|
+ 1836 SymTab.ClClass THEN
|
|
|
+ 1837 SemError(230)
|
|
|
+ 1838 ELSE SymTab.SetParent(ct, pt)
|
|
|
+ 1839 END
|
|
|
+ 1840 END;
|
|
|
+ 1841 AstAppend(AST.NkFieldDecl,
|
|
|
+ 1842 astClsP, astClsPTail,
|
|
|
+ 1843 AST.MakeLeaf(AST.NkIdent, p)); .) .
|
|
|
+ 1844 ClassField<ct: SymTab.TypeIndex> (. VAR n, rhs: SymTab.Name;
|
|
|
+ 1845 t: SymTab.TypeIndex;
|
|
|
+ 1846 astNode: AST.Node; .)
|
|
|
+ 1847 = GetIdent<n>
|
|
|
+ 1848 ( "=" GetIdent<rhs> (. IF NOT SymTab.Enter(n,
|
|
|
+ 1849 SymTab.KindConst) THEN
|
|
|
+ 1850 SemError(200) END;
|
|
|
+ 1851 astNode := AST.MakeNode(AST.NkConstDecl);
|
|
|
+ 1852 AST.SetChild(astNode, 0,
|
|
|
+ 1853 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
+ 1854 AST.SetChild(astNode, 1,
|
|
|
+ 1855 AST.MakeLeaf(AST.NkIdent, rhs));
|
|
|
+ 1856 AstAppend(AST.NkFieldDecl,
|
|
|
+ 1857 astClsF, astClsFTail, astNode);
|
|
|
+ 1858 IF SymTab.Lookup(rhs) THEN
|
|
|
+ 1859 SymTab.SetSymType(n,
|
|
|
+ 1860 SymTab.SymType(rhs))
|
|
|
+ 1861 END; .)
|
|
|
+ 1862 | (. IF NOT SymTab.FieldPending(ct,
|
|
|
+ 1863 n) THEN
|
|
|
+ 1864 SemError(200) END;
|
|
|
+ 1865 astNode := AST.MakeNode(AST.NkVarDecl);
|
|
|
+ 1866 AST.SetChild(astNode, 0,
|
|
|
+ 1867 AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
+ 1868 { "," GetIdent<n> (. IF NOT SymTab.FieldPending(ct,
|
|
|
+ 1869 n) THEN
|
|
|
+ 1870 SemError(200) END;
|
|
|
+ 1871 AST.SetChild(astNode,
|
|
|
+ 1872 AST.NChild(astNode),
|
|
|
+ 1873 AST.MakeLeaf(AST.NkIdent, n)); .) }
|
|
|
+ 1874 ":" Type<t, FALSE> (. SymTab.FixPendingF(ct, t);
|
|
|
+ 1875 AST.SetTy(astNode, t);
|
|
|
+ 1876 AstAppend(AST.NkFieldDecl,
|
|
|
+ 1877 astClsF, astClsFTail, astNode); .) ) .
|
|
|
+ 1878 MethodHeading<VAR pn: SymTab.Name; ct: SymTab.TypeIndex>
|
|
|
+ 1879 (. VAR wantVirt: BOOLEAN; .)
|
|
|
+ 1880 = (. wantVirt := FALSE; .)
|
|
|
+ 1881 [ "VIRTUAL" (. wantVirt := TRUE; .) ]
|
|
|
+ 1882 ProcHeading<pn, ct> (. IF wantVirt THEN
|
|
|
+ 1883 SymTab.MarkVirtual END;
|
|
|
+ 1884 astMethod := AST.MakeNode(AST.NkProcDecl);
|
|
|
+ 1885 AST.SetChild(astMethod, 0,
|
|
|
+ 1886 AST.MakeLeaf(AST.NkIdent, pn));
|
|
|
+ 1887 IF wantVirt THEN
|
|
|
+ 1888 AST.SetOp(astMethod, 3)
|
|
|
+ 1889 ELSE AST.SetOp(astMethod, 0)
|
|
|
+ 1890 END;
|
|
|
+ 1891 AstAppend(AST.NkFieldDecl,
|
|
|
+ 1892 astClsM, astClsMTail, astMethod); .) .
|
|
|
+ 1893 ClassImplRest (. VAR cn, m2: SymTab.Name;
|
|
|
+ 1894 ct: SymTab.TypeIndex;
|
|
|
+ 1895 astBody, astHandler: AST.Node;
|
|
|
+ 1896 hasExcept: BOOLEAN; .)
|
|
|
+ 1897 = GetIdent<cn> (. IF NOT SymTab.Lookup(cn) THEN
|
|
|
+ 1898 SemError(201);
|
|
|
+ 1899 ct := SymTab.InvalidType
|
|
|
+ 1900 ELSE ct := SymTab.SymType(cn);
|
|
|
+ 1901 IF SymTab.ClassOf(ct) #
|
|
|
+ 1902 SymTab.ClClass THEN
|
|
|
+ 1903 SemError(230);
|
|
|
+ 1904 ct := SymTab.InvalidType
|
|
|
+ 1905 END
|
|
|
+ 1906 END;
|
|
|
+ 1907 astCls := AST.MakeNode(AST.NkClassDecl);
|
|
|
+ 1908 AST.SetOp(astCls, 1);
|
|
|
+ 1909 AST.SetChild(astCls, 0,
|
|
|
+ 1910 AST.MakeLeaf(AST.NkIdent, cn));
|
|
|
+ 1911 astClsM := AST.NoNode;
|
|
|
+ 1912 astClsMTail := AST.NoNode;
|
|
|
+ 1913 astStmt := AST.NoNode;
|
|
|
+ 1914 inHandler := FALSE;
|
|
|
+ 1915 astHandler := AST.NoNode;
|
|
|
+ 1916 hasExcept := FALSE;
|
|
|
+ 1917 IF ct #
|
|
|
+ 1918 SymTab.InvalidType THEN
|
|
|
+ 1919 IF NOT SymTab.PushClassMembers(
|
|
|
+ 1920 ct) THEN
|
|
|
+ 1921 SemError(230) END;
|
|
|
+ 1922 SymTab.PushImplClass(ct)
|
|
|
+ 1923 END; .)
|
|
|
+ 1924 ";" { MethodImpl<ct> ";" }
|
|
|
+ 1925 (. astStmt := AST.NoNode; .)
|
|
|
+ 1926 [ "BEGIN" (. astStmt := AST.MakeNode(AST.NkBlock);
|
|
|
+ 1927 .)
|
|
|
+ 1928 [ StatSeq ] ]
|
|
|
+ 1929 (. astBody := astStmt; .)
|
|
|
+ 1930 [ "EXCEPT" (. (* M1: grammar/AST only; M2 removes
|
|
|
+ 1931 this 230 and adds codegen. *)
|
|
|
+ 1932 SemError(230);
|
|
|
+ 1933 hasExcept := TRUE;
|
|
|
+ 1934 inHandler := TRUE; .)
|
|
|
+ 1935 [ StatSeq ] (. astHandler := astStmt;
|
|
|
+ 1936 inHandler := FALSE .) ]
|
|
|
+ 1937 "END"
|
|
|
+ 1938 GetIdent<m2> (. IF NOT SymTab.Equal(cn, m2) THEN
|
|
|
+ 1939 SemError(202) END;
|
|
|
+ 1940 SymTab.PopImplClass;
|
|
|
+ 1941 SymTab.PopScope;
|
|
|
+ 1942 IF hasExcept THEN
|
|
|
+ 1943 astStmt := WrapExcept(astBody,
|
|
|
+ 1944 astHandler)
|
|
|
+ 1945 END;
|
|
|
+ 1946 AST.SetChild(astCls, 1, AST.NoNode);
|
|
|
+ 1947 AST.SetChild(astCls, 2, astStmt);
|
|
|
+ 1948 AST.SetChild(astCls, 3, astClsM);
|
|
|
+ 1949 astDecl := astCls; .) .
|
|
|
+ 1950 MethodImpl<ct: SymTab.TypeIndex> (. VAR pn: SymTab.Name;
|
|
|
+ 1951 thisQ: QbeGen.QVal;
|
|
|
+ 1952 methRes: SymTab.TypeIndex; .)
|
|
|
+ 1953 = MethodHeading<pn, ct> ";"
|
|
|
+ 1954 (. IF (ct #
|
|
|
+ 1955 SymTab.InvalidType)
|
|
|
+ 1956 AND NOT SymTab.MethodExists(ct,
|
|
|
+ 1957 pn) THEN
|
|
|
+ 1958 SemError(201) END; .)
|
|
|
+ 1959 ( "FORWARD" (. AST.SetOp(astMethod, 1);
|
|
|
+ 1960 SymTab.MarkFwd;
|
|
|
+ 1961 QbeGen.AbortFunc;
|
|
|
+ 1962 Lower.ScopeLeave;
|
|
|
+ 1963 SymTab.CloseProc; .)
|
|
|
+ 1964 | (.
|
|
|
+ 1965 (* bind the receiver: bare
|
|
|
+ 1966 field names resolve
|
|
|
+ 1967 against THIS *)
|
|
|
+ 1968 QbeGen.CopyOp("@", thisQ);
|
|
|
+ 1969 QbeGen.PushWith(thisQ); .)
|
|
|
+ 1970 Block<pn> (. AST.SetChild(astMethod, 1, astStmt);
|
|
|
+ 1971 AST.SetChild(astMethod, 2, astBlkDecls);
|
|
|
+ 1972 QbeGen.PopWith;
|
|
|
+ 1973 methRes := SymTab.CurRes();
|
|
|
+ 1974 Lower.ScopeLeave;
|
|
|
+ 1975 SymTab.CloseProc;
|
|
|
+ 1976 QbeGen.EndFunc(methRes); .) ) .
|
|
|
+ 1977 ConstBlock (. VAR astSeq, astTail: AST.Node; .)
|
|
|
+ 1978 = "CONST" (. astSeq := AST.NoNode;
|
|
|
+ 1979 astTail := AST.NoNode; .)
|
|
|
+ 1980 { ConstDecl ";" (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 1981 astSeq, astTail, astDecl); .) }
|
|
|
+ 1982 (. astDecl := astSeq; .) .
|
|
|
+ 1983 ConstDecl (. VAR n: SymTab.Name;
|
|
|
+ 1984 t: SymTab.TypeIndex;
|
|
|
+ 1985 qv: QbeGen.QVal;
|
|
|
+ 1986 cls: INTEGER;
|
|
|
+ 1987 mk: ARRAY [0 .. 15] OF CARDINAL;
|
|
|
+ 1988 mw: CARDINAL;
|
|
|
+ 1989 mlo: INTEGER;
|
|
|
+ 1990 astNode: AST.Node; .)
|
|
|
+ 1991 = GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
+ 1992 SymTab.KindConst) THEN
|
|
|
+ 1993 SemError(200) END; .)
|
|
|
+ 1994 "="
|
|
|
+ 1995 Expr<t, qv> (. astNode := AST.MakeNode(AST.NkConstDecl);
|
|
|
+ 1996 AST.SetChild(astNode, 0,
|
|
|
+ 1997 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
+ 1998 AST.SetChild(astNode, 1, astCur);
|
|
|
+ 1999 AST.SetTy(astNode, t);
|
|
|
+ 2000 astDecl := astNode;
|
|
|
+ 2001 Lower.NoteVar(n, SymTab.KindConst, t);
|
|
|
+ 2002 Lower.NoteConstVal(qv);
|
|
|
+ 2003 SymTab.SetSymType(n, t);
|
|
|
+ 2004 cls := SymTab.ClassOf(t);
|
|
|
+ 2005 IF cls = SymTab.ClSet THEN
|
|
|
+ 2006 (* a SET CONST needs static
|
|
|
+ 2007 data: fold its mask now
|
|
|
+ 2008 (the grammar sees the
|
|
|
+ 2009 element values) and let
|
|
|
+ 2010 Lower re-emit it *)
|
|
|
+ 2011 IF Lower.SetConstMaskOf(
|
|
|
+ 2012 AST.Child(astNode, 1),
|
|
|
+ 2013 mk, mw, mlo) THEN
|
|
|
+ 2014 Lower.NoteSetMask(n, mk, mw,
|
|
|
+ 2015 mlo);
|
|
|
+ 2016 SymTab.SetSymVal(n, qv)
|
|
|
+ 2017 ELSE
|
|
|
+ 2018 SemError(230)
|
|
|
+ 2019 END
|
|
|
+ 2020 ELSIF (cls = SymTab.ClArray)
|
|
|
+ 2021 OR (cls = SymTab.ClRecord)
|
|
|
+ 2022 OR (cls = SymTab.ClClass)
|
|
|
+ 2023 OR (cls = SymTab.ClStr)
|
|
|
+ 2024 OR (cls = SymTab.ClUStr) THEN
|
|
|
+ 2025 (* an aggregate/string
|
|
|
+ 2026 constant: qv is its
|
|
|
+ 2027 descriptor address; no
|
|
|
+ 2028 scalar data *)
|
|
|
+ 2029 SymTab.SetSymVal(n, qv)
|
|
|
+ 2030 ELSIF NOT QbeGen.IsImm(qv) THEN
|
|
|
+ 2031 SemError(230)
|
|
|
+ 2032 ELSE
|
|
|
+ 2033 SymTab.SetSymVal(n, qv);
|
|
|
+ 2034 END; .) .
|
|
|
+ 2035 VarBlock (. VAR astSeq, astTail: AST.Node; .)
|
|
|
+ 2036 = "VAR" (. astSeq := AST.NoNode;
|
|
|
+ 2037 astTail := AST.NoNode; .)
|
|
|
+ 2038 { VarDecl ";" (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 2039 astSeq, astTail, astDecl); .) }
|
|
|
+ 2040 (. astDecl := astSeq; .) .
|
|
|
+ 2041 VarDecl (. VAR nm: SymTab.Name;
|
|
|
+ 2042 t: SymTab.TypeIndex;
|
|
|
+ 2043 i: CARDINAL;
|
|
|
+ 2044 cls: INTEGER;
|
|
|
+ 2045 astNode, astTail: AST.Node; .)
|
|
|
+ 2046 = VarIdents ":"
|
|
|
+ 2047 Type<t, FALSE> (. astNode := AST.MakeNode(AST.NkVarDecl);
|
|
|
+ 2048 astTail := astNode;
|
|
|
+ 2049 i := 0;
|
|
|
+ 2050 WHILE i < SymTab.PendCount() DO
|
|
|
+ 2051 SymTab.PendName(i, nm);
|
|
|
+ 2052 Lower.NoteVar(nm, SymTab.KindVar, t);
|
|
|
+ 2053 (* chunked: a VAR list can
|
|
|
+ 2054 exceed AST.MaxChild *)
|
|
|
+ 2055 AstAppend(AST.NkBlock,
|
|
|
+ 2056 astNode, astTail,
|
|
|
+ 2057 AST.MakeLeaf(AST.NkIdent, nm));
|
|
|
+ 2058 INC(i)
|
|
|
+ 2059 END;
|
|
|
+ 2060 AST.SetTy(astNode, t);
|
|
|
+ 2061 astDecl := astNode;
|
|
|
+ 2062 cls := SymTab.ClassOf(t);
|
|
|
+ 2063 IF (t # SymTab.InvalidType)
|
|
|
+ 2064 AND NOT SymTab.IsUnresolved(t)
|
|
|
+ 2065 AND (cls # SymTab.ClInt)
|
|
|
+ 2066 AND (cls # SymTab.ClBool)
|
|
|
+ 2067 AND (cls # SymTab.ClChar)
|
|
|
+ 2068 AND (cls # SymTab.ClReal)
|
|
|
+ 2069 AND (cls # SymTab.ClArray)
|
|
|
+ 2070 AND (cls # SymTab.ClSet)
|
|
|
+ 2071 AND (cls # SymTab.ClRecord)
|
|
|
+ 2072 AND (cls # SymTab.ClPtr)
|
|
|
+ 2073 AND (cls # SymTab.ClLong)
|
|
|
+ 2074 AND (cls # SymTab.ClProc)
|
|
|
+ 2075 AND (cls # SymTab.ClUChar)
|
|
|
+ 2076 AND (cls # SymTab.ClUStr)
|
|
|
+ 2077 AND (cls # SymTab.ClEnum)
|
|
|
+ 2078 AND (cls # SymTab.ClByte)
|
|
|
+ 2079 AND (cls # SymTab.ClSByte)
|
|
|
+ 2080 AND (cls # SymTab.ClWord16)
|
|
|
+ 2081 AND (cls # SymTab.ClSWord16)
|
|
|
+ 2082 AND (cls # SymTab.ClClass) THEN
|
|
|
+ 2083 SemError(230) END;
|
|
|
+ 2084 IF QbeGen.LocFull() THEN
|
|
|
+ 2085 SemError(233) END;
|
|
|
+ 2086 i := 0;
|
|
|
+ 2087 IF SymTab.IsUnresolved(t)
|
|
|
+ 2088 AND NOT SymTab.InProc() THEN
|
|
|
+ 2089 (* a forward-typed global:
|
|
|
+ 2090 defer emission until the
|
|
|
+ 2091 TYPE block completes *)
|
|
|
+ 2092 AST.SetOp(astNode, 1);
|
|
|
+ 2093 WHILE i < SymTab.PendCount() DO
|
|
|
+ 2094 SymTab.PendName(i, nm);
|
|
|
+ 2095 IF nPendVar <=
|
|
|
+ 2096 HIGH(pendVarName) THEN
|
|
|
+ 2097 pendVarName[nPendVar] := nm;
|
|
|
+ 2098 pendVarT[nPendVar] := t;
|
|
|
+ 2099 INC(nPendVar)
|
|
|
+ 2100 END;
|
|
|
+ 2101 INC(i)
|
|
|
+ 2102 END
|
|
|
+ 2103 ELSE
|
|
|
+ 2104 WHILE i < SymTab.PendCount() DO
|
|
|
+ 2105 SymTab.PendName(i, nm);
|
|
|
+ 2106 INC(i)
|
|
|
+ 2107 END
|
|
|
+ 2108 END;
|
|
|
+ 2109 (* a plain VAR list, not a
|
|
|
+ 2110 heading: the signature
|
|
|
+ 2111 result is discarded *)
|
|
|
+ 2112 IF NOT SymTab.FixPending(t) THEN
|
|
|
+ 2113 END; .) .
|
|
|
+ 2114 VarIdents (. VAR n: SymTab.Name; .)
|
|
|
+ 2115 = GetIdent<n> (. IF NOT SymTab.EnterPending(n,
|
|
|
+ 2116 SymTab.KindVar) THEN
|
|
|
+ 2117 SemError(200) END; .)
|
|
|
+ 2118 { ","
|
|
|
+ 2119 GetIdent<n> (. IF NOT SymTab.EnterPending(n,
|
|
|
+ 2120 SymTab.KindVar) THEN
|
|
|
+ 2121 SemError(200) END; .) } .
|
|
|
+ 2122 ParIdents<isV: BOOLEAN> (. VAR n: SymTab.Name; .)
|
|
|
+ 2123 = GetIdent<n> (. IF NOT SymTab.EnterParam(n, isV) THEN
|
|
|
+ 2124 SemError(200) END; .)
|
|
|
+ 2125 { "," GetIdent<n> (. IF NOT SymTab.EnterParam(n, isV) THEN
|
|
|
+ 2126 SemError(200) END; .) } .
|
|
|
+ 2127 (* Procedure headings enter scopes/params/result and buffer the
|
|
|
+ 2128 QBE header; bodies lower to functions (4.1, module level only).
|
|
|
+ 2129 FORWARD marks; the body heading re-enters (signature compare
|
|
|
+ 2130 deferred). Nested procedures parse + check, lowering = 4.2. *)
|
|
|
+ 2131 (* gm2 declaration pragmas: __BUILTIN__ (definition module) and
|
|
|
+ 2132 __ATTRIBUTE__ __BUILTIN__ (( name )) (implementation). They
|
|
|
+ 2133 annotate C built-ins; V3 parses and ignores them. *)
|
|
|
+ 2134 ProcPragma
|
|
|
+ 2135 = "__BUILTIN__"
|
|
|
+ 2136 | "__ATTRIBUTE__" [ "__BUILTIN__" ] [ "(" "(" ident ")" ")" ] .
|
|
|
+ 2137
|
|
|
+ 2138 ProcHeading<VAR pn: SymTab.Name; methCls: SymTab.TypeIndex>
|
|
|
+ 2139 (. VAR t: SymTab.TypeIndex;
|
|
|
+ 2140 mg: QbeGen.QVal; .)
|
|
|
+ 2141 = "PROCEDURE"
|
|
|
+ 2142 [ ProcPragma ]
|
|
|
+ 2143 GetIdent<pn> (. IF methCls #
|
|
|
+ 2144 SymTab.InvalidType THEN
|
|
|
+ 2145 (* a method: resume the
|
|
|
+ 2146 declared symbol (reuse
|
|
|
+ 2147 its uid) *)
|
|
|
+ 2148 IF NOT SymTab.ResumeMethod(
|
|
|
+ 2149 methCls, pn) THEN
|
|
|
+ 2150 SemError(200) END
|
|
|
+ 2151 ELSIF NOT SymTab.EnterProc(pn) THEN
|
|
|
+ 2152 IF NOT SymTab.ReenterProc(pn) THEN
|
|
|
+ 2153 IF NOT SymTab.ResumeProc(pn) THEN
|
|
|
+ 2154 SemError(200) END
|
|
|
+ 2155 END
|
|
|
+ 2156 END;
|
|
|
+ 2157 Lower.ScopeEnter;
|
|
|
+ 2158 Lower.NoteProc(pn,
|
|
|
+ 2159 SymTab.ProcUid(pn),
|
|
|
+ 2160 SymTab.InvalidType,
|
|
|
+ 2161 SymTab.ProcDepthOf(pn),
|
|
|
+ 2162 FALSE);
|
|
|
+ 2163 QbeGen.BeginFunc("");
|
|
|
+ 2164 IF methCls #
|
|
|
+ 2165 SymTab.InvalidType THEN
|
|
|
+ 2166 (* hidden THIS receiver:
|
|
|
+ 2167 a VAR param of the
|
|
|
+ 2168 class type, pushed as
|
|
|
+ 2169 the WITH base *)
|
|
|
+ 2170 IF NOT SymTab.EnterThisParam(
|
|
|
+ 2171 methCls) THEN
|
|
|
+ 2172 SemError(200) END;
|
|
|
+ 2173 IF NOT QbeGen.FuncParam(
|
|
|
+ 2174 "THIS", TRUE,
|
|
|
+ 2175 methCls) THEN
|
|
|
+ 2176 SemError(233) END
|
|
|
+ 2177 END; .)
|
|
|
+ 2178 [ FormalParams ]
|
|
|
+ 2179 [ ":" ( TypeIdent<t> (. IF NOT SymTab.SetProcRes(t) THEN
|
|
|
+ 2180 SemError(235) END;
|
|
|
+ 2181 Lower.SetProcRes(t); .)
|
|
|
+ 2182 | "PROC" (. (* PROC result: the procedure
|
|
|
+ 2183 value type *)
|
|
|
+ 2184 IF NOT SymTab.SetProcRes(
|
|
|
+ 2185 SymTab.AddrType()) THEN
|
|
|
+ 2186 SemError(235) END;
|
|
|
+ 2187 Lower.SetProcRes(
|
|
|
+ 2188 SymTab.AddrType()); .) ) ] .
|
|
|
+ 2189 FormalParams
|
|
|
+ 2190 = "(" [ ParamSection { ";" ParamSection } ] ")" .
|
|
|
+ 2191 ParamSection (. VAR t: SymTab.TypeIndex;
|
|
|
+ 2192 nm: SymTab.Name;
|
|
|
+ 2193 i: CARDINAL;
|
|
|
+ 2194 isV: BOOLEAN; .)
|
|
|
+ 2195 = (. isV := FALSE; .)
|
|
|
+ 2196 [ "VAR" (. isV := TRUE; .) ]
|
|
|
+ 2197 ParIdents<isV> ":" Type<t, TRUE> (. i := 0;
|
|
|
+ 2198 WHILE i < SymTab.PendCount() DO
|
|
|
+ 2199 SymTab.PendName(i, nm);
|
|
|
+ 2200 Lower.NoteParam(nm, t, isV);
|
|
|
+ 2201 Lower.NoteVar(nm, SymTab.KindParam, t);
|
|
|
+ 2202 (* value open arrays are
|
|
|
+ 2203 passed as descriptor
|
|
|
+ 2204 addresses (no copy):
|
|
|
+ 2205 same representation as
|
|
|
+ 2206 VAR formals *)
|
|
|
+ 2207 IF NOT QbeGen.FuncParam(nm,
|
|
|
+ 2208 isV
|
|
|
+ 2209 OR SymTab.IsOpenArray(t),
|
|
|
+ 2210 t) THEN
|
|
|
+ 2211 SemError(233) END;
|
|
|
+ 2212 INC(i)
|
|
|
+ 2213 END;
|
|
|
+ 2214 IF NOT SymTab.FixPending(t) THEN
|
|
|
+ 2215 SemError(235) END; .) .
|
|
|
+ 2216 (* Nested procedures lower like top-level ones (4.2): the
|
|
|
+ 2217 static link gives them their parent's frame. Methods keep
|
|
|
+ 2218 parse-now/230-later. *)
|
|
|
+ 2219 ProcDecl (. VAR pn: SymTab.Name;
|
|
|
+ 2220 saveFun: SymTab.Name;
|
|
|
+ 2221 astNode: AST.Node; .)
|
|
|
+ 2222 = ProcHeading<pn, SymTab.InvalidType> ";"
|
|
|
+ 2223 (. astNode := AST.MakeNode(AST.NkProcDecl);
|
|
|
+ 2224 AST.SetOp(astNode, 0);
|
|
|
+ 2225 AST.SetChild(astNode, 0,
|
|
|
+ 2226 AST.MakeLeaf(AST.NkIdent, pn));
|
|
|
+ 2227 Lower.NoteProcNode(astNode); .)
|
|
|
+ 2228 ( "FORWARD" (. AST.SetOp(astNode, 1);
|
|
|
+ 2229 astDecl := astNode;
|
|
|
+ 2230 Lower.ScopeLeave;
|
|
|
+ 2231 SymTab.MarkFwd;
|
|
|
+ 2232 SymTab.CloseProc;
|
|
|
+ 2233 QbeGen.AbortFunc; .)
|
|
|
+ 2234 | "EXTERNAL" (. AST.SetOp(astNode, 2);
|
|
|
+ 2235 astDecl := astNode;
|
|
|
+ 2236 Lower.MarkProcExternal;
|
|
|
+ 2237 Lower.ScopeLeave;
|
|
|
+ 2238 SymTab.MarkExternal("");
|
|
|
+ 2239 SymTab.CloseProc;
|
|
|
+ 2240 QbeGen.AbortFunc; .)
|
|
|
+ 2241 |
|
|
|
+ 2242 (. allowDefer := TRUE; deferredBody := FALSE;
|
|
|
+ 2243 curProcNode := astNode;
|
|
|
+ 2244 saveFun := curFun;
|
|
|
+ 2245 curFun := pn; .)
|
|
|
+ 2246 Block<pn> (. curFun := saveFun;
|
|
|
+ 2247 IF deferredBody THEN
|
|
|
+ 2248 (* body skipped: close like
|
|
|
+ 2249 FORWARD (no body node) *)
|
|
|
+ 2250 astDecl := astNode;
|
|
|
+ 2251 Lower.ScopeLeave;
|
|
|
+ 2252 SymTab.CloseProc;
|
|
|
+ 2253 QbeGen.AbortFunc
|
|
|
+ 2254 ELSE
|
|
|
+ 2255 AST.SetChild(astNode, 1, astStmt);
|
|
|
+ 2256 AST.SetChild(astNode, 2, astBlkDecls);
|
|
|
+ 2257 astDecl := astNode;
|
|
|
+ 2258 Lower.ScopeLeave;
|
|
|
+ 2259 SymTab.CloseProc;
|
|
|
+ 2260 QbeGen.EndFunc(
|
|
|
+ 2261 SymTab.ProcRes(pn))
|
|
|
+ 2262 END; .) ) .
|
|
|
+ 2263 Block<pn: SymTab.Name> (. VAR m2: SymTab.Name; dfr: BOOLEAN;
|
|
|
+ 2264 astBody, astHandler: AST.Node;
|
|
|
+ 2265 hasExcept, saveHandler: BOOLEAN; .)
|
|
|
+ 2266 = (. dfr := FALSE;
|
|
|
+ 2267 saveHandler := inHandler;
|
|
|
+ 2268 inHandler := FALSE;
|
|
|
+ 2269 astHandler := AST.NoNode;
|
|
|
+ 2270 hasExcept := FALSE;
|
|
|
+ 2271 IF allowDefer AND twoPhaseParse
|
|
|
+ 2272 AND NOT repassing THEN
|
|
|
+ 2273 dfr := DeferSkip(pn)
|
|
|
+ 2274 END;
|
|
|
+ 2275 allowDefer := FALSE;
|
|
|
+ 2276 .)
|
|
|
+ 2277 DeclSeq (. astBlkDecls := astDecl;
|
|
|
+ 2278 astStmt := AST.NoNode;
|
|
|
+ 2279 nLab := 0; nGot := 0; .)
|
|
|
+ 2280 [ "BEGIN" (. (* an empty body is still a
|
|
|
+ 2281 body: mark it so Lower
|
|
|
+ 2282 does not read it as a
|
|
|
+ 2283 definition heading *)
|
|
|
+ 2284 IF NOT dfr THEN
|
|
|
+ 2285 IF astStmt = AST.NoNode THEN
|
|
|
+ 2286 astStmt :=
|
|
|
+ 2287 AST.MakeNode(AST.NkBlock)
|
|
|
+ 2288 END
|
|
|
+ 2289 END; .)
|
|
|
+ 2290 [ StatSeq ] ]
|
|
|
+ 2291 (. astBody := astStmt; .)
|
|
|
+ 2292 [ "EXCEPT" (. (* M1: grammar/AST only; M2 removes
|
|
|
+ 2293 this 230 and adds codegen. *)
|
|
|
+ 2294 SemError(230);
|
|
|
+ 2295 hasExcept := TRUE;
|
|
|
+ 2296 inHandler := TRUE; .)
|
|
|
+ 2297 [ StatSeq ] (. astHandler := astStmt;
|
|
|
+ 2298 inHandler := FALSE .) ]
|
|
|
+ 2299 "END"
|
|
|
+ 2300 GetIdent<m2> (. IF NOT SymTab.Equal(pn, m2) THEN
|
|
|
+ 2301 SemError(202) END;
|
|
|
+ 2302 inHandler := saveHandler;
|
|
|
+ 2303 IF hasExcept THEN
|
|
|
+ 2304 astStmt := WrapExcept(astBody,
|
|
|
+ 2305 astHandler)
|
|
|
+ 2306 END;
|
|
|
+ 2307 CheckGotos; .) .
|
|
|
+ 2308 (* Two-phase, phase 2 (milestone 2c): re-parse every deferred module-
|
|
|
+ 2309 level body once the unit's declarations are complete. Inlined at
|
|
|
+ 2310 both call sites because a stand-alone epsilon production is
|
|
|
+ 2311 "unreachable" to Coco/R (referenced only from actions). *)
|
|
|
+ 2312 StatSeq (. VAR astSeq, astTail: AST.Node; .)
|
|
|
+ 2313 = (. astSeq := AST.NoNode;
|
|
|
+ 2314 astTail := AST.NoNode; .)
|
|
|
+ 2315 Statement (. AstAppend(AST.NkBlock,
|
|
|
+ 2316 astSeq, astTail, astStmt); .)
|
|
|
+ 2317 { ";" [ Statement (. AstAppend(AST.NkBlock,
|
|
|
+ 2318 astSeq, astTail, astStmt); .) ] }
|
|
|
+ 2319 (. astStmt := astSeq; .) .
|
|
|
+ 2320 (* Trailing/empty statements (`a; ; b`, Coco/R's generated `;;`)
|
|
|
+ 2321 are accepted: the statement after ';' is optional. *)
|
|
|
+ 2322 Statement (. VAR lx: QbeGen.QVal; lxnm: SymTab.Name; .)
|
|
|
+ 2323 = (. astStmt := AST.NoNode; .)
|
|
|
+ 2324 ( AssOrCall
|
|
|
+ 2325 | IfStat
|
|
|
+ 2326 | WhileStat
|
|
|
+ 2327 | RepeatStat
|
|
|
+ 2328 | LoopStat
|
|
|
+ 2329 | ForStat
|
|
|
+ 2330 | CaseStat
|
|
|
+ 2331 | WithStat
|
|
|
+ 2332 | ReturnStat
|
|
|
+ 2333 | HaltStat
|
|
|
+ 2334 | NewStat
|
|
|
+ 2335 | DisposeStat
|
|
|
+ 2336 | IncDecStat
|
|
|
+ 2337 | InclExclStat
|
|
|
+ 2338 | "EXIT" (. IF NOT QbeGen.TopLoop(lx) THEN
|
|
|
+ 2339 SemError(230) END;
|
|
|
+ 2340 astStmt := AST.MakeNode(AST.NkExit); .)
|
|
|
+ 2341 | "RETRY" (. IF NOT inHandler THEN
|
|
|
+ 2342 SemError(237) END;
|
|
|
+ 2343 astStmt := AST.MakeNode(AST.NkRetry); .)
|
|
|
+ 2344 | "GOTO" GetIdent<lxnm> (. NoteGoto(lxnm);
|
|
|
+ 2345 astStmt := AST.MakeNode(AST.NkGoto);
|
|
|
+ 2346 AST.SetChild(astStmt, 0,
|
|
|
+ 2347 AST.MakeLeaf(AST.NkIdent, lxnm)); .) ) .
|
|
|
+ 2348 (* INCL(set, elem) / EXCL(set, elem): PIM set-element builtins. *)
|
|
|
+ 2349 InclExclStat (. VAR at, et2: SymTab.TypeIndex;
|
|
|
+ 2350 dk: INTEGER;
|
|
|
+ 2351 qd, qe: QbeGen.QVal;
|
|
|
+ 2352 qn: SymTab.Name;
|
|
|
+ 2353 sfx, isInc: BOOLEAN;
|
|
|
+ 2354 astNode, astD: AST.Node; .)
|
|
|
+ 2355 = ( "INCL" (. isInc := TRUE; .)
|
|
|
+ 2356 | "EXCL" (. isInc := FALSE; .) )
|
|
|
+ 2357 "(" Design<at, dk, qd, qn, sfx> (. astD := astCur; .) ","
|
|
|
+ 2358 Expr<et2, qe> ")"
|
|
|
+ 2359 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 2360 IF isInc THEN
|
|
|
+ 2361 AST.SetChild(astNode, 0,
|
|
|
+ 2362 AST.MakeLeaf(AST.NkIdent, "INCL"))
|
|
|
+ 2363 ELSE AST.SetChild(astNode, 0,
|
|
|
+ 2364 AST.MakeLeaf(AST.NkIdent, "EXCL"))
|
|
|
+ 2365 END;
|
|
|
+ 2366 IF astD # AST.NoNode THEN
|
|
|
+ 2367 AST.SetChild(astNode, 1, astD) END;
|
|
|
+ 2368 IF astCur # AST.NoNode THEN
|
|
|
+ 2369 AST.SetChild(astNode, 2, astCur) END;
|
|
|
+ 2370 astStmt := astNode; .)
|
|
|
+ 2371 (. IF (at # SymTab.InvalidType)
|
|
|
+ 2372 AND (SymTab.ClassOf(at) # SymTab.ClSet) THEN
|
|
|
+ 2373 SemError(222)
|
|
|
+ 2374 END; .) .
|
|
|
+ 2375 (* INC(v [,step]) / DEC(v [,step]) as builtin statements over an
|
|
|
+ 2376 integer designator. *)
|
|
|
+ 2377 IncDecStat (. VAR dt, et2: SymTab.TypeIndex;
|
|
|
+ 2378 dk: INTEGER;
|
|
|
+ 2379 qd, qv, qn2, qstep:
|
|
|
+ 2380 QbeGen.QVal;
|
|
|
+ 2381 qn: SymTab.Name;
|
|
|
+ 2382 sfx, isInc: BOOLEAN;
|
|
|
+ 2383 astNode, astD, astStep:
|
|
|
+ 2384 AST.Node; .)
|
|
|
+ 2385 = (. isInc := TRUE; .)
|
|
|
+ 2386 ( "INC" (. isInc := TRUE; .)
|
|
|
+ 2387 | "DEC" (. isInc := FALSE; .) )
|
|
|
+ 2388 "(" (. astStep := AST.NoNode; .)
|
|
|
+ 2389 Design<dt, dk, qd, qn, sfx> (. astD := astCur; .)
|
|
|
+ 2390 [ "," Expr<et2, qstep> (. astStep := astCur; .) ]
|
|
|
+ 2391 ")" (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 2392 IF isInc THEN
|
|
|
+ 2393 AST.SetChild(astNode, 0,
|
|
|
+ 2394 AST.MakeLeaf(AST.NkIdent, "INC"))
|
|
|
+ 2395 ELSE AST.SetChild(astNode, 0,
|
|
|
+ 2396 AST.MakeLeaf(AST.NkIdent, "DEC"))
|
|
|
+ 2397 END;
|
|
|
+ 2398 IF astD # AST.NoNode THEN
|
|
|
+ 2399 AST.SetChild(astNode, 1, astD) END;
|
|
|
+ 2400 IF astStep # AST.NoNode THEN
|
|
|
+ 2401 AST.SetChild(astNode, 2, astStep) END;
|
|
|
+ 2402 astStmt := astNode; .) (. IF dt = SymTab.InvalidType THEN
|
|
|
+ 2403 ELSIF (dk # SymTab.KindVar)
|
|
|
+ 2404 AND (dk # SymTab.KindParam)
|
|
|
+ 2405 AND (dk # SymTab.KindField) THEN
|
|
|
+ 2406 SemError(210)
|
|
|
+ 2407 ELSIF NOT SymTab.IsOrdinal(dt) THEN
|
|
|
+ 2408 SemError(211)
|
|
|
+ 2409 END; .) .
|
|
|
+ 2410 (* NEW/DISPOSE as builtin statements (no call syntax until step 4).
|
|
|
+ 2411 Targets are pointer designators; DISPOSE nils afterwards (safer
|
|
|
+ 2412 than Wirth-undefined; documented). DISPOSE is shallow. *)
|
|
|
+ 2413 NewStat (. VAR dt: SymTab.TypeIndex;
|
|
|
+ 2414 dk: INTEGER;
|
|
|
+ 2415 qd, qm: QbeGen.QVal;
|
|
|
+ 2416 qn: SymTab.Name;
|
|
|
+ 2417 sfx: BOOLEAN;
|
|
|
+ 2418 bt: SymTab.TypeIndex;
|
|
|
+ 2419 astNode, astD: AST.Node; .)
|
|
|
+ 2420 = "NEW" "(" Design<dt, dk, qd, qn, sfx> (. astD := astCur; .) ")"
|
|
|
+ 2421 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 2422 AST.SetChild(astNode, 0,
|
|
|
+ 2423 AST.MakeLeaf(AST.NkIdent, "NEW"));
|
|
|
+ 2424 IF astD # AST.NoNode THEN
|
|
|
+ 2425 AST.SetChild(astNode, 1, astD) END;
|
|
|
+ 2426 astStmt := astNode; .)
|
|
|
+ 2427 (. IF dt = SymTab.InvalidType THEN
|
|
|
+ 2428 ELSIF (dk # SymTab.KindVar)
|
|
|
+ 2429 AND (dk # SymTab.KindParam)
|
|
|
+ 2430 AND (dk # SymTab.KindField) THEN
|
|
|
+ 2431 SemError(210)
|
|
|
+ 2432 ELSIF SymTab.ClassOf(dt) #
|
|
|
+ 2433 SymTab.ClPtr THEN
|
|
|
+ 2434 SemError(219)
|
|
|
+ 2435 END; .) .
|
|
|
+ 2436 DisposeStat (. VAR dt: SymTab.TypeIndex;
|
|
|
+ 2437 dk: INTEGER;
|
|
|
+ 2438 qd, qv: QbeGen.QVal;
|
|
|
+ 2439 qn: SymTab.Name;
|
|
|
+ 2440 sfx: BOOLEAN;
|
|
|
+ 2441 astNode, astD: AST.Node; .)
|
|
|
+ 2442 = "DISPOSE" "(" Design<dt, dk, qd, qn, sfx> (. astD := astCur; .) ")"
|
|
|
+ 2443 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 2444 AST.SetChild(astNode, 0,
|
|
|
+ 2445 AST.MakeLeaf(AST.NkIdent, "DISPOSE"));
|
|
|
+ 2446 IF astD # AST.NoNode THEN
|
|
|
+ 2447 AST.SetChild(astNode, 1, astD) END;
|
|
|
+ 2448 astStmt := astNode; .)
|
|
|
+ 2449 (. IF dt = SymTab.InvalidType THEN
|
|
|
+ 2450 ELSIF (dk # SymTab.KindVar)
|
|
|
+ 2451 AND (dk # SymTab.KindParam)
|
|
|
+ 2452 AND (dk # SymTab.KindField) THEN
|
|
|
+ 2453 SemError(210)
|
|
|
+ 2454 ELSIF SymTab.ClassOf(dt) #
|
|
|
+ 2455 SymTab.ClPtr THEN
|
|
|
+ 2456 SemError(219)
|
|
|
+ 2457 END; .) .
|
|
|
+ 2458 (* WITH pushes each record's fields (inner wins) plus its base
|
|
|
+ 2459 address; field designators resolve through both stacks. *)
|
|
|
+ 2460 WithStat (. VAR nW: CARDINAL;
|
|
|
+ 2461 astNode: AST.Node; .)
|
|
|
+ 2462 = "WITH" (. nW := 0;
|
|
|
+ 2463 astNode := AST.MakeNode(AST.NkWith); .)
|
|
|
+ 2464 WithItem<nW, astNode> { "," WithItem<nW, astNode> }
|
|
|
+ 2465 "DO" (. astStmt := AST.NoNode; .)
|
|
|
+ 2466 [ StatSeq ] "END" (. AST.SetChild(astNode,
|
|
|
+ 2467 AST.NChild(astNode), astStmt);
|
|
|
+ 2468 astStmt := astNode;
|
|
|
+ 2469 WHILE nW > 0 DO
|
|
|
+ 2470 SymTab.PopScope;
|
|
|
+ 2471 QbeGen.PopWith;
|
|
|
+ 2472 DEC(nW)
|
|
|
+ 2473 END; .) .
|
|
|
+ 2474 WithItem<VAR nW: CARDINAL; wnode: AST.Node>
|
|
|
+ 2475 (. VAR dt: SymTab.TypeIndex;
|
|
|
+ 2476 dk: INTEGER;
|
|
|
+ 2477 qd, qe: QbeGen.QVal;
|
|
|
+ 2478 qn: SymTab.Name;
|
|
|
+ 2479 sfx: BOOLEAN; .)
|
|
|
+ 2480 = Design<dt, dk, qd, qn, sfx>
|
|
|
+ 2481 (. IF astCur # AST.NoNode THEN
|
|
|
+ 2482 AST.SetChild(wnode,
|
|
|
+ 2483 AST.NChild(wnode), astCur) END;
|
|
|
+ 2484 IF dt = SymTab.InvalidType THEN
|
|
|
+ 2485 ELSIF (SymTab.ClassOf(dt) #
|
|
|
+ 2486 SymTab.ClRecord)
|
|
|
+ 2487 AND (SymTab.ClassOf(dt) #
|
|
|
+ 2488 SymTab.ClClass) THEN
|
|
|
+ 2489 SemError(215)
|
|
|
+ 2490 ELSIF SymTab.PushRecord(dt) THEN
|
|
|
+ 2491 QbeGen.PushWith(qd);
|
|
|
+ 2492 INC(nW)
|
|
|
+ 2493 END; .) .
|
|
|
+ 2494 (* Assignment or procedure-statement call (4.1, module level).
|
|
|
+ 2495 Bare `P;` is a syntax error; function-as-statement is 233. *)
|
|
|
+ 2496 AssOrCall (. VAR dt, et: SymTab.TypeIndex;
|
|
|
+ 2497 dk: INTEGER;
|
|
|
+ 2498 qd, qe, qt, ql: QbeGen.QVal;
|
|
|
+ 2499 qn: SymTab.Name;
|
|
|
+ 2500 ct2, res0: SymTab.TypeIndex;
|
|
|
+ 2501 q2, mg0: QbeGen.QVal;
|
|
|
+ 2502 isR, conv, wconv: BOOLEAN;
|
|
|
+ 2503 called, sfx: BOOLEAN;
|
|
|
+ 2504 astLhs, astRes: AST.Node; mname: SymTab.Name; isM: BOOLEAN;
|
|
|
+ 2505 n: SymTab.Name; astLab, astNode: AST.Node; .)
|
|
|
+ 2506 = GetIdent<n>
|
|
|
+ 2507 ( ":" (. NoteLabel(n);
|
|
|
+ 2508 astNode := AST.MakeNode(AST.NkLabel);
|
|
|
+ 2509 AST.SetChild(astNode, 0,
|
|
|
+ 2510 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
+ 2511 astLab := AST.MakeNode(AST.NkBlock);
|
|
|
+ 2512 AST.SetChild(astLab, 0, astNode); .)
|
|
|
+ 2513 Statement (. IF astStmt # AST.NoNode THEN
|
|
|
+ 2514 AST.SetChild(astLab, 1, astStmt) END;
|
|
|
+ 2515 astStmt := astLab; .)
|
|
|
+ 2516 | DesignTail<n, dt, dk, qd, qn, sfx>
|
|
|
+ 2517 (. astLhs := astCur; astNArgs := 0; .)
|
|
|
+ 2518 ( ":="
|
|
|
+ 2519 Expr<et, qe> (. astStmt := AST.MakeBin(
|
|
|
+ 2520 AST.NkAssign, 0, astLhs, astCur);
|
|
|
+ 2521 IF (dt # SymTab.InvalidType)
|
|
|
+ 2522 AND (dk # SymTab.KindVar)
|
|
|
+ 2523 AND (dk # SymTab.KindParam)
|
|
|
+ 2524 AND (dk # SymTab.KindField) THEN
|
|
|
+ 2525 SemError(210)
|
|
|
+ 2526 ELSIF NOT SymTab.Assignable(et,
|
|
|
+ 2527 dt) THEN
|
|
|
+ 2528 SemError(210)
|
|
|
+ 2529 ELSIF (dt # SymTab.InvalidType)
|
|
|
+ 2530 AND (SymTab.ClassOf(dt) =
|
|
|
+ 2531 SymTab.ClClass) THEN
|
|
|
+ 2532 SemError(230) END;
|
|
|
+ 2533 isR := (dt #
|
|
|
+ 2534 SymTab.InvalidType)
|
|
|
+ 2535 AND (SymTab.ClassOf(dt)
|
|
|
+ 2536 = SymTab.ClReal);
|
|
|
+ 2537 conv := isR
|
|
|
+ 2538 AND SymTab.IsIntFamily(et);
|
|
|
+ 2539 wconv := (dt #
|
|
|
+ 2540 SymTab.InvalidType)
|
|
|
+ 2541 AND SymTab.IsLongFamily(dt)
|
|
|
+ 2542 AND SymTab.IsIntFamily(et);
|
|
|
+ 2543 IF ((dk = SymTab.KindVar)
|
|
|
+ 2544 OR (dk = SymTab.KindParam)
|
|
|
+ 2545 OR (dk = SymTab.KindField))
|
|
|
+ 2546 AND (dt # SymTab.InvalidType)
|
|
|
+ 2547 AND (et # SymTab.InvalidType)
|
|
|
+ 2548 AND (SymTab.ClassOf(dt) #
|
|
|
+ 2549 SymTab.ClClass) THEN
|
|
|
+ 2550 END; .)
|
|
|
+ 2551 | ArgList<qn, dt, qd, TRUE, TRUE, methCls, ct2, q2, called>
|
|
|
+ 2552 (. astRes := AstCallNode(astLhs);
|
|
|
+ 2553 sfx := FALSE; .)
|
|
|
+ 2554 ( { ResultComp<ct2, q2, sfx, astRes, mname, methCls, isM> }
|
|
|
+ 2555 ":=" Expr<et, qe> (. astStmt := AST.MakeBin(
|
|
|
+ 2556 AST.NkAssign, 0, astRes, astCur);
|
|
|
+ 2557 IF NOT sfx THEN
|
|
|
+ 2558 SemError(233)
|
|
|
+ 2559 ELSIF (ct2 # SymTab.InvalidType)
|
|
|
+ 2560 AND NOT SymTab.Assignable(et, ct2) THEN
|
|
|
+ 2561 SemError(210)
|
|
|
+ 2562 END; .)
|
|
|
+ 2563 | (. (* discarding the result of a
|
|
|
+ 2564 foreign C varargs call
|
|
|
+ 2565 (printf/snprintf) is accepted;
|
|
|
+ 2566 an ordinary Modula-2 function
|
|
|
+ 2567 used as a statement stays 233 *)
|
|
|
+ 2568 IF (ct2 # SymTab.InvalidType)
|
|
|
+ 2569 AND NOT SymTab.Varargs(qn) THEN
|
|
|
+ 2570 SemError(233) END;
|
|
|
+ 2571 astStmt := astRes; .) )
|
|
|
+ 2572 | (* bare `P;`: proper parameterless
|
|
|
+ 2573 procedure call; anything else
|
|
|
+ 2574 here is 233 (was a bare syntax
|
|
|
+ 2575 error before 4.2) *)
|
|
|
+ 2576 (. astStmt := AstCallNode(astLhs);
|
|
|
+ 2577 IF (dk = SymTab.KindProc)
|
|
|
+ 2578 AND NOT sfx THEN
|
|
|
+ 2579 res0 := SymTab.ProcRes(qn);
|
|
|
+ 2580 IF res0 #
|
|
|
+ 2581 SymTab.InvalidType THEN
|
|
|
+ 2582 SemError(233)
|
|
|
+ 2583 ELSIF SymTab.ProcNPar(qn) #
|
|
|
+ 2584 0 THEN
|
|
|
+ 2585 SemError(233)
|
|
|
+ 2586 END
|
|
|
+ 2587 ELSIF (dt # SymTab.InvalidType)
|
|
|
+ 2588 AND (SymTab.ClassOf(dt) = SymTab.ClProc) THEN
|
|
|
+ 2589 IF SymTab.ProcTypeRes(dt) #
|
|
|
+ 2590 SymTab.InvalidType THEN
|
|
|
+ 2591 SemError(233)
|
|
|
+ 2592 ELSIF SymTab.ProcTypeNPar(dt) #
|
|
|
+ 2593 0 THEN
|
|
|
+ 2594 SemError(233)
|
|
|
+ 2595 END
|
|
|
+ 2596 ELSE SemError(233)
|
|
|
+ 2597 END; .) ) ) .
|
|
|
+ 2598 (* Actual-parameter list shared by statement and expression calls.
|
|
|
+ 2599 want selects CallEnd's result handling; t/q carry the call
|
|
|
+ 2600 value (statement calls discard). Arity/type failures are 233;
|
|
|
+ 2601 evaluation code still emits so the .ssa stays assembleable. *)
|
|
|
+ 2602 ArgList<pn: SymTab.Name; pt: SymTab.TypeIndex; callee: QbeGen.QVal;
|
|
|
+ 2603 want: BOOLEAN; soft: BOOLEAN; methCls: SymTab.TypeIndex;
|
|
|
+ 2604 VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
|
|
|
+ 2605 VAR called: BOOLEAN> (. VAR i, np: CARDINAL;
|
|
|
+ 2606 vs: INTEGER;
|
|
|
+ 2607 res: SymTab.TypeIndex;
|
|
|
+ 2608 mg: QbeGen.QVal;
|
|
|
+ 2609 ok, ind, isMeth, va, isConv: BOOLEAN; .)
|
|
|
+ 2610 = "(" (. called := TRUE;
|
|
|
+ 2611 ok := TRUE;
|
|
|
+ 2612 ind := FALSE;
|
|
|
+ 2613 isConv := FALSE;
|
|
|
+ 2614 isMeth := methCls #
|
|
|
+ 2615 SymTab.InvalidType;
|
|
|
+ 2616 IF isMeth THEN
|
|
|
+ 2617 res := SymTab.ClassMethodRes(methCls, pn)
|
|
|
+ 2618 ELSIF SymTab.SymKind(pn) = SymTab.KindProc THEN
|
|
|
+ 2619 res := SymTab.ProcRes(pn)
|
|
|
+ 2620 ELSIF (SymTab.SymKind(pn) = SymTab.KindType)
|
|
|
+ 2621 OR (SymTab.SymKind(pn) = SymTab.KindPredef) THEN
|
|
|
+ 2622 (* ISO type conversion T(x):
|
|
|
+ 2623 one value, result is T *)
|
|
|
+ 2624 isConv := TRUE;
|
|
|
+ 2625 res := SymTab.SymType(pn)
|
|
|
+ 2626 ELSIF (pt # SymTab.InvalidType)
|
|
|
+ 2627 AND (SymTab.ClassOf(pt) = SymTab.ClProc) THEN
|
|
|
+ 2628 ind := TRUE;
|
|
|
+ 2629 res := SymTab.ProcTypeRes(pt)
|
|
|
+ 2630 ELSE SemError(233);
|
|
|
+ 2631 ok := FALSE;
|
|
|
+ 2632 res := SymTab.InvalidType
|
|
|
+ 2633 END;
|
|
|
+ 2634 i := 0; .)
|
|
|
+ 2635 [ ActParam<pn, pt, ind, methCls, i> (. INC(i); .)
|
|
|
+ 2636 { "," ActParam<pn, pt, ind, methCls, i> (. INC(i); .) } ]
|
|
|
+ 2637 ")" (. IF ok THEN
|
|
|
+ 2638 IF isConv THEN
|
|
|
+ 2639 (* a conversion takes
|
|
|
+ 2640 exactly one value *)
|
|
|
+ 2641 IF i # 1 THEN
|
|
|
+ 2642 SemError(233); ok := FALSE
|
|
|
+ 2643 END
|
|
|
+ 2644 ELSE
|
|
|
+ 2645 IF isMeth THEN
|
|
|
+ 2646 np := SymTab.ClassMethodNPar(
|
|
|
+ 2647 methCls, pn)
|
|
|
+ 2648 ELSIF ind THEN
|
|
|
+ 2649 np := SymTab.ProcTypeNPar(pt)
|
|
|
+ 2650 ELSE np := SymTab.ProcNPar(pn)
|
|
|
+ 2651 END;
|
|
|
+ 2652 va := (NOT isMeth) AND (NOT ind)
|
|
|
+ 2653 AND (SymTab.SymKind(pn) =
|
|
|
+ 2654 SymTab.KindProc)
|
|
|
+ 2655 AND SymTab.Varargs(pn);
|
|
|
+ 2656 IF (i # np) AND NOT va THEN
|
|
|
+ 2657 SemError(233); ok := FALSE
|
|
|
+ 2658 END
|
|
|
+ 2659 END
|
|
|
+ 2660 END;
|
|
|
+ 2661 IF NOT ok THEN
|
|
|
+ 2662 t := SymTab.InvalidType;
|
|
|
+ 2663 QbeGen.CopyOp("0", q)
|
|
|
+ 2664 ELSIF want THEN
|
|
|
+ 2665 IF res =
|
|
|
+ 2666 SymTab.InvalidType THEN
|
|
|
+ 2667 IF NOT soft THEN SemError(233) END;
|
|
|
+ 2668 t := SymTab.InvalidType;
|
|
|
+ 2669 QbeGen.CopyOp("0", q)
|
|
|
+ 2670 ELSE t := res;
|
|
|
+ 2671 QbeGen.CopyOp("@", q)
|
|
|
+ 2672 END
|
|
|
+ 2673 ELSE
|
|
|
+ 2674 (* a function call used as
|
|
|
+ 2675 a statement: allowed for
|
|
|
+ 2676 a foreign C varargs proc
|
|
|
+ 2677 (printf/snprintf), whose
|
|
|
+ 2678 result is conventionally
|
|
|
+ 2679 discarded; ordinary
|
|
|
+ 2680 Modula-2 functions keep
|
|
|
+ 2681 the 233 diagnostic *)
|
|
|
+ 2682 IF (res # SymTab.InvalidType)
|
|
|
+ 2683 AND NOT va THEN
|
|
|
+ 2684 SemError(233)
|
|
|
+ 2685 END;
|
|
|
+ 2686 t := SymTab.InvalidType;
|
|
|
+ 2687 QbeGen.CopyOp("0", q);
|
|
|
+ 2688 END; .) .
|
|
|
+ 2689 (* One actual: VAR formals take recorded designator addresses
|
|
|
+ 2690 (233 otherwise); value formals take converted expressions. *)
|
|
|
+ 2691 ActParam<pn: SymTab.Name; pt: SymTab.TypeIndex; ind: BOOLEAN;
|
|
|
+ 2692 methCls: SymTab.TypeIndex; i: CARDINAL>
|
|
|
+ 2693 (. VAR at, ft: SymTab.TypeIndex;
|
|
|
+ 2694 qe, qa, qt: QbeGen.QVal;
|
|
|
+ 2695 isV, conv, va: BOOLEAN;
|
|
|
+ 2696 cl: CHAR;
|
|
|
+ 2697 savedN, aj: CARDINAL;
|
|
|
+ 2698 savedArgs: ARRAY [0 .. 31]
|
|
|
+ 2699 OF AST.Node;
|
|
|
+ 2700 astActual: AST.Node; .)
|
|
|
+ 2701 = (. (* Parsing the actual can clobber
|
|
|
+ 2702 the enclosing call's argument
|
|
|
+ 2703 list (Factor resets astNArgs),
|
|
|
+ 2704 so save/restore it. *)
|
|
|
+ 2705 savedN := astNArgs; aj := 0;
|
|
|
+ 2706 WHILE aj <= HIGH(astArgs) DO
|
|
|
+ 2707 savedArgs[aj] := astArgs[aj];
|
|
|
+ 2708 INC(aj)
|
|
|
+ 2709 END; .)
|
|
|
+ 2710 Expr<at, qe> (. QbeGen.CopyOp(qe, convQ); convT := at;
|
|
|
+ 2711 astActual := astCur;
|
|
|
+ 2712 astNArgs := savedN; aj := 0;
|
|
|
+ 2713 WHILE aj <= HIGH(astArgs) DO
|
|
|
+ 2714 astArgs[aj] := savedArgs[aj];
|
|
|
+ 2715 INC(aj)
|
|
|
+ 2716 END;
|
|
|
+ 2717 IF astNArgs <= HIGH(astArgs) THEN
|
|
|
+ 2718 astArgs[astNArgs] := astCur;
|
|
|
+ 2719 INC(astNArgs)
|
|
|
+ 2720 ELSE SemError(230)
|
|
|
+ 2721 (* > 32 actuals: impl limit *)
|
|
|
+ 2722 END;
|
|
|
+ 2723 va := (NOT ind)
|
|
|
+ 2724 AND (methCls =
|
|
|
+ 2725 SymTab.InvalidType)
|
|
|
+ 2726 AND (SymTab.SymKind(pn) =
|
|
|
+ 2727 SymTab.KindProc)
|
|
|
+ 2728 AND SymTab.Varargs(pn);
|
|
|
+ 2729 IF ind THEN
|
|
|
+ 2730 ft :=
|
|
|
+ 2731 SymTab.ProcTypeParamType(pt,
|
|
|
+ 2732 i);
|
|
|
+ 2733 isV :=
|
|
|
+ 2734 SymTab.ProcTypeParamIsVar(pt,
|
|
|
+ 2735 i)
|
|
|
+ 2736 ELSIF methCls #
|
|
|
+ 2737 SymTab.InvalidType THEN
|
|
|
+ 2738 ft :=
|
|
|
+ 2739 SymTab.ClassMethodParamType(
|
|
|
+ 2740 methCls, pn, i);
|
|
|
+ 2741 isV :=
|
|
|
+ 2742 SymTab.ClassMethodParamIsVar(
|
|
|
+ 2743 methCls, pn, i)
|
|
|
+ 2744 ELSE
|
|
|
+ 2745 ft := SymTab.ParamType(pn, i);
|
|
|
+ 2746 isV := SymTab.ParamIsVar(pn, i)
|
|
|
+ 2747 END;
|
|
|
+ 2748 IF (at = SymTab.InvalidType) THEN
|
|
|
+ 2749 ELSIF ft = SymTab.InvalidType THEN
|
|
|
+ 2750 ELSIF isV THEN
|
|
|
+ 2751 IF (SymTab.ClassOf(at) = SymTab.ClChar)
|
|
|
+ 2752 AND (SymTab.ClassOf(ft) = SymTab.ClArray)
|
|
|
+ 2753 AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
|
|
|
+ 2754 AND QbeGen.IsImm(qe) THEN
|
|
|
+ 2755 ELSIF (AST.Kind(astActual) #
|
|
|
+ 2756 AST.NkDesignator)
|
|
|
+ 2757 AND (AST.Kind(astActual) # AST.NkStrLit) THEN
|
|
|
+ 2758 SemError(233)
|
|
|
+ 2759 ELSIF NOT SymTab.VarParamOk(at, ft)
|
|
|
+ 2760 AND NOT SymTab.ByteBufOk(at, ft) THEN
|
|
|
+ 2761 SemError(233)
|
|
|
+ 2762 END
|
|
|
+ 2763 ELSE
|
|
|
+ 2764 IF (SymTab.ClassOf(at) = SymTab.ClChar)
|
|
|
+ 2765 AND (SymTab.ClassOf(ft) = SymTab.ClArray)
|
|
|
+ 2766 AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
|
|
|
+ 2767 AND QbeGen.IsImm(qe) THEN
|
|
|
+ 2768 ELSIF NOT SymTab.Assignable(at, ft)
|
|
|
+ 2769 AND NOT SymTab.ByteBufOk(at, ft) THEN
|
|
|
+ 2770 SemError(233)
|
|
|
+ 2771 END
|
|
|
+ 2772 END; .) .
|
|
|
+ 2773 IfStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ 2774 q: QbeGen.QVal;
|
|
|
+ 2775 hasElse: BOOLEAN;
|
|
|
+ 2776 astCond, astIf, astLast,
|
|
|
+ 2777 astNode: AST.Node; .)
|
|
|
+ 2778 = "IF" (. hasElse := FALSE; .)
|
|
|
+ 2779 Expr<t, q> (. astCond := astCur; astStmt := AST.NoNode;
|
|
|
+ 2780 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
+ 2781 SemError(214) END; .)
|
|
|
+ 2782 "THEN" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkIf);
|
|
|
+ 2783 AST.SetChild(astNode, 0, astCond);
|
|
|
+ 2784 AST.SetChild(astNode, 1, astStmt);
|
|
|
+ 2785 astIf := astNode;
|
|
|
+ 2786 astLast := astNode; .)
|
|
|
+ 2787 { "ELSIF"
|
|
|
+ 2788 Expr<t, q> (. astCond := astCur; astStmt := AST.NoNode;
|
|
|
+ 2789 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
+ 2790 SemError(214) END; .)
|
|
|
+ 2791 "THEN" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkIf);
|
|
|
+ 2792 AST.SetChild(astNode, 0, astCond);
|
|
|
+ 2793 AST.SetChild(astNode, 1, astStmt);
|
|
|
+ 2794 AST.SetChild(astLast, 2, astNode);
|
|
|
+ 2795 astLast := astNode; .) }
|
|
|
+ 2796 [ "ELSE" (. hasElse := TRUE;
|
|
|
+ 2797 astStmt := AST.NoNode; .)
|
|
|
+ 2798 [ StatSeq ] (. AST.SetChild(astLast, 2, astStmt); .) ]
|
|
|
+ 2799 "END" (. astStmt := astIf; .) .
|
|
|
+ 2800 WhileStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ 2801 q: QbeGen.QVal;
|
|
|
+ 2802 astCond, astNode: AST.Node; .)
|
|
|
+ 2803 = "WHILE" (. astStmt := AST.NoNode; .)
|
|
|
+ 2804 Expr<t, q> (. astCond := astCur;
|
|
|
+ 2805 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
+ 2806 SemError(214) END; .)
|
|
|
+ 2807 "DO" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkWhile);
|
|
|
+ 2808 AST.SetChild(astNode, 0, astCond);
|
|
|
+ 2809 AST.SetChild(astNode, 1, astStmt);
|
|
|
+ 2810 astStmt := astNode; .)
|
|
|
+ 2811 "END" .
|
|
|
+ 2812 RepeatStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ 2813 q: QbeGen.QVal;
|
|
|
+ 2814 astCond, astBody, astNode:
|
|
|
+ 2815 AST.Node; .)
|
|
|
+ 2816 = "REPEAT" (. astStmt := AST.NoNode; .)
|
|
|
+ 2817 [ StatSeq ] (. astBody := astStmt; .)
|
|
|
+ 2818 "UNTIL" Expr<t, q> (. astCond := astCur;
|
|
|
+ 2819 astNode := AST.MakeNode(AST.NkRepeat);
|
|
|
+ 2820 AST.SetChild(astNode, 0, astBody);
|
|
|
+ 2821 AST.SetChild(astNode, 1, astCond);
|
|
|
+ 2822 astStmt := astNode;
|
|
|
+ 2823 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
+ 2824 SemError(214) END; .) .
|
|
|
+ 2825 LoopStat (. VAR lEnd: QbeGen.QVal; astNode: AST.Node; .)
|
|
|
+ 2826 = "LOOP" (. astStmt := AST.NoNode;
|
|
|
+ 2827 QbeGen.NewLabel(lEnd);
|
|
|
+ 2828 QbeGen.PushLoop(lEnd); .)
|
|
|
+ 2829 [ StatSeq ]
|
|
|
+ 2830 "END" (. astNode := AST.MakeNode(AST.NkLoop);
|
|
|
+ 2831 AST.SetChild(astNode, 0, astStmt);
|
|
|
+ 2832 astStmt := astNode;
|
|
|
+ 2833 QbeGen.PopLoop; .) .
|
|
|
+ 2834 (* FOR with static-sign BY (literal, non-zero; 220 otherwise).
|
|
|
+ 2835 Runtime direction would need a compare-select; the literal
|
|
|
+ 2836 sign picks cslew/csegew at "DO" time. *)
|
|
|
+ 2837 ForStat (. VAR lv: SymTab.Name;
|
|
|
+ 2838 tlo, thi, tby:
|
|
|
+ 2839 SymTab.TypeIndex;
|
|
|
+ 2840 qlo, qhi, qby, qt, qk, qb:
|
|
|
+ 2841 QbeGen.QVal;
|
|
|
+ 2842 lTop, lBody, lEnd:
|
|
|
+ 2843 QbeGen.QVal;
|
|
|
+ 2844 by: INTEGER;
|
|
|
+ 2845 ok: BOOLEAN;
|
|
|
+ 2846 astVar, astLo, astHi, astBy,
|
|
|
+ 2847 astNode: AST.Node; .)
|
|
|
+ 2848 = "FOR" (. by := 1; .)
|
|
|
+ 2849 GetIdent<lv> (. astVar := AST.MakeLeaf(AST.NkIdent, lv);
|
|
|
+ 2850 astStmt := AST.NoNode;
|
|
|
+ 2851 astBy := AST.NoNode;
|
|
|
+ 2852 ok := SymTab.Lookup(lv);
|
|
|
+ 2853 IF NOT ok THEN
|
|
|
+ 2854 SemError(201)
|
|
|
+ 2855 ELSIF (SymTab.SymKind(lv) #
|
|
|
+ 2856 SymTab.KindVar)
|
|
|
+ 2857 AND (SymTab.SymKind(lv) #
|
|
|
+ 2858 SymTab.KindParam) THEN
|
|
|
+ 2859 SemError(220); ok := FALSE
|
|
|
+ 2860 ELSIF NOT SymTab.IsOrdinal(
|
|
|
+ 2861 SymTab.SymType(lv)) THEN
|
|
|
+ 2862 SemError(220); ok := FALSE
|
|
|
+ 2863 END; .)
|
|
|
+ 2864 ":=" Expr<tlo, qlo> (. astLo := astCur;
|
|
|
+ 2865 IF NOT SymTab.Assignable(tlo,
|
|
|
+ 2866 SymTab.SymType(lv)) THEN
|
|
|
+ 2867 SemError(220); ok := FALSE
|
|
|
+ 2868 END; .)
|
|
|
+ 2869 "TO" Expr<thi, qhi> (. astHi := astCur;
|
|
|
+ 2870 IF NOT SymTab.Assignable(thi,
|
|
|
+ 2871 SymTab.SymType(lv)) THEN
|
|
|
+ 2872 SemError(220); ok := FALSE
|
|
|
+ 2873 END; .)
|
|
|
+ 2874 [ "BY" Expr<tby, qby> (. astBy := astCur;
|
|
|
+ 2875 IF (tby #
|
|
|
+ 2876 SymTab.InvalidType)
|
|
|
+ 2877 AND NOT SymTab.IsIntFamily(tby) THEN
|
|
|
+ 2878 SemError(220); ok := FALSE
|
|
|
+ 2879 END;
|
|
|
+ 2880 IF NOT SymTab.ConstInt(qby, by) THEN
|
|
|
+ 2881 SemError(230); by := 1
|
|
|
+ 2882 ELSIF by = 0 THEN
|
|
|
+ 2883 SemError(220); by := 1
|
|
|
+ 2884 END; .) ]
|
|
|
+ 2885 "DO"
|
|
|
+ 2886 [ StatSeq ]
|
|
|
+ 2887 "END" (. astNode := AST.MakeNode(AST.NkFor);
|
|
|
+ 2888 AST.SetChild(astNode, 0, astVar);
|
|
|
+ 2889 AST.SetChild(astNode, 1, astLo);
|
|
|
+ 2890 AST.SetChild(astNode, 2, astHi);
|
|
|
+ 2891 AST.SetChild(astNode, 3, astBy);
|
|
|
+ 2892 AST.SetChild(astNode, 4, astStmt);
|
|
|
+ 2893 astStmt := astNode;
|
|
|
+ 2894 .) .
|
|
|
+ 2895 CaseStat (. VAR tsel: SymTab.TypeIndex;
|
|
|
+ 2896 qsel, lEnd: QbeGen.QVal;
|
|
|
+ 2897 arm, astNode, astArms,
|
|
|
+ 2898 astArmsTail: AST.Node; .)
|
|
|
+ 2899 = "CASE" Expr<tsel, qsel> (. astNode := AST.MakeNode(AST.NkCase);
|
|
|
+ 2900 AST.SetChild(astNode, 0, astCur);
|
|
|
+ 2901 astArms := AST.NoNode;
|
|
|
+ 2902 astArmsTail := AST.NoNode;
|
|
|
+ 2903 .)
|
|
|
+ 2904 "OF" [ "|" ] CaseAlt<tsel, qsel, lEnd, astArms, astArmsTail>
|
|
|
+ 2905 { "|" CaseAlt<tsel, qsel, lEnd, astArms, astArmsTail> }
|
|
|
+ 2906 [ "ELSE" (. astStmt := AST.NoNode; .)
|
|
|
+ 2907 [ StatSeq ] (. arm := AST.MakeNode(AST.NkCaseArm);
|
|
|
+ 2908 AST.SetOp(arm, 1);
|
|
|
+ 2909 AST.SetChild(arm, 0, astStmt);
|
|
|
+ 2910 AstAppend(AST.NkBlock,
|
|
|
+ 2911 astArms, astArmsTail, arm); .) ]
|
|
|
+ 2912 "END" (. AST.SetChild(astNode, 1, astArms);
|
|
|
+ 2913 astStmt := astNode;
|
|
|
+ 2914 .) .
|
|
|
+ 2915 (* Compare-chain lowering: each alternative ends its match-tests
|
|
|
+ 2916 with "jmp lAfter", so the no-match fallthrough skips the body:
|
|
|
+ 2917 "cmp; jnz(lBody,lF); lF: ... ; jmp lAfter; lBody: S; jmp lEnd;
|
|
|
+ 2918 lAfter:". Falls into the next alternative, ELSE, or END. *)
|
|
|
+ 2919 CaseAlt<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
|
|
|
+ 2920 lEnd: QbeGen.QVal; VAR arms, armsTail: AST.Node>
|
|
|
+ 2921 (. VAR arm: AST.Node; .)
|
|
|
+ 2922 = (. arm := AST.MakeNode(AST.NkCaseArm); .)
|
|
|
+ 2923 CaseLabel<tsel, qsel, arm>
|
|
|
+ 2924 { "," CaseLabel<tsel, qsel, arm> }
|
|
|
+ 2925 ":" (. astStmt := AST.NoNode; .)
|
|
|
+ 2926 [ StatSeq ] (. AST.SetChild(arm, AST.NChild(arm),
|
|
|
+ 2927 astStmt);
|
|
|
+ 2928 AstAppend(AST.NkBlock,
|
|
|
+ 2929 arms, armsTail, arm);
|
|
|
+ 2930 .) .
|
|
|
+ 2931 CaseLabel<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
|
|
|
+ 2932 arm: AST.Node>
|
|
|
+ 2933 (. VAR t2, t3: SymTab.TypeIndex;
|
|
|
+ 2934 q2, q3, qc, qd, qe:
|
|
|
+ 2935 QbeGen.QVal;
|
|
|
+ 2936 astLab: AST.Node;
|
|
|
+ 2937 lNext: QbeGen.QVal; .)
|
|
|
+ 2938 = Expr<t2, q2> (. astLab := astCur;
|
|
|
+ 2939 IF SymTab.IsEmptyStr(t2)
|
|
|
+ 2940 AND (SymTab.ClassOf(tsel) =
|
|
|
+ 2941 SymTab.ClChar) THEN
|
|
|
+ 2942 (* ISO: '' as a CASE label
|
|
|
+ 2943 is the terminator *)
|
|
|
+ 2944 QbeGen.CopyOp("0", q2);
|
|
|
+ 2945 t2 := SymTab.CharType()
|
|
|
+ 2946 END;
|
|
|
+ 2947 IF (t2 #
|
|
|
+ 2948 SymTab.InvalidType)
|
|
|
+ 2949 AND (tsel #
|
|
|
+ 2950 SymTab.InvalidType)
|
|
|
+ 2951 AND NOT SymTab.EqCheck(t2,
|
|
|
+ 2952 tsel) THEN
|
|
|
+ 2953 SemError(213) END;
|
|
|
+ 2954 (* set labels are not immediates:
|
|
|
+ 2955 the CASE chain uses CmpSet *)
|
|
|
+ 2956 IF (SymTab.ClassOf(t2) # SymTab.ClSet)
|
|
|
+ 2957 AND NOT QbeGen.IsImm(q2) THEN
|
|
|
+ 2958 SemError(230)
|
|
|
+ 2959 END; .)
|
|
|
+ 2960 [ ".." Expr<t3, q3> (. astLab := AST.MakeBin(
|
|
|
+ 2961 AST.NkSubrange, 0, astLab, astCur);
|
|
|
+ 2962 IF SymTab.IsEmptyStr(t3)
|
|
|
+ 2963 AND (SymTab.ClassOf(tsel) =
|
|
|
+ 2964 SymTab.ClChar) THEN
|
|
|
+ 2965 QbeGen.CopyOp("0", q3);
|
|
|
+ 2966 t3 := SymTab.CharType()
|
|
|
+ 2967 END;
|
|
|
+ 2968 IF (t3 #
|
|
|
+ 2969 SymTab.InvalidType)
|
|
|
+ 2970 AND (tsel #
|
|
|
+ 2971 SymTab.InvalidType)
|
|
|
+ 2972 AND NOT SymTab.EqCheck(t3,
|
|
|
+ 2973 tsel) THEN
|
|
|
+ 2974 SemError(213) END;
|
|
|
+ 2975 IF (SymTab.ClassOf(t3) # SymTab.ClSet)
|
|
|
+ 2976 AND NOT QbeGen.IsImm(q3) THEN
|
|
|
+ 2977 SemError(230)
|
|
|
+ 2978 END; .) ]
|
|
|
+ 2979 (. AST.SetChild(arm,
|
|
|
+ 2980 AST.NChild(arm), astLab); .) .
|
|
|
+ 2981 ReturnStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ 2982 q, qt: QbeGen.QVal;
|
|
|
+ 2983 res: SymTab.TypeIndex;
|
|
|
+ 2984 hadE, conv: BOOLEAN;
|
|
|
+ 2985 astVal, astNode: AST.Node; .)
|
|
|
+ 2986 = "RETURN" (. hadE := FALSE; astStmt := AST.NoNode; .)
|
|
|
+ 2987 [ Expr<t, q> (. hadE := TRUE; astVal := astCur; .) ]
|
|
|
+ 2988 (. astNode := AST.MakeNode(AST.NkReturn);
|
|
|
+ 2989 IF hadE THEN
|
|
|
+ 2990 AST.SetChild(astNode, 0, astVal)
|
|
|
+ 2991 END;
|
|
|
+ 2992 astStmt := astNode;
|
|
|
+ 2993 conv := FALSE;
|
|
|
+ 2994 IF NOT SymTab.InProc() THEN
|
|
|
+ 2995 SemError(232)
|
|
|
+ 2996 ELSE res := SymTab.CurRes();
|
|
|
+ 2997 IF NOT hadE THEN
|
|
|
+ 2998 IF res #
|
|
|
+ 2999 SymTab.InvalidType THEN
|
|
|
+ 3000 SemError(232)
|
|
|
+ 3001 END
|
|
|
+ 3002 ELSIF (res =
|
|
|
+ 3003 SymTab.InvalidType)
|
|
|
+ 3004 OR (t #
|
|
|
+ 3005 SymTab.InvalidType)
|
|
|
+ 3006 AND NOT SymTab.Assignable(t,
|
|
|
+ 3007 res) THEN
|
|
|
+ 3008 SemError(232)
|
|
|
+ 3009 END
|
|
|
+ 3010 END; .) .
|
|
|
+ 3011 HaltStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ 3012 q: QbeGen.QVal;
|
|
|
+ 3013 astVal, astNode: AST.Node; .)
|
|
|
+ 3014 = "HALT" (. astVal := AST.NoNode; .)
|
|
|
+ 3015 [ "(" Expr<t, q> (. astVal := astCur; .) ")" ]
|
|
|
+ 3016 (. astNode := AST.MakeNode(AST.NkHalt);
|
|
|
+ 3017 IF astVal # AST.NoNode THEN
|
|
|
+ 3018 AST.SetChild(astNode, 0, astVal)
|
|
|
+ 3019 END;
|
|
|
+ 3020 astStmt := astNode;
|
|
|
+ 3021 .) .
|
|
|
+ 3022 (* Designator: scalar loads, array addresses, and index suffixes.
|
|
|
+ 3023 Each index descends one level (bounds-checked, trap on breach);
|
|
|
+ 3024 nested levels reload the inner descriptor address. q ends as the
|
|
|
+ 3025 value (scalars), the descriptor address (plain arrays), or the
|
|
|
+ 3026 element address (indexed); sfx marks the indexed form. *)
|
|
|
+ 3027 Design<VAR t: SymTab.TypeIndex; VAR k: INTEGER;
|
|
|
+ 3028 VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
|
|
|
+ 3029 (. VAR n: SymTab.Name; .)
|
|
|
+ 3030 = GetIdent<n> DesignTail<n, t, k, q, qn, sfx> .
|
|
|
+ 3031 (* The part of Design after the identifier: resolve it and walk the
|
|
|
+ 3032 selectors. Split out so a statement can decide between a label
|
|
|
+ 3033 (`ident :`) and a designator (`ident := ...`) with one token. *)
|
|
|
+ 3034 DesignTail<VAR n: SymTab.Name; VAR t: SymTab.TypeIndex; VAR k: INTEGER;
|
|
|
+ 3035 VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
|
|
|
+ 3036 (. VAR fn, mal: SymTab.Name;
|
|
|
+ 3037 cls: INTEGER;
|
|
|
+ 3038 ic: SymTab.TypeIndex;
|
|
|
+ 3039 curT, it, eT, bt:
|
|
|
+ 3040 SymTab.TypeIndex;
|
|
|
+ 3041 iq, ql, qlo, qhi, qe:
|
|
|
+ 3042 QbeGen.QVal;
|
|
|
+ 3043 lo, hi: INTEGER;
|
|
|
+ 3044 fo: INTEGER;
|
|
|
+ 3045 isOpen: BOOLEAN;
|
|
|
+ 3046 qb, cv: QbeGen.QVal;
|
|
|
+ 3047 r: BOOLEAN;
|
|
|
+ 3048 astDes, astSel: AST.Node; .)
|
|
|
+ 3049 = (. methCls := SymTab.InvalidType;
|
|
|
+ 3050 QbeGen.CopyOp(n, qn);
|
|
|
+ 3051 sfx := FALSE;
|
|
|
+ 3052 IF NOT SymTab.Lookup(n) THEN
|
|
|
+ 3053 (* a bare method name inside
|
|
|
+ 3054 a CLASS IMPLEMENTATION
|
|
|
+ 3055 is a sibling call on
|
|
|
+ 3056 THIS *)
|
|
|
+ 3057 ic := SymTab.CurImplClass();
|
|
|
+ 3058 IF (ic #
|
|
|
+ 3059 SymTab.InvalidType)
|
|
|
+ 3060 AND SymTab.MethodExists(ic, n) THEN
|
|
|
+ 3061 sfx := FALSE;
|
|
|
+ 3062 QbeGen.CopyOp("@", q);
|
|
|
+ 3063 methCls := ic;
|
|
|
+ 3064 k := SymTab.KindProc;
|
|
|
+ 3065 t := SymTab.InvalidType
|
|
|
+ 3066 ELSIF SymTab.InProc() THEN
|
|
|
+ 3067 (* not declared anywhere
|
|
|
+ 3068 in scope: with bodies
|
|
|
+ 3069 parsed at unit end this
|
|
|
+ 3070 is a genuine 201 (a
|
|
|
+ 3071 nested-local forward is
|
|
|
+ 3072 no longer tolerated). *)
|
|
|
+ 3073 SemError(201);
|
|
|
+ 3074 t := SymTab.InvalidType;
|
|
|
+ 3075 k := -1;
|
|
|
+ 3076 QbeGen.CopyOp("0", q)
|
|
|
+ 3077 ELSE
|
|
|
+ 3078 SemError(201);
|
|
|
+ 3079 t :=
|
|
|
+ 3080 SymTab.InvalidType;
|
|
|
+ 3081 k := -1;
|
|
|
+ 3082 QbeGen.CopyOp("0", q)
|
|
|
+ 3083 END
|
|
|
+ 3084 ELSE
|
|
|
+ 3085 t := SymTab.SymType(n);
|
|
|
+ 3086 k := SymTab.SymKind(n);
|
|
|
+ 3087 IF k = SymTab.KindConst THEN
|
|
|
+ 3088 IF SymTab.Equal(n,
|
|
|
+ 3089 "TRUE") THEN
|
|
|
+ 3090 t := SymTab.BoolType();
|
|
|
+ 3091 QbeGen.CopyOp("1", q)
|
|
|
+ 3092 ELSIF SymTab.Equal(n,
|
|
|
+ 3093 "FALSE") THEN
|
|
|
+ 3094 t := SymTab.BoolType();
|
|
|
+ 3095 QbeGen.CopyOp("0", q)
|
|
|
+ 3096 ELSIF SymTab.Equal(n,
|
|
|
+ 3097 "NIL") THEN
|
|
|
+ 3098 QbeGen.CopyOp("0", q)
|
|
|
+ 3099 ELSE
|
|
|
+ 3100 cls :=
|
|
|
+ 3101 SymTab.ClassOf(t);
|
|
|
+ 3102 IF (t #
|
|
|
+ 3103 SymTab.InvalidType)
|
|
|
+ 3104 AND ((cls = SymTab.ClInt)
|
|
|
+ 3105 OR (cls
|
|
|
+ 3106 = SymTab.ClChar)
|
|
|
+ 3107 OR (cls
|
|
|
+ 3108 = SymTab.ClEnum)
|
|
|
+ 3109 OR (cls
|
|
|
+ 3110 = SymTab.ClReal)
|
|
|
+ 3111 OR (cls
|
|
|
+ 3112 = SymTab.ClLong)
|
|
|
+ 3113 OR (cls
|
|
|
+ 3114 = SymTab.ClNil)
|
|
|
+ 3115 OR (cls = SymTab.ClByte)
|
|
|
+ 3116 OR (cls = SymTab.ClSByte)
|
|
|
+ 3117 OR (cls = SymTab.ClWord16)
|
|
|
+ 3118 OR (cls = SymTab.ClSWord16)
|
|
|
+ 3119 OR (cls = SymTab.ClBool)) THEN
|
|
|
+ 3120 IF cls = SymTab.ClNil THEN
|
|
|
+ 3121 QbeGen.CopyOp("0", q)
|
|
|
+ 3122 ELSIF ((cls
|
|
|
+ 3123 = SymTab.ClInt)
|
|
|
+ 3124 OR (cls
|
|
|
+ 3125 = SymTab.ClChar)
|
|
|
+ 3126 OR (cls
|
|
|
+ 3127 = SymTab.ClEnum)
|
|
|
+ 3128 OR (cls
|
|
|
+ 3129 = SymTab.ClLong)
|
|
|
+ 3130 OR (cls = SymTab.ClByte)
|
|
|
+ 3131 OR (cls = SymTab.ClSByte)
|
|
|
+ 3132 OR (cls = SymTab.ClWord16)
|
|
|
+ 3133 OR (cls = SymTab.ClSWord16)
|
|
|
+ 3134 OR (cls = SymTab.ClBool))
|
|
|
+ 3135 AND SymTab.GetSymVal(n, cv)
|
|
|
+ 3136 AND QbeGen.IsImm(cv) THEN
|
|
|
+ 3137 QbeGen.CopyOp(cv, q)
|
|
|
+ 3138 ELSE
|
|
|
+ 3139 QbeGen.LoadVar(n,
|
|
|
+ 3140 cls = SymTab.ClReal,
|
|
|
+ 3141 q)
|
|
|
+ 3142 END
|
|
|
+ 3143 ELSIF (cls = SymTab.ClArray)
|
|
|
+ 3144 OR (cls = SymTab.ClRecord)
|
|
|
+ 3145 OR (cls = SymTab.ClClass)
|
|
|
+ 3146 OR (cls = SymTab.ClStr)
|
|
|
+ 3147 OR (cls = SymTab.ClUStr)
|
|
|
+ 3148 OR (cls = SymTab.ClSet) THEN
|
|
|
+ 3149 (* aggregate constant:
|
|
|
+ 3150 its value IS the
|
|
|
+ 3151 descriptor address *)
|
|
|
+ 3152 IF SymTab.GetSymVal(n, cv) THEN
|
|
|
+ 3153 QbeGen.CopyOp(cv, q)
|
|
|
+ 3154 ELSE
|
|
|
+ 3155 QbeGen.CopyOp("0", q)
|
|
|
+ 3156 END
|
|
|
+ 3157 ELSE
|
|
|
+ 3158 IF t #
|
|
|
+ 3159 SymTab.InvalidType THEN
|
|
|
+ 3160 SemError(230)
|
|
|
+ 3161 END;
|
|
|
+ 3162 QbeGen.CopyOp("0", q)
|
|
|
+ 3163 END
|
|
|
+ 3164 END
|
|
|
+ 3165 ELSIF (k = SymTab.KindVar)
|
|
|
+ 3166 OR (k = SymTab.KindParam) THEN
|
|
|
+ 3167 cls := SymTab.ClassOf(t);
|
|
|
+ 3168 IF (cls # SymTab.ClInt)
|
|
|
+ 3169 AND (cls # SymTab.ClBool)
|
|
|
+ 3170 AND (cls # SymTab.ClChar)
|
|
|
+ 3171 AND (cls # SymTab.ClUChar)
|
|
|
+ 3172 AND (cls # SymTab.ClEnum)
|
|
|
+ 3173 AND (cls # SymTab.ClReal)
|
|
|
+ 3174 AND (cls # SymTab.ClPtr)
|
|
|
+ 3175 AND (cls # SymTab.ClProc)
|
|
|
+ 3176 AND (cls # SymTab.ClLong)
|
|
|
+ 3177 AND (cls # SymTab.ClArray)
|
|
|
+ 3178 AND (cls # SymTab.ClSet)
|
|
|
+ 3179 AND (cls # SymTab.ClRecord)
|
|
|
+ 3180 AND (cls # SymTab.ClUStr)
|
|
|
+ 3181 AND (cls # SymTab.ClByte)
|
|
|
+ 3182 AND (cls # SymTab.ClSByte)
|
|
|
+ 3183 AND (cls # SymTab.ClWord16)
|
|
|
+ 3184 AND (cls # SymTab.ClSWord16)
|
|
|
+ 3185 AND (cls # SymTab.ClClass) THEN
|
|
|
+ 3186 SemError(230);
|
|
|
+ 3187 QbeGen.CopyOp("0", q)
|
|
|
+ 3188 ELSE QbeGen.CopyOp("@", q)
|
|
|
+ 3189 END
|
|
|
+ 3190 ELSE QbeGen.CopyOp("0", q);
|
|
|
+ 3191 IF k = SymTab.KindImport THEN
|
|
|
+ 3192 SemError(230)
|
|
|
+ 3193 ELSIF k =
|
|
|
+ 3194 SymTab.KindProc THEN
|
|
|
+ 3195 (* bare procedure name:
|
|
|
+ 3196 a following ArgList
|
|
|
+ 3197 makes it a call;
|
|
|
+ 3198 otherwise Fact
|
|
|
+ 3199 reports 230 *)
|
|
|
+ 3200 ELSE
|
|
|
+ 3201 IF k = SymTab.KindField THEN
|
|
|
+ 3202 IF QbeGen.TopWith(qb) THEN
|
|
|
+ 3203 sfx := TRUE
|
|
|
+ 3204 ELSE SemError(230);
|
|
|
+ 3205 QbeGen.CopyOp("0", q)
|
|
|
+ 3206 END
|
|
|
+ 3207 END
|
|
|
+ 3208 END
|
|
|
+ 3209 END
|
|
|
+ 3210 END; .)
|
|
|
+ 3211 (. astDes := AST.MakeNode(AST.NkDesignator);
|
|
|
+ 3212 AST.SetChild(astDes, AST.NChild(astDes), AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
+ 3213 { "[" Expr<it, iq>
|
|
|
+ 3214 (. AST.SetChild(astDes, AST.NChild(astDes),
|
|
|
+ 3215 AST.MakeUn(AST.NkSelector, AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
+ 3216 ELSIF SymTab.ClassOf(t) #
|
|
|
+ 3217 SymTab.ClArray THEN
|
|
|
+ 3218 SemError(217);
|
|
|
+ 3219 t := SymTab.InvalidType
|
|
|
+ 3220 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
+ 3221 AND (SymTab.ClassOf(it) #
|
|
|
+ 3222 SymTab.ClChar)
|
|
|
+ 3223 AND (SymTab.ClassOf(it) #
|
|
|
+ 3224 SymTab.ClEnum)
|
|
|
+ 3225 AND (SymTab.ClassOf(it) #
|
|
|
+ 3226 SymTab.ClBool) THEN
|
|
|
+ 3227 SemError(218);
|
|
|
+ 3228 t := SymTab.InvalidType
|
|
|
+ 3229 ELSE
|
|
|
+ 3230 eT := SymTab.ArrayElem(t);
|
|
|
+ 3231 t := eT; sfx := TRUE
|
|
|
+ 3232 END; .)
|
|
|
+ 3233 { "," Expr<it, iq>
|
|
|
+ 3234 (. AST.SetChild(astDes, AST.NChild(astDes),
|
|
|
+ 3235 AST.MakeUn(AST.NkSelector, AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
+ 3236 ELSIF SymTab.ClassOf(t) #
|
|
|
+ 3237 SymTab.ClArray THEN
|
|
|
+ 3238 SemError(217);
|
|
|
+ 3239 t := SymTab.InvalidType
|
|
|
+ 3240 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
+ 3241 AND (SymTab.ClassOf(it) #
|
|
|
+ 3242 SymTab.ClChar)
|
|
|
+ 3243 AND (SymTab.ClassOf(it) #
|
|
|
+ 3244 SymTab.ClEnum)
|
|
|
+ 3245 AND (SymTab.ClassOf(it) #
|
|
|
+ 3246 SymTab.ClBool) THEN
|
|
|
+ 3247 SemError(218);
|
|
|
+ 3248 t := SymTab.InvalidType
|
|
|
+ 3249 ELSE
|
|
|
+ 3250 eT := SymTab.ArrayElem(t);
|
|
|
+ 3251 t := eT; sfx := TRUE
|
|
|
+ 3252 END; .) }
|
|
|
+ 3253 "]"
|
|
|
+ 3254 | "." GetIdent<fn>
|
|
|
+ 3255 (. astSel := AST.MakeNode(AST.NkSelector);
|
|
|
+ 3256 AST.SetOp(astSel, AST.SelField);
|
|
|
+ 3257 AST.SetChild(astSel, 0, AST.MakeLeaf(AST.NkIdent, fn));
|
|
|
+ 3258 AST.SetChild(astDes, AST.NChild(astDes), astSel); IF k = SymTab.KindModule THEN
|
|
|
+ 3259 (* qualified L.x: materialize
|
|
|
+ 3260 the export, then load it *)
|
|
|
+ 3261 IF NOT SymTab.MaterializeAlias(n,
|
|
|
+ 3262 fn, mal) THEN
|
|
|
+ 3263 SemError(201);
|
|
|
+ 3264 t := SymTab.InvalidType;
|
|
|
+ 3265 QbeGen.CopyOp("0", q)
|
|
|
+ 3266 ELSE
|
|
|
+ 3267 QbeGen.CopyOp(mal, qn);
|
|
|
+ 3268 t := SymTab.SymType(mal);
|
|
|
+ 3269 k := SymTab.SymKind(mal);
|
|
|
+ 3270 sfx := FALSE;
|
|
|
+ 3271 IF k = SymTab.KindProc THEN
|
|
|
+ 3272 (* call: ArgList supplies
|
|
|
+ 3273 the value *)
|
|
|
+ 3274 QbeGen.CopyOp("0", q)
|
|
|
+ 3275 ELSIF k = SymTab.KindConst THEN
|
|
|
+ 3276 IF SymTab.GetSymVal(mal,
|
|
|
+ 3277 cv)
|
|
|
+ 3278 THEN QbeGen.CopyOp(cv, q)
|
|
|
+ 3279 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 3280 END
|
|
|
+ 3281 END
|
|
|
+ 3282 END
|
|
|
+ 3283 ELSIF t = SymTab.InvalidType THEN
|
|
|
+ 3284 ELSIF (SymTab.ClassOf(t) #
|
|
|
+ 3285 SymTab.ClRecord)
|
|
|
+ 3286 AND (SymTab.ClassOf(t) #
|
|
|
+ 3287 SymTab.ClClass) THEN
|
|
|
+ 3288 SemError(215);
|
|
|
+ 3289 t := SymTab.InvalidType
|
|
|
+ 3290 ELSIF (SymTab.ClassOf(t) =
|
|
|
+ 3291 SymTab.ClClass)
|
|
|
+ 3292 AND SymTab.MethodExists(t, fn) THEN
|
|
|
+ 3293 (* obj.Method: bind the
|
|
|
+ 3294 method and pass obj as
|
|
|
+ 3295 the hidden receiver; q
|
|
|
+ 3296 already holds the
|
|
|
+ 3297 object's address *)
|
|
|
+ 3298 QbeGen.CopyOp(fn, n);
|
|
|
+ 3299 QbeGen.CopyOp(fn, qn);
|
|
|
+ 3300 methCls := t;
|
|
|
+ 3301 k := SymTab.KindProc;
|
|
|
+ 3302 t := SymTab.InvalidType
|
|
|
+ 3303 ELSIF NOT SymTab.FieldExists(t,
|
|
|
+ 3304 fn) THEN
|
|
|
+ 3305 SemError(216);
|
|
|
+ 3306 t := SymTab.InvalidType
|
|
|
+ 3307 ELSE
|
|
|
+ 3308 t := SymTab.FieldType(t, fn);
|
|
|
+ 3309 sfx := TRUE
|
|
|
+ 3310 END; .)
|
|
|
+ 3311 | "^"
|
|
|
+ 3312 (. astSel := AST.MakeNode(AST.NkSelector);
|
|
|
+ 3313 AST.SetOp(astSel, AST.SelDeref);
|
|
|
+ 3314 AST.SetChild(astDes, AST.NChild(astDes), astSel); IF t = SymTab.InvalidType THEN
|
|
|
+ 3315 ELSIF SymTab.ClassOf(t) #
|
|
|
+ 3316 SymTab.ClPtr THEN
|
|
|
+ 3317 SemError(219);
|
|
|
+ 3318 t := SymTab.InvalidType
|
|
|
+ 3319 ELSE
|
|
|
+ 3320 bt := SymTab.PtrBase(t);
|
|
|
+ 3321 IF bt = SymTab.InvalidType THEN
|
|
|
+ 3322 ELSE
|
|
|
+ 3323 t := bt;
|
|
|
+ 3324 sfx := TRUE
|
|
|
+ 3325 END
|
|
|
+ 3326 END; .) } (. astCur := astDes; .) .
|
|
|
+ 3327 (* Result suffix (ISO component after a function call): `F()^`,
|
|
|
+ 3328 `F()[i]`, `F().field`. The call result is in t/q with sfx FALSE
|
|
|
+ 3329 (a value, or a descriptor address for aggregates); each component
|
|
|
+ 3330 descends one level exactly like the Design components. *)
|
|
|
+ 3331 ResultComp<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
|
|
|
+ 3332 VAR sfx: BOOLEAN; VAR node: AST.Node;
|
|
|
+ 3333 VAR mname: SymTab.Name; VAR methCls: SymTab.TypeIndex;
|
|
|
+ 3334 VAR isM: BOOLEAN> (. VAR it, eT, bt: SymTab.TypeIndex;
|
|
|
+ 3335 iq, ql, qlo, qhi, qe, qb:
|
|
|
+ 3336 QbeGen.QVal;
|
|
|
+ 3337 lo, hi, fo: INTEGER;
|
|
|
+ 3338 isOpen: BOOLEAN;
|
|
|
+ 3339 fname: SymTab.Name;
|
|
|
+ 3340 astWrap, astSel: AST.Node; .)
|
|
|
+ 3341 = "[" Expr<it, iq>
|
|
|
+ 3342 (. isM := FALSE;
|
|
|
+ 3343 IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
+ 3344 astWrap := AST.MakeNode(
|
|
|
+ 3345 AST.NkDesignator);
|
|
|
+ 3346 AST.SetChild(astWrap, 0, node);
|
|
|
+ 3347 node := astWrap
|
|
|
+ 3348 END;
|
|
|
+ 3349 AST.SetChild(node, AST.NChild(node),
|
|
|
+ 3350 AST.MakeUn(AST.NkSelector,
|
|
|
+ 3351 AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
+ 3352 ELSIF SymTab.ClassOf(t) #
|
|
|
+ 3353 SymTab.ClArray THEN
|
|
|
+ 3354 SemError(217);
|
|
|
+ 3355 t := SymTab.InvalidType
|
|
|
+ 3356 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
+ 3357 AND (SymTab.ClassOf(it) # SymTab.ClChar)
|
|
|
+ 3358 AND (SymTab.ClassOf(it) # SymTab.ClEnum)
|
|
|
+ 3359 AND (SymTab.ClassOf(it) # SymTab.ClBool) THEN
|
|
|
+ 3360 SemError(218);
|
|
|
+ 3361 t := SymTab.InvalidType
|
|
|
+ 3362 ELSE
|
|
|
+ 3363 eT := SymTab.ArrayElem(t);
|
|
|
+ 3364 t := eT; sfx := TRUE
|
|
|
+ 3365 END; .)
|
|
|
+ 3366 "]"
|
|
|
+ 3367 | "." GetIdent<fname>
|
|
|
+ 3368 (. isM := FALSE;
|
|
|
+ 3369 IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
+ 3370 astWrap := AST.MakeNode(
|
|
|
+ 3371 AST.NkDesignator);
|
|
|
+ 3372 AST.SetChild(astWrap, 0, node);
|
|
|
+ 3373 node := astWrap
|
|
|
+ 3374 END;
|
|
|
+ 3375 AST.SetChild(node, AST.NChild(node),
|
|
|
+ 3376 AST.MakeUn(AST.NkSelector,
|
|
|
+ 3377 AST.SelField,
|
|
|
+ 3378 AST.MakeLeaf(AST.NkIdent,
|
|
|
+ 3379 fname))); IF t = SymTab.InvalidType THEN
|
|
|
+ 3380 ELSIF (SymTab.ClassOf(t) #
|
|
|
+ 3381 SymTab.ClRecord)
|
|
|
+ 3382 AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN
|
|
|
+ 3383 SemError(215);
|
|
|
+ 3384 t := SymTab.InvalidType
|
|
|
+ 3385 ELSIF (SymTab.ClassOf(t) =
|
|
|
+ 3386 SymTab.ClClass)
|
|
|
+ 3387 AND SymTab.MethodExists(t, fname) THEN
|
|
|
+ 3388 (* a method on the call result:
|
|
|
+ 3389 a following ArgList makes
|
|
|
+ 3390 the call *)
|
|
|
+ 3391 mname := fname;
|
|
|
+ 3392 methCls := t; isM := TRUE;
|
|
|
+ 3393 t := SymTab.InvalidType
|
|
|
+ 3394 ELSIF NOT SymTab.FieldExists(t,
|
|
|
+ 3395 fname) THEN
|
|
|
+ 3396 SemError(216);
|
|
|
+ 3397 t := SymTab.InvalidType
|
|
|
+ 3398 ELSE
|
|
|
+ 3399 t := SymTab.FieldType(t, fname);
|
|
|
+ 3400 sfx := TRUE
|
|
|
+ 3401 END; .)
|
|
|
+ 3402 | "^" (. isM := FALSE;
|
|
|
+ 3403 IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
+ 3404 astWrap := AST.MakeNode(
|
|
|
+ 3405 AST.NkDesignator);
|
|
|
+ 3406 AST.SetChild(astWrap, 0, node);
|
|
|
+ 3407 node := astWrap
|
|
|
+ 3408 END;
|
|
|
+ 3409 astSel := AST.MakeNode(AST.NkSelector);
|
|
|
+ 3410 AST.SetOp(astSel, AST.SelDeref);
|
|
|
+ 3411 AST.SetChild(node,
|
|
|
+ 3412 AST.NChild(node), astSel); IF t = SymTab.InvalidType THEN
|
|
|
+ 3413 ELSIF SymTab.ClassOf(t) #
|
|
|
+ 3414 SymTab.ClPtr THEN
|
|
|
+ 3415 SemError(219);
|
|
|
+ 3416 t := SymTab.InvalidType
|
|
|
+ 3417 ELSE
|
|
|
+ 3418 bt := SymTab.PtrBase(t);
|
|
|
+ 3419 IF bt # SymTab.InvalidType THEN
|
|
|
+ 3420 t := bt; sfx := TRUE
|
|
|
+ 3421 END
|
|
|
+ 3422 END; .) .
|
|
|
+ 3423 Expr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 3424 (. VAR t2: SymTab.TypeIndex;
|
|
|
+ 3425 op: INTEGER;
|
|
|
+ 3426 q2, qt, wl: QbeGen.QVal;
|
|
|
+ 3427 astA, astB: AST.Node;
|
|
|
+ 3428 astOp: INTEGER;
|
|
|
+ 3429 astMade: BOOLEAN;
|
|
|
+ 3430 isR: BOOLEAN;
|
|
|
+ 3431 v1, v2: INTEGER;
|
|
|
+ 3432 b: BOOLEAN; .)
|
|
|
+ 3433 = SimExpr<t, q> (. astA := astCur; astMade := FALSE; .)
|
|
|
+ 3434 [ Rel<op> SimExpr<t2, q2>
|
|
|
+ 3435 (. astB := astCur; astMade := TRUE;
|
|
|
+ 3436 astOp := AST.OpEq;
|
|
|
+ 3437 IF op = SymTab.OpNeq1 THEN astOp := AST.OpNe
|
|
|
+ 3438 ELSIF op = SymTab.OpNeq2 THEN astOp := AST.OpNe
|
|
|
+ 3439 ELSIF op = SymTab.OpLt THEN astOp := AST.OpLt
|
|
|
+ 3440 ELSIF op = SymTab.OpLe THEN astOp := AST.OpLe
|
|
|
+ 3441 ELSIF op = SymTab.OpGt THEN astOp := AST.OpGt
|
|
|
+ 3442 ELSIF op = SymTab.OpGe THEN astOp := AST.OpGe
|
|
|
+ 3443 ELSIF op = SymTab.OpIn THEN astOp := AST.OpIn
|
|
|
+ 3444 END;
|
|
|
+ 3445 IF op = SymTab.OpIn THEN
|
|
|
+ 3446 IF SymTab.InCheck(t, t2) THEN
|
|
|
+ 3447 IF (t = SymTab.InvalidType)
|
|
|
+ 3448 OR (t2 = SymTab.InvalidType) THEN
|
|
|
+ 3449 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
|
|
|
+ 3450 ELSE
|
|
|
+ 3451 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
+ 3452 END
|
|
|
+ 3453 ELSE SemError(222); t := SymTab.InvalidType;
|
|
|
+ 3454 QbeGen.CopyOp("0", q)
|
|
|
+ 3455 END
|
|
|
+ 3456 ELSIF SymTab.RelCheck(t, t2, op) THEN
|
|
|
+ 3457 IF (t = SymTab.InvalidType)
|
|
|
+ 3458 OR (t2 = SymTab.InvalidType) THEN
|
|
|
+ 3459 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
|
|
|
+ 3460 ELSIF SymTab.IsOrdinal(t) AND SymTab.IsOrdinal(t2)
|
|
|
+ 3461 AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2)
|
|
|
+ 3462 AND SymTab.ConstInt(q, v1)
|
|
|
+ 3463 AND SymTab.ConstInt(q2, v2) THEN
|
|
|
+ 3464 (* fold a relation of two ordinal constants (needed for
|
|
|
+ 3465 ORD(boolean) in a CONST initialiser) *)
|
|
|
+ 3466 IF op = SymTab.OpEq THEN b := v1 = v2
|
|
|
+ 3467 ELSIF (op = SymTab.OpNeq1) OR (op = SymTab.OpNeq2) THEN
|
|
|
+ 3468 b := v1 # v2
|
|
|
+ 3469 ELSIF op = SymTab.OpLt THEN b := v1 < v2
|
|
|
+ 3470 ELSIF op = SymTab.OpLe THEN b := v1 <= v2
|
|
|
+ 3471 ELSIF op = SymTab.OpGt THEN b := v1 > v2
|
|
|
+ 3472 ELSE b := v1 >= v2
|
|
|
+ 3473 END;
|
|
|
+ 3474 t := SymTab.BoolType();
|
|
|
+ 3475 IF b THEN QbeGen.CopyOp("1", q)
|
|
|
+ 3476 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 3477 END
|
|
|
+ 3478 ELSIF (SymTab.ClassOf(t) = SymTab.ClPtr)
|
|
|
+ 3479 OR (SymTab.ClassOf(t2) = SymTab.ClPtr) THEN
|
|
|
+ 3480 IF (op # SymTab.OpEq) AND (op # SymTab.OpNeq1)
|
|
|
+ 3481 AND (op # SymTab.OpNeq2) THEN
|
|
|
+ 3482 SemError(213); t := SymTab.InvalidType;
|
|
|
+ 3483 QbeGen.CopyOp("0", q)
|
|
|
+ 3484 ELSE
|
|
|
+ 3485 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
+ 3486 END
|
|
|
+ 3487 ELSIF (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
+ 3488 OR (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
+ 3489 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
+ 3490 ELSIF SymTab.StrCompat(t, t2) THEN
|
|
|
+ 3491 QbeGen.StrEq(op, q, q2, qt);
|
|
|
+ 3492 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
|
|
|
+ 3493 ELSIF SymTab.IsLongFamily(t)
|
|
|
+ 3494 OR SymTab.IsLongFamily(t2) THEN
|
|
|
+ 3495 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
+ 3496 ELSE
|
|
|
+ 3497 t := SymTab.BoolType();
|
|
|
+ 3498 QbeGen.CopyOp("@", q)
|
|
|
+ 3499 END
|
|
|
+ 3500 ELSE SemError(213); t := SymTab.InvalidType;
|
|
|
+ 3501 QbeGen.CopyOp("0", q)
|
|
|
+ 3502 END;
|
|
|
+ 3503 astCur := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB); .) ]
|
|
|
+ 3504 (. IF NOT astMade THEN astCur := astA END; .)
|
|
|
+ 3505 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
+ 3506 Rel<VAR op: INTEGER>
|
|
|
+ 3507 = "=" (. op := SymTab.OpEq; .)
|
|
|
+ 3508 | "#" (. op := SymTab.OpNeq1; .)
|
|
|
+ 3509 | "<" (. op := SymTab.OpLt; .)
|
|
|
+ 3510 | "<=" (. op := SymTab.OpLe; .)
|
|
|
+ 3511 | ">" (. op := SymTab.OpGt; .)
|
|
|
+ 3512 | ">=" (. op := SymTab.OpGe; .)
|
|
|
+ 3513 | "IN" (. op := SymTab.OpIn; .) .
|
|
|
+ 3514 SimExpr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 3515 (. VAR t2, res2, lt, rt:
|
|
|
+ 3516 SymTab.TypeIndex;
|
|
|
+ 3517 op: INTEGER;
|
|
|
+ 3518 q2, qt, wq, qf, q2a, q2b:
|
|
|
+ 3519 QbeGen.QVal;
|
|
|
+ 3520 neg, isR, isL, folded:
|
|
|
+ 3521 BOOLEAN;
|
|
|
+ 3522 fok: BOOLEAN;
|
|
|
+ 3523 lw, rw, mw: CARDINAL;
|
|
|
+ 3524 lTrue, lNext, lDone, qr, qs: QbeGen.QVal;
|
|
|
+ 3525 astA, astB: AST.Node;
|
|
|
+ 3526 astSign, astOp: INTEGER;
|
|
|
+ 3527 v1, v2: INTEGER;
|
|
|
+ 3528 s: ARRAY [0 .. 255] OF CHAR; .)
|
|
|
+ 3529 = (. neg := FALSE; astSign := 0; .)
|
|
|
+ 3530 [ "+" (. neg := TRUE; astSign := 1; .)
|
|
|
+ 3531 | "-" (. neg := TRUE; astSign := -1; .) ]
|
|
|
+ 3532 Term<t, q> (. astA := astCur;
|
|
|
+ 3533 IF neg AND QbeGen.IsImm(q) THEN
|
|
|
+ 3534 QbeGen.NegFold(q, q)
|
|
|
+ 3535 END;
|
|
|
+ 3536 IF astSign < 0 THEN
|
|
|
+ 3537 astCur := AST.MakeUn(
|
|
|
+ 3538 AST.NkUnary, AST.OpSub, astA);
|
|
|
+ 3539 astA := astCur
|
|
|
+ 3540 END; .)
|
|
|
+ 3541 { AddOp<op>
|
|
|
+ 3542 Term<t2, q2> (. astB := astCur; .)
|
|
|
+ 3543 (. astOp := AST.OpAdd;
|
|
|
+ 3544 IF op = SymTab.OpSub THEN astOp := AST.OpSub
|
|
|
+ 3545 ELSIF op = SymTab.OpOr THEN astOp := AST.OpOr END;
|
|
|
+ 3546 astA := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB);
|
|
|
+ 3547 astCur := astA;
|
|
|
+ 3548 IF op = SymTab.OpOr THEN
|
|
|
+ 3549 (* short-circuit: if q is true the RHS is skipped *)
|
|
|
+ 3550 IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
|
|
|
+ 3551 t := SymTab.BoolType()
|
|
|
+ 3552 ELSE SemError(212); t := SymTab.InvalidType END;
|
|
|
+ 3553 IF t # SymTab.InvalidType THEN
|
|
|
+ 3554 QbeGen.CopyOp("@", q)
|
|
|
+ 3555 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 3556 END
|
|
|
+ 3557 ELSIF (op = SymTab.OpAdd)
|
|
|
+ 3558 AND (SymTab.ClassOf(t) = SymTab.ClChar)
|
|
|
+ 3559 AND (SymTab.ClassOf(t2) = SymTab.ClChar)
|
|
|
+ 3560 AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
|
|
|
+ 3561 (* "W" + "o": two one-character string literals concatenate
|
|
|
+ 3562 to a two-character string (they are CHAR-typed immediates) *)
|
|
|
+ 3563 IF SymTab.ConstInt(q, v1) AND SymTab.ConstInt(q2, v2)
|
|
|
+ 3564 AND (v1 >= 0) AND (v1 <= 255)
|
|
|
+ 3565 AND (v2 >= 0) AND (v2 <= 255) THEN
|
|
|
+ 3566 s[0] := '"'; s[1] := CHR(v1); s[2] := CHR(v2);
|
|
|
+ 3567 s[3] := '"'; s[4] := CHR(0);
|
|
|
+ 3568 QbeGen.DeclStr(s, qt); QbeGen.CopyOp(qt, q);
|
|
|
+ 3569 t := SymTab.NewStr();
|
|
|
+ 3570 astA := AST.MakeLeaf(AST.NkStrLit, s);
|
|
|
+ 3571 astCur := astA
|
|
|
+ 3572 ELSE SemError(211); t := SymTab.InvalidType;
|
|
|
+ 3573 QbeGen.CopyOp("0", q)
|
|
|
+ 3574 END
|
|
|
+ 3575 ELSIF (op = SymTab.OpAdd)
|
|
|
+ 3576 AND (SymTab.UStrCompat(t, t2)
|
|
|
+ 3577 OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
|
|
|
+ 3578 AND (SymTab.ClassOf(t2) = SymTab.ClUStr))
|
|
|
+ 3579 OR ((SymTab.ClassOf(t) = SymTab.ClUStr)
|
|
|
+ 3580 AND (SymTab.ClassOf(t2) = SymTab.ClUChar))
|
|
|
+ 3581 OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
|
|
|
+ 3582 AND (SymTab.ClassOf(t2) = SymTab.ClUChar))) THEN
|
|
|
+ 3583 (* UString concatenation: a UCHAR operand becomes a
|
|
|
+ 3584 1-codepoint UString; the result is a descriptor in the
|
|
|
+ 3585 shim's concat buffer. Work on copies so neither
|
|
|
+ 3586 operand is clobbered. *)
|
|
|
+ 3587 t := SymTab.NewUStr();
|
|
|
+ 3588 QbeGen.CopyOp("@", q)
|
|
|
+ 3589 ELSIF (op = SymTab.OpAdd)
|
|
|
+ 3590 AND (SymTab.StrCompat(t, t2)
|
|
|
+ 3591 OR (SymTab.IsStrType(t)
|
|
|
+ 3592 AND (SymTab.ClassOf(t2) = SymTab.ClChar))
|
|
|
+ 3593 OR ((SymTab.ClassOf(t) = SymTab.ClChar)
|
|
|
+ 3594 AND SymTab.IsStrType(t2))) THEN
|
|
|
+ 3595 (* string concatenation; a CHAR operand becomes a
|
|
|
+ 3596 1-character string literal. When both operands are
|
|
|
+ 3597 constants, fold to a single string literal so a
|
|
|
+ 3598 constructor element stays compile-time. *)
|
|
|
+ 3599 QbeGen.StrFold(q, q2, SymTab.ClassOf(t), SymTab.ClassOf(t2),
|
|
|
+ 3600 qt, fok);
|
|
|
+ 3601 IF fok THEN QbeGen.CopyOp(qt, q)
|
|
|
+ 3602 ELSE QbeGen.CopyOp("@", q)
|
|
|
+ 3603 END;
|
|
|
+ 3604 t := SymTab.NewStr()
|
|
|
+ 3605 ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
|
|
|
+ 3606 AND (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
+ 3607 AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
+ 3608 lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
|
|
|
+ 3609 mw := lw;
|
|
|
+ 3610 IF rw > mw THEN mw := rw END;
|
|
|
+ 3611 t := SymTab.NewSet(
|
|
|
+ 3612 SymTab.NewSubR(0,
|
|
|
+ 3613 VAL(INTEGER, mw) * 32 - 1));
|
|
|
+ 3614 QbeGen.CopyOp("@", q)
|
|
|
+ 3615 ELSE
|
|
|
+ 3616 IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN
|
|
|
+ 3617 lt := t; rt := t2; t := res2
|
|
|
+ 3618 ELSE SemError(211); t := SymTab.InvalidType END;
|
|
|
+ 3619 IF t # SymTab.InvalidType THEN
|
|
|
+ 3620 isL := SymTab.IsLongFamily(t);
|
|
|
+ 3621 isR := SymTab.ClassOf(t) = SymTab.ClReal;
|
|
|
+ 3622 folded := FALSE;
|
|
|
+ 3623 IF (NOT isL) AND (NOT isR)
|
|
|
+ 3624 AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
|
|
|
+ 3625 IF op = SymTab.OpAdd THEN
|
|
|
+ 3626 folded := QbeGen.Fold2(0, q, q2, qf)
|
|
|
+ 3627 ELSE
|
|
|
+ 3628 folded := QbeGen.Fold2(1, q, q2, qf)
|
|
|
+ 3629 END
|
|
|
+ 3630 END;
|
|
|
+ 3631 IF folded THEN QbeGen.CopyOp(qf, q)
|
|
|
+ 3632 ELSE
|
|
|
+ 3633 QbeGen.CopyOp("@", q)
|
|
|
+ 3634 END
|
|
|
+ 3635 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 3636 END
|
|
|
+ 3637 END; .) }
|
|
|
+ 3638 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
+ 3639 AddOp<VAR op: INTEGER>
|
|
|
+ 3640 = "+" (. op := SymTab.OpAdd; .)
|
|
|
+ 3641 | "-" (. op := SymTab.OpSub; .)
|
|
|
+ 3642 | "OR" (. op := SymTab.OpOr; .) .
|
|
|
+ 3643 Term<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 3644 (. VAR t2, res2, lt, rt:
|
|
|
+ 3645 SymTab.TypeIndex;
|
|
|
+ 3646 op: INTEGER;
|
|
|
+ 3647 q2, qt, wq, qf:
|
|
|
+ 3648 QbeGen.QVal;
|
|
|
+ 3649 isR, isL, folded: BOOLEAN;
|
|
|
+ 3650 lw, rw, mw: CARDINAL;
|
|
|
+ 3651 lNext, lFalse, lDone, qr, qs: QbeGen.QVal;
|
|
|
+ 3652 astA, astB: AST.Node;
|
|
|
+ 3653 astOp: INTEGER; .)
|
|
|
+ 3654 = Fact<t, q> (. astA := astCur; .) { MulOp<op>
|
|
|
+ 3655 Fact<t2, q2> (. astB := astCur; .)
|
|
|
+ 3656 (. astOp := AST.OpMul;
|
|
|
+ 3657 IF op = SymTab.OpSlash THEN astOp := AST.OpDiv
|
|
|
+ 3658 ELSIF op = SymTab.OpDiv THEN astOp := AST.OpDiv
|
|
|
+ 3659 ELSIF op = SymTab.OpMod THEN astOp := AST.OpMod
|
|
|
+ 3660 ELSIF op = SymTab.OpAnd THEN astOp := AST.OpAnd END;
|
|
|
+ 3661 astA := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB);
|
|
|
+ 3662 astCur := astA;
|
|
|
+ 3663 IF op = SymTab.OpAnd THEN
|
|
|
+ 3664 (* short-circuit: if q is false the RHS is skipped *)
|
|
|
+ 3665 IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
|
|
|
+ 3666 t := SymTab.BoolType()
|
|
|
+ 3667 ELSE SemError(212); t := SymTab.InvalidType END;
|
|
|
+ 3668 IF t # SymTab.InvalidType THEN QbeGen.CopyOp("@", q)
|
|
|
+ 3669 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 3670 END
|
|
|
+ 3671 ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
|
|
|
+ 3672 AND (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
+ 3673 AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
+ 3674 lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
|
|
|
+ 3675 mw := lw;
|
|
|
+ 3676 IF rw > mw THEN mw := rw END;
|
|
|
+ 3677 t := SymTab.NewSet(
|
|
|
+ 3678 SymTab.NewSubR(0,
|
|
|
+ 3679 VAL(INTEGER, mw) * 32 - 1));
|
|
|
+ 3680 QbeGen.CopyOp("@", q)
|
|
|
+ 3681 ELSE
|
|
|
+ 3682 IF SymTab.ArithCheck(t, t2,
|
|
|
+ 3683 (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
|
|
|
+ 3684 res2) THEN
|
|
|
+ 3685 lt := t; rt := t2; t := res2
|
|
|
+ 3686 ELSE SemError(211); t := SymTab.InvalidType END;
|
|
|
+ 3687 IF t # SymTab.InvalidType THEN
|
|
|
+ 3688 isL := SymTab.IsLongFamily(t);
|
|
|
+ 3689 isR := SymTab.ClassOf(t) = SymTab.ClReal;
|
|
|
+ 3690 folded := FALSE;
|
|
|
+ 3691 IF (NOT isL) AND (NOT isR)
|
|
|
+ 3692 AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
|
|
|
+ 3693 IF op = SymTab.OpTimes THEN
|
|
|
+ 3694 folded := QbeGen.Fold2(2, q, q2, qf)
|
|
|
+ 3695 ELSIF op = SymTab.OpDiv THEN
|
|
|
+ 3696 folded := QbeGen.Fold2(3, q, q2, qf)
|
|
|
+ 3697 ELSIF op = SymTab.OpMod THEN
|
|
|
+ 3698 folded := QbeGen.Fold2(4, q, q2, qf)
|
|
|
+ 3699 END
|
|
|
+ 3700 END;
|
|
|
+ 3701 IF folded THEN QbeGen.CopyOp(qf, q)
|
|
|
+ 3702 ELSE
|
|
|
+ 3703 QbeGen.CopyOp("@", q)
|
|
|
+ 3704 END
|
|
|
+ 3705 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 3706 END
|
|
|
+ 3707 END; .) }
|
|
|
+ 3708 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
+ 3709 MulOp<VAR op: INTEGER>
|
|
|
+ 3710 = "*" (. op := SymTab.OpTimes; .)
|
|
|
+ 3711 | "/" (. op := SymTab.OpSlash; .)
|
|
|
+ 3712 | "DIV" (. op := SymTab.OpDiv; .)
|
|
|
+ 3713 | "MOD" (. op := SymTab.OpMod; .)
|
|
|
+ 3714 | ( "AND" | "&" ) (. op := SymTab.OpAnd; .) .
|
|
|
+ 3715 Fact<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 3716 (. VAR s: ARRAY [0 .. 255] OF CHAR;
|
|
|
+ 3717 et, dt, t2, st, ct2, et2:
|
|
|
+ 3718 SymTab.TypeIndex;
|
|
|
+ 3719 dk: INTEGER;
|
|
|
+ 3720 qd, q2, sq, qa, qm0, qr, qt:
|
|
|
+ 3721 QbeGen.QVal;
|
|
|
+ 3722 qn, vn: SymTab.Name;
|
|
|
+ 3723 vt: SymTab.TypeIndex;
|
|
|
+ 3724 c1, c2: INTEGER;
|
|
|
+ 3725 lo, hi: INTEGER;
|
|
|
+ 3726 isMax: BOOLEAN;
|
|
|
+ 3727 called, isHigh, sfx, isCh,
|
|
|
+ 3728 isU, uok, isStr: BOOLEAN;
|
|
|
+ 3729 ucp: INTEGER; astIsLit: BOOLEAN;
|
|
|
+ 3730 astD: AST.Node;
|
|
|
+ 3731 astCall: BOOLEAN;
|
|
|
+ 3732 astNode, astNot: AST.Node;
|
|
|
+ 3733 j: CARDINAL;
|
|
|
+ 3734 astArg2: AST.Node;
|
|
|
+ 3735 astBrace: AST.Node;
|
|
|
+ 3736 astRes: AST.Node; mname: SymTab.Name; isM: BOOLEAN;
|
|
|
+ 3737 isConvF: BOOLEAN;
|
|
|
+ 3738 fi, fj: CARDINAL; .)
|
|
|
+ 3739 = (. astIsLit := FALSE; .)
|
|
|
+ 3740 ( "__LINE__" (. QbeGen.IntStr(M2S.line, q);
|
|
|
+ 3741 astIsLit := TRUE;
|
|
|
+ 3742 astCur := AST.MakeLeaf(
|
|
|
+ 3743 AST.NkIntLit, q);
|
|
|
+ 3744 t := SymTab.IntType(); .)
|
|
|
+ 3745 | "__FUNCTION__" (. (* fold to the current procedure
|
|
|
+ 3746 (module name at unit level) *)
|
|
|
+ 3747 s[0] := '"'; fi := 1; fj := 0;
|
|
|
+ 3748 IF curFun[0] = CHR(0) THEN
|
|
|
+ 3749 WHILE (unitName[fj] # CHR(0))
|
|
|
+ 3750 AND (fi < HIGH(s)) DO
|
|
|
+ 3751 s[fi] := unitName[fj];
|
|
|
+ 3752 INC(fi); INC(fj)
|
|
|
+ 3753 END
|
|
|
+ 3754 ELSE
|
|
|
+ 3755 WHILE (curFun[fj] # CHR(0))
|
|
|
+ 3756 AND (fi < HIGH(s)) DO
|
|
|
+ 3757 s[fi] := curFun[fj];
|
|
|
+ 3758 INC(fi); INC(fj)
|
|
|
+ 3759 END
|
|
|
+ 3760 END;
|
|
|
+ 3761 s[fi] := '"';
|
|
|
+ 3762 s[fi + 1] := CHR(0);
|
|
|
+ 3763 astIsLit := TRUE;
|
|
|
+ 3764 astCur := AST.MakeLeaf(
|
|
|
+ 3765 AST.NkStrLit, s);
|
|
|
+ 3766 t := SymTab.NewStr();
|
|
|
+ 3767 QbeGen.DeclStr(s, q); .)
|
|
|
+ 3768 | "__FILE__" (. (* fold to the quoted file name *)
|
|
|
+ 3769 s[0] := '"'; fi := 1; fj := 0;
|
|
|
+ 3770 WHILE (M2S.fileName[fj] # CHR(0))
|
|
|
+ 3771 AND (fi < HIGH(s)) DO
|
|
|
+ 3772 s[fi] := M2S.fileName[fj];
|
|
|
+ 3773 INC(fi); INC(fj)
|
|
|
+ 3774 END;
|
|
|
+ 3775 s[fi] := '"';
|
|
|
+ 3776 s[fi + 1] := CHR(0);
|
|
|
+ 3777 astIsLit := TRUE;
|
|
|
+ 3778 astCur := AST.MakeLeaf(
|
|
|
+ 3779 AST.NkStrLit, s);
|
|
|
+ 3780 t := SymTab.NewStr();
|
|
|
+ 3781 QbeGen.DeclStr(s, q); .)
|
|
|
+ 3782 | integer (. LexString(s);
|
|
|
+ 3783 QbeGen.NormInt(s, q); astIsLit := TRUE; astCur := AST.MakeLeaf(AST.NkIntLit, s);
|
|
|
+ 3784 t := SymTab.IntType(); .)
|
|
|
+ 3785 | charConst (. LexString(s);
|
|
|
+ 3786 QbeGen.NormLit(s, q, isCh);
|
|
|
+ 3787 astIsLit := TRUE;
|
|
|
+ 3788 astCur := AST.MakeLeaf(
|
|
|
+ 3789 AST.NkCharLit, s);
|
|
|
+ 3790 t := SymTab.CharType(); .)
|
|
|
+ 3791 | real (. LexString(s);
|
|
|
+ 3792 QbeGen.NormReal(s, q);
|
|
|
+ 3793 astIsLit := TRUE;
|
|
|
+ 3794 astCur := AST.MakeLeaf(
|
|
|
+ 3795 AST.NkRealLit, s);
|
|
|
+ 3796 t := SymTab.RealType(); .)
|
|
|
+ 3797 | string (. LexString(s);
|
|
|
+ 3798 astIsLit := TRUE;
|
|
|
+ 3799 astCur := AST.MakeLeaf(
|
|
|
+ 3800 AST.NkStrLit, s);
|
|
|
+ 3801 IF SymTab.StrLen(s) = 3 THEN
|
|
|
+ 3802 t := SymTab.CharType();
|
|
|
+ 3803 QbeGen.IntStr(
|
|
|
+ 3804 QbeGen.CharVal(s), q)
|
|
|
+ 3805 ELSIF SymTab.StrLen(s) = 2 THEN
|
|
|
+ 3806 (* empty string: a string value
|
|
|
+ 3807 for arrays, 0 for CHAR *)
|
|
|
+ 3808 t := SymTab.NewEmptyStr();
|
|
|
+ 3809 QbeGen.DeclStr(s, q)
|
|
|
+ 3810 ELSE t := SymTab.NewStr();
|
|
|
+ 3811 QbeGen.DeclStr(s, q);
|
|
|
+ 3812 (* a literal's value IS its
|
|
|
+ 3813 static descriptor address *)
|
|
|
+ 3814 END; .)
|
|
|
+ 3815 | ustring (. LexString(s);
|
|
|
+ 3816 astIsLit := TRUE;
|
|
|
+ 3817 astCur := AST.MakeLeaf(
|
|
|
+ 3818 AST.NkStrLit, s);
|
|
|
+ 3819 QbeGen.DeclUStr(s, q, isU, ucp,
|
|
|
+ 3820 uok);
|
|
|
+ 3821 IF NOT uok THEN
|
|
|
+ 3822 SemError(234);
|
|
|
+ 3823 t := SymTab.InvalidType
|
|
|
+ 3824 ELSIF isU THEN
|
|
|
+ 3825 t := SymTab.UCharType();
|
|
|
+ 3826 QbeGen.IntStr(ucp, q)
|
|
|
+ 3827 ELSE
|
|
|
+ 3828 t := SymTab.NewUStr();
|
|
|
+ 3829 END; .)
|
|
|
+ 3830 | Design<dt, dk, qd, qn, sfx> (. astD := astCur; astCall := FALSE; astBrace := AST.NoNode;
|
|
|
+ 3831 astNArgs := 0; called := FALSE;
|
|
|
+ 3832 t := dt;
|
|
|
+ 3833 IF dk = SymTab.KindConst THEN
|
|
|
+ 3834 QbeGen.CopyOp(qd, q)
|
|
|
+ 3835 ELSE QbeGen.CopyOp("@", q)
|
|
|
+ 3836 END; .)
|
|
|
+ 3837 [ TypedBraceLit<dt, q> (. t := dt; astCall := TRUE;
|
|
|
+ 3838 astBrace := astCur; .) ]
|
|
|
+ 3839 [ ArgList<qn, dt, qd, TRUE, FALSE, methCls, ct2, q2, called>
|
|
|
+ 3840 (. astCall := TRUE;
|
|
|
+ 3841 IF (SymTab.SymKind(qn) = SymTab.KindType)
|
|
|
+ 3842 OR (SymTab.SymKind(qn) = SymTab.KindPredef) THEN
|
|
|
+ 3843 (* T(x): emit as the VAL builtin so Lower's
|
|
|
+ 3844 conversion rules apply unchanged *)
|
|
|
+ 3845 astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3846 AST.SetChild(astNode, 0,
|
|
|
+ 3847 AST.MakeLeaf(AST.NkIdent, "VAL"));
|
|
|
+ 3848 AST.SetChild(astNode, 1,
|
|
|
+ 3849 AST.MakeLeaf(AST.NkIdent, qn));
|
|
|
+ 3850 IF astNArgs = 1 THEN
|
|
|
+ 3851 AST.SetChild(astNode, 2, astArgs[0])
|
|
|
+ 3852 END;
|
|
|
+ 3853 isConvF := TRUE
|
|
|
+ 3854 ELSE astNode := AstCallNode(astD)
|
|
|
+ 3855 END;
|
|
|
+ 3856 astRes := astNode;
|
|
|
+ 3857 t := ct2;
|
|
|
+ 3858 QbeGen.CopyOp(q2, q);
|
|
|
+ 3859 IF isConvF AND QbeGen.IsImm(convQ)
|
|
|
+ 3860 AND OrdClass(convT) AND OrdClass(ct2) THEN
|
|
|
+ 3861 QbeGen.CopyOp(convQ, q)
|
|
|
+ 3862 END;
|
|
|
+ 3863 sfx := FALSE; .)
|
|
|
+ 3864 { ResultComp<t, q, sfx, astRes, mname, methCls, isM>
|
|
|
+ 3865 [ (. astNArgs := 0; .)
|
|
|
+ 3866 ArgList<mname, t, q, TRUE, FALSE, methCls, ct2, q2, called>
|
|
|
+ 3867 (. astNode := AstCallNode(astRes);
|
|
|
+ 3868 astRes := astNode;
|
|
|
+ 3869 t := ct2;
|
|
|
+ 3870 QbeGen.CopyOp(q2, q);
|
|
|
+ 3871 sfx := FALSE; .) ] }
|
|
|
+ 3872 (. IF sfx THEN
|
|
|
+ 3873 IF t = SymTab.InvalidType THEN
|
|
|
+ 3874 QbeGen.CopyOp("0", q)
|
|
|
+ 3875 ELSIF (SymTab.ClassOf(t) #
|
|
|
+ 3876 SymTab.ClRecord)
|
|
|
+ 3877 AND (SymTab.ClassOf(t) # SymTab.ClSet)
|
|
|
+ 3878 AND (SymTab.ClassOf(t) # SymTab.ClArray)
|
|
|
+ 3879 AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN
|
|
|
+ 3880 QbeGen.CopyOp("@", q)
|
|
|
+ 3881 END
|
|
|
+ 3882 END; .) ]
|
|
|
+ 3883 (. IF called THEN
|
|
|
+ 3884 astCur := astRes
|
|
|
+ 3885 ELSIF astCall THEN
|
|
|
+ 3886 astCur := astBrace
|
|
|
+ 3887 ELSE astCur := astD
|
|
|
+ 3888 END;
|
|
|
+ 3889 astIsLit := TRUE;
|
|
|
+ 3890 IF NOT called
|
|
|
+ 3891 AND (dk = SymTab.KindProc) THEN
|
|
|
+ 3892 (* bare zero-arg function
|
|
|
+ 3893 call (parentheses may be
|
|
|
+ 3894 omitted); a proper or
|
|
|
+ 3895 parameterised proc here
|
|
|
+ 3896 is 230 *)
|
|
|
+ 3897 IF (SymTab.ProcNPar(qn) = 0)
|
|
|
+ 3898 AND (SymTab.ProcRes(qn) # SymTab.InvalidType) THEN
|
|
|
+ 3899 t := SymTab.ProcRes(qn);
|
|
|
+ 3900 QbeGen.CopyOp("@", q);
|
|
|
+ 3901 astCur := AST.MakeNode(AST.NkCall);
|
|
|
+ 3902 AST.SetChild(astCur, 0, astD)
|
|
|
+ 3903 ELSE
|
|
|
+ 3904 t := SymTab.ProcTypeOf(qn);
|
|
|
+ 3905 QbeGen.CopyOp("@", q)
|
|
|
+ 3906 END
|
|
|
+ 3907 END; .)
|
|
|
+ 3908 | ( "HIGH" (. isHigh := TRUE; .)
|
|
|
+ 3909 | ( "LEN" | "LENGTH" ) (. isHigh := FALSE; .) )
|
|
|
+ 3910 "(" ( Design<dt, dk, qd, qn, sfx> (. isStr := FALSE;
|
|
|
+ 3911 isU := FALSE; .)
|
|
|
+ 3912 | string (. LexString(s); astCur := AST.MakeLeaf(AST.NkStrLit, s);
|
|
|
+ 3913 isStr := TRUE;
|
|
|
+ 3914 isU := FALSE;
|
|
|
+ 3915 IF SymTab.StrLen(s) = 3 THEN
|
|
|
+ 3916 dt := SymTab.CharType();
|
|
|
+ 3917 QbeGen.IntStr(QbeGen.CharVal(s),
|
|
|
+ 3918 qd)
|
|
|
+ 3919 ELSE
|
|
|
+ 3920 dt := SymTab.NewStr();
|
|
|
+ 3921 QbeGen.DeclStr(s, qd);
|
|
|
+ 3922 END;
|
|
|
+ 3923 dk := -1;
|
|
|
+ 3924 qn[0] := CHR(0); .)
|
|
|
+ 3925 | ustring (. LexString(s); astCur := AST.MakeLeaf(AST.NkStrLit, s);
|
|
|
+ 3926 QbeGen.DeclUStr(s, qd, isU, ucp,
|
|
|
+ 3927 uok);
|
|
|
+ 3928 isStr := FALSE;
|
|
|
+ 3929 IF NOT uok THEN
|
|
|
+ 3930 SemError(234);
|
|
|
+ 3931 dt := SymTab.InvalidType
|
|
|
+ 3932 ELSIF isU THEN
|
|
|
+ 3933 (* one codepoint: a UCHAR;
|
|
|
+ 3934 LEN is 1, HIGH is 0 *)
|
|
|
+ 3935 dt := SymTab.UCharType();
|
|
|
+ 3936 QbeGen.IntStr(ucp, qd)
|
|
|
+ 3937 ELSE
|
|
|
+ 3938 dt := SymTab.NewUStr();
|
|
|
+ 3939 END;
|
|
|
+ 3940 dk := -1;
|
|
|
+ 3941 qn[0] := CHR(0); .) )
|
|
|
+ 3942 ")"
|
|
|
+ 3943 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3944 IF isHigh THEN AST.SetChild(astNode, 0,
|
|
|
+ 3945 AST.MakeLeaf(AST.NkIdent, "HIGH"))
|
|
|
+ 3946 ELSE AST.SetChild(astNode, 0,
|
|
|
+ 3947 AST.MakeLeaf(AST.NkIdent, "LEN")) END;
|
|
|
+ 3948 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3949 astCur := astNode; astIsLit := TRUE;
|
|
|
+ 3950 IF (dt # SymTab.InvalidType)
|
|
|
+ 3951 AND (SymTab.ClassOf(dt) = SymTab.ClUStr) THEN
|
|
|
+ 3952 (* UString: the count is
|
|
|
+ 3953 the descriptor header *)
|
|
|
+ 3954 t := SymTab.IntType();
|
|
|
+ 3955 QbeGen.CopyOp("@", q)
|
|
|
+ 3956 ELSIF (dt # SymTab.InvalidType)
|
|
|
+ 3957 AND (SymTab.ClassOf(dt) = SymTab.ClUChar) THEN
|
|
|
+ 3958 (* single UCHAR codepoint *)
|
|
|
+ 3959 IF isHigh THEN
|
|
|
+ 3960 QbeGen.CopyOp("0", qr)
|
|
|
+ 3961 ELSE
|
|
|
+ 3962 QbeGen.CopyOp("1", qr)
|
|
|
+ 3963 END;
|
|
|
+ 3964 t := SymTab.IntType();
|
|
|
+ 3965 QbeGen.CopyOp(qr, q)
|
|
|
+ 3966 ELSIF isStr THEN
|
|
|
+ 3967 (* fold: content length at
|
|
|
+ 3968 compile time *)
|
|
|
+ 3969 IF SymTab.StrLen(s) = 3 THEN
|
|
|
+ 3970 c1 := 1
|
|
|
+ 3971 ELSE
|
|
|
+ 3972 c1 :=
|
|
|
+ 3973 SymTab.StrLen(s) - 2
|
|
|
+ 3974 END;
|
|
|
+ 3975 IF isHigh THEN
|
|
|
+ 3976 DEC(c1)
|
|
|
+ 3977 END;
|
|
|
+ 3978 QbeGen.IntStr(c1, qr);
|
|
|
+ 3979 t := SymTab.IntType();
|
|
|
+ 3980 QbeGen.CopyOp(qr, q)
|
|
|
+ 3981 ELSIF dt = SymTab.InvalidType THEN
|
|
|
+ 3982 t := SymTab.InvalidType;
|
|
|
+ 3983 QbeGen.CopyOp("0", q)
|
|
|
+ 3984 ELSIF SymTab.ClassOf(dt) =
|
|
|
+ 3985 SymTab.ClStr THEN
|
|
|
+ 3986 (* HIGH/LEN of a string
|
|
|
+ 3987 CONST: its pooled literal
|
|
|
+ 3988 knows its length *)
|
|
|
+ 3989 IF QbeGen.StrLitLen(qd, c1) THEN
|
|
|
+ 3990 IF isHigh THEN DEC(c1) END;
|
|
|
+ 3991 QbeGen.IntStr(VAL(INTEGER, c1),
|
|
|
+ 3992 qr);
|
|
|
+ 3993 t := SymTab.IntType();
|
|
|
+ 3994 QbeGen.CopyOp(qr, q)
|
|
|
+ 3995 ELSE SemError(217);
|
|
|
+ 3996 t := SymTab.InvalidType;
|
|
|
+ 3997 QbeGen.CopyOp("0", q)
|
|
|
+ 3998 END
|
|
|
+ 3999 ELSIF SymTab.ClassOf(dt) #
|
|
|
+ 4000 SymTab.ClArray THEN
|
|
|
+ 4001 SemError(217);
|
|
|
+ 4002 t := SymTab.InvalidType;
|
|
|
+ 4003 QbeGen.CopyOp("0", q)
|
|
|
+ 4004 ELSE
|
|
|
+ 4005 IF SymTab.IsOpenArray(dt) THEN
|
|
|
+ 4006 t := SymTab.IntType();
|
|
|
+ 4007 QbeGen.CopyOp("@", q)
|
|
|
+ 4008 ELSE
|
|
|
+ 4009 IF isHigh THEN
|
|
|
+ 4010 QbeGen.IntStr(
|
|
|
+ 4011 SymTab.ArrayHi(dt), qr)
|
|
|
+ 4012 ELSE
|
|
|
+ 4013 QbeGen.IntStr(VAL(
|
|
|
+ 4014 INTEGER,
|
|
|
+ 4015 SymTab.ArrayLen(dt)),
|
|
|
+ 4016 qr)
|
|
|
+ 4017 END;
|
|
|
+ 4018 t := SymTab.IntType();
|
|
|
+ 4019 QbeGen.CopyOp(qr, q)
|
|
|
+ 4020 END
|
|
|
+ 4021 END; .)
|
|
|
+ 4022 | ( "SIZE" | "TSIZE" ) "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
+ 4023 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 4024 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "SIZE"));
|
|
|
+ 4025 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 4026 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 4027 (. IF dt = SymTab.InvalidType THEN
|
|
|
+ 4028 t := SymTab.InvalidType;
|
|
|
+ 4029 QbeGen.CopyOp("0", q)
|
|
|
+ 4030 ELSE
|
|
|
+ 4031 QbeGen.IntStr(VAL(INTEGER,
|
|
|
+ 4032 SymTab.ObjectSize(dt)), q);
|
|
|
+ 4033 t := SymTab.IntType()
|
|
|
+ 4034 END; .)
|
|
|
+ 4035 | ( "SHIFT" (. isMax := FALSE; .)
|
|
|
+ 4036 | "ROTATE" (. isMax := TRUE; .) )
|
|
|
+ 4037 "(" Expr<et, q> (. astArg2 := astCur; .) "," Expr<et2, q2> ")"
|
|
|
+ 4038 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 4039 IF isMax THEN AST.SetChild(astNode, 0,
|
|
|
+ 4040 AST.MakeLeaf(AST.NkIdent, "ROTATE"))
|
|
|
+ 4041 ELSE AST.SetChild(astNode, 0,
|
|
|
+ 4042 AST.MakeLeaf(AST.NkIdent, "SHIFT")) END;
|
|
|
+ 4043 IF astArg2 # AST.NoNode THEN AST.SetChild(astNode, 1, astArg2) END;
|
|
|
+ 4044 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
+ 4045 astCur := astNode; astIsLit := TRUE;
|
|
|
+ 4046 (* set shift/rotate: isMax
|
|
|
+ 4047 doubles as "rotate" *)
|
|
|
+ 4048 IF (et # SymTab.InvalidType)
|
|
|
+ 4049 AND (SymTab.ClassOf(et) =
|
|
|
+ 4050 SymTab.ClSet) THEN
|
|
|
+ 4051 t := et;
|
|
|
+ 4052 QbeGen.CopyOp("@", q)
|
|
|
+ 4053 ELSE SemError(230);
|
|
|
+ 4054 t := SymTab.InvalidType;
|
|
|
+ 4055 QbeGen.CopyOp("0", q)
|
|
|
+ 4056 END; .)
|
|
|
+ 4057 | ( "MIN" (. isMax := FALSE; .)
|
|
|
+ 4058 | "MAX" (. isMax := TRUE; .) )
|
|
|
+ 4059 "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
+ 4060 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 4061 IF isMax THEN AST.SetChild(astNode, 0,
|
|
|
+ 4062 AST.MakeLeaf(AST.NkIdent, "MAX"))
|
|
|
+ 4063 ELSE AST.SetChild(astNode, 0,
|
|
|
+ 4064 AST.MakeLeaf(AST.NkIdent, "MIN")) END;
|
|
|
+ 4065 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 4066 astCur := astNode; astIsLit := TRUE;
|
|
|
+ 4067 IF (dt # SymTab.InvalidType)
|
|
|
+ 4068 AND (SymTab.ClassOf(dt) = SymTab.ClReal) THEN
|
|
|
+ 4069 (* REAL/LONGREAL: the
|
|
|
+ 4070 implementation bounds *)
|
|
|
+ 4071 IF isMax THEN
|
|
|
+ 4072 QbeGen.NormReal(
|
|
|
+ 4073 "3.402823e38", q)
|
|
|
+ 4074 ELSE QbeGen.NormReal(
|
|
|
+ 4075 "-3.402823e38", q)
|
|
|
+ 4076 END;
|
|
|
+ 4077 t := SymTab.RealType()
|
|
|
+ 4078 ELSIF (dt #
|
|
|
+ 4079 SymTab.InvalidType)
|
|
|
+ 4080 AND (SymTab.ClassOf(dt) =
|
|
|
+ 4081 SymTab.ClLong) THEN
|
|
|
+ 4082 IF isMax THEN
|
|
|
+ 4083 QbeGen.CopyOp(
|
|
|
+ 4084 "9223372036854775807", q)
|
|
|
+ 4085 ELSE QbeGen.CopyOp(
|
|
|
+ 4086 "-9223372036854775808", q)
|
|
|
+ 4087 END;
|
|
|
+ 4088 t := SymTab.LongType()
|
|
|
+ 4089 ELSIF SymTab.TypeBounds(dt, lo,
|
|
|
+ 4090 hi) THEN
|
|
|
+ 4091 IF isMax THEN
|
|
|
+ 4092 QbeGen.IntStr(hi, q)
|
|
|
+ 4093 ELSE QbeGen.IntStr(lo, q)
|
|
|
+ 4094 END;
|
|
|
+ 4095 (* a set's bounds are those
|
|
|
+ 4096 of its base type *)
|
|
|
+ 4097 IF SymTab.ClassOf(dt) =
|
|
|
+ 4098 SymTab.ClSet THEN
|
|
|
+ 4099 t := SymTab.SetBase(dt)
|
|
|
+ 4100 ELSE t := SymTab.IntType()
|
|
|
+ 4101 END
|
|
|
+ 4102 ELSE SemError(230);
|
|
|
+ 4103 t := SymTab.InvalidType;
|
|
|
+ 4104 QbeGen.CopyOp("0", q)
|
|
|
+ 4105 END; .)
|
|
|
+ 4106 | "ADR" "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
+ 4107 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 4108 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ADR"));
|
|
|
+ 4109 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 4110 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 4111 (. IF dt = SymTab.InvalidType THEN
|
|
|
+ 4112 t := SymTab.InvalidType;
|
|
|
+ 4113 QbeGen.CopyOp("0", q)
|
|
|
+ 4114 ELSE
|
|
|
+ 4115 IF sfx
|
|
|
+ 4116 OR (dk = SymTab.KindVar)
|
|
|
+ 4117 OR (dk = SymTab.KindParam) THEN
|
|
|
+ 4118 QbeGen.CopyOp("@", q)
|
|
|
+ 4119 ELSE SemError(230);
|
|
|
+ 4120 QbeGen.CopyOp("0", q)
|
|
|
+ 4121 END;
|
|
|
+ 4122 t := SymTab.AddrType()
|
|
|
+ 4123 END; .)
|
|
|
+ 4124 | "CHR" "(" Expr<et, q> ")"
|
|
|
+ 4125 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 4126 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CHR"));
|
|
|
+ 4127 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 4128 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 4129 (. IF (et # SymTab.InvalidType)
|
|
|
+ 4130 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
+ 4131 SemError(211) END;
|
|
|
+ 4132 t := SymTab.CharType(); .)
|
|
|
+ 4133 | "ORD" "(" Expr<et, q> ")"
|
|
|
+ 4134 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 4135 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ORD"));
|
|
|
+ 4136 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 4137 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 4138 (. IF et # SymTab.InvalidType THEN
|
|
|
+ 4139 IF (SymTab.ClassOf(et) #
|
|
|
+ 4140 SymTab.ClChar)
|
|
|
+ 4141 AND (SymTab.ClassOf(et) #
|
|
|
+ 4142 SymTab.ClBool)
|
|
|
+ 4143 AND (SymTab.ClassOf(et) #
|
|
|
+ 4144 SymTab.ClEnum)
|
|
|
+ 4145 AND NOT SymTab.IsIntFamily(et)
|
|
|
+ 4146 AND NOT SymTab.IsPackedSet(et) THEN
|
|
|
+ 4147 SemError(211) END
|
|
|
+ 4148 END;
|
|
|
+ 4149 t := SymTab.IntType(); .)
|
|
|
+ 4150 | "CAP" "(" Expr<et, q> ")"
|
|
|
+ 4151 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 4152 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CAP"));
|
|
|
+ 4153 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 4154 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 4155 (. IF QbeGen.IsImm(q)
|
|
|
+ 4156 AND SymTab.ConstInt(q, lo) THEN
|
|
|
+ 4157 IF (lo >= VAL(INTEGER, ORD("a"))) AND (lo <= VAL(INTEGER, ORD("z"))) THEN lo := lo - 32 END;
|
|
|
+ 4158 QbeGen.IntStr(lo, q)
|
|
|
+ 4159 ELSE QbeGen.CopyOp("@", q)
|
|
|
+ 4160 END;
|
|
|
+ 4161 t := SymTab.CharType(); .)
|
|
|
+ 4162 | "UCHR" "(" Expr<et, q> ")"
|
|
|
+ 4163 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 4164 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "UCHR"));
|
|
|
+ 4165 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 4166 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 4167 (. (* UCHR: the UCHAR constructor.
|
|
|
+ 4168 CHAR -> UCHAR (identity);
|
|
|
+ 4169 INTEGER familly -> UCHAR
|
|
|
+ 4170 (codepoint value). *)
|
|
|
+ 4171 IF (et # SymTab.InvalidType)
|
|
|
+ 4172 AND (SymTab.ClassOf(et) # SymTab.ClChar)
|
|
|
+ 4173 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
+ 4174 SemError(211) END;
|
|
|
+ 4175 t := SymTab.UCharType(); .)
|
|
|
+ 4176 | "CHR8" "(" Expr<et, q> ")"
|
|
|
+ 4177 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 4178 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CHR8"));
|
|
|
+ 4179 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 4180 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 4181 (. IF (et # SymTab.InvalidType)
|
|
|
+ 4182 AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
|
|
|
+ 4183 SemError(211) END;
|
|
|
+ 4184 t := SymTab.CharType(); .)
|
|
|
+ 4185 | "UORD" "(" Expr<et, q> ")"
|
|
|
+ 4186 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 4187 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "UORD"));
|
|
|
+ 4188 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 4189 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 4190 (. (* UORD(u): the codepoint as a
|
|
|
+ 4191 32-bit ordinal (INTEGER),
|
|
|
+ 4192 cf. ORD for CHAR. *)
|
|
|
+ 4193 IF (et # SymTab.InvalidType)
|
|
|
+ 4194 AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
|
|
|
+ 4195 SemError(211) END;
|
|
|
+ 4196 t := SymTab.IntType(); .)
|
|
|
+ 4197 | "ABS" "(" Expr<et, q> ")"
|
|
|
+ 4198 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 4199 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ABS"));
|
|
|
+ 4200 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 4201 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 4202 (. IF (et # SymTab.InvalidType)
|
|
|
+ 4203 AND NOT SymTab.IsIntFamily(et)
|
|
|
+ 4204 AND (SymTab.ClassOf(et) #
|
|
|
+ 4205 SymTab.ClReal) THEN
|
|
|
+ 4206 SemError(211)
|
|
|
+ 4207 ELSIF QbeGen.IsImm(q)
|
|
|
+ 4208 AND SymTab.ConstInt(q, lo) THEN
|
|
|
+ 4209 IF lo < 0 THEN lo := -lo END;
|
|
|
+ 4210 QbeGen.IntStr(lo, q)
|
|
|
+ 4211 ELSE QbeGen.CopyOp("@", q)
|
|
|
+ 4212 END;
|
|
|
+ 4213 t := et; .)
|
|
|
+ 4214 | "ODD" "(" Expr<et, q> ")"
|
|
|
+ 4215 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 4216 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ODD"));
|
|
|
+ 4217 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 4218 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 4219 (. IF (et # SymTab.InvalidType)
|
|
|
+ 4220 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
+ 4221 SemError(211) END;
|
|
|
+ 4222 t := SymTab.BoolType();
|
|
|
+ 4223 IF QbeGen.IsImm(q)
|
|
|
+ 4224 AND SymTab.ConstInt(q, lo) THEN
|
|
|
+ 4225 IF (lo MOD 2) # 0 THEN
|
|
|
+ 4226 QbeGen.CopyOp("1", q)
|
|
|
+ 4227 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 4228 END
|
|
|
+ 4229 ELSE QbeGen.CopyOp("@", q)
|
|
|
+ 4230 END; .)
|
|
|
+ 4231 | "TRUNC" "(" Expr<et, q> ")"
|
|
|
+ 4232 (. (* TRUNC(x): real -> INTEGER, as the VAL builtin *)
|
|
|
+ 4233 astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 4234 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "VAL"));
|
|
|
+ 4235 AST.SetChild(astNode, 1, AST.MakeLeaf(AST.NkIdent, "INTEGER"));
|
|
|
+ 4236 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
+ 4237 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 4238 (. t := SymTab.IntType();
|
|
|
+ 4239 QbeGen.CopyOp("@", q); .)
|
|
|
+ 4240 | "FLOAT" "(" Expr<et, q> ")"
|
|
|
+ 4241 (. (* FLOAT(i): integer -> REAL, as the VAL builtin *)
|
|
|
+ 4242 astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 4243 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "VAL"));
|
|
|
+ 4244 AST.SetChild(astNode, 1, AST.MakeLeaf(AST.NkIdent, "REAL"));
|
|
|
+ 4245 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
+ 4246 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 4247 (. t := SymTab.RealType();
|
|
|
+ 4248 IF QbeGen.IsImm(q) AND SymTab.ConstInt(q, lo) THEN QbeGen.NormReal(q, qa); QbeGen.CopyOp(qa, q)
|
|
|
+ 4249 ELSE QbeGen.CopyOp("@", q) END; .)
|
|
|
+ 4250 | ( "VAL" | "CONVERT" | "CAST" ) "(" GetIdent<vn> (. astArg2 := AST.MakeLeaf(AST.NkIdent, vn); .) "," Expr<et, q> ")"
|
|
|
+ 4251 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 4252 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "VAL"));
|
|
|
+ 4253 IF astArg2 # AST.NoNode THEN AST.SetChild(astNode, 1, astArg2) END;
|
|
|
+ 4254 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
+ 4255 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 4256 (. IF NOT SymTab.Lookup(vn) THEN
|
|
|
+ 4257 SemError(201);
|
|
|
+ 4258 t := SymTab.InvalidType
|
|
|
+ 4259 ELSE vt := SymTab.SymType(vn);
|
|
|
+ 4260 IF vt = SymTab.InvalidType THEN
|
|
|
+ 4261 t := SymTab.InvalidType
|
|
|
+ 4262 ELSIF et =
|
|
|
+ 4263 SymTab.InvalidType THEN
|
|
|
+ 4264 t := vt
|
|
|
+ 4265 ELSE
|
|
|
+ 4266 c1 := SymTab.ClassOf(et);
|
|
|
+ 4267 c2 := SymTab.ClassOf(vt);
|
|
|
+ 4268 IF ((c1 = SymTab.ClInt)
|
|
|
+ 4269 OR (c1 = SymTab.ClByte) OR (c1 = SymTab.ClSByte)
|
|
|
+ 4270 OR (c1 = SymTab.ClWord16) OR (c1 = SymTab.ClSWord16))
|
|
|
+ 4271 AND (c2 = SymTab.ClLong) THEN
|
|
|
+ 4272 IF NOT QbeGen.IsImm(q) THEN QbeGen.WidenLong(q, qa); QbeGen.CopyOp(qa, q) END;
|
|
|
+ 4273 t := vt
|
|
|
+ 4274 ELSIF (c1 = SymTab.ClLong)
|
|
|
+ 4275 AND ((c2 = SymTab.ClInt) OR (c2 = SymTab.ClByte)
|
|
|
+ 4276 OR (c2 = SymTab.ClSByte) OR (c2 = SymTab.ClWord16)
|
|
|
+ 4277 OR (c2 = SymTab.ClSWord16)) THEN
|
|
|
+ 4278 IF NOT (QbeGen.IsImm(q) AND SymTab.ConstInt(q, lo)) THEN QbeGen.NarrowLong(q, qa); QbeGen.CopyOp(qa, q) END;
|
|
|
+ 4279 t := vt
|
|
|
+ 4280 ELSIF ((c1 = SymTab.ClInt)
|
|
|
+ 4281 OR (c1 = SymTab.ClByte) OR (c1 = SymTab.ClSByte)
|
|
|
+ 4282 OR (c1 = SymTab.ClWord16) OR (c1 = SymTab.ClSWord16))
|
|
|
+ 4283 AND (c2 = SymTab.ClReal) THEN
|
|
|
+ 4284 IF QbeGen.IsImm(q) AND SymTab.ConstInt(q, lo) THEN QbeGen.NormReal(q, qa) ELSE QbeGen.ConvIR(q, qa) END;
|
|
|
+ 4285 QbeGen.CopyOp(qa, q);
|
|
|
+ 4286 t := vt
|
|
|
+ 4287 ELSIF (c1 = SymTab.ClLong)
|
|
|
+ 4288 AND (c2 = SymTab.ClReal) THEN
|
|
|
+ 4289 IF QbeGen.IsImm(q) AND SymTab.ConstInt(q, lo) THEN QbeGen.NormReal(q, qa) ELSE QbeGen.ConvLR(q, qa) END;
|
|
|
+ 4290 QbeGen.CopyOp(qa, q);
|
|
|
+ 4291 t := vt
|
|
|
+ 4292 ELSIF (c1 = SymTab.ClReal)
|
|
|
+ 4293 AND ((c2 = SymTab.ClInt) OR (c2 = SymTab.ClByte)
|
|
|
+ 4294 OR (c2 = SymTab.ClSByte) OR (c2 = SymTab.ClWord16)
|
|
|
+ 4295 OR (c2 = SymTab.ClSWord16)) THEN
|
|
|
+ 4296 QbeGen.ConvRI(q, qa);
|
|
|
+ 4297 QbeGen.CopyOp(qa, q);
|
|
|
+ 4298 t := vt
|
|
|
+ 4299 ELSIF (c1 = SymTab.ClReal)
|
|
|
+ 4300 AND (c2 = SymTab.ClLong) THEN
|
|
|
+ 4301 QbeGen.ConvRL(q, qa);
|
|
|
+ 4302 QbeGen.CopyOp(qa, q);
|
|
|
+ 4303 t := vt
|
|
|
+ 4304 ELSIF (c1 = SymTab.ClLong)
|
|
|
+ 4305 AND (c2 = SymTab.ClLong) THEN
|
|
|
+ 4306 t := vt
|
|
|
+ 4307 ELSIF ((c1 = SymTab.ClInt)
|
|
|
+ 4308 OR (c1 =
|
|
|
+ 4309 SymTab.ClChar)
|
|
|
+ 4310 OR (c1 =
|
|
|
+ 4311 SymTab.ClBool)
|
|
|
+ 4312 OR (c1 =
|
|
|
+ 4313 SymTab.ClByte)
|
|
|
+ 4314 OR (c1 =
|
|
|
+ 4315 SymTab.ClSByte)
|
|
|
+ 4316 OR (c1 =
|
|
|
+ 4317 SymTab.ClWord16)
|
|
|
+ 4318 OR (c1 =
|
|
|
+ 4319 SymTab.ClSWord16)
|
|
|
+ 4320 OR (c1 =
|
|
|
+ 4321 SymTab.ClEnum))
|
|
|
+ 4322 AND ((c2 = SymTab.ClInt)
|
|
|
+ 4323 OR (c2 =
|
|
|
+ 4324 SymTab.ClChar)
|
|
|
+ 4325 OR (c2 =
|
|
|
+ 4326 SymTab.ClBool)
|
|
|
+ 4327 OR (c2 =
|
|
|
+ 4328 SymTab.ClByte)
|
|
|
+ 4329 OR (c2 =
|
|
|
+ 4330 SymTab.ClSByte)
|
|
|
+ 4331 OR (c2 =
|
|
|
+ 4332 SymTab.ClWord16)
|
|
|
+ 4333 OR (c2 =
|
|
|
+ 4334 SymTab.ClSWord16)
|
|
|
+ 4335 OR (c2 =
|
|
|
+ 4336 SymTab.ClEnum)) THEN
|
|
|
+ 4337 t := vt
|
|
|
+ 4338 ELSIF (c1 = SymTab.ClPtr)
|
|
|
+ 4339 AND (c2 = SymTab.ClPtr) THEN
|
|
|
+ 4340 t := vt
|
|
|
+ 4341 ELSIF ((c1 = SymTab.ClProc)
|
|
|
+ 4342 AND (c2 = SymTab.ClProc))
|
|
|
+ 4343 OR ((c1 = SymTab.ClProc) AND (c2 = SymTab.ClPtr))
|
|
|
+ 4344 OR ((c1 = SymTab.ClPtr) AND (c2 = SymTab.ClProc)) THEN
|
|
|
+ 4345 t := vt
|
|
|
+ 4346 ELSIF (c1 = SymTab.ClReal)
|
|
|
+ 4347 AND (c2 = SymTab.ClReal) THEN
|
|
|
+ 4348 t := vt
|
|
|
+ 4349 ELSIF ((c1 = SymTab.ClSet) AND (c2 = SymTab.ClInt))
|
|
|
+ 4350 OR ((c1 = SymTab.ClInt) AND (c2 = SymTab.ClSet)) THEN
|
|
|
+ 4351 (* a set <-> its machine word (BITSET) *)
|
|
|
+ 4352 t := vt
|
|
|
+ 4353 ELSE SemError(230);
|
|
|
+ 4354 t := SymTab.InvalidType
|
|
|
+ 4355 END
|
|
|
+ 4356 END
|
|
|
+ 4357 END; .)
|
|
|
+ 4358 | "(" Expr<et, q> ")" (. t := et; astIsLit := TRUE; .)
|
|
|
+ 4359 | SetLit<st, sq> (. astIsLit := TRUE; t := st;
|
|
|
+ 4360 QbeGen.CopyOp(sq, q); .)
|
|
|
+ 4361 | ( "NOT" | "~" ) Fact<t2, q2> (. astNot := astCur;
|
|
|
+ 4362 IF SymTab.BoolCheck(t2) THEN
|
|
|
+ 4363 t := SymTab.BoolType()
|
|
|
+ 4364 ELSE SemError(212);
|
|
|
+ 4365 t := SymTab.InvalidType END;
|
|
|
+ 4366 IF t # SymTab.InvalidType THEN
|
|
|
+ 4367 QbeGen.CopyOp("@", q)
|
|
|
+ 4368 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 4369 END;
|
|
|
+ 4370 astIsLit := TRUE;
|
|
|
+ 4371 astCur := AST.MakeUn(
|
|
|
+ 4372 AST.NkUnary, AST.OpNot, astNot); .)
|
|
|
+ 4373 )
|
|
|
+ 4374 (. IF NOT astIsLit THEN astCur := AST.NoNode END; .)
|
|
|
+ 4375 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
+ 4376 (* Set literals are SET OF [0..255] (8 words); elements validated
|
|
|
+ 4377 0..255 statically when foldable (222 otherwise), runtime trap
|
|
|
+ 4378 for computed elements. Ranges always lower via SetRange. *)
|
|
|
+ 4379 SetLit<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 4380 (. VAR astNode: AST.Node; .)
|
|
|
+ 4381 = "{" (. t := SymTab.NewSet(
|
|
|
+ 4382 SymTab.NewSubR(0, 255));
|
|
|
+ 4383 astNode := AST.MakeNode(AST.NkSetLit);
|
|
|
+ 4384 QbeGen.NewSetTemp(8, q);
|
|
|
+ 4385 QbeGen.SetZero(q, 8); .)
|
|
|
+ 4386 [ SetElem<t, q, astNode> { "," SetElem<t, q, astNode> } ]
|
|
|
+ 4387 "}" (. astCur := astNode; .) .
|
|
|
+ 4388 (* Typed brace constructor: TypeName{ elems } — BITSET{0} (a set)
|
|
|
+ 4389 or ArrayName{...} (an array constructor, GNU Modula-2). The
|
|
|
+ 4390 declared type sets the width (set) or element type (array). *)
|
|
|
+ 4391 TypedBraceLit<vt: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 4392 (. VAR nw: CARDINAL;
|
|
|
+ 4393 astNode, astTail: AST.Node;
|
|
|
+ 4394 savedCls: INTEGER; .)
|
|
|
+ 4395 = "{" (. savedCls := braceCls;
|
|
|
+ 4396 astNode := AST.MakeNode(AST.NkBraceLit);
|
|
|
+ 4397 AST.SetTy(astNode, vt);
|
|
|
+ 4398 astTail := astNode;
|
|
|
+ 4399 IF vt = SymTab.InvalidType THEN
|
|
|
+ 4400 braceCls := -1
|
|
|
+ 4401 ELSE braceCls :=
|
|
|
+ 4402 SymTab.ClassOf(vt)
|
|
|
+ 4403 END;
|
|
|
+ 4404 IF braceCls = SymTab.ClSet THEN
|
|
|
+ 4405 IF vt = SymTab.InvalidType THEN
|
|
|
+ 4406 nw := 8
|
|
|
+ 4407 ELSE nw := SymTab.SetWords(vt);
|
|
|
+ 4408 IF nw = 0 THEN nw := 8 END
|
|
|
+ 4409 END;
|
|
|
+ 4410 QbeGen.NewSetTemp(nw, q);
|
|
|
+ 4411 QbeGen.SetZero(q, nw)
|
|
|
+ 4412 ELSIF (braceCls =
|
|
|
+ 4413 SymTab.ClArray)
|
|
|
+ 4414 OR (braceCls =
|
|
|
+ 4415 SymTab.ClRecord)
|
|
|
+ 4416 OR (braceCls =
|
|
|
+ 4417 SymTab.ClClass) THEN
|
|
|
+ 4418 QbeGen.CtorBegin(vt)
|
|
|
+ 4419 ELSE
|
|
|
+ 4420 IF vt # SymTab.InvalidType THEN
|
|
|
+ 4421 SemError(230) END;
|
|
|
+ 4422 braceCls := -1
|
|
|
+ 4423 END; .)
|
|
|
+ 4424 [ BraceElem<vt, q, astNode, astTail>
|
|
|
+ 4425 { "," BraceElem<vt, q, astNode, astTail> } ]
|
|
|
+ 4426 "}" (. IF (braceCls = SymTab.ClArray)
|
|
|
+ 4427 OR (braceCls =
|
|
|
+ 4428 SymTab.ClRecord)
|
|
|
+ 4429 OR (braceCls =
|
|
|
+ 4430 SymTab.ClClass) THEN
|
|
|
+ 4431 QbeGen.CtorEnd(q)
|
|
|
+ 4432 ELSIF braceCls # SymTab.ClSet THEN
|
|
|
+ 4433 QbeGen.CopyOp("0", q)
|
|
|
+ 4434 END;
|
|
|
+ 4435 braceCls := savedCls; .)
|
|
|
+ 4436 (. astCur := astNode; .) .
|
|
|
+ 4437 BraceElem<vt: SymTab.TypeIndex; VAR sq: QbeGen.QVal;
|
|
|
+ 4438 VAR node, tail: AST.Node>
|
|
|
+ 4439 (. VAR et, et2: SymTab.TypeIndex;
|
|
|
+ 4440 qe, q2: QbeGen.QVal;
|
|
|
+ 4441 v, v2, reps, k: INTEGER;
|
|
|
+ 4442 elem: SymTab.TypeIndex;
|
|
|
+ 4443 lo: INTEGER;
|
|
|
+ 4444 span: CARDINAL;
|
|
|
+ 4445 cl, cl2: INTEGER;
|
|
|
+ 4446 hasR, hasB: BOOLEAN;
|
|
|
+ 4447 astEl: AST.Node; .)
|
|
|
+ 4448 = (. hasR := FALSE; hasB := FALSE;
|
|
|
+ 4449 reps := 1; .)
|
|
|
+ 4450 Expr<et, qe> (. astEl := astCur; .)
|
|
|
+ 4451 [ ".." Expr<et2, q2> (. astEl := AST.MakeBin(
|
|
|
+ 4452 AST.NkSubrange, 0, astEl, astCur);
|
|
|
+ 4453 hasR := TRUE; .) ]
|
|
|
+ 4454 [ "BY" Expr<et2, q2> (. hasB := TRUE; .) ]
|
|
|
+ 4455 (. IF braceCls = SymTab.ClSet THEN
|
|
|
+ 4456 IF hasB THEN SemError(230) END;
|
|
|
+ 4457 lo := SymTab.SetBaseLo(vt);
|
|
|
+ 4458 span := SymTab.SetCount(vt);
|
|
|
+ 4459 IF (et = SymTab.InvalidType)
|
|
|
+ 4460 OR (hasR AND (et2 =
|
|
|
+ 4461 SymTab.InvalidType)) THEN
|
|
|
+ 4462 ELSE cl :=
|
|
|
+ 4463 SymTab.ClassOf(et);
|
|
|
+ 4464 IF hasR THEN
|
|
|
+ 4465 cl2 :=
|
|
|
+ 4466 SymTab.ClassOf(et2)
|
|
|
+ 4467 ELSE cl2 := SymTab.ClInt
|
|
|
+ 4468 END;
|
|
|
+ 4469 IF NOT SymTab.SetElemClassOk(cl)
|
|
|
+ 4470 OR (hasR AND NOT
|
|
|
+ 4471 SymTab.SetElemClassOk(cl2))
|
|
|
+ 4472 THEN
|
|
|
+ 4473 SemError(222)
|
|
|
+ 4474 ELSIF hasR
|
|
|
+ 4475 AND SymTab.ConstInt(qe, v)
|
|
|
+ 4476 AND SymTab.ConstInt(q2,
|
|
|
+ 4477 v2)
|
|
|
+ 4478 AND ((v < lo)
|
|
|
+ 4479 OR (v2 < lo)
|
|
|
+ 4480 OR (v >= lo +
|
|
|
+ 4481 VAL(INTEGER, span))
|
|
|
+ 4482 OR (v2 >= lo +
|
|
|
+ 4483 VAL(INTEGER, span))
|
|
|
+ 4484 OR (v > v2)) THEN
|
|
|
+ 4485 SemError(222)
|
|
|
+ 4486 ELSIF hasR THEN
|
|
|
+ 4487 QbeGen.SetRange(sq, qe, q2,
|
|
|
+ 4488 lo, span)
|
|
|
+ 4489 ELSIF SymTab.ConstInt(qe,
|
|
|
+ 4490 v)
|
|
|
+ 4491 AND ((v < lo)
|
|
|
+ 4492 OR (v >= lo +
|
|
|
+ 4493 VAL(INTEGER,
|
|
|
+ 4494 span))) THEN
|
|
|
+ 4495 SemError(222)
|
|
|
+ 4496 ELSE QbeGen.SetBit(sq, qe,
|
|
|
+ 4497 lo, span)
|
|
|
+ 4498 END
|
|
|
+ 4499 END
|
|
|
+ 4500 ELSIF (braceCls = SymTab.ClArray)
|
|
|
+ 4501 OR (braceCls =
|
|
|
+ 4502 SymTab.ClRecord)
|
|
|
+ 4503 OR (braceCls =
|
|
|
+ 4504 SymTab.ClClass) THEN
|
|
|
+ 4505 IF hasR THEN SemError(230) END;
|
|
|
+ 4506 reps := 1;
|
|
|
+ 4507 IF hasB THEN
|
|
|
+ 4508 IF SymTab.ConstInt(q2, v2)
|
|
|
+ 4509 AND (v2 >= 1) THEN
|
|
|
+ 4510 reps := v2
|
|
|
+ 4511 ELSE SemError(230)
|
|
|
+ 4512 END
|
|
|
+ 4513 END;
|
|
|
+ 4514 k := 0;
|
|
|
+ 4515 WHILE k < reps DO
|
|
|
+ 4516 QbeGen.CtorElem(qe);
|
|
|
+ 4517 INC(k)
|
|
|
+ 4518 END
|
|
|
+ 4519 END; .)
|
|
|
+ 4520 (. (* the BY form repeats the
|
|
|
+ 4521 element; keep the AST in
|
|
|
+ 4522 step with CtorElem *)
|
|
|
+ 4523 k := 0;
|
|
|
+ 4524 WHILE k < reps DO
|
|
|
+ 4525 AstAppend(AST.NkBlock,
|
|
|
+ 4526 node, tail, astEl);
|
|
|
+ 4527 INC(k)
|
|
|
+ 4528 END; .) .
|
|
|
+ 4529 SetElem<st: SymTab.TypeIndex; sq: QbeGen.QVal; node: AST.Node> (. VAR et, et2: SymTab.TypeIndex;
|
|
|
+ 4530 qe, q2: QbeGen.QVal;
|
|
|
+ 4531 v, v2: INTEGER;
|
|
|
+ 4532 lo: INTEGER;
|
|
|
+ 4533 span: CARDINAL;
|
|
|
+ 4534 cl, cl2: INTEGER;
|
|
|
+ 4535 hasR: BOOLEAN;
|
|
|
+ 4536 astEl: AST.Node; .)
|
|
|
+ 4537 = (. hasR := FALSE; .)
|
|
|
+ 4538 Expr<et, qe> (. astEl := astCur; .)
|
|
|
+ 4539 [ ".." Expr<et2, q2> (. astEl := AST.MakeBin(
|
|
|
+ 4540 AST.NkSubrange, 0, astEl, astCur);
|
|
|
+ 4541 hasR := TRUE; .) ]
|
|
|
+ 4542 (. lo := SymTab.SetBaseLo(st);
|
|
|
+ 4543 span := SymTab.SetCount(st);
|
|
|
+ 4544 IF (et = SymTab.InvalidType)
|
|
|
+ 4545 OR (hasR AND (et2 =
|
|
|
+ 4546 SymTab.InvalidType)) THEN
|
|
|
+ 4547 ELSE cl :=
|
|
|
+ 4548 SymTab.ClassOf(et);
|
|
|
+ 4549 IF hasR THEN
|
|
|
+ 4550 cl2 :=
|
|
|
+ 4551 SymTab.ClassOf(et2)
|
|
|
+ 4552 ELSE cl2 := SymTab.ClInt
|
|
|
+ 4553 END;
|
|
|
+ 4554 IF NOT SymTab.SetElemClassOk(cl)
|
|
|
+ 4555 OR (hasR AND NOT
|
|
|
+ 4556 SymTab.SetElemClassOk(cl2))
|
|
|
+ 4557 THEN
|
|
|
+ 4558 SemError(222)
|
|
|
+ 4559 ELSIF hasR
|
|
|
+ 4560 AND SymTab.ConstInt(qe, v)
|
|
|
+ 4561 AND SymTab.ConstInt(q2,
|
|
|
+ 4562 v2)
|
|
|
+ 4563 AND ((v < lo)
|
|
|
+ 4564 OR (v2 < lo)
|
|
|
+ 4565 OR (v >= lo +
|
|
|
+ 4566 VAL(INTEGER, span))
|
|
|
+ 4567 OR (v2 >= lo +
|
|
|
+ 4568 VAL(INTEGER, span))
|
|
|
+ 4569 OR (v > v2)) THEN
|
|
|
+ 4570 SemError(222)
|
|
|
+ 4571 ELSIF hasR THEN
|
|
|
+ 4572 QbeGen.SetRange(sq, qe, q2,
|
|
|
+ 4573 lo, span)
|
|
|
+ 4574 ELSIF SymTab.ConstInt(qe,
|
|
|
+ 4575 v)
|
|
|
+ 4576 AND ((v < lo)
|
|
|
+ 4577 OR (v >= lo +
|
|
|
+ 4578 VAL(INTEGER,
|
|
|
+ 4579 span))) THEN
|
|
|
+ 4580 SemError(222)
|
|
|
+ 4581 ELSE QbeGen.SetBit(sq, qe,
|
|
|
+ 4582 lo, span)
|
|
|
+ 4583 END
|
|
|
+ 4584 END; .)
|
|
|
+ 4585 (. AST.SetChild(node,
|
|
|
+ 4586 AST.NChild(node), astEl); .) .
|
|
|
+ 4587 GetIdent<VAR n: SymTab.Name>
|
|
|
+ 4588 = ident (. LexName(n); .) .
|
|
|
+ 4589
|
|
|
+ 4590 END M2.
|
|
|
|
|
|
0 errors
|
|
|
|
|
|
|
|
|
Statistics:
|
|
|
|
|
|
- nr of terminals: 119 (limit 400)
|
|
|
+ nr of terminals: 121 (limit 400)
|
|
|
nr of non-terminals: 93 (limit 210)
|
|
|
- nr of pragmas: 0 (limit 381)
|
|
|
- nr of symbolnodes: 212 (limit 500)
|
|
|
- nr of graphnodes: 1373 (limit 1500)
|
|
|
+ nr of pragmas: 0 (limit 379)
|
|
|
+ nr of symbolnodes: 214 (limit 500)
|
|
|
+ nr of graphnodes: 1413 (limit 1500)
|
|
|
nr of conditionsets: 12 (limit 100)
|
|
|
nr of charactersets: 17 (limit 250)
|
|
|
|
