- tarval *tv;
-
- TARVAL_VRFY (a);
-
- tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
-
- tv->mode = a->mode;
-
- switch (get_mode_modecode(a->mode)) {
- /* floating */
- case irm_F: tv->u.F = -a->u.F; break;
- case irm_D: tv->u.D = -a->u.D; break;
- /* unsigned */
- case irm_Bu: case irm_Hu: case irm_Iu: case irm_Lu:
- tv->u.uInt = -a->u.uInt & tv_val_uInt (get_mode_max(a->mode));
- break;
- /* signed */
- case irm_Bs: case irm_Hs: case irm_Is: case irm_Ls:
- tv->u.sInt = -a->u.sInt;
- if ( sInt_overflow (tv->u.sInt, a->mode)
- || ((tv->u.sInt >= 0) == (a->u.sInt >= 0))) {
- obstack_free (&tv_obst, tv);
- return NULL;
- }
- break;
- case irm_b: tv->u.b = !a->u.b; break;
- default: assert(0);
- }
-
- return tarval_identify (tv);
-}
-
-
-/* Compare `a' with `b'.
- Return one of irpn_Lt, irpn_Eq, irpn_Gt, irpn_Uo, or irpn_False if
- result is unknown. */
-ir_pncmp
-tarval_comp (tarval *a, tarval *b)
-{
-
- TARVAL_VRFY (a);
- TARVAL_VRFY (b);
-
- assert (a->mode == b->mode);
-
- switch (get_mode_modecode(a->mode)) {
- /* floating */
- case irm_F: return ( a->u.F == b->u.F ? irpn_Eq
- : a->u.F > b->u.F ? irpn_Gt
- : a->u.F < b->u.F ? irpn_Lt
- : irpn_Uo);
- case irm_D: return ( a->u.D == b->u.D ? irpn_Eq
- : a->u.D > b->u.D ? irpn_Gt
- : a->u.D < b->u.D ? irpn_Lt
- : irpn_Uo);
- case irm_E: return ( a->u.E == b-> u.E ? irpn_Eq
- : a->u.E > b->u.E ? irpn_Gt
- : a->u.E < b->u.E ? irpn_Lt
- : irpn_Uo);
- /* unsigned */
- case irm_Bu: case irm_Hu: case irm_Iu: case irm_Lu:
- return ( a->u.uInt == b->u.uInt ? irpn_Eq
- : a->u.uInt > b->u.uInt ? irpn_Gt
- : irpn_Lt);
- /* signed */
- case irm_Bs: case irm_Hs: case irm_Is: case irm_Ls:
- return ( a->u.sInt == b->u.sInt ? irpn_Eq
- : a->u.sInt > b->u.sInt ? irpn_Gt
- : irpn_Lt);
- case irm_b: return ( a->u.b == b->u.b ? irpn_Eq
- : a->u.b > b->u.b ? irpn_Gt
- : irpn_Lt);
- /* The following assumes that pointers are unsigned, which is valid
- for all sane CPUs (transputers are insane). */
- case irm_P: return ( a == b ? irpn_Eq
- : a == tarval_P_void ? irpn_Lt
- : b == tarval_P_void ? irpn_Gt
- : irpn_False); /* unknown */
- default: assert (0);
- }
-}
-
-
-/* Return `a+b' if computable, else NULL. Modes must be equal. */
-tarval *
-tarval_add (tarval *a, tarval *b)
-{
- tarval *tv;
-
- TARVAL_VRFY (a); TARVAL_VRFY (b);
- assert (a->mode == b->mode);
-
- tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
-
- tv->mode = a->mode;
-
- switch (get_mode_modecode(a->mode)) {
- /* floating */
- case irm_F: tv->u.F = a->u.F + b->u.F; break; /* @@@ overflow etc */
- case irm_D: tv->u.D = a->u.D + b->u.D; break; /* @@@ dto. */
- case irm_E: tv->u.E = a->u.E + b->u.E; break; /* @@@ dto. */
- /* unsigned */
- case irm_Bu: case irm_Hu: case irm_Iu: case irm_Lu:
- tv->u.uInt = (a->u.uInt + b->u.uInt) & tv_val_uInt (get_mode_max(a->mode));
- break;
- /* signed */
- case irm_Bs: case irm_Hs: case irm_Is: case irm_Ls:
- tv->u.sInt = a->u.sInt + b->u.sInt;
- if ( sInt_overflow (tv->u.sInt, a->mode)
- || ((tv->u.sInt > a->u.sInt) ^ (b->u.sInt > 0))) {
- obstack_free (&tv_obst, tv);
- return NULL;
- }
- break;
- case irm_b: tv->u.b = a->u.b | b->u.b; break; /* u.b is in canonical form */
- default: assert(0);
- }
-
- return tarval_identify (tv);
-}
-
-
-/* Return `a-b' if computable, else NULL. Modes must be equal. */
-tarval *
-tarval_sub (tarval *a, tarval *b)
-{
- tarval *tv;
-
- TARVAL_VRFY (a); TARVAL_VRFY (b);
- assert (a->mode == b->mode);
-
- tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
-
- tv->mode = a->mode;
-
- switch (get_mode_modecode(a->mode)) {
- /* floating */
- case irm_F: tv->u.F = a->u.F - b->u.F; break; /* @@@ overflow etc */
- case irm_D: tv->u.D = a->u.D - b->u.D; break; /* @@@ dto. */
- case irm_E: tv->u.E = a->u.E - b->u.E; break; /* @@@ dto. */
- /* unsigned */
- case irm_Bu: case irm_Hu: case irm_Iu: case irm_Lu:
- tv->u.uInt = (a->u.uInt - b->u.uInt) & tv_val_uInt (get_mode_max(a->mode));
- break;
- /* signed */
- case irm_Bs: case irm_Hs: case irm_Is: case irm_Ls:
- tv->u.sInt = a->u.sInt - b->u.sInt;
- if ( sInt_overflow (tv->u.sInt, a->mode)
- || ((tv->u.sInt > a->u.sInt) ^ (b->u.sInt < 0))) {
- obstack_free (&tv_obst, tv);
- return NULL;
- }
- break;
- case irm_b: tv->u.b = a->u.b & ~b->u.b; break; /* u.b is in canonical form */
- default: assert(0);
- }
-
- return tarval_identify (tv);
-}
-
-/* Return `a*b' if computable, else NULL. Modes must be equal. */
-tarval *
-tarval_mul (tarval *a, tarval *b)
-{
- tarval *tv;
-
- TARVAL_VRFY (a); TARVAL_VRFY (b);
- assert (a->mode == b->mode);
-
- tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
-
- tv->mode = a->mode;
-
- switch (get_mode_modecode(a->mode)) {
- /* floating */
- case irm_F: tv->u.F = a->u.F * b->u.F; break; /* @@@ overflow etc */
- case irm_D: tv->u.D = a->u.D * b->u.D; break; /* @@@ dto. */
- case irm_E: tv->u.E = a->u.E * b->u.E; break; /* @@@ dto. */
- /* unsigned */
- case irm_Bu: case irm_Hu: case irm_Iu: case irm_Lu:
- tv->u.uInt = (a->u.uInt * b->u.uInt) & tv_val_uInt (get_mode_max(a->mode));
- break;
- /* signed */
- case irm_Bs: case irm_Hs: case irm_Is: case irm_Ls:
- tv->u.sInt = a->u.sInt * b->u.sInt;
- if ( sInt_overflow (tv->u.sInt, a->mode)
- || (b->u.sInt && (tv->u.sInt / b->u.sInt != a->u.sInt))) {
- obstack_free (&tv_obst, tv);
- return NULL;
- }
- break;
- case irm_b: tv->u.b = a->u.b & b->u.b; break; /* u.b is in canonical form */
- default: assert(0);
- }
-
- return tarval_identify (tv);
-}
-
-
-/* Return floating-point `a/b' if computable, else NULL.
- Modes must be equal, non-floating-point operands are converted to irm_D. */
-tarval *
-tarval_quo (tarval *a, tarval *b)
-{
- tarval *tv;
-
- TARVAL_VRFY (a); TARVAL_VRFY (b);
- assert (a->mode == b->mode);
-
- switch (get_mode_modecode(a->mode)) {
- /* floating */
- case irm_F:
- tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
- tv->mode = mode_F;
- tv->u.F = a->u.F / b->u.F; /* @@@ overflow etc */
- break;
- case irm_D:
- tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
- tv->mode = mode_D;
- tv->u.D = a->u.D / b->u.D; /* @@@ overflow etc */
- break;
- default:
- a = tarval_convert_to (a, mode_D);
- b = tarval_convert_to (b, mode_D);
- return a && b ? tarval_quo (a, b) : NULL;
- }
-
- return tarval_identify (tv);
-}
-
-
-/* Return `a/b' if computable, else NULL. Modes must be equal. */
-tarval *
-tarval_div (tarval *a, tarval *b)
-{
- tarval *tv;
-
- TARVAL_VRFY (a); TARVAL_VRFY (b);
- assert (a->mode == b->mode);
-
- tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
-
- tv->mode = a->mode;
-
- switch (get_mode_modecode(a->mode)) {
- /* floating */
- case irm_F: tv->u.F = floor (a->u.F / b->u.F); break; /* @@@ overflow etc */
- case irm_D: tv->u.D = floor (a->u.D / b->u.D); break; /* @@@ dto. */
- case irm_E: tv->u.E = floor (a->u.E / b->u.E); break; /* @@@ dto. */
- /* unsigned */
- case irm_Bu: case irm_Hu: case irm_Iu: case irm_Lu:
- if (!b->u.uInt) goto fail;
- tv->u.uInt = a->u.uInt / b->u.uInt;
- break;
- /* signed */
- case irm_Bs: case irm_Hs: case irm_Is: case irm_Ls:
- if ( !b->u.sInt
- || ((b->u.sInt == -1) && (a->u.sInt == tv_val_sInt (get_mode_max(a->mode)) ))) {
- fail:
- obstack_free (&tv_obst, tv);
- return NULL;
- }
- tv->u.sInt = a->u.sInt / b->u.sInt;
- break;
- case irm_b: tv->u.b = a->u.b ^ b->u.b; break; /* u.b is in canonical form */
- default: assert(0);
- }
-
- return tarval_identify (tv);
-}
-
-
-/* Return `a%b' if computable, else NULL. Modes must be equal. */
-tarval *
-tarval_mod (tarval *a, tarval *b)
-{
- tarval *tv;
-
- TARVAL_VRFY (a); TARVAL_VRFY (b);
- assert (a->mode == b->mode);
-
- tv = (tarval *)obstack_alloc (&tv_obst, sizeof (tarval));
-
- tv->mode = a->mode;
-
- switch (get_mode_modecode(a->mode)) {
- /* floating */
- case irm_F: tv->u.F = fmod (a->u.F, b->u.F); break; /* @@@ overflow etc */
- case irm_D: tv->u.D = fmod (a->u.D, b->u.D); break; /* @@@ dto */
- case irm_E: tv->u.E = fmod (a->u.E, b->u.E); break; /* @@@ dto. */
- /* unsigned */
- case irm_Bu: case irm_Hu: case irm_Iu: case irm_Lu:
- if (!b->u.uInt) goto fail;
- tv->u.uInt = a->u.uInt % b->u.uInt;
- break;
- /* signed */
- case irm_Bs: case irm_Hs: case irm_Is: case irm_Ls:
- if (!b->u.sInt) {
- fail:
- obstack_free (&tv_obst, tv);
- return NULL;
- }
- tv->u.sInt = a->u.sInt % b->u.sInt;
- break;
- case irm_b: tv->u.b = a->u.b ^ b->u.b; break; /* u.b is in canonical form */
- default: assert(0);
- }
-
- return tarval_identify (tv);
-}
-
-/* Return |a| if computable, else Null. */
-/* is -max == min?? */
-tarval *
-tarval_abs (tarval *a) {
- TARVAL_VRFY (a);
- if (tv_is_negative(a)) return tarval_neg(a);
- return a;
+ static const tarval_mode_info default_info = { TVO_NATIVE, NULL, NULL };
+
+ const char *str;
+ char tv_buf[100];
+ const tarval_mode_info *mode_info;
+ const char *prefix, *suffix;
+
+ mode_info = (const tarval_mode_info*) tv->mode->tv_priv;
+ if (! mode_info)
+ mode_info = &default_info;
+ prefix = mode_info->mode_prefix ? mode_info->mode_prefix : "";
+ suffix = mode_info->mode_suffix ? mode_info->mode_suffix : "";
+
+ switch (get_mode_sort(tv->mode)) {
+ case irms_reference:
+ if (tv == tv->mode->null) return snprintf(buf, len, "NULL");
+ /* FALLTHROUGH */
+ case irms_int_number:
+ switch (mode_info->mode_output) {
+
+ case TVO_DECIMAL:
+ str = sc_print(tv->value, get_mode_size_bits(tv->mode), SC_DEC, mode_is_signed(tv->mode));
+ break;
+
+ case TVO_OCTAL:
+ str = sc_print(tv->value, get_mode_size_bits(tv->mode), SC_OCT, 0);
+ break;
+
+ case TVO_NATIVE:
+ prefix = "0x";
+ case TVO_HEX:
+ default:
+ str = sc_print(tv->value, get_mode_size_bits(tv->mode), SC_HEX, 0);
+ break;
+ }
+ return snprintf(buf, len, "%s%s%s", prefix, str, suffix);
+
+ case irms_float_number:
+ switch (mode_info->mode_output) {
+ case TVO_HEX:
+ return snprintf(buf, len, "%s%s%s", prefix, fc_print((const fp_value*) tv->value, tv_buf, sizeof(tv_buf), FC_PACKED), suffix);
+
+ case TVO_HEXFLOAT:
+ return snprintf(buf, len, "%s%s%s", prefix, fc_print((const fp_value*) tv->value, tv_buf, sizeof(tv_buf), FC_HEX), suffix);
+
+ case TVO_FLOAT:
+ case TVO_NATIVE:
+ default:
+ return snprintf(buf, len, "%s%s%s", prefix, fc_print((const fp_value*) tv->value, tv_buf, sizeof(tv_buf), FC_DEC), suffix);
+ }
+
+ case irms_internal_boolean:
+ switch (mode_info->mode_output) {
+
+ case TVO_DECIMAL:
+ case TVO_OCTAL:
+ case TVO_HEX:
+ case TVO_BINARY:
+ return snprintf(buf, len, "%s%c%s", prefix, (tv == tarval_b_true) ? '1' : '0', suffix);
+
+ case TVO_NATIVE:
+ default:
+ return snprintf(buf, len, "%s%s%s", prefix, (tv == tarval_b_true) ? "true" : "false", suffix);
+ }
+
+ default:
+ return snprintf(buf, len, "<TV_??""?>");
+ }