From 86fc7a6c5d2fc7f9a5daa5e48f94cbfb87ca6db1 Mon Sep 17 00:00:00 2001 From: Craig Burley Date: Sun, 22 Feb 1998 14:31:54 -0500 Subject: [PATCH] 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. Yes, even more patches from Craig :-) From-SVN: r18187 --- gcc/f/ChangeLog | 23 ++++++++++++ gcc/f/com.c | 96 ++++++++++++++++++++++++++++++++++------------- gcc/f/news.texi | 20 ++++++++++ gcc/f/ste.c | 6 +-- gcc/f/target.c | 99 ++++++++++++++++++++++++++++++++++++++++--------- 5 files changed, 197 insertions(+), 47 deletions(-) diff --git a/gcc/f/ChangeLog b/gcc/f/ChangeLog index beb3c94c106..864cf40adb7 100644 --- a/gcc/f/ChangeLog +++ b/gcc/f/ChangeLog @@ -29,6 +29,29 @@ Fri Jan 9 19:09:07 1998 Craig Burley Tue Dec 23 14:58:04 1997 Craig Burley + 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. diff --git a/gcc/f/com.c b/gcc/f/com.c index 63a8d27fee2..06a7bf93f1a 100644 --- a/gcc/f/com.c +++ b/gcc/f/com.c @@ -420,8 +420,8 @@ static tree ffecom_call_binop_ (tree fn, ffeinfoKindtype kt, 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_ @@ -653,6 +653,9 @@ static char *ffecom_gfrt_argstring_[FFECOM_gfrt] #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: @@ -1646,36 +1649,46 @@ ffecom_call_binop_ (tree fn, ffeinfoKindtype kt, bool is_f2c_complex, } #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 @@ -10818,7 +10831,19 @@ ffecom_arg_expr (ffebld expr, tree *length) 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 @@ -10828,7 +10853,8 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length) tree ign_length; ffecomConcatList_ catlist; - *length = NULL_TREE; + if (length != NULL) + *length = NULL_TREE; if (expr == NULL) return integer_zero_node; @@ -10850,8 +10876,11 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length) 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; @@ -10877,7 +10906,8 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length) } #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; @@ -10900,14 +10930,21 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length) 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; @@ -10943,8 +10980,13 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length) 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)) { @@ -10963,10 +11005,11 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length) 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, @@ -11015,7 +11058,8 @@ ffecom_arg_ptr_to_expr (ffebld expr, tree *length) item, temporary); - *length = known_length; + if (length != NULL) + *length = known_length; } ffecom_concat_list_kill_ (catlist); diff --git a/gcc/f/news.texi b/gcc/f/news.texi index 31324ce41ff..3b9ece36f54 100644 --- a/gcc/f/news.texi +++ b/gcc/f/news.texi @@ -27,6 +27,26 @@ involve a combination of these elements. @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). diff --git a/gcc/f/ste.c b/gcc/f/ste.c index 91698f17aae..f7168f0dfdd 100644 --- a/gcc/f/ste.c +++ b/gcc/f/ste.c @@ -999,7 +999,6 @@ ffeste_io_cilist_ (bool have_err, 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; @@ -1086,7 +1085,7 @@ ffeste_io_cilist_ (bool have_err, 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; @@ -1305,7 +1304,6 @@ ffeste_io_icilist_ (bool have_err, 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; @@ -1409,7 +1407,7 @@ ffeste_io_icilist_ (bool have_err, 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; diff --git a/gcc/f/target.c b/gcc/f/target.c index b66aad6ce26..8dfe68d7782 100644 --- a/gcc/f/target.c +++ b/gcc/f/target.c @@ -280,6 +280,13 @@ ffetarget_align (ffetargetAlign *updated_alignment, 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, @@ -290,8 +297,9 @@ 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; @@ -318,7 +326,12 @@ ffetarget_cmp_character1 (ffetargetCharacter1 l, ffetargetCharacter1 r) #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 @@ -331,11 +344,12 @@ ffetarget_concatenate_character1 (ffetargetCharacter1 *res, 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; @@ -501,7 +515,12 @@ ffetarget_ne_character1 (bool *res, ffetargetCharacter1 l, #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 @@ -519,8 +538,9 @@ ffetarget_substr_character1 (ffetargetCharacter1 *res, 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; @@ -666,6 +686,13 @@ ffetarget_convert_any_typeless_ (char *res, size_t size, 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, @@ -678,7 +705,7 @@ 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 @@ -686,12 +713,21 @@ ffetarget_convert_character1_character1 (ffetargetCharacter1 *res, 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, @@ -703,7 +739,8 @@ 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; @@ -727,7 +764,14 @@ ffetarget_convert_character1_hollerith (ffetargetCharacter1 *res, } #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 @@ -788,7 +832,8 @@ ffetarget_convert_character1_integer4 (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_t) size) <= size_of) { int i = size_of - size; @@ -813,7 +858,14 @@ ffetarget_convert_character1_integer4 (ffetargetCharacter1 *res, } #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 @@ -874,7 +926,8 @@ ffetarget_convert_character1_logical4 (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_t) size) <= size_of) { int i = size_of - size; @@ -899,7 +952,14 @@ ffetarget_convert_character1_logical4 (ffetargetCharacter1 *res, } #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 @@ -960,7 +1020,8 @@ ffetarget_convert_character1_typeless (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_t) size) <= size_of) { int i = size_of - size; @@ -1101,17 +1162,21 @@ ffetarget_divide_complex2 (ffetargetComplex2 *res, ffetargetComplex2 l, #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; } -- 2.30.2