diff options
| -rw-r--r-- | gdb/ChangeLog | 61 | ||||
| -rw-r--r-- | gdb/Makefile.in | 23 | ||||
| -rw-r--r-- | gdb/ch-exp.y | 113 | ||||
| -rw-r--r-- | gdb/language.c | 5 | ||||
| -rw-r--r-- | gdb/valarith.c | 209 |
5 files changed, 351 insertions, 60 deletions
diff --git a/gdb/ChangeLog b/gdb/ChangeLog index 0ff268e..bb76b2d 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -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, diff --git a/gdb/Makefile.in b/gdb/Makefile.in index ce1bead..b120b68 100644 --- a/gdb/Makefile.in +++ b/gdb/Makefile.in @@ -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 diff --git a/gdb/ch-exp.y b/gdb/ch-exp.y index cb17086..1ee9c90 100644 --- a/gdb/ch-exp.y +++ b/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); } ; @@ -929,16 +956,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; } %% diff --git a/gdb/language.c b/gdb/language.c index c5306bb..d9c7c1c 100644 --- a/gdb/language.c +++ b/gdb/language.c @@ -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; diff --git a/gdb/valarith.c b/gdb/valarith.c index 5ce8c79..e82f014 100644 --- a/gdb/valarith.c +++ b/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 */ } + + +/* 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 integers or two floats. +/* 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. */ @@ -371,12 +524,16 @@ value_binop (arg1, arg2, op) 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 && TYPE_CODE (VALUE_TYPE (arg2)) != TYPE_CODE_BOOL)) @@ -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; |