summaryrefslogtreecommitdiffstats
path: root/mdk-stage1/slang/slassoc.c
diff options
context:
space:
mode:
authorMystery Man <unknown@mandriva.org>2002-07-08 07:45:08 +0000
committerMystery Man <unknown@mandriva.org>2002-07-08 07:45:08 +0000
commitbe128d0615965c467107adeb2c8cecd1125318a1 (patch)
tree998f5b6803ad85a1411491ef4c499fa8b9760bb2 /mdk-stage1/slang/slassoc.c
parent9555bb791920e8feace953f90cf908e864451b59 (diff)
downloaddrakx-be128d0615965c467107adeb2c8cecd1125318a1.tar
drakx-be128d0615965c467107adeb2c8cecd1125318a1.tar.gz
drakx-be128d0615965c467107adeb2c8cecd1125318a1.tar.bz2
drakx-be128d0615965c467107adeb2c8cecd1125318a1.tar.xz
drakx-be128d0615965c467107adeb2c8cecd1125318a1.zip
This commit was manufactured by cvs2svn to create tag 'V1_1_8_2mdk'.V1_1_8_2mdk
Diffstat (limited to 'mdk-stage1/slang/slassoc.c')
-rw-r--r--mdk-stage1/slang/slassoc.c713
1 files changed, 0 insertions, 713 deletions
diff --git a/mdk-stage1/slang/slassoc.c b/mdk-stage1/slang/slassoc.c
deleted file mode 100644
index 5997458d2..000000000
--- a/mdk-stage1/slang/slassoc.c
+++ /dev/null
@@ -1,713 +0,0 @@
-/* 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"
-
-#define SL_APP_WANTS_FOREACH
-#include "slang.h"
-#include "_slang.h"
-
-#define USE_NEW_ANYTYPE_CODE 1
-
-typedef struct _SLAssoc_Array_Element_Type
-{
- char *key; /* slstring */
- struct _SLAssoc_Array_Element_Type *next;
- SLang_Object_Type value;
-}
-_SLAssoc_Array_Element_Type;
-
-typedef struct
-{
- _SLAssoc_Array_Element_Type *elements[SLASSOC_HASH_TABLE_SIZE];
- SLang_Object_Type default_value;
- unsigned int num_elements;
-#define HAS_DEFAULT_VALUE 1
- unsigned int flags;
- unsigned char type;
-}
-SLang_Assoc_Array_Type;
-
-#define USE_CACHED_STRING 1
-
-#if USE_CACHED_STRING
-static char *Cached_String;
-static SLang_Object_Type *Cached_Obj;
-static SLang_Assoc_Array_Type *Cached_Array;
-#endif
-
-static SLang_Assoc_Array_Type *alloc_assoc_array (unsigned char type, int has_default_value)
-{
- SLang_Assoc_Array_Type *a;
-
- a = (SLang_Assoc_Array_Type *)SLmalloc (sizeof (SLang_Assoc_Array_Type));
- if (a == NULL)
- {
- if (has_default_value)
- SLdo_pop_n (1);
- return NULL;
- }
-
- memset ((char *) a, 0, sizeof (SLang_Assoc_Array_Type));
- a->type = type;
-
- if (has_default_value)
- {
- if (
-#if USE_NEW_ANYTYPE_CODE
- ((type != SLANG_ANY_TYPE) && (-1 == SLclass_typecast (type, 1, 1)))
-#else
- (-1 == SLclass_typecast (type, 1, 1))
-#endif
- || (-1 == SLang_pop (&a->default_value)))
- {
- SLfree ((char *) a);
- return NULL;
- }
-
- a->flags |= HAS_DEFAULT_VALUE;
- }
- return a;
-}
-
-static void free_element (_SLAssoc_Array_Element_Type *e)
-{
- if (e == NULL)
- return;
-
- SLang_free_object (&e->value);
- SLang_free_slstring (e->key);
-#if USE_CACHED_STRING
- if (e->key == Cached_String)
- Cached_String = NULL;
-#endif
- SLfree ((char *)e);
-}
-
-static void delete_assoc_array (SLang_Assoc_Array_Type *a)
-{
- unsigned int i;
-
- if (a == NULL) return;
-
- for (i = 0; i < SLASSOC_HASH_TABLE_SIZE; i++)
- {
- _SLAssoc_Array_Element_Type *e;
-
- e = a->elements[i];
- while (e != NULL)
- {
- _SLAssoc_Array_Element_Type *next_e;
-
- next_e = e->next;
- free_element (e);
- e = next_e;
- }
- }
- if (a->flags & HAS_DEFAULT_VALUE)
- SLang_free_object (&a->default_value);
-
- SLfree ((char *) a);
-}
-
-_INLINE_
-static SLang_Object_Type *
-find_element (SLang_Assoc_Array_Type *a, char *str, unsigned long hash)
-{
- unsigned int h;
- _SLAssoc_Array_Element_Type *e;
-
- h = (unsigned int) (hash % SLASSOC_HASH_TABLE_SIZE);
- e = a->elements[h];
-
- while (e != NULL)
- {
- if (str == e->key) /* slstrings can be compared this way */
- {
-#if USE_CACHED_STRING
- Cached_String = str;
- Cached_Obj = &e->value;
- Cached_Array = a;
-#endif
- return &e->value;
- }
-
- e = e->next;
- }
-
- return NULL;
-}
-
-static _SLAssoc_Array_Element_Type *
-create_element (SLang_Assoc_Array_Type *a, char *str, unsigned long hash)
-{
- unsigned int h;
- _SLAssoc_Array_Element_Type *e;
-
- e = (_SLAssoc_Array_Element_Type *) SLmalloc (sizeof (_SLAssoc_Array_Element_Type));
- if (e == NULL)
- return NULL;
-
- memset ((char *) e, 0, sizeof (_SLAssoc_Array_Element_Type));
- h = (unsigned int) (hash % SLASSOC_HASH_TABLE_SIZE);
-
- if (NULL == (str = _SLstring_dup_hashed_string (str, hash)))
- {
- SLfree ((char *) e);
- return NULL;
- }
-
- e->key = str;
- e->next = a->elements[h];
- a->elements[h] = e;
-
- a->num_elements += 1;
-#if USE_CACHED_STRING
- Cached_String = str;
- Cached_Obj = &e->value;
- Cached_Array = a;
-#endif
- return e;
-}
-
-static int store_object (SLang_Assoc_Array_Type *a, char *s, SLang_Object_Type *obj)
-{
- unsigned long hash;
- SLang_Object_Type *v;
-
-#if USE_CACHED_STRING
- if ((s == Cached_String) && (a == Cached_Array))
- {
- v = Cached_Obj;
- SLang_free_object (v);
- }
- else
- {
-#endif
- hash = _SLcompute_string_hash (s);
- if (NULL != (v = find_element (a, s, hash)))
- SLang_free_object (v);
- else
- {
- _SLAssoc_Array_Element_Type *e;
-
- e = create_element (a, s, hash);
- if (e == NULL)
- return -1;
-
- v = &e->value;
- }
-#if USE_CACHED_STRING
- }
-#endif
-
- *v = *obj;
-
- return 0;
-}
-
-static void assoc_destroy (unsigned char type, VOID_STAR ptr)
-{
- (void) type;
- delete_assoc_array ((SLang_Assoc_Array_Type *) ptr);
-}
-
-static int pop_index (unsigned int num_indices,
- SLang_MMT_Type **mmt,
- SLang_Assoc_Array_Type **a,
- char **str)
-{
- if (NULL == (*mmt = SLang_pop_mmt (SLANG_ASSOC_TYPE)))
- {
- *a = NULL;
- *str = NULL;
- return -1;
- }
-
- if ((num_indices != 1)
- || (-1 == SLang_pop_slstring (str)))
- {
- SLang_verror (SL_NOT_IMPLEMENTED,
- "Assoc_Type arrays require a single string index");
- SLang_free_mmt (*mmt);
- *mmt = NULL;
- *a = NULL;
- *str = NULL;
- return -1;
- }
-
- *a = (SLang_Assoc_Array_Type *) SLang_object_from_mmt (*mmt);
- return 0;
-}
-
-static int assoc_aget (unsigned char type, unsigned int num_indices)
-{
- SLang_MMT_Type *mmt;
- char *str;
- SLang_Assoc_Array_Type *a;
- SLang_Object_Type *obj;
- int ret;
-
- (void) type;
-
- if (-1 == pop_index (num_indices, &mmt, &a, &str))
- return -1;
-
-#if USE_CACHED_STRING
- if ((str == Cached_String) && (a == Cached_Array))
- obj = Cached_Obj;
- else
-#endif
- obj = find_element (a, str, _SLcompute_string_hash (str));
-
- if ((obj == NULL)
- && (a->flags & HAS_DEFAULT_VALUE))
- obj = &a->default_value;
-
- if (obj == NULL)
- {
- SLang_verror (SL_INTRINSIC_ERROR,
- "No such element in Assoc Array: %s", str);
- ret = -1;
- }
- else
- {
-#if _SLANG_OPTIMIZE_FOR_SPEED
- if (SLANG_CLASS_TYPE_SCALAR == _SLclass_Class_Type[obj->data_type])
- ret = SLang_push (obj);
-#endif
- else
- ret = _SLpush_slang_obj (obj);
- }
-
- SLang_free_slstring (str);
- SLang_free_mmt (mmt);
- return ret;
-}
-
-static int assoc_aput (unsigned char type, unsigned int num_indices)
-{
- SLang_MMT_Type *mmt;
- char *str;
- SLang_Assoc_Array_Type *a;
- SLang_Object_Type obj;
- int ret;
-
- (void) type;
-
- if (-1 == pop_index (num_indices, &mmt, &a, &str))
- return -1;
-
- ret = -1;
-
- if (0 == SLang_pop (&obj))
- {
- if ((obj.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, 1))
- || (-1 == SLang_pop (&obj)))
- goto the_return;
- }
-
- if (-1 == store_object (a, str, &obj))
- SLang_free_object (&obj);
- else
- ret = 0;
- }
-
- the_return:
- SLang_free_slstring (str);
- SLang_free_mmt (mmt);
- return ret;
-}
-
-static int assoc_anew (unsigned char 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);
- SLang_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 assoc_get_keys (SLang_Assoc_Array_Type *a)
-{
- SLang_Array_Type *at;
- int num;
- unsigned int i, j;
- char **data;
-
- /* Note: If support for threads is added, then we need to modify this
- * algorithm to prevent another thread from modifying the array.
- * However, that should be handled in inner_interp.
- */
- num = a->num_elements;
-
- if (NULL == (at = SLang_create_array (SLANG_STRING_TYPE, 0, NULL, &num, 1)))
- return;
-
- data = (char **)at->data;
-
- i = 0;
- for (j = 0; j < SLASSOC_HASH_TABLE_SIZE; j++)
- {
- _SLAssoc_Array_Element_Type *e;
-
- e = a->elements[j];
- while (e != NULL)
- {
- /* Next cannot fail because it is an slstring */
- data [i] = SLang_create_slstring (e->key);
- e = e->next;
- i++;
- }
- }
- (void) SLang_push_array (at, 1);
-}
-
-static int
-transfer_element (SLang_Class_Type *cl, VOID_STAR dest_data,
- SLang_Object_Type *obj)
-{
- unsigned int sizeof_type;
- VOID_STAR src_data;
-
-#if USE_NEW_ANYTYPE_CODE
- if (cl->cl_data_type == SLANG_ANY_TYPE)
- {
- SLang_Any_Type *any;
-
- if ((-1 == _SLpush_slang_obj (obj))
- || (-1 == SLang_pop_anytype (&any)))
- return -1;
-
- *(SLang_Any_Type **)dest_data = any;
- return 0;
- }
-#endif
- /* Optimize for scalar */
- if (cl->cl_class_type == SLANG_CLASS_TYPE_SCALAR)
- {
- sizeof_type = cl->cl_sizeof_type;
- memcpy ((char *) dest_data, (char *)&obj->v, sizeof_type);
- return 0;
- }
-
- src_data = _SLclass_get_ptr_to_value (cl, obj);
-
- if (-1 == (*cl->cl_acopy) (cl->cl_data_type, src_data, dest_data))
- return -1;
-
- return 0;
-}
-
-static void assoc_get_values (SLang_Assoc_Array_Type *a)
-{
- SLang_Array_Type *at;
- int num;
- unsigned int i, j;
- char *dest_data;
- unsigned char type;
- SLang_Class_Type *cl;
- unsigned int sizeof_type;
-
- /* Note: If support for threads is added, then we need to modify this
- * algorithm to prevent another thread from modifying the array.
- * However, that should be handled in inner_interp.
- */
- num = a->num_elements;
- type = a->type;
-
- cl = _SLclass_get_class (type);
- sizeof_type = cl->cl_sizeof_type;
-
- if (NULL == (at = SLang_create_array (type, 0, NULL, &num, 1)))
- return;
-
- dest_data = (char *)at->data;
-
- i = 0;
- for (j = 0; j < SLASSOC_HASH_TABLE_SIZE; j++)
- {
- _SLAssoc_Array_Element_Type *e;
-
- e = a->elements[j];
- while (e != NULL)
- {
- if (-1 == transfer_element (cl, (VOID_STAR) dest_data, &e->value))
- {
- SLang_free_array (at);
- return;
- }
-
- dest_data += sizeof_type;
- e = e->next;
- i++;
- }
- }
- (void) SLang_push_array (at, 1);
-}
-
-static int assoc_key_exists (SLang_Assoc_Array_Type *a, char *key)
-{
- return (NULL != find_element (a, key, _SLcompute_string_hash (key)));
-}
-
-static void assoc_delete_key (SLang_Assoc_Array_Type *a, char *key)
-{
- unsigned int h;
- _SLAssoc_Array_Element_Type *v, *v0;
-
- h = (unsigned int) (_SLcompute_string_hash (key) % SLASSOC_HASH_TABLE_SIZE);
-
- v0 = NULL;
- v = a->elements[h];
- while (v != NULL)
- {
- if (v->key == key)
- {
- if (v0 != NULL)
- v0->next = v->next;
- else
- a->elements[h] = v->next;
-
- free_element (v);
- a->num_elements -= 1;
- return;
- }
- v0 = v;
- v = v->next;
- }
-
- /* No such element. Let it pass with no error. */
-}
-
-#define A SLANG_ASSOC_TYPE
-#define S SLANG_STRING_TYPE
-static SLang_Intrin_Fun_Type Assoc_Table [] =
-{
- MAKE_INTRINSIC_1("assoc_get_keys", assoc_get_keys, SLANG_VOID_TYPE, A),
- MAKE_INTRINSIC_1("assoc_get_values", assoc_get_values, SLANG_VOID_TYPE, A),
- MAKE_INTRINSIC_2("assoc_key_exists", assoc_key_exists, SLANG_INT_TYPE, A, S),
- MAKE_INTRINSIC_2("assoc_delete_key", assoc_delete_key, SLANG_VOID_TYPE, A, S),
-
- SLANG_END_INTRIN_FUN_TABLE
-};
-#undef A
-#undef S
-
-static int assoc_length (unsigned char type, VOID_STAR v, unsigned int *len)
-{
- SLang_Assoc_Array_Type *a;
-
- (void) type;
- a = (SLang_Assoc_Array_Type *) SLang_object_from_mmt (*(SLang_MMT_Type **)v);
- *len = a->num_elements;
- return 0;
-}
-
-struct _SLang_Foreach_Context_Type
-{
- SLang_MMT_Type *mmt;
- SLang_Assoc_Array_Type *a;
- unsigned int this_hash_index;
- unsigned int next_same_hash_index;
-#define CTX_WRITE_KEYS 1
-#define CTX_WRITE_VALUES 2
- unsigned char flags;
-};
-
-static SLang_Foreach_Context_Type *
-cl_foreach_open (unsigned char type, unsigned int num)
-{
- SLang_Foreach_Context_Type *c;
- unsigned char flags;
- SLang_MMT_Type *mmt;
-
- (void) type;
-
- if (NULL == (mmt = SLang_pop_mmt (SLANG_ASSOC_TYPE)))
- return NULL;
-
- flags = 0;
-
- while (num--)
- {
- char *s;
-
- if (-1 == SLang_pop_slstring (&s))
- {
- SLang_free_mmt (mmt);
- return NULL;
- }
-
- if (0 == strcmp (s, "keys"))
- flags |= CTX_WRITE_KEYS;
- else if (0 == strcmp (s, "values"))
- flags |= CTX_WRITE_VALUES;
- else
- {
- SLang_verror (SL_NOT_IMPLEMENTED,
- "using '%s' not supported by SLassoc_Type",
- s);
- SLang_free_slstring (s);
- SLang_free_mmt (mmt);
- return NULL;
- }
-
- SLang_free_slstring (s);
- }
-
- if (NULL == (c = (SLang_Foreach_Context_Type *) SLmalloc (sizeof (SLang_Foreach_Context_Type))))
- {
- SLang_free_mmt (mmt);
- return NULL;
- }
-
- memset ((char *) c, 0, sizeof (SLang_Foreach_Context_Type));
-
- if (flags == 0) flags = CTX_WRITE_VALUES|CTX_WRITE_KEYS;
-
- c->flags = flags;
- c->mmt = mmt;
- c->a = (SLang_Assoc_Array_Type *) SLang_object_from_mmt (mmt);
-
- return c;
-}
-
-static void cl_foreach_close (unsigned char type, SLang_Foreach_Context_Type *c)
-{
- (void) type;
- if (c == NULL) return;
- SLang_free_mmt (c->mmt);
- SLfree ((char *) c);
-}
-
-static int cl_foreach (unsigned char type, SLang_Foreach_Context_Type *c)
-{
- SLang_Assoc_Array_Type *a;
- _SLAssoc_Array_Element_Type *e;
- unsigned int i, j;
-
- (void) type;
-
- if (c == NULL)
- return -1;
-
- a = c->a;
-
- i = c->this_hash_index;
- if (i >= SLASSOC_HASH_TABLE_SIZE)
- return 0;
-
- e = a->elements[i];
-
- j = c->next_same_hash_index;
- c->next_same_hash_index = j + 1;
-
- while ((j > 0) && (e != NULL))
- {
- j--;
- e = e->next;
- }
-
- if (e == NULL)
- {
- do
- {
- i++;
- if (i >= SLASSOC_HASH_TABLE_SIZE)
- return 0; /* no more */
- }
- while (a->elements [i] == NULL);
-
- e = a->elements[i];
- c->this_hash_index = i;
- c->next_same_hash_index = 1;
- }
-
- if ((c->flags & CTX_WRITE_KEYS)
- && (-1 == SLang_push_string (e->key)))
- return -1;
-
- if ((c->flags & CTX_WRITE_VALUES)
- && (-1 == _SLpush_slang_obj (&e->value)))
- return -1;
-
- /* keep going */
- return 1;
-}
-
-int SLang_init_slassoc (void)
-{
- SLang_Class_Type *cl;
-
- if (SLclass_is_class_defined (SLANG_ASSOC_TYPE))
- return 0;
-
- if (NULL == (cl = SLclass_allocate_class ("Assoc_Type")))
- return -1;
-
- (void) SLclass_set_destroy_function (cl, assoc_destroy);
- (void) SLclass_set_aput_function (cl, assoc_aput);
- (void) SLclass_set_aget_function (cl, assoc_aget);
- (void) SLclass_set_anew_function (cl, assoc_anew);
- cl->cl_length = assoc_length;
- cl->cl_foreach_open = cl_foreach_open;
- cl->cl_foreach_close = cl_foreach_close;
- cl->cl_foreach = cl_foreach;
-
- if (-1 == SLclass_register_class (cl, SLANG_ASSOC_TYPE, sizeof (SLang_Assoc_Array_Type), SLANG_CLASS_TYPE_MMT))
- return -1;
-
- if (-1 == SLadd_intrin_fun_table (Assoc_Table, "__SLASSOC__"))
- return -1;
-
- return 0;
-}
-