aboutsummaryrefslogtreecommitdiff
path: root/gcc/m2
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/m2')
-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
4 files changed, 80 insertions, 10 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.
*)
generated by cgit v1.1 at 2024-09-18 15:43:28 +0000