1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
|
/* 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;
}
|
