https://gcc.gnu.org/g:e8acf6816cf360d5db0ebfaf995415961f455274
commit r14-11050-ge8acf6816cf360d5db0ebfaf995415961f455274
Author: Gaius Mulley <gaiusm...@gmail.com>
Date: Tue Dec 3 13:37:01 2024 +0000
[PATCH] PR modula2/115328 The FORWARD keyword is not implemented
This patch implements the FORWARD keyword found in the ISO standard.
The patch checks incoming parameters against the prior declaration
found in definition/forward sections and will issue an error based
on virtual tokens highlighing the full parameter declaration.
gcc/m2/ChangeLog:
PR modula2/115328
* gm2-compiler/M2MetaError.def: Extend comment documentating
new format specifiers.
* gm2-compiler/M2MetaError.mod (GetTokProcedure): New declaration.
(doErrorScopeModule): New procedure.
(doErrorScopeForward): Ditto.
(doErrorScopeMod): Reimplement.
(doErrorScopeFor): New procedure.
(declarationMod): Ditto.
(doErrorScopeDefinition): Ditto.
(doErrorScopeDef): Reimplement.
(declaredDef): New procedure.
(declaredFor): Ditto.
(doErrorScopeProc): Ditto.
(declaredVar): Ditto.
(declaredType): Ditto.
(declaredFull): Ditto.
* gm2-compiler/M2Options.mod (SetAutoInit): Add missing
return type.
(GetDumpGimple): Remove duplicate implementation.
* gm2-compiler/M2Quads.def (DupFrame): New procedure.
* gm2-compiler/M2Quads.mod (DupFrame): New procedure.
* gm2-compiler/M2Reserved.def (ForwardTok): New variable.
* gm2-compiler/M2Reserved.mod (ForwardTok): Initialize variable.
* gm2-compiler/M2Scaffold.mod (DeclareArgEnvParams): Add
tokno parameter for call to PutParam.
* gm2-compiler/P0SymBuild.def (EndForward): New procedure.
* gm2-compiler/P0SymBuild.mod (EndForward): New procedure.
* gm2-compiler/P0SyntaxCheck.bnf (BlockAssert): New procedure.
(ProcedureDeclaration): Reimplement rule.
(PostProcedureHeading): New rule.
(ForwardDeclaration): Ditto.
(ProperProcedure): Ditto.
* gm2-compiler/P1Build.bnf (ProcedureDeclaration): Reimplement rule.
(PostProcedureHeading): New rule.
(ForwardDeclaration): Ditto.
(ProperProcedure): Ditto.
* gm2-compiler/P1SymBuild.def (Export): Removed unnecessary
export.
(EndBuildForward): New procedure.
* gm2-compiler/P1SymBuild.mod (StartBuildProcedure): Reimplement.
(EndBuildProcedure): Ditto.
(EndBuildForward): Ditto.
* gm2-compiler/P2Build.bnf (ProcedureDeclaration): Reimplement rule.
(PostProcedureHeading): New rule.
(ForwardDeclaration): Ditto.
(ProperProcedure): Ditto.
* gm2-compiler/P2SymBuild.def (BuildProcedureDefinedByForward):
New procedure.
(BuildProcedureDefinedByProper): Ditto.
(CheckProcedure): Ditto.
(EndBuildForward): Ditto.
* gm2-compiler/P2SymBuild.mod (EndBuildProcedure): Reimplement.
(EndBuildForward): New procedure.
(BuildFPSection): Reimplement to allow forward declaration or
checking of parameters.
(BuildProcedureDefinedByProper): New procedure.
(BuildProcedureDefinedByForward): Ditto
(FailParameter): Remove.
(ParameterError): New procedure.
(ParameterMismatch): Ditto.
(EndBuildFormalParameters): Add parameter number check.
(GetComparison): New procedure function.
(GetSourceDesc): Ditto.
(GetCurSrcDesc): Ditto.
(GetDeclared): New procedure.
(ReturnTypeMismatch): Ditto.
(BuildFunction): Reimplement.
(CheckProcedure): New procedure.
(CheckFormalParameterSection): Reimplement using ParameterError.
* gm2-compiler/P3Build.bnf (ProcedureDeclaration): Reimplement rule.
(PostProcedureHeading): New rule.
(ForwardDeclaration): Ditto.
(ProperProcedure): Ditto.
* gm2-compiler/P3SymBuild.def (Export): Remove unnecessary export.
(EndBuildForward): New procedure.
* gm2-compiler/P3SymBuild.mod (EndBuildForward): New procedure.
* gm2-compiler/PCBuild.bnf (ProcedureDeclaration): Reimplement rule.
(PostProcedureHeading): New rule.
(ForwardDeclaration): Ditto.
(ProperProcedure): Ditto.
* gm2-compiler/PCSymBuild.def (EndBuildForward): New procedure.
* gm2-compiler/PCSymBuild.mod (EndBuildForward): Ditto.
* gm2-compiler/PHBuild.bnf (ProcedureDeclaration): Reimplement rule.
(PostProcedureHeading): New rule.
(ForwardDeclaration): Ditto.
(ProperProcedure): Ditto.
* gm2-compiler/SymbolTable.def (PutVarTok): New procedure.
(PutParam): Add typetok parameter.
(PutVarParam): Ditto.
(PutParamName): Ditto.
(GetDeclaredFor): New procedure function.
(AreParametersDefinedInDefinition): Ditto.
(PutParametersDefinedByForward): New procedure.
(GetParametersDefinedByForward): New procedure function.
(PutParametersDefinedByProper): New procedure.
(GetParametersDefinedByProper): New procedure function.
(GetProcedureDeclaredForward): Ditto.
(PutProcedureDeclaredForward): New procedure.
(GetProcedureDeclaredProper): New procedure function.
(PutProcedureDeclaredProper): New procedure.
(GetProcedureDeclaredDefinition): New procedure function.
(PutProcedureDeclaredDefinition): New procedure.
(GetVarDeclTypeTok): Ditto.
(PutVarDeclTypeTok): New procedure.
(GetVarDeclTok): Ditto.
(PutVarDeclTok): New procedure.
(GetVarDeclFullTok): Ditto.
* gm2-compiler/SymbolTable.mod (ProcedureDecl): New record type.
(VarDecl): Ditto.
(SymProcedure): Add new field Declared.
(SymVar): Add new field Declared.
(PutVarTok): New procedure.
(PutParam): Add typetok parameter.
(PutVarParam): Ditto.
(PutParamName): Ditto.
(GetDeclaredFor): New procedure function.
(AreParametersDefinedInDefinition): Ditto.
(PutParametersDefinedByForward): New procedure.
(GetParametersDefinedByForward): New procedure function.
(PutParametersDefinedByProper): New procedure.
(GetParametersDefinedByProper): New procedure function.
(GetProcedureDeclaredForward): Ditto.
(PutProcedureDeclaredForward): New procedure.
(GetProcedureDeclaredProper): New procedure function.
(PutProcedureDeclaredProper): New procedure.
(GetProcedureDeclaredDefinition): New procedure function.
(PutProcedureDeclaredDefinition): New procedure.
(GetVarDeclTypeTok): Ditto.
(PutVarDeclTypeTok): New procedure.
(GetVarDeclTok): Ditto.
(PutVarDeclTok): New procedure.
(GetVarDeclFullTok): Ditto.
(MakeProcedure): Initialize Declared field.
(MakeVar): Initialize Declared field.
* gm2-libs-log/FileSystem.def (FileNameChar): Add
missing return type.
* m2.flex: Add FORWARD keyword.
gcc/testsuite/ChangeLog:
PR modula2/115328
* gm2/iso/fail/badparam.def: New test.
* gm2/iso/fail/badparam.mod: New test.
* gm2/iso/fail/badparam2.def: New test.
* gm2/iso/fail/badparam2.mod: New test.
* gm2/iso/fail/badparam3.def: New test.
* gm2/iso/fail/badparam3.mod: New test.
* gm2/iso/fail/badparamarray.def: New test.
* gm2/iso/fail/badparamarray.mod: New test.
* gm2/iso/fail/simpledef1.def: New test.
* gm2/iso/fail/simpledef1.mod: New test.
* gm2/iso/fail/simpleforward.mod: New test.
* gm2/iso/fail/simpleforward2.mod: New test.
* gm2/iso/fail/simpleforward3.mod: New test.
* gm2/iso/fail/simpleforward4.mod: New test.
* gm2/iso/fail/simpleforward5.mod: New test.
* gm2/iso/fail/simpleforward7.mod: New test.
* gm2/iso/pass/simpleforward.mod: New test.
* gm2/iso/pass/simpleforward6.mod: New test.
(cherry picked from commit e751639e3d20efe97186faa7dca33e7761ba1e79)
Signed-off-by: Gaius Mulley <gaiusm...@gmail.com>
Diff:
---
gcc/m2/gm2-compiler/M2MetaError.def | 12 +
gcc/m2/gm2-compiler/M2MetaError.mod | 286 +++++++++++--
gcc/m2/gm2-compiler/M2Options.mod | 12 +-
gcc/m2/gm2-compiler/M2Quads.def | 9 +-
gcc/m2/gm2-compiler/M2Quads.mod | 16 +
gcc/m2/gm2-compiler/M2Reserved.def | 8 +-
gcc/m2/gm2-compiler/M2Reserved.mod | 3 +
gcc/m2/gm2-compiler/M2Scaffold.mod | 6 +-
gcc/m2/gm2-compiler/P0SymBuild.def | 7 +
gcc/m2/gm2-compiler/P0SymBuild.mod | 16 +-
gcc/m2/gm2-compiler/P0SyntaxCheck.bnf | 39 +-
gcc/m2/gm2-compiler/P1Build.bnf | 20 +-
gcc/m2/gm2-compiler/P1SymBuild.def | 46 +-
gcc/m2/gm2-compiler/P1SymBuild.mod | 84 +++-
gcc/m2/gm2-compiler/P2Build.bnf | 39 +-
gcc/m2/gm2-compiler/P2SymBuild.def | 103 ++---
gcc/m2/gm2-compiler/P2SymBuild.mod | 569 ++++++++++++++++---------
gcc/m2/gm2-compiler/P3Build.bnf | 20 +-
gcc/m2/gm2-compiler/P3SymBuild.def | 34 +-
gcc/m2/gm2-compiler/P3SymBuild.mod | 12 +
gcc/m2/gm2-compiler/PCBuild.bnf | 38 +-
gcc/m2/gm2-compiler/PCSymBuild.def | 19 +
gcc/m2/gm2-compiler/PCSymBuild.mod | 22 +
gcc/m2/gm2-compiler/PHBuild.bnf | 22 +-
gcc/m2/gm2-compiler/SymbolTable.def | 146 ++++++-
gcc/m2/gm2-compiler/SymbolTable.mod | 586 +++++++++++++++++++++++++-
gcc/m2/gm2-libs-log/FileSystem.def | 2 +-
gcc/m2/m2.flex | 1 +
gcc/testsuite/gm2/iso/fail/badparam.def | 5 +
gcc/testsuite/gm2/iso/fail/badparam.mod | 8 +
gcc/testsuite/gm2/iso/fail/badparam2.def | 5 +
gcc/testsuite/gm2/iso/fail/badparam2.mod | 7 +
gcc/testsuite/gm2/iso/fail/badparam3.def | 5 +
gcc/testsuite/gm2/iso/fail/badparam3.mod | 7 +
gcc/testsuite/gm2/iso/fail/badparamarray.def | 5 +
gcc/testsuite/gm2/iso/fail/badparamarray.mod | 8 +
gcc/testsuite/gm2/iso/fail/simpledef1.def | 6 +
gcc/testsuite/gm2/iso/fail/simpledef1.mod | 3 +
gcc/testsuite/gm2/iso/fail/simpleforward.mod | 12 +
gcc/testsuite/gm2/iso/fail/simpleforward2.mod | 11 +
gcc/testsuite/gm2/iso/fail/simpleforward3.mod | 11 +
gcc/testsuite/gm2/iso/fail/simpleforward4.mod | 17 +
gcc/testsuite/gm2/iso/fail/simpleforward5.mod | 12 +
gcc/testsuite/gm2/iso/fail/simpleforward7.mod | 11 +
gcc/testsuite/gm2/iso/pass/simpleforward.mod | 13 +
gcc/testsuite/gm2/iso/pass/simpleforward6.mod | 14 +
46 files changed, 1888 insertions(+), 449 deletions(-)
diff --git a/gcc/m2/gm2-compiler/M2MetaError.def
b/gcc/m2/gm2-compiler/M2MetaError.def
index 792f4a54c9a1..c83770a44039 100644
--- a/gcc/m2/gm2-compiler/M2MetaError.def
+++ b/gcc/m2/gm2-compiler/M2MetaError.def
@@ -69,11 +69,23 @@ EXPORT QUALIFIED MetaError0, MetaError1, MetaError2,
MetaError3, MetaError4,
{%1D} sets the error message to where symbol 1 was declared.
The declaration will choose the definition module, then
implementation (or program) module.
+ {%1G} sets the error message to where symbol 1 was declared.
+ The declaration will choose in order the forward declaration,
+ implementation module, program module or definition module.
{%1M} sets the error message to where symbol 1 was declared.
The declaration will choose the implementation or program
module and if these do not exist then it falls back to
the definition module.
{%1U} sets the error message to where symbol 1 was first used.
+ {%1V} set the error message location to the name of the symbol
declared.
+ For example foo: bar
+ ^^^ some error message.
+ {%1H} set the error message location to the whole declaration of the
symbol.
+ For example foo: bar
+ ^^^^^^^^ some error message.
+ {%1B} set the error message location to the type declaration of the
symbol.
+ For example foo: bar
+ ^^^ some error message.
{%A} abort, issue non recoverable error message (this should
not used for internal errors).
{%E} error (default recoverable error).
diff --git a/gcc/m2/gm2-compiler/M2MetaError.mod
b/gcc/m2/gm2-compiler/M2MetaError.mod
index 94ffdb14603b..007c10b28bdf 100644
--- a/gcc/m2/gm2-compiler/M2MetaError.mod
+++ b/gcc/m2/gm2-compiler/M2MetaError.mod
@@ -58,8 +58,10 @@ FROM SymbolTable IMPORT NulSym,
IsSubscript, IsSubrange, IsSet, IsHiddenType,
IsError, GetSymName, GetScope, IsExported,
GetType, SkipType, GetDeclaredDef, GetDeclaredMod,
- GetDeclaredModule, GetDeclaredDefinition, GetScope,
- GetFirstUsed, IsNameAnonymous, GetErrorScope ;
+ GetDeclaredFor, GetDeclaredModule,
+ GetDeclaredDefinition, GetScope,
+ GetFirstUsed, IsNameAnonymous, GetErrorScope,
+ GetVarDeclTok, GetVarDeclTypeTok, GetVarDeclFullTok ;
IMPORT M2ColorString ;
IMPORT M2Error ;
@@ -71,6 +73,8 @@ CONST
ColorDebug = FALSE ;
TYPE
+ GetTokProcedure = PROCEDURE (CARDINAL) : CARDINAL ;
+
errorType = (none, error, warning, note, chained, aborta) ;
colorType = (unsetColor, noColor, quoteColor, filenameColor, errorColor,
warningColor, noteColor, keywordColor, locusColor,
@@ -704,11 +708,23 @@ END killErrorBlock ;
)
=:
- op := {'a'|'q'|'t'|'d'|'n'|'s'|'D'|'I'|'U'|'E'|'W'|'A'} then =:
+ op := {'a'|'q'|'t'|'d'|'n'|'s'|'B'|'D'|'F'|'G'|'H'|'M'|'U'|'E'|'V'|'W'|'A'}
then =:
then := [ ':' ebnf ] =:
*)
+(*
+ {%1V} set the error message location to the name of the symbol
declared.
+ For example foo: bar
+ ^^^ some error message.
+ {%1H} set the error message location to the whole declaration of the
symbol.
+ For example foo: bar
+ ^^^^^^^^ some error message.
+ {%1B} set the error message location to the type declaration of the
symbol.
+ For example foo: bar
+ ^^^ some error message.
+*)
+
(*
InternalFormat - produces an informative internal error.
@@ -1185,6 +1201,72 @@ BEGIN
END chooseError ;
+(*
+ doErrorScopeModule -
+*)
+
+PROCEDURE doErrorScopeModule (VAR eb: errorBlock; sym: CARDINAL) ;
+VAR
+ scope: CARDINAL ;
+BEGIN
+ scope := GetScope (sym) ;
+ IF IsModule (scope)
+ THEN
+ IF IsInnerModule (scope)
+ THEN
+ doError (eb, GetDeclaredMod (sym))
+ ELSE
+ doError (eb, GetDeclaredMod (sym))
+ END
+ ELSE
+ Assert (IsDefImp (scope)) ;
+ (* if this fails then we need to skip to the outer scope.
+ REPEAT
+ OuterModule := GetScope(OuterModule)
+ UNTIL GetScope(OuterModule)=NulSym. *)
+ IF GetDeclaredModule (sym) = UnknownTokenNo
+ THEN
+ doError (eb, GetDeclaredDef (sym))
+ ELSE
+ doError (eb, GetDeclaredMod (sym))
+ END
+ END
+END doErrorScopeModule ;
+
+
+(*
+ doErrorScopeForward -
+*)
+
+PROCEDURE doErrorScopeForward (VAR eb: errorBlock; sym: CARDINAL) ;
+VAR
+ scope: CARDINAL ;
+BEGIN
+ scope := GetScope (sym) ;
+ IF IsModule (scope)
+ THEN
+ IF IsInnerModule (scope)
+ THEN
+ doError (eb, GetDeclaredFor (sym))
+ ELSE
+ doError (eb, GetDeclaredFor (sym))
+ END
+ ELSE
+ Assert (IsDefImp (scope)) ;
+ (* if this fails then we need to skip to the outer scope.
+ REPEAT
+ OuterModule := GetScope(OuterModule)
+ UNTIL GetScope(OuterModule)=NulSym. *)
+ IF GetDeclaredModule (sym) = UnknownTokenNo
+ THEN
+ doError (eb, GetDeclaredDef (sym))
+ ELSE
+ doError (eb, GetDeclaredFor (sym))
+ END
+ END
+END doErrorScopeForward ;
+
+
(*
doErrorScopeMod - potentially create an error referring to the definition
module, fall back to the implementation or program module
if
@@ -1206,33 +1288,82 @@ BEGIN
THEN
doError (eb, GetDeclaredMod (sym))
ELSE
- IF IsModule (scope)
- THEN
- IF IsInnerModule (scope)
- THEN
- doError (eb, GetDeclaredMod (sym))
- ELSE
- doError (eb, GetDeclaredMod (sym))
- END
- ELSE
- Assert (IsDefImp (scope)) ;
- (* if this fails then we need to skip to the outer scope.
- REPEAT
- OuterModule := GetScope(OuterModule)
- UNTIL GetScope(OuterModule)=NulSym ; *)
- IF GetDeclaredModule (sym) = UnknownTokenNo
- THEN
- doError (eb, GetDeclaredDef (sym))
- ELSE
- doError (eb, GetDeclaredMod (sym))
- END
- END
+ doErrorScopeModule (eb, sym)
END
END ;
M2Error.LeaveErrorScope
END doErrorScopeMod ;
+(*
+ doErrorScopeFor - potentially create an error referring to the
+ forward declaration, definition module, fall back
+ to the implementation or program module if
+ there is no declaration in the definition module.
+*)
+
+PROCEDURE doErrorScopeFor (VAR eb: errorBlock; sym: CARDINAL) ;
+VAR
+ scope: CARDINAL ;
+BEGIN
+ scope := GetScope (sym) ;
+ IF scope = NulSym
+ THEN
+ M2Error.EnterErrorScope (NIL) ;
+ doError (eb, GetDeclaredFor (sym))
+ ELSE
+ M2Error.EnterErrorScope (GetErrorScope (scope)) ;
+ IF IsProcedure (scope)
+ THEN
+ doError (eb, GetDeclaredFor (sym))
+ ELSE
+ doErrorScopeForward (eb, sym)
+ END
+ END ;
+ M2Error.LeaveErrorScope
+END doErrorScopeFor ;
+
+
+(*
+ doDeclaredMod - creates an error note where sym[bol] was declared.
+*)
+
+PROCEDURE declaredMod (VAR eb: errorBlock; sym: ARRAY OF CARDINAL; bol:
CARDINAL) ;
+BEGIN
+ IF bol <= HIGH (sym)
+ THEN
+ doErrorScopeMod (eb, sym[bol])
+ END
+END declaredMod ;
+
+
+(*
+ doErrorScopeDefinition - use the declaration in the definitio module if one
is available.
+*)
+
+PROCEDURE doErrorScopeDefinition (VAR eb: errorBlock; sym: CARDINAL) ;
+VAR
+ scope: CARDINAL ;
+BEGIN
+ scope := GetScope (sym) ;
+ IF IsModule (scope)
+ THEN
+ (* No definition module for a program module. *)
+ doError (eb, GetDeclaredMod (sym))
+ ELSE
+ Assert (IsDefImp (scope)) ;
+ IF GetDeclaredDefinition (sym) = UnknownTokenNo
+ THEN
+ (* Fall back to the implementation module if no declaration exists
+ in the definition module. *)
+ doError (eb, GetDeclaredMod (sym))
+ ELSE
+ doError (eb, GetDeclaredDef (sym))
+ END
+ END
+END doErrorScopeDefinition ;
+
+
(*
doErrorScopeDef - potentially create an error referring to the definition
module, fall back to the implementation or program module
if
@@ -1247,12 +1378,73 @@ BEGIN
IF scope = NulSym
THEN
M2Error.EnterErrorScope (NIL) ;
- doError (eb, GetDeclaredDef (sym))
+ doError (eb, GetDeclaredFor (sym))
ELSE
M2Error.EnterErrorScope (GetErrorScope (scope)) ;
IF IsProcedure (scope)
THEN
doError (eb, GetDeclaredDef (sym))
+ ELSE
+ doErrorScopeDefinition (eb, sym)
+ END
+ END ;
+ M2Error.LeaveErrorScope
+END doErrorScopeDef ;
+
+
+(*
+ doDeclaredDef - creates an error note where sym[bol] was declared.
+*)
+
+PROCEDURE declaredDef (VAR eb: errorBlock; sym: ARRAY OF CARDINAL; bol:
CARDINAL) ;
+BEGIN
+ IF bol <= HIGH (sym)
+ THEN
+ doErrorScopeDef (eb, sym[bol])
+ END
+END declaredDef ;
+
+
+(*
+ doDeclaredFor - creates an error note where sym[bol] was declared.
+*)
+
+PROCEDURE declaredFor (VAR eb: errorBlock; sym: ARRAY OF CARDINAL; bol:
CARDINAL) ;
+BEGIN
+ IF bol <= HIGH (sym)
+ THEN
+ doErrorScopeFor (eb, sym[bol])
+ END
+END declaredFor ;
+
+
+(*
+ doErrorScopeProc - determine the location for the error or warning from
+ the default declaration. For example parameters can be
+ declared in definition, forward or in modules (proper
procedure).
+ Use GetVarParamTok to obtain a variable or parameter
location.
+*)
+
+PROCEDURE doErrorScopeProc (VAR eb: errorBlock; sym: CARDINAL;
+ GetVarParamTok: GetTokProcedure) ;
+VAR
+ scope: CARDINAL ;
+BEGIN
+ scope := GetScope (sym) ;
+ IF scope = NulSym
+ THEN
+ M2Error.EnterErrorScope (NIL) ;
+ doError (eb, GetDeclaredDef (sym))
+ ELSE
+ M2Error.EnterErrorScope (GetErrorScope (scope)) ;
+ IF IsProcedure (scope)
+ THEN
+ IF IsVar (sym) OR IsParameter (sym)
+ THEN
+ doError (eb, GetVarParamTok (sym))
+ ELSE
+ doError (eb, GetDeclaredDef (sym))
+ END
ELSE
IF IsModule (scope)
THEN
@@ -1275,36 +1467,49 @@ BEGIN
doError (eb, GetDeclaredDef (sym))
END
END
- END
+ END
END ;
M2Error.LeaveErrorScope
-END doErrorScopeDef ;
+END doErrorScopeProc ;
(*
- declaredDef - creates an error note where sym[bol] was declared.
+ doDeclaredVar - creates an error note where sym[bol] was declared.
*)
-PROCEDURE declaredDef (VAR eb: errorBlock; sym: ARRAY OF CARDINAL; bol:
CARDINAL) ;
+PROCEDURE declaredVar (VAR eb: errorBlock; sym: ARRAY OF CARDINAL; bol:
CARDINAL) ;
BEGIN
IF bol <= HIGH (sym)
THEN
- doErrorScopeDef (eb, sym[bol])
+ doErrorScopeProc (eb, sym[bol], GetVarDeclTok)
END
-END declaredDef ;
+END declaredVar ;
(*
- doDeclaredMod - creates an error note where sym[bol] was declared.
+ doDeclaredType - creates an error note where sym[bol] was declared.
*)
-PROCEDURE declaredMod (VAR eb: errorBlock; sym: ARRAY OF CARDINAL; bol:
CARDINAL) ;
+PROCEDURE declaredType (VAR eb: errorBlock; sym: ARRAY OF CARDINAL; bol:
CARDINAL) ;
BEGIN
IF bol <= HIGH (sym)
THEN
- doErrorScopeMod (eb, sym[bol])
+ doErrorScopeProc (eb, sym[bol], GetVarDeclTypeTok)
END
-END declaredMod ;
+END declaredType ;
+
+
+(*
+ doDeclaredFull - creates an error note where sym[bol] was declared.
+*)
+
+PROCEDURE declaredFull (VAR eb: errorBlock; sym: ARRAY OF CARDINAL; bol:
CARDINAL) ;
+BEGIN
+ IF bol <= HIGH (sym)
+ THEN
+ doErrorScopeProc (eb, sym[bol], GetVarDeclFullTok)
+ END
+END declaredFull ;
(*
@@ -1479,7 +1684,8 @@ END copySym ;
(*
- op := {'a'|'q'|'t'|'d'|'n'|'s'| 'u' |'D'|'I'|'U'|'E'|'W'} then =:
+ op := {'a'|'q'|'t'|'d'|'n'|'s'|'B'|'D'|'F'|'G'|'H'|'M'|'U'|'E'|'V'|'W'|'A'}
then =:
+ op := {'a'|'q'|'t'|'d'|'n'|'s'| 'u' |'D'|'F'|'G'|'M'|'U'|'E'|'W'} then =:
*)
PROCEDURE op (VAR eb: errorBlock;
@@ -1501,8 +1707,12 @@ BEGIN
'n': doNumber (eb, sym, bol) |
'N': doCount (eb, sym, bol) |
's': doSkipType (eb, sym, bol) |
- 'D': declaredDef (eb, sym, bol) |
+ 'B': declaredType (eb, sym, bol) |
+ 'H': declaredFull (eb, sym, bol) |
+ 'V': declaredVar (eb, sym, bol) |
+ 'G': declaredFor (eb, sym, bol) |
'M': declaredMod (eb, sym, bol) |
+ 'D': declaredDef (eb, sym, bol) |
'U': used (eb, sym, bol) |
'E': eb.type := error |
'A': eb.type := aborta ;
@@ -1536,7 +1746,7 @@ BEGIN
'4': InternalError ('incorrect format spec, expecting %4 rather than %
spec 4')
ELSE
- InternalFormat (eb, 'expecting one of
[akqtdnpsuCDEFKNOPQRSTUWXYZ:<>%]', __LINE__)
+ InternalFormat (eb, 'expecting one of
[akqtdnpsuCDEFGKNOPQRSTUWXYZ:<>%]', __LINE__)
END ;
INC (eb.ini)
END ;
diff --git a/gcc/m2/gm2-compiler/M2Options.mod
b/gcc/m2/gm2-compiler/M2Options.mod
index e4ffa362ff33..ecdad63657c6 100644
--- a/gcc/m2/gm2-compiler/M2Options.mod
+++ b/gcc/m2/gm2-compiler/M2Options.mod
@@ -617,7 +617,7 @@ END SetCheckAll ;
TRUE is returned.
*)
-PROCEDURE SetAutoInit (value: BOOLEAN) ;
+PROCEDURE SetAutoInit (value: BOOLEAN) : BOOLEAN ;
BEGIN
AutoInit := value ;
RETURN TRUE
@@ -2007,16 +2007,6 @@ BEGIN
END GetDumpDecl ;
-(*
- GetDumpLangGimple - return TRUE if the gimple flag is set from SetM2Dump.
-*)
-
-PROCEDURE GetDumpGimple () : BOOLEAN ;
-BEGIN
- RETURN DumpGimple
-END GetDumpGimple ;
-
-
BEGIN
cflag := FALSE ; (* -c. *)
RuntimeModuleOverride := InitString
(DefaultRuntimeModuleOverride) ;
diff --git a/gcc/m2/gm2-compiler/M2Quads.def b/gcc/m2/gm2-compiler/M2Quads.def
index d3e2118abfd7..12a4708ee676 100644
--- a/gcc/m2/gm2-compiler/M2Quads.def
+++ b/gcc/m2/gm2-compiler/M2Quads.def
@@ -78,7 +78,7 @@ EXPORT QUALIFIED StartBuildDefFile, StartBuildModFile,
EndBuildFile,
BuildBinaryOp,
BuildUnaryOp,
RecordOp,
- Top,
+ Top, DupFrame,
PopTF, PushTF, PopT, PushT, PopNothing, PopN, PushTFA,
PushTtok, PushTFtok, PopTFtok, PopTtok, PushTFAtok,
PushTFn, PushTFntok, PopTFn,
@@ -2528,6 +2528,13 @@ PROCEDURE DisplayStack ;
PROCEDURE Top () : CARDINAL ;
+(*
+ DupFrame - duplicate the top of stack and push the new frame.
+*)
+
+PROCEDURE DupFrame ;
+
+
(*
WriteOperand - displays the operands name, symbol id and mode of addressing.
*)
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 6230bf7d139e..5ff0461d0d2a 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -15618,6 +15618,22 @@ BEGIN
END PopTF ;
+(*
+ DupFrame - duplicate the top of stack and push the new frame.
+*)
+
+PROCEDURE DupFrame ;
+VAR
+ f, newf: BoolFrame ;
+BEGIN
+ f := PopAddress (BoolStack) ;
+ PushAddress (BoolStack, f) ;
+ newf := newBoolFrame () ;
+ newf^ := f^ ;
+ PushAddress (BoolStack, newf)
+END DupFrame ;
+
+
(*
newBoolFrame - creates a new BoolFrame with all fields initialised to their
defaults.
*)
diff --git a/gcc/m2/gm2-compiler/M2Reserved.def
b/gcc/m2/gm2-compiler/M2Reserved.def
index 7718937bdd75..1ea5fc6048b9 100644
--- a/gcc/m2/gm2-compiler/M2Reserved.def
+++ b/gcc/m2/gm2-compiler/M2Reserved.def
@@ -44,7 +44,8 @@ EXPORT QUALIFIED IsReserved, tokToTok,
AndTok, ArrayTok, BeginTok, ByTok, CaseTok, ConstTok,
DefinitionTok, DivTok, DoTok, ElseTok, ElsifTok, EndTok,
ExceptTok,
- ExitTok, ExportTok, FinallyTok, ForTok, FromTok, IfTok,
+ ExitTok, ExportTok, FinallyTok, ForTok, ForwardTok,
+ FromTok, IfTok,
ImplementationTok, ImportTok, InTok, LoopTok, ModTok,
ModuleTok, NotTok, OfTok, OrTok,
PackedSetTok, PointerTok, ProcedureTok,
@@ -71,7 +72,7 @@ TYPE
arraytok, begintok, bytok, casetok, consttok,
definitiontok, divtok, dotok, elsetok, elsiftok,
endtok, excepttok, exittok, exporttok, finallytok,
- fortok, fromtok, iftok, implementationtok,
+ fortok, forwardtok, fromtok, iftok, implementationtok,
importtok, intok, looptok, modtok,
moduletok, nottok, oftok, ortok,
packedsettok, pointertok, proceduretok,
@@ -96,7 +97,8 @@ VAR
AndTok, ArrayTok, BeginTok, ByTok, CaseTok, ConstTok,
DefinitionTok, DivTok, DoTok, ElseTok, ElsifTok, EndTok,
- ExceptTok, ExitTok, ExportTok, FinallyTok, ForTok, FromTok,
+ ExceptTok, ExitTok, ExportTok, FinallyTok, ForTok,
+ ForwardTok, FromTok,
IfTok, ImplementationTok, ImportTok, InTok, LoopTok, ModTok,
ModuleTok, NotTok, OfTok, OrTok,
PackedSetTok, PointerTok, ProcedureTok,
diff --git a/gcc/m2/gm2-compiler/M2Reserved.mod
b/gcc/m2/gm2-compiler/M2Reserved.mod
index da63ea5a16e0..29ed87e47302 100644
--- a/gcc/m2/gm2-compiler/M2Reserved.mod
+++ b/gcc/m2/gm2-compiler/M2Reserved.mod
@@ -197,6 +197,9 @@ BEGIN
ForTok := MakeKey('FOR') ;
AddKeyword(ForTok, fortok) ;
+ ForwardTok := MakeKey('FORWARD') ;
+ AddKeyword(ForwardTok, forwardtok) ;
+
FromTok := MakeKey('FROM') ;
AddKeyword(FromTok, fromtok) ;
diff --git a/gcc/m2/gm2-compiler/M2Scaffold.mod
b/gcc/m2/gm2-compiler/M2Scaffold.mod
index 777737ef4c06..f4f557edaf38 100644
--- a/gcc/m2/gm2-compiler/M2Scaffold.mod
+++ b/gcc/m2/gm2-compiler/M2Scaffold.mod
@@ -611,9 +611,9 @@ PROCEDURE DeclareArgEnvParams (tokno: CARDINAL; proc:
CARDINAL) ;
BEGIN
Assert (IsProcedure (proc)) ;
StartScope (proc) ;
- Assert (PutParam (tokno, proc, 1, MakeKey ("argc"), Integer, FALSE)) ;
- Assert (PutParam (tokno, proc, 2, MakeKey ("argv"), Address, FALSE)) ;
- Assert (PutParam (tokno, proc, 3, MakeKey ("envp"), Address, FALSE)) ;
+ Assert (PutParam (tokno, proc, 1, MakeKey ("argc"), Integer, FALSE, tokno))
;
+ Assert (PutParam (tokno, proc, 2, MakeKey ("argv"), Address, FALSE, tokno))
;
+ Assert (PutParam (tokno, proc, 3, MakeKey ("envp"), Address, FALSE, tokno))
;
EndScope
END DeclareArgEnvParams ;
diff --git a/gcc/m2/gm2-compiler/P0SymBuild.def
b/gcc/m2/gm2-compiler/P0SymBuild.def
index e18e9c4851d4..b81683eb1991 100644
--- a/gcc/m2/gm2-compiler/P0SymBuild.def
+++ b/gcc/m2/gm2-compiler/P0SymBuild.def
@@ -103,6 +103,13 @@ PROCEDURE RegisterProcedure ;
PROCEDURE EndProcedure ;
+(*
+ EndForward - ends building a forward procedure.
+*)
+
+PROCEDURE EndForward ;
+
+
(*
P0Init -
*)
diff --git a/gcc/m2/gm2-compiler/P0SymBuild.mod
b/gcc/m2/gm2-compiler/P0SymBuild.mod
index 2238f188a01f..0939e33017c7 100644
--- a/gcc/m2/gm2-compiler/P0SymBuild.mod
+++ b/gcc/m2/gm2-compiler/P0SymBuild.mod
@@ -46,7 +46,7 @@ TYPE
name : Name ;
kind : Kind ;
sym : CARDINAL ;
- level : CARDINAL ;
+ level : INTEGER ;
token : CARDINAL ; (* where the block
starts. *)
LocalModules : List ; (* locally declared
modules at the current level *)
ImportedModules: Index ; (* current list of
imports for the scanned module *)
@@ -65,7 +65,7 @@ TYPE
VAR
headBP,
curBP : BlockInfoPtr ;
- Level : CARDINAL ;
+ Level : INTEGER ;
(*
@@ -536,6 +536,18 @@ BEGIN
END EndProcedure ;
+(*
+ EndForward - ends building a forward procedure.
+*)
+
+PROCEDURE EndForward ;
+BEGIN
+ PopN (1) ;
+ EndBlock ;
+ M2Error.LeaveErrorScope
+END EndForward ;
+
+
(*
EndModule -
*)
diff --git a/gcc/m2/gm2-compiler/P0SyntaxCheck.bnf
b/gcc/m2/gm2-compiler/P0SyntaxCheck.bnf
index 07f861adac9c..868484c9b622 100644
--- a/gcc/m2/gm2-compiler/P0SyntaxCheck.bnf
+++ b/gcc/m2/gm2-compiler/P0SyntaxCheck.bnf
@@ -47,9 +47,14 @@ IMPLEMENTATION MODULE P0SyntaxCheck ;
FROM M2LexBuf IMPORT currentstring, currenttoken, GetToken, InsertToken,
InsertTokenAndRewind, GetTokenNo, DisplayToken,
DumpTokens ;
+FROM M2Quads IMPORT PushT, PushTF, IsAutoPushOn, PushAutoOff, PushAutoOn,
+ PopAuto, DisplayStack, PushTFtok, PushTtok, DupFrame,
+ Top ;
+
+FROM M2Reserved IMPORT tokToTok, toktype, NulTok, ImportTok, ExportTok,
+ QualifiedTok, UnQualifiedTok, BuiltinTok, InlineTok ;
+
FROM M2MetaError IMPORT MetaErrorStringT0 ;
-FROM M2Quads IMPORT PushT, PushTF, IsAutoPushOn, PushAutoOff, PushAutoOn,
PopAuto, DisplayStack, PushTFtok, PushTtok ;
-FROM M2Reserved IMPORT tokToTok, toktype, NulTok, ImportTok, ExportTok,
QualifiedTok, UnQualifiedTok, BuiltinTok, InlineTok ;
FROM P2SymBuild IMPORT BuildString, BuildNumber ;
FROM NameKey IMPORT Name, NulName, makekey ;
FROM StrLib IMPORT StrCopy, StrConCat, StrEqual ;
@@ -64,7 +69,7 @@ FROM P0SymBuild IMPORT RegisterImports, RegisterInnerImports,
RegisterProgramModule,
RegisterImplementationModule, RegisterDefinitionModule,
RegisterInnerModule, EndModule,
- RegisterProcedure, EndProcedure ;
+ RegisterProcedure, EndProcedure, EndForward ;
FROM SymbolTable IMPORT NulSym, PutModuleContainsBuiltin,
PutHiddenTypeDeclared ;
@@ -88,6 +93,16 @@ VAR
InsertCount : CARDINAL ;
+(*
+ BlockAssert - wrap an Assert specifically for blocks.
+*)
+
+PROCEDURE BlockAssert (value: BOOLEAN) ;
+BEGIN
+ Assert (value) ;
+END BlockAssert ;
+
+
PROCEDURE ErrorString (s: String) ;
BEGIN
MetaErrorStringT0 (GetTokenNo (), s) ;
@@ -487,6 +502,7 @@ token 'EXIT' exittok
token 'EXPORT' exporttok
token 'FINALLY' finallytok
token 'FOR' fortok
+token 'FORWARD' forwardtok
token 'FROM' fromtok
token 'IF' iftok
token 'IMPLEMENTATION' implementationtok
@@ -805,11 +821,20 @@ LoopStatement := "LOOP" StatementSequence "END" =:
WithStatement := "WITH" Designator "DO" StatementSequence "END" =:
-ProcedureDeclaration :=
- ProcedureHeading ";" ( ProcedureBlock %
PushAutoOn %
- Ident %
EndProcedure %
+ProcedureDeclaration := %
VAR top: CARDINAL ; %
+ %
top := Top () %
+ ProcedureHeading ";" PostProcedureHeading %
BlockAssert (top = Top ()) %
+ =:
+
+PostProcedureHeading := ProperProcedure | ForwardDeclaration =:
+
+ForwardDeclaration := "FORWARD" %
EndForward %
+ =:
+
+ProperProcedure := ProcedureBlock %
PushAutoOn %
+ Ident %
EndProcedure %
%
PopAuto %
- ) =:
+ =:
DefineBuiltinProcedure := [ "__ATTRIBUTE__" "__BUILTIN__" "(" "(" Ident ")"
")" |
"__INLINE__" ] =:
diff --git a/gcc/m2/gm2-compiler/P1Build.bnf b/gcc/m2/gm2-compiler/P1Build.bnf
index a3534fcb84d2..ac96ddb383f1 100644
--- a/gcc/m2/gm2-compiler/P1Build.bnf
+++ b/gcc/m2/gm2-compiler/P1Build.bnf
@@ -46,7 +46,7 @@ IMPLEMENTATION MODULE P1Build ;
FROM M2LexBuf IMPORT currentstring, currenttoken, GetToken, InsertToken,
InsertTokenAndRewind, GetTokenNo ;
FROM M2Error IMPORT ErrorStringAt ;
-FROM M2Quads IMPORT PushT, PushTF, PushTFtok, IsAutoPushOn, PushAutoOff,
PushAutoOn, PopAuto, DisplayStack ;
+FROM M2Quads IMPORT Top, PushT, PushTF, PushTFtok, IsAutoPushOn, PushAutoOff,
PushAutoOn, PopAuto, DisplayStack, DupFrame ;
FROM M2Reserved IMPORT tokToTok, toktype, NulTok, ImportTok, ExportTok,
QualifiedTok, UnQualifiedTok, BuiltinTok, InlineTok ;
FROM NameKey IMPORT Name, NulName, makekey ;
FROM StrLib IMPORT StrCopy, StrConCat, StrEqual ;
@@ -89,6 +89,7 @@ FROM P1SymBuild IMPORT P1StartBuildProgramModule,
BuildProcedureHeading,
StartBuildProcedure,
EndBuildProcedure,
+ EndBuildForward,
AddImportToImportStatement,
BuildImportStatement ;
@@ -482,6 +483,7 @@ token 'EXIT' exittok
token 'EXPORT' exporttok
token 'FINALLY' finallytok
token 'FOR' fortok
+token 'FORWARD' forwardtok
token 'FROM' fromtok
token 'IF' iftok
token 'IMPLEMENTATION' implementationtok
@@ -869,10 +871,20 @@ LoopStatement := "LOOP" StatementSequence "END" =:
WithStatement := "WITH" Designator "DO" StatementSequence "END" =:
-ProcedureDeclaration := ProcedureHeading ";" ( ProcedureBlock %
PushAutoOn %
- Ident ) %
EndBuildProcedure %
+ProcedureDeclaration := %
VAR top: CARDINAL ; %
+ %
top := Top () %
+ ProcedureHeading ";" PostProcedureHeading %
Assert (top = Top ()) %
+ =:
+
+PostProcedureHeading := ProperProcedure | ForwardDeclaration =:
+
+ForwardDeclaration := "FORWARD" %
EndBuildForward %
+ =:
+
+ProperProcedure := ProcedureBlock %
PushAutoOn %
+ Ident %
EndBuildProcedure %
%
PopAuto %
- =:
+ =:
DefineBuiltinProcedure := "__ATTRIBUTE__" "__BUILTIN__" "(" "(" Ident ")" ")"
| "__INLINE__" %
PushT(InlineTok) %
diff --git a/gcc/m2/gm2-compiler/P1SymBuild.def
b/gcc/m2/gm2-compiler/P1SymBuild.def
index c909d7e23876..89ed3ad480bd 100644
--- a/gcc/m2/gm2-compiler/P1SymBuild.def
+++ b/gcc/m2/gm2-compiler/P1SymBuild.def
@@ -25,37 +25,12 @@ DEFINITION MODULE P1SymBuild ;
Title : P1SymBuild
Author : Gaius Mulley
Date : 24/6/87
- LastEdit : Sat Dec 9 11:34:34 EST 1989
System : UNIX (GNU Modula-2)
Description: Builds symbol entities, types, constants, variables,
procedures, modules and scopes.
All procedures are only called during Pass 1.
*)
-EXPORT QUALIFIED P1StartBuildDefinitionModule,
- P1EndBuildDefinitionModule,
- P1StartBuildImplementationModule,
- P1EndBuildImplementationModule,
- P1StartBuildProgramModule,
- P1EndBuildProgramModule,
- StartBuildInnerModule,
- EndBuildInnerModule,
- BuildImportOuterModule,
- BuildExportOuterModule,
- BuildImportInnerModule,
- BuildExportInnerModule,
- StartBuildEnumeration,
- EndBuildEnumeration,
- BuildHiddenType,
- StartBuildProcedure,
- EndBuildProcedure,
- BuildProcedureHeading,
- BuildNulName,
- BuildTypeEnd,
- CheckExplicitExported,
- BuildImportStatement,
- AddImportToImportStatement ;
-
(*
StartBuildDefinitionModule - Creates a definition module and starts
@@ -496,6 +471,27 @@ PROCEDURE EndBuildProcedure ;
PROCEDURE BuildProcedureHeading ;
+(*
+ EndBuildForward - Ends building a forward procedure declaration.
+
+ The Stack:
+
+ (This procedure is not defined in definition module)
+
+ Entry Exit
+
+ Ptr ->
+ +------------+
+ | ProcSym |
+ |------------|
+ | NameStart |
+ |------------|
+ Empty
+*)
+
+PROCEDURE EndBuildForward ;
+
+
(*
BuildNulName - Pushes a NulKey onto the top of the stack.
The Stack:
diff --git a/gcc/m2/gm2-compiler/P1SymBuild.mod
b/gcc/m2/gm2-compiler/P1SymBuild.mod
index 53aab8190098..40a83b7bacb9 100644
--- a/gcc/m2/gm2-compiler/P1SymBuild.mod
+++ b/gcc/m2/gm2-compiler/P1SymBuild.mod
@@ -82,6 +82,9 @@ FROM SymbolTable IMPORT NulSym,
PutProcedureBuiltin, PutProcedureInline,
GetSymName,
ResolveImports, PutDeclared,
+ GetProcedureDeclaredForward,
PutProcedureDeclaredForward,
+ GetProcedureDeclaredProper, PutProcedureDeclaredProper,
+ GetProcedureDeclaredDefinition,
PutProcedureDeclaredDefinition,
MakeError, MakeErrorS,
DisplayTrees ;
@@ -931,14 +934,20 @@ BEGIN
ProcSym := RequestSym (tokno, name) ;
IF IsUnknown (ProcSym)
THEN
- (*
- May have been compiled in DEF or IMP module, remember that IMP maybe
- compiled before corresponding DEF module.
- *)
+ (* A procedure may be created in a definition or implementation module,
remember
+ that an implementation module maybe compiled before the corresponding
+ definition module.
+
+ The procedure can also be created during a forward declaration.
+ We record the forward declaration as the token of creation and adjust
this
+ later when we see the proper procedure declaration. Likwwise when
the forward
+ keyword is seen we assign the procedure forward token location. *)
ProcSym := MakeProcedure (tokno, name)
ELSIF IsProcedure (ProcSym)
THEN
- (* declared in the other module, we record declaration here as well *)
+ (* Declared in the other module or it could have been declared by a
forward decl,
+ we overwrite the declaration to tokno. The forward location is
assigned in
+ EndBuildForward. *)
PutDeclared (tokno, ProcSym)
ELSE
MetaError1 ('expecting a procedure name and symbol {%1Ea} has been
declared as a {%1d}', ProcSym) ;
@@ -957,10 +966,20 @@ BEGIN
PutProcedureBuiltin (ProcSym, builtin)
END
END ;
- PushT (ProcSym) ;
+ PushTtok (ProcSym, tokno) ;
StartScope (ProcSym) ;
- IF NOT CompilingDefinitionModule ()
+ IF CompilingDefinitionModule ()
THEN
+ IF GetProcedureDeclaredDefinition (ProcSym) = UnknownTokenNo
+ THEN
+ PutProcedureDeclaredDefinition (ProcSym, tokno)
+ ELSE
+ MetaErrorT1 (GetProcedureDeclaredDefinition (ProcSym),
+ 'first declaration of procedure {%1Ea} in the definition
module', ProcSym) ;
+ MetaErrorT1 (tokno,
+ 'duplicate declaration of procedure {%1Ea} in the
definition module', ProcSym)
+ END
+ ELSE
EnterBlock (name)
END
END StartBuildProcedure ;
@@ -990,13 +1009,14 @@ END StartBuildProcedure ;
PROCEDURE EndBuildProcedure ;
VAR
+ tok,
start, end: CARDINAL ;
ProcSym : CARDINAL ;
NameEnd,
NameStart : Name ;
BEGIN
PopTtok(NameEnd, end) ;
- PopT(ProcSym) ;
+ PopTtok(ProcSym, tok) ;
PopTtok(NameStart, start) ;
IF NameEnd#NameStart
THEN
@@ -1014,11 +1034,59 @@ BEGIN
END
END ;
EndScope ;
+ IF GetProcedureDeclaredProper (ProcSym) = UnknownTokenNo
+ THEN
+ PutProcedureDeclaredProper (ProcSym, tok)
+ ELSE
+ MetaErrorT1 (GetProcedureDeclaredProper (ProcSym),
+ 'first proper declaration of procedure {%1Ea}', ProcSym) ;
+ MetaErrorT1 (tok, 'procedure {%1Ea} has already been declared', ProcSym)
+ END ;
Assert (NOT CompilingDefinitionModule()) ;
LeaveBlock
END EndBuildProcedure ;
+(*
+ EndBuildForward - Ends building a forward procedure declaration.
+
+ The Stack:
+
+ (This procedure is not defined in definition module)
+
+ Entry Exit
+
+ Ptr ->
+ +------------+
+ | ProcSym |
+ |------------|
+ | NameStart |
+ |------------|
+ Empty
+*)
+
+PROCEDURE EndBuildForward ;
+VAR
+ ProcSym: CARDINAL ;
+ tok : CARDINAL ;
+BEGIN
+ ProcSym := OperandT (1) ;
+ tok := OperandTok (1) ;
+ IF GetProcedureDeclaredForward (ProcSym) = UnknownTokenNo
+ THEN
+ PutProcedureDeclaredForward (ProcSym, tok)
+ ELSE
+ MetaErrorT1 (GetProcedureDeclaredForward (ProcSym),
+ 'first forward declaration of {%1Ea}', ProcSym) ;
+ MetaErrorT1 (tok, 'forward declaration of procedure {%1Ea} has already
occurred', ProcSym)
+ END ;
+ PopN (2) ;
+ EndScope ;
+ Assert (NOT CompilingDefinitionModule ()) ;
+ LeaveBlock
+END EndBuildForward ;
+
+
(*
BuildProcedureHeading - Builds a procedure heading for the definition
module procedures.
diff --git a/gcc/m2/gm2-compiler/P2Build.bnf b/gcc/m2/gm2-compiler/P2Build.bnf
index d69ce2cf17e5..3946f243134c 100644
--- a/gcc/m2/gm2-compiler/P2Build.bnf
+++ b/gcc/m2/gm2-compiler/P2Build.bnf
@@ -97,6 +97,9 @@ FROM P2SymBuild IMPORT P2StartBuildProgramModule,
EndBuildProcedure,
BuildFunction, BuildOptFunction,
BuildNoReturnAttribute,
+ BuildProcedureDefinedByForward,
+ BuildProcedureDefinedByProper,
+ EndBuildForward,
BuildPointerType,
BuildRecord, BuildFieldRecord,
@@ -115,7 +118,8 @@ FROM P2SymBuild IMPORT P2StartBuildProgramModule,
DetermineType, PushType, PopType,
SeenUnknown, SeenSet, SeenString, SeenArray,
SeenConstructor,
SeenCast,
- PushRememberConstant, PopRememberConstant ;
+ PushRememberConstant, PopRememberConstant,
+ CheckProcedure ;
FROM M2Reserved IMPORT ArrayTok, VarTok ;
@@ -499,6 +503,7 @@ token 'EXIT' exittok
token 'EXPORT' exporttok
token 'FINALLY' finallytok
token 'FOR' fortok
+token 'FORWARD' forwardtok
token 'FROM' fromtok
token 'IF' iftok
token 'IMPLEMENTATION' implementationtok
@@ -884,7 +889,9 @@ FormalTypeList := "(" ( ")" FormalReturn |
ProcedureParameters
")" FormalReturn ) =:
-FormalReturn := [ ":" OptReturnType ] =:
+FormalReturn := ( ":" OptReturnType | %
CheckProcedure %
+ )
+ =:
OptReturnType := "[" Qualident %
BuildOptFunction %
"]" | Qualident %
BuildFunction %
@@ -1008,13 +1015,22 @@ LoopStatement := "LOOP" StatementSequence "END" =:
WithStatement := "WITH" Designator "DO" StatementSequence "END" =:
-ProcedureDeclaration := ProcedureHeading %
Assert(IsProcedure(OperandT(1))) %
- ";" ( ProcedureBlock
- %
Assert(IsProcedure(OperandT(1))) %
- Ident )
- %
EndBuildProcedure %
+ProcedureDeclaration := %
VAR top: CARDINAL ; %
+ %
top := Top () %
+ ProcedureHeading %
Assert(IsProcedure(OperandT(1))) %
+ ";" PostProcedureHeading %
Assert (top = Top ()) %
+ =:
- =:
+PostProcedureHeading := ProperProcedure | ForwardDeclaration =:
+
+ForwardDeclaration := "FORWARD" %
Assert (IsProcedure (OperandT (1))) %
+ %
BuildProcedureDefinedByForward (OperandT (1)) %
+ %
EndBuildForward %
+ =:
+
+ProperProcedure := ProcedureBlock %
Assert(IsProcedure(OperandT(1))) %
+ Ident %
EndBuildProcedure %
+ =:
DefineBuiltinProcedure := [ "__ATTRIBUTE__" "__BUILTIN__"
"(" "(" %
PushAutoOff %
@@ -1064,6 +1080,7 @@ AttributeUnused := [ "<*"
% Pus
-- error messages
ProcedureBlock := %
Assert(IsProcedure(OperandT(1))) %
+ %
BuildProcedureDefinedByProper (OperandT (1)) %
{ %
Assert(IsProcedure(OperandT(1))) %
Declaration %
Assert(IsProcedure(OperandT(1))) %
} [ "BEGIN" ProcedureBlockBody ] "END" %
Assert(IsProcedure(OperandT(1))) %
@@ -1161,7 +1178,7 @@ NonVarFPSection :=
% VAR
%
BuildFPSection %
=:
-FormalType := "ARRAY" "OF" %
VAR n: CARDINAL ; %
+FormalType := "ARRAY" "OF" %
VAR n, tok: CARDINAL ; %
%
PushTF(ArrayTok, 1) %
{ "ARRAY" "OF" %
PopTF(ArrayTok, n) %
%
INC(n) %
@@ -1169,9 +1186,9 @@ FormalType := "ARRAY" "OF"
% VAR
} Qualident
| %
VAR Sym, Type: CARDINAL ; %
Qualident
- %
PopTF(Sym, Type) ;
+ %
PopTFtok (Sym, Type, tok) ;
PushT(NulTok) ;
-
PushTF(Sym, Type) %
+
PushTFtok (Sym, Type, tok) %
=:
ModuleDeclaration := "MODULE" %
M2Error.DefaultInnerModule %
diff --git a/gcc/m2/gm2-compiler/P2SymBuild.def
b/gcc/m2/gm2-compiler/P2SymBuild.def
index 89a83144011b..45b52f7f02d7 100644
--- a/gcc/m2/gm2-compiler/P2SymBuild.def
+++ b/gcc/m2/gm2-compiler/P2SymBuild.def
@@ -30,69 +30,6 @@ DEFINITION MODULE P2SymBuild ;
Description: pass 2 symbol creation.
*)
-EXPORT QUALIFIED P2StartBuildDefModule,
- P2EndBuildDefModule,
- P2StartBuildImplementationModule,
- P2EndBuildImplementationModule,
- P2StartBuildProgramModule,
- P2EndBuildProgramModule,
- StartBuildInnerModule,
- EndBuildInnerModule,
- BuildImportOuterModule,
- BuildExportOuterModule,
- BuildImportInnerModule,
- BuildExportInnerModule,
- BlockStart, BlockEnd, BlockBegin, BlockFinally,
- BuildNumber,
- BuildString,
- BuildConst,
- BuildSubrange, BuildAligned,
- BuildTypeAlignment, BuildVarAlignment,
- P2BuildDefaultFieldAlignment, BuildPragmaConst,
- BuildVariable,
- StartBuildEnumeration,
- BuildType,
- StartBuildFormalParameters,
- EndBuildFormalParameters,
- BuildProcedureHeading,
- BuildFPSection,
- BuildVarArgs,
- BuildFormalVarArgs,
- BuildOptArg,
- StartBuildProcedure,
- EndBuildProcedure,
- BuildNoReturnAttribute,
- BuildFunction,
- BuildOptFunction,
- BuildPointerType,
- BuildSetType,
- BuildRecord,
- BuildFieldRecord,
- StartBuildVarient,
- EndBuildVarient,
- BuildVarientSelector,
- StartBuildVarientFieldRecord,
- EndBuildVarientFieldRecord,
- BuildNulName,
- BuildTypeEnd,
- StartBuildArray, BuildArrayComma,
- EndBuildArray,
- BuildFieldArray,
- BuildProcedureType,
- BuildFormalType,
- SeenCast,
- SeenSet,
- SeenArray,
- SeenConstructor,
- SeenUnknown,
- SeenString,
- SeenBoolean,
- SeenCType, SeenRType, SeenZType,
- DetermineType, PushType, PopType,
- PushRememberConstant,
- PopRememberConstant,
- RememberConstant ;
-
(*
BlockStart - tokno is the module/procedure/implementation/definition token
@@ -864,6 +801,13 @@ PROCEDURE StartBuildProcedure ;
PROCEDURE EndBuildProcedure ;
+(*
+ EndBuildForward - ends building a forward procedure.
+*)
+
+PROCEDURE EndBuildForward ;
+
+
(*
BuildNoReturnAttribute - provide an interface to the symbol table module.
*)
@@ -871,6 +815,39 @@ PROCEDURE EndBuildProcedure ;
PROCEDURE BuildNoReturnAttribute (procedureSym: CARDINAL) ;
+(*
+ BuildProcedureDefinedByForward - indicates that the parameters for ProcSym
have
+ been defined using the FORWARD keyword.
+*)
+
+PROCEDURE BuildProcedureDefinedByForward (ProcSym: CARDINAL) ;
+
+
+(*
+ BuildProcedureDefinedByProper - indicates that the parameters for ProcSym
have
+ been defined during a proper procedure
declaration.
+*)
+
+PROCEDURE BuildProcedureDefinedByProper (ProcSym: CARDINAL) ;
+
+
+(*
+ CheckProcedure - checks to see that the top of stack procedure
+ has not been declared as a procedure function.
+
+ The Stack:
+
+ Entry Exit
+
+ Ptr -> <- Ptr
+ +------------+ +------------+
+ | ProcSym | | ProcSym |
+ |------------| |------------|
+*)
+
+PROCEDURE CheckProcedure ;
+
+
(*
BuildPointerType - builds a pointer type.
The Stack:
diff --git a/gcc/m2/gm2-compiler/P2SymBuild.mod
b/gcc/m2/gm2-compiler/P2SymBuild.mod
index a5060242a0e7..9edb911949ea 100644
--- a/gcc/m2/gm2-compiler/P2SymBuild.mod
+++ b/gcc/m2/gm2-compiler/P2SymBuild.mod
@@ -27,10 +27,9 @@ FROM NameKey IMPORT Name, MakeKey, makekey, KeyToCharStar,
NulName, LengthKey, W
FROM StrLib IMPORT StrEqual ;
FROM M2Debug IMPORT Assert, WriteDebug ;
FROM M2LexBuf IMPORT UnknownTokenNo, GetTokenNo, MakeVirtual2Tok ;
-FROM M2Error IMPORT InternalError, WriteFormat1, WriteFormat2, WriteFormat0,
ErrorStringAt, ErrorStringAt2 ;
-FROM M2MetaError IMPORT MetaError1, MetaError2, MetaErrorsT2, MetaErrors1,
MetaErrors2, MetaErrorString1 ;
+FROM M2Error IMPORT InternalError, WriteFormat1, WriteFormat2, WriteFormat0,
ErrorStringAt, ErrorStringAt2, WarnStringAt ;
FROM DynamicStrings IMPORT String, InitString, InitStringCharStar, Mark,
Slice, ConCat, KillString, string ;
-FROM FormatStrings IMPORT Sprintf0, Sprintf1, Sprintf2, Sprintf4 ;
+FROM FormatStrings IMPORT Sprintf0, Sprintf1, Sprintf2, Sprintf3, Sprintf4 ;
FROM M2Printf IMPORT printf0, printf1, printf2, printf3 ;
FROM M2StackWord IMPORT StackOfWord, InitStackWord, PushWord, PopWord ;
FROM M2Options IMPORT PedanticParamNames, ExtendedOpaque ;
@@ -43,6 +42,10 @@ FROM M2LexBuf IMPORT TokenToLocation ;
FROM M2Reserved IMPORT ImportTok, ExportTok, QualifiedTok, UnQualifiedTok,
NulTok, VarTok, ArrayTok ;
+FROM M2MetaError IMPORT MetaError1, MetaError2, MetaErrorsT2, MetaErrors1,
+ MetaErrors2, MetaErrorString1, MetaErrorStringT1,
+ MetaErrorString3, MetaErrorStringT3 ;
+
FROM FifoQueue IMPORT GetEnumerationFromFifoQueue, PutSubrangeIntoFifoQueue,
PutConstructorIntoFifoQueue, PutConstIntoFifoQueue ;
@@ -60,7 +63,7 @@ FROM SymbolTable IMPORT NulSym,
MakeVar, MakeType, PutType,
MakeModuleCtor,
PutMode, PutDeclared, GetParameterShadowVar,
- PutFieldEnumeration, PutSubrange, PutVar, PutConst,
+ PutFieldEnumeration, PutSubrange, PutVar, PutVarTok,
PutConst,
PutConstSet, PutConstructor,
IsDefImp, IsType, IsRecord, IsRecordField, IsPointer,
IsSubrange, IsEnumeration, IsConstString,
@@ -87,6 +90,7 @@ FROM SymbolTable IMPORT NulSym,
MakeVarient, MakeFieldVarient,
MakeArray, PutArraySubscript,
MakeSubscript, PutSubscript,
+ MakeError,
PutConstStringKnown, GetString,
PutArray, IsArray,
GetType, SkipType,
@@ -108,8 +112,15 @@ FROM SymbolTable IMPORT NulSym,
ParametersDefinedInDefinition,
ParametersDefinedInImplementation,
ProcedureParametersDefined,
+ GetProcedureDeclaredDefinition,
+ GetProcedureDeclaredForward,
+ GetProcedureDeclaredProper,
+ GetParametersDefinedByForward,
+ GetParametersDefinedByProper,
PutProcedureNoReturn,
PutProcedureParameterHeapVars,
+ PutParametersDefinedByForward,
+ PutParametersDefinedByProper,
CheckForUnImplementedExports,
CheckForUndeclaredExports,
IsHiddenTypeDeclared,
@@ -125,6 +136,10 @@ FROM SymbolTable IMPORT NulSym,
RequestSym,
PutDeclared,
GetPackedEquivalent,
+ GetVarDeclTok,
+ GetVarDeclFullTok,
+ PutVarDeclTok,
+ GetVarDeclTypeTok,
DisplayTrees ;
FROM M2Batch IMPORT MakeDefinitionSource,
@@ -1143,12 +1158,13 @@ PROCEDURE BuildVariable ;
VAR
name : Name ;
tok,
+ typetok,
AtAddress,
Type,
Var,
i, n : CARDINAL ;
BEGIN
- PopTF (Type, name) ;
+ PopTFtok (Type, name, typetok) ;
PopT (n) ;
i := 1 ;
WHILE i <= n DO
@@ -1160,11 +1176,12 @@ BEGIN
PutVariableAtAddress (Var, NulSym) ;
PutMode (Var, LeftValue)
END ;
- PutVar (Var, Type) ;
+ PutVarTok (Var, Type, typetok) ;
tok := OperandTok (n+1-i) ;
IF tok # UnknownTokenNo
THEN
PutDeclared (tok, Var) ;
+ PutVarDeclTok (Var, tok) ;
name := OperandT (n+1-i) ;
(* printf3 ('declaring variable %a at tok %d Type %d \n', name, tok,
Type) *)
(*
@@ -1316,12 +1333,9 @@ BEGIN
ProcSym := GetDeclareSym (tokno, name) ;
IF IsUnknown (ProcSym)
THEN
- (*
- May have been compiled in the definition or implementation module,
- remember that implementation maybe compiled before corresponding
- definition module.
- - no definition should always be compilied before implementation
modules.
- *)
+ (* May have been compiled in the definition or implementation module.
+ Note we always see an implementation module before its corresponding
+ definition module. *)
ProcSym := MakeProcedure (tokno, name)
ELSIF IsProcedure (ProcSym)
THEN
@@ -1385,6 +1399,18 @@ BEGIN
END EndBuildProcedure ;
+(*
+ EndBuildForward - ends building a forward procedure.
+*)
+
+PROCEDURE EndBuildForward ;
+BEGIN
+ PopN (2) ;
+ EndScope ;
+ M2Error.LeaveErrorScope
+END EndBuildForward ;
+
+
(*
BuildProcedureHeading - Builds a procedure heading for the definition
module procedures.
@@ -1411,6 +1437,8 @@ VAR
ProcSym : CARDINAL ;
NameStart: Name ;
BEGIN
+ ProcSym := OperandT (1) ;
+ ProcedureParametersDefined (ProcSym) ;
IF CompilingDefinitionModule()
THEN
PopT(ProcSym) ;
@@ -1454,7 +1482,6 @@ END BuildProcedureHeading ;
PROCEDURE BuildFPSection ;
VAR
- n : Name ;
ProcSym,
ParamTotal: CARDINAL ;
BEGIN
@@ -1464,11 +1491,7 @@ BEGIN
Assert(IsProcedure(ProcSym)) ;
IF CompilingDefinitionModule()
THEN
- IF AreParametersDefinedInDefinition(ProcSym) AND (ParamTotal=0)
- THEN
- n := GetSymName(ProcSym) ;
- WriteFormat1('cannot declare procedure %a twice in the definition
module', n)
- ELSIF AreParametersDefinedInImplementation(ProcSym)
+ IF AreParametersDefinedInImplementation(ProcSym)
THEN
CheckFormalParameterSection
ELSE
@@ -1476,16 +1499,12 @@ BEGIN
IF ParamTotal=0
THEN
ParametersDefinedInDefinition(ProcSym) ;
- ProcedureParametersDefined(ProcSym)
+ (* ProcedureParametersDefined(ProcSym) *)
END
END
ELSIF CompilingImplementationModule()
THEN
- IF AreParametersDefinedInImplementation(ProcSym) AND (ParamTotal=0)
- THEN
- n := GetSymName(ProcSym) ;
- WriteFormat1('cannot declare procedure %a twice in the implementation
module', n)
- ELSIF AreParametersDefinedInDefinition(ProcSym)
+ IF AreParametersDefinedInDefinition(ProcSym) OR
GetParametersDefinedByForward (ProcSym)
THEN
CheckFormalParameterSection
ELSE
@@ -1493,20 +1512,19 @@ BEGIN
IF ParamTotal=0
THEN
ParametersDefinedInImplementation(ProcSym) ;
- ProcedureParametersDefined(ProcSym)
+ (* ProcedureParametersDefined(ProcSym) *)
END
END
ELSIF CompilingProgramModule()
THEN
- IF AreProcedureParametersDefined(ProcSym) AND (ParamTotal=0)
+ IF GetParametersDefinedByForward (ProcSym) OR
AreProcedureParametersDefined (ProcSym)
THEN
- n := GetSymName(ProcSym) ;
- WriteFormat1('procedure %a parameters already declared in program
module', n)
+ CheckFormalParameterSection
ELSE
BuildFormalParameterSection ;
IF ParamTotal=0
THEN
- ProcedureParametersDefined(ProcSym)
+ (* ProcedureParametersDefined(ProcSym) *)
END
END
ELSE
@@ -1516,6 +1534,30 @@ BEGIN
END BuildFPSection ;
+(*
+ BuildProcedureDefinedByForward - indicates that the parameters for ProcSym
have
+ been defined using the FORWARD keyword.
+*)
+
+PROCEDURE BuildProcedureDefinedByForward (ProcSym: CARDINAL) ;
+BEGIN
+ Assert (IsProcedure (ProcSym)) ;
+ PutParametersDefinedByForward (ProcSym)
+END BuildProcedureDefinedByForward ;
+
+
+(*
+ BuildProcedureDefinedByProper - indicates that the parameters for ProcSym
have
+ been defined during a proper procedure
declaration.
+*)
+
+PROCEDURE BuildProcedureDefinedByProper (ProcSym: CARDINAL) ;
+BEGIN
+ Assert (IsProcedure (ProcSym)) ;
+ PutParametersDefinedByProper (ProcSym)
+END BuildProcedureDefinedByProper ;
+
+
(*
BuildVarArgs - indicates that the ProcSym takes varargs
after ParamTotal.
@@ -1657,6 +1699,7 @@ VAR
Var,
Array : Name ;
tok : CARDINAL ;
+ TypeTok,
ParamTotal,
TypeSym,
UnBoundedSym,
@@ -1665,7 +1708,7 @@ VAR
i, ndim : CARDINAL ;
BEGIN
PopT(ParamTotal) ;
- PopT(TypeSym) ;
+ PopTtok (TypeSym, TypeTok) ;
PopTF(Array, ndim) ;
Assert( (Array=ArrayTok) OR (Array=NulTok) ) ;
PopT(NoOfIds) ;
@@ -1680,13 +1723,9 @@ BEGIN
TypeSym := UnBoundedSym
END ;
i := 1 ;
-(*
- WriteString('Procedure ') ; WriteKey(GetSymName(ProcSym)) ;
- WriteString(' adding No. of identifiers:') ; WriteCard(NoOfIds, 4) ;
WriteLn ;
-*)
- WHILE i<=NoOfIds DO
+ WHILE i <= NoOfIds DO
IF CompilingDefinitionModule() AND (NOT PedanticParamNames) AND
- (* we will see the parameters in the implementation module *)
+ (* We will see the parameters in the implementation module. *)
((GetMainModule()=GetCurrentModule()) OR
(IsHiddenTypeDeclared(GetCurrentModule()) AND ExtendedOpaque))
THEN
@@ -1694,27 +1733,25 @@ BEGIN
ELSE
ParamName := OperandT(NoOfIds+1-i)
END ;
- tok := OperandTok(NoOfIds+1-i) ;
+ tok := OperandTok (NoOfIds+1-i) ;
+ (* WarnStringAt (InitString ('building param pos?'), OperandTok
(NoOfIds+1-i)) ; *)
IF Var=VarTok
THEN
- (* VAR parameter *)
- IF NOT PutVarParam(tok, ProcSym, ParamTotal+i, ParamName, TypeSym,
Array=ArrayTok)
+ (* VAR parameter. *)
+ IF NOT PutVarParam (tok, ProcSym, ParamTotal+i, ParamName,
+ TypeSym, Array=ArrayTok, TypeTok)
THEN
InternalError ('problems adding a VarParameter - wrong param #?')
END
ELSE
- (* Non VAR parameter *)
- IF NOT PutParam(tok, ProcSym, ParamTotal+i, ParamName, TypeSym,
Array=ArrayTok)
+ (* Non VAR parameter. *)
+ IF NOT PutParam (tok, ProcSym, ParamTotal+i, ParamName,
+ TypeSym, Array=ArrayTok, TypeTok)
THEN
InternalError ('problems adding a Parameter - wrong param #?')
END
END ;
-(*
- WriteString(' parameter') ; WriteCard(ParamTotal+i, 4) ; WriteLn ;
- WriteKey(Operand(Ptr+i+1)) ; WriteString(' is a parameter with type ') ;
- WriteKey(GetSymName(TypeSym)) ; WriteLn ;
-*)
- INC(i)
+ INC (i)
END ;
PopN(NoOfIds+1) ;
PushT(ParamTotal+NoOfIds) ;
@@ -1760,75 +1797,88 @@ VAR
ParamI,
ParamIType,
ParamTotal,
+ TypeTok,
TypeSym,
NoOfIds,
+ ProcTok,
ProcSym,
pi, i, ndim: CARDINAL ;
BEGIN
PopT(ParamTotal) ;
- PopT(TypeSym) ;
+ PopTtok(TypeSym, TypeTok) ;
PopTF(Array, ndim) ;
Assert( (Array=ArrayTok) OR (Array=NulTok) ) ;
PopT(NoOfIds) ;
ProcSym := OperandT(NoOfIds+2) ;
+ ProcTok := OperandTok (NoOfIds+2) ;
Assert(IsProcedure(ProcSym)) ;
Var := OperandT(NoOfIds+1) ;
Assert( (Var=VarTok) OR (Var=NulTok) ) ;
- Unbounded := (Array=ArrayTok) ; (* ARRAY OF Type, parameter *)
+ Unbounded := (Array=ArrayTok) ; (* ARRAY OF Type, parameter. *)
i := 1 ;
- pi := NoOfIds ; (* stack index referencing stacked parameter, i *)
+ pi := NoOfIds ; (* Stack index referencing stacked parameter i. *)
(*
WriteString('No. of identifiers:') ; WriteCard(NoOfIds, 4) ; WriteLn ;
*)
+ (* If there are an incorrect number of parameters specified then this
+ will be detcted by EndBuildFormalParameters. *)
WHILE i<=NoOfIds DO
IF ParamTotal+i<=NoOfParam(ProcSym)
THEN
+ (* WarnStringAt (InitString ('parampos?'), OperandTok (pi)) ; *)
IF Unbounded AND (NOT IsUnboundedParam(ProcSym, ParamTotal+i))
THEN
- FailParameter('the parameter was declared as an ARRAY OF type',
- 'the parameter was not declared as an ARRAY OF type',
- NulName, ParamTotal+i, ProcSym)
+ ParameterError ('declaration of procedure {%%1a} in the %s differs
from the %s, {%%2N} parameter is inconsistant, %s',
+ 'the parameter {%3Ea} was not declared as an ARRAY
OF type', (* '{%3EHa}'. *)
+ 'the parameter {%3EVa} was declared as an ARRAY OF
type',
+ pi, ParamTotal+i, ProcSym, ProcTok, GetParam
(ProcSym, ParamTotal+i), TypeTok)
ELSIF (NOT Unbounded) AND IsUnboundedParam(ProcSym, ParamTotal+i)
THEN
- FailParameter('the parameter was not declared as an ARRAY OF type',
- 'the parameter was declared as an ARRAY OF type',
- NulName, ParamTotal+i, ProcSym)
+ ParameterError ('declaration of procedure {%%1a} in the %s differs
from the %s, {%%2N} parameter is inconsistant, %s',
+ 'the parameter {%3Ea} was declared as an ARRAY OF
type', (* '{%3EHa}'. *)
+ 'the parameter {%3EVa} was not declared as an
ARRAY OF type',
+ pi, ParamTotal+i, ProcSym, ProcTok, GetParam
(ProcSym, ParamTotal+i), TypeTok)
END ;
IF Unbounded
THEN
IF GetDimension(GetNthParam(ProcSym, ParamTotal+1))#ndim
THEN
- FailParameter('', 'the dynamic array parameter was declared
with different number of dimensions',
- NulName, ParamTotal+i, ProcSym)
+ ParameterError ('declaration of procedure {%%1a} in the %s
differs from the %s, {%%2N} parameter is inconsistant, %s',
+ 'the dynamic array parameter {%3Ea} was
declared with a different of dimensions', (* '{%3EHa}'. *)
+ 'the dynamic array parameter {%3EVa} was
declared with a different of dimensions',
+ pi, ParamTotal+i, ProcSym, ProcTok, GetParam
(ProcSym, ParamTotal+i), TypeTok)
END
END ;
IF (Var=VarTok) AND (NOT IsVarParam(ProcSym, ParamTotal+i))
THEN
- (* expecting non VAR pamarater *)
- FailParameter('the parameter has been declared as a VAR parameter',
- 'the parameter was not declared as a VAR parameter',
- NulName, ParamTotal+i, ProcSym)
+ (* Expecting non VAR parameter. *)
+ ParameterError ('declaration of procedure {%%1a} in the %s differs
from the %s, {%%2N} parameter is inconsistant, %s',
+ '{%3Ea} was not declared as a {%kVAR} parameter',
(* '{%3EHa}'. *)
+ '{%3EVa} was declared as a {%kVAR} parameter',
+ pi, ParamTotal+i, ProcSym, ProcTok, GetParam
(ProcSym, ParamTotal+i), TypeTok)
ELSIF (Var=NulTok) AND IsVarParam(ProcSym, ParamTotal+i)
THEN
- (* expecting VAR pamarater *)
- FailParameter('the parameter was not declared as a VAR parameter',
- 'the parameter has been declared as a VAR parameter',
- NulName, ParamTotal+i, ProcSym)
+ (* Expecting VAR pamarater. *)
+ ParameterError ('declaration of procedure {%%1a} in the %s differs
from the %s, {%%2N} parameter is inconsistant, %s',
+ '{%3Ea} was declared as a {%kVAR} parameter',
(* '{%3EHa}'. *)
+ '{%3EVa} was not declared as a {%kVAR} parameter',
+ pi, ParamTotal+i, ProcSym, ProcTok, GetParam
(ProcSym, ParamTotal+i), TypeTok)
END ;
ParamI := GetParam(ProcSym, ParamTotal+i) ;
IF PedanticParamNames
THEN
IF GetSymName(ParamI)#OperandT(pi)
THEN
- (* different parameter names *)
- FailParameter('',
- 'the parameter has been declared with a different
name',
- OperandT (pi), ParamTotal+i, ProcSym)
+ (* Different parameter names. *)
+ ParameterError ('procedure {%%1a} in the %s differs from the
%s, {%%2N} parameter name is inconsistant, %s',
+ 'named as {%3EVa}',
+ 'named as {%3EVa}',
+ pi, ParamTotal+i, ProcSym, ProcTok, GetParam
(ProcSym, ParamTotal+i), OperandT (pi))
END
ELSE
IF GetSymName (ParamI) = NulName
THEN
- PutParamName (OperandTok (pi), ProcSym, ParamTotal+i, OperandT
(pi))
+ PutParamName (OperandTok (pi), ProcSym, ParamTotal+i, OperandT
(pi), TypeTok)
END
END ;
PutDeclared (OperandTok (pi), GetParameterShadowVar (ParamI)) ;
@@ -1845,111 +1895,69 @@ BEGIN
(NOT IsUnknown(SkipType(TypeSym))) AND
(NOT IsUnknown(SkipType(ParamIType)))
THEN
- (* different parameter types *)
- FailParameter('',
- 'the parameter has been declared with a different
type',
- OperandT(pi), ParamTotal+i, ProcSym)
+ (* Different parameter types. *)
+ ParameterError ('declaration in the %s differs from the %s, {%%2N}
parameter is inconsistant, %s',
+ 'the parameter {%3Ea} was declared with a
different type', (* '{%3EHa}'. *)
+ 'the parameter {%3EVa} was declared with a
different type',
+ pi, ParamTotal+i, ProcSym, ProcTok, GetParam
(ProcSym, ParamTotal+i), TypeTok)
END
- ELSE
- FailParameter('too many parameters',
- 'fewer parameters were declared',
- NulName, ParamTotal+i, ProcSym)
END ;
INC(i) ;
DEC(pi)
END ;
- PopN(NoOfIds+1) ; (* +1 for the Var/Nul *)
+ PopN(NoOfIds+1) ; (* +1 for the Var/Nul. *)
PushT(ParamTotal+NoOfIds) ;
Assert(IsProcedure(OperandT(2)))
END CheckFormalParameterSection ;
(*
- FailParameter - generates an error message indicating that a parameter
- declaration has failed.
-
- The parameters are:
+ ParameterError - create two error strings chained together. Both error
strings
+ commence with FmdHeader:
+ 1. FmtHeader DefinedDesc ParamNo Param.
+ 2. FmdHeader CurrentDesc ParamNo OperandT(ParamPtr).
+ The FmtHeader will have a location description for the
+ defined location and current location inserted by
processing %s
+ prior to passing the completed string to MetaError.
- CurrentState - string describing the current failing state.
- PreviousState - string describing the old defined state.
- Given - token or identifier that was given.
- ParameterNo - parameter number that has failed.
- ProcedureSym - procedure symbol where parameter has failed.
-
- If any parameter is Nul then it is ignored.
+ Currently the location of the first error is fixed to the
+ location of ProcSym.
*)
-PROCEDURE FailParameter (CurrentState : ARRAY OF CHAR;
- PreviousState: ARRAY OF CHAR;
- Given : Name ;
- ParameterNo : CARDINAL;
- ProcedureSym : CARDINAL) ;
+PROCEDURE ParameterError (FmtHeader, DefinedDesc, CurrentDesc: ARRAY OF CHAR;
+ ParamPtr, ParamNo, ProcSym, ProcTok, Param, TypeTok:
CARDINAL) ;
VAR
- First : CARDINAL ;
- FirstModule,
- SecondModule,
- s1, s2, s3 : String ;
-BEGIN
- IF NoOfParam(ProcedureSym)>=ParameterNo
- THEN
- IF CompilingDefinitionModule()
- THEN
- First := GetDeclaredDef(GetNthParam(ProcedureSym, ParameterNo))
- ELSE
- First := GetDeclaredMod(GetNthParam(ProcedureSym, ParameterNo))
- END
- ELSE
- (* ParameterNo does not exist - which is probably the reason why this
routine was called.. *)
- IF CompilingDefinitionModule()
- THEN
- First := GetDeclaredDef(ProcedureSym)
- ELSE
- First := GetDeclaredMod(ProcedureSym)
- END
- END ;
- IF CompilingDefinitionModule()
- THEN
- FirstModule := InitString('definition module') ;
- SecondModule := InitString('implementation module')
- ELSIF CompilingImplementationModule()
- THEN
- FirstModule := InitString('implementation module') ;
- SecondModule := InitString('definition module')
- ELSE
- Assert (CompilingProgramModule ()) ;
- FirstModule := InitString('program module') ;
- SecondModule := InitString('definition module')
- END ;
- s2 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(ProcedureSym)))) ;
- s3 := Mark(FirstModule) ;
- s1 := Sprintf4(Mark(InitString('declaration of procedure %s in the %s
differs from the %s, problem with parameter number %d')),
- s2, s3,
- SecondModule,
- ParameterNo) ;
- IF NoOfParam(ProcedureSym)>=ParameterNo
- THEN
- s2 :=
Mark(InitStringCharStar(KeyToCharStar(GetSymName(GetNthParam(ProcedureSym,
ParameterNo))))) ;
- s1 := ConCat(s1, Mark(Sprintf1(Mark(InitString(' (%s)')), s2)))
- END ;
- IF NOT StrEqual(CurrentState, '')
- THEN
- s2 := Mark(InitString(CurrentState)) ;
- s1 := ConCat(s1, Mark(Sprintf1(Mark(InitString(', %s')), s2)))
- END ;
- IF NOT StrEqual(PreviousState, '')
- THEN
- s2 := Mark(SecondModule) ;
- s3 := Mark(InitString(PreviousState)) ;
- s1 := ConCat(s1, Mark(Sprintf2(Mark(InitString(' in the %s %s')), s2,
s3)))
- END ;
- IF Given#NulName
- THEN
- s2 := Mark(InitStringCharStar(KeyToCharStar(Given))) ;
- s1 := ConCat(s1, Mark(Sprintf1(Mark(InitString(' (%s)')), s2)))
- END ;
- s1 := ConCat(s1, Mark(Sprintf0(Mark(InitString('\n'))))) ;
- ErrorStringAt2(s1, GetTokenNo(), First)
-END FailParameter ;
+(* parm, *)
+ Err : CARDINAL ;
+ CurStr,
+ DefStr,
+ Msg,
+ SrcProcSym,
+ SrcCurDecl: String ;
+BEGIN
+ SrcProcSym := GetSourceDesc (ProcSym) ;
+ SrcCurDecl := GetCurSrcDesc (ProcSym, ProcTok) ;
+ DefStr := InitString (DefinedDesc) ;
+ CurStr := InitString (CurrentDesc) ;
+ Msg := Sprintf3 (Mark (InitString (FmtHeader)), SrcProcSym, SrcCurDecl,
DefStr) ;
+ MetaErrorStringT3 (GetDeclared (ProcSym), Msg, ProcSym, ParamNo, Param) ;
+(*
+ It could be improved by using the '{%3EHa}' specifier in the DefinedDesc
(see
+ CheckFormalParameterSection) but this requires that the parameter
declarations
+ for the definition and forward procedures are saved. Currently they are
only
+ checked against the proper procedure declaration.
+
+ WarnStringAt (InitString ('testing ProcSym decl'), GetDeclared (ProcSym)) ;
+ parm := GetParam (ProcSym, ParamNo) ;
+ WarnStringAt (InitString ('testing param ProcSym GetVarDeclTok'),
GetVarDeclTok (parm)) ;
+ WarnStringAt (InitString ('testing param ProcSym GetVarDeclTypeTok'),
GetVarDeclTypeTok (parm)) ;
+ WarnStringAt (InitString ('testing param ProcSym GetVarDeclFullTok'),
GetVarDeclFullTok (parm)) ;
+ WarnStringAt (InitString ('testing cur pos'), MakeVirtual2Tok (OperandTok
(ParamPtr), TypeTok)) ;
+*)
+ Err := MakeError (MakeVirtual2Tok (OperandTok (ParamPtr), TypeTok),
OperandT (ParamPtr)) ;
+ Msg := Sprintf3 (Mark (InitString (FmtHeader)), SrcProcSym, SrcCurDecl,
CurStr) ;
+ MetaErrorString3 (Msg, ProcSym, ParamNo, Err)
+END ParameterError ;
(*
@@ -1972,6 +1980,38 @@ BEGIN
END StartBuildFormalParameters ;
+(*
+ ParameterMismatch - generate a parameter mismatch error between the current
+ declaration at tok and a previous ProcSym declaration.
+ NoOfPar is the current number of parameters.
+*)
+
+PROCEDURE ParameterMismatch (tok: CARDINAL; ProcSym: CARDINAL; NoOfPar:
CARDINAL) ;
+VAR
+ MsgCurrent,
+ MsgProcSym,
+ SrcProcSym,
+ SrcCurDecl,
+ CompProcSym,
+ CompCurrent: String ;
+BEGIN
+ SrcProcSym := GetSourceDesc (ProcSym) ;
+ SrcCurDecl := GetCurSrcDesc (ProcSym, tok) ;
+ CompProcSym := GetComparison (NoOfParam (ProcSym), NoOfPar) ;
+ CompCurrent := GetComparison (NoOfPar, NoOfParam (ProcSym)) ;
+ MsgCurrent := Sprintf3 (Mark (InitString ('the %s for {%%1ad} has %s
parameters than the %s')),
+ SrcCurDecl, CompCurrent, SrcProcSym) ;
+ MsgProcSym := Sprintf3 (Mark (InitString ('the %s for {%%1ad} has %s
parameters than the %s')),
+ SrcProcSym, CompProcSym, SrcCurDecl) ;
+ MetaErrorStringT1 (GetDeclared (ProcSym), MsgProcSym, ProcSym) ;
+ MetaErrorStringT1 (tok, MsgCurrent, ProcSym) ;
+ SrcProcSym := KillString (SrcProcSym) ;
+ SrcCurDecl := KillString (SrcCurDecl) ;
+ CompProcSym := KillString (CompProcSym) ;
+ CompCurrent := KillString (CompCurrent)
+END ParameterMismatch ;
+
+
(*
EndBuildFormalParameters - Resets the quadruple stack after building
Formal Parameters.
@@ -1990,26 +2030,139 @@ END StartBuildFormalParameters ;
PROCEDURE EndBuildFormalParameters ;
VAR
- n : Name ;
+ tok : CARDINAL ;
NoOfPar: CARDINAL ;
ProcSym: CARDINAL ;
BEGIN
- PopT(NoOfPar) ;
- PopT(ProcSym) ;
- PushT(ProcSym) ;
- Assert(IsProcedure(ProcSym)) ;
- IF NoOfParam(ProcSym)#NoOfPar
+ PopT (NoOfPar) ;
+ PopTtok (ProcSym, tok) ;
+ PushT (ProcSym) ;
+ Assert (IsProcedure (ProcSym)) ;
+ IF NoOfParam (ProcSym) # NoOfPar
THEN
- n := GetSymName(ProcSym) ;
- IF CompilingDefinitionModule()
+ ParameterMismatch (tok, ProcSym, NoOfPar)
+ END ;
+ Assert (IsProcedure (OperandT (1)))
+END EndBuildFormalParameters ;
+
+
+(*
+ GetComparison - return a simple description from the result of
+ a comparison between left and right.
+*)
+
+PROCEDURE GetComparison (left, right: CARDINAL) : String ;
+BEGIN
+ IF left < right
+ THEN
+ RETURN InitString ('less')
+ ELSIF left > right
+ THEN
+ RETURN InitString ('more')
+ ELSE
+ RETURN InitString ('same')
+ END
+END GetComparison ;
+
+
+(*
+ GetSourceDesc - return a description of where ProcSym was declared.
+*)
+
+PROCEDURE GetSourceDesc (ProcSym: CARDINAL) : String ;
+BEGIN
+ IF AreParametersDefinedInDefinition (ProcSym)
+ THEN
+ RETURN InitString ('definition module')
+ ELSIF GetParametersDefinedByForward (ProcSym)
+ THEN
+ RETURN InitString ('forward declaration')
+ ELSIF GetParametersDefinedByProper (ProcSym)
+ THEN
+ RETURN InitString ('proper declaration')
+ END ;
+ RETURN InitString ('')
+END GetSourceDesc ;
+
+
+(*
+ GetCurSrcDesc - return a description of where ProcSym was declared.
+*)
+
+PROCEDURE GetCurSrcDesc (ProcSym: CARDINAL; tok: CARDINAL) : String ;
+BEGIN
+ IF GetProcedureDeclaredDefinition (ProcSym) = tok
+ THEN
+ RETURN InitString ('definition module')
+ ELSIF GetProcedureDeclaredForward (ProcSym) = tok
+ THEN
+ RETURN InitString ('forward declaration')
+ ELSIF GetProcedureDeclaredProper (ProcSym) = tok
+ THEN
+ RETURN InitString ('proper declaration')
+ END ;
+ RETURN InitString ('')
+END GetCurSrcDesc ;
+
+
+(*
+ GetDeclared -
+*)
+
+PROCEDURE GetDeclared (sym: CARDINAL) : CARDINAL ;
+BEGIN
+ IF IsProcedure (sym)
+ THEN
+ IF AreParametersDefinedInDefinition (sym)
THEN
- WriteFormat1('procedure (%a) was declared with fewer parameters in
the DEFINITION MODULE', n)
- ELSE
- WriteFormat1('procedure (%a) was declared with more parameters in the
DEFINITION MODULE', n)
+ RETURN GetProcedureDeclaredDefinition (sym)
+ ELSIF GetParametersDefinedByProper (sym)
+ THEN
+ RETURN GetProcedureDeclaredProper (sym)
+ ELSIF GetParametersDefinedByForward (sym)
+ THEN
+ RETURN GetProcedureDeclaredForward (sym)
END
END ;
- Assert(IsProcedure(OperandT(1)))
-END EndBuildFormalParameters ;
+ RETURN GetDeclaredMod (sym)
+END GetDeclared ;
+
+
+(*
+ ReturnTypeMismatch - generate two errors showing the return type mismatches
between
+ ProcSym and ReturnType at procedure location tok.
+*)
+
+PROCEDURE ReturnTypeMismatch (tok: CARDINAL; ProcSym, ReturnType: CARDINAL) ;
+VAR
+ SrcProcSym,
+ SrcCurDecl,
+ MsgCurrent,
+ MsgProcSym: String ;
+BEGIN
+ SrcProcSym := GetSourceDesc (ProcSym) ;
+ SrcCurDecl := GetCurSrcDesc (ProcSym, tok) ;
+ IF ReturnType = NulSym
+ THEN
+ MsgCurrent := Sprintf2 (Mark (InitString ('there is no return type for
{%%1ad} specified in the %s whereas a return type is specified in the %s')),
+ SrcCurDecl, SrcProcSym) ;
+ MsgProcSym := Sprintf2 (Mark (InitString ('there is no return type for
{%%1ad} specified in the %s whereas a return type is specified in the %s')),
+ SrcCurDecl, SrcProcSym)
+ ELSIF GetType (ProcSym) = NulSym
+ THEN
+ MsgCurrent := Sprintf2 (Mark (InitString ('there is no return type for
{%%1ad} specified in the %s whereas a return type is specified in the %s')),
+ SrcProcSym, SrcCurDecl) ;
+ MsgProcSym := Sprintf2 (Mark (InitString ('there is no return type for
{%%1ad} specified in the %s whereas a return type is specified in the %s')),
+ SrcProcSym, SrcCurDecl)
+ ELSE
+ MsgCurrent := Sprintf2 (Mark (InitString ('the return type for {%%1ad}
specified in the %s differs in the %s')),
+ SrcCurDecl, SrcProcSym) ;
+ MsgProcSym := Sprintf2 (Mark (InitString ('the return type for {%%1ad}
specified in the %s differs in the %s')),
+ SrcCurDecl, SrcProcSym)
+ END ;
+ MetaErrorStringT1 (GetDeclared (ProcSym), MsgProcSym, ProcSym) ;
+ MetaErrorStringT1 (tok, MsgCurrent, ProcSym)
+END ReturnTypeMismatch ;
(*
@@ -2030,40 +2183,26 @@ END EndBuildFormalParameters ;
PROCEDURE BuildFunction ;
VAR
- PrevSym,
- TypeSym,
- ProcSym : CARDINAL ;
+ tok : CARDINAL ;
+ PrevRetType,
+ RetType,
+ ProcSym : CARDINAL ;
BEGIN
- PopT(TypeSym) ;
- PopT(ProcSym) ;
- IF IsProcedure(ProcSym) AND AreProcedureParametersDefined(ProcSym)
+ PopT (RetType) ;
+ PopTtok (ProcSym, tok) ;
+ IF IsProcedure (ProcSym)
THEN
- PrevSym := GetType(ProcSym) ;
- IF (PrevSym#NulSym) AND (PrevSym#TypeSym)
+ IF AreProcedureParametersDefined (ProcSym)
THEN
- IF CompilingDefinitionModule()
+ PrevRetType := GetType (ProcSym) ;
+ IF PrevRetType # RetType
THEN
- MetaErrorsT2(GetDeclaredDef(ProcSym),
- 'the return type for procedure {%1a} is defined
differently in the definition module as {%1tad} and the implementation module
as {%2ad}',
- 'the return type for procedure {%1a} is defined
differently in the definition module as {%1tad} and the implementation module
as {%2ad}',
- ProcSym, TypeSym)
- ELSE
- MetaErrorsT2(GetDeclaredMod(ProcSym),
- 'the return type for procedure {%1a} is defined
differently in the definition module as {%2ad} and the implementation module as
{%1tad}',
- 'the return type for procedure {%1a} is defined
differently in the definition module as {%2ad} and the implementation module as
{%1tad}',
- ProcSym, TypeSym)
+ ReturnTypeMismatch (tok, ProcSym, RetType)
END
END
END ;
- PutFunction(ProcSym, TypeSym) ;
-(*
- WriteString('Procedure ') ; WriteKey(GetSymName(ProcSym)) ;
- WriteString(' has a return argument ') ;
- WriteKey(GetSymName(TypeSym)) ;
- WriteString(' checking ') ; WriteKey(GetSymName(GetType(ProcSym))) ;
- WriteLn ;
-*)
- PushT(ProcSym)
+ PutFunction (ProcSym, RetType) ;
+ PushTtok (ProcSym, tok)
END BuildFunction ;
@@ -2114,6 +2253,34 @@ BEGIN
END BuildNoReturnAttribute ;
+(*
+ CheckProcedure - checks to see that the top of stack procedure
+ has not been declared as a procedure function.
+
+ The Stack:
+
+ Entry Exit
+
+ Ptr -> <- Ptr
+ +------------+ +------------+
+ | ProcSym | | ProcSym |
+ |------------| |------------|
+*)
+
+PROCEDURE CheckProcedure ;
+VAR
+ ProcSym,
+ tok : CARDINAL ;
+BEGIN
+ PopTtok (ProcSym, tok) ;
+ PushTtok (ProcSym, tok) ;
+ IF GetType (ProcSym) # NulSym
+ THEN
+ ReturnTypeMismatch (tok, ProcSym, NulSym)
+ END
+END CheckProcedure ;
+
+
(*
BuildPointerType - builds a pointer type.
The Stack:
diff --git a/gcc/m2/gm2-compiler/P3Build.bnf b/gcc/m2/gm2-compiler/P3Build.bnf
index f48b508ba1dc..3a142fdc0044 100644
--- a/gcc/m2/gm2-compiler/P3Build.bnf
+++ b/gcc/m2/gm2-compiler/P3Build.bnf
@@ -66,6 +66,7 @@ FROM M2Reserved IMPORT tokToTok, toktype,
FROM M2Quads IMPORT PushT, PopT, PushTF, PopTF, PopNothing, Annotate,
PushTtok, PushTFtok, PopTtok, PopTFtok, OperandTok,
+ DupFrame, Top,
BuildModuleStart,
StartBuildDefFile, StartBuildModFile,
EndBuildFile,
@@ -152,6 +153,7 @@ FROM P3SymBuild IMPORT P3StartBuildProgModule,
StartBuildProcedure,
BuildProcedureHeading,
EndBuildProcedure,
+ EndBuildForward,
BuildVarAtAddress,
BuildConst,
BuildSubrange,
@@ -522,6 +524,7 @@ token 'EXIT' exittok
token 'EXPORT' exporttok
token 'FINALLY' finallytok
token 'FOR' fortok
+token 'FORWARD' forwardtok
token 'FROM' fromtok
token 'IF' iftok
token 'IMPLEMENTATION' implementationtok
@@ -1336,12 +1339,21 @@ WithStatement :=
% VAR
"END" %
EndBuildWith %
=:
-ProcedureDeclaration := ProcedureHeading ";" ProcedureBlock %
BuildProcedureEnd ;
-
PushAutoOn %
+ProcedureDeclaration := %
VAR top: CARDINAL ; %
+ %
top := Top () %
+ ProcedureHeading ";" PostProcedureHeading %
Assert (top = Top ()) %
+ =:
+
+PostProcedureHeading := ProperProcedure | ForwardDeclaration =:
+
+ForwardDeclaration := "FORWARD" %
EndBuildForward %
+ =:
- Ident %
EndBuildProcedure ;
+ProperProcedure := ProcedureBlock %
BuildProcedureEnd ;
+
PushAutoOn %
+ Ident %
EndBuildProcedure ;
PopAuto %
- =:
+ =:
DefineBuiltinProcedure := [ "__ATTRIBUTE__" "__BUILTIN__"
"(" "(" %
PushAutoOff %
diff --git a/gcc/m2/gm2-compiler/P3SymBuild.def
b/gcc/m2/gm2-compiler/P3SymBuild.def
index 591db9984e9f..e506e54a6a39 100644
--- a/gcc/m2/gm2-compiler/P3SymBuild.def
+++ b/gcc/m2/gm2-compiler/P3SymBuild.def
@@ -25,37 +25,10 @@ DEFINITION MODULE P3SymBuild ;
Title : P3SymBuild
Author : Gaius Mulley
Date : 24/6/87
- LastEdit : 1/9/89
System : UNIX (GNU Modula-2)
Description: pass 3 symbol creation.
*)
-(* StartBuildDefinitionModule, *)
-(* EndBuildDefinitionModule, *)
-(* StartBuildImplementationModule, *)
-(* EndBuildImplementationModule, *)
-(* StartBuildProgramModule, *)
-(* EndBuildProgramModule, *)
-
-EXPORT QUALIFIED P3StartBuildDefModule,
- P3EndBuildDefModule,
- P3StartBuildImpModule,
- P3EndBuildImpModule,
- P3StartBuildProgModule,
- P3EndBuildProgModule,
- StartBuildInnerModule,
- EndBuildInnerModule,
- CheckImportListOuterModule,
- CheckCanBeImported,
- BuildProcedureHeading,
- StartBuildProcedure,
- EndBuildProcedure,
- BuildSubrange,
- BuildNulName,
- BuildConst,
- BuildVarAtAddress,
- BuildOptArgInitializer ;
-
(*
StartBuildDefinitionModule - Creates a definition module and starts
@@ -310,6 +283,13 @@ PROCEDURE StartBuildProcedure ;
PROCEDURE EndBuildProcedure ;
+(*
+ EndBuildForward -
+*)
+
+PROCEDURE EndBuildForward ;
+
+
(*
BuildSubrange - Builds a Subrange type Symbol.
diff --git a/gcc/m2/gm2-compiler/P3SymBuild.mod
b/gcc/m2/gm2-compiler/P3SymBuild.mod
index 84d0be04adae..1bebcf066cee 100644
--- a/gcc/m2/gm2-compiler/P3SymBuild.mod
+++ b/gcc/m2/gm2-compiler/P3SymBuild.mod
@@ -550,6 +550,18 @@ BEGIN
END BuildProcedureHeading ;
+(*
+ EndBuildForward -
+*)
+
+PROCEDURE EndBuildForward ;
+BEGIN
+ PopN (2) ;
+ EndScope ;
+ M2Error.LeaveErrorScope
+END EndBuildForward ;
+
+
(*
BuildSubrange - Builds a Subrange type Symbol.
diff --git a/gcc/m2/gm2-compiler/PCBuild.bnf b/gcc/m2/gm2-compiler/PCBuild.bnf
index 6e263b01629d..263ac9b40316 100644
--- a/gcc/m2/gm2-compiler/PCBuild.bnf
+++ b/gcc/m2/gm2-compiler/PCBuild.bnf
@@ -65,6 +65,7 @@ FROM M2Quads IMPORT Top, PushT, PopT, PushTF, PopTF,
PopNothing, OperandT, Opera
PushTFA,
PushTFn, PopTFn, PushTFtok, PopTtok, PopTFtok, PushTtok,
PushTFntok,
PushT, PushTF, IsAutoPushOn, PushAutoOff, PushAutoOn,
PopAuto,
+ DupFrame,
BuildTypeForConstructor, BuildConstructor,
BuildConstructorEnd,
PopConstructor,
NextConstructorField, SilentBuildConstructor,
@@ -87,6 +88,7 @@ FROM PCSymBuild IMPORT PCStartBuildProgModule,
PCStartBuildProcedure,
PCBuildProcedureHeading,
PCEndBuildProcedure,
+ PCEndBuildForward,
PCBuildImportOuterModule,
PCBuildImportInnerModule,
StartDesConst,
@@ -466,6 +468,7 @@ token 'EXIT' exittok
token 'EXPORT' exporttok
token 'FINALLY' finallytok
token 'FOR' fortok
+token 'FORWARD' forwardtok
token 'FROM' fromtok
token 'IF' iftok
token 'IMPLEMENTATION' implementationtok
@@ -1117,11 +1120,20 @@ WithStatement := "WITH" Designator "DO"
"END"
=:
-ProcedureDeclaration := ProcedureHeading ";" %
PushAutoOff %
- ProcedureBlock %
PopAuto ; PushAutoOn %
- Ident %
PCEndBuildProcedure ;
-
PopAuto %
- =:
+ProcedureDeclaration := %
VAR top: CARDINAL ; %
+ %
top := Top () %
+ ProcedureHeading ";" PostProcedureHeading %
Assert (top = Top ()) %
+ =:
+
+PostProcedureHeading := ProperProcedure | ForwardDeclaration =:
+
+ForwardDeclaration := "FORWARD" %
PCEndBuildForward %
+ =:
+
+ProperProcedure := ProcedureBlock %
PushAutoOn %
+ Ident %
PCEndBuildProcedure %
+ %
PopAuto %
+ =:
DefineBuiltinProcedure := [ "__ATTRIBUTE__" "__BUILTIN__"
"(" "(" %
PushAutoOff %
@@ -1133,11 +1145,11 @@ ProcedureHeading := "PROCEDURE"
% M2E
%
PushAutoOn %
DefineBuiltinProcedure
( Ident
- %
PCStartBuildProcedure ;
-
PushAutoOff %
+ %
PCStartBuildProcedure %
+ %
PushAutoOff %
[ FormalParameters ] AttributeNoReturn
- %
PCBuildProcedureHeading ;
-
PopAuto %
+ %
PCBuildProcedureHeading %
+ %
PopAuto %
) %
PopAuto %
=:
@@ -1147,11 +1159,11 @@ DefProcedureHeading := "PROCEDURE"
% M2E
%
PushAutoOn %
Builtin
( Ident
- %
PCStartBuildProcedure ;
-
PushAutoOff %
+ %
PCStartBuildProcedure %
+ %
PushAutoOff %
[ DefFormalParameters ] AttributeNoReturn
- %
PCBuildProcedureHeading ;
-
PopAuto %
+ %
PCBuildProcedureHeading %
+ %
PopAuto %
) %
PopAuto %
%
M2Error.LeaveErrorScope %
=:
diff --git a/gcc/m2/gm2-compiler/PCSymBuild.def
b/gcc/m2/gm2-compiler/PCSymBuild.def
index c130135d7438..f2c125d8e855 100644
--- a/gcc/m2/gm2-compiler/PCSymBuild.def
+++ b/gcc/m2/gm2-compiler/PCSymBuild.def
@@ -248,6 +248,25 @@ PROCEDURE PCStartBuildProcedure ;
PROCEDURE PCEndBuildProcedure ;
+(*
+ EndBuildForward - Ends building a forward declaration.
+
+ The Stack:
+
+ Entry Exit
+
+ Ptr ->
+ +------------+
+ | ProcSym |
+ |------------|
+ | NameStart |
+ |------------|
+ Empty
+*)
+
+PROCEDURE PCEndBuildForward ;
+
+
(*
BuildImportOuterModule - Builds imported identifiers into an outer module
from a definition module.
diff --git a/gcc/m2/gm2-compiler/PCSymBuild.mod
b/gcc/m2/gm2-compiler/PCSymBuild.mod
index fd1fd075bbe0..498a0444325a 100644
--- a/gcc/m2/gm2-compiler/PCSymBuild.mod
+++ b/gcc/m2/gm2-compiler/PCSymBuild.mod
@@ -676,6 +676,28 @@ BEGIN
END PCEndBuildProcedure ;
+(*
+ EndBuildForward - Ends building a forward declaration.
+
+ The Stack:
+
+ Entry Exit
+
+ Ptr ->
+ +------------+
+ | ProcSym |
+ |------------|
+ | NameStart |
+ |------------|
+ Empty
+*)
+
+PROCEDURE PCEndBuildForward ;
+BEGIN
+ PopN (2)
+END PCEndBuildForward ;
+
+
(*
BuildProcedureHeading - Builds a procedure heading for the definition
module procedures.
diff --git a/gcc/m2/gm2-compiler/PHBuild.bnf b/gcc/m2/gm2-compiler/PHBuild.bnf
index 776601d3b1c3..55f4e9008f31 100644
--- a/gcc/m2/gm2-compiler/PHBuild.bnf
+++ b/gcc/m2/gm2-compiler/PHBuild.bnf
@@ -57,7 +57,7 @@ FROM P2SymBuild IMPORT BuildString, BuildNumber ;
FROM M2Quads IMPORT PushT, PopT, PushTF, PopTF, PopNothing, Annotate,
PushTtok, PushTFtok, PopTtok, PopTFtok, OperandTok,
- PushTFntok, Top,
+ PushTFntok, Top, DupFrame,
StartBuildDefFile, StartBuildModFile,
BuildModuleStart,
EndBuildFile,
@@ -422,6 +422,7 @@ token 'EXIT' exittok
token 'EXPORT' exporttok
token 'FINALLY' finallytok
token 'FOR' fortok
+token 'FORWARD' forwardtok
token 'FROM' fromtok
token 'IF' iftok
token 'IMPLEMENTATION' implementationtok
@@ -1087,14 +1088,23 @@ WithStatement := "WITH"
"END"
=:
-ProcedureDeclaration := ProcedureHeading ";" ( ProcedureBlock %
PushAutoOn %
- Ident ) %
EndBuildProcedure %
+ProcedureDeclaration := %
VAR top: CARDINAL ; %
+ %
top := Top () %
+ ProcedureHeading ";" PostProcedureHeading %
BlockAssert (top = Top ()) %
+ =:
+
+PostProcedureHeading := ProperProcedure | ForwardDeclaration =:
+
+ForwardDeclaration := "FORWARD" %
DupFrame %
+ %
EndBuildProcedure %
+ =:
+ProperProcedure := ProcedureBlock %
PushAutoOn %
+ Ident %
EndBuildProcedure %
%
PopAuto %
- =:
+ =:
DefineBuiltinProcedure := [ "__ATTRIBUTE__" "__BUILTIN__" "(" "(" Ident ")"
")" |
- "__INLINE__" ]
- =:
+ "__INLINE__" ] =:
ProcedureHeading := "PROCEDURE" %
M2Error.DefaultProcedure %
DefineBuiltinProcedure %
PushAutoOn %
diff --git a/gcc/m2/gm2-compiler/SymbolTable.def
b/gcc/m2/gm2-compiler/SymbolTable.def
index 2036e1efc4d5..ce43df5d2c80 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.def
+++ b/gcc/m2/gm2-compiler/SymbolTable.def
@@ -1122,6 +1122,13 @@ PROCEDURE HasExceptionFinally (sym: CARDINAL) : BOOLEAN ;
PROCEDURE PutVar (Sym: CARDINAL; VarType: CARDINAL) ;
+(*
+ PutVarTok - gives the VarSym symbol Sym a type Type at typetok.
+*)
+
+PROCEDURE PutVarTok (Sym: CARDINAL; VarType: CARDINAL; typetok: CARDINAL) ;
+
+
(*
PutLeftValueFrontBackType - gives the variable symbol a front and backend
type.
The variable must be a LeftValue.
@@ -1353,7 +1360,7 @@ PROCEDURE IsReturnOptional (sym: CARDINAL) : BOOLEAN ;
PROCEDURE PutParam (tok: CARDINAL; Sym: CARDINAL; ParamNo: CARDINAL;
ParamName: Name; ParamType: CARDINAL;
- isUnbounded: BOOLEAN) : BOOLEAN ;
+ isUnbounded: BOOLEAN; typetok: CARDINAL) : BOOLEAN ;
(*
@@ -1367,7 +1374,7 @@ PROCEDURE PutParam (tok: CARDINAL; Sym: CARDINAL;
ParamNo: CARDINAL;
PROCEDURE PutVarParam (tok: CARDINAL; Sym: CARDINAL; ParamNo: CARDINAL;
ParamName: Name; ParamType: CARDINAL;
- isUnbounded: BOOLEAN) : BOOLEAN ;
+ isUnbounded: BOOLEAN; typetok: CARDINAL) : BOOLEAN ;
(*
@@ -1375,7 +1382,8 @@ PROCEDURE PutVarParam (tok: CARDINAL; Sym: CARDINAL;
ParamNo: CARDINAL;
ProcSym.
*)
-PROCEDURE PutParamName (tok: CARDINAL; ProcSym: CARDINAL; no: CARDINAL; name:
Name) ;
+PROCEDURE PutParamName (tok: CARDINAL; ProcSym: CARDINAL; no: CARDINAL;
+ name: Name; typetok: CARDINAL) ;
(*
@@ -1613,6 +1621,16 @@ PROCEDURE GetDeclaredDef (Sym: CARDINAL) : CARDINAL ;
PROCEDURE GetDeclaredMod (Sym: CARDINAL) : CARDINAL ;
+(*
+ GetDeclaredFor - returns the token where this symbol was declared.
+ It chooses the first from the forward declaration,
+ implementation module, program module
+ and definition module.
+*)
+
+PROCEDURE GetDeclaredFor (Sym: CARDINAL) : CARDINAL ;
+
+
(*
GetDeclaredDefinition - returns the token where this symbol
was declared in the definition module.
@@ -2212,9 +2230,8 @@ PROCEDURE AreParametersDefinedInDefinition (Sym:
CARDINAL) : BOOLEAN ;
(*
- ParametersDefinedInImplementation - dictates to procedure symbol, Sym,
- that its parameters have been defined in
- a implementation module.
+ ParametersDefinedInImplementation - records that the parameters have been
+ defined in an implementation module.
*)
PROCEDURE ParametersDefinedInImplementation (Sym: CARDINAL) ;
@@ -2229,6 +2246,86 @@ PROCEDURE ParametersDefinedInImplementation (Sym:
CARDINAL) ;
PROCEDURE AreParametersDefinedInImplementation (Sym: CARDINAL) : BOOLEAN ;
+(*
+ PutParametersDefinedByForward - records that the parameters have been
+ defined in a FORWARD declaration.
+*)
+
+PROCEDURE PutParametersDefinedByForward (ProcSym: CARDINAL) ;
+
+
+(*
+ GetParametersDefinedByForward - return TRUE if ProcSym has had its
parameters
+ defined by a FORWARD declaration.
+*)
+
+PROCEDURE GetParametersDefinedByForward (ProcSym: CARDINAL) : BOOLEAN ;
+
+
+(*
+ PutParametersDefinedByProper - records that the parameters have been
+ defined in a FORWARD declaration.
+*)
+
+PROCEDURE PutParametersDefinedByProper (ProcSym: CARDINAL) ;
+
+
+(*
+ GetParametersDefinedByProper - return TRUE if ProcSym has had its parameters
+ defined by a FORWARD declaration.
+*)
+
+PROCEDURE GetParametersDefinedByProper (ProcSym: CARDINAL) : BOOLEAN ;
+
+
+(*
+ GetProcedureDeclaredForward - return the token at which the forward
+ declaration procedure occurred.
+*)
+
+PROCEDURE GetProcedureDeclaredForward (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+ PutProcedureDeclaredForward - places the tok to which the forward
+ declaration procedure occurred.
+*)
+
+PROCEDURE PutProcedureDeclaredForward (sym: CARDINAL; tok: CARDINAL) ;
+
+
+(*
+ GetProcedureDeclaredProper - return the token at which the forward
+ declaration procedure occurred.
+*)
+
+PROCEDURE GetProcedureDeclaredProper (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+ PutProcedureDeclaredProper - places the tok to which the forward
+ declaration procedure occurred.
+*)
+
+PROCEDURE PutProcedureDeclaredProper (sym: CARDINAL; tok: CARDINAL) ;
+
+
+(*
+ GetProcedureDeclaredDefinition - return the token at which the forward
+ declaration procedure occurred.
+*)
+
+PROCEDURE GetProcedureDeclaredDefinition (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+ PutProcedureDeclaredDefinition - places the tok to which the forward
+ declaration procedure occurred.
+*)
+
+PROCEDURE PutProcedureDeclaredDefinition (sym: CARDINAL; tok: CARDINAL) ;
+
+
(*
PutUseVarArgs - tell the symbol table that this procedure, Sym, uses
varargs.
The procedure _must_ be declared inside a
@@ -3364,4 +3461,41 @@ PROCEDURE PutConstLitInternal (sym: CARDINAL; value:
BOOLEAN) ;
PROCEDURE IsConstLitInternal (sym: CARDINAL) : BOOLEAN ;
+(*
+ GetVarDeclTypeTok - returns the TypeTok field associate with variable sym.
+*)
+
+PROCEDURE GetVarDeclTypeTok (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+ PutVarDeclTypeTok - assigns the TypeTok field to typetok.
+ sym can be a variable or parameter.
+*)
+
+PROCEDURE PutVarDeclTypeTok (sym: CARDINAL; typetok: CARDINAL) ;
+
+
+(*
+ GetVarDeclTok - returns the TypeTok field associate with variable sym.
+*)
+
+PROCEDURE GetVarDeclTok (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+ PutVarDeclTok - assigns the VarTok field to vartok.
+ sym can be a variable or parameter.
+*)
+
+PROCEDURE PutVarDeclTok (sym: CARDINAL; vartok: CARDINAL) ;
+
+
+(*
+ GetVarDeclFullTok - returns the full virtual token containing var: type.
+*)
+
+PROCEDURE GetVarDeclFullTok (sym: CARDINAL) : CARDINAL ;
+
+
END SymbolTable.
diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod
b/gcc/m2/gm2-compiler/SymbolTable.mod
index b5e2b9b72035..8fed8b3fc5d5 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.mod
+++ b/gcc/m2/gm2-compiler/SymbolTable.mod
@@ -40,7 +40,8 @@ FROM M2Options IMPORT Pedantic, ExtendedOpaque,
DebugBuiltins ;
FROM M2LexBuf IMPORT UnknownTokenNo, TokenToLineNo,
- FindFileNameFromToken, TokenToLocation ;
+ FindFileNameFromToken, TokenToLocation,
+ MakeVirtual2Tok ;
FROM M2ALU IMPORT InitValue, PtrToValue, PushCard, PopInto,
PushString, PushFrom, PushChar, PushInt,
@@ -149,10 +150,22 @@ TYPE
Where = RECORD
DefDeclared,
- ModDeclared,
- FirstUsed : CARDINAL ;
+ FirstUsed,
+ ModDeclared: CARDINAL ;
END ;
+ ProcedureDecl = RECORD
+ Forward, (* The token locations for *)
+ Definition, (* each potential procedure *)
+ Proper : CARDINAL ; (* declaration. *)
+ END ;
+
+ VarDecl = RECORD
+ FullTok,
+ VarTok,
+ TypeTok: CARDINAL ; (* Variable and type token *)
+ END ; (* locations. *)
+
PackedInfo = RECORD
IsPacked : BOOLEAN ; (* is this type packed? *)
PackedEquiv : CARDINAL ; (* the equivalent packed type *)
@@ -207,6 +220,7 @@ TYPE
SymError = RECORD
name : Name ;
+ Scope : CARDINAL ; (* Scope of declaration. *)
At : Where ; (* Where was sym declared/used *)
END ;
@@ -382,6 +396,8 @@ TYPE
(* the .def or .mod first. *)
(* The second occurence is *)
(* compared to the first. *)
+ DefinedByProper, (* Were the parameters defined *)
+ DefinedByForward, (* by a FORWARD declaration? *)
HasVarArgs : BOOLEAN ; (* Does this procedure use ... ? *)
HasOptArg : BOOLEAN ; (* Does this procedure use [ ] ? *)
OptArgInit : CARDINAL ; (* The optarg initial value. *)
@@ -394,6 +410,11 @@ TYPE
IsPublic : BOOLEAN ; (* Make this procedure visible. *)
IsCtor : BOOLEAN ; (* Is this procedure a ctor? *)
IsMonoName : BOOLEAN ; (* Ignores module name prefix. *)
+ Declared : ProcedureDecl ; (* Forward, definition and *)
+ (* proper token positions. *)
+ DeclaredForward, (* The token no used to define *)
+ DeclaredDefinition, (* the definition, proper and *)
+ DeclaredProper: CARDINAL ; (* forward. *)
Unresolved : SymbolTree ; (* All symbols currently *)
(* unresolved in this procedure. *)
ScopeQuad : CARDINAL ; (* Index into quads for scope *)
@@ -547,6 +568,7 @@ TYPE
(* to an array? *)
Heap : BOOLEAN ; (* Is var on the heap? *)
InitState : LRInitDesc ; (* Initialization state. *)
+ Declared : VarDecl ; (* Var and type tokens. *)
At : Where ; (* Where was sym declared/used *)
ReadUsageList, (* list of var read quads *)
WriteUsageList: LRLists ; (* list of var write quads *)
@@ -1514,6 +1536,7 @@ BEGIN
WITH pSym^ DO
SymbolType := ErrorSym ;
Error.name := name ;
+ Error.Scope := GetCurrentScope () ;
InitWhereDeclaredTok(tok, Error.At) ;
InitWhereFirstUsedTok(tok, Error.At)
END ;
@@ -3916,6 +3939,18 @@ BEGIN
END PutModuleCtorExtern ;
+(*
+ InitProcedureDecl - initializes all fields of ProcedureDecl to
UnknownTokenNo.
+*)
+
+PROCEDURE InitProcedureDecl (VAR decl: ProcedureDecl) ;
+BEGIN
+ decl.Forward := UnknownTokenNo ;
+ decl.Definition := UnknownTokenNo ;
+ decl.Proper := UnknownTokenNo
+END InitProcedureDecl ;
+
+
(*
MakeProcedure - creates a procedure sym with name. It returns
the symbol index.
@@ -3953,6 +3988,10 @@ BEGIN
(* the .def or .mod first. *)
(* The second occurence is *)
(* compared to the first. *)
+ DefinedByProper := FALSE ; (* Were the parameters defined *)
+ (* in a proper procedure. *)
+ DefinedByForward := FALSE ; (* Were the parameters defined *)
+ (* in a FORWARD declaration? *)
HasVarArgs := FALSE ; (* Does the procedure use ... ? *)
HasOptArg := FALSE ; (* Does this procedure use [ ] ? *)
OptArgInit := NulSym ; (* The optarg initial value. *)
@@ -3965,6 +4004,9 @@ BEGIN
IsPublic := FALSE ; (* Make this procedure visible. *)
IsCtor := FALSE ; (* Is this procedure a ctor? *)
IsMonoName := FALSE ; (* Overrides module name prefix. *)
+ InitProcedureDecl (Declared) ; (* The token no used to define *)
+ (* the definition, proper and *)
+ (* forward. *)
Scope := GetCurrentScope() ; (* Scope of procedure. *)
InitTree(Unresolved) ; (* All symbols currently *)
(* unresolved in this procedure. *)
@@ -4283,6 +4325,237 @@ BEGIN
END AddVarToList ;
+(*
+ InitVarDecl - initialize the variable and type token location positions.
+*)
+
+PROCEDURE InitVarDecl (VAR decl: VarDecl; vartok: CARDINAL) ;
+BEGIN
+ decl.FullTok := UnknownTokenNo ;
+ decl.VarTok := vartok ;
+ decl.TypeTok := UnknownTokenNo
+END InitVarDecl ;
+
+
+(*
+ doPutVarDeclTypeTok - places typetok into decl.TypeTok.
+ sym must be a variable.
+*)
+
+PROCEDURE doPutVarDeclTypeTok (sym: CARDINAL; typetok: CARDINAL) ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ Assert (IsVar (sym)) ;
+ pSym := GetPsym (sym) ;
+ WITH pSym^.Var DO
+ Declared.TypeTok := typetok
+ END
+END doPutVarDeclTypeTok ;
+
+
+(*
+ PutVarDeclTypeTok - assigns the TypeTok field to typetok.
+ sym can be a variable or parameter.
+*)
+
+PROCEDURE PutVarDeclTypeTok (sym: CARDINAL; typetok: CARDINAL) ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ IF IsParameter (sym)
+ THEN
+ pSym := GetPsym (sym) ;
+ IF IsParameterVar (sym)
+ THEN
+ PutVarDeclTypeTok (pSym^.VarParam.ShadowVar, typetok)
+ ELSE
+ PutVarDeclTypeTok (pSym^.Param.ShadowVar, typetok)
+ END
+ ELSIF IsVar (sym)
+ THEN
+ doPutVarDeclTypeTok (sym, typetok)
+ END
+END PutVarDeclTypeTok ;
+
+
+(*
+ doPutVarDeclTok - places vartok into decl.VarTok.
+ sym must be a variable.
+*)
+
+PROCEDURE doPutVarDeclTok (sym: CARDINAL; vartok: CARDINAL) ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ Assert (IsVar (sym)) ;
+ pSym := GetPsym (sym) ;
+ WITH pSym^.Var DO
+ Declared.VarTok := vartok
+ END
+END doPutVarDeclTok ;
+
+
+(*
+ PutVarDeclTok - assigns the VarTok field to typetok.
+ sym can be a variable or parameter.
+*)
+
+PROCEDURE PutVarDeclTok (sym: CARDINAL; vartok: CARDINAL) ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ IF IsParameter (sym)
+ THEN
+ pSym := GetPsym (sym) ;
+ IF IsParameterVar (sym)
+ THEN
+ PutVarDeclTok (pSym^.VarParam.ShadowVar, vartok)
+ ELSE
+ PutVarDeclTok (pSym^.Param.ShadowVar, vartok)
+ END
+ ELSIF IsVar (sym)
+ THEN
+ doPutVarDeclTok (sym, vartok)
+ END
+END PutVarDeclTok ;
+
+
+(*
+ doGetVarDeclTok - return decl.VarTok for a variable.
+*)
+
+PROCEDURE doGetVarDeclTok (sym: CARDINAL) : CARDINAL ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym (sym) ;
+ Assert (IsVar (sym)) ;
+ WITH pSym^.Var DO
+ RETURN Declared.VarTok
+ END
+END doGetVarDeclTok ;
+
+
+(*
+ GetVarDeclTok - returns the TypeTok field associate with variable sym.
+*)
+
+PROCEDURE GetVarDeclTok (sym: CARDINAL) : CARDINAL ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ IF IsParameter (sym)
+ THEN
+ pSym := GetPsym (sym) ;
+ IF IsParameterVar (sym)
+ THEN
+ RETURN GetVarDeclTok (pSym^.VarParam.ShadowVar)
+ ELSE
+ RETURN GetVarDeclTok (pSym^.Param.ShadowVar)
+ END
+ ELSIF IsVar (sym)
+ THEN
+ RETURN doGetVarDeclTok (sym)
+ ELSE
+ RETURN UnknownTokenNo
+ END
+END GetVarDeclTok ;
+
+
+(*
+ doGetVarDeclTypeTok - return decl.TypeTok for a variable.
+*)
+
+PROCEDURE doGetVarDeclTypeTok (sym: CARDINAL) : CARDINAL ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym (sym) ;
+ Assert (IsVar (sym)) ;
+ WITH pSym^.Var DO
+ RETURN Declared.TypeTok
+ END
+END doGetVarDeclTypeTok ;
+
+
+(*
+ GetVarDeclTypeTok - returns the TypeTok field associate with variable sym.
+*)
+
+PROCEDURE GetVarDeclTypeTok (sym: CARDINAL) : CARDINAL ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ IF IsParameter (sym)
+ THEN
+ pSym := GetPsym (sym) ;
+ IF IsParameterVar (sym)
+ THEN
+ RETURN GetVarDeclTypeTok (pSym^.VarParam.ShadowVar)
+ ELSE
+ RETURN GetVarDeclTypeTok (pSym^.Param.ShadowVar)
+ END
+ ELSIF IsVar (sym)
+ THEN
+ RETURN doGetVarDeclTypeTok (sym)
+ ELSE
+ RETURN UnknownTokenNo
+ END
+END GetVarDeclTypeTok ;
+
+
+(*
+ doGetVarDeclFullTok - return the full declaration of var: type.
+*)
+
+PROCEDURE doGetVarDeclFullTok (sym: CARDINAL) : CARDINAL ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym (sym) ;
+ Assert (IsVar (sym)) ;
+ WITH pSym^.Var DO
+ IF Declared.FullTok = UnknownTokenNo
+ THEN
+ IF Declared.TypeTok = UnknownTokenNo
+ THEN
+ RETURN Declared.VarTok
+ ELSE
+ Declared.FullTok := MakeVirtual2Tok (Declared.VarTok,
Declared.TypeTok)
+ END
+ END ;
+ RETURN Declared.FullTok
+ END
+END doGetVarDeclFullTok ;
+
+
+(*
+ GetVarDeclFullTok - returns the full virtual token containing var: type.
+*)
+
+PROCEDURE GetVarDeclFullTok (sym: CARDINAL) : CARDINAL ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym (sym) ;
+ IF IsParameter (sym)
+ THEN
+ IF IsParameterVar (sym)
+ THEN
+ RETURN GetVarDeclFullTok (pSym^.VarParam.ShadowVar)
+ ELSE
+ RETURN GetVarDeclFullTok (pSym^.Param.ShadowVar)
+ END
+ ELSIF IsVar (sym)
+ THEN
+ RETURN doGetVarDeclFullTok (sym)
+ ELSE
+ RETURN UnknownTokenNo
+ END
+END GetVarDeclFullTok ;
+
+
(*
MakeVar - creates a variable sym with VarName. It returns the
symbol index.
@@ -4319,6 +4592,7 @@ BEGIN
IsConst := FALSE ;
ArrayRef := FALSE ;
Heap := FALSE ;
+ InitVarDecl (Declared, tok) ;
InitWhereDeclaredTok(tok, At) ;
InitWhereFirstUsedTok(tok, At) ; (* Where symbol first used. *)
InitList(ReadUsageList[RightValue]) ;
@@ -6680,6 +6954,31 @@ BEGIN
END PutVar ;
+(*
+ PutVarTok - gives the VarSym symbol Sym a type Type at typetok.
+*)
+
+PROCEDURE PutVarTok (Sym: CARDINAL; VarType: CARDINAL; typetok: CARDINAL) ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym(Sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ VarSym : Var.Type := VarType ;
+ Var.Declared.TypeTok := typetok ;
+ ConfigSymInit (Var.InitState[LeftValue], Sym) ;
+ ConfigSymInit (Var.InitState[RightValue], Sym) |
+ ConstVarSym: ConstVar.Type := VarType
+
+ ELSE
+ InternalError ('expecting VarSym or ConstVarSym')
+ END
+ END
+END PutVarTok ;
+
+
(*
PutLeftValueFrontBackType - gives the variable symbol a front and backend
type.
The variable must be a LeftValue.
@@ -10173,8 +10472,9 @@ END PutOptFunction ;
PROCEDURE MakeVariableForParam (tok : CARDINAL;
ParamName: Name;
- ProcSym : CARDINAL ;
- no : CARDINAL) : CARDINAL ;
+ ProcSym : CARDINAL;
+ no : CARDINAL;
+ typetok : CARDINAL) : CARDINAL ;
VAR
pSym : PtrToSymbol ;
VariableSym: CARDINAL ;
@@ -10193,7 +10493,7 @@ BEGIN
END
END ;
(* Note that the parameter is now treated as a local variable. *)
- PutVar (VariableSym, GetType(GetNthParam(ProcSym, no))) ;
+ PutVarTok (VariableSym, GetType(GetNthParam(ProcSym, no)), typetok) ;
PutDeclared (tok, VariableSym) ;
(*
Normal VAR parameters have LeftValue,
@@ -10220,7 +10520,7 @@ END MakeVariableForParam ;
PROCEDURE PutParam (tok: CARDINAL; Sym: CARDINAL; ParamNo: CARDINAL;
ParamName: Name; ParamType: CARDINAL;
- isUnbounded: BOOLEAN) : BOOLEAN ;
+ isUnbounded: BOOLEAN; typetok: CARDINAL) : BOOLEAN ;
VAR
pSym : PtrToSymbol ;
ParSym : CARDINAL ;
@@ -10246,7 +10546,8 @@ BEGIN
AddParameter(Sym, ParSym) ;
IF ParamName#NulName
THEN
- VariableSym := MakeVariableForParam(tok, ParamName, Sym, ParamNo) ;
+ VariableSym := MakeVariableForParam(tok, ParamName, Sym,
+ ParamNo, typetok) ;
IF VariableSym=NulSym
THEN
RETURN( FALSE )
@@ -10272,7 +10573,7 @@ END PutParam ;
PROCEDURE PutVarParam (tok: CARDINAL; Sym: CARDINAL; ParamNo: CARDINAL;
ParamName: Name; ParamType: CARDINAL;
- isUnbounded: BOOLEAN) : BOOLEAN ;
+ isUnbounded: BOOLEAN; typetok: CARDINAL) : BOOLEAN ;
VAR
pSym : PtrToSymbol ;
ParSym : CARDINAL ;
@@ -10299,7 +10600,8 @@ BEGIN
AddParameter(Sym, ParSym) ;
IF ParamName#NulName
THEN
- VariableSym := MakeVariableForParam(tok, ParamName, Sym, ParamNo) ;
+ VariableSym := MakeVariableForParam(tok, ParamName, Sym,
+ ParamNo, typetok) ;
IF VariableSym=NulSym
THEN
RETURN( FALSE )
@@ -10319,7 +10621,8 @@ END PutVarParam ;
ProcSym.
*)
-PROCEDURE PutParamName (tok: CARDINAL; ProcSym: CARDINAL; no: CARDINAL; name:
Name) ;
+PROCEDURE PutParamName (tok: CARDINAL; ProcSym: CARDINAL; no: CARDINAL;
+ name: Name; typetok: CARDINAL) ;
VAR
pSym : PtrToSymbol ;
ParSym: CARDINAL ;
@@ -10344,14 +10647,16 @@ BEGIN
ParamSym: IF Param.name=NulName
THEN
Param.name := name ;
- Param.ShadowVar := MakeVariableForParam(tok, name,
ProcSym, no)
+ Param.ShadowVar := MakeVariableForParam(tok, name,
ProcSym,
+ no, typetok)
ELSE
InternalError ('name of parameter has already been
assigned')
END |
VarParamSym: IF VarParam.name=NulName
THEN
VarParam.name := name ;
- VarParam.ShadowVar := MakeVariableForParam(tok, name,
ProcSym, no)
+ VarParam.ShadowVar := MakeVariableForParam(tok, name,
ProcSym,
+ no, typetok)
ELSE
InternalError ('name of parameter has already been
assigned')
END
@@ -10972,7 +11277,7 @@ BEGIN
CASE SymbolType OF
ErrorSym : |
- ProcedureSym: Assert(NOT Procedure.ParamDefined) ;
+ ProcedureSym: (* Assert(NOT Procedure.ParamDefined) ; *)
Procedure.ParamDefined := TRUE
ELSE
@@ -11108,6 +11413,100 @@ BEGIN
END AreParametersDefinedInImplementation ;
+(*
+ PutParametersDefinedByForward - records that the parameters have been
+ defined in a FORWARD declaration.
+*)
+
+PROCEDURE PutParametersDefinedByForward (ProcSym: CARDINAL) ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ CheckLegal (ProcSym) ;
+ pSym := GetPsym (ProcSym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ ProcedureSym: Procedure.DefinedByForward := TRUE
+
+ ELSE
+ InternalError ('expecting a Procedure symbol')
+ END
+ END
+END PutParametersDefinedByForward ;
+
+
+(*
+ GetParametersDefinedByForward - return TRUE if ProcSym has had its
parameters
+ defined by a FORWARD declaration.
+*)
+
+PROCEDURE GetParametersDefinedByForward (ProcSym: CARDINAL) : BOOLEAN ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ CheckLegal (ProcSym) ;
+ pSym := GetPsym (ProcSym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ ErrorSym : RETURN( FALSE ) |
+ ProcedureSym: RETURN( Procedure.DefinedByForward )
+
+ ELSE
+ InternalError ('expecting a Procedure symbol')
+ END
+ END
+END GetParametersDefinedByForward ;
+
+
+(*
+ PutParametersDefinedByProper - records that the parameters have been
+ defined in a FORWARD declaration.
+*)
+
+PROCEDURE PutParametersDefinedByProper (ProcSym: CARDINAL) ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ CheckLegal (ProcSym) ;
+ pSym := GetPsym (ProcSym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ ProcedureSym: Procedure.DefinedByProper := TRUE
+
+ ELSE
+ InternalError ('expecting a Procedure symbol')
+ END
+ END
+END PutParametersDefinedByProper ;
+
+
+(*
+ GetParametersDefinedByProper - return TRUE if ProcSym has had its parameters
+ defined by a FORWARD declaration.
+*)
+
+PROCEDURE GetParametersDefinedByProper (ProcSym: CARDINAL) : BOOLEAN ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ CheckLegal (ProcSym) ;
+ pSym := GetPsym (ProcSym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ ErrorSym : RETURN( FALSE ) |
+ ProcedureSym: RETURN( Procedure.DefinedByProper )
+
+ ELSE
+ InternalError ('expecting a Procedure symbol')
+ END
+ END
+END GetParametersDefinedByProper ;
+
+
(*
FillInUnknownFields -
*)
@@ -12479,7 +12878,7 @@ BEGIN
WITH pSym^ DO
CASE SymbolType OF
- ErrorSym : ErrorAbort0('') |
+ ErrorSym : RETURN( Error.Scope ) |
DefImpSym : RETURN( NulSym ) |
ModuleSym : RETURN( Module.Scope ) |
VarSym : RETURN( Var.Scope ) |
@@ -12500,6 +12899,18 @@ BEGIN
ConstLitSym : RETURN( ConstLit.Scope ) |
ConstStringSym : RETURN( ConstString.Scope ) |
ConstVarSym : RETURN( ConstVar.Scope ) |
+ ParamSym : IF Param.ShadowVar = NulSym
+ THEN
+ RETURN NulSym
+ ELSE
+ RETURN( GetScope (Param.ShadowVar) )
+ END |
+ VarParamSym : IF VarParam.ShadowVar = NulSym
+ THEN
+ RETURN NulSym
+ ELSE
+ RETURN( GetScope (VarParam.ShadowVar) )
+ END |
UndefinedSym : RETURN( NulSym ) |
PartialUnboundedSym: InternalError ('should not be requesting the scope
of a PartialUnbounded symbol')
@@ -13608,6 +14019,151 @@ BEGIN
END GetDeclaredMod ;
+(*
+ GetDeclaredFor - returns the token where this symbol was declared.
+ It chooses the first from the forward declaration,
+ implementation module, program module
+ and definition module.
+*)
+
+PROCEDURE GetDeclaredFor (Sym: CARDINAL) : CARDINAL ;
+BEGIN
+ RETURN GetProcedureDeclaredForward (Sym)
+END GetDeclaredFor ;
+
+
+(*
+ GetProcedureDeclaredForward - return the token at which the forward
+ declaration procedure occurred.
+*)
+
+PROCEDURE GetProcedureDeclaredForward (sym: CARDINAL) : CARDINAL ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym (sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ ProcedureSym: RETURN Procedure.Declared.Forward
+
+ ELSE
+ InternalError ('expecting procedure symbol')
+ END
+ END
+END GetProcedureDeclaredForward ;
+
+
+(*
+ PutProcedureDeclaredForward - places the tok to which the forward
+ declaration procedure occurred.
+*)
+
+PROCEDURE PutProcedureDeclaredForward (sym: CARDINAL; tok: CARDINAL) ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym (sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ ProcedureSym: Procedure.Declared.Forward := tok
+
+ ELSE
+ InternalError ('expecting procedure symbol')
+ END
+ END
+END PutProcedureDeclaredForward ;
+
+
+(*
+ GetProcedureDeclaredProper - return the token at which the forward
+ declaration procedure occurred.
+*)
+
+PROCEDURE GetProcedureDeclaredProper (sym: CARDINAL) : CARDINAL ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym (sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ ProcedureSym: RETURN Procedure.Declared.Proper
+
+ ELSE
+ InternalError ('expecting procedure symbol')
+ END
+ END
+END GetProcedureDeclaredProper ;
+
+
+(*
+ PutProcedureDeclaredProper - places the tok to which the forward
+ declaration procedure occurred.
+*)
+
+PROCEDURE PutProcedureDeclaredProper (sym: CARDINAL; tok: CARDINAL) ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym (sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ ProcedureSym: Procedure.Declared.Proper := tok
+
+ ELSE
+ InternalError ('expecting procedure symbol')
+ END
+ END
+END PutProcedureDeclaredProper ;
+
+
+(*
+ GetProcedureDeclaredDefinition - return the token at which the forward
+ declaration procedure occurred.
+*)
+
+PROCEDURE GetProcedureDeclaredDefinition (sym: CARDINAL) : CARDINAL ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym (sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ ProcedureSym: RETURN Procedure.Declared.Definition
+
+ ELSE
+ InternalError ('expecting procedure symbol')
+ END
+ END
+END GetProcedureDeclaredDefinition ;
+
+
+(*
+ PutProcedureDeclaredDefinition - places the tok to which the forward
+ declaration procedure occurred.
+*)
+
+PROCEDURE PutProcedureDeclaredDefinition (sym: CARDINAL; tok: CARDINAL) ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym (sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ ProcedureSym: Procedure.Declared.Definition := tok
+
+ ELSE
+ InternalError ('expecting procedure symbol')
+ END
+ END
+END PutProcedureDeclaredDefinition ;
+
+
(*
GetFirstUsed - returns the token where this symbol was first used.
*)
diff --git a/gcc/m2/gm2-libs-log/FileSystem.def
b/gcc/m2/gm2-libs-log/FileSystem.def
index bfc98e0d300c..89610a95f35b 100644
--- a/gcc/m2/gm2-libs-log/FileSystem.def
+++ b/gcc/m2/gm2-libs-log/FileSystem.def
@@ -269,7 +269,7 @@ PROCEDURE Doio (VAR f: File) ;
character was illegal.
*)
-PROCEDURE FileNameChar (ch: CHAR) ;
+PROCEDURE FileNameChar (ch: CHAR) : CHAR ;
END FileSystem.
diff --git a/gcc/m2/m2.flex b/gcc/m2/m2.flex
index 7f9b2d3d9319..876b759e8f0b 100644
--- a/gcc/m2/m2.flex
+++ b/gcc/m2/m2.flex
@@ -264,6 +264,7 @@ EXIT { updatepos();
M2LexBuf_AddTok(M2Reserved_exittok); r
EXPORT { updatepos();
M2LexBuf_AddTok(M2Reserved_exporttok); return; }
FINALLY { updatepos();
M2LexBuf_AddTok(M2Reserved_finallytok); return; }
FOR { updatepos(); M2LexBuf_AddTok(M2Reserved_fortok);
return; }
+FORWARD { updatepos();
M2LexBuf_AddTok(M2Reserved_forwardtok); return; }
FROM { updatepos(); M2LexBuf_AddTok(M2Reserved_fromtok);
return; }
IF { updatepos(); M2LexBuf_AddTok(M2Reserved_iftok);
return; }
IMPLEMENTATION { updatepos();
M2LexBuf_AddTok(M2Reserved_implementationtok); return; }
diff --git a/gcc/testsuite/gm2/iso/fail/badparam.def
b/gcc/testsuite/gm2/iso/fail/badparam.def
new file mode 100644
index 000000000000..e1ce0318877e
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/badparam.def
@@ -0,0 +1,5 @@
+DEFINITION MODULE badparam ;
+
+PROCEDURE foo (c: CHAR) ;
+
+END badparam.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/iso/fail/badparam.mod
b/gcc/testsuite/gm2/iso/fail/badparam.mod
new file mode 100644
index 000000000000..26ff5777fe52
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/badparam.mod
@@ -0,0 +1,8 @@
+IMPLEMENTATION MODULE badparam ;
+
+PROCEDURE foo (c: CARDINAL) ;
+BEGIN
+
+END foo ;
+
+END badparam.
\ No newline at end of file
diff --git a/gcc/testsuite/gm2/iso/fail/badparam2.def
b/gcc/testsuite/gm2/iso/fail/badparam2.def
new file mode 100644
index 000000000000..32f84024e7aa
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/badparam2.def
@@ -0,0 +1,5 @@
+DEFINITION MODULE badparam2 ;
+
+PROCEDURE foo (VAR c: CARDINAL) ;
+
+END badparam2.
diff --git a/gcc/testsuite/gm2/iso/fail/badparam2.mod
b/gcc/testsuite/gm2/iso/fail/badparam2.mod
new file mode 100644
index 000000000000..e182d43b7335
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/badparam2.mod
@@ -0,0 +1,7 @@
+IMPLEMENTATION MODULE badparam2 ;
+
+PROCEDURE foo (c: CARDINAL) ;
+BEGIN
+END foo ;
+
+END badparam2.
diff --git a/gcc/testsuite/gm2/iso/fail/badparam3.def
b/gcc/testsuite/gm2/iso/fail/badparam3.def
new file mode 100644
index 000000000000..4ca273b6c7ac
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/badparam3.def
@@ -0,0 +1,5 @@
+DEFINITION MODULE badparam3 ;
+
+PROCEDURE foo (c: CARDINAL) ;
+
+END badparam3.
diff --git a/gcc/testsuite/gm2/iso/fail/badparam3.mod
b/gcc/testsuite/gm2/iso/fail/badparam3.mod
new file mode 100644
index 000000000000..1adfb64c092c
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/badparam3.mod
@@ -0,0 +1,7 @@
+IMPLEMENTATION MODULE badparam3 ;
+
+PROCEDURE foo (VAR c: CARDINAL) ;
+BEGIN
+END foo ;
+
+END badparam3.
diff --git a/gcc/testsuite/gm2/iso/fail/badparamarray.def
b/gcc/testsuite/gm2/iso/fail/badparamarray.def
new file mode 100644
index 000000000000..fb92de362b48
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/badparamarray.def
@@ -0,0 +1,5 @@
+DEFINITION MODULE badparamarray ;
+
+PROCEDURE foo (a: ARRAY OF CHAR) ;
+
+END badparamarray.
diff --git a/gcc/testsuite/gm2/iso/fail/badparamarray.mod
b/gcc/testsuite/gm2/iso/fail/badparamarray.mod
new file mode 100644
index 000000000000..29037da0fcc1
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/badparamarray.mod
@@ -0,0 +1,8 @@
+IMPLEMENTATION MODULE badparamarray ;
+
+PROCEDURE foo (a: CHAR) ;
+BEGIN
+
+END foo ;
+
+END badparamarray.
diff --git a/gcc/testsuite/gm2/iso/fail/simpledef1.def
b/gcc/testsuite/gm2/iso/fail/simpledef1.def
new file mode 100644
index 000000000000..0be844692483
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/simpledef1.def
@@ -0,0 +1,6 @@
+DEFINITION MODULE simpledef1 ;
+
+PROCEDURE foo ;
+PROCEDURE foo ;
+
+END simpledef1.
diff --git a/gcc/testsuite/gm2/iso/fail/simpledef1.mod
b/gcc/testsuite/gm2/iso/fail/simpledef1.mod
new file mode 100644
index 000000000000..c65deb5351a2
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/simpledef1.mod
@@ -0,0 +1,3 @@
+IMPLEMENTATION MODULE simpledef1 ;
+
+END simpledef1.
diff --git a/gcc/testsuite/gm2/iso/fail/simpleforward.mod
b/gcc/testsuite/gm2/iso/fail/simpleforward.mod
new file mode 100644
index 000000000000..54edf815282d
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/simpleforward.mod
@@ -0,0 +1,12 @@
+MODULE simpleforward ;
+
+
+PROCEDURE foo ; FORWARD ;
+
+PROCEDURE foo (c: CARDINAL) ;
+BEGIN
+END foo ;
+
+BEGIN
+ foo (1)
+END simpleforward.
diff --git a/gcc/testsuite/gm2/iso/fail/simpleforward2.mod
b/gcc/testsuite/gm2/iso/fail/simpleforward2.mod
new file mode 100644
index 000000000000..7e30a00a0322
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/simpleforward2.mod
@@ -0,0 +1,11 @@
+MODULE simpleforward2 ;
+
+PROCEDURE foo (c: CARDINAL) ;
+BEGIN
+END foo ;
+
+PROCEDURE foo ; FORWARD ;
+
+BEGIN
+ foo (1)
+END simpleforward2.
diff --git a/gcc/testsuite/gm2/iso/fail/simpleforward3.mod
b/gcc/testsuite/gm2/iso/fail/simpleforward3.mod
new file mode 100644
index 000000000000..3537295a2c09
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/simpleforward3.mod
@@ -0,0 +1,11 @@
+MODULE simpleforward3 ;
+
+PROCEDURE foo (c: CARDINAL) ;
+BEGIN
+END foo ;
+
+PROCEDURE foo (c: CARDINAL) : CARDINAL ; FORWARD ;
+
+BEGIN
+ foo (1)
+END simpleforward3.
diff --git a/gcc/testsuite/gm2/iso/fail/simpleforward4.mod
b/gcc/testsuite/gm2/iso/fail/simpleforward4.mod
new file mode 100644
index 000000000000..06a6fab0574a
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/simpleforward4.mod
@@ -0,0 +1,17 @@
+MODULE simpleforward4 ;
+
+
+PROCEDURE foo () : CARDINAL ; FORWARD ;
+
+
+PROCEDURE foo () ;
+BEGIN
+ RETURN 0
+END foo ;
+
+
+BEGIN
+ IF foo () = 0
+ THEN
+ END
+END simpleforward4.
diff --git a/gcc/testsuite/gm2/iso/fail/simpleforward5.mod
b/gcc/testsuite/gm2/iso/fail/simpleforward5.mod
new file mode 100644
index 000000000000..4b4960dd7892
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/simpleforward5.mod
@@ -0,0 +1,12 @@
+MODULE simpleforward5 ;
+
+PROCEDURE foo (c: CARDINAL) : CARDINAL ; FORWARD ;
+PROCEDURE foo (c: CARDINAL) : CARDINAL ; FORWARD ;
+
+PROCEDURE foo (c: CARDINAL) ;
+BEGIN
+END foo ;
+
+BEGIN
+ foo (1)
+END simpleforward5.
diff --git a/gcc/testsuite/gm2/iso/fail/simpleforward7.mod
b/gcc/testsuite/gm2/iso/fail/simpleforward7.mod
new file mode 100644
index 000000000000..6435b51e2a7d
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/fail/simpleforward7.mod
@@ -0,0 +1,11 @@
+MODULE simpleforward7 ;
+
+PROCEDURE foo (c: CARDINAL) ; FORWARD ;
+
+PROCEDURE foo (c: INTEGER) ;
+BEGIN
+END foo ;
+
+BEGIN
+ foo (1)
+END simpleforward7.
diff --git a/gcc/testsuite/gm2/iso/pass/simpleforward.mod
b/gcc/testsuite/gm2/iso/pass/simpleforward.mod
new file mode 100644
index 000000000000..dd8b6f44f3cf
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/simpleforward.mod
@@ -0,0 +1,13 @@
+MODULE simpleforward ;
+
+
+PROCEDURE foo ; FORWARD ;
+
+PROCEDURE foo ;
+BEGIN
+END foo ;
+
+
+BEGIN
+ foo
+END simpleforward.
diff --git a/gcc/testsuite/gm2/iso/pass/simpleforward6.mod
b/gcc/testsuite/gm2/iso/pass/simpleforward6.mod
new file mode 100644
index 000000000000..f92b787c9dc4
--- /dev/null
+++ b/gcc/testsuite/gm2/iso/pass/simpleforward6.mod
@@ -0,0 +1,14 @@
+MODULE simpleforward6 ;
+
+PROCEDURE foo () : CARDINAL ;
+BEGIN
+ RETURN 0
+END foo ;
+
+PROCEDURE foo () : CARDINAL ; FORWARD ;
+
+BEGIN
+ IF foo () = 0
+ THEN
+ END
+END simpleforward6.
