aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
Diffstat (limited to 'gcc')
-rw-r--r--gcc/m2/gm2-compiler/M2Check.mod4
-rw-r--r--gcc/m2/gm2-compiler/M2Range.mod3
-rw-r--r--gcc/m2/gm2-compiler/SymbolTable.def7
-rw-r--r--gcc/m2/gm2-compiler/SymbolTable.mod76
-rw-r--r--gcc/testsuite/gm2/iso/const/fail/castproctype.mod19
-rw-r--r--gcc/testsuite/gm2/pim/fail/badproctype.mod37
-rw-r--r--gcc/testsuite/gm2/pim/pass/another.mod8
-rw-r--r--gcc/testsuite/gm2/pim/pass/proccard.mod3
8 files changed, 141 insertions, 16 deletions
diff --git a/gcc/m2/gm2-compiler/M2Check.mod b/gcc/m2/gm2-compiler/M2Check.mod
index 20d463d..a445193 100644
--- a/gcc/m2/gm2-compiler/M2Check.mod
+++ b/gcc/m2/gm2-compiler/M2Check.mod
@@ -47,7 +47,7 @@ FROM SymbolTable IMPORT NulSym, IsRecord, IsSet, GetDType, GetSType, IsType,
IsReallyPointer, IsPointer, IsParameter, ModeOfAddr,
GetMode, GetType, IsUnbounded, IsComposite, IsConstructor,
IsParameter, IsConstString, IsConstLitInternal, IsConstLit,
- GetStringLength ;
+ GetStringLength, GetProcedureProcType ;
FROM M2GCCDeclare IMPORT GetTypeMin, GetTypeMax ;
FROM M2System IMPORT Address ;
@@ -1397,7 +1397,7 @@ PROCEDURE getType (sym: CARDINAL) : CARDINAL ;
BEGIN
IF (sym # NulSym) AND IsProcedure (sym)
THEN
- RETURN Address
+ RETURN GetProcedureProcType (sym)
ELSIF IsTyped (sym)
THEN
RETURN GetDType (sym)
diff --git a/gcc/m2/gm2-compiler/M2Range.mod b/gcc/m2/gm2-compiler/M2Range.mod
index 50c2a48..4b8e5fa 100644
--- a/gcc/m2/gm2-compiler/M2Range.mod
+++ b/gcc/m2/gm2-compiler/M2Range.mod
@@ -1719,7 +1719,8 @@ BEGIN
'expression of type {%1Etad} is incompatible with type {%2tad}',
left, right, strict, isin)
THEN
- SubQuad(q) ;
+ SubQuad(q)
+ ELSE
setReported (r)
END
END
diff --git a/gcc/m2/gm2-compiler/SymbolTable.def b/gcc/m2/gm2-compiler/SymbolTable.def
index ec48631..d7f0f8d 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.def
+++ b/gcc/m2/gm2-compiler/SymbolTable.def
@@ -1395,6 +1395,13 @@ PROCEDURE IsProcedureNoReturn (Sym: CARDINAL) : BOOLEAN ;
(*
+ GetProcedureProcType - returns the proctype matching procedure sym.
+*)
+
+PROCEDURE GetProcedureProcType (sym: CARDINAL) : CARDINAL ;
+
+
+(*
PutModuleStartQuad - Places QuadNumber into the Module symbol, Sym.
QuadNumber is the start quad of Module,
Sym.
diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod b/gcc/m2/gm2-compiler/SymbolTable.mod
index 13ee1fb..7543bb5 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.mod
+++ b/gcc/m2/gm2-compiler/SymbolTable.mod
@@ -407,6 +407,7 @@ TYPE
SavePriority : BOOLEAN ; (* Does procedure need to save *)
(* and restore interrupts? *)
ReturnType : CARDINAL ; (* Return type for function. *)
+ ProcedureType : CARDINAL ; (* Proc type for this procedure. *)
Offset : CARDINAL ; (* Location of procedure used *)
(* in Pass 2 and if procedure *)
(* is a syscall. *)
@@ -3972,6 +3973,8 @@ BEGIN
SavePriority := FALSE ; (* Does procedure need to save *)
(* and restore interrupts? *)
ReturnType := NulSym ; (* Not a function yet! *)
+ (* The ProcType equivalent. *)
+ ProcedureType := MakeProcType (tok, NulName) ;
Offset := 0 ; (* Location of procedure. *)
InitTree(LocalSymbols) ;
InitList(EnumerationScopeList) ;
@@ -3993,7 +3996,7 @@ BEGIN
:= InitValue() ; (* size of all parameters. *)
Begin := 0 ; (* token number for BEGIN *)
End := 0 ; (* token number for END *)
- InitWhereDeclaredTok(tok, At) ; (* Where symbol declared. *)
+ InitWhereDeclaredTok(tok, At) ; (* Where the symbol was declared. *)
errorScope := GetCurrentErrorScope () ; (* Title error scope. *)
END
END ;
@@ -10095,8 +10098,11 @@ BEGIN
CASE SymbolType OF
ErrorSym: |
- ProcedureSym: CheckOptFunction(Sym, FALSE) ; Procedure.ReturnType := TypeSym |
- ProcTypeSym : CheckOptFunction(Sym, FALSE) ; ProcType.ReturnType := TypeSym
+ ProcedureSym: CheckOptFunction(Sym, FALSE) ;
+ Procedure.ReturnType := TypeSym ;
+ PutFunction (Procedure.ProcedureType, TypeSym) |
+ ProcTypeSym : CheckOptFunction(Sym, FALSE) ;
+ ProcType.ReturnType := TypeSym
ELSE
InternalError ('expecting a Procedure or ProcType symbol')
@@ -10113,13 +10119,16 @@ PROCEDURE PutOptFunction (Sym: CARDINAL; TypeSym: CARDINAL) ;
VAR
pSym: PtrToSymbol ;
BEGIN
- pSym := GetPsym(Sym) ;
+ pSym := GetPsym (Sym) ;
WITH pSym^ DO
CASE SymbolType OF
ErrorSym: |
- ProcedureSym: CheckOptFunction(Sym, TRUE) ; Procedure.ReturnType := TypeSym |
- ProcTypeSym : CheckOptFunction(Sym, TRUE) ; ProcType.ReturnType := TypeSym
+ ProcedureSym: CheckOptFunction (Sym, TRUE) ;
+ Procedure.ReturnType := TypeSym ;
+ PutOptFunction (Procedure.ProcedureType, TypeSym) |
+ ProcTypeSym : CheckOptFunction (Sym, TRUE) ;
+ ProcType.ReturnType := TypeSym
ELSE
InternalError ('expecting a Procedure or ProcType symbol')
@@ -10215,7 +10224,8 @@ BEGIN
pSym := GetPsym(ParSym) ;
pSym^.Param.ShadowVar := VariableSym
END
- END
+ END ;
+ AddProcedureProcTypeParam (Sym, ParamType, isUnbounded, FALSE)
END ;
RETURN( TRUE )
END PutParam ;
@@ -10268,6 +10278,7 @@ BEGIN
pSym^.VarParam.ShadowVar := VariableSym
END
END ;
+ AddProcedureProcTypeParam (Sym, ParamType, isUnbounded, TRUE) ;
RETURN( TRUE )
END
END PutVarParam ;
@@ -10346,6 +10357,36 @@ END AddParameter ;
(*
+ AddProcedureProcTypeParam - adds ParamType to the parameter ProcType
+ associated with procedure Sym.
+*)
+
+PROCEDURE AddProcedureProcTypeParam (Sym, ParamType: CARDINAL;
+ isUnbounded, isVarParam: BOOLEAN) ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym (Sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ ProcedureSym: IF isVarParam
+ THEN
+ PutProcTypeVarParam (Procedure.ProcedureType,
+ ParamType, isUnbounded)
+ ELSE
+ PutProcTypeParam (Procedure.ProcedureType,
+ ParamType, isUnbounded)
+ END
+
+ ELSE
+ InternalError ('expecting Sym to be a procedure')
+ END
+ END
+END AddProcedureProcTypeParam ;
+
+
+(*
IsVarParam - Returns a conditional depending whether parameter ParamNo
is a VAR parameter.
*)
@@ -12624,6 +12665,27 @@ END PutProcTypeVarParam ;
(*
+ GetProcedureProcType - returns the proctype matching procedure sym.
+*)
+
+PROCEDURE GetProcedureProcType (sym: CARDINAL) : CARDINAL ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym(sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ ProcedureSym: RETURN Procedure.ProcedureType
+
+ ELSE
+ InternalError ('expecting Procedure symbol')
+ END
+ END
+END GetProcedureProcType ;
+
+
+(*
PutProcedureReachable - Sets the procedure, Sym, to be reachable by the
main Module.
*)
diff --git a/gcc/testsuite/gm2/iso/const/fail/castproctype.mod b/gcc/testsuite/gm2/iso/const/fail/castproctype.mod
new file mode 100644
index 0000000..eb66513
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/const/fail/castproctype.mod
@@ -0,0 +1,19 @@
+MODULE castproctype ;
+
+IMPORT SYSTEM ;
+
+TYPE
+ foo3 = PROCEDURE (CARDINAL, INTEGER, CHAR) ;
+ foo2 = PROCEDURE (CARDINAL, INTEGER) ;
+
+CONST
+ bar = SYSTEM.CAST (foo2, NIL) ;
+
+VAR
+ p2: foo2 ;
+ p3: foo3 ;
+BEGIN
+ IF p2 = p3
+ THEN
+ END
+END castproctype.
diff --git a/gcc/testsuite/gm2/pim/fail/badproctype.mod b/gcc/testsuite/gm2/pim/fail/badproctype.mod
new file mode 100644
index 0000000..1921a8e
--- /dev/null
+++ b/gcc/testsuite/gm2/pim/fail/badproctype.mod
@@ -0,0 +1,37 @@
+MODULE badproctype ;
+
+TYPE
+ MYSHORTREAL = REAL;
+
+TYPE
+ PROCA = PROCEDURE (VAR ARRAY OF REAL);
+ PROCB = PROCEDURE (VAR ARRAY OF MYSHORTREAL);
+
+VAR
+ pa: PROCA; pb: PROCB;
+ x: ARRAY [0..1] OF REAL;
+ y: ARRAY [0..1] OF MYSHORTREAL;
+
+PROCEDURE ProcA(VAR z: ARRAY OF REAL);
+BEGIN
+END ProcA ;
+
+PROCEDURE ProcB(VAR z: ARRAY OF MYSHORTREAL);
+BEGIN
+END ProcB ;
+
+BEGIN
+ x := y;
+ pa := ProcA;
+ pb := ProcB;
+ pa(x);
+ pa(y);
+ pb(x);
+ pb(y);
+ pa := ProcB; (* proctype does not match. *)
+ pb := ProcA; (* proctype does not match. *)
+ pa(x);
+ pa(y);
+ pb(x);
+ pb(y)
+END badproctype.
diff --git a/gcc/testsuite/gm2/pim/pass/another.mod b/gcc/testsuite/gm2/pim/pass/another.mod
index e249ded..0f6cf4b 100644
--- a/gcc/testsuite/gm2/pim/pass/another.mod
+++ b/gcc/testsuite/gm2/pim/pass/another.mod
@@ -2,7 +2,7 @@ MODULE another ;
TYPE
MYSHORTREAL = REAL;
-
+
TYPE
PROCA = PROCEDURE (VAR ARRAY OF REAL);
PROCB = PROCEDURE (VAR ARRAY OF MYSHORTREAL);
@@ -11,7 +11,7 @@ VAR
pa: PROCA; pb: PROCB;
x: ARRAY [0..1] OF REAL;
y: ARRAY [0..1] OF MYSHORTREAL;
-
+
PROCEDURE ProcA(VAR z: ARRAY OF REAL);
BEGIN
END ProcA ;
@@ -28,8 +28,8 @@ BEGIN
pa(y);
pb(x);
pb(y);
- pa := ProcB;
- pb := ProcA;
+ pa := ProcA;
+ pb := ProcB;
pa(x);
pa(y);
pb(x);
diff --git a/gcc/testsuite/gm2/pim/pass/proccard.mod b/gcc/testsuite/gm2/pim/pass/proccard.mod
index 4518022..3042c28 100644
--- a/gcc/testsuite/gm2/pim/pass/proccard.mod
+++ b/gcc/testsuite/gm2/pim/pass/proccard.mod
@@ -8,7 +8,6 @@ BEGIN
RETURN 42
END func ;
-
BEGIN
- WriteString ('the value is: ') ; WriteCard (func, 5) ; WriteLn
+ WriteString ('the value is: ') ; WriteCard (VAL (CARDINAL, func), 5) ; WriteLn
END proccard.
generated by cgit v1.1 at 2025-09-30 21:26:59 +0000