|
|
@@ -1195,3079 +1195,3081 @@ Listing:
|
|
|
1174 IF NOT SymTab.DeclareCProc(n) THEN
|
|
|
1175 SemError(201) END;
|
|
|
1176 Lower.NoteCProc(n)
|
|
|
- 1177 ELSIF SymTab.ModKnown(mod) THEN
|
|
|
- 1178 IF NOT SymTab.ImportFrom(mod, n) THEN
|
|
|
- 1179 SemError(201)
|
|
|
- 1180 ELSE Lower.NoteImportedProc(n)
|
|
|
- 1181 END
|
|
|
- 1182 END; .)
|
|
|
- 1183 | ( "TSIZE" | "SIZE" | "ADR" | "HIGH" | "LEN"
|
|
|
- 1184 | "CHR" | "ORD" | "VAL" | "ABS" | "CAP"
|
|
|
- 1185 | "ODD" | "TRUNC" | "FLOAT"
|
|
|
- 1186 | "UCHR" | "CHR8" | "UORD"
|
|
|
- 1187 | "INC" | "DEC"
|
|
|
- 1188 | "SHIFT" | "ROTATE" | "CAST" | "CONVERT" | "MIN" | "MAX"
|
|
|
- 1189 | "INCL" | "EXCL" | "NEW" | "DISPOSE" | "LOC" ) .
|
|
|
- 1190 ImpModList<node: AST.Node> (. VAR n: SymTab.Name; .)
|
|
|
- 1191 = GetIdent<n> (. AST.SetChild(node, AST.NChild(node),
|
|
|
- 1192 AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
- 1193 { "," GetIdent<n> (. AST.SetChild(node, AST.NChild(node),
|
|
|
- 1194 AST.MakeLeaf(AST.NkIdent, n)); .) } .
|
|
|
- 1195 (* Opaque TYPE declarations (definition modules). The targetless
|
|
|
- 1196 alias resolves to InvalidType until step 4 completes it. *)
|
|
|
- 1197 (* Scalar-phase TYPEs: named types, integer subranges, enumerations.
|
|
|
- 1198 Opaque "TYPE T;" needs isDef (definition units); elsewhere 231.
|
|
|
- 1199 Composite forms (ARRAY/RECORD/SET/POINTER) arrive with step 3. *)
|
|
|
- 1200 TypeBlock<isDef: BOOLEAN> (. VAR astSeq, astTail: AST.Node; .)
|
|
|
- 1201 = "TYPE" (. SymTab.BeginTypeBlock;
|
|
|
- 1202 astSeq := AST.NoNode;
|
|
|
- 1203 astTail := AST.NoNode; .)
|
|
|
- 1204 { (. astDecl := AST.NoNode; .)
|
|
|
- 1205 ( TypeItem<isDef> ";" | ClassItem ";" )
|
|
|
- 1206 (. AstAppend(AST.NkDeclSeq,
|
|
|
- 1207 astSeq, astTail, astDecl); .) }
|
|
|
- 1208 (. SymTab.EndTypeBlock;
|
|
|
- 1209 astDecl := astSeq; .) .
|
|
|
- 1210 TypeItem<isDef: BOOLEAN> (. VAR n: SymTab.Name;
|
|
|
- 1211 t, op: SymTab.TypeIndex;
|
|
|
- 1212 astNode: AST.Node; .)
|
|
|
- 1213 = GetIdent<n> (. op := SymTab.OpaqueBase(n);
|
|
|
- 1214 IF op = SymTab.InvalidType THEN
|
|
|
- 1215 IF NOT SymTab.Enter(n,
|
|
|
- 1216 SymTab.KindType) THEN
|
|
|
- 1217 SemError(200) END
|
|
|
- 1218 END; .)
|
|
|
- 1219 ( "=" Type<t, FALSE> (. astNode := AST.MakeNode(AST.NkTypeDecl);
|
|
|
- 1220 AST.SetChild(astNode, 0,
|
|
|
- 1221 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
- 1222 AST.SetTy(astNode, t);
|
|
|
- 1223 astDecl := astNode;
|
|
|
- 1224 IF op # SymTab.InvalidType THEN
|
|
|
- 1225 SymTab.SetTarget(op, t)
|
|
|
- 1226 ELSE SymTab.SetSymType(n, t)
|
|
|
- 1227 END;
|
|
|
- 1228 IF SymTab.EnterEnumLits(t) > 0 THEN END; .)
|
|
|
- 1229 | (. IF op # SymTab.InvalidType THEN
|
|
|
- 1230 (* stays opaque *)
|
|
|
- 1231 ELSIF NOT isDef THEN
|
|
|
- 1232 SemError(231)
|
|
|
- 1233 ELSE SymTab.SetSymType(n,
|
|
|
- 1234 SymTab.NewAlias()) END; .) ) .
|
|
|
- 1235 Type<VAR t: SymTab.TypeIndex; allowOpen: BOOLEAN>
|
|
|
- 1236 = TypeIdent<t> [ Subrange<t> ] (* anchored subrange: T[lo..hi] *)
|
|
|
- 1237 | Subrange<t>
|
|
|
- 1238 | Enum<t>
|
|
|
- 1239 | ArrayType<t, allowOpen>
|
|
|
- 1240 | SetType<t>
|
|
|
- 1241 | RecordType<t>
|
|
|
- 1242 | PointerType<t>
|
|
|
- 1243 | ProcType<t> .
|
|
|
- 1244 PointerType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex; .)
|
|
|
- 1245 = "POINTER" "TO" (. allowFwdType := TRUE; .)
|
|
|
- 1246 Type<base, FALSE> (. allowFwdType := FALSE;
|
|
|
- 1247 t := SymTab.NewPtr(base); .) .
|
|
|
- 1248 (* Procedure types (step 8.5): PROCEDURE (params): result. Values
|
|
|
- 1249 are code pointers; params are collected into the descriptor. *)
|
|
|
- 1250 ProcType<VAR t: SymTab.TypeIndex> (. VAR res, pt: SymTab.TypeIndex;
|
|
|
- 1251 isV: BOOLEAN; .)
|
|
|
- 1252 = ( "PROCEDURE" | "PROC" ) (. allowFwdType := FALSE;
|
|
|
- 1253 res := SymTab.InvalidType;
|
|
|
- 1254 t := SymTab.NewProcType(res); .)
|
|
|
- 1255 [ "(" [ ProcTypeSection<t> { ";" ProcTypeSection<t> } ] ")" ]
|
|
|
- 1256 [ ":" TypeIdent<res> (. SymTab.SetProcTypeRes(t, res); .) ] .
|
|
|
- 1257 ProcTypeSection<t: SymTab.TypeIndex> (. VAR pt: SymTab.TypeIndex;
|
|
|
- 1258 isV: BOOLEAN;
|
|
|
- 1259 cnt, k: CARDINAL;
|
|
|
- 1260 names: ARRAY [0 .. 15] OF SymTab.Name; .)
|
|
|
- 1261 = (. isV := FALSE; cnt := 0; .)
|
|
|
- 1262 [ "VAR" (. isV := TRUE; .) ]
|
|
|
- 1263 ( GetIdent<names[cnt]> (. INC(cnt); .)
|
|
|
- 1264 { "," GetIdent<names[cnt]> (. INC(cnt); .) }
|
|
|
- 1265 ( ":" Type<pt, TRUE> (. k := 0;
|
|
|
- 1266 WHILE k < cnt DO
|
|
|
- 1267 SymTab.ProcTypeAdd(t, isV, pt);
|
|
|
- 1268 INC(k)
|
|
|
- 1269 END; .)
|
|
|
- 1270 | (. (* type-only parameter list:
|
|
|
- 1271 each name is a type (GNU
|
|
|
- 1272 shorthand used by the
|
|
|
- 1273 Coco/R scanner frame) *)
|
|
|
- 1274 k := 0;
|
|
|
- 1275 WHILE k < cnt DO
|
|
|
- 1276 IF SymTab.Lookup(names[k])
|
|
|
- 1277 AND ((SymTab.SymKind(names[k]) = SymTab.KindType)
|
|
|
- 1278 OR (SymTab.SymKind(names[k]) = SymTab.KindPredef)) THEN
|
|
|
- 1279 pt := SymTab.SymType(names[k])
|
|
|
- 1280 ELSE SemError(201);
|
|
|
- 1281 pt := SymTab.InvalidType
|
|
|
- 1282 END;
|
|
|
- 1283 SymTab.ProcTypeAdd(t, isV, pt);
|
|
|
- 1284 INC(k)
|
|
|
- 1285 END; .) )
|
|
|
- 1286 | Type<pt, TRUE> (. (* unnamed parameter (PIM):
|
|
|
- 1287 e.g. PROCEDURE (VAR ARRAY OF REAL) *)
|
|
|
- 1288 SymTab.ProcTypeAdd(t, isV, pt); .) ) .
|
|
|
- 1289 (* Arrays: "OF" without bounds is an open formal (allowed only
|
|
|
- 1290 where allowOpen); "[lo..hi, ...]" nests bounded levels inside
|
|
|
- 1291 out. The PIM/ISO multi-index form repeats the bracket group
|
|
|
- 1292 ("ARRAY [lo..hi], [lo..hi] OF T"); the bounds of every group
|
|
|
- 1293 nest in the same inside-out order as the comma list. Bounds are
|
|
|
- 1294 folded literals (int/char); anything else 230. Bare-type indices
|
|
|
- 1295 ("ARRAY Color OF") wait for enum ordinals. *)
|
|
|
- 1296 ArrayType<VAR t: SymTab.TypeIndex; allowOpen: BOOLEAN>
|
|
|
- 1297 (. VAR elem: SymTab.TypeIndex;
|
|
|
- 1298 eb: SymTab.Name;
|
|
|
- 1299 ok: BOOLEAN;
|
|
|
- 1300 bnds, bndh: ARRAY [0 .. 7] OF INTEGER;
|
|
|
- 1301 nb, k: CARDINAL;
|
|
|
- 1302 idx: SymTab.TypeIndex;
|
|
|
- 1303 ilo, ihi: INTEGER; .)
|
|
|
- 1304 = "ARRAY" (. allowFwdType := FALSE; .)
|
|
|
- 1305 ( "OF"
|
|
|
- 1306 Type<elem, FALSE> (. LexName(eb); (* the element ident *)
|
|
|
- 1307 IF NOT allowOpen THEN
|
|
|
- 1308 SemError(230) END;
|
|
|
- 1309 t := SymTab.NewOpenArray(elem);
|
|
|
- 1310 IF SymTab.Equal(eb, "BYTE") THEN
|
|
|
- 1311 SymTab.MarkByteBuf(t) END; .)
|
|
|
- 1312 | TypeIdent<idx> [ Subrange<idx> ]
|
|
|
- 1313 "OF" Type<elem, FALSE> (. (* index-type array: the index
|
|
|
- 1314 type's ordinal bounds give the
|
|
|
- 1315 [lo..hi] pair *)
|
|
|
- 1316 IF SymTab.TypeBounds(idx, ilo,
|
|
|
- 1317 ihi)
|
|
|
- 1318 THEN t := SymTab.NewArrayB(elem,
|
|
|
- 1319 ilo, ihi)
|
|
|
- 1320 ELSE SemError(230);
|
|
|
- 1321 t := SymTab.InvalidType
|
|
|
- 1322 END; .)
|
|
|
- 1323 | "[" (. SymTab.BoundBegin; ok := TRUE;
|
|
|
- 1324 nb := 0; .)
|
|
|
- 1325 BoundPair<ok>
|
|
|
- 1326 { "," BoundPair<ok> }
|
|
|
- 1327 "]" (. (* snapshot this bracket group
|
|
|
- 1328 before the element type, which
|
|
|
- 1329 reuses the bound buffer for a
|
|
|
- 1330 nested ARRAY *)
|
|
|
- 1331 IF nb + SymTab.BoundCount() >
|
|
|
- 1332 HIGH(bnds) + 1 THEN
|
|
|
- 1333 SemError(230); ok := FALSE
|
|
|
- 1334 ELSE
|
|
|
- 1335 k := 0;
|
|
|
- 1336 WHILE k < SymTab.BoundCount() DO
|
|
|
- 1337 bnds[nb] := SymTab.BoundLo(k);
|
|
|
- 1338 bndh[nb] := SymTab.BoundHi(k);
|
|
|
- 1339 INC(k); INC(nb)
|
|
|
- 1340 END
|
|
|
- 1341 END; .)
|
|
|
- 1342 { "," "[" (. SymTab.BoundBegin; .)
|
|
|
- 1343 BoundPair<ok>
|
|
|
- 1344 { "," BoundPair<ok> }
|
|
|
- 1345 "]" (. IF nb + SymTab.BoundCount() >
|
|
|
- 1346 HIGH(bnds) + 1 THEN
|
|
|
- 1347 SemError(230); ok := FALSE
|
|
|
- 1348 ELSE
|
|
|
- 1349 k := 0;
|
|
|
- 1350 WHILE k < SymTab.BoundCount() DO
|
|
|
- 1351 bnds[nb] := SymTab.BoundLo(k);
|
|
|
- 1352 bndh[nb] := SymTab.BoundHi(k);
|
|
|
- 1353 INC(k); INC(nb)
|
|
|
- 1354 END
|
|
|
- 1355 END; .) }
|
|
|
- 1356 "OF" Type<elem, FALSE>
|
|
|
- 1357 (. IF ok THEN
|
|
|
- 1358 k := nb;
|
|
|
- 1359 WHILE k > 0 DO
|
|
|
- 1360 DEC(k);
|
|
|
- 1361 elem := SymTab.NewArrayB(
|
|
|
- 1362 elem, bnds[k], bndh[k])
|
|
|
- 1363 END;
|
|
|
- 1364 t := elem
|
|
|
- 1365 ELSE t := SymTab.InvalidType
|
|
|
- 1366 END; .) ) .
|
|
|
- 1367 BoundPair<VAR ok: BOOLEAN> (. VAR tlo, thi: SymTab.TypeIndex;
|
|
|
- 1368 qlo, qhi: QbeGen.QVal;
|
|
|
- 1369 lo, hi: INTEGER;
|
|
|
- 1370 cl, cl2: INTEGER; .)
|
|
|
- 1371 = Expr<tlo, qlo> ".." Expr<thi, qhi>
|
|
|
- 1372 (. IF (tlo = SymTab.InvalidType)
|
|
|
- 1373 OR (thi = SymTab.InvalidType) THEN
|
|
|
- 1374 ok := FALSE
|
|
|
- 1375 ELSE cl := SymTab.ClassOf(tlo);
|
|
|
- 1376 cl2 := SymTab.ClassOf(thi);
|
|
|
- 1377 IF ((cl # SymTab.ClInt)
|
|
|
- 1378 AND (cl # SymTab.ClChar)
|
|
|
- 1379 AND (cl # SymTab.ClBool)
|
|
|
- 1380 AND (cl # SymTab.ClEnum))
|
|
|
- 1381 OR ((cl2 # SymTab.ClInt)
|
|
|
- 1382 AND (cl2 # SymTab.ClChar)
|
|
|
- 1383 AND (cl2 # SymTab.ClBool)
|
|
|
- 1384 AND (cl2 # SymTab.ClEnum)) THEN
|
|
|
- 1385 SemError(230); ok := FALSE
|
|
|
- 1386 ELSIF NOT SymTab.ConstInt(qlo, lo)
|
|
|
- 1387 OR NOT SymTab.ConstInt(qhi, hi)
|
|
|
- 1388 OR (lo > hi) THEN
|
|
|
- 1389 SemError(230); ok := FALSE
|
|
|
- 1390 ELSIF NOT SymTab.BoundAdd(lo, hi) THEN
|
|
|
- 1391 SemError(230); ok := FALSE
|
|
|
- 1392 END;
|
|
|
- 1393 END; .) .
|
|
|
- 1394 (* Sets: multi-word masks over bases ≤ 256 values (bool, char,
|
|
|
- 1395 bounded subranges; enums wait for ordinals, INTEGER is
|
|
|
- 1396 unbounded). Literals are SET OF [0..255]; assignment and
|
|
|
- 1397 comparison across suitable bases are lenient (masks over min
|
|
|
- 1398 words + zero-check extras), out-of-span literals are 222. *)
|
|
|
- 1399 SetType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex;
|
|
|
- 1400 blo, bhi, bspan: INTEGER;
|
|
|
- 1401 bcls: INTEGER; .)
|
|
|
- 1402 = "SET" (. allowFwdType := FALSE; .)
|
|
|
- 1403 "OF" Type<base, FALSE>
|
|
|
- 1404 (. IF base = SymTab.InvalidType THEN
|
|
|
- 1405 t := SymTab.InvalidType
|
|
|
- 1406 ELSIF SymTab.Unresolved(base) THEN
|
|
|
- 1407 (* an opaque/formal base: defer
|
|
|
- 1408 the span check until the
|
|
|
- 1409 base is completed *)
|
|
|
- 1410 t := SymTab.NewSet(base)
|
|
|
- 1411 ELSE bcls :=
|
|
|
- 1412 SymTab.ClassOf(base);
|
|
|
- 1413 (* a subrange keeps its own
|
|
|
- 1414 span even when its base is
|
|
|
- 1415 CHAR/BOOLEAN/an enum *)
|
|
|
- 1416 IF SymTab.SubBounds(base,
|
|
|
- 1417 blo, bhi) THEN
|
|
|
- 1418 bspan := bhi - blo + 1
|
|
|
- 1419 ELSIF bcls = SymTab.ClBool THEN
|
|
|
- 1420 blo := 0; bspan := 2
|
|
|
- 1421 ELSIF bcls = SymTab.ClChar THEN
|
|
|
- 1422 blo := 0; bspan := 256
|
|
|
- 1423 ELSIF bcls = SymTab.ClEnum THEN
|
|
|
- 1424 blo := 0;
|
|
|
- 1425 bspan := VAL(INTEGER,
|
|
|
- 1426 SymTab.EnumCount(base))
|
|
|
- 1427 ELSE bspan := 0 END;
|
|
|
- 1428 IF (bspan <= 0)
|
|
|
- 1429 OR (bspan > 65536) THEN
|
|
|
- 1430 SemError(230);
|
|
|
- 1431 t := SymTab.InvalidType
|
|
|
- 1432 ELSE t := SymTab.NewSet(base)
|
|
|
- 1433 END
|
|
|
- 1434 END; .) .
|
|
|
- 1435 (* Records: flat blobs; array fields are pointers to static
|
|
|
- 1436 descriptors (locked amendment), nested records inline. Field
|
|
|
- 1437 offsets static and declaration-ordered. *)
|
|
|
- 1438 (* Field list: plain fields and (optionally) one variant part. The
|
|
|
- 1439 variant part is a `CASE ... END` item; because it starts with the
|
|
|
- 1440 CASE keyword it is unambiguously distinguishable from a field
|
|
|
- 1441 (which starts with an identifier). *)
|
|
|
- 1442 RecordType<VAR t: SymTab.TypeIndex> (. VAR t2: SymTab.TypeIndex;
|
|
|
- 1443 tagOk: BOOLEAN; .)
|
|
|
- 1444 = "RECORD" (. allowFwdType := FALSE;
|
|
|
- 1445 t := SymTab.NewRecord(); .)
|
|
|
- 1446 [ RecItem<t> { ";" [ RecItem<t> ] } ]
|
|
|
- 1447 "END" (. SymTab.LayoutRecord(t); .) .
|
|
|
- 1448 RecItem<rec: SymTab.TypeIndex> (. VAR tt: SymTab.TypeIndex; .)
|
|
|
- 1449 = RecField<rec>
|
|
|
- 1450 | CaseField<rec> (. SymTab.MarkVariant(rec); .) .
|
|
|
- 1451 (* A variant part: CASE [tag] : Type OF variants. gm2 extensions:
|
|
|
- 1452 an untagged inner CASE (no tag field), empty arms and ELSE arms. *)
|
|
|
- 1453 CaseField<rec: SymTab.TypeIndex> (. VAR tagT: SymTab.TypeIndex;
|
|
|
- 1454 tagN: SymTab.Name;
|
|
|
- 1455 tagged: BOOLEAN; .)
|
|
|
- 1456 = "CASE" (. SymTab.ResetFields(rec);
|
|
|
- 1457 tagged := FALSE; .)
|
|
|
- 1458 [ GetIdent<tagN> (. IF NOT SymTab.FieldPending(rec,
|
|
|
- 1459 tagN) THEN
|
|
|
- 1460 SemError(200) END;
|
|
|
- 1461 tagged := TRUE; .) ]
|
|
|
- 1462 ":" Type<tagT, FALSE> (. IF (tagT # SymTab.InvalidType)
|
|
|
- 1463 AND NOT SymTab.IsOrdinal(tagT) THEN
|
|
|
- 1464 SemError(224)
|
|
|
- 1465 END;
|
|
|
- 1466 IF tagged THEN
|
|
|
- 1467 SymTab.FixPendingF(rec, tagT);
|
|
|
- 1468 SymTab.SetVariantTag(rec, tagN)
|
|
|
- 1469 END; .)
|
|
|
- 1470 "OF"
|
|
|
- 1471 RecFieldList<rec>
|
|
|
- 1472 { "|" (. SymTab.ResetFields(rec); .)
|
|
|
- 1473 RecFieldList<rec> }
|
|
|
- 1474 [ "ELSE" ]
|
|
|
- 1475 "END" .
|
|
|
- 1476 (* A variant branch: `labels : fields` (fields and their trailing ";"
|
|
|
- 1477 optional, gm2), `ELSE`, or empty (the extra "|" separators gm2
|
|
|
- 1478 tolerates). A branch may itself contain a nested variant CASE. *)
|
|
|
- 1479 RecFieldList<rec: SymTab.TypeIndex> (. VAR lt, lq: SymTab.TypeIndex;
|
|
|
- 1480 lv1, lv2: QbeGen.QVal; .)
|
|
|
- 1481 = [ ( VarLabel<lt, lv1> [ ".." VarLabel<lq, lv2> ]
|
|
|
- 1482 { "," VarLabel<lt, lv1> [ ".." VarLabel<lq, lv2> ] }
|
|
|
- 1483 ":"
|
|
|
- 1484 [ ArmField<rec> { ";" [ ArmField<rec> ] } ]
|
|
|
- 1485 | "ELSE" ) ] .
|
|
|
- 1486 ArmField<rec: SymTab.TypeIndex>
|
|
|
- 1487 = RecField<rec>
|
|
|
- 1488 | CaseField<rec> (. SymTab.MarkVariant(rec); .) .
|
|
|
- 1489 (* Variant case label: a constant (or a constant range). Values are
|
|
|
- 1490 not interpreted (the layout overlays regardless). *)
|
|
|
- 1491 VarLabel<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 1492 (. VAR lname: SymTab.Name; .)
|
|
|
- 1493 = ( ident (. LexName(lname);
|
|
|
- 1494 QbeGen.CopyOp("0", q);
|
|
|
- 1495 t := SymTab.IntType(); .)
|
|
|
- 1496 | integer (. LexString(lname);
|
|
|
- 1497 QbeGen.CopyOp("0", q);
|
|
|
- 1498 t := SymTab.IntType(); .)
|
|
|
- 1499 | charConst (. LexString(lname);
|
|
|
- 1500 QbeGen.CopyOp("0", q);
|
|
|
- 1501 t := SymTab.CharType(); .) ) .
|
|
|
- 1502 RecField<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name;
|
|
|
- 1503 t2: SymTab.TypeIndex; .)
|
|
|
- 1504 = RecIdents<rec> ":" Type<t2, FALSE>(. SymTab.FixPendingF(rec, t2); .) .
|
|
|
- 1505 RecIdents<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name; .)
|
|
|
- 1506 = GetIdent<n> (. IF NOT SymTab.FieldPending(rec,
|
|
|
- 1507 n) THEN
|
|
|
- 1508 SemError(200) END; .)
|
|
|
- 1509 { "," GetIdent<n> (. IF NOT SymTab.FieldPending(rec,
|
|
|
- 1510 n) THEN
|
|
|
- 1511 SemError(200) END; .) } .
|
|
|
- 1512 TypeIdent<VAR t: SymTab.TypeIndex> (. VAR n, qid: SymTab.Name;
|
|
|
- 1513 k: INTEGER;
|
|
|
- 1514 dotted: BOOLEAN; .)
|
|
|
- 1515 = GetIdent<n> (. dotted := FALSE;
|
|
|
- 1516 IF NOT SymTab.Lookup(n) THEN
|
|
|
- 1517 (* declaration before use: an
|
|
|
- 1518 undeclared type is 201,
|
|
|
- 1519 except as a POINTER's base
|
|
|
- 1520 (allowFwdType) *)
|
|
|
- 1521 k := -1;
|
|
|
- 1522 IF allowFwdType THEN
|
|
|
- 1523 t := SymTab.ForwardType(n)
|
|
|
- 1524 ELSE t := SymTab.InvalidType
|
|
|
- 1525 END;
|
|
|
- 1526 IF t = SymTab.InvalidType THEN
|
|
|
- 1527 SemError(201)
|
|
|
- 1528 END
|
|
|
- 1529 ELSE k := SymTab.SymKind(n);
|
|
|
- 1530 IF (k = SymTab.KindType)
|
|
|
- 1531 OR (k = SymTab.KindPredef) THEN
|
|
|
- 1532 t := SymTab.SymType(n)
|
|
|
- 1533 ELSE t := SymTab.InvalidType
|
|
|
- 1534 END
|
|
|
- 1535 END; .)
|
|
|
- 1536 [ "." GetIdent<qid> (. dotted := TRUE;
|
|
|
- 1537 IF k = SymTab.KindModule THEN
|
|
|
- 1538 t := SymTab.QualType(n, qid);
|
|
|
- 1539 IF t = SymTab.InvalidType THEN
|
|
|
- 1540 SemError(201)
|
|
|
- 1541 END
|
|
|
- 1542 ELSE SemError(221);
|
|
|
- 1543 t := SymTab.InvalidType
|
|
|
- 1544 END; .) ]
|
|
|
- 1545 (. IF NOT dotted THEN
|
|
|
- 1546 IF (k = SymTab.KindModule)
|
|
|
- 1547 OR ((k # SymTab.KindType)
|
|
|
- 1548 AND (k # SymTab.KindPredef)
|
|
|
- 1549 AND (k # SymTab.KindImport)
|
|
|
- 1550 AND (k # -1)) THEN
|
|
|
- 1551 SemError(221)
|
|
|
- 1552 END
|
|
|
- 1553 END; .) .
|
|
|
- 1554 Subrange<VAR t: SymTab.TypeIndex> (. VAR tlo, thi: SymTab.TypeIndex;
|
|
|
- 1555 qlo, qhi: QbeGen.QVal;
|
|
|
- 1556 lo, hi: INTEGER; .)
|
|
|
- 1557 = "[" Expr<tlo, qlo> ".." Expr<thi, qhi>
|
|
|
- 1558 (. IF (tlo = SymTab.InvalidType)
|
|
|
- 1559 OR (thi = SymTab.InvalidType) THEN
|
|
|
- 1560 t := SymTab.InvalidType
|
|
|
- 1561 ELSIF NOT SymTab.IsOrdinal(tlo)
|
|
|
- 1562 OR NOT SymTab.IsOrdinal(thi) THEN
|
|
|
- 1563 SemError(230);
|
|
|
- 1564 t := SymTab.InvalidType
|
|
|
- 1565 ELSIF NOT SymTab.ConstInt(qlo, lo)
|
|
|
- 1566 OR NOT SymTab.ConstInt(qhi, hi)
|
|
|
- 1567 OR (lo > hi) THEN
|
|
|
- 1568 SemError(230);
|
|
|
- 1569 t := SymTab.InvalidType
|
|
|
- 1570 ELSE IF SymTab.SameType(tlo, thi) THEN
|
|
|
- 1571 (* keep the base type: ['A'..'Z']
|
|
|
- 1572 is character, [red..blue]
|
|
|
- 1573 that enumeration *)
|
|
|
- 1574 t := SymTab.NewSubB(lo, hi, tlo)
|
|
|
- 1575 ELSE t := SymTab.NewSubR(lo, hi)
|
|
|
- 1576 END
|
|
|
- 1577 END; .)
|
|
|
- 1578 "]" .
|
|
|
- 1579 Enum<VAR t: SymTab.TypeIndex> (. VAR n: SymTab.Name;
|
|
|
- 1580 ord: INTEGER;
|
|
|
- 1581 qv: QbeGen.QVal; .)
|
|
|
- 1582 = "(" (. t := SymTab.NewEnum();
|
|
|
- 1583 ord := 0; .)
|
|
|
- 1584 GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
- 1585 SymTab.KindConst) THEN
|
|
|
- 1586 SemError(200) END;
|
|
|
- 1587 SymTab.SetSymType(n, t);
|
|
|
- 1588 QbeGen.IntStr(ord, qv);
|
|
|
- 1589 SymTab.SetSymVal(n, qv);
|
|
|
- 1590 SymTab.NoteEnumLit(t, n);
|
|
|
- 1591 Lower.NoteVar(n,
|
|
|
- 1592 SymTab.KindConst, t);
|
|
|
- 1593 Lower.NoteConstVal(qv);
|
|
|
- 1594 INC(ord); .)
|
|
|
- 1595 { "," GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
- 1596 SymTab.KindConst) THEN
|
|
|
- 1597 SemError(200) END;
|
|
|
- 1598 SymTab.SetSymType(n, t);
|
|
|
- 1599 QbeGen.IntStr(ord, qv);
|
|
|
- 1600 SymTab.SetSymVal(n, qv);
|
|
|
- 1601 SymTab.NoteEnumLit(t, n);
|
|
|
- 1602 Lower.NoteVar(n,
|
|
|
- 1603 SymTab.KindConst, t);
|
|
|
- 1604 Lower.NoteConstVal(qv);
|
|
|
- 1605 INC(ord); .) }
|
|
|
- 1606 ")" (. SymTab.SetEnumCount(t,
|
|
|
- 1607 VAL(CARDINAL, ord)); .) .
|
|
|
- 1608 (* Clarion-form classes (docs/OOP.txt): declaration + single
|
|
|
- 1609 inheritance + IMPLEMENTATION blocks. Scopes and member checks
|
|
|
- 1610 now; lowering (vtable, dispatch, THIS) later — one 230 per
|
|
|
- 1611 class/impl block. Methods end with ";" per the Table example
|
|
|
- 1612 (not "," as in the sketch). No underscores in identifiers. *)
|
|
|
- 1613 (* Single CLASS item in both loops: separating declaration from
|
|
|
- 1614 IMPLEMENTATION at the loop level needs 2-token lookahead
|
|
|
- 1615 (CLASS ident vs CLASS IMPLEMENTATION), which LL(1) cannot do.
|
|
|
- 1616 The second token decides after CLASS is consumed. A misplaced
|
|
|
- 1617 CLASS IMPLEMENTATION inside TYPE still parses (harmless: the
|
|
|
- 1618 whole unit ends 230 until lowering). *)
|
|
|
- 1619 ClassItem
|
|
|
- 1620 = "CLASS" ( "IMPLEMENTATION" ClassImplRest | ClassRest ) .
|
|
|
- 1621 ClassRest (. VAR cn, m2, pn: SymTab.Name;
|
|
|
- 1622 ct: SymTab.TypeIndex; .)
|
|
|
- 1623 = GetIdent<cn> (. IF NOT SymTab.Enter(cn,
|
|
|
- 1624 SymTab.KindType) THEN
|
|
|
- 1625 SemError(200) END;
|
|
|
- 1626 ct := SymTab.NewClass();
|
|
|
- 1627 SymTab.SetSymType(cn, ct);
|
|
|
- 1628 SymTab.PushClassScope(ct);
|
|
|
- 1629 astCls := AST.MakeNode(AST.NkClassDecl);
|
|
|
- 1630 AST.SetChild(astCls, 0,
|
|
|
- 1631 AST.MakeLeaf(AST.NkIdent, cn));
|
|
|
- 1632 astClsP := AST.NoNode;
|
|
|
- 1633 astClsPTail := AST.NoNode;
|
|
|
- 1634 astClsF := AST.NoNode;
|
|
|
- 1635 astClsFTail := AST.NoNode;
|
|
|
- 1636 astClsM := AST.NoNode;
|
|
|
- 1637 astClsMTail := AST.NoNode; .)
|
|
|
- 1638 [ Parents<ct> ]
|
|
|
- 1639 ";"
|
|
|
- 1640 { ClassField<ct> ";" }
|
|
|
- 1641 { MethodHeading<pn, SymTab.InvalidType> ";"
|
|
|
- 1642 (. Lower.ScopeLeave;
|
|
|
- 1643 SymTab.CloseProc;
|
|
|
- 1644 QbeGen.AbortFunc; .) }
|
|
|
- 1645 "END"
|
|
|
- 1646 GetIdent<m2> (. IF NOT SymTab.Equal(cn, m2) THEN
|
|
|
- 1647 SemError(202) END;
|
|
|
- 1648 SymTab.LayoutClass(ct);
|
|
|
- 1649 SymTab.PopScope;
|
|
|
- 1650 AST.SetChild(astCls, 1, astClsP);
|
|
|
- 1651 AST.SetChild(astCls, 2, astClsF);
|
|
|
- 1652 AST.SetChild(astCls, 3, astClsM);
|
|
|
- 1653 astDecl := astCls; .) .
|
|
|
- 1654 Parents<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name; .)
|
|
|
- 1655 = "(" Parent1<ct>
|
|
|
- 1656 { "," GetIdent<p> (. SemError(230); .) }
|
|
|
- 1657 ")" .
|
|
|
- 1658 Parent1<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name;
|
|
|
- 1659 pt: SymTab.TypeIndex; .)
|
|
|
- 1660 = GetIdent<p> (. IF NOT SymTab.Lookup(p) THEN
|
|
|
- 1661 SemError(201)
|
|
|
- 1662 ELSE pt := SymTab.SymType(p);
|
|
|
- 1663 IF SymTab.ClassOf(pt) #
|
|
|
- 1664 SymTab.ClClass THEN
|
|
|
- 1665 SemError(230)
|
|
|
- 1666 ELSE SymTab.SetParent(ct, pt)
|
|
|
- 1667 END
|
|
|
- 1668 END;
|
|
|
- 1669 AstAppend(AST.NkFieldDecl,
|
|
|
- 1670 astClsP, astClsPTail,
|
|
|
- 1671 AST.MakeLeaf(AST.NkIdent, p)); .) .
|
|
|
- 1672 ClassField<ct: SymTab.TypeIndex> (. VAR n, rhs: SymTab.Name;
|
|
|
- 1673 t: SymTab.TypeIndex;
|
|
|
- 1674 astNode: AST.Node; .)
|
|
|
- 1675 = GetIdent<n>
|
|
|
- 1676 ( "=" GetIdent<rhs> (. IF NOT SymTab.Enter(n,
|
|
|
- 1677 SymTab.KindConst) THEN
|
|
|
- 1678 SemError(200) END;
|
|
|
- 1679 astNode := AST.MakeNode(AST.NkConstDecl);
|
|
|
- 1680 AST.SetChild(astNode, 0,
|
|
|
- 1681 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
- 1682 AST.SetChild(astNode, 1,
|
|
|
- 1683 AST.MakeLeaf(AST.NkIdent, rhs));
|
|
|
- 1684 AstAppend(AST.NkFieldDecl,
|
|
|
- 1685 astClsF, astClsFTail, astNode);
|
|
|
- 1686 IF SymTab.Lookup(rhs) THEN
|
|
|
- 1687 SymTab.SetSymType(n,
|
|
|
- 1688 SymTab.SymType(rhs))
|
|
|
- 1689 END; .)
|
|
|
- 1690 | (. IF NOT SymTab.FieldPending(ct,
|
|
|
- 1691 n) THEN
|
|
|
- 1692 SemError(200) END;
|
|
|
- 1693 astNode := AST.MakeNode(AST.NkVarDecl);
|
|
|
- 1694 AST.SetChild(astNode, 0,
|
|
|
- 1695 AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
- 1696 { "," GetIdent<n> (. IF NOT SymTab.FieldPending(ct,
|
|
|
- 1697 n) THEN
|
|
|
- 1698 SemError(200) END;
|
|
|
- 1699 AST.SetChild(astNode,
|
|
|
- 1700 AST.NChild(astNode),
|
|
|
- 1701 AST.MakeLeaf(AST.NkIdent, n)); .) }
|
|
|
- 1702 ":" Type<t, FALSE> (. SymTab.FixPendingF(ct, t);
|
|
|
- 1703 AST.SetTy(astNode, t);
|
|
|
- 1704 AstAppend(AST.NkFieldDecl,
|
|
|
- 1705 astClsF, astClsFTail, astNode); .) ) .
|
|
|
- 1706 MethodHeading<VAR pn: SymTab.Name; ct: SymTab.TypeIndex>
|
|
|
- 1707 (. VAR wantVirt: BOOLEAN; .)
|
|
|
- 1708 = (. wantVirt := FALSE; .)
|
|
|
- 1709 [ "VIRTUAL" (. wantVirt := TRUE; .) ]
|
|
|
- 1710 ProcHeading<pn, ct> (. IF wantVirt THEN
|
|
|
- 1711 SymTab.MarkVirtual END;
|
|
|
- 1712 astMethod := AST.MakeNode(AST.NkProcDecl);
|
|
|
- 1713 AST.SetChild(astMethod, 0,
|
|
|
- 1714 AST.MakeLeaf(AST.NkIdent, pn));
|
|
|
- 1715 IF wantVirt THEN
|
|
|
- 1716 AST.SetOp(astMethod, 3)
|
|
|
- 1717 ELSE AST.SetOp(astMethod, 0)
|
|
|
- 1718 END;
|
|
|
- 1719 AstAppend(AST.NkFieldDecl,
|
|
|
- 1720 astClsM, astClsMTail, astMethod); .) .
|
|
|
- 1721 ClassImplRest (. VAR cn, m2: SymTab.Name;
|
|
|
- 1722 ct: SymTab.TypeIndex; .)
|
|
|
- 1723 = GetIdent<cn> (. IF NOT SymTab.Lookup(cn) THEN
|
|
|
- 1724 SemError(201);
|
|
|
- 1725 ct := SymTab.InvalidType
|
|
|
- 1726 ELSE ct := SymTab.SymType(cn);
|
|
|
- 1727 IF SymTab.ClassOf(ct) #
|
|
|
- 1728 SymTab.ClClass THEN
|
|
|
- 1729 SemError(230);
|
|
|
- 1730 ct := SymTab.InvalidType
|
|
|
- 1731 END
|
|
|
- 1732 END;
|
|
|
- 1733 astCls := AST.MakeNode(AST.NkClassDecl);
|
|
|
- 1734 AST.SetOp(astCls, 1);
|
|
|
- 1735 AST.SetChild(astCls, 0,
|
|
|
- 1736 AST.MakeLeaf(AST.NkIdent, cn));
|
|
|
- 1737 astClsM := AST.NoNode;
|
|
|
- 1738 astClsMTail := AST.NoNode;
|
|
|
- 1739 astStmt := AST.NoNode;
|
|
|
- 1740 IF ct #
|
|
|
- 1741 SymTab.InvalidType THEN
|
|
|
- 1742 IF NOT SymTab.PushClassMembers(
|
|
|
- 1743 ct) THEN
|
|
|
- 1744 SemError(230) END;
|
|
|
- 1745 SymTab.PushImplClass(ct)
|
|
|
- 1746 END; .)
|
|
|
- 1747 ";" { MethodImpl<ct> ";" }
|
|
|
- 1748 (. astStmt := AST.NoNode; .)
|
|
|
- 1749 [ "BEGIN" (. astStmt := AST.MakeNode(AST.NkBlock);
|
|
|
- 1750 .)
|
|
|
- 1751 [ StatSeq ] ]
|
|
|
- 1752 "END"
|
|
|
- 1753 GetIdent<m2> (. IF NOT SymTab.Equal(cn, m2) THEN
|
|
|
- 1754 SemError(202) END;
|
|
|
- 1755 SymTab.PopImplClass;
|
|
|
- 1756 SymTab.PopScope;
|
|
|
- 1757 AST.SetChild(astCls, 1, AST.NoNode);
|
|
|
- 1758 AST.SetChild(astCls, 2, astStmt);
|
|
|
- 1759 AST.SetChild(astCls, 3, astClsM);
|
|
|
- 1760 astDecl := astCls; .) .
|
|
|
- 1761 MethodImpl<ct: SymTab.TypeIndex> (. VAR pn: SymTab.Name;
|
|
|
- 1762 thisQ: QbeGen.QVal;
|
|
|
- 1763 methRes: SymTab.TypeIndex; .)
|
|
|
- 1764 = MethodHeading<pn, ct> ";"
|
|
|
- 1765 (. IF (ct #
|
|
|
- 1766 SymTab.InvalidType)
|
|
|
- 1767 AND NOT SymTab.MethodExists(ct,
|
|
|
- 1768 pn) THEN
|
|
|
- 1769 SemError(201) END; .)
|
|
|
- 1770 ( "FORWARD" (. AST.SetOp(astMethod, 1);
|
|
|
- 1771 SymTab.MarkFwd;
|
|
|
- 1772 QbeGen.AbortFunc;
|
|
|
- 1773 Lower.ScopeLeave;
|
|
|
- 1774 SymTab.CloseProc; .)
|
|
|
- 1775 | (.
|
|
|
- 1776 (* bind the receiver: bare
|
|
|
- 1777 field names resolve
|
|
|
- 1778 against THIS *)
|
|
|
- 1779 QbeGen.CopyOp("@", thisQ);
|
|
|
- 1780 QbeGen.PushWith(thisQ); .)
|
|
|
- 1781 Block<pn> (. AST.SetChild(astMethod, 1, astStmt);
|
|
|
- 1782 AST.SetChild(astMethod, 2, astBlkDecls);
|
|
|
- 1783 QbeGen.PopWith;
|
|
|
- 1784 methRes := SymTab.CurRes();
|
|
|
- 1785 Lower.ScopeLeave;
|
|
|
- 1786 SymTab.CloseProc;
|
|
|
- 1787 QbeGen.EndFunc(methRes); .) ) .
|
|
|
- 1788 ConstBlock (. VAR astSeq, astTail: AST.Node; .)
|
|
|
- 1789 = "CONST" (. astSeq := AST.NoNode;
|
|
|
- 1790 astTail := AST.NoNode; .)
|
|
|
- 1791 { ConstDecl ";" (. AstAppend(AST.NkDeclSeq,
|
|
|
- 1792 astSeq, astTail, astDecl); .) }
|
|
|
- 1793 (. astDecl := astSeq; .) .
|
|
|
- 1794 ConstDecl (. VAR n: SymTab.Name;
|
|
|
- 1795 t: SymTab.TypeIndex;
|
|
|
- 1796 qv: QbeGen.QVal;
|
|
|
- 1797 cls: INTEGER;
|
|
|
- 1798 mk: ARRAY [0 .. 15] OF CARDINAL;
|
|
|
- 1799 mw: CARDINAL;
|
|
|
- 1800 mlo: INTEGER;
|
|
|
- 1801 astNode: AST.Node; .)
|
|
|
- 1802 = GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
- 1803 SymTab.KindConst) THEN
|
|
|
- 1804 SemError(200) END; .)
|
|
|
- 1805 "="
|
|
|
- 1806 Expr<t, qv> (. astNode := AST.MakeNode(AST.NkConstDecl);
|
|
|
- 1807 AST.SetChild(astNode, 0,
|
|
|
- 1808 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
- 1809 AST.SetChild(astNode, 1, astCur);
|
|
|
- 1810 AST.SetTy(astNode, t);
|
|
|
- 1811 astDecl := astNode;
|
|
|
- 1812 Lower.NoteVar(n, SymTab.KindConst, t);
|
|
|
- 1813 Lower.NoteConstVal(qv);
|
|
|
- 1814 SymTab.SetSymType(n, t);
|
|
|
- 1815 cls := SymTab.ClassOf(t);
|
|
|
- 1816 IF cls = SymTab.ClSet THEN
|
|
|
- 1817 (* a SET CONST needs static
|
|
|
- 1818 data: fold its mask now
|
|
|
- 1819 (the grammar sees the
|
|
|
- 1820 element values) and let
|
|
|
- 1821 Lower re-emit it *)
|
|
|
- 1822 IF Lower.SetConstMaskOf(
|
|
|
- 1823 AST.Child(astNode, 1),
|
|
|
- 1824 mk, mw, mlo) THEN
|
|
|
- 1825 Lower.NoteSetMask(n, mk, mw,
|
|
|
- 1826 mlo);
|
|
|
- 1827 SymTab.SetSymVal(n, qv)
|
|
|
- 1828 ELSE
|
|
|
- 1829 SemError(230)
|
|
|
- 1830 END
|
|
|
- 1831 ELSIF (cls = SymTab.ClArray)
|
|
|
- 1832 OR (cls = SymTab.ClRecord)
|
|
|
- 1833 OR (cls = SymTab.ClClass)
|
|
|
- 1834 OR (cls = SymTab.ClStr)
|
|
|
- 1835 OR (cls = SymTab.ClUStr) THEN
|
|
|
- 1836 (* an aggregate/string
|
|
|
- 1837 constant: qv is its
|
|
|
- 1838 descriptor address; no
|
|
|
- 1839 scalar data *)
|
|
|
- 1840 SymTab.SetSymVal(n, qv)
|
|
|
- 1841 ELSIF NOT QbeGen.IsImm(qv) THEN
|
|
|
- 1842 SemError(230)
|
|
|
- 1843 ELSE
|
|
|
- 1844 SymTab.SetSymVal(n, qv);
|
|
|
- 1845 END; .) .
|
|
|
- 1846 VarBlock (. VAR astSeq, astTail: AST.Node; .)
|
|
|
- 1847 = "VAR" (. astSeq := AST.NoNode;
|
|
|
- 1848 astTail := AST.NoNode; .)
|
|
|
- 1849 { VarDecl ";" (. AstAppend(AST.NkDeclSeq,
|
|
|
- 1850 astSeq, astTail, astDecl); .) }
|
|
|
- 1851 (. astDecl := astSeq; .) .
|
|
|
- 1852 VarDecl (. VAR nm: SymTab.Name;
|
|
|
- 1853 t: SymTab.TypeIndex;
|
|
|
- 1854 i: CARDINAL;
|
|
|
- 1855 cls: INTEGER;
|
|
|
- 1856 astNode, astTail: AST.Node; .)
|
|
|
- 1857 = VarIdents ":"
|
|
|
- 1858 Type<t, FALSE> (. astNode := AST.MakeNode(AST.NkVarDecl);
|
|
|
- 1859 astTail := astNode;
|
|
|
- 1860 i := 0;
|
|
|
- 1861 WHILE i < SymTab.PendCount() DO
|
|
|
- 1862 SymTab.PendName(i, nm);
|
|
|
- 1863 Lower.NoteVar(nm, SymTab.KindVar, t);
|
|
|
- 1864 (* chunked: a VAR list can
|
|
|
- 1865 exceed AST.MaxChild *)
|
|
|
- 1866 AstAppend(AST.NkBlock,
|
|
|
- 1867 astNode, astTail,
|
|
|
- 1868 AST.MakeLeaf(AST.NkIdent, nm));
|
|
|
- 1869 INC(i)
|
|
|
- 1870 END;
|
|
|
- 1871 AST.SetTy(astNode, t);
|
|
|
- 1872 astDecl := astNode;
|
|
|
- 1873 cls := SymTab.ClassOf(t);
|
|
|
- 1874 IF (t # SymTab.InvalidType)
|
|
|
- 1875 AND NOT SymTab.IsUnresolved(t)
|
|
|
- 1876 AND (cls # SymTab.ClInt)
|
|
|
- 1877 AND (cls # SymTab.ClBool)
|
|
|
- 1878 AND (cls # SymTab.ClChar)
|
|
|
- 1879 AND (cls # SymTab.ClReal)
|
|
|
- 1880 AND (cls # SymTab.ClArray)
|
|
|
- 1881 AND (cls # SymTab.ClSet)
|
|
|
- 1882 AND (cls # SymTab.ClRecord)
|
|
|
- 1883 AND (cls # SymTab.ClPtr)
|
|
|
- 1884 AND (cls # SymTab.ClLong)
|
|
|
- 1885 AND (cls # SymTab.ClProc)
|
|
|
- 1886 AND (cls # SymTab.ClUChar)
|
|
|
- 1887 AND (cls # SymTab.ClUStr)
|
|
|
- 1888 AND (cls # SymTab.ClEnum)
|
|
|
- 1889 AND (cls # SymTab.ClClass) THEN
|
|
|
- 1890 SemError(230) END;
|
|
|
- 1891 IF QbeGen.LocFull() THEN
|
|
|
- 1892 SemError(233) END;
|
|
|
- 1893 i := 0;
|
|
|
- 1894 IF SymTab.IsUnresolved(t)
|
|
|
- 1895 AND NOT SymTab.InProc() THEN
|
|
|
- 1896 (* a forward-typed global:
|
|
|
- 1897 defer emission until the
|
|
|
- 1898 TYPE block completes *)
|
|
|
- 1899 AST.SetOp(astNode, 1);
|
|
|
- 1900 WHILE i < SymTab.PendCount() DO
|
|
|
- 1901 SymTab.PendName(i, nm);
|
|
|
- 1902 IF nPendVar <=
|
|
|
- 1903 HIGH(pendVarName) THEN
|
|
|
- 1904 pendVarName[nPendVar] := nm;
|
|
|
- 1905 pendVarT[nPendVar] := t;
|
|
|
- 1906 INC(nPendVar)
|
|
|
- 1907 END;
|
|
|
- 1908 INC(i)
|
|
|
- 1909 END
|
|
|
- 1910 ELSE
|
|
|
- 1911 WHILE i < SymTab.PendCount() DO
|
|
|
- 1912 SymTab.PendName(i, nm);
|
|
|
- 1913 INC(i)
|
|
|
- 1914 END
|
|
|
- 1915 END;
|
|
|
- 1916 (* a plain VAR list, not a
|
|
|
- 1917 heading: the signature
|
|
|
- 1918 result is discarded *)
|
|
|
- 1919 IF NOT SymTab.FixPending(t) THEN
|
|
|
- 1920 END; .) .
|
|
|
- 1921 VarIdents (. VAR n: SymTab.Name; .)
|
|
|
- 1922 = GetIdent<n> (. IF NOT SymTab.EnterPending(n,
|
|
|
- 1923 SymTab.KindVar) THEN
|
|
|
- 1924 SemError(200) END; .)
|
|
|
- 1925 { ","
|
|
|
- 1926 GetIdent<n> (. IF NOT SymTab.EnterPending(n,
|
|
|
- 1927 SymTab.KindVar) THEN
|
|
|
- 1928 SemError(200) END; .) } .
|
|
|
- 1929 ParIdents<isV: BOOLEAN> (. VAR n: SymTab.Name; .)
|
|
|
- 1930 = GetIdent<n> (. IF NOT SymTab.EnterParam(n, isV) THEN
|
|
|
- 1931 SemError(200) END; .)
|
|
|
- 1932 { "," GetIdent<n> (. IF NOT SymTab.EnterParam(n, isV) THEN
|
|
|
- 1933 SemError(200) END; .) } .
|
|
|
- 1934 (* Procedure headings enter scopes/params/result and buffer the
|
|
|
- 1935 QBE header; bodies lower to functions (4.1, module level only).
|
|
|
- 1936 FORWARD marks; the body heading re-enters (signature compare
|
|
|
- 1937 deferred). Nested procedures parse + check, lowering = 4.2. *)
|
|
|
- 1938 (* gm2 declaration pragmas: __BUILTIN__ (definition module) and
|
|
|
- 1939 __ATTRIBUTE__ __BUILTIN__ (( name )) (implementation). They
|
|
|
- 1940 annotate C built-ins; V3 parses and ignores them. *)
|
|
|
- 1941 ProcPragma
|
|
|
- 1942 = "__BUILTIN__"
|
|
|
- 1943 | "__ATTRIBUTE__" [ "__BUILTIN__" ] [ "(" "(" ident ")" ")" ] .
|
|
|
- 1944
|
|
|
- 1945 ProcHeading<VAR pn: SymTab.Name; methCls: SymTab.TypeIndex>
|
|
|
- 1946 (. VAR t: SymTab.TypeIndex;
|
|
|
- 1947 mg: QbeGen.QVal; .)
|
|
|
- 1948 = "PROCEDURE"
|
|
|
- 1949 [ ProcPragma ]
|
|
|
- 1950 GetIdent<pn> (. IF methCls #
|
|
|
- 1951 SymTab.InvalidType THEN
|
|
|
- 1952 (* a method: resume the
|
|
|
- 1953 declared symbol (reuse
|
|
|
- 1954 its uid) *)
|
|
|
- 1955 IF NOT SymTab.ResumeMethod(
|
|
|
- 1956 methCls, pn) THEN
|
|
|
- 1957 SemError(200) END
|
|
|
- 1958 ELSIF NOT SymTab.EnterProc(pn) THEN
|
|
|
- 1959 IF NOT SymTab.ReenterProc(pn) THEN
|
|
|
- 1960 IF NOT SymTab.ResumeProc(pn) THEN
|
|
|
- 1961 SemError(200) END
|
|
|
- 1962 END
|
|
|
- 1963 END;
|
|
|
- 1964 Lower.ScopeEnter;
|
|
|
- 1965 Lower.NoteProc(pn,
|
|
|
- 1966 SymTab.ProcUid(pn),
|
|
|
- 1967 SymTab.InvalidType,
|
|
|
- 1968 SymTab.ProcDepthOf(pn),
|
|
|
- 1969 FALSE);
|
|
|
- 1970 QbeGen.BeginFunc("");
|
|
|
- 1971 IF methCls #
|
|
|
- 1972 SymTab.InvalidType THEN
|
|
|
- 1973 (* hidden THIS receiver:
|
|
|
- 1974 a VAR param of the
|
|
|
- 1975 class type, pushed as
|
|
|
- 1976 the WITH base *)
|
|
|
- 1977 IF NOT SymTab.EnterThisParam(
|
|
|
- 1978 methCls) THEN
|
|
|
- 1979 SemError(200) END;
|
|
|
- 1980 IF NOT QbeGen.FuncParam(
|
|
|
- 1981 "THIS", TRUE,
|
|
|
- 1982 methCls) THEN
|
|
|
- 1983 SemError(233) END
|
|
|
- 1984 END; .)
|
|
|
- 1985 [ FormalParams ]
|
|
|
- 1986 [ ":" TypeIdent<t> (. IF NOT SymTab.SetProcRes(t) THEN
|
|
|
- 1987 SemError(235) END;
|
|
|
- 1988 Lower.SetProcRes(t); .) ] .
|
|
|
- 1989 FormalParams
|
|
|
- 1990 = "(" [ ParamSection { ";" ParamSection } ] ")" .
|
|
|
- 1991 ParamSection (. VAR t: SymTab.TypeIndex;
|
|
|
- 1992 nm: SymTab.Name;
|
|
|
- 1993 i: CARDINAL;
|
|
|
- 1994 isV: BOOLEAN; .)
|
|
|
- 1995 = (. isV := FALSE; .)
|
|
|
- 1996 [ "VAR" (. isV := TRUE; .) ]
|
|
|
- 1997 ParIdents<isV> ":" Type<t, TRUE> (. i := 0;
|
|
|
- 1998 WHILE i < SymTab.PendCount() DO
|
|
|
- 1999 SymTab.PendName(i, nm);
|
|
|
- 2000 Lower.NoteParam(nm, t, isV);
|
|
|
- 2001 Lower.NoteVar(nm, SymTab.KindParam, t);
|
|
|
- 2002 (* value open arrays are
|
|
|
- 2003 passed as descriptor
|
|
|
- 2004 addresses (no copy):
|
|
|
- 2005 same representation as
|
|
|
- 2006 VAR formals *)
|
|
|
- 2007 IF NOT QbeGen.FuncParam(nm,
|
|
|
- 2008 isV
|
|
|
- 2009 OR SymTab.IsOpenArray(t),
|
|
|
- 2010 t) THEN
|
|
|
- 2011 SemError(233) END;
|
|
|
- 2012 INC(i)
|
|
|
- 2013 END;
|
|
|
- 2014 IF NOT SymTab.FixPending(t) THEN
|
|
|
- 2015 SemError(235) END; .) .
|
|
|
- 2016 (* Nested procedures lower like top-level ones (4.2): the
|
|
|
- 2017 static link gives them their parent's frame. Methods keep
|
|
|
- 2018 parse-now/230-later. *)
|
|
|
- 2019 ProcDecl (. VAR pn: SymTab.Name;
|
|
|
- 2020 astNode: AST.Node; .)
|
|
|
- 2021 = ProcHeading<pn, SymTab.InvalidType> ";"
|
|
|
- 2022 (. astNode := AST.MakeNode(AST.NkProcDecl);
|
|
|
- 2023 AST.SetOp(astNode, 0);
|
|
|
- 2024 AST.SetChild(astNode, 0,
|
|
|
- 2025 AST.MakeLeaf(AST.NkIdent, pn));
|
|
|
- 2026 Lower.NoteProcNode(astNode); .)
|
|
|
- 2027 ( "FORWARD" (. AST.SetOp(astNode, 1);
|
|
|
- 2028 astDecl := astNode;
|
|
|
- 2029 Lower.ScopeLeave;
|
|
|
- 2030 SymTab.MarkFwd;
|
|
|
- 2031 SymTab.CloseProc;
|
|
|
- 2032 QbeGen.AbortFunc; .)
|
|
|
- 2033 | "EXTERNAL" (. AST.SetOp(astNode, 2);
|
|
|
- 2034 astDecl := astNode;
|
|
|
- 2035 Lower.MarkProcExternal;
|
|
|
- 2036 Lower.ScopeLeave;
|
|
|
- 2037 SymTab.MarkExternal("");
|
|
|
- 2038 SymTab.CloseProc;
|
|
|
- 2039 QbeGen.AbortFunc; .)
|
|
|
- 2040 |
|
|
|
- 2041 (. allowDefer := TRUE; deferredBody := FALSE;
|
|
|
- 2042 curProcNode := astNode; .)
|
|
|
- 2043 Block<pn> (. IF deferredBody THEN
|
|
|
- 2044 (* body skipped: close like
|
|
|
- 2045 FORWARD (no body node) *)
|
|
|
- 2046 astDecl := astNode;
|
|
|
- 2047 Lower.ScopeLeave;
|
|
|
- 2048 SymTab.CloseProc;
|
|
|
- 2049 QbeGen.AbortFunc
|
|
|
- 2050 ELSE
|
|
|
- 2051 AST.SetChild(astNode, 1, astStmt);
|
|
|
- 2052 AST.SetChild(astNode, 2, astBlkDecls);
|
|
|
- 2053 astDecl := astNode;
|
|
|
- 2054 Lower.ScopeLeave;
|
|
|
- 2055 SymTab.CloseProc;
|
|
|
- 2056 QbeGen.EndFunc(
|
|
|
- 2057 SymTab.ProcRes(pn))
|
|
|
- 2058 END; .) ) .
|
|
|
- 2059 Block<pn: SymTab.Name> (. VAR m2: SymTab.Name; dfr: BOOLEAN; .)
|
|
|
- 2060 = (. dfr := FALSE;
|
|
|
- 2061 IF allowDefer AND twoPhaseParse
|
|
|
- 2062 AND NOT repassing THEN
|
|
|
- 2063 dfr := DeferSkip(pn)
|
|
|
- 2064 END;
|
|
|
- 2065 allowDefer := FALSE;
|
|
|
- 2066 .)
|
|
|
- 2067 DeclSeq (. astBlkDecls := astDecl;
|
|
|
- 2068 astStmt := AST.NoNode;
|
|
|
- 2069 nLab := 0; nGot := 0; .)
|
|
|
- 2070 [ "BEGIN" (. (* an empty body is still a
|
|
|
- 2071 body: mark it so Lower
|
|
|
- 2072 does not read it as a
|
|
|
- 2073 definition heading *)
|
|
|
- 2074 IF NOT dfr THEN
|
|
|
- 2075 IF astStmt = AST.NoNode THEN
|
|
|
- 2076 astStmt :=
|
|
|
- 2077 AST.MakeNode(AST.NkBlock)
|
|
|
- 2078 END
|
|
|
- 2079 END; .)
|
|
|
- 2080 [ StatSeq ] ]
|
|
|
- 2081 "END"
|
|
|
- 2082 GetIdent<m2> (. IF NOT SymTab.Equal(pn, m2) THEN
|
|
|
- 2083 SemError(202) END;
|
|
|
- 2084 CheckGotos; .) .
|
|
|
- 2085 (* Two-phase, phase 2 (milestone 2c): re-parse every deferred module-
|
|
|
- 2086 level body once the unit's declarations are complete. Inlined at
|
|
|
- 2087 both call sites because a stand-alone epsilon production is
|
|
|
- 2088 "unreachable" to Coco/R (referenced only from actions). *)
|
|
|
- 2089 StatSeq (. VAR astSeq, astTail: AST.Node; .)
|
|
|
- 2090 = (. astSeq := AST.NoNode;
|
|
|
- 2091 astTail := AST.NoNode; .)
|
|
|
- 2092 Statement (. AstAppend(AST.NkBlock,
|
|
|
- 2093 astSeq, astTail, astStmt); .)
|
|
|
- 2094 { ";" [ Statement (. AstAppend(AST.NkBlock,
|
|
|
- 2095 astSeq, astTail, astStmt); .) ] }
|
|
|
- 2096 (. astStmt := astSeq; .) .
|
|
|
- 2097 (* Trailing/empty statements (`a; ; b`, Coco/R's generated `;;`)
|
|
|
- 2098 are accepted: the statement after ';' is optional. *)
|
|
|
- 2099 Statement (. VAR lx: QbeGen.QVal; lxnm: SymTab.Name; .)
|
|
|
- 2100 = (. astStmt := AST.NoNode; .)
|
|
|
- 2101 ( AssOrCall
|
|
|
- 2102 | IfStat
|
|
|
- 2103 | WhileStat
|
|
|
- 2104 | RepeatStat
|
|
|
- 2105 | LoopStat
|
|
|
- 2106 | ForStat
|
|
|
- 2107 | CaseStat
|
|
|
- 2108 | WithStat
|
|
|
- 2109 | ReturnStat
|
|
|
- 2110 | HaltStat
|
|
|
- 2111 | NewStat
|
|
|
- 2112 | DisposeStat
|
|
|
- 2113 | IncDecStat
|
|
|
- 2114 | InclExclStat
|
|
|
- 2115 | "EXIT" (. IF NOT QbeGen.TopLoop(lx) THEN
|
|
|
- 2116 SemError(230) END;
|
|
|
- 2117 astStmt := AST.MakeNode(AST.NkExit); .)
|
|
|
- 2118 | "GOTO" GetIdent<lxnm> (. NoteGoto(lxnm);
|
|
|
- 2119 astStmt := AST.MakeNode(AST.NkGoto);
|
|
|
- 2120 AST.SetChild(astStmt, 0,
|
|
|
- 2121 AST.MakeLeaf(AST.NkIdent, lxnm)); .) ) .
|
|
|
- 2122 (* INCL(set, elem) / EXCL(set, elem): PIM set-element builtins. *)
|
|
|
- 2123 InclExclStat (. VAR at, et2: SymTab.TypeIndex;
|
|
|
- 2124 dk: INTEGER;
|
|
|
- 2125 qd, qe: QbeGen.QVal;
|
|
|
- 2126 qn: SymTab.Name;
|
|
|
- 2127 sfx, isInc: BOOLEAN;
|
|
|
- 2128 astNode, astD: AST.Node; .)
|
|
|
- 2129 = ( "INCL" (. isInc := TRUE; .)
|
|
|
- 2130 | "EXCL" (. isInc := FALSE; .) )
|
|
|
- 2131 "(" Design<at, dk, qd, qn, sfx> (. astD := astCur; .) ","
|
|
|
- 2132 Expr<et2, qe> ")"
|
|
|
- 2133 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 2134 IF isInc THEN
|
|
|
- 2135 AST.SetChild(astNode, 0,
|
|
|
- 2136 AST.MakeLeaf(AST.NkIdent, "INCL"))
|
|
|
- 2137 ELSE AST.SetChild(astNode, 0,
|
|
|
- 2138 AST.MakeLeaf(AST.NkIdent, "EXCL"))
|
|
|
- 2139 END;
|
|
|
- 2140 IF astD # AST.NoNode THEN
|
|
|
- 2141 AST.SetChild(astNode, 1, astD) END;
|
|
|
- 2142 IF astCur # AST.NoNode THEN
|
|
|
- 2143 AST.SetChild(astNode, 2, astCur) END;
|
|
|
- 2144 astStmt := astNode; .)
|
|
|
- 2145 (. IF (at # SymTab.InvalidType)
|
|
|
- 2146 AND (SymTab.ClassOf(at) # SymTab.ClSet) THEN
|
|
|
- 2147 SemError(222)
|
|
|
- 2148 END; .) .
|
|
|
- 2149 (* INC(v [,step]) / DEC(v [,step]) as builtin statements over an
|
|
|
- 2150 integer designator. *)
|
|
|
- 2151 IncDecStat (. VAR dt, et2: SymTab.TypeIndex;
|
|
|
- 2152 dk: INTEGER;
|
|
|
- 2153 qd, qv, qn2, qstep:
|
|
|
- 2154 QbeGen.QVal;
|
|
|
- 2155 qn: SymTab.Name;
|
|
|
- 2156 sfx, isInc: BOOLEAN;
|
|
|
- 2157 astNode, astD, astStep:
|
|
|
- 2158 AST.Node; .)
|
|
|
- 2159 = (. isInc := TRUE; .)
|
|
|
- 2160 ( "INC" (. isInc := TRUE; .)
|
|
|
- 2161 | "DEC" (. isInc := FALSE; .) )
|
|
|
- 2162 "(" (. astStep := AST.NoNode; .)
|
|
|
- 2163 Design<dt, dk, qd, qn, sfx> (. astD := astCur; .)
|
|
|
- 2164 [ "," Expr<et2, qstep> (. astStep := astCur; .) ]
|
|
|
- 2165 ")" (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 2166 IF isInc THEN
|
|
|
- 2167 AST.SetChild(astNode, 0,
|
|
|
- 2168 AST.MakeLeaf(AST.NkIdent, "INC"))
|
|
|
- 2169 ELSE AST.SetChild(astNode, 0,
|
|
|
- 2170 AST.MakeLeaf(AST.NkIdent, "DEC"))
|
|
|
- 2171 END;
|
|
|
- 2172 IF astD # AST.NoNode THEN
|
|
|
- 2173 AST.SetChild(astNode, 1, astD) END;
|
|
|
- 2174 IF astStep # AST.NoNode THEN
|
|
|
- 2175 AST.SetChild(astNode, 2, astStep) END;
|
|
|
- 2176 astStmt := astNode; .) (. IF dt = SymTab.InvalidType THEN
|
|
|
- 2177 ELSIF (dk # SymTab.KindVar)
|
|
|
- 2178 AND (dk # SymTab.KindParam)
|
|
|
- 2179 AND (dk # SymTab.KindField) THEN
|
|
|
- 2180 SemError(210)
|
|
|
- 2181 ELSIF NOT SymTab.IsIntFamily(dt) THEN
|
|
|
- 2182 SemError(211)
|
|
|
- 2183 END; .) .
|
|
|
- 2184 (* NEW/DISPOSE as builtin statements (no call syntax until step 4).
|
|
|
- 2185 Targets are pointer designators; DISPOSE nils afterwards (safer
|
|
|
- 2186 than Wirth-undefined; documented). DISPOSE is shallow. *)
|
|
|
- 2187 NewStat (. VAR dt: SymTab.TypeIndex;
|
|
|
- 2188 dk: INTEGER;
|
|
|
- 2189 qd, qm: QbeGen.QVal;
|
|
|
- 2190 qn: SymTab.Name;
|
|
|
- 2191 sfx: BOOLEAN;
|
|
|
- 2192 bt: SymTab.TypeIndex;
|
|
|
- 2193 astNode, astD: AST.Node; .)
|
|
|
- 2194 = "NEW" "(" Design<dt, dk, qd, qn, sfx> (. astD := astCur; .) ")"
|
|
|
- 2195 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 2196 AST.SetChild(astNode, 0,
|
|
|
- 2197 AST.MakeLeaf(AST.NkIdent, "NEW"));
|
|
|
- 2198 IF astD # AST.NoNode THEN
|
|
|
- 2199 AST.SetChild(astNode, 1, astD) END;
|
|
|
- 2200 astStmt := astNode; .)
|
|
|
- 2201 (. IF dt = SymTab.InvalidType THEN
|
|
|
- 2202 ELSIF (dk # SymTab.KindVar)
|
|
|
- 2203 AND (dk # SymTab.KindParam)
|
|
|
- 2204 AND (dk # SymTab.KindField) THEN
|
|
|
- 2205 SemError(210)
|
|
|
- 2206 ELSIF SymTab.ClassOf(dt) #
|
|
|
- 2207 SymTab.ClPtr THEN
|
|
|
- 2208 SemError(219)
|
|
|
- 2209 END; .) .
|
|
|
- 2210 DisposeStat (. VAR dt: SymTab.TypeIndex;
|
|
|
- 2211 dk: INTEGER;
|
|
|
- 2212 qd, qv: QbeGen.QVal;
|
|
|
- 2213 qn: SymTab.Name;
|
|
|
- 2214 sfx: BOOLEAN;
|
|
|
- 2215 astNode, astD: AST.Node; .)
|
|
|
- 2216 = "DISPOSE" "(" Design<dt, dk, qd, qn, sfx> (. astD := astCur; .) ")"
|
|
|
- 2217 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 2218 AST.SetChild(astNode, 0,
|
|
|
- 2219 AST.MakeLeaf(AST.NkIdent, "DISPOSE"));
|
|
|
- 2220 IF astD # AST.NoNode THEN
|
|
|
- 2221 AST.SetChild(astNode, 1, astD) END;
|
|
|
- 2222 astStmt := astNode; .)
|
|
|
- 2223 (. IF dt = SymTab.InvalidType THEN
|
|
|
- 2224 ELSIF (dk # SymTab.KindVar)
|
|
|
- 2225 AND (dk # SymTab.KindParam)
|
|
|
- 2226 AND (dk # SymTab.KindField) THEN
|
|
|
- 2227 SemError(210)
|
|
|
- 2228 ELSIF SymTab.ClassOf(dt) #
|
|
|
- 2229 SymTab.ClPtr THEN
|
|
|
- 2230 SemError(219)
|
|
|
- 2231 END; .) .
|
|
|
- 2232 (* WITH pushes each record's fields (inner wins) plus its base
|
|
|
- 2233 address; field designators resolve through both stacks. *)
|
|
|
- 2234 WithStat (. VAR nW: CARDINAL;
|
|
|
- 2235 astNode: AST.Node; .)
|
|
|
- 2236 = "WITH" (. nW := 0;
|
|
|
- 2237 astNode := AST.MakeNode(AST.NkWith); .)
|
|
|
- 2238 WithItem<nW, astNode> { "," WithItem<nW, astNode> }
|
|
|
- 2239 "DO" (. astStmt := AST.NoNode; .)
|
|
|
- 2240 [ StatSeq ] "END" (. AST.SetChild(astNode,
|
|
|
- 2241 AST.NChild(astNode), astStmt);
|
|
|
- 2242 astStmt := astNode;
|
|
|
- 2243 WHILE nW > 0 DO
|
|
|
- 2244 SymTab.PopScope;
|
|
|
- 2245 QbeGen.PopWith;
|
|
|
- 2246 DEC(nW)
|
|
|
- 2247 END; .) .
|
|
|
- 2248 WithItem<VAR nW: CARDINAL; wnode: AST.Node>
|
|
|
- 2249 (. VAR dt: SymTab.TypeIndex;
|
|
|
- 2250 dk: INTEGER;
|
|
|
- 2251 qd, qe: QbeGen.QVal;
|
|
|
- 2252 qn: SymTab.Name;
|
|
|
- 2253 sfx: BOOLEAN; .)
|
|
|
- 2254 = Design<dt, dk, qd, qn, sfx>
|
|
|
- 2255 (. IF astCur # AST.NoNode THEN
|
|
|
- 2256 AST.SetChild(wnode,
|
|
|
- 2257 AST.NChild(wnode), astCur) END;
|
|
|
- 2258 IF dt = SymTab.InvalidType THEN
|
|
|
- 2259 ELSIF (SymTab.ClassOf(dt) #
|
|
|
- 2260 SymTab.ClRecord)
|
|
|
- 2261 AND (SymTab.ClassOf(dt) #
|
|
|
- 2262 SymTab.ClClass) THEN
|
|
|
- 2263 SemError(215)
|
|
|
- 2264 ELSIF SymTab.PushRecord(dt) THEN
|
|
|
- 2265 QbeGen.PushWith(qd);
|
|
|
- 2266 INC(nW)
|
|
|
- 2267 END; .) .
|
|
|
- 2268 (* Assignment or procedure-statement call (4.1, module level).
|
|
|
- 2269 Bare `P;` is a syntax error; function-as-statement is 233. *)
|
|
|
- 2270 AssOrCall (. VAR dt, et: SymTab.TypeIndex;
|
|
|
- 2271 dk: INTEGER;
|
|
|
- 2272 qd, qe, qt, ql: QbeGen.QVal;
|
|
|
- 2273 qn: SymTab.Name;
|
|
|
- 2274 ct2, res0: SymTab.TypeIndex;
|
|
|
- 2275 q2, mg0: QbeGen.QVal;
|
|
|
- 2276 isR, conv, wconv: BOOLEAN;
|
|
|
- 2277 called, sfx: BOOLEAN;
|
|
|
- 2278 astLhs, astRes: AST.Node; mname: SymTab.Name; isM: BOOLEAN;
|
|
|
- 2279 n: SymTab.Name; astLab, astNode: AST.Node; .)
|
|
|
- 2280 = GetIdent<n>
|
|
|
- 2281 ( ":" (. NoteLabel(n);
|
|
|
- 2282 astNode := AST.MakeNode(AST.NkLabel);
|
|
|
- 2283 AST.SetChild(astNode, 0,
|
|
|
- 2284 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
- 2285 astLab := AST.MakeNode(AST.NkBlock);
|
|
|
- 2286 AST.SetChild(astLab, 0, astNode); .)
|
|
|
- 2287 Statement (. IF astStmt # AST.NoNode THEN
|
|
|
- 2288 AST.SetChild(astLab, 1, astStmt) END;
|
|
|
- 2289 astStmt := astLab; .)
|
|
|
- 2290 | DesignTail<n, dt, dk, qd, qn, sfx>
|
|
|
- 2291 (. astLhs := astCur; astNArgs := 0; .)
|
|
|
- 2292 ( ":="
|
|
|
- 2293 Expr<et, qe> (. astStmt := AST.MakeBin(
|
|
|
- 2294 AST.NkAssign, 0, astLhs, astCur);
|
|
|
- 2295 IF (dt # SymTab.InvalidType)
|
|
|
- 2296 AND (dk # SymTab.KindVar)
|
|
|
- 2297 AND (dk # SymTab.KindParam)
|
|
|
- 2298 AND (dk # SymTab.KindField) THEN
|
|
|
- 2299 SemError(210)
|
|
|
- 2300 ELSIF NOT SymTab.Assignable(et,
|
|
|
- 2301 dt) THEN
|
|
|
- 2302 SemError(210)
|
|
|
- 2303 ELSIF (dt # SymTab.InvalidType)
|
|
|
- 2304 AND (SymTab.ClassOf(dt) =
|
|
|
- 2305 SymTab.ClClass) THEN
|
|
|
- 2306 SemError(230) END;
|
|
|
- 2307 isR := (dt #
|
|
|
- 2308 SymTab.InvalidType)
|
|
|
- 2309 AND (SymTab.ClassOf(dt)
|
|
|
- 2310 = SymTab.ClReal);
|
|
|
- 2311 conv := isR
|
|
|
- 2312 AND SymTab.IsIntFamily(et);
|
|
|
- 2313 wconv := (dt #
|
|
|
- 2314 SymTab.InvalidType)
|
|
|
- 2315 AND SymTab.IsLongFamily(dt)
|
|
|
- 2316 AND SymTab.IsIntFamily(et);
|
|
|
- 2317 IF ((dk = SymTab.KindVar)
|
|
|
- 2318 OR (dk = SymTab.KindParam)
|
|
|
- 2319 OR (dk = SymTab.KindField))
|
|
|
- 2320 AND (dt # SymTab.InvalidType)
|
|
|
- 2321 AND (et # SymTab.InvalidType)
|
|
|
- 2322 AND (SymTab.ClassOf(dt) #
|
|
|
- 2323 SymTab.ClClass) THEN
|
|
|
- 2324 END; .)
|
|
|
- 2325 | ArgList<qn, dt, qd, TRUE, TRUE, methCls, ct2, q2, called>
|
|
|
- 2326 (. astRes := AstCallNode(astLhs);
|
|
|
- 2327 sfx := FALSE; .)
|
|
|
- 2328 ( { ResultComp<ct2, q2, sfx, astRes, mname, methCls, isM> }
|
|
|
- 2329 ":=" Expr<et, qe> (. astStmt := AST.MakeBin(
|
|
|
- 2330 AST.NkAssign, 0, astRes, astCur);
|
|
|
- 2331 IF NOT sfx THEN
|
|
|
- 2332 SemError(233)
|
|
|
- 2333 ELSIF (ct2 # SymTab.InvalidType)
|
|
|
- 2334 AND NOT SymTab.Assignable(et, ct2) THEN
|
|
|
- 2335 SemError(210)
|
|
|
- 2336 END; .)
|
|
|
- 2337 | (. (* discarding the result of a
|
|
|
- 2338 foreign C varargs call
|
|
|
- 2339 (printf/snprintf) is accepted;
|
|
|
- 2340 an ordinary Modula-2 function
|
|
|
- 2341 used as a statement stays 233 *)
|
|
|
- 2342 IF (ct2 # SymTab.InvalidType)
|
|
|
- 2343 AND NOT SymTab.Varargs(qn) THEN
|
|
|
- 2344 SemError(233) END;
|
|
|
- 2345 astStmt := astRes; .) )
|
|
|
- 2346 | (* bare `P;`: proper parameterless
|
|
|
- 2347 procedure call; anything else
|
|
|
- 2348 here is 233 (was a bare syntax
|
|
|
- 2349 error before 4.2) *)
|
|
|
- 2350 (. astStmt := AstCallNode(astLhs);
|
|
|
- 2351 IF (dk = SymTab.KindProc)
|
|
|
- 2352 AND NOT sfx THEN
|
|
|
- 2353 res0 := SymTab.ProcRes(qn);
|
|
|
- 2354 IF res0 #
|
|
|
- 2355 SymTab.InvalidType THEN
|
|
|
- 2356 SemError(233)
|
|
|
- 2357 ELSIF SymTab.ProcNPar(qn) #
|
|
|
- 2358 0 THEN
|
|
|
- 2359 SemError(233)
|
|
|
- 2360 END
|
|
|
- 2361 ELSIF (dt # SymTab.InvalidType)
|
|
|
- 2362 AND (SymTab.ClassOf(dt) = SymTab.ClProc) THEN
|
|
|
- 2363 IF SymTab.ProcTypeRes(dt) #
|
|
|
- 2364 SymTab.InvalidType THEN
|
|
|
- 2365 SemError(233)
|
|
|
- 2366 ELSIF SymTab.ProcTypeNPar(dt) #
|
|
|
- 2367 0 THEN
|
|
|
- 2368 SemError(233)
|
|
|
- 2369 END
|
|
|
- 2370 ELSE SemError(233)
|
|
|
- 2371 END; .) ) ) .
|
|
|
- 2372 (* Actual-parameter list shared by statement and expression calls.
|
|
|
- 2373 want selects CallEnd's result handling; t/q carry the call
|
|
|
- 2374 value (statement calls discard). Arity/type failures are 233;
|
|
|
- 2375 evaluation code still emits so the .ssa stays assembleable. *)
|
|
|
- 2376 ArgList<pn: SymTab.Name; pt: SymTab.TypeIndex; callee: QbeGen.QVal;
|
|
|
- 2377 want: BOOLEAN; soft: BOOLEAN; methCls: SymTab.TypeIndex;
|
|
|
- 2378 VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
|
|
|
- 2379 VAR called: BOOLEAN> (. VAR i, np: CARDINAL;
|
|
|
- 2380 vs: INTEGER;
|
|
|
- 2381 res: SymTab.TypeIndex;
|
|
|
- 2382 mg: QbeGen.QVal;
|
|
|
- 2383 ok, ind, isMeth, va, isConv: BOOLEAN; .)
|
|
|
- 2384 = "(" (. called := TRUE;
|
|
|
- 2385 ok := TRUE;
|
|
|
- 2386 ind := FALSE;
|
|
|
- 2387 isConv := FALSE;
|
|
|
- 2388 isMeth := methCls #
|
|
|
- 2389 SymTab.InvalidType;
|
|
|
- 2390 IF isMeth THEN
|
|
|
- 2391 res := SymTab.ClassMethodRes(methCls, pn)
|
|
|
- 2392 ELSIF SymTab.SymKind(pn) = SymTab.KindProc THEN
|
|
|
- 2393 res := SymTab.ProcRes(pn)
|
|
|
- 2394 ELSIF (SymTab.SymKind(pn) = SymTab.KindType)
|
|
|
- 2395 OR (SymTab.SymKind(pn) = SymTab.KindPredef) THEN
|
|
|
- 2396 (* ISO type conversion T(x):
|
|
|
- 2397 one value, result is T *)
|
|
|
- 2398 isConv := TRUE;
|
|
|
- 2399 res := SymTab.SymType(pn)
|
|
|
- 2400 ELSIF (pt # SymTab.InvalidType)
|
|
|
- 2401 AND (SymTab.ClassOf(pt) = SymTab.ClProc) THEN
|
|
|
- 2402 ind := TRUE;
|
|
|
- 2403 res := SymTab.ProcTypeRes(pt)
|
|
|
- 2404 ELSE SemError(233);
|
|
|
- 2405 ok := FALSE;
|
|
|
- 2406 res := SymTab.InvalidType
|
|
|
- 2407 END;
|
|
|
- 2408 i := 0; .)
|
|
|
- 2409 [ ActParam<pn, pt, ind, methCls, i> (. INC(i); .)
|
|
|
- 2410 { "," ActParam<pn, pt, ind, methCls, i> (. INC(i); .) } ]
|
|
|
- 2411 ")" (. IF ok THEN
|
|
|
- 2412 IF isConv THEN
|
|
|
- 2413 (* a conversion takes
|
|
|
- 2414 exactly one value *)
|
|
|
- 2415 IF i # 1 THEN
|
|
|
- 2416 SemError(233); ok := FALSE
|
|
|
- 2417 END
|
|
|
- 2418 ELSE
|
|
|
- 2419 IF isMeth THEN
|
|
|
- 2420 np := SymTab.ClassMethodNPar(
|
|
|
- 2421 methCls, pn)
|
|
|
- 2422 ELSIF ind THEN
|
|
|
- 2423 np := SymTab.ProcTypeNPar(pt)
|
|
|
- 2424 ELSE np := SymTab.ProcNPar(pn)
|
|
|
- 2425 END;
|
|
|
- 2426 va := (NOT isMeth) AND (NOT ind)
|
|
|
- 2427 AND (SymTab.SymKind(pn) =
|
|
|
- 2428 SymTab.KindProc)
|
|
|
- 2429 AND SymTab.Varargs(pn);
|
|
|
- 2430 IF (i # np) AND NOT va THEN
|
|
|
- 2431 SemError(233); ok := FALSE
|
|
|
- 2432 END
|
|
|
- 2433 END
|
|
|
- 2434 END;
|
|
|
- 2435 IF NOT ok THEN
|
|
|
- 2436 t := SymTab.InvalidType;
|
|
|
- 2437 QbeGen.CopyOp("0", q)
|
|
|
- 2438 ELSIF want THEN
|
|
|
- 2439 IF res =
|
|
|
- 2440 SymTab.InvalidType THEN
|
|
|
- 2441 IF NOT soft THEN SemError(233) END;
|
|
|
- 2442 t := SymTab.InvalidType;
|
|
|
- 2443 QbeGen.CopyOp("0", q)
|
|
|
- 2444 ELSE t := res;
|
|
|
- 2445 QbeGen.CopyOp("@", q)
|
|
|
- 2446 END
|
|
|
- 2447 ELSE
|
|
|
- 2448 (* a function call used as
|
|
|
- 2449 a statement: allowed for
|
|
|
- 2450 a foreign C varargs proc
|
|
|
- 2451 (printf/snprintf), whose
|
|
|
- 2452 result is conventionally
|
|
|
- 2453 discarded; ordinary
|
|
|
- 2454 Modula-2 functions keep
|
|
|
- 2455 the 233 diagnostic *)
|
|
|
- 2456 IF (res # SymTab.InvalidType)
|
|
|
- 2457 AND NOT va THEN
|
|
|
- 2458 SemError(233)
|
|
|
- 2459 END;
|
|
|
- 2460 t := SymTab.InvalidType;
|
|
|
- 2461 QbeGen.CopyOp("0", q);
|
|
|
- 2462 END; .) .
|
|
|
- 2463 (* One actual: VAR formals take recorded designator addresses
|
|
|
- 2464 (233 otherwise); value formals take converted expressions. *)
|
|
|
- 2465 ActParam<pn: SymTab.Name; pt: SymTab.TypeIndex; ind: BOOLEAN;
|
|
|
- 2466 methCls: SymTab.TypeIndex; i: CARDINAL>
|
|
|
- 2467 (. VAR at, ft: SymTab.TypeIndex;
|
|
|
- 2468 qe, qa, qt: QbeGen.QVal;
|
|
|
- 2469 isV, conv, va: BOOLEAN;
|
|
|
- 2470 cl: CHAR;
|
|
|
- 2471 savedN, aj: CARDINAL;
|
|
|
- 2472 savedArgs: ARRAY [0 .. 31]
|
|
|
- 2473 OF AST.Node;
|
|
|
- 2474 astActual: AST.Node; .)
|
|
|
- 2475 = (. (* Parsing the actual can clobber
|
|
|
- 2476 the enclosing call's argument
|
|
|
- 2477 list (Factor resets astNArgs),
|
|
|
- 2478 so save/restore it. *)
|
|
|
- 2479 savedN := astNArgs; aj := 0;
|
|
|
- 2480 WHILE aj <= HIGH(astArgs) DO
|
|
|
- 2481 savedArgs[aj] := astArgs[aj];
|
|
|
- 2482 INC(aj)
|
|
|
- 2483 END; .)
|
|
|
- 2484 Expr<at, qe> (. QbeGen.CopyOp(qe, convQ); convT := at;
|
|
|
- 2485 astActual := astCur;
|
|
|
- 2486 astNArgs := savedN; aj := 0;
|
|
|
- 2487 WHILE aj <= HIGH(astArgs) DO
|
|
|
- 2488 astArgs[aj] := savedArgs[aj];
|
|
|
- 2489 INC(aj)
|
|
|
- 2490 END;
|
|
|
- 2491 IF astNArgs <= HIGH(astArgs) THEN
|
|
|
- 2492 astArgs[astNArgs] := astCur;
|
|
|
- 2493 INC(astNArgs)
|
|
|
- 2494 ELSE SemError(230)
|
|
|
- 2495 (* > 32 actuals: impl limit *)
|
|
|
- 2496 END;
|
|
|
- 2497 va := (NOT ind)
|
|
|
- 2498 AND (methCls =
|
|
|
- 2499 SymTab.InvalidType)
|
|
|
- 2500 AND (SymTab.SymKind(pn) =
|
|
|
- 2501 SymTab.KindProc)
|
|
|
- 2502 AND SymTab.Varargs(pn);
|
|
|
- 2503 IF ind THEN
|
|
|
- 2504 ft :=
|
|
|
- 2505 SymTab.ProcTypeParamType(pt,
|
|
|
- 2506 i);
|
|
|
- 2507 isV :=
|
|
|
- 2508 SymTab.ProcTypeParamIsVar(pt,
|
|
|
- 2509 i)
|
|
|
- 2510 ELSIF methCls #
|
|
|
- 2511 SymTab.InvalidType THEN
|
|
|
- 2512 ft :=
|
|
|
- 2513 SymTab.ClassMethodParamType(
|
|
|
- 2514 methCls, pn, i);
|
|
|
- 2515 isV :=
|
|
|
- 2516 SymTab.ClassMethodParamIsVar(
|
|
|
- 2517 methCls, pn, i)
|
|
|
- 2518 ELSE
|
|
|
- 2519 ft := SymTab.ParamType(pn, i);
|
|
|
- 2520 isV := SymTab.ParamIsVar(pn, i)
|
|
|
- 2521 END;
|
|
|
- 2522 IF (at = SymTab.InvalidType) THEN
|
|
|
- 2523 ELSIF ft = SymTab.InvalidType THEN
|
|
|
- 2524 ELSIF isV THEN
|
|
|
- 2525 IF (SymTab.ClassOf(at) = SymTab.ClChar)
|
|
|
- 2526 AND (SymTab.ClassOf(ft) = SymTab.ClArray)
|
|
|
- 2527 AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
|
|
|
- 2528 AND QbeGen.IsImm(qe) THEN
|
|
|
- 2529 ELSIF (AST.Kind(astActual) #
|
|
|
- 2530 AST.NkDesignator)
|
|
|
- 2531 AND (AST.Kind(astActual) # AST.NkStrLit) THEN
|
|
|
- 2532 SemError(233)
|
|
|
- 2533 ELSIF NOT SymTab.VarParamOk(at, ft)
|
|
|
- 2534 AND NOT SymTab.ByteBufOk(at, ft) THEN
|
|
|
- 2535 SemError(233)
|
|
|
- 2536 END
|
|
|
- 2537 ELSE
|
|
|
- 2538 IF (SymTab.ClassOf(at) = SymTab.ClChar)
|
|
|
- 2539 AND (SymTab.ClassOf(ft) = SymTab.ClArray)
|
|
|
- 2540 AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
|
|
|
- 2541 AND QbeGen.IsImm(qe) THEN
|
|
|
- 2542 ELSIF NOT SymTab.Assignable(at, ft)
|
|
|
- 2543 AND NOT SymTab.ByteBufOk(at, ft) THEN
|
|
|
- 2544 SemError(233)
|
|
|
- 2545 END
|
|
|
- 2546 END; .) .
|
|
|
- 2547 IfStat (. VAR t: SymTab.TypeIndex;
|
|
|
- 2548 q: QbeGen.QVal;
|
|
|
- 2549 hasElse: BOOLEAN;
|
|
|
- 2550 astCond, astIf, astLast,
|
|
|
- 2551 astNode: AST.Node; .)
|
|
|
- 2552 = "IF" (. hasElse := FALSE; .)
|
|
|
- 2553 Expr<t, q> (. astCond := astCur; astStmt := AST.NoNode;
|
|
|
- 2554 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
- 2555 SemError(214) END; .)
|
|
|
- 2556 "THEN" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkIf);
|
|
|
- 2557 AST.SetChild(astNode, 0, astCond);
|
|
|
- 2558 AST.SetChild(astNode, 1, astStmt);
|
|
|
- 2559 astIf := astNode;
|
|
|
- 2560 astLast := astNode; .)
|
|
|
- 2561 { "ELSIF"
|
|
|
- 2562 Expr<t, q> (. astCond := astCur; astStmt := AST.NoNode;
|
|
|
- 2563 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
- 2564 SemError(214) END; .)
|
|
|
- 2565 "THEN" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkIf);
|
|
|
- 2566 AST.SetChild(astNode, 0, astCond);
|
|
|
- 2567 AST.SetChild(astNode, 1, astStmt);
|
|
|
- 2568 AST.SetChild(astLast, 2, astNode);
|
|
|
- 2569 astLast := astNode; .) }
|
|
|
- 2570 [ "ELSE" (. hasElse := TRUE;
|
|
|
- 2571 astStmt := AST.NoNode; .)
|
|
|
- 2572 [ StatSeq ] (. AST.SetChild(astLast, 2, astStmt); .) ]
|
|
|
- 2573 "END" (. astStmt := astIf; .) .
|
|
|
- 2574 WhileStat (. VAR t: SymTab.TypeIndex;
|
|
|
- 2575 q: QbeGen.QVal;
|
|
|
- 2576 astCond, astNode: AST.Node; .)
|
|
|
- 2577 = "WHILE" (. astStmt := AST.NoNode; .)
|
|
|
- 2578 Expr<t, q> (. astCond := astCur;
|
|
|
- 2579 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
- 2580 SemError(214) END; .)
|
|
|
- 2581 "DO" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkWhile);
|
|
|
- 2582 AST.SetChild(astNode, 0, astCond);
|
|
|
- 2583 AST.SetChild(astNode, 1, astStmt);
|
|
|
- 2584 astStmt := astNode; .)
|
|
|
- 2585 "END" .
|
|
|
- 2586 RepeatStat (. VAR t: SymTab.TypeIndex;
|
|
|
- 2587 q: QbeGen.QVal;
|
|
|
- 2588 astCond, astBody, astNode:
|
|
|
- 2589 AST.Node; .)
|
|
|
- 2590 = "REPEAT" (. astStmt := AST.NoNode; .)
|
|
|
- 2591 [ StatSeq ] (. astBody := astStmt; .)
|
|
|
- 2592 "UNTIL" Expr<t, q> (. astCond := astCur;
|
|
|
- 2593 astNode := AST.MakeNode(AST.NkRepeat);
|
|
|
- 2594 AST.SetChild(astNode, 0, astBody);
|
|
|
- 2595 AST.SetChild(astNode, 1, astCond);
|
|
|
- 2596 astStmt := astNode;
|
|
|
- 2597 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
- 2598 SemError(214) END; .) .
|
|
|
- 2599 LoopStat (. VAR lEnd: QbeGen.QVal; astNode: AST.Node; .)
|
|
|
- 2600 = "LOOP" (. astStmt := AST.NoNode;
|
|
|
- 2601 QbeGen.NewLabel(lEnd);
|
|
|
- 2602 QbeGen.PushLoop(lEnd); .)
|
|
|
- 2603 [ StatSeq ]
|
|
|
- 2604 "END" (. astNode := AST.MakeNode(AST.NkLoop);
|
|
|
- 2605 AST.SetChild(astNode, 0, astStmt);
|
|
|
- 2606 astStmt := astNode;
|
|
|
- 2607 QbeGen.PopLoop; .) .
|
|
|
- 2608 (* FOR with static-sign BY (literal, non-zero; 220 otherwise).
|
|
|
- 2609 Runtime direction would need a compare-select; the literal
|
|
|
- 2610 sign picks cslew/csegew at "DO" time. *)
|
|
|
- 2611 ForStat (. VAR lv: SymTab.Name;
|
|
|
- 2612 tlo, thi, tby:
|
|
|
- 2613 SymTab.TypeIndex;
|
|
|
- 2614 qlo, qhi, qby, qt, qk, qb:
|
|
|
- 2615 QbeGen.QVal;
|
|
|
- 2616 lTop, lBody, lEnd:
|
|
|
+ 1177 ELSIF SymTab.ModKnown(mod)
|
|
|
+ 1178 AND NOT SymTab.Equal(mod,
|
|
|
+ 1179 "SYSTEM") THEN
|
|
|
+ 1180 IF NOT SymTab.ImportFrom(mod, n) THEN
|
|
|
+ 1181 SemError(201)
|
|
|
+ 1182 ELSE Lower.NoteImportedProc(n)
|
|
|
+ 1183 END
|
|
|
+ 1184 END; .)
|
|
|
+ 1185 | ( "TSIZE" | "SIZE" | "ADR" | "HIGH" | "LEN"
|
|
|
+ 1186 | "CHR" | "ORD" | "VAL" | "ABS" | "CAP"
|
|
|
+ 1187 | "ODD" | "TRUNC" | "FLOAT"
|
|
|
+ 1188 | "UCHR" | "CHR8" | "UORD"
|
|
|
+ 1189 | "INC" | "DEC"
|
|
|
+ 1190 | "SHIFT" | "ROTATE" | "CAST" | "CONVERT" | "MIN" | "MAX"
|
|
|
+ 1191 | "INCL" | "EXCL" | "NEW" | "DISPOSE" | "LOC" ) .
|
|
|
+ 1192 ImpModList<node: AST.Node> (. VAR n: SymTab.Name; .)
|
|
|
+ 1193 = GetIdent<n> (. AST.SetChild(node, AST.NChild(node),
|
|
|
+ 1194 AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
+ 1195 { "," GetIdent<n> (. AST.SetChild(node, AST.NChild(node),
|
|
|
+ 1196 AST.MakeLeaf(AST.NkIdent, n)); .) } .
|
|
|
+ 1197 (* Opaque TYPE declarations (definition modules). The targetless
|
|
|
+ 1198 alias resolves to InvalidType until step 4 completes it. *)
|
|
|
+ 1199 (* Scalar-phase TYPEs: named types, integer subranges, enumerations.
|
|
|
+ 1200 Opaque "TYPE T;" needs isDef (definition units); elsewhere 231.
|
|
|
+ 1201 Composite forms (ARRAY/RECORD/SET/POINTER) arrive with step 3. *)
|
|
|
+ 1202 TypeBlock<isDef: BOOLEAN> (. VAR astSeq, astTail: AST.Node; .)
|
|
|
+ 1203 = "TYPE" (. SymTab.BeginTypeBlock;
|
|
|
+ 1204 astSeq := AST.NoNode;
|
|
|
+ 1205 astTail := AST.NoNode; .)
|
|
|
+ 1206 { (. astDecl := AST.NoNode; .)
|
|
|
+ 1207 ( TypeItem<isDef> ";" | ClassItem ";" )
|
|
|
+ 1208 (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 1209 astSeq, astTail, astDecl); .) }
|
|
|
+ 1210 (. SymTab.EndTypeBlock;
|
|
|
+ 1211 astDecl := astSeq; .) .
|
|
|
+ 1212 TypeItem<isDef: BOOLEAN> (. VAR n: SymTab.Name;
|
|
|
+ 1213 t, op: SymTab.TypeIndex;
|
|
|
+ 1214 astNode: AST.Node; .)
|
|
|
+ 1215 = GetIdent<n> (. op := SymTab.OpaqueBase(n);
|
|
|
+ 1216 IF op = SymTab.InvalidType THEN
|
|
|
+ 1217 IF NOT SymTab.Enter(n,
|
|
|
+ 1218 SymTab.KindType) THEN
|
|
|
+ 1219 SemError(200) END
|
|
|
+ 1220 END; .)
|
|
|
+ 1221 ( "=" Type<t, FALSE> (. astNode := AST.MakeNode(AST.NkTypeDecl);
|
|
|
+ 1222 AST.SetChild(astNode, 0,
|
|
|
+ 1223 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
+ 1224 AST.SetTy(astNode, t);
|
|
|
+ 1225 astDecl := astNode;
|
|
|
+ 1226 IF op # SymTab.InvalidType THEN
|
|
|
+ 1227 SymTab.SetTarget(op, t)
|
|
|
+ 1228 ELSE SymTab.SetSymType(n, t)
|
|
|
+ 1229 END;
|
|
|
+ 1230 IF SymTab.EnterEnumLits(t) > 0 THEN END; .)
|
|
|
+ 1231 | (. IF op # SymTab.InvalidType THEN
|
|
|
+ 1232 (* stays opaque *)
|
|
|
+ 1233 ELSIF NOT isDef THEN
|
|
|
+ 1234 SemError(231)
|
|
|
+ 1235 ELSE SymTab.SetSymType(n,
|
|
|
+ 1236 SymTab.NewAlias()) END; .) ) .
|
|
|
+ 1237 Type<VAR t: SymTab.TypeIndex; allowOpen: BOOLEAN>
|
|
|
+ 1238 = TypeIdent<t> [ Subrange<t> ] (* anchored subrange: T[lo..hi] *)
|
|
|
+ 1239 | Subrange<t>
|
|
|
+ 1240 | Enum<t>
|
|
|
+ 1241 | ArrayType<t, allowOpen>
|
|
|
+ 1242 | SetType<t>
|
|
|
+ 1243 | RecordType<t>
|
|
|
+ 1244 | PointerType<t>
|
|
|
+ 1245 | ProcType<t> .
|
|
|
+ 1246 PointerType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex; .)
|
|
|
+ 1247 = "POINTER" "TO" (. allowFwdType := TRUE; .)
|
|
|
+ 1248 Type<base, FALSE> (. allowFwdType := FALSE;
|
|
|
+ 1249 t := SymTab.NewPtr(base); .) .
|
|
|
+ 1250 (* Procedure types (step 8.5): PROCEDURE (params): result. Values
|
|
|
+ 1251 are code pointers; params are collected into the descriptor. *)
|
|
|
+ 1252 ProcType<VAR t: SymTab.TypeIndex> (. VAR res, pt: SymTab.TypeIndex;
|
|
|
+ 1253 isV: BOOLEAN; .)
|
|
|
+ 1254 = ( "PROCEDURE" | "PROC" ) (. allowFwdType := FALSE;
|
|
|
+ 1255 res := SymTab.InvalidType;
|
|
|
+ 1256 t := SymTab.NewProcType(res); .)
|
|
|
+ 1257 [ "(" [ ProcTypeSection<t> { ";" ProcTypeSection<t> } ] ")" ]
|
|
|
+ 1258 [ ":" TypeIdent<res> (. SymTab.SetProcTypeRes(t, res); .) ] .
|
|
|
+ 1259 ProcTypeSection<t: SymTab.TypeIndex> (. VAR pt: SymTab.TypeIndex;
|
|
|
+ 1260 isV: BOOLEAN;
|
|
|
+ 1261 cnt, k: CARDINAL;
|
|
|
+ 1262 names: ARRAY [0 .. 15] OF SymTab.Name; .)
|
|
|
+ 1263 = (. isV := FALSE; cnt := 0; .)
|
|
|
+ 1264 [ "VAR" (. isV := TRUE; .) ]
|
|
|
+ 1265 ( GetIdent<names[cnt]> (. INC(cnt); .)
|
|
|
+ 1266 { "," GetIdent<names[cnt]> (. INC(cnt); .) }
|
|
|
+ 1267 ( ":" Type<pt, TRUE> (. k := 0;
|
|
|
+ 1268 WHILE k < cnt DO
|
|
|
+ 1269 SymTab.ProcTypeAdd(t, isV, pt);
|
|
|
+ 1270 INC(k)
|
|
|
+ 1271 END; .)
|
|
|
+ 1272 | (. (* type-only parameter list:
|
|
|
+ 1273 each name is a type (GNU
|
|
|
+ 1274 shorthand used by the
|
|
|
+ 1275 Coco/R scanner frame) *)
|
|
|
+ 1276 k := 0;
|
|
|
+ 1277 WHILE k < cnt DO
|
|
|
+ 1278 IF SymTab.Lookup(names[k])
|
|
|
+ 1279 AND ((SymTab.SymKind(names[k]) = SymTab.KindType)
|
|
|
+ 1280 OR (SymTab.SymKind(names[k]) = SymTab.KindPredef)) THEN
|
|
|
+ 1281 pt := SymTab.SymType(names[k])
|
|
|
+ 1282 ELSE SemError(201);
|
|
|
+ 1283 pt := SymTab.InvalidType
|
|
|
+ 1284 END;
|
|
|
+ 1285 SymTab.ProcTypeAdd(t, isV, pt);
|
|
|
+ 1286 INC(k)
|
|
|
+ 1287 END; .) )
|
|
|
+ 1288 | Type<pt, TRUE> (. (* unnamed parameter (PIM):
|
|
|
+ 1289 e.g. PROCEDURE (VAR ARRAY OF REAL) *)
|
|
|
+ 1290 SymTab.ProcTypeAdd(t, isV, pt); .) ) .
|
|
|
+ 1291 (* Arrays: "OF" without bounds is an open formal (allowed only
|
|
|
+ 1292 where allowOpen); "[lo..hi, ...]" nests bounded levels inside
|
|
|
+ 1293 out. The PIM/ISO multi-index form repeats the bracket group
|
|
|
+ 1294 ("ARRAY [lo..hi], [lo..hi] OF T"); the bounds of every group
|
|
|
+ 1295 nest in the same inside-out order as the comma list. Bounds are
|
|
|
+ 1296 folded literals (int/char); anything else 230. Bare-type indices
|
|
|
+ 1297 ("ARRAY Color OF") wait for enum ordinals. *)
|
|
|
+ 1298 ArrayType<VAR t: SymTab.TypeIndex; allowOpen: BOOLEAN>
|
|
|
+ 1299 (. VAR elem: SymTab.TypeIndex;
|
|
|
+ 1300 eb: SymTab.Name;
|
|
|
+ 1301 ok: BOOLEAN;
|
|
|
+ 1302 bnds, bndh: ARRAY [0 .. 7] OF INTEGER;
|
|
|
+ 1303 nb, k: CARDINAL;
|
|
|
+ 1304 idx: SymTab.TypeIndex;
|
|
|
+ 1305 ilo, ihi: INTEGER; .)
|
|
|
+ 1306 = "ARRAY" (. allowFwdType := FALSE; .)
|
|
|
+ 1307 ( "OF"
|
|
|
+ 1308 Type<elem, FALSE> (. LexName(eb); (* the element ident *)
|
|
|
+ 1309 IF NOT allowOpen THEN
|
|
|
+ 1310 SemError(230) END;
|
|
|
+ 1311 t := SymTab.NewOpenArray(elem);
|
|
|
+ 1312 IF SymTab.Equal(eb, "BYTE") THEN
|
|
|
+ 1313 SymTab.MarkByteBuf(t) END; .)
|
|
|
+ 1314 | TypeIdent<idx> [ Subrange<idx> ]
|
|
|
+ 1315 "OF" Type<elem, FALSE> (. (* index-type array: the index
|
|
|
+ 1316 type's ordinal bounds give the
|
|
|
+ 1317 [lo..hi] pair *)
|
|
|
+ 1318 IF SymTab.TypeBounds(idx, ilo,
|
|
|
+ 1319 ihi)
|
|
|
+ 1320 THEN t := SymTab.NewArrayB(elem,
|
|
|
+ 1321 ilo, ihi)
|
|
|
+ 1322 ELSE SemError(230);
|
|
|
+ 1323 t := SymTab.InvalidType
|
|
|
+ 1324 END; .)
|
|
|
+ 1325 | "[" (. SymTab.BoundBegin; ok := TRUE;
|
|
|
+ 1326 nb := 0; .)
|
|
|
+ 1327 BoundPair<ok>
|
|
|
+ 1328 { "," BoundPair<ok> }
|
|
|
+ 1329 "]" (. (* snapshot this bracket group
|
|
|
+ 1330 before the element type, which
|
|
|
+ 1331 reuses the bound buffer for a
|
|
|
+ 1332 nested ARRAY *)
|
|
|
+ 1333 IF nb + SymTab.BoundCount() >
|
|
|
+ 1334 HIGH(bnds) + 1 THEN
|
|
|
+ 1335 SemError(230); ok := FALSE
|
|
|
+ 1336 ELSE
|
|
|
+ 1337 k := 0;
|
|
|
+ 1338 WHILE k < SymTab.BoundCount() DO
|
|
|
+ 1339 bnds[nb] := SymTab.BoundLo(k);
|
|
|
+ 1340 bndh[nb] := SymTab.BoundHi(k);
|
|
|
+ 1341 INC(k); INC(nb)
|
|
|
+ 1342 END
|
|
|
+ 1343 END; .)
|
|
|
+ 1344 { "," "[" (. SymTab.BoundBegin; .)
|
|
|
+ 1345 BoundPair<ok>
|
|
|
+ 1346 { "," BoundPair<ok> }
|
|
|
+ 1347 "]" (. IF nb + SymTab.BoundCount() >
|
|
|
+ 1348 HIGH(bnds) + 1 THEN
|
|
|
+ 1349 SemError(230); ok := FALSE
|
|
|
+ 1350 ELSE
|
|
|
+ 1351 k := 0;
|
|
|
+ 1352 WHILE k < SymTab.BoundCount() DO
|
|
|
+ 1353 bnds[nb] := SymTab.BoundLo(k);
|
|
|
+ 1354 bndh[nb] := SymTab.BoundHi(k);
|
|
|
+ 1355 INC(k); INC(nb)
|
|
|
+ 1356 END
|
|
|
+ 1357 END; .) }
|
|
|
+ 1358 "OF" Type<elem, FALSE>
|
|
|
+ 1359 (. IF ok THEN
|
|
|
+ 1360 k := nb;
|
|
|
+ 1361 WHILE k > 0 DO
|
|
|
+ 1362 DEC(k);
|
|
|
+ 1363 elem := SymTab.NewArrayB(
|
|
|
+ 1364 elem, bnds[k], bndh[k])
|
|
|
+ 1365 END;
|
|
|
+ 1366 t := elem
|
|
|
+ 1367 ELSE t := SymTab.InvalidType
|
|
|
+ 1368 END; .) ) .
|
|
|
+ 1369 BoundPair<VAR ok: BOOLEAN> (. VAR tlo, thi: SymTab.TypeIndex;
|
|
|
+ 1370 qlo, qhi: QbeGen.QVal;
|
|
|
+ 1371 lo, hi: INTEGER;
|
|
|
+ 1372 cl, cl2: INTEGER; .)
|
|
|
+ 1373 = Expr<tlo, qlo> ".." Expr<thi, qhi>
|
|
|
+ 1374 (. IF (tlo = SymTab.InvalidType)
|
|
|
+ 1375 OR (thi = SymTab.InvalidType) THEN
|
|
|
+ 1376 ok := FALSE
|
|
|
+ 1377 ELSE cl := SymTab.ClassOf(tlo);
|
|
|
+ 1378 cl2 := SymTab.ClassOf(thi);
|
|
|
+ 1379 IF ((cl # SymTab.ClInt)
|
|
|
+ 1380 AND (cl # SymTab.ClChar)
|
|
|
+ 1381 AND (cl # SymTab.ClBool)
|
|
|
+ 1382 AND (cl # SymTab.ClEnum))
|
|
|
+ 1383 OR ((cl2 # SymTab.ClInt)
|
|
|
+ 1384 AND (cl2 # SymTab.ClChar)
|
|
|
+ 1385 AND (cl2 # SymTab.ClBool)
|
|
|
+ 1386 AND (cl2 # SymTab.ClEnum)) THEN
|
|
|
+ 1387 SemError(230); ok := FALSE
|
|
|
+ 1388 ELSIF NOT SymTab.ConstInt(qlo, lo)
|
|
|
+ 1389 OR NOT SymTab.ConstInt(qhi, hi)
|
|
|
+ 1390 OR (lo > hi) THEN
|
|
|
+ 1391 SemError(230); ok := FALSE
|
|
|
+ 1392 ELSIF NOT SymTab.BoundAdd(lo, hi) THEN
|
|
|
+ 1393 SemError(230); ok := FALSE
|
|
|
+ 1394 END;
|
|
|
+ 1395 END; .) .
|
|
|
+ 1396 (* Sets: multi-word masks over bases ≤ 256 values (bool, char,
|
|
|
+ 1397 bounded subranges; enums wait for ordinals, INTEGER is
|
|
|
+ 1398 unbounded). Literals are SET OF [0..255]; assignment and
|
|
|
+ 1399 comparison across suitable bases are lenient (masks over min
|
|
|
+ 1400 words + zero-check extras), out-of-span literals are 222. *)
|
|
|
+ 1401 SetType<VAR t: SymTab.TypeIndex> (. VAR base: SymTab.TypeIndex;
|
|
|
+ 1402 blo, bhi, bspan: INTEGER;
|
|
|
+ 1403 bcls: INTEGER; .)
|
|
|
+ 1404 = "SET" (. allowFwdType := FALSE; .)
|
|
|
+ 1405 "OF" Type<base, FALSE>
|
|
|
+ 1406 (. IF base = SymTab.InvalidType THEN
|
|
|
+ 1407 t := SymTab.InvalidType
|
|
|
+ 1408 ELSIF SymTab.Unresolved(base) THEN
|
|
|
+ 1409 (* an opaque/formal base: defer
|
|
|
+ 1410 the span check until the
|
|
|
+ 1411 base is completed *)
|
|
|
+ 1412 t := SymTab.NewSet(base)
|
|
|
+ 1413 ELSE bcls :=
|
|
|
+ 1414 SymTab.ClassOf(base);
|
|
|
+ 1415 (* a subrange keeps its own
|
|
|
+ 1416 span even when its base is
|
|
|
+ 1417 CHAR/BOOLEAN/an enum *)
|
|
|
+ 1418 IF SymTab.SubBounds(base,
|
|
|
+ 1419 blo, bhi) THEN
|
|
|
+ 1420 bspan := bhi - blo + 1
|
|
|
+ 1421 ELSIF bcls = SymTab.ClBool THEN
|
|
|
+ 1422 blo := 0; bspan := 2
|
|
|
+ 1423 ELSIF bcls = SymTab.ClChar THEN
|
|
|
+ 1424 blo := 0; bspan := 256
|
|
|
+ 1425 ELSIF bcls = SymTab.ClEnum THEN
|
|
|
+ 1426 blo := 0;
|
|
|
+ 1427 bspan := VAL(INTEGER,
|
|
|
+ 1428 SymTab.EnumCount(base))
|
|
|
+ 1429 ELSE bspan := 0 END;
|
|
|
+ 1430 IF (bspan <= 0)
|
|
|
+ 1431 OR (bspan > 65536) THEN
|
|
|
+ 1432 SemError(230);
|
|
|
+ 1433 t := SymTab.InvalidType
|
|
|
+ 1434 ELSE t := SymTab.NewSet(base)
|
|
|
+ 1435 END
|
|
|
+ 1436 END; .) .
|
|
|
+ 1437 (* Records: flat blobs; array fields are pointers to static
|
|
|
+ 1438 descriptors (locked amendment), nested records inline. Field
|
|
|
+ 1439 offsets static and declaration-ordered. *)
|
|
|
+ 1440 (* Field list: plain fields and (optionally) one variant part. The
|
|
|
+ 1441 variant part is a `CASE ... END` item; because it starts with the
|
|
|
+ 1442 CASE keyword it is unambiguously distinguishable from a field
|
|
|
+ 1443 (which starts with an identifier). *)
|
|
|
+ 1444 RecordType<VAR t: SymTab.TypeIndex> (. VAR t2: SymTab.TypeIndex;
|
|
|
+ 1445 tagOk: BOOLEAN; .)
|
|
|
+ 1446 = "RECORD" (. allowFwdType := FALSE;
|
|
|
+ 1447 t := SymTab.NewRecord(); .)
|
|
|
+ 1448 [ RecItem<t> { ";" [ RecItem<t> ] } ]
|
|
|
+ 1449 "END" (. SymTab.LayoutRecord(t); .) .
|
|
|
+ 1450 RecItem<rec: SymTab.TypeIndex> (. VAR tt: SymTab.TypeIndex; .)
|
|
|
+ 1451 = RecField<rec>
|
|
|
+ 1452 | CaseField<rec> (. SymTab.MarkVariant(rec); .) .
|
|
|
+ 1453 (* A variant part: CASE [tag] : Type OF variants. gm2 extensions:
|
|
|
+ 1454 an untagged inner CASE (no tag field), empty arms and ELSE arms. *)
|
|
|
+ 1455 CaseField<rec: SymTab.TypeIndex> (. VAR tagT: SymTab.TypeIndex;
|
|
|
+ 1456 tagN: SymTab.Name;
|
|
|
+ 1457 tagged: BOOLEAN; .)
|
|
|
+ 1458 = "CASE" (. SymTab.ResetFields(rec);
|
|
|
+ 1459 tagged := FALSE; .)
|
|
|
+ 1460 [ GetIdent<tagN> (. IF NOT SymTab.FieldPending(rec,
|
|
|
+ 1461 tagN) THEN
|
|
|
+ 1462 SemError(200) END;
|
|
|
+ 1463 tagged := TRUE; .) ]
|
|
|
+ 1464 ":" Type<tagT, FALSE> (. IF (tagT # SymTab.InvalidType)
|
|
|
+ 1465 AND NOT SymTab.IsOrdinal(tagT) THEN
|
|
|
+ 1466 SemError(224)
|
|
|
+ 1467 END;
|
|
|
+ 1468 IF tagged THEN
|
|
|
+ 1469 SymTab.FixPendingF(rec, tagT);
|
|
|
+ 1470 SymTab.SetVariantTag(rec, tagN)
|
|
|
+ 1471 END; .)
|
|
|
+ 1472 "OF"
|
|
|
+ 1473 RecFieldList<rec>
|
|
|
+ 1474 { "|" (. SymTab.ResetFields(rec); .)
|
|
|
+ 1475 RecFieldList<rec> }
|
|
|
+ 1476 [ "ELSE" ]
|
|
|
+ 1477 "END" .
|
|
|
+ 1478 (* A variant branch: `labels : fields` (fields and their trailing ";"
|
|
|
+ 1479 optional, gm2), `ELSE`, or empty (the extra "|" separators gm2
|
|
|
+ 1480 tolerates). A branch may itself contain a nested variant CASE. *)
|
|
|
+ 1481 RecFieldList<rec: SymTab.TypeIndex> (. VAR lt, lq: SymTab.TypeIndex;
|
|
|
+ 1482 lv1, lv2: QbeGen.QVal; .)
|
|
|
+ 1483 = [ ( VarLabel<lt, lv1> [ ".." VarLabel<lq, lv2> ]
|
|
|
+ 1484 { "," VarLabel<lt, lv1> [ ".." VarLabel<lq, lv2> ] }
|
|
|
+ 1485 ":"
|
|
|
+ 1486 [ ArmField<rec> { ";" [ ArmField<rec> ] } ]
|
|
|
+ 1487 | "ELSE" ) ] .
|
|
|
+ 1488 ArmField<rec: SymTab.TypeIndex>
|
|
|
+ 1489 = RecField<rec>
|
|
|
+ 1490 | CaseField<rec> (. SymTab.MarkVariant(rec); .) .
|
|
|
+ 1491 (* Variant case label: a constant (or a constant range). Values are
|
|
|
+ 1492 not interpreted (the layout overlays regardless). *)
|
|
|
+ 1493 VarLabel<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 1494 (. VAR lname: SymTab.Name; .)
|
|
|
+ 1495 = ( ident (. LexName(lname);
|
|
|
+ 1496 QbeGen.CopyOp("0", q);
|
|
|
+ 1497 t := SymTab.IntType(); .)
|
|
|
+ 1498 | integer (. LexString(lname);
|
|
|
+ 1499 QbeGen.CopyOp("0", q);
|
|
|
+ 1500 t := SymTab.IntType(); .)
|
|
|
+ 1501 | charConst (. LexString(lname);
|
|
|
+ 1502 QbeGen.CopyOp("0", q);
|
|
|
+ 1503 t := SymTab.CharType(); .) ) .
|
|
|
+ 1504 RecField<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name;
|
|
|
+ 1505 t2: SymTab.TypeIndex; .)
|
|
|
+ 1506 = RecIdents<rec> ":" Type<t2, FALSE>(. SymTab.FixPendingF(rec, t2); .) .
|
|
|
+ 1507 RecIdents<rec: SymTab.TypeIndex> (. VAR n: SymTab.Name; .)
|
|
|
+ 1508 = GetIdent<n> (. IF NOT SymTab.FieldPending(rec,
|
|
|
+ 1509 n) THEN
|
|
|
+ 1510 SemError(200) END; .)
|
|
|
+ 1511 { "," GetIdent<n> (. IF NOT SymTab.FieldPending(rec,
|
|
|
+ 1512 n) THEN
|
|
|
+ 1513 SemError(200) END; .) } .
|
|
|
+ 1514 TypeIdent<VAR t: SymTab.TypeIndex> (. VAR n, qid: SymTab.Name;
|
|
|
+ 1515 k: INTEGER;
|
|
|
+ 1516 dotted: BOOLEAN; .)
|
|
|
+ 1517 = GetIdent<n> (. dotted := FALSE;
|
|
|
+ 1518 IF NOT SymTab.Lookup(n) THEN
|
|
|
+ 1519 (* declaration before use: an
|
|
|
+ 1520 undeclared type is 201,
|
|
|
+ 1521 except as a POINTER's base
|
|
|
+ 1522 (allowFwdType) *)
|
|
|
+ 1523 k := -1;
|
|
|
+ 1524 IF allowFwdType THEN
|
|
|
+ 1525 t := SymTab.ForwardType(n)
|
|
|
+ 1526 ELSE t := SymTab.InvalidType
|
|
|
+ 1527 END;
|
|
|
+ 1528 IF t = SymTab.InvalidType THEN
|
|
|
+ 1529 SemError(201)
|
|
|
+ 1530 END
|
|
|
+ 1531 ELSE k := SymTab.SymKind(n);
|
|
|
+ 1532 IF (k = SymTab.KindType)
|
|
|
+ 1533 OR (k = SymTab.KindPredef) THEN
|
|
|
+ 1534 t := SymTab.SymType(n)
|
|
|
+ 1535 ELSE t := SymTab.InvalidType
|
|
|
+ 1536 END
|
|
|
+ 1537 END; .)
|
|
|
+ 1538 [ "." GetIdent<qid> (. dotted := TRUE;
|
|
|
+ 1539 IF k = SymTab.KindModule THEN
|
|
|
+ 1540 t := SymTab.QualType(n, qid);
|
|
|
+ 1541 IF t = SymTab.InvalidType THEN
|
|
|
+ 1542 SemError(201)
|
|
|
+ 1543 END
|
|
|
+ 1544 ELSE SemError(221);
|
|
|
+ 1545 t := SymTab.InvalidType
|
|
|
+ 1546 END; .) ]
|
|
|
+ 1547 (. IF NOT dotted THEN
|
|
|
+ 1548 IF (k = SymTab.KindModule)
|
|
|
+ 1549 OR ((k # SymTab.KindType)
|
|
|
+ 1550 AND (k # SymTab.KindPredef)
|
|
|
+ 1551 AND (k # SymTab.KindImport)
|
|
|
+ 1552 AND (k # -1)) THEN
|
|
|
+ 1553 SemError(221)
|
|
|
+ 1554 END
|
|
|
+ 1555 END; .) .
|
|
|
+ 1556 Subrange<VAR t: SymTab.TypeIndex> (. VAR tlo, thi: SymTab.TypeIndex;
|
|
|
+ 1557 qlo, qhi: QbeGen.QVal;
|
|
|
+ 1558 lo, hi: INTEGER; .)
|
|
|
+ 1559 = "[" Expr<tlo, qlo> ".." Expr<thi, qhi>
|
|
|
+ 1560 (. IF (tlo = SymTab.InvalidType)
|
|
|
+ 1561 OR (thi = SymTab.InvalidType) THEN
|
|
|
+ 1562 t := SymTab.InvalidType
|
|
|
+ 1563 ELSIF NOT SymTab.IsOrdinal(tlo)
|
|
|
+ 1564 OR NOT SymTab.IsOrdinal(thi) THEN
|
|
|
+ 1565 SemError(230);
|
|
|
+ 1566 t := SymTab.InvalidType
|
|
|
+ 1567 ELSIF NOT SymTab.ConstInt(qlo, lo)
|
|
|
+ 1568 OR NOT SymTab.ConstInt(qhi, hi)
|
|
|
+ 1569 OR (lo > hi) THEN
|
|
|
+ 1570 SemError(230);
|
|
|
+ 1571 t := SymTab.InvalidType
|
|
|
+ 1572 ELSE IF SymTab.SameType(tlo, thi) THEN
|
|
|
+ 1573 (* keep the base type: ['A'..'Z']
|
|
|
+ 1574 is character, [red..blue]
|
|
|
+ 1575 that enumeration *)
|
|
|
+ 1576 t := SymTab.NewSubB(lo, hi, tlo)
|
|
|
+ 1577 ELSE t := SymTab.NewSubR(lo, hi)
|
|
|
+ 1578 END
|
|
|
+ 1579 END; .)
|
|
|
+ 1580 "]" .
|
|
|
+ 1581 Enum<VAR t: SymTab.TypeIndex> (. VAR n: SymTab.Name;
|
|
|
+ 1582 ord: INTEGER;
|
|
|
+ 1583 qv: QbeGen.QVal; .)
|
|
|
+ 1584 = "(" (. t := SymTab.NewEnum();
|
|
|
+ 1585 ord := 0; .)
|
|
|
+ 1586 GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
+ 1587 SymTab.KindConst) THEN
|
|
|
+ 1588 SemError(200) END;
|
|
|
+ 1589 SymTab.SetSymType(n, t);
|
|
|
+ 1590 QbeGen.IntStr(ord, qv);
|
|
|
+ 1591 SymTab.SetSymVal(n, qv);
|
|
|
+ 1592 SymTab.NoteEnumLit(t, n);
|
|
|
+ 1593 Lower.NoteVar(n,
|
|
|
+ 1594 SymTab.KindConst, t);
|
|
|
+ 1595 Lower.NoteConstVal(qv);
|
|
|
+ 1596 INC(ord); .)
|
|
|
+ 1597 { "," GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
+ 1598 SymTab.KindConst) THEN
|
|
|
+ 1599 SemError(200) END;
|
|
|
+ 1600 SymTab.SetSymType(n, t);
|
|
|
+ 1601 QbeGen.IntStr(ord, qv);
|
|
|
+ 1602 SymTab.SetSymVal(n, qv);
|
|
|
+ 1603 SymTab.NoteEnumLit(t, n);
|
|
|
+ 1604 Lower.NoteVar(n,
|
|
|
+ 1605 SymTab.KindConst, t);
|
|
|
+ 1606 Lower.NoteConstVal(qv);
|
|
|
+ 1607 INC(ord); .) }
|
|
|
+ 1608 ")" (. SymTab.SetEnumCount(t,
|
|
|
+ 1609 VAL(CARDINAL, ord)); .) .
|
|
|
+ 1610 (* Clarion-form classes (docs/OOP.txt): declaration + single
|
|
|
+ 1611 inheritance + IMPLEMENTATION blocks. Scopes and member checks
|
|
|
+ 1612 now; lowering (vtable, dispatch, THIS) later — one 230 per
|
|
|
+ 1613 class/impl block. Methods end with ";" per the Table example
|
|
|
+ 1614 (not "," as in the sketch). No underscores in identifiers. *)
|
|
|
+ 1615 (* Single CLASS item in both loops: separating declaration from
|
|
|
+ 1616 IMPLEMENTATION at the loop level needs 2-token lookahead
|
|
|
+ 1617 (CLASS ident vs CLASS IMPLEMENTATION), which LL(1) cannot do.
|
|
|
+ 1618 The second token decides after CLASS is consumed. A misplaced
|
|
|
+ 1619 CLASS IMPLEMENTATION inside TYPE still parses (harmless: the
|
|
|
+ 1620 whole unit ends 230 until lowering). *)
|
|
|
+ 1621 ClassItem
|
|
|
+ 1622 = "CLASS" ( "IMPLEMENTATION" ClassImplRest | ClassRest ) .
|
|
|
+ 1623 ClassRest (. VAR cn, m2, pn: SymTab.Name;
|
|
|
+ 1624 ct: SymTab.TypeIndex; .)
|
|
|
+ 1625 = GetIdent<cn> (. IF NOT SymTab.Enter(cn,
|
|
|
+ 1626 SymTab.KindType) THEN
|
|
|
+ 1627 SemError(200) END;
|
|
|
+ 1628 ct := SymTab.NewClass();
|
|
|
+ 1629 SymTab.SetSymType(cn, ct);
|
|
|
+ 1630 SymTab.PushClassScope(ct);
|
|
|
+ 1631 astCls := AST.MakeNode(AST.NkClassDecl);
|
|
|
+ 1632 AST.SetChild(astCls, 0,
|
|
|
+ 1633 AST.MakeLeaf(AST.NkIdent, cn));
|
|
|
+ 1634 astClsP := AST.NoNode;
|
|
|
+ 1635 astClsPTail := AST.NoNode;
|
|
|
+ 1636 astClsF := AST.NoNode;
|
|
|
+ 1637 astClsFTail := AST.NoNode;
|
|
|
+ 1638 astClsM := AST.NoNode;
|
|
|
+ 1639 astClsMTail := AST.NoNode; .)
|
|
|
+ 1640 [ Parents<ct> ]
|
|
|
+ 1641 ";"
|
|
|
+ 1642 { ClassField<ct> ";" }
|
|
|
+ 1643 { MethodHeading<pn, SymTab.InvalidType> ";"
|
|
|
+ 1644 (. Lower.ScopeLeave;
|
|
|
+ 1645 SymTab.CloseProc;
|
|
|
+ 1646 QbeGen.AbortFunc; .) }
|
|
|
+ 1647 "END"
|
|
|
+ 1648 GetIdent<m2> (. IF NOT SymTab.Equal(cn, m2) THEN
|
|
|
+ 1649 SemError(202) END;
|
|
|
+ 1650 SymTab.LayoutClass(ct);
|
|
|
+ 1651 SymTab.PopScope;
|
|
|
+ 1652 AST.SetChild(astCls, 1, astClsP);
|
|
|
+ 1653 AST.SetChild(astCls, 2, astClsF);
|
|
|
+ 1654 AST.SetChild(astCls, 3, astClsM);
|
|
|
+ 1655 astDecl := astCls; .) .
|
|
|
+ 1656 Parents<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name; .)
|
|
|
+ 1657 = "(" Parent1<ct>
|
|
|
+ 1658 { "," GetIdent<p> (. SemError(230); .) }
|
|
|
+ 1659 ")" .
|
|
|
+ 1660 Parent1<ct: SymTab.TypeIndex> (. VAR p: SymTab.Name;
|
|
|
+ 1661 pt: SymTab.TypeIndex; .)
|
|
|
+ 1662 = GetIdent<p> (. IF NOT SymTab.Lookup(p) THEN
|
|
|
+ 1663 SemError(201)
|
|
|
+ 1664 ELSE pt := SymTab.SymType(p);
|
|
|
+ 1665 IF SymTab.ClassOf(pt) #
|
|
|
+ 1666 SymTab.ClClass THEN
|
|
|
+ 1667 SemError(230)
|
|
|
+ 1668 ELSE SymTab.SetParent(ct, pt)
|
|
|
+ 1669 END
|
|
|
+ 1670 END;
|
|
|
+ 1671 AstAppend(AST.NkFieldDecl,
|
|
|
+ 1672 astClsP, astClsPTail,
|
|
|
+ 1673 AST.MakeLeaf(AST.NkIdent, p)); .) .
|
|
|
+ 1674 ClassField<ct: SymTab.TypeIndex> (. VAR n, rhs: SymTab.Name;
|
|
|
+ 1675 t: SymTab.TypeIndex;
|
|
|
+ 1676 astNode: AST.Node; .)
|
|
|
+ 1677 = GetIdent<n>
|
|
|
+ 1678 ( "=" GetIdent<rhs> (. IF NOT SymTab.Enter(n,
|
|
|
+ 1679 SymTab.KindConst) THEN
|
|
|
+ 1680 SemError(200) END;
|
|
|
+ 1681 astNode := AST.MakeNode(AST.NkConstDecl);
|
|
|
+ 1682 AST.SetChild(astNode, 0,
|
|
|
+ 1683 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
+ 1684 AST.SetChild(astNode, 1,
|
|
|
+ 1685 AST.MakeLeaf(AST.NkIdent, rhs));
|
|
|
+ 1686 AstAppend(AST.NkFieldDecl,
|
|
|
+ 1687 astClsF, astClsFTail, astNode);
|
|
|
+ 1688 IF SymTab.Lookup(rhs) THEN
|
|
|
+ 1689 SymTab.SetSymType(n,
|
|
|
+ 1690 SymTab.SymType(rhs))
|
|
|
+ 1691 END; .)
|
|
|
+ 1692 | (. IF NOT SymTab.FieldPending(ct,
|
|
|
+ 1693 n) THEN
|
|
|
+ 1694 SemError(200) END;
|
|
|
+ 1695 astNode := AST.MakeNode(AST.NkVarDecl);
|
|
|
+ 1696 AST.SetChild(astNode, 0,
|
|
|
+ 1697 AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
+ 1698 { "," GetIdent<n> (. IF NOT SymTab.FieldPending(ct,
|
|
|
+ 1699 n) THEN
|
|
|
+ 1700 SemError(200) END;
|
|
|
+ 1701 AST.SetChild(astNode,
|
|
|
+ 1702 AST.NChild(astNode),
|
|
|
+ 1703 AST.MakeLeaf(AST.NkIdent, n)); .) }
|
|
|
+ 1704 ":" Type<t, FALSE> (. SymTab.FixPendingF(ct, t);
|
|
|
+ 1705 AST.SetTy(astNode, t);
|
|
|
+ 1706 AstAppend(AST.NkFieldDecl,
|
|
|
+ 1707 astClsF, astClsFTail, astNode); .) ) .
|
|
|
+ 1708 MethodHeading<VAR pn: SymTab.Name; ct: SymTab.TypeIndex>
|
|
|
+ 1709 (. VAR wantVirt: BOOLEAN; .)
|
|
|
+ 1710 = (. wantVirt := FALSE; .)
|
|
|
+ 1711 [ "VIRTUAL" (. wantVirt := TRUE; .) ]
|
|
|
+ 1712 ProcHeading<pn, ct> (. IF wantVirt THEN
|
|
|
+ 1713 SymTab.MarkVirtual END;
|
|
|
+ 1714 astMethod := AST.MakeNode(AST.NkProcDecl);
|
|
|
+ 1715 AST.SetChild(astMethod, 0,
|
|
|
+ 1716 AST.MakeLeaf(AST.NkIdent, pn));
|
|
|
+ 1717 IF wantVirt THEN
|
|
|
+ 1718 AST.SetOp(astMethod, 3)
|
|
|
+ 1719 ELSE AST.SetOp(astMethod, 0)
|
|
|
+ 1720 END;
|
|
|
+ 1721 AstAppend(AST.NkFieldDecl,
|
|
|
+ 1722 astClsM, astClsMTail, astMethod); .) .
|
|
|
+ 1723 ClassImplRest (. VAR cn, m2: SymTab.Name;
|
|
|
+ 1724 ct: SymTab.TypeIndex; .)
|
|
|
+ 1725 = GetIdent<cn> (. IF NOT SymTab.Lookup(cn) THEN
|
|
|
+ 1726 SemError(201);
|
|
|
+ 1727 ct := SymTab.InvalidType
|
|
|
+ 1728 ELSE ct := SymTab.SymType(cn);
|
|
|
+ 1729 IF SymTab.ClassOf(ct) #
|
|
|
+ 1730 SymTab.ClClass THEN
|
|
|
+ 1731 SemError(230);
|
|
|
+ 1732 ct := SymTab.InvalidType
|
|
|
+ 1733 END
|
|
|
+ 1734 END;
|
|
|
+ 1735 astCls := AST.MakeNode(AST.NkClassDecl);
|
|
|
+ 1736 AST.SetOp(astCls, 1);
|
|
|
+ 1737 AST.SetChild(astCls, 0,
|
|
|
+ 1738 AST.MakeLeaf(AST.NkIdent, cn));
|
|
|
+ 1739 astClsM := AST.NoNode;
|
|
|
+ 1740 astClsMTail := AST.NoNode;
|
|
|
+ 1741 astStmt := AST.NoNode;
|
|
|
+ 1742 IF ct #
|
|
|
+ 1743 SymTab.InvalidType THEN
|
|
|
+ 1744 IF NOT SymTab.PushClassMembers(
|
|
|
+ 1745 ct) THEN
|
|
|
+ 1746 SemError(230) END;
|
|
|
+ 1747 SymTab.PushImplClass(ct)
|
|
|
+ 1748 END; .)
|
|
|
+ 1749 ";" { MethodImpl<ct> ";" }
|
|
|
+ 1750 (. astStmt := AST.NoNode; .)
|
|
|
+ 1751 [ "BEGIN" (. astStmt := AST.MakeNode(AST.NkBlock);
|
|
|
+ 1752 .)
|
|
|
+ 1753 [ StatSeq ] ]
|
|
|
+ 1754 "END"
|
|
|
+ 1755 GetIdent<m2> (. IF NOT SymTab.Equal(cn, m2) THEN
|
|
|
+ 1756 SemError(202) END;
|
|
|
+ 1757 SymTab.PopImplClass;
|
|
|
+ 1758 SymTab.PopScope;
|
|
|
+ 1759 AST.SetChild(astCls, 1, AST.NoNode);
|
|
|
+ 1760 AST.SetChild(astCls, 2, astStmt);
|
|
|
+ 1761 AST.SetChild(astCls, 3, astClsM);
|
|
|
+ 1762 astDecl := astCls; .) .
|
|
|
+ 1763 MethodImpl<ct: SymTab.TypeIndex> (. VAR pn: SymTab.Name;
|
|
|
+ 1764 thisQ: QbeGen.QVal;
|
|
|
+ 1765 methRes: SymTab.TypeIndex; .)
|
|
|
+ 1766 = MethodHeading<pn, ct> ";"
|
|
|
+ 1767 (. IF (ct #
|
|
|
+ 1768 SymTab.InvalidType)
|
|
|
+ 1769 AND NOT SymTab.MethodExists(ct,
|
|
|
+ 1770 pn) THEN
|
|
|
+ 1771 SemError(201) END; .)
|
|
|
+ 1772 ( "FORWARD" (. AST.SetOp(astMethod, 1);
|
|
|
+ 1773 SymTab.MarkFwd;
|
|
|
+ 1774 QbeGen.AbortFunc;
|
|
|
+ 1775 Lower.ScopeLeave;
|
|
|
+ 1776 SymTab.CloseProc; .)
|
|
|
+ 1777 | (.
|
|
|
+ 1778 (* bind the receiver: bare
|
|
|
+ 1779 field names resolve
|
|
|
+ 1780 against THIS *)
|
|
|
+ 1781 QbeGen.CopyOp("@", thisQ);
|
|
|
+ 1782 QbeGen.PushWith(thisQ); .)
|
|
|
+ 1783 Block<pn> (. AST.SetChild(astMethod, 1, astStmt);
|
|
|
+ 1784 AST.SetChild(astMethod, 2, astBlkDecls);
|
|
|
+ 1785 QbeGen.PopWith;
|
|
|
+ 1786 methRes := SymTab.CurRes();
|
|
|
+ 1787 Lower.ScopeLeave;
|
|
|
+ 1788 SymTab.CloseProc;
|
|
|
+ 1789 QbeGen.EndFunc(methRes); .) ) .
|
|
|
+ 1790 ConstBlock (. VAR astSeq, astTail: AST.Node; .)
|
|
|
+ 1791 = "CONST" (. astSeq := AST.NoNode;
|
|
|
+ 1792 astTail := AST.NoNode; .)
|
|
|
+ 1793 { ConstDecl ";" (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 1794 astSeq, astTail, astDecl); .) }
|
|
|
+ 1795 (. astDecl := astSeq; .) .
|
|
|
+ 1796 ConstDecl (. VAR n: SymTab.Name;
|
|
|
+ 1797 t: SymTab.TypeIndex;
|
|
|
+ 1798 qv: QbeGen.QVal;
|
|
|
+ 1799 cls: INTEGER;
|
|
|
+ 1800 mk: ARRAY [0 .. 15] OF CARDINAL;
|
|
|
+ 1801 mw: CARDINAL;
|
|
|
+ 1802 mlo: INTEGER;
|
|
|
+ 1803 astNode: AST.Node; .)
|
|
|
+ 1804 = GetIdent<n> (. IF NOT SymTab.Enter(n,
|
|
|
+ 1805 SymTab.KindConst) THEN
|
|
|
+ 1806 SemError(200) END; .)
|
|
|
+ 1807 "="
|
|
|
+ 1808 Expr<t, qv> (. astNode := AST.MakeNode(AST.NkConstDecl);
|
|
|
+ 1809 AST.SetChild(astNode, 0,
|
|
|
+ 1810 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
+ 1811 AST.SetChild(astNode, 1, astCur);
|
|
|
+ 1812 AST.SetTy(astNode, t);
|
|
|
+ 1813 astDecl := astNode;
|
|
|
+ 1814 Lower.NoteVar(n, SymTab.KindConst, t);
|
|
|
+ 1815 Lower.NoteConstVal(qv);
|
|
|
+ 1816 SymTab.SetSymType(n, t);
|
|
|
+ 1817 cls := SymTab.ClassOf(t);
|
|
|
+ 1818 IF cls = SymTab.ClSet THEN
|
|
|
+ 1819 (* a SET CONST needs static
|
|
|
+ 1820 data: fold its mask now
|
|
|
+ 1821 (the grammar sees the
|
|
|
+ 1822 element values) and let
|
|
|
+ 1823 Lower re-emit it *)
|
|
|
+ 1824 IF Lower.SetConstMaskOf(
|
|
|
+ 1825 AST.Child(astNode, 1),
|
|
|
+ 1826 mk, mw, mlo) THEN
|
|
|
+ 1827 Lower.NoteSetMask(n, mk, mw,
|
|
|
+ 1828 mlo);
|
|
|
+ 1829 SymTab.SetSymVal(n, qv)
|
|
|
+ 1830 ELSE
|
|
|
+ 1831 SemError(230)
|
|
|
+ 1832 END
|
|
|
+ 1833 ELSIF (cls = SymTab.ClArray)
|
|
|
+ 1834 OR (cls = SymTab.ClRecord)
|
|
|
+ 1835 OR (cls = SymTab.ClClass)
|
|
|
+ 1836 OR (cls = SymTab.ClStr)
|
|
|
+ 1837 OR (cls = SymTab.ClUStr) THEN
|
|
|
+ 1838 (* an aggregate/string
|
|
|
+ 1839 constant: qv is its
|
|
|
+ 1840 descriptor address; no
|
|
|
+ 1841 scalar data *)
|
|
|
+ 1842 SymTab.SetSymVal(n, qv)
|
|
|
+ 1843 ELSIF NOT QbeGen.IsImm(qv) THEN
|
|
|
+ 1844 SemError(230)
|
|
|
+ 1845 ELSE
|
|
|
+ 1846 SymTab.SetSymVal(n, qv);
|
|
|
+ 1847 END; .) .
|
|
|
+ 1848 VarBlock (. VAR astSeq, astTail: AST.Node; .)
|
|
|
+ 1849 = "VAR" (. astSeq := AST.NoNode;
|
|
|
+ 1850 astTail := AST.NoNode; .)
|
|
|
+ 1851 { VarDecl ";" (. AstAppend(AST.NkDeclSeq,
|
|
|
+ 1852 astSeq, astTail, astDecl); .) }
|
|
|
+ 1853 (. astDecl := astSeq; .) .
|
|
|
+ 1854 VarDecl (. VAR nm: SymTab.Name;
|
|
|
+ 1855 t: SymTab.TypeIndex;
|
|
|
+ 1856 i: CARDINAL;
|
|
|
+ 1857 cls: INTEGER;
|
|
|
+ 1858 astNode, astTail: AST.Node; .)
|
|
|
+ 1859 = VarIdents ":"
|
|
|
+ 1860 Type<t, FALSE> (. astNode := AST.MakeNode(AST.NkVarDecl);
|
|
|
+ 1861 astTail := astNode;
|
|
|
+ 1862 i := 0;
|
|
|
+ 1863 WHILE i < SymTab.PendCount() DO
|
|
|
+ 1864 SymTab.PendName(i, nm);
|
|
|
+ 1865 Lower.NoteVar(nm, SymTab.KindVar, t);
|
|
|
+ 1866 (* chunked: a VAR list can
|
|
|
+ 1867 exceed AST.MaxChild *)
|
|
|
+ 1868 AstAppend(AST.NkBlock,
|
|
|
+ 1869 astNode, astTail,
|
|
|
+ 1870 AST.MakeLeaf(AST.NkIdent, nm));
|
|
|
+ 1871 INC(i)
|
|
|
+ 1872 END;
|
|
|
+ 1873 AST.SetTy(astNode, t);
|
|
|
+ 1874 astDecl := astNode;
|
|
|
+ 1875 cls := SymTab.ClassOf(t);
|
|
|
+ 1876 IF (t # SymTab.InvalidType)
|
|
|
+ 1877 AND NOT SymTab.IsUnresolved(t)
|
|
|
+ 1878 AND (cls # SymTab.ClInt)
|
|
|
+ 1879 AND (cls # SymTab.ClBool)
|
|
|
+ 1880 AND (cls # SymTab.ClChar)
|
|
|
+ 1881 AND (cls # SymTab.ClReal)
|
|
|
+ 1882 AND (cls # SymTab.ClArray)
|
|
|
+ 1883 AND (cls # SymTab.ClSet)
|
|
|
+ 1884 AND (cls # SymTab.ClRecord)
|
|
|
+ 1885 AND (cls # SymTab.ClPtr)
|
|
|
+ 1886 AND (cls # SymTab.ClLong)
|
|
|
+ 1887 AND (cls # SymTab.ClProc)
|
|
|
+ 1888 AND (cls # SymTab.ClUChar)
|
|
|
+ 1889 AND (cls # SymTab.ClUStr)
|
|
|
+ 1890 AND (cls # SymTab.ClEnum)
|
|
|
+ 1891 AND (cls # SymTab.ClClass) THEN
|
|
|
+ 1892 SemError(230) END;
|
|
|
+ 1893 IF QbeGen.LocFull() THEN
|
|
|
+ 1894 SemError(233) END;
|
|
|
+ 1895 i := 0;
|
|
|
+ 1896 IF SymTab.IsUnresolved(t)
|
|
|
+ 1897 AND NOT SymTab.InProc() THEN
|
|
|
+ 1898 (* a forward-typed global:
|
|
|
+ 1899 defer emission until the
|
|
|
+ 1900 TYPE block completes *)
|
|
|
+ 1901 AST.SetOp(astNode, 1);
|
|
|
+ 1902 WHILE i < SymTab.PendCount() DO
|
|
|
+ 1903 SymTab.PendName(i, nm);
|
|
|
+ 1904 IF nPendVar <=
|
|
|
+ 1905 HIGH(pendVarName) THEN
|
|
|
+ 1906 pendVarName[nPendVar] := nm;
|
|
|
+ 1907 pendVarT[nPendVar] := t;
|
|
|
+ 1908 INC(nPendVar)
|
|
|
+ 1909 END;
|
|
|
+ 1910 INC(i)
|
|
|
+ 1911 END
|
|
|
+ 1912 ELSE
|
|
|
+ 1913 WHILE i < SymTab.PendCount() DO
|
|
|
+ 1914 SymTab.PendName(i, nm);
|
|
|
+ 1915 INC(i)
|
|
|
+ 1916 END
|
|
|
+ 1917 END;
|
|
|
+ 1918 (* a plain VAR list, not a
|
|
|
+ 1919 heading: the signature
|
|
|
+ 1920 result is discarded *)
|
|
|
+ 1921 IF NOT SymTab.FixPending(t) THEN
|
|
|
+ 1922 END; .) .
|
|
|
+ 1923 VarIdents (. VAR n: SymTab.Name; .)
|
|
|
+ 1924 = GetIdent<n> (. IF NOT SymTab.EnterPending(n,
|
|
|
+ 1925 SymTab.KindVar) THEN
|
|
|
+ 1926 SemError(200) END; .)
|
|
|
+ 1927 { ","
|
|
|
+ 1928 GetIdent<n> (. IF NOT SymTab.EnterPending(n,
|
|
|
+ 1929 SymTab.KindVar) THEN
|
|
|
+ 1930 SemError(200) END; .) } .
|
|
|
+ 1931 ParIdents<isV: BOOLEAN> (. VAR n: SymTab.Name; .)
|
|
|
+ 1932 = GetIdent<n> (. IF NOT SymTab.EnterParam(n, isV) THEN
|
|
|
+ 1933 SemError(200) END; .)
|
|
|
+ 1934 { "," GetIdent<n> (. IF NOT SymTab.EnterParam(n, isV) THEN
|
|
|
+ 1935 SemError(200) END; .) } .
|
|
|
+ 1936 (* Procedure headings enter scopes/params/result and buffer the
|
|
|
+ 1937 QBE header; bodies lower to functions (4.1, module level only).
|
|
|
+ 1938 FORWARD marks; the body heading re-enters (signature compare
|
|
|
+ 1939 deferred). Nested procedures parse + check, lowering = 4.2. *)
|
|
|
+ 1940 (* gm2 declaration pragmas: __BUILTIN__ (definition module) and
|
|
|
+ 1941 __ATTRIBUTE__ __BUILTIN__ (( name )) (implementation). They
|
|
|
+ 1942 annotate C built-ins; V3 parses and ignores them. *)
|
|
|
+ 1943 ProcPragma
|
|
|
+ 1944 = "__BUILTIN__"
|
|
|
+ 1945 | "__ATTRIBUTE__" [ "__BUILTIN__" ] [ "(" "(" ident ")" ")" ] .
|
|
|
+ 1946
|
|
|
+ 1947 ProcHeading<VAR pn: SymTab.Name; methCls: SymTab.TypeIndex>
|
|
|
+ 1948 (. VAR t: SymTab.TypeIndex;
|
|
|
+ 1949 mg: QbeGen.QVal; .)
|
|
|
+ 1950 = "PROCEDURE"
|
|
|
+ 1951 [ ProcPragma ]
|
|
|
+ 1952 GetIdent<pn> (. IF methCls #
|
|
|
+ 1953 SymTab.InvalidType THEN
|
|
|
+ 1954 (* a method: resume the
|
|
|
+ 1955 declared symbol (reuse
|
|
|
+ 1956 its uid) *)
|
|
|
+ 1957 IF NOT SymTab.ResumeMethod(
|
|
|
+ 1958 methCls, pn) THEN
|
|
|
+ 1959 SemError(200) END
|
|
|
+ 1960 ELSIF NOT SymTab.EnterProc(pn) THEN
|
|
|
+ 1961 IF NOT SymTab.ReenterProc(pn) THEN
|
|
|
+ 1962 IF NOT SymTab.ResumeProc(pn) THEN
|
|
|
+ 1963 SemError(200) END
|
|
|
+ 1964 END
|
|
|
+ 1965 END;
|
|
|
+ 1966 Lower.ScopeEnter;
|
|
|
+ 1967 Lower.NoteProc(pn,
|
|
|
+ 1968 SymTab.ProcUid(pn),
|
|
|
+ 1969 SymTab.InvalidType,
|
|
|
+ 1970 SymTab.ProcDepthOf(pn),
|
|
|
+ 1971 FALSE);
|
|
|
+ 1972 QbeGen.BeginFunc("");
|
|
|
+ 1973 IF methCls #
|
|
|
+ 1974 SymTab.InvalidType THEN
|
|
|
+ 1975 (* hidden THIS receiver:
|
|
|
+ 1976 a VAR param of the
|
|
|
+ 1977 class type, pushed as
|
|
|
+ 1978 the WITH base *)
|
|
|
+ 1979 IF NOT SymTab.EnterThisParam(
|
|
|
+ 1980 methCls) THEN
|
|
|
+ 1981 SemError(200) END;
|
|
|
+ 1982 IF NOT QbeGen.FuncParam(
|
|
|
+ 1983 "THIS", TRUE,
|
|
|
+ 1984 methCls) THEN
|
|
|
+ 1985 SemError(233) END
|
|
|
+ 1986 END; .)
|
|
|
+ 1987 [ FormalParams ]
|
|
|
+ 1988 [ ":" TypeIdent<t> (. IF NOT SymTab.SetProcRes(t) THEN
|
|
|
+ 1989 SemError(235) END;
|
|
|
+ 1990 Lower.SetProcRes(t); .) ] .
|
|
|
+ 1991 FormalParams
|
|
|
+ 1992 = "(" [ ParamSection { ";" ParamSection } ] ")" .
|
|
|
+ 1993 ParamSection (. VAR t: SymTab.TypeIndex;
|
|
|
+ 1994 nm: SymTab.Name;
|
|
|
+ 1995 i: CARDINAL;
|
|
|
+ 1996 isV: BOOLEAN; .)
|
|
|
+ 1997 = (. isV := FALSE; .)
|
|
|
+ 1998 [ "VAR" (. isV := TRUE; .) ]
|
|
|
+ 1999 ParIdents<isV> ":" Type<t, TRUE> (. i := 0;
|
|
|
+ 2000 WHILE i < SymTab.PendCount() DO
|
|
|
+ 2001 SymTab.PendName(i, nm);
|
|
|
+ 2002 Lower.NoteParam(nm, t, isV);
|
|
|
+ 2003 Lower.NoteVar(nm, SymTab.KindParam, t);
|
|
|
+ 2004 (* value open arrays are
|
|
|
+ 2005 passed as descriptor
|
|
|
+ 2006 addresses (no copy):
|
|
|
+ 2007 same representation as
|
|
|
+ 2008 VAR formals *)
|
|
|
+ 2009 IF NOT QbeGen.FuncParam(nm,
|
|
|
+ 2010 isV
|
|
|
+ 2011 OR SymTab.IsOpenArray(t),
|
|
|
+ 2012 t) THEN
|
|
|
+ 2013 SemError(233) END;
|
|
|
+ 2014 INC(i)
|
|
|
+ 2015 END;
|
|
|
+ 2016 IF NOT SymTab.FixPending(t) THEN
|
|
|
+ 2017 SemError(235) END; .) .
|
|
|
+ 2018 (* Nested procedures lower like top-level ones (4.2): the
|
|
|
+ 2019 static link gives them their parent's frame. Methods keep
|
|
|
+ 2020 parse-now/230-later. *)
|
|
|
+ 2021 ProcDecl (. VAR pn: SymTab.Name;
|
|
|
+ 2022 astNode: AST.Node; .)
|
|
|
+ 2023 = ProcHeading<pn, SymTab.InvalidType> ";"
|
|
|
+ 2024 (. astNode := AST.MakeNode(AST.NkProcDecl);
|
|
|
+ 2025 AST.SetOp(astNode, 0);
|
|
|
+ 2026 AST.SetChild(astNode, 0,
|
|
|
+ 2027 AST.MakeLeaf(AST.NkIdent, pn));
|
|
|
+ 2028 Lower.NoteProcNode(astNode); .)
|
|
|
+ 2029 ( "FORWARD" (. AST.SetOp(astNode, 1);
|
|
|
+ 2030 astDecl := astNode;
|
|
|
+ 2031 Lower.ScopeLeave;
|
|
|
+ 2032 SymTab.MarkFwd;
|
|
|
+ 2033 SymTab.CloseProc;
|
|
|
+ 2034 QbeGen.AbortFunc; .)
|
|
|
+ 2035 | "EXTERNAL" (. AST.SetOp(astNode, 2);
|
|
|
+ 2036 astDecl := astNode;
|
|
|
+ 2037 Lower.MarkProcExternal;
|
|
|
+ 2038 Lower.ScopeLeave;
|
|
|
+ 2039 SymTab.MarkExternal("");
|
|
|
+ 2040 SymTab.CloseProc;
|
|
|
+ 2041 QbeGen.AbortFunc; .)
|
|
|
+ 2042 |
|
|
|
+ 2043 (. allowDefer := TRUE; deferredBody := FALSE;
|
|
|
+ 2044 curProcNode := astNode; .)
|
|
|
+ 2045 Block<pn> (. IF deferredBody THEN
|
|
|
+ 2046 (* body skipped: close like
|
|
|
+ 2047 FORWARD (no body node) *)
|
|
|
+ 2048 astDecl := astNode;
|
|
|
+ 2049 Lower.ScopeLeave;
|
|
|
+ 2050 SymTab.CloseProc;
|
|
|
+ 2051 QbeGen.AbortFunc
|
|
|
+ 2052 ELSE
|
|
|
+ 2053 AST.SetChild(astNode, 1, astStmt);
|
|
|
+ 2054 AST.SetChild(astNode, 2, astBlkDecls);
|
|
|
+ 2055 astDecl := astNode;
|
|
|
+ 2056 Lower.ScopeLeave;
|
|
|
+ 2057 SymTab.CloseProc;
|
|
|
+ 2058 QbeGen.EndFunc(
|
|
|
+ 2059 SymTab.ProcRes(pn))
|
|
|
+ 2060 END; .) ) .
|
|
|
+ 2061 Block<pn: SymTab.Name> (. VAR m2: SymTab.Name; dfr: BOOLEAN; .)
|
|
|
+ 2062 = (. dfr := FALSE;
|
|
|
+ 2063 IF allowDefer AND twoPhaseParse
|
|
|
+ 2064 AND NOT repassing THEN
|
|
|
+ 2065 dfr := DeferSkip(pn)
|
|
|
+ 2066 END;
|
|
|
+ 2067 allowDefer := FALSE;
|
|
|
+ 2068 .)
|
|
|
+ 2069 DeclSeq (. astBlkDecls := astDecl;
|
|
|
+ 2070 astStmt := AST.NoNode;
|
|
|
+ 2071 nLab := 0; nGot := 0; .)
|
|
|
+ 2072 [ "BEGIN" (. (* an empty body is still a
|
|
|
+ 2073 body: mark it so Lower
|
|
|
+ 2074 does not read it as a
|
|
|
+ 2075 definition heading *)
|
|
|
+ 2076 IF NOT dfr THEN
|
|
|
+ 2077 IF astStmt = AST.NoNode THEN
|
|
|
+ 2078 astStmt :=
|
|
|
+ 2079 AST.MakeNode(AST.NkBlock)
|
|
|
+ 2080 END
|
|
|
+ 2081 END; .)
|
|
|
+ 2082 [ StatSeq ] ]
|
|
|
+ 2083 "END"
|
|
|
+ 2084 GetIdent<m2> (. IF NOT SymTab.Equal(pn, m2) THEN
|
|
|
+ 2085 SemError(202) END;
|
|
|
+ 2086 CheckGotos; .) .
|
|
|
+ 2087 (* Two-phase, phase 2 (milestone 2c): re-parse every deferred module-
|
|
|
+ 2088 level body once the unit's declarations are complete. Inlined at
|
|
|
+ 2089 both call sites because a stand-alone epsilon production is
|
|
|
+ 2090 "unreachable" to Coco/R (referenced only from actions). *)
|
|
|
+ 2091 StatSeq (. VAR astSeq, astTail: AST.Node; .)
|
|
|
+ 2092 = (. astSeq := AST.NoNode;
|
|
|
+ 2093 astTail := AST.NoNode; .)
|
|
|
+ 2094 Statement (. AstAppend(AST.NkBlock,
|
|
|
+ 2095 astSeq, astTail, astStmt); .)
|
|
|
+ 2096 { ";" [ Statement (. AstAppend(AST.NkBlock,
|
|
|
+ 2097 astSeq, astTail, astStmt); .) ] }
|
|
|
+ 2098 (. astStmt := astSeq; .) .
|
|
|
+ 2099 (* Trailing/empty statements (`a; ; b`, Coco/R's generated `;;`)
|
|
|
+ 2100 are accepted: the statement after ';' is optional. *)
|
|
|
+ 2101 Statement (. VAR lx: QbeGen.QVal; lxnm: SymTab.Name; .)
|
|
|
+ 2102 = (. astStmt := AST.NoNode; .)
|
|
|
+ 2103 ( AssOrCall
|
|
|
+ 2104 | IfStat
|
|
|
+ 2105 | WhileStat
|
|
|
+ 2106 | RepeatStat
|
|
|
+ 2107 | LoopStat
|
|
|
+ 2108 | ForStat
|
|
|
+ 2109 | CaseStat
|
|
|
+ 2110 | WithStat
|
|
|
+ 2111 | ReturnStat
|
|
|
+ 2112 | HaltStat
|
|
|
+ 2113 | NewStat
|
|
|
+ 2114 | DisposeStat
|
|
|
+ 2115 | IncDecStat
|
|
|
+ 2116 | InclExclStat
|
|
|
+ 2117 | "EXIT" (. IF NOT QbeGen.TopLoop(lx) THEN
|
|
|
+ 2118 SemError(230) END;
|
|
|
+ 2119 astStmt := AST.MakeNode(AST.NkExit); .)
|
|
|
+ 2120 | "GOTO" GetIdent<lxnm> (. NoteGoto(lxnm);
|
|
|
+ 2121 astStmt := AST.MakeNode(AST.NkGoto);
|
|
|
+ 2122 AST.SetChild(astStmt, 0,
|
|
|
+ 2123 AST.MakeLeaf(AST.NkIdent, lxnm)); .) ) .
|
|
|
+ 2124 (* INCL(set, elem) / EXCL(set, elem): PIM set-element builtins. *)
|
|
|
+ 2125 InclExclStat (. VAR at, et2: SymTab.TypeIndex;
|
|
|
+ 2126 dk: INTEGER;
|
|
|
+ 2127 qd, qe: QbeGen.QVal;
|
|
|
+ 2128 qn: SymTab.Name;
|
|
|
+ 2129 sfx, isInc: BOOLEAN;
|
|
|
+ 2130 astNode, astD: AST.Node; .)
|
|
|
+ 2131 = ( "INCL" (. isInc := TRUE; .)
|
|
|
+ 2132 | "EXCL" (. isInc := FALSE; .) )
|
|
|
+ 2133 "(" Design<at, dk, qd, qn, sfx> (. astD := astCur; .) ","
|
|
|
+ 2134 Expr<et2, qe> ")"
|
|
|
+ 2135 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 2136 IF isInc THEN
|
|
|
+ 2137 AST.SetChild(astNode, 0,
|
|
|
+ 2138 AST.MakeLeaf(AST.NkIdent, "INCL"))
|
|
|
+ 2139 ELSE AST.SetChild(astNode, 0,
|
|
|
+ 2140 AST.MakeLeaf(AST.NkIdent, "EXCL"))
|
|
|
+ 2141 END;
|
|
|
+ 2142 IF astD # AST.NoNode THEN
|
|
|
+ 2143 AST.SetChild(astNode, 1, astD) END;
|
|
|
+ 2144 IF astCur # AST.NoNode THEN
|
|
|
+ 2145 AST.SetChild(astNode, 2, astCur) END;
|
|
|
+ 2146 astStmt := astNode; .)
|
|
|
+ 2147 (. IF (at # SymTab.InvalidType)
|
|
|
+ 2148 AND (SymTab.ClassOf(at) # SymTab.ClSet) THEN
|
|
|
+ 2149 SemError(222)
|
|
|
+ 2150 END; .) .
|
|
|
+ 2151 (* INC(v [,step]) / DEC(v [,step]) as builtin statements over an
|
|
|
+ 2152 integer designator. *)
|
|
|
+ 2153 IncDecStat (. VAR dt, et2: SymTab.TypeIndex;
|
|
|
+ 2154 dk: INTEGER;
|
|
|
+ 2155 qd, qv, qn2, qstep:
|
|
|
+ 2156 QbeGen.QVal;
|
|
|
+ 2157 qn: SymTab.Name;
|
|
|
+ 2158 sfx, isInc: BOOLEAN;
|
|
|
+ 2159 astNode, astD, astStep:
|
|
|
+ 2160 AST.Node; .)
|
|
|
+ 2161 = (. isInc := TRUE; .)
|
|
|
+ 2162 ( "INC" (. isInc := TRUE; .)
|
|
|
+ 2163 | "DEC" (. isInc := FALSE; .) )
|
|
|
+ 2164 "(" (. astStep := AST.NoNode; .)
|
|
|
+ 2165 Design<dt, dk, qd, qn, sfx> (. astD := astCur; .)
|
|
|
+ 2166 [ "," Expr<et2, qstep> (. astStep := astCur; .) ]
|
|
|
+ 2167 ")" (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 2168 IF isInc THEN
|
|
|
+ 2169 AST.SetChild(astNode, 0,
|
|
|
+ 2170 AST.MakeLeaf(AST.NkIdent, "INC"))
|
|
|
+ 2171 ELSE AST.SetChild(astNode, 0,
|
|
|
+ 2172 AST.MakeLeaf(AST.NkIdent, "DEC"))
|
|
|
+ 2173 END;
|
|
|
+ 2174 IF astD # AST.NoNode THEN
|
|
|
+ 2175 AST.SetChild(astNode, 1, astD) END;
|
|
|
+ 2176 IF astStep # AST.NoNode THEN
|
|
|
+ 2177 AST.SetChild(astNode, 2, astStep) END;
|
|
|
+ 2178 astStmt := astNode; .) (. IF dt = SymTab.InvalidType THEN
|
|
|
+ 2179 ELSIF (dk # SymTab.KindVar)
|
|
|
+ 2180 AND (dk # SymTab.KindParam)
|
|
|
+ 2181 AND (dk # SymTab.KindField) THEN
|
|
|
+ 2182 SemError(210)
|
|
|
+ 2183 ELSIF NOT SymTab.IsIntFamily(dt) THEN
|
|
|
+ 2184 SemError(211)
|
|
|
+ 2185 END; .) .
|
|
|
+ 2186 (* NEW/DISPOSE as builtin statements (no call syntax until step 4).
|
|
|
+ 2187 Targets are pointer designators; DISPOSE nils afterwards (safer
|
|
|
+ 2188 than Wirth-undefined; documented). DISPOSE is shallow. *)
|
|
|
+ 2189 NewStat (. VAR dt: SymTab.TypeIndex;
|
|
|
+ 2190 dk: INTEGER;
|
|
|
+ 2191 qd, qm: QbeGen.QVal;
|
|
|
+ 2192 qn: SymTab.Name;
|
|
|
+ 2193 sfx: BOOLEAN;
|
|
|
+ 2194 bt: SymTab.TypeIndex;
|
|
|
+ 2195 astNode, astD: AST.Node; .)
|
|
|
+ 2196 = "NEW" "(" Design<dt, dk, qd, qn, sfx> (. astD := astCur; .) ")"
|
|
|
+ 2197 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 2198 AST.SetChild(astNode, 0,
|
|
|
+ 2199 AST.MakeLeaf(AST.NkIdent, "NEW"));
|
|
|
+ 2200 IF astD # AST.NoNode THEN
|
|
|
+ 2201 AST.SetChild(astNode, 1, astD) END;
|
|
|
+ 2202 astStmt := astNode; .)
|
|
|
+ 2203 (. IF dt = SymTab.InvalidType THEN
|
|
|
+ 2204 ELSIF (dk # SymTab.KindVar)
|
|
|
+ 2205 AND (dk # SymTab.KindParam)
|
|
|
+ 2206 AND (dk # SymTab.KindField) THEN
|
|
|
+ 2207 SemError(210)
|
|
|
+ 2208 ELSIF SymTab.ClassOf(dt) #
|
|
|
+ 2209 SymTab.ClPtr THEN
|
|
|
+ 2210 SemError(219)
|
|
|
+ 2211 END; .) .
|
|
|
+ 2212 DisposeStat (. VAR dt: SymTab.TypeIndex;
|
|
|
+ 2213 dk: INTEGER;
|
|
|
+ 2214 qd, qv: QbeGen.QVal;
|
|
|
+ 2215 qn: SymTab.Name;
|
|
|
+ 2216 sfx: BOOLEAN;
|
|
|
+ 2217 astNode, astD: AST.Node; .)
|
|
|
+ 2218 = "DISPOSE" "(" Design<dt, dk, qd, qn, sfx> (. astD := astCur; .) ")"
|
|
|
+ 2219 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 2220 AST.SetChild(astNode, 0,
|
|
|
+ 2221 AST.MakeLeaf(AST.NkIdent, "DISPOSE"));
|
|
|
+ 2222 IF astD # AST.NoNode THEN
|
|
|
+ 2223 AST.SetChild(astNode, 1, astD) END;
|
|
|
+ 2224 astStmt := astNode; .)
|
|
|
+ 2225 (. IF dt = SymTab.InvalidType THEN
|
|
|
+ 2226 ELSIF (dk # SymTab.KindVar)
|
|
|
+ 2227 AND (dk # SymTab.KindParam)
|
|
|
+ 2228 AND (dk # SymTab.KindField) THEN
|
|
|
+ 2229 SemError(210)
|
|
|
+ 2230 ELSIF SymTab.ClassOf(dt) #
|
|
|
+ 2231 SymTab.ClPtr THEN
|
|
|
+ 2232 SemError(219)
|
|
|
+ 2233 END; .) .
|
|
|
+ 2234 (* WITH pushes each record's fields (inner wins) plus its base
|
|
|
+ 2235 address; field designators resolve through both stacks. *)
|
|
|
+ 2236 WithStat (. VAR nW: CARDINAL;
|
|
|
+ 2237 astNode: AST.Node; .)
|
|
|
+ 2238 = "WITH" (. nW := 0;
|
|
|
+ 2239 astNode := AST.MakeNode(AST.NkWith); .)
|
|
|
+ 2240 WithItem<nW, astNode> { "," WithItem<nW, astNode> }
|
|
|
+ 2241 "DO" (. astStmt := AST.NoNode; .)
|
|
|
+ 2242 [ StatSeq ] "END" (. AST.SetChild(astNode,
|
|
|
+ 2243 AST.NChild(astNode), astStmt);
|
|
|
+ 2244 astStmt := astNode;
|
|
|
+ 2245 WHILE nW > 0 DO
|
|
|
+ 2246 SymTab.PopScope;
|
|
|
+ 2247 QbeGen.PopWith;
|
|
|
+ 2248 DEC(nW)
|
|
|
+ 2249 END; .) .
|
|
|
+ 2250 WithItem<VAR nW: CARDINAL; wnode: AST.Node>
|
|
|
+ 2251 (. VAR dt: SymTab.TypeIndex;
|
|
|
+ 2252 dk: INTEGER;
|
|
|
+ 2253 qd, qe: QbeGen.QVal;
|
|
|
+ 2254 qn: SymTab.Name;
|
|
|
+ 2255 sfx: BOOLEAN; .)
|
|
|
+ 2256 = Design<dt, dk, qd, qn, sfx>
|
|
|
+ 2257 (. IF astCur # AST.NoNode THEN
|
|
|
+ 2258 AST.SetChild(wnode,
|
|
|
+ 2259 AST.NChild(wnode), astCur) END;
|
|
|
+ 2260 IF dt = SymTab.InvalidType THEN
|
|
|
+ 2261 ELSIF (SymTab.ClassOf(dt) #
|
|
|
+ 2262 SymTab.ClRecord)
|
|
|
+ 2263 AND (SymTab.ClassOf(dt) #
|
|
|
+ 2264 SymTab.ClClass) THEN
|
|
|
+ 2265 SemError(215)
|
|
|
+ 2266 ELSIF SymTab.PushRecord(dt) THEN
|
|
|
+ 2267 QbeGen.PushWith(qd);
|
|
|
+ 2268 INC(nW)
|
|
|
+ 2269 END; .) .
|
|
|
+ 2270 (* Assignment or procedure-statement call (4.1, module level).
|
|
|
+ 2271 Bare `P;` is a syntax error; function-as-statement is 233. *)
|
|
|
+ 2272 AssOrCall (. VAR dt, et: SymTab.TypeIndex;
|
|
|
+ 2273 dk: INTEGER;
|
|
|
+ 2274 qd, qe, qt, ql: QbeGen.QVal;
|
|
|
+ 2275 qn: SymTab.Name;
|
|
|
+ 2276 ct2, res0: SymTab.TypeIndex;
|
|
|
+ 2277 q2, mg0: QbeGen.QVal;
|
|
|
+ 2278 isR, conv, wconv: BOOLEAN;
|
|
|
+ 2279 called, sfx: BOOLEAN;
|
|
|
+ 2280 astLhs, astRes: AST.Node; mname: SymTab.Name; isM: BOOLEAN;
|
|
|
+ 2281 n: SymTab.Name; astLab, astNode: AST.Node; .)
|
|
|
+ 2282 = GetIdent<n>
|
|
|
+ 2283 ( ":" (. NoteLabel(n);
|
|
|
+ 2284 astNode := AST.MakeNode(AST.NkLabel);
|
|
|
+ 2285 AST.SetChild(astNode, 0,
|
|
|
+ 2286 AST.MakeLeaf(AST.NkIdent, n));
|
|
|
+ 2287 astLab := AST.MakeNode(AST.NkBlock);
|
|
|
+ 2288 AST.SetChild(astLab, 0, astNode); .)
|
|
|
+ 2289 Statement (. IF astStmt # AST.NoNode THEN
|
|
|
+ 2290 AST.SetChild(astLab, 1, astStmt) END;
|
|
|
+ 2291 astStmt := astLab; .)
|
|
|
+ 2292 | DesignTail<n, dt, dk, qd, qn, sfx>
|
|
|
+ 2293 (. astLhs := astCur; astNArgs := 0; .)
|
|
|
+ 2294 ( ":="
|
|
|
+ 2295 Expr<et, qe> (. astStmt := AST.MakeBin(
|
|
|
+ 2296 AST.NkAssign, 0, astLhs, astCur);
|
|
|
+ 2297 IF (dt # SymTab.InvalidType)
|
|
|
+ 2298 AND (dk # SymTab.KindVar)
|
|
|
+ 2299 AND (dk # SymTab.KindParam)
|
|
|
+ 2300 AND (dk # SymTab.KindField) THEN
|
|
|
+ 2301 SemError(210)
|
|
|
+ 2302 ELSIF NOT SymTab.Assignable(et,
|
|
|
+ 2303 dt) THEN
|
|
|
+ 2304 SemError(210)
|
|
|
+ 2305 ELSIF (dt # SymTab.InvalidType)
|
|
|
+ 2306 AND (SymTab.ClassOf(dt) =
|
|
|
+ 2307 SymTab.ClClass) THEN
|
|
|
+ 2308 SemError(230) END;
|
|
|
+ 2309 isR := (dt #
|
|
|
+ 2310 SymTab.InvalidType)
|
|
|
+ 2311 AND (SymTab.ClassOf(dt)
|
|
|
+ 2312 = SymTab.ClReal);
|
|
|
+ 2313 conv := isR
|
|
|
+ 2314 AND SymTab.IsIntFamily(et);
|
|
|
+ 2315 wconv := (dt #
|
|
|
+ 2316 SymTab.InvalidType)
|
|
|
+ 2317 AND SymTab.IsLongFamily(dt)
|
|
|
+ 2318 AND SymTab.IsIntFamily(et);
|
|
|
+ 2319 IF ((dk = SymTab.KindVar)
|
|
|
+ 2320 OR (dk = SymTab.KindParam)
|
|
|
+ 2321 OR (dk = SymTab.KindField))
|
|
|
+ 2322 AND (dt # SymTab.InvalidType)
|
|
|
+ 2323 AND (et # SymTab.InvalidType)
|
|
|
+ 2324 AND (SymTab.ClassOf(dt) #
|
|
|
+ 2325 SymTab.ClClass) THEN
|
|
|
+ 2326 END; .)
|
|
|
+ 2327 | ArgList<qn, dt, qd, TRUE, TRUE, methCls, ct2, q2, called>
|
|
|
+ 2328 (. astRes := AstCallNode(astLhs);
|
|
|
+ 2329 sfx := FALSE; .)
|
|
|
+ 2330 ( { ResultComp<ct2, q2, sfx, astRes, mname, methCls, isM> }
|
|
|
+ 2331 ":=" Expr<et, qe> (. astStmt := AST.MakeBin(
|
|
|
+ 2332 AST.NkAssign, 0, astRes, astCur);
|
|
|
+ 2333 IF NOT sfx THEN
|
|
|
+ 2334 SemError(233)
|
|
|
+ 2335 ELSIF (ct2 # SymTab.InvalidType)
|
|
|
+ 2336 AND NOT SymTab.Assignable(et, ct2) THEN
|
|
|
+ 2337 SemError(210)
|
|
|
+ 2338 END; .)
|
|
|
+ 2339 | (. (* discarding the result of a
|
|
|
+ 2340 foreign C varargs call
|
|
|
+ 2341 (printf/snprintf) is accepted;
|
|
|
+ 2342 an ordinary Modula-2 function
|
|
|
+ 2343 used as a statement stays 233 *)
|
|
|
+ 2344 IF (ct2 # SymTab.InvalidType)
|
|
|
+ 2345 AND NOT SymTab.Varargs(qn) THEN
|
|
|
+ 2346 SemError(233) END;
|
|
|
+ 2347 astStmt := astRes; .) )
|
|
|
+ 2348 | (* bare `P;`: proper parameterless
|
|
|
+ 2349 procedure call; anything else
|
|
|
+ 2350 here is 233 (was a bare syntax
|
|
|
+ 2351 error before 4.2) *)
|
|
|
+ 2352 (. astStmt := AstCallNode(astLhs);
|
|
|
+ 2353 IF (dk = SymTab.KindProc)
|
|
|
+ 2354 AND NOT sfx THEN
|
|
|
+ 2355 res0 := SymTab.ProcRes(qn);
|
|
|
+ 2356 IF res0 #
|
|
|
+ 2357 SymTab.InvalidType THEN
|
|
|
+ 2358 SemError(233)
|
|
|
+ 2359 ELSIF SymTab.ProcNPar(qn) #
|
|
|
+ 2360 0 THEN
|
|
|
+ 2361 SemError(233)
|
|
|
+ 2362 END
|
|
|
+ 2363 ELSIF (dt # SymTab.InvalidType)
|
|
|
+ 2364 AND (SymTab.ClassOf(dt) = SymTab.ClProc) THEN
|
|
|
+ 2365 IF SymTab.ProcTypeRes(dt) #
|
|
|
+ 2366 SymTab.InvalidType THEN
|
|
|
+ 2367 SemError(233)
|
|
|
+ 2368 ELSIF SymTab.ProcTypeNPar(dt) #
|
|
|
+ 2369 0 THEN
|
|
|
+ 2370 SemError(233)
|
|
|
+ 2371 END
|
|
|
+ 2372 ELSE SemError(233)
|
|
|
+ 2373 END; .) ) ) .
|
|
|
+ 2374 (* Actual-parameter list shared by statement and expression calls.
|
|
|
+ 2375 want selects CallEnd's result handling; t/q carry the call
|
|
|
+ 2376 value (statement calls discard). Arity/type failures are 233;
|
|
|
+ 2377 evaluation code still emits so the .ssa stays assembleable. *)
|
|
|
+ 2378 ArgList<pn: SymTab.Name; pt: SymTab.TypeIndex; callee: QbeGen.QVal;
|
|
|
+ 2379 want: BOOLEAN; soft: BOOLEAN; methCls: SymTab.TypeIndex;
|
|
|
+ 2380 VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
|
|
|
+ 2381 VAR called: BOOLEAN> (. VAR i, np: CARDINAL;
|
|
|
+ 2382 vs: INTEGER;
|
|
|
+ 2383 res: SymTab.TypeIndex;
|
|
|
+ 2384 mg: QbeGen.QVal;
|
|
|
+ 2385 ok, ind, isMeth, va, isConv: BOOLEAN; .)
|
|
|
+ 2386 = "(" (. called := TRUE;
|
|
|
+ 2387 ok := TRUE;
|
|
|
+ 2388 ind := FALSE;
|
|
|
+ 2389 isConv := FALSE;
|
|
|
+ 2390 isMeth := methCls #
|
|
|
+ 2391 SymTab.InvalidType;
|
|
|
+ 2392 IF isMeth THEN
|
|
|
+ 2393 res := SymTab.ClassMethodRes(methCls, pn)
|
|
|
+ 2394 ELSIF SymTab.SymKind(pn) = SymTab.KindProc THEN
|
|
|
+ 2395 res := SymTab.ProcRes(pn)
|
|
|
+ 2396 ELSIF (SymTab.SymKind(pn) = SymTab.KindType)
|
|
|
+ 2397 OR (SymTab.SymKind(pn) = SymTab.KindPredef) THEN
|
|
|
+ 2398 (* ISO type conversion T(x):
|
|
|
+ 2399 one value, result is T *)
|
|
|
+ 2400 isConv := TRUE;
|
|
|
+ 2401 res := SymTab.SymType(pn)
|
|
|
+ 2402 ELSIF (pt # SymTab.InvalidType)
|
|
|
+ 2403 AND (SymTab.ClassOf(pt) = SymTab.ClProc) THEN
|
|
|
+ 2404 ind := TRUE;
|
|
|
+ 2405 res := SymTab.ProcTypeRes(pt)
|
|
|
+ 2406 ELSE SemError(233);
|
|
|
+ 2407 ok := FALSE;
|
|
|
+ 2408 res := SymTab.InvalidType
|
|
|
+ 2409 END;
|
|
|
+ 2410 i := 0; .)
|
|
|
+ 2411 [ ActParam<pn, pt, ind, methCls, i> (. INC(i); .)
|
|
|
+ 2412 { "," ActParam<pn, pt, ind, methCls, i> (. INC(i); .) } ]
|
|
|
+ 2413 ")" (. IF ok THEN
|
|
|
+ 2414 IF isConv THEN
|
|
|
+ 2415 (* a conversion takes
|
|
|
+ 2416 exactly one value *)
|
|
|
+ 2417 IF i # 1 THEN
|
|
|
+ 2418 SemError(233); ok := FALSE
|
|
|
+ 2419 END
|
|
|
+ 2420 ELSE
|
|
|
+ 2421 IF isMeth THEN
|
|
|
+ 2422 np := SymTab.ClassMethodNPar(
|
|
|
+ 2423 methCls, pn)
|
|
|
+ 2424 ELSIF ind THEN
|
|
|
+ 2425 np := SymTab.ProcTypeNPar(pt)
|
|
|
+ 2426 ELSE np := SymTab.ProcNPar(pn)
|
|
|
+ 2427 END;
|
|
|
+ 2428 va := (NOT isMeth) AND (NOT ind)
|
|
|
+ 2429 AND (SymTab.SymKind(pn) =
|
|
|
+ 2430 SymTab.KindProc)
|
|
|
+ 2431 AND SymTab.Varargs(pn);
|
|
|
+ 2432 IF (i # np) AND NOT va THEN
|
|
|
+ 2433 SemError(233); ok := FALSE
|
|
|
+ 2434 END
|
|
|
+ 2435 END
|
|
|
+ 2436 END;
|
|
|
+ 2437 IF NOT ok THEN
|
|
|
+ 2438 t := SymTab.InvalidType;
|
|
|
+ 2439 QbeGen.CopyOp("0", q)
|
|
|
+ 2440 ELSIF want THEN
|
|
|
+ 2441 IF res =
|
|
|
+ 2442 SymTab.InvalidType THEN
|
|
|
+ 2443 IF NOT soft THEN SemError(233) END;
|
|
|
+ 2444 t := SymTab.InvalidType;
|
|
|
+ 2445 QbeGen.CopyOp("0", q)
|
|
|
+ 2446 ELSE t := res;
|
|
|
+ 2447 QbeGen.CopyOp("@", q)
|
|
|
+ 2448 END
|
|
|
+ 2449 ELSE
|
|
|
+ 2450 (* a function call used as
|
|
|
+ 2451 a statement: allowed for
|
|
|
+ 2452 a foreign C varargs proc
|
|
|
+ 2453 (printf/snprintf), whose
|
|
|
+ 2454 result is conventionally
|
|
|
+ 2455 discarded; ordinary
|
|
|
+ 2456 Modula-2 functions keep
|
|
|
+ 2457 the 233 diagnostic *)
|
|
|
+ 2458 IF (res # SymTab.InvalidType)
|
|
|
+ 2459 AND NOT va THEN
|
|
|
+ 2460 SemError(233)
|
|
|
+ 2461 END;
|
|
|
+ 2462 t := SymTab.InvalidType;
|
|
|
+ 2463 QbeGen.CopyOp("0", q);
|
|
|
+ 2464 END; .) .
|
|
|
+ 2465 (* One actual: VAR formals take recorded designator addresses
|
|
|
+ 2466 (233 otherwise); value formals take converted expressions. *)
|
|
|
+ 2467 ActParam<pn: SymTab.Name; pt: SymTab.TypeIndex; ind: BOOLEAN;
|
|
|
+ 2468 methCls: SymTab.TypeIndex; i: CARDINAL>
|
|
|
+ 2469 (. VAR at, ft: SymTab.TypeIndex;
|
|
|
+ 2470 qe, qa, qt: QbeGen.QVal;
|
|
|
+ 2471 isV, conv, va: BOOLEAN;
|
|
|
+ 2472 cl: CHAR;
|
|
|
+ 2473 savedN, aj: CARDINAL;
|
|
|
+ 2474 savedArgs: ARRAY [0 .. 31]
|
|
|
+ 2475 OF AST.Node;
|
|
|
+ 2476 astActual: AST.Node; .)
|
|
|
+ 2477 = (. (* Parsing the actual can clobber
|
|
|
+ 2478 the enclosing call's argument
|
|
|
+ 2479 list (Factor resets astNArgs),
|
|
|
+ 2480 so save/restore it. *)
|
|
|
+ 2481 savedN := astNArgs; aj := 0;
|
|
|
+ 2482 WHILE aj <= HIGH(astArgs) DO
|
|
|
+ 2483 savedArgs[aj] := astArgs[aj];
|
|
|
+ 2484 INC(aj)
|
|
|
+ 2485 END; .)
|
|
|
+ 2486 Expr<at, qe> (. QbeGen.CopyOp(qe, convQ); convT := at;
|
|
|
+ 2487 astActual := astCur;
|
|
|
+ 2488 astNArgs := savedN; aj := 0;
|
|
|
+ 2489 WHILE aj <= HIGH(astArgs) DO
|
|
|
+ 2490 astArgs[aj] := savedArgs[aj];
|
|
|
+ 2491 INC(aj)
|
|
|
+ 2492 END;
|
|
|
+ 2493 IF astNArgs <= HIGH(astArgs) THEN
|
|
|
+ 2494 astArgs[astNArgs] := astCur;
|
|
|
+ 2495 INC(astNArgs)
|
|
|
+ 2496 ELSE SemError(230)
|
|
|
+ 2497 (* > 32 actuals: impl limit *)
|
|
|
+ 2498 END;
|
|
|
+ 2499 va := (NOT ind)
|
|
|
+ 2500 AND (methCls =
|
|
|
+ 2501 SymTab.InvalidType)
|
|
|
+ 2502 AND (SymTab.SymKind(pn) =
|
|
|
+ 2503 SymTab.KindProc)
|
|
|
+ 2504 AND SymTab.Varargs(pn);
|
|
|
+ 2505 IF ind THEN
|
|
|
+ 2506 ft :=
|
|
|
+ 2507 SymTab.ProcTypeParamType(pt,
|
|
|
+ 2508 i);
|
|
|
+ 2509 isV :=
|
|
|
+ 2510 SymTab.ProcTypeParamIsVar(pt,
|
|
|
+ 2511 i)
|
|
|
+ 2512 ELSIF methCls #
|
|
|
+ 2513 SymTab.InvalidType THEN
|
|
|
+ 2514 ft :=
|
|
|
+ 2515 SymTab.ClassMethodParamType(
|
|
|
+ 2516 methCls, pn, i);
|
|
|
+ 2517 isV :=
|
|
|
+ 2518 SymTab.ClassMethodParamIsVar(
|
|
|
+ 2519 methCls, pn, i)
|
|
|
+ 2520 ELSE
|
|
|
+ 2521 ft := SymTab.ParamType(pn, i);
|
|
|
+ 2522 isV := SymTab.ParamIsVar(pn, i)
|
|
|
+ 2523 END;
|
|
|
+ 2524 IF (at = SymTab.InvalidType) THEN
|
|
|
+ 2525 ELSIF ft = SymTab.InvalidType THEN
|
|
|
+ 2526 ELSIF isV THEN
|
|
|
+ 2527 IF (SymTab.ClassOf(at) = SymTab.ClChar)
|
|
|
+ 2528 AND (SymTab.ClassOf(ft) = SymTab.ClArray)
|
|
|
+ 2529 AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
|
|
|
+ 2530 AND QbeGen.IsImm(qe) THEN
|
|
|
+ 2531 ELSIF (AST.Kind(astActual) #
|
|
|
+ 2532 AST.NkDesignator)
|
|
|
+ 2533 AND (AST.Kind(astActual) # AST.NkStrLit) THEN
|
|
|
+ 2534 SemError(233)
|
|
|
+ 2535 ELSIF NOT SymTab.VarParamOk(at, ft)
|
|
|
+ 2536 AND NOT SymTab.ByteBufOk(at, ft) THEN
|
|
|
+ 2537 SemError(233)
|
|
|
+ 2538 END
|
|
|
+ 2539 ELSE
|
|
|
+ 2540 IF (SymTab.ClassOf(at) = SymTab.ClChar)
|
|
|
+ 2541 AND (SymTab.ClassOf(ft) = SymTab.ClArray)
|
|
|
+ 2542 AND (SymTab.ClassOf(SymTab.ArrayElem(ft)) = SymTab.ClChar)
|
|
|
+ 2543 AND QbeGen.IsImm(qe) THEN
|
|
|
+ 2544 ELSIF NOT SymTab.Assignable(at, ft)
|
|
|
+ 2545 AND NOT SymTab.ByteBufOk(at, ft) THEN
|
|
|
+ 2546 SemError(233)
|
|
|
+ 2547 END
|
|
|
+ 2548 END; .) .
|
|
|
+ 2549 IfStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ 2550 q: QbeGen.QVal;
|
|
|
+ 2551 hasElse: BOOLEAN;
|
|
|
+ 2552 astCond, astIf, astLast,
|
|
|
+ 2553 astNode: AST.Node; .)
|
|
|
+ 2554 = "IF" (. hasElse := FALSE; .)
|
|
|
+ 2555 Expr<t, q> (. astCond := astCur; astStmt := AST.NoNode;
|
|
|
+ 2556 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
+ 2557 SemError(214) END; .)
|
|
|
+ 2558 "THEN" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkIf);
|
|
|
+ 2559 AST.SetChild(astNode, 0, astCond);
|
|
|
+ 2560 AST.SetChild(astNode, 1, astStmt);
|
|
|
+ 2561 astIf := astNode;
|
|
|
+ 2562 astLast := astNode; .)
|
|
|
+ 2563 { "ELSIF"
|
|
|
+ 2564 Expr<t, q> (. astCond := astCur; astStmt := AST.NoNode;
|
|
|
+ 2565 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
+ 2566 SemError(214) END; .)
|
|
|
+ 2567 "THEN" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkIf);
|
|
|
+ 2568 AST.SetChild(astNode, 0, astCond);
|
|
|
+ 2569 AST.SetChild(astNode, 1, astStmt);
|
|
|
+ 2570 AST.SetChild(astLast, 2, astNode);
|
|
|
+ 2571 astLast := astNode; .) }
|
|
|
+ 2572 [ "ELSE" (. hasElse := TRUE;
|
|
|
+ 2573 astStmt := AST.NoNode; .)
|
|
|
+ 2574 [ StatSeq ] (. AST.SetChild(astLast, 2, astStmt); .) ]
|
|
|
+ 2575 "END" (. astStmt := astIf; .) .
|
|
|
+ 2576 WhileStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ 2577 q: QbeGen.QVal;
|
|
|
+ 2578 astCond, astNode: AST.Node; .)
|
|
|
+ 2579 = "WHILE" (. astStmt := AST.NoNode; .)
|
|
|
+ 2580 Expr<t, q> (. astCond := astCur;
|
|
|
+ 2581 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
+ 2582 SemError(214) END; .)
|
|
|
+ 2583 "DO" [ StatSeq ] (. astNode := AST.MakeNode(AST.NkWhile);
|
|
|
+ 2584 AST.SetChild(astNode, 0, astCond);
|
|
|
+ 2585 AST.SetChild(astNode, 1, astStmt);
|
|
|
+ 2586 astStmt := astNode; .)
|
|
|
+ 2587 "END" .
|
|
|
+ 2588 RepeatStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ 2589 q: QbeGen.QVal;
|
|
|
+ 2590 astCond, astBody, astNode:
|
|
|
+ 2591 AST.Node; .)
|
|
|
+ 2592 = "REPEAT" (. astStmt := AST.NoNode; .)
|
|
|
+ 2593 [ StatSeq ] (. astBody := astStmt; .)
|
|
|
+ 2594 "UNTIL" Expr<t, q> (. astCond := astCur;
|
|
|
+ 2595 astNode := AST.MakeNode(AST.NkRepeat);
|
|
|
+ 2596 AST.SetChild(astNode, 0, astBody);
|
|
|
+ 2597 AST.SetChild(astNode, 1, astCond);
|
|
|
+ 2598 astStmt := astNode;
|
|
|
+ 2599 IF NOT SymTab.BoolCheck(t) THEN
|
|
|
+ 2600 SemError(214) END; .) .
|
|
|
+ 2601 LoopStat (. VAR lEnd: QbeGen.QVal; astNode: AST.Node; .)
|
|
|
+ 2602 = "LOOP" (. astStmt := AST.NoNode;
|
|
|
+ 2603 QbeGen.NewLabel(lEnd);
|
|
|
+ 2604 QbeGen.PushLoop(lEnd); .)
|
|
|
+ 2605 [ StatSeq ]
|
|
|
+ 2606 "END" (. astNode := AST.MakeNode(AST.NkLoop);
|
|
|
+ 2607 AST.SetChild(astNode, 0, astStmt);
|
|
|
+ 2608 astStmt := astNode;
|
|
|
+ 2609 QbeGen.PopLoop; .) .
|
|
|
+ 2610 (* FOR with static-sign BY (literal, non-zero; 220 otherwise).
|
|
|
+ 2611 Runtime direction would need a compare-select; the literal
|
|
|
+ 2612 sign picks cslew/csegew at "DO" time. *)
|
|
|
+ 2613 ForStat (. VAR lv: SymTab.Name;
|
|
|
+ 2614 tlo, thi, tby:
|
|
|
+ 2615 SymTab.TypeIndex;
|
|
|
+ 2616 qlo, qhi, qby, qt, qk, qb:
|
|
|
2617 QbeGen.QVal;
|
|
|
- 2618 by: INTEGER;
|
|
|
- 2619 ok: BOOLEAN;
|
|
|
- 2620 astVar, astLo, astHi, astBy,
|
|
|
- 2621 astNode: AST.Node; .)
|
|
|
- 2622 = "FOR" (. by := 1; .)
|
|
|
- 2623 GetIdent<lv> (. astVar := AST.MakeLeaf(AST.NkIdent, lv);
|
|
|
- 2624 astStmt := AST.NoNode;
|
|
|
- 2625 astBy := AST.NoNode;
|
|
|
- 2626 ok := SymTab.Lookup(lv);
|
|
|
- 2627 IF NOT ok THEN
|
|
|
- 2628 SemError(201)
|
|
|
- 2629 ELSIF (SymTab.SymKind(lv) #
|
|
|
- 2630 SymTab.KindVar)
|
|
|
- 2631 AND (SymTab.SymKind(lv) #
|
|
|
- 2632 SymTab.KindParam) THEN
|
|
|
- 2633 SemError(220); ok := FALSE
|
|
|
- 2634 ELSIF NOT SymTab.IsOrdinal(
|
|
|
- 2635 SymTab.SymType(lv)) THEN
|
|
|
- 2636 SemError(220); ok := FALSE
|
|
|
- 2637 END; .)
|
|
|
- 2638 ":=" Expr<tlo, qlo> (. astLo := astCur;
|
|
|
- 2639 IF NOT SymTab.Assignable(tlo,
|
|
|
- 2640 SymTab.SymType(lv)) THEN
|
|
|
- 2641 SemError(220); ok := FALSE
|
|
|
- 2642 END; .)
|
|
|
- 2643 "TO" Expr<thi, qhi> (. astHi := astCur;
|
|
|
- 2644 IF NOT SymTab.Assignable(thi,
|
|
|
- 2645 SymTab.SymType(lv)) THEN
|
|
|
- 2646 SemError(220); ok := FALSE
|
|
|
- 2647 END; .)
|
|
|
- 2648 [ "BY" Expr<tby, qby> (. astBy := astCur;
|
|
|
- 2649 IF (tby #
|
|
|
- 2650 SymTab.InvalidType)
|
|
|
- 2651 AND NOT SymTab.IsIntFamily(tby) THEN
|
|
|
- 2652 SemError(220); ok := FALSE
|
|
|
- 2653 END;
|
|
|
- 2654 IF NOT SymTab.ConstInt(qby, by) THEN
|
|
|
- 2655 SemError(230); by := 1
|
|
|
- 2656 ELSIF by = 0 THEN
|
|
|
- 2657 SemError(220); by := 1
|
|
|
- 2658 END; .) ]
|
|
|
- 2659 "DO"
|
|
|
- 2660 [ StatSeq ]
|
|
|
- 2661 "END" (. astNode := AST.MakeNode(AST.NkFor);
|
|
|
- 2662 AST.SetChild(astNode, 0, astVar);
|
|
|
- 2663 AST.SetChild(astNode, 1, astLo);
|
|
|
- 2664 AST.SetChild(astNode, 2, astHi);
|
|
|
- 2665 AST.SetChild(astNode, 3, astBy);
|
|
|
- 2666 AST.SetChild(astNode, 4, astStmt);
|
|
|
- 2667 astStmt := astNode;
|
|
|
- 2668 .) .
|
|
|
- 2669 CaseStat (. VAR tsel: SymTab.TypeIndex;
|
|
|
- 2670 qsel, lEnd: QbeGen.QVal;
|
|
|
- 2671 arm, astNode, astArms,
|
|
|
- 2672 astArmsTail: AST.Node; .)
|
|
|
- 2673 = "CASE" Expr<tsel, qsel> (. astNode := AST.MakeNode(AST.NkCase);
|
|
|
- 2674 AST.SetChild(astNode, 0, astCur);
|
|
|
- 2675 astArms := AST.NoNode;
|
|
|
- 2676 astArmsTail := AST.NoNode;
|
|
|
- 2677 .)
|
|
|
- 2678 "OF" CaseAlt<tsel, qsel, lEnd, astArms, astArmsTail>
|
|
|
- 2679 { "|" CaseAlt<tsel, qsel, lEnd, astArms, astArmsTail> }
|
|
|
- 2680 [ "ELSE" (. astStmt := AST.NoNode; .)
|
|
|
- 2681 [ StatSeq ] (. arm := AST.MakeNode(AST.NkCaseArm);
|
|
|
- 2682 AST.SetOp(arm, 1);
|
|
|
- 2683 AST.SetChild(arm, 0, astStmt);
|
|
|
- 2684 AstAppend(AST.NkBlock,
|
|
|
- 2685 astArms, astArmsTail, arm); .) ]
|
|
|
- 2686 "END" (. AST.SetChild(astNode, 1, astArms);
|
|
|
- 2687 astStmt := astNode;
|
|
|
- 2688 .) .
|
|
|
- 2689 (* Compare-chain lowering: each alternative ends its match-tests
|
|
|
- 2690 with "jmp lAfter", so the no-match fallthrough skips the body:
|
|
|
- 2691 "cmp; jnz(lBody,lF); lF: ... ; jmp lAfter; lBody: S; jmp lEnd;
|
|
|
- 2692 lAfter:". Falls into the next alternative, ELSE, or END. *)
|
|
|
- 2693 CaseAlt<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
|
|
|
- 2694 lEnd: QbeGen.QVal; VAR arms, armsTail: AST.Node>
|
|
|
- 2695 (. VAR arm: AST.Node; .)
|
|
|
- 2696 = (. arm := AST.MakeNode(AST.NkCaseArm); .)
|
|
|
- 2697 CaseLabel<tsel, qsel, arm>
|
|
|
- 2698 { "," CaseLabel<tsel, qsel, arm> }
|
|
|
- 2699 ":" (. astStmt := AST.NoNode; .)
|
|
|
- 2700 [ StatSeq ] (. AST.SetChild(arm, AST.NChild(arm),
|
|
|
- 2701 astStmt);
|
|
|
- 2702 AstAppend(AST.NkBlock,
|
|
|
- 2703 arms, armsTail, arm);
|
|
|
- 2704 .) .
|
|
|
- 2705 CaseLabel<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
|
|
|
- 2706 arm: AST.Node>
|
|
|
- 2707 (. VAR t2, t3: SymTab.TypeIndex;
|
|
|
- 2708 q2, q3, qc, qd, qe:
|
|
|
- 2709 QbeGen.QVal;
|
|
|
- 2710 astLab: AST.Node;
|
|
|
- 2711 lNext: QbeGen.QVal; .)
|
|
|
- 2712 = Expr<t2, q2> (. astLab := astCur;
|
|
|
- 2713 IF SymTab.IsEmptyStr(t2)
|
|
|
- 2714 AND (SymTab.ClassOf(tsel) =
|
|
|
- 2715 SymTab.ClChar) THEN
|
|
|
- 2716 (* ISO: '' as a CASE label
|
|
|
- 2717 is the terminator *)
|
|
|
- 2718 QbeGen.CopyOp("0", q2);
|
|
|
- 2719 t2 := SymTab.CharType()
|
|
|
- 2720 END;
|
|
|
- 2721 IF (t2 #
|
|
|
- 2722 SymTab.InvalidType)
|
|
|
- 2723 AND (tsel #
|
|
|
- 2724 SymTab.InvalidType)
|
|
|
- 2725 AND NOT SymTab.EqCheck(t2,
|
|
|
- 2726 tsel) THEN
|
|
|
- 2727 SemError(213) END;
|
|
|
- 2728 (* set labels are not immediates:
|
|
|
- 2729 the CASE chain uses CmpSet *)
|
|
|
- 2730 IF (SymTab.ClassOf(t2) # SymTab.ClSet)
|
|
|
- 2731 AND NOT QbeGen.IsImm(q2) THEN
|
|
|
- 2732 SemError(230)
|
|
|
- 2733 END; .)
|
|
|
- 2734 [ ".." Expr<t3, q3> (. astLab := AST.MakeBin(
|
|
|
- 2735 AST.NkSubrange, 0, astLab, astCur);
|
|
|
- 2736 IF SymTab.IsEmptyStr(t3)
|
|
|
- 2737 AND (SymTab.ClassOf(tsel) =
|
|
|
- 2738 SymTab.ClChar) THEN
|
|
|
- 2739 QbeGen.CopyOp("0", q3);
|
|
|
- 2740 t3 := SymTab.CharType()
|
|
|
- 2741 END;
|
|
|
- 2742 IF (t3 #
|
|
|
- 2743 SymTab.InvalidType)
|
|
|
- 2744 AND (tsel #
|
|
|
- 2745 SymTab.InvalidType)
|
|
|
- 2746 AND NOT SymTab.EqCheck(t3,
|
|
|
- 2747 tsel) THEN
|
|
|
- 2748 SemError(213) END;
|
|
|
- 2749 IF (SymTab.ClassOf(t3) # SymTab.ClSet)
|
|
|
- 2750 AND NOT QbeGen.IsImm(q3) THEN
|
|
|
- 2751 SemError(230)
|
|
|
- 2752 END; .) ]
|
|
|
- 2753 (. AST.SetChild(arm,
|
|
|
- 2754 AST.NChild(arm), astLab); .) .
|
|
|
- 2755 ReturnStat (. VAR t: SymTab.TypeIndex;
|
|
|
- 2756 q, qt: QbeGen.QVal;
|
|
|
- 2757 res: SymTab.TypeIndex;
|
|
|
- 2758 hadE, conv: BOOLEAN;
|
|
|
- 2759 astVal, astNode: AST.Node; .)
|
|
|
- 2760 = "RETURN" (. hadE := FALSE; astStmt := AST.NoNode; .)
|
|
|
- 2761 [ Expr<t, q> (. hadE := TRUE; astVal := astCur; .) ]
|
|
|
- 2762 (. astNode := AST.MakeNode(AST.NkReturn);
|
|
|
- 2763 IF hadE THEN
|
|
|
- 2764 AST.SetChild(astNode, 0, astVal)
|
|
|
- 2765 END;
|
|
|
- 2766 astStmt := astNode;
|
|
|
- 2767 conv := FALSE;
|
|
|
- 2768 IF NOT SymTab.InProc() THEN
|
|
|
- 2769 SemError(232)
|
|
|
- 2770 ELSE res := SymTab.CurRes();
|
|
|
- 2771 IF NOT hadE THEN
|
|
|
- 2772 IF res #
|
|
|
- 2773 SymTab.InvalidType THEN
|
|
|
- 2774 SemError(232)
|
|
|
- 2775 END
|
|
|
- 2776 ELSIF (res =
|
|
|
- 2777 SymTab.InvalidType)
|
|
|
- 2778 OR (t #
|
|
|
+ 2618 lTop, lBody, lEnd:
|
|
|
+ 2619 QbeGen.QVal;
|
|
|
+ 2620 by: INTEGER;
|
|
|
+ 2621 ok: BOOLEAN;
|
|
|
+ 2622 astVar, astLo, astHi, astBy,
|
|
|
+ 2623 astNode: AST.Node; .)
|
|
|
+ 2624 = "FOR" (. by := 1; .)
|
|
|
+ 2625 GetIdent<lv> (. astVar := AST.MakeLeaf(AST.NkIdent, lv);
|
|
|
+ 2626 astStmt := AST.NoNode;
|
|
|
+ 2627 astBy := AST.NoNode;
|
|
|
+ 2628 ok := SymTab.Lookup(lv);
|
|
|
+ 2629 IF NOT ok THEN
|
|
|
+ 2630 SemError(201)
|
|
|
+ 2631 ELSIF (SymTab.SymKind(lv) #
|
|
|
+ 2632 SymTab.KindVar)
|
|
|
+ 2633 AND (SymTab.SymKind(lv) #
|
|
|
+ 2634 SymTab.KindParam) THEN
|
|
|
+ 2635 SemError(220); ok := FALSE
|
|
|
+ 2636 ELSIF NOT SymTab.IsOrdinal(
|
|
|
+ 2637 SymTab.SymType(lv)) THEN
|
|
|
+ 2638 SemError(220); ok := FALSE
|
|
|
+ 2639 END; .)
|
|
|
+ 2640 ":=" Expr<tlo, qlo> (. astLo := astCur;
|
|
|
+ 2641 IF NOT SymTab.Assignable(tlo,
|
|
|
+ 2642 SymTab.SymType(lv)) THEN
|
|
|
+ 2643 SemError(220); ok := FALSE
|
|
|
+ 2644 END; .)
|
|
|
+ 2645 "TO" Expr<thi, qhi> (. astHi := astCur;
|
|
|
+ 2646 IF NOT SymTab.Assignable(thi,
|
|
|
+ 2647 SymTab.SymType(lv)) THEN
|
|
|
+ 2648 SemError(220); ok := FALSE
|
|
|
+ 2649 END; .)
|
|
|
+ 2650 [ "BY" Expr<tby, qby> (. astBy := astCur;
|
|
|
+ 2651 IF (tby #
|
|
|
+ 2652 SymTab.InvalidType)
|
|
|
+ 2653 AND NOT SymTab.IsIntFamily(tby) THEN
|
|
|
+ 2654 SemError(220); ok := FALSE
|
|
|
+ 2655 END;
|
|
|
+ 2656 IF NOT SymTab.ConstInt(qby, by) THEN
|
|
|
+ 2657 SemError(230); by := 1
|
|
|
+ 2658 ELSIF by = 0 THEN
|
|
|
+ 2659 SemError(220); by := 1
|
|
|
+ 2660 END; .) ]
|
|
|
+ 2661 "DO"
|
|
|
+ 2662 [ StatSeq ]
|
|
|
+ 2663 "END" (. astNode := AST.MakeNode(AST.NkFor);
|
|
|
+ 2664 AST.SetChild(astNode, 0, astVar);
|
|
|
+ 2665 AST.SetChild(astNode, 1, astLo);
|
|
|
+ 2666 AST.SetChild(astNode, 2, astHi);
|
|
|
+ 2667 AST.SetChild(astNode, 3, astBy);
|
|
|
+ 2668 AST.SetChild(astNode, 4, astStmt);
|
|
|
+ 2669 astStmt := astNode;
|
|
|
+ 2670 .) .
|
|
|
+ 2671 CaseStat (. VAR tsel: SymTab.TypeIndex;
|
|
|
+ 2672 qsel, lEnd: QbeGen.QVal;
|
|
|
+ 2673 arm, astNode, astArms,
|
|
|
+ 2674 astArmsTail: AST.Node; .)
|
|
|
+ 2675 = "CASE" Expr<tsel, qsel> (. astNode := AST.MakeNode(AST.NkCase);
|
|
|
+ 2676 AST.SetChild(astNode, 0, astCur);
|
|
|
+ 2677 astArms := AST.NoNode;
|
|
|
+ 2678 astArmsTail := AST.NoNode;
|
|
|
+ 2679 .)
|
|
|
+ 2680 "OF" CaseAlt<tsel, qsel, lEnd, astArms, astArmsTail>
|
|
|
+ 2681 { "|" CaseAlt<tsel, qsel, lEnd, astArms, astArmsTail> }
|
|
|
+ 2682 [ "ELSE" (. astStmt := AST.NoNode; .)
|
|
|
+ 2683 [ StatSeq ] (. arm := AST.MakeNode(AST.NkCaseArm);
|
|
|
+ 2684 AST.SetOp(arm, 1);
|
|
|
+ 2685 AST.SetChild(arm, 0, astStmt);
|
|
|
+ 2686 AstAppend(AST.NkBlock,
|
|
|
+ 2687 astArms, astArmsTail, arm); .) ]
|
|
|
+ 2688 "END" (. AST.SetChild(astNode, 1, astArms);
|
|
|
+ 2689 astStmt := astNode;
|
|
|
+ 2690 .) .
|
|
|
+ 2691 (* Compare-chain lowering: each alternative ends its match-tests
|
|
|
+ 2692 with "jmp lAfter", so the no-match fallthrough skips the body:
|
|
|
+ 2693 "cmp; jnz(lBody,lF); lF: ... ; jmp lAfter; lBody: S; jmp lEnd;
|
|
|
+ 2694 lAfter:". Falls into the next alternative, ELSE, or END. *)
|
|
|
+ 2695 CaseAlt<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
|
|
|
+ 2696 lEnd: QbeGen.QVal; VAR arms, armsTail: AST.Node>
|
|
|
+ 2697 (. VAR arm: AST.Node; .)
|
|
|
+ 2698 = (. arm := AST.MakeNode(AST.NkCaseArm); .)
|
|
|
+ 2699 CaseLabel<tsel, qsel, arm>
|
|
|
+ 2700 { "," CaseLabel<tsel, qsel, arm> }
|
|
|
+ 2701 ":" (. astStmt := AST.NoNode; .)
|
|
|
+ 2702 [ StatSeq ] (. AST.SetChild(arm, AST.NChild(arm),
|
|
|
+ 2703 astStmt);
|
|
|
+ 2704 AstAppend(AST.NkBlock,
|
|
|
+ 2705 arms, armsTail, arm);
|
|
|
+ 2706 .) .
|
|
|
+ 2707 CaseLabel<tsel: SymTab.TypeIndex; qsel: QbeGen.QVal;
|
|
|
+ 2708 arm: AST.Node>
|
|
|
+ 2709 (. VAR t2, t3: SymTab.TypeIndex;
|
|
|
+ 2710 q2, q3, qc, qd, qe:
|
|
|
+ 2711 QbeGen.QVal;
|
|
|
+ 2712 astLab: AST.Node;
|
|
|
+ 2713 lNext: QbeGen.QVal; .)
|
|
|
+ 2714 = Expr<t2, q2> (. astLab := astCur;
|
|
|
+ 2715 IF SymTab.IsEmptyStr(t2)
|
|
|
+ 2716 AND (SymTab.ClassOf(tsel) =
|
|
|
+ 2717 SymTab.ClChar) THEN
|
|
|
+ 2718 (* ISO: '' as a CASE label
|
|
|
+ 2719 is the terminator *)
|
|
|
+ 2720 QbeGen.CopyOp("0", q2);
|
|
|
+ 2721 t2 := SymTab.CharType()
|
|
|
+ 2722 END;
|
|
|
+ 2723 IF (t2 #
|
|
|
+ 2724 SymTab.InvalidType)
|
|
|
+ 2725 AND (tsel #
|
|
|
+ 2726 SymTab.InvalidType)
|
|
|
+ 2727 AND NOT SymTab.EqCheck(t2,
|
|
|
+ 2728 tsel) THEN
|
|
|
+ 2729 SemError(213) END;
|
|
|
+ 2730 (* set labels are not immediates:
|
|
|
+ 2731 the CASE chain uses CmpSet *)
|
|
|
+ 2732 IF (SymTab.ClassOf(t2) # SymTab.ClSet)
|
|
|
+ 2733 AND NOT QbeGen.IsImm(q2) THEN
|
|
|
+ 2734 SemError(230)
|
|
|
+ 2735 END; .)
|
|
|
+ 2736 [ ".." Expr<t3, q3> (. astLab := AST.MakeBin(
|
|
|
+ 2737 AST.NkSubrange, 0, astLab, astCur);
|
|
|
+ 2738 IF SymTab.IsEmptyStr(t3)
|
|
|
+ 2739 AND (SymTab.ClassOf(tsel) =
|
|
|
+ 2740 SymTab.ClChar) THEN
|
|
|
+ 2741 QbeGen.CopyOp("0", q3);
|
|
|
+ 2742 t3 := SymTab.CharType()
|
|
|
+ 2743 END;
|
|
|
+ 2744 IF (t3 #
|
|
|
+ 2745 SymTab.InvalidType)
|
|
|
+ 2746 AND (tsel #
|
|
|
+ 2747 SymTab.InvalidType)
|
|
|
+ 2748 AND NOT SymTab.EqCheck(t3,
|
|
|
+ 2749 tsel) THEN
|
|
|
+ 2750 SemError(213) END;
|
|
|
+ 2751 IF (SymTab.ClassOf(t3) # SymTab.ClSet)
|
|
|
+ 2752 AND NOT QbeGen.IsImm(q3) THEN
|
|
|
+ 2753 SemError(230)
|
|
|
+ 2754 END; .) ]
|
|
|
+ 2755 (. AST.SetChild(arm,
|
|
|
+ 2756 AST.NChild(arm), astLab); .) .
|
|
|
+ 2757 ReturnStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ 2758 q, qt: QbeGen.QVal;
|
|
|
+ 2759 res: SymTab.TypeIndex;
|
|
|
+ 2760 hadE, conv: BOOLEAN;
|
|
|
+ 2761 astVal, astNode: AST.Node; .)
|
|
|
+ 2762 = "RETURN" (. hadE := FALSE; astStmt := AST.NoNode; .)
|
|
|
+ 2763 [ Expr<t, q> (. hadE := TRUE; astVal := astCur; .) ]
|
|
|
+ 2764 (. astNode := AST.MakeNode(AST.NkReturn);
|
|
|
+ 2765 IF hadE THEN
|
|
|
+ 2766 AST.SetChild(astNode, 0, astVal)
|
|
|
+ 2767 END;
|
|
|
+ 2768 astStmt := astNode;
|
|
|
+ 2769 conv := FALSE;
|
|
|
+ 2770 IF NOT SymTab.InProc() THEN
|
|
|
+ 2771 SemError(232)
|
|
|
+ 2772 ELSE res := SymTab.CurRes();
|
|
|
+ 2773 IF NOT hadE THEN
|
|
|
+ 2774 IF res #
|
|
|
+ 2775 SymTab.InvalidType THEN
|
|
|
+ 2776 SemError(232)
|
|
|
+ 2777 END
|
|
|
+ 2778 ELSIF (res =
|
|
|
2779 SymTab.InvalidType)
|
|
|
- 2780 AND NOT SymTab.Assignable(t,
|
|
|
- 2781 res) THEN
|
|
|
- 2782 SemError(232)
|
|
|
- 2783 END
|
|
|
- 2784 END; .) .
|
|
|
- 2785 HaltStat (. VAR t: SymTab.TypeIndex;
|
|
|
- 2786 q: QbeGen.QVal;
|
|
|
- 2787 astVal, astNode: AST.Node; .)
|
|
|
- 2788 = "HALT" (. astVal := AST.NoNode; .)
|
|
|
- 2789 [ "(" Expr<t, q> (. astVal := astCur; .) ")" ]
|
|
|
- 2790 (. astNode := AST.MakeNode(AST.NkHalt);
|
|
|
- 2791 IF astVal # AST.NoNode THEN
|
|
|
- 2792 AST.SetChild(astNode, 0, astVal)
|
|
|
- 2793 END;
|
|
|
- 2794 astStmt := astNode;
|
|
|
- 2795 .) .
|
|
|
- 2796 (* Designator: scalar loads, array addresses, and index suffixes.
|
|
|
- 2797 Each index descends one level (bounds-checked, trap on breach);
|
|
|
- 2798 nested levels reload the inner descriptor address. q ends as the
|
|
|
- 2799 value (scalars), the descriptor address (plain arrays), or the
|
|
|
- 2800 element address (indexed); sfx marks the indexed form. *)
|
|
|
- 2801 Design<VAR t: SymTab.TypeIndex; VAR k: INTEGER;
|
|
|
- 2802 VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
|
|
|
- 2803 (. VAR n: SymTab.Name; .)
|
|
|
- 2804 = GetIdent<n> DesignTail<n, t, k, q, qn, sfx> .
|
|
|
- 2805 (* The part of Design after the identifier: resolve it and walk the
|
|
|
- 2806 selectors. Split out so a statement can decide between a label
|
|
|
- 2807 (`ident :`) and a designator (`ident := ...`) with one token. *)
|
|
|
- 2808 DesignTail<VAR n: SymTab.Name; VAR t: SymTab.TypeIndex; VAR k: INTEGER;
|
|
|
- 2809 VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
|
|
|
- 2810 (. VAR fn, mal: SymTab.Name;
|
|
|
- 2811 cls: INTEGER;
|
|
|
- 2812 ic: SymTab.TypeIndex;
|
|
|
- 2813 curT, it, eT, bt:
|
|
|
- 2814 SymTab.TypeIndex;
|
|
|
- 2815 iq, ql, qlo, qhi, qe:
|
|
|
- 2816 QbeGen.QVal;
|
|
|
- 2817 lo, hi: INTEGER;
|
|
|
- 2818 fo: INTEGER;
|
|
|
- 2819 isOpen: BOOLEAN;
|
|
|
- 2820 qb, cv: QbeGen.QVal;
|
|
|
- 2821 r: BOOLEAN;
|
|
|
- 2822 astDes, astSel: AST.Node; .)
|
|
|
- 2823 = (. methCls := SymTab.InvalidType;
|
|
|
- 2824 QbeGen.CopyOp(n, qn);
|
|
|
- 2825 sfx := FALSE;
|
|
|
- 2826 IF NOT SymTab.Lookup(n) THEN
|
|
|
- 2827 (* a bare method name inside
|
|
|
- 2828 a CLASS IMPLEMENTATION
|
|
|
- 2829 is a sibling call on
|
|
|
- 2830 THIS *)
|
|
|
- 2831 ic := SymTab.CurImplClass();
|
|
|
- 2832 IF (ic #
|
|
|
- 2833 SymTab.InvalidType)
|
|
|
- 2834 AND SymTab.MethodExists(ic, n) THEN
|
|
|
- 2835 sfx := FALSE;
|
|
|
- 2836 QbeGen.CopyOp("@", q);
|
|
|
- 2837 methCls := ic;
|
|
|
- 2838 k := SymTab.KindProc;
|
|
|
- 2839 t := SymTab.InvalidType
|
|
|
- 2840 ELSIF SymTab.InProc() THEN
|
|
|
- 2841 (* not declared anywhere
|
|
|
- 2842 in scope: with bodies
|
|
|
- 2843 parsed at unit end this
|
|
|
- 2844 is a genuine 201 (a
|
|
|
- 2845 nested-local forward is
|
|
|
- 2846 no longer tolerated). *)
|
|
|
- 2847 SemError(201);
|
|
|
- 2848 t := SymTab.InvalidType;
|
|
|
- 2849 k := -1;
|
|
|
- 2850 QbeGen.CopyOp("0", q)
|
|
|
- 2851 ELSE
|
|
|
- 2852 SemError(201);
|
|
|
- 2853 t :=
|
|
|
- 2854 SymTab.InvalidType;
|
|
|
- 2855 k := -1;
|
|
|
- 2856 QbeGen.CopyOp("0", q)
|
|
|
- 2857 END
|
|
|
- 2858 ELSE
|
|
|
- 2859 t := SymTab.SymType(n);
|
|
|
- 2860 k := SymTab.SymKind(n);
|
|
|
- 2861 IF k = SymTab.KindConst THEN
|
|
|
- 2862 IF SymTab.Equal(n,
|
|
|
- 2863 "TRUE") THEN
|
|
|
- 2864 t := SymTab.BoolType();
|
|
|
- 2865 QbeGen.CopyOp("1", q)
|
|
|
- 2866 ELSIF SymTab.Equal(n,
|
|
|
- 2867 "FALSE") THEN
|
|
|
- 2868 t := SymTab.BoolType();
|
|
|
- 2869 QbeGen.CopyOp("0", q)
|
|
|
- 2870 ELSIF SymTab.Equal(n,
|
|
|
- 2871 "NIL") THEN
|
|
|
- 2872 QbeGen.CopyOp("0", q)
|
|
|
- 2873 ELSE
|
|
|
- 2874 cls :=
|
|
|
- 2875 SymTab.ClassOf(t);
|
|
|
- 2876 IF (t #
|
|
|
- 2877 SymTab.InvalidType)
|
|
|
- 2878 AND ((cls = SymTab.ClInt)
|
|
|
- 2879 OR (cls
|
|
|
- 2880 = SymTab.ClChar)
|
|
|
+ 2780 OR (t #
|
|
|
+ 2781 SymTab.InvalidType)
|
|
|
+ 2782 AND NOT SymTab.Assignable(t,
|
|
|
+ 2783 res) THEN
|
|
|
+ 2784 SemError(232)
|
|
|
+ 2785 END
|
|
|
+ 2786 END; .) .
|
|
|
+ 2787 HaltStat (. VAR t: SymTab.TypeIndex;
|
|
|
+ 2788 q: QbeGen.QVal;
|
|
|
+ 2789 astVal, astNode: AST.Node; .)
|
|
|
+ 2790 = "HALT" (. astVal := AST.NoNode; .)
|
|
|
+ 2791 [ "(" Expr<t, q> (. astVal := astCur; .) ")" ]
|
|
|
+ 2792 (. astNode := AST.MakeNode(AST.NkHalt);
|
|
|
+ 2793 IF astVal # AST.NoNode THEN
|
|
|
+ 2794 AST.SetChild(astNode, 0, astVal)
|
|
|
+ 2795 END;
|
|
|
+ 2796 astStmt := astNode;
|
|
|
+ 2797 .) .
|
|
|
+ 2798 (* Designator: scalar loads, array addresses, and index suffixes.
|
|
|
+ 2799 Each index descends one level (bounds-checked, trap on breach);
|
|
|
+ 2800 nested levels reload the inner descriptor address. q ends as the
|
|
|
+ 2801 value (scalars), the descriptor address (plain arrays), or the
|
|
|
+ 2802 element address (indexed); sfx marks the indexed form. *)
|
|
|
+ 2803 Design<VAR t: SymTab.TypeIndex; VAR k: INTEGER;
|
|
|
+ 2804 VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
|
|
|
+ 2805 (. VAR n: SymTab.Name; .)
|
|
|
+ 2806 = GetIdent<n> DesignTail<n, t, k, q, qn, sfx> .
|
|
|
+ 2807 (* The part of Design after the identifier: resolve it and walk the
|
|
|
+ 2808 selectors. Split out so a statement can decide between a label
|
|
|
+ 2809 (`ident :`) and a designator (`ident := ...`) with one token. *)
|
|
|
+ 2810 DesignTail<VAR n: SymTab.Name; VAR t: SymTab.TypeIndex; VAR k: INTEGER;
|
|
|
+ 2811 VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN>
|
|
|
+ 2812 (. VAR fn, mal: SymTab.Name;
|
|
|
+ 2813 cls: INTEGER;
|
|
|
+ 2814 ic: SymTab.TypeIndex;
|
|
|
+ 2815 curT, it, eT, bt:
|
|
|
+ 2816 SymTab.TypeIndex;
|
|
|
+ 2817 iq, ql, qlo, qhi, qe:
|
|
|
+ 2818 QbeGen.QVal;
|
|
|
+ 2819 lo, hi: INTEGER;
|
|
|
+ 2820 fo: INTEGER;
|
|
|
+ 2821 isOpen: BOOLEAN;
|
|
|
+ 2822 qb, cv: QbeGen.QVal;
|
|
|
+ 2823 r: BOOLEAN;
|
|
|
+ 2824 astDes, astSel: AST.Node; .)
|
|
|
+ 2825 = (. methCls := SymTab.InvalidType;
|
|
|
+ 2826 QbeGen.CopyOp(n, qn);
|
|
|
+ 2827 sfx := FALSE;
|
|
|
+ 2828 IF NOT SymTab.Lookup(n) THEN
|
|
|
+ 2829 (* a bare method name inside
|
|
|
+ 2830 a CLASS IMPLEMENTATION
|
|
|
+ 2831 is a sibling call on
|
|
|
+ 2832 THIS *)
|
|
|
+ 2833 ic := SymTab.CurImplClass();
|
|
|
+ 2834 IF (ic #
|
|
|
+ 2835 SymTab.InvalidType)
|
|
|
+ 2836 AND SymTab.MethodExists(ic, n) THEN
|
|
|
+ 2837 sfx := FALSE;
|
|
|
+ 2838 QbeGen.CopyOp("@", q);
|
|
|
+ 2839 methCls := ic;
|
|
|
+ 2840 k := SymTab.KindProc;
|
|
|
+ 2841 t := SymTab.InvalidType
|
|
|
+ 2842 ELSIF SymTab.InProc() THEN
|
|
|
+ 2843 (* not declared anywhere
|
|
|
+ 2844 in scope: with bodies
|
|
|
+ 2845 parsed at unit end this
|
|
|
+ 2846 is a genuine 201 (a
|
|
|
+ 2847 nested-local forward is
|
|
|
+ 2848 no longer tolerated). *)
|
|
|
+ 2849 SemError(201);
|
|
|
+ 2850 t := SymTab.InvalidType;
|
|
|
+ 2851 k := -1;
|
|
|
+ 2852 QbeGen.CopyOp("0", q)
|
|
|
+ 2853 ELSE
|
|
|
+ 2854 SemError(201);
|
|
|
+ 2855 t :=
|
|
|
+ 2856 SymTab.InvalidType;
|
|
|
+ 2857 k := -1;
|
|
|
+ 2858 QbeGen.CopyOp("0", q)
|
|
|
+ 2859 END
|
|
|
+ 2860 ELSE
|
|
|
+ 2861 t := SymTab.SymType(n);
|
|
|
+ 2862 k := SymTab.SymKind(n);
|
|
|
+ 2863 IF k = SymTab.KindConst THEN
|
|
|
+ 2864 IF SymTab.Equal(n,
|
|
|
+ 2865 "TRUE") THEN
|
|
|
+ 2866 t := SymTab.BoolType();
|
|
|
+ 2867 QbeGen.CopyOp("1", q)
|
|
|
+ 2868 ELSIF SymTab.Equal(n,
|
|
|
+ 2869 "FALSE") THEN
|
|
|
+ 2870 t := SymTab.BoolType();
|
|
|
+ 2871 QbeGen.CopyOp("0", q)
|
|
|
+ 2872 ELSIF SymTab.Equal(n,
|
|
|
+ 2873 "NIL") THEN
|
|
|
+ 2874 QbeGen.CopyOp("0", q)
|
|
|
+ 2875 ELSE
|
|
|
+ 2876 cls :=
|
|
|
+ 2877 SymTab.ClassOf(t);
|
|
|
+ 2878 IF (t #
|
|
|
+ 2879 SymTab.InvalidType)
|
|
|
+ 2880 AND ((cls = SymTab.ClInt)
|
|
|
2881 OR (cls
|
|
|
- 2882 = SymTab.ClEnum)
|
|
|
+ 2882 = SymTab.ClChar)
|
|
|
2883 OR (cls
|
|
|
- 2884 = SymTab.ClReal)
|
|
|
+ 2884 = SymTab.ClEnum)
|
|
|
2885 OR (cls
|
|
|
- 2886 = SymTab.ClLong)
|
|
|
+ 2886 = SymTab.ClReal)
|
|
|
2887 OR (cls
|
|
|
- 2888 = SymTab.ClNil)
|
|
|
- 2889 OR (cls = SymTab.ClBool)) THEN
|
|
|
- 2890 IF cls = SymTab.ClNil THEN
|
|
|
- 2891 QbeGen.CopyOp("0", q)
|
|
|
- 2892 ELSIF ((cls
|
|
|
- 2893 = SymTab.ClInt)
|
|
|
- 2894 OR (cls
|
|
|
- 2895 = SymTab.ClChar)
|
|
|
+ 2888 = SymTab.ClLong)
|
|
|
+ 2889 OR (cls
|
|
|
+ 2890 = SymTab.ClNil)
|
|
|
+ 2891 OR (cls = SymTab.ClBool)) THEN
|
|
|
+ 2892 IF cls = SymTab.ClNil THEN
|
|
|
+ 2893 QbeGen.CopyOp("0", q)
|
|
|
+ 2894 ELSIF ((cls
|
|
|
+ 2895 = SymTab.ClInt)
|
|
|
2896 OR (cls
|
|
|
- 2897 = SymTab.ClEnum)
|
|
|
+ 2897 = SymTab.ClChar)
|
|
|
2898 OR (cls
|
|
|
- 2899 = SymTab.ClLong)
|
|
|
- 2900 OR (cls = SymTab.ClBool))
|
|
|
- 2901 AND SymTab.GetSymVal(n, cv)
|
|
|
- 2902 AND QbeGen.IsImm(cv) THEN
|
|
|
- 2903 QbeGen.CopyOp(cv, q)
|
|
|
- 2904 ELSE
|
|
|
- 2905 QbeGen.LoadVar(n,
|
|
|
- 2906 cls = SymTab.ClReal,
|
|
|
- 2907 q)
|
|
|
- 2908 END
|
|
|
- 2909 ELSIF (cls = SymTab.ClArray)
|
|
|
- 2910 OR (cls = SymTab.ClRecord)
|
|
|
- 2911 OR (cls = SymTab.ClClass)
|
|
|
- 2912 OR (cls = SymTab.ClStr)
|
|
|
- 2913 OR (cls = SymTab.ClUStr)
|
|
|
- 2914 OR (cls = SymTab.ClSet) THEN
|
|
|
- 2915 (* aggregate constant:
|
|
|
- 2916 its value IS the
|
|
|
- 2917 descriptor address *)
|
|
|
- 2918 IF SymTab.GetSymVal(n, cv) THEN
|
|
|
- 2919 QbeGen.CopyOp(cv, q)
|
|
|
- 2920 ELSE
|
|
|
- 2921 QbeGen.CopyOp("0", q)
|
|
|
- 2922 END
|
|
|
- 2923 ELSE
|
|
|
- 2924 IF t #
|
|
|
- 2925 SymTab.InvalidType THEN
|
|
|
- 2926 SemError(230)
|
|
|
- 2927 END;
|
|
|
- 2928 QbeGen.CopyOp("0", q)
|
|
|
- 2929 END
|
|
|
- 2930 END
|
|
|
- 2931 ELSIF (k = SymTab.KindVar)
|
|
|
- 2932 OR (k = SymTab.KindParam) THEN
|
|
|
- 2933 cls := SymTab.ClassOf(t);
|
|
|
- 2934 IF (cls # SymTab.ClInt)
|
|
|
- 2935 AND (cls # SymTab.ClBool)
|
|
|
- 2936 AND (cls # SymTab.ClChar)
|
|
|
- 2937 AND (cls # SymTab.ClUChar)
|
|
|
- 2938 AND (cls # SymTab.ClEnum)
|
|
|
- 2939 AND (cls # SymTab.ClReal)
|
|
|
- 2940 AND (cls # SymTab.ClPtr)
|
|
|
- 2941 AND (cls # SymTab.ClProc)
|
|
|
- 2942 AND (cls # SymTab.ClLong)
|
|
|
- 2943 AND (cls # SymTab.ClArray)
|
|
|
- 2944 AND (cls # SymTab.ClSet)
|
|
|
- 2945 AND (cls # SymTab.ClRecord)
|
|
|
- 2946 AND (cls # SymTab.ClUStr)
|
|
|
- 2947 AND (cls # SymTab.ClClass) THEN
|
|
|
- 2948 SemError(230);
|
|
|
- 2949 QbeGen.CopyOp("0", q)
|
|
|
- 2950 ELSE QbeGen.CopyOp("@", q)
|
|
|
- 2951 END
|
|
|
- 2952 ELSE QbeGen.CopyOp("0", q);
|
|
|
- 2953 IF k = SymTab.KindImport THEN
|
|
|
- 2954 SemError(230)
|
|
|
- 2955 ELSIF k =
|
|
|
- 2956 SymTab.KindProc THEN
|
|
|
- 2957 (* bare procedure name:
|
|
|
- 2958 a following ArgList
|
|
|
- 2959 makes it a call;
|
|
|
- 2960 otherwise Fact
|
|
|
- 2961 reports 230 *)
|
|
|
- 2962 ELSE
|
|
|
- 2963 IF k = SymTab.KindField THEN
|
|
|
- 2964 IF QbeGen.TopWith(qb) THEN
|
|
|
- 2965 sfx := TRUE
|
|
|
- 2966 ELSE SemError(230);
|
|
|
- 2967 QbeGen.CopyOp("0", q)
|
|
|
- 2968 END
|
|
|
- 2969 END
|
|
|
- 2970 END
|
|
|
- 2971 END
|
|
|
- 2972 END; .)
|
|
|
- 2973 (. astDes := AST.MakeNode(AST.NkDesignator);
|
|
|
- 2974 AST.SetChild(astDes, AST.NChild(astDes), AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
- 2975 { "[" Expr<it, iq>
|
|
|
- 2976 (. AST.SetChild(astDes, AST.NChild(astDes),
|
|
|
- 2977 AST.MakeUn(AST.NkSelector, AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
- 2978 ELSIF SymTab.ClassOf(t) #
|
|
|
- 2979 SymTab.ClArray THEN
|
|
|
- 2980 SemError(217);
|
|
|
- 2981 t := SymTab.InvalidType
|
|
|
- 2982 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
- 2983 AND (SymTab.ClassOf(it) #
|
|
|
- 2984 SymTab.ClChar)
|
|
|
+ 2899 = SymTab.ClEnum)
|
|
|
+ 2900 OR (cls
|
|
|
+ 2901 = SymTab.ClLong)
|
|
|
+ 2902 OR (cls = SymTab.ClBool))
|
|
|
+ 2903 AND SymTab.GetSymVal(n, cv)
|
|
|
+ 2904 AND QbeGen.IsImm(cv) THEN
|
|
|
+ 2905 QbeGen.CopyOp(cv, q)
|
|
|
+ 2906 ELSE
|
|
|
+ 2907 QbeGen.LoadVar(n,
|
|
|
+ 2908 cls = SymTab.ClReal,
|
|
|
+ 2909 q)
|
|
|
+ 2910 END
|
|
|
+ 2911 ELSIF (cls = SymTab.ClArray)
|
|
|
+ 2912 OR (cls = SymTab.ClRecord)
|
|
|
+ 2913 OR (cls = SymTab.ClClass)
|
|
|
+ 2914 OR (cls = SymTab.ClStr)
|
|
|
+ 2915 OR (cls = SymTab.ClUStr)
|
|
|
+ 2916 OR (cls = SymTab.ClSet) THEN
|
|
|
+ 2917 (* aggregate constant:
|
|
|
+ 2918 its value IS the
|
|
|
+ 2919 descriptor address *)
|
|
|
+ 2920 IF SymTab.GetSymVal(n, cv) THEN
|
|
|
+ 2921 QbeGen.CopyOp(cv, q)
|
|
|
+ 2922 ELSE
|
|
|
+ 2923 QbeGen.CopyOp("0", q)
|
|
|
+ 2924 END
|
|
|
+ 2925 ELSE
|
|
|
+ 2926 IF t #
|
|
|
+ 2927 SymTab.InvalidType THEN
|
|
|
+ 2928 SemError(230)
|
|
|
+ 2929 END;
|
|
|
+ 2930 QbeGen.CopyOp("0", q)
|
|
|
+ 2931 END
|
|
|
+ 2932 END
|
|
|
+ 2933 ELSIF (k = SymTab.KindVar)
|
|
|
+ 2934 OR (k = SymTab.KindParam) THEN
|
|
|
+ 2935 cls := SymTab.ClassOf(t);
|
|
|
+ 2936 IF (cls # SymTab.ClInt)
|
|
|
+ 2937 AND (cls # SymTab.ClBool)
|
|
|
+ 2938 AND (cls # SymTab.ClChar)
|
|
|
+ 2939 AND (cls # SymTab.ClUChar)
|
|
|
+ 2940 AND (cls # SymTab.ClEnum)
|
|
|
+ 2941 AND (cls # SymTab.ClReal)
|
|
|
+ 2942 AND (cls # SymTab.ClPtr)
|
|
|
+ 2943 AND (cls # SymTab.ClProc)
|
|
|
+ 2944 AND (cls # SymTab.ClLong)
|
|
|
+ 2945 AND (cls # SymTab.ClArray)
|
|
|
+ 2946 AND (cls # SymTab.ClSet)
|
|
|
+ 2947 AND (cls # SymTab.ClRecord)
|
|
|
+ 2948 AND (cls # SymTab.ClUStr)
|
|
|
+ 2949 AND (cls # SymTab.ClClass) THEN
|
|
|
+ 2950 SemError(230);
|
|
|
+ 2951 QbeGen.CopyOp("0", q)
|
|
|
+ 2952 ELSE QbeGen.CopyOp("@", q)
|
|
|
+ 2953 END
|
|
|
+ 2954 ELSE QbeGen.CopyOp("0", q);
|
|
|
+ 2955 IF k = SymTab.KindImport THEN
|
|
|
+ 2956 SemError(230)
|
|
|
+ 2957 ELSIF k =
|
|
|
+ 2958 SymTab.KindProc THEN
|
|
|
+ 2959 (* bare procedure name:
|
|
|
+ 2960 a following ArgList
|
|
|
+ 2961 makes it a call;
|
|
|
+ 2962 otherwise Fact
|
|
|
+ 2963 reports 230 *)
|
|
|
+ 2964 ELSE
|
|
|
+ 2965 IF k = SymTab.KindField THEN
|
|
|
+ 2966 IF QbeGen.TopWith(qb) THEN
|
|
|
+ 2967 sfx := TRUE
|
|
|
+ 2968 ELSE SemError(230);
|
|
|
+ 2969 QbeGen.CopyOp("0", q)
|
|
|
+ 2970 END
|
|
|
+ 2971 END
|
|
|
+ 2972 END
|
|
|
+ 2973 END
|
|
|
+ 2974 END; .)
|
|
|
+ 2975 (. astDes := AST.MakeNode(AST.NkDesignator);
|
|
|
+ 2976 AST.SetChild(astDes, AST.NChild(astDes), AST.MakeLeaf(AST.NkIdent, n)); .)
|
|
|
+ 2977 { "[" Expr<it, iq>
|
|
|
+ 2978 (. AST.SetChild(astDes, AST.NChild(astDes),
|
|
|
+ 2979 AST.MakeUn(AST.NkSelector, AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
+ 2980 ELSIF SymTab.ClassOf(t) #
|
|
|
+ 2981 SymTab.ClArray THEN
|
|
|
+ 2982 SemError(217);
|
|
|
+ 2983 t := SymTab.InvalidType
|
|
|
+ 2984 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
2985 AND (SymTab.ClassOf(it) #
|
|
|
- 2986 SymTab.ClEnum)
|
|
|
+ 2986 SymTab.ClChar)
|
|
|
2987 AND (SymTab.ClassOf(it) #
|
|
|
- 2988 SymTab.ClBool) THEN
|
|
|
- 2989 SemError(218);
|
|
|
- 2990 t := SymTab.InvalidType
|
|
|
- 2991 ELSE
|
|
|
- 2992 eT := SymTab.ArrayElem(t);
|
|
|
- 2993 t := eT; sfx := TRUE
|
|
|
- 2994 END; .)
|
|
|
- 2995 { "," Expr<it, iq>
|
|
|
- 2996 (. AST.SetChild(astDes, AST.NChild(astDes),
|
|
|
- 2997 AST.MakeUn(AST.NkSelector, AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
- 2998 ELSIF SymTab.ClassOf(t) #
|
|
|
- 2999 SymTab.ClArray THEN
|
|
|
- 3000 SemError(217);
|
|
|
- 3001 t := SymTab.InvalidType
|
|
|
- 3002 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
- 3003 AND (SymTab.ClassOf(it) #
|
|
|
- 3004 SymTab.ClChar)
|
|
|
+ 2988 SymTab.ClEnum)
|
|
|
+ 2989 AND (SymTab.ClassOf(it) #
|
|
|
+ 2990 SymTab.ClBool) THEN
|
|
|
+ 2991 SemError(218);
|
|
|
+ 2992 t := SymTab.InvalidType
|
|
|
+ 2993 ELSE
|
|
|
+ 2994 eT := SymTab.ArrayElem(t);
|
|
|
+ 2995 t := eT; sfx := TRUE
|
|
|
+ 2996 END; .)
|
|
|
+ 2997 { "," Expr<it, iq>
|
|
|
+ 2998 (. AST.SetChild(astDes, AST.NChild(astDes),
|
|
|
+ 2999 AST.MakeUn(AST.NkSelector, AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
+ 3000 ELSIF SymTab.ClassOf(t) #
|
|
|
+ 3001 SymTab.ClArray THEN
|
|
|
+ 3002 SemError(217);
|
|
|
+ 3003 t := SymTab.InvalidType
|
|
|
+ 3004 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
3005 AND (SymTab.ClassOf(it) #
|
|
|
- 3006 SymTab.ClEnum)
|
|
|
+ 3006 SymTab.ClChar)
|
|
|
3007 AND (SymTab.ClassOf(it) #
|
|
|
- 3008 SymTab.ClBool) THEN
|
|
|
- 3009 SemError(218);
|
|
|
- 3010 t := SymTab.InvalidType
|
|
|
- 3011 ELSE
|
|
|
- 3012 eT := SymTab.ArrayElem(t);
|
|
|
- 3013 t := eT; sfx := TRUE
|
|
|
- 3014 END; .) }
|
|
|
- 3015 "]"
|
|
|
- 3016 | "." GetIdent<fn>
|
|
|
- 3017 (. astSel := AST.MakeNode(AST.NkSelector);
|
|
|
- 3018 AST.SetOp(astSel, AST.SelField);
|
|
|
- 3019 AST.SetChild(astSel, 0, AST.MakeLeaf(AST.NkIdent, fn));
|
|
|
- 3020 AST.SetChild(astDes, AST.NChild(astDes), astSel); IF k = SymTab.KindModule THEN
|
|
|
- 3021 (* qualified L.x: materialize
|
|
|
- 3022 the export, then load it *)
|
|
|
- 3023 IF NOT SymTab.MaterializeAlias(n,
|
|
|
- 3024 fn, mal) THEN
|
|
|
- 3025 SemError(201);
|
|
|
- 3026 t := SymTab.InvalidType;
|
|
|
- 3027 QbeGen.CopyOp("0", q)
|
|
|
- 3028 ELSE
|
|
|
- 3029 QbeGen.CopyOp(mal, qn);
|
|
|
- 3030 t := SymTab.SymType(mal);
|
|
|
- 3031 k := SymTab.SymKind(mal);
|
|
|
- 3032 sfx := FALSE;
|
|
|
- 3033 IF k = SymTab.KindProc THEN
|
|
|
- 3034 (* call: ArgList supplies
|
|
|
- 3035 the value *)
|
|
|
- 3036 QbeGen.CopyOp("0", q)
|
|
|
- 3037 ELSIF k = SymTab.KindConst THEN
|
|
|
- 3038 IF SymTab.GetSymVal(mal,
|
|
|
- 3039 cv)
|
|
|
- 3040 THEN QbeGen.CopyOp(cv, q)
|
|
|
- 3041 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 3042 END
|
|
|
- 3043 END
|
|
|
- 3044 END
|
|
|
- 3045 ELSIF t = SymTab.InvalidType THEN
|
|
|
- 3046 ELSIF (SymTab.ClassOf(t) #
|
|
|
- 3047 SymTab.ClRecord)
|
|
|
- 3048 AND (SymTab.ClassOf(t) #
|
|
|
- 3049 SymTab.ClClass) THEN
|
|
|
- 3050 SemError(215);
|
|
|
- 3051 t := SymTab.InvalidType
|
|
|
- 3052 ELSIF (SymTab.ClassOf(t) =
|
|
|
- 3053 SymTab.ClClass)
|
|
|
- 3054 AND SymTab.MethodExists(t, fn) THEN
|
|
|
- 3055 (* obj.Method: bind the
|
|
|
- 3056 method and pass obj as
|
|
|
- 3057 the hidden receiver; q
|
|
|
- 3058 already holds the
|
|
|
- 3059 object's address *)
|
|
|
- 3060 QbeGen.CopyOp(fn, n);
|
|
|
- 3061 QbeGen.CopyOp(fn, qn);
|
|
|
- 3062 methCls := t;
|
|
|
- 3063 k := SymTab.KindProc;
|
|
|
- 3064 t := SymTab.InvalidType
|
|
|
- 3065 ELSIF NOT SymTab.FieldExists(t,
|
|
|
- 3066 fn) THEN
|
|
|
- 3067 SemError(216);
|
|
|
- 3068 t := SymTab.InvalidType
|
|
|
- 3069 ELSE
|
|
|
- 3070 t := SymTab.FieldType(t, fn);
|
|
|
- 3071 sfx := TRUE
|
|
|
- 3072 END; .)
|
|
|
- 3073 | "^"
|
|
|
- 3074 (. astSel := AST.MakeNode(AST.NkSelector);
|
|
|
- 3075 AST.SetOp(astSel, AST.SelDeref);
|
|
|
- 3076 AST.SetChild(astDes, AST.NChild(astDes), astSel); IF t = SymTab.InvalidType THEN
|
|
|
- 3077 ELSIF SymTab.ClassOf(t) #
|
|
|
- 3078 SymTab.ClPtr THEN
|
|
|
- 3079 SemError(219);
|
|
|
- 3080 t := SymTab.InvalidType
|
|
|
- 3081 ELSE
|
|
|
- 3082 bt := SymTab.PtrBase(t);
|
|
|
- 3083 IF bt = SymTab.InvalidType THEN
|
|
|
- 3084 ELSE
|
|
|
- 3085 t := bt;
|
|
|
- 3086 sfx := TRUE
|
|
|
- 3087 END
|
|
|
- 3088 END; .) } (. astCur := astDes; .) .
|
|
|
- 3089 (* Result suffix (ISO component after a function call): `F()^`,
|
|
|
- 3090 `F()[i]`, `F().field`. The call result is in t/q with sfx FALSE
|
|
|
- 3091 (a value, or a descriptor address for aggregates); each component
|
|
|
- 3092 descends one level exactly like the Design components. *)
|
|
|
- 3093 ResultComp<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
|
|
|
- 3094 VAR sfx: BOOLEAN; VAR node: AST.Node;
|
|
|
- 3095 VAR mname: SymTab.Name; VAR methCls: SymTab.TypeIndex;
|
|
|
- 3096 VAR isM: BOOLEAN> (. VAR it, eT, bt: SymTab.TypeIndex;
|
|
|
- 3097 iq, ql, qlo, qhi, qe, qb:
|
|
|
- 3098 QbeGen.QVal;
|
|
|
- 3099 lo, hi, fo: INTEGER;
|
|
|
- 3100 isOpen: BOOLEAN;
|
|
|
- 3101 fname: SymTab.Name;
|
|
|
- 3102 astWrap, astSel: AST.Node; .)
|
|
|
- 3103 = "[" Expr<it, iq>
|
|
|
- 3104 (. isM := FALSE;
|
|
|
- 3105 IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
- 3106 astWrap := AST.MakeNode(
|
|
|
- 3107 AST.NkDesignator);
|
|
|
- 3108 AST.SetChild(astWrap, 0, node);
|
|
|
- 3109 node := astWrap
|
|
|
- 3110 END;
|
|
|
- 3111 AST.SetChild(node, AST.NChild(node),
|
|
|
- 3112 AST.MakeUn(AST.NkSelector,
|
|
|
- 3113 AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
- 3114 ELSIF SymTab.ClassOf(t) #
|
|
|
- 3115 SymTab.ClArray THEN
|
|
|
- 3116 SemError(217);
|
|
|
- 3117 t := SymTab.InvalidType
|
|
|
- 3118 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
- 3119 AND (SymTab.ClassOf(it) # SymTab.ClChar)
|
|
|
- 3120 AND (SymTab.ClassOf(it) # SymTab.ClEnum)
|
|
|
- 3121 AND (SymTab.ClassOf(it) # SymTab.ClBool) THEN
|
|
|
- 3122 SemError(218);
|
|
|
- 3123 t := SymTab.InvalidType
|
|
|
- 3124 ELSE
|
|
|
- 3125 eT := SymTab.ArrayElem(t);
|
|
|
- 3126 t := eT; sfx := TRUE
|
|
|
- 3127 END; .)
|
|
|
- 3128 "]"
|
|
|
- 3129 | "." GetIdent<fname>
|
|
|
- 3130 (. isM := FALSE;
|
|
|
- 3131 IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
- 3132 astWrap := AST.MakeNode(
|
|
|
- 3133 AST.NkDesignator);
|
|
|
- 3134 AST.SetChild(astWrap, 0, node);
|
|
|
- 3135 node := astWrap
|
|
|
- 3136 END;
|
|
|
- 3137 AST.SetChild(node, AST.NChild(node),
|
|
|
- 3138 AST.MakeUn(AST.NkSelector,
|
|
|
- 3139 AST.SelField,
|
|
|
- 3140 AST.MakeLeaf(AST.NkIdent,
|
|
|
- 3141 fname))); IF t = SymTab.InvalidType THEN
|
|
|
- 3142 ELSIF (SymTab.ClassOf(t) #
|
|
|
- 3143 SymTab.ClRecord)
|
|
|
- 3144 AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN
|
|
|
- 3145 SemError(215);
|
|
|
- 3146 t := SymTab.InvalidType
|
|
|
- 3147 ELSIF (SymTab.ClassOf(t) =
|
|
|
- 3148 SymTab.ClClass)
|
|
|
- 3149 AND SymTab.MethodExists(t, fname) THEN
|
|
|
- 3150 (* a method on the call result:
|
|
|
- 3151 a following ArgList makes
|
|
|
- 3152 the call *)
|
|
|
- 3153 mname := fname;
|
|
|
- 3154 methCls := t; isM := TRUE;
|
|
|
- 3155 t := SymTab.InvalidType
|
|
|
- 3156 ELSIF NOT SymTab.FieldExists(t,
|
|
|
- 3157 fname) THEN
|
|
|
- 3158 SemError(216);
|
|
|
- 3159 t := SymTab.InvalidType
|
|
|
- 3160 ELSE
|
|
|
- 3161 t := SymTab.FieldType(t, fname);
|
|
|
- 3162 sfx := TRUE
|
|
|
- 3163 END; .)
|
|
|
- 3164 | "^" (. isM := FALSE;
|
|
|
- 3165 IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
- 3166 astWrap := AST.MakeNode(
|
|
|
- 3167 AST.NkDesignator);
|
|
|
- 3168 AST.SetChild(astWrap, 0, node);
|
|
|
- 3169 node := astWrap
|
|
|
- 3170 END;
|
|
|
- 3171 astSel := AST.MakeNode(AST.NkSelector);
|
|
|
- 3172 AST.SetOp(astSel, AST.SelDeref);
|
|
|
- 3173 AST.SetChild(node,
|
|
|
- 3174 AST.NChild(node), astSel); IF t = SymTab.InvalidType THEN
|
|
|
- 3175 ELSIF SymTab.ClassOf(t) #
|
|
|
- 3176 SymTab.ClPtr THEN
|
|
|
- 3177 SemError(219);
|
|
|
- 3178 t := SymTab.InvalidType
|
|
|
- 3179 ELSE
|
|
|
- 3180 bt := SymTab.PtrBase(t);
|
|
|
- 3181 IF bt # SymTab.InvalidType THEN
|
|
|
- 3182 t := bt; sfx := TRUE
|
|
|
- 3183 END
|
|
|
- 3184 END; .) .
|
|
|
- 3185 Expr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 3186 (. VAR t2: SymTab.TypeIndex;
|
|
|
- 3187 op: INTEGER;
|
|
|
- 3188 q2, qt, wl: QbeGen.QVal;
|
|
|
- 3189 astA, astB: AST.Node;
|
|
|
- 3190 astOp: INTEGER;
|
|
|
- 3191 astMade: BOOLEAN;
|
|
|
- 3192 isR: BOOLEAN; .)
|
|
|
- 3193 = SimExpr<t, q> (. astA := astCur; astMade := FALSE; .)
|
|
|
- 3194 [ Rel<op> SimExpr<t2, q2>
|
|
|
- 3195 (. astB := astCur; astMade := TRUE;
|
|
|
- 3196 astOp := AST.OpEq;
|
|
|
- 3197 IF op = SymTab.OpNeq1 THEN astOp := AST.OpNe
|
|
|
- 3198 ELSIF op = SymTab.OpNeq2 THEN astOp := AST.OpNe
|
|
|
- 3199 ELSIF op = SymTab.OpLt THEN astOp := AST.OpLt
|
|
|
- 3200 ELSIF op = SymTab.OpLe THEN astOp := AST.OpLe
|
|
|
- 3201 ELSIF op = SymTab.OpGt THEN astOp := AST.OpGt
|
|
|
- 3202 ELSIF op = SymTab.OpGe THEN astOp := AST.OpGe
|
|
|
- 3203 ELSIF op = SymTab.OpIn THEN astOp := AST.OpIn
|
|
|
- 3204 END;
|
|
|
- 3205 IF op = SymTab.OpIn THEN
|
|
|
- 3206 IF SymTab.InCheck(t, t2) THEN
|
|
|
- 3207 IF (t = SymTab.InvalidType)
|
|
|
- 3208 OR (t2 = SymTab.InvalidType) THEN
|
|
|
- 3209 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
|
|
|
- 3210 ELSE
|
|
|
- 3211 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
- 3212 END
|
|
|
- 3213 ELSE SemError(222); t := SymTab.InvalidType;
|
|
|
- 3214 QbeGen.CopyOp("0", q)
|
|
|
- 3215 END
|
|
|
- 3216 ELSIF SymTab.RelCheck(t, t2, op) THEN
|
|
|
- 3217 IF (t = SymTab.InvalidType)
|
|
|
- 3218 OR (t2 = SymTab.InvalidType) THEN
|
|
|
- 3219 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
|
|
|
- 3220 ELSIF (SymTab.ClassOf(t) = SymTab.ClPtr)
|
|
|
- 3221 OR (SymTab.ClassOf(t2) = SymTab.ClPtr) THEN
|
|
|
- 3222 IF (op # SymTab.OpEq) AND (op # SymTab.OpNeq1)
|
|
|
- 3223 AND (op # SymTab.OpNeq2) THEN
|
|
|
- 3224 SemError(213); t := SymTab.InvalidType;
|
|
|
- 3225 QbeGen.CopyOp("0", q)
|
|
|
- 3226 ELSE
|
|
|
- 3227 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
- 3228 END
|
|
|
- 3229 ELSIF (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
- 3230 OR (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
- 3231 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
- 3232 ELSIF SymTab.StrCompat(t, t2) THEN
|
|
|
- 3233 QbeGen.StrEq(op, q, q2, qt);
|
|
|
- 3234 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
|
|
|
- 3235 ELSIF SymTab.IsLongFamily(t)
|
|
|
- 3236 OR SymTab.IsLongFamily(t2) THEN
|
|
|
- 3237 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
- 3238 ELSE
|
|
|
- 3239 t := SymTab.BoolType();
|
|
|
- 3240 QbeGen.CopyOp("@", q)
|
|
|
- 3241 END
|
|
|
- 3242 ELSE SemError(213); t := SymTab.InvalidType;
|
|
|
- 3243 QbeGen.CopyOp("0", q)
|
|
|
- 3244 END;
|
|
|
- 3245 astCur := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB); .) ]
|
|
|
- 3246 (. IF NOT astMade THEN astCur := astA END; .)
|
|
|
- 3247 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
- 3248 Rel<VAR op: INTEGER>
|
|
|
- 3249 = "=" (. op := SymTab.OpEq; .)
|
|
|
- 3250 | "#" (. op := SymTab.OpNeq1; .)
|
|
|
- 3251 | "<" (. op := SymTab.OpLt; .)
|
|
|
- 3252 | "<=" (. op := SymTab.OpLe; .)
|
|
|
- 3253 | ">" (. op := SymTab.OpGt; .)
|
|
|
- 3254 | ">=" (. op := SymTab.OpGe; .)
|
|
|
- 3255 | "IN" (. op := SymTab.OpIn; .) .
|
|
|
- 3256 SimExpr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 3257 (. VAR t2, res2, lt, rt:
|
|
|
- 3258 SymTab.TypeIndex;
|
|
|
- 3259 op: INTEGER;
|
|
|
- 3260 q2, qt, wq, qf, q2a, q2b:
|
|
|
- 3261 QbeGen.QVal;
|
|
|
- 3262 neg, isR, isL, folded:
|
|
|
- 3263 BOOLEAN;
|
|
|
- 3264 fok: BOOLEAN;
|
|
|
- 3265 lw, rw, mw: CARDINAL;
|
|
|
- 3266 lTrue, lNext, lDone, qr, qs: QbeGen.QVal;
|
|
|
- 3267 astA, astB: AST.Node;
|
|
|
- 3268 astSign, astOp: INTEGER; .)
|
|
|
- 3269 = (. neg := FALSE; astSign := 0; .)
|
|
|
- 3270 [ "+" (. neg := TRUE; astSign := 1; .)
|
|
|
- 3271 | "-" (. neg := TRUE; astSign := -1; .) ]
|
|
|
- 3272 Term<t, q> (. astA := astCur;
|
|
|
- 3273 IF neg AND QbeGen.IsImm(q) THEN
|
|
|
- 3274 QbeGen.NegFold(q, q)
|
|
|
- 3275 END;
|
|
|
- 3276 IF astSign < 0 THEN
|
|
|
- 3277 astCur := AST.MakeUn(
|
|
|
- 3278 AST.NkUnary, AST.OpSub, astA);
|
|
|
- 3279 astA := astCur
|
|
|
- 3280 END; .)
|
|
|
- 3281 { AddOp<op>
|
|
|
- 3282 Term<t2, q2> (. astB := astCur; .)
|
|
|
- 3283 (. astOp := AST.OpAdd;
|
|
|
- 3284 IF op = SymTab.OpSub THEN astOp := AST.OpSub
|
|
|
- 3285 ELSIF op = SymTab.OpOr THEN astOp := AST.OpOr END;
|
|
|
- 3286 astA := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB);
|
|
|
- 3287 astCur := astA;
|
|
|
- 3288 IF op = SymTab.OpOr THEN
|
|
|
- 3289 (* short-circuit: if q is true the RHS is skipped *)
|
|
|
- 3290 IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
|
|
|
- 3291 t := SymTab.BoolType()
|
|
|
- 3292 ELSE SemError(212); t := SymTab.InvalidType END;
|
|
|
- 3293 IF t # SymTab.InvalidType THEN
|
|
|
- 3294 QbeGen.CopyOp("@", q)
|
|
|
- 3295 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 3296 END
|
|
|
- 3297 ELSIF (op = SymTab.OpAdd)
|
|
|
- 3298 AND (SymTab.UStrCompat(t, t2)
|
|
|
- 3299 OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
|
|
|
- 3300 AND (SymTab.ClassOf(t2) = SymTab.ClUStr))
|
|
|
- 3301 OR ((SymTab.ClassOf(t) = SymTab.ClUStr)
|
|
|
- 3302 AND (SymTab.ClassOf(t2) = SymTab.ClUChar))
|
|
|
- 3303 OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
|
|
|
- 3304 AND (SymTab.ClassOf(t2) = SymTab.ClUChar))) THEN
|
|
|
- 3305 (* UString concatenation: a UCHAR operand becomes a
|
|
|
- 3306 1-codepoint UString; the result is a descriptor in the
|
|
|
- 3307 shim's concat buffer. Work on copies so neither
|
|
|
- 3308 operand is clobbered. *)
|
|
|
- 3309 t := SymTab.NewUStr();
|
|
|
- 3310 QbeGen.CopyOp("@", q)
|
|
|
- 3311 ELSIF (op = SymTab.OpAdd)
|
|
|
- 3312 AND (SymTab.StrCompat(t, t2)
|
|
|
- 3313 OR (SymTab.IsStrType(t)
|
|
|
- 3314 AND (SymTab.ClassOf(t2) = SymTab.ClChar))
|
|
|
- 3315 OR ((SymTab.ClassOf(t) = SymTab.ClChar)
|
|
|
- 3316 AND SymTab.IsStrType(t2))) THEN
|
|
|
- 3317 (* string concatenation; a CHAR operand becomes a
|
|
|
- 3318 1-character string literal. When both operands are
|
|
|
- 3319 constants, fold to a single string literal so a
|
|
|
- 3320 constructor element stays compile-time. *)
|
|
|
- 3321 QbeGen.StrFold(q, q2, SymTab.ClassOf(t), SymTab.ClassOf(t2),
|
|
|
- 3322 qt, fok);
|
|
|
- 3323 IF fok THEN QbeGen.CopyOp(qt, q)
|
|
|
- 3324 ELSE QbeGen.CopyOp("@", q)
|
|
|
- 3325 END;
|
|
|
- 3326 t := SymTab.NewStr()
|
|
|
- 3327 ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
|
|
|
- 3328 AND (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
- 3329 AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
- 3330 lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
|
|
|
- 3331 mw := lw;
|
|
|
- 3332 IF rw > mw THEN mw := rw END;
|
|
|
- 3333 t := SymTab.NewSet(
|
|
|
- 3334 SymTab.NewSubR(0,
|
|
|
- 3335 VAL(INTEGER, mw) * 32 - 1));
|
|
|
- 3336 QbeGen.CopyOp("@", q)
|
|
|
- 3337 ELSE
|
|
|
- 3338 IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN
|
|
|
- 3339 lt := t; rt := t2; t := res2
|
|
|
- 3340 ELSE SemError(211); t := SymTab.InvalidType END;
|
|
|
- 3341 IF t # SymTab.InvalidType THEN
|
|
|
- 3342 isL := SymTab.IsLongFamily(t);
|
|
|
- 3343 isR := SymTab.ClassOf(t) = SymTab.ClReal;
|
|
|
- 3344 folded := FALSE;
|
|
|
- 3345 IF (NOT isL) AND (NOT isR)
|
|
|
- 3346 AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
|
|
|
- 3347 IF op = SymTab.OpAdd THEN
|
|
|
- 3348 folded := QbeGen.Fold2(0, q, q2, qf)
|
|
|
- 3349 ELSE
|
|
|
- 3350 folded := QbeGen.Fold2(1, q, q2, qf)
|
|
|
- 3351 END
|
|
|
- 3352 END;
|
|
|
- 3353 IF folded THEN QbeGen.CopyOp(qf, q)
|
|
|
- 3354 ELSE
|
|
|
- 3355 QbeGen.CopyOp("@", q)
|
|
|
- 3356 END
|
|
|
- 3357 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 3358 END
|
|
|
- 3359 END; .) }
|
|
|
- 3360 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
- 3361 AddOp<VAR op: INTEGER>
|
|
|
- 3362 = "+" (. op := SymTab.OpAdd; .)
|
|
|
- 3363 | "-" (. op := SymTab.OpSub; .)
|
|
|
- 3364 | "OR" (. op := SymTab.OpOr; .) .
|
|
|
- 3365 Term<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 3366 (. VAR t2, res2, lt, rt:
|
|
|
- 3367 SymTab.TypeIndex;
|
|
|
- 3368 op: INTEGER;
|
|
|
- 3369 q2, qt, wq, qf:
|
|
|
- 3370 QbeGen.QVal;
|
|
|
- 3371 isR, isL, folded: BOOLEAN;
|
|
|
- 3372 lw, rw, mw: CARDINAL;
|
|
|
- 3373 lNext, lFalse, lDone, qr, qs: QbeGen.QVal;
|
|
|
- 3374 astA, astB: AST.Node;
|
|
|
- 3375 astOp: INTEGER; .)
|
|
|
- 3376 = Fact<t, q> (. astA := astCur; .) { MulOp<op>
|
|
|
- 3377 Fact<t2, q2> (. astB := astCur; .)
|
|
|
- 3378 (. astOp := AST.OpMul;
|
|
|
- 3379 IF op = SymTab.OpSlash THEN astOp := AST.OpDiv
|
|
|
- 3380 ELSIF op = SymTab.OpDiv THEN astOp := AST.OpDiv
|
|
|
- 3381 ELSIF op = SymTab.OpMod THEN astOp := AST.OpMod
|
|
|
- 3382 ELSIF op = SymTab.OpAnd THEN astOp := AST.OpAnd END;
|
|
|
- 3383 astA := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB);
|
|
|
- 3384 astCur := astA;
|
|
|
- 3385 IF op = SymTab.OpAnd THEN
|
|
|
- 3386 (* short-circuit: if q is false the RHS is skipped *)
|
|
|
- 3387 IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
|
|
|
- 3388 t := SymTab.BoolType()
|
|
|
- 3389 ELSE SemError(212); t := SymTab.InvalidType END;
|
|
|
- 3390 IF t # SymTab.InvalidType THEN QbeGen.CopyOp("@", q)
|
|
|
- 3391 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 3392 END
|
|
|
- 3393 ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
|
|
|
- 3394 AND (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
- 3395 AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
- 3396 lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
|
|
|
- 3397 mw := lw;
|
|
|
- 3398 IF rw > mw THEN mw := rw END;
|
|
|
- 3399 t := SymTab.NewSet(
|
|
|
- 3400 SymTab.NewSubR(0,
|
|
|
- 3401 VAL(INTEGER, mw) * 32 - 1));
|
|
|
- 3402 QbeGen.CopyOp("@", q)
|
|
|
- 3403 ELSE
|
|
|
- 3404 IF SymTab.ArithCheck(t, t2,
|
|
|
- 3405 (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
|
|
|
- 3406 res2) THEN
|
|
|
- 3407 lt := t; rt := t2; t := res2
|
|
|
- 3408 ELSE SemError(211); t := SymTab.InvalidType END;
|
|
|
- 3409 IF t # SymTab.InvalidType THEN
|
|
|
- 3410 isL := SymTab.IsLongFamily(t);
|
|
|
- 3411 isR := SymTab.ClassOf(t) = SymTab.ClReal;
|
|
|
- 3412 folded := FALSE;
|
|
|
- 3413 IF (NOT isL) AND (NOT isR)
|
|
|
- 3414 AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
|
|
|
- 3415 IF op = SymTab.OpTimes THEN
|
|
|
- 3416 folded := QbeGen.Fold2(2, q, q2, qf)
|
|
|
- 3417 ELSIF op = SymTab.OpDiv THEN
|
|
|
- 3418 folded := QbeGen.Fold2(3, q, q2, qf)
|
|
|
- 3419 ELSIF op = SymTab.OpMod THEN
|
|
|
- 3420 folded := QbeGen.Fold2(4, q, q2, qf)
|
|
|
- 3421 END
|
|
|
- 3422 END;
|
|
|
- 3423 IF folded THEN QbeGen.CopyOp(qf, q)
|
|
|
- 3424 ELSE
|
|
|
- 3425 QbeGen.CopyOp("@", q)
|
|
|
- 3426 END
|
|
|
- 3427 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 3428 END
|
|
|
- 3429 END; .) }
|
|
|
- 3430 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
- 3431 MulOp<VAR op: INTEGER>
|
|
|
- 3432 = "*" (. op := SymTab.OpTimes; .)
|
|
|
- 3433 | "/" (. op := SymTab.OpSlash; .)
|
|
|
- 3434 | "DIV" (. op := SymTab.OpDiv; .)
|
|
|
- 3435 | "MOD" (. op := SymTab.OpMod; .)
|
|
|
- 3436 | ( "AND" | "&" ) (. op := SymTab.OpAnd; .) .
|
|
|
- 3437 Fact<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 3438 (. VAR s: ARRAY [0 .. 255] OF CHAR;
|
|
|
- 3439 et, dt, t2, st, ct2, et2:
|
|
|
- 3440 SymTab.TypeIndex;
|
|
|
- 3441 dk: INTEGER;
|
|
|
- 3442 qd, q2, sq, qa, qm0, qr, qt:
|
|
|
- 3443 QbeGen.QVal;
|
|
|
- 3444 qn, vn: SymTab.Name;
|
|
|
- 3445 vt: SymTab.TypeIndex;
|
|
|
- 3446 c1, c2: INTEGER;
|
|
|
- 3447 lo, hi: INTEGER;
|
|
|
- 3448 isMax: BOOLEAN;
|
|
|
- 3449 called, isHigh, sfx, isCh,
|
|
|
- 3450 isU, uok, isStr: BOOLEAN;
|
|
|
- 3451 ucp: INTEGER; astIsLit: BOOLEAN;
|
|
|
- 3452 astD: AST.Node;
|
|
|
- 3453 astCall: BOOLEAN;
|
|
|
- 3454 astNode, astNot: AST.Node;
|
|
|
- 3455 j: CARDINAL;
|
|
|
- 3456 astArg2: AST.Node;
|
|
|
- 3457 astBrace: AST.Node;
|
|
|
- 3458 astRes: AST.Node; mname: SymTab.Name; isM: BOOLEAN;
|
|
|
- 3459 isConvF: BOOLEAN;
|
|
|
- 3460 fi, fj: CARDINAL; .)
|
|
|
- 3461 = (. astIsLit := FALSE; .)
|
|
|
- 3462 ( "__LINE__" (. QbeGen.IntStr(M2S.line, q);
|
|
|
- 3463 astIsLit := TRUE;
|
|
|
- 3464 astCur := AST.MakeLeaf(
|
|
|
- 3465 AST.NkIntLit, q);
|
|
|
- 3466 t := SymTab.IntType(); .)
|
|
|
- 3467 | "__FILE__" (. (* fold to the quoted file name *)
|
|
|
- 3468 s[0] := '"'; fi := 1; fj := 0;
|
|
|
- 3469 WHILE (M2S.fileName[fj] # CHR(0))
|
|
|
- 3470 AND (fi < HIGH(s)) DO
|
|
|
- 3471 s[fi] := M2S.fileName[fj];
|
|
|
- 3472 INC(fi); INC(fj)
|
|
|
- 3473 END;
|
|
|
- 3474 s[fi] := '"';
|
|
|
- 3475 s[fi + 1] := CHR(0);
|
|
|
- 3476 astIsLit := TRUE;
|
|
|
- 3477 astCur := AST.MakeLeaf(
|
|
|
- 3478 AST.NkStrLit, s);
|
|
|
- 3479 t := SymTab.NewStr();
|
|
|
- 3480 QbeGen.DeclStr(s, q); .)
|
|
|
- 3481 | integer (. LexString(s);
|
|
|
- 3482 QbeGen.NormInt(s, q); astIsLit := TRUE; astCur := AST.MakeLeaf(AST.NkIntLit, s);
|
|
|
- 3483 t := SymTab.IntType(); .)
|
|
|
- 3484 | charConst (. LexString(s);
|
|
|
- 3485 QbeGen.NormLit(s, q, isCh);
|
|
|
- 3486 astIsLit := TRUE;
|
|
|
- 3487 astCur := AST.MakeLeaf(
|
|
|
- 3488 AST.NkCharLit, s);
|
|
|
- 3489 t := SymTab.CharType(); .)
|
|
|
- 3490 | real (. LexString(s);
|
|
|
- 3491 QbeGen.NormReal(s, q);
|
|
|
- 3492 astIsLit := TRUE;
|
|
|
- 3493 astCur := AST.MakeLeaf(
|
|
|
- 3494 AST.NkRealLit, s);
|
|
|
- 3495 t := SymTab.RealType(); .)
|
|
|
- 3496 | string (. LexString(s);
|
|
|
- 3497 astIsLit := TRUE;
|
|
|
- 3498 astCur := AST.MakeLeaf(
|
|
|
- 3499 AST.NkStrLit, s);
|
|
|
- 3500 IF SymTab.StrLen(s) = 3 THEN
|
|
|
- 3501 t := SymTab.CharType();
|
|
|
- 3502 QbeGen.IntStr(
|
|
|
- 3503 QbeGen.CharVal(s), q)
|
|
|
- 3504 ELSIF SymTab.StrLen(s) = 2 THEN
|
|
|
- 3505 (* empty string: a string value
|
|
|
- 3506 for arrays, 0 for CHAR *)
|
|
|
- 3507 t := SymTab.NewEmptyStr();
|
|
|
- 3508 QbeGen.DeclStr(s, q)
|
|
|
- 3509 ELSE t := SymTab.NewStr();
|
|
|
- 3510 QbeGen.DeclStr(s, q);
|
|
|
- 3511 (* a literal's value IS its
|
|
|
- 3512 static descriptor address *)
|
|
|
- 3513 END; .)
|
|
|
- 3514 | ustring (. LexString(s);
|
|
|
- 3515 astIsLit := TRUE;
|
|
|
- 3516 astCur := AST.MakeLeaf(
|
|
|
- 3517 AST.NkStrLit, s);
|
|
|
- 3518 QbeGen.DeclUStr(s, q, isU, ucp,
|
|
|
- 3519 uok);
|
|
|
- 3520 IF NOT uok THEN
|
|
|
- 3521 SemError(234);
|
|
|
- 3522 t := SymTab.InvalidType
|
|
|
- 3523 ELSIF isU THEN
|
|
|
- 3524 t := SymTab.UCharType();
|
|
|
- 3525 QbeGen.IntStr(ucp, q)
|
|
|
- 3526 ELSE
|
|
|
- 3527 t := SymTab.NewUStr();
|
|
|
- 3528 END; .)
|
|
|
- 3529 | Design<dt, dk, qd, qn, sfx> (. astD := astCur; astCall := FALSE; astBrace := AST.NoNode;
|
|
|
- 3530 astNArgs := 0; called := FALSE;
|
|
|
- 3531 t := dt;
|
|
|
- 3532 IF dk = SymTab.KindConst THEN
|
|
|
- 3533 QbeGen.CopyOp(qd, q)
|
|
|
- 3534 ELSE QbeGen.CopyOp("@", q)
|
|
|
- 3535 END; .)
|
|
|
- 3536 [ TypedBraceLit<dt, q> (. t := dt; astCall := TRUE;
|
|
|
- 3537 astBrace := astCur; .) ]
|
|
|
- 3538 [ ArgList<qn, dt, qd, TRUE, FALSE, methCls, ct2, q2, called>
|
|
|
- 3539 (. astCall := TRUE;
|
|
|
- 3540 IF (SymTab.SymKind(qn) = SymTab.KindType)
|
|
|
- 3541 OR (SymTab.SymKind(qn) = SymTab.KindPredef) THEN
|
|
|
- 3542 (* T(x): emit as the VAL builtin so Lower's
|
|
|
- 3543 conversion rules apply unchanged *)
|
|
|
- 3544 astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3545 AST.SetChild(astNode, 0,
|
|
|
- 3546 AST.MakeLeaf(AST.NkIdent, "VAL"));
|
|
|
- 3547 AST.SetChild(astNode, 1,
|
|
|
- 3548 AST.MakeLeaf(AST.NkIdent, qn));
|
|
|
- 3549 IF astNArgs = 1 THEN
|
|
|
- 3550 AST.SetChild(astNode, 2, astArgs[0])
|
|
|
- 3551 END;
|
|
|
- 3552 isConvF := TRUE
|
|
|
- 3553 ELSE astNode := AstCallNode(astD)
|
|
|
- 3554 END;
|
|
|
- 3555 astRes := astNode;
|
|
|
- 3556 t := ct2;
|
|
|
- 3557 QbeGen.CopyOp(q2, q);
|
|
|
- 3558 IF isConvF AND QbeGen.IsImm(convQ)
|
|
|
- 3559 AND OrdClass(convT) AND OrdClass(ct2) THEN
|
|
|
- 3560 QbeGen.CopyOp(convQ, q)
|
|
|
- 3561 END;
|
|
|
- 3562 sfx := FALSE; .)
|
|
|
- 3563 { ResultComp<t, q, sfx, astRes, mname, methCls, isM>
|
|
|
- 3564 [ (. astNArgs := 0; .)
|
|
|
- 3565 ArgList<mname, t, q, TRUE, FALSE, methCls, ct2, q2, called>
|
|
|
- 3566 (. astNode := AstCallNode(astRes);
|
|
|
- 3567 astRes := astNode;
|
|
|
- 3568 t := ct2;
|
|
|
- 3569 QbeGen.CopyOp(q2, q);
|
|
|
- 3570 sfx := FALSE; .) ] }
|
|
|
- 3571 (. IF sfx THEN
|
|
|
- 3572 IF t = SymTab.InvalidType THEN
|
|
|
- 3573 QbeGen.CopyOp("0", q)
|
|
|
- 3574 ELSIF (SymTab.ClassOf(t) #
|
|
|
- 3575 SymTab.ClRecord)
|
|
|
- 3576 AND (SymTab.ClassOf(t) # SymTab.ClSet)
|
|
|
- 3577 AND (SymTab.ClassOf(t) # SymTab.ClArray)
|
|
|
- 3578 AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN
|
|
|
- 3579 QbeGen.CopyOp("@", q)
|
|
|
- 3580 END
|
|
|
- 3581 END; .) ]
|
|
|
- 3582 (. IF called THEN
|
|
|
- 3583 astCur := astRes
|
|
|
- 3584 ELSIF astCall THEN
|
|
|
- 3585 astCur := astBrace
|
|
|
- 3586 ELSE astCur := astD
|
|
|
- 3587 END;
|
|
|
- 3588 astIsLit := TRUE;
|
|
|
- 3589 IF NOT called
|
|
|
- 3590 AND (dk = SymTab.KindProc) THEN
|
|
|
- 3591 (* bare zero-arg function
|
|
|
- 3592 call (parentheses may be
|
|
|
- 3593 omitted); a proper or
|
|
|
- 3594 parameterised proc here
|
|
|
- 3595 is 230 *)
|
|
|
- 3596 IF (SymTab.ProcNPar(qn) = 0)
|
|
|
- 3597 AND (SymTab.ProcRes(qn) # SymTab.InvalidType) THEN
|
|
|
- 3598 t := SymTab.ProcRes(qn);
|
|
|
- 3599 QbeGen.CopyOp("@", q);
|
|
|
- 3600 astCur := AST.MakeNode(AST.NkCall);
|
|
|
- 3601 AST.SetChild(astCur, 0, astD)
|
|
|
- 3602 ELSE
|
|
|
- 3603 t := SymTab.ProcTypeOf(qn);
|
|
|
- 3604 QbeGen.CopyOp("@", q)
|
|
|
- 3605 END
|
|
|
- 3606 END; .)
|
|
|
- 3607 | ( "HIGH" (. isHigh := TRUE; .)
|
|
|
- 3608 | ( "LEN" | "LENGTH" ) (. isHigh := FALSE; .) )
|
|
|
- 3609 "(" ( Design<dt, dk, qd, qn, sfx> (. isStr := FALSE;
|
|
|
- 3610 isU := FALSE; .)
|
|
|
- 3611 | string (. LexString(s); astCur := AST.MakeLeaf(AST.NkStrLit, s);
|
|
|
- 3612 isStr := TRUE;
|
|
|
- 3613 isU := FALSE;
|
|
|
- 3614 IF SymTab.StrLen(s) = 3 THEN
|
|
|
- 3615 dt := SymTab.CharType();
|
|
|
- 3616 QbeGen.IntStr(QbeGen.CharVal(s),
|
|
|
- 3617 qd)
|
|
|
- 3618 ELSE
|
|
|
- 3619 dt := SymTab.NewStr();
|
|
|
- 3620 QbeGen.DeclStr(s, qd);
|
|
|
- 3621 END;
|
|
|
- 3622 dk := -1;
|
|
|
- 3623 qn[0] := CHR(0); .)
|
|
|
- 3624 | ustring (. LexString(s); astCur := AST.MakeLeaf(AST.NkStrLit, s);
|
|
|
- 3625 QbeGen.DeclUStr(s, qd, isU, ucp,
|
|
|
- 3626 uok);
|
|
|
- 3627 isStr := FALSE;
|
|
|
- 3628 IF NOT uok THEN
|
|
|
- 3629 SemError(234);
|
|
|
- 3630 dt := SymTab.InvalidType
|
|
|
- 3631 ELSIF isU THEN
|
|
|
- 3632 (* one codepoint: a UCHAR;
|
|
|
- 3633 LEN is 1, HIGH is 0 *)
|
|
|
- 3634 dt := SymTab.UCharType();
|
|
|
- 3635 QbeGen.IntStr(ucp, qd)
|
|
|
- 3636 ELSE
|
|
|
- 3637 dt := SymTab.NewUStr();
|
|
|
- 3638 END;
|
|
|
- 3639 dk := -1;
|
|
|
- 3640 qn[0] := CHR(0); .) )
|
|
|
- 3641 ")"
|
|
|
- 3642 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3643 IF isHigh THEN AST.SetChild(astNode, 0,
|
|
|
- 3644 AST.MakeLeaf(AST.NkIdent, "HIGH"))
|
|
|
- 3645 ELSE AST.SetChild(astNode, 0,
|
|
|
- 3646 AST.MakeLeaf(AST.NkIdent, "LEN")) END;
|
|
|
- 3647 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3648 astCur := astNode; astIsLit := TRUE;
|
|
|
- 3649 IF (dt # SymTab.InvalidType)
|
|
|
- 3650 AND (SymTab.ClassOf(dt) = SymTab.ClUStr) THEN
|
|
|
- 3651 (* UString: the count is
|
|
|
- 3652 the descriptor header *)
|
|
|
- 3653 t := SymTab.IntType();
|
|
|
- 3654 QbeGen.CopyOp("@", q)
|
|
|
- 3655 ELSIF (dt # SymTab.InvalidType)
|
|
|
- 3656 AND (SymTab.ClassOf(dt) = SymTab.ClUChar) THEN
|
|
|
- 3657 (* single UCHAR codepoint *)
|
|
|
- 3658 IF isHigh THEN
|
|
|
- 3659 QbeGen.CopyOp("0", qr)
|
|
|
- 3660 ELSE
|
|
|
- 3661 QbeGen.CopyOp("1", qr)
|
|
|
- 3662 END;
|
|
|
- 3663 t := SymTab.IntType();
|
|
|
- 3664 QbeGen.CopyOp(qr, q)
|
|
|
- 3665 ELSIF isStr THEN
|
|
|
- 3666 (* fold: content length at
|
|
|
- 3667 compile time *)
|
|
|
- 3668 IF SymTab.StrLen(s) = 3 THEN
|
|
|
- 3669 c1 := 1
|
|
|
- 3670 ELSE
|
|
|
- 3671 c1 :=
|
|
|
- 3672 SymTab.StrLen(s) - 2
|
|
|
- 3673 END;
|
|
|
- 3674 IF isHigh THEN
|
|
|
- 3675 DEC(c1)
|
|
|
- 3676 END;
|
|
|
- 3677 QbeGen.IntStr(c1, qr);
|
|
|
- 3678 t := SymTab.IntType();
|
|
|
- 3679 QbeGen.CopyOp(qr, q)
|
|
|
- 3680 ELSIF dt = SymTab.InvalidType THEN
|
|
|
- 3681 t := SymTab.InvalidType;
|
|
|
- 3682 QbeGen.CopyOp("0", q)
|
|
|
- 3683 ELSIF SymTab.ClassOf(dt) #
|
|
|
- 3684 SymTab.ClArray THEN
|
|
|
- 3685 SemError(217);
|
|
|
- 3686 t := SymTab.InvalidType;
|
|
|
- 3687 QbeGen.CopyOp("0", q)
|
|
|
- 3688 ELSE
|
|
|
- 3689 IF SymTab.IsOpenArray(dt) THEN
|
|
|
- 3690 t := SymTab.IntType();
|
|
|
- 3691 QbeGen.CopyOp("@", q)
|
|
|
- 3692 ELSE
|
|
|
- 3693 IF isHigh THEN
|
|
|
- 3694 QbeGen.IntStr(
|
|
|
- 3695 SymTab.ArrayHi(dt), qr)
|
|
|
- 3696 ELSE
|
|
|
- 3697 QbeGen.IntStr(VAL(
|
|
|
- 3698 INTEGER,
|
|
|
- 3699 SymTab.ArrayLen(dt)),
|
|
|
- 3700 qr)
|
|
|
- 3701 END;
|
|
|
- 3702 t := SymTab.IntType();
|
|
|
- 3703 QbeGen.CopyOp(qr, q)
|
|
|
- 3704 END
|
|
|
- 3705 END; .)
|
|
|
- 3706 | ( "SIZE" | "TSIZE" ) "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
- 3707 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3708 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "SIZE"));
|
|
|
- 3709 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3710 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3711 (. IF dt = SymTab.InvalidType THEN
|
|
|
- 3712 t := SymTab.InvalidType;
|
|
|
- 3713 QbeGen.CopyOp("0", q)
|
|
|
- 3714 ELSE
|
|
|
- 3715 QbeGen.IntStr(VAL(INTEGER,
|
|
|
- 3716 SymTab.ObjectSize(dt)), q);
|
|
|
- 3717 t := SymTab.IntType()
|
|
|
- 3718 END; .)
|
|
|
- 3719 | ( "SHIFT" (. isMax := FALSE; .)
|
|
|
- 3720 | "ROTATE" (. isMax := TRUE; .) )
|
|
|
- 3721 "(" Expr<et, q> (. astArg2 := astCur; .) "," Expr<et2, q2> ")"
|
|
|
- 3722 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3723 IF isMax THEN AST.SetChild(astNode, 0,
|
|
|
- 3724 AST.MakeLeaf(AST.NkIdent, "ROTATE"))
|
|
|
- 3725 ELSE AST.SetChild(astNode, 0,
|
|
|
- 3726 AST.MakeLeaf(AST.NkIdent, "SHIFT")) END;
|
|
|
- 3727 IF astArg2 # AST.NoNode THEN AST.SetChild(astNode, 1, astArg2) END;
|
|
|
- 3728 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
- 3729 astCur := astNode; astIsLit := TRUE;
|
|
|
- 3730 (* set shift/rotate: isMax
|
|
|
- 3731 doubles as "rotate" *)
|
|
|
- 3732 IF (et # SymTab.InvalidType)
|
|
|
- 3733 AND (SymTab.ClassOf(et) =
|
|
|
- 3734 SymTab.ClSet) THEN
|
|
|
- 3735 t := et;
|
|
|
- 3736 QbeGen.CopyOp("@", q)
|
|
|
- 3737 ELSE SemError(230);
|
|
|
- 3738 t := SymTab.InvalidType;
|
|
|
- 3739 QbeGen.CopyOp("0", q)
|
|
|
- 3740 END; .)
|
|
|
- 3741 | ( "MIN" (. isMax := FALSE; .)
|
|
|
- 3742 | "MAX" (. isMax := TRUE; .) )
|
|
|
- 3743 "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
- 3744 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3745 IF isMax THEN AST.SetChild(astNode, 0,
|
|
|
- 3746 AST.MakeLeaf(AST.NkIdent, "MAX"))
|
|
|
- 3747 ELSE AST.SetChild(astNode, 0,
|
|
|
- 3748 AST.MakeLeaf(AST.NkIdent, "MIN")) END;
|
|
|
- 3749 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3750 astCur := astNode; astIsLit := TRUE;
|
|
|
- 3751 IF (dt # SymTab.InvalidType)
|
|
|
- 3752 AND (SymTab.ClassOf(dt) = SymTab.ClReal) THEN
|
|
|
- 3753 (* REAL/LONGREAL: the
|
|
|
- 3754 implementation bounds *)
|
|
|
- 3755 IF isMax THEN
|
|
|
- 3756 QbeGen.NormReal(
|
|
|
- 3757 "3.402823e38", q)
|
|
|
- 3758 ELSE QbeGen.NormReal(
|
|
|
- 3759 "-3.402823e38", q)
|
|
|
- 3760 END;
|
|
|
- 3761 t := SymTab.RealType()
|
|
|
- 3762 ELSIF (dt #
|
|
|
- 3763 SymTab.InvalidType)
|
|
|
- 3764 AND (SymTab.ClassOf(dt) =
|
|
|
- 3765 SymTab.ClLong) THEN
|
|
|
- 3766 IF isMax THEN
|
|
|
- 3767 QbeGen.CopyOp(
|
|
|
- 3768 "9223372036854775807", q)
|
|
|
- 3769 ELSE QbeGen.CopyOp(
|
|
|
- 3770 "-9223372036854775808", q)
|
|
|
- 3771 END;
|
|
|
- 3772 t := SymTab.LongType()
|
|
|
- 3773 ELSIF SymTab.TypeBounds(dt, lo,
|
|
|
- 3774 hi) THEN
|
|
|
- 3775 IF isMax THEN
|
|
|
- 3776 QbeGen.IntStr(hi, q)
|
|
|
- 3777 ELSE QbeGen.IntStr(lo, q)
|
|
|
- 3778 END;
|
|
|
- 3779 (* a set's bounds are those
|
|
|
- 3780 of its base type *)
|
|
|
- 3781 IF SymTab.ClassOf(dt) =
|
|
|
- 3782 SymTab.ClSet THEN
|
|
|
- 3783 t := SymTab.SetBase(dt)
|
|
|
- 3784 ELSE t := SymTab.IntType()
|
|
|
- 3785 END
|
|
|
- 3786 ELSE SemError(230);
|
|
|
- 3787 t := SymTab.InvalidType;
|
|
|
- 3788 QbeGen.CopyOp("0", q)
|
|
|
- 3789 END; .)
|
|
|
- 3790 | "ADR" "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
- 3791 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3792 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ADR"));
|
|
|
- 3793 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3794 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3795 (. IF dt = SymTab.InvalidType THEN
|
|
|
- 3796 t := SymTab.InvalidType;
|
|
|
- 3797 QbeGen.CopyOp("0", q)
|
|
|
- 3798 ELSE
|
|
|
- 3799 IF sfx
|
|
|
- 3800 OR (dk = SymTab.KindVar)
|
|
|
- 3801 OR (dk = SymTab.KindParam) THEN
|
|
|
- 3802 QbeGen.CopyOp("@", q)
|
|
|
- 3803 ELSE SemError(230);
|
|
|
- 3804 QbeGen.CopyOp("0", q)
|
|
|
- 3805 END;
|
|
|
- 3806 t := SymTab.AddrType()
|
|
|
- 3807 END; .)
|
|
|
- 3808 | "CHR" "(" Expr<et, q> ")"
|
|
|
- 3809 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3810 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CHR"));
|
|
|
- 3811 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3812 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3813 (. IF (et # SymTab.InvalidType)
|
|
|
- 3814 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
- 3815 SemError(211) END;
|
|
|
- 3816 t := SymTab.CharType(); .)
|
|
|
- 3817 | "ORD" "(" Expr<et, q> ")"
|
|
|
- 3818 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3819 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ORD"));
|
|
|
- 3820 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3821 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3822 (. IF et # SymTab.InvalidType THEN
|
|
|
- 3823 IF (SymTab.ClassOf(et) #
|
|
|
- 3824 SymTab.ClChar)
|
|
|
- 3825 AND (SymTab.ClassOf(et) #
|
|
|
- 3826 SymTab.ClBool)
|
|
|
+ 3008 SymTab.ClEnum)
|
|
|
+ 3009 AND (SymTab.ClassOf(it) #
|
|
|
+ 3010 SymTab.ClBool) THEN
|
|
|
+ 3011 SemError(218);
|
|
|
+ 3012 t := SymTab.InvalidType
|
|
|
+ 3013 ELSE
|
|
|
+ 3014 eT := SymTab.ArrayElem(t);
|
|
|
+ 3015 t := eT; sfx := TRUE
|
|
|
+ 3016 END; .) }
|
|
|
+ 3017 "]"
|
|
|
+ 3018 | "." GetIdent<fn>
|
|
|
+ 3019 (. astSel := AST.MakeNode(AST.NkSelector);
|
|
|
+ 3020 AST.SetOp(astSel, AST.SelField);
|
|
|
+ 3021 AST.SetChild(astSel, 0, AST.MakeLeaf(AST.NkIdent, fn));
|
|
|
+ 3022 AST.SetChild(astDes, AST.NChild(astDes), astSel); IF k = SymTab.KindModule THEN
|
|
|
+ 3023 (* qualified L.x: materialize
|
|
|
+ 3024 the export, then load it *)
|
|
|
+ 3025 IF NOT SymTab.MaterializeAlias(n,
|
|
|
+ 3026 fn, mal) THEN
|
|
|
+ 3027 SemError(201);
|
|
|
+ 3028 t := SymTab.InvalidType;
|
|
|
+ 3029 QbeGen.CopyOp("0", q)
|
|
|
+ 3030 ELSE
|
|
|
+ 3031 QbeGen.CopyOp(mal, qn);
|
|
|
+ 3032 t := SymTab.SymType(mal);
|
|
|
+ 3033 k := SymTab.SymKind(mal);
|
|
|
+ 3034 sfx := FALSE;
|
|
|
+ 3035 IF k = SymTab.KindProc THEN
|
|
|
+ 3036 (* call: ArgList supplies
|
|
|
+ 3037 the value *)
|
|
|
+ 3038 QbeGen.CopyOp("0", q)
|
|
|
+ 3039 ELSIF k = SymTab.KindConst THEN
|
|
|
+ 3040 IF SymTab.GetSymVal(mal,
|
|
|
+ 3041 cv)
|
|
|
+ 3042 THEN QbeGen.CopyOp(cv, q)
|
|
|
+ 3043 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 3044 END
|
|
|
+ 3045 END
|
|
|
+ 3046 END
|
|
|
+ 3047 ELSIF t = SymTab.InvalidType THEN
|
|
|
+ 3048 ELSIF (SymTab.ClassOf(t) #
|
|
|
+ 3049 SymTab.ClRecord)
|
|
|
+ 3050 AND (SymTab.ClassOf(t) #
|
|
|
+ 3051 SymTab.ClClass) THEN
|
|
|
+ 3052 SemError(215);
|
|
|
+ 3053 t := SymTab.InvalidType
|
|
|
+ 3054 ELSIF (SymTab.ClassOf(t) =
|
|
|
+ 3055 SymTab.ClClass)
|
|
|
+ 3056 AND SymTab.MethodExists(t, fn) THEN
|
|
|
+ 3057 (* obj.Method: bind the
|
|
|
+ 3058 method and pass obj as
|
|
|
+ 3059 the hidden receiver; q
|
|
|
+ 3060 already holds the
|
|
|
+ 3061 object's address *)
|
|
|
+ 3062 QbeGen.CopyOp(fn, n);
|
|
|
+ 3063 QbeGen.CopyOp(fn, qn);
|
|
|
+ 3064 methCls := t;
|
|
|
+ 3065 k := SymTab.KindProc;
|
|
|
+ 3066 t := SymTab.InvalidType
|
|
|
+ 3067 ELSIF NOT SymTab.FieldExists(t,
|
|
|
+ 3068 fn) THEN
|
|
|
+ 3069 SemError(216);
|
|
|
+ 3070 t := SymTab.InvalidType
|
|
|
+ 3071 ELSE
|
|
|
+ 3072 t := SymTab.FieldType(t, fn);
|
|
|
+ 3073 sfx := TRUE
|
|
|
+ 3074 END; .)
|
|
|
+ 3075 | "^"
|
|
|
+ 3076 (. astSel := AST.MakeNode(AST.NkSelector);
|
|
|
+ 3077 AST.SetOp(astSel, AST.SelDeref);
|
|
|
+ 3078 AST.SetChild(astDes, AST.NChild(astDes), astSel); IF t = SymTab.InvalidType THEN
|
|
|
+ 3079 ELSIF SymTab.ClassOf(t) #
|
|
|
+ 3080 SymTab.ClPtr THEN
|
|
|
+ 3081 SemError(219);
|
|
|
+ 3082 t := SymTab.InvalidType
|
|
|
+ 3083 ELSE
|
|
|
+ 3084 bt := SymTab.PtrBase(t);
|
|
|
+ 3085 IF bt = SymTab.InvalidType THEN
|
|
|
+ 3086 ELSE
|
|
|
+ 3087 t := bt;
|
|
|
+ 3088 sfx := TRUE
|
|
|
+ 3089 END
|
|
|
+ 3090 END; .) } (. astCur := astDes; .) .
|
|
|
+ 3091 (* Result suffix (ISO component after a function call): `F()^`,
|
|
|
+ 3092 `F()[i]`, `F().field`. The call result is in t/q with sfx FALSE
|
|
|
+ 3093 (a value, or a descriptor address for aggregates); each component
|
|
|
+ 3094 descends one level exactly like the Design components. *)
|
|
|
+ 3095 ResultComp<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal;
|
|
|
+ 3096 VAR sfx: BOOLEAN; VAR node: AST.Node;
|
|
|
+ 3097 VAR mname: SymTab.Name; VAR methCls: SymTab.TypeIndex;
|
|
|
+ 3098 VAR isM: BOOLEAN> (. VAR it, eT, bt: SymTab.TypeIndex;
|
|
|
+ 3099 iq, ql, qlo, qhi, qe, qb:
|
|
|
+ 3100 QbeGen.QVal;
|
|
|
+ 3101 lo, hi, fo: INTEGER;
|
|
|
+ 3102 isOpen: BOOLEAN;
|
|
|
+ 3103 fname: SymTab.Name;
|
|
|
+ 3104 astWrap, astSel: AST.Node; .)
|
|
|
+ 3105 = "[" Expr<it, iq>
|
|
|
+ 3106 (. isM := FALSE;
|
|
|
+ 3107 IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
+ 3108 astWrap := AST.MakeNode(
|
|
|
+ 3109 AST.NkDesignator);
|
|
|
+ 3110 AST.SetChild(astWrap, 0, node);
|
|
|
+ 3111 node := astWrap
|
|
|
+ 3112 END;
|
|
|
+ 3113 AST.SetChild(node, AST.NChild(node),
|
|
|
+ 3114 AST.MakeUn(AST.NkSelector,
|
|
|
+ 3115 AST.SelIndex, astCur)); IF t = SymTab.InvalidType THEN
|
|
|
+ 3116 ELSIF SymTab.ClassOf(t) #
|
|
|
+ 3117 SymTab.ClArray THEN
|
|
|
+ 3118 SemError(217);
|
|
|
+ 3119 t := SymTab.InvalidType
|
|
|
+ 3120 ELSIF NOT SymTab.IsIntFamily(it)
|
|
|
+ 3121 AND (SymTab.ClassOf(it) # SymTab.ClChar)
|
|
|
+ 3122 AND (SymTab.ClassOf(it) # SymTab.ClEnum)
|
|
|
+ 3123 AND (SymTab.ClassOf(it) # SymTab.ClBool) THEN
|
|
|
+ 3124 SemError(218);
|
|
|
+ 3125 t := SymTab.InvalidType
|
|
|
+ 3126 ELSE
|
|
|
+ 3127 eT := SymTab.ArrayElem(t);
|
|
|
+ 3128 t := eT; sfx := TRUE
|
|
|
+ 3129 END; .)
|
|
|
+ 3130 "]"
|
|
|
+ 3131 | "." GetIdent<fname>
|
|
|
+ 3132 (. isM := FALSE;
|
|
|
+ 3133 IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
+ 3134 astWrap := AST.MakeNode(
|
|
|
+ 3135 AST.NkDesignator);
|
|
|
+ 3136 AST.SetChild(astWrap, 0, node);
|
|
|
+ 3137 node := astWrap
|
|
|
+ 3138 END;
|
|
|
+ 3139 AST.SetChild(node, AST.NChild(node),
|
|
|
+ 3140 AST.MakeUn(AST.NkSelector,
|
|
|
+ 3141 AST.SelField,
|
|
|
+ 3142 AST.MakeLeaf(AST.NkIdent,
|
|
|
+ 3143 fname))); IF t = SymTab.InvalidType THEN
|
|
|
+ 3144 ELSIF (SymTab.ClassOf(t) #
|
|
|
+ 3145 SymTab.ClRecord)
|
|
|
+ 3146 AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN
|
|
|
+ 3147 SemError(215);
|
|
|
+ 3148 t := SymTab.InvalidType
|
|
|
+ 3149 ELSIF (SymTab.ClassOf(t) =
|
|
|
+ 3150 SymTab.ClClass)
|
|
|
+ 3151 AND SymTab.MethodExists(t, fname) THEN
|
|
|
+ 3152 (* a method on the call result:
|
|
|
+ 3153 a following ArgList makes
|
|
|
+ 3154 the call *)
|
|
|
+ 3155 mname := fname;
|
|
|
+ 3156 methCls := t; isM := TRUE;
|
|
|
+ 3157 t := SymTab.InvalidType
|
|
|
+ 3158 ELSIF NOT SymTab.FieldExists(t,
|
|
|
+ 3159 fname) THEN
|
|
|
+ 3160 SemError(216);
|
|
|
+ 3161 t := SymTab.InvalidType
|
|
|
+ 3162 ELSE
|
|
|
+ 3163 t := SymTab.FieldType(t, fname);
|
|
|
+ 3164 sfx := TRUE
|
|
|
+ 3165 END; .)
|
|
|
+ 3166 | "^" (. isM := FALSE;
|
|
|
+ 3167 IF AST.Kind(node) # AST.NkDesignator THEN
|
|
|
+ 3168 astWrap := AST.MakeNode(
|
|
|
+ 3169 AST.NkDesignator);
|
|
|
+ 3170 AST.SetChild(astWrap, 0, node);
|
|
|
+ 3171 node := astWrap
|
|
|
+ 3172 END;
|
|
|
+ 3173 astSel := AST.MakeNode(AST.NkSelector);
|
|
|
+ 3174 AST.SetOp(astSel, AST.SelDeref);
|
|
|
+ 3175 AST.SetChild(node,
|
|
|
+ 3176 AST.NChild(node), astSel); IF t = SymTab.InvalidType THEN
|
|
|
+ 3177 ELSIF SymTab.ClassOf(t) #
|
|
|
+ 3178 SymTab.ClPtr THEN
|
|
|
+ 3179 SemError(219);
|
|
|
+ 3180 t := SymTab.InvalidType
|
|
|
+ 3181 ELSE
|
|
|
+ 3182 bt := SymTab.PtrBase(t);
|
|
|
+ 3183 IF bt # SymTab.InvalidType THEN
|
|
|
+ 3184 t := bt; sfx := TRUE
|
|
|
+ 3185 END
|
|
|
+ 3186 END; .) .
|
|
|
+ 3187 Expr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 3188 (. VAR t2: SymTab.TypeIndex;
|
|
|
+ 3189 op: INTEGER;
|
|
|
+ 3190 q2, qt, wl: QbeGen.QVal;
|
|
|
+ 3191 astA, astB: AST.Node;
|
|
|
+ 3192 astOp: INTEGER;
|
|
|
+ 3193 astMade: BOOLEAN;
|
|
|
+ 3194 isR: BOOLEAN; .)
|
|
|
+ 3195 = SimExpr<t, q> (. astA := astCur; astMade := FALSE; .)
|
|
|
+ 3196 [ Rel<op> SimExpr<t2, q2>
|
|
|
+ 3197 (. astB := astCur; astMade := TRUE;
|
|
|
+ 3198 astOp := AST.OpEq;
|
|
|
+ 3199 IF op = SymTab.OpNeq1 THEN astOp := AST.OpNe
|
|
|
+ 3200 ELSIF op = SymTab.OpNeq2 THEN astOp := AST.OpNe
|
|
|
+ 3201 ELSIF op = SymTab.OpLt THEN astOp := AST.OpLt
|
|
|
+ 3202 ELSIF op = SymTab.OpLe THEN astOp := AST.OpLe
|
|
|
+ 3203 ELSIF op = SymTab.OpGt THEN astOp := AST.OpGt
|
|
|
+ 3204 ELSIF op = SymTab.OpGe THEN astOp := AST.OpGe
|
|
|
+ 3205 ELSIF op = SymTab.OpIn THEN astOp := AST.OpIn
|
|
|
+ 3206 END;
|
|
|
+ 3207 IF op = SymTab.OpIn THEN
|
|
|
+ 3208 IF SymTab.InCheck(t, t2) THEN
|
|
|
+ 3209 IF (t = SymTab.InvalidType)
|
|
|
+ 3210 OR (t2 = SymTab.InvalidType) THEN
|
|
|
+ 3211 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
|
|
|
+ 3212 ELSE
|
|
|
+ 3213 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
+ 3214 END
|
|
|
+ 3215 ELSE SemError(222); t := SymTab.InvalidType;
|
|
|
+ 3216 QbeGen.CopyOp("0", q)
|
|
|
+ 3217 END
|
|
|
+ 3218 ELSIF SymTab.RelCheck(t, t2, op) THEN
|
|
|
+ 3219 IF (t = SymTab.InvalidType)
|
|
|
+ 3220 OR (t2 = SymTab.InvalidType) THEN
|
|
|
+ 3221 t := SymTab.BoolType(); QbeGen.CopyOp("0", q)
|
|
|
+ 3222 ELSIF (SymTab.ClassOf(t) = SymTab.ClPtr)
|
|
|
+ 3223 OR (SymTab.ClassOf(t2) = SymTab.ClPtr) THEN
|
|
|
+ 3224 IF (op # SymTab.OpEq) AND (op # SymTab.OpNeq1)
|
|
|
+ 3225 AND (op # SymTab.OpNeq2) THEN
|
|
|
+ 3226 SemError(213); t := SymTab.InvalidType;
|
|
|
+ 3227 QbeGen.CopyOp("0", q)
|
|
|
+ 3228 ELSE
|
|
|
+ 3229 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
+ 3230 END
|
|
|
+ 3231 ELSIF (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
+ 3232 OR (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
+ 3233 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
+ 3234 ELSIF SymTab.StrCompat(t, t2) THEN
|
|
|
+ 3235 QbeGen.StrEq(op, q, q2, qt);
|
|
|
+ 3236 t := SymTab.BoolType(); QbeGen.CopyOp(qt, q)
|
|
|
+ 3237 ELSIF SymTab.IsLongFamily(t)
|
|
|
+ 3238 OR SymTab.IsLongFamily(t2) THEN
|
|
|
+ 3239 t := SymTab.BoolType(); QbeGen.CopyOp("@", q)
|
|
|
+ 3240 ELSE
|
|
|
+ 3241 t := SymTab.BoolType();
|
|
|
+ 3242 QbeGen.CopyOp("@", q)
|
|
|
+ 3243 END
|
|
|
+ 3244 ELSE SemError(213); t := SymTab.InvalidType;
|
|
|
+ 3245 QbeGen.CopyOp("0", q)
|
|
|
+ 3246 END;
|
|
|
+ 3247 astCur := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB); .) ]
|
|
|
+ 3248 (. IF NOT astMade THEN astCur := astA END; .)
|
|
|
+ 3249 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
+ 3250 Rel<VAR op: INTEGER>
|
|
|
+ 3251 = "=" (. op := SymTab.OpEq; .)
|
|
|
+ 3252 | "#" (. op := SymTab.OpNeq1; .)
|
|
|
+ 3253 | "<" (. op := SymTab.OpLt; .)
|
|
|
+ 3254 | "<=" (. op := SymTab.OpLe; .)
|
|
|
+ 3255 | ">" (. op := SymTab.OpGt; .)
|
|
|
+ 3256 | ">=" (. op := SymTab.OpGe; .)
|
|
|
+ 3257 | "IN" (. op := SymTab.OpIn; .) .
|
|
|
+ 3258 SimExpr<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 3259 (. VAR t2, res2, lt, rt:
|
|
|
+ 3260 SymTab.TypeIndex;
|
|
|
+ 3261 op: INTEGER;
|
|
|
+ 3262 q2, qt, wq, qf, q2a, q2b:
|
|
|
+ 3263 QbeGen.QVal;
|
|
|
+ 3264 neg, isR, isL, folded:
|
|
|
+ 3265 BOOLEAN;
|
|
|
+ 3266 fok: BOOLEAN;
|
|
|
+ 3267 lw, rw, mw: CARDINAL;
|
|
|
+ 3268 lTrue, lNext, lDone, qr, qs: QbeGen.QVal;
|
|
|
+ 3269 astA, astB: AST.Node;
|
|
|
+ 3270 astSign, astOp: INTEGER; .)
|
|
|
+ 3271 = (. neg := FALSE; astSign := 0; .)
|
|
|
+ 3272 [ "+" (. neg := TRUE; astSign := 1; .)
|
|
|
+ 3273 | "-" (. neg := TRUE; astSign := -1; .) ]
|
|
|
+ 3274 Term<t, q> (. astA := astCur;
|
|
|
+ 3275 IF neg AND QbeGen.IsImm(q) THEN
|
|
|
+ 3276 QbeGen.NegFold(q, q)
|
|
|
+ 3277 END;
|
|
|
+ 3278 IF astSign < 0 THEN
|
|
|
+ 3279 astCur := AST.MakeUn(
|
|
|
+ 3280 AST.NkUnary, AST.OpSub, astA);
|
|
|
+ 3281 astA := astCur
|
|
|
+ 3282 END; .)
|
|
|
+ 3283 { AddOp<op>
|
|
|
+ 3284 Term<t2, q2> (. astB := astCur; .)
|
|
|
+ 3285 (. astOp := AST.OpAdd;
|
|
|
+ 3286 IF op = SymTab.OpSub THEN astOp := AST.OpSub
|
|
|
+ 3287 ELSIF op = SymTab.OpOr THEN astOp := AST.OpOr END;
|
|
|
+ 3288 astA := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB);
|
|
|
+ 3289 astCur := astA;
|
|
|
+ 3290 IF op = SymTab.OpOr THEN
|
|
|
+ 3291 (* short-circuit: if q is true the RHS is skipped *)
|
|
|
+ 3292 IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
|
|
|
+ 3293 t := SymTab.BoolType()
|
|
|
+ 3294 ELSE SemError(212); t := SymTab.InvalidType END;
|
|
|
+ 3295 IF t # SymTab.InvalidType THEN
|
|
|
+ 3296 QbeGen.CopyOp("@", q)
|
|
|
+ 3297 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 3298 END
|
|
|
+ 3299 ELSIF (op = SymTab.OpAdd)
|
|
|
+ 3300 AND (SymTab.UStrCompat(t, t2)
|
|
|
+ 3301 OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
|
|
|
+ 3302 AND (SymTab.ClassOf(t2) = SymTab.ClUStr))
|
|
|
+ 3303 OR ((SymTab.ClassOf(t) = SymTab.ClUStr)
|
|
|
+ 3304 AND (SymTab.ClassOf(t2) = SymTab.ClUChar))
|
|
|
+ 3305 OR ((SymTab.ClassOf(t) = SymTab.ClUChar)
|
|
|
+ 3306 AND (SymTab.ClassOf(t2) = SymTab.ClUChar))) THEN
|
|
|
+ 3307 (* UString concatenation: a UCHAR operand becomes a
|
|
|
+ 3308 1-codepoint UString; the result is a descriptor in the
|
|
|
+ 3309 shim's concat buffer. Work on copies so neither
|
|
|
+ 3310 operand is clobbered. *)
|
|
|
+ 3311 t := SymTab.NewUStr();
|
|
|
+ 3312 QbeGen.CopyOp("@", q)
|
|
|
+ 3313 ELSIF (op = SymTab.OpAdd)
|
|
|
+ 3314 AND (SymTab.StrCompat(t, t2)
|
|
|
+ 3315 OR (SymTab.IsStrType(t)
|
|
|
+ 3316 AND (SymTab.ClassOf(t2) = SymTab.ClChar))
|
|
|
+ 3317 OR ((SymTab.ClassOf(t) = SymTab.ClChar)
|
|
|
+ 3318 AND SymTab.IsStrType(t2))) THEN
|
|
|
+ 3319 (* string concatenation; a CHAR operand becomes a
|
|
|
+ 3320 1-character string literal. When both operands are
|
|
|
+ 3321 constants, fold to a single string literal so a
|
|
|
+ 3322 constructor element stays compile-time. *)
|
|
|
+ 3323 QbeGen.StrFold(q, q2, SymTab.ClassOf(t), SymTab.ClassOf(t2),
|
|
|
+ 3324 qt, fok);
|
|
|
+ 3325 IF fok THEN QbeGen.CopyOp(qt, q)
|
|
|
+ 3326 ELSE QbeGen.CopyOp("@", q)
|
|
|
+ 3327 END;
|
|
|
+ 3328 t := SymTab.NewStr()
|
|
|
+ 3329 ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
|
|
|
+ 3330 AND (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
+ 3331 AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
+ 3332 lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
|
|
|
+ 3333 mw := lw;
|
|
|
+ 3334 IF rw > mw THEN mw := rw END;
|
|
|
+ 3335 t := SymTab.NewSet(
|
|
|
+ 3336 SymTab.NewSubR(0,
|
|
|
+ 3337 VAL(INTEGER, mw) * 32 - 1));
|
|
|
+ 3338 QbeGen.CopyOp("@", q)
|
|
|
+ 3339 ELSE
|
|
|
+ 3340 IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN
|
|
|
+ 3341 lt := t; rt := t2; t := res2
|
|
|
+ 3342 ELSE SemError(211); t := SymTab.InvalidType END;
|
|
|
+ 3343 IF t # SymTab.InvalidType THEN
|
|
|
+ 3344 isL := SymTab.IsLongFamily(t);
|
|
|
+ 3345 isR := SymTab.ClassOf(t) = SymTab.ClReal;
|
|
|
+ 3346 folded := FALSE;
|
|
|
+ 3347 IF (NOT isL) AND (NOT isR)
|
|
|
+ 3348 AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
|
|
|
+ 3349 IF op = SymTab.OpAdd THEN
|
|
|
+ 3350 folded := QbeGen.Fold2(0, q, q2, qf)
|
|
|
+ 3351 ELSE
|
|
|
+ 3352 folded := QbeGen.Fold2(1, q, q2, qf)
|
|
|
+ 3353 END
|
|
|
+ 3354 END;
|
|
|
+ 3355 IF folded THEN QbeGen.CopyOp(qf, q)
|
|
|
+ 3356 ELSE
|
|
|
+ 3357 QbeGen.CopyOp("@", q)
|
|
|
+ 3358 END
|
|
|
+ 3359 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 3360 END
|
|
|
+ 3361 END; .) }
|
|
|
+ 3362 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
+ 3363 AddOp<VAR op: INTEGER>
|
|
|
+ 3364 = "+" (. op := SymTab.OpAdd; .)
|
|
|
+ 3365 | "-" (. op := SymTab.OpSub; .)
|
|
|
+ 3366 | "OR" (. op := SymTab.OpOr; .) .
|
|
|
+ 3367 Term<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 3368 (. VAR t2, res2, lt, rt:
|
|
|
+ 3369 SymTab.TypeIndex;
|
|
|
+ 3370 op: INTEGER;
|
|
|
+ 3371 q2, qt, wq, qf:
|
|
|
+ 3372 QbeGen.QVal;
|
|
|
+ 3373 isR, isL, folded: BOOLEAN;
|
|
|
+ 3374 lw, rw, mw: CARDINAL;
|
|
|
+ 3375 lNext, lFalse, lDone, qr, qs: QbeGen.QVal;
|
|
|
+ 3376 astA, astB: AST.Node;
|
|
|
+ 3377 astOp: INTEGER; .)
|
|
|
+ 3378 = Fact<t, q> (. astA := astCur; .) { MulOp<op>
|
|
|
+ 3379 Fact<t2, q2> (. astB := astCur; .)
|
|
|
+ 3380 (. astOp := AST.OpMul;
|
|
|
+ 3381 IF op = SymTab.OpSlash THEN astOp := AST.OpDiv
|
|
|
+ 3382 ELSIF op = SymTab.OpDiv THEN astOp := AST.OpDiv
|
|
|
+ 3383 ELSIF op = SymTab.OpMod THEN astOp := AST.OpMod
|
|
|
+ 3384 ELSIF op = SymTab.OpAnd THEN astOp := AST.OpAnd END;
|
|
|
+ 3385 astA := AST.MakeBin(AST.NkBinExpr, astOp, astA, astB);
|
|
|
+ 3386 astCur := astA;
|
|
|
+ 3387 IF op = SymTab.OpAnd THEN
|
|
|
+ 3388 (* short-circuit: if q is false the RHS is skipped *)
|
|
|
+ 3389 IF SymTab.BoolCheck(t) AND SymTab.BoolCheck(t2) THEN
|
|
|
+ 3390 t := SymTab.BoolType()
|
|
|
+ 3391 ELSE SemError(212); t := SymTab.InvalidType END;
|
|
|
+ 3392 IF t # SymTab.InvalidType THEN QbeGen.CopyOp("@", q)
|
|
|
+ 3393 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 3394 END
|
|
|
+ 3395 ELSIF (t # SymTab.InvalidType) AND (t2 # SymTab.InvalidType)
|
|
|
+ 3396 AND (SymTab.ClassOf(t) = SymTab.ClSet)
|
|
|
+ 3397 AND (SymTab.ClassOf(t2) = SymTab.ClSet) THEN
|
|
|
+ 3398 lw := SymTab.SetWords(t); rw := SymTab.SetWords(t2);
|
|
|
+ 3399 mw := lw;
|
|
|
+ 3400 IF rw > mw THEN mw := rw END;
|
|
|
+ 3401 t := SymTab.NewSet(
|
|
|
+ 3402 SymTab.NewSubR(0,
|
|
|
+ 3403 VAL(INTEGER, mw) * 32 - 1));
|
|
|
+ 3404 QbeGen.CopyOp("@", q)
|
|
|
+ 3405 ELSE
|
|
|
+ 3406 IF SymTab.ArithCheck(t, t2,
|
|
|
+ 3407 (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
|
|
|
+ 3408 res2) THEN
|
|
|
+ 3409 lt := t; rt := t2; t := res2
|
|
|
+ 3410 ELSE SemError(211); t := SymTab.InvalidType END;
|
|
|
+ 3411 IF t # SymTab.InvalidType THEN
|
|
|
+ 3412 isL := SymTab.IsLongFamily(t);
|
|
|
+ 3413 isR := SymTab.ClassOf(t) = SymTab.ClReal;
|
|
|
+ 3414 folded := FALSE;
|
|
|
+ 3415 IF (NOT isL) AND (NOT isR)
|
|
|
+ 3416 AND QbeGen.IsImm(q) AND QbeGen.IsImm(q2) THEN
|
|
|
+ 3417 IF op = SymTab.OpTimes THEN
|
|
|
+ 3418 folded := QbeGen.Fold2(2, q, q2, qf)
|
|
|
+ 3419 ELSIF op = SymTab.OpDiv THEN
|
|
|
+ 3420 folded := QbeGen.Fold2(3, q, q2, qf)
|
|
|
+ 3421 ELSIF op = SymTab.OpMod THEN
|
|
|
+ 3422 folded := QbeGen.Fold2(4, q, q2, qf)
|
|
|
+ 3423 END
|
|
|
+ 3424 END;
|
|
|
+ 3425 IF folded THEN QbeGen.CopyOp(qf, q)
|
|
|
+ 3426 ELSE
|
|
|
+ 3427 QbeGen.CopyOp("@", q)
|
|
|
+ 3428 END
|
|
|
+ 3429 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 3430 END
|
|
|
+ 3431 END; .) }
|
|
|
+ 3432 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
+ 3433 MulOp<VAR op: INTEGER>
|
|
|
+ 3434 = "*" (. op := SymTab.OpTimes; .)
|
|
|
+ 3435 | "/" (. op := SymTab.OpSlash; .)
|
|
|
+ 3436 | "DIV" (. op := SymTab.OpDiv; .)
|
|
|
+ 3437 | "MOD" (. op := SymTab.OpMod; .)
|
|
|
+ 3438 | ( "AND" | "&" ) (. op := SymTab.OpAnd; .) .
|
|
|
+ 3439 Fact<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 3440 (. VAR s: ARRAY [0 .. 255] OF CHAR;
|
|
|
+ 3441 et, dt, t2, st, ct2, et2:
|
|
|
+ 3442 SymTab.TypeIndex;
|
|
|
+ 3443 dk: INTEGER;
|
|
|
+ 3444 qd, q2, sq, qa, qm0, qr, qt:
|
|
|
+ 3445 QbeGen.QVal;
|
|
|
+ 3446 qn, vn: SymTab.Name;
|
|
|
+ 3447 vt: SymTab.TypeIndex;
|
|
|
+ 3448 c1, c2: INTEGER;
|
|
|
+ 3449 lo, hi: INTEGER;
|
|
|
+ 3450 isMax: BOOLEAN;
|
|
|
+ 3451 called, isHigh, sfx, isCh,
|
|
|
+ 3452 isU, uok, isStr: BOOLEAN;
|
|
|
+ 3453 ucp: INTEGER; astIsLit: BOOLEAN;
|
|
|
+ 3454 astD: AST.Node;
|
|
|
+ 3455 astCall: BOOLEAN;
|
|
|
+ 3456 astNode, astNot: AST.Node;
|
|
|
+ 3457 j: CARDINAL;
|
|
|
+ 3458 astArg2: AST.Node;
|
|
|
+ 3459 astBrace: AST.Node;
|
|
|
+ 3460 astRes: AST.Node; mname: SymTab.Name; isM: BOOLEAN;
|
|
|
+ 3461 isConvF: BOOLEAN;
|
|
|
+ 3462 fi, fj: CARDINAL; .)
|
|
|
+ 3463 = (. astIsLit := FALSE; .)
|
|
|
+ 3464 ( "__LINE__" (. QbeGen.IntStr(M2S.line, q);
|
|
|
+ 3465 astIsLit := TRUE;
|
|
|
+ 3466 astCur := AST.MakeLeaf(
|
|
|
+ 3467 AST.NkIntLit, q);
|
|
|
+ 3468 t := SymTab.IntType(); .)
|
|
|
+ 3469 | "__FILE__" (. (* fold to the quoted file name *)
|
|
|
+ 3470 s[0] := '"'; fi := 1; fj := 0;
|
|
|
+ 3471 WHILE (M2S.fileName[fj] # CHR(0))
|
|
|
+ 3472 AND (fi < HIGH(s)) DO
|
|
|
+ 3473 s[fi] := M2S.fileName[fj];
|
|
|
+ 3474 INC(fi); INC(fj)
|
|
|
+ 3475 END;
|
|
|
+ 3476 s[fi] := '"';
|
|
|
+ 3477 s[fi + 1] := CHR(0);
|
|
|
+ 3478 astIsLit := TRUE;
|
|
|
+ 3479 astCur := AST.MakeLeaf(
|
|
|
+ 3480 AST.NkStrLit, s);
|
|
|
+ 3481 t := SymTab.NewStr();
|
|
|
+ 3482 QbeGen.DeclStr(s, q); .)
|
|
|
+ 3483 | integer (. LexString(s);
|
|
|
+ 3484 QbeGen.NormInt(s, q); astIsLit := TRUE; astCur := AST.MakeLeaf(AST.NkIntLit, s);
|
|
|
+ 3485 t := SymTab.IntType(); .)
|
|
|
+ 3486 | charConst (. LexString(s);
|
|
|
+ 3487 QbeGen.NormLit(s, q, isCh);
|
|
|
+ 3488 astIsLit := TRUE;
|
|
|
+ 3489 astCur := AST.MakeLeaf(
|
|
|
+ 3490 AST.NkCharLit, s);
|
|
|
+ 3491 t := SymTab.CharType(); .)
|
|
|
+ 3492 | real (. LexString(s);
|
|
|
+ 3493 QbeGen.NormReal(s, q);
|
|
|
+ 3494 astIsLit := TRUE;
|
|
|
+ 3495 astCur := AST.MakeLeaf(
|
|
|
+ 3496 AST.NkRealLit, s);
|
|
|
+ 3497 t := SymTab.RealType(); .)
|
|
|
+ 3498 | string (. LexString(s);
|
|
|
+ 3499 astIsLit := TRUE;
|
|
|
+ 3500 astCur := AST.MakeLeaf(
|
|
|
+ 3501 AST.NkStrLit, s);
|
|
|
+ 3502 IF SymTab.StrLen(s) = 3 THEN
|
|
|
+ 3503 t := SymTab.CharType();
|
|
|
+ 3504 QbeGen.IntStr(
|
|
|
+ 3505 QbeGen.CharVal(s), q)
|
|
|
+ 3506 ELSIF SymTab.StrLen(s) = 2 THEN
|
|
|
+ 3507 (* empty string: a string value
|
|
|
+ 3508 for arrays, 0 for CHAR *)
|
|
|
+ 3509 t := SymTab.NewEmptyStr();
|
|
|
+ 3510 QbeGen.DeclStr(s, q)
|
|
|
+ 3511 ELSE t := SymTab.NewStr();
|
|
|
+ 3512 QbeGen.DeclStr(s, q);
|
|
|
+ 3513 (* a literal's value IS its
|
|
|
+ 3514 static descriptor address *)
|
|
|
+ 3515 END; .)
|
|
|
+ 3516 | ustring (. LexString(s);
|
|
|
+ 3517 astIsLit := TRUE;
|
|
|
+ 3518 astCur := AST.MakeLeaf(
|
|
|
+ 3519 AST.NkStrLit, s);
|
|
|
+ 3520 QbeGen.DeclUStr(s, q, isU, ucp,
|
|
|
+ 3521 uok);
|
|
|
+ 3522 IF NOT uok THEN
|
|
|
+ 3523 SemError(234);
|
|
|
+ 3524 t := SymTab.InvalidType
|
|
|
+ 3525 ELSIF isU THEN
|
|
|
+ 3526 t := SymTab.UCharType();
|
|
|
+ 3527 QbeGen.IntStr(ucp, q)
|
|
|
+ 3528 ELSE
|
|
|
+ 3529 t := SymTab.NewUStr();
|
|
|
+ 3530 END; .)
|
|
|
+ 3531 | Design<dt, dk, qd, qn, sfx> (. astD := astCur; astCall := FALSE; astBrace := AST.NoNode;
|
|
|
+ 3532 astNArgs := 0; called := FALSE;
|
|
|
+ 3533 t := dt;
|
|
|
+ 3534 IF dk = SymTab.KindConst THEN
|
|
|
+ 3535 QbeGen.CopyOp(qd, q)
|
|
|
+ 3536 ELSE QbeGen.CopyOp("@", q)
|
|
|
+ 3537 END; .)
|
|
|
+ 3538 [ TypedBraceLit<dt, q> (. t := dt; astCall := TRUE;
|
|
|
+ 3539 astBrace := astCur; .) ]
|
|
|
+ 3540 [ ArgList<qn, dt, qd, TRUE, FALSE, methCls, ct2, q2, called>
|
|
|
+ 3541 (. astCall := TRUE;
|
|
|
+ 3542 IF (SymTab.SymKind(qn) = SymTab.KindType)
|
|
|
+ 3543 OR (SymTab.SymKind(qn) = SymTab.KindPredef) THEN
|
|
|
+ 3544 (* T(x): emit as the VAL builtin so Lower's
|
|
|
+ 3545 conversion rules apply unchanged *)
|
|
|
+ 3546 astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3547 AST.SetChild(astNode, 0,
|
|
|
+ 3548 AST.MakeLeaf(AST.NkIdent, "VAL"));
|
|
|
+ 3549 AST.SetChild(astNode, 1,
|
|
|
+ 3550 AST.MakeLeaf(AST.NkIdent, qn));
|
|
|
+ 3551 IF astNArgs = 1 THEN
|
|
|
+ 3552 AST.SetChild(astNode, 2, astArgs[0])
|
|
|
+ 3553 END;
|
|
|
+ 3554 isConvF := TRUE
|
|
|
+ 3555 ELSE astNode := AstCallNode(astD)
|
|
|
+ 3556 END;
|
|
|
+ 3557 astRes := astNode;
|
|
|
+ 3558 t := ct2;
|
|
|
+ 3559 QbeGen.CopyOp(q2, q);
|
|
|
+ 3560 IF isConvF AND QbeGen.IsImm(convQ)
|
|
|
+ 3561 AND OrdClass(convT) AND OrdClass(ct2) THEN
|
|
|
+ 3562 QbeGen.CopyOp(convQ, q)
|
|
|
+ 3563 END;
|
|
|
+ 3564 sfx := FALSE; .)
|
|
|
+ 3565 { ResultComp<t, q, sfx, astRes, mname, methCls, isM>
|
|
|
+ 3566 [ (. astNArgs := 0; .)
|
|
|
+ 3567 ArgList<mname, t, q, TRUE, FALSE, methCls, ct2, q2, called>
|
|
|
+ 3568 (. astNode := AstCallNode(astRes);
|
|
|
+ 3569 astRes := astNode;
|
|
|
+ 3570 t := ct2;
|
|
|
+ 3571 QbeGen.CopyOp(q2, q);
|
|
|
+ 3572 sfx := FALSE; .) ] }
|
|
|
+ 3573 (. IF sfx THEN
|
|
|
+ 3574 IF t = SymTab.InvalidType THEN
|
|
|
+ 3575 QbeGen.CopyOp("0", q)
|
|
|
+ 3576 ELSIF (SymTab.ClassOf(t) #
|
|
|
+ 3577 SymTab.ClRecord)
|
|
|
+ 3578 AND (SymTab.ClassOf(t) # SymTab.ClSet)
|
|
|
+ 3579 AND (SymTab.ClassOf(t) # SymTab.ClArray)
|
|
|
+ 3580 AND (SymTab.ClassOf(t) # SymTab.ClClass) THEN
|
|
|
+ 3581 QbeGen.CopyOp("@", q)
|
|
|
+ 3582 END
|
|
|
+ 3583 END; .) ]
|
|
|
+ 3584 (. IF called THEN
|
|
|
+ 3585 astCur := astRes
|
|
|
+ 3586 ELSIF astCall THEN
|
|
|
+ 3587 astCur := astBrace
|
|
|
+ 3588 ELSE astCur := astD
|
|
|
+ 3589 END;
|
|
|
+ 3590 astIsLit := TRUE;
|
|
|
+ 3591 IF NOT called
|
|
|
+ 3592 AND (dk = SymTab.KindProc) THEN
|
|
|
+ 3593 (* bare zero-arg function
|
|
|
+ 3594 call (parentheses may be
|
|
|
+ 3595 omitted); a proper or
|
|
|
+ 3596 parameterised proc here
|
|
|
+ 3597 is 230 *)
|
|
|
+ 3598 IF (SymTab.ProcNPar(qn) = 0)
|
|
|
+ 3599 AND (SymTab.ProcRes(qn) # SymTab.InvalidType) THEN
|
|
|
+ 3600 t := SymTab.ProcRes(qn);
|
|
|
+ 3601 QbeGen.CopyOp("@", q);
|
|
|
+ 3602 astCur := AST.MakeNode(AST.NkCall);
|
|
|
+ 3603 AST.SetChild(astCur, 0, astD)
|
|
|
+ 3604 ELSE
|
|
|
+ 3605 t := SymTab.ProcTypeOf(qn);
|
|
|
+ 3606 QbeGen.CopyOp("@", q)
|
|
|
+ 3607 END
|
|
|
+ 3608 END; .)
|
|
|
+ 3609 | ( "HIGH" (. isHigh := TRUE; .)
|
|
|
+ 3610 | ( "LEN" | "LENGTH" ) (. isHigh := FALSE; .) )
|
|
|
+ 3611 "(" ( Design<dt, dk, qd, qn, sfx> (. isStr := FALSE;
|
|
|
+ 3612 isU := FALSE; .)
|
|
|
+ 3613 | string (. LexString(s); astCur := AST.MakeLeaf(AST.NkStrLit, s);
|
|
|
+ 3614 isStr := TRUE;
|
|
|
+ 3615 isU := FALSE;
|
|
|
+ 3616 IF SymTab.StrLen(s) = 3 THEN
|
|
|
+ 3617 dt := SymTab.CharType();
|
|
|
+ 3618 QbeGen.IntStr(QbeGen.CharVal(s),
|
|
|
+ 3619 qd)
|
|
|
+ 3620 ELSE
|
|
|
+ 3621 dt := SymTab.NewStr();
|
|
|
+ 3622 QbeGen.DeclStr(s, qd);
|
|
|
+ 3623 END;
|
|
|
+ 3624 dk := -1;
|
|
|
+ 3625 qn[0] := CHR(0); .)
|
|
|
+ 3626 | ustring (. LexString(s); astCur := AST.MakeLeaf(AST.NkStrLit, s);
|
|
|
+ 3627 QbeGen.DeclUStr(s, qd, isU, ucp,
|
|
|
+ 3628 uok);
|
|
|
+ 3629 isStr := FALSE;
|
|
|
+ 3630 IF NOT uok THEN
|
|
|
+ 3631 SemError(234);
|
|
|
+ 3632 dt := SymTab.InvalidType
|
|
|
+ 3633 ELSIF isU THEN
|
|
|
+ 3634 (* one codepoint: a UCHAR;
|
|
|
+ 3635 LEN is 1, HIGH is 0 *)
|
|
|
+ 3636 dt := SymTab.UCharType();
|
|
|
+ 3637 QbeGen.IntStr(ucp, qd)
|
|
|
+ 3638 ELSE
|
|
|
+ 3639 dt := SymTab.NewUStr();
|
|
|
+ 3640 END;
|
|
|
+ 3641 dk := -1;
|
|
|
+ 3642 qn[0] := CHR(0); .) )
|
|
|
+ 3643 ")"
|
|
|
+ 3644 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3645 IF isHigh THEN AST.SetChild(astNode, 0,
|
|
|
+ 3646 AST.MakeLeaf(AST.NkIdent, "HIGH"))
|
|
|
+ 3647 ELSE AST.SetChild(astNode, 0,
|
|
|
+ 3648 AST.MakeLeaf(AST.NkIdent, "LEN")) END;
|
|
|
+ 3649 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3650 astCur := astNode; astIsLit := TRUE;
|
|
|
+ 3651 IF (dt # SymTab.InvalidType)
|
|
|
+ 3652 AND (SymTab.ClassOf(dt) = SymTab.ClUStr) THEN
|
|
|
+ 3653 (* UString: the count is
|
|
|
+ 3654 the descriptor header *)
|
|
|
+ 3655 t := SymTab.IntType();
|
|
|
+ 3656 QbeGen.CopyOp("@", q)
|
|
|
+ 3657 ELSIF (dt # SymTab.InvalidType)
|
|
|
+ 3658 AND (SymTab.ClassOf(dt) = SymTab.ClUChar) THEN
|
|
|
+ 3659 (* single UCHAR codepoint *)
|
|
|
+ 3660 IF isHigh THEN
|
|
|
+ 3661 QbeGen.CopyOp("0", qr)
|
|
|
+ 3662 ELSE
|
|
|
+ 3663 QbeGen.CopyOp("1", qr)
|
|
|
+ 3664 END;
|
|
|
+ 3665 t := SymTab.IntType();
|
|
|
+ 3666 QbeGen.CopyOp(qr, q)
|
|
|
+ 3667 ELSIF isStr THEN
|
|
|
+ 3668 (* fold: content length at
|
|
|
+ 3669 compile time *)
|
|
|
+ 3670 IF SymTab.StrLen(s) = 3 THEN
|
|
|
+ 3671 c1 := 1
|
|
|
+ 3672 ELSE
|
|
|
+ 3673 c1 :=
|
|
|
+ 3674 SymTab.StrLen(s) - 2
|
|
|
+ 3675 END;
|
|
|
+ 3676 IF isHigh THEN
|
|
|
+ 3677 DEC(c1)
|
|
|
+ 3678 END;
|
|
|
+ 3679 QbeGen.IntStr(c1, qr);
|
|
|
+ 3680 t := SymTab.IntType();
|
|
|
+ 3681 QbeGen.CopyOp(qr, q)
|
|
|
+ 3682 ELSIF dt = SymTab.InvalidType THEN
|
|
|
+ 3683 t := SymTab.InvalidType;
|
|
|
+ 3684 QbeGen.CopyOp("0", q)
|
|
|
+ 3685 ELSIF SymTab.ClassOf(dt) #
|
|
|
+ 3686 SymTab.ClArray THEN
|
|
|
+ 3687 SemError(217);
|
|
|
+ 3688 t := SymTab.InvalidType;
|
|
|
+ 3689 QbeGen.CopyOp("0", q)
|
|
|
+ 3690 ELSE
|
|
|
+ 3691 IF SymTab.IsOpenArray(dt) THEN
|
|
|
+ 3692 t := SymTab.IntType();
|
|
|
+ 3693 QbeGen.CopyOp("@", q)
|
|
|
+ 3694 ELSE
|
|
|
+ 3695 IF isHigh THEN
|
|
|
+ 3696 QbeGen.IntStr(
|
|
|
+ 3697 SymTab.ArrayHi(dt), qr)
|
|
|
+ 3698 ELSE
|
|
|
+ 3699 QbeGen.IntStr(VAL(
|
|
|
+ 3700 INTEGER,
|
|
|
+ 3701 SymTab.ArrayLen(dt)),
|
|
|
+ 3702 qr)
|
|
|
+ 3703 END;
|
|
|
+ 3704 t := SymTab.IntType();
|
|
|
+ 3705 QbeGen.CopyOp(qr, q)
|
|
|
+ 3706 END
|
|
|
+ 3707 END; .)
|
|
|
+ 3708 | ( "SIZE" | "TSIZE" ) "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
+ 3709 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3710 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "SIZE"));
|
|
|
+ 3711 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3712 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3713 (. IF dt = SymTab.InvalidType THEN
|
|
|
+ 3714 t := SymTab.InvalidType;
|
|
|
+ 3715 QbeGen.CopyOp("0", q)
|
|
|
+ 3716 ELSE
|
|
|
+ 3717 QbeGen.IntStr(VAL(INTEGER,
|
|
|
+ 3718 SymTab.ObjectSize(dt)), q);
|
|
|
+ 3719 t := SymTab.IntType()
|
|
|
+ 3720 END; .)
|
|
|
+ 3721 | ( "SHIFT" (. isMax := FALSE; .)
|
|
|
+ 3722 | "ROTATE" (. isMax := TRUE; .) )
|
|
|
+ 3723 "(" Expr<et, q> (. astArg2 := astCur; .) "," Expr<et2, q2> ")"
|
|
|
+ 3724 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3725 IF isMax THEN AST.SetChild(astNode, 0,
|
|
|
+ 3726 AST.MakeLeaf(AST.NkIdent, "ROTATE"))
|
|
|
+ 3727 ELSE AST.SetChild(astNode, 0,
|
|
|
+ 3728 AST.MakeLeaf(AST.NkIdent, "SHIFT")) END;
|
|
|
+ 3729 IF astArg2 # AST.NoNode THEN AST.SetChild(astNode, 1, astArg2) END;
|
|
|
+ 3730 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
+ 3731 astCur := astNode; astIsLit := TRUE;
|
|
|
+ 3732 (* set shift/rotate: isMax
|
|
|
+ 3733 doubles as "rotate" *)
|
|
|
+ 3734 IF (et # SymTab.InvalidType)
|
|
|
+ 3735 AND (SymTab.ClassOf(et) =
|
|
|
+ 3736 SymTab.ClSet) THEN
|
|
|
+ 3737 t := et;
|
|
|
+ 3738 QbeGen.CopyOp("@", q)
|
|
|
+ 3739 ELSE SemError(230);
|
|
|
+ 3740 t := SymTab.InvalidType;
|
|
|
+ 3741 QbeGen.CopyOp("0", q)
|
|
|
+ 3742 END; .)
|
|
|
+ 3743 | ( "MIN" (. isMax := FALSE; .)
|
|
|
+ 3744 | "MAX" (. isMax := TRUE; .) )
|
|
|
+ 3745 "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
+ 3746 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3747 IF isMax THEN AST.SetChild(astNode, 0,
|
|
|
+ 3748 AST.MakeLeaf(AST.NkIdent, "MAX"))
|
|
|
+ 3749 ELSE AST.SetChild(astNode, 0,
|
|
|
+ 3750 AST.MakeLeaf(AST.NkIdent, "MIN")) END;
|
|
|
+ 3751 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3752 astCur := astNode; astIsLit := TRUE;
|
|
|
+ 3753 IF (dt # SymTab.InvalidType)
|
|
|
+ 3754 AND (SymTab.ClassOf(dt) = SymTab.ClReal) THEN
|
|
|
+ 3755 (* REAL/LONGREAL: the
|
|
|
+ 3756 implementation bounds *)
|
|
|
+ 3757 IF isMax THEN
|
|
|
+ 3758 QbeGen.NormReal(
|
|
|
+ 3759 "3.402823e38", q)
|
|
|
+ 3760 ELSE QbeGen.NormReal(
|
|
|
+ 3761 "-3.402823e38", q)
|
|
|
+ 3762 END;
|
|
|
+ 3763 t := SymTab.RealType()
|
|
|
+ 3764 ELSIF (dt #
|
|
|
+ 3765 SymTab.InvalidType)
|
|
|
+ 3766 AND (SymTab.ClassOf(dt) =
|
|
|
+ 3767 SymTab.ClLong) THEN
|
|
|
+ 3768 IF isMax THEN
|
|
|
+ 3769 QbeGen.CopyOp(
|
|
|
+ 3770 "9223372036854775807", q)
|
|
|
+ 3771 ELSE QbeGen.CopyOp(
|
|
|
+ 3772 "-9223372036854775808", q)
|
|
|
+ 3773 END;
|
|
|
+ 3774 t := SymTab.LongType()
|
|
|
+ 3775 ELSIF SymTab.TypeBounds(dt, lo,
|
|
|
+ 3776 hi) THEN
|
|
|
+ 3777 IF isMax THEN
|
|
|
+ 3778 QbeGen.IntStr(hi, q)
|
|
|
+ 3779 ELSE QbeGen.IntStr(lo, q)
|
|
|
+ 3780 END;
|
|
|
+ 3781 (* a set's bounds are those
|
|
|
+ 3782 of its base type *)
|
|
|
+ 3783 IF SymTab.ClassOf(dt) =
|
|
|
+ 3784 SymTab.ClSet THEN
|
|
|
+ 3785 t := SymTab.SetBase(dt)
|
|
|
+ 3786 ELSE t := SymTab.IntType()
|
|
|
+ 3787 END
|
|
|
+ 3788 ELSE SemError(230);
|
|
|
+ 3789 t := SymTab.InvalidType;
|
|
|
+ 3790 QbeGen.CopyOp("0", q)
|
|
|
+ 3791 END; .)
|
|
|
+ 3792 | "ADR" "(" Design<dt, dk, qd, qn, sfx> ")"
|
|
|
+ 3793 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3794 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ADR"));
|
|
|
+ 3795 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3796 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3797 (. IF dt = SymTab.InvalidType THEN
|
|
|
+ 3798 t := SymTab.InvalidType;
|
|
|
+ 3799 QbeGen.CopyOp("0", q)
|
|
|
+ 3800 ELSE
|
|
|
+ 3801 IF sfx
|
|
|
+ 3802 OR (dk = SymTab.KindVar)
|
|
|
+ 3803 OR (dk = SymTab.KindParam) THEN
|
|
|
+ 3804 QbeGen.CopyOp("@", q)
|
|
|
+ 3805 ELSE SemError(230);
|
|
|
+ 3806 QbeGen.CopyOp("0", q)
|
|
|
+ 3807 END;
|
|
|
+ 3808 t := SymTab.AddrType()
|
|
|
+ 3809 END; .)
|
|
|
+ 3810 | "CHR" "(" Expr<et, q> ")"
|
|
|
+ 3811 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3812 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CHR"));
|
|
|
+ 3813 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3814 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3815 (. IF (et # SymTab.InvalidType)
|
|
|
+ 3816 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
+ 3817 SemError(211) END;
|
|
|
+ 3818 t := SymTab.CharType(); .)
|
|
|
+ 3819 | "ORD" "(" Expr<et, q> ")"
|
|
|
+ 3820 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3821 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ORD"));
|
|
|
+ 3822 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3823 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3824 (. IF et # SymTab.InvalidType THEN
|
|
|
+ 3825 IF (SymTab.ClassOf(et) #
|
|
|
+ 3826 SymTab.ClChar)
|
|
|
3827 AND (SymTab.ClassOf(et) #
|
|
|
- 3828 SymTab.ClEnum)
|
|
|
- 3829 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
- 3830 SemError(211) END
|
|
|
- 3831 END;
|
|
|
- 3832 t := SymTab.IntType(); .)
|
|
|
- 3833 | "CAP" "(" Expr<et, q> ")"
|
|
|
- 3834 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3835 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CAP"));
|
|
|
- 3836 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3837 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3838 (. IF QbeGen.IsImm(q)
|
|
|
- 3839 AND SymTab.ConstInt(q, lo) THEN
|
|
|
- 3840 IF (lo >= VAL(INTEGER, ORD("a"))) AND (lo <= VAL(INTEGER, ORD("z"))) THEN lo := lo - 32 END;
|
|
|
- 3841 QbeGen.IntStr(lo, q)
|
|
|
- 3842 ELSE QbeGen.CopyOp("@", q)
|
|
|
- 3843 END;
|
|
|
- 3844 t := SymTab.CharType(); .)
|
|
|
- 3845 | "UCHR" "(" Expr<et, q> ")"
|
|
|
- 3846 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3847 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "UCHR"));
|
|
|
- 3848 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3849 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3850 (. (* UCHR: the UCHAR constructor.
|
|
|
- 3851 CHAR -> UCHAR (identity);
|
|
|
- 3852 INTEGER familly -> UCHAR
|
|
|
- 3853 (codepoint value). *)
|
|
|
- 3854 IF (et # SymTab.InvalidType)
|
|
|
- 3855 AND (SymTab.ClassOf(et) # SymTab.ClChar)
|
|
|
- 3856 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
- 3857 SemError(211) END;
|
|
|
- 3858 t := SymTab.UCharType(); .)
|
|
|
- 3859 | "CHR8" "(" Expr<et, q> ")"
|
|
|
- 3860 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3861 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CHR8"));
|
|
|
- 3862 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3863 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3864 (. IF (et # SymTab.InvalidType)
|
|
|
- 3865 AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
|
|
|
- 3866 SemError(211) END;
|
|
|
- 3867 t := SymTab.CharType(); .)
|
|
|
- 3868 | "UORD" "(" Expr<et, q> ")"
|
|
|
- 3869 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3870 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "UORD"));
|
|
|
- 3871 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3872 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3873 (. (* UORD(u): the codepoint as a
|
|
|
- 3874 32-bit ordinal (INTEGER),
|
|
|
- 3875 cf. ORD for CHAR. *)
|
|
|
- 3876 IF (et # SymTab.InvalidType)
|
|
|
- 3877 AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
|
|
|
- 3878 SemError(211) END;
|
|
|
- 3879 t := SymTab.IntType(); .)
|
|
|
- 3880 | "ABS" "(" Expr<et, q> ")"
|
|
|
- 3881 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3882 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ABS"));
|
|
|
- 3883 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3884 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3885 (. IF (et # SymTab.InvalidType)
|
|
|
- 3886 AND NOT SymTab.IsIntFamily(et)
|
|
|
- 3887 AND (SymTab.ClassOf(et) #
|
|
|
- 3888 SymTab.ClReal) THEN
|
|
|
- 3889 SemError(211)
|
|
|
- 3890 ELSIF QbeGen.IsImm(q)
|
|
|
- 3891 AND SymTab.ConstInt(q, lo) THEN
|
|
|
- 3892 IF lo < 0 THEN lo := -lo END;
|
|
|
- 3893 QbeGen.IntStr(lo, q)
|
|
|
- 3894 ELSE QbeGen.CopyOp("@", q)
|
|
|
- 3895 END;
|
|
|
- 3896 t := et; .)
|
|
|
- 3897 | "ODD" "(" Expr<et, q> ")"
|
|
|
- 3898 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3899 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ODD"));
|
|
|
- 3900 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
- 3901 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3902 (. IF (et # SymTab.InvalidType)
|
|
|
- 3903 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
- 3904 SemError(211) END;
|
|
|
- 3905 t := SymTab.BoolType();
|
|
|
- 3906 IF QbeGen.IsImm(q)
|
|
|
- 3907 AND SymTab.ConstInt(q, lo) THEN
|
|
|
- 3908 IF (lo MOD 2) # 0 THEN
|
|
|
- 3909 QbeGen.CopyOp("1", q)
|
|
|
- 3910 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 3911 END
|
|
|
- 3912 ELSE QbeGen.CopyOp("@", q)
|
|
|
- 3913 END; .)
|
|
|
- 3914 | "TRUNC" "(" Expr<et, q> ")"
|
|
|
- 3915 (. (* TRUNC(x): real -> INTEGER, as the VAL builtin *)
|
|
|
- 3916 astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3917 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "VAL"));
|
|
|
- 3918 AST.SetChild(astNode, 1, AST.MakeLeaf(AST.NkIdent, "INTEGER"));
|
|
|
- 3919 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
- 3920 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3921 (. t := SymTab.IntType();
|
|
|
- 3922 QbeGen.CopyOp("@", q); .)
|
|
|
- 3923 | "FLOAT" "(" Expr<et, q> ")"
|
|
|
- 3924 (. (* FLOAT(i): integer -> REAL, as the VAL builtin *)
|
|
|
- 3925 astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3926 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "VAL"));
|
|
|
- 3927 AST.SetChild(astNode, 1, AST.MakeLeaf(AST.NkIdent, "REAL"));
|
|
|
- 3928 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
- 3929 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3930 (. t := SymTab.RealType();
|
|
|
- 3931 IF QbeGen.IsImm(q) AND SymTab.ConstInt(q, lo) THEN QbeGen.NormReal(q, qa); QbeGen.CopyOp(qa, q)
|
|
|
- 3932 ELSE QbeGen.CopyOp("@", q) END; .)
|
|
|
- 3933 | ( "VAL" | "CONVERT" | "CAST" ) "(" GetIdent<vn> (. astArg2 := AST.MakeLeaf(AST.NkIdent, vn); .) "," Expr<et, q> ")"
|
|
|
- 3934 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
- 3935 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "VAL"));
|
|
|
- 3936 IF astArg2 # AST.NoNode THEN AST.SetChild(astNode, 1, astArg2) END;
|
|
|
- 3937 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
- 3938 astCur := astNode; astIsLit := TRUE; .)
|
|
|
- 3939 (. IF NOT SymTab.Lookup(vn) THEN
|
|
|
- 3940 SemError(201);
|
|
|
- 3941 t := SymTab.InvalidType
|
|
|
- 3942 ELSE vt := SymTab.SymType(vn);
|
|
|
- 3943 IF vt = SymTab.InvalidType THEN
|
|
|
- 3944 t := SymTab.InvalidType
|
|
|
- 3945 ELSIF et =
|
|
|
- 3946 SymTab.InvalidType THEN
|
|
|
- 3947 t := vt
|
|
|
- 3948 ELSE
|
|
|
- 3949 c1 := SymTab.ClassOf(et);
|
|
|
- 3950 c2 := SymTab.ClassOf(vt);
|
|
|
- 3951 IF (c1 = SymTab.ClInt)
|
|
|
- 3952 AND (c2 = SymTab.ClLong) THEN
|
|
|
- 3953 IF NOT QbeGen.IsImm(q) THEN QbeGen.WidenLong(q, qa); QbeGen.CopyOp(qa, q) END;
|
|
|
- 3954 t := vt
|
|
|
- 3955 ELSIF (c1 = SymTab.ClLong)
|
|
|
- 3956 AND (c2 = SymTab.ClInt) THEN
|
|
|
- 3957 IF NOT (QbeGen.IsImm(q) AND SymTab.ConstInt(q, lo)) THEN QbeGen.NarrowLong(q, qa); QbeGen.CopyOp(qa, q) END;
|
|
|
- 3958 t := vt
|
|
|
- 3959 ELSIF (c1 = SymTab.ClInt)
|
|
|
- 3960 AND (c2 = SymTab.ClReal) THEN
|
|
|
- 3961 IF QbeGen.IsImm(q) AND SymTab.ConstInt(q, lo) THEN QbeGen.NormReal(q, qa) ELSE QbeGen.ConvIR(q, qa) END;
|
|
|
- 3962 QbeGen.CopyOp(qa, q);
|
|
|
- 3963 t := vt
|
|
|
- 3964 ELSIF (c1 = SymTab.ClLong)
|
|
|
- 3965 AND (c2 = SymTab.ClReal) THEN
|
|
|
- 3966 IF QbeGen.IsImm(q) AND SymTab.ConstInt(q, lo) THEN QbeGen.NormReal(q, qa) ELSE QbeGen.ConvLR(q, qa) END;
|
|
|
- 3967 QbeGen.CopyOp(qa, q);
|
|
|
- 3968 t := vt
|
|
|
- 3969 ELSIF (c1 = SymTab.ClReal)
|
|
|
- 3970 AND (c2 = SymTab.ClInt) THEN
|
|
|
- 3971 QbeGen.ConvRI(q, qa);
|
|
|
- 3972 QbeGen.CopyOp(qa, q);
|
|
|
- 3973 t := vt
|
|
|
- 3974 ELSIF (c1 = SymTab.ClReal)
|
|
|
- 3975 AND (c2 = SymTab.ClLong) THEN
|
|
|
- 3976 QbeGen.ConvRL(q, qa);
|
|
|
- 3977 QbeGen.CopyOp(qa, q);
|
|
|
- 3978 t := vt
|
|
|
- 3979 ELSIF (c1 = SymTab.ClLong)
|
|
|
- 3980 AND (c2 = SymTab.ClLong) THEN
|
|
|
- 3981 t := vt
|
|
|
- 3982 ELSIF ((c1 = SymTab.ClInt)
|
|
|
- 3983 OR (c1 =
|
|
|
- 3984 SymTab.ClChar)
|
|
|
+ 3828 SymTab.ClBool)
|
|
|
+ 3829 AND (SymTab.ClassOf(et) #
|
|
|
+ 3830 SymTab.ClEnum)
|
|
|
+ 3831 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
+ 3832 SemError(211) END
|
|
|
+ 3833 END;
|
|
|
+ 3834 t := SymTab.IntType(); .)
|
|
|
+ 3835 | "CAP" "(" Expr<et, q> ")"
|
|
|
+ 3836 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3837 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CAP"));
|
|
|
+ 3838 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3839 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3840 (. IF QbeGen.IsImm(q)
|
|
|
+ 3841 AND SymTab.ConstInt(q, lo) THEN
|
|
|
+ 3842 IF (lo >= VAL(INTEGER, ORD("a"))) AND (lo <= VAL(INTEGER, ORD("z"))) THEN lo := lo - 32 END;
|
|
|
+ 3843 QbeGen.IntStr(lo, q)
|
|
|
+ 3844 ELSE QbeGen.CopyOp("@", q)
|
|
|
+ 3845 END;
|
|
|
+ 3846 t := SymTab.CharType(); .)
|
|
|
+ 3847 | "UCHR" "(" Expr<et, q> ")"
|
|
|
+ 3848 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3849 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "UCHR"));
|
|
|
+ 3850 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3851 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3852 (. (* UCHR: the UCHAR constructor.
|
|
|
+ 3853 CHAR -> UCHAR (identity);
|
|
|
+ 3854 INTEGER familly -> UCHAR
|
|
|
+ 3855 (codepoint value). *)
|
|
|
+ 3856 IF (et # SymTab.InvalidType)
|
|
|
+ 3857 AND (SymTab.ClassOf(et) # SymTab.ClChar)
|
|
|
+ 3858 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
+ 3859 SemError(211) END;
|
|
|
+ 3860 t := SymTab.UCharType(); .)
|
|
|
+ 3861 | "CHR8" "(" Expr<et, q> ")"
|
|
|
+ 3862 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3863 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "CHR8"));
|
|
|
+ 3864 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3865 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3866 (. IF (et # SymTab.InvalidType)
|
|
|
+ 3867 AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
|
|
|
+ 3868 SemError(211) END;
|
|
|
+ 3869 t := SymTab.CharType(); .)
|
|
|
+ 3870 | "UORD" "(" Expr<et, q> ")"
|
|
|
+ 3871 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3872 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "UORD"));
|
|
|
+ 3873 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3874 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3875 (. (* UORD(u): the codepoint as a
|
|
|
+ 3876 32-bit ordinal (INTEGER),
|
|
|
+ 3877 cf. ORD for CHAR. *)
|
|
|
+ 3878 IF (et # SymTab.InvalidType)
|
|
|
+ 3879 AND (SymTab.ClassOf(et) # SymTab.ClUChar) THEN
|
|
|
+ 3880 SemError(211) END;
|
|
|
+ 3881 t := SymTab.IntType(); .)
|
|
|
+ 3882 | "ABS" "(" Expr<et, q> ")"
|
|
|
+ 3883 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3884 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ABS"));
|
|
|
+ 3885 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3886 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3887 (. IF (et # SymTab.InvalidType)
|
|
|
+ 3888 AND NOT SymTab.IsIntFamily(et)
|
|
|
+ 3889 AND (SymTab.ClassOf(et) #
|
|
|
+ 3890 SymTab.ClReal) THEN
|
|
|
+ 3891 SemError(211)
|
|
|
+ 3892 ELSIF QbeGen.IsImm(q)
|
|
|
+ 3893 AND SymTab.ConstInt(q, lo) THEN
|
|
|
+ 3894 IF lo < 0 THEN lo := -lo END;
|
|
|
+ 3895 QbeGen.IntStr(lo, q)
|
|
|
+ 3896 ELSE QbeGen.CopyOp("@", q)
|
|
|
+ 3897 END;
|
|
|
+ 3898 t := et; .)
|
|
|
+ 3899 | "ODD" "(" Expr<et, q> ")"
|
|
|
+ 3900 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3901 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "ODD"));
|
|
|
+ 3902 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 1, astCur) END;
|
|
|
+ 3903 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3904 (. IF (et # SymTab.InvalidType)
|
|
|
+ 3905 AND NOT SymTab.IsIntFamily(et) THEN
|
|
|
+ 3906 SemError(211) END;
|
|
|
+ 3907 t := SymTab.BoolType();
|
|
|
+ 3908 IF QbeGen.IsImm(q)
|
|
|
+ 3909 AND SymTab.ConstInt(q, lo) THEN
|
|
|
+ 3910 IF (lo MOD 2) # 0 THEN
|
|
|
+ 3911 QbeGen.CopyOp("1", q)
|
|
|
+ 3912 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 3913 END
|
|
|
+ 3914 ELSE QbeGen.CopyOp("@", q)
|
|
|
+ 3915 END; .)
|
|
|
+ 3916 | "TRUNC" "(" Expr<et, q> ")"
|
|
|
+ 3917 (. (* TRUNC(x): real -> INTEGER, as the VAL builtin *)
|
|
|
+ 3918 astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3919 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "VAL"));
|
|
|
+ 3920 AST.SetChild(astNode, 1, AST.MakeLeaf(AST.NkIdent, "INTEGER"));
|
|
|
+ 3921 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
+ 3922 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3923 (. t := SymTab.IntType();
|
|
|
+ 3924 QbeGen.CopyOp("@", q); .)
|
|
|
+ 3925 | "FLOAT" "(" Expr<et, q> ")"
|
|
|
+ 3926 (. (* FLOAT(i): integer -> REAL, as the VAL builtin *)
|
|
|
+ 3927 astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3928 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "VAL"));
|
|
|
+ 3929 AST.SetChild(astNode, 1, AST.MakeLeaf(AST.NkIdent, "REAL"));
|
|
|
+ 3930 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
+ 3931 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3932 (. t := SymTab.RealType();
|
|
|
+ 3933 IF QbeGen.IsImm(q) AND SymTab.ConstInt(q, lo) THEN QbeGen.NormReal(q, qa); QbeGen.CopyOp(qa, q)
|
|
|
+ 3934 ELSE QbeGen.CopyOp("@", q) END; .)
|
|
|
+ 3935 | ( "VAL" | "CONVERT" | "CAST" ) "(" GetIdent<vn> (. astArg2 := AST.MakeLeaf(AST.NkIdent, vn); .) "," Expr<et, q> ")"
|
|
|
+ 3936 (. astNode := AST.MakeNode(AST.NkCall);
|
|
|
+ 3937 AST.SetChild(astNode, 0, AST.MakeLeaf(AST.NkIdent, "VAL"));
|
|
|
+ 3938 IF astArg2 # AST.NoNode THEN AST.SetChild(astNode, 1, astArg2) END;
|
|
|
+ 3939 IF astCur # AST.NoNode THEN AST.SetChild(astNode, 2, astCur) END;
|
|
|
+ 3940 astCur := astNode; astIsLit := TRUE; .)
|
|
|
+ 3941 (. IF NOT SymTab.Lookup(vn) THEN
|
|
|
+ 3942 SemError(201);
|
|
|
+ 3943 t := SymTab.InvalidType
|
|
|
+ 3944 ELSE vt := SymTab.SymType(vn);
|
|
|
+ 3945 IF vt = SymTab.InvalidType THEN
|
|
|
+ 3946 t := SymTab.InvalidType
|
|
|
+ 3947 ELSIF et =
|
|
|
+ 3948 SymTab.InvalidType THEN
|
|
|
+ 3949 t := vt
|
|
|
+ 3950 ELSE
|
|
|
+ 3951 c1 := SymTab.ClassOf(et);
|
|
|
+ 3952 c2 := SymTab.ClassOf(vt);
|
|
|
+ 3953 IF (c1 = SymTab.ClInt)
|
|
|
+ 3954 AND (c2 = SymTab.ClLong) THEN
|
|
|
+ 3955 IF NOT QbeGen.IsImm(q) THEN QbeGen.WidenLong(q, qa); QbeGen.CopyOp(qa, q) END;
|
|
|
+ 3956 t := vt
|
|
|
+ 3957 ELSIF (c1 = SymTab.ClLong)
|
|
|
+ 3958 AND (c2 = SymTab.ClInt) THEN
|
|
|
+ 3959 IF NOT (QbeGen.IsImm(q) AND SymTab.ConstInt(q, lo)) THEN QbeGen.NarrowLong(q, qa); QbeGen.CopyOp(qa, q) END;
|
|
|
+ 3960 t := vt
|
|
|
+ 3961 ELSIF (c1 = SymTab.ClInt)
|
|
|
+ 3962 AND (c2 = SymTab.ClReal) THEN
|
|
|
+ 3963 IF QbeGen.IsImm(q) AND SymTab.ConstInt(q, lo) THEN QbeGen.NormReal(q, qa) ELSE QbeGen.ConvIR(q, qa) END;
|
|
|
+ 3964 QbeGen.CopyOp(qa, q);
|
|
|
+ 3965 t := vt
|
|
|
+ 3966 ELSIF (c1 = SymTab.ClLong)
|
|
|
+ 3967 AND (c2 = SymTab.ClReal) THEN
|
|
|
+ 3968 IF QbeGen.IsImm(q) AND SymTab.ConstInt(q, lo) THEN QbeGen.NormReal(q, qa) ELSE QbeGen.ConvLR(q, qa) END;
|
|
|
+ 3969 QbeGen.CopyOp(qa, q);
|
|
|
+ 3970 t := vt
|
|
|
+ 3971 ELSIF (c1 = SymTab.ClReal)
|
|
|
+ 3972 AND (c2 = SymTab.ClInt) THEN
|
|
|
+ 3973 QbeGen.ConvRI(q, qa);
|
|
|
+ 3974 QbeGen.CopyOp(qa, q);
|
|
|
+ 3975 t := vt
|
|
|
+ 3976 ELSIF (c1 = SymTab.ClReal)
|
|
|
+ 3977 AND (c2 = SymTab.ClLong) THEN
|
|
|
+ 3978 QbeGen.ConvRL(q, qa);
|
|
|
+ 3979 QbeGen.CopyOp(qa, q);
|
|
|
+ 3980 t := vt
|
|
|
+ 3981 ELSIF (c1 = SymTab.ClLong)
|
|
|
+ 3982 AND (c2 = SymTab.ClLong) THEN
|
|
|
+ 3983 t := vt
|
|
|
+ 3984 ELSIF ((c1 = SymTab.ClInt)
|
|
|
3985 OR (c1 =
|
|
|
- 3986 SymTab.ClBool)
|
|
|
+ 3986 SymTab.ClChar)
|
|
|
3987 OR (c1 =
|
|
|
- 3988 SymTab.ClEnum))
|
|
|
- 3989 AND ((c2 = SymTab.ClInt)
|
|
|
- 3990 OR (c2 =
|
|
|
- 3991 SymTab.ClChar)
|
|
|
+ 3988 SymTab.ClBool)
|
|
|
+ 3989 OR (c1 =
|
|
|
+ 3990 SymTab.ClEnum))
|
|
|
+ 3991 AND ((c2 = SymTab.ClInt)
|
|
|
3992 OR (c2 =
|
|
|
- 3993 SymTab.ClBool)
|
|
|
+ 3993 SymTab.ClChar)
|
|
|
3994 OR (c2 =
|
|
|
- 3995 SymTab.ClEnum)) THEN
|
|
|
- 3996 t := vt
|
|
|
- 3997 ELSIF (c1 = SymTab.ClPtr)
|
|
|
- 3998 AND (c2 = SymTab.ClPtr) THEN
|
|
|
- 3999 t := vt
|
|
|
- 4000 ELSIF ((c1 = SymTab.ClProc)
|
|
|
- 4001 AND (c2 = SymTab.ClProc))
|
|
|
- 4002 OR ((c1 = SymTab.ClProc) AND (c2 = SymTab.ClPtr))
|
|
|
- 4003 OR ((c1 = SymTab.ClPtr) AND (c2 = SymTab.ClProc)) THEN
|
|
|
- 4004 t := vt
|
|
|
- 4005 ELSIF (c1 = SymTab.ClReal)
|
|
|
- 4006 AND (c2 = SymTab.ClReal) THEN
|
|
|
- 4007 t := vt
|
|
|
- 4008 ELSIF ((c1 = SymTab.ClSet) AND (c2 = SymTab.ClInt))
|
|
|
- 4009 OR ((c1 = SymTab.ClInt) AND (c2 = SymTab.ClSet)) THEN
|
|
|
- 4010 (* a set <-> its machine word (BITSET) *)
|
|
|
- 4011 t := vt
|
|
|
- 4012 ELSE SemError(230);
|
|
|
- 4013 t := SymTab.InvalidType
|
|
|
- 4014 END
|
|
|
- 4015 END
|
|
|
- 4016 END; .)
|
|
|
- 4017 | "(" Expr<et, q> ")" (. t := et; astIsLit := TRUE; .)
|
|
|
- 4018 | SetLit<st, sq> (. astIsLit := TRUE; t := st;
|
|
|
- 4019 QbeGen.CopyOp(sq, q); .)
|
|
|
- 4020 | ( "NOT" | "~" ) Fact<t2, q2> (. astNot := astCur;
|
|
|
- 4021 IF SymTab.BoolCheck(t2) THEN
|
|
|
- 4022 t := SymTab.BoolType()
|
|
|
- 4023 ELSE SemError(212);
|
|
|
- 4024 t := SymTab.InvalidType END;
|
|
|
- 4025 IF t # SymTab.InvalidType THEN
|
|
|
- 4026 QbeGen.CopyOp("@", q)
|
|
|
- 4027 ELSE QbeGen.CopyOp("0", q)
|
|
|
- 4028 END;
|
|
|
- 4029 astIsLit := TRUE;
|
|
|
- 4030 astCur := AST.MakeUn(
|
|
|
- 4031 AST.NkUnary, AST.OpNot, astNot); .)
|
|
|
- 4032 )
|
|
|
- 4033 (. IF NOT astIsLit THEN astCur := AST.NoNode END; .)
|
|
|
- 4034 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
- 4035 (* Set literals are SET OF [0..255] (8 words); elements validated
|
|
|
- 4036 0..255 statically when foldable (222 otherwise), runtime trap
|
|
|
- 4037 for computed elements. Ranges always lower via SetRange. *)
|
|
|
- 4038 SetLit<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 4039 (. VAR astNode: AST.Node; .)
|
|
|
- 4040 = "{" (. t := SymTab.NewSet(
|
|
|
- 4041 SymTab.NewSubR(0, 255));
|
|
|
- 4042 astNode := AST.MakeNode(AST.NkSetLit);
|
|
|
- 4043 QbeGen.NewSetTemp(8, q);
|
|
|
- 4044 QbeGen.SetZero(q, 8); .)
|
|
|
- 4045 [ SetElem<t, q, astNode> { "," SetElem<t, q, astNode> } ]
|
|
|
- 4046 "}" (. astCur := astNode; .) .
|
|
|
- 4047 (* Typed brace constructor: TypeName{ elems } — BITSET{0} (a set)
|
|
|
- 4048 or ArrayName{...} (an array constructor, GNU Modula-2). The
|
|
|
- 4049 declared type sets the width (set) or element type (array). *)
|
|
|
- 4050 TypedBraceLit<vt: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
- 4051 (. VAR nw: CARDINAL;
|
|
|
- 4052 astNode, astTail: AST.Node;
|
|
|
- 4053 savedCls: INTEGER; .)
|
|
|
- 4054 = "{" (. savedCls := braceCls;
|
|
|
- 4055 astNode := AST.MakeNode(AST.NkBraceLit);
|
|
|
- 4056 AST.SetTy(astNode, vt);
|
|
|
- 4057 astTail := astNode;
|
|
|
- 4058 IF vt = SymTab.InvalidType THEN
|
|
|
- 4059 braceCls := -1
|
|
|
- 4060 ELSE braceCls :=
|
|
|
- 4061 SymTab.ClassOf(vt)
|
|
|
- 4062 END;
|
|
|
- 4063 IF braceCls = SymTab.ClSet THEN
|
|
|
- 4064 IF vt = SymTab.InvalidType THEN
|
|
|
- 4065 nw := 8
|
|
|
- 4066 ELSE nw := SymTab.SetWords(vt);
|
|
|
- 4067 IF nw = 0 THEN nw := 8 END
|
|
|
- 4068 END;
|
|
|
- 4069 QbeGen.NewSetTemp(nw, q);
|
|
|
- 4070 QbeGen.SetZero(q, nw)
|
|
|
- 4071 ELSIF (braceCls =
|
|
|
- 4072 SymTab.ClArray)
|
|
|
- 4073 OR (braceCls =
|
|
|
- 4074 SymTab.ClRecord)
|
|
|
+ 3995 SymTab.ClBool)
|
|
|
+ 3996 OR (c2 =
|
|
|
+ 3997 SymTab.ClEnum)) THEN
|
|
|
+ 3998 t := vt
|
|
|
+ 3999 ELSIF (c1 = SymTab.ClPtr)
|
|
|
+ 4000 AND (c2 = SymTab.ClPtr) THEN
|
|
|
+ 4001 t := vt
|
|
|
+ 4002 ELSIF ((c1 = SymTab.ClProc)
|
|
|
+ 4003 AND (c2 = SymTab.ClProc))
|
|
|
+ 4004 OR ((c1 = SymTab.ClProc) AND (c2 = SymTab.ClPtr))
|
|
|
+ 4005 OR ((c1 = SymTab.ClPtr) AND (c2 = SymTab.ClProc)) THEN
|
|
|
+ 4006 t := vt
|
|
|
+ 4007 ELSIF (c1 = SymTab.ClReal)
|
|
|
+ 4008 AND (c2 = SymTab.ClReal) THEN
|
|
|
+ 4009 t := vt
|
|
|
+ 4010 ELSIF ((c1 = SymTab.ClSet) AND (c2 = SymTab.ClInt))
|
|
|
+ 4011 OR ((c1 = SymTab.ClInt) AND (c2 = SymTab.ClSet)) THEN
|
|
|
+ 4012 (* a set <-> its machine word (BITSET) *)
|
|
|
+ 4013 t := vt
|
|
|
+ 4014 ELSE SemError(230);
|
|
|
+ 4015 t := SymTab.InvalidType
|
|
|
+ 4016 END
|
|
|
+ 4017 END
|
|
|
+ 4018 END; .)
|
|
|
+ 4019 | "(" Expr<et, q> ")" (. t := et; astIsLit := TRUE; .)
|
|
|
+ 4020 | SetLit<st, sq> (. astIsLit := TRUE; t := st;
|
|
|
+ 4021 QbeGen.CopyOp(sq, q); .)
|
|
|
+ 4022 | ( "NOT" | "~" ) Fact<t2, q2> (. astNot := astCur;
|
|
|
+ 4023 IF SymTab.BoolCheck(t2) THEN
|
|
|
+ 4024 t := SymTab.BoolType()
|
|
|
+ 4025 ELSE SemError(212);
|
|
|
+ 4026 t := SymTab.InvalidType END;
|
|
|
+ 4027 IF t # SymTab.InvalidType THEN
|
|
|
+ 4028 QbeGen.CopyOp("@", q)
|
|
|
+ 4029 ELSE QbeGen.CopyOp("0", q)
|
|
|
+ 4030 END;
|
|
|
+ 4031 astIsLit := TRUE;
|
|
|
+ 4032 astCur := AST.MakeUn(
|
|
|
+ 4033 AST.NkUnary, AST.OpNot, astNot); .)
|
|
|
+ 4034 )
|
|
|
+ 4035 (. IF NOT astIsLit THEN astCur := AST.NoNode END; .)
|
|
|
+ 4036 (. IF astCur # AST.NoNode THEN AST.SetTy(astCur, t) END; .) .
|
|
|
+ 4037 (* Set literals are SET OF [0..255] (8 words); elements validated
|
|
|
+ 4038 0..255 statically when foldable (222 otherwise), runtime trap
|
|
|
+ 4039 for computed elements. Ranges always lower via SetRange. *)
|
|
|
+ 4040 SetLit<VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 4041 (. VAR astNode: AST.Node; .)
|
|
|
+ 4042 = "{" (. t := SymTab.NewSet(
|
|
|
+ 4043 SymTab.NewSubR(0, 255));
|
|
|
+ 4044 astNode := AST.MakeNode(AST.NkSetLit);
|
|
|
+ 4045 QbeGen.NewSetTemp(8, q);
|
|
|
+ 4046 QbeGen.SetZero(q, 8); .)
|
|
|
+ 4047 [ SetElem<t, q, astNode> { "," SetElem<t, q, astNode> } ]
|
|
|
+ 4048 "}" (. astCur := astNode; .) .
|
|
|
+ 4049 (* Typed brace constructor: TypeName{ elems } — BITSET{0} (a set)
|
|
|
+ 4050 or ArrayName{...} (an array constructor, GNU Modula-2). The
|
|
|
+ 4051 declared type sets the width (set) or element type (array). *)
|
|
|
+ 4052 TypedBraceLit<vt: SymTab.TypeIndex; VAR q: QbeGen.QVal>
|
|
|
+ 4053 (. VAR nw: CARDINAL;
|
|
|
+ 4054 astNode, astTail: AST.Node;
|
|
|
+ 4055 savedCls: INTEGER; .)
|
|
|
+ 4056 = "{" (. savedCls := braceCls;
|
|
|
+ 4057 astNode := AST.MakeNode(AST.NkBraceLit);
|
|
|
+ 4058 AST.SetTy(astNode, vt);
|
|
|
+ 4059 astTail := astNode;
|
|
|
+ 4060 IF vt = SymTab.InvalidType THEN
|
|
|
+ 4061 braceCls := -1
|
|
|
+ 4062 ELSE braceCls :=
|
|
|
+ 4063 SymTab.ClassOf(vt)
|
|
|
+ 4064 END;
|
|
|
+ 4065 IF braceCls = SymTab.ClSet THEN
|
|
|
+ 4066 IF vt = SymTab.InvalidType THEN
|
|
|
+ 4067 nw := 8
|
|
|
+ 4068 ELSE nw := SymTab.SetWords(vt);
|
|
|
+ 4069 IF nw = 0 THEN nw := 8 END
|
|
|
+ 4070 END;
|
|
|
+ 4071 QbeGen.NewSetTemp(nw, q);
|
|
|
+ 4072 QbeGen.SetZero(q, nw)
|
|
|
+ 4073 ELSIF (braceCls =
|
|
|
+ 4074 SymTab.ClArray)
|
|
|
4075 OR (braceCls =
|
|
|
- 4076 SymTab.ClClass) THEN
|
|
|
- 4077 QbeGen.CtorBegin(vt)
|
|
|
- 4078 ELSE
|
|
|
- 4079 IF vt # SymTab.InvalidType THEN
|
|
|
- 4080 SemError(230) END;
|
|
|
- 4081 braceCls := -1
|
|
|
- 4082 END; .)
|
|
|
- 4083 [ BraceElem<vt, q, astNode, astTail>
|
|
|
- 4084 { "," BraceElem<vt, q, astNode, astTail> } ]
|
|
|
- 4085 "}" (. IF (braceCls = SymTab.ClArray)
|
|
|
- 4086 OR (braceCls =
|
|
|
- 4087 SymTab.ClRecord)
|
|
|
+ 4076 SymTab.ClRecord)
|
|
|
+ 4077 OR (braceCls =
|
|
|
+ 4078 SymTab.ClClass) THEN
|
|
|
+ 4079 QbeGen.CtorBegin(vt)
|
|
|
+ 4080 ELSE
|
|
|
+ 4081 IF vt # SymTab.InvalidType THEN
|
|
|
+ 4082 SemError(230) END;
|
|
|
+ 4083 braceCls := -1
|
|
|
+ 4084 END; .)
|
|
|
+ 4085 [ BraceElem<vt, q, astNode, astTail>
|
|
|
+ 4086 { "," BraceElem<vt, q, astNode, astTail> } ]
|
|
|
+ 4087 "}" (. IF (braceCls = SymTab.ClArray)
|
|
|
4088 OR (braceCls =
|
|
|
- 4089 SymTab.ClClass) THEN
|
|
|
- 4090 QbeGen.CtorEnd(q)
|
|
|
- 4091 ELSIF braceCls # SymTab.ClSet THEN
|
|
|
- 4092 QbeGen.CopyOp("0", q)
|
|
|
- 4093 END;
|
|
|
- 4094 braceCls := savedCls; .)
|
|
|
- 4095 (. astCur := astNode; .) .
|
|
|
- 4096 BraceElem<vt: SymTab.TypeIndex; VAR sq: QbeGen.QVal;
|
|
|
- 4097 VAR node, tail: AST.Node>
|
|
|
- 4098 (. VAR et, et2: SymTab.TypeIndex;
|
|
|
- 4099 qe, q2: QbeGen.QVal;
|
|
|
- 4100 v, v2, reps, k: INTEGER;
|
|
|
- 4101 elem: SymTab.TypeIndex;
|
|
|
- 4102 lo: INTEGER;
|
|
|
- 4103 span: CARDINAL;
|
|
|
- 4104 cl, cl2: INTEGER;
|
|
|
- 4105 hasR, hasB: BOOLEAN;
|
|
|
- 4106 astEl: AST.Node; .)
|
|
|
- 4107 = (. hasR := FALSE; hasB := FALSE;
|
|
|
- 4108 reps := 1; .)
|
|
|
- 4109 Expr<et, qe> (. astEl := astCur; .)
|
|
|
- 4110 [ ".." Expr<et2, q2> (. astEl := AST.MakeBin(
|
|
|
- 4111 AST.NkSubrange, 0, astEl, astCur);
|
|
|
- 4112 hasR := TRUE; .) ]
|
|
|
- 4113 [ "BY" Expr<et2, q2> (. hasB := TRUE; .) ]
|
|
|
- 4114 (. IF braceCls = SymTab.ClSet THEN
|
|
|
- 4115 IF hasB THEN SemError(230) END;
|
|
|
- 4116 lo := SymTab.SetBaseLo(vt);
|
|
|
- 4117 span := SymTab.SetCount(vt);
|
|
|
- 4118 IF (et = SymTab.InvalidType)
|
|
|
- 4119 OR (hasR AND (et2 =
|
|
|
- 4120 SymTab.InvalidType)) THEN
|
|
|
- 4121 ELSE cl :=
|
|
|
- 4122 SymTab.ClassOf(et);
|
|
|
- 4123 IF hasR THEN
|
|
|
- 4124 cl2 :=
|
|
|
- 4125 SymTab.ClassOf(et2)
|
|
|
- 4126 ELSE cl2 := SymTab.ClInt
|
|
|
- 4127 END;
|
|
|
- 4128 IF NOT SymTab.SetElemClassOk(cl)
|
|
|
- 4129 OR (hasR AND NOT
|
|
|
- 4130 SymTab.SetElemClassOk(cl2))
|
|
|
- 4131 THEN
|
|
|
- 4132 SemError(222)
|
|
|
- 4133 ELSIF hasR
|
|
|
- 4134 AND SymTab.ConstInt(qe, v)
|
|
|
- 4135 AND SymTab.ConstInt(q2,
|
|
|
- 4136 v2)
|
|
|
- 4137 AND ((v < lo)
|
|
|
- 4138 OR (v2 < lo)
|
|
|
- 4139 OR (v >= lo +
|
|
|
- 4140 VAL(INTEGER, span))
|
|
|
- 4141 OR (v2 >= lo +
|
|
|
+ 4089 SymTab.ClRecord)
|
|
|
+ 4090 OR (braceCls =
|
|
|
+ 4091 SymTab.ClClass) THEN
|
|
|
+ 4092 QbeGen.CtorEnd(q)
|
|
|
+ 4093 ELSIF braceCls # SymTab.ClSet THEN
|
|
|
+ 4094 QbeGen.CopyOp("0", q)
|
|
|
+ 4095 END;
|
|
|
+ 4096 braceCls := savedCls; .)
|
|
|
+ 4097 (. astCur := astNode; .) .
|
|
|
+ 4098 BraceElem<vt: SymTab.TypeIndex; VAR sq: QbeGen.QVal;
|
|
|
+ 4099 VAR node, tail: AST.Node>
|
|
|
+ 4100 (. VAR et, et2: SymTab.TypeIndex;
|
|
|
+ 4101 qe, q2: QbeGen.QVal;
|
|
|
+ 4102 v, v2, reps, k: INTEGER;
|
|
|
+ 4103 elem: SymTab.TypeIndex;
|
|
|
+ 4104 lo: INTEGER;
|
|
|
+ 4105 span: CARDINAL;
|
|
|
+ 4106 cl, cl2: INTEGER;
|
|
|
+ 4107 hasR, hasB: BOOLEAN;
|
|
|
+ 4108 astEl: AST.Node; .)
|
|
|
+ 4109 = (. hasR := FALSE; hasB := FALSE;
|
|
|
+ 4110 reps := 1; .)
|
|
|
+ 4111 Expr<et, qe> (. astEl := astCur; .)
|
|
|
+ 4112 [ ".." Expr<et2, q2> (. astEl := AST.MakeBin(
|
|
|
+ 4113 AST.NkSubrange, 0, astEl, astCur);
|
|
|
+ 4114 hasR := TRUE; .) ]
|
|
|
+ 4115 [ "BY" Expr<et2, q2> (. hasB := TRUE; .) ]
|
|
|
+ 4116 (. IF braceCls = SymTab.ClSet THEN
|
|
|
+ 4117 IF hasB THEN SemError(230) END;
|
|
|
+ 4118 lo := SymTab.SetBaseLo(vt);
|
|
|
+ 4119 span := SymTab.SetCount(vt);
|
|
|
+ 4120 IF (et = SymTab.InvalidType)
|
|
|
+ 4121 OR (hasR AND (et2 =
|
|
|
+ 4122 SymTab.InvalidType)) THEN
|
|
|
+ 4123 ELSE cl :=
|
|
|
+ 4124 SymTab.ClassOf(et);
|
|
|
+ 4125 IF hasR THEN
|
|
|
+ 4126 cl2 :=
|
|
|
+ 4127 SymTab.ClassOf(et2)
|
|
|
+ 4128 ELSE cl2 := SymTab.ClInt
|
|
|
+ 4129 END;
|
|
|
+ 4130 IF NOT SymTab.SetElemClassOk(cl)
|
|
|
+ 4131 OR (hasR AND NOT
|
|
|
+ 4132 SymTab.SetElemClassOk(cl2))
|
|
|
+ 4133 THEN
|
|
|
+ 4134 SemError(222)
|
|
|
+ 4135 ELSIF hasR
|
|
|
+ 4136 AND SymTab.ConstInt(qe, v)
|
|
|
+ 4137 AND SymTab.ConstInt(q2,
|
|
|
+ 4138 v2)
|
|
|
+ 4139 AND ((v < lo)
|
|
|
+ 4140 OR (v2 < lo)
|
|
|
+ 4141 OR (v >= lo +
|
|
|
4142 VAL(INTEGER, span))
|
|
|
- 4143 OR (v > v2)) THEN
|
|
|
- 4144 SemError(222)
|
|
|
- 4145 ELSIF hasR THEN
|
|
|
- 4146 QbeGen.SetRange(sq, qe, q2,
|
|
|
- 4147 lo, span)
|
|
|
- 4148 ELSIF SymTab.ConstInt(qe,
|
|
|
- 4149 v)
|
|
|
- 4150 AND ((v < lo)
|
|
|
- 4151 OR (v >= lo +
|
|
|
- 4152 VAL(INTEGER,
|
|
|
- 4153 span))) THEN
|
|
|
- 4154 SemError(222)
|
|
|
- 4155 ELSE QbeGen.SetBit(sq, qe,
|
|
|
- 4156 lo, span)
|
|
|
- 4157 END
|
|
|
- 4158 END
|
|
|
- 4159 ELSIF (braceCls = SymTab.ClArray)
|
|
|
- 4160 OR (braceCls =
|
|
|
- 4161 SymTab.ClRecord)
|
|
|
+ 4143 OR (v2 >= lo +
|
|
|
+ 4144 VAL(INTEGER, span))
|
|
|
+ 4145 OR (v > v2)) THEN
|
|
|
+ 4146 SemError(222)
|
|
|
+ 4147 ELSIF hasR THEN
|
|
|
+ 4148 QbeGen.SetRange(sq, qe, q2,
|
|
|
+ 4149 lo, span)
|
|
|
+ 4150 ELSIF SymTab.ConstInt(qe,
|
|
|
+ 4151 v)
|
|
|
+ 4152 AND ((v < lo)
|
|
|
+ 4153 OR (v >= lo +
|
|
|
+ 4154 VAL(INTEGER,
|
|
|
+ 4155 span))) THEN
|
|
|
+ 4156 SemError(222)
|
|
|
+ 4157 ELSE QbeGen.SetBit(sq, qe,
|
|
|
+ 4158 lo, span)
|
|
|
+ 4159 END
|
|
|
+ 4160 END
|
|
|
+ 4161 ELSIF (braceCls = SymTab.ClArray)
|
|
|
4162 OR (braceCls =
|
|
|
- 4163 SymTab.ClClass) THEN
|
|
|
- 4164 IF hasR THEN SemError(230) END;
|
|
|
- 4165 reps := 1;
|
|
|
- 4166 IF hasB THEN
|
|
|
- 4167 IF SymTab.ConstInt(q2, v2)
|
|
|
- 4168 AND (v2 >= 1) THEN
|
|
|
- 4169 reps := v2
|
|
|
- 4170 ELSE SemError(230)
|
|
|
- 4171 END
|
|
|
- 4172 END;
|
|
|
- 4173 k := 0;
|
|
|
- 4174 WHILE k < reps DO
|
|
|
- 4175 QbeGen.CtorElem(qe);
|
|
|
- 4176 INC(k)
|
|
|
- 4177 END
|
|
|
- 4178 END; .)
|
|
|
- 4179 (. (* the BY form repeats the
|
|
|
- 4180 element; keep the AST in
|
|
|
- 4181 step with CtorElem *)
|
|
|
- 4182 k := 0;
|
|
|
- 4183 WHILE k < reps DO
|
|
|
- 4184 AstAppend(AST.NkBlock,
|
|
|
- 4185 node, tail, astEl);
|
|
|
- 4186 INC(k)
|
|
|
- 4187 END; .) .
|
|
|
- 4188 SetElem<st: SymTab.TypeIndex; sq: QbeGen.QVal; node: AST.Node> (. VAR et, et2: SymTab.TypeIndex;
|
|
|
- 4189 qe, q2: QbeGen.QVal;
|
|
|
- 4190 v, v2: INTEGER;
|
|
|
- 4191 lo: INTEGER;
|
|
|
- 4192 span: CARDINAL;
|
|
|
- 4193 cl, cl2: INTEGER;
|
|
|
- 4194 hasR: BOOLEAN;
|
|
|
- 4195 astEl: AST.Node; .)
|
|
|
- 4196 = (. hasR := FALSE; .)
|
|
|
- 4197 Expr<et, qe> (. astEl := astCur; .)
|
|
|
- 4198 [ ".." Expr<et2, q2> (. astEl := AST.MakeBin(
|
|
|
- 4199 AST.NkSubrange, 0, astEl, astCur);
|
|
|
- 4200 hasR := TRUE; .) ]
|
|
|
- 4201 (. lo := SymTab.SetBaseLo(st);
|
|
|
- 4202 span := SymTab.SetCount(st);
|
|
|
- 4203 IF (et = SymTab.InvalidType)
|
|
|
- 4204 OR (hasR AND (et2 =
|
|
|
- 4205 SymTab.InvalidType)) THEN
|
|
|
- 4206 ELSE cl :=
|
|
|
- 4207 SymTab.ClassOf(et);
|
|
|
- 4208 IF hasR THEN
|
|
|
- 4209 cl2 :=
|
|
|
- 4210 SymTab.ClassOf(et2)
|
|
|
- 4211 ELSE cl2 := SymTab.ClInt
|
|
|
- 4212 END;
|
|
|
- 4213 IF NOT SymTab.SetElemClassOk(cl)
|
|
|
- 4214 OR (hasR AND NOT
|
|
|
- 4215 SymTab.SetElemClassOk(cl2))
|
|
|
- 4216 THEN
|
|
|
- 4217 SemError(222)
|
|
|
- 4218 ELSIF hasR
|
|
|
- 4219 AND SymTab.ConstInt(qe, v)
|
|
|
- 4220 AND SymTab.ConstInt(q2,
|
|
|
- 4221 v2)
|
|
|
- 4222 AND ((v < lo)
|
|
|
- 4223 OR (v2 < lo)
|
|
|
- 4224 OR (v >= lo +
|
|
|
- 4225 VAL(INTEGER, span))
|
|
|
- 4226 OR (v2 >= lo +
|
|
|
+ 4163 SymTab.ClRecord)
|
|
|
+ 4164 OR (braceCls =
|
|
|
+ 4165 SymTab.ClClass) THEN
|
|
|
+ 4166 IF hasR THEN SemError(230) END;
|
|
|
+ 4167 reps := 1;
|
|
|
+ 4168 IF hasB THEN
|
|
|
+ 4169 IF SymTab.ConstInt(q2, v2)
|
|
|
+ 4170 AND (v2 >= 1) THEN
|
|
|
+ 4171 reps := v2
|
|
|
+ 4172 ELSE SemError(230)
|
|
|
+ 4173 END
|
|
|
+ 4174 END;
|
|
|
+ 4175 k := 0;
|
|
|
+ 4176 WHILE k < reps DO
|
|
|
+ 4177 QbeGen.CtorElem(qe);
|
|
|
+ 4178 INC(k)
|
|
|
+ 4179 END
|
|
|
+ 4180 END; .)
|
|
|
+ 4181 (. (* the BY form repeats the
|
|
|
+ 4182 element; keep the AST in
|
|
|
+ 4183 step with CtorElem *)
|
|
|
+ 4184 k := 0;
|
|
|
+ 4185 WHILE k < reps DO
|
|
|
+ 4186 AstAppend(AST.NkBlock,
|
|
|
+ 4187 node, tail, astEl);
|
|
|
+ 4188 INC(k)
|
|
|
+ 4189 END; .) .
|
|
|
+ 4190 SetElem<st: SymTab.TypeIndex; sq: QbeGen.QVal; node: AST.Node> (. VAR et, et2: SymTab.TypeIndex;
|
|
|
+ 4191 qe, q2: QbeGen.QVal;
|
|
|
+ 4192 v, v2: INTEGER;
|
|
|
+ 4193 lo: INTEGER;
|
|
|
+ 4194 span: CARDINAL;
|
|
|
+ 4195 cl, cl2: INTEGER;
|
|
|
+ 4196 hasR: BOOLEAN;
|
|
|
+ 4197 astEl: AST.Node; .)
|
|
|
+ 4198 = (. hasR := FALSE; .)
|
|
|
+ 4199 Expr<et, qe> (. astEl := astCur; .)
|
|
|
+ 4200 [ ".." Expr<et2, q2> (. astEl := AST.MakeBin(
|
|
|
+ 4201 AST.NkSubrange, 0, astEl, astCur);
|
|
|
+ 4202 hasR := TRUE; .) ]
|
|
|
+ 4203 (. lo := SymTab.SetBaseLo(st);
|
|
|
+ 4204 span := SymTab.SetCount(st);
|
|
|
+ 4205 IF (et = SymTab.InvalidType)
|
|
|
+ 4206 OR (hasR AND (et2 =
|
|
|
+ 4207 SymTab.InvalidType)) THEN
|
|
|
+ 4208 ELSE cl :=
|
|
|
+ 4209 SymTab.ClassOf(et);
|
|
|
+ 4210 IF hasR THEN
|
|
|
+ 4211 cl2 :=
|
|
|
+ 4212 SymTab.ClassOf(et2)
|
|
|
+ 4213 ELSE cl2 := SymTab.ClInt
|
|
|
+ 4214 END;
|
|
|
+ 4215 IF NOT SymTab.SetElemClassOk(cl)
|
|
|
+ 4216 OR (hasR AND NOT
|
|
|
+ 4217 SymTab.SetElemClassOk(cl2))
|
|
|
+ 4218 THEN
|
|
|
+ 4219 SemError(222)
|
|
|
+ 4220 ELSIF hasR
|
|
|
+ 4221 AND SymTab.ConstInt(qe, v)
|
|
|
+ 4222 AND SymTab.ConstInt(q2,
|
|
|
+ 4223 v2)
|
|
|
+ 4224 AND ((v < lo)
|
|
|
+ 4225 OR (v2 < lo)
|
|
|
+ 4226 OR (v >= lo +
|
|
|
4227 VAL(INTEGER, span))
|
|
|
- 4228 OR (v > v2)) THEN
|
|
|
- 4229 SemError(222)
|
|
|
- 4230 ELSIF hasR THEN
|
|
|
- 4231 QbeGen.SetRange(sq, qe, q2,
|
|
|
- 4232 lo, span)
|
|
|
- 4233 ELSIF SymTab.ConstInt(qe,
|
|
|
- 4234 v)
|
|
|
- 4235 AND ((v < lo)
|
|
|
- 4236 OR (v >= lo +
|
|
|
- 4237 VAL(INTEGER,
|
|
|
- 4238 span))) THEN
|
|
|
- 4239 SemError(222)
|
|
|
- 4240 ELSE QbeGen.SetBit(sq, qe,
|
|
|
- 4241 lo, span)
|
|
|
- 4242 END
|
|
|
- 4243 END; .)
|
|
|
- 4244 (. AST.SetChild(node,
|
|
|
- 4245 AST.NChild(node), astEl); .) .
|
|
|
- 4246 GetIdent<VAR n: SymTab.Name>
|
|
|
- 4247 = ident (. LexName(n); .) .
|
|
|
- 4248
|
|
|
- 4249 END M2.
|
|
|
+ 4228 OR (v2 >= lo +
|
|
|
+ 4229 VAL(INTEGER, span))
|
|
|
+ 4230 OR (v > v2)) THEN
|
|
|
+ 4231 SemError(222)
|
|
|
+ 4232 ELSIF hasR THEN
|
|
|
+ 4233 QbeGen.SetRange(sq, qe, q2,
|
|
|
+ 4234 lo, span)
|
|
|
+ 4235 ELSIF SymTab.ConstInt(qe,
|
|
|
+ 4236 v)
|
|
|
+ 4237 AND ((v < lo)
|
|
|
+ 4238 OR (v >= lo +
|
|
|
+ 4239 VAL(INTEGER,
|
|
|
+ 4240 span))) THEN
|
|
|
+ 4241 SemError(222)
|
|
|
+ 4242 ELSE QbeGen.SetBit(sq, qe,
|
|
|
+ 4243 lo, span)
|
|
|
+ 4244 END
|
|
|
+ 4245 END; .)
|
|
|
+ 4246 (. AST.SetChild(node,
|
|
|
+ 4247 AST.NChild(node), astEl); .) .
|
|
|
+ 4248 GetIdent<VAR n: SymTab.Name>
|
|
|
+ 4249 = ident (. LexName(n); .) .
|
|
|
+ 4250
|
|
|
+ 4251 END M2.
|
|
|
|
|
|
0 errors
|
|
|
|
