IsReallyPointer, IsPointer, IsParameter, ModeOfAddr,
GetMode, GetType, IsUnbounded, IsComposite, IsConstructor,
IsParameter, IsConstString, IsConstLitInternal, IsConstLit,
- GetStringLength, GetProcedureProcType ;
+ GetStringLength, GetProcedureProcType, IsHiddenType,
+ IsHiddenReallyPointer ;
FROM M2GCCDeclare IMPORT GetTypeMin, GetTypeMax ;
FROM M2System IMPORT Address ;
*)
PROCEDURE checkUnbounded (result: status; tinfo: tInfo; unbounded, right: CARDINAL) : status ;
-VAR
- lLow, rLow,
- lHigh, rHigh: CARDINAL ;
BEGIN
(* Firstly check to see if we have resolved this as false. *)
IF isFalse (result)
THEN
RETURN result
ELSIF IsSet (typeRight) OR IsEnumeration (typeRight) OR
- IsProcedure (typeRight) OR IsRecord (typeRight)
+ IsProcedure (typeRight) OR IsRecord (typeRight) OR
+ IsReallyPointer (typeRight)
THEN
RETURN false
ELSIF IsArray (typeRight)
GetModuleQuads, GetProcedureQuads,
GetModuleCtors,
MakeProcedure,
- CopyConstString, PutConstStringKnown,
+ PutConstStringKnown,
PutModuleStartQuad, PutModuleEndQuad,
PutModuleFinallyStartQuad, PutModuleFinallyEndQuad,
PutProcedureStartQuad, PutProcedureEndQuad,
THEN
GenQuadOtok (tokno, BecomesOp, Des, NulSym, Exp, TRUE,
destok, UnknownTokenNo, exptok) ;
- CopyConstString (tokno, Des, Exp)
ELSE
IF GetMode(Des)=RightValue
THEN
PROCEDURE IsHiddenTypeDeclared (Sym: CARDINAL) : BOOLEAN ;
+(*
+ IsHiddenReallyPointer - returns TRUE is sym is a pointer, address or a
+ type declared as a pointer or address.
+*)
+
+PROCEDURE IsHiddenReallyPointer (Sym: CARDINAL) : BOOLEAN ;
+
+
(*
DisplayTrees - displays the SymbolTrees for Module symbol, ModSym.
*)
PROCEDURE IsReallyPointer (Sym: CARDINAL) : BOOLEAN ;
BEGIN
- IF IsVar(Sym)
+ IF IsVar (Sym)
THEN
- Sym := GetType(Sym)
+ Sym := GetType (Sym)
END ;
- Sym := SkipType(Sym) ;
- RETURN( IsPointer(Sym) OR (Sym=Address) )
+ Sym := SkipType (Sym) ;
+ RETURN IsPointer (Sym) OR (Sym = Address) OR IsHiddenReallyPointer (Sym)
END IsReallyPointer ;
-(*
- SkipHiddenType - if sym is a TYPE foo = bar
- then call SkipType(bar)
- else return sym
-
- it does skip over hidden type.
-*)
-
-(*
-PROCEDURE SkipHiddenType (Sym: CARDINAL) : CARDINAL ;
-BEGIN
- IF (Sym#NulSym) AND IsType(Sym) AND (GetType(Sym)#NulSym)
- THEN
- RETURN( SkipType(GetType(Sym)) )
- ELSE
- RETURN( Sym )
- END
-END SkipHiddenType ;
-*)
-
-
(*
IsHiddenReallyPointer - returns TRUE is sym is a pointer, address or a
type declared as a pointer or address.
--- /dev/null
+MODULE badprocbool ;
+
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+PROCEDURE Func () : BOOLEAN ;
+BEGIN
+ RETURN TRUE
+END Func ;
+
+BEGIN
+ WriteString ('the value is: ') ; WriteCard (Func (), 5) ; WriteLn
+END badprocbool.
--- /dev/null
+MODULE badproccard ;
+
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+PROCEDURE func () : CARDINAL ;
+BEGIN
+ RETURN 42
+END func ;
+
+BEGIN
+ WriteString ('the value is: ') ; WriteCard (func, 5) ; WriteLn
+END badproccard.
--- /dev/null
+MODULE badprocint ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+PROCEDURE func () : INTEGER ;
+BEGIN
+ RETURN 42
+END func ;
+
+PROCEDURE PassRef (VAR x: CARDINAL) ;
+BEGIN
+END PassRef ;
+
+
+BEGIN
+ WriteString ('the value is: ') ; PassRef (func ()) ; WriteLn
+END badprocint.
--- /dev/null
+MODULE badprocint2 ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+PROCEDURE PassRef (VAR x: CARDINAL) ;
+BEGIN
+END PassRef ;
+
+VAR
+ i: INTEGER ;
+BEGIN
+ i := 42 ;
+ WriteString ('the value is: ') ; PassRef (i) ; WriteLn
+END badprocint2.
MODULE badproctype ;
-TYPE
- MYSHORTREAL = REAL;
-
TYPE
PROCA = PROCEDURE (VAR ARRAY OF REAL);
- PROCB = PROCEDURE (VAR ARRAY OF MYSHORTREAL);
+ PROCB = PROCEDURE (VAR ARRAY OF SHORTREAL);
VAR
pa: PROCA; pb: PROCB;
x: ARRAY [0..1] OF REAL;
- y: ARRAY [0..1] OF MYSHORTREAL;
+ y: ARRAY [0..1] OF SHORTREAL;
PROCEDURE ProcA(VAR z: ARRAY OF REAL);
BEGIN
END ProcA ;
-PROCEDURE ProcB(VAR z: ARRAY OF MYSHORTREAL);
+PROCEDURE ProcB(VAR z: ARRAY OF SHORTREAL);
BEGIN
END ProcB ;
--- /dev/null
+MODULE badproccard2 ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+PROCEDURE func () : INTEGER ;
+BEGIN
+ RETURN 42
+END func ;
+
+PROCEDURE PassValue (x: CARDINAL) ;
+BEGIN
+END PassValue ;
+
+BEGIN
+ WriteString ('the value is: ') ; PassValue (func ()) ; WriteLn
+END badproccard2.
--- /dev/null
+MODULE goodprocint ;
+
+FROM NumberIO IMPORT WriteCard ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+PROCEDURE func () : INTEGER ;
+BEGIN
+ RETURN 42
+END func ;
+
+BEGIN
+ WriteString ('the value is: ') ; WriteCard (func (), 5) ; WriteLn
+END goodprocint.
--- /dev/null
+MODULE goodprocint3 ;
+
+FROM StrIO IMPORT WriteString, WriteLn ;
+
+PROCEDURE PassValue (x: CARDINAL) ;
+BEGIN
+END PassValue ;
+
+VAR
+ i: INTEGER ;
+BEGIN
+ i := 42 ;
+ WriteString ('the value is: ') ; PassValue (i) ; WriteLn
+END goodprocint3.
--- /dev/null
+MODULE genconststr ;
+
+FROM libc IMPORT printf, exit ;
+FROM StrLib IMPORT StrEqual ;
+
+CONST
+ foo = hello + space + world ;
+ hello = "hello" ;
+ space = " " ;
+ world = "world" ;
+
+PROCEDURE test (a: ARRAY OF CHAR) ;
+BEGIN
+ IF NOT StrEqual (a, "hello world")
+ THEN
+ printf ("const string failed\n");
+ exit (1)
+ END
+END test ;
+
+BEGIN
+ test (foo)
+END genconststr.
projects / thirdparty / gcc.git / commitdiff
