MakeSubscript, PutSubscript,
PutArray, GetType, IsArray,
IsProcType, MakeProcType,
- PutProcTypeVarParam, PutProcTypeParam,
PutProcedureBuiltin, PutProcedureInline,
GetSymName,
ResolveImports, PutDeclared,
importStatementCount: CARDINAL ;
-(*
- CheckFileName - checks to see that the module name matches the file name.
-*)
-
-(*
-PROCEDURE CheckFileName (tok: CARDINAL; name: Name; ModuleType: ARRAY OF CHAR) ;
-VAR
- ext,
- basename: INTEGER ;
- s,
- FileName: String ;
-BEGIN
- FileName := GetFileName() ;
- basename := RIndex(FileName, '/', 0) ;
- IF basename=-1
- THEN
- basename := 0
- END ;
- ext := RIndex(FileName, '.', 0) ;
- IF ext=-1
- THEN
- ext := 0
- END ;
- FileName := Slice(FileName, basename, ext) ;
- IF EqualCharStar(FileName, KeyToCharStar(name))
- THEN
- FileName := KillString(FileName)
- ELSE
- s := ConCat (InitString (ModuleType),
- Mark (InitString (" module name {%1Ea} is inconsistant with the filename {%F{%2a}}"))) ;
- MetaErrorString2 (s, MakeError (tok, name), MakeErrorS (tok, FileName))
- END
-END CheckFileName ;
-*)
-
-
(*
StartBuildDefinitionModule - Creates a definition module and starts
a new scope.
END ;
IF NameStart#NameEnd
THEN
- MetaError1 ('inconsistant definition module name {%1Wa}', MakeError (start, NameStart))
+ MetaError1 ('inconsistent definition module name {%1Wa}', MakeError (start, NameStart))
END ;
LeaveBlock
END P1EndBuildDefinitionModule ;
IF NameStart#NameEnd
THEN
MetaErrorT1 (end,
- 'inconsistant implementation module name {%1Wa}', MakeError (start, NameStart))
+ 'inconsistent implementation module name {%1Wa}', MakeError (start, NameStart))
END ;
LeaveBlock
END P1EndBuildImplementationModule ;
IF NameStart#NameEnd
THEN
MetaErrorT1 (end,
- 'inconsistant program module name {%1Wa}', MakeError (start, NameStart))
+ 'inconsistent program module name {%1Wa}', MakeError (start, NameStart))
END ;
LeaveBlock
END P1EndBuildProgramModule ;
IF NameStart#NameEnd
THEN
MetaErrorT1 (end,
- 'inconsistant inner module name {%1Wa}', MakeError (start, NameStart))
+ 'inconsistent inner module name {%1Wa}', MakeError (start, NameStart))
END ;
LeaveBlock
END EndBuildInnerModule ;
END ;
IF NameStart#NameEnd
THEN
- WriteFormat2('inconsistant definition module name, module began as (%a) and ended with (%a)', NameStart, NameEnd)
+ WriteFormat2('inconsistent definition module name, module began as (%a) and ended with (%a)', NameStart, NameEnd)
END ;
M2Error.LeaveErrorScope
END P2EndBuildDefModule ;
PopT (NameEnd) ;
IF NameStart#NameEnd
THEN
- WriteFormat1('inconsistant implementation module name %a', NameStart)
+ WriteFormat1('inconsistent implementation module name %a', NameStart)
END ;
M2Error.LeaveErrorScope
END P2EndBuildImplementationModule ;
END ;
IF NameStart#NameEnd
THEN
- WriteFormat2('inconsistant program module name %a does not match %a', NameStart, NameEnd)
+ WriteFormat2('inconsistent program module name %a does not match %a', NameStart, NameEnd)
END ;
M2Error.LeaveErrorScope
END P2EndBuildProgramModule ;
PopT(NameEnd) ;
IF NameStart#NameEnd
THEN
- WriteFormat2('inconsistant inner module name %a does not match %a',
+ WriteFormat2('inconsistent inner module name %a does not match %a',
NameStart, NameEnd)
END ;
M2Error.LeaveErrorScope
(* WarnStringAt (InitString ('parampos?'), OperandTok (pi)) ; *)
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',
+ ParameterError ('declaration of procedure {%%1a} in the %s differs from the %s, {%%2N} parameter is inconsistent, %s',
'the parameter {%3EHa} was not declared as an ARRAY OF type',
'the parameter {%3EVa} was declared as an ARRAY OF type',
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',
+ ParameterError ('declaration of procedure {%%1a} in the %s differs from the %s, {%%2N} parameter is inconsistent, %s',
'the parameter {%3EHa} was declared as an ARRAY OF type',
'the parameter {%3EVa} was not declared as an ARRAY OF type',
ParamTotal+i, ProcSym, curkind, prevkind)
THEN
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',
+ ParameterError ('declaration of procedure {%%1a} in the %s differs from the %s, {%%2N} parameter is inconsistent, %s',
'the dynamic array parameter {%3EHa} was declared with a different of dimensions',
'the dynamic array parameter {%3EVa} was declared with a different of dimensions',
ParamTotal+i, ProcSym, curkind, prevkind)
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',
+ ParameterError ('declaration of procedure {%%1a} in the %s differs from the %s, {%%2N} parameter is inconsistent, %s',
'{%3EHa} was not declared as a {%kVAR} parameter',
'{%3EVa} was declared as a {%kVAR} parameter',
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',
+ ParameterError ('declaration of procedure {%%1a} in the %s differs from the %s, {%%2N} parameter is inconsistent, %s',
'{%3EHa} was declared as a {%kVAR} parameter',
'{%3EVa} was not declared as a {%kVAR} parameter',
ParamTotal+i, ProcSym, curkind, prevkind)
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',
+ ParameterError ('procedure {%%1a} in the %s differs from the %s, {%%2N} parameter name is inconsistent, %s',
'named as {%3EVa}',
'named as {%3EVa}',
ParamTotal+i, ProcSym, curkind, prevkind)
(NOT IsUnknown(SkipType(ParamIType)))
THEN
(* Different parameter types. *)
- ParameterError ('declaration in the %s differs from the %s, {%%2N} parameter is inconsistant, %s',
+ ParameterError ('declaration in the %s differs from the %s, {%%2N} parameter is inconsistent, %s',
'the parameter {%3EHa} was declared with a different type',
'the parameter {%3EVa} was declared with a different type',
ParamTotal+i, ProcSym, curkind, prevkind)
IF Var=VarTok
THEN
(* VAR parameter *)
- PutProcTypeVarParam(ProcTypeSym, TypeSym, IsUnbounded(TypeSym))
+ PutProcTypeVarParam (tok, ProcTypeSym, TypeSym, IsUnbounded (TypeSym))
ELSE
(* Non VAR parameter *)
- PutProcTypeParam(ProcTypeSym, TypeSym, IsUnbounded(TypeSym))
+ PutProcTypeParam (tok, ProcTypeSym, TypeSym, IsUnbounded (TypeSym))
END ;
PushT(ProcTypeSym) ;
Annotate("%1s(%1d)||proc type")
PopT(NameStart) ;
IF NameStart#NameEnd
THEN
- WriteFormat2('inconsistant definition module was named (%a) and concluded as (%a)',
+ WriteFormat2('inconsistent definition module was named (%a) and concluded as (%a)',
NameStart, NameEnd)
END ;
M2Error.LeaveErrorScope
PopT(NameStart) ;
IF NameStart#NameEnd
THEN
- WriteFormat2('inconsistant definition module was named (%a) and concluded as (%a)',
+ WriteFormat2('inconsistent definition module was named (%a) and concluded as (%a)',
NameStart, NameEnd)
END ;
M2Error.LeaveErrorScope
par := GetParam (p, i) ;
IF IsParameterVar (par)
THEN
- PutProcTypeVarParam (t, GetType (par), IsParameterUnbounded (par))
+ PutProcTypeVarParam (tok, t, GetType (par), IsParameterUnbounded (par))
ELSE
- PutProcTypeParam (t, GetType (par), IsParameterUnbounded (par))
+ PutProcTypeParam (tok, t, GetType (par), IsParameterUnbounded (par))
END ;
INC(i)
END ;
ParamType into ProcType Sym.
*)
-PROCEDURE PutProcTypeParam (Sym: CARDINAL;
+PROCEDURE PutProcTypeParam (tok: CARDINAL;
+ Sym: CARDINAL;
ParamType: CARDINAL; isUnbounded: BOOLEAN) ;
ParamType into ProcType Sym.
*)
-PROCEDURE PutProcTypeVarParam (Sym: CARDINAL;
+PROCEDURE PutProcTypeVarParam (tok: CARDINAL;
+ Sym: CARDINAL;
ParamType: CARDINAL; isUnbounded: BOOLEAN) ;
(* of param. *)
Type : CARDINAL ; (* Index to the type of param. *)
IsUnbounded : BOOLEAN ; (* Is it an ARRAY OF Type? *)
+ Scope : CARDINAL ; (* Procedure declaration. *)
ShadowVar : CARDINAL ; (* The local variable used to *)
(* shadow this parameter. *)
- At : Where ; (* Where was sym declared/used *)
+ FullTok, (* name: type virtual token. *)
+ At : CARDINAL ; (* Where was sym declared. *)
END ;
SymVarParam = RECORD
HeapVar : CARDINAL ;(* The pointer value on heap. *)
(* Only used by static *)
(* analysis. *)
+ Scope : CARDINAL ;(* Procedure declaration. *)
ShadowVar : CARDINAL ;(* The local variable used to *)
(* shadow this parameter. *)
- At : Where ; (* Where was sym declared/used *)
+ FullTok, (* name: type virtual token. *)
+ At : CARDINAL ;(* Where was sym declared. *)
END ;
ConstStringVariant = (m2str, cstr, m2nulstr, cnulstr) ;
pSym := GetPsym (sym) ;
IF IsParameterVar (sym)
THEN
- RETURN GetVarDeclTok (pSym^.VarParam.ShadowVar)
+ IF pSym^.VarParam.ShadowVar = NulSym
+ THEN
+ RETURN pSym^.VarParam.At
+ ELSE
+ RETURN GetVarDeclTok (pSym^.VarParam.ShadowVar)
+ END
ELSE
- RETURN GetVarDeclTok (pSym^.Param.ShadowVar)
+ IF pSym^.Param.ShadowVar = NulSym
+ THEN
+ RETURN pSym^.Param.At
+ ELSE
+ RETURN GetVarDeclTok (pSym^.Param.ShadowVar)
+ END
END
ELSIF IsVar (sym)
THEN
THEN
IF IsParameterVar (sym)
THEN
- RETURN GetVarDeclFullTok (pSym^.VarParam.ShadowVar)
+ RETURN pSym^.VarParam.FullTok
ELSE
- RETURN GetVarDeclFullTok (pSym^.Param.ShadowVar)
+ RETURN pSym^.Param.FullTok
END
ELSIF IsVar (sym)
THEN
name := ParamName ;
Type := ParamType ;
IsUnbounded := isUnbounded ;
+ Scope := Sym ;
ShadowVar := NulSym ;
- InitWhereDeclaredTok(tok, At)
+ FullTok := MakeVirtual2Tok (tok, typetok) ;
+ At := tok
END
END ;
AddParameter (Sym, kind, ParSym) ;
pSym^.Param.ShadowVar := VariableSym
END
END ;
- AddProcedureProcTypeParam (Sym, ParamType, isUnbounded, FALSE)
+ AddProcedureProcTypeParam (tok, Sym, ParamType, isUnbounded, FALSE)
END ;
RETURN( TRUE )
END PutParam ;
name := ParamName ;
Type := ParamType ;
IsUnbounded := isUnbounded ;
+ Scope := Sym ;
ShadowVar := NulSym ;
HeapVar := NulSym ; (* Will contain a pointer value. *)
- InitWhereDeclaredTok(tok, At)
+ FullTok := MakeVirtual2Tok (tok, typetok) ;
+ At := tok
END
END ;
AddParameter (Sym, kind, ParSym) ;
pSym^.VarParam.ShadowVar := VariableSym
END
END ;
- AddProcedureProcTypeParam (Sym, ParamType, isUnbounded, TRUE)
+ AddProcedureProcTypeParam (tok, Sym, ParamType, isUnbounded, TRUE)
END ;
RETURN( TRUE )
END PutVarParam ;
associated with procedure Sym.
*)
-PROCEDURE AddProcedureProcTypeParam (Sym, ParamType: CARDINAL;
+PROCEDURE AddProcedureProcTypeParam (tok: CARDINAL;
+ Sym, ParamType: CARDINAL;
isUnbounded, isVarParam: BOOLEAN) ;
VAR
pSym: PtrToSymbol ;
THEN
IF isVarParam
THEN
- PutProcTypeVarParam (Procedure.ProcedureType,
+ PutProcTypeVarParam (tok,
+ Procedure.ProcedureType,
ParamType, isUnbounded)
ELSE
- PutProcTypeParam (Procedure.ProcedureType,
+ PutProcTypeParam (tok,
+ Procedure.ProcedureType,
ParamType, isUnbounded)
END
END
ConstLitSym : RETURN( ConstLit.Scope ) |
ConstStringSym : RETURN( ConstString.Scope ) |
ConstVarSym : RETURN( ConstVar.Scope ) |
- ParamSym : IF Param.ShadowVar = NulSym
- THEN
- RETURN NulSym
- ELSE
- RETURN( GetScope (Param.ShadowVar) )
- END |
- VarParamSym : IF VarParam.ShadowVar = NulSym
- THEN
- RETURN NulSym
- ELSE
- RETURN( GetScope (VarParam.ShadowVar) )
- END |
+ ParamSym : RETURN( Param.Scope ) |
+ VarParamSym : RETURN( VarParam.Scope ) |
UndefinedSym : RETURN( NulSym ) |
PartialUnboundedSym: InternalError ('should not be requesting the scope of a PartialUnbounded symbol')
ParamType into ProcType Sym.
*)
-PROCEDURE PutProcTypeParam (Sym: CARDINAL;
+PROCEDURE PutProcTypeParam (tok: CARDINAL;
+ Sym: CARDINAL;
ParamType: CARDINAL; isUnbounded: BOOLEAN) ;
VAR
pSym : PtrToSymbol ;
Type := ParamType ;
IsUnbounded := isUnbounded ;
ShadowVar := NulSym ;
- InitWhereDeclared(At)
+ FullTok := tok ;
+ At := tok
END
END ;
AddParameter (Sym, ProperProcedure, ParSym)
ParamType into ProcType Sym.
*)
-PROCEDURE PutProcTypeVarParam (Sym: CARDINAL;
+PROCEDURE PutProcTypeVarParam (tok: CARDINAL;
+ Sym: CARDINAL;
ParamType: CARDINAL; isUnbounded: BOOLEAN) ;
VAR
pSym : PtrToSymbol ;
Type := ParamType ;
IsUnbounded := isUnbounded ;
ShadowVar := NulSym ;
- InitWhereDeclared(At)
+ FullTok := tok ;
+ At := tok
END
END ;
AddParameter (Sym, ProperProcedure, ParSym)
UnboundedSym : RETURN( Unbounded.At.DefDeclared ) |
ProcedureSym : RETURN( Procedure.At.DefDeclared ) |
ProcTypeSym : RETURN( ProcType.At.DefDeclared ) |
- ParamSym : RETURN( Param.At.DefDeclared ) |
- VarParamSym : RETURN( VarParam.At.DefDeclared ) |
+ ParamSym : RETURN( Param.At ) |
+ VarParamSym : RETURN( VarParam.At ) |
ConstStringSym : RETURN( ConstString.At.DefDeclared ) |
ConstLitSym : RETURN( ConstLit.At.DefDeclared ) |
ConstVarSym : RETURN( ConstVar.At.DefDeclared ) |
UnboundedSym : RETURN( Unbounded.At.ModDeclared ) |
ProcedureSym : RETURN( Procedure.At.ModDeclared ) |
ProcTypeSym : RETURN( ProcType.At.ModDeclared ) |
- ParamSym : RETURN( Param.At.ModDeclared ) |
- VarParamSym : RETURN( VarParam.At.ModDeclared ) |
+ ParamSym : RETURN( Param.At ) |
+ VarParamSym : RETURN( VarParam.At ) |
ConstStringSym : RETURN( ConstString.At.ModDeclared ) |
ConstLitSym : RETURN( ConstLit.At.ModDeclared ) |
ConstVarSym : RETURN( ConstVar.At.ModDeclared ) |
UnboundedSym : Unbounded.At.DefDeclared := tok |
ProcedureSym : Procedure.At.DefDeclared := tok |
ProcTypeSym : ProcType.At.DefDeclared := tok |
- ParamSym : Param.At.DefDeclared := tok |
- VarParamSym : VarParam.At.DefDeclared := tok |
ConstStringSym : ConstString.At.DefDeclared := tok |
ConstLitSym : ConstLit.At.DefDeclared := tok |
ConstVarSym : ConstVar.At.DefDeclared := tok |
UnboundedSym : Unbounded.At.ModDeclared := tok |
ProcedureSym : Procedure.At.ModDeclared := tok |
ProcTypeSym : ProcType.At.ModDeclared := tok |
- ParamSym : Param.At.ModDeclared := tok |
- VarParamSym : VarParam.At.ModDeclared := tok |
ConstStringSym : ConstString.At.ModDeclared := tok |
ConstLitSym : ConstLit.At.ModDeclared := tok |
ConstVarSym : ConstVar.At.ModDeclared := tok |
UnboundedSym : RETURN( Unbounded.At.FirstUsed ) |
ProcedureSym : RETURN( Procedure.At.FirstUsed ) |
ProcTypeSym : RETURN( ProcType.At.FirstUsed ) |
+ (*
ParamSym : RETURN( Param.At.FirstUsed ) |
VarParamSym : RETURN( VarParam.At.FirstUsed ) |
+ *)
ConstStringSym : RETURN( ConstString.At.FirstUsed ) |
ConstLitSym : RETURN( ConstLit.At.FirstUsed ) |
ConstVarSym : RETURN( ConstVar.At.FirstUsed ) |
--- /dev/null
+DEFINITION MODULE arrayofchar ;
+
+FROM FIO IMPORT File ;
+
+(*
+ Description: provides write procedures for ARRAY OF CHAR.
+*)
+
+PROCEDURE Write (f: File; str: ARRAY OF CHAR) ;
+PROCEDURE WriteLn (f: File) ;
+
+END arrayofchar.
--- /dev/null
+IMPLEMENTATION MODULE arrayofchar ;
+
+FROM FIO IMPORT WriteChar, WriteLine ;
+IMPORT StrLib ;
+
+
+(*
+ Write - writes a string to file f.
+*)
+
+PROCEDURE Write (f: File; a: ARRAY OF CHAR) ;
+VAR
+ len, i: CARDINAL ;
+BEGIN
+ len := StrLib.StrLen (a) ;
+ i := 0 ;
+ WHILE i < len DO
+ WriteChar (f, a[i]) ;
+ INC (i)
+ END
+END Write ;
+
+
+PROCEDURE WriteLn (f: File) ;
+BEGIN
+ WriteLine (f)
+END WriteLn ;
+
+
+END arrayofchar.
-fm2-pathname=m2iso -I. -Ilibm2iso -I$(GM2_SRC)/gm2-libs-iso \
-fm2-pathname=m2pim -I$(GM2_SRC)/gm2-libs \
-fiso -fextended-opaque -fm2-g -g -Wcase-enum \
+ -Wall \
-Wreturn-type -fcase -fm2-prefix=m2iso
if TARGET_DARWIN
@BUILD_ISOLIB_TRUE@ -fm2-pathname=m2iso -I. -Ilibm2iso -I$(GM2_SRC)/gm2-libs-iso \
@BUILD_ISOLIB_TRUE@ -fm2-pathname=m2pim -I$(GM2_SRC)/gm2-libs \
@BUILD_ISOLIB_TRUE@ -fiso -fextended-opaque -fm2-g -g -Wcase-enum \
+@BUILD_ISOLIB_TRUE@ -Wall \
@BUILD_ISOLIB_TRUE@ -Wreturn-type -fcase -fm2-prefix=m2iso
@BUILD_ISOLIB_TRUE@@TARGET_DARWIN_FALSE@libm2iso_la_link_flags = \
-fm2-pathname=m2log -I$(GM2_SRC)/gm2-libs-log \
-fm2-pathname=m2pim -I$(GM2_SRC)/gm2-libs \
-fm2-pathname=m2iso -I$(GM2_SRC)/gm2-libs-iso \
+ -Wall \
-Wcase-enum -Wreturn-type \
-fcase -fm2-prefix=m2log
@BUILD_LOGLIB_TRUE@ -fm2-pathname=m2log -I$(GM2_SRC)/gm2-libs-log \
@BUILD_LOGLIB_TRUE@ -fm2-pathname=m2pim -I$(GM2_SRC)/gm2-libs \
@BUILD_LOGLIB_TRUE@ -fm2-pathname=m2iso -I$(GM2_SRC)/gm2-libs-iso \
+@BUILD_LOGLIB_TRUE@ -Wall \
@BUILD_LOGLIB_TRUE@ -Wcase-enum -Wreturn-type \
@BUILD_LOGLIB_TRUE@ -fcase -fm2-prefix=m2log
libm2min_la_M2FLAGS = \
-fm2-pathname=m2min -I. -I$(GM2_SRC)/gm2-libs-min \
-fm2-pathname=m2pim -I$(GM2_SRC)/gm2-libs -fno-exceptions \
+ -Wall \
-fno-m2-plugin -fno-scaffold-dynamic -fno-scaffold-main -fm2-prefix=m2min
if TARGET_DARWIN
libm2min_la_M2FLAGS = \
-fm2-pathname=m2min -I. -I$(GM2_SRC)/gm2-libs-min \
-fm2-pathname=m2pim -I$(GM2_SRC)/gm2-libs -fno-exceptions \
+ -Wall \
-fno-m2-plugin -fno-scaffold-dynamic -fno-scaffold-main -fm2-prefix=m2min
@TARGET_DARWIN_FALSE@libm2min_la_link_flags = $(am__append_1)
-fm2-pathname=m2pim -I. -I$(GM2_SRC)/gm2-libs \
-fm2-pathname=m2iso -I$(GM2_SRC)/gm2-libs-iso \
-fm2-g -g -Wcase-enum -Wreturn-type \
+ -Wall \
-fcase -fm2-prefix=m2pim
if TARGET_DARWIN
@BUILD_PIMLIB_TRUE@ -fm2-pathname=m2pim -I. -I$(GM2_SRC)/gm2-libs \
@BUILD_PIMLIB_TRUE@ -fm2-pathname=m2iso -I$(GM2_SRC)/gm2-libs-iso \
@BUILD_PIMLIB_TRUE@ -fm2-g -g -Wcase-enum -Wreturn-type \
+@BUILD_PIMLIB_TRUE@ -Wall \
@BUILD_PIMLIB_TRUE@ -fcase -fm2-prefix=m2pim
@BUILD_PIMLIB_TRUE@@TARGET_DARWIN_FALSE@libm2pim_la_link_flags = \
projects / thirdparty / gcc.git / commitdiff
