* ch-exp.c (parse_primval): Handle CARD, MAX, MIN.

(match_string_literal): Handle control sequence.
        (match_character_literal): Deto.

        * ch-lang.c (chill_printchar): Change formating of nonprintable
        characters from C'xx' to ^(num).
        (chill_printstr): Deto.
        (value_chill_card, value_chill_max_min): New functions to process
        Chill's CARD, MAX, MIN.
        (evaluate_subexp_chill): Process UNOP_CARD, UNOP_CHMAX, UNOP_CHMIN.

        * expression.h (exp_opcode): Add UNOP_CARD, UNOP_CHMAX, UNOP_CHMIN
        for Chill's CARD, MAX, MIN.

        * valarith.c (value_in): Add processing of TYPE_CODE_RANGE
        and change return type from builtin_type_int to
        builtin_type_chill_bool.
This commit is contained in:
Wilfried Moser 1996-03-06 08:02:45 +00:00
parent 6bf53072e9
commit c105168f76
4 changed files with 225 additions and 36 deletions

View File

@ -1,3 +1,23 @@
Tue Mar 5 23:48:36 1996 Wilfried Moser (Alcatel) <moser@rtl.cygnus.com>
* ch-exp.c (parse_primval): Handle CARD, MAX, MIN.
(match_string_literal): Handle control sequence.
(match_character_literal): Deto.
* ch-lang.c (chill_printchar): Change formating of nonprintable
characters from C'xx' to ^(num).
(chill_printstr): Deto.
(value_chill_card, value_chill_max_min): New functions to process
Chill's CARD, MAX, MIN.
(evaluate_subexp_chill): Process UNOP_CARD, UNOP_CHMAX, UNOP_CHMIN.
* expression.h (exp_opcode): Add UNOP_CARD, UNOP_CHMAX, UNOP_CHMIN
for Chill's CARD, MAX, MIN.
* valarith.c (value_in): Add processing of TYPE_CODE_RANGE
and change return type from builtin_type_int to
builtin_type_chill_bool.
Tue Mar 5 18:54:04 1996 Stan Shebs <shebs@andros.cygnus.com>
* config/nm-nbsd.h (link_object, lo_name, etc): Move to here

View File

@ -683,12 +683,21 @@ parse_primval ()
write_exp_elt_type (builtin_type_int);
write_exp_elt_opcode (UNOP_CAST);
break;
case CARD:
parse_unary_call ();
write_exp_elt_opcode (UNOP_CARD);
break;
case MAX_TOKEN:
parse_unary_call ();
write_exp_elt_opcode (UNOP_CHMAX);
break;
case MIN_TOKEN:
parse_unary_call ();
write_exp_elt_opcode (UNOP_CHMIN);
break;
case PRED: op_name = "PRED"; goto unimplemented_unary_builtin;
case SUCC: op_name = "SUCC"; goto unimplemented_unary_builtin;
case ABS: op_name = "ABS"; goto unimplemented_unary_builtin;
case CARD: op_name = "CARD"; goto unimplemented_unary_builtin;
case MAX_TOKEN: op_name = "MAX"; goto unimplemented_unary_builtin;
case MIN_TOKEN: op_name = "MIN"; goto unimplemented_unary_builtin;
unimplemented_unary_builtin:
parse_unary_call ();
error ("not implemented: %s builtin function", op_name);
@ -1404,23 +1413,67 @@ static enum ch_terminal
match_string_literal ()
{
char *tokptr = lexptr;
int in_ctrlseq = 0;
LONGEST ival;
for (tempbufindex = 0, tokptr++; *tokptr != '\0'; tokptr++)
{
CHECKBUF (1);
if (*tokptr == *lexptr)
tryagain: ;
if (in_ctrlseq)
{
/* skip possible whitespaces */
while ((*tokptr == ' ' || *tokptr == '\t') && *tokptr)
tokptr++;
if (*tokptr == ')')
{
in_ctrlseq = 0;
tokptr++;
goto tryagain;
}
else if (*tokptr != ',')
error ("Invalid control sequence");
tokptr++;
/* skip possible whitespaces */
while ((*tokptr == ' ' || *tokptr == '\t') && *tokptr)
tokptr++;
if (!decode_integer_literal (&ival, &tokptr))
error ("Invalid control sequence");
tokptr--;
}
else if (*tokptr == *lexptr)
{
if (*(tokptr + 1) == *lexptr)
{
tokptr++;
ival = *tokptr++;
}
else
{
break;
}
}
tempbuf[tempbufindex++] = *tokptr;
else if (*tokptr == '^')
{
if (*(tokptr + 1) == '(')
{
in_ctrlseq = 1;
tokptr += 2;
if (!decode_integer_literal (&ival, &tokptr))
error ("Invalid control sequence");
tokptr--;
}
else if (*(tokptr + 1) == '^')
ival = *tokptr++;
else
error ("Invalid control sequence");
}
else
ival = *tokptr;
tempbuf[tempbufindex++] = ival;
}
if (in_ctrlseq)
error ("Invalid control sequence");
if (*tokptr == '\0' /* no terminator */
|| (tempbufindex == 1 && *tokptr == '\'')) /* char literal */
{
@ -1449,12 +1502,6 @@ match_string_literal ()
Note that more than a single character, enclosed in single quotes, is
a string literal.
Also note that the control sequence form is not in GNU Chill since it
is ambiguous with the string literal form using single quotes. I.E.
is '^(7)' a character literal or a string literal. In theory it it
possible to tell by context, but GNU Chill doesn't accept the control
sequence form, so neither do we (for now the code is disabled).
Returns CHARACTER_LITERAL if a match is found.
*/
@ -1483,28 +1530,39 @@ match_character_literal ()
/* Determine which form we have, either a control sequence or the
single character form. */
if ((*tokptr == '^') && (*(tokptr + 1) == '('))
if (*tokptr == '^')
{
#if 0 /* Disable, see note above. -fnf */
/* Match and decode a control sequence. Return zero if we don't
find a valid integer literal, or if the next unconsumed character
after the integer literal is not the trailing ')'.
FIXME: We currently don't handle the multiple integer literal
form. */
tokptr += 2;
if (!decode_integer_literal (&ival, &tokptr) || (*tokptr++ != ')'))
if (*(tokptr + 1) == '(')
{
return (0);
/* Match and decode a control sequence. Return zero if we don't
find a valid integer literal, or if the next unconsumed character
after the integer literal is not the trailing ')'. */
tokptr += 2;
if (!decode_integer_literal (&ival, &tokptr) || (*tokptr++ != ')'))
{
return (0);
}
}
#else
return (0);
#endif
else if (*(tokptr + 1) == '^')
{
ival = *tokptr;
tokptr += 2;
}
else
/* fail */
error ("Invalid control sequence");
}
else if (*tokptr == '\'')
{
/* this must be duplicated */
ival = *tokptr;
tokptr += 2;
}
else
{
ival = *tokptr++;
}
/* The trailing quote has not yet been consumed. If we don't find
it, then we have no match. */
@ -1618,7 +1676,8 @@ match_bitstring_literal ()
digit += 10;
break;
default:
error ("Invalid character in bitstring or integer.");
/* this is not a bitstring literal, probably an integer */
return 0;
}
if (digit >= 1 << bits_per_char)
{

View File

@ -68,11 +68,14 @@ chill_printchar (c, stream)
if (PRINT_LITERAL_FORM (c))
{
fprintf_filtered (stream, "'%c'", c);
if (c == '\'' || c == '^')
fprintf_filtered (stream, "'%c%c'", c, c);
else
fprintf_filtered (stream, "'%c'", c);
}
else
{
fprintf_filtered (stream, "C'%.2x'", (unsigned int) c);
fprintf_filtered (stream, "'^(%u)'", (unsigned int) c);
}
}
@ -138,6 +141,8 @@ chill_printstr (stream, string, length, force_ellipses)
{
if (in_control_form || in_literal_form)
{
if (in_control_form)
fputs_filtered (")", stream);
fputs_filtered ("\"//", stream);
in_control_form = in_literal_form = 0;
}
@ -149,19 +154,23 @@ chill_printstr (stream, string, length, force_ellipses)
}
else
{
if (! in_literal_form && ! in_control_form)
fputs_filtered ("\"", stream);
if (PRINT_LITERAL_FORM (c))
{
if (!in_literal_form)
{
if (in_control_form)
{
fputs_filtered ("\"//", stream);
fputs_filtered (")", stream);
in_control_form = 0;
}
fputs_filtered ("\"", stream);
in_literal_form = 1;
}
fprintf_filtered (stream, "%c", c);
if (c == '"' || c == '^')
/* duplicate this one as must be done at input */
fprintf_filtered (stream, "%c", c);
}
else
{
@ -169,19 +178,25 @@ chill_printstr (stream, string, length, force_ellipses)
{
if (in_literal_form)
{
fputs_filtered ("\"//", stream);
in_literal_form = 0;
}
fputs_filtered ("c\"", stream);
fputs_filtered ("^(", stream);
in_control_form = 1;
}
fprintf_filtered (stream, "%.2x", c);
else
fprintf_filtered (stream, ",");
c = c & 0xff;
fprintf_filtered (stream, "%u", (unsigned int) c);
}
++things_printed;
}
}
/* Terminate the quotes if necessary. */
if (in_control_form)
{
fputs_filtered (")", stream);
}
if (in_literal_form || in_control_form)
{
fputs_filtered ("\"", stream);
@ -265,7 +280,9 @@ static const struct op_print chill_op_print_tab[] = {
{"SIZE",UNOP_SIZEOF, PREC_BUILTIN_FUNCTION, 0},
{"LOWER",UNOP_LOWER, PREC_BUILTIN_FUNCTION, 0},
{"UPPER",UNOP_UPPER, PREC_BUILTIN_FUNCTION, 0},
{"LOWER",UNOP_UPPER, PREC_BUILTIN_FUNCTION, 0},
{"CARD",UNOP_CARD, PREC_BUILTIN_FUNCTION, 0},
{"MAX",UNOP_CHMAX, PREC_BUILTIN_FUNCTION, 0},
{"MIN",UNOP_CHMIN, PREC_BUILTIN_FUNCTION, 0},
{":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
{"=", BINOP_EQUAL, PREC_EQUAL, 0},
{"/=", BINOP_NOTEQUAL, PREC_EQUAL, 0},
@ -390,6 +407,86 @@ value_chill_length (val)
return value_from_longest (builtin_type_int, tmp);
}
static value_ptr
value_chill_card (val)
value_ptr val;
{
LONGEST tmp = 0;
struct type *type = VALUE_TYPE (val);
CHECK_TYPEDEF (type);
if (TYPE_CODE (type) == TYPE_CODE_SET)
{
struct type *range_type = TYPE_INDEX_TYPE (type);
LONGEST lower_bound, upper_bound;
int i;
get_discrete_bounds (range_type, &lower_bound, &upper_bound);
for (i = lower_bound; i <= upper_bound; i++)
if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0)
tmp++;
}
else
error ("bad argument to CARD builtin");
return value_from_longest (builtin_type_int, tmp);
}
static value_ptr
value_chill_max_min (op, val)
enum exp_opcode op;
value_ptr val;
{
LONGEST tmp = 0;
struct type *type = VALUE_TYPE (val);
struct type *elttype;
CHECK_TYPEDEF (type);
if (TYPE_CODE (type) == TYPE_CODE_SET)
{
LONGEST lower_bound, upper_bound;
int i, empty = 1;
elttype = TYPE_INDEX_TYPE (type);
CHECK_TYPEDEF (elttype);
get_discrete_bounds (elttype, &lower_bound, &upper_bound);
if (op == UNOP_CHMAX)
{
for (i = upper_bound; i >= lower_bound; i--)
{
if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0)
{
tmp = i;
empty = 0;
break;
}
}
}
else
{
for (i = lower_bound; i <= upper_bound; i++)
{
if (value_bit_index (type, VALUE_CONTENTS (val), i) > 0)
{
tmp = i;
empty = 0;
break;
}
}
}
if (empty)
error ("%s for empty powerset", op == UNOP_CHMAX ? "MAX" : "MIN");
}
else
error ("bad argument to %s builtin", op == UNOP_CHMAX ? "MAX" : "MIN");
return value_from_longest (TYPE_CODE (elttype) == TYPE_CODE_RANGE
? TYPE_TARGET_TYPE (elttype)
: elttype,
tmp);
}
static value_ptr
evaluate_subexp_chill (expect_type, exp, pos, noside)
struct type *expect_type;
@ -477,6 +574,17 @@ evaluate_subexp_chill (expect_type, exp, pos, noside)
arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
return value_chill_length (arg1);
case UNOP_CARD:
(*pos)++;
arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
return value_chill_card (arg1);
case UNOP_CHMAX:
case UNOP_CHMIN:
(*pos)++;
arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
return value_chill_max_min (op, arg1);
case BINOP_COMMA:
error ("',' operator used in invalid context");

View File

@ -1191,6 +1191,8 @@ value_in (element, set)
int member;
struct type *settype = check_typedef (VALUE_TYPE (set));
struct type *eltype = check_typedef (VALUE_TYPE (element));
if (TYPE_CODE (eltype) == TYPE_CODE_RANGE)
eltype = TYPE_TARGET_TYPE (eltype);
if (TYPE_CODE (settype) != TYPE_CODE_SET)
error ("Second argument of 'IN' has wrong type");
if (TYPE_CODE (eltype) != TYPE_CODE_INT
@ -1202,7 +1204,7 @@ value_in (element, set)
value_as_long (element));
if (member < 0)
error ("First argument of 'IN' not in range");
return value_from_longest (builtin_type_int, member);
return value_from_longest (builtin_type_chill_bool, member);
}
void