diff options
author | Gaius Mulley <gaiusmod2@gmail.com> | 2023-09-19 19:23:03 +0100 |
---|---|---|
committer | Gaius Mulley <gaiusmod2@gmail.com> | 2023-09-19 19:23:03 +0100 |
commit | 81d5ca0b9b8431f1bd7a5ec8a2c94f04bb0cf032 (patch) | |
tree | 6d96b1d3e57a0d06bfd6d7ad2e3d9b2b140e0dd3 /gcc/m2 | |
parent | eec7c373c2de6d5806537552de5f5b2bd064c43e (diff) | |
download | gcc-81d5ca0b9b8431f1bd7a5ec8a2c94f04bb0cf032.zip gcc-81d5ca0b9b8431f1bd7a5ec8a2c94f04bb0cf032.tar.gz gcc-81d5ca0b9b8431f1bd7a5ec8a2c94f04bb0cf032.tar.bz2 |
PR 108143/modula2 LONGREAL and powerpc64le-linux
This patch introduces a configure for LONGREAL as float128 when
targetting or hosting cc1gm2 on ppc64le. It fixes calls to builtins
and fixes the -fdebug-builtins option.
gcc/ChangeLog:
* doc/gm2.texi (fdebug-builtins): Correct description.
gcc/m2/ChangeLog:
* Make-lang.in (host_mc_longreal): Detect hosting on powerpc64le
and if so use __float128 for longreal in mc.
(MC_ARGS): Append host_mc_longreal.
* config-make.in (TEST_TARGET_CPU_DEFAULT): New variable.
(TEST_HOST_CPU_DEFAULT): New variable.
* configure: Regenerate.
* configure.ac (M2C_LONGREAL_FLOAT128): New define set if target
is powerpc64le.
(M2C_LONGREAL_PPC64LE): New define set if target is powerpc64le.
* gm2-compiler/M2GCCDeclare.mod: Correct comment case.
* gm2-compiler/M2GenGCC.mod (MaybeDebugBuiltinAlloca): Call
SetLastFunction for the builtin function call.
(MaybeDebugBuiltinMemcpy): Call SetLastFunction for the builtin
function call.
(MaybeDebugBuiltinMemset): New procedure function.
(MakeCopyUse): Use GNU formatting.
(UseBuiltin): Rewrite to check BuiltinExists.
(CodeDirectCall): Rewrite to check BuiltinExists and call
SetLastFunction.
(CodeMakeAdr): Re-format.
* gm2-compiler/M2Options.def (SetDebugBuiltins): New procedure.
* gm2-compiler/M2Options.mod (SetUninitVariableChecking): Allow
"cond" to switch UninitVariableConditionalChecking separately.
(SetDebugBuiltins): New procedure.
* gm2-compiler/M2Quads.def (BuildFunctionCall): Add parameter
ConstExpr.
* gm2-compiler/M2Quads.mod (BuildRealProcedureCall): Add parameter
to BuildRealFuncProcCall.
(BuildRealFuncProcCall): Add ConstExpr parameter. Pass ConstExpr
to BuildFunctionCall.
(BuildFunctionCall): Add parameter ConstExpr. Pass ConstExpr to
BuildRealFunctionCall.
(BuildConstFunctionCall): Add parameter ConstExpr. Pass ConstExpr to
BuildFunctionCall.
(BuildRealFunctionCall): Add parameter ConstExpr. Pass ConstExpr to
BuildRealFuncProcCall.
* gm2-compiler/P3Build.bnf (SetOrDesignatorOrFunction): Pass FALSE
to BuildFunctionCall.
(AssignmentOrProcedureCall): Pass FALSE to BuildFunctionCall.
* gm2-compiler/SymbolTable.def (IsProcedureBuiltinAvailable): New
procedure function.
* gm2-compiler/SymbolTable.mod (CanUseBuiltin): New procedure
function.
(IsProcedureBuiltinAvailable): New procedure function.
* gm2-gcc/m2builtins.cc (DEBUGGING): Undef.
(bf_category): New enum type.
(struct builtin_function_entry): New field function_avail.
(m2builtins_BuiltInMemCopy): Rename from ...
(m2builtins_BuiltinMemCopy): ... this.
(DoBuiltinMemSet): New function.
(m2builtins_BuiltinMemSet): New function.
(do_target_support_exists): New function.
(target_support_exists): New function.
(m2builtins_BuiltinExists): Return true or false.
(m2builtins_BuildBuiltinTree): Rename local variables.
Replace long_double_type_node with GetM2LongRealType.
(m2builtins_init): Use GetM2LongRealType rather than
long_double_type_node.
* gm2-gcc/m2builtins.def (BuiltInMemCopy): Rename to ...
(BuiltinMemCopy): ... this.
(BuiltinMemSet): New procedure function.
* gm2-gcc/m2builtins.h (m2builtins_BuiltInMemCopy): Rename to ...
(m2builtins_BuiltinMemCopy): ... this.
(m2builtins_BuiltinMemSet): New procedure function.
* gm2-gcc/m2configure.cc (m2configure_M2CLongRealFloat128): New
procedure function.
(m2configure_M2CLongRealIBM128): New procedure function.
(m2configure_M2CLongRealLongDouble): New procedure function.
(m2configure_M2CLongRealLongDoublePPC64LE): New procedure function.
* gm2-gcc/m2configure.def (M2CLongRealFloat128): New procedure function.
(M2CLongRealIBM128): New procedure function.
(M2CLongRealLongDouble): New procedure function.
(M2CLongRealLongDoublePPC64LE): New procedure function.
* gm2-gcc/m2configure.h (m2configure_FullPathCPP): New procedure function.
(m2configure_M2CLongRealFloat128): New procedure function.
(m2configure_M2CLongRealIBM128): New procedure function.
(m2configure_M2CLongRealLongDouble): New procedure function.
(m2configure_M2CLongRealLongDoublePPC64LE): New procedure function.
* gm2-gcc/m2convert.cc (m2convert_BuildConvert): Use convert_loc.
* gm2-gcc/m2options.h (M2Options_SetDebugBuiltins): New function.
* gm2-gcc/m2statement.cc (m2statement_BuildAssignmentTree): Set
TREE_USED to true.
(m2statement_BuildGoto):Set TREE_USED to true.
(m2statement_BuildParam): Set TREE_USED to true.
(m2statement_BuildBuiltinCallTree): New function.
(m2statement_BuildFunctValue): Set TREE_USED to true.
* gm2-gcc/m2statement.def (BuildBuiltinCallTree): New procedure function.
* gm2-gcc/m2statement.h (m2statement_BuildBuiltinCallTree): New
procedure function.
* gm2-gcc/m2treelib.cc (m2treelib_DoCall0): Remove spacing.
(m2treelib_DoCall1): Remove spacing.
(m2treelib_DoCall2): Remove spacing.
(m2treelib_DoCall3): Remove spacing.
(add_stmt): Rename parameter.
* gm2-gcc/m2type.cc (build_set_type): Remove spacing.
(build_m2_specific_size_type): Remove spacing.
(finish_build_pointer_type): Remove spacing.
(m2type_BuildVariableArrayAndDeclare): Remove spacing.
(build_m2_short_real_node): Remove spacing.
(build_m2_real_node): Remove spacing.
(build_m2_long_real_node): Use float128_type_node if
M2CLongRealFloat128 is set.
(build_m2_ztype_node): Remove spacing.
(build_m2_long_int_node): Remove spacing.
(build_m2_long_card_node): Remove spacing.
(build_m2_short_int_node): Remove spacing.
(build_m2_short_card_node): Remove spacing.
(build_m2_iso_loc_node): Remove spacing.
(m2type_SameRealType): New function.
(m2type_InitBaseTypes): Create m2_c_type_node using
m2_long_complex_type_node.
(m2type_SetAlignment): Tidy up comment.
* gm2-gcc/m2type.def (SameRealType): New procedure function.
* gm2-gcc/m2type.h (m2type_SameRealType): New procedure function.
* gm2-lang.cc (gm2_langhook_type_for_mode): Build long complex
node from m2 language specific long double node.
* gm2-libs-log/RealConversions.mod (IsNan): New procedure
function.
(doPowerOfTen): Re-implement.
* gm2-libs/Builtins.mod: Add newline.
* gm2-libs/DynamicStrings.def (ReplaceChar): New procedure function.
* gm2-libs/DynamicStrings.mod (ReplaceChar): New procedure function.
* gm2config.aci.in (M2C_LONGREAL_FLOAT128): New config value.
(M2C_LONGREAL_PPC64LE): New config value.
* gm2spec.cc (lang_specific_driver): New local variable
need_default_mabi set to default value depending upon
M2C_LONGREAL_PPC64LE and M2C_LONGREAL_FLOAT128.
* lang.opt (Wcase-enum): Moved to correct section.
* m2pp.cc (m2pp_real_type): New function.
(m2pp_type): Call m2pp_real_type.
(m2pp_print_mode): New function.
(m2pp_simple_type): Call m2pp_simple_type.
(m2pp_float): New function.
(m2pp_expression): Call m2pp_float.
* mc-boot/GDynamicStrings.cc: Rebuild.
* mc-boot/GDynamicStrings.h: Rebuild.
* mc-boot/GFIO.cc: Rebuild.
* mc-boot/GFIO.h: Rebuild.
* mc-boot/GIO.cc: Rebuild.
* mc-boot/GRTint.cc: Rebuild.
* mc-boot/Gdecl.cc: Rebuild.
* mc-boot/GmcOptions.cc: Rebuild.
* mc-boot/GmcOptions.h: Rebuild.
* mc/decl.mod: Rebuild.
* mc/mcOptions.def (getCRealType): New procedure function.
(getCLongRealType): New procedure function.
(getCShortRealType): New procedure function.
* mc/mcOptions.mod (getCRealType): New procedure function.
(getCLongRealType): New procedure function.
(getCShortRealType): New procedure function.
libgm2/ChangeLog:
* Makefile.am (TARGET_LONGDOUBLE_ABI): New variable set to
-mabi=ieeelongdouble if the target is powerpc64le.
(AM_MAKEFLAGS): Append TARGET_LONGDOUBLE_ABI.
* Makefile.in: Rebuild.
* libm2cor/Makefile.am (AM_MAKEFLAGS): Add CFLAGS_LONGDOUBLE and
TARGET_LONGDOUBLE_ABI.
(libm2cor_la_CFLAGS): Add TARGET_LONGDOUBLE_ABI.
(libm2cor_la_M2FLAGS): Add TARGET_LONGDOUBLE_ABI.
* libm2cor/Makefile.in: Rebuild.
* libm2iso/Makefile.am (AM_MAKEFLAGS): Add CFLAGS_LONGDOUBLE and
TARGET_LONGDOUBLE_ABI.
(libm2iso_la_CFLAGS): Add TARGET_LONGDOUBLE_ABI.
(libm2iso_la_M2FLAGS): Add TARGET_LONGDOUBLE_ABI.
* libm2iso/Makefile.in: Rebuild.
* libm2log/Makefile.am (AM_MAKEFLAGS): Add CFLAGS_LONGDOUBLE and
TARGET_LONGDOUBLE_ABI.
(libm2log_la_CFLAGS): Add TARGET_LONGDOUBLE_ABI.
(libm2log_la_M2FLAGS): Add TARGET_LONGDOUBLE_ABI.
* libm2log/Makefile.in: Rebuild.
* libm2min/Makefile.am (AM_MAKEFLAGS): Add CFLAGS_LONGDOUBLE and
TARGET_LONGDOUBLE_ABI.
(libm2min_la_CFLAGS): Add TARGET_LONGDOUBLE_ABI.
(libm2min_la_M2FLAGS): Add TARGET_LONGDOUBLE_ABI.
* libm2min/Makefile.in: Rebuild.
* libm2pim/Makefile.am (AM_MAKEFLAGS): Add CFLAGS_LONGDOUBLE and
TARGET_LONGDOUBLE_ABI.
(libm2pim_la_CFLAGS): Add TARGET_LONGDOUBLE_ABI.
(libm2pim_la_M2FLAGS): Add TARGET_LONGDOUBLE_ABI.
* libm2pim/Makefile.in: Rebuild.
gcc/testsuite/ChangeLog:
* gm2/extensions/pass/libc.def: Add spacing.
* gm2/pimlib/logitech/run/pass/realconv.mod: Add debugging print.
* gm2/switches/uninit-variable-checking/cascade/fail/switches-uninit-variable-checking-cascade-fail.exp:
Add -fdebug-builtins flag.
* lib/gm2.exp (gm2_target_compile_default): Add
-mabi=ieeelongdouble if the target is powerpc.
(gm2_link_flags): Add
-mabi=ieeelongdouble if the target is powerpc.
* gm2/pim/intrinsic/run/pass/cstub.c: New test.
* gm2/pim/intrinsic/run/pass/cstub.def: New test.
* gm2/pim/intrinsic/run/pass/pim-intrinsic-run-pass.exp: New test.
* gm2/pim/intrinsic/run/pass/test.mod: New test.
* gm2/pim/run/pass/builtins.mod: New test.
* gm2/pim/run/pass/convert1.mod: New test.
* gm2/pim/run/pass/longint1.mod: New test.
* gm2/pim/run/pass/longint2.mod: New test.
* gm2/pim/run/pass/longint3.mod: New test.
* gm2/pim/run/pass/longint4.mod: New test.
* gm2/pim/run/pass/longint5.mod: New test.
* gm2/pim/run/pass/longint6.mod: New test.
* gm2/pim/run/pass/longint7.mod: New test.
* gm2/pim/run/pass/longint8.mod: New test.
Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>
Diffstat (limited to 'gcc/m2')
49 files changed, 1443 insertions, 474 deletions
diff --git a/gcc/m2/Make-lang.in b/gcc/m2/Make-lang.in index 7338bfe..a541518 100644 --- a/gcc/m2/Make-lang.in +++ b/gcc/m2/Make-lang.in @@ -85,6 +85,9 @@ GM2_PROG_DEP=gm2$(exeext) xgcc$(exeext) cc1gm2$(exeext) include m2/config-make +# Determine if float128 should represent the Modula-2 type LONGREAL. +host_mc_longreal := $(if $(strip $(filter powerpc64le%,$(host))),--longreal=__float128) + LIBSTDCXX=../$(TARGET_SUBDIR)/libstdc++-v3/src/.libs/libstdc++.a PGE=m2/pge$(exeext) @@ -458,7 +461,8 @@ MC_ARGS= --olang=c++ \ -I$(srcdir)/m2/gm2-gcc \ --quiet \ $(MC_COPYRIGHT) \ - --gcc-config-system + --gcc-config-system \ + $(host_mc_longreal) MCDEPS=m2/boot-bin/mc$(exeext) diff --git a/gcc/m2/config-make.in b/gcc/m2/config-make.in index fb25ef4..5521d4f 100644 --- a/gcc/m2/config-make.in +++ b/gcc/m2/config-make.in @@ -3,4 +3,8 @@ TARGET_SUBDIR = @target_subdir@ # Python3 executable name if it exists PYTHON = @PYTHON@ # Does Python3 exist? (yes/no). -HAVE_PYTHON = @HAVE_PYTHON@
\ No newline at end of file +HAVE_PYTHON = @HAVE_PYTHON@ +# target cpu +TEST_TARGET_CPU_DEFAULT = @target@ +# host cpu +TEST_HOST_CPU_DEFAULT = @host@
\ No newline at end of file diff --git a/gcc/m2/configure b/gcc/m2/configure index de78fdd..f62f3d8 100755 --- a/gcc/m2/configure +++ b/gcc/m2/configure @@ -3645,6 +3645,25 @@ $as_echo "#define HAVE_OPENDIR 1" >>confdefs.h fi + +case $target in #( + powerpc64le*) : + +$as_echo "#define M2C_LONGREAL_FLOAT128 1" >>confdefs.h + ;; #( + *) : + ;; +esac + +case $target in #( + powerpc64le*) : + +$as_echo "#define M2C_LONGREAL_PPC64LE 1" >>confdefs.h + ;; #( + *) : + ;; +esac + ac_config_headers="$ac_config_headers gm2config.aci" cat >confcache <<\_ACEOF diff --git a/gcc/m2/configure.ac b/gcc/m2/configure.ac index 0a77cae..82b764c 100644 --- a/gcc/m2/configure.ac +++ b/gcc/m2/configure.ac @@ -29,5 +29,12 @@ AC_CHECK_FUNCS([stpcpy]) AC_CHECK_HEADERS(sys/types.h) AC_HEADER_DIRENT AC_CHECK_LIB([c],[opendir],[AC_DEFINE([HAVE_OPENDIR],[1],[found opendir])]) + +AS_CASE([$target],[powerpc64le*], + [AC_DEFINE([M2C_LONGREAL_FLOAT128],[1],[use __float128 for LONGREAL])]) + +AS_CASE([$target],[powerpc64le*], + [AC_DEFINE([M2C_LONGREAL_PPC64LE],[1],[target is ppc64le])]) + AC_CONFIG_HEADERS(gm2config.aci, [echo timestamp > stamp-h]) AC_OUTPUT diff --git a/gcc/m2/gm2-compiler/M2GCCDeclare.mod b/gcc/m2/gm2-compiler/M2GCCDeclare.mod index 3ce9cb2..87ca0da 100644 --- a/gcc/m2/gm2-compiler/M2GCCDeclare.mod +++ b/gcc/m2/gm2-compiler/M2GCCDeclare.mod @@ -2458,7 +2458,7 @@ BEGIN p := NoOfParam(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 GetNthParam 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). *) diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod index bcef4e7..c023eda 100644 --- a/gcc/m2/gm2-compiler/M2GenGCC.mod +++ b/gcc/m2/gm2-compiler/M2GenGCC.mod @@ -52,7 +52,7 @@ FROM SymbolTable IMPORT PushSize, PopSize, PushValue, PopValue, IsExportQualified, IsExported, IsSubrange, IsPointer, - IsProcedureBuiltin, IsProcedureInline, + IsProcedureBuiltinAvailable, IsProcedureInline, IsParameter, IsParameterVar, IsValueSolved, IsSizeSolved, IsProcedureNested, IsInnerModule, IsArrayLarge, @@ -83,7 +83,7 @@ FROM SymbolTable IMPORT PushSize, PopSize, PushValue, PopValue, FROM M2Batch IMPORT MakeDefinitionSource ; FROM M2LexBuf IMPORT FindFileNameFromToken, TokenToLineNo, TokenToLocation, - MakeVirtualTok, UnknownTokenNo ; + MakeVirtualTok, UnknownTokenNo, BuiltinTokenNo ; FROM M2Code IMPORT CodeBlock ; FROM M2Debug IMPORT Assert ; @@ -158,7 +158,8 @@ FROM M2GCCDeclare IMPORT WalkAction, FROM M2Range IMPORT CodeRangeCheck, FoldRangeCheck, CodeErrorCheck, GetMinMax ; -FROM m2builtins IMPORT BuiltInMemCopy, BuiltInAlloca, +FROM m2builtins IMPORT BuiltInAlloca, + BuiltinMemSet, BuiltinMemCopy, GetBuiltinConst, GetBuiltinTypeInfo, BuiltinExists, BuildBuiltinTree ; @@ -228,6 +229,7 @@ FROM m2statement IMPORT BuildAsm, BuildProcedureCallTree, BuildParam, BuildFunct BuildReturnValueCode, SetLastFunction, BuildIncludeVarConst, BuildIncludeVarVar, BuildExcludeVarConst, BuildExcludeVarVar, + BuildBuiltinCallTree, GetParamTree, BuildCleanUp, BuildTryFinally, GetLastFunction, SetLastFunction, @@ -270,6 +272,7 @@ TYPE DoUnaryProcedure = PROCEDURE (CARDINAL) ; VAR + Memset, Memcpy : CARDINAL ; CurrentQuadToken : CARDINAL ; UnboundedLabelNo : CARDINAL ; LastLine : CARDINAL ;(* The Last Line number emitted with the *) @@ -444,6 +447,7 @@ VAR op1, op2, op3: CARDINAL ; location : location_t ; BEGIN + InitBuiltinSyms (BuiltinTokenNo) ; GetQuad(q, op, op1, op2, op3) ; IF op=StatementNoteOp THEN @@ -572,6 +576,7 @@ VAR op3pos : CARDINAL ; Changed: BOOLEAN ; BEGIN + InitBuiltinSyms (BuiltinTokenNo) ; Changed := FALSE ; REPEAT NoChange := TRUE ; @@ -1310,18 +1315,25 @@ END GetSizeOfHighFromUnbounded ; PROCEDURE MaybeDebugBuiltinAlloca (location: location_t; tok: CARDINAL; high: Tree) : Tree ; VAR - func: Tree ; + call, + memptr, + func : Tree ; BEGIN IF DebugBuiltins THEN - func := Mod2Gcc(FromModuleGetSym(tok, - MakeKey('alloca_trace'), - MakeDefinitionSource(tok, - MakeKey('Builtins')))) ; - RETURN( BuildCall2(location, func, GetPointerType(), BuiltInAlloca(location, high), high) ) + func := Mod2Gcc (FromModuleGetSym (tok, + MakeKey ('alloca_trace'), + MakeDefinitionSource (tok, + MakeKey ('Builtins')))) ; + call := BuiltInAlloca (location, high) ; + SetLastFunction (call) ; + memptr := BuildFunctValue (location, call) ; + call := BuildCall2 (location, func, GetPointerType(), memptr, high) ; ELSE - RETURN( BuiltInAlloca(location, high) ) - END + call := BuiltInAlloca (location, high) + END ; + SetLastFunction (call) ; + RETURN BuildFunctValue (location, call) END MaybeDebugBuiltinAlloca ; @@ -1331,22 +1343,44 @@ END MaybeDebugBuiltinAlloca ; PROCEDURE MaybeDebugBuiltinMemcpy (location: location_t; tok: CARDINAL; src, dest, nbytes: Tree) : Tree ; VAR + call, func: Tree ; BEGIN IF DebugBuiltins THEN - func := Mod2Gcc(FromModuleGetSym(tok, - MakeKey('memcpy'), - MakeDefinitionSource(tok, - MakeKey('Builtins')))) ; - RETURN( BuildCall3(location, func, GetPointerType(), src, dest, nbytes) ) + func := Mod2Gcc (Memcpy) ; + call := BuildCall3 (location, func, GetPointerType (), src, dest, nbytes) ; ELSE - RETURN( BuiltInMemCopy(location, src, dest, nbytes) ) - END + call := BuiltinMemCopy (location, src, dest, nbytes) + END ; + SetLastFunction (call) ; + RETURN BuildFunctValue (location, call) END MaybeDebugBuiltinMemcpy ; (* + MaybeDebugBuiltinMemset - +*) + +PROCEDURE MaybeDebugBuiltinMemset (location: location_t; tok: CARDINAL; + ptr, bytevalue, nbytes: Tree) : Tree ; +VAR + call, + func: Tree ; +BEGIN + IF DebugBuiltins + THEN + func := Mod2Gcc (Memset) ; + call := BuildCall3 (location, func, GetPointerType (), ptr, bytevalue, nbytes) ; + ELSE + call := BuiltinMemSet (location, ptr, bytevalue, nbytes) + END ; + SetLastFunction (call) ; + RETURN BuildFunctValue (location, call) +END MaybeDebugBuiltinMemset ; + + +(* MakeCopyUse - make a copy of the unbounded array and alter all references from the old unbounded array to the new unbounded array. The parameter, param, contains a RECORD @@ -1368,7 +1402,7 @@ VAR High, NewArray : Tree ; BEGIN - location := TokenToLocation(tokenno) ; + location := TokenToLocation (tokenno) ; UnboundedType := GetType (param) ; Assert (IsUnbounded (UnboundedType)) ; @@ -1397,20 +1431,20 @@ VAR sym, type: CARDINAL ; BEGIN - IF IsParameter(param) + IF IsParameter (param) THEN - type := GetType(param) ; - sym := GetLocalSym(proc, GetSymName(param)) ; - IF IsUnbounded(type) + type := GetType (param) ; + sym := GetLocalSym (proc, GetSymName (param)) ; + IF IsUnbounded (type) THEN - RETURN( GetAddressOfUnbounded(location, sym) ) + RETURN( GetAddressOfUnbounded (location, sym) ) ELSE - Assert(GetMode(sym)=LeftValue) ; - RETURN( Mod2Gcc(sym) ) + Assert (GetMode (sym) = LeftValue) ; + RETURN( Mod2Gcc (sym) ) END ELSE - Assert(IsVar(param)) ; - Assert(GetMode(param)=LeftValue) ; + Assert (IsVar (param)) ; + Assert (GetMode (param) = LeftValue) ; RETURN( Mod2Gcc(param) ) END END GetParamAddress ; @@ -1927,31 +1961,18 @@ END CodeCall ; (* - CanUseBuiltin - returns TRUE if the procedure, Sym, can be - inlined via a builtin function. -*) - -PROCEDURE CanUseBuiltin (Sym: CARDINAL) : BOOLEAN ; -BEGIN - RETURN( (NOT DebugBuiltins) AND - (BuiltinExists(KeyToCharStar(GetProcedureBuiltin(Sym))) OR - BuiltinExists(KeyToCharStar(GetSymName(Sym)))) ) -END CanUseBuiltin ; - - -(* UseBuiltin - returns a Tree containing the builtin function and parameters. It should only be called if - CanUseBuiltin returns TRUE. + CanUseBuiltin or IsProcedureBuiltinAvailable returns TRUE. *) PROCEDURE UseBuiltin (tokenno: CARDINAL; Sym: CARDINAL) : Tree ; BEGIN IF BuiltinExists(KeyToCharStar(GetProcedureBuiltin(Sym))) THEN - RETURN( BuildBuiltinTree(TokenToLocation (tokenno), KeyToCharStar(GetProcedureBuiltin(Sym))) ) + RETURN( BuildBuiltinTree(TokenToLocation (tokenno), KeyToCharStar (GetProcedureBuiltin (Sym))) ) ELSE - RETURN( BuildBuiltinTree(TokenToLocation (tokenno), KeyToCharStar(GetSymName(Sym))) ) + RETURN( BuildBuiltinTree(TokenToLocation (tokenno), KeyToCharStar (GetSymName (Sym))) ) END END UseBuiltin ; @@ -1963,19 +1984,35 @@ END UseBuiltin ; PROCEDURE CodeDirectCall (tokenno: CARDINAL; procedure: CARDINAL) : Tree ; VAR location: location_t ; + call : Tree ; BEGIN - location := TokenToLocation(tokenno) ; - IF IsProcedureBuiltin(procedure) AND CanUseBuiltin(procedure) + location := TokenToLocation (tokenno) ; + IF IsProcedureBuiltinAvailable (procedure) THEN - RETURN UseBuiltin (tokenno, procedure) + call := UseBuiltin (tokenno, procedure) ; + IF call # NIL + THEN + call := BuildBuiltinCallTree (location, call) + END ELSE - IF GetType(procedure)=NulSym + call := NIL + END ; + IF call = NIL + THEN + IF GetType (procedure) = NulSym THEN - RETURN BuildProcedureCallTree(location, Mod2Gcc(procedure), NIL) + call := BuildProcedureCallTree (location, Mod2Gcc (procedure), NIL) ELSE - RETURN BuildProcedureCallTree(location, Mod2Gcc(procedure), Mod2Gcc(GetType(procedure))) + call := BuildProcedureCallTree (location, Mod2Gcc (procedure), Mod2Gcc (GetType (procedure))) END - END + END ; + IF GetType (procedure) = NulSym + THEN + SetLastFunction (NIL) + ELSE + SetLastFunction (call) + END ; + RETURN call END CodeDirectCall ; @@ -2208,43 +2245,43 @@ BEGIN location := TokenToLocation (CurrentQuadToken) ; n := q ; REPEAT - IF op1>0 + IF op1 > 0 THEN - DeclareConstant(CurrentQuadToken, op3) + DeclareConstant (CurrentQuadToken, op3) END ; - n := GetNextQuad(n) ; - GetQuad(n, op, r, op2, op3) - UNTIL op=FunctValueOp ; + n := GetNextQuad (n) ; + GetQuad (n, op, r, op2, op3) + UNTIL op = FunctValueOp ; n := q ; - GetQuad(n, op, op1, op2, op3) ; - res := Mod2Gcc(r) ; - max := GetSizeOfInBits(Mod2Gcc(Address)) ; - bits := GetIntegerZero(location) ; - val := GetPointerZero(location) ; + GetQuad (n, op, op1, op2, op3) ; + res := Mod2Gcc (r) ; + max := GetSizeOfInBits (Mod2Gcc(Address)) ; + bits := GetIntegerZero (location) ; + val := GetPointerZero (location) ; REPEAT - location := TokenToLocation(CurrentQuadToken) ; - IF (op=ParamOp) AND (op1>0) + location := TokenToLocation (CurrentQuadToken) ; + IF (op = ParamOp) AND (op1 > 0) THEN - IF GetType(op3)=NulSym + IF GetType (op3) = NulSym THEN - WriteFormat0('must supply typed constants to MAKEADR') + WriteFormat0 ('must supply typed constants to MAKEADR') ELSE - type := GetType(op3) ; - tmp := BuildConvert(location, GetPointerType(), Mod2Gcc(op3), FALSE) ; - IF CompareTrees(bits, GetIntegerZero(location))>0 + type := GetType (op3) ; + tmp := BuildConvert (location, GetPointerType (), Mod2Gcc (op3), FALSE) ; + IF CompareTrees (bits, GetIntegerZero (location)) > 0 THEN - tmp := BuildLSL(location, tmp, bits, FALSE) + tmp := BuildLSL (location, tmp, bits, FALSE) END ; - bits := BuildAdd(location, bits, GetSizeOfInBits(Mod2Gcc(type)), FALSE) ; - val := BuildLogicalOrAddress(location, val, tmp, FALSE) + bits := BuildAdd (location, bits, GetSizeOfInBits (Mod2Gcc (type)), FALSE) ; + val := BuildLogicalOrAddress (location, val, tmp, FALSE) END END ; - SubQuad(n) ; - n := GetNextQuad(n) ; - GetQuad(n, op, op1, op2, op3) + SubQuad (n) ; + n := GetNextQuad (n) ; + GetQuad (n, op, op1, op2, op3) UNTIL op=FunctValueOp ; - IF CompareTrees(bits, max)>0 + IF CompareTrees(bits, max) > 0 THEN MetaErrorT0 (CurrentQuadToken, 'total number of bits specified as parameters to {%kMAKEADR} exceeds address width') @@ -2259,11 +2296,15 @@ END CodeMakeAdr ; inlines the SYSTEM function MAKEADR. *) -PROCEDURE CodeBuiltinFunction (q: CARDINAL; op1, op2, op3: CARDINAL) ; +PROCEDURE CodeBuiltinFunction (q: CARDINAL; nth, func, parameter: CARDINAL) ; BEGIN - IF (op1=0) AND (op3=MakeAdr) + IF nth = 0 THEN - CodeMakeAdr (q, op1, op2, op3) + InitBuiltinSyms (BuiltinTokenNo) ; + IF func = MakeAdr + THEN + CodeMakeAdr (q, nth, func, parameter) + END END END CodeBuiltinFunction ; @@ -2294,55 +2335,55 @@ BEGIN IF r>0 THEN TryDeclareConstant (tokenno, op3) ; - IF NOT GccKnowsAbout(op3) + IF NOT GccKnowsAbout (op3) THEN resolved := FALSE END END ; - n := GetNextQuad(n) ; - GetQuad(n, op, r, op2, op3) - UNTIL op=FunctValueOp ; + n := GetNextQuad (n) ; + GetQuad (n, op, r, op2, op3) + UNTIL op = FunctValueOp ; - IF resolved AND IsConst(r) + IF resolved AND IsConst (r) THEN n := q ; - GetQuad(n, op, op1, op2, op3) ; - max := GetSizeOfInBits(Mod2Gcc(Address)) ; - bits := GetIntegerZero(location) ; - val := GetPointerZero(location) ; + GetQuad (n, op, op1, op2, op3) ; + max := GetSizeOfInBits (Mod2Gcc(Address)) ; + bits := GetIntegerZero (location) ; + val := GetPointerZero (location) ; REPEAT - location := TokenToLocation(tokenno) ; - IF (op=ParamOp) AND (op1>0) + location := TokenToLocation (tokenno) ; + IF (op = ParamOp) AND (op1 > 0) THEN - IF GetType(op3)=NulSym + IF GetType (op3) = NulSym THEN MetaErrorT0 (tokenno, 'constants passed to {%kMAKEADR} must be typed') ELSE - type := GetType(op3) ; - tmp := BuildConvert(location, GetPointerType(), Mod2Gcc(op3), FALSE) ; - IF CompareTrees(bits, GetIntegerZero(location))>0 + type := GetType (op3) ; + tmp := BuildConvert (location, GetPointerType (), Mod2Gcc (op3), FALSE) ; + IF CompareTrees (bits, GetIntegerZero (location)) > 0 THEN - tmp := BuildLSL(location, tmp, bits, FALSE) + tmp := BuildLSL (location, tmp, bits, FALSE) END ; - bits := BuildAdd(location, bits, GetSizeOfInBits(Mod2Gcc(type)), FALSE) ; - val := BuildLogicalOrAddress(location, val, tmp, FALSE) + bits := BuildAdd (location, bits, GetSizeOfInBits (Mod2Gcc (type)), FALSE) ; + val := BuildLogicalOrAddress (location, val, tmp, FALSE) END END ; - SubQuad(n) ; - n := GetNextQuad(n) ; - GetQuad(n, op, op1, op2, op3) - UNTIL op=FunctValueOp ; - IF CompareTrees(bits, max)>0 + SubQuad (n) ; + n := GetNextQuad (n) ; + GetQuad (n, op, op1, op2, op3) + UNTIL op = FunctValueOp ; + IF CompareTrees (bits, max) > 0 THEN MetaErrorT0 (tokenno, 'total number of bits specified as parameters to {%kMAKEADR} exceeds address width') END ; - PutConst(r, Address) ; - AddModGcc(r, DeclareKnownConstant(location, Mod2Gcc(Address), val)) ; - p(r) ; + PutConst (r, Address) ; + AddModGcc (r, DeclareKnownConstant (location, Mod2Gcc (Address), val)) ; + p (r) ; NoChange := FALSE ; - SubQuad(n) + SubQuad (n) END END FoldMakeAdr ; @@ -2376,7 +2417,7 @@ VAR op1, op2, op3 : CARDINAL ; op : QuadOperator ; - val : Tree ; + val, call : Tree ; location : location_t ; BEGIN GetQuad (q, op, op1, op2, op3) ; @@ -2419,10 +2460,12 @@ BEGIN GetQuad(n, op, op1, op2, op3) UNTIL op=FunctValueOp ; - IF IsProcedureBuiltin(procedure) AND CanUseBuiltin(procedure) + IF IsProcedureBuiltinAvailable (procedure) THEN location := TokenToLocation(tokenno) ; - val := FoldAndStrip (UseBuiltin (tokenno, procedure)) ; + call := UseBuiltin (tokenno, procedure) ; + val := BuildFunctValue (location, call) ; + val := FoldAndStrip (val) ; PutConst(r, GetType(procedure)) ; AddModGcc(r, DeclareKnownConstant(location, Mod2Gcc(GetType(procedure)), val)) ; p(r) ; @@ -2450,7 +2493,7 @@ BEGIN IF op3=MakeAdr THEN FoldMakeAdr (tokenno, p, q, op1, op2, op3) - ELSIF IsProcedure (op3) AND IsProcedureBuiltin (op3) AND CanUseBuiltin (op3) + ELSIF IsProcedure (op3) AND IsProcedureBuiltinAvailable (op3) THEN FoldBuiltin (tokenno, p, q) END @@ -7262,7 +7305,26 @@ BEGIN END CodeXIndr ; +(* + InitBuiltinSyms - +*) + +PROCEDURE InitBuiltinSyms (tok: CARDINAL) ; +BEGIN + IF Memset = NulSym + THEN + Memset := FromModuleGetSym (tok, MakeKey ('memset'), MakeDefinitionSource (tok, MakeKey ('Builtins'))) + END ; + IF Memcpy = NulSym + THEN + Memcpy := FromModuleGetSym (tok, MakeKey ('memcpy'), MakeDefinitionSource (tok, MakeKey ('Builtins'))) + END ; +END InitBuiltinSyms ; + + BEGIN + Memset := NulSym ; + Memcpy := NulSym ; UnboundedLabelNo := 0 ; CurrentQuadToken := 0 ; ScopeStack := InitStackWord () diff --git a/gcc/m2/gm2-compiler/M2Options.def b/gcc/m2/gm2-compiler/M2Options.def index 6eefe7c..b70cd8f 100644 --- a/gcc/m2/gm2-compiler/M2Options.def +++ b/gcc/m2/gm2-compiler/M2Options.def @@ -97,7 +97,8 @@ EXPORT QUALIFIED SetReturnCheck, SetNilCheck, SetCaseCheck, SetGenModuleList, GetGenModuleFilename, SharedFlag, SetB, GetB, SetMD, GetMD, SetMMD, GetMMD, SetObj, GetObj, GetMQ, SetMQ, SetM2Prefix, GetM2Prefix, - SetM2PathName, GetM2PathName, SetCaseEnumChecking ; + SetM2PathName, GetM2PathName, SetCaseEnumChecking, + SetDebugBuiltins ; VAR @@ -946,6 +947,13 @@ PROCEDURE SetCaseEnumChecking (value: BOOLEAN) ; (* + SetDebugBuiltins - sets the DebugBuiltins to value. +*) + +PROCEDURE SetDebugBuiltins (value: BOOLEAN) ; + + +(* FinaliseOptions - once all options have been parsed we set any inferred values. *) diff --git a/gcc/m2/gm2-compiler/M2Options.mod b/gcc/m2/gm2-compiler/M2Options.mod index f265aa5..1a64cf0 100644 --- a/gcc/m2/gm2-compiler/M2Options.mod +++ b/gcc/m2/gm2-compiler/M2Options.mod @@ -1367,7 +1367,11 @@ END SetShared ; (* - SetUninitVariableChecking - sets the UninitVariableChecking flag to value. + SetUninitVariableChecking - sets the UninitVariableChecking and + UninitVariableConditionalChecking flags to value + depending upon arg string. The arg string + can be: "all", "known,cond", "cond,known", "known" + or "cond". *) PROCEDURE SetUninitVariableChecking (value: BOOLEAN; arg: ADDRESS) : INTEGER ; @@ -1386,8 +1390,7 @@ BEGIN s := InitStringCharStar (arg) ; IF EqualArray (s, "all") OR EqualArray (s, "known,cond") OR - EqualArray (s, "cond,known") OR - EqualArray (s, "cond") + EqualArray (s, "cond,known") THEN UninitVariableChecking := value ; UninitVariableConditionalChecking := value ; @@ -1396,7 +1399,11 @@ BEGIN ELSIF EqualArray (s, "known") THEN UninitVariableChecking := value ; - UninitVariableConditionalChecking := NOT value ; + s := KillString (s) ; + RETURN 1 + ELSIF EqualArray (s, "cond") + THEN + UninitVariableConditionalChecking := value ; s := KillString (s) ; RETURN 1 ELSE @@ -1416,6 +1423,16 @@ BEGIN END SetCaseEnumChecking ; +(* + SetDebugBuiltins - sets the DebugBuiltins to value. +*) + +PROCEDURE SetDebugBuiltins (value: BOOLEAN) ; +BEGIN + DebugBuiltins := value +END SetDebugBuiltins ; + + BEGIN cflag := FALSE ; (* -c. *) RuntimeModuleOverride := InitString (DefaultRuntimeModuleOverride) ; diff --git a/gcc/m2/gm2-compiler/M2Quads.def b/gcc/m2/gm2-compiler/M2Quads.def index 743589f..298482b 100644 --- a/gcc/m2/gm2-compiler/M2Quads.def +++ b/gcc/m2/gm2-compiler/M2Quads.def @@ -1644,7 +1644,7 @@ PROCEDURE CheckBuildFunction () : BOOLEAN ; *) -PROCEDURE BuildFunctionCall ; +PROCEDURE BuildFunctionCall (ConstExpr: BOOLEAN) ; (* diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod index be837b3..0cea540 100644 --- a/gcc/m2/gm2-compiler/M2Quads.mod +++ b/gcc/m2/gm2-compiler/M2Quads.mod @@ -117,6 +117,7 @@ FROM SymbolTable IMPORT ModeOfAddr, GetMode, PutMode, GetSymName, IsUnknown, PushSize, PushValue, PopValue, GetVariableAtAddress, IsVariableAtAddress, MakeError, UnknownReported, + IsProcedureBuiltinAvailable, IsError, IsInnerModule, IsImportStatement, IsImport, GetImportModule, GetImportDeclared, @@ -5147,9 +5148,9 @@ BEGIN END ; IF IsDefImp (GetScope (ProcSym)) AND IsDefinitionForC (GetScope (ProcSym)) THEN - BuildRealFuncProcCall (tokno, FALSE, TRUE) + BuildRealFuncProcCall (tokno, FALSE, TRUE, FALSE) ELSE - BuildRealFuncProcCall (tokno, FALSE, FALSE) + BuildRealFuncProcCall (tokno, FALSE, FALSE, FALSE) END END BuildRealProcedureCall ; @@ -5179,7 +5180,7 @@ END BuildRealProcedureCall ; |----------------| *) -PROCEDURE BuildRealFuncProcCall (tokno: CARDINAL; IsFunc, IsForC: BOOLEAN) ; +PROCEDURE BuildRealFuncProcCall (tokno: CARDINAL; IsFunc, IsForC, ConstExpr: BOOLEAN) ; VAR AllocateProc, DeallocateProc, @@ -5220,7 +5221,7 @@ BEGIN ParamConstant := FALSE ELSE Proc := ProcSym ; - ParamConstant := IsProcedureBuiltin (Proc) ; + ParamConstant := TRUE ; AllocateProc := GetSymName (Proc) = MakeKey('ALLOCATE') ; DeallocateProc := GetSymName (Proc) = MakeKey('DEALLOCATE') END ; @@ -5295,13 +5296,18 @@ BEGIN INC (pi) END ; GenQuadO (proctok, CallOp, NulSym, NulSym, ProcSym, TRUE) ; - PopN (NoOfParameters+1) ; (* Destroy arguments and procedure call *) + PopN (NoOfParameters+1) ; (* Destroy arguments and procedure call *) IF IsFunc THEN - (* ReturnVar - will have the type of the procedure *) + (* ReturnVar has the type of the procedure. *) resulttok := MakeVirtualTok (proctok, proctok, paramtok) ; - ReturnVar := MakeTemporary (resulttok, AreConstant(ParamConstant)) ; - PutVar (ReturnVar, GetSType(Proc)) ; + IF ConstExpr AND (NOT IsProcedureBuiltinAvailable (Proc)) + THEN + MetaError1('{%1d} {%1ad} cannot be used in a constant expression', Proc) ; + ParamConstant := FALSE + END ; + ReturnVar := MakeTemporary (resulttok, AreConstant (ParamConstant AND ConstExpr)) ; + PutVar (ReturnVar, GetSType (Proc)) ; GenQuadO (resulttok, FunctValueOp, ReturnVar, NulSym, Proc, TRUE) ; IF NOT ForcedFunc THEN @@ -6624,19 +6630,19 @@ BEGIN PushTFtok (TSize, Cardinal, tok) ; (* TSIZE(ParamType) *) PushTtok (ParamType, tok) ; PushT (1) ; (* 1 parameter for TSIZE() *) - BuildFunctionCall ; + BuildFunctionCall (FALSE) ; BuildBinaryOp ELSE (* SIZE(parameter) DIV TSIZE(ParamType) *) PushTFtok (TSize, Cardinal, tok) ; (* TSIZE(ArrayType) *) PushTtok (ArrayType, tok) ; PushT (1) ; (* 1 parameter for TSIZE() *) - BuildFunctionCall ; + BuildFunctionCall (TRUE) ; PushT (DivideTok) ; (* Divide by *) PushTFtok (TSize, Cardinal, tok) ; (* TSIZE(ParamType) *) PushTtok (ParamType, tok) ; PushT (1) ; (* 1 parameter for TSIZE() *) - BuildFunctionCall ; + BuildFunctionCall (TRUE) ; BuildBinaryOp END ; (* now convert from no of elements into HIGH by subtracting 1 *) @@ -6734,15 +6740,15 @@ BEGIN PushTFtok (Field, GetSType (Field), tok) ; PushT (1) ; BuildDesignatorRecord (tok) ; - PushTFtok (Adr, Address, tok) ; (* ADR(Sym) *) + PushTFtok (Adr, Address, tok) ; (* ADR (Sym). *) IF IsUnbounded (SymType) AND (dim = 0) THEN PushTFADtok (Sym, SymType, UnboundedSym, dim, tok) ELSE PushTFADtok (Sym, SymType, ArraySym, dim, tok) END ; - PushT (1) ; (* 1 parameter for ADR() *) - BuildFunctionCall ; + PushT (1) ; (* 1 parameter for ADR(). *) + BuildFunctionCall (FALSE) ; BuildAssignmentWithoutBounds (tok, FALSE, TRUE) ; AssignHighFields (tok, Sym, ArraySym, UnboundedSym, ParamType, dim) @@ -6957,7 +6963,7 @@ BEGIN (* x^ *) PushTtok (GetItemPointedTo (PtrSym), paramtok) ; PushT (1) ; (* One parameter *) - BuildFunctionCall ; + BuildFunctionCall (FALSE) ; PopT (SizeSym) ; PushTtok (ProcSym, combinedtok) ; (* ALLOCATE *) @@ -7046,7 +7052,7 @@ BEGIN (* x^ *) PushTtok (GetItemPointedTo(PtrSym), paramtok) ; PushT (1) ; (* One parameter *) - BuildFunctionCall ; + BuildFunctionCall (FALSE) ; PopT (SizeSym) ; PushTtok (ProcSym, combinedtok) ; (* DEALLOCATE *) @@ -7527,7 +7533,7 @@ END CheckBuildFunction ; |----------------| |------------| *) -PROCEDURE BuildFunctionCall ; +PROCEDURE BuildFunctionCall (ConstExpr: BOOLEAN) ; VAR paramtok, combinedtok, @@ -7540,14 +7546,15 @@ BEGIN ProcSym := OperandT (NoOfParam + 1) ; ProcSym := SkipConst (ProcSym) ; PushT (NoOfParam) ; - (* Compile time stack restored to entry state *) + (* Compile time stack restored to entry state. *) IF IsUnknown (ProcSym) THEN paramtok := OperandTtok (1) ; combinedtok := MakeVirtualTok (functok, functok, paramtok) ; MetaErrorT1 (functok, 'procedure function {%1Ea} is undefined', ProcSym) ; PopN (NoOfParam + 2) ; - PushT (MakeConstLit (combinedtok, MakeKey ('0'), NulSym)) (* fake return value to continue compiling *) + (* Fake return value to continue compiling. *) + PushT (MakeConstLit (combinedtok, MakeKey ('0'), NulSym)) ELSIF IsAModula2Type (ProcSym) THEN ManipulatePseudoCallParameters ; @@ -7558,7 +7565,7 @@ BEGIN ManipulatePseudoCallParameters ; BuildPseudoFunctionCall ELSE - BuildRealFunctionCall (functok) + BuildRealFunctionCall (functok, ConstExpr) END END BuildFunctionCall ; @@ -7607,7 +7614,7 @@ BEGIN IF CompilerDebugging THEN printf2 ('procsym = %d token = %d\n', ProcSym, functok) ; - (* ErrorStringAt (InitString ('constant function'), functok) *) + (* ErrorStringAt (InitString ('constant function'), functok). *) END ; PushT (NoOfParam) ; IF (ProcSym # Convert) AND @@ -7615,29 +7622,27 @@ BEGIN IsPseudoSystemFunctionConstExpression (ProcSym) OR (IsProcedure (ProcSym) AND IsProcedureBuiltin (ProcSym))) THEN - BuildFunctionCall + BuildFunctionCall (TRUE) ELSE IF IsAModula2Type (ProcSym) THEN - (* type conversion *) + (* Type conversion. *) IF NoOfParam = 1 THEN ConstExpression := OperandT (NoOfParam + 1) ; paramtok := OperandTtok (NoOfParam + 1) ; PopN (NoOfParam + 2) ; - (* - Build macro: CONVERT( ProcSym, ConstExpression ) - *) + (* Build macro: CONVERT( ProcSym, ConstExpression ). *) PushTFtok (Convert, NulSym, functok) ; PushTtok (ProcSym, functok) ; PushTtok (ConstExpression, paramtok) ; - PushT (2) ; (* Two parameters *) + PushT (2) ; (* Two parameters. *) BuildConvertFunction ELSE MetaErrorT0 (functok, '{%E}a constant type conversion can only have one argument') END ELSE - (* error issue message and fake return stack *) + (* Error issue message and fake return stack. *) IF Iso THEN MetaErrorT0 (functok, 'the only functions permissible in a constant expression are: {%kCAP}, {%kCHR}, {%kCMPLX}, {%kFLOAT}, {%kHIGH}, {%kIM}, {%kLENGTH}, {%kMAX}, {%kMIN}, {%kODD}, {%kORD}, {%kRE}, {%kSIZE}, {%kTSIZE}, {%kTRUNC}, {%kVAL} and gcc builtins') @@ -7652,7 +7657,7 @@ BEGIN combinedtok := functok END ; PopN (NoOfParam+2) ; - PushT (MakeConstLit (combinedtok, MakeKey('0'), NulSym)) (* fake return value to continue compiling *) + PushT (MakeConstLit (combinedtok, MakeKey('0'), NulSym)) (* Fake return value to continue compiling. *) END END END BuildConstFunctionCall ; @@ -7725,8 +7730,8 @@ BEGIN MarkAsRead (r) ; resulttok := MakeVirtualTok (proctok, proctok, exptok) ; ReturnVar := MakeTemporary (resulttok, RightValue) ; - PutVar (ReturnVar, ProcSym) ; (* Set ReturnVar's TYPE *) - PopN (1) ; (* pop procedure. *) + PutVar (ReturnVar, ProcSym) ; (* Set ReturnVar's TYPE. *) + PopN (1) ; (* Pop procedure. *) IF IsConst (exp) OR IsVar (exp) THEN GenQuad (CoerceOp, ReturnVar, ProcSym, exp) @@ -7768,7 +7773,7 @@ END BuildTypeCoercion ; |----------------| |------------| *) -PROCEDURE BuildRealFunctionCall (tokno: CARDINAL) ; +PROCEDURE BuildRealFunctionCall (tokno: CARDINAL; ConstExpr: BOOLEAN) ; VAR NoOfParam, ProcSym : CARDINAL ; @@ -7779,14 +7784,14 @@ BEGIN ProcSym := SkipConst (ProcSym) ; IF IsVar(ProcSym) THEN - (* Procedure Variable ? *) - ProcSym := SkipType(OperandF(NoOfParam+2)) + (* Procedure Variable therefore get its type to see if it is a FOR "C" call. *) + ProcSym := SkipType (OperandF (NoOfParam+2)) END ; - IF IsDefImp (GetScope (ProcSym)) AND IsDefinitionForC (GetScope(ProcSym)) + IF IsDefImp (GetScope (ProcSym)) AND IsDefinitionForC (GetScope (ProcSym)) THEN - BuildRealFuncProcCall (tokno, TRUE, TRUE) + BuildRealFuncProcCall (tokno, TRUE, TRUE, ConstExpr) ELSE - BuildRealFuncProcCall (tokno, TRUE, FALSE) + BuildRealFuncProcCall (tokno, TRUE, FALSE, ConstExpr) END END BuildRealFunctionCall ; @@ -8428,7 +8433,7 @@ BEGIN PushTtok (ProcSym, functok) ; PushTFtok (Param, Type, paramtok) ; PushT (NoOfParam) ; - BuildRealFunctionCall (functok) + BuildRealFunctionCall (functok, FALSE) END ELSE PopT (NoOfParam) ; diff --git a/gcc/m2/gm2-compiler/P3Build.bnf b/gcc/m2/gm2-compiler/P3Build.bnf index 15c31fb..7cd7ec0 100644 --- a/gcc/m2/gm2-compiler/P3Build.bnf +++ b/gcc/m2/gm2-compiler/P3Build.bnf @@ -1111,7 +1111,7 @@ SetOrDesignatorOrFunction := Qualident THEN BuildConstFunctionCall ELSE - BuildFunctionCall + BuildFunctionCall (FALSE) END % ] ] | @@ -1158,7 +1158,7 @@ AssignmentOrProcedureCall := % VAR ( ActualParameters | % BuildNulParam (* in epsilon *) % ) % IF isFunc THEN - BuildFunctionCall ; + BuildFunctionCall (FALSE) ; BuildAssignment (tokno) ELSE BuildProcedureCall (tokno - 1) diff --git a/gcc/m2/gm2-compiler/SymbolTable.def b/gcc/m2/gm2-compiler/SymbolTable.def index e7356da..2068aa2 100644 --- a/gcc/m2/gm2-compiler/SymbolTable.def +++ b/gcc/m2/gm2-compiler/SymbolTable.def @@ -266,6 +266,7 @@ EXPORT QUALIFIED NulSym, IsDefLink, IsModLink, IsModuleBuiltin, + IsProcedureBuiltinAvailable, ForeachProcedureDo, ProcedureParametersDefined, @@ -3667,4 +3668,12 @@ PROCEDURE GetParameterHeapVar (ParSym: CARDINAL) : CARDINAL ; PROCEDURE PutProcedureParameterHeapVars (sym: CARDINAL) ; +(* + IsProcedureBuiltinAvailable - return TRUE if procedure is available as a builtin + for the target architecture. +*) + +PROCEDURE IsProcedureBuiltinAvailable (procedure: CARDINAL) : BOOLEAN ; + + END SymbolTable. diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod b/gcc/m2/gm2-compiler/SymbolTable.mod index 86f896e..dc41c12 100644 --- a/gcc/m2/gm2-compiler/SymbolTable.mod +++ b/gcc/m2/gm2-compiler/SymbolTable.mod @@ -32,7 +32,7 @@ FROM Indexing IMPORT InitIndex, InBounds, LowIndice, HighIndice, PutIndice, GetI FROM Sets IMPORT Set, InitSet, IncludeElementIntoSet, IsElementInSet ; FROM m2linemap IMPORT location_t ; -FROM M2Options IMPORT Pedantic, ExtendedOpaque, DebugFunctionLineNumbers, ScaffoldDynamic ; +FROM M2Options IMPORT Pedantic, ExtendedOpaque, DebugFunctionLineNumbers, ScaffoldDynamic, DebugBuiltins ; FROM M2LexBuf IMPORT UnknownTokenNo, TokenToLineNo, FindFileNameFromToken, TokenToLocation ; @@ -80,6 +80,7 @@ FROM m2decl IMPORT ConstantStringExceedsZType ; FROM m2tree IMPORT Tree ; FROM m2linemap IMPORT BuiltinsLocation ; FROM StrLib IMPORT StrEqual ; +FROM m2builtins IMPORT BuiltinExists ; FROM M2Comp IMPORT CompilingDefinitionModule, CompilingImplementationModule ; @@ -5788,6 +5789,30 @@ END IsProcedureBuiltin ; (* + CanUseBuiltin - returns TRUE if the procedure, Sym, can be + inlined via a builtin function. +*) + +PROCEDURE CanUseBuiltin (Sym: CARDINAL) : BOOLEAN ; +BEGIN + RETURN( (NOT DebugBuiltins) AND + (BuiltinExists (KeyToCharStar (GetProcedureBuiltin (Sym))) OR + BuiltinExists (KeyToCharStar (GetSymName (Sym)))) ) +END CanUseBuiltin ; + + +(* + IsProcedureBuiltinAvailable - return TRUE if procedure is available as a builtin + for the target architecture. +*) + +PROCEDURE IsProcedureBuiltinAvailable (procedure: CARDINAL) : BOOLEAN ; +BEGIN + RETURN IsProcedureBuiltin (procedure) AND CanUseBuiltin (procedure) +END IsProcedureBuiltinAvailable ; + + +(* PutProcedureInline - determines that procedure, Sym, has been requested to be inlined. *) diff --git a/gcc/m2/gm2-gcc/m2builtins.cc b/gcc/m2/gm2-gcc/m2builtins.cc index 3d13e20..8774ee7 100644 --- a/gcc/m2/gm2-gcc/m2builtins.cc +++ b/gcc/m2/gm2-gcc/m2builtins.cc @@ -29,6 +29,9 @@ along with GNU Modula-2; see the file COPYING3. If not see #include "m2tree.h" #include "m2treelib.h" #include "m2type.h" +#include "m2configure.h" + +#undef DEBUGGING #define GM2 #define GM2_BUG_REPORT \ @@ -107,6 +110,19 @@ typedef enum { BT_FN_DOUBLE_DOUBLE_DOUBLE, } builtin_prototype; +typedef enum +{ + bf_true, + bf_false, + bf_extension_lib, + bf_default_lib, + bf_gcc, + bf_c99, + bf_c99_c90res, + bf_extension_lib_floatn, + bf_c99_compl, +} bf_category; + struct builtin_function_entry { const char *name; @@ -116,6 +132,7 @@ struct builtin_function_entry const char *library_name; tree function_node; tree return_node; + bf_category function_avail; }; /* Entries are added by examining gcc/builtins.def and copying those @@ -123,255 +140,248 @@ struct builtin_function_entry static struct builtin_function_entry list_of_builtins[] = { { "__builtin_alloca", BT_FN_PTR_SIZE, BUILT_IN_ALLOCA, BUILT_IN_NORMAL, - "alloca", NULL, NULL }, + "alloca", NULL, NULL, bf_extension_lib }, { "__builtin_memcpy", BT_FN_TRAD_PTR_PTR_CONST_PTR_SIZE, BUILT_IN_MEMCPY, - BUILT_IN_NORMAL, "memcpy", NULL, NULL }, - + BUILT_IN_NORMAL, "memcpy", NULL, NULL, bf_default_lib }, { "__builtin_isfinite", BT_FN_INT_DOUBLE, BUILT_IN_ISFINITE, BUILT_IN_NORMAL, - "isfinite", NULL, NULL }, - + "isfinite", NULL, NULL, bf_gcc }, { "__builtin_sinf", BT_FN_FLOAT_FLOAT, BUILT_IN_SINF, BUILT_IN_NORMAL, - "sinf", NULL, NULL }, + "sinf", NULL, NULL, bf_c99_c90res }, { "__builtin_sin", BT_FN_DOUBLE_DOUBLE, BUILT_IN_SIN, BUILT_IN_NORMAL, "sin", - NULL, NULL }, + NULL, NULL, bf_c99_c90res }, { "__builtin_sinl", BT_FN_LONG_DOUBLE_LONG_DOUBLE, BUILT_IN_SINL, - BUILT_IN_NORMAL, "sinl", NULL, NULL }, + BUILT_IN_NORMAL, "sinl", NULL, NULL, bf_c99_c90res }, { "__builtin_cosf", BT_FN_FLOAT_FLOAT, BUILT_IN_SINF, BUILT_IN_NORMAL, - "cosf", NULL, NULL }, + "cosf", NULL, NULL, bf_c99_c90res }, { "__builtin_cos", BT_FN_DOUBLE_DOUBLE, BUILT_IN_COS, BUILT_IN_NORMAL, "cos", - NULL, NULL }, + NULL, NULL, bf_c99_c90res }, { "__builtin_cosl", BT_FN_LONG_DOUBLE_LONG_DOUBLE, BUILT_IN_COSL, - BUILT_IN_NORMAL, "cosl", NULL, NULL }, + BUILT_IN_NORMAL, "cosl", NULL, NULL, bf_c99_c90res }, { "__builtin_sqrtf", BT_FN_FLOAT_FLOAT, BUILT_IN_SQRTF, BUILT_IN_NORMAL, - "sqrtf", NULL, NULL }, + "sqrtf", NULL, NULL, bf_c99_c90res }, { "__builtin_sqrt", BT_FN_DOUBLE_DOUBLE, BUILT_IN_SQRT, BUILT_IN_NORMAL, - "sqrt", NULL, NULL }, + "sqrt", NULL, NULL, bf_default_lib }, { "__builtin_sqrtl", BT_FN_LONG_DOUBLE_LONG_DOUBLE, BUILT_IN_SQRTL, - BUILT_IN_NORMAL, "sqrtl", NULL, NULL }, + BUILT_IN_NORMAL, "sqrtl", NULL, NULL, bf_c99_c90res }, { "__builtin_fabsf", BT_FN_FLOAT_FLOAT, BUILT_IN_FABSF, BUILT_IN_NORMAL, - "fabsf", NULL, NULL }, + "fabsf", NULL, NULL, bf_c99_c90res }, { "__builtin_fabs", BT_FN_DOUBLE_DOUBLE, BUILT_IN_FABS, BUILT_IN_NORMAL, - "fabs", NULL, NULL }, + "fabs", NULL, NULL, bf_default_lib }, { "__builtin_fabsl", BT_FN_LONG_DOUBLE_LONG_DOUBLE, BUILT_IN_FABSL, - BUILT_IN_NORMAL, "fabsl", NULL, NULL }, + BUILT_IN_NORMAL, "fabsl", NULL, NULL, bf_c99_c90res }, { "__builtin_logf", BT_FN_FLOAT_FLOAT, BUILT_IN_LOGF, BUILT_IN_NORMAL, - "logf", NULL, NULL }, + "logf", NULL, NULL, bf_c99_c90res }, { "__builtin_log", BT_FN_DOUBLE_DOUBLE, BUILT_IN_LOG, BUILT_IN_NORMAL, "log", - NULL, NULL }, + NULL, NULL, bf_extension_lib_floatn }, { "__builtin_logl", BT_FN_LONG_DOUBLE_LONG_DOUBLE, BUILT_IN_LOGL, - BUILT_IN_NORMAL, "logl", NULL, NULL }, + BUILT_IN_NORMAL, "logl", NULL, NULL, bf_c99_c90res }, { "__builtin_expf", BT_FN_FLOAT_FLOAT, BUILT_IN_EXPF, BUILT_IN_NORMAL, - "expf", NULL, NULL }, + "expf", NULL, NULL, bf_c99_c90res }, { "__builtin_exp", BT_FN_DOUBLE_DOUBLE, BUILT_IN_EXP, BUILT_IN_NORMAL, "exp", - NULL, NULL }, + NULL, NULL, bf_extension_lib_floatn }, { "__builtin_expl", BT_FN_LONG_DOUBLE_LONG_DOUBLE, BUILT_IN_EXPL, - BUILT_IN_NORMAL, "expl", NULL, NULL }, + BUILT_IN_NORMAL, "expl", NULL, NULL, bf_c99_c90res }, { "__builtin_log10f", BT_FN_FLOAT_FLOAT, BUILT_IN_LOG10F, BUILT_IN_NORMAL, - "log10f", NULL, NULL }, + "log10f", NULL, NULL, bf_c99_c90res }, { "__builtin_log10", BT_FN_DOUBLE_DOUBLE, BUILT_IN_LOG10, BUILT_IN_NORMAL, - "log10", NULL, NULL }, + "log10", NULL, NULL, bf_default_lib }, { "__builtin_log10l", BT_FN_LONG_DOUBLE_LONG_DOUBLE, BUILT_IN_LOG10L, - BUILT_IN_NORMAL, "log10l", NULL, NULL }, + BUILT_IN_NORMAL, "log10l", NULL, NULL, bf_c99_c90res }, { "__builtin_ilogbf", BT_FN_INT_FLOAT, BUILT_IN_ILOGBF, BUILT_IN_NORMAL, - "ilogbf", NULL, NULL }, + "ilogbf", NULL, NULL, bf_c99 }, { "__builtin_ilogb", BT_FN_INT_DOUBLE, BUILT_IN_ILOGB, BUILT_IN_NORMAL, - "ilogb", NULL, NULL }, + "ilogb", NULL, NULL, bf_c99 }, { "__builtin_ilogbl", BT_FN_INT_LONG_DOUBLE, BUILT_IN_ILOGBL, - BUILT_IN_NORMAL, "ilogbl", NULL, NULL }, + BUILT_IN_NORMAL, "ilogbl", NULL, NULL, bf_c99 }, { "__builtin_atan2f", BT_FN_FLOAT_FLOAT_FLOAT, BUILT_IN_ATAN2F, - BUILT_IN_NORMAL, "atan2f", NULL, NULL }, + BUILT_IN_NORMAL, "atan2f", NULL, NULL, bf_c99_c90res }, { "__builtin_atan2", BT_FN_DOUBLE_DOUBLE_DOUBLE, BUILT_IN_ATAN2, - BUILT_IN_NORMAL, "atan2", NULL, NULL }, + BUILT_IN_NORMAL, "atan2", NULL, NULL, bf_default_lib }, { "__builtin_atan2l", BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG_DOUBLE, - BUILT_IN_ATAN2L, BUILT_IN_NORMAL, "atan2l", NULL, NULL }, + BUILT_IN_ATAN2L, BUILT_IN_NORMAL, "atan2l", NULL, NULL, bf_c99_c90res }, { "__builtin_signbit", BT_FN_INT_DOUBLE, BUILT_IN_SIGNBIT, BUILT_IN_NORMAL, - "signbit", NULL, NULL }, + "signbit", NULL, NULL, bf_extension_lib }, { "__builtin_signbitf", BT_FN_INT_FLOAT, BUILT_IN_SIGNBITF, BUILT_IN_NORMAL, - "signbitf", NULL, NULL }, + "signbitf", NULL, NULL, bf_extension_lib }, { "__builtin_signbitl", BT_FN_INT_LONG_DOUBLE, BUILT_IN_SIGNBITL, - BUILT_IN_NORMAL, "signbitl", NULL, NULL }, + BUILT_IN_NORMAL, "signbitl", NULL, NULL, bf_extension_lib }, { "__builtin_modf", BT_FN_DOUBLE_DOUBLE_DOUBLEPTR, BUILT_IN_MODF, - BUILT_IN_NORMAL, "modf", NULL, NULL }, + BUILT_IN_NORMAL, "modf", NULL, NULL, bf_default_lib }, { "__builtin_modff", BT_FN_FLOAT_FLOAT_FLOATPTR, BUILT_IN_MODFF, - BUILT_IN_NORMAL, "modff", NULL, NULL }, + BUILT_IN_NORMAL, "modff", NULL, NULL, bf_c99_c90res }, { "__builtin_modfl", BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG_DOUBLEPTR, - BUILT_IN_MODFL, BUILT_IN_NORMAL, "modfl", NULL, NULL }, + BUILT_IN_MODFL, BUILT_IN_NORMAL, "modfl", NULL, NULL, bf_c99_c90res }, { "__builtin_nextafter", BT_FN_DOUBLE_DOUBLE_DOUBLE, BUILT_IN_NEXTAFTER, - BUILT_IN_NORMAL, "nextafter", NULL, NULL }, + BUILT_IN_NORMAL, "nextafter", NULL, NULL, bf_c99 }, { "__builtin_nextafterf", BT_FN_FLOAT_FLOAT_FLOAT, BUILT_IN_NEXTAFTERF, - BUILT_IN_NORMAL, "nextafterf", NULL, NULL }, + BUILT_IN_NORMAL, "nextafterf", NULL, NULL, bf_c99 }, { "__builtin_nextafterl", BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG_DOUBLE, - BUILT_IN_NEXTAFTERL, BUILT_IN_NORMAL, "nextafterl", NULL, NULL }, + BUILT_IN_NEXTAFTERL, BUILT_IN_NORMAL, "nextafterl", NULL, NULL, bf_c99 }, { "__builtin_nexttoward", BT_FN_DOUBLE_DOUBLE_LONG_DOUBLE, - BUILT_IN_NEXTTOWARD, BUILT_IN_NORMAL, "nexttoward", NULL, NULL }, + BUILT_IN_NEXTTOWARD, BUILT_IN_NORMAL, "nexttoward", NULL, NULL, bf_c99 }, { "__builtin_nexttowardf", BT_FN_FLOAT_FLOAT_LONG_DOUBLE, - BUILT_IN_NEXTTOWARDF, BUILT_IN_NORMAL, "nexttowardf", NULL, NULL }, + BUILT_IN_NEXTTOWARDF, BUILT_IN_NORMAL, "nexttowardf", NULL, NULL, bf_c99 }, { "__builtin_nexttowardl", BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG_DOUBLE, - BUILT_IN_NEXTTOWARDL, BUILT_IN_NORMAL, "nexttowardl", NULL, NULL }, + BUILT_IN_NEXTTOWARDL, BUILT_IN_NORMAL, "nexttowardl", NULL, NULL, bf_c99 }, { "__builtin_scalbln", BT_FN_DOUBLE_DOUBLE_LONG, BUILT_IN_SCALBLN, - BUILT_IN_NORMAL, "scalbln", NULL, NULL }, + BUILT_IN_NORMAL, "scalbln", NULL, NULL, bf_extension_lib }, { "__builtin_scalblnf", BT_FN_FLOAT_FLOAT_LONG, BUILT_IN_SCALBLNF, - BUILT_IN_NORMAL, "scalblnf", NULL, NULL }, + BUILT_IN_NORMAL, "scalblnf", NULL, NULL, bf_extension_lib }, { "__builtin_scalblnl", BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG, - BUILT_IN_SCALBLNL, BUILT_IN_NORMAL, "scalblnl", NULL, NULL }, + BUILT_IN_SCALBLNL, BUILT_IN_NORMAL, "scalblnl", NULL, NULL, bf_extension_lib }, { "__builtin_scalbn", BT_FN_DOUBLE_DOUBLE_INT, BUILT_IN_SCALBN, - BUILT_IN_NORMAL, "scalbln", NULL, NULL }, + BUILT_IN_NORMAL, "scalbln", NULL, NULL, bf_extension_lib }, { "__builtin_scalbnf", BT_FN_FLOAT_FLOAT_INT, BUILT_IN_SCALBNF, - BUILT_IN_NORMAL, "scalblnf", NULL, NULL }, + BUILT_IN_NORMAL, "scalblnf", NULL, NULL, bf_extension_lib }, { "__builtin_scalbnl", BT_FN_LONG_DOUBLE_LONG_DOUBLE_INT, BUILT_IN_SCALBNL, - BUILT_IN_NORMAL, "scalblnl", NULL, NULL }, + BUILT_IN_NORMAL, "scalblnl", NULL, NULL, bf_extension_lib }, /* Complex intrinsic functions. */ { "__builtin_cabs", BT_FN_DOUBLE_DCOMPLEX, BUILT_IN_CABS, BUILT_IN_NORMAL, - "cabs", NULL, NULL }, + "cabs", NULL, NULL, bf_c99_compl }, { "__builtin_cabsf", BT_FN_FLOAT_FCOMPLEX, BUILT_IN_CABSF, BUILT_IN_NORMAL, - "cabsf", NULL, NULL }, + "cabsf", NULL, NULL, bf_c99_compl }, { "__builtin_cabsl", BT_FN_LONG_DOUBLE_LDCOMPLEX, BUILT_IN_CABSL, - BUILT_IN_NORMAL, "cabsl", NULL, NULL }, + BUILT_IN_NORMAL, "cabsl", NULL, NULL, bf_c99_compl }, { "__builtin_carg", BT_FN_DOUBLE_DCOMPLEX, BUILT_IN_CABS, BUILT_IN_NORMAL, - "carg", NULL, NULL }, + "carg", NULL, NULL, bf_c99_compl }, { "__builtin_cargf", BT_FN_FLOAT_FCOMPLEX, BUILT_IN_CABSF, BUILT_IN_NORMAL, - "cargf", NULL, NULL }, + "cargf", NULL, NULL, bf_c99_compl }, { "__builtin_cargl", BT_FN_LONG_DOUBLE_LDCOMPLEX, BUILT_IN_CABSL, - BUILT_IN_NORMAL, "cargl", NULL, NULL }, + BUILT_IN_NORMAL, "cargl", NULL, NULL, bf_c99_compl }, { "__builtin_conj", BT_FN_DCOMPLEX_DCOMPLEX, BUILT_IN_CONJ, BUILT_IN_NORMAL, - "carg", NULL, NULL }, + "carg", NULL, NULL, bf_c99_compl }, { "__builtin_conjf", BT_FN_FCOMPLEX_FCOMPLEX, BUILT_IN_CONJF, - BUILT_IN_NORMAL, "conjf", NULL, NULL }, + BUILT_IN_NORMAL, "conjf", NULL, NULL, bf_c99_compl }, { "__builtin_conjl", BT_FN_LDCOMPLEX_LDCOMPLEX, BUILT_IN_CONJL, - BUILT_IN_NORMAL, "conjl", NULL, NULL }, + BUILT_IN_NORMAL, "conjl", NULL, NULL, bf_c99_compl }, { "__builtin_cpow", BT_FN_DCOMPLEX_DOUBLE_DCOMPLEX, BUILT_IN_CPOW, - BUILT_IN_NORMAL, "cpow", NULL, NULL }, + BUILT_IN_NORMAL, "cpow", NULL, NULL, bf_c99_compl }, { "__builtin_cpowf", BT_FN_FCOMPLEX_FLOAT_FCOMPLEX, BUILT_IN_CPOWF, - BUILT_IN_NORMAL, "cpowf", NULL, NULL }, + BUILT_IN_NORMAL, "cpowf", NULL, NULL, bf_c99_compl }, { "__builtin_cpowl", BT_FN_LDCOMPLEX_LONG_DOUBLE_LDCOMPLEX, BUILT_IN_CPOWL, - BUILT_IN_NORMAL, "cpowl", NULL, NULL }, + BUILT_IN_NORMAL, "cpowl", NULL, NULL, bf_c99_compl }, { "__builtin_csqrt", BT_FN_DCOMPLEX_DCOMPLEX, BUILT_IN_CSQRT, - BUILT_IN_NORMAL, "csqrt", NULL, NULL }, + BUILT_IN_NORMAL, "csqrt", NULL, NULL, bf_c99_compl }, { "__builtin_csqrtf", BT_FN_FCOMPLEX_FCOMPLEX, BUILT_IN_CSQRTF, - BUILT_IN_NORMAL, "csqrtf", NULL, NULL }, + BUILT_IN_NORMAL, "csqrtf", NULL, NULL, bf_c99_compl }, { "__builtin_csqrtl", BT_FN_LDCOMPLEX_LDCOMPLEX, BUILT_IN_CSQRTL, - BUILT_IN_NORMAL, "csqrtl", NULL, NULL }, + BUILT_IN_NORMAL, "csqrtl", NULL, NULL, bf_c99_compl }, { "__builtin_cexp", BT_FN_DCOMPLEX_DCOMPLEX, BUILT_IN_CEXP, BUILT_IN_NORMAL, - "cexp", NULL, NULL }, + "cexp", NULL, NULL, bf_c99_compl }, { "__builtin_cexpf", BT_FN_FCOMPLEX_FCOMPLEX, BUILT_IN_CEXPF, - BUILT_IN_NORMAL, "cexpf", NULL, NULL }, + BUILT_IN_NORMAL, "cexpf", NULL, NULL, bf_c99_compl }, { "__builtin_cexpl", BT_FN_LDCOMPLEX_LDCOMPLEX, BUILT_IN_CEXPL, - BUILT_IN_NORMAL, "cexpl", NULL, NULL }, + BUILT_IN_NORMAL, "cexpl", NULL, NULL, bf_c99_compl }, - { "__builtin_cln", BT_FN_DCOMPLEX_DCOMPLEX, BUILT_IN_CLOG, BUILT_IN_NORMAL, - "cln", NULL, NULL }, - { "__builtin_clnf", BT_FN_FCOMPLEX_FCOMPLEX, BUILT_IN_CLOGF, BUILT_IN_NORMAL, - "clnf", NULL, NULL }, - { "__builtin_clnl", BT_FN_LDCOMPLEX_LDCOMPLEX, BUILT_IN_CLOGL, - BUILT_IN_NORMAL, "clnl", NULL, NULL }, + { "__builtin_clog", BT_FN_DCOMPLEX_DCOMPLEX, BUILT_IN_CLOG, BUILT_IN_NORMAL, + "clog", NULL, NULL, bf_c99_compl }, + { "__builtin_clogf", BT_FN_FCOMPLEX_FCOMPLEX, BUILT_IN_CLOGF, BUILT_IN_NORMAL, + "clogf", NULL, NULL, bf_c99_compl }, + { "__builtin_clogl", BT_FN_LDCOMPLEX_LDCOMPLEX, BUILT_IN_CLOGL, + BUILT_IN_NORMAL, "clogl", NULL, NULL, bf_c99_compl }, { "__builtin_csin", BT_FN_DCOMPLEX_DCOMPLEX, BUILT_IN_CSIN, BUILT_IN_NORMAL, - "csin", NULL, NULL }, + "csin", NULL, NULL, bf_c99_compl }, { "__builtin_csinf", BT_FN_FCOMPLEX_FCOMPLEX, BUILT_IN_CSINF, - BUILT_IN_NORMAL, "csinf", NULL, NULL }, + BUILT_IN_NORMAL, "csinf", NULL, NULL, bf_c99_compl }, { "__builtin_csinl", BT_FN_LDCOMPLEX_LDCOMPLEX, BUILT_IN_CSINL, - BUILT_IN_NORMAL, "csinl", NULL, NULL }, + BUILT_IN_NORMAL, "csinl", NULL, NULL, bf_c99_compl }, { "__builtin_ccos", BT_FN_DCOMPLEX_DCOMPLEX, BUILT_IN_CCOS, BUILT_IN_NORMAL, - "ccos", NULL, NULL }, + "ccos", NULL, NULL, bf_c99_compl }, { "__builtin_ccosf", BT_FN_FCOMPLEX_FCOMPLEX, BUILT_IN_CCOSF, - BUILT_IN_NORMAL, "ccosf", NULL, NULL }, + BUILT_IN_NORMAL, "ccosf", NULL, NULL, bf_c99_compl }, { "__builtin_ccosl", BT_FN_LDCOMPLEX_LDCOMPLEX, BUILT_IN_CCOSL, - BUILT_IN_NORMAL, "ccosl", NULL, NULL }, + BUILT_IN_NORMAL, "ccosl", NULL, NULL, bf_c99_compl }, { "__builtin_ctan", BT_FN_DCOMPLEX_DCOMPLEX, BUILT_IN_CTAN, BUILT_IN_NORMAL, - "ctan", NULL, NULL }, + "ctan", NULL, NULL, bf_c99_compl }, { "__builtin_ctanf", BT_FN_FCOMPLEX_FCOMPLEX, BUILT_IN_CTANF, - BUILT_IN_NORMAL, "ctanf", NULL, NULL }, + BUILT_IN_NORMAL, "ctanf", NULL, NULL, bf_c99_compl }, { "__builtin_ctanl", BT_FN_LDCOMPLEX_LDCOMPLEX, BUILT_IN_CTANL, - BUILT_IN_NORMAL, "ctanl", NULL, NULL }, + BUILT_IN_NORMAL, "ctanl", NULL, NULL, bf_c99_compl }, { "__builtin_casin", BT_FN_DCOMPLEX_DCOMPLEX, BUILT_IN_CASIN, - BUILT_IN_NORMAL, "casin", NULL, NULL }, + BUILT_IN_NORMAL, "casin", NULL, NULL, bf_c99_compl }, { "__builtin_casinf", BT_FN_FCOMPLEX_FCOMPLEX, BUILT_IN_CASINF, - BUILT_IN_NORMAL, "casinf", NULL, NULL }, + BUILT_IN_NORMAL, "casinf", NULL, NULL, bf_c99_compl }, { "__builtin_casinl", BT_FN_LDCOMPLEX_LDCOMPLEX, BUILT_IN_CASINL, - BUILT_IN_NORMAL, "casinl", NULL, NULL }, + BUILT_IN_NORMAL, "casinl", NULL, NULL, bf_c99_compl }, { "__builtin_cacos", BT_FN_DCOMPLEX_DCOMPLEX, BUILT_IN_CACOS, - BUILT_IN_NORMAL, "cacos", NULL, NULL }, + BUILT_IN_NORMAL, "cacos", NULL, NULL, bf_c99_compl }, { "__builtin_cacosf", BT_FN_FCOMPLEX_FCOMPLEX, BUILT_IN_CACOSF, - BUILT_IN_NORMAL, "cacosf", NULL, NULL }, + BUILT_IN_NORMAL, "cacosf", NULL, NULL, bf_c99_compl }, { "__builtin_cacosl", BT_FN_LDCOMPLEX_LDCOMPLEX, BUILT_IN_CACOSL, - BUILT_IN_NORMAL, "cacosl", NULL, NULL }, + BUILT_IN_NORMAL, "cacosl", NULL, NULL, bf_c99_compl }, { "__builtin_catan", BT_FN_DCOMPLEX_DCOMPLEX, BUILT_IN_CATAN, - BUILT_IN_NORMAL, "catan", NULL, NULL }, + BUILT_IN_NORMAL, "catan", NULL, NULL, bf_c99_compl }, { "__builtin_catanf", BT_FN_FCOMPLEX_FCOMPLEX, BUILT_IN_CATANF, - BUILT_IN_NORMAL, "catanf", NULL, NULL }, + BUILT_IN_NORMAL, "catanf", NULL, NULL, bf_c99_compl }, { "__builtin_catanl", BT_FN_LDCOMPLEX_LDCOMPLEX, BUILT_IN_CATANL, - BUILT_IN_NORMAL, "catanl", NULL, NULL }, + BUILT_IN_NORMAL, "catanl", NULL, NULL, bf_c99_compl }, { "__builtin_huge_val", BT_FN_DOUBLE, BUILT_IN_HUGE_VAL, BUILT_IN_NORMAL, - "huge_val", NULL, NULL }, + "huge_val", NULL, NULL, bf_gcc }, { "__builtin_huge_valf", BT_FN_FLOAT, BUILT_IN_HUGE_VALF, BUILT_IN_NORMAL, - "huge_valf", NULL, NULL }, + "huge_valf", NULL, NULL, bf_gcc }, { "__builtin_huge_vall", BT_FN_LONG_DOUBLE, BUILT_IN_HUGE_VALL, - BUILT_IN_NORMAL, "huge_vall", NULL, NULL }, + BUILT_IN_NORMAL, "huge_vall", NULL, NULL, bf_gcc }, { "__builtin_index", BT_FN_STRING_CONST_STRING_INT, BUILT_IN_INDEX, - BUILT_IN_NORMAL, "index", NULL, NULL }, + BUILT_IN_NORMAL, "index", NULL, NULL, bf_extension_lib }, { "__builtin_rindex", BT_FN_STRING_CONST_STRING_INT, BUILT_IN_RINDEX, - BUILT_IN_NORMAL, "rindex", NULL, NULL }, + BUILT_IN_NORMAL, "rindex", NULL, NULL, bf_extension_lib }, { "__builtin_memcmp", BT_FN_INT_CONST_PTR_CONST_PTR_SIZE, BUILT_IN_MEMCMP, - BUILT_IN_NORMAL, "memcmp", NULL, NULL }, + BUILT_IN_NORMAL, "memcmp", NULL, NULL, bf_default_lib }, { "__builtin_memmove", BT_FN_TRAD_PTR_PTR_CONST_PTR_SIZE, BUILT_IN_MEMMOVE, - BUILT_IN_NORMAL, "memmove", NULL, NULL }, + BUILT_IN_NORMAL, "memmove", NULL, NULL, bf_default_lib }, { "__builtin_memset", BT_FN_TRAD_PTR_PTR_INT_SIZE, BUILT_IN_MEMSET, - BUILT_IN_NORMAL, "memset", NULL, NULL }, + BUILT_IN_NORMAL, "memset", NULL, NULL, bf_default_lib }, { "__builtin_strcat", BT_FN_STRING_STRING_CONST_STRING, BUILT_IN_STRCAT, - BUILT_IN_NORMAL, "strcat", NULL, NULL }, + BUILT_IN_NORMAL, "strcat", NULL, NULL, bf_default_lib }, { "__builtin_strncat", BT_FN_STRING_STRING_CONST_STRING_SIZE, - BUILT_IN_STRNCAT, BUILT_IN_NORMAL, "strncat", NULL, NULL }, + BUILT_IN_STRNCAT, BUILT_IN_NORMAL, "strncat", NULL, NULL, bf_default_lib }, { "__builtin_strcpy", BT_FN_STRING_STRING_CONST_STRING, BUILT_IN_STRCPY, - BUILT_IN_NORMAL, "strcpy", NULL, NULL }, + BUILT_IN_NORMAL, "strcpy", NULL, NULL, bf_default_lib }, { "__builtin_strncpy", BT_FN_STRING_STRING_CONST_STRING_SIZE, - BUILT_IN_STRNCPY, BUILT_IN_NORMAL, "strncpy", NULL, NULL }, + BUILT_IN_STRNCPY, BUILT_IN_NORMAL, "strncpy", NULL, NULL, bf_default_lib }, { "__builtin_strcmp", BT_FN_INT_CONST_STRING_CONST_STRING, BUILT_IN_STRCMP, - BUILT_IN_NORMAL, "strcmp", NULL, NULL }, + BUILT_IN_NORMAL, "strcmp", NULL, NULL, bf_default_lib }, { "__builtin_strncmp", BT_FN_INT_CONST_STRING_CONST_STRING_SIZE, - BUILT_IN_STRNCMP, BUILT_IN_NORMAL, "strncmp", NULL, NULL }, + BUILT_IN_STRNCMP, BUILT_IN_NORMAL, "strncmp", NULL, NULL, bf_default_lib }, { "__builtin_strlen", BT_FN_INT_CONST_STRING, BUILT_IN_STRLEN, - BUILT_IN_NORMAL, "strlen", NULL, NULL }, + BUILT_IN_NORMAL, "strlen", NULL, NULL, bf_default_lib }, { "__builtin_strstr", BT_FN_STRING_CONST_STRING_CONST_STRING, - BUILT_IN_STRSTR, BUILT_IN_NORMAL, "strstr", NULL, NULL }, + BUILT_IN_STRSTR, BUILT_IN_NORMAL, "strstr", NULL, NULL, bf_default_lib }, { "__builtin_strpbrk", BT_FN_STRING_CONST_STRING_CONST_STRING, - BUILT_IN_STRPBRK, BUILT_IN_NORMAL, "strpbrk", NULL, NULL }, + BUILT_IN_STRPBRK, BUILT_IN_NORMAL, "strpbrk", NULL, NULL, bf_default_lib }, { "__builtin_strspn", BT_FN_SIZE_CONST_STRING_CONST_STRING, BUILT_IN_STRSPN, - BUILT_IN_NORMAL, "strspn", NULL, NULL }, + BUILT_IN_NORMAL, "strspn", NULL, NULL, bf_default_lib }, { "__builtin_strcspn", BT_FN_SIZE_CONST_STRING_CONST_STRING, - BUILT_IN_STRCSPN, BUILT_IN_NORMAL, "strcspn", NULL, NULL }, + BUILT_IN_STRCSPN, BUILT_IN_NORMAL, "strcspn", NULL, NULL, bf_default_lib }, { "__builtin_strchr", BT_FN_STRING_CONST_STRING_INT, BUILT_IN_STRCHR, - BUILT_IN_NORMAL, "strchr", NULL, NULL }, + BUILT_IN_NORMAL, "strchr", NULL, NULL, bf_default_lib }, { "__builtin_strrchr", BT_FN_STRING_CONST_STRING_INT, BUILT_IN_STRCHR, - BUILT_IN_NORMAL, "strrchr", NULL, NULL }, - //{ "__builtin_constant_p", BT_FN_INT_VAR, BUILT_IN_CONSTANT_P, - //BUILT_IN_NORMAL, "constant_p", NULL, NULL}, + BUILT_IN_NORMAL, "strrchr", NULL, NULL, bf_default_lib }, { "__builtin_frame_address", BT_FN_PTR_UNSIGNED, BUILT_IN_FRAME_ADDRESS, - BUILT_IN_NORMAL, "frame_address", NULL, NULL }, + BUILT_IN_NORMAL, "frame_address", NULL, NULL, bf_gcc }, { "__builtin_return_address", BT_FN_PTR_UNSIGNED, BUILT_IN_RETURN_ADDRESS, - BUILT_IN_NORMAL, "return_address", NULL, NULL }, - //{ "__builtin_aggregate_incoming_address", BT_FN_PTR_VAR, - //BUILT_IN_AGGREGATE_INCOMING_ADDRESS, BUILT_IN_NORMAL, - //"aggregate_incoming_address", NULL, NULL}, + BUILT_IN_NORMAL, "return_address", NULL, NULL, bf_gcc }, { "__builtin_longjmp", BT_FN_VOID_PTR_INT, BUILT_IN_LONGJMP, BUILT_IN_NORMAL, - "longjmp", NULL, NULL }, + "longjmp", NULL, NULL, bf_gcc }, { "__builtin_setjmp", BT_FN_INT_PTR, BUILT_IN_SETJMP, BUILT_IN_NORMAL, - "setjmp", NULL, NULL }, - { NULL, BT_FN_NONE, 0, NOT_BUILT_IN, "", NULL, NULL } + "setjmp", NULL, NULL, bf_gcc }, + { NULL, BT_FN_NONE, 0, NOT_BUILT_IN, "", NULL, NULL, bf_false} }; struct builtin_type_info @@ -396,6 +406,7 @@ static GTY (()) tree double_ftype_double; static GTY (()) tree ldouble_ftype_ldouble; static GTY (()) tree gm2_alloca_node; static GTY (()) tree gm2_memcpy_node; +static GTY (()) tree gm2_memset_node; static GTY (()) tree gm2_isfinite_node; static GTY (()) tree gm2_huge_valf_node; static GTY (()) tree gm2_huge_val_node; @@ -771,15 +782,36 @@ donModes (location_t location ATTRIBUTE_UNUSED, tree type ATTRIBUTE_UNUSED) return m2decl_BuildIntegerConstant (1); } -/* BuiltInMemCopy - copy n bytes of memory efficiently from address +/* BuiltinMemCopy - copy n bytes of memory efficiently from address src to dest. */ tree -m2builtins_BuiltInMemCopy (location_t location, tree dest, tree src, tree n) +m2builtins_BuiltinMemCopy (location_t location, tree dest, tree src, tree n) { return DoBuiltinMemCopy (location, dest, src, n); } + +static tree +DoBuiltinMemSet (location_t location, tree ptr, tree bytevalue, tree nbytes) +{ + tree functype = TREE_TYPE (gm2_memset_node); + tree funcptr + = build1 (ADDR_EXPR, build_pointer_type (functype), gm2_memset_node); + tree call + = m2treelib_DoCall3 (location, ptr_type_node, funcptr, ptr, bytevalue, nbytes); + return call; +} + +/* BuiltinMemSet set copy n bytes of memory efficiently from address + src to dest. */ + +tree +m2builtins_BuiltinMemSet (location_t location, tree ptr, tree bytevalue, tree nbytes) +{ + return DoBuiltinMemSet (location, ptr, bytevalue, nbytes); +} + /* BuiltInAlloca - given an expression, n, allocate, n, bytes on the stack for the life of the current function. */ @@ -798,6 +830,65 @@ m2builtins_BuiltInIsfinite (location_t location, tree expression) return DoBuiltinIsfinite (location, expression); } + +/* do_target_support_exists returns true if the builting function + is supported by the target. */ + +static +bool +do_target_support_exists (struct builtin_function_entry *fe) +{ + tree type = TREE_TYPE (fe->function_node); + + switch (fe->function_avail) + { + case bf_true: + return true; + case bf_false: + return false; + case bf_extension_lib: + return true; + case bf_default_lib: + return true; + case bf_gcc: + return true; + case bf_c99: + return targetm.libc_has_function (function_c99_misc, type); + case bf_c99_c90res: + return targetm.libc_has_function (function_c99_misc, type); + case bf_extension_lib_floatn: + return true; + default: + gcc_unreachable (); + } + return false; +} + + +static +bool +target_support_exists (struct builtin_function_entry *fe) +{ +#if defined(DEBUGGING) + printf ("target_support_exists (%s): ", fe->library_name); +#endif + if (do_target_support_exists (fe)) + { +#if defined(DEBUGGING) + printf ("yes\n"); +#endif + return true; + } + else + { +#if defined(DEBUGGING) + printf ("no\n"); +#endif + return false; + } +} + + /* BuiltinExists - returns TRUE if the builtin function, name, exists for this target architecture. */ @@ -808,11 +899,13 @@ m2builtins_BuiltinExists (char *name) for (fe = &list_of_builtins[0]; fe->name != NULL; fe++) if (strcmp (name, fe->name) == 0) - return TRUE; + return true; + // return target_support_exists (fe); - return FALSE; + return false; } + /* BuildBuiltinTree - returns a Tree containing the builtin function, name. */ @@ -820,23 +913,23 @@ tree m2builtins_BuildBuiltinTree (location_t location, char *name) { struct builtin_function_entry *fe; - tree t; + tree call; m2statement_SetLastFunction (NULL_TREE); + for (fe = &list_of_builtins[0]; fe->name != NULL; fe++) - if (strcmp (name, fe->name) == 0) + if ((strcmp (name, fe->name) == 0) && target_support_exists (fe)) { tree functype = TREE_TYPE (fe->function_node); tree funcptr = build1 (ADDR_EXPR, build_pointer_type (functype), fe->function_node); - - m2statement_SetLastFunction (m2treelib_DoCall ( - location, fe->return_node, funcptr, m2statement_GetParamList ())); + call = m2treelib_DoCall ( + location, fe->return_node, funcptr, m2statement_GetParamList ()); + m2statement_SetLastFunction (call); m2statement_SetParamList (NULL_TREE); - t = m2statement_GetLastFunction (); if (fe->return_node == void_type_node) m2statement_SetLastFunction (NULL_TREE); - return t; + return call; } m2statement_SetParamList (NULL_TREE); @@ -938,7 +1031,7 @@ create_function_prototype (location_t location, break; case BT_FN_LONG_DOUBLE: ftype = ldouble_ftype_void; - fe->return_node = long_double_type_node; + fe->return_node = m2type_GetM2LongRealType (); break; case BT_FN_FLOAT_FLOAT: ftype = float_ftype_float; @@ -950,7 +1043,7 @@ create_function_prototype (location_t location, break; case BT_FN_LONG_DOUBLE_LONG_DOUBLE: ftype = ldouble_ftype_ldouble; - fe->return_node = long_double_type_node; + fe->return_node = m2type_GetM2LongRealType (); break; case BT_FN_STRING_CONST_STRING_INT: ftype = build_function_type ( @@ -1032,7 +1125,7 @@ create_function_prototype (location_t location, case BT_FN_INT_LONG_DOUBLE: ftype = build_function_type ( integer_type_node, - tree_cons (NULL_TREE, long_double_type_node, endlink)); + tree_cons (NULL_TREE, m2type_GetM2LongRealType (), endlink)); fe->return_node = integer_type_node; break; case BT_FN_FLOAT_FCOMPLEX: @@ -1049,9 +1142,9 @@ create_function_prototype (location_t location, break; case BT_FN_LONG_DOUBLE_LDCOMPLEX: ftype = build_function_type ( - long_double_type_node, - tree_cons (NULL_TREE, complex_long_double_type_node, endlink)); - fe->return_node = long_double_type_node; + m2type_GetM2LongRealType (), + tree_cons (NULL_TREE, m2type_GetM2LongComplexType (), endlink)); + fe->return_node = m2type_GetM2LongRealType (); break; case BT_FN_FCOMPLEX_FCOMPLEX: ftype = build_function_type ( @@ -1067,9 +1160,9 @@ create_function_prototype (location_t location, break; case BT_FN_LDCOMPLEX_LDCOMPLEX: ftype = build_function_type ( - complex_long_double_type_node, - tree_cons (NULL_TREE, complex_long_double_type_node, endlink)); - fe->return_node = complex_long_double_type_node; + m2type_GetM2LongComplexType (), + tree_cons (NULL_TREE, m2type_GetM2LongComplexType (), endlink)); + fe->return_node = m2type_GetM2LongComplexType (); break; case BT_FN_DCOMPLEX_DOUBLE_DCOMPLEX: ftype = build_function_type ( @@ -1087,10 +1180,10 @@ create_function_prototype (location_t location, break; case BT_FN_LDCOMPLEX_LONG_DOUBLE_LDCOMPLEX: ftype = build_function_type ( - complex_long_double_type_node, - tree_cons (NULL_TREE, complex_long_double_type_node, - tree_cons (NULL_TREE, long_double_type_node, endlink))); - fe->return_node = complex_long_double_type_node; + m2type_GetM2LongComplexType (), + tree_cons (NULL_TREE, m2type_GetM2LongComplexType (), + tree_cons (NULL_TREE, m2type_GetM2LongRealType (), endlink))); + fe->return_node = m2type_GetM2LongComplexType (); break; case BT_FN_FLOAT_FLOAT_FLOATPTR: ftype = build_function_type ( @@ -1108,32 +1201,32 @@ create_function_prototype (location_t location, break; case BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG_DOUBLEPTR: ftype = build_function_type ( - long_double_type_node, + m2type_GetM2LongRealType (), tree_cons ( - NULL_TREE, long_double_type_node, + NULL_TREE, m2type_GetM2LongRealType (), tree_cons (NULL_TREE, long_doubleptr_type_node, endlink))); - fe->return_node = long_double_type_node; + fe->return_node = m2type_GetM2LongRealType (); break; case BT_FN_FLOAT_FLOAT_LONG_DOUBLE: ftype = build_function_type ( float_type_node, tree_cons (NULL_TREE, float_type_node, - tree_cons (NULL_TREE, long_double_type_node, endlink))); + tree_cons (NULL_TREE, m2type_GetM2LongRealType (), endlink))); fe->return_node = float_type_node; break; case BT_FN_DOUBLE_DOUBLE_LONG_DOUBLE: ftype = build_function_type ( double_type_node, tree_cons (NULL_TREE, double_type_node, - tree_cons (NULL_TREE, long_double_type_node, endlink))); + tree_cons (NULL_TREE, m2type_GetM2LongRealType (), endlink))); fe->return_node = double_type_node; break; case BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG_DOUBLE: ftype = build_function_type ( - long_double_type_node, - tree_cons (NULL_TREE, long_double_type_node, - tree_cons (NULL_TREE, long_double_type_node, endlink))); - fe->return_node = long_double_type_node; + m2type_GetM2LongRealType (), + tree_cons (NULL_TREE, m2type_GetM2LongRealType (), + tree_cons (NULL_TREE, m2type_GetM2LongRealType (), endlink))); + fe->return_node = m2type_GetM2LongRealType (); break; case BT_FN_FLOAT_FLOAT_LONG: ftype = build_function_type ( @@ -1151,10 +1244,10 @@ create_function_prototype (location_t location, break; case BT_FN_LONG_DOUBLE_LONG_DOUBLE_LONG: ftype = build_function_type ( - long_double_type_node, - tree_cons (NULL_TREE, long_double_type_node, + m2type_GetM2LongRealType (), + tree_cons (NULL_TREE, m2type_GetM2LongRealType (), tree_cons (NULL_TREE, long_integer_type_node, endlink))); - fe->return_node = long_double_type_node; + fe->return_node = m2type_GetM2LongRealType (); break; case BT_FN_FLOAT_FLOAT_INT: ftype = build_function_type ( @@ -1172,10 +1265,10 @@ create_function_prototype (location_t location, break; case BT_FN_LONG_DOUBLE_LONG_DOUBLE_INT: ftype = build_function_type ( - long_double_type_node, - tree_cons (NULL_TREE, long_double_type_node, + m2type_GetM2LongRealType (), + tree_cons (NULL_TREE, m2type_GetM2LongRealType (), tree_cons (NULL_TREE, integer_type_node, endlink))); - fe->return_node = long_double_type_node; + fe->return_node = m2type_GetM2LongRealType (); break; case BT_FN_FLOAT_FLOAT_FLOAT: ftype = build_function_type ( @@ -1264,9 +1357,9 @@ m2builtins_init (location_t location) float_ftype_void = build_function_type (float_type_node, math_endlink); double_ftype_void = build_function_type (double_type_node, math_endlink); ldouble_ftype_void - = build_function_type (long_double_type_node, math_endlink); + = build_function_type (m2type_GetM2LongRealType (), math_endlink); - long_doubleptr_type_node = build_pointer_type (long_double_type_node); + long_doubleptr_type_node = build_pointer_type (m2type_GetM2LongRealType ()); doubleptr_type_node = build_pointer_type (double_type_node); floatptr_type_node = build_pointer_type (float_type_node); @@ -1277,8 +1370,8 @@ m2builtins_init (location_t location) double_type_node, tree_cons (NULL_TREE, double_type_node, math_endlink)); ldouble_ftype_ldouble = build_function_type ( - long_double_type_node, - tree_cons (NULL_TREE, long_double_type_node, endlink)); + m2type_GetM2LongRealType (), + tree_cons (NULL_TREE, m2type_GetM2LongRealType (), endlink)); builtin_ftype_int_var = build_function_type ( integer_type_node, tree_cons (NULL_TREE, double_type_node, endlink)); @@ -1306,6 +1399,7 @@ m2builtins_init (location_t location) gm2_alloca_node = find_builtin_tree ("__builtin_alloca"); gm2_memcpy_node = find_builtin_tree ("__builtin_memcpy"); + gm2_memset_node = find_builtin_tree ("__builtin_memset"); gm2_huge_valf_node = find_builtin_tree ("__builtin_huge_valf"); gm2_huge_val_node = find_builtin_tree ("__builtin_huge_val"); gm2_huge_vall_node = find_builtin_tree ("__builtin_huge_vall"); diff --git a/gcc/m2/gm2-gcc/m2builtins.def b/gcc/m2/gm2-gcc/m2builtins.def index bce8536..c6eefcd 100644 --- a/gcc/m2/gm2-gcc/m2builtins.def +++ b/gcc/m2/gm2-gcc/m2builtins.def @@ -28,7 +28,7 @@ FROM m2linemap IMPORT location_t ; EXPORT QUALIFIED GetBuiltinConst, GetBuiltinConstType, GetBuiltinTypeInfoType, GetBuiltinTypeInfo, BuiltinExists, BuildBuiltinTree, - BuiltInMemCopy, BuiltInAlloca, + BuiltinMemCopy, BuiltinMemSet, BuiltInAlloca, BuiltInIsfinite ; @@ -98,7 +98,14 @@ PROCEDURE BuildBuiltinTree (location: location_t; name: ADDRESS) : Tree ; BuiltinMemCopy and BuiltinAlloca - are called by M2GenGCC to implement open arrays. *) -PROCEDURE BuiltInMemCopy (location: location_t; dest, src, n: Tree) : Tree ; +PROCEDURE BuiltinMemCopy (location: location_t; dest, src, n: Tree) : Tree ; + + +(* + BuiltinMemSet is called by M2GenGCC to implement the set type. +*) + +PROCEDURE BuiltinMemSet (location: location_t; dest, bytevalue, nbytes: Tree) : Tree ; (* diff --git a/gcc/m2/gm2-gcc/m2builtins.h b/gcc/m2/gm2-gcc/m2builtins.h index 487a41a..8e2b60b 100644 --- a/gcc/m2/gm2-gcc/m2builtins.h +++ b/gcc/m2/gm2-gcc/m2builtins.h @@ -43,8 +43,10 @@ EXTERN unsigned int m2builtins_GetBuiltinConstType (char *name); EXTERN unsigned int m2builtins_GetBuiltinTypeInfoType (const char *ident); EXTERN tree m2builtins_GetBuiltinTypeInfo (location_t location, tree type, const char *ident); -EXTERN tree m2builtins_BuiltInMemCopy (location_t location, tree dest, +EXTERN tree m2builtins_BuiltinMemCopy (location_t location, tree dest, tree src, tree n); +EXTERN tree m2builtins_BuiltinMemSet (location_t location, tree dest, + tree bytevalue, tree nbytes); EXTERN tree m2builtins_BuiltInAlloca (location_t location, tree n); EXTERN tree m2builtins_BuiltInIsfinite (location_t location, tree e); EXTERN bool m2builtins_BuiltinExists (char *name); diff --git a/gcc/m2/gm2-gcc/m2configure.cc b/gcc/m2/gm2-gcc/m2configure.cc index 1c69103..46a57dd 100644 --- a/gcc/m2/gm2-gcc/m2configure.cc +++ b/gcc/m2/gm2-gcc/m2configure.cc @@ -99,3 +99,51 @@ m2configure_FullPathCPP (void) } return NULL; } + +/* Return true if M2C_LONGREAL_FLOAT128 is defined. */ + +bool +m2configure_M2CLongRealFloat128 (void) +{ +#if defined(M2C_LONGREAL_FLOAT128) + return true; +#else + return false; +#endif +} + +/* Return true if M2C_LONGREAL_IBM128 is defined. */ + +bool +m2configure_M2CLongRealIBM128 (void) +{ +#if defined(M2C_LONGREAL_IBM128) + return true; +#else + return false; +#endif +} + +/* Return true if M2C_LONGREAL_LONGDOUBLE is defined. */ + +bool +m2configure_M2CLongRealLongDouble (void) +{ +#if defined(M2C_LONGREAL_LONGDOUBLE) + return true; +#else + return false; +#endif +} + +/* Return true if the target is ppc64le. */ + +bool +m2configure_M2CLongRealLongDoublePPC64LE (void) +{ +#if defined(M2C_LONGREAL_PPC64LE) + return true; +#else + return false; +#endif +} diff --git a/gcc/m2/gm2-gcc/m2configure.def b/gcc/m2/gm2-gcc/m2configure.def index 7fe9ba6..9fc0876 100644 --- a/gcc/m2/gm2-gcc/m2configure.def +++ b/gcc/m2/gm2-gcc/m2configure.def @@ -22,7 +22,6 @@ along with GNU Modula-2; see the file COPYING3. If not see DEFINITION MODULE FOR "C" m2configure ; FROM SYSTEM IMPORT ADDRESS ; -EXPORT QUALIFIED UseUnderscoreForC, FullPathCPP ; CONST @@ -41,4 +40,39 @@ CONST PROCEDURE FullPathCPP () : ADDRESS ; +(* + M2CLongRealFloat128 - return true if M2C_LONGREAL_FLOAT128 + is defined. + Only one of M2CLongRealFloat128, + M2CLongRealIBM128, + M2CLongRealLongDouble will be set true. +*) + +PROCEDURE M2CLongRealFloat128 () : BOOLEAN ; + + +(* + M2CLongRealIBM128 - return true if M2C_LONGREAL_IBM128 + is defined. +*) + +PROCEDURE M2CLongRealIBM128 () : BOOLEAN ; + + +(* + M2CLongRealLongDouble - return true if M2C_LONGREAL_LONGDOUBLE + is defined. This is true if the LONGREAL + maps onto the default gcc long double type. +*) + +PROCEDURE M2CLongRealLongDouble () : BOOLEAN ; + + +(* + M2CLongRealLongDoublePPC64LE - return true if the target is ppc64le. +*) + +PROCEDURE M2CLongRealLongDoublePPC64LE () : BOOLEAN ; + + END m2configure. diff --git a/gcc/m2/gm2-gcc/m2configure.h b/gcc/m2/gm2-gcc/m2configure.h index 9e1a040..f98c71d 100644 --- a/gcc/m2/gm2-gcc/m2configure.h +++ b/gcc/m2/gm2-gcc/m2configure.h @@ -38,7 +38,20 @@ along with GNU Modula-2; see the file COPYING3. If not see #include "input.h" -EXTERN char *m2configure_FullPathCPP (void); +EXTERN char * +m2configure_FullPathCPP (void); + +EXTERN bool +m2configure_M2CLongRealFloat128 (void); + +EXTERN bool +m2configure_M2CLongRealIBM128 (void); + +EXTERN bool +m2configure_M2CLongRealLongDouble (void); + +EXTERN bool +m2configure_M2CLongRealLongDoublePPC64LE (void); #undef EXTERN #endif /* m2configure_h. */ diff --git a/gcc/m2/gm2-gcc/m2convert.cc b/gcc/m2/gm2-gcc/m2convert.cc index 5d35bce..7d9c722 100644 --- a/gcc/m2/gm2-gcc/m2convert.cc +++ b/gcc/m2/gm2-gcc/m2convert.cc @@ -478,7 +478,7 @@ m2convert_BuildConvert (location_t location, tree type, tree value, if (checkOverflow) return convert_and_check (location, type, value); else - return convert (type, value); + return convert_loc (location, type, value); } /* const_to_ISO_type - perform VAL (iso_type, expr). */ diff --git a/gcc/m2/gm2-gcc/m2options.h b/gcc/m2/gm2-gcc/m2options.h index 8bd820f..2ed2c9a 100644 --- a/gcc/m2/gm2-gcc/m2options.h +++ b/gcc/m2/gm2-gcc/m2options.h @@ -138,6 +138,7 @@ EXTERN void M2Options_SetM2PathName (const char *arg); EXTERN char *M2Options_GetM2PathName (void); EXTERN int M2Options_SetUninitVariableChecking (bool value, const char *arg); EXTERN void M2Options_SetCaseEnumChecking (bool value); +EXTERN void M2Options_SetDebugBuiltins (bool value); #undef EXTERN #endif /* m2options_h. */ diff --git a/gcc/m2/gm2-gcc/m2statement.cc b/gcc/m2/gm2-gcc/m2statement.cc index fa799c8..ffbe364 100644 --- a/gcc/m2/gm2-gcc/m2statement.cc +++ b/gcc/m2/gm2-gcc/m2statement.cc @@ -174,7 +174,9 @@ m2statement_BuildAssignmentTree (location_t location, tree des, tree expr) m2convert_BuildConvert (location, TREE_TYPE (des), expr, false)); } - TREE_SIDE_EFFECTS (result) = 1; + TREE_SIDE_EFFECTS (result) = true; + TREE_USED (des) = true; + TREE_USED (expr) = true; add_stmt (location, result); return des; } @@ -195,7 +197,7 @@ m2statement_BuildGoto (location_t location, char *name) tree label = m2block_getLabel (location, name); m2assert_AssertLocation (location); - TREE_USED (label) = 1; + TREE_USED (label) = true; add_stmt (location, build1 (GOTO_EXPR, void_type_node, label)); } @@ -218,6 +220,7 @@ m2statement_BuildParam (location_t location, tree param) { m2assert_AssertLocation (location); + TREE_USED (param) = true; if (TREE_CODE (param) == FUNCTION_DECL) param = m2expr_BuildAddr (location, param, false); @@ -349,6 +352,20 @@ m2statement_BuildIndirectProcedureCallTree (location_t location, } } + +/* BuildBuiltinCallTree calls the builtin procedure. */ + +tree +m2statement_BuildBuiltinCallTree (location_t location, tree func) +{ + TREE_USED (func) = true; + TREE_SIDE_EFFECTS (func) = true; + param_list + = NULL_TREE; /* Ready for the next time we call a procedure. */ + return func; +} + + /* BuildFunctValue - generates code for value := last_function(foobar); */ @@ -361,12 +378,14 @@ m2statement_BuildFunctValue (location_t location, tree value) m2assert_AssertLocation (location); ASSERT_CONDITION ( last_function - != NULL_TREE); /* No value available, possible used before. */ + != NULL_TREE); /* No value available, possible used before. */ TREE_SIDE_EFFECTS (assign) = true; TREE_USED (assign) = true; + TREE_USED (value) = true; last_function = NULL_TREE; return assign; + // return m2statement_BuildAssignmentTree (location, value, assign); } /* BuildCall2 - builds a tree representing: function (arg1, arg2). */ diff --git a/gcc/m2/gm2-gcc/m2statement.def b/gcc/m2/gm2-gcc/m2statement.def index 6c3a0ec..4ad77ec 100644 --- a/gcc/m2/gm2-gcc/m2statement.def +++ b/gcc/m2/gm2-gcc/m2statement.def @@ -309,4 +309,11 @@ PROCEDURE SetBeginLocation (location: location_t) ; PROCEDURE SetEndLocation (location: location_t) ; +(* + BuildBuiltinCallTree - calls the builtin procedure. +*) + +PROCEDURE BuildBuiltinCallTree (location: location_t; func: Tree) : Tree ; + + END m2statement. diff --git a/gcc/m2/gm2-gcc/m2statement.h b/gcc/m2/gm2-gcc/m2statement.h index 1ca70f8..b0531ed 100644 --- a/gcc/m2/gm2-gcc/m2statement.h +++ b/gcc/m2/gm2-gcc/m2statement.h @@ -103,6 +103,8 @@ EXTERN tree m2statement_GetCurrentFunction (void); EXTERN void m2statement_SetBeginLocation (location_t location); EXTERN void m2statement_SetEndLocation (location_t location); EXTERN tree m2statement_GetParamTree (tree call, unsigned int i); +EXTERN tree m2statement_BuildBuiltinCallTree (location_t location, tree func); + EXTERN tree m2statement_BuildTryFinally (location_t location, tree call, tree cleanups); EXTERN tree m2statement_BuildCleanUp (tree param); diff --git a/gcc/m2/gm2-gcc/m2treelib.cc b/gcc/m2/gm2-gcc/m2treelib.cc index 6694af6..168f9f4 100644 --- a/gcc/m2/gm2-gcc/m2treelib.cc +++ b/gcc/m2/gm2-gcc/m2treelib.cc @@ -188,7 +188,6 @@ m2treelib_DoCall0 (location_t location, tree rettype, tree funcptr) tree *argarray = XALLOCAVEC (tree, 1); argarray[0] = NULL_TREE; - return build_call_array_loc (location, rettype, funcptr, 0, argarray); } @@ -200,7 +199,6 @@ m2treelib_DoCall1 (location_t location, tree rettype, tree funcptr, tree arg0) tree *argarray = XALLOCAVEC (tree, 1); argarray[0] = arg0; - return build_call_array_loc (location, rettype, funcptr, 1, argarray); } @@ -214,7 +212,6 @@ m2treelib_DoCall2 (location_t location, tree rettype, tree funcptr, tree arg0, argarray[0] = arg0; argarray[1] = arg1; - return build_call_array_loc (location, rettype, funcptr, 2, argarray); } @@ -229,7 +226,6 @@ m2treelib_DoCall3 (location_t location, tree rettype, tree funcptr, tree arg0, argarray[0] = arg0; argarray[1] = arg1; argarray[2] = arg2; - return build_call_array_loc (location, rettype, funcptr, 3, argarray); } @@ -377,12 +373,12 @@ m2treelib_get_set_address_if_var (location_t location, tree op, bool is_lvalue, return m2treelib_get_set_address (location, op, is_lvalue); } -/* add_stmt - t is a statement. Add it to the statement-tree. */ +/* add_stmt add stmt to the statement-tree. */ tree -add_stmt (location_t location, tree t) +add_stmt (location_t location, tree stmt) { - return m2block_add_stmt (location, t); + return m2block_add_stmt (location, stmt); } /* taken from gcc/c-semantics.cc. */ diff --git a/gcc/m2/gm2-gcc/m2type.cc b/gcc/m2/gm2-gcc/m2type.cc index eeee355..86edde5 100644 --- a/gcc/m2/gm2-gcc/m2type.cc +++ b/gcc/m2/gm2-gcc/m2type.cc @@ -37,6 +37,7 @@ along with GNU Modula-2; see the file COPYING3. If not see #include "m2treelib.h" #include "m2type.h" #include "m2options.h" +#include "m2configure.h" #define USE_BOOLEAN static int broken_set_debugging_info = true; @@ -935,7 +936,6 @@ build_set_type (tree domain, tree range_type, int allow_void, int ispacked) TREE_TYPE (type) = range_type; TYPE_DOMAIN (type) = domain; TYPE_PACKED (type) = ispacked; - return type; } @@ -1104,7 +1104,6 @@ build_m2_specific_size_type (location_t location, enum tree_code base, TYPE_UNSIGNED (c) = true; } } - return c; } @@ -1153,7 +1152,6 @@ finish_build_pointer_type (tree t, tree to_type, enum machine_mode mode, /* Lay out the type. */ /* layout_type (t); */ layout_type (t); - return t; } @@ -1344,7 +1342,6 @@ m2type_BuildVariableArrayAndDeclare (location_t location, tree elementtype, gm2_finish_decl (location, indextype); gm2_finish_decl (location, arraytype); add_stmt (location, build_stmt (location, DECL_EXPR, decl)); - return decl; } @@ -1443,7 +1440,6 @@ build_m2_short_real_node (void) c = make_node (REAL_TYPE); TYPE_PRECISION (c) = FLOAT_TYPE_SIZE; layout_type (c); - return c; } @@ -1457,7 +1453,6 @@ build_m2_real_node (void) c = make_node (REAL_TYPE); TYPE_PRECISION (c) = DOUBLE_TYPE_SIZE; layout_type (c); - return c; } @@ -1468,10 +1463,17 @@ build_m2_long_real_node (void) /* Define `LONGREAL'. */ - c = make_node (REAL_TYPE); - TYPE_PRECISION (c) = LONG_DOUBLE_TYPE_SIZE; - layout_type (c); + if (m2configure_M2CLongRealFloat128 ()) + c = float128_type_node; + else if (m2configure_M2CLongRealIBM128 ()) + { + c = make_node (REAL_TYPE); + TYPE_PRECISION (c) = LONG_DOUBLE_TYPE_SIZE; + } + else + c = long_double_type_node; + layout_type (c); return c; } @@ -1487,7 +1489,6 @@ build_m2_ztype_node (void) else ztype_node = gm2_type_for_size (64, 0); layout_type (ztype_node); - return ztype_node; } @@ -1500,7 +1501,6 @@ build_m2_long_int_node (void) c = make_signed_type (LONG_LONG_TYPE_SIZE); layout_type (c); - return c; } @@ -1513,7 +1513,6 @@ build_m2_long_card_node (void) c = make_unsigned_type (LONG_LONG_TYPE_SIZE); layout_type (c); - return c; } @@ -1526,7 +1525,6 @@ build_m2_short_int_node (void) c = make_signed_type (SHORT_TYPE_SIZE); layout_type (c); - return c; } @@ -1539,7 +1537,6 @@ build_m2_short_card_node (void) c = make_unsigned_type (SHORT_TYPE_SIZE); layout_type (c); - return c; } @@ -1556,7 +1553,6 @@ build_m2_iso_loc_node (void) fixup_unsigned_type (c); TYPE_UNSIGNED (c) = 1; - return c; } @@ -1754,6 +1750,16 @@ build_m2_boolean (location_t location) TYPE_NAME (boolean_type_node) = typedecl; } + +/* Return true if real types a and b are the same. */ + +bool +m2type_SameRealType (tree a, tree b) +{ + return ((a == b) + || (TYPE_PRECISION (a) == TYPE_PRECISION (b))); +} + /* InitBaseTypes create the Modula-2 base types. */ void @@ -1797,7 +1803,7 @@ m2type_InitBaseTypes (location_t location) m2_complex_type_node = build_m2_complex_type_node (); m2_long_complex_type_node = build_m2_long_complex_type_node (); m2_short_complex_type_node = build_m2_short_complex_type_node (); - m2_c_type_node = build_m2_long_complex_type_node (); + m2_c_type_node = m2_long_complex_type_node; m2_complex32_type_node = build_m2_complex32_type_node (); m2_complex64_type_node = build_m2_complex64_type_node (); m2_complex96_type_node = build_m2_complex96_type_node (); @@ -2575,7 +2581,8 @@ gm2_start_struct (location_t location, enum tree_code code, char *name) else id = get_identifier (name); - TYPE_PACKED (s) = false; /* This maybe set true later if necessary. */ + /* This maybe set true later if necessary. */ + TYPE_PACKED (s) = false; m2block_pushDecl (build_decl (location, TYPE_DECL, id, s)); return s; @@ -2814,7 +2821,6 @@ m2type_SetAlignment (tree node, tree align) error ("requested alignment is too large"); else if (is_type) { - /* If we have a TYPE_DECL, then copy the type, so that we don't accidentally modify a builtin type. See pushdecl. */ if (decl && TREE_TYPE (decl) != error_mark_node diff --git a/gcc/m2/gm2-gcc/m2type.def b/gcc/m2/gm2-gcc/m2type.def index 1528104..257e7e1 100644 --- a/gcc/m2/gm2-gcc/m2type.def +++ b/gcc/m2/gm2-gcc/m2type.def @@ -983,4 +983,11 @@ PROCEDURE BuildStartArrayType (index_type: Tree; elt_type: Tree; type: INTEGER) PROCEDURE IsAddress (type: Tree) : BOOLEAN ; +(* + SameRealType - return true if real types a and b are the same. +*) + +PROCEDURE SameRealType (a, b: Tree) : BOOLEAN ; + + END m2type. diff --git a/gcc/m2/gm2-gcc/m2type.h b/gcc/m2/gm2-gcc/m2type.h index 7186116..949e104 100644 --- a/gcc/m2/gm2-gcc/m2type.h +++ b/gcc/m2/gm2-gcc/m2type.h @@ -219,6 +219,8 @@ EXTERN tree m2type_BuildProcTypeParameterDeclaration (location_t location, bool isreference); EXTERN int m2type_IsAddress (tree type); EXTERN tree m2type_GetCardinalAddressType (void); +EXTERN bool m2type_SameRealType (tree a, tree b); + #undef EXTERN #endif /* m2type_h */ diff --git a/gcc/m2/gm2-lang.cc b/gcc/m2/gm2-lang.cc index 2b702cd..45b5fe2 100644 --- a/gcc/m2/gm2-lang.cc +++ b/gcc/m2/gm2-lang.cc @@ -427,6 +427,9 @@ gm2_langhook_handle_option ( case OPT_fd: M2Options_SetCompilerDebugging (value); return 1; + case OPT_fdebug_builtins: + M2Options_SetDebugBuiltins (value); + return 1; case OPT_fdebug_trace_quad: M2Options_SetDebugTraceQuad (value); return 1; @@ -809,14 +812,25 @@ gm2_langhook_type_for_mode (machine_mode mode, int unsignedp) if (mode == TYPE_MODE (long_double_type_node)) return long_double_type_node; + if ((float128_type_node != NULL) && (mode == TYPE_MODE (float128_type_node))) + return float128_type_node; + if (COMPLEX_MODE_P (mode)) { + machine_mode inner_mode; + tree inner_type; + if (mode == TYPE_MODE (complex_float_type_node)) return complex_float_type_node; if (mode == TYPE_MODE (complex_double_type_node)) return complex_double_type_node; if (mode == TYPE_MODE (complex_long_double_type_node)) return complex_long_double_type_node; + + inner_mode = GET_MODE_INNER (mode); + inner_type = gm2_langhook_type_for_mode (inner_mode, unsignedp); + if (inner_type != NULL_TREE) + return build_complex_type (inner_type); } #if HOST_BITS_PER_WIDE_INT >= 64 diff --git a/gcc/m2/gm2-libs-log/RealConversions.mod b/gcc/m2/gm2-libs-log/RealConversions.mod index 189096a..02e0f92 100644 --- a/gcc/m2/gm2-libs-log/RealConversions.mod +++ b/gcc/m2/gm2-libs-log/RealConversions.mod @@ -57,12 +57,29 @@ VAR #define Slice(X,Y,Z) SliceDB(X, Y, Z, __FILE__, __LINE__) *) + (* - logl10 - + IsNan - return TRUE if x is a nan (which never are equal to themselves). +*) + +PROCEDURE IsNan (x: LONGREAL) : BOOLEAN ; +BEGIN + RETURN x # x +END IsNan ; + + +(* + logl10 - this is a local implementation of log10l, currently the ppe64le + builtin log10l is broken. *) PROCEDURE logl10 (r: LONGREAL) : LONGREAL ; BEGIN + IF Debugging + THEN + printf ("logl10 (%lf) = %lf, logl/logl(10.0) = %lf\n", + r, log10l (r), logl(r)/logl(10.0)) + END ; RETURN logl(r)/logl(10.0) END logl10 ; @@ -138,18 +155,9 @@ BEGIN END ; IF c>=1.0 THEN - RETURN( VAL(INTEGER, log10l(c)) ) + RETURN VAL (INTEGER, log10l (c)) ELSE - i := 0 ; - LOOP - d := c*powl(10.0, VAL(LONGREAL, i)) ; - IF d>=1.0 - THEN - RETURN( -i ) - ELSE - INC(i) - END - END + RETURN VAL (INTEGER, log10l (c)) -1 END END END doPowerOfTen ; @@ -245,7 +253,7 @@ BEGIN ELSE ... END - *) + *) l := VAL(LONGREAL, r) ; LongRealToString(l, digits, width, str, ok) END RealToString ; @@ -397,14 +405,12 @@ VAR s : String ; powerOfTen: INTEGER ; BEGIN - (* --fixme-- *) - (* IF IsNan(r) - THEN - ok := FALSE ; - MakeNanString(str, width) ; - RETURN - END - *) + IF IsNan (r) + THEN + ok := FALSE ; + MakeNanString (str, width) ; + RETURN + END ; powerOfTen := doPowerOfTen(r) ; IF (powerOfTen=MAX(INTEGER)) OR (powerOfTen=MIN(INTEGER)) THEN diff --git a/gcc/m2/gm2-libs/Builtins.mod b/gcc/m2/gm2-libs/Builtins.mod index 70c1f8a..707f0e3 100644 --- a/gcc/m2/gm2-libs/Builtins.mod +++ b/gcc/m2/gm2-libs/Builtins.mod @@ -28,6 +28,7 @@ IMPLEMENTATION MODULE Builtins ; IMPORT cbuiltin, wrapc ; + PROCEDURE __ATTRIBUTE__ __BUILTIN__ ((__builtin_alloca)) alloca (i: CARDINAL) : ADDRESS ; BEGIN (* This routine will never be called as it allocates memory on diff --git a/gcc/m2/gm2-libs/DynamicStrings.def b/gcc/m2/gm2-libs/DynamicStrings.def index 90930a9..785c327 100644 --- a/gcc/m2/gm2-libs/DynamicStrings.def +++ b/gcc/m2/gm2-libs/DynamicStrings.def @@ -32,7 +32,7 @@ EXPORT QUALIFIED String, InitStringChar, Index, RIndex, Mark, Length, ConCat, ConCatChar, Assign, Dup, Add, Equal, EqualCharStar, EqualArray, ToUpper, ToLower, - CopyOut, Mult, Slice, + CopyOut, Mult, Slice, ReplaceChar, RemoveWhitePrefix, RemoveWhitePostfix, RemoveComment, char, string, InitStringDB, InitStringCharStarDB, InitStringCharDB, @@ -123,6 +123,14 @@ PROCEDURE Assign (a, b: String) : String ; (* + ReplaceChar - returns string s after it has changed all + occurances of from to to. +*) + +PROCEDURE ReplaceChar (s: String; from, to: CHAR) : String ; + + +(* Dup - duplicate a String, s, returning the copy of s. *) diff --git a/gcc/m2/gm2-libs/DynamicStrings.mod b/gcc/m2/gm2-libs/DynamicStrings.mod index 2c93130..b90bc3f 100644 --- a/gcc/m2/gm2-libs/DynamicStrings.mod +++ b/gcc/m2/gm2-libs/DynamicStrings.mod @@ -1135,6 +1135,31 @@ END ConCatChar ; (* + ReplaceChar - returns string s after it has changed all occurances of from to to. +*) + +PROCEDURE ReplaceChar (s: String; from, to: CHAR) : String ; +VAR + t: String ; + i: CARDINAL ; +BEGIN + t := s ; + WHILE t # NIL DO + i := 0 ; + WHILE i < t^.contents.len DO + IF t^.contents.buf[i] = from + THEN + t^.contents.buf[i] := to + END ; + INC (i) + END ; + t := t^.contents.next + END ; + RETURN s +END ReplaceChar ; + + +(* Assign - assigns the contents of, b, into, a. String, a, is returned. *) diff --git a/gcc/m2/gm2config.aci.in b/gcc/m2/gm2config.aci.in index cb9f505..5228ef0 100644 --- a/gcc/m2/gm2config.aci.in +++ b/gcc/m2/gm2config.aci.in @@ -48,6 +48,12 @@ /* Define to 1 if you have the <unistd.h> header file. */ #undef HAVE_UNISTD_H +/* use __float128 for LONGREAL */ +#undef M2C_LONGREAL_FLOAT128 + +/* target is ppc64le */ +#undef M2C_LONGREAL_PPC64LE + /* Define to the address where bug reports for this package should be sent. */ #undef PACKAGE_BUGREPORT diff --git a/gcc/m2/gm2spec.cc b/gcc/m2/gm2spec.cc index 75a6ed3..0da9a57 100644 --- a/gcc/m2/gm2spec.cc +++ b/gcc/m2/gm2spec.cc @@ -475,6 +475,15 @@ lang_specific_driver (struct cl_decoded_option **in_decoded_options, /* True if we should set up include paths and library paths. */ bool allow_libraries = true; +#ifdef M2C_LONGREAL_PPC64LE + /* Should we add -mabi=ieeelongdouble by default? */ +#ifdef M2C_LONGREAL_FLOAT128 + bool need_default_mabi = true; +#else + bool need_default_mabi = false; +#endif +#endif + #if defined(DEBUG_ARG) printf ("argc = %d\n", argc); fprintf (stderr, "Incoming:"); @@ -580,6 +589,16 @@ lang_specific_driver (struct cl_decoded_option **in_decoded_options, args[i] |= SKIPOPT; /* We will add the option if it is needed. */ push_back_Ipath (decoded_options[i].arg); break; +#if defined(OPT_mabi_ibmlongdouble) + case OPT_mabi_ibmlongdouble: + need_default_mabi = false; /* User has specified a -mabi. */ + break; +#endif +#if defined(OPT_mabi_ieeelongdouble) + case OPT_mabi_ieeelongdouble: + need_default_mabi = true; /* User has specified a -mabi. */ + break; +#endif case OPT_nostdlib: case OPT_nostdlib__: case OPT_nodefaultlibs: @@ -849,6 +868,11 @@ lang_specific_driver (struct cl_decoded_option **in_decoded_options, if (need_plugin) append_option (OPT_fplugin_, "m2rte", 1); +#ifdef M2C_LONGREAL_PPC64LE + if (need_default_mabi) + append_option (OPT_mabi_ieeelongdouble, NULL, 1); +#endif + if (linking) { if (allow_libraries) diff --git a/gcc/m2/lang.opt b/gcc/m2/lang.opt index f906d4e..24f3c65 100644 --- a/gcc/m2/lang.opt +++ b/gcc/m2/lang.opt @@ -30,6 +30,10 @@ Language Modula-2 +Wcase-enum +Modula-2 +turns on case statement label compile time checking when using an expression of an enum type. + Wpedantic-param-names Modula-2 compiler checks to force definition module procedure parameter names with their implementation module counterpart @@ -46,6 +50,14 @@ Wstyle Modula-2 extra compile time semantic checking, typically tries to catch poor programming style +Wuninit-variable-checking +Modula-2 +turns on compile time analysis in the first basic block of a procedure detecting access to uninitialized data. + +Wuninit-variable-checking= +Modula-2 Joined +turns on compile time analysis to detect access to uninitialized variables, the checking can be specified by: known,cond,all. + fauto-init Modula-2 automatically initializes all pointers to NIL @@ -277,10 +289,6 @@ Wall Modula-2 ; Documented in c.opt -Wcase-enum -Modula-2 -turns on case statement label compile time checking when using an expression of an enum type. - Wpedantic Modula-2 ; Documented in common.opt @@ -297,14 +305,6 @@ Wunused-parameter Modula-2 ; Documented in c.opt -Wuninit-variable-checking -Modula-2 -turns on compile time analysis in the first basic block of a procedure detecting access to uninitialized data. - -Wuninit-variable-checking= -Modula-2 Joined -turns on compile time analysis to detect access to uninitialized variables, the checking can be specified by: known,cond,all. - B Modula-2 ; Documented in c.opt diff --git a/gcc/m2/m2pp.cc b/gcc/m2/m2pp.cc index d502c93..5677951 100644 --- a/gcc/m2/m2pp.cc +++ b/gcc/m2/m2pp.cc @@ -1308,6 +1308,33 @@ m2pp_complex (pretty *s, tree t ATTRIBUTE_UNUSED) } #endif +void +m2pp_real_type (pretty *s, tree t) +{ + if (t == m2type_GetRealType ()) + m2pp_print (s, "C double"); + else if (t == m2type_GetShortRealType ()) + m2pp_print (s, "C float"); + else if (t == m2type_GetLongRealType ()) + m2pp_print (s, "C long double"); + else if (t == m2type_GetM2RealType ()) + m2pp_print (s, "REAL"); + else if (t == m2type_GetM2ShortRealType ()) + m2pp_print (s, "SHORTREAL"); + else if (t == m2type_GetM2LongRealType ()) + m2pp_print (s, "LONGREAL"); + else if (t == m2type_GetM2Real128 ()) + m2pp_print (s, "REAL128"); + else if (t == m2type_GetM2Real64 ()) + m2pp_print (s, "REAL64"); + else if (t == m2type_GetM2Real32 ()) + m2pp_print (s, "REAL32"); + else if (t == m2type_GetM2RType ()) + m2pp_print (s, "R Type"); + else + m2pp_print (s, "unknown REAL"); +} + /* m2pp_type prints a full type. */ void @@ -1326,7 +1353,7 @@ m2pp_type (pretty *s, tree t) m2pp_integer (s, t); break; case REAL_TYPE: - m2pp_print (s, "REAL"); + m2pp_real_type (s, t); break; case ENUMERAL_TYPE: m2pp_enum (s, t); @@ -1593,6 +1620,22 @@ m2pp_union_type (pretty *s, tree t) pop (); } +/* m2pp_print_mode. */ + +static void +m2pp_print_mode (pretty *s, tree t) +{ + int mode = SCALAR_FLOAT_TYPE_MODE (t); + char buf[100]; + + snprintf (buf, sizeof (buf), "%d", mode); + m2pp_print (s, "<*"); + m2pp_needspace (s); + m2pp_print (s, buf); + m2pp_needspace (s); + m2pp_print (s, "*>"); +} + /* m2pp_simple_type. */ static void @@ -1611,7 +1654,8 @@ m2pp_simple_type (pretty *s, tree t) m2pp_integer (s, t); break; case REAL_TYPE: - m2pp_print (s, "REAL"); + m2pp_real_type (s, t); + m2pp_print_mode (s, t); break; case BOOLEAN_TYPE: m2pp_print (s, "BOOLEAN"); @@ -1642,6 +1686,19 @@ m2pp_simple_type (pretty *s, tree t) } } +/* m2pp_float issue a VAL (type, expr) expression. */ + +static void +m2pp_float (pretty *s, tree t) +{ + m2pp_needspace (s); + m2pp_print (s, "VAL ("); + m2pp_simple_type (s, TREE_TYPE (t)); + m2pp_print (s, ", "); + m2pp_expression (s, TREE_OPERAND (t, 0)); + m2pp_print (s, ")"); +} + /* m2pp_expression display an expression. */ static void @@ -1669,6 +1726,9 @@ m2pp_expression (pretty *s, tree t) case GT_EXPR: m2pp_relop (s, t, ">"); break; + case FLOAT_EXPR: + m2pp_float (s, t); + break; default: m2pp_simple_expression (s, t); } diff --git a/gcc/m2/mc-boot/GDynamicStrings.cc b/gcc/m2/mc-boot/GDynamicStrings.cc index 0076047..a79583c 100644 --- a/gcc/m2/mc-boot/GDynamicStrings.cc +++ b/gcc/m2/mc-boot/GDynamicStrings.cc @@ -188,6 +188,12 @@ extern "C" DynamicStrings_String DynamicStrings_ConCatChar (DynamicStrings_Strin extern "C" DynamicStrings_String DynamicStrings_Assign (DynamicStrings_String a, DynamicStrings_String b); /* + ReplaceChar - returns string s after it has changed all occurances of from to to. +*/ + +extern "C" DynamicStrings_String DynamicStrings_ReplaceChar (DynamicStrings_String s, char from, char to); + +/* Dup - duplicate a String, s, returning the copy of s. */ @@ -1816,6 +1822,35 @@ extern "C" DynamicStrings_String DynamicStrings_Assign (DynamicStrings_String a, /* + ReplaceChar - returns string s after it has changed all occurances of from to to. +*/ + +extern "C" DynamicStrings_String DynamicStrings_ReplaceChar (DynamicStrings_String s, char from, char to) +{ + DynamicStrings_String t; + unsigned int i; + + t = s; + while (t != NULL) + { + i = 0; + while (i < t->contents.len) + { + if (t->contents.buf.array[i] == from) + { + t->contents.buf.array[i] = to; + } + i += 1; + } + t = t->contents.next; + } + return s; + /* static analysis guarentees a RETURN statement will be used before here. */ + __builtin_unreachable (); +} + + +/* Dup - duplicate a String, s, returning the copy of s. */ @@ -1828,7 +1863,7 @@ extern "C" DynamicStrings_String DynamicStrings_Dup (DynamicStrings_String s) s = DynamicStrings_Assign (DynamicStrings_InitString ((const char *) "", 0), s); if (TraceOn) { - s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1173, (const char *) "Dup", 3); + s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1198, (const char *) "Dup", 3); } return s; /* static analysis guarentees a RETURN statement will be used before here. */ @@ -1850,7 +1885,7 @@ extern "C" DynamicStrings_String DynamicStrings_Add (DynamicStrings_String a, Dy a = DynamicStrings_ConCat (DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "", 0), a), b); if (TraceOn) { - a = AssignDebug (a, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1193, (const char *) "Add", 3); + a = AssignDebug (a, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1218, (const char *) "Add", 3); } return a; /* static analysis guarentees a RETURN statement will be used before here. */ @@ -1915,7 +1950,7 @@ extern "C" bool DynamicStrings_EqualCharStar (DynamicStrings_String s, void * a) t = DynamicStrings_InitStringCharStar (a); if (TraceOn) { - t = AssignDebug (t, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1250, (const char *) "EqualCharStar", 13); + t = AssignDebug (t, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1275, (const char *) "EqualCharStar", 13); } t = AddToGarbage (t, s); if (DynamicStrings_Equal (t, s)) @@ -1953,7 +1988,7 @@ extern "C" bool DynamicStrings_EqualArray (DynamicStrings_String s, const char * t = DynamicStrings_InitString ((const char *) a, _a_high); if (TraceOn) { - t = AssignDebug (t, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1280, (const char *) "EqualArray", 10); + t = AssignDebug (t, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1305, (const char *) "EqualArray", 10); } t = AddToGarbage (t, s); if (DynamicStrings_Equal (t, s)) @@ -1991,7 +2026,7 @@ extern "C" DynamicStrings_String DynamicStrings_Mult (DynamicStrings_String s, u } if (TraceOn) { - s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1312, (const char *) "Mult", 4); + s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1337, (const char *) "Mult", 4); } return s; /* static analysis guarentees a RETURN statement will be used before here. */ @@ -2070,7 +2105,7 @@ extern "C" DynamicStrings_String DynamicStrings_Slice (DynamicStrings_String s, AddDebugInfo (t->contents.next); if (TraceOn) { - t->contents.next = AssignDebug (t->contents.next, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1380, (const char *) "Slice", 5); + t->contents.next = AssignDebug (t->contents.next, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1405, (const char *) "Slice", 5); } } t = t->contents.next; @@ -2088,7 +2123,7 @@ extern "C" DynamicStrings_String DynamicStrings_Slice (DynamicStrings_String s, } if (TraceOn) { - d = AssignDebug (d, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1397, (const char *) "Slice", 5); + d = AssignDebug (d, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1422, (const char *) "Slice", 5); } return d; /* static analysis guarentees a RETURN statement will be used before here. */ @@ -2216,7 +2251,7 @@ extern "C" DynamicStrings_String DynamicStrings_RemoveComment (DynamicStrings_St } if (TraceOn) { - s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1509, (const char *) "RemoveComment", 13); + s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1534, (const char *) "RemoveComment", 13); } return s; /* static analysis guarentees a RETURN statement will be used before here. */ @@ -2241,7 +2276,7 @@ extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePrefix (DynamicString s = DynamicStrings_Slice (s, (int ) (i), 0); if (TraceOn) { - s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1621, (const char *) "RemoveWhitePrefix", 17); + s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1646, (const char *) "RemoveWhitePrefix", 17); } return s; /* static analysis guarentees a RETURN statement will be used before here. */ @@ -2266,7 +2301,7 @@ extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePostfix (DynamicStrin s = DynamicStrings_Slice (s, 0, i+1); if (TraceOn) { - s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1643, (const char *) "RemoveWhitePostfix", 18); + s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1668, (const char *) "RemoveWhitePostfix", 18); } return s; /* static analysis guarentees a RETURN statement will be used before here. */ diff --git a/gcc/m2/mc-boot/GDynamicStrings.h b/gcc/m2/mc-boot/GDynamicStrings.h index d20d618..c3fb7ff 100644 --- a/gcc/m2/mc-boot/GDynamicStrings.h +++ b/gcc/m2/mc-boot/GDynamicStrings.h @@ -125,6 +125,13 @@ EXTERN DynamicStrings_String DynamicStrings_ConCatChar (DynamicStrings_String a, EXTERN DynamicStrings_String DynamicStrings_Assign (DynamicStrings_String a, DynamicStrings_String b); /* + ReplaceChar - returns string s after it has changed all + occurances of from to to. +*/ + +EXTERN DynamicStrings_String DynamicStrings_ReplaceChar (DynamicStrings_String s, char from, char to); + +/* Dup - duplicate a String, s, returning the copy of s. */ diff --git a/gcc/m2/mc-boot/GFIO.cc b/gcc/m2/mc-boot/GFIO.cc index a3f5362..683a11f 100644 --- a/gcc/m2/mc-boot/GFIO.cc +++ b/gcc/m2/mc-boot/GFIO.cc @@ -195,7 +195,7 @@ extern "C" void FIO_FlushBuffer (FIO_File f); extern "C" unsigned int FIO_ReadNBytes (FIO_File f, unsigned int nBytes, void * dest); /* - ReadAny - reads HIGH(a) bytes into, a. All input + ReadAny - reads HIGH (a) + 1 bytes into, a. All input is fully buffered, unlike ReadNBytes and thus is more suited to small reads. */ @@ -213,7 +213,7 @@ extern "C" void FIO_ReadAny (FIO_File f, unsigned char *a, unsigned int _a_high) extern "C" unsigned int FIO_WriteNBytes (FIO_File f, unsigned int nBytes, void * src); /* - WriteAny - writes HIGH(a) bytes onto, file, f. All output + WriteAny - writes HIGH (a) + 1 bytes onto, file, f. All output is fully buffered, unlike WriteNBytes and thus is more suited to small writes. */ @@ -410,7 +410,7 @@ static int ReadFromBuffer (FIO_File f, void * a, unsigned int nBytes); Useful when performing small reads. */ -static int BufferedRead (FIO_File f, unsigned int nBytes, void * a); +static int BufferedRead (FIO_File f, unsigned int nBytes, void * dest); /* HandleEscape - translates @@ -473,7 +473,7 @@ static void SetEndOfLine (FIO_File f, char ch); Useful when performing small writes. */ -static int BufferedWrite (FIO_File f, unsigned int nBytes, void * a); +static int BufferedWrite (FIO_File f, unsigned int nBytes, void * src); /* PreInitialize - preinitialize the file descriptor. @@ -809,11 +809,11 @@ static int ReadFromBuffer (FIO_File f, void * a, unsigned int nBytes) Useful when performing small reads. */ -static int BufferedRead (FIO_File f, unsigned int nBytes, void * a) +static int BufferedRead (FIO_File f, unsigned int nBytes, void * dest) { typedef unsigned char *BufferedRead__T3; - void * t; + void * src; int total; int n; BufferedRead__T3 p; @@ -835,7 +835,7 @@ static int BufferedRead (FIO_File f, unsigned int nBytes, void * a) if (nBytes == 1) { /* too expensive to call memcpy for 1 character */ - p = static_cast<BufferedRead__T3> (a); + p = static_cast<BufferedRead__T3> (dest); (*p) = static_cast<unsigned char> ((*fd->buffer->contents).array[fd->buffer->position]); fd->buffer->left -= 1; /* remove consumed byte */ fd->buffer->position += 1; /* move onwards n byte */ @@ -845,13 +845,13 @@ static int BufferedRead (FIO_File f, unsigned int nBytes, void * a) else { n = Min (fd->buffer->left, nBytes); - t = fd->buffer->address; - t = reinterpret_cast<void *> (reinterpret_cast<char *> (t)+fd->buffer->position); - p = static_cast<BufferedRead__T3> (libc_memcpy (a, t, static_cast<size_t> (n))); + src = fd->buffer->address; + src = reinterpret_cast<void *> (reinterpret_cast<char *> (src)+fd->buffer->position); + p = static_cast<BufferedRead__T3> (libc_memcpy (dest, src, static_cast<size_t> (n))); fd->buffer->left -= n; /* remove consumed bytes */ fd->buffer->position += n; /* move onwards n bytes */ /* move onwards ready for direct reads */ - a = reinterpret_cast<void *> (reinterpret_cast<char *> (a)+n); + dest = reinterpret_cast<void *> (reinterpret_cast<char *> (dest)+n); nBytes -= n; /* reduce the amount for future direct */ /* read */ total += n; @@ -1236,11 +1236,11 @@ static void SetEndOfLine (FIO_File f, char ch) Useful when performing small writes. */ -static int BufferedWrite (FIO_File f, unsigned int nBytes, void * a) +static int BufferedWrite (FIO_File f, unsigned int nBytes, void * src) { typedef unsigned char *BufferedWrite__T5; - void * t; + void * dest; int total; int n; BufferedWrite__T5 p; @@ -1262,7 +1262,7 @@ static int BufferedWrite (FIO_File f, unsigned int nBytes, void * a) if (nBytes == 1) { /* too expensive to call memcpy for 1 character */ - p = static_cast<BufferedWrite__T5> (a); + p = static_cast<BufferedWrite__T5> (src); (*fd->buffer->contents).array[fd->buffer->position] = static_cast<char> ((*p)); fd->buffer->left -= 1; /* reduce space */ fd->buffer->position += 1; /* move onwards n byte */ @@ -1272,13 +1272,13 @@ static int BufferedWrite (FIO_File f, unsigned int nBytes, void * a) else { n = Min (fd->buffer->left, nBytes); - t = fd->buffer->address; - t = reinterpret_cast<void *> (reinterpret_cast<char *> (t)+fd->buffer->position); - p = static_cast<BufferedWrite__T5> (libc_memcpy (a, t, static_cast<size_t> ((unsigned int ) (n)))); + dest = fd->buffer->address; + dest = reinterpret_cast<void *> (reinterpret_cast<char *> (dest)+fd->buffer->position); + p = static_cast<BufferedWrite__T5> (libc_memcpy (dest, src, static_cast<size_t> ((unsigned int ) (n)))); fd->buffer->left -= n; /* remove consumed bytes */ fd->buffer->position += n; /* move onwards n bytes */ /* move ready for further writes */ - a = reinterpret_cast<void *> (reinterpret_cast<char *> (a)+n); + src = reinterpret_cast<void *> (reinterpret_cast<char *> (src)+n); nBytes -= n; /* reduce the amount for future writes */ total += n; /* reduce the amount for future writes */ } @@ -1686,7 +1686,7 @@ extern "C" unsigned int FIO_ReadNBytes (FIO_File f, unsigned int nBytes, void * /* - ReadAny - reads HIGH(a) bytes into, a. All input + ReadAny - reads HIGH (a) + 1 bytes into, a. All input is fully buffered, unlike ReadNBytes and thus is more suited to small reads. */ @@ -1694,7 +1694,7 @@ extern "C" unsigned int FIO_ReadNBytes (FIO_File f, unsigned int nBytes, void * extern "C" void FIO_ReadAny (FIO_File f, unsigned char *a, unsigned int _a_high) { CheckAccess (f, FIO_openedforread, false); - if ((BufferedRead (f, _a_high, a)) == ((int ) (_a_high))) + if ((BufferedRead (f, _a_high+1, a)) == ((int ) (_a_high+1))) { SetEndOfLine (f, static_cast<char> (a[_a_high])); } @@ -1745,7 +1745,7 @@ extern "C" unsigned int FIO_WriteNBytes (FIO_File f, unsigned int nBytes, void * /* - WriteAny - writes HIGH(a) bytes onto, file, f. All output + WriteAny - writes HIGH (a) + 1 bytes onto, file, f. All output is fully buffered, unlike WriteNBytes and thus is more suited to small writes. */ @@ -1753,7 +1753,7 @@ extern "C" unsigned int FIO_WriteNBytes (FIO_File f, unsigned int nBytes, void * extern "C" void FIO_WriteAny (FIO_File f, unsigned char *a, unsigned int _a_high) { CheckAccess (f, FIO_openedforwrite, true); - if ((BufferedWrite (f, _a_high, a)) == ((int ) (_a_high))) + if ((BufferedWrite (f, _a_high+1, a)) == ((int ) (_a_high+1))) {} /* empty. */ } diff --git a/gcc/m2/mc-boot/GFIO.h b/gcc/m2/mc-boot/GFIO.h index a4a9e40..04dd844 100644 --- a/gcc/m2/mc-boot/GFIO.h +++ b/gcc/m2/mc-boot/GFIO.h @@ -135,7 +135,7 @@ EXTERN void FIO_FlushBuffer (FIO_File f); EXTERN unsigned int FIO_ReadNBytes (FIO_File f, unsigned int nBytes, void * dest); /* - ReadAny - reads HIGH(a) bytes into, a. All input + ReadAny - reads HIGH (a) + 1 bytes into, a. All input is fully buffered, unlike ReadNBytes and thus is more suited to small reads. */ @@ -153,7 +153,7 @@ EXTERN void FIO_ReadAny (FIO_File f, unsigned char *a, unsigned int _a_high); EXTERN unsigned int FIO_WriteNBytes (FIO_File f, unsigned int nBytes, void * src); /* - WriteAny - writes HIGH(a) bytes onto, file, f. All output + WriteAny - writes HIGH (a) + 1 bytes onto, file, f. All output is fully buffered, unlike WriteNBytes and thus is more suited to small writes. */ diff --git a/gcc/m2/mc-boot/GIO.cc b/gcc/m2/mc-boot/GIO.cc index feaf27d..e1c55de 100644 --- a/gcc/m2/mc-boot/GIO.cc +++ b/gcc/m2/mc-boot/GIO.cc @@ -286,12 +286,13 @@ static void dononraw (termios_TERMIOS term) static void Init (void) { - fdState.array[0].IsEof = false; - fdState.array[0].IsRaw = false; - fdState.array[1].IsEof = false; - fdState.array[1].IsRaw = false; - fdState.array[2].IsEof = false; - fdState.array[2].IsRaw = false; + unsigned int fdi; + + for (fdi=0; fdi<=MaxDefaultFd; fdi++) + { + fdState.array[fdi].IsEof = false; + fdState.array[fdi].IsRaw = false; + } } diff --git a/gcc/m2/mc-boot/GRTint.cc b/gcc/m2/mc-boot/GRTint.cc index e8f4bc4..d67ae94 100644 --- a/gcc/m2/mc-boot/GRTint.cc +++ b/gcc/m2/mc-boot/GRTint.cc @@ -352,6 +352,10 @@ static RTint_Vector FindPendingVector (unsigned int vec) static void AddFd (Selective_SetOfFd *set, int *max, int fd) { + if (fd < 0) + { + return ; + } (*max) = Max (fd, (*max)); if ((*set) == NULL) { @@ -928,6 +932,7 @@ extern "C" void RTint_Listen (bool untilInterrupt, RTint_DispatchVector call, un { bool found; int result; + Selective_Timeval zero; Selective_Timeval after; Selective_Timeval b4; Selective_Timeval timeval; @@ -995,13 +1000,13 @@ extern "C" void RTint_Listen (bool untilInterrupt, RTint_DispatchVector call, un { Selective_SetTime (timeval, 0, 0); } - if (((untilInterrupt && (inSet == NULL)) && (outSet == NULL)) && ! found) + if ((untilInterrupt && (((inSet == NULL) && (outSet == NULL)) || (maxFd == -1))) && ! found) { - M2RTS_Halt ((const char *) "deadlock found, no more processes to run and no interrupts active", 65, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, (const char *) "Listen", 6, 728); + M2RTS_Halt ((const char *) "deadlock found, no more processes to run and no interrupts active", 65, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, (const char *) "Listen", 6, 733); } /* printf('} ') ; */ - if (((! found && (maxFd == -1)) && (inSet == NULL)) && (outSet == NULL)) + if (! found && (maxFd == -1)) { /* no file descriptors to be selected upon. */ timeval = Selective_KillTime (timeval); @@ -1012,6 +1017,7 @@ extern "C" void RTint_Listen (bool untilInterrupt, RTint_DispatchVector call, un { Selective_GetTime (timeval, &sec, µ); Assertion_Assert (micro < Microseconds); + zero = Selective_InitTime (0, 0); b4 = Selective_InitTime (0, 0); after = Selective_InitTime (0, 0); result = Selective_GetTimeOfDay (b4); @@ -1028,28 +1034,65 @@ extern "C" void RTint_Listen (bool untilInterrupt, RTint_DispatchVector call, un { libc_printf ((const char *) "select (.., .., .., %u.%06u)\\n", 30, sec, micro); } - result = RTco_select (maxFd+1, inSet, outSet, NULL, timeval); + if (maxFd < 0) + { + result = RTco_select (0, NULL, NULL, NULL, timeval); + } + else + { + result = RTco_select (maxFd+1, inSet, outSet, NULL, timeval); + } if (result == -1) { - libc_perror ((const char *) "select", 6); - result = RTco_select (maxFd+1, inSet, outSet, NULL, NULL); - if (result == -1) + if (Debugging) { - libc_perror ((const char *) "select timeout argument is faulty", 33); + libc_perror ((const char *) "select failed : ", 16); } - result = RTco_select (maxFd+1, inSet, NULL, NULL, timeval); - if (result == -1) + result = RTco_select (maxFd+1, inSet, outSet, NULL, zero); + if (result != -1) { - libc_perror ((const char *) "select output fd argument is faulty", 35); - } - result = RTco_select (maxFd+1, NULL, outSet, NULL, timeval); - if (result == -1) - { - libc_perror ((const char *) "select input fd argument is faulty", 34); + Selective_GetTime (timeval, &sec, µ); + if (Debugging) + { + libc_printf ((const char *) "(nfds : %d timeval: %u.%06u) : \\n", 33, maxFd, sec, micro); + } + libc_perror ((const char *) "select timeout argument was faulty : ", 37); } else { - libc_perror ((const char *) "select maxFD+1 argument is faulty", 33); + result = RTco_select (maxFd+1, inSet, NULL, NULL, timeval); + if (result != -1) + { + libc_perror ((const char *) "select output fd argument was faulty : ", 39); + } + else + { + result = RTco_select (maxFd+1, NULL, outSet, NULL, timeval); + if (result != -1) + { + libc_perror ((const char *) "select input fd argument was faulty : ", 38); + } + else + { + if (maxFd == -1) + { + /* avoid dangling else. */ + result = RTco_select (0, NULL, NULL, NULL, timeval); + if (result == -1) + { + if (Debugging) + { + libc_perror ((const char *) "select does not accept nfds == 0 ", 33); + } + result = 0; + } + } + else + { + libc_perror ((const char *) "select maxFD+1 argument was faulty : ", 37); + } + } + } } } } while (! (result != -1)); @@ -1060,6 +1103,10 @@ extern "C" void RTint_Listen (bool untilInterrupt, RTint_DispatchVector call, un { timeval = Selective_KillTime (timeval); } + if (zero != NULL) + { + zero = Selective_KillTime (zero); + } if (after != NULL) { after = Selective_KillTime (after); diff --git a/gcc/m2/mc-boot/Gdecl.cc b/gcc/m2/mc-boot/Gdecl.cc index 72acd82..793d91e 100644 --- a/gcc/m2/mc-boot/Gdecl.cc +++ b/gcc/m2/mc-boot/Gdecl.cc @@ -2517,6 +2517,12 @@ extern "C" DynamicStrings_String DynamicStrings_ConCatChar (DynamicStrings_Strin extern "C" DynamicStrings_String DynamicStrings_Assign (DynamicStrings_String a, DynamicStrings_String b); /* + ReplaceChar - returns string s after it has changed all occurances of from to to. +*/ + +extern "C" DynamicStrings_String DynamicStrings_ReplaceChar (DynamicStrings_String s, char from, char to); + +/* Dup - duplicate a String, s, returning the copy of s. */ @@ -2750,6 +2756,9 @@ extern "C" void mcOptions_writeGPLheader (FIO_File f); extern "C" void mcOptions_setSuppressNoReturn (bool value); extern "C" bool mcOptions_getSuppressNoReturn (void); extern "C" bool mcOptions_useBool (void); +extern "C" DynamicStrings_String mcOptions_getCRealType (void); +extern "C" DynamicStrings_String mcOptions_getCLongRealType (void); +extern "C" DynamicStrings_String mcOptions_getCShortRealType (void); extern "C" DynamicStrings_String FormatStrings_Sprintf0 (DynamicStrings_String fmt); extern "C" DynamicStrings_String FormatStrings_Sprintf1 (DynamicStrings_String fmt, const unsigned char *w_, unsigned int _w_high); extern "C" DynamicStrings_String FormatStrings_Sprintf2 (DynamicStrings_String fmt, const unsigned char *w1_, unsigned int _w1_high, const unsigned char *w2_, unsigned int _w2_high); @@ -5346,6 +5355,12 @@ static void doSizeC (mcPretty_pretty p, decl_node n); static void doConvertC (mcPretty_pretty p, decl_node n, const char *conversion_, unsigned int _conversion_high); /* + doConvertSC - +*/ + +static void doConvertSC (mcPretty_pretty p, decl_node n, DynamicStrings_String conversion); + +/* getFuncFromExpr - */ @@ -10544,19 +10559,19 @@ static void doExprC (mcPretty_pretty p, decl_node n) break; case decl_float: - doConvertC (p, n, (const char *) "(double)", 8); + doConvertSC (p, n, mcOptions_getCRealType ()); break; case decl_trunc: - doConvertC (p, n, (const char *) "(int)", 5); + doConvertC (p, n, (const char *) "int", 3); break; case decl_ord: - doConvertC (p, n, (const char *) "(unsigned int)", 14); + doConvertC (p, n, (const char *) "unsigned int", 12); break; case decl_chr: - doConvertC (p, n, (const char *) "(char)", 6); + doConvertC (p, n, (const char *) "char", 4); break; case decl_cap: @@ -12615,15 +12630,15 @@ static void doBaseC (mcPretty_pretty p, decl_node n) break; case decl_real: - outText (p, (const char *) "double", 6); + outTextS (p, mcOptions_getCRealType ()); break; case decl_longreal: - outText (p, (const char *) "long double", 11); + outTextS (p, mcOptions_getCLongRealType ()); break; case decl_shortreal: - outText (p, (const char *) "float", 5); + outTextS (p, mcOptions_getCShortRealType ()); break; case decl_bitset: @@ -16311,15 +16326,29 @@ static void doSizeC (mcPretty_pretty p, decl_node n) static void doConvertC (mcPretty_pretty p, decl_node n, const char *conversion_, unsigned int _conversion_high) { + DynamicStrings_String s; char conversion[_conversion_high+1]; /* make a local copy of each unbounded array. */ memcpy (conversion, conversion_, _conversion_high+1); + s = DynamicStrings_InitString ((const char *) conversion, _conversion_high); + doConvertSC (p, n, s); + s = DynamicStrings_KillString (s); +} + + +/* + doConvertSC - +*/ + +static void doConvertSC (mcPretty_pretty p, decl_node n, DynamicStrings_String conversion) +{ mcDebug_assert (isUnary (n)); mcPretty_setNeedSpace (p); - outText (p, (const char *) "(", 1); - outText (p, (const char *) conversion, _conversion_high); + outText (p, (const char *) "((", 2); + outTextS (p, conversion); + outText (p, (const char *) ")", 1); mcPretty_setNeedSpace (p); outText (p, (const char *) "(", 1); doExprC (p, n->unaryF.arg); diff --git a/gcc/m2/mc-boot/GmcOptions.cc b/gcc/m2/mc-boot/GmcOptions.cc index 9b2dc424..23d2a39 100644 --- a/gcc/m2/mc-boot/GmcOptions.cc +++ b/gcc/m2/mc-boot/GmcOptions.cc @@ -72,6 +72,9 @@ static bool extendedOpaque; static bool internalDebugging; static bool verbose; static bool quiet; +static DynamicStrings_String CReal; +static DynamicStrings_String CLongReal; +static DynamicStrings_String CShortReal; static DynamicStrings_String projectContents; static DynamicStrings_String summaryContents; static DynamicStrings_String contributedContents; @@ -192,6 +195,27 @@ extern "C" bool mcOptions_getSuppressNoReturn (void); extern "C" bool mcOptions_useBool (void); /* + getCRealType - returns the string representing the REAL type + used by C. By default this is "double". +*/ + +extern "C" DynamicStrings_String mcOptions_getCRealType (void); + +/* + getCLongRealType - returns the string representing the REAL type + used by C. By default this is "long double". +*/ + +extern "C" DynamicStrings_String mcOptions_getCLongRealType (void); + +/* + getCShortRealType - returns the string representing the REAL type + used by C. By default this is "float". +*/ + +extern "C" DynamicStrings_String mcOptions_getCShortRealType (void); + +/* getYear - return the year. */ @@ -300,6 +324,34 @@ static void setHPrefix (DynamicStrings_String s); static void setIgnoreFQ (bool value); /* + toCType - returns a new string which has all occurences of '-' + replaced by ' '. +*/ + +static DynamicStrings_String toCType (DynamicStrings_String namedType); + +/* + setCReal - assigns CReal to namedType after it has been transformed by + toCType. +*/ + +static void setCReal (DynamicStrings_String namedType); + +/* + setCShortReal - assigns CShortReal to namedType after it has been + transformed by toCType. +*/ + +static void setCShortReal (DynamicStrings_String namedType); + +/* + setCLongReal - assigns CLongReal to namedType after it has been + transformed by toCType. +*/ + +static void setCLongReal (DynamicStrings_String namedType); + +/* optionIs - returns TRUE if the first len (right) characters match left. */ @@ -675,6 +727,52 @@ static void setIgnoreFQ (bool value) /* + toCType - returns a new string which has all occurences of '-' + replaced by ' '. +*/ + +static DynamicStrings_String toCType (DynamicStrings_String namedType) +{ + return DynamicStrings_ReplaceChar (DynamicStrings_Dup (namedType), '-', ' '); + /* static analysis guarentees a RETURN statement will be used before here. */ + __builtin_unreachable (); +} + + +/* + setCReal - assigns CReal to namedType after it has been transformed by + toCType. +*/ + +static void setCReal (DynamicStrings_String namedType) +{ + CReal = toCType (namedType); +} + + +/* + setCShortReal - assigns CShortReal to namedType after it has been + transformed by toCType. +*/ + +static void setCShortReal (DynamicStrings_String namedType) +{ + CShortReal = toCType (namedType); +} + + +/* + setCLongReal - assigns CLongReal to namedType after it has been + transformed by toCType. +*/ + +static void setCLongReal (DynamicStrings_String namedType) +{ + CLongReal = toCType (namedType); +} + + +/* optionIs - returns TRUE if the first len (right) characters match left. */ @@ -851,6 +949,21 @@ static void handleOption (DynamicStrings_String arg) /* avoid dangling else. */ suppressNoReturn = true; } + else if (optionIs ((const char *) "--real=", 7, arg)) + { + /* avoid dangling else. */ + setCReal (DynamicStrings_Slice (arg, 7, 0)); + } + else if (optionIs ((const char *) "--longreal=", 11, arg)) + { + /* avoid dangling else. */ + setCLongReal (DynamicStrings_Slice (arg, 11, 0)); + } + else if (optionIs ((const char *) "--shortreal=", 12, arg)) + { + /* avoid dangling else. */ + setCShortReal (DynamicStrings_Slice (arg, 12, 0)); + } } @@ -1106,6 +1219,45 @@ extern "C" bool mcOptions_useBool (void) __builtin_unreachable (); } + +/* + getCRealType - returns the string representing the REAL type + used by C. By default this is "double". +*/ + +extern "C" DynamicStrings_String mcOptions_getCRealType (void) +{ + return CReal; + /* static analysis guarentees a RETURN statement will be used before here. */ + __builtin_unreachable (); +} + + +/* + getCLongRealType - returns the string representing the REAL type + used by C. By default this is "long double". +*/ + +extern "C" DynamicStrings_String mcOptions_getCLongRealType (void) +{ + return CLongReal; + /* static analysis guarentees a RETURN statement will be used before here. */ + __builtin_unreachable (); +} + + +/* + getCShortRealType - returns the string representing the REAL type + used by C. By default this is "float". +*/ + +extern "C" DynamicStrings_String mcOptions_getCShortRealType (void) +{ + return CShortReal; + /* static analysis guarentees a RETURN statement will be used before here. */ + __builtin_unreachable (); +} + extern "C" void _M2_mcOptions_init (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) { langC = true; @@ -1136,6 +1288,9 @@ extern "C" void _M2_mcOptions_init (__attribute__((unused)) int argc,__attribute summaryContents = DynamicStrings_InitString ((const char *) "", 0); contributedContents = DynamicStrings_InitString ((const char *) "", 0); projectContents = DynamicStrings_InitString ((const char *) "GNU Modula-2", 12); + CReal = DynamicStrings_InitString ((const char *) "double", 6); + CLongReal = DynamicStrings_InitString ((const char *) "long double", 11); + CShortReal = DynamicStrings_InitString ((const char *) "float", 5); } extern "C" void _M2_mcOptions_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[]) diff --git a/gcc/m2/mc-boot/GmcOptions.h b/gcc/m2/mc-boot/GmcOptions.h index ba22857..077c588 100644 --- a/gcc/m2/mc-boot/GmcOptions.h +++ b/gcc/m2/mc-boot/GmcOptions.h @@ -151,6 +151,27 @@ EXTERN bool mcOptions_getSuppressNoReturn (void); */ EXTERN bool mcOptions_useBool (void); + +/* + getCRealType - returns the string representing the REAL type + used by C. By default this is "double". +*/ + +EXTERN DynamicStrings_String mcOptions_getCRealType (void); + +/* + getCLongRealType - returns the string representing the REAL type + used by C. By default this is "long double". +*/ + +EXTERN DynamicStrings_String mcOptions_getCLongRealType (void); + +/* + getCShortRealType - returns the string representing the REAL type + used by C. By default this is "float". +*/ + +EXTERN DynamicStrings_String mcOptions_getCShortRealType (void); # ifdef __cplusplus } # endif diff --git a/gcc/m2/mc/decl.mod b/gcc/m2/mc/decl.mod index 856c717..54a6921 100644 --- a/gcc/m2/mc/decl.mod +++ b/gcc/m2/mc/decl.mod @@ -34,7 +34,8 @@ FROM StringConvert IMPORT CardinalToString, ostoc ; FROM mcOptions IMPORT getOutputFile, getDebugTopological, getHPrefix, getIgnoreFQ, getExtendedOpaque, writeGPLheader, getGccConfigSystem, getScaffoldDynamic, getScaffoldMain, getSuppressNoReturn, - useBool ; + useBool, getCRealType, getCShortRealType, + getCLongRealType ; FROM FormatStrings IMPORT Sprintf0, Sprintf1, Sprintf2, Sprintf3 ; FROM libc IMPORT printf, memset ; @@ -6355,10 +6356,10 @@ BEGIN adr : doAdrC (p, n) | size, tsize : doSizeC (p, n) | - float : doConvertC (p, n, "(double)") | - trunc : doConvertC (p, n, "(int)") | - ord : doConvertC (p, n, "(unsigned int)") | - chr : doConvertC (p, n, "(char)") | + float : doConvertSC (p, n, getCRealType ()) | + trunc : doConvertC (p, n, "int") | + ord : doConvertC (p, n, "unsigned int") | + chr : doConvertC (p, n, "char") | cap : doCapC (p, n) | abs : doAbsC (p, n) | high : doFuncHighC (p, n^.unaryF.arg) | @@ -7878,9 +7879,9 @@ BEGIN complex : outText (p, 'double complex') | longcomplex : outText (p, 'long double complex') | shortcomplex: outText (p, 'float complex') | - real : outText (p, 'double') | - longreal : outText (p, 'long double') | - shortreal : outText (p, 'float') | + real : outTextS (p, getCRealType ()) | + longreal : outTextS (p, getCLongRealType ()) | + shortreal : outTextS (p, getCShortRealType ()) | bitset : outText (p, 'unsigned int') | boolean : doBoolC (p) | proc : outText (p, 'PROC') @@ -11026,16 +11027,31 @@ END doSizeC ; *) PROCEDURE doConvertC (p: pretty; n: node; conversion: ARRAY OF CHAR) ; +VAR + s: String ; +BEGIN + s := InitString (conversion) ; + doConvertSC (p, n, s) ; + s := KillString (s) +END doConvertC ; + + +(* + doConvertSC - +*) + +PROCEDURE doConvertSC (p: pretty; n: node; conversion: String) ; BEGIN assert (isUnary (n)) ; setNeedSpace (p) ; - outText (p, "(") ; - outText (p, conversion) ; + outText (p, "((") ; + outTextS (p, conversion) ; + outText (p, ")") ; setNeedSpace (p) ; outText (p, "(") ; doExprC (p, n^.unaryF.arg) ; outText (p, "))") -END doConvertC ; +END doConvertSC ; (* not needed? diff --git a/gcc/m2/mc/mcOptions.def b/gcc/m2/mc/mcOptions.def index a814f83..2b2888a 100644 --- a/gcc/m2/mc/mcOptions.def +++ b/gcc/m2/mc/mcOptions.def @@ -155,4 +155,28 @@ PROCEDURE getSuppressNoReturn () : BOOLEAN ; PROCEDURE useBool () : BOOLEAN ; +(* + getCRealType - returns the string representing the REAL type + used by C. By default this is "double". +*) + +PROCEDURE getCRealType () : String ; + + +(* + getCLongRealType - returns the string representing the REAL type + used by C. By default this is "long double". +*) + +PROCEDURE getCLongRealType () : String ; + + +(* + getCShortRealType - returns the string representing the REAL type + used by C. By default this is "float". +*) + +PROCEDURE getCShortRealType () : String ; + + END mcOptions. diff --git a/gcc/m2/mc/mcOptions.mod b/gcc/m2/mc/mcOptions.mod index 9c439ed..1582dfe 100644 --- a/gcc/m2/mc/mcOptions.mod +++ b/gcc/m2/mc/mcOptions.mod @@ -28,7 +28,7 @@ FROM decl IMPORT setLangC, setLangCP, setLangM2 ; FROM DynamicStrings IMPORT String, Length, InitString, Mark, Slice, EqualArray, InitStringCharStar, ConCatChar, ConCat, KillString, - Dup, string, char ; + Dup, string, char, ReplaceChar ; IMPORT FIO ; IMPORT SFIO ; @@ -55,6 +55,9 @@ VAR internalDebugging, verbose, quiet : BOOLEAN ; + CReal, + CLongReal, + CShortReal, projectContents, summaryContents, contributedContents, @@ -594,6 +597,83 @@ END useBool ; (* + getCRealType - returns the string representing the REAL type + used by C. By default this is "double". +*) + +PROCEDURE getCRealType () : String ; +BEGIN + RETURN CReal +END getCRealType ; + + +(* + getCLongRealType - returns the string representing the REAL type + used by C. By default this is "long double". +*) + +PROCEDURE getCLongRealType () : String ; +BEGIN + RETURN CLongReal +END getCLongRealType ; + + +(* + getCShortRealType - returns the string representing the REAL type + used by C. By default this is "float". +*) + +PROCEDURE getCShortRealType () : String ; +BEGIN + RETURN CShortReal +END getCShortRealType ; + + +(* + toCType - returns a new string which has all occurences of '-' + replaced by ' '. +*) + +PROCEDURE toCType (namedType: String) : String ; +BEGIN + RETURN ReplaceChar (Dup (namedType), '-', ' ') +END toCType ; + + +(* + setCReal - assigns CReal to namedType after it has been transformed by + toCType. +*) + +PROCEDURE setCReal (namedType: String) ; +BEGIN + CReal := toCType (namedType) +END setCReal ; + + +(* + setCShortReal - assigns CShortReal to namedType after it has been + transformed by toCType. +*) + +PROCEDURE setCShortReal (namedType: String) ; +BEGIN + CShortReal := toCType (namedType) +END setCShortReal ; + + +(* + setCLongReal - assigns CLongReal to namedType after it has been + transformed by toCType. +*) + +PROCEDURE setCLongReal (namedType: String) ; +BEGIN + CLongReal := toCType (namedType) +END setCLongReal ; + + +(* optionIs - returns TRUE if the first len (right) characters match left. *) @@ -711,6 +791,15 @@ BEGIN ELSIF optionIs ('--suppress-noreturn', arg) THEN suppressNoReturn := TRUE + ELSIF optionIs ("--real=", arg) + THEN + setCReal (Slice (arg, 7, 0)) + ELSIF optionIs ("--longreal=", arg) + THEN + setCLongReal (Slice (arg, 11, 0)) + ELSIF optionIs ("--shortreal=", arg) + THEN + setCShortReal (Slice (arg, 12, 0)) END END handleOption ; @@ -777,5 +866,8 @@ BEGIN outputFile := InitString ('-') ; summaryContents := InitString ('') ; contributedContents := InitString ('') ; - projectContents := InitString ('GNU Modula-2') + projectContents := InitString ('GNU Modula-2') ; + CReal := InitString ('double') ; + CLongReal := InitString ('long double') ; + CShortReal := InitString ('float') END mcOptions. |