This commit was manufactured by cvs2svn to create tag 'V9_1_17mdk'.V9_1_17mdk

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);
-}