_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; }
/* Double */ static int double_push (SLtype type, VOID_STAR ptr) { #if SLANG_OPTIMIZE_FOR_SPEED SLang_Object_Type obj; obj.o_data_type = type; obj.v.double_val = *(double *)ptr; return SLang_push (&obj); #else return SLclass_push_double_obj (type, *(double *) ptr); #endif }
static int cl_foreach (SLtype type, SLang_Foreach_Context_Type *c) { SLang_Assoc_Array_Type *a; _pSLAssoc_Array_Element_Type *e, *emax; (void) type; if (c == NULL) return -1; a = c->a; e = a->elements + c->next_hash_index; emax = a->elements + a->table_len; while (1) { if (e == emax) return 0; if ((e->key != NULL) && (e->key != Deleted_Key)) break; e++; } c->next_hash_index = (e - a->elements) + 1; if ((c->flags & CTX_WRITE_KEYS) && (-1 == SLang_push_string (e->key))) return -1; if (c->flags & CTX_WRITE_VALUES) { #if SLANG_OPTIMIZE_FOR_SPEED if (c->is_scalar) { if (-1 == SLang_push (&e->value)) return -1; } else #endif if (-1 == _pSLpush_slang_obj (&e->value)) return -1; } /* keep going */ return 1; }
static int integer_push (SLtype type, VOID_STAR ptr) { SLang_Object_Type obj; int i; void (*f)(VOID_STAR, VOID_STAR, unsigned int); i = TYPE_TO_TABLE_INDEX(type); f = (void (*)(VOID_STAR, VOID_STAR, unsigned int)) Binary_Matrix[i][i].copy_function; obj.o_data_type = type; (*f) ((VOID_STAR)&obj.v, ptr, 1); return SLang_push (&obj); }
int _pSLassoc_aget (SLtype type, unsigned int num_indices) { unsigned long hash; SLang_MMT_Type *mmt; SLstr_Type *str; _pSLAssoc_Array_Element_Type *e; SLang_Assoc_Array_Type *a; SLang_Object_Type *obj; int ret; (void) type; if (-1 == pop_index (num_indices, &mmt, &a, &str, &hash)) return -1; e = find_element (a, str, hash); if (e == NULL) { if (a->flags & HAS_DEFAULT_VALUE) obj = &a->default_value; else { ret = -1; _pSLang_verror (SL_INTRINSIC_ERROR, "No such element in Assoc Array: %s", str); goto free_and_return; } } else obj = &e->value; #if SLANG_OPTIMIZE_FOR_SPEED if (a->is_scalar_type) ret = SLang_push (obj); else #endif ret = _pSLpush_slang_obj (obj); free_and_return: _pSLang_free_slstring (str); SLang_free_mmt (mmt); 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; }
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; }