void _pSLpack (void)
{
SLang_BString_Type *bs;
char *fmt;
int nitems;
check_native_byte_order ();
nitems = SLang_Num_Function_Args;
if (nitems <= 0)
{
_pSLang_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);
}
static int assoc_anew (SLtype type, unsigned int num_dims)
{
SLang_MMT_Type *mmt;
SLang_Assoc_Array_Type *a;
int has_default_value;
has_default_value = 0;
switch (num_dims)
{
case 0:
type = SLANG_ANY_TYPE;
break;
case 2:
(void) SLreverse_stack (2);
has_default_value = 1;
/* drop */
case 1:
if (0 == SLang_pop_datatype (&type))
break;
num_dims--;
/* drop */
default:
SLdo_pop_n (num_dims);
_pSLang_verror (SL_SYNTAX_ERROR, "Usage: Assoc_Type [DataType_Type]");
return -1;
}
a = alloc_assoc_array (type, has_default_value);
if (a == NULL)
return -1;
if (NULL == (mmt = SLang_create_mmt (SLANG_ASSOC_TYPE, (VOID_STAR) a)))
{
delete_assoc_array (a);
return -1;
}
if (-1 == SLang_push_mmt (mmt))
{
SLang_free_mmt (mmt);
return -1;
}
return 0;
}
static void intrin_reverse_stack (int *n)
{
SLreverse_stack (*n);
}
/* Usage: get/setsockopt (socket, level, optname, value) */
static void getset_sockopt (int set)
{
Socket_Type *s;
SLFile_FD_Type *f;
int level, optname;
SockOpt_Type *table;
if (-1 == SLreverse_stack (SLang_Num_Function_Args))
return;
if (NULL == (s = pop_socket (&f)))
return;
if ((-1 == SLang_pop_int (&level))
|| (-1 == SLang_pop_int (&optname)))
{
SLfile_free_fd (f);
return;
}
switch (level)
{
#ifdef SOL_SOCKET
case SOL_SOCKET: table = SO_Option_Table; break;
#endif
#ifdef SOL_IP
case SOL_IP: table = IP_Option_Table; break;
#endif
default:
SLang_verror (SL_NotImplemented_Error, "get/setsockopt level %d is not supported", level);
goto free_return;
}
while (1)
{
if (table->optname == optname)
{
int (*func)(Socket_Type *, int, int);
if (set)
func = table->setopt;
else
func = table->getopt;
if (func == NULL)
goto not_implemented_error;
(void)(*func)(s, level, optname);
break;
}
if (table->optname == -1)
goto free_return;
table++;
}
/* drop */
free_return:
SLfile_free_fd (f);
return;
not_implemented_error:
SLang_verror (SL_NotImplemented_Error, "get/setsockopt option %d is not supported at level %d", optname, level);
SLfile_free_fd (f);
}
/* FIXME: This function does not handle LONG_LONG */
int _pSLang_sscanf (void)
{
int num;
unsigned int num_refs;
char *format;
char *input_string, *input_string_max;
SLFUTURE_CONST char *f, *s;
unsigned char map8[256], map10[256], map16[256];
if (SLang_Num_Function_Args < 2)
{
_pSLang_verror (SL_INVALID_PARM, "Int_Type sscanf (str, format, ...)");
return -1;
}
num_refs = (unsigned int) SLang_Num_Function_Args;
if (-1 == SLreverse_stack (num_refs))
return -1;
num_refs -= 2;
if (-1 == SLang_pop_slstring (&input_string))
return -1;
if (-1 == SLang_pop_slstring (&format))
{
SLang_free_slstring (input_string);
return -1;
}
f = format;
s = input_string;
input_string_max = input_string + strlen (input_string);
init_map (map8, 8);
init_map (map10, 10);
init_map (map16, 16);
num = 0;
while (num_refs != 0)
{
SLang_Object_Type obj;
SLang_Ref_Type *ref;
SLFUTURE_CONST char *smax;
unsigned char *map;
int base;
int no_assign;
int is_short;
int is_long;
int status;
char chf;
unsigned int width;
int has_width;
chf = *f++;
if (chf == 0)
{
/* Hmmm.... what is the most useful thing to do?? */
#if 1
break;
#else
_pSLang_verror (SL_INVALID_PARM, "sscanf: format not big enough for output list");
goto return_error;
#endif
}
if (isspace (chf))
{
char *s1 = _pSLskip_whitespace (s);
if (s1 == s)
break;
s = s1;
continue;
}
if ((chf != '%')
|| ((chf = *f++) == '%'))
{
if (*s != chf)
break;
s++;
continue;
}
no_assign = 0;
is_short = 0;
is_long = 0;
width = 0;
smax = input_string_max;
/* Look for the flag character */
if (chf == '*')
{
no_assign = 1;
chf = *f++;
}
/* Width */
has_width = isdigit (chf);
if (has_width)
{
f--;
(void) parse_uint (&f, f + strlen(f), &width, 10, map10);
chf = *f++;
}
/* Now the type modifier */
switch (chf)
{
case 'h':
is_short = 1;
chf = *f++;
break;
case 'L': /* not implemented */
case 'l':
is_long = 1;
chf = *f++;
break;
}
status = -1;
if ((chf != 'c') && (chf != '['))
{
s = _pSLskip_whitespace (s);
if (*s == 0)
break;
}
if (has_width)
{
if (width > (unsigned int) (input_string_max - s))
width = (unsigned int) (input_string_max - s);
smax = s + width;
}
/* Now the format descriptor */
map = map10;
base = 10;
try_again: /* used by i, x, and o, conversions */
switch (chf)
{
case 0:
_pSLang_verror (SL_INVALID_PARM, "sscanf: Unexpected end of format");
goto return_error;
case 'D':
is_long = 1;
case 'd':
if (is_short)
{
obj.o_data_type = SLANG_SHORT_TYPE;
status = parse_short (&s, smax, &obj.v.short_val, base, map);
}
else if (is_long)
{
obj.o_data_type = SLANG_LONG_TYPE;
status = parse_long (&s, smax, &obj.v.long_val, base, map);
}
else
{
obj.o_data_type = SLANG_INT_TYPE;
status = parse_int (&s, smax, &obj.v.int_val, base, map);
}
break;
case 'U':
is_long = 1;
case 'u':
if (is_short)
{
obj.o_data_type = SLANG_USHORT_TYPE;
status = parse_ushort (&s, smax, &obj.v.ushort_val, base, map);
}
else if (is_long)
{
obj.o_data_type = SLANG_ULONG_TYPE;
status = parse_ulong (&s, smax, &obj.v.ulong_val, base, map);
}
else
{
obj.o_data_type = SLANG_INT_TYPE;
status = parse_uint (&s, smax, &obj.v.uint_val, base, map);
}
break;
case 'I':
is_long = 1;
case 'i':
if ((s + 1 >= smax)
|| (*s != 0))
chf = 'd';
else if (((s[1] == 'x') || (s[1] == 'X'))
&& (s + 2 < smax))
{
s += 2;
chf = 'x';
}
else chf = 'o';
goto try_again;
case 'O':
is_long = 1;
case 'o':
map = map8;
base = 8;
chf = 'd';
goto try_again;
case 'X':
is_long = 1;
case 'x':
base = 16;
map = map16;
chf = 'd';
goto try_again;
case 'E':
case 'F':
is_long = 1;
case 'e':
case 'f':
case 'g':
#if SLANG_HAS_FLOAT
if (is_long)
{
obj.o_data_type = SLANG_DOUBLE_TYPE;
status = parse_double (&s, smax, &obj.v.double_val);
}
else
{
obj.o_data_type = SLANG_FLOAT_TYPE;
status = parse_float (&s, smax, &obj.v.float_val);
}
#else
_pSLang_verror (SL_NOT_IMPLEMENTED,
"This version of the S-Lang does not support floating point");
status = -1;
#endif
break;
case 's':
obj.o_data_type = SLANG_STRING_TYPE;
status = parse_string (&s, smax, &obj.v.s_val);
break;
case 'c':
if (has_width == 0)
{
obj.o_data_type = SLANG_UCHAR_TYPE;
obj.v.uchar_val = *s++;
status = 1;
break;
}
obj.o_data_type = SLANG_STRING_TYPE;
status = parse_bstring (&s, smax, &obj.v.s_val);
break;
case '[':
obj.o_data_type = SLANG_STRING_TYPE;
status = parse_range (&s, smax, &f, &obj.v.s_val);
break;
case 'n':
obj.o_data_type = SLANG_UINT_TYPE;
obj.v.uint_val = (unsigned int) (s - input_string);
status = 1;
break;
default:
status = -1;
_pSLang_verror (SL_NOT_IMPLEMENTED, "format specifier '%c' is not supported", chf);
break;
}
if (status == 0)
break;
if (status == -1)
goto return_error;
if (no_assign)
{
SLang_free_object (&obj);
continue;
}
if (-1 == SLang_pop_ref (&ref))
{
SLang_free_object (&obj);
goto return_error;
}
if (-1 == SLang_push (&obj))
{
SLang_free_object (&obj);
SLang_free_ref (ref);
goto return_error;
}
if (-1 == _pSLang_deref_assign (ref))
{
SLang_free_ref (ref);
goto return_error;
}
SLang_free_ref (ref);
num++;
num_refs--;
}
if (-1 == SLdo_pop_n (num_refs))
goto return_error;
SLang_free_slstring (format);
SLang_free_slstring (input_string);
return num;
return_error:
/* NULLS ok */
SLang_free_slstring (format);
SLang_free_slstring (input_string);
return -1;
}
