* expression.h (BINOP_CONCAT): Document use for self concatenation
an integral number of times. * language.c (binop_type_check): Extend BINOP_CONCAT for self concatenation case. * valarith.c (value_concat): Rewrite to support self concatenation an integral number of times. **** start-sanitize-chill **** * Makefile.in (ch-exp.tab.c): Change "expect" message. * ch-exp.y (FIXME's): Make all FIXME tokens distinct, to eliminate hundreds of spurious shift/reduce and reduce/reduce conflicts that mask the 5 real ones. * ch-exp.y (STRING, CONSTANT, SC): Remove unused tokens. * ch-exp.y (integer_literal_expression): Remove production, no longer used. **** end-sanitize-chill ****
This commit is contained in:
Fred Fish
parent
3a8d4a5faf
commit
2fcc38b81f
|
|
@ -1,3 +1,64 @@
|
|||
Wed Jan 27 21:34:21 1993 Fred Fish (fnf@cygnus.com)
|
||||
|
||||
* expression.h (BINOP_CONCAT): Document use for self concatenation
|
||||
an integral number of times.
|
||||
* language.c (binop_type_check): Extend BINOP_CONCAT for self
|
||||
concatenation case.
|
||||
* valarith.c (value_concat): Rewrite to support self
|
||||
concatenation an integral number of times.
|
||||
**** start-sanitize-chill ****
|
||||
* Makefile.in (ch-exp.tab.c): Change "expect" message.
|
||||
* ch-exp.y (FIXME's): Make all FIXME tokens distinct, to
|
||||
eliminate hundreds of spurious shift/reduce and reduce/reduce
|
||||
conflicts that mask the 5 real ones.
|
||||
* ch-exp.y (STRING, CONSTANT, SC): Remove unused tokens.
|
||||
* ch-exp.y (integer_literal_expression): Remove production,
|
||||
no longer used.
|
||||
**** end-sanitize-chill ****
|
||||
|
||||
Thu Jan 21 09:58:36 1993 Fred Fish (fnf@cygnus.com)
|
||||
|
||||
* eval.c (evaluate_subexp): Fix OP_ARRAY, remove code that
|
||||
implied that "no side effects" was nonfunctional.
|
||||
* eval.c (evaluate_subexp): Add BINOP_CONCAT case to deal with
|
||||
character string and bitstring concatenation.
|
||||
* expprint.c (dump_expression): Add case for BINOP_CONCAT.
|
||||
* expression.h (exp_opcode): Add BINOP_CONCAT.
|
||||
* gdbtypes.h (type_code): Add TYPE_CODE_BITSTRING.
|
||||
* language.c (string_type): Add function to determine if a type
|
||||
is a string type.
|
||||
* language.c (binop_type_check): Add case for BINOP_CONCAT.
|
||||
* valarith.c (value_concat): New function to concatenate two
|
||||
values, such as character strings or bitstrings.
|
||||
* valops.c (value_string): Remove error stub and implement
|
||||
function body.
|
||||
* value.h (value_concat): Add prototype.
|
||||
**** start-sanitize-chill ****
|
||||
* ch-exp.y (operand_3): Add actions for SLASH_SLASH (//).
|
||||
* ch-exp.y (yylex): Recognize SLASH_SLASH.
|
||||
* ch-lang.c (chill_op_print_tab): Add SLASH_SLASH (//) as
|
||||
BINOP_CONCAT.
|
||||
**** end-sanitize-chill ****
|
||||
|
||||
Tue Jan 19 14:26:15 1993 Fred Fish (fnf@cygnus.com)
|
||||
|
||||
* c-exp.y (exp): Add production to support direct creation
|
||||
of array constants using the obvious syntax.
|
||||
* c-valprint.c (c_val_print): Set printed string length.
|
||||
* dwarfread.c (read_tag_string_type): New prototype and
|
||||
function that handles TAG_string_type DIEs.
|
||||
* dwarfread.c (process_dies): Add case for TAG_string_type
|
||||
that calls new read_tag_string_type function.
|
||||
* expprint.c (print_subexp): Add support for OP_ARRAY.
|
||||
* gdbtypes.c (create_range_type, create_array_type): Inherit
|
||||
objfile from the index type.
|
||||
**** start-sanitize-chill ****
|
||||
* ch-typeprint.c (chill_print_type): Add case for
|
||||
TYPE_CODE_STRING.
|
||||
* ch-valprint.c (chill_val_print): Fix case for
|
||||
TYPE_CODE_STRING.
|
||||
**** end-sanitize-chill ****
|
||||
|
||||
Mon Jan 18 11:58:45 1993 Ian Lance Taylor (ian@cygnus.com)
|
||||
|
||||
* mipsread.c (CODE_MASK, MIPS_IS_STAB, MIPS_MARK_STAB,
|
||||
|
|
|
|||
|
|
@ -179,6 +179,8 @@ LINTFLAGS= -I${BFD_DIR}
|
|||
# End of host and target-dependent makefile fragments
|
||||
|
||||
FLAGS_TO_PASS = \
|
||||
"prefix=$(prefix)" \
|
||||
"exec_prefix=$(exec_prefix)" \
|
||||
"against=$(against)" \
|
||||
"AR=$(AR)" \
|
||||
"AR_FLAGS=$(AR_FLAGS)" \
|
||||
|
|
@ -333,14 +335,14 @@ YYOBJ = c-exp.tab.o m2-exp.tab.o ch-exp.tab.o
|
|||
${CC} -c ${INTERNAL_CFLAGS} $<
|
||||
|
||||
all: gdb
|
||||
$(MAKE) subdir_do DO=all "DODIRS=$(SUBDIRS)" $(FLAGS_TO_PASS)
|
||||
$(MAKE) $(FLAGS_TO_PASS) DO=all "DODIRS=$(SUBDIRS)" subdir_do
|
||||
check:
|
||||
info: force
|
||||
$(MAKE) subdir_do DO=info "DODIRS=$(SUBDIRS)" $(FLAGS_TO_PASS)
|
||||
$(MAKE) $(FLAGS_TO_PASS) DO=info "DODIRS=$(SUBDIRS)" subdir_do
|
||||
install-info: force
|
||||
$(MAKE) subdir_do DO=install-info "DODIRS=$(SUBDIRS)" $(FLAGS_TO_PASS)
|
||||
$(MAKE) $(FLAGS_TO_PASS) DO=install-info "DODIRS=$(SUBDIRS)" subdir_do
|
||||
clean-info: force
|
||||
$(MAKE) subdir_do DO=clean-info "DODIRS=$(SUBDIRS)" $(FLAGS_TO_PASS)
|
||||
$(MAKE) $(FLAGS_TO_PASS) DO=clean-info "DODIRS=$(SUBDIRS)" subdir_do
|
||||
|
||||
gdb.z:gdb.1
|
||||
nroff -man $(srcdir)/gdb.1 | col -b > gdb.t
|
||||
|
|
@ -358,7 +360,7 @@ install: gdb
|
|||
$(INSTALL_PROGRAM) gdb $(bindir)/$$n; \
|
||||
$(INSTALL_DATA) $(srcdir)/gdb.1 $(man1dir)/$$n.1
|
||||
$(M_INSTALL)
|
||||
$(MAKE) subdir_do DO=install "DODIRS=$(SUBDIRS)" $(FLAGS_TO_PASS)
|
||||
$(MAKE) DO=install "DODIRS=$(SUBDIRS)" $(FLAGS_TO_PASS) subdir_do
|
||||
|
||||
init.c: $(srcdir)/munch $(OBS) $(TSOBS)
|
||||
$(srcdir)/munch ${MUNCH_DEFINE} $(OBS) $(TSOBS) > init.c
|
||||
|
|
@ -619,19 +621,19 @@ clean:
|
|||
rm -f init.c version.c
|
||||
rm -f gdb core gdb.tar gdb.tar.Z make.log
|
||||
rm -f gdb[0-9]
|
||||
@$(MAKE) subdir_do DO=clean "DODIRS=$(SUBDIRS)" $(FLAGS_TO_PASS)
|
||||
@$(MAKE) $(FLAGS_TO_PASS) DO=clean "DODIRS=$(SUBDIRS)" subdir_do
|
||||
|
||||
distclean: clean c-exp.tab.c m2-exp.tab.c ch-exp.tab.c TAGS
|
||||
rm -f tm.h xm.h config.status
|
||||
rm -f y.output yacc.acts yacc.tmp
|
||||
rm -f ${TESTS} Makefile depend
|
||||
@$(MAKE) subdir_do DO=distclean "DODIRS=$(SUBDIRS)" $(FLAGS_TO_PASS)
|
||||
@$(MAKE) $(FLAGS_TO_PASS) DO=distclean "DODIRS=$(SUBDIRS)" subdir_do
|
||||
|
||||
realclean: clean
|
||||
rm -f c-exp.tab.c m2-exp.tab.c ch-exp.tab.c TAGS
|
||||
rm -f tm.h xm.h config.status
|
||||
rm -f Makefile depend
|
||||
@$(MAKE) subdir_do DO=realclean "DODIRS=$(SUBDIRS)" $(FLAGS_TO_PASS)
|
||||
@$(MAKE) $(FLAGS_TO_PASS) DO=realclean "DODIRS=$(SUBDIRS)" subdir_do
|
||||
|
||||
STAGESTUFF=${OBS} ${TSOBS} ${NTSOBS} ${ADD_FILES} init.c init.o version.c gdb
|
||||
|
||||
|
|
@ -704,7 +706,7 @@ c-exp.tab.c: $(srcdir)/c-exp.y Makefile
|
|||
# else.
|
||||
ch-exp.tab.o: ch-exp.tab.c
|
||||
ch-exp.tab.c: $(srcdir)/ch-exp.y Makefile
|
||||
@echo 'Expect rules never reduced, and lots of reduce/reduce conflicts.'
|
||||
@echo 'Expect rules never reduced and {shift,reduce}/reduce conflicts.'
|
||||
${YACC} $(srcdir)/ch-exp.y
|
||||
-sed -e '/extern.*malloc/d' \
|
||||
-e '/extern.*realloc/d' \
|
||||
|
|
@ -761,6 +763,9 @@ xcoffread.o: ${srcdir}/xcoffread.c
|
|||
xcoffexec.o: ${srcdir}/xcoffexec.c
|
||||
${CC} -c ${INTERNAL_CFLAGS} -I$(BFD_DIR) ${srcdir}/xcoffexec.c
|
||||
|
||||
paread.o: ${srcdir}/paread.c
|
||||
${CC} -c ${INTERNAL_CFLAGS} -I$(BFD_DIR) ${srcdir}/paread.c
|
||||
|
||||
# Drag in the files that are in another directory.
|
||||
|
||||
xdr_ld.o: ${srcdir}/vx-share/xdr_ld.c
|
||||
|
|
|
|||
113
gdb/ch-exp.y
113
gdb/ch-exp.y
|
|
@ -139,7 +139,36 @@ yyerror PARAMS ((char *));
|
|||
int *ivec;
|
||||
}
|
||||
|
||||
%token <voidval> FIXME
|
||||
%token <voidval> FIXME_01
|
||||
%token <voidval> FIXME_02
|
||||
%token <voidval> FIXME_03
|
||||
%token <voidval> FIXME_04
|
||||
%token <voidval> FIXME_05
|
||||
%token <voidval> FIXME_06
|
||||
%token <voidval> FIXME_07
|
||||
%token <voidval> FIXME_08
|
||||
%token <voidval> FIXME_09
|
||||
%token <voidval> FIXME_10
|
||||
%token <voidval> FIXME_11
|
||||
%token <voidval> FIXME_12
|
||||
%token <voidval> FIXME_13
|
||||
%token <voidval> FIXME_14
|
||||
%token <voidval> FIXME_15
|
||||
%token <voidval> FIXME_16
|
||||
%token <voidval> FIXME_17
|
||||
%token <voidval> FIXME_18
|
||||
%token <voidval> FIXME_19
|
||||
%token <voidval> FIXME_20
|
||||
%token <voidval> FIXME_21
|
||||
%token <voidval> FIXME_22
|
||||
%token <voidval> FIXME_23
|
||||
%token <voidval> FIXME_24
|
||||
%token <voidval> FIXME_25
|
||||
%token <voidval> FIXME_26
|
||||
%token <voidval> FIXME_27
|
||||
%token <voidval> FIXME_28
|
||||
%token <voidval> FIXME_29
|
||||
%token <voidval> FIXME_30
|
||||
|
||||
%token <typed_val> INTEGER_LITERAL
|
||||
%token <ulval> BOOLEAN_LITERAL
|
||||
|
|
@ -152,8 +181,6 @@ yyerror PARAMS ((char *));
|
|||
%token <sval> CHARACTER_STRING_LITERAL
|
||||
%token <sval> BIT_STRING_LITERAL
|
||||
|
||||
%token <voidval> STRING
|
||||
%token <voidval> CONSTANT
|
||||
%token <voidval> '.'
|
||||
%token <voidval> ';'
|
||||
%token <voidval> ':'
|
||||
|
|
@ -182,7 +209,6 @@ yyerror PARAMS ((char *));
|
|||
%token <voidval> NOT
|
||||
%token <voidval> POINTER
|
||||
%token <voidval> RECEIVE
|
||||
%token <voidval> SC
|
||||
%token <voidval> '['
|
||||
%token <voidval> ']'
|
||||
%token <voidval> '('
|
||||
|
|
@ -249,7 +275,6 @@ yyerror PARAMS ((char *));
|
|||
%type <voidval> operand_4
|
||||
%type <voidval> operand_5
|
||||
%type <voidval> operand_6
|
||||
%type <voidval> integer_literal_expression
|
||||
%type <voidval> synonym_name
|
||||
%type <voidval> value_enumeration_name
|
||||
%type <voidval> value_do_with_name
|
||||
|
|
@ -295,7 +320,7 @@ value : expression
|
|||
}
|
||||
;
|
||||
|
||||
undefined_value : FIXME
|
||||
undefined_value : FIXME_01
|
||||
{
|
||||
$$ = 0; /* FIXME */
|
||||
}
|
||||
|
|
@ -307,7 +332,7 @@ location : access_name
|
|||
{
|
||||
$$ = 0; /* FIXME */
|
||||
}
|
||||
| FIXME
|
||||
| FIXME_02
|
||||
{
|
||||
$$ = 0; /* FIXME */
|
||||
}
|
||||
|
|
@ -339,7 +364,7 @@ access_name : LOCATION_NAME
|
|||
write_exp_elt_intern ($1);
|
||||
write_exp_elt_opcode (OP_INTERNALVAR);
|
||||
}
|
||||
| FIXME
|
||||
| FIXME_03
|
||||
{
|
||||
$$ = 0; /* FIXME */
|
||||
}
|
||||
|
|
@ -507,7 +532,7 @@ literal : INTEGER_LITERAL
|
|||
|
||||
/* Z.200, 5.2.5 */
|
||||
|
||||
tuple : FIXME
|
||||
tuple : FIXME_04
|
||||
{
|
||||
$$ = 0; /* FIXME */
|
||||
}
|
||||
|
|
@ -570,7 +595,7 @@ value_structure_field: structure_primitive_value '.' field_name
|
|||
|
||||
/* Z.200, 5.2.11 */
|
||||
|
||||
expression_conversion: mode_name '(' expression ')'
|
||||
expression_conversion: mode_name parenthesised_expression
|
||||
{
|
||||
$$ = 0; /* FIXME */
|
||||
}
|
||||
|
|
@ -578,7 +603,7 @@ expression_conversion: mode_name '(' expression ')'
|
|||
|
||||
/* Z.200, 5.2.12 */
|
||||
|
||||
value_procedure_call: FIXME
|
||||
value_procedure_call: FIXME_05
|
||||
{
|
||||
$$ = 0; /* FIXME */
|
||||
}
|
||||
|
|
@ -594,7 +619,7 @@ value_built_in_routine_call: chill_value_built_in_routine_call
|
|||
|
||||
/* Z.200, 5.2.14 */
|
||||
|
||||
start_expression: FIXME
|
||||
start_expression: FIXME_06
|
||||
{
|
||||
$$ = 0; /* FIXME */
|
||||
} /* Not in GNU-Chill */
|
||||
|
|
@ -602,7 +627,7 @@ start_expression: FIXME
|
|||
|
||||
/* Z.200, 5.2.15 */
|
||||
|
||||
zero_adic_operator: FIXME
|
||||
zero_adic_operator: FIXME_07
|
||||
{
|
||||
$$ = 0; /* FIXME */
|
||||
}
|
||||
|
|
@ -788,6 +813,8 @@ operand_4 : operand_5
|
|||
;
|
||||
|
||||
/* Z.200, 5.3.8 */
|
||||
/* Note that we accept any expression for BINOP_CONCAT, not just
|
||||
integer literal expressions. (FIXME?) */
|
||||
|
||||
operand_5 : operand_6
|
||||
{
|
||||
|
|
@ -801,9 +828,9 @@ operand_5 : operand_6
|
|||
{
|
||||
write_exp_elt_opcode (UNOP_LOGICAL_NOT);
|
||||
}
|
||||
| '(' integer_literal_expression ')' operand_6
|
||||
| parenthesised_expression operand_6
|
||||
{
|
||||
$$ = 0; /* FIXME */
|
||||
write_exp_elt_opcode (BINOP_CONCAT);
|
||||
}
|
||||
;
|
||||
|
||||
|
|
@ -928,16 +955,6 @@ length_argument : location
|
|||
}
|
||||
;
|
||||
|
||||
/* Z.200, 12.4.3 */
|
||||
/* FIXME: For now we just accept only a single integer literal. */
|
||||
|
||||
integer_literal_expression:
|
||||
INTEGER_LITERAL
|
||||
{
|
||||
$$ = 0;
|
||||
}
|
||||
;
|
||||
|
||||
/* Z.200, 12.4.3 */
|
||||
|
||||
array_primitive_value : primitive_value
|
||||
|
|
@ -949,29 +966,29 @@ array_primitive_value : primitive_value
|
|||
|
||||
/* Things which still need productions... */
|
||||
|
||||
array_mode_name : FIXME { $$ = 0; }
|
||||
string_mode_name : FIXME { $$ = 0; }
|
||||
variant_structure_mode_name: FIXME { $$ = 0; }
|
||||
synonym_name : FIXME { $$ = 0; }
|
||||
value_enumeration_name : FIXME { $$ = 0; }
|
||||
value_do_with_name : FIXME { $$ = 0; }
|
||||
value_receive_name : FIXME { $$ = 0; }
|
||||
string_primitive_value : FIXME { $$ = 0; }
|
||||
start_element : FIXME { $$ = 0; }
|
||||
left_element : FIXME { $$ = 0; }
|
||||
right_element : FIXME { $$ = 0; }
|
||||
slice_size : FIXME { $$ = 0; }
|
||||
lower_element : FIXME { $$ = 0; }
|
||||
upper_element : FIXME { $$ = 0; }
|
||||
first_element : FIXME { $$ = 0; }
|
||||
structure_primitive_value: FIXME { $$ = 0; }
|
||||
field_name : FIXME { $$ = 0; }
|
||||
mode_name : FIXME { $$ = 0; }
|
||||
boolean_expression : FIXME { $$ = 0; }
|
||||
case_selector_list : FIXME { $$ = 0; }
|
||||
subexpression : FIXME { $$ = 0; }
|
||||
case_label_specification: FIXME { $$ = 0; }
|
||||
buffer_location : FIXME { $$ = 0; }
|
||||
array_mode_name : FIXME_08 { $$ = 0; }
|
||||
string_mode_name : FIXME_09 { $$ = 0; }
|
||||
variant_structure_mode_name: FIXME_10 { $$ = 0; }
|
||||
synonym_name : FIXME_11 { $$ = 0; }
|
||||
value_enumeration_name : FIXME_12 { $$ = 0; }
|
||||
value_do_with_name : FIXME_13 { $$ = 0; }
|
||||
value_receive_name : FIXME_14 { $$ = 0; }
|
||||
string_primitive_value : FIXME_15 { $$ = 0; }
|
||||
start_element : FIXME_16 { $$ = 0; }
|
||||
left_element : FIXME_17 { $$ = 0; }
|
||||
right_element : FIXME_18 { $$ = 0; }
|
||||
slice_size : FIXME_19 { $$ = 0; }
|
||||
lower_element : FIXME_20 { $$ = 0; }
|
||||
upper_element : FIXME_21 { $$ = 0; }
|
||||
first_element : FIXME_22 { $$ = 0; }
|
||||
structure_primitive_value: FIXME_23 { $$ = 0; }
|
||||
field_name : FIXME_24 { $$ = 0; }
|
||||
mode_name : FIXME_25 { $$ = 0; }
|
||||
boolean_expression : FIXME_26 { $$ = 0; }
|
||||
case_selector_list : FIXME_27 { $$ = 0; }
|
||||
subexpression : FIXME_28 { $$ = 0; }
|
||||
case_label_specification: FIXME_29 { $$ = 0; }
|
||||
buffer_location : FIXME_30 { $$ = 0; }
|
||||
|
||||
%%
|
||||
|
||||
|
|
|
|||
|
|
@ -894,8 +894,9 @@ binop_type_check(arg1,arg2,op)
|
|||
break;
|
||||
|
||||
case BINOP_CONCAT:
|
||||
if (!(string_type(t1) || character_type(t1))
|
||||
|| !(string_type(t2) || character_type(t2)))
|
||||
/* FIXME: Needs to handle bitstrings as well. */
|
||||
if (!(string_type(t1) || character_type(t1) || integral_type(t1))
|
||||
|| !(string_type(t2) || character_type(t2) || integral_type(t2)))
|
||||
type_op_error ("Arguments to %s must be strings or characters.", op);
|
||||
break;
|
||||
|
||||
|
|
|
|||
209
gdb/valarith.c
209
gdb/valarith.c
|
|
@ -23,8 +23,16 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
|
|||
#include "gdbtypes.h"
|
||||
#include "expression.h"
|
||||
#include "target.h"
|
||||
#include "language.h"
|
||||
#include <string.h>
|
||||
|
||||
/* Define whether or not the C operator '/' truncates towards zero for
|
||||
differently signed operands (truncation direction is undefined in C). */
|
||||
|
||||
#ifndef TRUNCATION_TOWARDS_ZERO
|
||||
#define TRUNCATION_TOWARDS_ZERO ((-5 / 2) == -2)
|
||||
#endif
|
||||
|
||||
static value
|
||||
value_subscripted_rvalue PARAMS ((value, value));
|
||||
|
||||
|
|
@ -268,6 +276,7 @@ value_x_binop (arg1, arg2, op, otherop)
|
|||
case BINOP_BITWISE_AND: strcpy(ptr,"&="); break;
|
||||
case BINOP_BITWISE_IOR: strcpy(ptr,"|="); break;
|
||||
case BINOP_BITWISE_XOR: strcpy(ptr,"^="); break;
|
||||
case BINOP_MOD: /* invalid */
|
||||
default:
|
||||
error ("Invalid binary operation specified.");
|
||||
}
|
||||
|
|
@ -279,6 +288,7 @@ value_x_binop (arg1, arg2, op, otherop)
|
|||
case BINOP_GTR: strcpy(ptr,">"); break;
|
||||
case BINOP_GEQ: strcpy(ptr,">="); break;
|
||||
case BINOP_LEQ: strcpy(ptr,"<="); break;
|
||||
case BINOP_MOD: /* invalid */
|
||||
default:
|
||||
error ("Invalid binary operation specified.");
|
||||
}
|
||||
|
|
@ -354,8 +364,151 @@ value_x_unop (arg1, op)
|
|||
error ("member function %s not found", tstr);
|
||||
return 0; /* For lint -- never reached */
|
||||
}
|
||||
|
||||
|
||||
/* Perform a binary operation on two integers or two floats.
|
||||
/* Concatenate two values with the following conditions:
|
||||
|
||||
(1) Both values must be either bitstring values or character string
|
||||
values and the resulting value consists of the concatenation of
|
||||
ARG1 followed by ARG2.
|
||||
|
||||
or
|
||||
|
||||
One value must be an integer value and the other value must be
|
||||
either a bitstring value or character string value, which is
|
||||
to be repeated by the number of times specified by the integer
|
||||
value.
|
||||
|
||||
|
||||
(2) Boolean values are also allowed and are treated as bit string
|
||||
values of length 1.
|
||||
|
||||
(3) Character values are also allowed and are treated as character
|
||||
string values of length 1.
|
||||
*/
|
||||
|
||||
value
|
||||
value_concat (arg1, arg2)
|
||||
value arg1, arg2;
|
||||
{
|
||||
register value inval1, inval2, outval;
|
||||
int inval1len, inval2len;
|
||||
int count, idx;
|
||||
char *ptr;
|
||||
char inchar;
|
||||
|
||||
/* First figure out if we are dealing with two values to be concatenated
|
||||
or a repeat count and a value to be repeated. INVAL1 is set to the
|
||||
first of two concatenated values, or the repeat count. INVAL2 is set
|
||||
to the second of the two concatenated values or the value to be
|
||||
repeated. */
|
||||
|
||||
if (TYPE_CODE (VALUE_TYPE (arg2)) == TYPE_CODE_INT)
|
||||
{
|
||||
inval1 = arg2;
|
||||
inval2 = arg1;
|
||||
}
|
||||
else
|
||||
{
|
||||
inval1 = arg1;
|
||||
inval2 = arg2;
|
||||
}
|
||||
|
||||
/* Now process the input values. */
|
||||
|
||||
if (TYPE_CODE (VALUE_TYPE (inval1)) == TYPE_CODE_INT)
|
||||
{
|
||||
/* We have a repeat count. Validate the second value and then
|
||||
construct a value repeated that many times. */
|
||||
if (TYPE_CODE (VALUE_TYPE (inval2)) == TYPE_CODE_STRING
|
||||
|| TYPE_CODE (VALUE_TYPE (inval2)) == TYPE_CODE_CHAR)
|
||||
{
|
||||
count = longest_to_int (value_as_long (inval1));
|
||||
inval2len = TYPE_LENGTH (VALUE_TYPE (inval2));
|
||||
ptr = (char *) alloca (count * inval2len);
|
||||
if (TYPE_CODE (VALUE_TYPE (inval2)) == TYPE_CODE_CHAR)
|
||||
{
|
||||
inchar = (char) unpack_long (VALUE_TYPE (inval2),
|
||||
VALUE_CONTENTS (inval2));
|
||||
for (idx = 0; idx < count; idx++)
|
||||
{
|
||||
*(ptr + idx) = inchar;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
for (idx = 0; idx < count; idx++)
|
||||
{
|
||||
memcpy (ptr + (idx * inval2len), VALUE_CONTENTS (inval2),
|
||||
inval2len);
|
||||
}
|
||||
}
|
||||
outval = value_string (ptr, count * inval2len);
|
||||
}
|
||||
else if (TYPE_CODE (VALUE_TYPE (inval2)) == TYPE_CODE_BITSTRING
|
||||
|| TYPE_CODE (VALUE_TYPE (inval2)) == TYPE_CODE_BOOL)
|
||||
{
|
||||
error ("unimplemented support for bitstring/boolean repeats");
|
||||
}
|
||||
else
|
||||
{
|
||||
error ("can't repeat values of that type");
|
||||
}
|
||||
}
|
||||
else if (TYPE_CODE (VALUE_TYPE (inval1)) == TYPE_CODE_STRING
|
||||
|| TYPE_CODE (VALUE_TYPE (inval1)) == TYPE_CODE_CHAR)
|
||||
{
|
||||
/* We have two character strings to concatenate. */
|
||||
if (TYPE_CODE (VALUE_TYPE (inval2)) != TYPE_CODE_STRING
|
||||
&& TYPE_CODE (VALUE_TYPE (inval2)) != TYPE_CODE_CHAR)
|
||||
{
|
||||
error ("Strings can only be concatenated with other strings.");
|
||||
}
|
||||
inval1len = TYPE_LENGTH (VALUE_TYPE (inval1));
|
||||
inval2len = TYPE_LENGTH (VALUE_TYPE (inval2));
|
||||
ptr = (char *) alloca (inval1len + inval2len);
|
||||
if (TYPE_CODE (VALUE_TYPE (inval1)) == TYPE_CODE_CHAR)
|
||||
{
|
||||
*ptr = (char) unpack_long (VALUE_TYPE (inval1), VALUE_CONTENTS (inval1));
|
||||
}
|
||||
else
|
||||
{
|
||||
memcpy (ptr, VALUE_CONTENTS (inval1), inval1len);
|
||||
}
|
||||
if (TYPE_CODE (VALUE_TYPE (inval2)) == TYPE_CODE_CHAR)
|
||||
{
|
||||
*(ptr + inval1len) =
|
||||
(char) unpack_long (VALUE_TYPE (inval2), VALUE_CONTENTS (inval2));
|
||||
}
|
||||
else
|
||||
{
|
||||
memcpy (ptr + inval1len, VALUE_CONTENTS (inval2), inval2len);
|
||||
}
|
||||
outval = value_string (ptr, inval1len + inval2len);
|
||||
}
|
||||
else if (TYPE_CODE (VALUE_TYPE (inval1)) == TYPE_CODE_BITSTRING
|
||||
|| TYPE_CODE (VALUE_TYPE (inval1)) == TYPE_CODE_BOOL)
|
||||
{
|
||||
/* We have two bitstrings to concatenate. */
|
||||
if (TYPE_CODE (VALUE_TYPE (inval2)) != TYPE_CODE_BITSTRING
|
||||
&& TYPE_CODE (VALUE_TYPE (inval2)) != TYPE_CODE_BOOL)
|
||||
{
|
||||
error ("Bitstrings or booleans can only be concatenated with other bitstrings or booleans.");
|
||||
}
|
||||
error ("unimplemented support for bitstring/boolean concatenation.");
|
||||
}
|
||||
else
|
||||
{
|
||||
/* We don't know how to concatenate these operands. */
|
||||
error ("illegal operands for concatenation.");
|
||||
}
|
||||
return (outval);
|
||||
}
|
||||
|
||||
|
||||
/* Perform a binary operation on two operands which have reasonable
|
||||
representations as integers or floats. This includes booleans,
|
||||
characters, integers, or floats.
|
||||
Does not support addition and subtraction on pointers;
|
||||
use value_add or value_sub if you want to handle those possibilities. */
|
||||
|
||||
|
|
@ -370,12 +523,16 @@ value_binop (arg1, arg2, op)
|
|||
COERCE_ENUM (arg2);
|
||||
|
||||
if ((TYPE_CODE (VALUE_TYPE (arg1)) != TYPE_CODE_FLT
|
||||
&&
|
||||
TYPE_CODE (VALUE_TYPE (arg1)) != TYPE_CODE_CHAR
|
||||
&&
|
||||
TYPE_CODE (VALUE_TYPE (arg1)) != TYPE_CODE_INT
|
||||
&&
|
||||
TYPE_CODE (VALUE_TYPE (arg1)) != TYPE_CODE_BOOL)
|
||||
||
|
||||
(TYPE_CODE (VALUE_TYPE (arg2)) != TYPE_CODE_FLT
|
||||
&&
|
||||
TYPE_CODE (VALUE_TYPE (arg2)) != TYPE_CODE_CHAR
|
||||
&&
|
||||
TYPE_CODE (VALUE_TYPE (arg2)) != TYPE_CODE_INT
|
||||
&&
|
||||
|
|
@ -483,6 +640,29 @@ value_binop (arg1, arg2, op)
|
|||
v = v1 % v2;
|
||||
break;
|
||||
|
||||
case BINOP_MOD:
|
||||
/* Knuth 1.2.4, integer only. Note that unlike the C '%' op,
|
||||
v1 mod 0 has a defined value, v1. */
|
||||
/* start-sanitize-chill */
|
||||
/* Chill specifies that v2 must be > 0, so check for that. */
|
||||
if (current_language -> la_language == language_chill
|
||||
&& value_as_long (arg2) <= 0)
|
||||
{
|
||||
error ("Second operand of MOD must be greater than zero.");
|
||||
}
|
||||
/* end-sanitize-chill */
|
||||
if (v2 == 0)
|
||||
{
|
||||
v = v1;
|
||||
}
|
||||
else
|
||||
{
|
||||
v = v1/v2;
|
||||
/* Note floor(v1/v2) == v1/v2 for unsigned. */
|
||||
v = v1 - (v2 * v);
|
||||
}
|
||||
break;
|
||||
|
||||
case BINOP_LSH:
|
||||
v = v1 << v2;
|
||||
break;
|
||||
|
|
@ -555,6 +735,33 @@ value_binop (arg1, arg2, op)
|
|||
v = v1 % v2;
|
||||
break;
|
||||
|
||||
case BINOP_MOD:
|
||||
/* Knuth 1.2.4, integer only. Note that unlike the C '%' op,
|
||||
X mod 0 has a defined value, X. */
|
||||
/* start-sanitize-chill */
|
||||
/* Chill specifies that v2 must be > 0, so check for that. */
|
||||
if (current_language -> la_language == language_chill
|
||||
&& v2 <= 0)
|
||||
{
|
||||
error ("Second operand of MOD must be greater than zero.");
|
||||
}
|
||||
/* end-sanitize-chill */
|
||||
if (v2 == 0)
|
||||
{
|
||||
v = v1;
|
||||
}
|
||||
else
|
||||
{
|
||||
v = v1/v2;
|
||||
/* Compute floor. */
|
||||
if (TRUNCATION_TOWARDS_ZERO && (v < 0) && ((v1 % v2) != 0))
|
||||
{
|
||||
v--;
|
||||
}
|
||||
v = v1 - (v2 * v);
|
||||
}
|
||||
break;
|
||||
|
||||
case BINOP_LSH:
|
||||
v = v1 << v2;
|
||||
break;
|
||||
|
|
|
|||
Loading…
Reference in New Issue