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, 0 insertions, 785 deletions
diff --git a/mdk-stage1/slang/slpack.c b/mdk-stage1/slang/slpack.c
deleted file mode 100644
index 53ef63643..000000000
--- a/mdk-stage1/slang/slpack.c
+++ /dev/null
@@ -1,785 +0,0 @@
-/* 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);
-}
generated by cgit v1.2.1 (git 2.21.0) at 2025-10-31 00:35:12 +0000