DEFINITION MODULE M2Base ;
-(*
- Author : Gaius Mulley
- Title : M2Base
- Date : 22/5/87
- Description: Implements the default Base Types and Base
- procedures in the Modula-2 compiler.
-*)
+(* M2Base implements the default base types and base procedures in the
+ Modula-2 front end. *)
FROM NameKey IMPORT Name ;
FROM gcctypes IMPORT location_t ;
-EXPORT QUALIFIED Nil, (* Base constants *)
- Cardinal, (* Base types *)
- Integer,
- Boolean,
- True, False,
- Char,
- Proc,
- LongInt, LongCard,
- ShortInt, ShortCard,
- ZType, RType, CType,
- Real,
- LongReal, ShortReal,
- Complex,
- LongComplex,
- ShortComplex,
- High, IsOrd, (* Base functions *)
- LengthS,
- Convert,
- Re, Im, Cmplx,
- Cap, Abs, Odd,
- Chr, Val,
- IsTrunc, IsFloat,
- IsInt,
- Min, Max,
- New, Dispose, (* Base procedures *)
- Inc, Dec,
- Incl, Excl,
- IsPseudoBaseFunction, (* Manipulation procedures *)
- IsPseudoBaseProcedure, (* Manipulation procedures *)
- IsBaseType,
- GetBaseTypeMinMax,
- InitBase,
- CannotCheckTypeInPass3,
- CheckExpressionCompatible,
- CheckAssignmentCompatible,
- CheckParameterCompatible,
- IsAssignmentCompatible,
- IsExpressionCompatible,
- IsParameterCompatible,
- IsComparisonCompatible,
- IsValidParameter,
- AssignmentRequiresWarning,
- IsMathType,
- IsRealType,
- IsOrdinalType,
- IsComplexType,
- GetCmplxReturnType,
- ComplexToScalar,
- ScalarToComplex,
- MixTypes, NegateType,
- TemplateProcedure,
- ActivationPointer,
- IsNeededAtRunTime,
- ExceptionAssign,
- ExceptionReturn,
- ExceptionInc,
- ExceptionDec,
- ExceptionIncl,
- ExceptionExcl,
- ExceptionShift,
- ExceptionRotate,
- ExceptionStaticArray,
- ExceptionDynamicArray,
- ExceptionForLoopBegin,
- ExceptionForLoopTo,
- ExceptionForLoopEnd,
- ExceptionPointerNil,
- ExceptionNoReturn,
- ExceptionCase,
- ExceptionNonPosDiv,
- ExceptionNonPosMod,
- ExceptionZeroDiv,
- ExceptionZeroRem,
- ExceptionWholeValue,
- ExceptionRealValue,
- ExceptionParameterBounds,
- ExceptionNo ;
-
VAR
TemplateProcedure,
(*
- MixTypes - returns the type symbol that corresponds to the types t1 and t2.
+ MixTypes - given types leftType and rightType return a type symbol that
+ provides expression type compatibility.
NearTok is used to identify the source position if a type
incompatability occurs.
*)
-PROCEDURE MixTypes (t1, t2: CARDINAL; NearTok: CARDINAL) : CARDINAL ;
+PROCEDURE MixTypes (leftType, rightType: CARDINAL; NearTok: CARDINAL) : CARDINAL ;
+
+
+(*
+ MixTypesDecl - returns a type symbol which provides expression compatibility
+ between leftType and rightType. An error is emitted if this
+ is not possible. left and right are the source (variable,
+ constant) of leftType and rightType respectively.
+*)
+
+PROCEDURE MixTypesDecl (left, right, leftType, rightType: CARDINAL;
+ NearTok: CARDINAL) : CARDINAL ;
(*
FROM StrLib IMPORT StrLen ;
FROM M2MetaError IMPORT MetaError0, MetaError1, MetaError2, MetaErrors3,
- MetaErrorT1, MetaErrorT2,
- MetaErrorStringT2, MetaErrorStringT1 ;
+ MetaErrorT1, MetaErrorT2, MetaErrorT4,
+ MetaErrorStringT2, MetaErrorStringT1,
+ MetaErrorDecl ;
-FROM SymbolTable IMPORT ModeOfAddr,
+FROM SymbolTable IMPORT ModeOfAddr, ProcedureKind,
MakeModule, MakeType, PutType,
MakeEnumeration, PutFieldEnumeration,
MakeProcType,
IsParameterUnbounded, GetSubrange,
IsArray, IsProcedure, IsConstString,
IsVarient, IsRecordField, IsFieldVarient,
- GetArraySubscript, IsRecord, NoOfParam,
- GetNthParam, IsVarParam, GetNth, GetDimension,
+ IsVarAParam, IsVar,
+ GetArraySubscript, IsRecord, NoOfParamAny,
+ GetNthParamAny, IsVarParam, GetNth, GetDimension,
+ GetVarDeclFullTok,
MakeError ;
FROM M2ALU IMPORT PushIntegerTree, PushRealTree, PushCard, Equ, Gre, Less ;
PROCEDURE BuildOrdFunctions ;
BEGIN
Ord := MakeProcedure(BuiltinTokenNo, MakeKey('ORD')) ;
- PutFunction(Ord, Cardinal) ;
+ PutFunction (BuiltinTokenNo, Ord, DefProcedure, Cardinal) ;
OrdS := MakeProcedure(BuiltinTokenNo, MakeKey('ORDS')) ;
- PutFunction(OrdS, ShortCard) ;
+ PutFunction (BuiltinTokenNo, OrdS, DefProcedure, ShortCard) ;
OrdL := MakeProcedure(BuiltinTokenNo, MakeKey('ORDL')) ;
- PutFunction(OrdL, LongCard)
+ PutFunction (BuiltinTokenNo, OrdL, DefProcedure, LongCard)
END BuildOrdFunctions ;
IF Pim2 OR Pim3 OR Iso
THEN
Trunc := MakeProcedure(BuiltinTokenNo, MakeKey('TRUNC')) ;
- PutFunction(Trunc, Cardinal) ;
+ PutFunction (BuiltinTokenNo, Trunc, DefProcedure, Cardinal) ;
TruncS := MakeProcedure(BuiltinTokenNo, MakeKey('STRUNC')) ;
- PutFunction(TruncS, ShortCard) ;
+ PutFunction (BuiltinTokenNo, TruncS, DefProcedure, ShortCard) ;
TruncL := MakeProcedure(BuiltinTokenNo, MakeKey('LTRUNC')) ;
- PutFunction(TruncL, LongCard)
+ PutFunction (BuiltinTokenNo, TruncL, DefProcedure, LongCard)
ELSE
Trunc := MakeProcedure(BuiltinTokenNo, MakeKey('TRUNC')) ;
- PutFunction(Trunc, Integer) ;
+ PutFunction (BuiltinTokenNo, Trunc, DefProcedure, Integer) ;
TruncS := MakeProcedure(BuiltinTokenNo, MakeKey('STRUNC')) ;
- PutFunction(TruncS, ShortInt) ;
+ PutFunction (BuiltinTokenNo, TruncS, DefProcedure, ShortInt) ;
TruncL := MakeProcedure(BuiltinTokenNo, MakeKey('LTRUNC')) ;
- PutFunction(TruncL, LongInt)
+ PutFunction (BuiltinTokenNo, TruncL, DefProcedure, LongInt)
END
END BuildTruncFunctions ;
PROCEDURE BuildFloatFunctions ;
BEGIN
Float := MakeProcedure(BuiltinTokenNo, MakeKey('FLOAT')) ;
- PutFunction(Float, Real) ;
+ PutFunction (BuiltinTokenNo, Float, DefProcedure, Real) ;
SFloat := MakeProcedure(BuiltinTokenNo, MakeKey('SFLOAT')) ;
- PutFunction(SFloat, ShortReal) ;
+ PutFunction (BuiltinTokenNo, SFloat, DefProcedure, ShortReal) ;
LFloat := MakeProcedure(BuiltinTokenNo, MakeKey('LFLOAT')) ;
- PutFunction(LFloat, LongReal) ;
+ PutFunction (BuiltinTokenNo, LFloat, DefProcedure, LongReal) ;
FloatS := MakeProcedure(BuiltinTokenNo, MakeKey('FLOATS')) ;
- PutFunction(FloatS, ShortReal) ;
+ PutFunction (BuiltinTokenNo, FloatS, DefProcedure, ShortReal) ;
FloatL := MakeProcedure(BuiltinTokenNo, MakeKey('FLOATL')) ;
- PutFunction(FloatL, LongReal)
+ PutFunction (BuiltinTokenNo, FloatL, DefProcedure, LongReal)
END BuildFloatFunctions ;
PROCEDURE BuildIntFunctions ;
BEGIN
Int := MakeProcedure(BuiltinTokenNo, MakeKey('INT')) ;
- PutFunction(Int, Integer) ;
+ PutFunction (BuiltinTokenNo, Int, DefProcedure, Integer) ;
IntS := MakeProcedure(BuiltinTokenNo, MakeKey('INTS')) ;
- PutFunction(IntS, ShortInt) ;
+ PutFunction (BuiltinTokenNo, IntS, DefProcedure, ShortInt) ;
IntL := MakeProcedure(BuiltinTokenNo, MakeKey('INTL')) ;
- PutFunction(IntL, LongInt)
+ PutFunction (BuiltinTokenNo, IntL, DefProcedure, LongInt)
END BuildIntFunctions ;
BEGIN
(* Now declare the dynamic array components, HIGH *)
High := MakeProcedure(BuiltinTokenNo, MakeKey('HIGH')) ; (* Pseudo Base function HIGH *)
- PutFunction(High, Cardinal) ;
+ PutFunction (BuiltinTokenNo, High, DefProcedure, Cardinal) ;
(*
_TemplateProcedure is a procedure which has a local variable _ActivationPointer
IF Iso
THEN
LengthS := MakeProcedure(BuiltinTokenNo, MakeKey('LENGTH')) ; (* Pseudo Base function LENGTH *)
- PutFunction(LengthS, ZType)
+ PutFunction (BuiltinTokenNo, LengthS, DefProcedure, ZType)
ELSE
LengthS := NulSym
END ;
Abs := MakeProcedure(BuiltinTokenNo, MakeKey('ABS')) ; (* Pseudo Base function ABS *)
- PutFunction(Abs, ZType) ;
+ PutFunction (BuiltinTokenNo, Abs, DefProcedure, ZType) ;
Cap := MakeProcedure(BuiltinTokenNo, MakeKey('CAP')) ; (* Pseudo Base function CAP *)
- PutFunction(Cap, Char) ;
+ PutFunction (BuiltinTokenNo, Cap, DefProcedure, Char) ;
Odd := MakeProcedure(BuiltinTokenNo, MakeKey('ODD')) ; (* Pseudo Base function ODD *)
- PutFunction(Odd, Boolean) ;
+ PutFunction (BuiltinTokenNo, Odd, DefProcedure, Boolean) ;
Chr := MakeProcedure(BuiltinTokenNo, MakeKey('CHR')) ; (* Pseudo Base function CHR *)
- PutFunction(Chr, Char) ;
+ PutFunction (BuiltinTokenNo, Chr, DefProcedure, Char) ;
(* the following three procedure functions have a return type depending upon *)
(* the parameters. *)
Max := MakeProcedure(BuiltinTokenNo, MakeKey('MAX')) ; (* Pseudo Base function MIN *)
Re := MakeProcedure(BuiltinTokenNo, MakeKey('RE')) ; (* Pseudo Base function RE *)
- PutFunction(Re, RType) ;
+ PutFunction (BuiltinTokenNo, Re, DefProcedure, RType) ;
Im := MakeProcedure(BuiltinTokenNo, MakeKey('IM')) ; (* Pseudo Base function IM *)
- PutFunction(Im, RType) ;
+ PutFunction (BuiltinTokenNo, Im, DefProcedure, RType) ;
Cmplx := MakeProcedure(BuiltinTokenNo, MakeKey('CMPLX')) ; (* Pseudo Base function CMPLX *)
- PutFunction(Cmplx, CType) ;
+ PutFunction (BuiltinTokenNo, Cmplx, DefProcedure, CType) ;
BuildFloatFunctions ;
BuildTruncFunctions ;
pa, pb: CARDINAL ;
n, i : CARDINAL ;
BEGIN
- n := NoOfParam(p1) ;
- IF n#NoOfParam(p2)
+ n := NoOfParamAny (p1) ;
+ IF n # NoOfParamAny (p2)
THEN
IF error
THEN
- MetaError2('parameter is incompatible as {%1Dd} was declared with {%2n} parameters', p1, NoOfParam(p1)) ;
- MetaError2('whereas {%1Dd} was declared with {%2n} parameters', p2, NoOfParam(p2))
+ MetaError2('parameter is incompatible as {%1Dd} was declared with {%2n} parameters', p1, NoOfParamAny(p1)) ;
+ MetaError2('whereas {%1Dd} was declared with {%2n} parameters', p2, NoOfParamAny(p2))
END ;
RETURN( FALSE )
END ;
i := 1 ;
WHILE i<=n DO
- pa := GetNthParam(p1, i) ;
- pb := GetNthParam(p2, i) ;
- IF IsVarParam(p1, i)#IsVarParam(p2, i)
+ pa := GetNthParamAny (p1, i) ;
+ pb := GetNthParamAny (p2, i) ;
+ IF IsParameterVar (pa) # IsParameterVar (pb)
THEN
IF error
THEN
MetaErrors3('the {%1n} parameter is incompatible between {%2Dad} and {%3ad} as only one was declared as VAR',
'the {%1n} parameter is incompatible between {%2ad} and {%3Dad} as only one was declared as VAR',
- i, p1, p2)
+ i, pa, pb)
END ;
RETURN( FALSE )
END ;
MixMetaTypes -
*)
-PROCEDURE MixMetaTypes (t1, t2: CARDINAL; NearTok: CARDINAL) : CARDINAL ;
+PROCEDURE MixMetaTypes (left, right, leftType, rightType: CARDINAL; NearTok: CARDINAL) : CARDINAL ;
VAR
mt1, mt2: MetaType ;
BEGIN
- mt1 := FindMetaType(t1) ;
- mt2 := FindMetaType(t2) ;
+ mt1 := FindMetaType (leftType) ;
+ mt2 := FindMetaType (rightType) ;
CASE Expr[mt1, mt2] OF
- no : MetaErrorT2 (NearTok, 'type incompatibility between {%1asd} and {%2asd}', t1, t2) ;
+ no : MetaErrorT2 (NearTok, 'type incompatibility between {%1asd} and {%2asd}',
+ leftType, rightType) ;
+ MetaErrorDecl (left) ;
+ MetaErrorDecl (right) ;
FlushErrors (* unrecoverable at present *) |
warnfirst,
- first : RETURN( t1 ) |
+ first : RETURN( leftType ) |
warnsecond,
- second : RETURN( t2 )
+ second : RETURN( rightType )
ELSE
InternalError ('not expecting this metatype value')
(*
- MixTypes - given types, t1 and t2, returns a type symbol that
+ MixTypes - given types leftType and rightType return a type symbol that
provides expression type compatibility.
NearTok is used to identify the source position if a type
incompatability occurs.
*)
-PROCEDURE MixTypes (t1, t2: CARDINAL; NearTok: CARDINAL) : CARDINAL ;
+PROCEDURE MixTypes (leftType, rightType: CARDINAL; NearTok: CARDINAL) : CARDINAL ;
BEGIN
- IF t1=t2
+ RETURN MixTypesDecl (NulSym, NulSym, leftType, rightType, NearTok)
+END MixTypes ;
+
+
+(*
+ MixTypesDecl - returns a type symbol which provides expression compatibility
+ between leftType and rightType. An error is emitted if this
+ is not possible. left and right are the source (variable,
+ constant) of leftType and rightType respectively.
+*)
+
+PROCEDURE MixTypesDecl (left, right, leftType, rightType: CARDINAL; NearTok: CARDINAL) : CARDINAL ;
+BEGIN
+ IF leftType=rightType
THEN
- RETURN( t1 )
- ELSIF (t1=Address) AND (t2=Cardinal)
+ RETURN( leftType )
+ ELSIF (leftType=Address) AND (rightType=Cardinal)
THEN
RETURN( Address )
- ELSIF (t1=Cardinal) AND (t2=Address)
+ ELSIF (leftType=Cardinal) AND (rightType=Address)
THEN
RETURN( Address )
- ELSIF (t1=Address) AND (t2=Integer)
+ ELSIF (leftType=Address) AND (rightType=Integer)
THEN
RETURN( Address )
- ELSIF (t1=Integer) AND (t2=Address)
+ ELSIF (leftType=Integer) AND (rightType=Address)
THEN
RETURN( Address )
- ELSIF t1=NulSym
+ ELSIF leftType=NulSym
THEN
- RETURN( t2 )
- ELSIF t2=NulSym
+ RETURN( rightType )
+ ELSIF rightType=NulSym
THEN
- RETURN( t1 )
- ELSIF (t1=Bitset) AND IsSet(t2)
+ RETURN( leftType )
+ ELSIF (leftType=Bitset) AND IsSet(rightType)
THEN
- RETURN( t1 )
- ELSIF IsSet(t1) AND (t2=Bitset)
+ RETURN( leftType )
+ ELSIF IsSet(leftType) AND (rightType=Bitset)
THEN
- RETURN( t2 )
- ELSIF IsEnumeration(t1)
+ RETURN( rightType )
+ ELSIF IsEnumeration(leftType)
THEN
- RETURN( MixTypes(Integer, t2, NearTok) )
- ELSIF IsEnumeration(t2)
+ RETURN( MixTypesDecl (left, right, Integer, rightType, NearTok) )
+ ELSIF IsEnumeration(rightType)
THEN
- RETURN( MixTypes(t1, Integer, NearTok) )
- ELSIF IsSubrange(t1)
+ RETURN( MixTypesDecl (left, right, leftType, Integer, NearTok) )
+ ELSIF IsSubrange(leftType)
THEN
- RETURN( MixTypes(GetType(t1), t2, NearTok) )
- ELSIF IsSubrange(t2)
+ RETURN( MixTypesDecl (left, right, GetType(leftType), rightType, NearTok) )
+ ELSIF IsSubrange(rightType)
THEN
- RETURN( MixTypes(t1, GetType(t2), NearTok) )
- ELSIF IsRealType(t1) AND IsRealType(t2)
+ RETURN( MixTypesDecl (left, right, leftType, GetType(rightType), NearTok) )
+ ELSIF IsRealType(leftType) AND IsRealType(rightType)
THEN
- IF t1=RType
+ IF leftType=RType
THEN
- RETURN( t2 )
- ELSIF t2=RType
+ RETURN( rightType )
+ ELSIF rightType=RType
THEN
- RETURN( t1 )
+ RETURN( leftType )
ELSE
RETURN( RType )
END
- ELSIF IsComplexType(t1) AND IsComplexType(t2)
+ ELSIF IsComplexType(leftType) AND IsComplexType(rightType)
THEN
- IF t1=CType
+ IF leftType=CType
THEN
- RETURN( t2 )
- ELSIF t2=CType
+ RETURN( rightType )
+ ELSIF rightType=CType
THEN
- RETURN( t1 )
+ RETURN( leftType )
ELSE
RETURN( CType )
END
- ELSIF IsUserType (t1)
+ ELSIF IsUserType (leftType)
THEN
- RETURN( MixTypes(GetType(t1), t2, NearTok) )
- ELSIF IsUserType (t2)
+ RETURN( MixTypesDecl (left, right, GetType(leftType), rightType, NearTok) )
+ ELSIF IsUserType (rightType)
THEN
- RETURN( MixTypes(t1, GetType(t2), NearTok) )
- ELSIF (t1=GetLowestType(t1)) AND (t2=GetLowestType(t2))
+ RETURN( MixTypes(leftType, GetType(rightType), NearTok) )
+ ELSIF (leftType=GetLowestType(leftType)) AND (rightType=GetLowestType(rightType))
THEN
- RETURN( MixMetaTypes(t1, t2, NearTok) )
+ RETURN( MixMetaTypes (left, right, leftType, rightType, NearTok) )
ELSE
- t1 := GetLowestType(t1) ;
- t2 := GetLowestType(t2) ;
- RETURN( MixTypes(t1, t2, NearTok) )
+ leftType := GetLowestType(leftType) ;
+ rightType := GetLowestType(rightType) ;
+ RETURN( MixTypesDecl (left, right, leftType, rightType, NearTok) )
END
-END MixTypes ;
+END MixTypesDecl ;
(*
FROM M2Debug IMPORT Assert ;
FROM SymbolTable IMPORT NulSym, IsRecord, IsSet, GetDType, GetSType, IsType,
- SkipType, IsProcedure, NoOfParam, IsVarParam, GetNth,
- GetNthParam, IsProcType, IsVar, IsEnumeration, IsArray,
- GetDeclaredMod, IsSubrange, GetArraySubscript, IsConst,
+ SkipType, IsProcedure, NoOfParamAny, IsVarParamAny, GetNth,
+ GetNthParamAny, IsProcType, IsVar, IsEnumeration, IsArray,
+ IsSubrange, GetArraySubscript, IsConst,
IsReallyPointer, IsPointer, IsParameter, ModeOfAddr,
GetMode, GetType, IsUnbounded, IsComposite, IsConstructor,
IsParameter, IsConstString, IsConstLitInternal, IsConstLit,
result := checkPair (unknown, tinfo, lt, rt)
END ;
- IF NoOfParam (left) # NoOfParam (right)
+ IF NoOfParamAny (left) # NoOfParamAny (right)
THEN
IF tinfo^.format # NIL
THEN
RETURN return (false, tinfo, left, right)
END ;
i := 1 ;
- n := NoOfParam (left) ;
+ n := NoOfParamAny (left) ;
WHILE i <= n DO
- IF IsVarParam (left, i) # IsVarParam (right, i)
+ IF IsVarParamAny (left, i) # IsVarParamAny (right, i)
THEN
- IF IsVarParam (left, i)
+ IF IsVarParamAny (left, i)
THEN
IF tinfo^.format # NIL
THEN
END ;
RETURN return (false, tinfo, left, right)
END ;
- result := checkPair (result, tinfo, GetDType (GetNthParam (left, i)), GetDType (GetNthParam (right, i))) ;
+ result := checkPair (result, tinfo, GetDType (GetNthParamAny (left, i)), GetDType (GetNthParamAny (right, i))) ;
INC (i)
END
END ;
result := checkPair (result, tinfo, lt, rt)
END ;
- IF NoOfParam (left) # NoOfParam (right)
+ IF NoOfParamAny (left) # NoOfParamAny (right)
THEN
IF tinfo^.format # NIL
THEN
RETURN return (false, tinfo, left, right)
END ;
i := 1 ;
- n := NoOfParam (left) ;
+ n := NoOfParamAny (left) ;
WHILE i <= n DO
- IF IsVarParam (left, i) # IsVarParam (right, i)
+ IF IsVarParamAny (left, i) # IsVarParamAny (right, i)
THEN
- IF IsVarParam (left, i)
+ IF IsVarParamAny (left, i)
THEN
IF tinfo^.format # NIL
THEN
END ;
RETURN return (false, tinfo, left, right)
END ;
- result := checkPair (result, tinfo, GetDType (GetNthParam (left, i)), GetDType (GetNthParam (right, i))) ;
+ result := checkPair (result, tinfo, GetDType (GetNthParamAny (left, i)), GetDType (GetNthParamAny (right, i))) ;
INC (i)
END
END ;
FROM DynamicStrings IMPORT String ;
FROM NameKey IMPORT Name ;
-EXPORT QUALIFIED Error, ErrorScope,
- InternalError,
- WriteFormat0, WriteFormat1, WriteFormat2, WriteFormat3,
- NewError, ErrorFormat0, ErrorFormat1, ErrorFormat2, ErrorFormat3,
- ErrorString,
- NewWarning, NewNote, SetColor,
- FlushErrors, FlushWarnings, ChainError,
- ErrorStringAt, ErrorStringAt2, ErrorStringsAt2,
- WarnStringAt, WarnStringAt2, WarnStringsAt2,
- ErrorAbort0,
- WarnFormat0, WarnFormat1, MoveError,
- AnnounceScope, EnterImplementationScope,
- EnterModuleScope, EnterDefinitionScope, EnterProgramScope,
- EnterProcedureScope, DepthScope, GetAnnounceScope,
- DefaultProgramModule, DefaultImplementationModule,
- DefaultDefinitionModule, DefaultInnerModule, DefaultProcedure,
- EnterErrorScope, GetCurrentErrorScope, ResetErrorScope,
- LeaveErrorScope ;
-
TYPE
Error ;
FROM NameKey IMPORT Name, MakeKey, NulName, KeyToCharStar, makekey ;
FROM M2FileName IMPORT CalculateFileName ;
FROM DynamicStrings IMPORT String, string, InitString, KillString, InitStringCharStar, InitStringChar, Mark ;
-FROM FormatStrings IMPORT Sprintf1 ;
FROM M2LexBuf IMPORT TokenToLineNo, FindFileNameFromToken, TokenToLocation, UnknownTokenNo, BuiltinTokenNo ;
FROM M2MetaError IMPORT MetaError1, MetaError2, MetaError3 ;
FROM M2Error IMPORT FlushErrors, InternalError ;
FROM M2BasicBlock IMPORT BasicBlock, InitBasicBlocks, KillBasicBlocks, ForeachBasicBlockDo ;
FROM SymbolTable IMPORT NulSym,
- ModeOfAddr,
+ ModeOfAddr, ProcedureKind,
+ GetProcedureKindDesc,
+ GetProcedureParametersDefined,
GetMode,
GetScope,
GetNth, SkipType, GetVarBackEndType,
GetSType, GetLType, GetDType,
MakeType, PutType, GetLowestType,
GetSubrange, PutSubrange, GetArraySubscript,
- NoOfParam, GetNthParam,
+ NoOfParamAny, GetNthParamAny,
PushValue, PopValue, PopSize,
IsTemporary, IsUnbounded, IsPartialUnbounded,
IsEnumeration, IsVar,
IsConst, IsConstSet, IsConstructor,
IsFieldEnumeration,
IsExported, IsImported,
- IsVarParam, IsRecordField, IsUnboundedParam,
+ IsVarParamAny, IsRecordField, IsUnboundedParam,
IsValueSolved,
IsDefinitionForC, IsHiddenTypeDeclared,
IsInnerModule, IsUnknown,
IsError, IsHiddenType, IsVarHeap,
IsComponent, IsPublic, IsExtern, IsCtor,
IsImport, IsImportStatement, IsConstStringKnown,
+ IsUnboundedParamAny,
GetMainModule, GetBaseModule, GetModule, GetLocalSym,
PutModuleFinallyFunction,
GetProcedureScope, GetProcedureQuads,
+ NoOfParam, IsVarParam, GetNthParam, GetType,
IsRecordFieldAVarientTag, IsEmptyFieldVarient,
GetVarient, GetUnbounded, PutArrayLarge,
IsAModula2Type, UsesVarArgs,
GetSymName, GetParent,
GetDeclaredMod, GetVarBackEndType,
- GetProcedureBeginEnd, IsProcedureNoReturn,
+ GetProcedureBeginEnd, IsProcedureAnyNoReturn,
GetString, GetStringLength, IsConstString,
IsConstStringM2, IsConstStringC, IsConstStringM2nul, IsConstStringCnul,
GetAlignment, IsDeclaredPacked, PutDeclaredPacked,
GetPackedEquivalent,
GetParameterShadowVar,
GetUnboundedRecordType,
- GetModuleCtors,
+ GetModuleCtors, GetProcedureProcType,
MakeSubrange, MakeConstVar, MakeConstLit,
PutConst,
ForeachOAFamily, GetOAFamily,
BEGIN
IF IsProcedure(sym)
THEN
- p := NoOfParam(sym) ;
+ p := NoOfParamAny (sym) ;
i := p ;
WHILE i>0 DO
- IF IsUnboundedParam(sym, i)
+ IF IsUnboundedParamAny (sym, i)
THEN
- param := GetNthParam(sym, i) ;
+ param := GetNthParamAny (sym, i) ;
type := GetSType(param) ;
TraverseDependants(type) ;
IF GccKnowsAbout(type)
BEGIN
IF IsProcedure (sym)
THEN
- p := NoOfParam (sym) ;
+ p := NoOfParamAny (sym) ;
i := p ;
WHILE i>0 DO
- IF IsUnboundedParam (sym, i)
+ IF IsUnboundedParamAny (sym, i)
THEN
- param := GetNthParam (sym, i)
+ param := GetNthParamAny (sym, i)
ELSE
param := GetNth (sym, i)
END ;
returnType,
GccParam : tree ;
scope,
- Son,
+ Variable,
p, i : CARDINAL ;
b, e : CARDINAL ;
begin, end,
IF (NOT GccKnowsAbout(Sym)) AND (NOT IsPseudoProcFunc(Sym))
THEN
BuildStartFunctionDeclaration(UsesVarArgs(Sym)) ;
- p := NoOfParam(Sym) ;
+ p := NoOfParamAny (Sym) ;
i := p ;
WHILE i>0 DO
- (* note we dont use GetNthParam as we want the parameter that is seen by the procedure block
+ (* note we dont use GetNthParamAny as we want the parameter that is seen by the procedure block
remember that this is treated exactly the same as a variable, just its position on
the activation record is special (ie a parameter)
*)
- Son := GetNth(Sym, i) ;
- location := TokenToLocation(GetDeclaredMod(Son)) ;
- IF IsUnboundedParam(Sym, i)
+ Variable := GetNth(Sym, i) ;
+ location := TokenToLocation(GetDeclaredMod(Variable)) ;
+ IF IsUnboundedParamAny (Sym, i)
THEN
GccParam := BuildParameterDeclaration(location,
- KeyToCharStar(GetSymName(Son)),
- Mod2Gcc(GetLType(Son)),
+ KeyToCharStar(GetSymName(Variable)),
+ Mod2Gcc(GetLType(Variable)),
FALSE)
ELSE
GccParam := BuildParameterDeclaration(location,
- KeyToCharStar(GetSymName(Son)),
- Mod2Gcc(GetLType(Son)),
- IsVarParam(Sym, i))
+ KeyToCharStar(GetSymName(Variable)),
+ Mod2Gcc(GetLType(Variable)),
+ IsVarParamAny (Sym, i))
END ;
- PreAddModGcc(Son, GccParam) ;
- WatchRemoveList(Son, todolist) ;
- WatchIncludeList(Son, fullydeclared) ;
+ PreAddModGcc(Variable, GccParam) ;
+ WatchRemoveList(Variable, todolist) ;
+ WatchIncludeList(Variable, fullydeclared) ;
DEC(i)
END ;
GetProcedureBeginEnd(Sym, b, e) ;
IsExternalToWholeProgram(Sym),
IsProcedureGccNested(Sym),
IsExported(GetModuleWhereDeclared(Sym), Sym),
- IsProcedureNoReturn(Sym))) ;
+ IsProcedureAnyNoReturn(Sym))) ;
PopBinding(scope) ;
WatchRemoveList(Sym, todolist) ;
WatchIncludeList(Sym, fullydeclared)
returnType,
GccParam : tree ;
scope,
- Son,
+ Variable,
p, i : CARDINAL ;
b, e : CARDINAL ;
begin, end,
IsExtern (Sym))
THEN
BuildStartFunctionDeclaration(UsesVarArgs(Sym)) ;
- p := NoOfParam(Sym) ;
+ p := NoOfParamAny (Sym) ;
i := p ;
WHILE i>0 DO
- (* Note we dont use GetNthParam as we want the parameter that is seen by
+ (* Note we dont use GetNthParamAny as we want the parameter that is seen by
the procedure block remember that this is treated exactly the same as
a variable, just its position on the activation record is special (ie
a parameter). *)
- Son := GetNth(Sym, i) ;
- location := TokenToLocation(GetDeclaredMod(Son)) ;
- IF IsUnboundedParam(Sym, i)
+ Variable := GetNth(Sym, i) ;
+ location := TokenToLocation(GetDeclaredMod(Variable)) ;
+ IF IsUnboundedParamAny (Sym, i)
THEN
GccParam := BuildParameterDeclaration(location,
- KeyToCharStar(GetSymName(Son)),
- Mod2Gcc(GetLType(Son)),
+ KeyToCharStar(GetSymName(Variable)),
+ Mod2Gcc(GetLType(Variable)),
FALSE)
ELSE
GccParam := BuildParameterDeclaration(location,
- KeyToCharStar(GetSymName(Son)),
- Mod2Gcc(GetLType(Son)),
- IsVarParam(Sym, i))
+ KeyToCharStar(GetSymName(Variable)),
+ Mod2Gcc(GetLType(Variable)),
+ IsVarParamAny (Sym, i))
END ;
- PreAddModGcc(Son, GccParam) ;
- WatchRemoveList(Son, todolist) ;
- WatchIncludeList(Son, fullydeclared) ;
+ PreAddModGcc(Variable, GccParam) ;
+ WatchRemoveList(Variable, todolist) ;
+ WatchIncludeList(Variable, fullydeclared) ;
DEC(i)
END ;
GetProcedureBeginEnd(Sym, b, e) ;
IsProcedureGccNested (Sym),
(* Exported from the module where it was declared. *)
IsExported (GetModuleWhereDeclared (Sym), Sym) OR IsExtern (Sym),
- IsProcedureNoReturn(Sym))) ;
+ IsProcedureAnyNoReturn(Sym))) ;
PopBinding(scope) ;
WatchRemoveList(Sym, todolist) ;
WatchIncludeList(Sym, fullydeclared)
PROCEDURE DeclareGlobalVariablesWholeProgram (ModSym: CARDINAL) ;
VAR
- n, Son: CARDINAL ;
+ n, Variable: CARDINAL ;
BEGIN
n := 1 ;
- Son := GetNth(ModSym, n) ;
- WHILE Son#NulSym DO
- DeclareVariableWholeProgram(ModSym, Son) ;
- INC(n) ;
- Son := GetNth(ModSym, n)
+ Variable := GetNth (ModSym, n) ;
+ WHILE Variable # NulSym DO
+ DeclareVariableWholeProgram (ModSym, Variable) ;
+ INC (n) ;
+ Variable := GetNth (ModSym, n)
END ;
ForeachInnerModuleDo(ModSym, DeclareGlobalVariablesWholeProgram)
END DeclareGlobalVariablesWholeProgram ;
PROCEDURE DeclareGlobalVariables (ModSym: CARDINAL) ;
VAR
- n, variable: CARDINAL ;
+ n, Variable: CARDINAL ;
BEGIN
n := 1 ;
- variable := GetNth (ModSym, n) ;
- WHILE variable # NulSym DO
- DeclareVariable (ModSym, variable) ;
+ Variable := GetNth (ModSym, n) ;
+ WHILE Variable # NulSym DO
+ DeclareVariable (ModSym, Variable) ;
INC (n) ;
- variable := GetNth (ModSym, n)
+ Variable := GetNth (ModSym, n)
END ;
ForeachInnerModuleDo (ModSym, DeclareGlobalVariables)
END DeclareGlobalVariables ;
VAR
i, var: CARDINAL ;
BEGIN
- i := NoOfParam (procedure) + 1 ;
+ i := NoOfParamAny (procedure) + 1 ;
var := GetNth (procedure, i) ;
WHILE var # NulSym DO
Assert (procedure = GetScope (var)) ;
VAR
i: CARDINAL ;
BEGIN
- fprintf0 (GetDumpFile (), ' ListOfSons [') ;
+ fprintf0 (GetDumpFile (), ' ListOfFields [') ;
i := 1 ;
WHILE GetNth (sym, i) # NulSym DO
IF i>1
END PrintScope ;
+(*
+ PrintKind -
+*)
+
+PROCEDURE PrintKind (kind: ProcedureKind) ;
+VAR
+ s: String ;
+BEGIN
+ s := GetProcedureKindDesc (kind) ;
+ fprintf1 (GetDumpFile (), "%s", s) ;
+ s := KillString (s)
+END PrintKind ;
+
+
+(*
+ PrintProcedureParameters -
+*)
+
+PROCEDURE PrintProcedureParameters (sym: CARDINAL; kind: ProcedureKind) ;
+VAR
+ typeName,
+ paramName: Name ;
+ p, i, n,
+ type : CARDINAL ;
+BEGIN
+ fprintf0 (GetDumpFile (), ' (') ;
+ n := NoOfParam (sym, kind) ;
+ i := 1 ;
+ WHILE i <= n DO
+ IF i > 1
+ THEN
+ fprintf0 (GetDumpFile (), '; ')
+ END ;
+ IF IsVarParam (sym, kind, i)
+ THEN
+ fprintf0 (GetDumpFile (), 'VAR ')
+ END ;
+ p := GetNthParam (sym, kind, i) ;
+ paramName := GetSymName (p) ;
+ type := GetType (p) ;
+ typeName := GetSymName (type) ;
+ IF IsUnboundedParam (sym, kind, i)
+ THEN
+ fprintf2 (GetDumpFile (), '%a: ARRAY OF %a', paramName, typeName)
+ ELSE
+ fprintf2 (GetDumpFile (), '%a: %a', paramName, typeName)
+ END ;
+ INC (i)
+ END ;
+ fprintf0 (GetDumpFile (), ')')
+END PrintProcedureParameters ;
+
+
+(*
+ PrintProcedureReturnType -
+*)
+
+PROCEDURE PrintProcedureReturnType (sym: CARDINAL) ;
+VAR
+ typeName: Name ;
+BEGIN
+ IF GetType (sym) # NulSym
+ THEN
+ typeName := GetSymName (GetType (sym)) ;
+ fprintf1 (GetDumpFile (), ' : %a', typeName)
+ END ;
+ fprintf0 (GetDumpFile (), ' ;')
+END PrintProcedureReturnType ;
+
+
(*
PrintProcedure -
*)
PROCEDURE PrintProcedure (sym: CARDINAL) ;
VAR
- n: Name ;
+ n : Name ;
+ kind: ProcedureKind ;
BEGIN
n := GetSymName (sym) ;
fprintf2 (GetDumpFile (), 'sym %d IsProcedure (%a)', sym, n);
THEN
fprintf0 (GetDumpFile (), ' ctor')
END ;
- PrintDeclared(sym)
+ PrintDeclared (sym) ;
+ fprintf0 (GetDumpFile (), '\n') ;
+ FOR kind := MIN (ProcedureKind) TO MAX (ProcedureKind) DO
+ fprintf0 (GetDumpFile (), 'parameters ') ;
+ PrintKind (kind) ;
+ IF GetProcedureParametersDefined (sym, kind)
+ THEN
+ fprintf0 (GetDumpFile (), ' defined') ;
+ PrintProcedureParameters (sym, kind) ;
+ PrintProcedureReturnType (sym)
+ ELSE
+ fprintf0 (GetDumpFile (), ' undefined')
+ END ;
+ fprintf0 (GetDumpFile (), '\n')
+ END ;
+ fprintf0 (GetDumpFile (), ' Associated proctype: ') ;
+ PrintProcType (GetProcedureProcType (sym))
END PrintProcedure ;
+(*
+ PrintProcTypeParameters -
+*)
+
+PROCEDURE PrintProcTypeParameters (sym: CARDINAL) ;
+VAR
+ typeName : Name ;
+ p, i, n,
+ type : CARDINAL ;
+BEGIN
+ fprintf0 (GetDumpFile (), ' (') ;
+ n := NoOfParam (sym, ProperProcedure) ;
+ i := 1 ;
+ WHILE i <= n DO
+ IF i > 1
+ THEN
+ fprintf0 (GetDumpFile (), '; ')
+ END ;
+ IF IsVarParam (sym, ProperProcedure, i)
+ THEN
+ fprintf0 (GetDumpFile (), 'VAR ')
+ END ;
+ p := GetNthParam (sym, ProperProcedure, i) ;
+ type := GetType (p) ;
+ typeName := GetSymName (type) ;
+ IF IsUnboundedParam (sym, ProperProcedure, i)
+ THEN
+ fprintf1 (GetDumpFile (), 'ARRAY OF %a', typeName)
+ ELSE
+ fprintf1 (GetDumpFile (), '%a', typeName)
+ END ;
+ INC (i)
+ END ;
+ fprintf0 (GetDumpFile (), ')')
+END PrintProcTypeParameters ;
+
+
+(*
+ PrintProcType -
+*)
+
+PROCEDURE PrintProcType (sym: CARDINAL) ;
+VAR
+ n: Name ;
+BEGIN
+ n := GetSymName (sym) ;
+ fprintf2 (GetDumpFile (), 'sym %d IsProcType (%a)', sym, n);
+ PrintScope (sym) ;
+ PrintDeclared (sym) ;
+ fprintf0 (GetDumpFile (), '\n') ;
+ fprintf0 (GetDumpFile (), 'parameters ') ;
+ PrintProcTypeParameters (sym) ;
+ PrintProcedureReturnType (sym) ;
+ fprintf0 (GetDumpFile (), '\n')
+END PrintProcType ;
+
+
(*
PrintString -
*)
PrintDecl(sym)
ELSIF IsProcType(sym)
THEN
- fprintf2 (GetDumpFile (), 'sym %d IsProcType (%a)', sym, n)
+ PrintProcType (sym)
ELSIF IsVar(sym)
THEN
fprintf2 (GetDumpFile (), 'sym %d IsVar (%a) declared in ', sym, n) ;
PROCEDURE DeclareProcType (Sym: CARDINAL) : tree ;
VAR
- i, p, Son,
+ i, p,
+ Parameter,
ReturnType: CARDINAL ;
func,
GccParam : tree ;
ReturnType := GetSType(Sym) ;
func := DoStartDeclaration(Sym, BuildStartFunctionType) ;
InitFunctionTypeParameters ;
- p := NoOfParam(Sym) ;
+ p := NoOfParamAny (Sym) ;
i := p ;
- WHILE i>0 DO
- Son := GetNthParam(Sym, i) ;
- location := TokenToLocation(GetDeclaredMod(Son)) ;
- GccParam := BuildProcTypeParameterDeclaration(location, Mod2Gcc(GetSType(Son)), IsVarParam(Sym, i)) ;
- PreAddModGcc(Son, GccParam) ;
+ WHILE i > 0 DO
+ Parameter := GetNthParamAny (Sym, i) ;
+ location := TokenToLocation (GetDeclaredMod (Parameter)) ;
+ GccParam := BuildProcTypeParameterDeclaration (location, Mod2Gcc (GetSType (Parameter)), IsVarParamAny (Sym, i)) ;
+ PreAddModGcc(Parameter, GccParam) ;
DEC(i)
END ;
- IF ReturnType=NulSym
+ IF ReturnType = NulSym
THEN
- RETURN( BuildEndFunctionType(func, NIL, UsesVarArgs(Sym)) )
+ RETURN( BuildEndFunctionType (func, NIL, UsesVarArgs(Sym)) )
ELSE
- RETURN( BuildEndFunctionType(func, Mod2Gcc(ReturnType), UsesVarArgs(Sym)) )
+ RETURN( BuildEndFunctionType (func, Mod2Gcc(ReturnType), UsesVarArgs(Sym)) )
END
END DeclareProcType ;
Assert(IsProcType(sym)) ;
i := 1 ;
ReturnType := GetSType(sym) ;
- p := NoOfParam(sym) ;
+ p := NoOfParamAny (sym) ;
WHILE i<=p DO
- son := GetNthParam(sym, i) ;
+ son := GetNthParamAny (sym, i) ;
ParamType := GetSType(son) ;
IF NOT q(ParamType)
THEN
Assert(IsProcType(sym)) ;
i := 1 ;
ReturnType := GetSType(sym) ;
- n := NoOfParam(sym) ;
+ n := NoOfParamAny (sym) ;
WHILE i<=n DO
- son := GetNthParam(sym, i) ;
+ son := GetNthParamAny (sym, i) ;
ParamType := GetSType(son) ;
p(ParamType) ;
INC(i)
FROM SymbolTable IMPORT PushSize, PopSize, PushValue, PopValue,
PushVarSize,
- PushSumOfLocalVarSize,
- PushSumOfParamSize,
MakeConstLit,
RequestSym, FromModuleGetSym,
StartScope, EndScope, GetScope,
GetLocalSym, GetVarWritten,
GetVarient, GetVarBackEndType, GetModuleCtors,
NoOfVariables,
- NoOfParam, GetParent, GetDimension, IsAModula2Type,
+ NoOfParamAny, GetParent, GetDimension, IsAModula2Type,
IsModule, IsDefImp, IsType, IsModuleWithinProcedure,
IsConstString, GetString, GetStringLength,
IsConstStringCnul, IsConstStringM2nul,
IsConst, IsConstSet, IsProcedure, IsProcType,
- IsVar, IsVarParam, IsTemporary,
+ IsVar, IsVarParamAny, IsTemporary,
IsEnumeration,
IsUnbounded, IsArray, IsSet, IsConstructor,
IsProcedureVariable,
- IsUnboundedParam,
+ IsUnboundedParamAny,
IsRecordField, IsFieldVarient, IsVarient, IsRecord,
IsExportQualified,
IsExported,
ForeachInnerModuleDo,
ForeachLocalSymDo,
GetLType,
- GetType, GetNth, GetNthParam,
+ GetType, GetNth, GetNthParamAny,
SkipType, SkipTypeAndSubrange,
GetUnboundedHighOffset,
GetUnboundedAddressOffset,
PutConst, PutConstSet, PutConstructor,
GetSType, GetTypeMode,
HasVarParameters, CopyConstString,
+ GetVarDeclFullTok,
NulSym ;
FROM M2Batch IMPORT MakeDefinitionSource ;
FROM M2Error IMPORT InternalError, WriteFormat0, WriteFormat1, WriteFormat2, WarnStringAt ;
FROM M2MetaError IMPORT MetaErrorT0, MetaErrorT1, MetaErrorT2, MetaErrorT3,
- MetaError1, MetaError2, MetaErrorStringT1 ;
+ MetaError1, MetaError2, MetaErrorStringT1,
+ MetaErrorDecl ;
FROM M2Options IMPORT UnboundedByReference, PedanticCast,
VerboseUnbounded, Iso, Pim, DebugBuiltins, WholeProgram,
FROM M2Printf IMPORT printf0, printf1, printf2, printf4 ;
FROM M2Quiet IMPORT qprintf0 ;
-FROM M2Base IMPORT MixTypes, NegateType, ActivationPointer, IsMathType,
+FROM M2Base IMPORT MixTypes, MixTypesDecl, NegateType, ActivationPointer, IsMathType,
IsRealType, IsComplexType, IsBaseType,
IsOrdinalType,
Cardinal, Char, Integer, IsTrunc,
*)
+(*
+ ErrorMessageDecl - emit an error message together with declaration fragments of left
+ and right if they are parameters or variables.
+*)
+
+PROCEDURE ErrorMessageDecl (tok: CARDINAL; message: ARRAY OF CHAR; left, right: CARDINAL) ;
+BEGIN
+ MetaErrorT2 (tok, message, left, right) ;
+ MetaErrorDecl (left) ;
+ MetaErrorDecl (right)
+END ErrorMessageDecl ;
+
+
(*
IsExportedGcc - returns TRUE if this symbol should be (as far as the middle/backend of GCC)
is concerned, exported.
BEGIN
InitList(trashed) ;
i := 1 ;
- p := NoOfParam(proc) ;
+ p := NoOfParamAny (proc) ;
WHILE i<=p DO
- sym := GetNthParam(proc, i) ;
+ sym := GetNthParamAny (proc, i) ;
IF IsParameterWritten(proc, sym)
THEN
IF VerboseUnbounded
END ;
(* now see whether we need to copy any unbounded array parameters *)
i := 1 ;
- p := NoOfParam(proc) ;
+ p := NoOfParamAny (proc) ;
WHILE i<=p DO
- IF IsUnboundedParam(proc, i) AND (NOT IsVarParam(proc, i))
+ IF IsUnboundedParamAny (proc, i) AND (NOT IsVarParamAny (proc, i))
THEN
CheckUnboundedNonVarParameter (tokenno, trashed, proc, GetNth (proc, i))
END ;
IF IsProcedure (scope)
THEN
(* the parameters are stored as local variables. *)
- INC (i, NoOfParam (scope))
+ INC (i, NoOfParamAny (scope))
END ;
WHILE i <= n DO
AutoInitVariable (location, GetNth (scope, i)) ;
location : location_t ;
BEGIN
location := TokenToLocation(tokenno) ;
- IF GetNthParam(op2, op1)=NulSym
+ IF GetNthParamAny (op2, op1)=NulSym
THEN
(* We reach here if the argument is being passed to a C vararg function. *)
RETURN( Mod2Gcc(op3) )
ELSE
OperandType := SkipType(GetType(op3)) ;
- ParamType := SkipType(GetType(GetNthParam(op2, op1)))
+ ParamType := SkipType(GetType(GetNthParamAny (op2, op1)))
END ;
IF IsProcType(ParamType)
THEN
ELSE
IF StrictTypeChecking
THEN
- IF (nth <= NoOfParam (procedure))
+ IF (nth <= NoOfParamAny (procedure))
THEN
compatible := ParameterTypeCompatible (parampos,
'parameter incompatibility when attempting to pass actual parameter {%2ad} to a {%kVAR} formal parameter {%3Ead} during call to procedure {%1ad}',
- procedure, GetNthParam (procedure, nth),
- parameter, nth, IsVarParam (procedure, nth))
+ procedure, GetNthParamAny (procedure, nth),
+ parameter, nth, IsVarParamAny (procedure, nth))
END
END ;
- IF (nth <= NoOfParam (procedure)) AND
- IsVarParam (procedure, nth) AND IsConst (parameter)
+ IF (nth <= NoOfParamAny (procedure)) AND
+ IsVarParamAny (procedure, nth) AND IsConst (parameter)
THEN
MetaErrorT1 (parampos,
'cannot pass a constant {%1Ead} as a VAR parameter', parameter)
THEN
IF NOT IsAssignmentCompatible (t1, t2)
THEN
- MetaErrorT2 (virtpos,
- 'illegal assignment error between {%1Etad} and {%2tad}',
- des, expr) ;
+ ErrorMessageDecl (virtpos,
+ 'illegal assignment error between {%1Etad} and {%2tad}',
+ des, expr) ;
RETURN( FALSE )
END
END
THEN
RETURN Address
ELSE
- RETURN MixTypes (FindType (left), FindType (right), tokpos)
+ RETURN MixTypesDecl (left, right, FindType (left), FindType (right), tokpos)
END
END MixTypesBinary ;
is bug free. *)
IF NOT IsExpressionCompatible (lefttype, righttype)
THEN
- MetaErrorT2 (subexprpos,
- 'expression mismatch between {%1Etad} and {%2tad}',
- left, right) ;
+ ErrorMessageDecl (subexprpos,
+ 'expression mismatch between {%1Etad} and {%2tad}',
+ left, right) ;
NoChange := FALSE ;
SubQuad (quad) ;
p (des) ;
(* Now fall though and compare the set element left against the type of set righttype. *)
IF NOT IsExpressionCompatible (lefttype, righttype)
THEN
- MetaErrorT2 (subexprpos,
- 'the types used in expression {%1Etad} {%kIN} {%2tad} are incompatible',
- left, right) ;
+ ErrorMessageDecl (subexprpos,
+ 'the types used in expression {%1Etad} {%kIN} {%2tad} are incompatible',
+ left, right) ;
NoChange := FALSE ;
SubQuad (quad) ;
RETURN FALSE
varproc := Mod2Gcc(FromModuleGetSym(CurrentQuadToken, var, System)) ;
leftproc := Mod2Gcc(FromModuleGetSym(CurrentQuadToken, left, System)) ;
rightproc := Mod2Gcc(FromModuleGetSym(CurrentQuadToken, right, System)) ;
- unbounded := Mod2Gcc(GetType(GetNthParam(FromModuleGetSym(CurrentQuadToken,
+ unbounded := Mod2Gcc(GetType(GetNthParamAny (FromModuleGetSym(CurrentQuadToken,
var, System), 1))) ;
PushValue(GetTypeMax(SkipType(GetType(op1)))) ;
PushIntegerTree(BuildConvert(location, GetM2ZType(), PopIntegerTree(), FALSE)) ;
ELSE
ConvertBinaryOperands (location,
tl, tr,
- ComparisonMixTypes (SkipType (GetType (left)),
+ ComparisonMixTypes (left, right,
+ SkipType (GetType (left)),
SkipType (GetType (right)),
combined),
left, right) ;
ELSE
ConvertBinaryOperands(location,
tl, tr,
- ComparisonMixTypes (SkipType (GetType (left)),
+ ComparisonMixTypes (left, right,
+ SkipType (GetType (left)),
SkipType (GetType (right)),
combined),
left, right) ;
ELSE
ConvertBinaryOperands (location,
tl, tr,
- ComparisonMixTypes (SkipType (GetType (left)),
+ ComparisonMixTypes (left, right,
+ SkipType (GetType (left)),
SkipType (GetType (right)),
combined),
left, right) ;
ELSE
ConvertBinaryOperands(location,
tl, tr,
- ComparisonMixTypes (SkipType (GetType (left)),
+ ComparisonMixTypes (left, right,
+ SkipType (GetType (left)),
SkipType (GetType (right)),
combined),
left, right) ;
ComparisonMixTypes -
*)
-PROCEDURE ComparisonMixTypes (left, right: CARDINAL; tokpos: CARDINAL) : CARDINAL ;
+PROCEDURE ComparisonMixTypes (varleft, varright, left, right: CARDINAL; tokpos: CARDINAL) : CARDINAL ;
BEGIN
IF IsGenericSystemType (left)
THEN
THEN
RETURN right
ELSE
- RETURN MixTypes (left, right, tokpos)
+ RETURN MixTypesDecl (varleft, varright, left, right, tokpos)
END
END ComparisonMixTypes ;
ELSE
ConvertBinaryOperands (location,
tl, tr,
- ComparisonMixTypes (SkipType (GetType (left)),
+ ComparisonMixTypes (left, right,
+ SkipType (GetType (left)),
SkipType (GetType (right)),
combined),
left, right) ;
ELSE
ConvertBinaryOperands (location,
tl, tr,
- ComparisonMixTypes (SkipType (GetType (left)),
+ ComparisonMixTypes (left, right,
+ SkipType (GetType (left)),
SkipType (GetType (right)),
combined),
left, right) ;
DEFINITION MODULE M2MetaError ;
-(*
- Title : M2MetaError
- Author : Gaius Mulley
- System : GNU Modula-2
- Date : Tue Oct 14 12:11:13 2008
- Revision : $Version$
- Description: provides a set of high level error routines. These
- routines utilise M2Error and provides the programmer
- with an easier method to obtain useful symbol table
- information.
-*)
+(* Provides a set of high level error routines using format specifiers. *)
FROM DynamicStrings IMPORT String ;
FROM NameKey IMPORT Name ;
-EXPORT QUALIFIED MetaError0, MetaError1, MetaError2, MetaError3, MetaError4,
- MetaErrors1, MetaErrors2, MetaErrors3, MetaErrors4,
- MetaErrorT0, MetaErrorT1, MetaErrorT2, MetaErrorT3, MetaErrorT4,
- MetaErrorsT1, MetaErrorsT2, MetaErrorsT3, MetaErrorsT4,
- MetaErrorString0,
- MetaErrorString1, MetaErrorString2, MetaErrorString3,
- MetaErrorString4,
- MetaErrorStringT0, MetaErrorStringT1, MetaErrorStringT2,
- MetaErrorStringT3, MetaErrorStringT4,
- MetaErrorN1, MetaErrorN2, MetaErrorNT0, MetaErrorNT1, MetaErrorNT2,
- MetaString0, MetaString1, MetaString2, MetaString3, MetaString4 ;
-
(*
All the procedures below expect the s, s1, s2, s3, s4 to be symbols
PROCEDURE MetaString3 (m: String; s1, s2, s3: CARDINAL) : String ;
PROCEDURE MetaString4 (m: String; s1, s2, s3, s4: CARDINAL) : String ;
+
+(*
+ MetaErrorDecl - if sym is a variable or parameter then generate a
+ declaration error message.
+*)
+
+PROCEDURE MetaErrorDecl (sym: CARDINAL) ;
+
+
END M2MetaError.
IsDefImp, IsModule, IsInnerModule,
IsUnknown, IsType, IsProcedure, IsParameter,
IsParameterUnbounded, IsParameterVar, IsVarParam,
- IsUnboundedParam, IsPointer, IsRecord, IsVarient,
+ IsUnboundedParamAny, IsPointer, IsRecord, IsVarient,
IsFieldVarient, IsEnumeration, IsFieldEnumeration,
IsUnbounded, IsArray, IsRecordField, IsProcType,
IsVar, IsConst, IsConstString, IsConstLit, IsConstSet,
END MetaString4 ;
+(*
+ MetaErrorDecl - if sym is a variable or parameter then generate a
+ declaration error message.
+*)
+
+PROCEDURE MetaErrorDecl (sym: CARDINAL) ;
+BEGIN
+ IF (sym # NulSym) AND IsVar (sym)
+ THEN
+ IF IsVarAParam (sym)
+ THEN
+ MetaErrorT1 (GetVarDeclFullTok (sym), 'parameter declaration for {%1ad}', sym)
+ ELSE
+ MetaErrorT1 (GetVarDeclFullTok (sym), 'variable declaration for {%1ad}', sym)
+ END
+ END
+END MetaErrorDecl ;
+
+
BEGIN
lastRoot := NIL ;
lastColor := noColor ;
(*
SetCompilerDebugging - turn on internal compiler debugging.
+ Enabled via the command line option -fd.
*)
PROCEDURE SetCompilerDebugging (value: BOOLEAN) ;
(*
SetCompilerDebugging - turn on internal compiler debugging.
+ Enabled via the command line option -fd.
*)
PROCEDURE SetCompilerDebugging (value: BOOLEAN) ;
MetaErrorT0, MetaErrorT1, MetaErrorT2,
MetaErrorsT1, MetaErrorsT2, MetaErrorT3,
MetaErrorStringT0, MetaErrorStringT1,
+ MetaErrorStringT2,
MetaErrorString1, MetaErrorString2,
MetaErrorN1, MetaErrorN2,
MetaErrorNT0, MetaErrorNT1, MetaErrorNT2 ;
InitStringCharDB, MultDB, DupDB, SliceDB ;
FROM SymbolTable IMPORT ModeOfAddr, GetMode, PutMode, GetSymName, IsUnknown,
- MakeTemporary,
+ MakeTemporary, ProcedureKind,
MakeTemporaryFromExpression,
MakeTemporaryFromExpressions,
MakeConstLit,
GetStringLength, GetString,
GetArraySubscript, GetDimension,
GetParam,
- GetNth, GetNthParam,
+ GetNth, GetNthParamAny,
GetFirstUsed, GetDeclaredMod,
GetQuads, GetReadQuads, GetWriteQuads,
GetWriteLimitQuads, GetReadLimitQuads,
PutVarConst, IsVarConst,
PutConstLitInternal,
PutVarHeap,
- IsVarParam, IsProcedure, IsPointer, IsParameter,
- IsUnboundedParam, IsEnumeration, IsDefinitionForC,
+ IsVarParamAny, IsProcedure, IsPointer, IsParameter,
+ IsUnboundedParamAny, IsEnumeration, IsDefinitionForC,
IsVarAParam, IsVarient, IsLegal,
- UsesVarArgs, UsesOptArg,
+ UsesVarArgs, UsesOptArgAny,
GetOptArgInit,
- IsReturnOptional,
+ IsReturnOptionalAny,
NoOfElements,
- NoOfParam,
+ NoOfParamAny,
StartScope, EndScope,
IsGnuAsm, IsGnuAsmVolatile,
MakeRegInterface, PutRegInterface,
GetUnboundedAddressOffset,
GetUnboundedHighOffset,
PutVarArrayRef,
+ PutProcedureDefined,
+ PutProcedureParametersDefined,
+ GetVarDeclFullTok,
ForeachFieldEnumerationDo, ForeachLocalSymDo,
GetExported, PutImported, GetSym, GetLibName,
CONST
DebugStackOn = TRUE ;
DebugVarients = FALSE ;
- BreakAtQuad = 200 ;
+ BreakAtQuad = 758 ;
DebugTokPos = FALSE ;
TYPE
VAR
f: QuadFrame ;
BEGIN
- IF QuadNo = BreakAtQuad
- THEN
- stop
- END ;
IF QuadrupleGeneration
THEN
EraseQuad (QuadNo) ;
ParamOp : CheckAddVariableRead(Oper2, FALSE, QuadNo) ;
CheckAddVariableRead(Oper3, FALSE, QuadNo) ;
- IF (Oper1>0) AND (Oper1<=NoOfParam(Oper2)) AND
- IsVarParam(Oper2, Oper1)
+ IF (Oper1>0) AND (Oper1<=NoOfParamAny(Oper2)) AND
+ IsVarParamAny (Oper2, Oper1)
THEN
(* _may_ also write to a var parameter, although we dont know *)
CheckAddVariableWrite(Oper3, TRUE, QuadNo)
PROCEDURE stop ; BEGIN END stop ;
+(*
+ CheckBreak - check whether QuadNo = BreakAtQuad and if so call stop.
+*)
+
+PROCEDURE CheckBreak (QuadNo: CARDINAL) ;
+BEGIN
+ IF QuadNo = BreakAtQuad
+ THEN
+ stop
+ END
+END CheckBreak ;
+
+
(*
PutQuadO - alters a quadruple QuadNo with Op, Oper1, Oper2, Oper3, and
sets a boolean to determinine whether overflow should be checked.
VAR
f: QuadFrame ;
BEGIN
- IF QuadNo = BreakAtQuad
- THEN
- stop
- END ;
IF QuadrupleGeneration
THEN
EraseQuad (QuadNo) ;
KillLocalVarOp : |
ParamOp : CheckRemoveVariableRead(Oper2, FALSE, QuadNo) ;
CheckRemoveVariableRead(Oper3, FALSE, QuadNo) ;
- IF (Oper1>0) AND (Oper1<=NoOfParam(Oper2)) AND
- IsVarParam(Oper2, Oper1)
+ IF (Oper1>0) AND (Oper1<=NoOfParamAny(Oper2)) AND
+ IsVarParamAny (Oper2, Oper1)
THEN
(* _may_ also write to a var parameter, although we dont know *)
CheckRemoveVariableWrite(Oper3, TRUE, QuadNo)
VAR
f: QuadFrame ;
BEGIN
+ CheckBreak (QuadNo) ;
f := GetQF(QuadNo) ;
WITH f^ DO
UndoReadWriteInfo(QuadNo, Operator, Operand1, Operand2, Operand3) ;
i : CARDINAL ;
f, g: QuadFrame ;
BEGIN
- IF QuadNo = BreakAtQuad
- THEN
- stop
- END ;
+ CheckBreak (QuadNo) ;
f := GetQF(QuadNo) ;
WITH f^ DO
AlterReference(Head, QuadNo, f^.Next) ;
f := GetQF(q) ;
IF (f^.Operand3#0) AND (f^.Operand3<NextQuad)
THEN
- IF f^.Operand3 = BreakAtQuad
- THEN
- stop
- END ;
+ CheckBreak (f^.Operand3) ;
g := GetQF(f^.Operand3) ;
Assert(g^.NoOfTimesReferenced#0) ;
DEC(g^.NoOfTimesReferenced)
IF GetSType (Proc) # NulSym
THEN
(* however it was declared as a procedure function *)
- IF NOT IsReturnOptional (Proc)
+ IF NOT IsReturnOptionalAny (Proc)
THEN
MetaErrors1 ('function {%1a} is being called but its return value is ignored',
'function {%1Da} return a type {%1ta:of {%1ta}}',
THEN
GenQuad (ParamOp, 0, Proc, ProcSym) (* Space for return value *)
END ;
- IF (NoOfParameters+1=NoOfParam(Proc)) AND UsesOptArg(Proc)
+ IF (NoOfParameters+1=NoOfParamAny(Proc)) AND UsesOptArgAny (Proc)
THEN
- GenQuad (OptParamOp, NoOfParam(Proc), Proc, Proc)
+ GenQuad (OptParamOp, NoOfParamAny (Proc), Proc, Proc)
END ;
i := NoOfParameters ;
pi := 1 ; (* stack index referencing stacked parameter, i *)
i := 1 ;
pi := ParamTotal+1 ; (* stack index referencing stacked parameter, i *)
WHILE i<=ParamTotal DO
- IF i<=NoOfParam(Proc)
+ IF i <= NoOfParamAny (Proc)
THEN
FormalI := GetParam(Proc, i) ;
IF CompilerDebugging
BuildRange (InitTypesParameterCheck (paramtok, Proc, i, FormalI, Actual)) ;
IF IsConst(Actual)
THEN
- IF IsVarParam(Proc, i)
+ IF IsVarParamAny (Proc, i)
THEN
FailParameter (paramtok,
'trying to pass a constant to a VAR parameter',
- Actual, FormalI, Proc, i)
+ Actual, Proc, i)
ELSIF IsConstString (Actual)
THEN
IF (NOT IsConstStringKnown (Actual))
ELSIF (GetStringLength(paramtok, Actual) = 1) (* If = 1 then it maybe treated as a char. *)
THEN
CheckParameter (paramtok, Actual, Dim, FormalI, Proc, i, NIL)
- ELSIF NOT IsUnboundedParam(Proc, i)
+ ELSIF NOT IsUnboundedParamAny (Proc, i)
THEN
IF IsForC AND (GetSType(FormalI)=Address)
THEN
FailParameter (paramtok,
'a string constant can either be passed to an ADDRESS parameter or an ARRAY OF CHAR',
- Actual, FormalI, Proc, i)
+ Actual, Proc, i)
ELSE
FailParameter (paramtok,
'cannot pass a string constant to a non unbounded array parameter',
- Actual, FormalI, Proc, i)
+ Actual, Proc, i)
END
END
END
CheckedProcedure: CARDINAL ;
e : Error ;
BEGIN
- n := NoOfParam(ProcType) ;
+ n := NoOfParamAny (ProcType) ;
IF IsVar(call) OR IsTemporary(call) OR IsParameter(call)
THEN
CheckedProcedure := GetDType(call)
ELSE
CheckedProcedure := call
END ;
- IF n#NoOfParam(CheckedProcedure)
+ IF n # NoOfParamAny (CheckedProcedure)
THEN
e := NewError(GetDeclaredMod(ProcType)) ;
n1 := GetSymName(call) ;
ErrorFormat2(e, 'procedure (%a) is a parameter being passed as variable (%a) but they are declared with different number of parameters',
n1, n2) ;
e := ChainError(GetDeclaredMod(call), e) ;
- t := NoOfParam(CheckedProcedure) ;
+ t := NoOfParamAny (CheckedProcedure) ;
IF n<2
THEN
ErrorFormat3(e, 'procedure (%a) is being called incorrectly with (%d) parameter, declared with (%d)',
ELSE
i := 1 ;
WHILE i<=n DO
- IF IsVarParam (ProcType, i) # IsVarParam (CheckedProcedure, i)
+ IF IsVarParamAny (ProcType, i) # IsVarParamAny (CheckedProcedure, i)
THEN
MetaError3 ('parameter {%3n} in {%1dD} causes a mismatch it was declared as a {%2d}', ProcType, GetNth (ProcType, i), i) ;
MetaError3 ('parameter {%3n} in {%1dD} causes a mismatch it was declared as a {%2d}', call, GetNth (call, i), i)
ELSE
FailParameter(tokpos,
'attempting to pass an array with the incorrect number dimenisons to an unbounded formal parameter of different dimensions',
- Actual, Formal, ProcSym, i) ;
+ Actual, ProcSym, i) ;
RETURN( FALSE )
END
END
ELSE
FailParameter(tokpos,
'attempting to pass an unbounded array with the incorrect number dimenisons to an unbounded formal parameter of different dimensions',
- Actual, Formal, ProcSym, i) ;
+ Actual, ProcSym, i) ;
RETURN( FALSE )
END
END
ELSE
FailParameter(tokpos,
'identifier with an incompatible type is being passed to this procedure',
- Actual, Formal, ProcSym, i) ;
+ Actual, ProcSym, i) ;
RETURN( FALSE )
END
END LegalUnboundedParam ;
THEN
FailParameter(tokpos,
'expecting a procedure or procedure variable as a parameter',
- Actual, Formal, ProcSym, i) ;
+ Actual, ProcSym, i) ;
RETURN
END ;
IF IsProcedure(Actual) AND IsProcedureNested(Actual)
THEN
FailParameter(tokpos,
'the item being passed is a function whereas the formal procedure parameter is a procedure',
- Actual, Formal, ProcSym, i) ;
+ Actual, ProcSym, i) ;
RETURN
ELSIF ((GetSType(ActualType)=NulSym) AND (GetSType(FormalType)#NulSym))
THEN
FailParameter(tokpos,
'the item being passed is a procedure whereas the formal procedure parameter is a function',
- Actual, Formal, ProcSym, i) ;
+ Actual, ProcSym, i) ;
RETURN
ELSIF AssignmentRequiresWarning(GetSType(ActualType), GetSType(FormalType))
THEN
WarnParameter(tokpos,
'the return result of the procedure variable parameter may not be compatible on other targets with the return result of the item being passed',
- Actual, Formal, ProcSym, i) ;
+ Actual, ProcSym, i) ;
RETURN
ELSIF IsGenericSystemType (GetSType(FormalType)) OR
IsGenericSystemType (GetSType(ActualType)) OR
ELSE
FailParameter(tokpos,
'the return result of the procedure variable parameter is not compatible with the return result of the item being passed',
- Actual, Formal, ProcSym, i) ;
+ Actual, ProcSym, i) ;
RETURN
END
END ;
THEN
FailParameter(tokpos,
'procedure parameter type is undeclared',
- Actual, Formal, ProcSym, i) ;
+ Actual, ProcSym, i) ;
RETURN
END ;
- IF IsUnbounded(ActualType) AND (NOT IsUnboundedParam(ProcSym, i))
+ IF IsUnbounded(ActualType) AND (NOT IsUnboundedParamAny (ProcSym, i))
THEN
FailParameter(tokpos,
'attempting to pass an unbounded array to a NON unbounded parameter',
- Actual, Formal, ProcSym, i) ;
+ Actual, ProcSym, i) ;
RETURN
- ELSIF IsUnboundedParam(ProcSym, i)
+ ELSIF IsUnboundedParamAny (ProcSym, i)
THEN
IF NOT LegalUnboundedParam(tokpos, ProcSym, i, ActualType, Actual, Dimension, Formal)
THEN
THEN
WarnParameter (tokpos,
'identifier being passed to this procedure may contain a possibly incompatible type when compiling for a different target',
- Actual, Formal, ProcSym, i)
+ Actual, ProcSym, i)
ELSIF IsGenericSystemType (FormalType) OR
IsGenericSystemType (ActualType) OR
IsAssignmentCompatible (ActualType, FormalType)
ELSE
FailParameter (tokpos,
'identifier with an incompatible type is being passed to this procedure',
- Actual, Formal, ProcSym, i)
+ Actual, ProcSym, i)
END
END
END ;
The parameters are:
CurrentState - string describing the current failing state.
- Given - the token that the source code provided.
- Expecting - token or identifier that was expected.
+ Actual - actual parameter.
ParameterNo - parameter number that has failed.
ProcedureSym - procedure symbol where parameter has failed.
PROCEDURE FailParameter (tokpos : CARDINAL;
CurrentState : ARRAY OF CHAR;
- Given : CARDINAL;
- Expecting : CARDINAL;
+ Actual : CARDINAL;
ProcedureSym : CARDINAL;
ParameterNo : CARDINAL) ;
VAR
- First,
- ExpectType: CARDINAL ;
- s, s1, s2 : String ;
+ FormalParam: CARDINAL ;
+ Msg : String ;
BEGIN
- MetaErrorT2 (tokpos,
- 'parameter mismatch between the {%2N} parameter of procedure {%1Ead}',
- ProcedureSym, ParameterNo) ;
- s := InitString ('{%kPROCEDURE} {%1Eau} (') ;
- IF NoOfParam(ProcedureSym)>=ParameterNo
+ Msg := InitString ('parameter mismatch between the {%2N} parameter of procedure {%1Ead}, ') ;
+ Msg := ConCat (Msg, Mark (InitString (CurrentState))) ;
+ MetaErrorStringT2 (tokpos, Msg, ProcedureSym, ParameterNo) ;
+ IF NoOfParamAny (ProcedureSym) >= ParameterNo
THEN
- IF ParameterNo>1
- THEN
- s := ConCat(s, Mark(InitString('.., ')))
- END ;
- IF IsVarParam(ProcedureSym, ParameterNo)
- THEN
- s := ConCat(s, Mark(InitString('{%kVAR} ')))
- END ;
-
- First := GetDeclaredMod(GetNthParam(ProcedureSym, ParameterNo)) ;
- ExpectType := GetSType(Expecting) ;
- IF IsUnboundedParam(ProcedureSym, ParameterNo)
+ FormalParam := GetNthParamAny (ProcedureSym, ParameterNo) ;
+ IF IsUnboundedParamAny (ProcedureSym, ParameterNo)
THEN
- s1 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(Expecting)))) ;
- s2 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(GetSType(ExpectType))))) ;
- s := ConCat(s, Mark(Sprintf2(Mark(InitString('%s: {%%kARRAY} {%%kOF} %s')),
- s1, s2)))
+ MetaErrorT2 (GetVarDeclFullTok (FormalParam), 'formal parameter {%1ad} has an open array type {%2tad}',
+ FormalParam, GetSType (GetSType (FormalParam)))
ELSE
- s1 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(Expecting)))) ;
- s2 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(ExpectType)))) ;
- s := ConCat(s, Mark(Sprintf2(Mark(InitString('%s: %s')), s1, s2)))
- END ;
- IF ParameterNo<NoOfParam(ProcedureSym)
- THEN
- s := ConCat(s, Mark(InitString('; ... ')))
+ MetaErrorT1 (GetVarDeclFullTok (FormalParam), 'formal parameter {%1ad} has type {%1tad}', FormalParam)
END
ELSE
- First := GetDeclaredMod(ProcedureSym) ;
- IF NoOfParam(ProcedureSym)>0
- THEN
- s := ConCat(s, Mark(InitString('..')))
- END
+ MetaErrorT1 (GetDeclaredMod (ProcedureSym), 'procedure declaration', ProcedureSym)
END ;
- s := ConCat (s, Mark (InitString ('){%1Tau:% : {%1Tau}} ;'))) ;
- MetaErrorStringT1 (First, Dup (s), ProcedureSym) ;
- MetaErrorStringT1 (tokpos, s, ProcedureSym) ;
- IF GetLType (Given) = NulSym
+ IF GetLType (Actual) = NulSym
THEN
- MetaError1 ('item being passed is {%1EDda} {%1Dad}', Given)
+ MetaError1 ('actual parameter being passed is {%1Eda} {%1ad}', Actual)
ELSE
- MetaError1 ('item being passed is {%1EDda} {%1Dad} of type {%1Dts}',
- Given)
+ IF IsVar (Actual)
+ THEN
+ MetaErrorT1 (GetVarDeclFullTok (Actual),
+ 'actual parameter variable being passed is {%1Eda} {%1ad} of an incompatible type {%1ts}',
+ Actual)
+ ELSE
+ MetaErrorT1 (tokpos,
+ 'actual parameter being passed is {%1Eda} {%1ad} of an incompatible type {%1ts}',
+ Actual)
+ END
END
END FailParameter ;
WarnParameter - generates a warning message indicating that a parameter
use might cause problems on another target.
- The parameters are:
-
CurrentState - string describing the current failing state.
- Given - the token that the source code provided.
- Expecting - token or identifier that was expected.
+ Actual - actual parameter.
ParameterNo - parameter number that has failed.
ProcedureSym - procedure symbol where parameter has failed.
PROCEDURE WarnParameter (tokpos : CARDINAL;
CurrentState : ARRAY OF CHAR;
- Given : CARDINAL;
- Expecting : CARDINAL;
+ Actual : CARDINAL;
ProcedureSym : CARDINAL;
ParameterNo : CARDINAL) ;
VAR
- First,
- ExpectType,
- ReturnType: CARDINAL ;
- s, s1, s2 : String ;
+ FormalParam: CARDINAL ;
+ Msg : String ;
BEGIN
- s := InitString('{%W}') ;
- IF CompilingImplementationModule()
+ Msg := InitString ('{%W}parameter mismatch between the {%2N} parameter of procedure {%1ad}, ') ;
+ Msg := ConCat (Msg, Mark (InitString (CurrentState))) ;
+ MetaErrorStringT2 (tokpos, Msg, ProcedureSym, ParameterNo) ;
+ IF NoOfParamAny (ProcedureSym) >= ParameterNo
THEN
- s := ConCat(s, Sprintf0(Mark(InitString('warning issued while compiling the implementation module\n'))))
- ELSIF CompilingProgramModule()
- THEN
- s := ConCat(s, Sprintf0(Mark(InitString('warning issued while compiling the program module\n'))))
- END ;
- s1 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(ProcedureSym)))) ;
- s := ConCat(s, Mark(Sprintf2(Mark(InitString('problem in parameter %d, PROCEDURE %s (')),
- ParameterNo,
- s1))) ;
- IF NoOfParam(ProcedureSym)>=ParameterNo
- THEN
- IF ParameterNo>1
+ FormalParam := GetNthParamAny (ProcedureSym, ParameterNo) ;
+ IF IsUnboundedParamAny (ProcedureSym, ParameterNo)
THEN
- s := ConCat(s, Mark(InitString('.., ')))
- END ;
- IF IsVarParam(ProcedureSym, ParameterNo)
- THEN
- s := ConCat(s, Mark(InitString('{%kVAR} ')))
- END ;
-
- First := GetDeclaredMod(GetNthParam(ProcedureSym, ParameterNo)) ;
- ExpectType := GetSType(Expecting) ;
- IF IsUnboundedParam(ProcedureSym, ParameterNo)
- THEN
- s1 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(Expecting)))) ;
- s2 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(GetSType(ExpectType))))) ;
- s := ConCat(s, Mark(Sprintf2(Mark(InitString('%s: {%%kARRAY} {%%kOF} %s')),
- s1, s2)))
+ MetaErrorT2 (GetVarDeclFullTok (FormalParam), '{%W}formal parameter {%1ad} has an open array type {%2tad}',
+ FormalParam, GetSType (GetSType (FormalParam)))
ELSE
- s1 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(Expecting)))) ;
- s2 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(ExpectType)))) ;
- s := ConCat(s, Mark(Sprintf2(Mark(InitString('%s: %s')), s1, s2)))
- END ;
- IF ParameterNo<NoOfParam(ProcedureSym)
- THEN
- s := ConCat(s, Mark(InitString('; ... ')))
+ MetaErrorT1 (GetVarDeclFullTok (FormalParam), '{%W}formal parameter {%1ad} has type {%1tad}', FormalParam)
END
ELSE
- First := GetDeclaredMod(ProcedureSym) ;
- IF NoOfParam(ProcedureSym)>0
- THEN
- s := ConCat(s, Mark(InitString('..')))
- END
+ MetaErrorT1 (GetDeclaredMod (ProcedureSym), '{%W}procedure declaration', ProcedureSym)
END ;
- ReturnType := GetSType(ProcedureSym) ;
- IF ReturnType=NulSym
+ IF GetLType (Actual) = NulSym
THEN
- s := ConCat(s, Sprintf0(Mark(InitString(') ;\n'))))
+ MetaError1 ('actual parameter being passed is {%1Wda} {%1ad}', Actual)
ELSE
- s1 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(ReturnType)))) ;
- s := ConCat(s, Mark(Sprintf1(Mark(InitString(') : %s ;\n')), s1)))
- END ;
- IF IsConstString(Given)
- THEN
- s1 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(Given)))) ;
- s := ConCat(s, Mark(Sprintf1(Mark(InitString("item being passed is '%s'")),
- s1)))
- ELSIF IsTemporary(Given)
- THEN
- s := ConCat(s, Mark(InitString("item being passed has type")))
- ELSE
- s1 := Mark(InitStringCharStar(KeyToCharStar(GetSymName(Given)))) ;
- s := ConCat(s, Mark(Sprintf1(Mark(InitString("item being passed is '%s'")),
- s1)))
- END ;
- s1 := DescribeType(Given) ;
- s2 := Mark(InitString(CurrentState)) ;
- s := ConCat(s, Mark(Sprintf2(Mark(InitString(': %s\nparameter mismatch: %s')),
- s1, s2))) ;
- MetaErrorStringT0 (tokpos, Dup (s)) ;
- MetaErrorStringT0 (First, Dup (s))
+ IF IsVar (Actual)
+ THEN
+ MetaErrorT1 (GetVarDeclFullTok (Actual),
+ 'actual parameter variable being passed is {%1Wda} {%1ad} of type {%1ts}',
+ Actual)
+ ELSE
+ MetaErrorT1 (tokpos,
+ 'actual parameter being passed is {%1Wda} {%1ad} of type {%1ts}',
+ Actual)
+ END
+ END
END WarnParameter ;
IF IsForC AND UsesVarArgs(Proc)
THEN
- IF NoOfParameters<NoOfParam(Proc)
+ IF NoOfParameters < NoOfParamAny (Proc)
THEN
s := Mark(InitStringCharStar(KeyToCharStar(GetSymName(Proc)))) ;
- np := NoOfParam(Proc) ;
+ np := NoOfParamAny (Proc) ;
ErrorStringAt2(Sprintf3(Mark(InitString('attempting to pass (%d) parameters to procedure (%s) which was declared with varargs but contains at least (%d) parameters')),
NoOfParameters, s, np),
tokpos, GetDeclaredMod(ProcSym))
END
- ELSIF UsesOptArg(Proc)
+ ELSIF UsesOptArgAny (Proc)
THEN
- IF NOT ((NoOfParameters=NoOfParam(Proc)) OR (NoOfParameters+1=NoOfParam(Proc)))
+ IF NOT ((NoOfParameters=NoOfParamAny (Proc)) OR (NoOfParameters+1=NoOfParamAny (Proc)))
THEN
s := Mark(InitStringCharStar(KeyToCharStar(GetSymName(Proc)))) ;
- np := NoOfParam(Proc) ;
+ np := NoOfParamAny (Proc) ;
ErrorStringAt2(Sprintf3(Mark(InitString('attempting to pass (%d) parameters to procedure (%s) which was declared with an optarg with a maximum of (%d) parameters')),
NoOfParameters, s, np),
tokpos, GetDeclaredMod(ProcSym))
END
- ELSIF NoOfParameters#NoOfParam(Proc)
+ ELSIF NoOfParameters#NoOfParamAny (Proc)
THEN
s := Mark(InitStringCharStar(KeyToCharStar(GetSymName(Proc)))) ;
- np := NoOfParam(Proc) ;
+ np := NoOfParamAny (Proc) ;
ErrorStringAt2(Sprintf3(Mark(InitString('attempting to pass (%d) parameters to procedure (%s) which was declared with (%d) parameters')),
NoOfParameters, s, np),
tokpos, GetDeclaredMod(ProcSym))
f := PeepAddress(BoolStack, pi) ;
rw := OperandMergeRW(pi) ;
Assert(IsLegal(rw)) ;
- IF i>NoOfParam(Proc)
+ IF i>NoOfParamAny (Proc)
THEN
IF IsForC AND UsesVarArgs(Proc)
THEN
'attempting to pass too many parameters to procedure {%1a}, the {%2N} parameter does not exist',
Proc, i)
END
- ELSIF IsForC AND IsUnboundedParam(Proc, i) AND
+ ELSIF IsForC AND IsUnboundedParamAny (Proc, i) AND
(GetSType(OperandT(pi))#NulSym) AND IsArray(GetDType(OperandT(pi)))
THEN
f^.TrueExit := MakeLeftValue(OperandTok(pi), OperandT(pi), RightValue, Address) ;
MarkAsReadWrite(rw)
- ELSIF IsForC AND IsUnboundedParam(Proc, i) AND
+ ELSIF IsForC AND IsUnboundedParamAny (Proc, i) AND
(GetSType(OperandT(pi))#NulSym) AND IsUnbounded(GetDType(OperandT(pi)))
THEN
MarkAsReadWrite(rw) ;
BuildAdrFunction ;
PopT(f^.TrueExit)
ELSIF IsForC AND IsConstString(OperandT(pi)) AND
- (IsUnboundedParam(Proc, i) OR (GetDType(GetParam(Proc, i))=Address))
+ (IsUnboundedParamAny (Proc, i) OR (GetDType(GetParam(Proc, i))=Address))
THEN
f^.TrueExit := MakeLeftValue (OperandTok (pi),
DeferMakeConstStringCnul (OperandTok (pi), OperandT (pi)),
RightValue, Address) ;
MarkAsReadWrite (rw)
- ELSIF IsUnboundedParam(Proc, i)
+ ELSIF IsUnboundedParamAny (Proc, i)
THEN
(* always pass constant strings with a nul terminator, but leave the HIGH as before. *)
IF IsConstString (OperandT(pi))
ELSE
ArraySym := OperandA(pi)
END ;
- IF IsVarParam(Proc, i)
+ IF IsVarParamAny (Proc, i)
THEN
MarkArrayWritten (OperandT (pi)) ;
MarkArrayWritten (OperandA (pi)) ;
AssignUnboundedNonVar (OperandTtok (pi), OperandT (pi), ArraySym, t, ParamType, OperandD (pi))
END ;
f^.TrueExit := t
- ELSIF IsVarParam(Proc, i)
+ ELSIF IsVarParamAny (Proc, i)
THEN
(* must reference by address, but we contain the type of the referenced entity *)
MarkArrayWritten(OperandT(pi)) ;
MarkArrayWritten(OperandA(pi)) ;
MarkAsReadWrite(rw) ;
f^.TrueExit := MakeLeftValue(OperandTok(pi), OperandT(pi), LeftValue, GetSType(GetParam(Proc, i)))
- ELSIF (NOT IsVarParam(Proc, i)) AND (GetMode(OperandT(pi))=LeftValue)
+ ELSIF (NOT IsVarParamAny (Proc, i)) AND (GetMode(OperandT(pi))=LeftValue)
THEN
(* must dereference LeftValue *)
t := MakeTemporary (OperandTok (pi), RightValue) ;
i := 1 ;
pi := ParamTotal+1 ; (* stack index referencing stacked parameter, i *)
WHILE i<=ParamTotal DO
- IF i<=NoOfParam(Proc)
+ IF i<=NoOfParamAny (Proc)
THEN
FormalI := GetParam (Proc, i) ;
Actual := OperandT (pi) ;
PROCEDURE CheckBuildFunction () : BOOLEAN ;
VAR
- n : Name ;
tokpos,
TempSym,
ProcSym, Type: CARDINAL ;
PutVar(TempSym, GetSType(Type)) ;
PushTFtok(TempSym, GetSType(Type), tokpos) ;
PushTFtok(ProcSym, Type, tokpos) ;
- IF NOT IsReturnOptional(Type)
+ IF NOT IsReturnOptionalAny (Type)
THEN
- IF IsTemporary(ProcSym)
- THEN
- ErrorFormat0 (NewError (tokpos),
- 'function is being called but its return value is ignored')
- ELSE
- n := GetSymName (ProcSym) ;
- ErrorFormat1 (NewError (tokpos),
- 'function (%a) is being called but its return value is ignored', n)
- END
+ MetaErrorT1 (tokpos,
+ 'function {%1Ea} is called but its return value is ignored', ProcSym)
END ;
RETURN TRUE
END
PutVar(TempSym, Type) ;
PushTFtok(TempSym, Type, tokpos) ;
PushTFtok(ProcSym, Type, tokpos) ;
- IF NOT IsReturnOptional(ProcSym)
+ IF NOT IsReturnOptionalAny (ProcSym)
THEN
- n := GetSymName(ProcSym) ;
- ErrorFormat1(NewError(tokpos),
- 'function (%a) is being called but its return value is ignored', n)
+ MetaErrorT1 (tokpos,
+ 'function {%1Ea} is called but its return value is ignored', ProcSym)
END ;
RETURN TRUE
END ;
BEGIN
IF IsProcedure(BlockSym)
THEN
- ParamNo := NoOfParam(BlockSym)
+ ParamNo := NoOfParamAny (BlockSym)
ELSE
ParamNo := 0
END ;
GenQuad(ReturnOp, NulSym, NulSym, ProcSym) ;
CheckFunctionReturn(ProcSym) ;
CheckVariablesInBlock(ProcSym) ;
+ (* Call PutProcedureEndQuad so that any runtime procedure will be
+ seen as defined even if it not seen during pass 2 (which will also
+ call PutProcedureEndQuad). *)
+ PutProcedureParametersDefined (ProcSym, ProperProcedure) ;
+ PutProcedureDefined (ProcSym, ProperProcedure) ;
RemoveTop (CatchStack) ;
RemoveTop (TryStack) ;
PushT(ProcSym)
(* MetaErrorT1 (TokenNo, '{%1On}', NextQuad) *)
END
END ;
- IF NextQuad=BreakAtQuad
- THEN
- stop
- END ;
+ CheckBreak (NextQuad) ;
NewQuad (NextQuad)
END
END GenQuadOTrash ;
(* MetaErrorT1 (TokenNo, '{%1On}', NextQuad) *)
END
END ;
- IF NextQuad=BreakAtQuad
- THEN
- stop
- END ;
+ CheckBreak (NextQuad) ;
NewQuad (NextQuad)
END
END GenQuadOTypetok ;
ProcedureScopeOp : n1 := GetSymName(Operand2) ;
n2 := GetSymName(Operand3) ;
- fprintf3 (GetDumpFile (), ' %4d %a %a', Operand1, n1, n2) ;
+ fprintf4 (GetDumpFile (), ' %4d %a %a(%d)', Operand1, n1, n2, Operand3) ;
DisplayProcedureAttributes (Operand3) |
NewLocalVarOp,
FinallyStartOp,
IsRecord, IsPointer, IsArray, IsProcType, IsConstLit,
IsAModula2Type, IsUnbounded, IsEnumeration, GetMode,
IsConstString, MakeConstLit, SkipType, IsProcedure,
- IsParameter, GetDeclaredMod, IsVarParam, GetNthParam,
+ IsParameter, GetDeclaredMod, IsVarParamAny, GetNthParam,
ModeOfAddr ;
FROM SYSTEM IMPORT ADDRESS ;
compatible: BOOLEAN ;
BEGIN
compatible := FALSE ;
- IF IsVarParam (procedure, paramNo)
+ IF IsVarParamAny (procedure, paramNo)
THEN
(* Expression type compatibility rules for pass by reference parameters. *)
compatible := ParameterTypeCompatible (tokenNo,
BEGIN
IF NOT ParameterTypeCompatible (tokenNo,
'{%4EN} type failure between actual {%3ad} and the formal {%2ad}',
- procedure, formal, actual, paramNo, IsVarParam (procedure, paramNo))
+ procedure, formal, actual, paramNo, IsVarParamAny (procedure, paramNo))
THEN
END
END CodeTypeParam ;
IMPLEMENTATION MODULE M2Scaffold ;
-FROM SymbolTable IMPORT NulSym, MakeProcedure, PutFunction,
+FROM SymbolTable IMPORT NulSym, ProcedureKind, MakeProcedure, PutFunction,
PutPublic, PutCtor, PutParam, IsProcedure,
MakeConstant, PutExtern, MakeArray, PutArray,
MakeSubrange, PutSubrange,
GetModuleDefImportStatementList,
GetModuleModImportStatementList,
GetImportModule, GetImportStatementList,
- PutLibName ;
+ PutLibName,
+ PutProcedureDeclaredTok, PutProcedureParametersDefined,
+ PutProcedureDefined ;
FROM NameKey IMPORT NulName, Name, MakeKey, makekey, KeyToCharStar ;
FROM M2Base IMPORT Integer, Cardinal ;
FROM M2System IMPORT Address ;
-FROM M2LexBuf IMPORT GetTokenNo ;
+FROM M2LexBuf IMPORT GetTokenNo, BuiltinTokenNo ;
FROM Assertion IMPORT Assert ;
FROM Lists IMPORT List, InitList, IncludeItemIntoList, NoOfItemsInList, GetItemFromList, KillList, IsItemInList ;
FROM M2MetaError IMPORT MetaErrorT0, MetaErrorStringT0 ;
DeclareCtorGlobal (tokenno) ;
DeclareModuleExtern (tokenno) ;
linkFunction := MakeProcedure (tokenno, MakeKey ("_M2_link")) ;
- PutMonoName (linkFunction, TRUE)
+ PutMonoName (linkFunction, TRUE) ;
+ PutProcedureDefined (linkFunction, ProperProcedure) ;
ELSIF ScaffoldDynamic AND (NOT cflag)
THEN
MetaErrorT0 (tokenno,
initFunction := MakeProcedure (tokenno, MakeKey ("_M2_init")) ;
PutMonoName (initFunction, TRUE) ;
+ PutProcedureDefined (initFunction, ProperProcedure) ;
finiFunction := MakeProcedure (tokenno, MakeKey ("_M2_fini")) ;
PutMonoName (finiFunction, TRUE) ;
+ PutProcedureDefined (initFunction, ProperProcedure) ;
IF SharedFlag
THEN
PutCtor (initFunction, TRUE) ;
mainFunction := MakeProcedure (tokenno, MakeKey ("main")) ;
PutMonoName (mainFunction, TRUE) ;
StartScope (mainFunction) ;
- PutFunction (mainFunction, Integer) ;
+ PutFunction (BuiltinTokenNo, mainFunction, ProperProcedure, Integer) ;
DeclareArgEnvParams (tokenno, mainFunction) ;
PutPublic (mainFunction, TRUE) ;
+ PutProcedureDefined (mainFunction, ProperProcedure) ;
EndScope
END
END DeclareScaffoldFunctions ;
BEGIN
Assert (IsProcedure (proc)) ;
StartScope (proc) ;
- 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)) ;
+ Assert (PutParam (tokno, proc, ProperProcedure, 1, MakeKey ("argc"), Integer, FALSE, tokno)) ;
+ Assert (PutParam (tokno, proc, ProperProcedure, 2, MakeKey ("argv"), Address, FALSE, tokno)) ;
+ Assert (PutParam (tokno, proc, ProperProcedure, 3, MakeKey ("envp"), Address, FALSE, tokno)) ;
+ PutProcedureParametersDefined (proc, ProperProcedure) ;
+ PutProcedureDeclaredTok (proc, ProperProcedure, tokno) ;
EndScope
END DeclareArgEnvParams ;
FROM M2LexBuf IMPORT BuiltinTokenNo ;
FROM SymbolTable IMPORT NulSym, MakeProcedure, PutFunction,
- AddSymToModuleScope, GetCurrentScope ;
+ AddSymToModuleScope, GetCurrentScope,
+ ProcedureKind ;
(*
IF Size=NulSym
THEN
(* Function *)
- Size := MakeProcedure (BuiltinTokenNo, MakeKey('SIZE')) ;
- PutFunction(Size, ZType) (* Return Type *)
+ Size := MakeProcedure (BuiltinTokenNo, MakeKey ('SIZE')) ;
+ PutFunction (BuiltinTokenNo, Size, DefProcedure, ZType)
+ (* Return Type *)
(* ZType *)
ELSE
- AddSymToModuleScope(GetCurrentScope(), Size)
+ AddSymToModuleScope (GetCurrentScope (), Size)
END
END MakeSize ;
LongCard, ShortCard, LongInt, ShortInt, Boolean ;
FROM SymbolTable IMPORT GetSymName, IsType, IsProcedure, IsConst, IsVar,
- GetType, GetNthParam, IsUnbounded, GetMode, ModeOfAddr,
- NoOfParam, IsConstString, IsConstLit, IsPointer,
- IsExported, ForeachExportedDo, IsUnboundedParam,
+ GetType, GetNthParamAny, IsUnbounded, GetMode, ModeOfAddr,
+ NoOfParamAny, IsConstString, IsConstLit, IsPointer,
+ IsExported, ForeachExportedDo, IsUnboundedParamAny,
IsParameter, IsParameterUnbounded, IsParameterVar,
GetParameterShadowVar, GetReadQuads, GetWriteQuads,
NulSym ;
solved := FALSE
END
END ;
- p := NoOfParam(sym) ;
+ p := NoOfParamAny (sym) ;
i := 1 ;
WHILE i<=p DO
- son := GetNthParam(sym, i) ;
+ son := GetNthParamAny(sym, i) ;
IF TryDependents(son)
THEN
result := TRUE
needComma: BOOLEAN ;
BEGIN
fprintf0(f, '/* Parameter: ') ;
- p := NoOfParam(sym) ;
+ p := NoOfParamAny (sym) ;
i := 1 ;
needComma := FALSE ;
WHILE i<=p DO
- son := GetNthParam(sym, i) ;
+ son := GetNthParamAny(sym, i) ;
IF IsParameterVar(son)
THEN
IF needComma
fprintf0(f, ' ') ;
DoName(sym) ;
fprintf0(f, ' (') ;
- p := NoOfParam(sym) ;
+ p := NoOfParamAny (sym) ;
IF p=0
THEN
fprintf0(f, 'void') ;
ELSE
i := 1 ;
WHILE i<=p DO
- son := GetNthParam(sym, i) ;
- IF IsUnboundedParam(sym, i)
+ son := GetNthParamAny(sym, i) ;
+ IF IsUnboundedParamAny (sym, i)
THEN
DoUnbounded(son)
ELSE
RemoveItemFromList, ForeachItemInListDo, KillList, DuplicateList ;
FROM SymbolTable IMPORT NulSym, ModeOfAddr, IsVar, IsRecord, GetSType,
+ ProcedureKind, GetNthParam, NoOfParam,
GetNth, IsRecordField, IsSet, IsArray, IsProcedure,
GetVarScope, IsVarAParam, IsComponent, GetMode,
VarCheckReadInit, VarInitState, PutVarInitialized,
PutVarFieldInitialized, GetVarFieldInitialized,
- IsConst, IsConstString, NoOfParam, IsVarParam,
+ IsConst, IsConstString, NoOfParamAny, IsVarParamAny,
ForeachLocalSymDo, ForeachParamSymDo,
IsTemporary, ModeOfAddr,
IsReallyPointer, IsUnbounded,
IsVarArrayRef, GetSymName,
IsType, IsPointer,
GetParameterShadowVar, IsParameter, GetLType,
- GetParameterHeapVar ;
+ GetParameterHeapVar, GetVarDeclTok ;
FROM M2Quads IMPORT QuadOperator, GetQuadOtok, GetQuad, GetNextQuad,
IsNewLocalVar, IsReturn, IsKillLocalVar, IsConditional,
SizeOp : SetVarInitialized (op1, FALSE, op1tok) |
AddrOp : CheckAddr (op1tok, op1, op3tok, op3) |
ReturnValueOp : SetVarInitialized (op1, FALSE, op1tok) |
- NewLocalVarOp : |
+ NewLocalVarOp : SetParameterVariablesInitialized (op3) |
ParamOp : CheckDeferredRecordAccess (op2tok, op2, FALSE, warning, i) ;
CheckDeferredRecordAccess (op3tok, op3, FALSE, warning, i) ;
- IF (op1 > 0) AND (op1 <= NoOfParam (op2)) AND
- IsVarParam (op2, op1)
+ IF (op1 > 0) AND (op1 <= NoOfParamAny (op2)) AND
+ IsVarParamAny (op2, op1)
THEN
SetVarInitialized (op3, TRUE, op3tok)
END |
END CheckReadBeforeInitQuad ;
+(*
+ SetParameterVariablesInitialized - sets all shadow variables for parameters as
+ initialized.
+*)
+
+PROCEDURE SetParameterVariablesInitialized (procSym: CARDINAL) ;
+BEGIN
+ ForeachLocalSymDo (procSym, SetVarUninitialized) ;
+ ForeachParamSymDo (procSym, SetVarLRInitialized) ;
+END SetParameterVariablesInitialized ;
+
+
(*
FilterCheckReadBeforeInitQuad -
*)
PutProcedureNoReturn,
GetSym, GetSymName,
GetCurrentModule, SetCurrentModule,
- IsLegal,
+ IsLegal, ProcedureKind,
PopValue,
PopSize ;
END
END ;
- (* And now the predefined pseudo functions *)
+ (* The predefined pseudo functions. *)
Adr := MakeProcedure(BuiltinTokenNo,
MakeKey('ADR')) ; (* Function *)
- PutFunction(Adr, Address) ; (* Return Type *)
+ PutFunction (BuiltinTokenNo, Adr, DefProcedure, Address) ;
+ (* Return Type *)
(* Address *)
-
TSize := MakeProcedure(BuiltinTokenNo,
MakeKey('TSIZE')) ; (* Function *)
- PutFunction(TSize, ZType) ; (* Return Type *)
+ PutFunction (BuiltinTokenNo, TSize, DefProcedure, ZType) ;
+ (* Return Type *)
(* ZType *)
-
TBitSize := MakeProcedure(BuiltinTokenNo,
MakeKey('TBITSIZE')) ; (* GNU extension *)
(* Function *)
- PutFunction(TBitSize, ZType) ; (* Return Type *)
+ PutFunction (BuiltinTokenNo, TBitSize, DefProcedure, ZType) ;
+ (* Return Type *)
(* ZType *)
- (* and the ISO specific predefined pseudo functions *)
+ (* The ISO specific predefined pseudo functions. *)
AddAdr := MakeProcedure(BuiltinTokenNo,
MakeKey('ADDADR')) ; (* Function *)
- PutFunction(AddAdr, Address) ; (* Return Type *)
-
+ PutFunction (BuiltinTokenNo, AddAdr, DefProcedure, Address) ;
+ (* Return Type *)
SubAdr := MakeProcedure(BuiltinTokenNo,
MakeKey('SUBADR')) ; (* Function *)
- PutFunction(SubAdr, Address) ; (* Return Type *)
-
- DifAdr := MakeProcedure(BuiltinTokenNo,
- MakeKey('DIFADR')) ; (* Function *)
- PutFunction(DifAdr, Address) ; (* Return Type *)
-
- MakeAdr := MakeProcedure(BuiltinTokenNo,
- MakeKey('MAKEADR')) ; (* Function *)
- PutFunction(MakeAdr, Address) ; (* Return Type *)
-
- (* the return value for ROTATE, SHIFT and CAST is actually the
- same as the first parameter, this is faked in M2Quads *)
+ PutFunction (BuiltinTokenNo, SubAdr, DefProcedure, Address) ;
+ (* Return Type *)
+ DifAdr := MakeProcedure (BuiltinTokenNo,
+ MakeKey ('DIFADR')) ; (* Function *)
+ PutFunction (BuiltinTokenNo, DifAdr, DefProcedure, Address) ;
+ (* Return Type *)
+ MakeAdr := MakeProcedure (BuiltinTokenNo,
+ MakeKey ('MAKEADR')) ; (* Function *)
+ PutFunction (BuiltinTokenNo, MakeAdr, DefProcedure, Address) ;
+ (* Return Type *)
+
+ (* The return value for ROTATE, SHIFT and CAST is the
+ same as the first parameter and is faked in M2Quads. *)
Rotate := MakeProcedure(BuiltinTokenNo,
MakeKey('ROTATE')) ; (* Function *)
Throw := MakeProcedure(BuiltinTokenNo,
MakeKey('THROW')) ; (* Procedure *)
- PutProcedureNoReturn (Throw, TRUE) ;
+ PutProcedureNoReturn (Throw, DefProcedure, TRUE) ;
CreateMinMaxFor(Word, 'MinWord', 'MaxWord', GetWordType()) ;
CreateMinMaxFor(Address, 'MinAddress', 'MaxAddress', GetPointerType()) ;
PutDoesNeedExportList, PutDoesNotNeedExportList,
DoesNotNeedExportList,
MakeProcedure,
- PutFunction, PutParam, PutVarParam,
- GetNthParam,
IsProcedure, IsConstString,
MakePointer, PutPointer,
MakeRecord, PutFieldRecord,
PutProcedureBuiltin, PutProcedureInline,
GetSymName,
ResolveImports, PutDeclared,
- GetProcedureDeclaredForward, PutProcedureDeclaredForward,
- GetProcedureDeclaredProper, PutProcedureDeclaredProper,
- GetProcedureDeclaredDefinition, PutProcedureDeclaredDefinition,
+ ProcedureKind,
+ PutProcedureDeclaredTok, GetProcedureDeclaredTok,
+ PutProcedureDefined, GetProcedureDefined,
MakeError, MakeErrorS,
DisplayTrees ;
StartScope (ProcSym) ;
IF CompilingDefinitionModule ()
THEN
- IF GetProcedureDeclaredDefinition (ProcSym) = UnknownTokenNo
+ IF GetProcedureDefined (ProcSym, DefProcedure)
THEN
- PutProcedureDeclaredDefinition (ProcSym, tokno)
- ELSE
- MetaErrorT1 (GetProcedureDeclaredDefinition (ProcSym),
+ MetaErrorT1 (GetProcedureDeclaredTok (ProcSym, DefProcedure),
'first declaration of procedure {%1Ea} in the definition module', ProcSym) ;
MetaErrorT1 (tokno,
'duplicate declaration of procedure {%1Ea} in the definition module', ProcSym)
+ ELSE
+ PutProcedureDeclaredTok (ProcSym, DefProcedure, tokno) ;
+ PutProcedureDefined (ProcSym, DefProcedure)
END
ELSE
EnterBlock (name)
PopTtok(NameEnd, end) ;
PopTtok(ProcSym, tok) ;
PopTtok(NameStart, start) ;
- IF NameEnd#NameStart
+ IF NameEnd # NameStart
THEN
IF end # UnknownTokenNo
THEN
END
END ;
EndScope ;
- IF GetProcedureDeclaredProper (ProcSym) = UnknownTokenNo
+ IF GetProcedureDefined (ProcSym, ProperProcedure)
THEN
- PutProcedureDeclaredProper (ProcSym, tok)
- ELSE
- MetaErrorT1 (GetProcedureDeclaredProper (ProcSym),
+ MetaErrorT1 (GetProcedureDeclaredTok (ProcSym, ProperProcedure),
'first proper declaration of procedure {%1Ea}', ProcSym) ;
MetaErrorT1 (tok, 'procedure {%1Ea} has already been declared', ProcSym)
+ ELSE
+ PutProcedureDeclaredTok (ProcSym, ProperProcedure, tok)
END ;
Assert (NOT CompilingDefinitionModule()) ;
LeaveBlock
BEGIN
ProcSym := OperandT (1) ;
tok := OperandTok (1) ;
- IF GetProcedureDeclaredForward (ProcSym) = UnknownTokenNo
+ IF GetProcedureDefined (ProcSym, ForwardProcedure)
THEN
- PutProcedureDeclaredForward (ProcSym, tok)
- ELSE
- MetaErrorT1 (GetProcedureDeclaredForward (ProcSym),
+ MetaErrorT1 (GetProcedureDeclaredTok (ProcSym, ForwardProcedure),
'first forward declaration of {%1Ea}', ProcSym) ;
MetaErrorT1 (tok, 'forward declaration of procedure {%1Ea} has already occurred', ProcSym)
+ ELSE
+ PutProcedureDeclaredTok (ProcSym, ForwardProcedure, tok) ;
+ PutProcedureDefined (ProcSym, ForwardProcedure)
END ;
PopN (2) ;
EndScope ;
EndBuildProcedure,
BuildFunction, BuildOptFunction,
BuildNoReturnAttribute,
- BuildProcedureDefinedByForward,
- BuildProcedureDefinedByProper,
EndBuildForward,
BuildPointerType,
PostProcedureHeading := ProperProcedure | ForwardDeclaration =:
ForwardDeclaration := "FORWARD" % Assert (IsProcedure (OperandT (1))) %
- % BuildProcedureDefinedByForward (OperandT (1)) %
% EndBuildForward %
=:
% StartBuildProcedure %
% Assert(IsProcedure(OperandT(1))) %
% StartBuildFormalParameters %
- [ FormalParameters ] % EndBuildFormalParameters %
+ % Assert(IsProcedure(OperandT(2))) %
+ [ FormalParameters
+ % Assert(IsProcedure(OperandT(2))) %
+ ] % EndBuildFormalParameters %
AttributeNoReturn
% BuildProcedureHeading %
)
( Ident
% StartBuildProcedure %
% Assert(IsProcedure(OperandT(1))) %
+ % DisplayStack %
% StartBuildFormalParameters %
- [ DefFormalParameters ] % EndBuildFormalParameters %
+ % DisplayStack %
+ [ DefFormalParameters % DisplayStack %
+ ] % DisplayStack %
+ % EndBuildFormalParameters %
AttributeNoReturn
% BuildProcedureHeading %
) % M2Error.LeaveErrorScope %
Ident % PopAuto %
% checkReturnAttribute %
% Assert(IsProcedure(OperandT(1))) %
- % BuildNoReturnAttribute (OperandT(1)) %
+ % BuildNoReturnAttribute %
"*>" ] =:
AttributeUnused := [ "<*" % PushAutoOn %
-- 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))) %
[ DefMultiFPSection ] % VAR n: CARDINAL; %
% PopT(n) ; (* remove param count *) %
")"
- FormalReturn % PushT(n) ; (* restore param count *) %
+ FormalReturn % PushT(n) ; (* restore param count *)
+ Annotate ("%1d||running total of no. of parameters") %
=:
DefMultiFPSection := DefExtendedFP |
[ MultiFPSection ] % VAR n: CARDINAL; %
% PopT(n) ; (* remove param count *) %
")"
- FormalReturn % PushT(n) ; (* restore param count *) %
+ FormalReturn % PushT(n) ; (* restore param count *) ;
+ Annotate ("%1d||running total of no. of parameters") %
=:
MultiFPSection := ExtendedFP |
% PushT(NulTok) %
Ident % PushT(1) %
":" FormalType % PushT(n) %
+ % Annotate ("%1d||running total of no. of parameters") %
% BuildFPSection %
% BuildOptArg %
[ "=" ConstExpression ]
% PushT(NulTok) %
Ident % PushT(1) %
":" FormalType % PushT(n) %
+ % Annotate ("%1d||running total of no. of parameters") %
% BuildFPSection %
% BuildOptArg %
"=" ConstExpression
% PopT(n) ; %
% PushT(VarTok) ; %
IdentList ":" FormalType % PushT(n) %
+ % Annotate ("%1d||running total of no. of parameters") %
[ AttributeUnused ]
% BuildFPSection %
=:
% PopT(n) %
% PushT(NulTok) %
IdentList ":" FormalType % PushT(n) %
+ % Annotate ("%1d||running total of no. of parameters") %
[ AttributeUnused ]
% BuildFPSection %
=:
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) ;
+PROCEDURE BuildNoReturnAttribute ;
(*
FROM M2Reserved IMPORT ImportTok, ExportTok, QualifiedTok, UnQualifiedTok,
NulTok, VarTok, ArrayTok ;
-FROM M2MetaError IMPORT MetaError1, MetaError2, MetaErrorsT2, MetaErrors1,
+FROM M2MetaError IMPORT MetaError1, MetaError2, MetaError3,
+ MetaErrorsT2, MetaErrors1, MetaErrorT1,
MetaErrors2, MetaErrorString1, MetaErrorStringT1,
MetaErrorString3, MetaErrorStringT3 ;
PutConstructorIntoFifoQueue, PutConstIntoFifoQueue ;
FROM SymbolTable IMPORT NulSym,
- ModeOfAddr,
+ ModeOfAddr, ProcedureKind,
StartScope, EndScope, PseudoScope,
GetCurrentScope, GetScope,
IsDeclaredIn,
NoOfParam,
PutParamName,
GetParam, GetDimension,
- AreParametersDefinedInDefinition,
- AreParametersDefinedInImplementation,
- AreProcedureParametersDefined,
- ParametersDefinedInDefinition,
- ParametersDefinedInImplementation,
- ProcedureParametersDefined,
- GetProcedureDeclaredDefinition,
- GetProcedureDeclaredForward,
- GetProcedureDeclaredProper,
- GetParametersDefinedByForward,
- GetParametersDefinedByProper,
- PutProcedureNoReturn,
+ PutProcedureParametersDefined,
+ GetProcedureParametersDefined,
PutProcedureParameterHeapVars,
- PutParametersDefinedByForward,
- PutParametersDefinedByProper,
CheckForUnImplementedExports,
CheckForUndeclaredExports,
IsHiddenTypeDeclared,
PutDeclared,
GetPackedEquivalent,
GetVarDeclTok,
- GetVarDeclFullTok,
PutVarDeclTok,
GetVarDeclTypeTok,
+ GetProcedureKindDesc,
+ GetProcedureDeclaredTok,
+ GetProcedureKind,
+ GetReturnTypeTok,
+ SetReturnOptional,
+ IsReturnOptional,
+ PutProcedureNoReturn,
+ PutProcedureDefined,
DisplayTrees ;
FROM M2Batch IMPORT MakeDefinitionSource,
FROM M2Quads IMPORT PushT, PopT,
PushTF, PopTF, PopTtok, PushTFtok, PushTtok, PopTFtok,
OperandT, OperandF, OperandA, OperandTok, PopN, DisplayStack, Annotate,
- AddVarientFieldToList ;
+ AddVarientFieldToList, Top ;
FROM M2Comp IMPORT CompilingDefinitionModule,
CompilingImplementationModule,
PROCEDURE stop ; BEGIN END stop ;
+(*
+ Debug - call stop if symbol name is name.
+*)
+
+PROCEDURE Debug (sym: CARDINAL; name: ARRAY OF CHAR) ;
+BEGIN
+ IF MakeKey (name) = GetSymName (sym)
+ THEN
+ stop
+ END
+END Debug ;
+
+
(*
BlockStart - tokno is the module/procedure/implementation/definition token
*)
ModuleSym: CARDINAL ;
tokno : CARDINAL ;
BEGIN
- PopTtok(name, tokno) ;
+ PopTtok (name, tokno) ;
ModuleSym := MakeDefinitionSource(tokno, name) ;
curModuleSym := ModuleSym ;
SetCurrentModule(ModuleSym) ;
ModuleSym: CARDINAL ;
tokno : CARDINAL ;
BEGIN
- PopTtok(name, tokno) ;
+ PopTtok (name, tokno) ;
ModuleSym := MakeImplementationSource(tokno, name) ;
curModuleSym := ModuleSym ;
SetCurrentModule(ModuleSym) ;
Assert(CompilingImplementationModule()) ;
CheckForUnImplementedExports ;
EndScope ;
- PopT(NameStart) ;
- PopT(NameEnd) ;
+ PopT (NameStart) ;
+ PopT (NameEnd) ;
IF NameStart#NameEnd
THEN
WriteFormat1('inconsistant implementation module name %a', NameStart)
ModuleSym: CARDINAL ;
tokno : CARDINAL ;
BEGIN
- PopTtok(name, tokno) ;
+ PopTtok (name, tokno) ;
ModuleSym := MakeProgramSource(tokno, name) ;
curModuleSym := ModuleSym ;
SetCurrentModule(ModuleSym) ;
Assert(CompilingProgramModule()) ;
CheckForUndeclaredExports(GetCurrentModule()) ; (* Not really allowed exports here though! *)
EndScope ;
- PopT(NameStart) ;
- PopT(NameEnd) ;
+ PopT (NameStart) ;
+ PopT (NameEnd) ;
IF Debugging
THEN
printf0('pass 2: ') ;
i := 1 ;
WHILE i <= n DO
CheckForVariableThatLooksLikeKeyword (OperandT (n+1-i)) ;
- Var := MakeVar (OperandTok (n+1-i), OperandT (n+1-i)) ;
+ tok := OperandTok (n+1-i) ;
+ Var := MakeVar (tok, OperandT (n+1-i)) ;
AtAddress := OperandA (n+1-i) ;
IF AtAddress # NulSym
THEN
PutMode (Var, LeftValue)
END ;
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) *)
- (*
- l := TokenToLocation (tok) ;
- printf3 ('declaring variable %a at position %d location %d\n', name, tok, l)
- *)
+ PutVarDeclTok (Var, tok)
END ;
INC (i)
END ;
BEGIN
PopTtok (name, tokno) ;
PushTtok (name, tokno) ; (* name saved for the EndBuildProcedure name check *)
+ Annotate ("%1n|(%1d)||procedure name saved by StartBuildProcedure") ;
ProcSym := GetDeclareSym (tokno, name) ;
IF IsUnknown (ProcSym)
THEN
VAR
NameEnd,
NameStart: Name ;
+ tok : CARDINAL ;
ProcSym : CARDINAL ;
+ kind : ProcedureKind ;
BEGIN
- PopT(NameEnd) ;
- PopT(ProcSym) ;
- Assert(IsProcedure(ProcSym)) ;
- PopT(NameStart) ;
- IF NameEnd#NameStart
+ PopT (NameEnd) ;
+ PopTtok (ProcSym, tok) ;
+ Assert (IsProcedure(ProcSym)) ;
+ kind := GetProcedureKind (ProcSym, tok) ;
+ PopT (NameStart) ;
+ IF NameEnd # NameStart
THEN
- WriteFormat2('end procedure name does not match beginning %a name %a', NameStart, NameEnd)
+ WriteFormat2 ('end procedure name does not match beginning %a name %a', NameStart, NameEnd)
END ;
PutProcedureParameterHeapVars (ProcSym) ;
+ PutProcedureDefined (ProcSym, kind) ;
EndScope ;
M2Error.LeaveErrorScope
END EndBuildProcedure ;
PROCEDURE BuildProcedureHeading ;
VAR
+ tok,
ProcSym : CARDINAL ;
NameStart: Name ;
BEGIN
ProcSym := OperandT (1) ;
- ProcedureParametersDefined (ProcSym) ;
- IF CompilingDefinitionModule()
+ tok := OperandTok (1) ;
+ PutProcedureParametersDefined (ProcSym, GetProcedureKind (ProcSym, tok)) ;
+ IF CompilingDefinitionModule ()
THEN
- PopT(ProcSym) ;
- Assert(IsProcedure(ProcSym)) ;
- PopT(NameStart) ;
+ PopT (ProcSym) ;
+ Assert (IsProcedure (ProcSym)) ;
+ PopT (NameStart) ;
EndScope
END
END BuildProcedureHeading ;
PROCEDURE BuildFPSection ;
VAR
+ kind,
+ curkind : ProcedureKind ;
+ tok : CARDINAL ;
+ top,
ProcSym,
ParamTotal: CARDINAL ;
BEGIN
- PopT(ParamTotal) ;
- ProcSym := CARDINAL(OperandT(3+CARDINAL(OperandT(3))+2)) ;
- PushT(ParamTotal) ;
- Assert(IsProcedure(ProcSym)) ;
- IF CompilingDefinitionModule()
- THEN
- IF AreParametersDefinedInImplementation(ProcSym)
- THEN
- CheckFormalParameterSection
- ELSE
- BuildFormalParameterSection ;
- IF ParamTotal=0
- THEN
- ParametersDefinedInDefinition(ProcSym) ;
- (* ProcedureParametersDefined(ProcSym) *)
- END
- END
- ELSIF CompilingImplementationModule()
+ top := Top () ;
+ PopT (ParamTotal) ;
+ ProcSym := CARDINAL (OperandT (3 + CARDINAL (OperandT (3)) + 2)) ;
+ tok := CARDINAL (OperandTok (3 + CARDINAL (OperandT (3)) + 2)) ;
+ Debug (ProcSym, 'foo') ;
+ curkind := GetProcedureKind (ProcSym, tok) ;
+ PushT (ParamTotal) ;
+ Annotate ("%1d||running total of no. of parameters") ;
+ Assert (IsProcedure (ProcSym) OR IsProcType (ProcSym)) ;
+ Assert (top = Top ()) ;
+ ProcSym := CARDINAL (OperandT (3 + CARDINAL (OperandT (3 + 1)) + 2 + 1)) ;
+ Assert (IsProcedure (ProcSym) OR IsProcType (ProcSym)) ;
+
+ IF NOT GetProcedureParametersDefined (ProcSym, curkind)
THEN
- IF AreParametersDefinedInDefinition(ProcSym) OR GetParametersDefinedByForward (ProcSym)
- THEN
- CheckFormalParameterSection
- ELSE
- BuildFormalParameterSection ;
- IF ParamTotal=0
- THEN
- ParametersDefinedInImplementation(ProcSym) ;
- (* ProcedureParametersDefined(ProcSym) *)
- END
- END
- ELSIF CompilingProgramModule()
- THEN
- IF GetParametersDefinedByForward (ProcSym) OR AreProcedureParametersDefined (ProcSym)
+ BuildFormalParameterSection (curkind)
+ END ;
+ (* Check against any previous declaration. *)
+ FOR kind := MIN (ProcedureKind) TO MAX (ProcedureKind) DO
+ IF (kind # curkind) AND GetProcedureParametersDefined (ProcSym, kind)
THEN
- CheckFormalParameterSection
- ELSE
- BuildFormalParameterSection ;
- IF ParamTotal=0
- THEN
- (* ProcedureParametersDefined(ProcSym) *)
- END
- END
- ELSE
- InternalError ('should never reach this point')
+ Assert (top = Top ()) ;
+ CheckFormalParameterSection (curkind, kind) ;
+ Assert (top = Top ())
+ END ;
+ ProcSym := CARDINAL (OperandT (3 + CARDINAL (OperandT (3 + 1)) + 2 + 1)) ;
+ Assert (IsProcedure (ProcSym) OR IsProcType (ProcSym))
END ;
- Assert(IsProcedure(OperandT(2)))
+ RemoveFPParameters ;
+ Assert (IsProcedure (OperandT (2)))
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.
PROCEDURE BuildVarArgs ;
VAR
+ kind : ProcedureKind ;
+ tok : CARDINAL ;
ProcSym,
ParamTotal: CARDINAL ;
BEGIN
- PopT(ParamTotal) ;
- PopT(ProcSym) ;
- IF UsesOptArg(ProcSym)
+ PopT (ParamTotal) ;
+ PopTtok (ProcSym, tok) ;
+ kind := GetProcedureKind (ProcSym, tok) ;
+ IF UsesOptArg (ProcSym, kind)
THEN
WriteFormat0('procedure can use either a single optional argument or a single vararg section ... at the end of the formal parameter list')
END ;
- IF UsesVarArgs(ProcSym)
+ IF UsesVarArgs (ProcSym)
THEN
WriteFormat0('procedure can only have one vararg section ... at the end of the formal parameter list')
END ;
- PutUseVarArgs(ProcSym) ;
+ PutUseVarArgs (ProcSym) ;
IF IsDefImp(GetCurrentModule())
THEN
IF NOT IsDefinitionForC(GetCurrentModule())
ELSE
WriteFormat0('varargs can only be used in the module declared as DEFINITION MODULE FOR "C"')
END ;
- PushT(ProcSym) ;
- PushT(ParamTotal)
+ PushTtok (ProcSym, tok) ;
+ PushT (ParamTotal)
END BuildVarArgs ;
PROCEDURE BuildOptArg ;
VAR
+ kind : ProcedureKind ;
+ tok : CARDINAL ;
ProcSym,
ParamTotal: CARDINAL ;
BEGIN
- PopT(ParamTotal) ;
- PopT(ProcSym) ;
- IF UsesVarArgs(ProcSym)
+ PopT (ParamTotal) ;
+ PopTtok (ProcSym, tok) ;
+ kind := GetProcedureKind (ProcSym, tok) ;
+ IF UsesVarArgs (ProcSym)
THEN
WriteFormat0('procedure can not use an optional argument after a vararg ...')
END ;
- PutUseOptArg(ProcSym) ;
- PushT(ProcSym) ;
- PushT(ParamTotal)
+ PutUseOptArg (ProcSym, kind) ;
+ PushTtok (ProcSym, tok) ;
+ PushT (ParamTotal)
END BuildOptArg ;
ELSE
WriteFormat0('varargs can only be used in the module declared as DEFINITION MODULE FOR "C"')
END ;
- PushT(ProcSym)
+ PushT (ProcSym)
END BuildFormalVarArgs ;
The Stack:
- Entry Exit
+ Entry and Exit
- Ptr ->
+ Ptr -> <- Ptr
+------------+
| ParamTotal |
|------------|
. .
. .
|------------|
- | Id n | <- Ptr
- |------------| +------------+
- | Var / Nul | | ParamTotal |
- |------------| |------------|
- | ProcSym | | ProcSym |
- |------------| |------------|
+ | Id n |
+ |------------|
+ | Var / Nul |
+ |------------|
+ | ProcSym |
+ |------------|
*)
-PROCEDURE BuildFormalParameterSection ;
+PROCEDURE BuildFormalParameterSection (kind: ProcedureKind) ;
VAR
ParamName,
Var,
Array : Name ;
tok : CARDINAL ;
+ pi,
TypeTok,
ParamTotal,
TypeSym,
ProcSym,
i, ndim : CARDINAL ;
BEGIN
- PopT(ParamTotal) ;
+ PopT (ParamTotal) ;
PopTtok (TypeSym, TypeTok) ;
- PopTF(Array, ndim) ;
- Assert( (Array=ArrayTok) OR (Array=NulTok) ) ;
- PopT(NoOfIds) ;
- ProcSym := OperandT(NoOfIds+2) ;
- Assert(IsProcedure(ProcSym)) ;
- Var := OperandT(NoOfIds+1) ;
- tok := OperandTok (NoOfIds+2) ;
- Assert( (Var=VarTok) OR (Var=NulTok) ) ;
- IF Array=ArrayTok
+ PopTF (Array, ndim) ;
+ Assert ((Array=ArrayTok) OR (Array=NulTok)) ;
+ PopT (NoOfIds) ;
+ ProcSym := OperandT (NoOfIds + 2) ;
+ Assert (IsProcedure (ProcSym)) ;
+ Var := OperandT (NoOfIds + 1) ;
+ tok := OperandTok (NoOfIds + 2) ;
+ Assert ((Var=VarTok) OR (Var=NulTok)) ;
+ (* Restore popped elements. *)
+ PushT (NoOfIds) ;
+ PushTF (Array, ndim) ;
+ PushTtok (TypeSym, TypeTok) ;
+ PushT (ParamTotal) ;
+
+ IF Array = ArrayTok
THEN
- UnBoundedSym := MakeUnbounded(tok, TypeSym, ndim) ;
+ UnBoundedSym := MakeUnbounded (tok, TypeSym, ndim) ;
TypeSym := UnBoundedSym
END ;
i := 1 ;
+ (* +4 to skip over the top restored elements. *)
+ pi := NoOfIds + 4 ; (* Stack index referencing stacked parameter i. *)
WHILE i <= NoOfIds DO
- IF CompilingDefinitionModule() AND (NOT PedanticParamNames) AND
+ IF CompilingDefinitionModule () AND (NOT PedanticParamNames) AND
(* We will see the parameters in the implementation module. *)
- ((GetMainModule()=GetCurrentModule()) OR
- (IsHiddenTypeDeclared(GetCurrentModule()) AND ExtendedOpaque))
+ ((GetMainModule () = GetCurrentModule ()) OR
+ (IsHiddenTypeDeclared (GetCurrentModule ()) AND ExtendedOpaque))
THEN
ParamName := NulName
ELSE
- ParamName := OperandT(NoOfIds+1-i)
+ ParamName := OperandT (pi)
END ;
- tok := OperandTok (NoOfIds+1-i) ;
- (* WarnStringAt (InitString ('building param pos?'), OperandTok (NoOfIds+1-i)) ; *)
+ tok := OperandTok (pi) ;
IF Var=VarTok
THEN
(* VAR parameter. *)
- IF NOT PutVarParam (tok, ProcSym, ParamTotal+i, ParamName,
- TypeSym, Array=ArrayTok, TypeTok)
+ IF NOT PutVarParam (tok, ProcSym, kind, ParamTotal + i, ParamName,
+ TypeSym, Array = ArrayTok, TypeTok)
THEN
- InternalError ('problems adding a VarParameter - wrong param #?')
+ InternalError ('problems adding a VarParameter - wrong param number?')
END
ELSE
(* Non VAR parameter. *)
- IF NOT PutParam (tok, ProcSym, ParamTotal+i, ParamName,
- TypeSym, Array=ArrayTok, TypeTok)
+ IF NOT PutParam (tok, ProcSym, kind, ParamTotal + i, ParamName,
+ TypeSym, Array = ArrayTok, TypeTok)
THEN
- InternalError ('problems adding a Parameter - wrong param #?')
+ InternalError ('problems adding a Parameter - wrong param number?')
END
END ;
- INC (i)
- END ;
- PopN(NoOfIds+1) ;
- PushT(ParamTotal+NoOfIds) ;
- Assert(IsProcedure(OperandT(2)))
+ (*
+ IF kind = ProperProcedure
+ THEN
+ PutDeclared (OperandTok (pi), GetParameterShadowVar (GetNthParam (ProcSym, kind, ParamTotal + i)))
+ END ;
+ *)
+ INC (i) ;
+ DEC (pi)
+ END
END BuildFormalParameterSection ;
(*
CheckFormalParameterSection - Checks a Formal Parameter in a procedure.
+ The stack is unaffected.
The Stack:
- Entry Exit
+ Entry and Exit
Ptr ->
+------------+
. .
. .
|------------|
- | Id n | <- Ptr
- |------------| +------------+
- | Var / Nul | | ParamTotal |
- |------------| |------------|
- | ProcSym | | ProcSym |
- |------------| |------------|
+ | Id n |
+ |------------|
+ | Var / Nul |
+ |------------|
+ | ProcSym |
+ |------------|
*)
-PROCEDURE CheckFormalParameterSection ;
+PROCEDURE CheckFormalParameterSection (curkind, prevkind: ProcedureKind) ;
VAR
Array, Var: Name ;
+ isVarParam,
Unbounded : BOOLEAN ;
ParamI,
ParamIType,
TypeTok,
TypeSym,
NoOfIds,
- ProcTok,
ProcSym,
pi, i, ndim: CARDINAL ;
BEGIN
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) ;
+ ProcSym := OperandT (NoOfIds+2) ;
+ Assert (IsProcedure (ProcSym)) ;
+ Var := OperandT (NoOfIds+1) ;
+ Assert ((Var = NulName) OR (Var = VarTok)) ;
+ isVarParam := (Var # NulName) ;
+
+ (* Restore popped elements. *)
+ PushT (NoOfIds) ;
+ PushTF (Array, ndim) ;
+ PushTtok (TypeSym, TypeTok) ;
+ PushT (ParamTotal) ;
+
Assert( (Var=VarTok) OR (Var=NulTok) ) ;
Unbounded := (Array=ArrayTok) ; (* ARRAY OF Type, parameter. *)
i := 1 ;
- pi := NoOfIds ; (* Stack index referencing stacked parameter i. *)
-(*
- WriteString('No. of identifiers:') ; WriteCard(NoOfIds, 4) ; WriteLn ;
-*)
+ (* +4 to skip over the top restored elements. *)
+ pi := NoOfIds + 4 ; (* Stack index referencing stacked parameter i. *)
+
(* 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)
+ IF ParamTotal+i <= NoOfParam (ProcSym, prevkind)
THEN
(* WarnStringAt (InitString ('parampos?'), OperandTok (pi)) ; *)
- IF Unbounded AND (NOT IsUnboundedParam(ProcSym, ParamTotal+i))
+ IF Unbounded AND (NOT IsUnboundedParam (ProcSym, prevkind, ParamTotal+i))
THEN
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 {%3EHa} was not declared as an ARRAY OF type',
'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)
+ ParamTotal+i, ProcSym, curkind, prevkind)
+ ELSIF (NOT Unbounded) AND IsUnboundedParam (ProcSym, prevkind, ParamTotal+i)
THEN
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 {%3EHa} was declared as an ARRAY OF type',
'the parameter {%3EVa} was not declared as an ARRAY OF type',
- pi, ParamTotal+i, ProcSym, ProcTok, GetParam (ProcSym, ParamTotal+i), TypeTok)
+ ParamTotal+i, ProcSym, curkind, prevkind)
END ;
IF Unbounded
THEN
- IF GetDimension(GetNthParam(ProcSym, ParamTotal+1))#ndim
+ IF GetDimension (GetNthParam (ProcSym, prevkind, ParamTotal+1)) # ndim
THEN
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 {%3EHa} was declared with a different of dimensions',
'the dynamic array parameter {%3EVa} was declared with a different of dimensions',
- pi, ParamTotal+i, ProcSym, ProcTok, GetParam (ProcSym, ParamTotal+i), TypeTok)
+ ParamTotal+i, ProcSym, curkind, prevkind)
END
END ;
- IF (Var=VarTok) AND (NOT IsVarParam(ProcSym, ParamTotal+i))
+ IF isVarParam AND (NOT IsVarParam (ProcSym, prevkind, ParamTotal+i))
THEN
(* 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}'. *)
+ '{%3EHa} was not declared as a {%kVAR} parameter',
'{%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)
+ ParamTotal+i, ProcSym, curkind, prevkind)
+ ELSIF (NOT isVarParam) AND IsVarParam (ProcSym, prevkind, ParamTotal+i)
THEN
(* 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}'. *)
+ '{%3EHa} was declared as a {%kVAR} parameter',
'{%3EVa} was not declared as a {%kVAR} parameter',
- pi, ParamTotal+i, ProcSym, ProcTok, GetParam (ProcSym, ParamTotal+i), TypeTok)
+ ParamTotal+i, ProcSym, curkind, prevkind)
END ;
- ParamI := GetParam(ProcSym, ParamTotal+i) ;
+ ParamI := GetNthParam (ProcSym, prevkind, ParamTotal+i) ;
IF PedanticParamNames
THEN
- IF GetSymName(ParamI)#OperandT(pi)
+ IF GetSymName (ParamI) # OperandT (pi)
THEN
(* 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), TypeTok)
+ ParamTotal+i, ProcSym, curkind, prevkind)
END
END ;
- PutDeclared (OperandTok (pi), GetParameterShadowVar (ParamI)) ;
IF Unbounded
THEN
(* GetType(ParamI) yields an UnboundedSym or a PartialUnboundedSym,
depending whether it has been resolved.. *)
- ParamIType := GetType(GetType(ParamI))
+ ParamIType := GetType (GetType (ParamI))
ELSE
- ParamIType := GetType(ParamI)
+ ParamIType := GetType (ParamI)
END ;
IF ((SkipType(ParamIType)#SkipType(TypeSym)) OR
(PedanticParamNames AND (ParamIType#TypeSym))) AND
THEN
(* 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 {%3EHa} was declared with a different type',
'the parameter {%3EVa} was declared with a different type',
- pi, ParamTotal+i, ProcSym, ProcTok, GetParam (ProcSym, ParamTotal+i), TypeTok)
+ ParamTotal+i, ProcSym, curkind, prevkind)
END
END ;
- INC(i) ;
- DEC(pi)
- END ;
- PopN(NoOfIds+1) ; (* +1 for the Var/Nul. *)
- PushT(ParamTotal+NoOfIds) ;
- Assert(IsProcedure(OperandT(2)))
+ INC (i) ;
+ DEC (pi)
+ END
END CheckFormalParameterSection ;
(*
- 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.
+ RemoveFPParameters - remove the FPSection parameters from the stack and
+ increment the param total with the NoOfIds.
- Currently the location of the first error is fixed to the
- location of ProcSym.
+ The Stack:
+
+ Entry Exit
+
+ Ptr ->
+ +------------+
+ | ParamTotal |
+ |------------|
+ | TypeSym |
+ |------------|
+ | Array/Nul |
+ |------------|
+ | NoOfIds |
+ |------------|
+ | Id 1 |
+ |------------|
+ . .
+ . .
+ . .
+ |------------|
+ | Id n | <- Ptr
+ |------------| +------------+
+ | Var / Nul | | ParamTotal |
+ |------------| |------------|
+ | ProcSym | | ProcSym |
+ |------------| |------------|
+*)
+
+PROCEDURE RemoveFPParameters ;
+VAR
+ ParamTotal,
+ Array,
+ TypeSym,
+ NoOfIds,
+ ProcSym : CARDINAL ;
+BEGIN
+ PopT (ParamTotal) ;
+ PopT (TypeSym) ;
+ PopT (Array) ;
+ Assert ((Array=ArrayTok) OR (Array=NulTok)) ;
+ PopT (NoOfIds) ;
+ ProcSym := OperandT (NoOfIds+2) ;
+ Assert (IsProcedure (ProcSym)) ;
+ PopN (NoOfIds+1) ; (* +1 for the Var/Nul. *)
+ PushT (ParamTotal + NoOfIds) ;
+ Annotate ("%1d||running total of no. of parameters") ;
+ Assert (IsProcedure (OperandT (2)))
+END RemoveFPParameters ;
+
+
+(*
+ ParameterError - create two error strings chained together.
*)
-PROCEDURE ParameterError (FmtHeader, DefinedDesc, CurrentDesc: ARRAY OF CHAR;
- ParamPtr, ParamNo, ProcSym, ProcTok, Param, TypeTok: CARDINAL) ;
+PROCEDURE ParameterError (FmtHeader, PrevDesc, CurDesc: ARRAY OF CHAR;
+ ParamNo, ProcSym: CARDINAL;
+ curkind, prevkind: ProcedureKind) ;
VAR
-(* parm, *)
- Err : CARDINAL ;
+ PrevParam,
+ CurParam : CARDINAL ;
CurStr,
- DefStr,
+ PrevStr,
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)
+ CurKindStr,
+ PrevKindStr: String ;
+BEGIN
+ CurParam := GetNthParam (ProcSym, curkind, ParamNo) ;
+ CurKindStr := GetProcedureKindDesc (curkind) ;
+ PrevKindStr := GetProcedureKindDesc (prevkind) ;
+ PrevParam := GetNthParam (ProcSym, prevkind, ParamNo) ;
+ PrevStr := InitString (PrevDesc) ;
+ CurStr := InitString (CurDesc) ;
+ Msg := Sprintf3 (Mark (InitString (FmtHeader)), CurKindStr, PrevKindStr, PrevStr) ;
+ MetaErrorString3 (Msg, ProcSym, ParamNo, PrevParam) ;
+ Msg := Sprintf3 (Mark (InitString (FmtHeader)), CurKindStr, PrevKindStr, CurStr) ;
+ MetaErrorString3 (Msg, ProcSym, ParamNo, CurParam)
END ParameterError ;
PROCEDURE StartBuildFormalParameters ;
BEGIN
- PushT(0)
+ PushT (0) ;
+ Annotate ("%1d||running total of no. of parameters")
END StartBuildFormalParameters ;
NoOfPar is the current number of parameters.
*)
-PROCEDURE ParameterMismatch (tok: CARDINAL; ProcSym: CARDINAL; NoOfPar: CARDINAL) ;
+PROCEDURE ParameterMismatch (tok: CARDINAL; ProcSym: CARDINAL;
+ NoOfPar: CARDINAL; prevkind, curkind: ProcedureKind) ;
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)) ;
+ MsgPrev,
+ CompCur,
+ CompPrev,
+ CurDesc,
+ PrevDesc : String ;
+BEGIN
+ CurDesc := GetProcedureKindDesc (curkind) ;
+ PrevDesc := GetProcedureKindDesc (prevkind) ;
+ CompPrev := GetComparison (NoOfParam (ProcSym, prevkind), NoOfPar) ;
+ CompCur := GetComparison (NoOfPar, NoOfParam (ProcSym, prevkind)) ;
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) ;
+ CurDesc, CompCur, PrevDesc) ;
+ MsgPrev := Sprintf3 (Mark (InitString ('the %s for {%%1ad} has %s parameters than the %s')),
+ PrevDesc, CompPrev, CurDesc) ;
+ MetaErrorStringT1 (GetProcedureDeclaredTok (ProcSym, prevkind), MsgPrev, ProcSym) ;
MetaErrorStringT1 (tok, MsgCurrent, ProcSym) ;
- SrcProcSym := KillString (SrcProcSym) ;
- SrcCurDecl := KillString (SrcCurDecl) ;
- CompProcSym := KillString (CompProcSym) ;
- CompCurrent := KillString (CompCurrent)
+ CurDesc := KillString (CurDesc) ;
+ PrevDesc := KillString (PrevDesc) ;
+ CompCur := KillString (CompCur) ;
+ CompPrev := KillString (CompPrev)
END ParameterMismatch ;
PROCEDURE EndBuildFormalParameters ;
VAR
+ kind,
+ curkind: ProcedureKind ;
tok : CARDINAL ;
NoOfPar: CARDINAL ;
ProcSym: CARDINAL ;
BEGIN
PopT (NoOfPar) ;
PopTtok (ProcSym, tok) ;
- PushT (ProcSym) ;
+ PushTtok (ProcSym, tok) ;
+ Annotate ("%1s(%1d)||procedure start symbol") ;
Assert (IsProcedure (ProcSym)) ;
- IF NoOfParam (ProcSym) # NoOfPar
- THEN
- ParameterMismatch (tok, ProcSym, NoOfPar)
+ curkind := GetProcedureKind (ProcSym, tok) ;
+ FOR kind := MIN (ProcedureKind) TO MAX (ProcedureKind) DO
+ IF GetProcedureParametersDefined (ProcSym, kind) AND
+ (curkind # kind) AND (NoOfParam (ProcSym, kind) # NoOfPar)
+ THEN
+ ParameterMismatch (tok, ProcSym, NoOfPar, kind, curkind)
+ END
END ;
+ (* All parameter seen so set procedure defined. *)
+ PutProcedureParametersDefined (ProcSym, curkind) ;
Assert (IsProcedure (OperandT (1)))
END EndBuildFormalParameters ;
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
- RETURN GetProcedureDeclaredDefinition (sym)
- ELSIF GetParametersDefinedByProper (sym)
- THEN
- RETURN GetProcedureDeclaredProper (sym)
- ELSIF GetParametersDefinedByForward (sym)
- THEN
- RETURN GetProcedureDeclaredForward (sym)
- END
- END ;
- 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) ;
+PROCEDURE ReturnTypeMismatch (curtok: CARDINAL; ProcSym, CurRetType: CARDINAL;
+ curtypetok: CARDINAL;
+ curkind, prevkind: ProcedureKind;
+ PrevRetType: CARDINAL) ;
VAR
- SrcProcSym,
- SrcCurDecl,
+ prevtok : CARDINAL ;
+ CurDesc,
+ PrevDesc,
MsgCurrent,
- MsgProcSym: String ;
+ MsgPrev : String ;
BEGIN
- SrcProcSym := GetSourceDesc (ProcSym) ;
- SrcCurDecl := GetCurSrcDesc (ProcSym, tok) ;
- IF ReturnType = NulSym
+ CurDesc := GetProcedureKindDesc (curkind) ;
+ PrevDesc := GetProcedureKindDesc (prevkind) ;
+ prevtok := GetProcedureDeclaredTok (ProcSym, prevkind) ;
+ IF CurRetType = 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
+ CurDesc, PrevDesc) ;
+ MsgPrev := Sprintf2 (Mark (InitString ('there is no return type for {%%1ad} specified in the %s whereas a return type is specified in the %s')),
+ CurDesc, PrevDesc) ;
+ prevtok := GetReturnTypeTok (ProcSym, prevkind)
+ ELSIF PrevRetType = 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)
+ PrevDesc, CurDesc) ;
+ MsgPrev := Sprintf2 (Mark (InitString ('there is no return type for {%%1ad} specified in the %s whereas a return type is specified in the %s')),
+ PrevDesc, CurDesc) ;
+ curtok := curtypetok
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)
+ CurDesc, PrevDesc) ;
+ MsgPrev := Sprintf2 (Mark (InitString ('the return type for {%%1ad} specified in the %s differs in the %s')),
+ CurDesc, PrevDesc) ;
+ curtok := curtypetok ;
+ prevtok := GetReturnTypeTok (ProcSym, prevkind)
END ;
- MetaErrorStringT1 (GetDeclared (ProcSym), MsgProcSym, ProcSym) ;
- MetaErrorStringT1 (tok, MsgCurrent, ProcSym)
+ MetaErrorStringT1 (curtok, MsgCurrent, ProcSym) ;
+ MetaErrorStringT1 (prevtok, MsgPrev, ProcSym)
END ReturnTypeMismatch ;
PROCEDURE BuildFunction ;
VAR
- tok : CARDINAL ;
- PrevRetType,
- RetType,
- ProcSym : CARDINAL ;
+ tok : CARDINAL ;
+ ProcSym,
+ typetok: CARDINAL ;
+ RetType: CARDINAL ;
BEGIN
- PopT (RetType) ;
+ PopTtok (RetType, typetok) ;
PopTtok (ProcSym, tok) ;
- IF IsProcedure (ProcSym)
- THEN
- IF AreProcedureParametersDefined (ProcSym)
- THEN
- PrevRetType := GetType (ProcSym) ;
- IF PrevRetType # RetType
- THEN
- ReturnTypeMismatch (tok, ProcSym, RetType)
- END
- END
- END ;
- PutFunction (ProcSym, RetType) ;
- PushTtok (ProcSym, tok)
+ PushTtok (ProcSym, tok) ;
+ PutFunction (typetok, ProcSym, GetProcedureKind (ProcSym, tok), RetType) ;
+ CheckOptFunction (tok, ProcSym, GetProcedureKind (ProcSym, tok), FALSE) ;
+ CheckProcedureReturn (RetType, typetok)
END BuildFunction ;
PROCEDURE BuildOptFunction ;
VAR
- TypeSym,
+ typetok,
+ tok : CARDINAL ;
+ RetType,
ProcSym : CARDINAL ;
BEGIN
- PopT(TypeSym) ;
- PopT(ProcSym) ;
- PutOptFunction(ProcSym, TypeSym) ;
+ PopTtok (RetType, typetok) ;
+ PopTtok (ProcSym, tok) ;
+ PutOptFunction (typetok, ProcSym, GetProcedureKind (ProcSym, tok), RetType) ;
+ CheckOptFunction (tok, ProcSym, GetProcedureKind (ProcSym, tok), TRUE) ;
+ PushTtok (ProcSym, tok)
+END BuildOptFunction ;
+
+
(*
- WriteString('Procedure ') ; WriteKey(GetSymName(ProcSym)) ;
- WriteString(' has a return argument ') ;
- WriteKey(GetSymName(TypeSym)) ;
- WriteString(' checking ') ; WriteKey(GetSymName(GetType(ProcSym))) ;
- WriteLn ;
+ CheckOptFunction - checks to see whether the optional return value
+ has been set before and if it differs it will
+ generate an error message. It will set the
+ new value to isopt.
*)
- PushT(ProcSym)
-END BuildOptFunction ;
+
+PROCEDURE CheckOptFunction (tok: CARDINAL; sym: CARDINAL; kind: ProcedureKind;
+ isopt: BOOLEAN) ;
+VAR
+ other: ProcedureKind ;
+BEGIN
+ IF GetType (sym) # NulSym
+ THEN
+ (* Procedure sym has been declared as a function. *)
+ FOR other := MIN (ProcedureKind) TO MAX (ProcedureKind) DO
+ IF (kind # other) AND GetProcedureParametersDefined (sym, other)
+ THEN
+ IF IsReturnOptional (sym, kind) AND (NOT isopt)
+ THEN
+ MetaErrorT1 (tok, 'procedure {%1Ea} is not declared with an optional return type here', sym) ;
+ MetaErrorT1 (GetReturnTypeTok (sym, kind),
+ 'previously procedure {%1Ea} was declared with an optional return type', sym)
+ ELSIF (NOT IsReturnOptional (sym, kind)) AND isopt
+ THEN
+ MetaErrorT1 (tok, 'procedure {%1Ea} is declared with an optional return type here', sym) ;
+ MetaErrorT1 (GetReturnTypeTok (sym, kind),
+ 'previously procedure {%1Ea} was declared without an optional return type', sym)
+ END
+ END
+ END
+ END ;
+ SetReturnOptional (sym, kind, isopt)
+END CheckOptFunction ;
(*
BuildNoReturnAttribute - provide an interface to the symbol table module.
*)
-PROCEDURE BuildNoReturnAttribute (procedureSym: CARDINAL) ;
+PROCEDURE BuildNoReturnAttribute ;
+VAR
+ kind : ProcedureKind ;
+ ProcSym,
+ tok : CARDINAL ;
BEGIN
- Assert (IsProcedure (procedureSym)) ;
- PutProcedureNoReturn (procedureSym, TRUE)
+ PopTtok (ProcSym, tok) ;
+ PushTtok (ProcSym, tok) ;
+ kind := GetProcedureKind (ProcSym, tok) ;
+ Assert (IsProcedure (ProcSym)) ;
+ PutProcedureNoReturn (ProcSym, kind, TRUE)
END BuildNoReturnAttribute ;
*)
PROCEDURE CheckProcedure ;
+BEGIN
+ CheckProcedureReturn (NulSym, UnknownTokenNo)
+END CheckProcedure ;
+
+
+
+PROCEDURE CheckProcedureReturn (RetType: CARDINAL; typetok: CARDINAL) ;
VAR
- ProcSym,
- tok : CARDINAL ;
+ curkind,
+ kind : ProcedureKind ;
+ tok : CARDINAL ;
+ PrevRetType,
+ ProcSym : CARDINAL ;
BEGIN
PopTtok (ProcSym, tok) ;
PushTtok (ProcSym, tok) ;
- IF GetType (ProcSym) # NulSym
+ Annotate ("%1s(%1d)||procedure start symbol") ;
+ IF IsProcedure (ProcSym)
THEN
- ReturnTypeMismatch (tok, ProcSym, NulSym)
+ curkind := GetProcedureKind (ProcSym, tok) ;
+ (* Check against any previously declared kinds. *)
+ FOR kind := MIN (ProcedureKind) TO MAX (ProcedureKind) DO
+ IF (kind # curkind) AND GetProcedureParametersDefined (ProcSym, kind)
+ THEN
+ PrevRetType := GetType (ProcSym) ;
+ IF PrevRetType # RetType
+ THEN
+ ReturnTypeMismatch (tok, ProcSym, RetType, typetok,
+ curkind, kind, PrevRetType)
+ END
+ END
+ END ;
+ PutFunction (tok, ProcSym, curkind, RetType)
END
-END CheckProcedure ;
+END CheckProcedureReturn ;
(*
FROM M2Error IMPORT WriteFormat0, WriteFormat1, WriteFormat2, FlushErrors, InternalError ;
FROM M2LexBuf IMPORT GetTokenNo ;
-FROM SymbolTable IMPORT NulSym, ModeOfAddr,
+FROM SymbolTable IMPORT NulSym, ModeOfAddr, ProcedureKind,
StartScope, EndScope, GetScope, GetCurrentScope,
GetModuleScope,
SetCurrentModule, GetCurrentModule, SetFileModule,
IsConst, IsConstructor, PutConst, PutConstructor,
PopValue, PushValue,
MakeTemporary, PutVar,
- PutSubrange,
+ PutSubrange, GetProcedureKind,
GetSymName ;
FROM M2Batch IMPORT MakeDefinitionSource,
PROCEDURE BuildOptArgInitializer ;
VAR
- const: CARDINAL ;
+ tok : CARDINAL ;
+ const,
+ ProcSym: CARDINAL ;
BEGIN
- PopT(const) ;
- PutOptArgInit(GetCurrentScope(), const)
+ PopT (const) ;
+ PopTtok (ProcSym, tok) ;
+ Assert (IsProcedure (ProcSym)) ;
+ PushTtok (ProcSym, tok) ;
+ PutOptArgInit (GetCurrentScope (), const)
END BuildOptArgInitializer ;
LessTok, GreaterTok, HashTok, LessGreaterTok,
InTok, NotTok ;
-FROM SymbolTable IMPORT NulSym, ModeOfAddr,
+FROM SymbolTable IMPORT NulSym, ModeOfAddr, ProcedureKind,
StartScope, EndScope, GetScope, GetCurrentScope,
GetModuleScope,
SetCurrentModule, GetCurrentModule, SetFileModule,
CheckAnonymous,
IsProcedureBuiltin,
MakeProcType,
- NoOfParam,
+ NoOfParamAny,
GetParam,
IsParameterVar, PutProcTypeParam,
PutProcTypeVarParam, IsParameterUnbounded,
tok := GetTokenNo () ;
t := MakeProcType (tok, CheckAnonymous (NulName)) ;
i := 1 ;
- n := NoOfParam(p) ;
+ n := NoOfParamAny (p) ;
WHILE i<=n DO
par := GetParam (p, i) ;
IF IsParameterVar (par)
END ;
IF GetType (p) # NulSym
THEN
- PutFunction (t, GetType (p))
+ PutFunction (tok, t, ProperProcedure, GetType (p))
END ;
RETURN( t )
ELSE
TYPE
ModeOfAddr = (NoValue, ImmediateValue, RightValue, LeftValue) ;
+ ProcedureKind = (ProperProcedure, ForwardProcedure, DefProcedure) ;
FamilyOperation = PROCEDURE (CARDINAL, CARDINAL, CARDINAL) ;
a parameter.
*)
-PROCEDURE GetNthParam (Sym: CARDINAL; ParamNo: CARDINAL) : CARDINAL ;
+PROCEDURE GetNthParam (Sym: CARDINAL; kind: ProcedureKind; ParamNo: CARDINAL) : CARDINAL ;
(*
PutFunction - Places a TypeSym as the return type to a procedure Sym.
*)
-PROCEDURE PutFunction (Sym: CARDINAL; TypeSym: CARDINAL) ;
+PROCEDURE PutFunction (tok: CARDINAL; Sym: CARDINAL; kind: ProcedureKind;
+ TypeSym: CARDINAL) ;
(*
PutOptFunction - places a TypeSym as the optional return type to a procedure Sym.
*)
-PROCEDURE PutOptFunction (Sym: CARDINAL; TypeSym: CARDINAL) ;
+PROCEDURE PutOptFunction (tok: CARDINAL; Sym: CARDINAL; kind: ProcedureKind; TypeSym: CARDINAL) ;
(*
optional.
*)
-PROCEDURE IsReturnOptional (sym: CARDINAL) : BOOLEAN ;
+PROCEDURE IsReturnOptional (sym: CARDINAL; kind: ProcedureKind) : BOOLEAN ;
+
+
+(*
+ IsReturnOptionalAny - returns TRUE if the return value for sym is
+ optional.
+*)
+
+PROCEDURE IsReturnOptionalAny (sym: CARDINAL) : BOOLEAN ;
(*
PutParam - Places a Non VAR parameter ParamName with type ParamType into
- procedure Sym. The parameter number is ParamNo.
+ procedure Sym:kind. The parameter number is ParamNo.
If the procedure Sym already has this parameter then
the parameter is checked for consistancy and the
consistancy test is returned.
*)
-PROCEDURE PutParam (tok: CARDINAL; Sym: CARDINAL; ParamNo: CARDINAL;
+PROCEDURE PutParam (tok: CARDINAL; Sym: CARDINAL;
+ kind: ProcedureKind; ParamNo: CARDINAL;
ParamName: Name; ParamType: CARDINAL;
isUnbounded: BOOLEAN; typetok: CARDINAL) : BOOLEAN ;
(*
PutVarParam - Places a Non VAR parameter ParamName with type
- ParamType into procedure Sym.
+ ParamType into procedure Sym:kind.
The parameter number is ParamNo.
If the procedure Sym already has this parameter then
the parameter is checked for consistancy and the
consistancy test is returned.
*)
-PROCEDURE PutVarParam (tok: CARDINAL; Sym: CARDINAL; ParamNo: CARDINAL;
+PROCEDURE PutVarParam (tok: CARDINAL; Sym: CARDINAL; kind: ProcedureKind;
+ ParamNo: CARDINAL;
ParamName: Name; ParamType: CARDINAL;
isUnbounded: BOOLEAN; typetok: CARDINAL) : BOOLEAN ;
(*
- PutParamName - assigns a name, name, to paramater, no, of procedure,
- ProcSym.
+ PutParamName - assigns a name to paramater no of procedure ProcSym:kind.
*)
-PROCEDURE PutParamName (tok: CARDINAL; ProcSym: CARDINAL; no: CARDINAL;
- name: Name; typetok: CARDINAL) ;
+PROCEDURE PutParamName (tok: CARDINAL; ProcSym: CARDINAL; kind: ProcedureKind;
+ no: CARDINAL;
+ name: Name; ParamType: CARDINAL; typetok: CARDINAL) ;
(*
field of procedure sym.
*)
-PROCEDURE PutProcedureNoReturn (Sym: CARDINAL; value: BOOLEAN) ;
+PROCEDURE PutProcedureNoReturn (Sym: CARDINAL; kind: ProcedureKind;
+ value: BOOLEAN) ;
(*
IsProcedureNoReturn - returns TRUE if this procedure never returns.
*)
-PROCEDURE IsProcedureNoReturn (Sym: CARDINAL) : BOOLEAN ;
+PROCEDURE IsProcedureNoReturn (Sym: CARDINAL; kind: ProcedureKind) : BOOLEAN ;
(*
is a VAR procedure parameter.
*)
-PROCEDURE IsVarParam (Sym: CARDINAL; ParamNo: CARDINAL) : BOOLEAN ;
+PROCEDURE IsVarParam (Sym: CARDINAL; kind: ProcedureKind;
+ ParamNo: CARDINAL) : BOOLEAN ;
+
+
+(*
+ IsVarParamAny - Returns a conditional depending whether parameter ParamNo
+ is a VAR parameter.
+*)
+
+PROCEDURE IsVarParamAny (Sym: CARDINAL; ParamNo: CARDINAL) : BOOLEAN ;
+
+
+(*
+ IsUnboundedParam - Returns a conditional depending whether parameter
+ ParamNo is an unbounded array procedure parameter.
+*)
+
+PROCEDURE IsUnboundedParam (Sym: CARDINAL; kind: ProcedureKind;
+ ParamNo: CARDINAL) : BOOLEAN ;
(*
ParamNo is an unbounded array procedure parameter.
*)
-PROCEDURE IsUnboundedParam (Sym: CARDINAL; ParamNo: CARDINAL) : BOOLEAN ;
+PROCEDURE IsUnboundedParamAny (Sym: CARDINAL; ParamNo: CARDINAL) : BOOLEAN ;
(*
NoOfParam - Returns the number of parameters that procedure Sym contains.
*)
-PROCEDURE NoOfParam (Sym: CARDINAL) : CARDINAL ;
+PROCEDURE NoOfParam (Sym: CARDINAL; kind: ProcedureKind) : CARDINAL ;
(*
(*
- ForeachParamSymDo - foreach parameter symbol in procedure, Sym,
- perform the procedure, P.
+ ForeachParamSymDo - foreach parameter symbol in procedure Sym
+ perform the procedure P. Each symbol
+ looked up will be VarParam or Param
+ (not the shadow variable). Every parameter
+ from each KindProcedure is iterated over.
*)
PROCEDURE ForeachParamSymDo (Sym: CARDINAL; P: PerformOperation) ;
(*
- ProcedureParametersDefined - dictates to procedure symbol, Sym,
- that its parameters have been defined.
-*)
-
-PROCEDURE ProcedureParametersDefined (Sym: CARDINAL) ;
-
-
-(*
- AreProcedureParametersDefined - returns true if the parameters to procedure
- symbol, Sym, have been defined.
+ GetProcedureKind - returns the procedure kind given the declaration tok.
+ The declaration tok must match the ident tok in the
+ procedure name. It is only safe to call this
+ procedure function during pass 2 onwards.
*)
-PROCEDURE AreProcedureParametersDefined (Sym: CARDINAL) : BOOLEAN ;
+PROCEDURE GetProcedureKind (sym: CARDINAL; tok: CARDINAL) : ProcedureKind ;
(*
- ParametersDefinedInDefinition - dictates to procedure symbol, Sym,
- that its parameters have been defined in
- a definition module.
+ GetProcedureDeclaredTok - return the token where the
+ declaration of procedure sym:kind
+ occurred.
*)
-PROCEDURE ParametersDefinedInDefinition (Sym: CARDINAL) ;
+PROCEDURE GetProcedureDeclaredTok (sym: CARDINAL; kind: ProcedureKind) : CARDINAL ;
(*
- AreParametersDefinedInDefinition - returns true if procedure symbol, Sym,
- has had its parameters been defined in
- a definition module.
+ PutProcedureDeclaredTok - places the tok where the
+ declaration of procedure sym:kind
+ occurred.
*)
-PROCEDURE AreParametersDefinedInDefinition (Sym: CARDINAL) : BOOLEAN ;
+PROCEDURE PutProcedureDeclaredTok (sym: CARDINAL; kind: ProcedureKind;
+ tok: CARDINAL) ;
(*
- ParametersDefinedInImplementation - records that the parameters have been
- defined in an implementation module.
+ GetReturnTypeTok - return the token where the
+ return type procedure sym:kind was defined.
*)
-PROCEDURE ParametersDefinedInImplementation (Sym: CARDINAL) ;
+PROCEDURE GetReturnTypeTok (sym: CARDINAL; kind: ProcedureKind) : CARDINAL ;
(*
- AreParametersDefinedInImplementation - returns true if procedure symbol, Sym,
- has had its parameters been defined in
- an implementation module.
+ PutReturnTypeTok - places the tok where the return type of procedure sym:kind
+ was defined.
*)
-PROCEDURE AreParametersDefinedInImplementation (Sym: CARDINAL) : BOOLEAN ;
+PROCEDURE PutReturnTypeTok (sym: CARDINAL; kind: ProcedureKind; tok: CARDINAL) ;
(*
- PutParametersDefinedByForward - records that the parameters have been
- defined in a FORWARD declaration.
+ PutProcedureParametersDefined - the procedure symbol sym:kind
+ parameters have been defined.
*)
-PROCEDURE PutParametersDefinedByForward (ProcSym: CARDINAL) ;
+PROCEDURE PutProcedureParametersDefined (sym: CARDINAL; kind: ProcedureKind) ;
(*
- GetParametersDefinedByForward - return TRUE if ProcSym has had its parameters
- defined by a FORWARD declaration.
+ GetProcedureParametersDefined - returns true if procedure symbol sym:kind
+ parameters are defined.
*)
-PROCEDURE GetParametersDefinedByForward (ProcSym: CARDINAL) : BOOLEAN ;
+PROCEDURE GetProcedureParametersDefined (sym: CARDINAL; kind: ProcedureKind) : BOOLEAN ;
(*
- PutParametersDefinedByProper - records that the parameters have been
- defined in a FORWARD declaration.
+ PutProcedureDefined - the procedure symbol sym:kind is defined.
*)
-PROCEDURE PutParametersDefinedByProper (ProcSym: CARDINAL) ;
+PROCEDURE PutProcedureDefined (sym: CARDINAL; kind: ProcedureKind) ;
(*
- GetParametersDefinedByProper - return TRUE if ProcSym has had its parameters
- defined by a FORWARD declaration.
+ GetProcedureDefined - returns true if procedure symbol sym:kind
+ is defined.
*)
-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) ;
+PROCEDURE GetProcedureDefined (sym: CARDINAL; kind: ProcedureKind) : BOOLEAN ;
(*
uses an optarg.
*)
-PROCEDURE PutUseOptArg (Sym: CARDINAL) ;
+PROCEDURE PutUseOptArg (Sym: CARDINAL; kind: ProcedureKind) ;
(*
UsesOptArg - returns TRUE if procedure, Sym, uses varargs.
*)
-PROCEDURE UsesOptArg (Sym: CARDINAL) : BOOLEAN ;
+PROCEDURE UsesOptArg (Sym: CARDINAL; kind: ProcedureKind) : BOOLEAN ;
(*
procedure, ProcSym.
*)
-PROCEDURE PutOptArgInit (ProcSym, Sym: CARDINAL) ;
+PROCEDURE PutOptArgInit (ProcSym: CARDINAL; Sym: CARDINAL) ;
(*
(*
- PushOffset - pushes the Offset of Sym.
+ PopSize - pops the ALU stack into Size of Sym.
*)
-PROCEDURE PushOffset (Sym: CARDINAL) ;
+PROCEDURE PopSize (Sym: CARDINAL) ;
(*
PROCEDURE PushValue (Sym: CARDINAL) ;
-(*
- PushParamSize - push the size of parameter, ParamNo,
- of procedure Sym onto the ALU stack.
-*)
-
-PROCEDURE PushParamSize (Sym: CARDINAL; ParamNo: CARDINAL) ;
-
-
-(*
- PushSumOfLocalVarSize - push the total size of all local variables
- onto the ALU stack.
-*)
-
-PROCEDURE PushSumOfLocalVarSize (Sym: CARDINAL) ;
-
-
-(*
- PushSumOfParamSize - push the total size of all parameters onto
- the ALU stack.
-*)
-
-PROCEDURE PushSumOfParamSize (Sym: CARDINAL) ;
-
-
(*
PushVarSize - pushes the size of a variable, Sym.
The runtime size of Sym will depend upon its addressing mode,
PROCEDURE PopValue (Sym: CARDINAL) ;
-(*
- PopSize - pops the ALU stack into Size of Sym.
-*)
-
-PROCEDURE PopSize (Sym: CARDINAL) ;
-
-
-(*
- PopOffset - pops the ALU stack into Offset of Sym.
-*)
-
-PROCEDURE PopOffset (Sym: CARDINAL) ;
-
-
-(*
- PopSumOfParamSize - pop the total value on the ALU stack as the
- sum of all parameters.
-*)
-
-PROCEDURE PopSumOfParamSize (Sym: CARDINAL) ;
-
-
(*
IsObject - returns TRUE if the symbol is an object symbol.
*)
PROCEDURE GetVarDeclFullTok (sym: CARDINAL) : CARDINAL ;
+(*
+ IsProcedureAnyNoReturn - return TRUE if any of the defined kinds
+ of procedure sym is declared no return.
+*)
+
+PROCEDURE IsProcedureAnyNoReturn (sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+ GetNthParamAny - returns the nth parameter from the order
+ proper procedure, forward declaration
+ or definition module procedure.
+*)
+
+PROCEDURE GetNthParamAny (sym: CARDINAL; ParamNo: CARDINAL) : CARDINAL ;
+
+
+(*
+ NoOfParamAny - return the number of parameters for sym.
+*)
+
+PROCEDURE NoOfParamAny (sym: CARDINAL) : CARDINAL ;
+
+
+(*
+ SetReturnOptional - sets the ReturnOptional field in the Procedure:kind or
+ ProcType symboltable entry.
+*)
+
+PROCEDURE SetReturnOptional (sym: CARDINAL; kind: ProcedureKind;
+ isopt: BOOLEAN) ;
+
+
+(*
+ UsesOptArgAny - returns TRUE if procedure, Sym, uses varargs.
+*)
+
+PROCEDURE UsesOptArgAny (Sym: CARDINAL) : BOOLEAN ;
+
+
+(*
+ GetProcedureKindDesc - return a string describing kind.
+*)
+
+PROCEDURE GetProcedureKindDesc (kind: ProcedureKind) : String ;
+
+
END SymbolTable.
DoesTreeContainAny, ForeachNodeDo, ForeachNodeConditionDo,
NoOfNodes ;
-FROM M2Base IMPORT MixTypes, InitBase, Char, Integer, LongReal,
+FROM M2Base IMPORT MixTypes, MixTypesDecl, InitBase, Char, Integer, LongReal,
Cardinal, LongInt, LongCard, ZType, RType ;
FROM M2System IMPORT Address ;
UnboundedAddressName = "_m2_contents" ;
UnboundedHighName = "_m2_high_%d" ;
- BreakSym = 8496 ;
+ BreakSym = 203 ;
TYPE
+ ProcAnyBoolean = PROCEDURE (CARDINAL, ProcedureKind) : BOOLEAN ;
+ ProcAnyCardinal = PROCEDURE (CARDINAL, ProcedureKind) : CARDINAL ;
+
ConstLitPoolEntry = POINTER TO RECORD
sym : CARDINAL ;
tok : CARDINAL ;
ModDeclared: CARDINAL ;
END ;
- ProcedureDecl = RECORD
- Forward, (* The token locations for *)
- Definition, (* each potential procedure *)
- Proper : CARDINAL ; (* declaration. *)
- END ;
-
VarDecl = RECORD
FullTok,
VarTok,
NDim: CARDINAL ; (* dimensions associated *)
END ;
- SymProcedure
+ ProcedureDeclaration
= RECORD
- name : Name ; (* Index into name array, name *)
- (* of procedure. *)
ListOfParam : List ; (* Contains a list of all the *)
(* parameters in this procedure. *)
+ Defined : BOOLEAN ; (* Has the procedure been *)
+ (* declared yet? *)
ParamDefined : BOOLEAN ; (* Have the parameters been *)
(* defined yet? *)
- DefinedInDef : BOOLEAN ; (* Were the parameters defined *)
- (* in the Definition module? *)
- (* Note that this depends on *)
- (* whether the compiler has read *)
- (* the .def or .mod first. *)
- (* The second occurence is *)
- (* compared to the first. *)
- DefinedInImp : BOOLEAN ; (* Were the parameters defined *)
- (* in the Implementation module? *)
- (* Note that this depends on *)
- (* whether the compiler has read *)
- (* 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. *)
- IsBuiltin : BOOLEAN ; (* Was it declared __BUILTIN__ ? *)
- BuiltinName : Name ; (* name of equivalent builtin *)
- IsInline : BOOLEAN ; (* Was it declared __INLINE__ ? *)
IsNoReturn : BOOLEAN ; (* Attribute noreturn ? *)
ReturnOptional: BOOLEAN ; (* Is the return value optional? *)
+ ReturnTypeTok,
+ ProcedureTok : CARDINAL ; (* Token pos of procedure name. *)
+ END ;
+
+ SymProcedure
+ = RECORD
+ name : Name ; (* Index into name array, name *)
+ (* of procedure. *)
+ Decl : ARRAY ProcedureKind OF ProcedureDeclaration ;
+ OptArgInit : CARDINAL ; (* The optarg initial value. *)
IsExtern : BOOLEAN ; (* Make this procedure extern. *)
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. *)
+ BuildProcType : BOOLEAN ; (* Are we building the *)
+ (* associated proctype? *)
Unresolved : SymbolTree ; (* All symbols currently *)
(* unresolved in this procedure. *)
ScopeQuad : CARDINAL ; (* Index into quads for scope *)
(* and restore interrupts? *)
ReturnType : CARDINAL ; (* Return type for function. *)
ProcedureType : CARDINAL ; (* Proc type for this procedure. *)
- Offset : CARDINAL ; (* Location of procedure used *)
- (* in Pass 2 and if procedure *)
- (* is a syscall. *)
+ IsBuiltin : BOOLEAN ; (* Was it declared __BUILTIN__ ? *)
+ BuiltinName : Name ; (* name of equivalent builtin *)
+ IsInline : BOOLEAN ; (* Was it declared __INLINE__ ? *)
LocalSymbols: SymbolTree ; (* Contains all symbols declared *)
(* within this procedure. *)
EnumerationScopeList: List ;
OptArgInit : CARDINAL ; (* The optarg initial value. *)
ReturnType : CARDINAL ; (* Return type for function. *)
ReturnOptional: BOOLEAN ; (* Is the return value optional? *)
+ ReturnTypeTok : CARDINAL ; (* Token of return type. *)
Scope : CARDINAL ; (* Scope of declaration. *)
Size : PtrToValue ; (* Runtime size of symbol. *)
TotalParamSize: PtrToValue ; (* size of all parameters. *)
VAR
pSym: PtrToSymbol ;
BEGIN
- CheckLegal(Sym) ;
+ AssertInRange(Sym) ;
pSym := GetPsym(Sym) ;
RETURN( pSym^.SymbolType=ErrorSym )
END IsError ;
VAR
pSym: PtrToSymbol ;
BEGIN
- CheckLegal(Sym) ;
+ AssertInRange(Sym) ;
pSym := GetPsym(Sym) ;
RETURN( pSym^.SymbolType=TupleSym )
END IsTuple ;
VAR
pSym: PtrToSymbol ;
BEGIN
- CheckLegal(Sym) ;
+ AssertInRange(Sym) ;
pSym := GetPsym(Sym) ;
RETURN( pSym^.SymbolType=ObjectSym )
END IsObject ;
(*
- InitProcedureDecl - initializes all fields of ProcedureDecl to UnknownTokenNo.
+ InitProcedureDeclaration - initialize all the ProcedureDeclaration
+ fields.
*)
-PROCEDURE InitProcedureDecl (VAR decl: ProcedureDecl) ;
+PROCEDURE InitProcedureDeclaration (VAR decl: ProcedureDeclaration) ;
BEGIN
- decl.Forward := UnknownTokenNo ;
- decl.Definition := UnknownTokenNo ;
- decl.Proper := UnknownTokenNo
-END InitProcedureDecl ;
+ WITH decl DO
+ Defined := FALSE ; (* Has the procedure been *)
+ (* declared yet? *)
+ ParamDefined := FALSE ; (* Have the parameters been *)
+ (* defined yet? *)
+ HasVarArgs := FALSE ; (* Does the procedure use ... ? *)
+ HasOptArg := FALSE ; (* Does this procedure use [ ] ? *)
+ IsNoReturn := FALSE ; (* Declared attribute noreturn ? *)
+ ReturnOptional := FALSE (* Is the return value optional? *)
+ END
+END InitProcedureDeclaration ;
(*
VAR
pSym: PtrToSymbol ;
Sym : CARDINAL ;
+ kind: ProcedureKind ;
BEGIN
tok := CheckTok (tok, 'procedure') ;
Sym := DeclareSym(tok, ProcedureName) ;
+ IF Sym = BreakSym
+ THEN
+ stop
+ END ;
IF NOT IsError(Sym)
THEN
pSym := GetPsym(Sym) ;
SymbolType := ProcedureSym ;
WITH Procedure DO
name := ProcedureName ;
- InitList(ListOfParam) ; (* Contains a list of all the *)
- (* parameters in this procedure. *)
- ParamDefined := FALSE ; (* Have the parameters been *)
- (* defined yet? *)
- DefinedInDef := FALSE ; (* Were the parameters defined *)
- (* in the Definition module? *)
- (* Note that this depends on *)
- (* whether the compiler has read *)
- (* the .def or .mod first. *)
- (* The second occurence is *)
- (* compared to the first. *)
- DefinedInImp := FALSE ; (* Were the parameters defined *)
- (* in the Implementation module? *)
- (* Note that this depends on *)
- (* whether the compiler has read *)
- (* 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. *)
- IsBuiltin := FALSE ; (* Was it declared __BUILTIN__ ? *)
- BuiltinName := NulName ; (* name of equivalent builtin *)
- IsInline := FALSE ; (* Was is declared __INLINE__ ? *)
- IsNoReturn := FALSE ; (* Declared attribute noreturn ? *)
- ReturnOptional := FALSE ; (* Is the return value optional? *)
+ FOR kind := MIN (ProcedureKind) TO MAX (ProcedureKind) DO
+ InitProcedureDeclaration (Decl[kind]) ;
+ InitList (Decl[kind].ListOfParam)
+ END ;
+ OptArgInit := NulSym ; (* The optional arg default *)
+ (* value. *)
IsExtern := FALSE ; (* Make this procedure external. *)
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. *)
+ BuildProcType := TRUE ; (* Are we building the *)
+ (* proctype associated with sym? *)
Scope := GetCurrentScope() ; (* Scope of procedure. *)
InitTree(Unresolved) ; (* All symbols currently *)
(* unresolved in this procedure. *)
ReturnType := NulSym ; (* Not a function yet! *)
(* The ProcType equivalent. *)
ProcedureType := MakeProcType (tok, NulName) ;
- Offset := 0 ; (* Location of procedure. *)
InitTree(LocalSymbols) ;
InitList(EnumerationScopeList) ;
(* Enumeration scope list which *)
InitList(ListOfModules) ; (* List of all inner modules. *)
ExceptionFinally := FALSE ; (* does it have an exception? *)
ExceptionBlock := FALSE ; (* does it have an exception? *)
+ IsBuiltin := FALSE ; (* Was it declared __BUILTIN__ ? *)
+ BuiltinName := NulName ; (* name of equivalent builtin *)
+ IsInline := FALSE ; (* Was is declared __INLINE__ ? *)
Size := InitValue() ; (* Activation record size. *)
TotalParamSize
:= InitValue() ; (* size of all parameters. *)
field of procedure sym.
*)
-PROCEDURE PutProcedureNoReturn (Sym: CARDINAL; value: BOOLEAN) ;
+PROCEDURE PutProcedureNoReturn (Sym: CARDINAL; kind: ProcedureKind;
+ value: BOOLEAN) ;
VAR
pSym: PtrToSymbol ;
BEGIN
WITH pSym^ DO
CASE SymbolType OF
- ProcedureSym: Procedure.IsNoReturn := value
+ ProcedureSym: Procedure.Decl[kind].IsNoReturn := value
ELSE
InternalError ('expecting ProcedureSym symbol')
IsProcedureNoReturn - returns TRUE if this procedure never returns.
*)
-PROCEDURE IsProcedureNoReturn (Sym: CARDINAL) : BOOLEAN ;
+PROCEDURE IsProcedureNoReturn (Sym: CARDINAL; kind: ProcedureKind) : BOOLEAN ;
VAR
pSym: PtrToSymbol ;
BEGIN
WITH pSym^ DO
CASE SymbolType OF
- ProcedureSym: RETURN Procedure.IsNoReturn
+ ProcedureSym: RETURN Procedure.Decl[kind].IsNoReturn
ELSE
InternalError ('expecting ProcedureSym symbol')
GetNthParam - returns the n th parameter of a procedure Sym.
*)
-PROCEDURE GetNthParam (Sym: CARDINAL; ParamNo: CARDINAL) : CARDINAL ;
+PROCEDURE GetNthParam (Sym: CARDINAL; kind: ProcedureKind;
+ ParamNo: CARDINAL) : CARDINAL ;
VAR
pSym: PtrToSymbol ;
i : CARDINAL ;
BEGIN
IF ParamNo=0
THEN
- (* Demands the return type of the function *)
+ (* The return type of the function *)
i := GetType(Sym)
ELSE
pSym := GetPsym(Sym) ;
WITH pSym^ DO
CASE SymbolType OF
- ProcedureSym: i := GetItemFromList(Procedure.ListOfParam, ParamNo) |
- ProcTypeSym : i := GetItemFromList(ProcType.ListOfParam, ParamNo)
+ ProcedureSym: i := GetItemFromList (Procedure.Decl[kind].ListOfParam,
+ ParamNo) |
+ ProcTypeSym : i := GetItemFromList (ProcType.ListOfParam, ParamNo)
ELSE
InternalError ('expecting ProcedureSym or ProcTypeSym')
END GetNthParam ;
+(*
+ GetNthParamAny - returns the nth parameter from the order
+ proper procedure, forward declaration
+ or definition module procedure.
+*)
+
+PROCEDURE GetNthParamAny (sym: CARDINAL; ParamNo: CARDINAL) : CARDINAL ;
+VAR
+ kind: ProcedureKind ;
+BEGIN
+ FOR kind := MIN (ProcedureKind) TO MAX (ProcedureKind) DO
+ IF GetProcedureParametersDefined (sym, kind)
+ THEN
+ RETURN GetNthParam (sym, kind, ParamNo)
+ END
+ END ;
+ InternalError ('no procedure kind exists')
+END GetNthParamAny ;
+
+
(*
The Following procedures fill in the symbol table with the
symbol entities.
InternalError ('expecting a Var symbol')
END
END ;
- t := MixTypes(GetType(e1), GetType(e2), tok) ;
+ t := MixTypesDecl (e1, e2, GetType(e1), GetType(e2), tok) ;
IF t#NulSym
THEN
Assert(NOT IsConstructor(t)) ;
VAR
pSym: PtrToSymbol ;
BEGIN
- CheckLegal (Sym) ;
+ AssertInRange (Sym) ;
pSym := GetPsym(Sym) ;
RETURN pSym^.SymbolType=UndefinedSym
END IsUnknown ;
(*
- CheckLegal - determines whether the Sym is a legal symbol.
+ AssertInRange - determines whether the Sym is a legal symbol.
*)
-PROCEDURE CheckLegal (Sym: CARDINAL) ;
+PROCEDURE AssertInRange (Sym: CARDINAL) ;
BEGIN
IF (Sym<1) OR (Sym>FinalSymbol())
THEN
InternalError ('illegal symbol')
END
-END CheckLegal ;
+END AssertInRange ;
(*
(*
- ForeachParamSymDo - foreach parameter symbol in procedure, Sym,
- perform the procedure, P. Each symbol
+ ForeachParamSymDo - foreach parameter symbol in procedure Sym
+ perform the procedure P. Each symbol
looked up will be VarParam or Param
- (not the shadow variable).
+ (not the shadow variable). Every parameter
+ from each KindProcedure is iterated over.
*)
PROCEDURE ForeachParamSymDo (Sym: CARDINAL; P: PerformOperation) ;
VAR
+ kind : ProcedureKind ;
param: CARDINAL ;
p, i : CARDINAL ;
BEGIN
IF IsProcedure (Sym)
THEN
- p := NoOfParam (Sym) ;
- i := p ;
- WHILE i>0 DO
- param := GetNthParam (Sym, i) ;
- P (param) ;
- DEC(i)
+ FOR kind := MIN (ProcedureKind) TO MAX (ProcedureKind) DO
+ p := NoOfParam (Sym, kind) ;
+ i := p ;
+ WHILE i>0 DO
+ param := GetNthParam (Sym, kind, i) ;
+ P (param) ;
+ DEC(i)
+ END
END
END
END ForeachParamSymDo ;
optional.
*)
-PROCEDURE IsReturnOptional (sym: CARDINAL) : BOOLEAN ;
+PROCEDURE IsReturnOptional (sym: CARDINAL; kind: ProcedureKind) : BOOLEAN ;
VAR
pSym: PtrToSymbol ;
BEGIN
WITH pSym^ DO
CASE SymbolType OF
- ProcedureSym: RETURN( Procedure.ReturnOptional ) |
+ ProcedureSym: RETURN( Procedure.Decl[kind].ReturnOptional ) |
ProcTypeSym : RETURN( ProcType.ReturnOptional )
ELSE
(*
- SetReturnOptional - sets the ReturnOptional field in the Procedure or
+ SetReturnOptional - sets the ReturnOptional field in the Procedure:kind or
ProcType symboltable entry.
*)
-PROCEDURE SetReturnOptional (sym: CARDINAL; isopt: BOOLEAN) ;
+PROCEDURE SetReturnOptional (sym: CARDINAL; kind: ProcedureKind;
+ isopt: BOOLEAN) ;
VAR
pSym: PtrToSymbol ;
BEGIN
WITH pSym^ DO
CASE SymbolType OF
- ProcedureSym: Procedure.ReturnOptional := isopt |
+ ProcedureSym: Procedure.Decl[kind].ReturnOptional := isopt |
ProcTypeSym : ProcType.ReturnOptional := isopt
ELSE
(*
- CheckOptFunction - checks to see whether the optional return value
- has been set before and if it differs it will
- generate an error message. It will set the
- new value to, isopt.
+ IsReturnOptionalAny - returns TRUE if the return value for sym is
+ optional.
*)
-PROCEDURE CheckOptFunction (sym: CARDINAL; isopt: BOOLEAN) ;
+PROCEDURE IsReturnOptionalAny (sym: CARDINAL) : BOOLEAN ;
VAR
- n: Name ;
- e: Error ;
+ pSym: PtrToSymbol ;
BEGIN
- IF GetType(sym)#NulSym
- THEN
- IF IsReturnOptional(sym) AND (NOT isopt)
- THEN
- n := GetSymName(sym) ;
- e := NewError(GetTokenNo()) ;
- ErrorFormat1(e, 'function (%a) has no optional return value here', n) ;
- e := ChainError(GetDeclaredMod(sym), e) ;
- ErrorFormat1(e, 'whereas the same function (%a) was declared to have an optional return value at this point', n)
- ELSIF (NOT IsReturnOptional(sym)) AND isopt
- THEN
- n := GetSymName(sym) ;
- e := NewError(GetTokenNo()) ;
- ErrorFormat1(e, 'function (%a) has an optional return value', n) ;
- e := ChainError(GetDeclaredMod(sym), e) ;
- ErrorFormat1(e, 'whereas the same function (%a) was declared to have no optional return value at this point', n)
+ pSym := GetPsym(sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ ProcedureSym: RETURN IsProcedureAnyBoolean (sym, IsReturnOptional) |
+ ProcTypeSym : RETURN ProcType.ReturnOptional
+
+ ELSE
+ InternalError ('expecting a Procedure or ProcType symbol')
END
- END ;
- SetReturnOptional(sym, isopt)
-END CheckOptFunction ;
+ END
+END IsReturnOptionalAny ;
(*
PutFunction - Places a TypeSym as the return type to a procedure Sym.
*)
-PROCEDURE PutFunction (Sym: CARDINAL; TypeSym: CARDINAL) ;
+PROCEDURE PutFunction (tok: CARDINAL; Sym: CARDINAL; kind: ProcedureKind;
+ TypeSym: CARDINAL) ;
VAR
pSym: PtrToSymbol ;
BEGIN
CASE SymbolType OF
ErrorSym: |
- ProcedureSym: CheckOptFunction(Sym, FALSE) ;
- Procedure.ReturnType := TypeSym ;
- PutFunction (Procedure.ProcedureType, TypeSym) |
- ProcTypeSym : CheckOptFunction(Sym, FALSE) ;
- ProcType.ReturnType := TypeSym
+ ProcedureSym: Procedure.ReturnType := TypeSym ;
+ Procedure.Decl[kind].ReturnTypeTok := tok ;
+ PutFunction (tok, Procedure.ProcedureType, kind, TypeSym) |
+ ProcTypeSym : ProcType.ReturnType := TypeSym ;
+ ProcType.ReturnTypeTok := tok ;
ELSE
InternalError ('expecting a Procedure or ProcType symbol')
PutOptFunction - places a TypeSym as the optional return type to a procedure Sym.
*)
-PROCEDURE PutOptFunction (Sym: CARDINAL; TypeSym: CARDINAL) ;
+PROCEDURE PutOptFunction (tok: CARDINAL; Sym: CARDINAL; kind: ProcedureKind; TypeSym: CARDINAL) ;
VAR
pSym: PtrToSymbol ;
BEGIN
CASE SymbolType OF
ErrorSym: |
- ProcedureSym: CheckOptFunction (Sym, TRUE) ;
- Procedure.ReturnType := TypeSym ;
- PutOptFunction (Procedure.ProcedureType, TypeSym) |
- ProcTypeSym : CheckOptFunction (Sym, TRUE) ;
- ProcType.ReturnType := TypeSym
+ ProcedureSym: Procedure.ReturnType := TypeSym ;
+ Procedure.Decl[kind].ReturnOptional := TRUE ;
+ Procedure.Decl[kind].ReturnTypeTok := tok ;
+ PutOptFunction (tok, Procedure.ProcedureType, kind, TypeSym) |
+ ProcTypeSym : ProcType.ReturnType := TypeSym ;
+ ProcType.ReturnTypeTok := tok ;
ELSE
InternalError ('expecting a Procedure or ProcType symbol')
PROCEDURE MakeVariableForParam (tok : CARDINAL;
ParamName: Name;
ProcSym : CARDINAL;
+ kind : ProcedureKind;
no : CARDINAL;
+ ParmType : CARDINAL;
typetok : CARDINAL) : CARDINAL ;
VAR
pSym : PtrToSymbol ;
END
END ;
(* Note that the parameter is now treated as a local variable. *)
- PutVarTok (VariableSym, GetType(GetNthParam(ProcSym, no)), typetok) ;
+ PutVarTok (VariableSym, ParmType, typetok) ;
PutDeclared (tok, VariableSym) ;
(*
Normal VAR parameters have LeftValue,
however Unbounded VAR parameters have RightValue.
Non VAR parameters always have RightValue.
*)
- IF IsVarParam (ProcSym, no) AND (NOT IsUnboundedParam (ProcSym, no))
+ IF IsVarParam (ProcSym, kind, no) AND (NOT IsUnboundedParam (ProcSym, kind, no))
THEN
PutMode (VariableSym, LeftValue)
ELSE
(*
PutParam - Places a Non VAR parameter ParamName with type ParamType into
- procedure Sym. The parameter number is ParamNo.
+ procedure Sym:kind. The parameter number is ParamNo.
If the procedure Sym already has this parameter then
the parameter is checked for consistancy and the
consistancy test is returned.
*)
-PROCEDURE PutParam (tok: CARDINAL; Sym: CARDINAL; ParamNo: CARDINAL;
+PROCEDURE PutParam (tok: CARDINAL; Sym: CARDINAL;
+ kind: ProcedureKind; ParamNo: CARDINAL;
ParamName: Name; ParamType: CARDINAL;
isUnbounded: BOOLEAN; typetok: CARDINAL) : BOOLEAN ;
VAR
ParSym : CARDINAL ;
VariableSym: CARDINAL ;
BEGIN
- IF ParamNo<=NoOfParam(Sym)
+ IF GetProcedureParametersDefined (Sym, kind)
THEN
+ (* ParamNo <= NoOfParamAny (Sym) *)
InternalError ('why are we trying to put parameters again')
ELSE
(* Add a new parameter *)
InitWhereDeclaredTok(tok, At)
END
END ;
- AddParameter(Sym, ParSym) ;
- IF ParamName#NulName
+ AddParameter (Sym, kind, ParSym) ;
+ (* Only declare a parameter as a local variable if it has not been done before.
+ It might be declared during the definition module, forward declaration or
+ proper procedure. Name mismatches are checked in P2SymBuild.mod. *)
+ IF (ParamName # NulName) AND (GetNth (Sym, ParamNo) = NulSym)
THEN
- VariableSym := MakeVariableForParam(tok, ParamName, Sym,
- ParamNo, typetok) ;
+ VariableSym := MakeVariableForParam (tok, ParamName, Sym, kind,
+ ParamNo, ParamType, typetok) ;
IF VariableSym=NulSym
THEN
RETURN( FALSE )
(*
PutVarParam - Places a Non VAR parameter ParamName with type
- ParamType into procedure Sym.
+ ParamType into procedure Sym:kind.
The parameter number is ParamNo.
If the procedure Sym already has this parameter then
the parameter is checked for consistancy and the
consistancy test is returned.
*)
-PROCEDURE PutVarParam (tok: CARDINAL; Sym: CARDINAL; ParamNo: CARDINAL;
+PROCEDURE PutVarParam (tok: CARDINAL; Sym: CARDINAL; kind: ProcedureKind;
+ ParamNo: CARDINAL;
ParamName: Name; ParamType: CARDINAL;
isUnbounded: BOOLEAN; typetok: CARDINAL) : BOOLEAN ;
VAR
ParSym : CARDINAL ;
VariableSym: CARDINAL ;
BEGIN
- IF ParamNo<=NoOfParam(Sym)
+ IF GetProcedureParametersDefined (Sym, kind)
THEN
InternalError ('why are we trying to put parameters again')
ELSE
InitWhereDeclaredTok(tok, At)
END
END ;
- AddParameter(Sym, ParSym) ;
- IF ParamName#NulName
+ AddParameter (Sym, kind, ParSym) ;
+ (* Only declare a parameter as a local variable if it has not been done before.
+ It might be declared during the definition module, forward declaration or
+ proper procedure. Name mismatches are checked in P2SymBuild.mod. *)
+ IF (ParamName # NulName) AND (GetNth (Sym, ParamNo) = NulSym)
THEN
- VariableSym := MakeVariableForParam(tok, ParamName, Sym,
- ParamNo, typetok) ;
+ VariableSym := MakeVariableForParam (tok, ParamName, Sym, kind,
+ ParamNo, ParamType, typetok) ;
IF VariableSym=NulSym
THEN
RETURN( FALSE )
pSym^.VarParam.ShadowVar := VariableSym
END
END ;
- AddProcedureProcTypeParam (Sym, ParamType, isUnbounded, TRUE) ;
- RETURN( TRUE )
- END
+ AddProcedureProcTypeParam (Sym, ParamType, isUnbounded, TRUE)
+ END ;
+ RETURN( TRUE )
END PutVarParam ;
(*
- PutParamName - assigns a name, name, to paramater, no, of procedure,
- ProcSym.
+ PutParamName - assigns a name to paramater no of procedure ProcSym:kind.
*)
-PROCEDURE PutParamName (tok: CARDINAL; ProcSym: CARDINAL; no: CARDINAL;
- name: Name; typetok: CARDINAL) ;
+PROCEDURE PutParamName (tok: CARDINAL; ProcSym: CARDINAL; kind: ProcedureKind;
+ no: CARDINAL;
+ name: Name; ParamType: CARDINAL; typetok: CARDINAL) ;
VAR
pSym : PtrToSymbol ;
ParSym: CARDINAL ;
CASE SymbolType OF
ErrorSym : RETURN |
- ProcedureSym: ParSym := GetItemFromList(Procedure.ListOfParam, no) |
+ ProcedureSym: ParSym := GetItemFromList(Procedure.Decl[kind].ListOfParam,
+ no) |
ProcTypeSym : ParSym := GetItemFromList(ProcType.ListOfParam, no)
ELSE
ParamSym: IF Param.name=NulName
THEN
Param.name := name ;
- Param.ShadowVar := MakeVariableForParam(tok, name, ProcSym,
- no, typetok)
+ Param.ShadowVar := MakeVariableForParam(tok, name, ProcSym, kind,
+ no, ParamType, 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, typetok)
+ VarParam.ShadowVar := MakeVariableForParam(tok, name, ProcSym, kind,
+ no, ParamType, typetok)
ELSE
InternalError ('name of parameter has already been assigned')
END
AddParameter - adds a parameter ParSym to a procedure Sym.
*)
-PROCEDURE AddParameter (Sym: CARDINAL; ParSym: CARDINAL) ;
+PROCEDURE AddParameter (Sym: CARDINAL; kind: ProcedureKind; ParSym: CARDINAL) ;
VAR
pSym: PtrToSymbol ;
BEGIN
CASE SymbolType OF
ErrorSym: |
- ProcedureSym: PutItemIntoList(Procedure.ListOfParam, ParSym) |
- ProcTypeSym : PutItemIntoList(ProcType.ListOfParam, ParSym)
+ ProcedureSym: PutItemIntoList (Procedure.Decl[kind].ListOfParam, ParSym) |
+ ProcTypeSym : PutItemIntoList (ProcType.ListOfParam, ParSym)
ELSE
- InternalError ('expecting a Procedure symbol')
+ InternalError ('expecting a Procedure or ProcType symbol')
END
END
END AddParameter ;
WITH pSym^ DO
CASE SymbolType OF
- ProcedureSym: IF isVarParam
+ ProcedureSym: IF Procedure.BuildProcType
THEN
- PutProcTypeVarParam (Procedure.ProcedureType,
+ IF isVarParam
+ THEN
+ PutProcTypeVarParam (Procedure.ProcedureType,
+ ParamType, isUnbounded)
+ ELSE
+ PutProcTypeParam (Procedure.ProcedureType,
ParamType, isUnbounded)
- ELSE
- PutProcTypeParam (Procedure.ProcedureType,
- ParamType, isUnbounded)
+ END
END
ELSE
is a VAR parameter.
*)
-PROCEDURE IsVarParam (Sym: CARDINAL; ParamNo: CARDINAL) : BOOLEAN ;
+PROCEDURE IsVarParam (Sym: CARDINAL; kind: ProcedureKind;
+ ParamNo: CARDINAL) : BOOLEAN ;
VAR
pSym : PtrToSymbol ;
IsVar: BOOLEAN ;
CASE SymbolType OF
ErrorSym : |
- ProcedureSym: IsVar := IsNthParamVar(Procedure.ListOfParam, ParamNo) |
+ ProcedureSym: IsVar := IsNthParamVar(Procedure.Decl[kind].ListOfParam,
+ ParamNo) |
ProcTypeSym : IsVar := IsNthParamVar(ProcType.ListOfParam, ParamNo)
ELSE
END IsVarParam ;
+(*
+ IsVarParamAny - Returns a conditional depending whether parameter ParamNo
+ is a VAR parameter.
+*)
+
+PROCEDURE IsVarParamAny (Sym: CARDINAL; ParamNo: CARDINAL) : BOOLEAN ;
+VAR
+ pSym: PtrToSymbol ;
+ kind: ProcedureKind ;
+BEGIN
+ pSym := GetPsym(Sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ ErrorSym : |
+ ProcedureSym: FOR kind := MIN (ProcedureKind) TO MAX (ProcedureKind) DO
+ IF GetProcedureDefined (Sym, kind)
+ THEN
+ RETURN IsNthParamVar (Procedure.Decl[kind].ListOfParam,
+ ParamNo)
+ END
+ END |
+ ProcTypeSym : RETURN IsNthParamVar(ProcType.ListOfParam, ParamNo)
+
+ ELSE
+ InternalError ('expecting a Procedure or ProcType symbol')
+ END
+ END ;
+ RETURN FALSE
+END IsVarParamAny ;
+
+
(*
IsNthParamVar - returns true if the n th parameter of the parameter list,
List, is a VAR parameter.
NoOfParam - Returns the number of parameters that procedure Sym contains.
*)
-PROCEDURE NoOfParam (Sym: CARDINAL) : CARDINAL ;
+PROCEDURE NoOfParam (Sym: CARDINAL; kind: ProcedureKind) : CARDINAL ;
VAR
pSym: PtrToSymbol ;
n : CARDINAL ;
BEGIN
- CheckLegal(Sym) ;
+ AssertInRange(Sym) ;
pSym := GetPsym(Sym) ;
WITH pSym^ DO
CASE SymbolType OF
ErrorSym : n := 0 |
- ProcedureSym: n := NoOfItemsInList(Procedure.ListOfParam) |
+ ProcedureSym: n := NoOfItemsInList(Procedure.Decl[kind].ListOfParam) |
ProcTypeSym : n := NoOfItemsInList(ProcType.ListOfParam)
ELSE
END NoOfParam ;
+(*
+ NoOfParamAny - return the number of parameters for sym.
+*)
+
+PROCEDURE NoOfParamAny (sym: CARDINAL) : CARDINAL ;
+VAR
+ kind: ProcedureKind ;
+ pSym: PtrToSymbol ;
+BEGIN
+ AssertInRange (sym) ;
+ pSym := GetPsym (sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ ErrorSym : RETURN 0 |
+ ProcedureSym: FOR kind := MIN (ProcedureKind) TO MAX (ProcedureKind) DO
+ IF GetProcedureParametersDefined (sym, kind)
+ THEN
+ RETURN NoOfParam (sym, kind)
+ END
+ END |
+ ProcTypeSym : RETURN NoOfItemsInList(ProcType.ListOfParam)
+
+ ELSE
+ InternalError ('expecting a Procedure or ProcType symbol')
+ END
+ END ;
+ RETURN 0
+END NoOfParamAny ;
+
+
(*
HasVarParameters - returns TRUE if procedure, p, has any VAR parameters.
*)
VAR
i, n: CARDINAL ;
BEGIN
- n := NoOfParam(p) ;
+ n := NoOfParamAny (p) ;
i := 1 ;
- WHILE i<=n DO
- IF IsVarParam(p, i)
+ WHILE i <= n DO
+ IF IsParameterVar (GetNthParamAny (p, i))
THEN
RETURN TRUE
END ;
VAR
pSym: PtrToSymbol ;
BEGIN
- CheckLegal(Sym) ;
+ AssertInRange(Sym) ;
pSym := GetPsym(Sym) ;
WITH pSym^ DO
CASE SymbolType OF
ErrorSym: |
- ProcedureSym: Procedure.HasVarArgs := TRUE |
+ (* Currently can only declare var args in a definition module. *)
+ ProcedureSym: Procedure.Decl[DefProcedure].HasVarArgs := TRUE |
ProcTypeSym : ProcType.HasVarArgs := TRUE
ELSE
VAR
pSym: PtrToSymbol ;
BEGIN
- CheckLegal(Sym) ;
+ AssertInRange(Sym) ;
pSym := GetPsym(Sym) ;
WITH pSym^ DO
CASE SymbolType OF
ErrorSym : RETURN( FALSE ) |
- ProcedureSym: RETURN( Procedure.HasVarArgs ) |
+ (* Currently can only declare var args in a definition module. *)
+ ProcedureSym: RETURN( Procedure.Decl[DefProcedure].HasVarArgs ) |
ProcTypeSym : RETURN( ProcType.HasVarArgs )
ELSE
uses an optarg.
*)
-PROCEDURE PutUseOptArg (Sym: CARDINAL) ;
+PROCEDURE PutUseOptArg (Sym: CARDINAL; kind: ProcedureKind) ;
VAR
pSym: PtrToSymbol ;
BEGIN
- CheckLegal(Sym) ;
+ AssertInRange(Sym) ;
pSym := GetPsym(Sym) ;
WITH pSym^ DO
CASE SymbolType OF
ErrorSym: |
- ProcedureSym: Procedure.HasOptArg := TRUE |
+ ProcedureSym: Procedure.Decl[kind].HasOptArg := TRUE |
ProcTypeSym : ProcType.HasOptArg := TRUE
ELSE
UsesOptArg - returns TRUE if procedure, Sym, uses varargs.
*)
-PROCEDURE UsesOptArg (Sym: CARDINAL) : BOOLEAN ;
+PROCEDURE UsesOptArg (Sym: CARDINAL; kind: ProcedureKind) : BOOLEAN ;
VAR
pSym: PtrToSymbol ;
BEGIN
- CheckLegal(Sym) ;
+ AssertInRange(Sym) ;
pSym := GetPsym(Sym) ;
WITH pSym^ DO
CASE SymbolType OF
- ErrorSym : RETURN( FALSE ) |
- ProcedureSym: RETURN( Procedure.HasOptArg ) |
- ProcTypeSym : RETURN( ProcType.HasOptArg )
+ ErrorSym : RETURN FALSE |
+ ProcedureSym: RETURN Procedure.Decl[kind].HasOptArg |
+ ProcTypeSym : RETURN ProcType.HasOptArg
ELSE
InternalError ('expecting a Procedure or ProcType symbol')
END UsesOptArg ;
+(*
+ UsesOptArgAny - returns TRUE if procedure Sym:kind uses an optional argument.
+*)
+
+PROCEDURE UsesOptArgAny (Sym: CARDINAL) : BOOLEAN ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ pSym := GetPsym(Sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ ErrorSym : RETURN FALSE |
+ ProcedureSym: RETURN IsProcedureAnyDefaultBoolean (Sym, FALSE, UsesOptArg) |
+ ProcTypeSym : RETURN ProcType.HasOptArg
+
+ ELSE
+ InternalError ('expecting a Procedure or ProcType symbol')
+ END
+ END
+END UsesOptArgAny ;
+
+
(*
PutOptArgInit - makes symbol, Sym, the initializer value to
procedure, ProcSym.
*)
-PROCEDURE PutOptArgInit (ProcSym, Sym: CARDINAL) ;
+PROCEDURE PutOptArgInit (ProcSym: CARDINAL; Sym: CARDINAL) ;
VAR
pSym: PtrToSymbol ;
BEGIN
- CheckLegal(Sym) ;
+ AssertInRange(Sym) ;
IF NOT IsError(ProcSym)
THEN
- IF UsesOptArg(ProcSym)
- THEN
- pSym := GetPsym(ProcSym) ;
- WITH pSym^ DO
- CASE SymbolType OF
+ pSym := GetPsym(ProcSym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
- ErrorSym : |
- ProcedureSym: Procedure.OptArgInit := Sym |
- ProcTypeSym : ProcType.OptArgInit := Sym
+ ErrorSym : |
+ ProcedureSym: Procedure.OptArgInit := Sym |
+ ProcTypeSym : ProcType.OptArgInit := Sym
- ELSE
- InternalError ('expecting a Procedure or ProcType symbol')
- END
+ ELSE
+ InternalError ('expecting a Procedure or ProcType symbol')
END
END
END
BEGIN
IF NOT IsError(ProcSym)
THEN
- IF UsesOptArg(ProcSym)
- THEN
- pSym := GetPsym(ProcSym) ;
- WITH pSym^ DO
- CASE SymbolType OF
+ pSym := GetPsym(ProcSym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
- ErrorSym : |
- ProcedureSym: RETURN( Procedure.OptArgInit ) |
- ProcTypeSym : RETURN( ProcType.OptArgInit )
+ ErrorSym : |
+ ProcedureSym: RETURN( Procedure.OptArgInit ) |
+ ProcTypeSym : RETURN( ProcType.OptArgInit )
- ELSE
- InternalError ('expecting a Procedure or ProcType symbol')
- END
+ ELSE
+ InternalError ('expecting a Procedure or ProcType symbol')
END
END
END ;
therefore we must subtract the Parameter Number from local variable
total.
*)
- RETURN( n-NoOfParam(Sym) )
+ RETURN( n - NoOfParamAny (Sym) )
END NoOfLocalVar ;
ParamNo is an unbounded array procedure parameter.
*)
-PROCEDURE IsUnboundedParam (Sym: CARDINAL; ParamNo: CARDINAL) : BOOLEAN ;
+PROCEDURE IsUnboundedParam (Sym: CARDINAL; kind: ProcedureKind;
+ ParamNo: CARDINAL) : BOOLEAN ;
VAR
param: CARDINAL ;
BEGIN
- Assert(IsProcedure(Sym) OR IsProcType(Sym)) ;
- param := GetNthParam(Sym, ParamNo) ;
- RETURN( IsParameterUnbounded(param) )
+ param := GetNthParam (Sym, kind, ParamNo) ;
+ RETURN IsParameterUnbounded (param)
END IsUnboundedParam ;
+(*
+ IsUnboundedParam - Returns a conditional depending whether parameter
+ ParamNo is an unbounded array procedure parameter.
+*)
+
+PROCEDURE IsUnboundedParamAny (Sym: CARDINAL; ParamNo: CARDINAL) : BOOLEAN ;
+VAR
+ kind: ProcedureKind ;
+BEGIN
+ FOR kind := MIN (ProcedureKind) TO MAX (ProcedureKind) DO
+ IF GetProcedureParametersDefined (Sym, kind)
+ THEN
+ RETURN IsUnboundedParam (Sym, kind, ParamNo)
+ END
+ END ;
+ InternalError ('no procedure kind exists')
+END IsUnboundedParamAny ;
+
+
(*
IsParameter - returns true if Sym is a parameter symbol.
*)
VAR
pSym: PtrToSymbol ;
BEGIN
- CheckLegal(Sym) ;
+ AssertInRange(Sym) ;
pSym := GetPsym(Sym) ;
RETURN( pSym^.SymbolType=ProcedureSym )
END IsProcedure ;
(*
- ProcedureParametersDefined - dictates to procedure symbol, Sym,
- that its parameters have been defined.
+ PutProcedureParametersDefined - the procedure symbol sym:kind
+ parameters have been defined.
*)
-PROCEDURE ProcedureParametersDefined (Sym: CARDINAL) ;
+PROCEDURE PutProcedureParametersDefined (sym: CARDINAL; kind: ProcedureKind) ;
VAR
pSym: PtrToSymbol ;
BEGIN
- CheckLegal(Sym) ;
- pSym := GetPsym(Sym) ;
- WITH pSym^ DO
- CASE SymbolType OF
-
- ErrorSym : |
- ProcedureSym: (* Assert(NOT Procedure.ParamDefined) ; *)
- Procedure.ParamDefined := TRUE
-
- ELSE
- InternalError ('expecting a Procedure symbol')
- END
- END
-END ProcedureParametersDefined ;
-
-
-(*
- AreProcedureParametersDefined - returns true if the parameters to procedure
- symbol, Sym, have been defined.
-*)
-
-PROCEDURE AreProcedureParametersDefined (Sym: CARDINAL) : BOOLEAN ;
-VAR
- pSym: PtrToSymbol ;
-BEGIN
- CheckLegal(Sym) ;
- pSym := GetPsym(Sym) ;
- WITH pSym^ DO
- CASE SymbolType OF
-
- ErrorSym : RETURN( FALSE ) |
- ProcedureSym: RETURN( Procedure.ParamDefined )
-
- ELSE
- InternalError ('expecting a Procedure symbol')
- END
- END
-END AreProcedureParametersDefined ;
-
-
-(*
- ParametersDefinedInDefinition - dictates to procedure symbol, Sym,
- that its parameters have been defined in
- a definition module.
-*)
-
-PROCEDURE ParametersDefinedInDefinition (Sym: CARDINAL) ;
-VAR
- pSym: PtrToSymbol ;
-BEGIN
- CheckLegal(Sym) ;
- pSym := GetPsym(Sym) ;
+ AssertInRange (sym) ;
+ pSym := GetPsym (sym) ;
WITH pSym^ DO
CASE SymbolType OF
ErrorSym : |
- ProcedureSym: Assert(NOT Procedure.DefinedInDef) ;
- Procedure.DefinedInDef := TRUE
+ ProcedureSym: Procedure.Decl[kind].ParamDefined := TRUE ;
+ Procedure.BuildProcType := FALSE |
+ ProcTypeSym :
ELSE
InternalError ('expecting a Procedure symbol')
END
END
-END ParametersDefinedInDefinition ;
+END PutProcedureParametersDefined ;
(*
- AreParametersDefinedInDefinition - returns true if procedure symbol, Sym,
- has had its parameters been defined in
- a definition module.
+ GetProcedureParametersDefined - returns true if procedure symbol sym:kind
+ parameters are defined.
*)
-PROCEDURE AreParametersDefinedInDefinition (Sym: CARDINAL) : BOOLEAN ;
+PROCEDURE GetProcedureParametersDefined (sym: CARDINAL; kind: ProcedureKind) : BOOLEAN ;
VAR
pSym: PtrToSymbol ;
BEGIN
- CheckLegal(Sym) ;
- pSym := GetPsym(Sym) ;
+ AssertInRange (sym) ;
+ pSym := GetPsym (sym) ;
WITH pSym^ DO
CASE SymbolType OF
ErrorSym : RETURN( FALSE ) |
- ProcedureSym: RETURN( Procedure.DefinedInDef )
+ ProcedureSym: RETURN( Procedure.Decl[kind].ParamDefined ) |
+ ProcTypeSym : RETURN( TRUE )
ELSE
InternalError ('expecting a Procedure symbol')
END
END
-END AreParametersDefinedInDefinition ;
+END GetProcedureParametersDefined ;
(*
- ParametersDefinedInImplementation - dictates to procedure symbol, Sym,
- that its parameters have been defined in
- a implemtation module.
+ PutProcedureDefined - the procedure symbol sym:kind is defined.
*)
-PROCEDURE ParametersDefinedInImplementation (Sym: CARDINAL) ;
+PROCEDURE PutProcedureDefined (sym: CARDINAL; kind: ProcedureKind) ;
VAR
pSym: PtrToSymbol ;
BEGIN
- CheckLegal(Sym) ;
- pSym := GetPsym(Sym) ;
+ AssertInRange (sym) ;
+ pSym := GetPsym (sym) ;
WITH pSym^ DO
CASE SymbolType OF
ErrorSym : |
- ProcedureSym: Assert(NOT Procedure.DefinedInImp) ;
- Procedure.DefinedInImp := TRUE
+ ProcedureSym: Procedure.Decl[kind].Defined := TRUE
ELSE
InternalError ('expecting a Procedure symbol')
END
END
-END ParametersDefinedInImplementation ;
+END PutProcedureDefined ;
(*
- AreParametersDefinedInImplementation - returns true if procedure symbol, Sym,
- has had its parameters been defined in
- an implementation module.
+ GetProcedureDefined - returns true if procedure symbol sym:kind
+ is defined.
*)
-PROCEDURE AreParametersDefinedInImplementation (Sym: CARDINAL) : BOOLEAN ;
+PROCEDURE GetProcedureDefined (sym: CARDINAL; kind: ProcedureKind) : BOOLEAN ;
VAR
pSym: PtrToSymbol ;
BEGIN
- CheckLegal(Sym) ;
- pSym := GetPsym(Sym) ;
+ AssertInRange (sym) ;
+ pSym := GetPsym (sym) ;
WITH pSym^ DO
CASE SymbolType OF
ErrorSym : RETURN( FALSE ) |
- ProcedureSym: RETURN( Procedure.DefinedInImp )
-
- ELSE
- InternalError ('expecting a Procedure symbol')
- END
- END
-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
+ ProcedureSym: RETURN( Procedure.Decl[kind].Defined )
ELSE
InternalError ('expecting a Procedure symbol')
END
END
-END PutParametersDefinedByForward ;
+END GetProcedureDefined ;
(*
- GetParametersDefinedByForward - return TRUE if ProcSym has had its parameters
- defined by a FORWARD declaration.
+ IsProcedureAnyBoolean - returns the boolean result from p
+ for any of procedure kind which is defined.
*)
-PROCEDURE GetParametersDefinedByForward (ProcSym: CARDINAL) : BOOLEAN ;
+PROCEDURE IsProcedureAnyBoolean (sym: CARDINAL; p: ProcAnyBoolean) : BOOLEAN ;
VAR
- pSym: PtrToSymbol ;
+ kind: ProcedureKind ;
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')
+ FOR kind := MIN (ProcedureKind) TO MAX (ProcedureKind) DO
+ IF GetProcedureDefined (sym, kind)
+ THEN
+ RETURN p (sym, kind)
END
- END
-END GetParametersDefinedByForward ;
+ END ;
+ InternalError ('no procedure kind exists')
+END IsProcedureAnyBoolean ;
(*
- PutParametersDefinedByProper - records that the parameters have been
- defined in a FORWARD declaration.
+ IsProcedureAnyDefaultBoolean - returns the boolean result from p
+ for any of procedure kind which is defined.
*)
-PROCEDURE PutParametersDefinedByProper (ProcSym: CARDINAL) ;
+PROCEDURE IsProcedureAnyDefaultBoolean (sym: CARDINAL; default: BOOLEAN; p: ProcAnyBoolean) : BOOLEAN ;
VAR
- pSym: PtrToSymbol ;
+ kind: ProcedureKind ;
BEGIN
- CheckLegal (ProcSym) ;
- pSym := GetPsym (ProcSym) ;
- WITH pSym^ DO
- CASE SymbolType OF
-
- ProcedureSym: Procedure.DefinedByProper := TRUE
-
- ELSE
- InternalError ('expecting a Procedure symbol')
+ FOR kind := MIN (ProcedureKind) TO MAX (ProcedureKind) DO
+ IF GetProcedureDefined (sym, kind)
+ THEN
+ RETURN p (sym, kind)
END
- END
-END PutParametersDefinedByProper ;
+ END ;
+ RETURN default
+END IsProcedureAnyDefaultBoolean ;
(*
- GetParametersDefinedByProper - return TRUE if ProcSym has had its parameters
- defined by a FORWARD declaration.
+ IsProcedureAnyNoReturn - return TRUE if any of the defined kinds
+ of procedure sym is declared no return.
*)
-PROCEDURE GetParametersDefinedByProper (ProcSym: CARDINAL) : BOOLEAN ;
-VAR
- pSym: PtrToSymbol ;
+PROCEDURE IsProcedureAnyNoReturn (sym: CARDINAL) : BOOLEAN ;
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 ;
+ RETURN IsProcedureAnyDefaultBoolean (sym, FALSE, IsProcedureNoReturn)
+END IsProcedureAnyNoReturn ;
(*
VAR
pSym: PtrToSymbol ;
BEGIN
- CheckLegal(Sym) ;
+ AssertInRange(Sym) ;
pSym := GetPsym(Sym) ;
RETURN( pSym^.SymbolType=PointerSym )
END IsPointer ;
VAR
pSym: PtrToSymbol ;
BEGIN
- CheckLegal(Sym) ;
+ AssertInRange(Sym) ;
pSym := GetPsym(Sym) ;
RETURN( pSym^.SymbolType=RecordSym )
END IsRecord ;
VAR
pSym: PtrToSymbol ;
BEGIN
- CheckLegal(Sym) ;
+ AssertInRange(Sym) ;
pSym := GetPsym(Sym) ;
RETURN( pSym^.SymbolType=ArraySym )
END IsArray ;
VAR
pSym: PtrToSymbol ;
BEGIN
- CheckLegal(Sym) ;
+ AssertInRange(Sym) ;
pSym := GetPsym(Sym) ;
RETURN( pSym^.SymbolType=EnumerationSym )
END IsEnumeration ;
VAR
pSym: PtrToSymbol ;
BEGIN
- CheckLegal(Sym) ;
+ AssertInRange(Sym) ;
pSym := GetPsym(Sym) ;
RETURN( pSym^.SymbolType=UnboundedSym )
END IsUnbounded ;
VAR
pSym: PtrToSymbol ;
BEGIN
- CheckLegal(Sym) ;
+ AssertInRange(Sym) ;
pSym := GetPsym(Sym) ;
RETURN( pSym^.SymbolType=SetSym )
END IsSet ;
VAR
pSym: PtrToSymbol ;
BEGIN
- CheckLegal (Sym) ;
+ AssertInRange (Sym) ;
pSym := GetPsym (Sym) ;
RETURN (pSym^.SymbolType=SetSym) AND pSym^.Set.ispacked
END IsSetPacked ;
VAR
pSym: PtrToSymbol ;
BEGIN
- CheckLegal(Sym) ;
+ AssertInRange(Sym) ;
pSym := GetPsym(Sym) ;
WITH pSym^ DO
CASE SymbolType OF
VAR
pSym: PtrToSymbol ;
BEGIN
- CheckLegal(Sym) ;
+ AssertInRange(Sym) ;
pSym := GetPsym(Sym) ;
RETURN( pSym^.SymbolType=OAFamilySym )
END IsOAFamily ;
i, n: CARDINAL ;
BEGIN
i := 1 ;
- n := NoOfParam(sym) ;
- WHILE i<=n DO
- p := GetType(GetParam(sym, i)) ;
- IF IsConst(p)
+ n := NoOfParamAny (sym) ;
+ WHILE i <= n DO
+ p := GetType (GetParam (sym, i)) ;
+ IF IsConst (p)
THEN
- MetaError3('the {%1N} formal parameter in procedure {%2Dad} should have a type rather than a constant {%3Dad}',
- i, sym, p)
+ MetaError3 ('the {%1N} formal parameter in procedure {%2Dad} should have a type rather than a constant {%3Dad}',
+ i, sym, p)
END ;
- INC(i)
+ INC (i)
END
END SanityCheckParameters ;
PROCEDURE IsModuleWithinProcedure (sym: CARDINAL) : BOOLEAN ;
BEGIN
- RETURN( GetProcedureScope(sym)#NulSym )
+ RETURN( GetProcedureScope (sym) # NulSym )
END IsModuleWithinProcedure ;
ProcType.HasOptArg := FALSE ; (* Does this proc type use [ ] ? *)
ProcType.OptArgInit := NulSym ; (* The optarg initial value. *)
ProcType.ReturnOptional := FALSE ; (* Is the return value optional? *)
+ ProcType.ReturnTypeTok := UnknownTokenNo ;
ProcType.Scope := GetCurrentScope() ;
(* scope of procedure. *)
ProcType.Size := InitValue() ;
InitWhereDeclared(At)
END
END ;
- AddParameter(Sym, ParSym)
+ AddParameter (Sym, ProperProcedure, ParSym)
END PutProcTypeParam ;
InitWhereDeclared(At)
END
END ;
- AddParameter(Sym, ParSym)
+ AddParameter (Sym, ProperProcedure, ParSym)
END PutProcTypeVarParam ;
(*
- GetDeclaredDef - returns the tokenno where the symbol was declared.
- The priority of declaration is definition, implementation
- and program module.
+ GetDeclaredDef - returns the tokenno where the symbol was declared
+ in the definition module. UnknownTokenNo is returned
+ if no declaration occurred.
*)
PROCEDURE GetDeclaredDef (Sym: CARDINAL) : CARDINAL ;
-VAR
- declared: CARDINAL ;
BEGIN
- declared := GetDeclaredDefinition (Sym) ;
- IF declared = UnknownTokenNo
- THEN
- RETURN GetDeclaredModule (Sym)
- END ;
- RETURN declared
+ RETURN GetDeclaredDefinition (Sym)
END GetDeclaredDef ;
(*
GetDeclaredMod - returns the tokenno where the symbol was declared.
- The priority of declaration is program,
- implementation and definition module.
+ in the program or implementation module.
+ UnknownTokenNo is returned if no declaration occurred.
*)
PROCEDURE GetDeclaredMod (Sym: CARDINAL) : CARDINAL ;
-VAR
- declared: CARDINAL ;
BEGIN
- declared := GetDeclaredModule (Sym) ;
- IF declared = UnknownTokenNo
- THEN
- RETURN GetDeclaredDefinition (Sym)
- END ;
- RETURN declared
+ RETURN GetDeclaredModule (Sym)
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.
+ GetDeclaredFor - returns the token where this forward procedure symbol
+ was declared in the program or implementation module.
+ UnknownTokenNo is returned if no declaration occurred.
*)
PROCEDURE GetDeclaredFor (Sym: CARDINAL) : CARDINAL ;
BEGIN
- RETURN GetProcedureDeclaredForward (Sym)
+ IF IsProcedure (Sym)
+ THEN
+ RETURN GetProcedureDeclaredTok (Sym, ForwardProcedure)
+ ELSE
+ RETURN UnknownTokenNo
+ END
END GetDeclaredFor ;
(*
- GetProcedureDeclaredForward - return the token at which the forward
- declaration procedure occurred.
+ GetProcedureKind - returns the procedure kind given the declaration tok.
+ The declaration tok must match the ident tok in the
+ procedure name. It is only safe to call this
+ procedure function during pass 2 onwards.
*)
-PROCEDURE GetProcedureDeclaredForward (sym: CARDINAL) : CARDINAL ;
+PROCEDURE GetProcedureKind (sym: CARDINAL; tok: CARDINAL) : ProcedureKind ;
VAR
+ kind: ProcedureKind ;
pSym: PtrToSymbol ;
BEGIN
pSym := GetPsym (sym) ;
WITH pSym^ DO
CASE SymbolType OF
- ProcedureSym: RETURN Procedure.Declared.Forward
+ ProcedureSym: FOR kind := MIN (ProcedureKind) TO MAX (ProcedureKind) DO
+ IF Procedure.Decl[kind].ProcedureTok = tok
+ THEN
+ RETURN kind
+ END
+ END |
+ ProcTypeSym: RETURN ProperProcedure
ELSE
- InternalError ('expecting procedure symbol')
+ InternalError ('expecting ProcedureSym symbol')
END
- END
-END GetProcedureDeclaredForward ;
+ END ;
+ InternalError ('ProcedureSym kind has not yet been declared')
+END GetProcedureKind ;
(*
- PutProcedureDeclaredForward - places the tok to which the forward
- declaration procedure occurred.
+ GetProcedureDeclaredTok - return the token where the
+ declaration of procedure sym:kind
+ occurred.
*)
-PROCEDURE PutProcedureDeclaredForward (sym: CARDINAL; tok: CARDINAL) ;
+PROCEDURE GetProcedureDeclaredTok (sym: CARDINAL; kind: ProcedureKind) : CARDINAL ;
VAR
pSym: PtrToSymbol ;
BEGIN
WITH pSym^ DO
CASE SymbolType OF
- ProcedureSym: Procedure.Declared.Forward := tok
+ ProcedureSym: RETURN Procedure.Decl[kind].ProcedureTok
ELSE
InternalError ('expecting procedure symbol')
END
END
-END PutProcedureDeclaredForward ;
+END GetProcedureDeclaredTok ;
(*
- GetProcedureDeclaredProper - return the token at which the forward
- declaration procedure occurred.
+ PutProcedureDeclaredTok - places the tok where the
+ declaration of procedure sym:kind
+ occurred.
*)
-PROCEDURE GetProcedureDeclaredProper (sym: CARDINAL) : CARDINAL ;
+PROCEDURE PutProcedureDeclaredTok (sym: CARDINAL; kind: ProcedureKind;
+ tok: CARDINAL) ;
VAR
pSym: PtrToSymbol ;
BEGIN
WITH pSym^ DO
CASE SymbolType OF
- ProcedureSym: RETURN Procedure.Declared.Proper
+ ProcedureSym: Procedure.Decl[kind].ProcedureTok := tok
ELSE
InternalError ('expecting procedure symbol')
END
END
-END GetProcedureDeclaredProper ;
+END PutProcedureDeclaredTok ;
(*
- PutProcedureDeclaredProper - places the tok to which the forward
- declaration procedure occurred.
+ GetReturnTypeTok - return the token where the
+ return type procedure sym:kind or proctype
+ was defined.
*)
-PROCEDURE PutProcedureDeclaredProper (sym: CARDINAL; tok: CARDINAL) ;
+PROCEDURE GetReturnTypeTok (sym: CARDINAL; kind: ProcedureKind) : CARDINAL ;
VAR
pSym: PtrToSymbol ;
BEGIN
WITH pSym^ DO
CASE SymbolType OF
- ProcedureSym: Procedure.Declared.Proper := tok
+ ProcedureSym: RETURN Procedure.Decl[kind].ReturnTypeTok |
+ ProcTypeSym : RETURN ProcType.ReturnTypeTok
ELSE
InternalError ('expecting procedure symbol')
END
END
-END PutProcedureDeclaredProper ;
+END GetReturnTypeTok ;
(*
- GetProcedureDeclaredDefinition - return the token at which the forward
- declaration procedure occurred.
+ PutReturnTypeTok - places the tok where the
+ return type of procedure sym:kind or proctype
+ was defined.
*)
-PROCEDURE GetProcedureDeclaredDefinition (sym: CARDINAL) : CARDINAL ;
+PROCEDURE PutReturnTypeTok (sym: CARDINAL; kind: ProcedureKind;
+ tok: CARDINAL) ;
VAR
pSym: PtrToSymbol ;
BEGIN
WITH pSym^ DO
CASE SymbolType OF
- ProcedureSym: RETURN Procedure.Declared.Definition
+ ProcedureSym: Procedure.Decl[kind].ReturnTypeTok := tok |
+ ProcTypeSym : ProcType.ReturnTypeTok := tok
ELSE
InternalError ('expecting procedure symbol')
END
END
-END GetProcedureDeclaredDefinition ;
+END PutReturnTypeTok ;
(*
- PutProcedureDeclaredDefinition - places the tok to which the forward
- declaration procedure occurred.
+ GetProcedureKindDesc - return a string describing kind.
*)
-PROCEDURE PutProcedureDeclaredDefinition (sym: CARDINAL; tok: CARDINAL) ;
-VAR
- pSym: PtrToSymbol ;
+PROCEDURE GetProcedureKindDesc (kind: ProcedureKind) : String ;
BEGIN
- pSym := GetPsym (sym) ;
- WITH pSym^ DO
- CASE SymbolType OF
-
- ProcedureSym: Procedure.Declared.Definition := tok
-
- ELSE
- InternalError ('expecting procedure symbol')
- END
- END
-END PutProcedureDeclaredDefinition ;
+ IF kind = ProperProcedure
+ THEN
+ RETURN InitString ('proper procedure')
+ ELSIF kind = ForwardProcedure
+ THEN
+ RETURN InitString ('forward procedure')
+ ELSIF kind = DefProcedure
+ THEN
+ RETURN InitString ('definition procedure')
+ END ;
+ InternalError ('unknown kind value')
+END GetProcedureKindDesc ;
(*
PROCEDURE IsProcedureVariable (Sym: CARDINAL) : BOOLEAN ;
BEGIN
- CheckLegal(Sym) ;
+ AssertInRange(Sym) ;
RETURN( IsVar(Sym) AND IsProcedure(GetVarScope(Sym)) )
END IsProcedureVariable ;
PROCEDURE IsAModula2Type (Sym: CARDINAL) : BOOLEAN ;
BEGIN
- CheckLegal(Sym) ;
+ AssertInRange(Sym) ;
RETURN(
IsType(Sym) OR IsRecord(Sym) OR IsPointer(Sym) OR
IsEnumeration(Sym) OR IsSubrange(Sym) OR IsArray(Sym) OR
PROCEDURE GetParam (Sym: CARDINAL; ParamNo: CARDINAL) : CARDINAL ;
BEGIN
- CheckLegal(Sym) ;
+ AssertInRange(Sym) ;
IF ParamNo=0
THEN
(* Parameter Zero is the return argument for the Function *)
RETURN(GetType(Sym))
ELSE
- RETURN(GetNthParam(Sym, ParamNo))
+ RETURN (GetNthParamAny (Sym, ParamNo))
END
END GetParam ;
VAR
pSym: PtrToSymbol ;
BEGIN
- CheckLegal(Sym) ;
+ AssertInRange(Sym) ;
pSym := GetPsym(Sym) ;
WITH pSym^ DO
CASE SymbolType OF
VAR
pSym: PtrToSymbol ;
BEGIN
- CheckLegal(Sym) ;
+ AssertInRange(Sym) ;
pSym := GetPsym(Sym) ;
WITH pSym^ DO
CASE SymbolType OF
VAR
pSym: PtrToSymbol ;
BEGIN
- CheckLegal(Sym) ;
+ AssertInRange(Sym) ;
pSym := GetPsym(Sym) ;
WITH pSym^ DO
CASE SymbolType OF
VAR
pSym: PtrToSymbol ;
BEGIN
- CheckLegal(Sym) ;
+ AssertInRange(Sym) ;
pSym := GetPsym(Sym) ;
WITH pSym^ DO
CASE SymbolType OF
VAR
pSym: PtrToSymbol ;
BEGIN
- CheckLegal(Sym) ;
+ AssertInRange(Sym) ;
pSym := GetPsym(Sym) ;
WITH pSym^ DO
CASE SymbolType OF
(*
- PushOffset - pushes the Offset of Sym.
+ PopSize - pops the ALU stack into Size of Sym.
*)
-PROCEDURE PushOffset (Sym: CARDINAL) ;
+PROCEDURE PopSize (Sym: CARDINAL) ;
VAR
pSym: PtrToSymbol ;
BEGIN
- CheckLegal(Sym) ;
+ AssertInRange(Sym) ;
pSym := GetPsym(Sym) ;
WITH pSym^ DO
CASE SymbolType OF
- VarSym : PushFrom(Var.Offset) |
- RecordFieldSym : PushFrom(RecordField.Offset) |
- VarientFieldSym : PushFrom(VarientField.Offset)
+ ProcedureSym : PopInto(Procedure.Size) |
+ VarSym : PopInto(Var.Size) |
+ TypeSym : PopInto(Type.Size) |
+ RecordSym : PopInto(Record.Size) |
+ VarientSym : PopInto(Varient.Size) |
+ EnumerationSym : PopInto(Enumeration.Size) |
+ PointerSym : PopInto(Pointer.Size) |
+ ArraySym : PopInto(Array.Size) |
+ RecordFieldSym : PopInto(RecordField.Size) |
+ VarientFieldSym : PopInto(VarientField.Size) |
+ SubrangeSym : PopInto(Subrange.Size) |
+ SubscriptSym : PopInto(Subscript.Size) |
+ ProcTypeSym : PopInto(ProcType.Size) |
+ UnboundedSym : PopInto(Unbounded.Size) |
+ SetSym : PopInto(Set.Size)
ELSE
InternalError ('not expecting this kind of symbol')
END
END
-END PushOffset ;
+END PopSize ;
(*
VAR
pSym: PtrToSymbol ;
BEGIN
- CheckLegal(Sym) ;
+ AssertInRange(Sym) ;
pSym := GetPsym(Sym) ;
WITH pSym^ DO
CASE SymbolType OF
pSym: PtrToSymbol ;
a : ARRAY [0..10] OF CHAR ;
BEGIN
- CheckLegal (Sym) ;
+ AssertInRange (Sym) ;
pSym := GetPsym (Sym) ;
WITH pSym^ DO
CASE SymbolType OF
END PushConstString ;
-(*
- PushParamSize - push the size of parameter, ParamNo,
- of procedure Sym onto the ALU stack.
-*)
-
-PROCEDURE PushParamSize (Sym: CARDINAL; ParamNo: CARDINAL) ;
-VAR
- p, Type: CARDINAL ;
-BEGIN
- CheckLegal(Sym) ;
- Assert(IsProcedure(Sym) OR IsProcType(Sym)) ;
- IF ParamNo=0
- THEN
- PushSize(GetType(Sym))
- ELSE
- (*
- can use GetNthParam but 1..n returns parameter.
- But 0 yields the function return type.
-
- Note that VAR Unbounded parameters and non VAR Unbounded parameters
- contain the unbounded descriptor. VAR unbounded parameters
- do NOT JUST contain an address re: other VAR parameters.
- *)
- IF IsVarParam(Sym, ParamNo) AND (NOT IsUnboundedParam(Sym, ParamNo))
- THEN
- PushSize(Address) (* VAR parameters point to the variable *)
- ELSE
- p := GetNthParam(Sym, ParamNo) ; (* nth Parameter *)
- (*
- N.B. chose to get the Type of the parameter rather than the Var
- because ProcType's have Type but no Var associated with them.
- *)
- Type := GetType(p) ; (* ie Variable from Procedure Sym *)
- Assert(p#NulSym) ; (* If this fails then ParamNo is out of range *)
- PushSize(Type)
- END
- END
-END PushParamSize ;
-
-
-(*
- PushSumOfLocalVarSize - push the total size of all local variables
- onto the ALU stack.
-*)
-
-PROCEDURE PushSumOfLocalVarSize (Sym: CARDINAL) ;
-VAR
- pSym: PtrToSymbol ;
-BEGIN
- CheckLegal(Sym) ;
- pSym := GetPsym(Sym) ;
- WITH pSym^ DO
- CASE SymbolType OF
-
- ProcedureSym,
- DefImpSym,
- ModuleSym : PushSize(Sym)
-
- ELSE
- InternalError ('expecting Procedure, DefImp or Module symbol')
- END
- END
-END PushSumOfLocalVarSize ;
-
-
-(*
- PushSumOfParamSize - push the total size of all parameters onto
- the ALU stack.
-*)
-
-PROCEDURE PushSumOfParamSize (Sym: CARDINAL) ;
-VAR
- pSym: PtrToSymbol ;
-BEGIN
- CheckLegal(Sym) ;
- pSym := GetPsym(Sym) ;
- WITH pSym^ DO
- CASE SymbolType OF
-
- ProcedureSym: PushFrom(Procedure.TotalParamSize) |
- ProcTypeSym : PushFrom(ProcType.TotalParamSize)
-
- ELSE
- InternalError ('expecting Procedure or ProcType symbol')
- END
- END
-END PushSumOfParamSize ;
-
-
(*
PushVarSize - pushes the size of a variable, Sym.
The runtime size of Sym will depend upon its addressing mode,
PROCEDURE PushVarSize (Sym: CARDINAL) ;
BEGIN
- CheckLegal(Sym) ;
+ AssertInRange(Sym) ;
Assert(IsVar(Sym)) ;
IF GetMode(Sym)=LeftValue
THEN
VAR
pSym: PtrToSymbol ;
BEGIN
- CheckLegal(Sym) ;
+ AssertInRange(Sym) ;
pSym := GetPsym(Sym) ;
WITH pSym^ DO
CASE SymbolType OF
END PopValue ;
-(*
- PopSize - pops the ALU stack into Size of Sym.
-*)
-
-PROCEDURE PopSize (Sym: CARDINAL) ;
-VAR
- pSym: PtrToSymbol ;
-BEGIN
- CheckLegal(Sym) ;
- pSym := GetPsym(Sym) ;
- WITH pSym^ DO
- CASE SymbolType OF
-
- ProcedureSym : PopInto(Procedure.Size) |
- VarSym : PopInto(Var.Size) |
- TypeSym : PopInto(Type.Size) |
- RecordSym : PopInto(Record.Size) |
- VarientSym : PopInto(Varient.Size) |
- EnumerationSym : PopInto(Enumeration.Size) |
- PointerSym : PopInto(Pointer.Size) |
- ArraySym : PopInto(Array.Size) |
- RecordFieldSym : PopInto(RecordField.Size) |
- VarientFieldSym : PopInto(VarientField.Size) |
- SubrangeSym : PopInto(Subrange.Size) |
- SubscriptSym : PopInto(Subscript.Size) |
- ProcTypeSym : PopInto(ProcType.Size) |
- UnboundedSym : PopInto(Unbounded.Size) |
- SetSym : PopInto(Set.Size)
-
- ELSE
- InternalError ('not expecting this kind of symbol')
- END
- END
-END PopSize ;
-
-
-(*
- PopOffset - pops the ALU stack into Offset of Sym.
-*)
-
-PROCEDURE PopOffset (Sym: CARDINAL) ;
-VAR
- pSym: PtrToSymbol ;
-BEGIN
- CheckLegal(Sym) ;
- pSym := GetPsym(Sym) ;
- WITH pSym^ DO
- CASE SymbolType OF
-
- VarSym : PopInto(Var.Offset) |
- RecordFieldSym : PopInto(RecordField.Offset) |
- VarientFieldSym : PopInto(VarientField.Offset)
-
- ELSE
- InternalError ('not expecting this kind of symbol')
- END
- END
-END PopOffset ;
-
-
-(*
- PopSumOfParamSize - pop the total value on the ALU stack as the
- sum of all parameters.
-*)
-
-PROCEDURE PopSumOfParamSize (Sym: CARDINAL) ;
-VAR
- pSym: PtrToSymbol ;
-BEGIN
- CheckLegal(Sym) ;
- pSym := GetPsym(Sym) ;
- WITH pSym^ DO
- CASE SymbolType OF
-
- ProcedureSym: PopInto(Procedure.TotalParamSize) |
- ProcTypeSym : PopInto(ProcType.TotalParamSize)
-
- ELSE
- InternalError ('expecting Procedure or ProcType symbol')
- END
- END
-END PopSumOfParamSize ;
-
-
(*
PutAlignment - assigns the alignment constant associated with,
type, with, align.
PROCEDURE Finished (p: ADDRESS) ;
BEGIN
- Halt('process terminated illegally',
- __FILE__, __FUNCTION__, __LINE__)
+ Halt ('process terminated illegally',
+ __FILE__, __FUNCTION__, __LINE__)
END Finished ;
--- /dev/null
+MODULE badexpression3 ;
+
+VAR
+ c: CARDINAL ;
+ i: INTEGER ;
+ r: CARDINAL ;
+BEGIN
+ c := 1 ;
+ i := 2 ;
+ r := c + i
+END badexpression3.
--- /dev/null
+DEFINITION MODULE badparam4 ;
+
+PROCEDURE foo (x, y: CARDINAL) ;
+
+END badparam4.
--- /dev/null
+IMPLEMENTATION MODULE badparam4 ;
+
+PROCEDURE foo (x: CARDINAL) ;
+BEGIN
+
+END foo ;
+
+END badparam4.
projects / thirdparty / gcc.git / commitdiff
