summaryrefslogtreecommitdiff
path: root/srfi/srfi-4.c
diff options
context:
space:
mode:
authorRob Browning <rlb@defaultvalue.org>2004-06-20 17:24:04 +0000
committerRob Browning <rlb@defaultvalue.org>2004-06-20 17:24:04 +0000
commit6b513f4643102410e14864641635abe010a9aefd (patch)
treec6e68bc2d5a1289df70286668db41263ccf848f8 /srfi/srfi-4.c
parentf8ac37336ff1b265a9d3b8f42631e92cf279c0f4 (diff)
downloadguile-6b513f4643102410e14864641635abe010a9aefd.tar.gz
(uvec_print): rewrite using a union to make more
compact, and use static print_uint64 and print_int64 to print 64-bit elements. (print_int64): new static function (temporary fix). (print_uint64): new static function (temporary fix).
Diffstat (limited to 'srfi/srfi-4.c')
-rw-r--r--srfi/srfi-4.c366
1 files changed, 145 insertions, 221 deletions
diff --git a/srfi/srfi-4.c b/srfi/srfi-4.c
index 0ad20e494..d5a6fcaea 100644
--- a/srfi/srfi-4.c
+++ b/srfi/srfi-4.c
@@ -73,6 +73,79 @@ int scm_tc16_uvec = 0;
static int uvec_sizes[10] = {1, 1, 2, 2, 4, 4, 8, 8, 4, 8};
+#ifdef SCM_HAVE_T_INT64
+
+// This is a modified version of scm_iint2str and should go away once
+// we have a public scm_print_integer or similar.
+
+static void
+print_int64 (scm_t_int64 num, SCM port)
+{
+ char num_buf[SCM_INTBUFLEN];
+ char *p = num_buf;
+ const int rad = 10;
+ size_t num_chars = 1;
+ size_t i;
+ scm_t_uint64 n = (num < 0) ? -num : num;
+
+ for (n /= rad; n > 0; n /= rad)
+ num_chars++;
+
+ i = num_chars;
+ if (num < 0)
+ {
+ *p++ = '-';
+ num_chars++;
+ n = -num;
+ }
+ else
+ n = num;
+ while (i--)
+ {
+ int d = n % rad;
+
+ n /= rad;
+ p[i] = d + ((d < 10) ? '0' : 'a' - 10);
+ }
+
+ scm_lfwrite (num_buf, num_chars, port);
+}
+
+#endif /* SCM_HAVE_T_INT64 */
+
+#ifdef SCM_HAVE_T_UINT64
+
+// This is a modified version of scm_iint2str and should go away once
+// we have a public scm_print_integer or similar.
+
+static void
+print_uint64 (scm_t_uint64 num, SCM port)
+{
+ char num_buf[SCM_INTBUFLEN];
+ char *p = num_buf;
+ const int rad = 10;
+ size_t num_chars = 1;
+ size_t i;
+ scm_t_uint64 n = num;
+
+ for (n /= rad; n > 0; n /= rad)
+ num_chars++;
+
+ i = num_chars;
+ n = num;
+ while (i--)
+ {
+ int d = n % rad;
+
+ n /= rad;
+ p[i] = d + ((d < 10) ? '0' : 'a' - 10);
+ }
+
+ scm_lfwrite (num_buf, num_chars, port);
+}
+
+#endif /* SCM_HAVE_T_UINT64 */
+
/* ================================================================ */
/* SMOB procedures. */
/* ================================================================ */
@@ -82,233 +155,84 @@ static int uvec_sizes[10] = {1, 1, 2, 2, 4, 4, 8, 8, 4, 8};
static int
uvec_print (SCM uvec, SCM port, scm_print_state *pstate SCM_UNUSED)
{
- switch (SCM_UVEC_TYPE (uvec))
- {
- case SCM_UVEC_U8:
- {
- int_u8 * p = (int_u8 *) SCM_UVEC_BASE (uvec);
- int i = 0;
-
- scm_puts ("#u8(", port);
- if (SCM_UVEC_LENGTH (uvec) > 0)
- {
- scm_intprint (*p, 10, port);
- p++;
- i++;
- for (; i < SCM_UVEC_LENGTH (uvec); i++)
- {
- scm_puts (" ", port);
- scm_intprint (*p, 10, port);
- p++;
- }
- }
- scm_puts (")", port);
- break;
- }
-
- case SCM_UVEC_S8:
- {
- int_s8 * p = (int_s8 *) SCM_UVEC_BASE (uvec);
- int i = 0;
-
- scm_puts ("#s8(", port);
- if (SCM_UVEC_LENGTH (uvec) > 0)
- {
- scm_intprint (*p, 10, port);
- p++;
- i++;
- for (; i < SCM_UVEC_LENGTH (uvec); i++)
- {
- scm_puts (" ", port);
- scm_intprint (*p, 10, port);
- p++;
- }
- }
- scm_puts (")", port);
- break;
- }
-
- case SCM_UVEC_U16:
- {
- int_u16 * p = (int_u16 *) SCM_UVEC_BASE (uvec);
- int i = 0;
-
- scm_puts ("#u16(", port);
- if (SCM_UVEC_LENGTH (uvec) > 0)
- {
- scm_intprint (*p, 10, port);
- p++;
- i++;
- for (; i < SCM_UVEC_LENGTH (uvec); i++)
- {
- scm_puts (" ", port);
- scm_intprint (*p, 10, port);
- p++;
- }
- }
- scm_puts (")", port);
- break;
- }
-
- case SCM_UVEC_S16:
- {
- int_s16 * p = (int_s16 *) SCM_UVEC_BASE (uvec);
- int i = 0;
-
- scm_puts ("#s16(", port);
- if (SCM_UVEC_LENGTH (uvec) > 0)
- {
- scm_intprint (*p, 10, port);
- p++;
- i++;
- for (; i < SCM_UVEC_LENGTH (uvec); i++)
- {
- scm_puts (" ", port);
- scm_intprint (*p, 10, port);
- p++;
- }
- }
- scm_puts (")", port);
- break;
- }
-
- case SCM_UVEC_U32:
- {
- int_u32 * p = (int_u32 *) SCM_UVEC_BASE (uvec);
- int i = 0;
-
- scm_puts ("#u32(", port);
- if (SCM_UVEC_LENGTH (uvec) > 0)
- {
- scm_intprint (*p, 10, port);
- p++;
- i++;
- for (; i < SCM_UVEC_LENGTH (uvec); i++)
- {
- scm_puts (" ", port);
- scm_intprint (*p, 10, port);
- p++;
- }
- }
- scm_puts (")", port);
- break;
- }
-
- case SCM_UVEC_S32:
- {
- int_s32 * p = (int_s32 *) SCM_UVEC_BASE (uvec);
- int i = 0;
-
- scm_puts ("#s32(", port);
- if (SCM_UVEC_LENGTH (uvec) > 0)
- {
- scm_intprint (*p, 10, port);
- p++;
- i++;
- for (; i < SCM_UVEC_LENGTH (uvec); i++)
- {
- scm_puts (" ", port);
- scm_intprint (*p, 10, port);
- p++;
- }
- }
- scm_puts (")", port);
- break;
- }
-
-#ifdef SCM_HAVE_T_INT64
- case SCM_UVEC_U64:
- {
- int_u64 * p = (int_u64 *) SCM_UVEC_BASE (uvec);
- int i = 0;
-
- scm_puts ("#u64(", port);
- if (SCM_UVEC_LENGTH (uvec) > 0)
- {
- scm_intprint (*p, 10, port);
- p++;
- i++;
- for (; i < SCM_UVEC_LENGTH (uvec); i++)
- {
- scm_puts (" ", port);
- scm_intprint (*p, 10, port);
- p++;
- }
- }
- scm_puts (")", port);
- break;
- }
-
- case SCM_UVEC_S64:
- {
- int_s64 * p = (int_s64 *) SCM_UVEC_BASE (uvec);
- int i = 0;
-
- scm_puts ("#s64(", port);
- if (SCM_UVEC_LENGTH (uvec) > 0)
- {
- scm_intprint (*p, 10, port);
- p++;
- i++;
- for (; i < SCM_UVEC_LENGTH (uvec); i++)
- {
- scm_puts (" ", port);
- scm_intprint (*p, 10, port);
- p++;
- }
- }
- scm_puts (")", port);
- break;
- }
+ union {
+ int_u8 *u8;
+ int_s8 *s8;
+ int_u16 *u16;
+ int_s16 *s16;
+ int_u32 *u32;
+ int_s32 *s32;
+#if SCM_HAVE_T_UINT64
+ int_u64 *u64;
+#endif
+#if SCM_HAVE_T_INT64
+ int_s64 *s64;
#endif
+ float_f32 *f32;
+ float_f64 *f64;
+ } np;
- case SCM_UVEC_F32:
- {
- float_f32 * p = (float_f32 *) SCM_UVEC_BASE (uvec);
- int i = 0;
-
- scm_puts ("#f32(", port);
- if (SCM_UVEC_LENGTH (uvec) > 0)
- {
- scm_iprin1 (scm_make_real (*p), port, pstate);
- p++;
- i++;
- for (; i < SCM_UVEC_LENGTH (uvec); i++)
- {
- scm_puts (" ", port);
- scm_iprin1 (scm_make_real (*p), port, pstate);
- p++;
- }
- }
- scm_puts (")", port);
- break;
- }
-
- case SCM_UVEC_F64:
- {
- float_f64 * p = (float_f64 *) SCM_UVEC_BASE (uvec);
- int i = 0;
-
- scm_puts ("#f64(", port);
- if (SCM_UVEC_LENGTH (uvec) > 0)
- {
- scm_iprin1 (scm_make_real (*p), port, pstate);
- p++;
- i++;
- for (; i < SCM_UVEC_LENGTH (uvec); i++)
- {
- scm_puts (" ", port);
- scm_iprin1 (scm_make_real (*p), port, pstate);
- p++;
- }
- }
- scm_puts (")", port);
- break;
- }
+ scm_t_bits i = 0; // since SCM_UVEC_LENGTH will return something this size.
+ const scm_t_bits uvlen = SCM_UVEC_LENGTH (uvec);
+ char *tagstr;
+ void *uptr = SCM_UVEC_BASE (uvec);
+ switch (SCM_UVEC_TYPE (uvec))
+ {
+ case SCM_UVEC_U8: tagstr = "u8"; np.u8 = (int_u8 *) uptr; break;
+ case SCM_UVEC_S8: tagstr = "s8"; np.s8 = (int_s8 *) uptr; break;
+ case SCM_UVEC_U16: tagstr = "u16"; np.u16 = (int_u16 *) uptr; break;
+ case SCM_UVEC_S16: tagstr = "s16"; np.s16 = (int_s16 *) uptr; break;
+ case SCM_UVEC_U32: tagstr = "u32"; np.u32 = (int_u32 *) uptr; break;
+ case SCM_UVEC_S32: tagstr = "s32"; np.s32 = (int_s32 *) uptr; break;
+#if SCM_HAVE_T_UINT64
+ case SCM_UVEC_U64: tagstr = "u64"; np.u64 = (int_u64 *) uptr; break;
+#endif
+#if SCM_HAVE_T_INT64
+ case SCM_UVEC_S64: tagstr = "s64"; np.s64 = (int_s64 *) uptr; break;
+#endif
+ case SCM_UVEC_F32: tagstr = "f32"; np.f32 = (float_f32 *) uptr; break;
+ case SCM_UVEC_F64: tagstr = "f64"; np.f64 = (float_f64 *) uptr; break;
default:
abort (); /* Sanity check. */
+ break;
+ }
+
+ scm_putc ('#', port);
+ scm_puts (tagstr, port);
+ scm_putc ('(', port);
+
+ while (i < uvlen)
+ {
+ if (i != 0) scm_puts (" ", port);
+ switch (SCM_UVEC_TYPE (uvec))
+ {
+ case SCM_UVEC_U8: scm_intprint (*np.u8, 10, port); np.u8++; break;
+ case SCM_UVEC_S8: scm_intprint (*np.s8, 10, port); np.s8++; break;
+ case SCM_UVEC_U16: scm_intprint (*np.u16, 10, port); np.u16++; break;
+ case SCM_UVEC_S16: scm_intprint (*np.s16, 10, port); np.s16++; break;
+ case SCM_UVEC_U32: scm_intprint (*np.u32, 10, port); np.u32++; break;
+ case SCM_UVEC_S32: scm_intprint (*np.s32, 10, port); np.s32++; break;
+#if SCM_HAVE_T_UINT64
+ case SCM_UVEC_U64: print_uint64(*np.u64, port); np.u64++; break;
+#endif
+#if SCM_HAVE_T_INT64
+ case SCM_UVEC_S64: print_int64(*np.s64, port); np.s64++; break;
+#endif
+ case SCM_UVEC_F32: scm_iprin1 (scm_make_real (*np.f32), port, pstate);
+ np.f32++;
+ break;
+ case SCM_UVEC_F64: scm_iprin1 (scm_make_real (*np.f64), port, pstate);
+ np.f64++;
+ break;
+ default:
+ abort (); /* Sanity check. */
+ break;
}
+ i++;
+ }
+ scm_remember_upto_here_1 (uvec);
+ scm_puts (")", port);
return 1;
}