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