|
|
@@ -631,11 +631,6 @@ PROCEDURE NewAlias (): TypeIndex;
|
|
|
RETURN NewDesc(FAlias, InvalidType)
|
|
|
END NewAlias;
|
|
|
|
|
|
-PROCEDURE NewSub (base: TypeIndex): TypeIndex;
|
|
|
- BEGIN
|
|
|
- RETURN NewDesc(FSub, base)
|
|
|
- END NewSub;
|
|
|
-
|
|
|
PROCEDURE NewSubR (lo, hi: INTEGER): TypeIndex;
|
|
|
VAR t: TypeIndex;
|
|
|
BEGIN
|
|
|
@@ -702,17 +697,6 @@ PROCEDURE BoundHi (i: CARDINAL): INTEGER;
|
|
|
IF i < nBounds THEN RETURN bhi[i] ELSE RETURN -1 END
|
|
|
END BoundHi;
|
|
|
|
|
|
-PROCEDURE NestArray (elem: TypeIndex): TypeIndex;
|
|
|
- VAR i: CARDINAL;
|
|
|
- BEGIN
|
|
|
- i := nBounds;
|
|
|
- WHILE i > 0 DO
|
|
|
- DEC(i);
|
|
|
- elem := NewArrayB(elem, blo[i], bhi[i])
|
|
|
- END;
|
|
|
- RETURN elem
|
|
|
- END NestArray;
|
|
|
-
|
|
|
PROCEDURE NewRecord (): TypeIndex;
|
|
|
BEGIN
|
|
|
RETURN NewDesc(FRecord, -1)
|
|
|
@@ -2153,11 +2137,6 @@ PROCEDURE CurRes (): TypeIndex;
|
|
|
RETURN procStk[nProc - 1]^.rslt
|
|
|
END CurRes;
|
|
|
|
|
|
-PROCEDURE ProcDepth (): CARDINAL;
|
|
|
- BEGIN
|
|
|
- RETURN nProc
|
|
|
- END ProcDepth;
|
|
|
-
|
|
|
PROCEDURE ProcDepthOf (name: ARRAY OF CHAR): CARDINAL;
|
|
|
VAR node: SymPtr;
|
|
|
BEGIN
|
|
|
@@ -2219,20 +2198,6 @@ PROCEDURE ParamIsVar (name: ARRAY OF CHAR; i: CARDINAL): BOOLEAN;
|
|
|
RETURN p^.isVar
|
|
|
END ParamIsVar;
|
|
|
|
|
|
-PROCEDURE ParamName (name: ARRAY OF CHAR; i: CARDINAL;
|
|
|
- VAR out: ARRAY OF CHAR): BOOLEAN;
|
|
|
- VAR node, p: SymPtr;
|
|
|
- BEGIN
|
|
|
- out[0] := CHR(0);
|
|
|
- node := Find(name);
|
|
|
- IF node = NIL THEN RETURN FALSE END;
|
|
|
- IF node^.kind # KindProc THEN RETURN FALSE END;
|
|
|
- p := NthParam(node, i);
|
|
|
- IF p = NIL THEN RETURN FALSE END;
|
|
|
- Assign(out, p^.name);
|
|
|
- RETURN TRUE
|
|
|
- END ParamName;
|
|
|
-
|
|
|
|
|
|
(* ---------------- modules / separate compilation (step 4.3) ---------------- *)
|
|
|
|
|
|
@@ -2335,37 +2300,11 @@ PROCEDURE EndUnit;
|
|
|
curUnit := -1
|
|
|
END EndUnit;
|
|
|
|
|
|
-PROCEDURE CurUnit (): INTEGER;
|
|
|
- BEGIN
|
|
|
- RETURN curUnit
|
|
|
- END CurUnit;
|
|
|
-
|
|
|
-PROCEDURE CurModule (VAR name: Name);
|
|
|
- BEGIN
|
|
|
- IF curMod < 0 THEN name[0] := CHR(0)
|
|
|
- ELSE Assign(name, modNames[curMod])
|
|
|
- END
|
|
|
- END CurModule;
|
|
|
-
|
|
|
PROCEDURE ModKnown (name: ARRAY OF CHAR): BOOLEAN;
|
|
|
BEGIN
|
|
|
RETURN FindMod(name) # -1
|
|
|
END ModKnown;
|
|
|
|
|
|
-PROCEDURE ModDefined (name: ARRAY OF CHAR): BOOLEAN;
|
|
|
- VAR i : INTEGER;
|
|
|
- BEGIN
|
|
|
- i := FindMod(name);
|
|
|
- RETURN (i # -1) AND (modKind[i] # UnitProg)
|
|
|
- END ModDefined;
|
|
|
-
|
|
|
-PROCEDURE ModImplemented (name: ARRAY OF CHAR): BOOLEAN;
|
|
|
- VAR i : INTEGER;
|
|
|
- BEGIN
|
|
|
- i := FindMod(name);
|
|
|
- RETURN (i # -1) AND modImpl[i]
|
|
|
- END ModImplemented;
|
|
|
-
|
|
|
PROCEDURE OpaqueBase (name: ARRAY OF CHAR): TypeIndex;
|
|
|
VAR node: SymPtr;
|
|
|
r : TypeIndex;
|
|
|
@@ -2450,19 +2389,6 @@ PROCEDURE QualNode (mod, name: ARRAY OF CHAR): SymPtr;
|
|
|
RETURN TreeFind(modScopes[i]^.root, name)
|
|
|
END QualNode;
|
|
|
|
|
|
-PROCEDURE QualFind (mod, name: ARRAY OF CHAR): BOOLEAN;
|
|
|
- BEGIN
|
|
|
- RETURN QualNode(mod, name) # NIL
|
|
|
- END QualFind;
|
|
|
-
|
|
|
-PROCEDURE QualKind (mod, name: ARRAY OF CHAR): INTEGER;
|
|
|
- VAR n : SymPtr;
|
|
|
- BEGIN
|
|
|
- n := QualNode(mod, name);
|
|
|
- IF n = NIL THEN RETURN -1 END;
|
|
|
- RETURN n^.kind
|
|
|
- END QualKind;
|
|
|
-
|
|
|
PROCEDURE QualType (mod, name: ARRAY OF CHAR): TypeIndex;
|
|
|
VAR n : SymPtr;
|
|
|
BEGIN
|
|
|
@@ -2471,15 +2397,6 @@ PROCEDURE QualType (mod, name: ARRAY OF CHAR): TypeIndex;
|
|
|
RETURN n^.typ
|
|
|
END QualType;
|
|
|
|
|
|
-PROCEDURE QualProcUid (mod, name: ARRAY OF CHAR): CARDINAL;
|
|
|
- VAR n : SymPtr;
|
|
|
- BEGIN
|
|
|
- n := QualNode(mod, name);
|
|
|
- IF n = NIL THEN RETURN 0 END;
|
|
|
- IF n^.kind # KindProc THEN RETURN 0 END;
|
|
|
- RETURN n^.uid
|
|
|
- END QualProcUid;
|
|
|
-
|
|
|
PROCEDURE QualNthParam (n: SymPtr; i: CARDINAL): SymPtr;
|
|
|
BEGIN
|
|
|
n := n^.plink;
|
|
|
@@ -2489,51 +2406,6 @@ PROCEDURE QualNthParam (n: SymPtr; i: CARDINAL): SymPtr;
|
|
|
RETURN n
|
|
|
END QualNthParam;
|
|
|
|
|
|
-PROCEDURE QualProcNPar (mod, name: ARRAY OF CHAR): CARDINAL;
|
|
|
- VAR n, p : SymPtr;
|
|
|
- c : CARDINAL;
|
|
|
- BEGIN
|
|
|
- n := QualNode(mod, name);
|
|
|
- IF n = NIL THEN RETURN 0 END;
|
|
|
- IF n^.kind # KindProc THEN RETURN 0 END;
|
|
|
- c := 0; p := n^.plink;
|
|
|
- WHILE p # NIL DO INC(c); p := p^.plink END;
|
|
|
- RETURN c
|
|
|
- END QualProcNPar;
|
|
|
-
|
|
|
-PROCEDURE QualParamType (mod, name: ARRAY OF CHAR; i: CARDINAL):
|
|
|
- TypeIndex;
|
|
|
- VAR n, p : SymPtr;
|
|
|
- BEGIN
|
|
|
- n := QualNode(mod, name);
|
|
|
- IF n = NIL THEN RETURN InvalidType END;
|
|
|
- IF n^.kind # KindProc THEN RETURN InvalidType END;
|
|
|
- p := QualNthParam(n, i);
|
|
|
- IF p = NIL THEN RETURN InvalidType END;
|
|
|
- RETURN p^.typ
|
|
|
- END QualParamType;
|
|
|
-
|
|
|
-PROCEDURE QualParamIsVar (mod, name: ARRAY OF CHAR; i: CARDINAL):
|
|
|
- BOOLEAN;
|
|
|
- VAR n, p : SymPtr;
|
|
|
- BEGIN
|
|
|
- n := QualNode(mod, name);
|
|
|
- IF n = NIL THEN RETURN FALSE END;
|
|
|
- IF n^.kind # KindProc THEN RETURN FALSE END;
|
|
|
- p := QualNthParam(n, i);
|
|
|
- IF p = NIL THEN RETURN FALSE END;
|
|
|
- RETURN p^.isVar
|
|
|
- END QualParamIsVar;
|
|
|
-
|
|
|
-PROCEDURE QualProcRes (mod, name: ARRAY OF CHAR): TypeIndex;
|
|
|
- VAR n : SymPtr;
|
|
|
- BEGIN
|
|
|
- n := QualNode(mod, name);
|
|
|
- IF n = NIL THEN RETURN InvalidType END;
|
|
|
- IF n^.kind # KindProc THEN RETURN InvalidType END;
|
|
|
- RETURN n^.rslt
|
|
|
- END QualProcRes;
|
|
|
-
|
|
|
PROCEDURE ExportUp (name: ARRAY OF CHAR);
|
|
|
VAR src, node: SymPtr;
|
|
|
parent: ScopePtr;
|
|
|
@@ -2735,14 +2607,6 @@ PROCEDURE FwdVarType (id: INTEGER): TypeIndex;
|
|
|
RETURN InvalidType
|
|
|
END FwdVarType;
|
|
|
|
|
|
-PROCEDURE FwdVarKind (id: INTEGER): INTEGER;
|
|
|
- BEGIN
|
|
|
- IF (id >= 1) AND (id <= VAL(INTEGER, nFwdVar)) THEN
|
|
|
- RETURN fwdVarKind[id - 1]
|
|
|
- END;
|
|
|
- RETURN -1
|
|
|
- END FwdVarKind;
|
|
|
-
|
|
|
PROCEDURE FwdVarResolve (id: INTEGER): BOOLEAN;
|
|
|
(* Resolves forward reference id against the module's declarations.
|
|
|
TRUE when the name now exists; sets the recorded placeholder's
|
|
|
@@ -2917,17 +2781,6 @@ PROCEDURE ArithCheck (l, r: TypeIndex; divmod: BOOLEAN;
|
|
|
RETURN FALSE
|
|
|
END ArithCheck;
|
|
|
|
|
|
-PROCEDURE UnaryCheck (t: TypeIndex; VAR res: TypeIndex): BOOLEAN;
|
|
|
- BEGIN
|
|
|
- res := InvalidType;
|
|
|
- IF IsFwdVar(t) THEN res := dInt; RETURN TRUE END;
|
|
|
- IF t = InvalidType THEN RETURN TRUE END;
|
|
|
- IF IsLongFamily(t) THEN res := dLong; RETURN TRUE END;
|
|
|
- IF IsIntFamily(t) THEN res := dInt; RETURN TRUE END;
|
|
|
- IF ClassOf(t) = ClReal THEN res := dReal; RETURN TRUE END;
|
|
|
- RETURN FALSE
|
|
|
- END UnaryCheck;
|
|
|
-
|
|
|
PROCEDURE BoolCheck (t: TypeIndex): BOOLEAN;
|
|
|
BEGIN
|
|
|
IF t = InvalidType THEN RETURN TRUE END;
|
|
|
@@ -3083,24 +2936,6 @@ PROCEDURE RelCheck (l, r: TypeIndex; op: INTEGER): BOOLEAN;
|
|
|
RETURN OrdCheck(l, r)
|
|
|
END RelCheck;
|
|
|
|
|
|
-PROCEDURE SetElemCheck (first, elem: TypeIndex): BOOLEAN;
|
|
|
- BEGIN
|
|
|
- IF (first = InvalidType) OR (elem = InvalidType) THEN
|
|
|
- RETURN TRUE
|
|
|
- END;
|
|
|
- IF SameType(first, elem) THEN RETURN TRUE END;
|
|
|
- IF IsIntFamily(first) AND IsIntFamily(elem) THEN RETURN TRUE END;
|
|
|
- RETURN FALSE
|
|
|
- END SetElemCheck;
|
|
|
-
|
|
|
-PROCEDURE SetFor (elem: TypeIndex): TypeIndex;
|
|
|
- VAR e: TypeIndex;
|
|
|
- BEGIN
|
|
|
- e := Resolve(elem);
|
|
|
- IF e = InvalidType THEN e := dInt END;
|
|
|
- RETURN NewSet(e)
|
|
|
- END SetFor;
|
|
|
-
|
|
|
(* ---------------- init ---------------- *)
|
|
|
|
|
|
PROCEDURE Predef (name: ARRAY OF CHAR; kind: INTEGER; t: TypeIndex);
|