Tue Dec 23 14:58:04 1997 Craig Burley <burley@gnu.org>
+ Improve run-time diagnostic for "PRINT '(I1', 42":
+ * com.c (ffecom_char_args_x_): Renamed from ffecom_char_args_,
+ which is now a macro (to avoid lots of changes to other code)
+ with new arg, ffecom_char_args_with_null_ being another new
+ macro to call same function with different value for new arg.
+ This function now appends a null byte to opCONTER expression
+ if the new arg is TRUE.
+ (ffecom_arg_ptr_to_expr): Support NULL length pointer.
+ * ste.c (ffeste_io_cilist_):
+ (ffeste_io_icilist_): Pass NULL length ptr for
+ FORMAT expression, so null byte gets appended where
+ feasible.
+ * target.c (ffetarget_character1):
+ (ffetarget_concatenate_character1):
+ (ffetarget_substr_character1):
+ (ffetarget_convert_character1_character1):
+ (ffetarget_convert_character1_hollerith):
+ (ffetarget_convert_character1_integer4):
+ (ffetarget_convert_character1_logical4):
+ (ffetarget_convert_character1_typeless):
+ (ffetarget_hollerith): Append extra phantom null byte as
+ part of FFETARGET-NULL-BYTE kludge.
+
* intrin.c (ffeintrin_fulfill_generic): Don't generate
FFEBAD_INTRINSIC_TYPE for CHARACTER*(*) intrinsic.
tree dest_tree, ffebld dest,
bool *dest_used, tree callee_commons,
bool scalar_args);
-static void ffecom_char_args_ (tree *xitem, tree *length,
- ffebld expr);
+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);
static tree ffecom_char_enhance_arg_ (tree *xtype, ffesymbol s);
static ffecomConcatList_
#define ffecom_start_compstmt_ bison_rule_pushlevel_
#define ffecom_end_compstmt_ bison_rule_compstmt_
+#define ffecom_char_args_(i,l,e) ffecom_char_args_x_((i),(l),(e),FALSE)
+#define ffecom_char_args_with_null_(i,l,e) ffecom_char_args_x_((i),(l),(e),TRUE)
+
/* For each binding contour we allocate a binding_level structure
* which records the names defined in that contour.
* Contours include:
}
#endif
-/* ffecom_char_args_ -- Return ptr/length args for char subexpression
+/* ffecom_char_args_x_ -- Return ptr/length args for char subexpression
tree ptr_arg;
tree length_arg;
ffebld expr;
- ffecom_char_args_(&ptr_arg,&length_arg,expr);
+ bool with_null;
+ ffecom_char_args_x_(&ptr_arg,&length_arg,expr,with_null);
Handles CHARACTER-type CONTER, SYMTER, SUBSTR, ARRAYREF, and FUNCREF
subexpressions by constructing the appropriate trees for the ptr-to-
character-text and length-of-character-text arguments in a calling
- sequence. */
+ sequence.
+
+ Note that if with_null is TRUE, and the expression is an opCONTER,
+ a null byte is appended to the string. */
#if FFECOM_targetCURRENT == FFECOM_targetGCC
static void
-ffecom_char_args_ (tree *xitem, tree *length, ffebld expr)
+ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null)
{
tree item;
tree high;
ffetargetCharacter1 val;
+ ffetargetCharacterSize newlen;
switch (ffebld_op (expr))
{
case FFEBLD_opCONTER:
val = ffebld_constant_character1 (ffebld_conter (expr));
- *length = build_int_2 (ffetarget_length_character1 (val), 0);
+ newlen = ffetarget_length_character1 (val);
+ if (with_null)
+ {
+ if (newlen != 0)
+ ++newlen; /* begin FFETARGET-NULL-KLUDGE. */
+ }
+ *length = build_int_2 (newlen, 0);
TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node;
- high = build_int_2 (ffetarget_length_character1 (val),
- 0);
+ high = build_int_2 (newlen, 0);
TREE_TYPE (high) = ffecom_f2c_ftnlen_type_node;
- item = build_string (ffetarget_length_character1 (val),
+ item = build_string (newlen, /* end FFETARGET-NULL-KLUDGE. */
ffetarget_text_character1 (val));
TREE_TYPE (item)
= build_type_variant
returns and sets the length return value to NULL_TREE. Otherwise
generates code to evaluate the character expression, returns the proper
pointer to the result, AND sets the length return value to a tree that
- specifies the length of the result. */
+ specifies the length of the result.
+
+ If the length argument is NULL, this is a slightly special
+ case of building a FORMAT expression, that is, an expression that
+ will be used at run time without regard to length. For the current
+ implementation, which uses the libf2c library, this means it is nice
+ to append a null byte to the end of the expression, where feasible,
+ to make sure any diagnostic about the FORMAT string terminates at
+ some useful point.
+
+ For now, treat %REF(char-expr) as the same as char-expr with a NULL
+ length argument. This might even be seen as a feature, if a null
+ byte can always be appended. */
#if FFECOM_targetCURRENT == FFECOM_targetGCC
tree
tree ign_length;
ffecomConcatList_ catlist;
- *length = NULL_TREE;
+ if (length != NULL)
+ *length = NULL_TREE;
if (expr == NULL)
return integer_zero_node;
case FFEBLD_opPERCENT_REF:
if (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeCHARACTER)
return ffecom_ptr_to_expr (ffebld_left (expr));
- ign_length = NULL_TREE;
- length = &ign_length;
+ if (length != NULL)
+ {
+ ign_length = NULL_TREE;
+ length = &ign_length;
+ }
expr = ffebld_left (expr);
break;
}
#ifdef PASS_HOLLERITH_BY_DESCRIPTOR
- if (ffeinfo_basictype (ffebld_info (expr)) == FFEINFO_basictypeHOLLERITH)
+ if ((ffeinfo_basictype (ffebld_info (expr)) == FFEINFO_basictypeHOLLERITH)
+ && (length != NULL))
{ /* Pass Hollerith by descriptor. */
ffetargetHollerith h;
switch (ffecom_concat_list_count_ (catlist))
{
case 0: /* Shouldn't happen, but in case it does... */
- *length = ffecom_f2c_ftnlen_zero_node;
- TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node;
+ if (length != NULL)
+ {
+ *length = ffecom_f2c_ftnlen_zero_node;
+ TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node;
+ }
ffecom_concat_list_kill_ (catlist);
return null_pointer_node;
case 1: /* The (fairly) easy case. */
- ffecom_char_args_ (&item, length,
- ffecom_concat_list_expr_ (catlist, 0));
+ if (length == NULL)
+ ffecom_char_args_with_null_ (&item, &ign_length,
+ ffecom_concat_list_expr_ (catlist, 0));
+ else
+ ffecom_char_args_ (&item, length,
+ ffecom_concat_list_expr_ (catlist, 0));
ffecom_concat_list_kill_ (catlist);
assert (item != NULL_TREE);
return item;
for (i = 0; i < count; ++i)
{
- ffecom_char_args_ (&citem, &clength,
- ffecom_concat_list_expr_ (catlist, i));
+ if ((i == count)
+ && (length == NULL))
+ ffecom_char_args_with_null_ (&citem, &clength,
+ ffecom_concat_list_expr_ (catlist, i));
+ else
+ ffecom_char_args_ (&citem, &clength,
+ ffecom_concat_list_expr_ (catlist, i));
if ((citem == error_mark_node)
|| (clength == error_mark_node))
{
citem),
items);
clength = ffecom_save_tree (clength);
- known_length
- = ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node,
- known_length,
- clength);
+ if (length != NULL)
+ known_length
+ = ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node,
+ known_length,
+ clength);
lengths
= ffecom_2 (COMPOUND_EXPR, TREE_TYPE (lengths),
ffecom_modify (void_type_node,
item,
temporary);
- *length = known_length;
+ if (length != NULL)
+ *length = known_length;
}
ffecom_concat_list_kill_ (catlist);
@heading In 0.5.22:
@itemize @bullet
@item
+@item
+Improve diagnostic messages from @code{libf2c}
+so it is more likely that the printing of the
+active format string is limited to the string,
+with no trailing garbage being printed.
+
+(Unlike @code{f2c}, @code{g77} does not append
+a null byte to its compiled form of every
+format string specified via a @code{FORMAT} statement.
+However, @code{f2c} would exhibit the problem
+anyway for a statement like @samp{PRINT '(I)garbage', 1}
+by printing @samp{(I)garbage} as the format string.)
+
+@item
+Improve compilation of FORMAT expressions so that
+a null byte is appended to the last operand if it
+is a constant.
+This provides a cleaner run-time diagnostic as provided
+by @code{libf2c} for statements like @samp{PRINT '(I1', 42}.
+
Fix @code{SIGNAL} intrinsic so it offers portable
support for 64-bit systems (such as Digital Alphas
running GNU/Linux).
int yes;
tree field;
tree inits, initn;
- tree ignore; /* We ignore the length of format! */
bool constantp = TRUE;
static tree errfield, unitfield, endfield, formatfield, recfield;
tree errinit, unitinit, endinit, formatinit, recinit;
break;
case FFESTV_formatCHAREXPR:
- formatexp = ffecom_arg_ptr_to_expr (format_spec->u.expr, &ignore);
+ formatexp = ffecom_arg_ptr_to_expr (format_spec->u.expr, NULL);
if (TREE_CONSTANT (formatexp))
{
formatinit = formatexp;
int yes;
tree field;
tree inits, initn;
- tree ignore; /* We ignore the length of format! */
bool constantp = TRUE;
static tree errfield, unitfield, endfield, formatfield, unitlenfield,
unitnumfield;
break;
case FFESTV_formatCHAREXPR:
- formatexp = ffecom_arg_ptr_to_expr (format_spec->u.expr, &ignore);
+ formatexp = ffecom_arg_ptr_to_expr (format_spec->u.expr, NULL);
if (TREE_CONSTANT (formatexp))
{
formatinit = formatexp;
return min_pad;
}
+/* Always append a null byte to the end, in case this is wanted in
+ a special case such as passing a string as a FORMAT or %REF.
+ Done to save a bit of hassle, nothing more, but it's a kludge anyway,
+ because it isn't a "feature" that is self-documenting. Use the
+ string "FFETARGET-NULL-KLUDGE" to flag anyplace you use this feature
+ in the code. */
+
#if FFETARGET_okCHARACTER1
bool
ffetarget_character1 (ffetargetCharacter1 *val, ffelexToken character,
val->text = NULL;
else
{
- val->text = malloc_new_kp (pool, "ffetargetCharacter1", val->length);
+ val->text = malloc_new_kp (pool, "ffetargetCharacter1", val->length + 1);
memcpy (val->text, ffelex_token_text (character), val->length);
+ val->text[val->length] = '\0';
}
return TRUE;
#endif
/* ffetarget_concatenate_character1 -- Perform CONCAT op on two constants
- Compare lengths, if equal then use memcmp. */
+ Always append a null byte to the end, in case this is wanted in
+ a special case such as passing a string as a FORMAT or %REF.
+ Done to save a bit of hassle, nothing more, but it's a kludge anyway,
+ because it isn't a "feature" that is self-documenting. Use the
+ string "FFETARGET-NULL-KLUDGE" to flag anyplace you use this feature
+ in the code. */
#if FFETARGET_okCHARACTER1
ffebad
res->text = NULL;
else
{
- res->text = malloc_new_kp (pool, "ffetargetCharacter1(CONCAT)", *len);
+ res->text = malloc_new_kp (pool, "ffetargetCharacter1(CONCAT)", *len + 1);
if (l.length != 0)
memcpy (res->text, l.text, l.length);
if (r.length != 0)
memcpy (res->text + l.length, r.text, r.length);
+ res->text[*len] = '\0';
}
return FFEBAD;
#endif
/* ffetarget_substr_character1 -- Perform SUBSTR op on three constants
- Compare lengths, if equal then use memcmp. */
+ Always append a null byte to the end, in case this is wanted in
+ a special case such as passing a string as a FORMAT or %REF.
+ Done to save a bit of hassle, nothing more, but it's a kludge anyway,
+ because it isn't a "feature" that is self-documenting. Use the
+ string "FFETARGET-NULL-KLUDGE" to flag anyplace you use this feature
+ in the code. */
#if FFETARGET_okCHARACTER1
ffebad
else
{
res->length = *len = last - first + 1;
- res->text = malloc_new_kp (pool, "ffetargetCharacter1(SUBSTR)", *len);
+ res->text = malloc_new_kp (pool, "ffetargetCharacter1(SUBSTR)", *len + 1);
memcpy (res->text, l.text + first - 1, *len);
+ res->text[*len] = '\0';
}
return FFEBAD;
return FFEBAD;
}
+/* Always append a null byte to the end, in case this is wanted in
+ a special case such as passing a string as a FORMAT or %REF.
+ Done to save a bit of hassle, nothing more, but it's a kludge anyway,
+ because it isn't a "feature" that is self-documenting. Use the
+ string "FFETARGET-NULL-KLUDGE" to flag anyplace you use this feature
+ in the code. */
+
#if FFETARGET_okCHARACTER1
ffebad
ffetarget_convert_character1_character1 (ffetargetCharacter1 *res,
res->text = NULL;
else
{
- res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size);
+ res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size + 1);
if (size <= l.length)
memcpy (res->text, l.text, size);
else
memcpy (res->text, l.text, l.length);
memset (res->text + l.length, ' ', size - l.length);
}
+ res->text[size] = '\0';
}
return FFEBAD;
}
#endif
+
+/* Always append a null byte to the end, in case this is wanted in
+ a special case such as passing a string as a FORMAT or %REF.
+ Done to save a bit of hassle, nothing more, but it's a kludge anyway,
+ because it isn't a "feature" that is self-documenting. Use the
+ string "FFETARGET-NULL-KLUDGE" to flag anyplace you use this feature
+ in the code. */
+
#if FFETARGET_okCHARACTER1
ffebad
ffetarget_convert_character1_hollerith (ffetargetCharacter1 *res,
res->text = NULL;
else
{
- res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size);
+ res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size + 1);
+ res->text[size] = '\0';
if (size <= l.length)
{
char *p;
}
#endif
-/* ffetarget_convert_character1_integer1 -- Raw conversion. */
+/* ffetarget_convert_character1_integer4 -- Raw conversion.
+
+ Always append a null byte to the end, in case this is wanted in
+ a special case such as passing a string as a FORMAT or %REF.
+ Done to save a bit of hassle, nothing more, but it's a kludge anyway,
+ because it isn't a "feature" that is self-documenting. Use the
+ string "FFETARGET-NULL-KLUDGE" to flag anyplace you use this feature
+ in the code. */
#if FFETARGET_okCHARACTER1
ffebad
res->text = NULL;
else
{
- res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size);
+ res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size + 1);
+ res->text[size] = '\0';
if (((size_t) size) <= size_of)
{
int i = size_of - size;
}
#endif
-/* ffetarget_convert_character1_logical1 -- Raw conversion. */
+/* ffetarget_convert_character1_logical4 -- Raw conversion.
+
+ Always append a null byte to the end, in case this is wanted in
+ a special case such as passing a string as a FORMAT or %REF.
+ Done to save a bit of hassle, nothing more, but it's a kludge anyway,
+ because it isn't a "feature" that is self-documenting. Use the
+ string "FFETARGET-NULL-KLUDGE" to flag anyplace you use this feature
+ in the code. */
#if FFETARGET_okCHARACTER1
ffebad
res->text = NULL;
else
{
- res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size);
+ res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size + 1);
+ res->text[size] = '\0';
if (((size_t) size) <= size_of)
{
int i = size_of - size;
}
#endif
-/* ffetarget_convert_character1_typeless -- Raw conversion. */
+/* ffetarget_convert_character1_typeless -- Raw conversion.
+
+ Always append a null byte to the end, in case this is wanted in
+ a special case such as passing a string as a FORMAT or %REF.
+ Done to save a bit of hassle, nothing more, but it's a kludge anyway,
+ because it isn't a "feature" that is self-documenting. Use the
+ string "FFETARGET-NULL-KLUDGE" to flag anyplace you use this feature
+ in the code. */
#if FFETARGET_okCHARACTER1
ffebad
res->text = NULL;
else
{
- res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size);
+ res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size + 1);
+ res->text[size] = '\0';
if (((size_t) size) <= size_of)
{
int i = size_of - size;
#endif
/* ffetarget_hollerith -- Convert token to a hollerith constant
- See prototype.
-
- Token use count not affected overall. */
+ Always append a null byte to the end, in case this is wanted in
+ a special case such as passing a string as a FORMAT or %REF.
+ Done to save a bit of hassle, nothing more, but it's a kludge anyway,
+ because it isn't a "feature" that is self-documenting. Use the
+ string "FFETARGET-NULL-KLUDGE" to flag anyplace you use this feature
+ in the code. */
bool
ffetarget_hollerith (ffetargetHollerith *val, ffelexToken integer,
mallocPool pool)
{
val->length = ffelex_token_length (integer);
- val->text = malloc_new_kp (pool, "ffetargetHollerith", val->length);
+ val->text = malloc_new_kp (pool, "ffetargetHollerith", val->length + 1);
memcpy (val->text, ffelex_token_text (integer), val->length);
+ val->text[val->length] = '\0';
return TRUE;
}
OSDN Git Service
