summaryrefslogtreecommitdiffstats
path: root/mdk-stage1/slang/slpack.c
diff options
context:
space:
mode:
Diffstat (limited to 'mdk-stage1/slang/slpack.c')
-rw-r--r--mdk-stage1/slang/slpack.c785
1 files changed, 785 insertions, 0 deletions
diff --git a/mdk-stage1/slang/slpack.c b/mdk-stage1/slang/slpack.c
new file mode 100644
index 000000000..53ef63643
--- /dev/null
+++ b/mdk-stage1/slang/slpack.c
@@ -0,0 +1,785 @@
+/* Pack objects as a binary string */
+/* Copyright (c) 1998, 1999, 2001 John E. Davis
+ * This file is part of the S-Lang library.
+ *
+ * You may distribute under the terms of either the GNU General Public
+ * License or the Perl Artistic License.
+ */
+#include "slinclud.h"
+
+#include <ctype.h>
+
+#include "slang.h"
+#include "_slang.h"
+
+#ifndef isdigit
+# define isdigit(c) (((c)>='0')&&((c)<= '9'))
+#endif
+#ifndef isspace
+# define isspace(c) (((c)==' ') || ((c)=='\t') || ((c)=='\n'))
+#endif
+
+/* format description:
+ *
+ * s = string (null padded)
+ * S = string (space padded)
+ * c = signed char
+ * C = unsigned char
+ * h = short
+ * H = unsigned short
+ * i = int
+ * I = unsigned int
+ * l = long
+ * L = unsigned long
+ * j = 16 bit signed integer (short)
+ * J = 16 bit unsigned integer (short)
+ * k = 32 bit signed integer (long)
+ * K = 32 bit unsigned integer (long)
+ * f = float (native format)
+ * F = 32 bit double
+ * d = double (native format)
+ * D = 64 bit double
+ * x = null pad byte
+ * > = big-endian mode
+ * < = little-endian mode
+ * = = native mode
+ */
+
+#define NATIVE_ORDER 0
+#define BIGENDIAN_ORDER 1
+#define LILENDIAN_ORDER 2
+static int Native_Byte_Order = NATIVE_ORDER;
+
+typedef struct
+{
+ char format_type;
+ unsigned char data_type;
+ unsigned int repeat;
+ unsigned int sizeof_type;
+ char pad;
+ int byteorder;
+ int is_scalar;
+}
+Format_Type;
+
+static int get_int_type_for_size (unsigned int size, unsigned char *s, unsigned char *u)
+{
+ if (sizeof (int) == size)
+ {
+ if (s != NULL) *s = SLANG_INT_TYPE;
+ if (u != NULL) *u = SLANG_UINT_TYPE;
+ return 0;
+ }
+
+ if (sizeof (short) == size)
+ {
+ if (s != NULL) *s = SLANG_SHORT_TYPE;
+ if (u != NULL) *u = SLANG_USHORT_TYPE;
+ return 1;
+ }
+
+ if (sizeof (long) == size)
+ {
+ if (s != NULL) *s = SLANG_LONG_TYPE;
+ if (u != NULL) *u = SLANG_ULONG_TYPE;
+ return 1;
+ }
+
+ if (s != NULL) *s = 0;
+ if (u != NULL) *u = 0;
+ SLang_verror (SL_NOT_IMPLEMENTED,
+ "This OS does not support a %u byte int", size);
+ return -1;
+}
+
+static int get_float_type_for_size (unsigned int size, unsigned char *s)
+{
+ if (sizeof (float) == size)
+ {
+ *s = SLANG_FLOAT_TYPE;
+ return 0;
+ }
+
+ if (sizeof (double) == size)
+ {
+ *s = SLANG_DOUBLE_TYPE;
+ return 0;
+ }
+
+ SLang_verror (SL_NOT_IMPLEMENTED,
+ "This OS does not support a %u byte float", size);
+ return -1;
+}
+
+static int parse_a_format (char **format, Format_Type *ft)
+{
+ char *f;
+ char ch;
+ unsigned repeat;
+
+ f = *format;
+
+ while (((ch = *f++) != 0)
+ && isspace (ch))
+ ;
+
+ switch (ch)
+ {
+ default:
+ ft->byteorder = NATIVE_ORDER;
+ break;
+
+ case '=':
+ ft->byteorder = NATIVE_ORDER;
+ ch = *f++;
+ break;
+
+ case '>':
+ ft->byteorder = BIGENDIAN_ORDER;
+ ch = *f++;
+ break;
+
+ case '<':
+ ft->byteorder = LILENDIAN_ORDER;
+ ch = *f++;
+ break;
+ }
+
+ if (ch == 0)
+ {
+ f--;
+ *format = f;
+ return 0;
+ }
+
+ ft->format_type = ch;
+ ft->repeat = 1;
+
+ if (isdigit (*f))
+ {
+ repeat = (unsigned int) (*f - '0');
+ f++;
+
+ while (isdigit (*f))
+ {
+ unsigned int repeat10 = 10 * repeat + (unsigned int)(*f - '0');
+
+ /* Check overflow */
+ if (repeat != repeat10 / 10)
+ {
+ SLang_verror (SL_OVERFLOW,
+ "Repeat count too large in [un]pack format");
+ return -1;
+ }
+ repeat = repeat10;
+ f++;
+ }
+ ft->repeat = repeat;
+ }
+
+ *format = f;
+
+ ft->is_scalar = 1;
+ ft->pad = 0;
+
+ switch (ft->format_type)
+ {
+ default:
+ SLang_verror (SL_NOT_IMPLEMENTED,
+ "[un]pack format character '%c' not supported", ft->format_type);
+ return -1;
+
+ case 'D':
+ ft->sizeof_type = 8;
+ if (-1 == get_float_type_for_size (8, &ft->data_type))
+ return -1;
+ break;
+
+ case 'd':
+ ft->data_type = SLANG_DOUBLE_TYPE;
+ ft->sizeof_type = sizeof (double);
+ break;
+
+ case 'F':
+ ft->sizeof_type = 4;
+ if (-1 == get_float_type_for_size (4, &ft->data_type))
+ return -1;
+ break;
+ case 'f':
+ ft->data_type = SLANG_FLOAT_TYPE;
+ ft->sizeof_type = sizeof (float);
+ break;
+
+ case 'h':
+ ft->data_type = SLANG_SHORT_TYPE;
+ ft->sizeof_type = sizeof (short);
+ break;
+ case 'H':
+ ft->data_type = SLANG_USHORT_TYPE;
+ ft->sizeof_type = sizeof (unsigned short);
+ break;
+ case 'i':
+ ft->data_type = SLANG_INT_TYPE;
+ ft->sizeof_type = sizeof (int);
+ break;
+ case 'I':
+ ft->data_type = SLANG_UINT_TYPE;
+ ft->sizeof_type = sizeof (unsigned int);
+ break;
+ case 'l':
+ ft->data_type = SLANG_LONG_TYPE;
+ ft->sizeof_type = sizeof (long);
+ break;
+ case 'L':
+ ft->data_type = SLANG_ULONG_TYPE;
+ ft->sizeof_type = sizeof (unsigned long);
+ break;
+
+ /* 16 bit ints */
+ case 'j':
+ ft->sizeof_type = 2;
+ if (-1 == get_int_type_for_size (2, &ft->data_type, NULL))
+ return -1;
+ break;
+ case 'J':
+ ft->sizeof_type = 2;
+ if (-1 == get_int_type_for_size (2, NULL, &ft->data_type))
+ return -1;
+ break;
+
+ /* 32 bit ints */
+ case 'k':
+ ft->sizeof_type = 4;
+ if (-1 == get_int_type_for_size (4, &ft->data_type, NULL))
+ return -1;
+ break;
+ case 'K':
+ ft->sizeof_type = 4;
+ if (-1 == get_int_type_for_size (4, NULL, &ft->data_type))
+ return -1;
+ break;
+
+ case 'x':
+ ft->sizeof_type = 1;
+ ft->data_type = 0;
+ break;
+
+ case 'c':
+ ft->sizeof_type = 1;
+ ft->data_type = SLANG_CHAR_TYPE;
+ break;
+
+ case 'C':
+ ft->data_type = SLANG_UCHAR_TYPE;
+ ft->sizeof_type = 1;
+ break;
+
+ case 'S':
+ case 'A':
+ ft->pad = ' ';
+ case 'a':
+ case 's':
+ ft->data_type = SLANG_BSTRING_TYPE;
+ ft->sizeof_type = 1;
+ ft->is_scalar = 0;
+ break;
+ }
+ return 1;
+}
+
+static int compute_size_for_format (char *format, unsigned int *num_bytes)
+{
+ unsigned int size;
+ Format_Type ft;
+ int status;
+
+ *num_bytes = size = 0;
+
+ while (1 == (status = parse_a_format (&format, &ft)))
+ size += ft.repeat * ft.sizeof_type;
+
+ *num_bytes = size;
+ return status;
+}
+
+static void byte_swap64 (unsigned char *ss, unsigned int n) /*{{{*/
+{
+ unsigned char *p, *pmax, ch;
+
+ if (n == 0) return;
+ p = (unsigned char *) ss;
+ pmax = p + 8 * n;
+ while (p < pmax)
+ {
+ ch = *p;
+ *p = *(p + 7);
+ *(p + 7) = ch;
+
+ ch = *(p + 6);
+ *(p + 6) = *(p + 1);
+ *(p + 1) = ch;
+
+ ch = *(p + 5);
+ *(p + 5) = *(p + 2);
+ *(p + 2) = ch;
+
+ ch = *(p + 4);
+ *(p + 4) = *(p + 3);
+ *(p + 3) = ch;
+
+ p += 8;
+ }
+}
+
+/*}}}*/
+static void byte_swap32 (unsigned char *ss, unsigned int n) /*{{{*/
+{
+ unsigned char *p, *pmax, ch;
+
+ p = (unsigned char *) ss;
+ pmax = p + 4 * n;
+ while (p < pmax)
+ {
+ ch = *p;
+ *p = *(p + 3);
+ *(p + 3) = ch;
+
+ ch = *(p + 1);
+ *(p + 1) = *(p + 2);
+ *(p + 2) = ch;
+ p += 4;
+ }
+}
+
+/*}}}*/
+static void byte_swap16 (unsigned char *p, unsigned int nread) /*{{{*/
+{
+ unsigned char *pmax, ch;
+
+ pmax = p + 2 * nread;
+ while (p < pmax)
+ {
+ ch = *p;
+ *p = *(p + 1);
+ *(p + 1) = ch;
+ p += 2;
+ }
+}
+
+/*}}}*/
+
+static int byteswap (int order, unsigned char *b, unsigned int size, unsigned int num)
+{
+ if (Native_Byte_Order == order)
+ return 0;
+
+ switch (size)
+ {
+ case 2:
+ byte_swap16 (b, num);
+ break;
+ case 4:
+ byte_swap32 (b, num);
+ break;
+ case 8:
+ byte_swap64 (b, num);
+ break;
+ default:
+ return -1;
+ }
+
+ return 0;
+}
+
+static void check_native_byte_order (void)
+{
+ unsigned short x;
+
+ if (Native_Byte_Order != NATIVE_ORDER)
+ return;
+
+ x = 0xFF;
+ if (*(unsigned char *)&x == 0xFF)
+ Native_Byte_Order = LILENDIAN_ORDER;
+ else
+ Native_Byte_Order = BIGENDIAN_ORDER;
+}
+
+static SLang_BString_Type *
+pack_according_to_format (char *format, unsigned int nitems)
+{
+ unsigned int size, num;
+ unsigned char *buf, *b;
+ SLang_BString_Type *bs;
+ Format_Type ft;
+
+ buf = NULL;
+
+ if (-1 == compute_size_for_format (format, &size))
+ goto return_error;
+
+ if (NULL == (buf = (unsigned char *) SLmalloc (size + 1)))
+ goto return_error;
+
+ b = buf;
+
+ while (1 == parse_a_format (&format, &ft))
+ {
+ unsigned char *ptr;
+ unsigned int repeat;
+
+ repeat = ft.repeat;
+ if (ft.data_type == 0)
+ {
+ memset ((char *) b, ft.pad, repeat);
+ b += repeat;
+ continue;
+ }
+
+ if (ft.is_scalar)
+ {
+ unsigned char *bstart;
+ num = repeat;
+
+ bstart = b;
+ while (repeat != 0)
+ {
+ unsigned int nelements;
+ SLang_Array_Type *at;
+
+ if (nitems == 0)
+ {
+ SLang_verror (SL_INVALID_PARM,
+ "Not enough items for pack format");
+ goto return_error;
+ }
+
+ if (-1 == SLang_pop_array_of_type (&at, ft.data_type))
+ goto return_error;
+
+ nelements = at->num_elements;
+ if (repeat < nelements)
+ nelements = repeat;
+ repeat -= nelements;
+
+ nelements = nelements * ft.sizeof_type;
+ memcpy ((char *)b, (char *)at->data, nelements);
+
+ b += nelements;
+ SLang_free_array (at);
+ nitems--;
+ }
+
+ if (ft.byteorder != NATIVE_ORDER)
+ byteswap (ft.byteorder, bstart, ft.sizeof_type, num);
+
+ continue;
+ }
+
+ /* Otherwise we have a string */
+ if (-1 == SLang_pop_bstring (&bs))
+ goto return_error;
+
+ ptr = SLbstring_get_pointer (bs, &num);
+ if (repeat < num) num = repeat;
+ memcpy ((char *)b, (char *)ptr, num);
+ b += num;
+ repeat -= num;
+ memset ((char *)b, ft.pad, repeat);
+ SLbstring_free (bs);
+ b += repeat;
+ nitems--;
+ }
+
+ *b = 0;
+ bs = SLbstring_create_malloced (buf, size, 0);
+ if (bs == NULL)
+ goto return_error;
+
+ SLdo_pop_n (nitems);
+ return bs;
+
+ return_error:
+ SLdo_pop_n (nitems);
+ if (buf != NULL)
+ SLfree ((char *) buf);
+
+ return NULL;
+}
+
+void _SLpack (void)
+{
+ SLang_BString_Type *bs;
+ char *fmt;
+ int nitems;
+
+ check_native_byte_order ();
+
+ nitems = SLang_Num_Function_Args;
+ if (nitems <= 0)
+ {
+ SLang_verror (SL_SYNTAX_ERROR,
+ "pack: not enough arguments");
+ return;
+ }
+
+ if ((-1 == SLreverse_stack (nitems))
+ || (-1 == SLang_pop_slstring (&fmt)))
+ bs = NULL;
+ else
+ {
+ bs = pack_according_to_format (fmt, (unsigned int)nitems - 1);
+ SLang_free_slstring (fmt);
+ }
+
+ SLang_push_bstring (bs);
+ SLbstring_free (bs);
+}
+
+void _SLunpack (char *format, SLang_BString_Type *bs)
+{
+ Format_Type ft;
+ unsigned char *b;
+ unsigned int len;
+ unsigned int num_bytes;
+
+ check_native_byte_order ();
+
+ if (-1 == compute_size_for_format (format, &num_bytes))
+ return;
+
+ b = SLbstring_get_pointer (bs, &len);
+ if (b == NULL)
+ return;
+
+ if (len < num_bytes)
+ {
+ SLang_verror (SL_INVALID_PARM,
+ "unpack format %s is too large for input string",
+ format);
+ return;
+ }
+
+ while (1 == parse_a_format (&format, &ft))
+ {
+ char *str, *s;
+
+ if (ft.repeat == 0)
+ continue;
+
+ if (ft.data_type == 0)
+ { /* skip padding */
+ b += ft.repeat;
+ continue;
+ }
+
+ if (ft.is_scalar)
+ {
+ SLang_Array_Type *at;
+ int dims;
+
+ if (ft.repeat == 1)
+ {
+ SLang_Class_Type *cl;
+
+ cl = _SLclass_get_class (ft.data_type);
+ memcpy ((char *)cl->cl_transfer_buf, (char *)b, ft.sizeof_type);
+ if (ft.byteorder != NATIVE_ORDER)
+ byteswap (ft.byteorder, (unsigned char *)cl->cl_transfer_buf, ft.sizeof_type, 1);
+
+ if (-1 == (cl->cl_apush (ft.data_type, cl->cl_transfer_buf)))
+ return;
+ b += ft.sizeof_type;
+ continue;
+ }
+
+ dims = (int) ft.repeat;
+ at = SLang_create_array (ft.data_type, 0, NULL, &dims, 1);
+ if (at == NULL)
+ return;
+
+ num_bytes = ft.repeat * ft.sizeof_type;
+ memcpy ((char *)at->data, (char *)b, num_bytes);
+ if (ft.byteorder != NATIVE_ORDER)
+ byteswap (ft.byteorder, (unsigned char *)at->data, ft.sizeof_type, ft.repeat);
+
+ if (-1 == SLang_push_array (at, 1))
+ return;
+
+ b += num_bytes;
+ continue;
+ }
+
+ len = ft.repeat;
+ str = SLmalloc (len + 1);
+ if (str == NULL)
+ return;
+
+ memcpy ((char *) str, (char *)b, len);
+ str [len] = 0;
+
+ if (ft.pad == ' ')
+ {
+ unsigned int new_len;
+
+ s = str + len;
+ while (s > str)
+ {
+ s--;
+ if ((*s != ' ') && (*s != 0))
+ {
+ s++;
+ break;
+ }
+ *s = 0;
+ }
+ new_len = (unsigned int) (s - str);
+
+ if (new_len != len)
+ {
+ s = SLrealloc (str, new_len + 1);
+ if (s == NULL)
+ {
+ SLfree (str);
+ return;
+ }
+ str = s;
+ len = new_len;
+ }
+ }
+
+ /* Avoid a bstring if possible */
+ s = SLmemchr (str, 0, len);
+ if (s == NULL)
+ {
+ if (-1 == SLang_push_malloced_string (str))
+ return;
+ }
+ else
+ {
+ SLang_BString_Type *new_bs;
+
+ new_bs = SLbstring_create_malloced ((unsigned char *)str, len, 1);
+ if (new_bs == NULL)
+ return;
+
+ if (-1 == SLang_push_bstring (new_bs))
+ {
+ SLfree (str);
+ return;
+ }
+ SLbstring_free (new_bs);
+ }
+
+ b += ft.repeat;
+ }
+}
+
+unsigned int _SLpack_compute_size (char *format)
+{
+ unsigned int n;
+
+ n = 0;
+ (void) compute_size_for_format (format, &n);
+ return n;
+}
+
+void _SLpack_pad_format (char *format)
+{
+ unsigned int len, max_len;
+ Format_Type ft;
+ char *buf, *b;
+
+ check_native_byte_order ();
+
+ /* Just check the syntax */
+ if (-1 == compute_size_for_format (format, &max_len))
+ return;
+
+ /* This should be sufficient to handle any needed xyy padding characters.
+ * I cannot see how this will be overrun
+ */
+ max_len = 4 * (strlen (format) + 1);
+ if (NULL == (buf = SLmalloc (max_len + 1)))
+ return;
+
+ b = buf;
+ len = 0;
+ while (1 == parse_a_format (&format, &ft))
+ {
+ struct { char a; short b; } s_h;
+ struct { char a; int b; } s_i;
+ struct { char a; long b; } s_l;
+ struct { char a; float b; } s_f;
+ struct { char a; double b; } s_d;
+ unsigned int pad;
+
+ if (ft.repeat == 0)
+ continue;
+
+ if (ft.data_type == 0)
+ { /* pad */
+ sprintf (b, "x%u", ft.repeat);
+ b += strlen (b);
+ len += ft.repeat;
+ continue;
+ }
+
+ switch (ft.data_type)
+ {
+ default:
+ case SLANG_STRING_TYPE:
+ case SLANG_BSTRING_TYPE:
+ case SLANG_CHAR_TYPE:
+ case SLANG_UCHAR_TYPE:
+ pad = 0;
+ break;
+
+ case SLANG_SHORT_TYPE:
+ case SLANG_USHORT_TYPE:
+ pad = ((unsigned int) ((char *)&s_h.b - (char *)&s_h.a));
+ break;
+
+ case SLANG_INT_TYPE:
+ case SLANG_UINT_TYPE:
+ pad = ((unsigned int) ((char *)&s_i.b - (char *)&s_i.a));
+ break;
+
+ case SLANG_LONG_TYPE:
+ case SLANG_ULONG_TYPE:
+ pad = ((unsigned int) ((char *)&s_l.b - (char *)&s_l.a));
+ break;
+
+ case SLANG_FLOAT_TYPE:
+ pad = ((unsigned int) ((char *)&s_f.b - (char *)&s_f.a));
+ break;
+
+ case SLANG_DOUBLE_TYPE:
+ pad = ((unsigned int) ((char *)&s_d.b - (char *)&s_d.a));
+ break;
+ }
+
+ /* Pad to a length that is an integer multiple of pad. */
+ if (pad)
+ pad = pad * ((len + pad - 1)/pad) - len;
+
+ if (pad)
+ {
+ sprintf (b, "x%u", pad);
+ b += strlen (b);
+ len += pad;
+ }
+
+ *b++ = ft.format_type;
+ if (ft.repeat > 1)
+ {
+ sprintf (b, "%u", ft.repeat);
+ b += strlen (b);
+ }
+
+ len += ft.repeat * ft.sizeof_type;
+ }
+ *b = 0;
+
+ (void) SLang_push_malloced_string (buf);
+}