static void delete_assoc_array (SLang_Assoc_Array_Type *a)
{
_pSLAssoc_Array_Element_Type *e, *emax;
#if SLANG_OPTIMIZE_FOR_SPEED
int is_scalar_type = a->is_scalar_type;
#endif
if (a == NULL) return;
e = a->elements;
if (e != NULL)
{
emax = e + a->table_len;
while (e < emax)
{
if ((e->key != NULL) && (e->key != Deleted_Key))
{
_pSLfree_hashed_string ((char *)e->key, strlen (e->key), e->hash);
#if SLANG_OPTIMIZE_FOR_SPEED
if ((is_scalar_type == 0) && (e->value.o_data_type != SLANG_INT_TYPE))
#endif
SLang_free_object (&e->value);
}
e++;
}
SLfree ((char *) a->elements);
}
if (a->flags & HAS_DEFAULT_VALUE)
SLang_free_object (&a->default_value);
SLfree ((char *) a);
}
_INLINE_
static _pSLAssoc_Array_Element_Type *
assoc_aput (SLang_Assoc_Array_Type *a, _pSLAssoc_Array_Element_Type *e,
SLstr_Type *str, unsigned long hash)
{
SLang_Object_Type obj;
if (-1 == SLang_pop (&obj))
return NULL;
if ((obj.o_data_type != a->type)
#if USE_NEW_ANYTYPE_CODE
&& (a->type != SLANG_ANY_TYPE)
#endif
)
{
(void) SLang_push (&obj);
if ((-1 == SLclass_typecast (a->type, 1, 0))
|| (-1 == SLang_pop (&obj)))
return NULL;
}
if (NULL == (e = store_object (a, e, str, hash, &obj)))
SLang_free_object (&obj);
return e;
}
static int pop_as_list_internal (unsigned int count)
{
SLang_List_Type *list;
if (NULL == (list = allocate_list (count)))
return -1;
while (count)
{
SLang_Object_Type obj;
if (-1 == SLang_pop (&obj))
goto return_error;
if (-1 == insert_element (list, &obj, 0))
{
SLang_free_object (&obj);
goto return_error;
}
count--;
}
return push_list (list, 1);
return_error:
free_list (list);
return -1;
}
/* joins l2 onto l1 */
static int list_join_internal (SLang_List_Type *l1, SLang_List_Type *l2)
{
Chunk_Type *chunk;
SLindex_Type num2;
chunk = l2->first;
num2 = l2->length;
while (num2 > 0)
{
SLindex_Type i, imax;
SLang_Object_Type *objs;
objs = chunk->elements;
i = 0; imax = chunk->num_elements;
while ((num2 > 0) && (i < imax))
{
SLang_Object_Type obj;
if (-1 == _pSLslang_copy_obj (objs+i, &obj))
return -1;
if (-1 == insert_element(l1, &obj, l1->length))
{
SLang_free_object (&obj);
return -1;
}
i++;
num2--;
}
chunk = chunk->next;
}
return 0;
}
static int length_cmd (void)
{
SLang_Class_Type *cl;
SLang_Object_Type obj;
VOID_STAR p;
unsigned int length;
int len;
if (-1 == SLang_pop (&obj))
return -1;
cl = _pSLclass_get_class (obj.o_data_type);
p = _pSLclass_get_ptr_to_value (cl, &obj);
len = 1;
if (cl->cl_length != NULL)
{
if (0 == (*cl->cl_length)(obj.o_data_type, p, &length))
len = (int) length;
else
len = -1;
}
SLang_free_object (&obj);
return len;
}
static _pSLAssoc_Array_Element_Type *store_object (SLang_Assoc_Array_Type *a, _pSLAssoc_Array_Element_Type *e, SLstr_Type *s, unsigned long hash, SLang_Object_Type *obj)
{
if ((e != NULL)
|| (NULL != (e = find_element (a, s, hash))))
{
#if SLANG_OPTIMIZE_FOR_SPEED
if ((a->is_scalar_type == 0) && (e->value.o_data_type != SLANG_INT_TYPE))
#endif
SLang_free_object (&e->value);
}
else
{
if ((a->num_occupied == a->resize_num)
&& (-1 == resize_table (a)))
return NULL;
if (NULL == (e = find_empty_element (a->elements, a->table_len, s, hash)))
return NULL;
if (e->key == Deleted_Key)
a->num_deleted--;
else
a->num_occupied++;
if (NULL == (e->key = _pSLstring_dup_hashed_string (s, hash)))
return NULL;
e->hash = hash;
}
e->value = *obj;
return e;
}
static int integer_pop (SLtype type, VOID_STAR ptr)
{
SLang_Object_Type obj;
int i, j;
void (*f)(VOID_STAR, VOID_STAR, unsigned int);
if (-1 == SLang_pop (&obj))
return -1;
if (0 == IS_INTEGER_TYPE(obj.o_data_type))
{
_pSLclass_type_mismatch_error (type, obj.o_data_type);
SLang_free_object (&obj);
return -1;
}
i = TYPE_TO_TABLE_INDEX(type);
j = TYPE_TO_TABLE_INDEX(obj.o_data_type);
f = (void (*)(VOID_STAR, VOID_STAR, unsigned int))
Binary_Matrix[j][i].copy_function;
(*f) (ptr, (VOID_STAR)&obj.v, 1);
return 0;
}
static void free_thrown_object (void)
{
if (Object_Thrownp != NULL)
{
SLang_free_object (Object_Thrownp);
Object_Thrownp = NULL;
}
}
static void anytype_destroy (SLtype type, VOID_STAR ptr)
{
SLang_Object_Type *obj;
(void) type;
obj = *(SLang_Object_Type **)ptr;
SLang_free_object (obj);
SLfree ((char *) obj);
}
int SLang_pop_double (double *x)
{
SLang_Object_Type obj;
if (0 != SLang_pop (&obj))
return -1;
switch (obj.o_data_type)
{
case SLANG_FLOAT_TYPE:
*x = (double) obj.v.float_val;
break;
case SLANG_DOUBLE_TYPE:
*x = obj.v.double_val;
break;
case SLANG_INT_TYPE:
*x = (double) obj.v.int_val;
break;
case SLANG_CHAR_TYPE:
*x = (double) obj.v.char_val;
break;
case SLANG_UCHAR_TYPE:
*x = (double) obj.v.uchar_val;
break;
case SLANG_SHORT_TYPE:
*x = (double) obj.v.short_val;
break;
case SLANG_USHORT_TYPE:
*x = (double) obj.v.ushort_val;
break;
case SLANG_UINT_TYPE:
*x = (double) obj.v.uint_val;
break;
case SLANG_LONG_TYPE:
*x = (double) obj.v.long_val;
break;
case SLANG_ULONG_TYPE:
*x = (double) obj.v.ulong_val;
break;
#ifdef HAVE_LONG_LONG
case SLANG_LLONG_TYPE:
*x = (double) obj.v.llong_val;
break;
case SLANG_ULLONG_TYPE:
*x = (double) obj.v.ullong_val;
break;
#endif
default:
_pSLclass_type_mismatch_error (SLANG_DOUBLE_TYPE, obj.o_data_type);
SLang_free_object (&obj);
return -1;
}
return 0;
}
static void intrin_type_info (void)
{
SLang_Object_Type obj;
if (-1 == SLang_pop (&obj))
return;
SLang_push_datatype (obj.o_data_type);
SLang_free_object (&obj);
}
void _pSLstring_intrinsic (void) /*{{{*/
{
SLang_Object_Type x;
char *s;
if (SLang_pop (&x)) return;
if (NULL != (s = _pSLstringize_object (&x)))
_pSLang_push_slstring (s);
SLang_free_object (&x);
}
static int do_obj_cmp_fun (int (*fun)(SLang_Object_Type *, SLang_Object_Type *))
{
int eqs;
SLang_Object_Type a, b;
if (-1 == SLang_pop (&b))
return -1;
if (-1 == SLang_pop (&a))
{
SLang_free_object (&b);
return -1;
}
eqs = (*fun) (&a, &b);
SLang_free_object (&a);
SLang_free_object (&b);
return eqs;
}
static int aput_object (SLang_List_Type *list, SLindex_Type indx, SLang_Object_Type *obj)
{
SLang_Object_Type *elem;
if (NULL == (elem = find_nth_element (list, indx, NULL)))
return -1;
SLang_free_object (elem);
*elem = *obj;
return 0;
}
int SLdo_pop_n (unsigned int n)
{
SLang_Object_Type x;
while (n--)
{
if (SLang_pop(&x)) return -1;
SLang_free_object (&x);
}
return 0;
}
static void assoc_delete_key (SLang_Assoc_Array_Type *a, char *key)
{
_pSLAssoc_Array_Element_Type *e;
e = find_element (a, key, _pSLstring_get_hash (key));
if (e == NULL)
return;
_pSLang_free_slstring ((char *) e->key);
SLang_free_object (&e->value);
e->key = Deleted_Key;
a->num_deleted++;
}
/* this will be called with use_current_queue set to 0 if the catch block
* was processed with no error. If an error occurs processing the catch
* block, then that error will take precedence over the one triggering the
* catch block. However, if the original error is rethrown, then this routine
* will still be called with use_current_queue non-zero since all the caller
* knows is that an error occured and cannot tell if it was a rethrow.
*/
int _pSLang_pop_error_context (int use_current_queue)
{
Error_Context_Type *e;
e = Error_Context;
if (e == NULL)
return -1;
Error_Context = e->next;
if ((use_current_queue == 0) || (e->rethrow))
{
(void) _pSLerr_set_error_queue (e->err_queue);
_pSLerr_delete_error_queue (Error_Message_Queue);
Error_Message_Queue = e->err_queue;
free_thrown_object ();
if (e->object_was_thrown)
{
Object_Thrownp = &Object_Thrown;
Object_Thrown = e->object_thrown;
}
}
else
{
_pSLerr_delete_error_queue (e->err_queue);
if (e->object_was_thrown)
SLang_free_object (&e->object_thrown);
}
if (_pSLang_Error == 0)
{
if (e->err_cleared == 0)
{
SLang_free_slstring ((char *)File_With_Error);
SLang_free_slstring ((char *)Function_With_Error);
File_With_Error = e->file; e->file = NULL;
Function_With_Error = e->function; e->function = NULL;
Linenum_With_Error = e->linenum;
(void) SLang_set_error (e->err);
}
}
if (_pSLang_Error == SL_UserBreak_Error)
SLKeyBoard_Quit = 1;
SLang_free_slstring ((char *) e->file);
SLang_free_slstring ((char *) e->function);
SLfree ((char *) e);
return 0;
}
static void delete_chunk (Chunk_Type *c)
{
unsigned int i, n;
SLang_Object_Type *objs;
if (c == NULL)
return;
n = c->num_elements;
objs = c->elements;
for (i = 0; i < n; i++)
SLang_free_object (objs+i);
SLfree ((char *) objs);
SLfree ((char *) c);
}
static void intrin_type_info1 (void)
{
SLang_Object_Type obj;
unsigned int type;
if (-1 == SLang_pop (&obj))
return;
type = obj.o_data_type;
if (type == SLANG_ARRAY_TYPE)
type = obj.v.array_val->data_type;
SLang_free_object (&obj);
SLang_push_datatype (type);
}
int SLang_list_insert (SLang_List_Type *list, int indx)
{
SLang_Object_Type obj;
if (-1 == SLang_pop (&obj))
return -1;
if (indx < 0)
indx += list->length;
if (-1 == insert_element (list, &obj, indx))
{
SLang_free_object (&obj);
return -1;
}
return 0;
}
static int pop_insert_append_args (SLang_List_Type **listp,
SLang_Object_Type *obj, int *indx)
{
if (SLang_Num_Function_Args == 3)
{
if (-1 == SLang_pop_integer (indx))
return -1;
}
if (-1 == SLang_pop (obj))
return -1;
if (-1 == pop_list (listp))
{
SLang_free_object (obj);
return -1;
}
return 0;
}
static void list_append_elem (void)
{
int indx;
SLang_Object_Type obj;
SLang_List_Type *list;
indx = -1;
if (-1 == pop_insert_append_args (&list, &obj, &indx))
return;
if (indx < 0)
indx += list->length;
if (-1 == insert_element (list, &obj, indx+1))
SLang_free_object (&obj);
free_list (list);
}
static void list_delete_elem (SLang_List_Type *list, SLindex_Type *indxp)
{
SLang_Object_Type *elem;
Chunk_Type *c;
char *src, *dest, *src_max;
SLindex_Type indx;
indx = *indxp;
if (NULL == (elem = find_nth_element (list, indx, &c)))
return;
if (indx < 0) indx += list->length; /* checked by find_nth_element */
SLang_free_object (elem);
c->num_elements--;
list->length--;
if (c->num_elements == 0)
{
if (list->first == c)
list->first = c->next;
if (list->last == c)
list->last = c->prev;
if (c->next != NULL)
c->next->prev = c->prev;
if (c->prev != NULL)
c->prev->next = c->next;
delete_chunk (c);
if (list->recent == c)
list->recent = NULL;
return;
}
src = (char *) (elem + 1);
dest = (char *) elem;
src_max = src + sizeof(SLang_Object_Type)*((c->elements+c->num_elements)-elem);
while (src < src_max)
*dest++ = *src++;
if ((list->recent != NULL) && (list->recent_num > indx))
list->recent_num--;
}
int
SLclass_typecast (SLtype to_type, int is_implicit, int allow_array)
{
SLtype from_type;
SLang_Class_Type *cl_to, *cl_from;
SLang_Object_Type obj;
VOID_STAR ap;
VOID_STAR bp;
int status;
if (-1 == SLang_pop (&obj))
return -1;
from_type = obj.o_data_type;
if (from_type == to_type)
return SLang_push (&obj);
cl_from = _pSLclass_get_class (from_type);
cl_to = _pSLclass_get_class (to_type);
/* Check for alias, e.g., int and long */
if (cl_from == cl_to)
{
obj.o_data_type = to_type;
return SLang_push (&obj);
}
/* Since the typecast functions are designed to work on arrays,
* get the pointer to the value instead of just &obj.v.
*/
ap = _pSLclass_get_ptr_to_value (cl_from, &obj);
if ((from_type == SLANG_ARRAY_TYPE)
&& (allow_array || (to_type != SLANG_ANY_TYPE)))
{
if (allow_array == 0)
goto return_error;
cl_to = _pSLclass_get_class (SLANG_ARRAY_TYPE);
bp = cl_to->cl_transfer_buf;
status = _pSLarray_typecast (from_type, ap, 1, to_type, bp, is_implicit);
}
else
{
int (*t) (SLtype, VOID_STAR, unsigned int, SLtype, VOID_STAR);
if (NULL == (t = _pSLclass_get_typecast (from_type, to_type, is_implicit)))
{
SLang_free_object (&obj);
return -1;
}
bp = cl_to->cl_transfer_buf;
status = (*t) (from_type, ap, 1, to_type, bp);
}
if (1 == status)
{
/* AnyType apush will do a reference, which is undesirable here.
* So, to avoid that, perform push instead of apush. Yes, this is
* an ugly hack.
*/
if (to_type == SLANG_ANY_TYPE)
status = (*cl_to->cl_push)(to_type, bp);
else
status = (*cl_to->cl_apush)(to_type, bp);
if (status == -1)
{
(*cl_to->cl_adestroy) (to_type, bp);
SLang_free_object (&obj);
return -1;
}
/* cl_apush will push a copy, so destry this one */
(*cl_to->cl_adestroy) (to_type, bp);
SLang_free_object (&obj);
return 0;
}
return_error:
_pSLang_verror (SL_TYPE_MISMATCH, "Unable to typecast %s to %s",
cl_from->cl_name,
SLclass_get_datatype_name (to_type));
SLang_free_object (&obj);
return -1;
}
/* FIXME: Extend this to allow an index array */
static int _pSLlist_aget (SLtype type, unsigned int num_indices)
{
SLang_List_Type *list, *new_list;
SLang_Object_Type *obj;
SLang_Array_Type *ind_at;
SLindex_Type indx, *idx_data;
SLuindex_Type i, num;
int ret;
(void) type;
if (-1 == pop_list_and_index (num_indices, &list, &ind_at, &indx))
return -1;
ret = -1;
if (ind_at == NULL)
{
obj = find_nth_element (list, indx, NULL);
if (obj != NULL)
ret = _pSLpush_slang_obj (obj);
free_list (list);
return ret;
}
num = ind_at->num_elements;
if (NULL == (new_list = allocate_list (num)))
goto free_and_return;
idx_data = (SLindex_Type *)ind_at->data;
for (i = 0; i < num; i++)
{
SLang_Object_Type *obja;
SLang_Object_Type objb;
indx = idx_data[i];
if (NULL == (obja = find_nth_element (list, idx_data[i], NULL)))
goto free_and_return;
if (-1 == _pSLslang_copy_obj (obja, &objb))
goto free_and_return;
if (-1 == insert_element (new_list, &objb, i))
{
SLang_free_object (&objb);
goto free_and_return;
}
}
ret = push_list (new_list, 1); /* frees upon error */
new_list = NULL;
free_and_return:
if (new_list != NULL)
free_list (new_list);
free_list (list);
SLang_free_array (ind_at);
return ret;
}
static int _pSLlist_aput (SLtype type, unsigned int num_indices)
{
SLang_List_Type *list;
SLang_Object_Type obj;
SLang_Array_Type *ind_at;
SLindex_Type indx, *idx_data;
SLuindex_Type i, num;
int ret;
(void) type;
if (-1 == pop_list_and_index (num_indices, &list, &ind_at, &indx))
return -1;
if (ind_at == NULL)
{
if (-1 == SLang_pop (&obj))
{
free_list (list);
return -1;
}
if (-1 == aput_object (list, indx, &obj))
{
SLang_free_object (&obj);
free_list (list);
return -1;
}
free_list (list);
return 0;
}
idx_data = (SLindex_Type *)ind_at->data;
num = ind_at->num_elements;
if (-1 == SLang_pop (&obj))
{
free_list (list);
SLang_free_array (ind_at);
return -1;
}
ret = -1;
if (obj.o_data_type == SLANG_ARRAY_TYPE)
{
SLang_Array_Type *at = obj.v.array_val;
if ((at->num_elements != num) || (at->num_dims != 1))
{
SLang_verror (SL_Index_Error, "Inappropriate array for list[indices]=array expression");
goto free_and_return;
}
for (i = 0; i < num; i++)
{
SLang_Object_Type objb;
indx = idx_data[i];
if ((-1 == _pSLarray1d_push_elem (at, i))
|| (-1 == SLang_pop (&objb)))
goto free_and_return;
if (-1 == aput_object (list, indx, &objb))
{
SLang_free_object (&objb);
goto free_and_return;
}
}
ret = 0;
goto free_and_return;
}
if (obj.o_data_type == SLANG_LIST_TYPE)
{
SLang_List_Type *list2;
if (NULL == (list2 = (SLang_List_Type *)obj.v.ptr_val))
goto free_and_return;
if (list2->length != (SLindex_Type)num)
{
SLang_verror (SL_Index_Error, "Inappropriate list2 size for list[indices]=list2 expression");
goto free_and_return;
}
for (i = 0; i < num; i++)
{
SLang_Object_Type *obja;
SLang_Object_Type objb;
indx = idx_data[i];
if (NULL == (obja = find_nth_element (list, idx_data[i], NULL)))
goto free_and_return;
if (-1 == _pSLslang_copy_obj (obja, &objb))
goto free_and_return;
if (-1 == aput_object (list, indx, &objb))
{
SLang_free_object (&objb);
goto free_and_return;
}
}
ret = 0;
goto free_and_return;
}
for (i = 0; i < num; i++)
{
SLang_Object_Type objb;
indx = idx_data[i];
if (-1 == _pSLslang_copy_obj (&obj, &objb))
goto free_and_return;
if (-1 == aput_object (list, indx, &objb))
{
SLang_free_object (&objb);
goto free_and_return;
}
}
ret = 0;
/* drop */
free_and_return:
SLang_free_object (&obj);
SLang_free_array (ind_at);
free_list (list);
return ret;
}
/* 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;
}
