+Tue Jun 13 21:40:11 1995 Per Bothner <bothner@kalessin.cygnus.com>
+
+ * parser-defs.h (enum precedence): Added PREC_BUILTIN_FUNCTION.
+ * expression.h (enum exp_opcode): Added UNOP_LOWER, UNOP_UPPER,
+ UNUP_LENGTH.
+ * expprint.c (dump_expression): Handle the new exp_opcodes.
+ (print_subexp): Handle PREC_BUILTIN_FUNCTION.
+ (print_simple_m2_func): Removed.
+ (print_subexp): Remove support for Modula2 builtin functions.
+ * m2-lang.c (m2_op_print_tab): Add support for builtin functions.
+ * ch-exp.y: Parse LOWER, UPPER, and LENGTH builtins.
+ (write_lower_upper_value): Convenience function for LOWER and UPPER.
+ (upper_lower_argument, length_argument): Removed non-terminals.
+ * ch-lang.c (chill_op_print_tab): Entries for UPPER, LOWER, LENGTH.
+ (type_lower_upper): New function. Calculate LOWER/UPPER of type.
+ (value_chill_length): New function. Calcalate LENGTH of ARRAY/STRING.
+ (evaluate_subexp_chill): Handle UNOP_LOWER, UNOP_UPPER, UNOP_LENGTH.
+
Mon Jun 12 12:48:13 1995 Stan Shebs <shebs@andros.cygnus.com>
Windows support bits from Steve Chamberlain <sac@slash.cygnus.com>.
%type <voidval> value_receive_name
%type <voidval> expression_list
%type <tval> mode_argument
-%type <voidval> upper_lower_argument
-%type <voidval> length_argument
%type <voidval> array_mode_name
%type <voidval> string_mode_name
%type <voidval> variant_structure_mode_name
write_exp_elt_type (builtin_type_int);
write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
write_exp_elt_opcode (OP_LONG); }
- | UPPER '(' upper_lower_argument ')'
- {
- $$ = 0; /* FIXME */
- }
- | LOWER '(' upper_lower_argument ')'
- {
- $$ = 0; /* FIXME */
- }
- | LENGTH '(' length_argument ')'
- {
- $$ = 0; /* FIXME */
- }
+ | LOWER '(' mode_argument ')'
+ { write_lower_upper_value (UNOP_LOWER, $3); }
+ | UPPER '(' mode_argument ')'
+ { write_lower_upper_value (UNOP_UPPER, $3); }
+ | LOWER '(' expression ')'
+ { write_exp_elt_opcode (UNOP_LOWER); }
+ | UPPER '(' expression ')'
+ { write_exp_elt_opcode (UNOP_UPPER); }
+ | LENGTH '(' expression ')'
+ { write_exp_elt_opcode (UNOP_LENGTH); }
;
mode_argument : mode_name
mode_name : TYPENAME
;
-upper_lower_argument : expression
- {
- $$ = 0; /* FIXME */
- }
- | mode_name
- {
- $$ = 0; /* FIXME */
- }
- ;
-
-length_argument : expression
- {
- $$ = 0; /* FIXME */
- }
- ;
-
/* Things which still need productions... */
array_mode_name : FIXME_08 { $$ = 0; }
return (ILLEGAL_TOKEN);
}
+void
+write_lower_upper_value (opcode, type)
+ enum exp_opcode opcode; /* Either UNOP_LOWER or UNOP_UPPER */
+ struct type *type;
+{
+ extern LONGEST type_lower_upper ();
+ struct type *result_type;
+ LONGEST val = type_lower_upper (opcode, type, &result_type);
+ write_exp_elt_opcode (OP_LONG);
+ write_exp_elt_type (result_type);
+ write_exp_elt_longcst (val);
+ write_exp_elt_opcode (OP_LONG);
+}
+
void
yyerror (msg)
char *msg;
{"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
{"MOD", BINOP_MOD, PREC_MUL, 0},
{"REM", BINOP_REM, PREC_MUL, 0},
+ {"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},
{":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
{"=", BINOP_EQUAL, PREC_EQUAL, 0},
{"/=", BINOP_NOTEQUAL, PREC_EQUAL, 0},
0
};
+/* Calculate LOWER or UPPER of TYPE.
+ Returns the result as an integer.
+ *RESULT_TYPE is the appropriate type for the result. */
+
+LONGEST
+type_lower_upper (op, type, result_type)
+ enum exp_opcode op; /* Either UNOP_LOWER or UNOP_UPPER */
+ struct type *type;
+ struct type **result_type;
+{
+ LONGEST tmp;
+ *result_type = builtin_type_int;
+ retry:
+ switch (TYPE_CODE (type))
+ {
+ case TYPE_CODE_STRUCT:
+ if (chill_varying_type (type))
+ return type_lower_upper (op, TYPE_FIELD_TYPE (type, 1), result_type);
+ break;
+ case TYPE_CODE_ARRAY:
+ case TYPE_CODE_BITSTRING:
+ case TYPE_CODE_STRING:
+ type = TYPE_FIELD_TYPE (type, 0); /* Get index type */
+
+ /* ... fall through ... */
+ case TYPE_CODE_RANGE:
+ if (TYPE_DUMMY_RANGE (type) > 0)
+ return type_lower_upper (op, TYPE_TARGET_TYPE (type), result_type);
+ *result_type = TYPE_TARGET_TYPE (type);
+ return op == UNOP_LOWER ? TYPE_LOW_BOUND (type) : TYPE_HIGH_BOUND (type);
+
+ case TYPE_CODE_ENUM:
+ *result_type = type;
+ if (TYPE_NFIELDS (type) > 0)
+ return TYPE_FIELD_BITPOS (type,
+ op == UNOP_LOWER ? 0
+ : TYPE_NFIELDS (type) - 1);
+
+ case TYPE_CODE_BOOL:
+ *result_type = type;
+ return op == UNOP_LOWER ? 0 : 1;
+ case TYPE_CODE_INT:
+ case TYPE_CODE_CHAR:
+ *result_type = type;
+ tmp = (LONGEST) 1 << (TARGET_CHAR_BIT * TYPE_LENGTH (type));
+ if (TYPE_UNSIGNED (type))
+ return op == UNOP_LOWER ? 0 : tmp - (LONGEST) 1;
+ tmp = tmp >> 1;
+ return op == UNOP_LOWER ? -tmp : (tmp - 1);
+ }
+ error ("unknown mode for LOWER/UPPER builtin");
+}
+
+static value_ptr
+value_chill_length (val)
+ value_ptr val;
+{
+ LONGEST tmp;
+ struct type *type = VALUE_TYPE (val);
+ struct type *ttype;
+ switch (TYPE_CODE (type))
+ {
+ case TYPE_CODE_ARRAY:
+ case TYPE_CODE_BITSTRING:
+ case TYPE_CODE_STRING:
+ tmp = type_lower_upper (UNOP_UPPER, type, &ttype)
+ - type_lower_upper (UNOP_LOWER, type, &ttype) + 1;
+ break;
+ case TYPE_CODE_STRUCT:
+ if (chill_varying_type (type))
+ {
+ tmp = unpack_long (TYPE_FIELD_TYPE (type, 0), VALUE_CONTENTS (val));
+ break;
+ }
+ /* ... else fall through ... */
+ default:
+ error ("bad argument to LENGTH builtin");
+ }
+ return value_from_longest (builtin_type_int, tmp);
+}
+
static value_ptr
evaluate_subexp_chill (expect_type, exp, pos, noside)
struct type *expect_type;
enum noside noside;
{
int pc = *pos;
+ struct type *type;
int tem, nargs;
value_ptr arg1;
value_ptr *argvec;
- switch (exp->elts[*pos].opcode)
+ enum exp_opcode op = exp->elts[*pos].opcode;
+ switch (op)
{
case MULTI_SUBSCRIPT:
if (noside == EVAL_SKIP || noside == EVAL_AVOID_SIDE_EFFECTS)
arg1 = value_subscript (arg1, index);
}
return (arg1);
+
+ case UNOP_LOWER:
+ case UNOP_UPPER:
+ (*pos)++;
+ if (noside == EVAL_SKIP)
+ {
+ (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, EVAL_SKIP);
+ goto nosideret;
+ }
+ arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos,
+ EVAL_AVOID_SIDE_EFFECTS);
+ tem = type_lower_upper (op, VALUE_TYPE (arg1), &type);
+ return value_from_longest (type, tem);
+
+ case UNOP_LENGTH:
+ (*pos)++;
+ arg1 = (*exp->language_defn->evaluate_exp) (NULL_TYPE, exp, pos, noside);
+ return value_chill_length (arg1);
+
default:
break;
}
return evaluate_subexp_standard (expect_type, exp, pos, noside);
+ nosideret:
+ return value_from_longest (builtin_type_long, (LONGEST) 1);
}
const struct language_defn chill_language_defn = {
{"<", BINOP_LESS, PREC_ORDER, 0},
{"^", UNOP_IND, PREC_PREFIX, 0},
{"@", BINOP_REPEAT, PREC_REPEAT, 0},
+ {"CAP", UNOP_CAP, PREC_BUILTIN_FUNCTION, 0},
+ {"CHR", UNOP_CHR, PREC_BUILTIN_FUNCTION, 0},
+ {"ORD", UNOP_ORD, PREC_BUILTIN_FUNCTION, 0},
+ {"FLOAT",UNOP_FLOAT, PREC_BUILTIN_FUNCTION, 0},
+ {"HIGH", UNOP_HIGH, PREC_BUILTIN_FUNCTION, 0},
+ {"MAX", UNOP_MAX, PREC_BUILTIN_FUNCTION, 0},
+ {"MIN", UNOP_MIN, PREC_BUILTIN_FUNCTION, 0},
+ {"ODD", UNOP_ODD, PREC_BUILTIN_FUNCTION, 0},
+ {"TRUNC", UNOP_TRUNC, PREC_BUILTIN_FUNCTION, 0},
{NULL, 0, 0, 0}
};
\f
{ PREC_NULL, PREC_COMMA, PREC_ABOVE_COMMA, PREC_ASSIGN, PREC_LOGICAL_OR,
PREC_LOGICAL_AND, PREC_BITWISE_IOR, PREC_BITWISE_AND, PREC_BITWISE_XOR,
PREC_EQUAL, PREC_ORDER, PREC_SHIFT, PREC_ADD, PREC_MUL, PREC_REPEAT,
- PREC_HYPER, PREC_PREFIX, PREC_SUFFIX };
+ PREC_HYPER, PREC_PREFIX, PREC_SUFFIX, PREC_BUILTIN_FUNCTION };
/* Table mapping opcodes into strings for printing operators
and precedences of the operators. */
projects / binutils-gdb.git / commitdiff