mirrors/gcc
0
0
Fork 0
mirror of https://gcc.gnu.org/git/gcc.git synced 2024-11-26 21:33:59 +08:00
Code Issues Actions Packages Projects Releases Wiki Activity

PR modula2/114745: const cast causes ICE

Browse Source 
This patch allows SYSTEM.CAST to be used during a const expression and
prevents an ICE.

gcc/m2/ChangeLog:

	PR modula2/114745
	* gm2-compiler/M2Code.mod (DumpLangDecl): Replace with ...
	(GetDumpDecl): ... this.
	(DumpLangGimple): Replace with ...
	(GetDumpGimple): ... this.
	* gm2-compiler/M2GenGCC.mod:
	* gm2-compiler/M2LangDump.mod (GetDumpLangQuadFilename): Replace with ...
	(GetDumpQuadFilename): ... this.
	(GetDumpLangDeclFilename): Replace with ...
	(GetDumpDeclFilename): ... this.
	(GetDumpLangGimpleFilename): Replace with ...
	(GetDumpGimpleFilename): ... this.
	* gm2-compiler/M2Options.def (GetDumpLangDeclFilename): New
	procedure function.
	(GetDumpDeclFilename): Ditto.
	(SetDumpLangDeclFilename): New procedure.
	(SetDumpDeclFilename): Ditto.
	(GetDumpLangQuadFilename): New procedure function.
	(GetDumpQuadFilename): Ditto
	(SetDumpLangQuadFilename): New procedure.
	(SetDumpQuadFilename): Ditto.
	(GetDumpLangGimpleFilename): New procedure function.
	(GetDumpGimpleFilename): Ditto.
	(SetDumpLangGimpleFilename): New procedure.
	(SetDumpGimpleFilename): Ditto.
	(GetDumpLangGimple): New procedure function.
	(SetM2Dump): New procedure.
	(GetDumpGimple): New procedure function.
	(GetDumpQuad): Ditto.
	(GetDumpDecl): Ditto.
	* gm2-compiler/M2Options.mod (DumpLangDeclFilename): Remove.
	(DumpLangQuadFilename): Ditto.
	(DumpLangGimpleFilename): Ditto.
	(DumpDeclFilename): New variable.
	(DumpQuadFilename): Ditto.
	(DumpGimpleFilename): Ditto.
	(DebugTraceTree): New variable.
	(SetQuadDebugging): Rewrite.
	(GetDumpLangDeclFilename): Replace with ...
	(GetDumpDeclFilename): ... this.
	(SetDumpLangQuadFilename): Replace with ...
	(SetDumpQuadFilename): ... this.
	(GetDumpLangGimpleFilename): Replace with ...
	(GetDumpGimpleFilename): ... this.
	(SetDumpLangGimpleFilename): Replace with ...
	(SetDumpGimpleFilename): ... this.
	(GetDumpLangGimple): Remove.
	(MatchDump): New procedure function.
	(SetM2Dump): New procedure.
	(GetDumpGimple): New procedure function.
	(GetDumpQuad): Ditto.
	(GetDumpDecl): Ditto.
	(GetDumpLangGimple): Ditto.
	* gm2-compiler/M2Quads.mod (BreakAtQuad): Assigned to 140.
	(BuildTypeCoercion): Add ConstExpr parameter.
	Check for const parameter in a const expression.
	Create a constant temporary if in a const expression.
	(BuildCastFunction): Pass ConstExpr to BuildTypeCoercion.
	(BuildFunctionCall): Pass ConstExpr to BuildTypeCoercion.
	* gm2-compiler/PCSymBuild.mod (buildConstFunction): Test for Cast
	and call InitConvert.
	(ErrorConstFunction): Add CAST to the error message.
	* gm2-compiler/SymbolTable.mod (GetConstStringContent): Remove
	unused procedure.
	* gm2-gcc/m2decl.cc (m2decl_DeclareKnownConstant): Copy value
	and change type of value.
	* gm2-gcc/m2options.h (M2Options_GetDumpLangDeclFilename): Remove.
	(M2Options_SetDumpLangDeclFilename): Ditto.
	(M2Options_GetDumpLangQuadFilename): Ditto.
	(M2Options_SetDumpLangQuadFilename): Ditto.
	(M2Options_GetDumpLangGimpleFilename): Ditto.
	(M2Options_SetDumpLangGimpleFilename): Ditto.
	(M2Options_GetDumpLangGimple): Ditto.
	(M2Options_GetDumpDeclFilename): New function.
	(M2Options_SetDumpDeclFilename): Ditto.
	(M2Options_GetDumpQuadFilename): Ditto.
	(M2Options_SetDumpQuadFilename): Ditto.
	(M2Options_GetDumpGimpleFilename): Ditto.
	(M2Options_SetDumpGimpleFilename): Ditto.
	(M2Options_SetM2Dump): Ditto.
	(M2Options_GetDumpGimple): Ditto.
	* gm2-gcc/m2pp.cc (GM2): New define.
	(m2pp_type_lowlevel): Remove linefeed.
	(m2pp_identifier): Add type description for const.
	(m2pp_assignment): Display lhs/rhs types.
	(m2pp_dump_gimple): Replace GetDumpLangGimple with GetDumpGimple.
	* gm2-lang.cc (ENABLE_QUAD_DUMP_ALL): Remove.
	(ENABLE_M2DUMP_ALL): New define.
	(gm2_langhook_handle_option): Remove commented options
	OPT_fdump_lang_all, OPT_fdump_lang_decl_, OPT_fdump_lang_gimple,
	OPT_fdump_lang_gimple_, OPT_fdump_lang_quad and
	OPT_fdump_lang_quad_.
	Add commented options OPT_fm2_dump_, OPT_fm2_dump_decl_,
	OPT_fm2_dump_gimple_ and OPT_fm2_dump_quad_.

gcc/testsuite/ChangeLog:

	PR modula2/114745
	* gm2/iso/const/pass/constcast.mod: New test.
	* gm2/iso/const/pass/constodd.mod: New test.
	* gm2/pim/pass/tinyindr.mod: New test.

Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>
This commit is contained in:
Gaius Mulley 2024-04-16 23:08:43 +01:00
parent f438acf7ce
commit eadd05d560
15 changed files with 341 additions and 166 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/m2/gm2-compiler/M2Code.mod
View File

@ -26,7 +26,7 @@ FROM SYSTEM IMPORT WORD ;
FROM M2Options IMPORT Statistics, OptimizeUncalledProcedures, FROM M2Options IMPORT Statistics, OptimizeUncalledProcedures,
OptimizeCommonSubExpressions, OptimizeCommonSubExpressions,
StyleChecking, Optimizing, WholeProgram, StyleChecking, Optimizing, WholeProgram,
DumpLangDecl, DumpLangGimple ; GetDumpDecl, GetDumpGimple ;
FROM M2LangDump IMPORT CreateDumpDecl, CloseDumpDecl, MakeGimpleTemplate ; FROM M2LangDump IMPORT CreateDumpDecl, CloseDumpDecl, MakeGimpleTemplate ;
FROM M2Error IMPORT InternalError ; FROM M2Error IMPORT InternalError ;
@ -171,7 +171,7 @@ END RemoveUnreachableCode ;
PROCEDURE DoModuleDeclare ; PROCEDURE DoModuleDeclare ;
BEGIN BEGIN
IF DumpLangDecl IF GetDumpDecl ()
THEN THEN
CreateDumpDecl ("symbol resolver of filtered symbols\n") ; CreateDumpDecl ("symbol resolver of filtered symbols\n") ;
DumpFilteredResolver DumpFilteredResolver
@ -182,7 +182,7 @@ BEGIN
ELSE ELSE
StartDeclareScope (GetMainModule ()) StartDeclareScope (GetMainModule ())
END ; END ;
IF DumpLangDecl IF GetDumpDecl ()
THEN THEN
CloseDumpDecl ; CloseDumpDecl ;
CreateDumpDecl ("definitive declaration of filtered symbols\n") ; CreateDumpDecl ("definitive declaration of filtered symbols\n") ;
@ -216,7 +216,7 @@ VAR
filename: String ; filename: String ;
len : CARDINAL ; len : CARDINAL ;
BEGIN BEGIN
IF DumpLangGimple IF GetDumpGimple ()
THEN THEN
filename := MakeGimpleTemplate (len) ; filename := MakeGimpleTemplate (len) ;
CreateDumpGimple (filename, len) ; CreateDumpGimple (filename, len) ;

26
gcc/m2/gm2-compiler/M2GenGCC.mod
View File

@ -2950,9 +2950,11 @@ BEGIN
virtpos := MakeVirtualTok (becomespos, despos, exprpos) ; virtpos := MakeVirtualTok (becomespos, despos, exprpos) ;
CheckOrResetOverflow (exprpos, Mod2Gcc (des), MustCheckOverflow (quad)) ; CheckOrResetOverflow (exprpos, Mod2Gcc (des), MustCheckOverflow (quad)) ;
AddModGcc (des, AddModGcc (des,
DeclareKnownConstant (TokenToLocation (virtpos), BuildConvert (TokenToLocation (virtpos),
Mod2Gcc (GetType (expr)), Mod2Gcc (GetType (des)),
Mod2Gcc (expr))) DeclareKnownConstant (TokenToLocation (virtpos),
Mod2Gcc (GetType (expr)),
Mod2Gcc (expr)), FALSE))
END END
END ; END ;
RemoveQuad (p, des, quad) ; RemoveQuad (p, des, quad) ;
@ -5328,13 +5330,18 @@ BEGIN
IF IsValueSolved (left) AND IsValueSolved (right) IF IsValueSolved (left) AND IsValueSolved (right)
THEN THEN
(* We can take advantage of the known values and evaluate the condition. *) (* We can take advantage of the known values and evaluate the condition. *)
PushValue (left) ; IF IsBooleanRelOpPattern (quad)
PushValue (right) ;
IF Less (tokenno)
THEN THEN
PutQuad (quad, GotoOp, NulSym, NulSym, destQuad) FoldBooleanRelopPattern (p, quad)
ELSE ELSE
SubQuad (quad) PushValue (left) ;
PushValue (right) ;
IF Less (tokenno)
THEN
PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
ELSE
SubQuad (quad)
END
END ; END ;
NoChange := FALSE NoChange := FALSE
END END
@ -7795,7 +7802,6 @@ PROCEDURE IsValidExpressionRelOp (quad: CARDINAL; isin: BOOLEAN) : BOOLEAN ;
CONST CONST
Verbose = FALSE ; Verbose = FALSE ;
VAR VAR
lefttype, righttype,
left, right, dest, combined, left, right, dest, combined,
leftpos, rightpos, destpos : CARDINAL ; leftpos, rightpos, destpos : CARDINAL ;
constExpr, overflow : BOOLEAN ; constExpr, overflow : BOOLEAN ;
@ -7810,8 +7816,6 @@ BEGIN
DeclareConstant (rightpos, right) ; DeclareConstant (rightpos, right) ;
DeclareConstructor (leftpos, quad, left) ; DeclareConstructor (leftpos, quad, left) ;
DeclareConstructor (rightpos, quad, right) ; DeclareConstructor (rightpos, quad, right) ;
lefttype := GetType (left) ;
righttype := GetType (right) ;
IF ExpressionTypeCompatible (combined, "", left, right, IF ExpressionTypeCompatible (combined, "", left, right,
StrictTypeChecking, isin) StrictTypeChecking, isin)
THEN THEN

10
gcc/m2/gm2-compiler/M2LangDump.mod
View File

@ -40,8 +40,8 @@ FROM SymbolTable IMPORT NulSym,
IsExported, IsPublic, IsExtern, IsMonoName, IsExported, IsPublic, IsExtern, IsMonoName,
IsDefinitionForC ; IsDefinitionForC ;
FROM M2Options IMPORT GetM2DumpFilter, GetDumpDir, GetDumpLangQuadFilename, FROM M2Options IMPORT GetM2DumpFilter, GetDumpDir, GetDumpQuadFilename,
GetDumpLangDeclFilename, GetDumpLangGimpleFilename ; GetDumpDeclFilename, GetDumpGimpleFilename ;
FROM M2GCCDeclare IMPORT IncludeDumpSymbol ; FROM M2GCCDeclare IMPORT IncludeDumpSymbol ;
FROM FormatStrings IMPORT Sprintf0, Sprintf1 ; FROM FormatStrings IMPORT Sprintf0, Sprintf1 ;
@ -751,7 +751,7 @@ END CreateTemplate ;
PROCEDURE MakeQuadTemplate () : String ; PROCEDURE MakeQuadTemplate () : String ;
BEGIN BEGIN
RETURN CreateTemplate (GetDumpLangQuadFilename (), InitString ('quad')) RETURN CreateTemplate (GetDumpQuadFilename (), InitString ('quad'))
END MakeQuadTemplate ; END MakeQuadTemplate ;
@ -761,7 +761,7 @@ END MakeQuadTemplate ;
PROCEDURE MakeDeclTemplate () : String ; PROCEDURE MakeDeclTemplate () : String ;
BEGIN BEGIN
RETURN CreateTemplate (GetDumpLangDeclFilename (), InitString ('decl')) RETURN CreateTemplate (GetDumpDeclFilename (), InitString ('decl'))
END MakeDeclTemplate ; END MakeDeclTemplate ;
@ -775,7 +775,7 @@ PROCEDURE MakeGimpleTemplate (VAR len: CARDINAL) : String ;
VAR VAR
filename: String ; filename: String ;
BEGIN BEGIN
filename := CreateTemplate (GetDumpLangGimpleFilename (), InitString ('gimple')) ; filename := CreateTemplate (GetDumpGimpleFilename (), InitString ('gimple')) ;
len := Length (filename) ; (* This is a short cut based on '%03d' format len := Length (filename) ; (* This is a short cut based on '%03d' format
specifier used above. *) specifier used above. *)
RETURN filename RETURN filename

52
gcc/m2/gm2-compiler/M2Options.def
View File

@ -53,9 +53,6 @@ VAR
PedanticCast, (* -Wpedantic-cast warns if sizes differ. *) PedanticCast, (* -Wpedantic-cast warns if sizes differ. *)
Statistics, (* -fstatistics information about code *) Statistics, (* -fstatistics information about code *)
StyleChecking, (* -Wstudents checks for common student errs*) StyleChecking, (* -Wstudents checks for common student errs*)
DumpLangDecl, (* -fdump-lang-decl. *)
DumpLangGimple, (* -fdump-lang-gimple. *)
DumpLangQuad, (* -fq, -fdump-lang-quad dump quadruples. *)
UnboundedByReference, (* -funbounded-by-reference *) UnboundedByReference, (* -funbounded-by-reference *)
VerboseUnbounded, (* -Wverbose-unbounded *) VerboseUnbounded, (* -Wverbose-unbounded *)
OptimizeUncalledProcedures, (* -Ouncalled removes uncalled procedures *) OptimizeUncalledProcedures, (* -Ouncalled removes uncalled procedures *)
@ -1004,45 +1001,45 @@ PROCEDURE GetIEEELongDouble () : BOOLEAN ;
(* (*
GetDumpLangDeclFilename - returns the DumpLangDeclFilename. GetDumpDeclFilename - returns the DumpLangDeclFilename.
*) *)
PROCEDURE GetDumpLangDeclFilename () : String ; PROCEDURE GetDumpDeclFilename () : String ;
(* (*
SetDumpLangDeclFilename - set DumpLangDeclFilename to filename. SetDumpDeclFilename - set DumpDeclFilename to filename.
*) *)
PROCEDURE SetDumpLangDeclFilename (value: BOOLEAN; filename: ADDRESS) ; PROCEDURE SetDumpDeclFilename (value: BOOLEAN; filename: ADDRESS) ;
(* (*
GetDumpLangQuadFilename - returns the DumpLangQuadFilename. GetDumpQuadFilename - returns the DumpQuadFilename.
*) *)
PROCEDURE GetDumpLangQuadFilename () : String ; PROCEDURE GetDumpQuadFilename () : String ;
(* (*
SetDumpLangQuadFilename - set DumpLangQuadFilename to filename. SetDumpQuadFilename - set DumpQuadFilename to filename.
*) *)
PROCEDURE SetDumpLangQuadFilename (value: BOOLEAN; filename: ADDRESS) ; PROCEDURE SetDumpQuadFilename (value: BOOLEAN; filename: ADDRESS) ;
(* (*
GetDumpLangGimpleFilename - returns the DumpLangGimpleFilename. GetDumpGimpleFilename - returns the DumpGimpleFilename.
*) *)
PROCEDURE GetDumpLangGimpleFilename () : String ; PROCEDURE GetDumpGimpleFilename () : String ;
(* (*
SetDumpLangGimpleFilename - set DumpLangGimpleFilename to filename. SetDumpGimpleFilename - set DumpGimpleFilename to filename.
*) *)
PROCEDURE SetDumpLangGimpleFilename (value: BOOLEAN; filename: ADDRESS) ; PROCEDURE SetDumpGimpleFilename (value: BOOLEAN; filename: ADDRESS) ;
(* (*
@ -1061,10 +1058,31 @@ PROCEDURE GetM2DumpFilter () : ADDRESS ;
(* (*
GetDumpLangGimple - return TRUE if -fdump-lang-gimple is set. SetM2Dump - sets the dump via a comma separated list: quad,decl,gimple,all.
*) *)
PROCEDURE GetDumpLangGimple () : BOOLEAN ; PROCEDURE SetM2Dump (value: BOOLEAN; filter: ADDRESS) ;
(*
GetDumpGimple - return TRUE if the dump gimple flag is set from SetM2Dump.
*)
PROCEDURE GetDumpGimple () : BOOLEAN ;
(*
GetDumpQuad - return TRUE if the dump quad flag is set from SetM2Dump.
*)
PROCEDURE GetDumpQuad () : BOOLEAN ;
(*
GetDumpDecl - return TRUE if the dump quad flag is set from SetM2Dump.
*)
PROCEDURE GetDumpDecl () : BOOLEAN ;
(* (*

214
gcc/m2/gm2-compiler/M2Options.mod
View File

@ -57,9 +57,10 @@ CONST
DefaultRuntimeModuleOverride = "m2iso:RTentity,m2iso:Storage,m2iso:SYSTEM,m2iso:M2RTS,m2iso:RTExceptions,m2iso:IOLink" ; DefaultRuntimeModuleOverride = "m2iso:RTentity,m2iso:Storage,m2iso:SYSTEM,m2iso:M2RTS,m2iso:RTExceptions,m2iso:IOLink" ;
VAR VAR
DumpLangDeclFilename, DumpDeclFilename,
DumpLangQuadFilename, DumpQuadFilename,
DumpLangGimpleFilename, DumpGimpleFilename,
M2Dump,
M2DumpFilter, M2DumpFilter,
M2Prefix, M2Prefix,
M2PathName, M2PathName,
@ -76,10 +77,13 @@ VAR
RuntimeModuleOverride, RuntimeModuleOverride,
CppArgs : String ; CppArgs : String ;
DebugFunctionLineNumbers, DebugFunctionLineNumbers,
DebugTraceQuad, (* -fdebug-trace-quad. *) DebugTraceQuad, (* -fm2-debug-trace=quad. *)
DebugTraceTree, (* -fdebug-trace-tree. *) DebugTraceLine, (* -fm2-debug-trace=line. *)
DebugTraceLine, (* -fdebug-trace-line. *) DebugTraceToken, (* -fm2-debug-trace=token. *)
DebugTraceToken, (* -fdebug-trace-token. *) DebugTraceTree, (* -fm2-debug-trace=tree. (not yet implemented). *)
DumpDecl, (* -fm2-dump=decl. *)
DumpGimple, (* -fm2-dump=gimple. *)
DumpQuad, (* -fq, -fm2-dump=quad dump quadruples. *)
MFlag, MFlag,
MMFlag, MMFlag,
MPFlag, MPFlag,
@ -1085,9 +1089,9 @@ END SetSwig ;
PROCEDURE SetQuadDebugging (value: BOOLEAN) ; PROCEDURE SetQuadDebugging (value: BOOLEAN) ;
BEGIN BEGIN
DumpLangQuad := value ; DumpQuad := value ;
DumpLangQuadFilename := KillString (DumpLangQuadFilename) ; DumpQuadFilename := KillString (DumpQuadFilename) ;
DumpLangQuadFilename := InitString ('-') DumpQuadFilename := InitString ('-')
END SetQuadDebugging ; END SetQuadDebugging ;
@ -1140,7 +1144,7 @@ PROCEDURE SetM2DebugTrace (word: String; value: BOOLEAN) ;
BEGIN BEGIN
IF EqualArray (word, 'all') IF EqualArray (word, 'all')
THEN THEN
(* DebugTraceTree := value *) (* DebugTraceTree := value ; *)
DebugTraceQuad := value ; DebugTraceQuad := value ;
DebugTraceToken := value ; DebugTraceToken := value ;
DebugTraceLine := value DebugTraceLine := value
@ -1796,83 +1800,84 @@ END InitializeLongDoubleFlags ;
(* (*
GetDumpLangDeclFilename - returns the DumpLangDeclFilename. GetDumpDeclFilename - returns the DumpDeclFilename.
*) *)
PROCEDURE GetDumpLangDeclFilename () : String ; PROCEDURE GetDumpDeclFilename () : String ;
BEGIN BEGIN
RETURN DumpLangDeclFilename RETURN DumpDeclFilename
END GetDumpLangDeclFilename ; END GetDumpDeclFilename ;
(* (*
SetDumpLangDeclFilename - SetDumpDeclFilename -
*) *)
PROCEDURE SetDumpLangDeclFilename (value: BOOLEAN; filename: ADDRESS) ; PROCEDURE SetDumpDeclFilename (value: BOOLEAN; filename: ADDRESS) ;
BEGIN BEGIN
DumpLangDecl := value ; DumpDecl := value ;
DumpLangDeclFilename := KillString (DumpLangDeclFilename) ; DumpDeclFilename := KillString (DumpDeclFilename) ;
IF filename # NIL IF filename # NIL
THEN THEN
DumpLangDeclFilename := InitStringCharStar (filename) DumpDeclFilename := InitStringCharStar (filename)
END END
END SetDumpLangDeclFilename ; END SetDumpDeclFilename ;
(* (*
GetDumpLangQuadFilename - returns the DumpLangQuadFilename. GetDumpQuadFilename - returns the DumpQuadFilename.
*) *)
PROCEDURE GetDumpLangQuadFilename () : String ; PROCEDURE GetDumpQuadFilename () : String ;
BEGIN BEGIN
RETURN DumpLangQuadFilename RETURN DumpQuadFilename
END GetDumpLangQuadFilename ; END GetDumpQuadFilename ;
(* (*
SetDumpLangQuadFilename - SetDumpQuadFilename -
*) *)
PROCEDURE SetDumpLangQuadFilename (value: BOOLEAN; filename: ADDRESS) ; PROCEDURE SetDumpQuadFilename (value: BOOLEAN; filename: ADDRESS) ;
BEGIN BEGIN
DumpLangQuad := value ; DumpQuad := value ;
DumpLangQuadFilename := KillString (DumpLangQuadFilename) ; DumpQuadFilename := KillString (DumpQuadFilename) ;
IF filename # NIL IF filename # NIL
THEN THEN
DumpLangQuadFilename := InitStringCharStar (filename) DumpQuadFilename := InitStringCharStar (filename)
END END
END SetDumpLangQuadFilename ; END SetDumpQuadFilename ;
(* (*
GetDumpLangGimpleFilename - returns the DumpLangGimpleFilename. GetDumpGimpleFilename - returns the DumpGimpleFilename.
*) *)
PROCEDURE GetDumpLangGimpleFilename () : String ; PROCEDURE GetDumpGimpleFilename () : String ;
BEGIN BEGIN
RETURN DumpLangGimpleFilename RETURN DumpGimpleFilename
END GetDumpLangGimpleFilename ; END GetDumpGimpleFilename ;
(* (*
SetDumpLangGimpleFilename - set DumpLangGimpleFilename to filename. SetDumpGimpleFilename - set DumpGimpleFilename to filename.
*) *)
PROCEDURE SetDumpLangGimpleFilename (value: BOOLEAN; filename: ADDRESS) ; PROCEDURE SetDumpGimpleFilename (value: BOOLEAN; filename: ADDRESS) ;
BEGIN BEGIN
DumpLangGimple := value ; DumpGimple := value ;
DumpLangGimpleFilename := KillString (DumpLangGimpleFilename) ; DumpGimpleFilename := KillString (DumpGimpleFilename) ;
IF value AND (filename # NIL) IF value AND (filename # NIL)
THEN THEN
DumpLangGimpleFilename := InitStringCharStar (filename) DumpGimpleFilename := InitStringCharStar (filename)
END END
END SetDumpLangGimpleFilename ; END SetDumpGimpleFilename ;
(* (*
SetM2DumpFilter - sets the filter to a comma separated list of procedures SetM2DumpFilter - sets the filter to a comma separated list of procedures
and modules. and modules. Not to be confused with SetM2Dump below
which enables the class of data structures to be dumped.
*) *)
PROCEDURE SetM2DumpFilter (value: BOOLEAN; filter: ADDRESS) ; PROCEDURE SetM2DumpFilter (value: BOOLEAN; filter: ADDRESS) ;
@ -1901,13 +1906,115 @@ END GetM2DumpFilter ;
(* (*
GetDumpLangGimple - return TRUE if -fdump-lang-gimple is set. MatchDump - enable/disable dump using value. It returns TRUE if dump
is valid.
*) *)
PROCEDURE GetDumpLangGimple () : BOOLEAN ; PROCEDURE MatchDump (dump: String; value: BOOLEAN) : BOOLEAN ;
BEGIN BEGIN
RETURN DumpLangGimple IF EqualArray (dump, 'all')
END GetDumpLangGimple ; THEN
DumpDecl := value ;
DumpQuad := value ;
DumpGimple := value ;
RETURN TRUE
ELSIF EqualArray (dump, 'decl')
THEN
DumpDecl := value ;
RETURN TRUE
ELSIF EqualArray (dump, 'gimple')
THEN
DumpGimple := value ;
RETURN TRUE
ELSIF EqualArray (dump, 'quad')
THEN
DumpQuad := value ;
RETURN TRUE
END ;
RETURN FALSE
END MatchDump ;
(*
SetM2Dump - sets the dump via a comma separated list: quad,decl,gimple,all.
It returns TRUE if the comma separated list is valid.
*)
PROCEDURE SetM2Dump (value: BOOLEAN; filter: ADDRESS) : BOOLEAN ;
VAR
result: BOOLEAN ;
dump : String ;
start,
i : INTEGER ;
BEGIN
IF filter = NIL
THEN
RETURN FALSE
END ;
IF M2Dump # NIL
THEN
M2Dump := KillString (M2Dump)
END ;
M2Dump := InitStringCharStar (filter) ;
start := 0 ;
REPEAT
i := Index (M2Dump, ',', start) ;
IF i = -1
THEN
dump := Slice (M2Dump, start, 0)
ELSE
dump := Slice (M2Dump, start, i)
END ;
result := MatchDump (dump, value) ;
dump := KillString (dump) ;
IF NOT result
THEN
RETURN FALSE
END ;
start := i+1 ;
UNTIL i = -1 ;
RETURN TRUE
END SetM2Dump ;
(*
GetDumpGimple - return TRUE if the dump gimple flag is set from SetM2Dump.
*)
PROCEDURE GetDumpGimple () : BOOLEAN ;
BEGIN
RETURN DumpGimple
END GetDumpGimple ;
(*
GetDumpQuad - return TRUE if the dump quad flag is set from SetM2Dump.
*)
PROCEDURE GetDumpQuad () : BOOLEAN ;
BEGIN
RETURN DumpQuad
END GetDumpQuad ;
(*
GetDumpDecl - return TRUE if the dump decl flag is set from SetM2Dump.
*)
PROCEDURE GetDumpDecl () : BOOLEAN ;
BEGIN
RETURN DumpDecl
END GetDumpDecl ;
(*
GetDumpLangGimple - return TRUE if the gimple flag is set from SetM2Dump.
*)
PROCEDURE GetDumpGimple () : BOOLEAN ;
BEGIN
RETURN DumpGimple
END GetDumpGimple ;
BEGIN BEGIN
@ -1931,7 +2038,7 @@ BEGIN
Quiet := TRUE ; Quiet := TRUE ;
CC1Quiet := TRUE ; CC1Quiet := TRUE ;
Profiling := FALSE ; Profiling := FALSE ;
DumpLangQuad := FALSE ; DumpQuad := FALSE ;
OptimizeBasicBlock := FALSE ; OptimizeBasicBlock := FALSE ;
OptimizeUncalledProcedures := FALSE ; OptimizeUncalledProcedures := FALSE ;
OptimizeCommonSubExpressions := FALSE ; OptimizeCommonSubExpressions := FALSE ;
@ -1994,11 +2101,12 @@ BEGIN
InitializeLongDoubleFlags ; InitializeLongDoubleFlags ;
M2Prefix := InitString ('') ; M2Prefix := InitString ('') ;
M2PathName := InitString ('') ; M2PathName := InitString ('') ;
DumpLangQuadFilename := NIL ; DumpQuadFilename := NIL ;
DumpLangGimpleFilename := NIL ; DumpGimpleFilename := NIL ;
DumpLangDeclFilename := NIL ; DumpDeclFilename := NIL ;
DumpLangDecl := FALSE ; DumpDecl := FALSE ;
DumpLangQuad := FALSE ; DumpQuad := FALSE ;
DumpLangGimple := FALSE ; DumpGimple := FALSE ;
M2Dump := NIL ;
M2DumpFilter := NIL M2DumpFilter := NIL
END M2Options. END M2Options.

30
gcc/m2/gm2-compiler/M2Quads.mod
View File

@ -222,7 +222,7 @@ FROM M2Options IMPORT NilChecking,
ScaffoldMain, SharedFlag, WholeProgram, ScaffoldMain, SharedFlag, WholeProgram,
GetDumpDir, GetM2DumpFilter, GetDumpDir, GetM2DumpFilter,
GetRuntimeModuleOverride, GetDebugTraceQuad, GetRuntimeModuleOverride, GetDebugTraceQuad,
DumpLangQuad ; GetDumpQuad ;
FROM M2LangDump IMPORT CreateDumpQuad, CloseDumpQuad, GetDumpFile ; FROM M2LangDump IMPORT CreateDumpQuad, CloseDumpQuad, GetDumpFile ;
FROM M2Pass IMPORT IsPassCodeGeneration, IsNoPass ; FROM M2Pass IMPORT IsPassCodeGeneration, IsNoPass ;
@ -276,7 +276,7 @@ IMPORT M2Error, FIO, SFIO, DynamicStrings, StdIO ;
CONST CONST
DebugStackOn = TRUE ; DebugStackOn = TRUE ;
DebugVarients = FALSE ; DebugVarients = FALSE ;
BreakAtQuad = 189 ; BreakAtQuad = 140 ;
DebugTokPos = FALSE ; DebugTokPos = FALSE ;
TYPE TYPE
@ -7794,7 +7794,7 @@ BEGIN
ELSIF IsAModula2Type (ProcSym) ELSIF IsAModula2Type (ProcSym)
THEN THEN
ManipulatePseudoCallParameters ; ManipulatePseudoCallParameters ;
BuildTypeCoercion BuildTypeCoercion (ConstExpr)
ELSIF IsPseudoSystemFunction (ProcSym) OR ELSIF IsPseudoSystemFunction (ProcSym) OR
IsPseudoBaseFunction (ProcSym) IsPseudoBaseFunction (ProcSym)
THEN THEN
@ -7942,7 +7942,7 @@ END BuildConstFunctionCall ;
differ. differ.
*) *)
PROCEDURE BuildTypeCoercion ; PROCEDURE BuildTypeCoercion (ConstExpr: BOOLEAN) ;
VAR VAR
resulttok, resulttok,
proctok, proctok,
@ -7964,18 +7964,24 @@ BEGIN
THEN THEN
PopTrwtok (exp, r, exptok) ; PopTrwtok (exp, r, exptok) ;
MarkAsRead (r) ; MarkAsRead (r) ;
resulttok := MakeVirtualTok (proctok, proctok, exptok) ; resulttok := MakeVirtual2Tok (proctok, exptok) ;
ReturnVar := MakeTemporary (resulttok, RightValue) ;
PutVar (ReturnVar, ProcSym) ; (* Set ReturnVar's TYPE. *)
PopN (1) ; (* Pop procedure. *) PopN (1) ; (* Pop procedure. *)
IF IsConst (exp) OR IsVar (exp) IF ConstExprError (ProcSym, exp, exptok, ConstExpr)
THEN THEN
ReturnVar := MakeTemporary (resulttok, ImmediateValue) ;
PutVar (ReturnVar, ProcSym) ; (* Set ReturnVar's TYPE. *)
ELSIF IsConst (exp) OR IsVar (exp)
THEN
ReturnVar := MakeTemporary (resulttok, AreConstant (IsConst (exp))) ;
PutVar (ReturnVar, ProcSym) ; (* Set ReturnVar's TYPE. *)
GenQuad (CoerceOp, ReturnVar, ProcSym, exp) GenQuad (CoerceOp, ReturnVar, ProcSym, exp)
ELSE ELSE
MetaError2 ('trying to coerse {%1EMRad} which is not a variable or constant into {%2ad}', MetaError2 ('trying to coerse {%1EMRad} which is not a variable or constant into {%2ad}',
exp, ProcSym) ; exp, ProcSym) ;
MetaError2 ('trying to coerse {%1ECad} which is not a variable or constant into {%2ad}', MetaError2 ('trying to coerse {%1ECad} which is not a variable or constant into {%2ad}',
exp, ProcSym) exp, ProcSym) ;
ReturnVar := MakeTemporary (resulttok, RightValue) ;
PutVar (ReturnVar, ProcSym) (* Set ReturnVar's TYPE. *)
END ; END ;
PushTFtok (ReturnVar, ProcSym, resulttok) PushTFtok (ReturnVar, ProcSym, resulttok)
ELSE ELSE
@ -9632,7 +9638,7 @@ BEGIN
PushTFtok (Type, NulSym, typetok) ; PushTFtok (Type, NulSym, typetok) ;
PushTtok (Exp, exptok) ; PushTtok (Exp, exptok) ;
PushT (1) ; (* one parameter *) PushT (1) ; (* one parameter *)
BuildTypeCoercion BuildTypeCoercion (ConstExpr)
ELSIF IsVar (Exp) OR IsProcedure (Exp) ELSIF IsVar (Exp) OR IsProcedure (Exp)
THEN THEN
PopN (NoOfParam + 1) ; PopN (NoOfParam + 1) ;
@ -11737,7 +11743,7 @@ BEGIN
Assert (GetSType (Sym) = Type) ; Assert (GetSType (Sym) = Type) ;
ti := calculateMultipicand (indexTok, Sym, Type, Dim) ; ti := calculateMultipicand (indexTok, Sym, Type, Dim) ;
idx := OperandT (1) ; idx := OperandT (1) ;
IF IsConst (idx) IF IsConst (idx) AND IsConst (ti)
THEN THEN
(* tj has no type since constant *) (* tj has no type since constant *)
tj := MakeTemporary (indexTok, ImmediateValue) ; tj := MakeTemporary (indexTok, ImmediateValue) ;
@ -13708,7 +13714,7 @@ END DumpQuadrupleAll ;
PROCEDURE DumpQuadruples (title: ARRAY OF CHAR) ; PROCEDURE DumpQuadruples (title: ARRAY OF CHAR) ;
BEGIN BEGIN
IF DumpLangQuad IF GetDumpQuad ()
THEN THEN
CreateDumpQuad (title) ; CreateDumpQuad (title) ;
IF GetM2DumpFilter () = NIL IF GetM2DumpFilter () = NIL

8
gcc/m2/gm2-compiler/PCSymBuild.mod
View File

@ -39,7 +39,7 @@ FROM M2Quads IMPORT PushT, PopT, OperandT, PopN, PopTF, PushTF, IsAutoPushOn,
FROM M2Options IMPORT Iso ; FROM M2Options IMPORT Iso ;
FROM StdIO IMPORT Write ; FROM StdIO IMPORT Write ;
FROM M2System IMPORT IsPseudoSystemFunctionConstExpression ; FROM M2System IMPORT Cast, IsPseudoSystemFunctionConstExpression ;
FROM M2Base IMPORT MixTypes, FROM M2Base IMPORT MixTypes,
ZType, RType, Char, Boolean, Val, Max, Min, Convert, ZType, RType, Char, Boolean, Val, Max, Min, Convert,
@ -1399,7 +1399,7 @@ BEGIN
second := PopAddress (exprStack) ; second := PopAddress (exprStack) ;
first := PopAddress (exprStack) first := PopAddress (exprStack)
END ; END ;
IF func=Val IF (func=Val) OR (func=Cast)
THEN THEN
InitConvert (cast, NulSym, first, second) InitConvert (cast, NulSym, first, second)
ELSIF (func=Max) OR (func=Min) ELSIF (func=Max) OR (func=Min)
@ -1424,7 +1424,7 @@ BEGIN
IF Iso IF Iso
THEN THEN
ErrorFormat0 (NewError (functok), ErrorFormat0 (NewError (functok),
'the only functions permissible in a constant expression are: CAP, CHR, CMPLX, FLOAT, HIGH, IM, LENGTH, MAX, MIN, ODD, ORD, RE, SIZE, TSIZE, TRUNC, VAL and gcc builtins') 'the only functions permissible in a constant expression are: CAP, CAST, CHR, CMPLX, FLOAT, HIGH, IM, LENGTH, MAX, MIN, ODD, ORD, RE, SIZE, TSIZE, TRUNC, VAL and gcc builtins')
ELSE ELSE
ErrorFormat0 (NewError (functok), ErrorFormat0 (NewError (functok),
'the only functions permissible in a constant expression are: CAP, CHR, FLOAT, HIGH, MAX, MIN, ODD, ORD, SIZE, TSIZE, TRUNC, VAL and gcc builtins') 'the only functions permissible in a constant expression are: CAP, CHR, FLOAT, HIGH, MAX, MIN, ODD, ORD, SIZE, TSIZE, TRUNC, VAL and gcc builtins')
@ -1433,7 +1433,7 @@ BEGIN
IF Iso IF Iso
THEN THEN
MetaErrorT1 (functok, MetaErrorT1 (functok,
'the only functions permissible in a constant expression are: CAP, CHR, CMPLX, FLOAT, HIGH, IM, LENGTH, MAX, MIN, ODD, ORD, RE, SIZE, TSIZE, TRUNC, VAL and gcc builtins, but not {%1Ead}', 'the only functions permissible in a constant expression are: CAP, CAST, CHR, CMPLX, FLOAT, HIGH, IM, LENGTH, MAX, MIN, ODD, ORD, RE, SIZE, TSIZE, TRUNC, VAL and gcc builtins, but not {%1Ead}',
func) func)
ELSE ELSE
MetaErrorT1 (functok, MetaErrorT1 (functok,

21
gcc/m2/gm2-compiler/SymbolTable.mod
View File

@ -5082,27 +5082,6 @@ BEGIN
END InitConstString ; END InitConstString ;
(*
GetConstString - returns the contents of a string constant.
*)
PROCEDURE GetConstStringContent (sym: CARDINAL) : Name ;
VAR
pSym: PtrToSymbol ;
BEGIN
pSym := GetPsym (sym) ;
WITH pSym^ DO
CASE SymbolType OF
ConstStringSym: RETURN ConstString.Contents
ELSE
InternalError ('expecting ConstStringSym')
END
END
END GetConstStringContent ;
(* (*
IsConstStringNulTerminated - returns TRUE if the constant string, sym, IsConstStringNulTerminated - returns TRUE if the constant string, sym,
should be created with a nul terminator. should be created with a nul terminator.

4
gcc/m2/gm2-gcc/m2decl.cc
View File

@ -152,11 +152,11 @@ m2decl_DeclareKnownConstant (location_t location, tree type, tree value)
decl = build_decl (location, CONST_DECL, id, type); decl = build_decl (location, CONST_DECL, id, type);
value = copy_node (value);
TREE_TYPE (value) = type;
DECL_INITIAL (decl) = value; DECL_INITIAL (decl) = value;
TREE_TYPE (decl) = type; TREE_TYPE (decl) = type;
decl = m2block_global_constant (decl); decl = m2block_global_constant (decl);
return decl; return decl;
} }

15
gcc/m2/gm2-gcc/m2options.h
View File

@ -155,16 +155,17 @@ EXTERN void M2Options_SetIBMLongDouble (bool value);
EXTERN bool M2Options_GetIBMLongDouble (void); EXTERN bool M2Options_GetIBMLongDouble (void);
EXTERN void M2Options_SetIEEELongDouble (bool value); EXTERN void M2Options_SetIEEELongDouble (bool value);
EXTERN bool M2Options_GetIEEELongDouble (void); EXTERN bool M2Options_GetIEEELongDouble (void);
EXTERN bool M2Options_GetDumpLangDeclFilename (void); EXTERN bool M2Options_GetDumpDeclFilename (void);
EXTERN void M2Options_SetDumpLangDeclFilename (bool value, const char *arg); EXTERN void M2Options_SetDumpDeclFilename (bool value, const char *arg);
EXTERN bool M2Options_GetDumpLangQuadFilename (void); EXTERN bool M2Options_GetDumpQuadFilename (void);
EXTERN void M2Options_SetDumpLangQuadFilename (bool value, const char *arg); EXTERN void M2Options_SetDumpQuadFilename (bool value, const char *arg);
EXTERN bool M2Options_GetDumpLangGimpleFilename (void); EXTERN bool M2Options_GetDumpGimpleFilename (void);
EXTERN void M2Options_SetDumpLangGimpleFilename (bool value, const char *arg); EXTERN void M2Options_SetDumpGimpleFilename (bool value, const char *arg);
EXTERN bool M2Options_GetDumpLangGimple (void);
EXTERN void M2Options_SetM2DumpFilter (bool value, const char *args); EXTERN void M2Options_SetM2DumpFilter (bool value, const char *args);
EXTERN char *M2Options_GetM2DumpFilter (void); EXTERN char *M2Options_GetM2DumpFilter (void);
EXTERN void M2Options_SetM2DebugTraceFilter (bool value, const char *arg); EXTERN void M2Options_SetM2DebugTraceFilter (bool value, const char *arg);
EXTERN bool M2Options_SetM2Dump (bool value, const char *arg);
EXTERN bool M2Options_GetDumpGimple (void);
#undef EXTERN #undef EXTERN
#endif /* m2options_h. */ #endif /* m2options_h. */

31
gcc/m2/gm2-gcc/m2pp.cc
View File

@ -34,6 +34,8 @@ along with GNU Modula-2; see the file COPYING3. If not see
#define M2PP_C #define M2PP_C
#include "m2pp.h" #include "m2pp.h"
#define GM2
const char *m2pp_dump_description[M2PP_DUMP_END] = const char *m2pp_dump_description[M2PP_DUMP_END] =
{ {
"interactive user invoked output", "interactive user invoked output",
@ -526,9 +528,9 @@ m2pp_type_lowlevel (pretty *s, tree t)
m2pp_needspace (s); m2pp_needspace (s);
if (TYPE_UNSIGNED (t)) if (TYPE_UNSIGNED (t))
m2pp_print (s, "unsigned\n"); m2pp_print (s, "unsigned");
else else
m2pp_print (s, "signed\n"); m2pp_print (s, "signed");
} }
} }
@ -896,6 +898,19 @@ m2pp_identifier (pretty *s, tree t)
else else
snprintf (name, 100, "D_%u", DECL_UID (t)); snprintf (name, 100, "D_%u", DECL_UID (t));
m2pp_print (s, name); m2pp_print (s, name);
if (TREE_TYPE (t) != NULL_TREE)
{
m2pp_needspace (s);
m2pp_print (s, "(* type:");
m2pp_needspace (s);
m2pp_simple_type (s, TREE_TYPE (t));
m2pp_needspace (s);
#if 0
m2pp_type_lowlevel (s, TREE_TYPE (t));
m2pp_needspace (s);
#endif
m2pp_print (s, "*)");
}
} }
} }
} }
@ -2554,6 +2569,16 @@ m2pp_assignment (pretty *s, tree t)
int o; int o;
m2pp_begin (s); m2pp_begin (s);
/* Print the types of des and expr. */
m2pp_type (s, TREE_TYPE (TREE_OPERAND (t, 0)));
m2pp_needspace (s);
m2pp_print (s, ":=");
m2pp_needspace (s);
m2pp_type (s, TREE_TYPE (TREE_OPERAND (t, 1)));
m2pp_needspace (s);
m2pp_print (s, ";\n");
/* Print the assignment statement. */
m2pp_designator (s, TREE_OPERAND (t, 0)); m2pp_designator (s, TREE_OPERAND (t, 0));
m2pp_needspace (s); m2pp_needspace (s);
m2pp_print (s, ":="); m2pp_print (s, ":=");
@ -2818,7 +2843,7 @@ m2pp_dump_gimple_pretty (m2pp_dump_kind kind, tree fndecl)
void void
m2pp_dump_gimple (m2pp_dump_kind kind, tree fndecl) m2pp_dump_gimple (m2pp_dump_kind kind, tree fndecl)
{ {
if (M2Options_GetDumpLangGimple () if (M2Options_GetDumpGimple ()
&& M2LangDump_IsDumpRequiredTree (fndecl, true)) && M2LangDump_IsDumpRequiredTree (fndecl, true))
m2pp_dump_gimple_pretty (kind, fndecl); m2pp_dump_gimple_pretty (kind, fndecl);
} }

40
gcc/m2/gm2-lang.cc
View File

@ -42,7 +42,7 @@ Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
#include "convert.h" #include "convert.h"
#include "rtegraph.h" #include "rtegraph.h"
#undef ENABLE_QUAD_DUMP_ALL #undef ENABLE_M2DUMP_ALL
static void write_globals (void); static void write_globals (void);
@ -478,31 +478,6 @@ gm2_langhook_handle_option (
case OPT_fdebug_function_line_numbers: case OPT_fdebug_function_line_numbers:
M2Options_SetDebugFunctionLineNumbers (value); M2Options_SetDebugFunctionLineNumbers (value);
return 1; return 1;
#ifdef ENABLE_QUAD_DUMP_ALL
case OPT_fdump_lang_all:
M2Options_SetDumpLangDeclFilename (value, NULL);
M2Options_SetDumpLangGimpleFilename (value, NULL);
M2Options_SetDumpLangQuadFilename (value, NULL);
return 1;
case OPT_fdump_lang_decl:
M2Options_SetDumpLangDeclFilename (value, NULL);
return 1;
case OPT_fdump_lang_decl_:
M2Options_SetDumpLangDeclFilename (value, arg);
return 1;
case OPT_fdump_lang_gimple:
M2Options_SetDumpLangGimpleFilename (value, NULL);
return 1;
case OPT_fdump_lang_gimple_:
M2Options_SetDumpLangGimpleFilename (value, arg);
return 1;
case OPT_fdump_lang_quad:
M2Options_SetDumpLangQuadFilename (value, NULL);
return 1;
case OPT_fdump_lang_quad_:
M2Options_SetDumpLangQuadFilename (value, arg);
return 1;
#endif
case OPT_fauto_init: case OPT_fauto_init:
M2Options_SetAutoInit (value); M2Options_SetAutoInit (value);
return 1; return 1;
@ -546,7 +521,18 @@ gm2_langhook_handle_option (
case OPT_fm2_debug_trace_: case OPT_fm2_debug_trace_:
M2Options_SetM2DebugTraceFilter (value, arg); M2Options_SetM2DebugTraceFilter (value, arg);
return 1; return 1;
#ifdef ENABLE_QUAD_DUMP_ALL #ifdef ENABLE_M2DUMP_ALL
case OPT_fm2_dump_:
return M2Options_SetM2Dump (value, arg);
case OPT_fm2_dump_decl_:
M2Options_SetDumpDeclFilename (value, arg);
return 1;
case OPT_fm2_dump_gimple_:
M2Options_SetDumpGimpleFilename (value, arg);
return 1;
case OPT_fm2_dump_quad_:
M2Options_SetDumpQuadFilename (value, arg);
return 1;
case OPT_fm2_dump_filter_: case OPT_fm2_dump_filter_:
M2Options_SetM2DumpFilter (value, arg); M2Options_SetM2DumpFilter (value, arg);
return 1; return 1;

8
gcc/testsuite/gm2/iso/const/pass/constcast.mod Normal file
View File

@ -0,0 +1,8 @@
MODULE constcast ;
FROM SYSTEM IMPORT CAST ;
CONST Nil = CAST (PROC, NIL) ;
BEGIN
END constcast.

16
gcc/testsuite/gm2/iso/const/pass/constodd.mod Normal file
View File

@ -0,0 +1,16 @@
MODULE constodd ;
FROM libc IMPORT printf, exit ;
CONST
IsOdd = ODD (1) AND (2 > 1) ;
BEGIN
IF IsOdd
THEN
printf ("success\n");
ELSE
printf ("failure\n");
exit (1)
END
END constodd.

24
gcc/testsuite/gm2/pim/pass/tinyindr.mod Normal file
View File

@ -0,0 +1,24 @@
MODULE tinyindr ;
FROM SYSTEM IMPORT WORD, BYTE ;
TYPE
File = RECORD
lastWord: WORD ;
lastByte: BYTE ;
END ;
PROCEDURE Create (VAR f: File) ;
BEGIN
WITH f DO
lastWord := WORD (0) ;
lastByte := BYTE (0)
END
END Create ;
VAR
foo: File ;
BEGIN
Create (foo)
END tinyindr.