com-rt.def: Adapt macro DEFGFRT to accept CONST boolean.

2000-08-23  Toon Moene  <toon@moene.indiv.nluug.nl>

	* com-rt.def: Adapt macro DEFGFRT to accept CONST boolean.
	* com.c (macro DEFGFRT): Use CONST boolean.
	(ffecom_call_binop_): Choose between call by value
	and call by reference.
	(ffecom_expr_): Use direct calls to (g)libc functions for
	POW_DD, LOG10, (float) MOD.
	(ffecom_make_gfrt_): Add const indication to table of
	intrinsics.
	* com.h (macro DEFGFRT): Use CONST boolean.
	* intrin.def: Adjust DEFIMP definition of LOG10, (float) MOD.

From-SVN: r35925

gcc/f/ChangeLog

+2000-08-22  Toon Moene  <toon@moene.indiv.nluug.nl>
+
+	* com-rt.def: Adapt macro DEFGFRT to accept CONST boolean.
+	* com.c (macro DEFGFRT): Use CONST boolean.
+	(ffecom_call_binop_): Choose between call by value
+	and call by reference.
+	(ffecom_expr_): Use direct calls to (g)libc functions for
+	POW_DD, LOG10, (float) MOD.
+	(ffecom_make_gfrt_): Add const indication to table of
+	intrinsics.
+	* com.h (macro DEFGFRT): Use CONST boolean.
+	* intrin.def: Adjust DEFIMP definition of LOG10, (float) MOD.
+
 2000-08-21  Nix  <nix@esperi.demon.co.uk>
         
         * lang-specs.h: Do not process -o or run the assembler if

gcc/f/com.c

@@ -371,7 +371,7 @@ static tree ffecom_call_binop_ (tree fn, ffeinfoKindtype kt,
 				ffebld left, ffebld right,
 				tree dest_tree, ffebld dest,
 				bool *dest_used, tree callee_commons,
-				bool scalar_args, tree hook);
+				bool scalar_args, bool ref, tree hook);
 static void ffecom_char_args_x_ (tree *xitem, tree *length,
 				 ffebld expr, bool with_null);
 static tree ffecom_check_size_overflow_ (ffesymbol s, tree type, bool dummy);
@@ -518,7 +518,7 @@ static int ffecom_typesize_integer1_;
 static tree ffecom_gfrt_[FFECOM_gfrt]
 =
 {
-#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX) NULL_TREE,
+#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX,CONST) NULL_TREE,
 #include "com-rt.def"
 #undef DEFGFRT
 };
@@ -528,7 +528,7 @@ static tree ffecom_gfrt_[FFECOM_gfrt]
 static const char *ffecom_gfrt_name_[FFECOM_gfrt]
 =
 {
-#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX) NAME,
+#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX,CONST) NAME,
 #include "com-rt.def"
 #undef DEFGFRT
 };
@@ -538,7 +538,7 @@ static const char *ffecom_gfrt_name_[FFECOM_gfrt]
 static bool ffecom_gfrt_volatile_[FFECOM_gfrt]
 =
 {
-#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX) VOLATILE,
+#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX,CONST) VOLATILE,
 #include "com-rt.def"
 #undef DEFGFRT
 };
@@ -548,7 +548,18 @@ static bool ffecom_gfrt_volatile_[FFECOM_gfrt]
 static bool ffecom_gfrt_complex_[FFECOM_gfrt]
 =
 {
-#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX) COMPLEX,
+#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX,CONST) COMPLEX,
+#include "com-rt.def"
+#undef DEFGFRT
+};
+
+/* Whether the function is const
+   (i.e., has no side effects and only depends on its arguments).  */
+
+static bool ffecom_gfrt_const_[FFECOM_gfrt]
+=
+{
+#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX,CONST) CONST,
 #include "com-rt.def"
 #undef DEFGFRT
 };
@@ -558,7 +569,7 @@ static bool ffecom_gfrt_complex_[FFECOM_gfrt]
 static ffecomRttype_ ffecom_gfrt_type_[FFECOM_gfrt]
 =
 {
-#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX) TYPE,
+#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX,CONST) TYPE,
 #include "com-rt.def"
 #undef DEFGFRT
 };
@@ -568,7 +579,7 @@ static ffecomRttype_ ffecom_gfrt_type_[FFECOM_gfrt]
 static const char *ffecom_gfrt_argstring_[FFECOM_gfrt]
 =
 {
-#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX) ARGS,
+#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX,CONST) ARGS,
 #include "com-rt.def"
 #undef DEFGFRT
 };
@@ -1930,15 +1941,26 @@ static tree
 ffecom_call_binop_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex,
 		    tree type, ffebld left, ffebld right,
 		    tree dest_tree, ffebld dest, bool *dest_used,
-		    tree callee_commons, bool scalar_args, tree hook)
+		    tree callee_commons, bool scalar_args, bool ref, tree hook)
 {
   tree left_tree;
   tree right_tree;
   tree left_length;
   tree right_length;
 
-  left_tree = ffecom_arg_ptr_to_expr (left, &left_length);
-  right_tree = ffecom_arg_ptr_to_expr (right, &right_length);
+  if (ref)
+    {
+      /* Pass arguments by reference.  */
+      left_tree = ffecom_arg_ptr_to_expr (left, &left_length);
+      right_tree = ffecom_arg_ptr_to_expr (right, &right_length);
+    }
+  else
+    {
+      /* Pass arguments by value.  */
+      left_tree = ffecom_arg_expr (left, &left_length);
+      right_tree = ffecom_arg_expr (right, &right_length);
+    }
+
 
   left_tree = build_tree_list (NULL_TREE, left_tree);
   right_tree = build_tree_list (NULL_TREE, right_tree);
@@ -3355,9 +3377,11 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest,
 	ffecomGfrt code;
 	ffeinfoKindtype rtkt;
 	ffeinfoKindtype ltkt;
+	bool ref = TRUE;
 
 	switch (ffeinfo_basictype (ffebld_info (right)))
 	  {
+
 	  case FFEINFO_basictypeINTEGER:
 	    if (1 || optimize)
 	      {
@@ -3447,7 +3471,11 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest,
 				       FFEINFO_kindtypeREALDOUBLE, 0,
 				       FFETARGET_charactersizeNONE,
 				       FFEEXPR_contextLET);
-	    code = FFECOM_gfrtPOW_DD;
+	    /* We used to call FFECOM_gfrtPOW_DD here,
+	       which passes arguments by reference.  */
+	    code = FFECOM_gfrtL_POW;
+	    /* Pass arguments by value. */
+	    ref  = FALSE;
 	    break;
 
 	  case FFEINFO_basictypeCOMPLEX:
@@ -3465,6 +3493,7 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest,
 				       FFETARGET_charactersizeNONE,
 				       FFEEXPR_contextLET);
 	    code = FFECOM_gfrtPOW_ZZ;	/* Overlapping result okay. */
+	    ref = TRUE;			/* Pass arguments by reference. */
 	    break;
 
 	  default:
@@ -3478,7 +3507,7 @@ ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest,
 				    && ffecom_gfrt_complex_[code]),
 				   tree_type, left, right,
 				   dest_tree, dest, dest_used,
-				   NULL_TREE, FALSE,
+				   NULL_TREE, FALSE, ref,
 				   ffebld_nonter_hook (expr));
       }
 
@@ -4318,9 +4347,11 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 	break;	/* Already picked one, stick with it. */
 
       if (kt == FFEINFO_kindtypeREAL1)
-	gfrt = FFECOM_gfrtALOG10;
+	/* We used to call FFECOM_gfrtALOG10 here.  */
+	gfrt = FFECOM_gfrtL_LOG10;
       else if (kt == FFEINFO_kindtypeREAL2)
-	gfrt = FFECOM_gfrtDLOG10;
+	/* We used to call FFECOM_gfrtDLOG10 here.  */
+	gfrt = FFECOM_gfrtL_LOG10;
       break;
 
     case FFEINTRIN_impMAX:
@@ -4382,9 +4413,11 @@ ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
 			 convert (tree_type, ffecom_expr (arg2)));
 
       if (kt == FFEINFO_kindtypeREAL1)
-	gfrt = FFECOM_gfrtAMOD;
+	/* We used to call FFECOM_gfrtAMOD here.  */
+	gfrt = FFECOM_gfrtL_FMOD;
       else if (kt == FFEINFO_kindtypeREAL2)
-	gfrt = FFECOM_gfrtDMOD;
+	/* We used to call FFECOM_gfrtDMOD here.  */
+	gfrt = FFECOM_gfrtL_FMOD;
       break;
 
     case FFEINTRIN_impNINT:
@@ -7068,9 +7101,18 @@ ffecom_make_gfrt_ (ffecomGfrt ix)
 		  get_identifier (ffecom_gfrt_name_[ix]),
 		  ttype);
   DECL_EXTERNAL (t) = 1;
+  TREE_READONLY (t) = ffecom_gfrt_const_[ix] ? 1 : 0;
   TREE_PUBLIC (t) = 1;
   TREE_THIS_VOLATILE (t) = ffecom_gfrt_volatile_[ix] ? 1 : 0;
 
+  /* Sanity check:  A function that's const cannot be volatile.  */
+
+  assert (ffecom_gfrt_const_[ix] ? !ffecom_gfrt_volatile_[ix] : 1);
+
+  /* Sanity check: A function that's const cannot return complex.  */
+
+  assert (ffecom_gfrt_const_[ix] ? !ffecom_gfrt_complex_[ix] : 1);
+
   t = start_decl (t, TRUE);
 
   finish_decl (t, NULL_TREE, TRUE);

gcc/f/com.h

@@ -176,7 +176,7 @@ the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 
 typedef enum
   {
-#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX) CODE,
+#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX,CONST) CODE,
 #include "com-rt.def"
 #undef DEFGFRT
     FFECOM_gfrt

gcc/f/intrin.def

@@ -3129,12 +3129,12 @@ DEFIMP	(ACOS,		"ACOS",		L_ACOS,ACOS,,	"R=:0:X=R*")
 DEFIMP	(AIMAG,		"AIMAG",	,AIMAG,,	"RC:0:Z=C*")
 DEFIMP	(AINT,		"AINT",		,AINT,,		"R=:0:A=R*")
 DEFIMP	(ALOG,		"ALOG",		L_LOG,ALOG,,	"R1:-:X=R1")
-DEFIMP	(ALOG10,	"ALOG10",	,ALOG10,,	"R1:-:X=R1")
+DEFIMP	(ALOG10,	"ALOG10",	L_LOG10,ALOG10,,"R1:-:X=R1")
 DEFIMP	(AMAX0,		"AMAX0",	,,,		"R1:*:A=pI1")
 DEFIMP	(AMAX1,		"AMAX1",	,,,		"R1:*:A=pR1")
 DEFIMP	(AMIN0,		"AMIN0",	,,,		"R1:*:A=pI1")
 DEFIMP	(AMIN1,		"AMIN1",	,,,		"R1:*:A=pR1")
-DEFIMP	(AMOD,		"AMOD",		,AMOD,,		"R1:*:A=R1,P=R1")
+DEFIMP	(AMOD,		"AMOD",		L_FMOD,AMOD,,	"R1:*:A=R1,P=R1")
 DEFIMP	(ANINT,		"ANINT",	,ANINT,,	"R=:0:A=R*")
 DEFIMP	(ASIN,		"ASIN",		L_ASIN,ASIN,,	"R=:0:X=R*")
 DEFIMP	(ATAN,		"ATAN",		L_ATAN,ATAN,,	"R=:0:X=R*")
@@ -3164,10 +3164,10 @@ DEFIMP	(DEXP,		"DEXP",		L_EXP,DEXP,,	"R2:-:X=R2")
 DEFIMP	(DIM,		"DIM",		,DIM,,		"S=:*:X=S*,Y=S*")
 DEFIMP	(DINT,		"DINT",		,DINT,,		"R2:-:A=R2")
 DEFIMP	(DLOG,		"DLOG",		L_LOG,DLOG,,	"R2:-:X=R2")
-DEFIMP	(DLOG10,	"DLOG10",	,DLOG10,,	"R2:-:X=R2")
+DEFIMP	(DLOG10,	"DLOG10",	L_LOG10,DLOG10,,"R2:-:X=R2")
 DEFIMP	(DMAX1,		"DMAX1",	,,,		"R2:*:A=pR2")
 DEFIMP	(DMIN1,		"DMIN1",	,,,		"R2:*:A=pR2")
-DEFIMP	(DMOD,		"DMOD",		,DMOD,,		"R2:*:A=R2,P=R2")
+DEFIMP	(DMOD,		"DMOD",		L_FMOD,DMOD,,	"R2:*:A=R2,P=R2")
 DEFIMP	(DNINT,		"DNINT",	,DNINT,,	"R2:-:A=R2")
 DEFIMP	(DPROD,		"DPROD",	,DPROD,,	"R2:*:X=R1,Y=R1")
 DEFIMP	(DSIGN,		"DSIGN",	,DSIGN,,	"R2:*:A=R2,B=R2")
@@ -3193,7 +3193,7 @@ DEFIMP	(LGT,		"LGT",		,LGT,LGT,	"L1:*:String_A=A1,String_B=A1")
 DEFIMP	(LLE,		"LLE",		,LLE,LLE,	"L1:*:String_A=A1,String_B=A1")
 DEFIMP	(LLT,		"LLT",		,LLT,LLT,	"L1:*:String_A=A1,String_B=A1")
 DEFIMP	(LOG,		"LOG",		L_LOG,ALOG,,	"F=:0:X=F*")
-DEFIMP	(LOG10,		"LOG10",	,,,		"R=:0:X=R*")
+DEFIMP	(LOG10,		"LOG10",	L_LOG10,ALOG10,,"R=:0:X=R*")
 DEFIMP	(MAX,		"MAX",		,,,		"S=:*:A=pS*")
 DEFIMP	(MIN,		"MIN",		,,,		"S=:*:A=pS*")
 DEFIMP	(MAX0,		"MAX0",		,,,		"I1:*:A=pI1")