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.
Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>
{%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).
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 ;
ColorDebug = FALSE ;
TYPE
+ GetTokProcedure = PROCEDURE (CARDINAL) : CARDINAL ;
+
errorType = (none, error, warning, note, chained, aborta) ;
colorType = (unsetColor, noColor, quoteColor, filenameColor, errorColor,
warningColor, noteColor, keywordColor, locusColor,
)
=:
- 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.
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
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
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
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 ;
(*
(*
- 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;
'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 ;
'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 ;
TRUE is returned.
*)
-PROCEDURE SetAutoInit (value: BOOLEAN) ;
+PROCEDURE SetAutoInit (value: BOOLEAN) : BOOLEAN ;
BEGIN
AutoInit := value ;
RETURN TRUE
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) ;
BuildBinaryOp,
BuildUnaryOp,
RecordOp,
- Top,
+ Top, DupFrame,
PopTF, PushTF, PopT, PushT, PopNothing, PopN, PushTFA,
PushTtok, PushTFtok, PopTFtok, PopTtok, PushTFAtok,
PushTFn, PushTFntok, PopTFn,
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.
*)
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.
*)
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,
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,
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,
ForTok := MakeKey('FOR') ;
AddKeyword(ForTok, fortok) ;
+ ForwardTok := MakeKey('FORWARD') ;
+ AddKeyword(ForwardTok, forwardtok) ;
+
FromTok := MakeKey('FROM') ;
AddKeyword(FromTok, fromtok) ;
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 ;
PROCEDURE EndProcedure ;
+(*
+ EndForward - ends building a forward procedure.
+*)
+
+PROCEDURE EndForward ;
+
+
(*
P0Init -
*)
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 *)
VAR
headBP,
curBP : BlockInfoPtr ;
- Level : CARDINAL ;
+ Level : INTEGER ;
(*
END EndProcedure ;
+(*
+ EndForward - ends building a forward procedure.
+*)
+
+PROCEDURE EndForward ;
+BEGIN
+ PopN (1) ;
+ EndBlock ;
+ M2Error.LeaveErrorScope
+END EndForward ;
+
+
(*
EndModule -
*)
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 ;
RegisterProgramModule,
RegisterImplementationModule, RegisterDefinitionModule,
RegisterInnerModule, EndModule,
- RegisterProcedure, EndProcedure ;
+ RegisterProcedure, EndProcedure, EndForward ;
FROM SymbolTable IMPORT NulSym, PutModuleContainsBuiltin, PutHiddenTypeDeclared ;
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) ;
token 'EXPORT' exporttok
token 'FINALLY' finallytok
token 'FOR' fortok
+token 'FORWARD' forwardtok
token 'FROM' fromtok
token 'IF' iftok
token 'IMPLEMENTATION' implementationtok
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__" ] =:
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 ;
BuildProcedureHeading,
StartBuildProcedure,
EndBuildProcedure,
+ EndBuildForward,
AddImportToImportStatement,
BuildImportStatement ;
token 'EXPORT' exporttok
token 'FINALLY' finallytok
token 'FOR' fortok
+token 'FORWARD' forwardtok
token 'FROM' fromtok
token 'IF' iftok
token 'IMPLEMENTATION' implementationtok
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) %
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
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:
PutProcedureBuiltin, PutProcedureInline,
GetSymName,
ResolveImports, PutDeclared,
+ GetProcedureDeclaredForward, PutProcedureDeclaredForward,
+ GetProcedureDeclaredProper, PutProcedureDeclaredProper,
+ GetProcedureDeclaredDefinition, PutProcedureDeclaredDefinition,
MakeError, MakeErrorS,
DisplayTrees ;
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) ;
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 ;
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
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.
EndBuildProcedure,
BuildFunction, BuildOptFunction,
BuildNoReturnAttribute,
+ BuildProcedureDefinedByForward,
+ BuildProcedureDefinedByProper,
+ EndBuildForward,
BuildPointerType,
BuildRecord, BuildFieldRecord,
DetermineType, PushType, PopType,
SeenUnknown, SeenSet, SeenString, SeenArray, SeenConstructor,
SeenCast,
- PushRememberConstant, PopRememberConstant ;
+ PushRememberConstant, PopRememberConstant,
+ CheckProcedure ;
FROM M2Reserved IMPORT ArrayTok, VarTok ;
token 'EXPORT' exporttok
token 'FINALLY' finallytok
token 'FOR' fortok
+token 'FORWARD' forwardtok
token 'FROM' fromtok
token 'IF' iftok
token 'IMPLEMENTATION' implementationtok
ProcedureParameters
")" FormalReturn ) =:
-FormalReturn := [ ":" OptReturnType ] =:
+FormalReturn := ( ":" OptReturnType | % CheckProcedure %
+ )
+ =:
OptReturnType := "[" Qualident % BuildOptFunction %
"]" | Qualident % BuildFunction %
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 %
-- 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))) %
% BuildFPSection %
=:
-FormalType := "ARRAY" "OF" % VAR n: CARDINAL ; %
+FormalType := "ARRAY" "OF" % VAR n, tok: CARDINAL ; %
% PushTF(ArrayTok, 1) %
{ "ARRAY" "OF" % PopTF(ArrayTok, n) %
% INC(n) %
} 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 %
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
PROCEDURE EndBuildProcedure ;
+(*
+ EndBuildForward - ends building a forward procedure.
+*)
+
+PROCEDURE EndBuildForward ;
+
+
(*
BuildNoReturnAttribute - provide an interface to the symbol table module.
*)
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:
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 ;
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 ;
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,
MakeVarient, MakeFieldVarient,
MakeArray, PutArraySubscript,
MakeSubscript, PutSubscript,
+ MakeError,
PutConstStringKnown, GetString,
PutArray, IsArray,
GetType, SkipType,
ParametersDefinedInDefinition,
ParametersDefinedInImplementation,
ProcedureParametersDefined,
+ GetProcedureDeclaredDefinition,
+ GetProcedureDeclaredForward,
+ GetProcedureDeclaredProper,
+ GetParametersDefinedByForward,
+ GetParametersDefinedByProper,
PutProcedureNoReturn,
PutProcedureParameterHeapVars,
+ PutParametersDefinedByForward,
+ PutParametersDefinedByProper,
CheckForUnImplementedExports,
CheckForUndeclaredExports,
IsHiddenTypeDeclared,
RequestSym,
PutDeclared,
GetPackedEquivalent,
+ GetVarDeclTok,
+ GetVarDeclFullTok,
+ PutVarDeclTok,
+ GetVarDeclTypeTok,
DisplayTrees ;
FROM M2Batch IMPORT MakeDefinitionSource,
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
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) *)
(*
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
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.
ProcSym : CARDINAL ;
NameStart: Name ;
BEGIN
+ ProcSym := OperandT (1) ;
+ ProcedureParametersDefined (ProcSym) ;
IF CompilingDefinitionModule()
THEN
PopT(ProcSym) ;
PROCEDURE BuildFPSection ;
VAR
- n : Name ;
ProcSym,
ParamTotal: CARDINAL ;
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
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
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
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.
Var,
Array : Name ;
tok : CARDINAL ;
+ TypeTok,
ParamTotal,
TypeSym,
UnBoundedSym,
i, ndim : CARDINAL ;
BEGIN
PopT(ParamTotal) ;
- PopT(TypeSym) ;
+ PopTtok (TypeSym, TypeTok) ;
PopTF(Array, ndim) ;
Assert( (Array=ArrayTok) OR (Array=NulTok) ) ;
PopT(NoOfIds) ;
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
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) ;
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)) ;
(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 ;
(*
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.
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 ;
(*
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 ;
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:
FROM M2Quads IMPORT PushT, PopT, PushTF, PopTF, PopNothing, Annotate,
PushTtok, PushTFtok, PopTtok, PopTFtok, OperandTok,
+ DupFrame, Top,
BuildModuleStart,
StartBuildDefFile, StartBuildModFile,
EndBuildFile,
StartBuildProcedure,
BuildProcedureHeading,
EndBuildProcedure,
+ EndBuildForward,
BuildVarAtAddress,
BuildConst,
BuildSubrange,
token 'EXPORT' exporttok
token 'FINALLY' finallytok
token 'FOR' fortok
+token 'FORWARD' forwardtok
token 'FROM' fromtok
token 'IF' iftok
token 'IMPLEMENTATION' implementationtok
"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 %
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
PROCEDURE EndBuildProcedure ;
+(*
+ EndBuildForward -
+*)
+
+PROCEDURE EndBuildForward ;
+
+
(*
BuildSubrange - Builds a Subrange type Symbol.
END BuildProcedureHeading ;
+(*
+ EndBuildForward -
+*)
+
+PROCEDURE EndBuildForward ;
+BEGIN
+ PopN (2) ;
+ EndScope ;
+ M2Error.LeaveErrorScope
+END EndBuildForward ;
+
+
(*
BuildSubrange - Builds a Subrange type Symbol.
PushTFA,
PushTFn, PopTFn, PushTFtok, PopTtok, PopTFtok, PushTtok, PushTFntok,
PushT, PushTF, IsAutoPushOn, PushAutoOff, PushAutoOn, PopAuto,
+ DupFrame,
BuildTypeForConstructor, BuildConstructor, BuildConstructorEnd,
PopConstructor,
NextConstructorField, SilentBuildConstructor,
PCStartBuildProcedure,
PCBuildProcedureHeading,
PCEndBuildProcedure,
+ PCEndBuildForward,
PCBuildImportOuterModule,
PCBuildImportInnerModule,
StartDesConst,
token 'EXPORT' exporttok
token 'FINALLY' finallytok
token 'FOR' fortok
+token 'FORWARD' forwardtok
token 'FROM' fromtok
token 'IF' iftok
token 'IMPLEMENTATION' implementationtok
"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 %
% PushAutoOn %
DefineBuiltinProcedure
( Ident
- % PCStartBuildProcedure ;
- PushAutoOff %
+ % PCStartBuildProcedure %
+ % PushAutoOff %
[ FormalParameters ] AttributeNoReturn
- % PCBuildProcedureHeading ;
- PopAuto %
+ % PCBuildProcedureHeading %
+ % PopAuto %
) % PopAuto %
=:
% PushAutoOn %
Builtin
( Ident
- % PCStartBuildProcedure ;
- PushAutoOff %
+ % PCStartBuildProcedure %
+ % PushAutoOff %
[ DefFormalParameters ] AttributeNoReturn
- % PCBuildProcedureHeading ;
- PopAuto %
+ % PCBuildProcedureHeading %
+ % PopAuto %
) % PopAuto %
% M2Error.LeaveErrorScope %
=:
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.
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.
FROM M2Quads IMPORT PushT, PopT, PushTF, PopTF, PopNothing, Annotate,
PushTtok, PushTFtok, PopTtok, PopTFtok, OperandTok,
- PushTFntok, Top,
+ PushTFntok, Top, DupFrame,
StartBuildDefFile, StartBuildModFile,
BuildModuleStart,
EndBuildFile,
token 'EXPORT' exporttok
token 'FINALLY' finallytok
token 'FOR' fortok
+token 'FORWARD' forwardtok
token 'FROM' fromtok
token 'IF' iftok
token 'IMPLEMENTATION' implementationtok
"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 %
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.
PROCEDURE PutParam (tok: CARDINAL; Sym: CARDINAL; ParamNo: CARDINAL;
ParamName: Name; ParamType: CARDINAL;
- isUnbounded: BOOLEAN) : BOOLEAN ;
+ isUnbounded: BOOLEAN; typetok: CARDINAL) : BOOLEAN ;
(*
PROCEDURE PutVarParam (tok: CARDINAL; Sym: CARDINAL; ParamNo: CARDINAL;
ParamName: Name; ParamType: CARDINAL;
- isUnbounded: BOOLEAN) : BOOLEAN ;
+ isUnbounded: BOOLEAN; typetok: CARDINAL) : BOOLEAN ;
(*
ProcSym.
*)
-PROCEDURE PutParamName (tok: CARDINAL; ProcSym: CARDINAL; no: CARDINAL; name: Name) ;
+PROCEDURE PutParamName (tok: CARDINAL; ProcSym: CARDINAL; no: CARDINAL;
+ name: Name; typetok: 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.
(*
- 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) ;
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
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.
DebugBuiltins ;
FROM M2LexBuf IMPORT UnknownTokenNo, TokenToLineNo,
- FindFileNameFromToken, TokenToLocation ;
+ FindFileNameFromToken, TokenToLocation,
+ MakeVirtual2Tok ;
FROM M2ALU IMPORT InitValue, PtrToValue, PushCard, PopInto,
PushString, PushFrom, PushChar, PushInt,
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 *)
SymError = RECORD
name : Name ;
+ Scope : CARDINAL ; (* Scope of declaration. *)
At : Where ; (* Where was sym declared/used *)
END ;
(* 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. *)
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 *)
(* 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 *)
WITH pSym^ DO
SymbolType := ErrorSym ;
Error.name := name ;
+ Error.Scope := GetCurrentScope () ;
InitWhereDeclaredTok(tok, Error.At) ;
InitWhereFirstUsedTok(tok, Error.At)
END ;
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.
(* 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. *)
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. *)
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.
IsConst := FALSE ;
ArrayRef := FALSE ;
Heap := FALSE ;
+ InitVarDecl (Declared, tok) ;
InitWhereDeclaredTok(tok, At) ;
InitWhereFirstUsedTok(tok, At) ; (* Where symbol first used. *)
InitList(ReadUsageList[RightValue]) ;
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.
PROCEDURE MakeVariableForParam (tok : CARDINAL;
ParamName: Name;
- ProcSym : CARDINAL ;
- no : CARDINAL) : CARDINAL ;
+ ProcSym : CARDINAL;
+ no : CARDINAL;
+ typetok : CARDINAL) : CARDINAL ;
VAR
pSym : PtrToSymbol ;
VariableSym: CARDINAL ;
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,
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 ;
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 )
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 ;
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 )
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 ;
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
CASE SymbolType OF
ErrorSym : |
- ProcedureSym: Assert(NOT Procedure.ParamDefined) ;
+ ProcedureSym: (* Assert(NOT Procedure.ParamDefined) ; *)
Procedure.ParamDefined := TRUE
ELSE
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 -
*)
WITH pSym^ DO
CASE SymbolType OF
- ErrorSym : ErrorAbort0('') |
+ ErrorSym : RETURN( Error.Scope ) |
DefImpSym : RETURN( NulSym ) |
ModuleSym : RETURN( Module.Scope ) |
VarSym : RETURN( Var.Scope ) |
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')
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.
*)
character was illegal.
*)
-PROCEDURE FileNameChar (ch: CHAR) ;
+PROCEDURE FileNameChar (ch: CHAR) : CHAR ;
END FileSystem.
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; }
--- /dev/null
+DEFINITION MODULE badparam ;
+
+PROCEDURE foo (c: CHAR) ;
+
+END badparam.
\ No newline at end of file
--- /dev/null
+IMPLEMENTATION MODULE badparam ;
+
+PROCEDURE foo (c: CARDINAL) ;
+BEGIN
+
+END foo ;
+
+END badparam.
\ No newline at end of file
--- /dev/null
+DEFINITION MODULE badparam2 ;
+
+PROCEDURE foo (VAR c: CARDINAL) ;
+
+END badparam2.
--- /dev/null
+IMPLEMENTATION MODULE badparam2 ;
+
+PROCEDURE foo (c: CARDINAL) ;
+BEGIN
+END foo ;
+
+END badparam2.
--- /dev/null
+DEFINITION MODULE badparam3 ;
+
+PROCEDURE foo (c: CARDINAL) ;
+
+END badparam3.
--- /dev/null
+IMPLEMENTATION MODULE badparam3 ;
+
+PROCEDURE foo (VAR c: CARDINAL) ;
+BEGIN
+END foo ;
+
+END badparam3.
--- /dev/null
+DEFINITION MODULE badparamarray ;
+
+PROCEDURE foo (a: ARRAY OF CHAR) ;
+
+END badparamarray.
--- /dev/null
+IMPLEMENTATION MODULE badparamarray ;
+
+PROCEDURE foo (a: CHAR) ;
+BEGIN
+
+END foo ;
+
+END badparamarray.
--- /dev/null
+DEFINITION MODULE simpledef1 ;
+
+PROCEDURE foo ;
+PROCEDURE foo ;
+
+END simpledef1.
--- /dev/null
+IMPLEMENTATION MODULE simpledef1 ;
+
+END simpledef1.
--- /dev/null
+MODULE simpleforward ;
+
+
+PROCEDURE foo ; FORWARD ;
+
+PROCEDURE foo (c: CARDINAL) ;
+BEGIN
+END foo ;
+
+BEGIN
+ foo (1)
+END simpleforward.
--- /dev/null
+MODULE simpleforward2 ;
+
+PROCEDURE foo (c: CARDINAL) ;
+BEGIN
+END foo ;
+
+PROCEDURE foo ; FORWARD ;
+
+BEGIN
+ foo (1)
+END simpleforward2.
--- /dev/null
+MODULE simpleforward3 ;
+
+PROCEDURE foo (c: CARDINAL) ;
+BEGIN
+END foo ;
+
+PROCEDURE foo (c: CARDINAL) : CARDINAL ; FORWARD ;
+
+BEGIN
+ foo (1)
+END simpleforward3.
--- /dev/null
+MODULE simpleforward4 ;
+
+
+PROCEDURE foo () : CARDINAL ; FORWARD ;
+
+
+PROCEDURE foo () ;
+BEGIN
+ RETURN 0
+END foo ;
+
+
+BEGIN
+ IF foo () = 0
+ THEN
+ END
+END simpleforward4.
--- /dev/null
+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.
--- /dev/null
+MODULE simpleforward7 ;
+
+PROCEDURE foo (c: CARDINAL) ; FORWARD ;
+
+PROCEDURE foo (c: INTEGER) ;
+BEGIN
+END foo ;
+
+BEGIN
+ foo (1)
+END simpleforward7.
--- /dev/null
+MODULE simpleforward ;
+
+
+PROCEDURE foo ; FORWARD ;
+
+PROCEDURE foo ;
+BEGIN
+END foo ;
+
+
+BEGIN
+ foo
+END simpleforward.
--- /dev/null
+MODULE simpleforward6 ;
+
+PROCEDURE foo () : CARDINAL ;
+BEGIN
+ RETURN 0
+END foo ;
+
+PROCEDURE foo () : CARDINAL ; FORWARD ;
+
+BEGIN
+ IF foo () = 0
+ THEN
+ END
+END simpleforward6.
projects / thirdparty / gcc.git / commitdiff
