diff options
Diffstat (limited to 'mdk-stage1/slang/slistruc.c')
| -rw-r--r-- | mdk-stage1/slang/slistruc.c | 218 |
1 files changed, 0 insertions, 218 deletions
diff --git a/mdk-stage1/slang/slistruc.c b/mdk-stage1/slang/slistruc.c deleted file mode 100644 index 06b8fd6ff..000000000 --- a/mdk-stage1/slang/slistruc.c +++ /dev/null @@ -1,218 +0,0 @@ -/* Intrinsic Structure type implementation */ -/* 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 "slang.h" -#include "_slang.h" - -/* Intrinsic structures */ - -typedef struct -{ - char *name; - VOID_STAR addr; - SLang_IStruct_Field_Type *fields; -} -_SLang_IStruct_Type; - -static SLang_IStruct_Field_Type *istruct_pop_field (char *name, int no_readonly, VOID_STAR *addr) -{ - _SLang_IStruct_Type *s; - SLang_IStruct_Field_Type *f; - char *struct_addr; - - /* Note: There is no need to free this object */ - if (-1 == SLclass_pop_ptr_obj (SLANG_ISTRUCT_TYPE, (VOID_STAR *) &s)) - return NULL; - - if (NULL == (struct_addr = *(char **)s->addr)) - { - SLang_verror (SL_INTRINSIC_ERROR, - "%s is NULL. Unable to access field", s->name); - return NULL; - } - - f = s->fields; - while (f->field_name != NULL) - { - /* Since both these are slstrings, just test pointers */ - if (f->field_name != name) - { - f++; - continue; - } - - if (no_readonly && f->read_only) - { - SLang_verror (SL_READONLY_ERROR, - "%s.%s is read-only", s->name, name); - return NULL; - } - - *addr = (VOID_STAR) (struct_addr + f->offset); - return f; - } - - SLang_verror (SL_TYPE_MISMATCH, - "%s has no field called %s", s->name, name); - return NULL; -} - -static int istruct_sget (unsigned char type, char *name) -{ - SLang_IStruct_Field_Type *f; - VOID_STAR addr; - SLang_Class_Type *cl; - - if (NULL == (f = istruct_pop_field (name, 0, &addr))) - return -1; - - type = f->type; - cl = _SLclass_get_class (type); - - return (cl->cl_push_intrinsic)(f->type, addr); -} - -static int istruct_sput (unsigned char type, char *name) -{ - SLang_IStruct_Field_Type *f; - VOID_STAR addr; - SLang_Class_Type *cl; - - if (NULL == (f = istruct_pop_field (name, 1, &addr))) - return -1; - - type = f->type; - cl = _SLclass_get_class (type); - - return (*cl->cl_pop) (type, addr); -} - -static int istruct_push (unsigned char type, VOID_STAR ptr) -{ - _SLang_IStruct_Type *s; - - s = *(_SLang_IStruct_Type **) ptr; - if ((s == NULL) - || (s->addr == NULL) - || (*(char **) s->addr == NULL)) - return SLang_push_null (); - - return SLclass_push_ptr_obj (type, (VOID_STAR) s); -} - -static int istruct_pop (unsigned char type, VOID_STAR ptr) -{ - return SLclass_pop_ptr_obj (type, (VOID_STAR *)ptr); -} - -static void istruct_destroy (unsigned char type, VOID_STAR ptr) -{ - (void) type; - (void) ptr; -} - -/* Intrinsic struct objects are not stored in a variable. So, the address that - * is passed here is actually a pointer to the struct. So, pass its address - * to istruct_push since v is a variable. Confusing, n'est pas? - */ -static int istruct_push_intrinsic (unsigned char type, VOID_STAR v) -{ - return istruct_push (type, (VOID_STAR) &v); -} - -static int init_intrin_struct (void) -{ - SLang_Class_Type *cl; - static int initialized; - - if (initialized) - return 0; - - if (NULL == (cl = SLclass_allocate_class ("IStruct_Type"))) - return -1; - - cl->cl_pop = istruct_pop; - cl->cl_push = istruct_push; - cl->cl_sget = istruct_sget; - cl->cl_sput = istruct_sput; - cl->cl_destroy = istruct_destroy; - cl->cl_push_intrinsic = istruct_push_intrinsic; - - if (-1 == SLclass_register_class (cl, SLANG_ISTRUCT_TYPE, sizeof (_SLang_IStruct_Type *), - SLANG_CLASS_TYPE_PTR)) - return -1; - - initialized = 1; - return 0; -} - -int SLadd_istruct_table (SLang_IStruct_Field_Type *fields, VOID_STAR addr, char *name) -{ - _SLang_IStruct_Type *s; - SLang_IStruct_Field_Type *f; - - if (-1 == init_intrin_struct ()) - return -1; - - if (addr == NULL) - { - SLang_verror (SL_INVALID_PARM, - "SLadd_istruct_table: address must be non-NULL"); - return -1; - } - - if (fields == NULL) - return -1; - - /* Make the field names slstrings so that only the pointers need to be - * compared. However, this table may have been already been added for - * another instance of the intrinsic object. So, check for the presence - * of an slstring. - */ - f = fields; - while (f->field_name != NULL) - { - char *fname; - - fname = SLang_create_slstring (f->field_name); - if (fname == NULL) - return -1; - - /* Here is the check for the slstring */ - if (f->field_name == fname) - SLang_free_slstring (fname); - else /* replace string literal with slstring */ - f->field_name = fname; - - f++; - } - - s = (_SLang_IStruct_Type *)SLmalloc (sizeof (_SLang_IStruct_Type)); - if (s == NULL) - return -1; - - memset ((char *)s, 0, sizeof (_SLang_IStruct_Type)); - if (NULL == (s->name = SLang_create_slstring (name))) - { - SLfree ((char *) s); - return -1; - } - - s->addr = addr; - s->fields = fields; - - if (-1 == SLadd_intrinsic_variable (name, (VOID_STAR) s, SLANG_ISTRUCT_TYPE, 1)) - { - SLang_free_slstring (s->name); - SLfree ((char *) s); - return -1; - } - - return 0; -} |