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