OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

com.c (ffecom_get_invented_identifier): Rewrite to take an ellipses. 

* com.c (ffecom_get_invented_identifier): Rewrite to take an ellipses.

	(ffecom_char_enhance_arg_, ffecom_do_entry_,
	ffecom_f2c_make_type_, ffecom_gen_sfuncdef_,
	ffecom_start_progunit_, ffecom_start_progunit_,
	ffecom_start_progunit_, ffecom_sym_transform_assign_,
	ffecom_transform_equiv_, ffecom_transform_namelist_,
	ffecom_vardesc_, ffecom_vardesc_array_, ffecom_vardesc_dims_,
	ffecom_end_transition, ffecom_lookup_label, ffecom_temp_label):
	Adjust accordingly.

	* com.h (ffecom_get_invented_identifier): Likewise.

	* sts.c (ffests_printf): New function taking ellipses.
	(ffests_printf_1D, ffests_printf_1U, ffests_printf_1s,
	ffests_printf_2Us): Delete.

	* sts.h: Likewise.

	* std.c (ffestd_R1001dump_, ffestd_R1001dump_1005_1_,
	ffestd_R1001dump_1005_2_, ffestd_R1001dump_1005_3_,
	ffestd_R1001dump_1005_4_, ffestd_R1001dump_1005_5_,
	ffestd_R1001dump_1010_2_, ffestd_R1001dump_1010_3_,
	ffestd_R1001dump_1010_4_, ffestd_R1001dump_1010_5_,
	ffestd_R1001rtexpr_): Call `ffests_printf', not `ffests_printf_*'.

	* ste.c (ffeste_io_ialist_, ffeste_io_cilist_, ffeste_io_cllist_,
	ffeste_io_icilist_, ffeste_io_inlist_, ffeste_io_olist_): Likewise.

From-SVN: r30692
This commit is contained in:
Kaveh R. Ghazi 1999-11-29 02:26:49 +00:00 committed by Kaveh Ghazi
parent 146e60a070
commit 14657de8f1
7 changed files with 99 additions and 219 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
gcc/f/ChangeLog
View File

@ -1,3 +1,34 @@
Sun Nov 28 21:15:29 1999 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
* com.c (ffecom_get_invented_identifier): Rewrite to take an ellipses.
(ffecom_char_enhance_arg_, ffecom_do_entry_,
ffecom_f2c_make_type_, ffecom_gen_sfuncdef_,
ffecom_start_progunit_, ffecom_start_progunit_,
ffecom_start_progunit_, ffecom_sym_transform_assign_,
ffecom_transform_equiv_, ffecom_transform_namelist_,
ffecom_vardesc_, ffecom_vardesc_array_, ffecom_vardesc_dims_,
ffecom_end_transition, ffecom_lookup_label, ffecom_temp_label):
Adjust accordingly.
* com.h (ffecom_get_invented_identifier): Likewise.
* sts.c (ffests_printf): New function taking ellipses.
(ffests_printf_1D, ffests_printf_1U, ffests_printf_1s,
ffests_printf_2Us): Delete.
* sts.h: Likewise.
* std.c (ffestd_R1001dump_, ffestd_R1001dump_1005_1_,
ffestd_R1001dump_1005_2_, ffestd_R1001dump_1005_3_,
ffestd_R1001dump_1005_4_, ffestd_R1001dump_1005_5_,
ffestd_R1001dump_1010_2_, ffestd_R1001dump_1010_3_,
ffestd_R1001dump_1010_4_, ffestd_R1001dump_1010_5_,
ffestd_R1001rtexpr_): Call `ffests_printf', not `ffests_printf_*'.
* ste.c (ffeste_io_ialist_, ffeste_io_cilist_, ffeste_io_cllist_,
ffeste_io_icilist_, ffeste_io_inlist_, ffeste_io_olist_): Likewise.
Wed Nov 10 12:43:21 1999 Philippe De Muyter <phdm@macqel.be>
Kaveh R. Ghazi <ghazi@caip.rutgers.edu>

101
gcc/f/com.c
View File

@ -2402,10 +2402,9 @@ ffecom_char_enhance_arg_ (tree *xtype, ffesymbol s)
{
if (ffesymbol_where (s) == FFEINFO_whereDUMMY)
tlen = ffecom_get_invented_identifier ("__g77_length_%s",
ffesymbol_text (s), -1);
ffesymbol_text (s));
else
tlen = ffecom_get_invented_identifier ("__g77_%s",
"length", -1);
tlen = ffecom_get_invented_identifier ("__g77_%s", "length");
tlen = build_decl (PARM_DECL, tlen, ffecom_f2c_ftnlen_type_node);
#if BUILT_FOR_270
DECL_ARTIFICIAL (tlen) = 1;
@ -2841,8 +2840,7 @@ ffecom_do_entry_ (ffesymbol fn, int entrynum)
else
type = ffecom_tree_type[FFEINFO_basictypeCOMPLEX][kt];
result = ffecom_get_invented_identifier ("__g77_%s",
"result", -1);
result = ffecom_get_invented_identifier ("__g77_%s", "result");
/* Make length arg _and_ enhance type info for CHAR arg itself. */
@ -2883,7 +2881,7 @@ ffecom_do_entry_ (ffesymbol fn, int entrynum)
yes = suspend_momentary ();
multi_retval = ffecom_get_invented_identifier ("__g77_%s",
"multi_retval", -1);
"multi_retval");
multi_retval = build_decl (VAR_DECL, multi_retval,
ffecom_multi_type_node_);
multi_retval = start_decl (multi_retval, FALSE);
@ -6042,8 +6040,7 @@ ffecom_f2c_make_type_ (tree *type, int tcode, const char *name)
}
pushdecl (build_decl (TYPE_DECL,
ffecom_get_invented_identifier ("__g77_f2c_%s",
name, -1),
ffecom_get_invented_identifier ("__g77_f2c_%s", name),
*type));
}
@ -6340,8 +6337,7 @@ ffecom_gen_sfuncdef_ (ffesymbol s, ffeinfoBasictype bt, ffeinfoKindtype kt)
type = ffecom_tree_type[FFEINFO_basictypeCHARACTER][kt];
result = ffecom_get_invented_identifier ("__g77_%s",
"result", -1);
result = ffecom_get_invented_identifier ("__g77_%s", "result");
ffecom_char_enhance_arg_ (&type, s); /* Ignore returned length. */
@ -7384,8 +7380,7 @@ ffecom_start_progunit_ ()
if (altentries)
{
id = ffecom_get_invented_identifier ("__g77_masterfun_%s",
ffesymbol_text (fn),
-1);
ffesymbol_text (fn));
}
#if FFETARGET_isENFORCED_MAIN
else if (main_program)
@ -7420,8 +7415,7 @@ ffecom_start_progunit_ ()
ffecom_which_entrypoint_decl_
= build_decl (PARM_DECL,
ffecom_get_invented_identifier ("__g77_%s",
"which_entrypoint",
-1),
"which_entrypoint"),
integer_type_node);
push_parm_decl (ffecom_which_entrypoint_decl_);
}
@ -7440,8 +7434,7 @@ ffecom_start_progunit_ ()
else
type = ffecom_multi_type_node_;
result = ffecom_get_invented_identifier ("__g77_%s",
"result", -1);
result = ffecom_get_invented_identifier ("__g77_%s", "result");
/* Make length arg _and_ enhance type info for CHAR arg itself. */
@ -8605,8 +8598,7 @@ ffecom_sym_transform_assign_ (ffesymbol s)
t = build_decl (VAR_DECL,
ffecom_get_invented_identifier ("__g77_ASSIGN_%s",
ffesymbol_text (s),
-1),
ffesymbol_text (s)),
TREE_TYPE (null_pointer_node));
switch (ffesymbol_where (s))
@ -8924,9 +8916,7 @@ ffecom_transform_equiv_ (ffestorag eqst)
eqt = build_decl (VAR_DECL,
ffecom_get_invented_identifier ("__g77_equiv_%s",
ffesymbol_text
(ffestorag_symbol
(eqst)),
-1),
(ffestorag_symbol (eqst))),
eqtype);
DECL_EXTERNAL (eqt) = 0;
if (is_init
@ -9010,7 +9000,7 @@ ffecom_transform_namelist_ (ffesymbol s)
nmlt = build_decl (VAR_DECL,
ffecom_get_invented_identifier ("__g77_namelist_%d",
NULL, mynumber++),
mynumber++),
nmltype);
TREE_STATIC (nmlt) = 1;
DECL_INITIAL (nmlt) = error_mark_node;
@ -9616,7 +9606,7 @@ ffecom_vardesc_ (ffebld expr)
var = build_decl (VAR_DECL,
ffecom_get_invented_identifier ("__g77_vardesc_%d",
NULL, mynumber++),
mynumber++),
vardesctype);
TREE_STATIC (var) = 1;
DECL_INITIAL (var) = error_mark_node;
@ -9723,8 +9713,7 @@ ffecom_vardesc_array_ (ffesymbol s)
TREE_CONSTANT (list) = 1;
TREE_STATIC (list) = 1;
var = ffecom_get_invented_identifier ("__g77_vardesc_array_%d", NULL,
mynumber++);
var = ffecom_get_invented_identifier ("__g77_vardesc_array_%d", mynumber++);
var = build_decl (VAR_DECL, var, item);
TREE_STATIC (var) = 1;
DECL_INITIAL (var) = error_mark_node;
@ -9837,8 +9826,7 @@ ffecom_vardesc_dims_ (ffesymbol s)
TREE_CONSTANT (list) = 1;
TREE_STATIC (list) = 1;
var = ffecom_get_invented_identifier ("__g77_dims_%d", NULL,
mynumber++);
var = ffecom_get_invented_identifier ("__g77_dims_%d", mynumber++);
var = build_decl (VAR_DECL, var, item);
TREE_STATIC (var) = 1;
DECL_INITIAL (var) = error_mark_node;
@ -11164,7 +11152,7 @@ ffecom_end_transition ()
var = build_decl (VAR_DECL,
ffecom_get_invented_identifier ("__g77_forceload_%d",
NULL, number++),
number++),
dt);
DECL_EXTERNAL (var) = 0;
TREE_STATIC (var) = 1;
@ -11453,59 +11441,24 @@ ffecom_finish_progunit ()
}
#endif
/* Wrapper for get_identifier. pattern is sprintf-like, assumed to contain
one %s if text is not NULL, assumed to contain one %d if number is
not -1. If both are assumed, the %s is assumed to precede the %d. */
/* Wrapper for get_identifier. pattern is sprintf-like. */
#if FFECOM_targetCURRENT == FFECOM_targetGCC
tree
ffecom_get_invented_identifier (const char *pattern, const char *text,
int number)
ffecom_get_invented_identifier (const char *pattern, ...)
{
tree decl;
char *nam;
mallocSize lenlen;
char space[66];
lenlen = 0;
if (text)
lenlen += strlen (text);
if (number != -1)
lenlen += 20;
if (text || number != -1)
{
lenlen += strlen (pattern);
if (lenlen > ARRAY_SIZE (space))
nam = malloc_new_ks (malloc_pool_image (), pattern, lenlen);
else
nam = &space[0];
}
else
{
lenlen = 0;
nam = (char *) pattern;
}
if (text == NULL)
{
if (number != -1)
sprintf (&nam[0], pattern, number);
}
else
{
if (number == -1)
sprintf (&nam[0], pattern, text);
else
sprintf (&nam[0], pattern, text, number);
}
va_list ap;
va_start (ap, pattern);
if (vasprintf (&nam, pattern, ap) == 0)
abort ();
va_end (ap);
decl = get_identifier (nam);
if (lenlen > ARRAY_SIZE (space))
malloc_kill_ks (malloc_pool_image (), nam, lenlen);
free (nam);
IDENTIFIER_INVENTED (decl) = 1;
return decl;
}
@ -12444,8 +12397,7 @@ ffecom_lookup_label (ffelab label)
glabel = build_decl (VAR_DECL,
ffecom_get_invented_identifier
("__g77_format_%d", NULL,
(int) ffelab_value (label)),
("__g77_format_%d", (int) ffelab_value (label)),
build_type_variant (build_array_type
(char_type_node,
NULL_TREE),
@ -13578,7 +13530,6 @@ ffecom_temp_label ()
glabel = build_decl (LABEL_DECL,
ffecom_get_invented_identifier ("__g77_label_%d",
NULL,
mynumber++),
void_type_node);
DECL_CONTEXT (glabel) = current_function_decl;

4
gcc/f/com.h
View File

@ -306,8 +306,8 @@ tree ffecom_expr_w (tree type, ffebld expr);
void ffecom_finish_compile (void);
void ffecom_finish_decl (tree decl, tree init, bool is_top_level);
void ffecom_finish_progunit (void);
tree ffecom_get_invented_identifier (const char *pattern, const char *text,
int number);
tree ffecom_get_invented_identifier (const char *pattern, ...)
ATTRIBUTE_PRINTF_1;
ffeinfoKindtype ffecom_gfrt_basictype (ffecomGfrt ix);
ffeinfoKindtype ffecom_gfrt_kindtype (ffecomGfrt ix);
void ffecom_init_0 (void);

46
gcc/f/std.c
View File

@ -4465,9 +4465,7 @@ ffestd_R1001dump_ (ffests s, ffesttFormatList list)
char *p = ffelex_token_text (next->t);
ffeTokenLength i = ffelex_token_length (next->t);
ffests_printf_1U (s,
"%" ffeTokenLength_f "uH",
i);
ffests_printf (s, "%" ffeTokenLength_f "uH", i);
while (i-- != 0)
{
ffests_putc (s, *p);
@ -4487,8 +4485,7 @@ ffestd_R1001dump_ (ffests s, ffesttFormatList list)
if (next->u.R1003D.R1004.rtexpr)
ffestd_R1001rtexpr_ (s, next, next->u.R1003D.R1004.u.expr);
else
ffests_printf_1U (s, "%lu",
next->u.R1003D.R1004.u.unsigned_val);
ffests_printf (s, "%lu", next->u.R1003D.R1004.u.unsigned_val);
}
ffests_putc (s, '(');
@ -4520,7 +4517,7 @@ ffestd_R1001dump_1005_1_ (ffests s, ffesttFormatList f, const char *string)
if (f->u.R1005.R1004.rtexpr)
ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1004.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
ffests_printf (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
}
ffests_puts (s, string);
@ -4530,7 +4527,7 @@ ffestd_R1001dump_1005_1_ (ffests s, ffesttFormatList f, const char *string)
if (f->u.R1005.R1006.rtexpr)
ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1006.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
ffests_printf (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
}
}
@ -4553,7 +4550,7 @@ ffestd_R1001dump_1005_2_ (ffests s, ffesttFormatList f, const char *string)
if (f->u.R1005.R1004.rtexpr)
ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1004.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
ffests_printf (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
}
ffests_puts (s, string);
@ -4561,7 +4558,7 @@ ffestd_R1001dump_1005_2_ (ffests s, ffesttFormatList f, const char *string)
if (f->u.R1005.R1006.rtexpr)
ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1006.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
ffests_printf (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
}
/* ffestd_R1001dump_1005_3_ -- Dump a particular format
@ -4582,7 +4579,7 @@ ffestd_R1001dump_1005_3_ (ffests s, ffesttFormatList f, const char *string)
if (f->u.R1005.R1004.rtexpr)
ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1004.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
ffests_printf (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
}
ffests_puts (s, string);
@ -4590,7 +4587,7 @@ ffestd_R1001dump_1005_3_ (ffests s, ffesttFormatList f, const char *string)
if (f->u.R1005.R1006.rtexpr)
ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1006.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
ffests_printf (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
if (f->u.R1005.R1007_or_R1008.present)
{
@ -4598,8 +4595,7 @@ ffestd_R1001dump_1005_3_ (ffests s, ffesttFormatList f, const char *string)
if (f->u.R1005.R1007_or_R1008.rtexpr)
ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1007_or_R1008.u.expr);
else
ffests_printf_1U (s, "%lu",
f->u.R1005.R1007_or_R1008.u.unsigned_val);
ffests_printf (s, "%lu", f->u.R1005.R1007_or_R1008.u.unsigned_val);
}
}
@ -4622,7 +4618,7 @@ ffestd_R1001dump_1005_4_ (ffests s, ffesttFormatList f, const char *string)
if (f->u.R1005.R1004.rtexpr)
ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1004.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
ffests_printf (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
}
ffests_puts (s, string);
@ -4630,13 +4626,13 @@ ffestd_R1001dump_1005_4_ (ffests s, ffesttFormatList f, const char *string)
if (f->u.R1005.R1006.rtexpr)
ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1006.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
ffests_printf (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
ffests_putc (s, '.');
if (f->u.R1005.R1007_or_R1008.rtexpr)
ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1007_or_R1008.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1005.R1007_or_R1008.u.unsigned_val);
ffests_printf (s, "%lu", f->u.R1005.R1007_or_R1008.u.unsigned_val);
}
/* ffestd_R1001dump_1005_5_ -- Dump a particular format
@ -4657,7 +4653,7 @@ ffestd_R1001dump_1005_5_ (ffests s, ffesttFormatList f, const char *string)
if (f->u.R1005.R1004.rtexpr)
ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1004.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
ffests_printf (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
}
ffests_puts (s, string);
@ -4665,13 +4661,13 @@ ffestd_R1001dump_1005_5_ (ffests s, ffesttFormatList f, const char *string)
if (f->u.R1005.R1006.rtexpr)
ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1006.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
ffests_printf (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
ffests_putc (s, '.');
if (f->u.R1005.R1007_or_R1008.rtexpr)
ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1007_or_R1008.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1005.R1007_or_R1008.u.unsigned_val);
ffests_printf (s, "%lu", f->u.R1005.R1007_or_R1008.u.unsigned_val);
if (f->u.R1005.R1009.present)
{
@ -4679,7 +4675,7 @@ ffestd_R1001dump_1005_5_ (ffests s, ffesttFormatList f, const char *string)
if (f->u.R1005.R1009.rtexpr)
ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1009.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1005.R1009.u.unsigned_val);
ffests_printf (s, "%lu", f->u.R1005.R1009.u.unsigned_val);
}
}
@ -4713,7 +4709,7 @@ ffestd_R1001dump_1010_2_ (ffests s, ffesttFormatList f, const char *string)
if (f->u.R1010.val.rtexpr)
ffestd_R1001rtexpr_ (s, f, f->u.R1010.val.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1010.val.u.unsigned_val);
ffests_printf (s, "%lu", f->u.R1010.val.u.unsigned_val);
}
ffests_puts (s, string);
@ -4734,7 +4730,7 @@ ffestd_R1001dump_1010_3_ (ffests s, ffesttFormatList f, const char *string)
if (f->u.R1010.val.rtexpr)
ffestd_R1001rtexpr_ (s, f, f->u.R1010.val.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1010.val.u.unsigned_val);
ffests_printf (s, "%lu", f->u.R1010.val.u.unsigned_val);
ffests_puts (s, string);
}
@ -4754,7 +4750,7 @@ ffestd_R1001dump_1010_4_ (ffests s, ffesttFormatList f, const char *string)
if (f->u.R1010.val.rtexpr)
ffestd_R1001rtexpr_ (s, f, f->u.R1010.val.u.expr);
else
ffests_printf_1D (s, "%ld", f->u.R1010.val.u.signed_val);
ffests_printf (s, "%ld", f->u.R1010.val.u.signed_val);
ffests_puts (s, string);
}
@ -4776,7 +4772,7 @@ ffestd_R1001dump_1010_5_ (ffests s, ffesttFormatList f, const char *string)
if (f->u.R1010.val.rtexpr)
ffestd_R1001rtexpr_ (s, f, f->u.R1010.val.u.expr);
else
ffests_printf_1U (s, "%lu", f->u.R1010.val.u.unsigned_val);
ffests_printf (s, "%lu", f->u.R1010.val.u.unsigned_val);
}
/* ffestd_R1001error_ -- Complain about FORMAT specification not supported
@ -4836,7 +4832,7 @@ ffestd_R1001rtexpr_ (ffests s, ffesttFormatList f, ffebld expr)
case FFEINFO_kindtypeANY:
return;
}
ffests_printf_1D (s, "%ld", val);
ffests_printf (s, "%ld", (long) val);
}
}

12
gcc/f/ste.c
View File

@ -1279,7 +1279,7 @@ ffeste_io_ialist_ (bool have_err,
yes = suspend_momentary ();
t = build_decl (VAR_DECL,
ffecom_get_invented_identifier ("__g77_alist_%d", NULL,
ffecom_get_invented_identifier ("__g77_alist_%d",
mynumber++),
f2c_alist_struct);
TREE_STATIC (t) = 1;
@ -1495,7 +1495,7 @@ ffeste_io_cilist_ (bool have_err,
yes = suspend_momentary ();
t = build_decl (VAR_DECL,
ffecom_get_invented_identifier ("__g77_cilist_%d", NULL,
ffecom_get_invented_identifier ("__g77_cilist_%d",
mynumber++),
f2c_cilist_struct);
TREE_STATIC (t) = 1;
@ -1635,7 +1635,7 @@ ffeste_io_cllist_ (bool have_err,
yes = suspend_momentary ();
t = build_decl (VAR_DECL,
ffecom_get_invented_identifier ("__g77_cllist_%d", NULL,
ffecom_get_invented_identifier ("__g77_cllist_%d",
mynumber++),
f2c_close_struct);
TREE_STATIC (t) = 1;
@ -1853,7 +1853,7 @@ ffeste_io_icilist_ (bool have_err,
yes = suspend_momentary ();
t = build_decl (VAR_DECL,
ffecom_get_invented_identifier ("__g77_icilist_%d", NULL,
ffecom_get_invented_identifier ("__g77_icilist_%d",
mynumber++),
f2c_icilist_struct);
TREE_STATIC (t) = 1;
@ -2113,7 +2113,7 @@ ffeste_io_inlist_ (bool have_err,
yes = suspend_momentary ();
t = build_decl (VAR_DECL,
ffecom_get_invented_identifier ("__g77_inlist_%d", NULL,
ffecom_get_invented_identifier ("__g77_inlist_%d",
mynumber++),
f2c_inquire_struct);
TREE_STATIC (t) = 1;
@ -2302,7 +2302,7 @@ ffeste_io_olist_ (bool have_err,
yes = suspend_momentary ();
t = build_decl (VAR_DECL,
ffecom_get_invented_identifier ("__g77_olist_%d", NULL,
ffecom_get_invented_identifier ("__g77_olist_%d",
mynumber++),
f2c_open_struct);
TREE_STATIC (t) = 1;

118
gcc/f/sts.c
View File

@ -96,119 +96,25 @@ ffests_new (ffests s, mallocPool pool, ffestsLength size)
s->text_ = malloc_new_ksr (pool, "ffests", size);
}
/* ffests_printf_1D -- printf("...%ld...",(long)) to a string
/* ffests_printf -- printf ("...%ld...",(long)) to a string
ffests s;
ffests_printf_1D(s,"...%ld...",1);
ffests_printf (s,"...%ld...",1);
Like printf, but into a string. */
void
ffests_printf_1D (ffests s, const char *ctl, long arg1)
ffests_printf (ffests s, const char *ctl, ...)
{
char quickbuf[40];
char *buff;
ffestsLength len;
if ((len = strlen (ctl) + 21) < ARRAY_SIZE (quickbuf))
/* No # bigger than 20 digits. */
{
sprintf (&quickbuf[0], ctl, arg1);
ffests_puttext (s, &quickbuf[0], strlen (quickbuf));
}
else
{
buff = malloc_new_ks (malloc_pool_image (), "ffests_printf_1D", len);
sprintf (buff, ctl, arg1);
ffests_puttext (s, buff, strlen (buff));
malloc_kill_ks (malloc_pool_image (), buff, len);
}
}
/* ffests_printf_1U -- printf("...%lu...",(unsigned long)) to a string
ffests s;
ffests_printf_1U(s,"...%lu...",1);
Like printf, but into a string. */
void
ffests_printf_1U (ffests s, const char *ctl, unsigned long arg1)
{
char quickbuf[40];
char *buff;
ffestsLength len;
if ((len = strlen (ctl) + 21) < ARRAY_SIZE (quickbuf))
/* No # bigger than 20 digits. */
{
sprintf (&quickbuf[0], ctl, arg1);
ffests_puttext (s, &quickbuf[0], strlen (quickbuf));
}
else
{
buff = malloc_new_ks (malloc_pool_image (), "ffests_printf_1U", len);
sprintf (buff, ctl, arg1);
ffests_puttext (s, buff, strlen (buff));
malloc_kill_ks (malloc_pool_image (), buff, len);
}
}
/* ffests_printf_1s -- printf("...%s...",(char *)) to a string
ffests s;
ffests_printf_1s(s,"...%s...","hi there!");
Like printf, but into a string. */
void
ffests_printf_1s (ffests s, const char *ctl, const char *arg1)
{
char quickbuf[40];
char *buff;
ffestsLength len;
if ((len = strlen (ctl) + strlen (arg1) - 1) < ARRAY_SIZE (quickbuf))
{
sprintf (&quickbuf[0], ctl, arg1);
ffests_puttext (s, &quickbuf[0], strlen (quickbuf));
}
else
{
buff = malloc_new_ks (malloc_pool_image (), "ffests_printf_1s", len);
sprintf (buff, ctl, arg1);
ffests_puttext (s, buff, strlen (buff));
malloc_kill_ks (malloc_pool_image (), buff, len);
}
}
/* ffests_printf_2Us -- printf("...%lu...%s...",...) to a string
ffests s;
ffests_printf_2Us(s,"...%lu...%s...",1,"hi there!");
Like printf, but into a string. */
void
ffests_printf_2Us (ffests s, const char *ctl, unsigned long arg1, const char *arg2)
{
char quickbuf[60];
char *buff;
ffestsLength len;
if ((len = strlen (ctl) + 21 + strlen (arg2) - 1) < ARRAY_SIZE (quickbuf))
/* No # bigger than 20 digits. */
{
sprintf (&quickbuf[0], ctl, arg1, arg2);
ffests_puttext (s, &quickbuf[0], strlen (quickbuf));
}
else
{
buff = malloc_new_ks (malloc_pool_image (), "ffests_printf_2Us", len);
sprintf (buff, ctl, arg1, arg2);
ffests_puttext (s, buff, strlen (buff));
malloc_kill_ks (malloc_pool_image (), buff, len);
}
char *string;
va_list ap;
va_start (ap, ctl);
if (vasprintf (&string, ctl, ap) == 0)
abort ();
va_end (ap);
ffests_puts (s, string);
free (string);
}
/* ffests_putc -- Put a single character into string

6
gcc/f/sts.h
View File

@ -60,11 +60,7 @@ struct _ffests_
void ffests_kill (ffests s);
void ffests_new (ffests s, mallocPool pool, ffestsLength size);
void ffests_printf_1D (ffests s, const char *ctl, long arg1);
void ffests_printf_1U (ffests s, const char *ctl, unsigned long arg1);
void ffests_printf_1s (ffests s, const char *ctl, const char *arg1);
void ffests_printf_2Us (ffests s, const char *ctl, unsigned long arg1,
const char *arg2);
void ffests_printf (ffests s, const char *ctl, ...) ATTRIBUTE_PRINTF_2;
void ffests_putc (ffests s, char c);
void ffests_puts (ffests s, const char *string);
void ffests_puttext (ffests s, const char *text, ffestsLength length);