SLang_Ref_Type *_pSLang_new_ref (unsigned int sizeof_data)
{
SLang_Ref_Type *ref;
if (NULL == (ref = (SLang_Ref_Type *)SLcalloc (1, sizeof (SLang_Ref_Type))))
return NULL;
if (NULL == (ref->data = (VOID_STAR)SLcalloc (1, sizeof_data)))
{
SLfree ((char *)ref);
return NULL;
}
ref->num_refs = 1;
ref->sizeof_data = sizeof_data;
return ref;
}
static Host_Addr_Info_Type *alloc_host_addr_info (unsigned int num, int h_length)
{
Host_Addr_Info_Type *hinfo;
size_t nbytes;
char *buf;
unsigned int i;
hinfo = (Host_Addr_Info_Type *) SLcalloc (1, sizeof (Host_Addr_Info_Type));
if (hinfo == NULL)
return NULL;
/* We need memory to hold num (char *) addresses + num*h_length bytes */
nbytes = num * sizeof(char *) + num * h_length;
if (NULL == (buf = (char *)SLmalloc (nbytes)))
{
SLfree ((char *)hinfo);
return NULL;
}
hinfo->h_addr_list = (char **)buf;
buf += num*sizeof(char *);
for (i = 0; i < num; i++)
{
hinfo->h_addr_list[i] = buf;
buf += h_length;
}
hinfo->num = num;
hinfo->h_length = h_length;
return hinfo;
}
static SLang_Foreach_Context_Type *
cl_foreach_open (SLtype type, unsigned int num)
{
SLang_Foreach_Context_Type *c;
(void) type;
if (num != 0)
{
_pSLang_verror (SL_NOT_IMPLEMENTED,
"%s does not support 'foreach using' form",
SLclass_get_datatype_name (type));
return NULL;
}
if (NULL == (c = (SLang_Foreach_Context_Type *) SLcalloc (1, sizeof (SLang_Foreach_Context_Type))))
return NULL;
if (-1 == pop_list (&c->list))
{
SLfree ((char *) c);
return NULL;
}
return c;
}
static Chunk_Type *new_chunk (unsigned int size)
{
Chunk_Type *c;
c = (Chunk_Type *) SLcalloc (1, sizeof (Chunk_Type));
if (c == NULL)
return c;
c->elements = (SLang_Object_Type *)SLcalloc(size, sizeof(SLang_Object_Type));
if (c->elements == NULL)
{
SLfree ((char *) c);
return NULL;
}
c->chunk_size = size;
return c;
}
_pSLerr_Error_Queue_Type *_pSLerr_new_error_queue (int make_active)
{
_pSLerr_Error_Queue_Type *q;
if (NULL == (q = (_pSLerr_Error_Queue_Type *)SLcalloc (1, sizeof(_pSLerr_Error_Queue_Type))))
return NULL;
if (make_active)
Active_Error_Queue = q;
return q;
}
static Error_Message_Type *allocate_error_msg (char *msg, int msg_type)
{
Error_Message_Type *m;
if (NULL == (m = (Error_Message_Type*) SLcalloc (1, sizeof (Error_Message_Type))))
return NULL;
if ((NULL != msg) && (NULL == (m->msg = SLang_create_slstring (msg))))
{
free_error_msg (m);
return NULL;
}
m->msg_type = msg_type;
return m;
}
static Handle_Type *allocate_handle_type (SLFUTURE_CONST char *module_name, VOID_STAR handle)
{
Handle_Type *h;
h = (Handle_Type *) SLcalloc (1, sizeof (Handle_Type));
if (h == NULL)
return NULL;
if (NULL == (h->module_name = SLang_create_slstring (module_name)))
{
SLfree ((char *) h);
return NULL;
}
h->handle = handle;
return h;
}
/* This is used if the key is not UTF-8, or it is but the search is case-sensitive */
static SLsearch_Type *bm_open_search (SLuchar_Type *key, int flags)
{
SLsearch_Type *st;
size_t keylen;
keylen = strlen ((char *)key);
if (NULL == (st = (SLsearch_Type *)SLcalloc (1, sizeof (SLsearch_Type))))
return NULL;
st->free_fun = bm_free;
/* If the search is case-insensitive, then it must either be all ascii, or
* it is not unicode. In either case, the UPPER_CASE and LOWER_CASE macros
* should be ok to use.
*/
if (flags & SLSEARCH_CASELESS)
{
char *keyup = SLmake_nstring ((char *)key, keylen);
if (keyup != NULL)
{
unsigned char *k = (unsigned char *)keyup;
while (*k != 0)
{
*k = UPPER_CASE(*k);
k++;
}
st->s.bm.key = (SLuchar_Type *)SLang_create_slstring (keyup);
SLfree (keyup);
}
else st->s.bm.key = NULL;
}
else st->s.bm.key = (SLuchar_Type*) SLang_create_slstring ((char *)key);
if (st->s.bm.key == NULL)
{
SLsearch_delete (st);
return NULL;
}
st->s.bm.key_len = keylen;
st->flags = flags;
st->search_fun = bm_search;
init_skip_table (st->s.bm.key, st->s.bm.key_len, st->s.bm.fskip_table, 1, flags);
init_skip_table (st->s.bm.key, st->s.bm.key_len, st->s.bm.bskip_table, -1, flags);
return st;
}
static SLang_List_Type *allocate_list (SLindex_Type chunk_size)
{
SLang_List_Type *list;
if (chunk_size <= 0)
chunk_size = DEFAULT_CHUNK_SIZE;
else if (chunk_size > 2*DEFAULT_CHUNK_SIZE)
chunk_size = 2*DEFAULT_CHUNK_SIZE;
list = (SLang_List_Type *)SLcalloc (1, sizeof (SLang_List_Type));
if (list != NULL)
{
list->ref_count = 1;
list->default_chunk_size = chunk_size;
}
return list;
}
static RL_History_Type *allocate_history (SLFUTURE_CONST char *str, int point)
{
RL_History_Type *h;
if (NULL == (h = (RL_History_Type *) SLcalloc (1, sizeof (RL_History_Type)))
|| (NULL == (h->buf = SLang_create_slstring (str))))
{
SLfree ((char *)h); /* NULL ok */
return NULL;
}
h->len = strlen (str);
if ((point < 0) || ((unsigned int)point > h->len))
point = h->len;
h->point = point;
return h;
}
/*{{{ SLprep_open_prep (), SLprep_close_prep () */
SLprep_Type *SLprep_new (void)
{
SLprep_Type *pt;
if (NULL == (pt = (SLprep_Type *)SLcalloc (1, sizeof (SLprep_Type))))
return NULL;
if (-1 == SLprep_set_comment (pt, "%", ""))
{
SLprep_delete (pt);
return NULL;
}
if (-1 == SLprep_set_prefix (pt, "#"))
{
SLprep_delete (pt);
return NULL;
}
return pt;
}
int SLerr_new_exception (int baseclass, SLFUTURE_CONST char *name, SLFUTURE_CONST char *descript)
{
Exception_Type *base;
Exception_Type *e;
if (-1 == _pSLerr_init ())
return -1;
base = find_exception (Exception_Root, baseclass);
if (base == NULL)
{
_pSLang_verror (SL_InvalidParm_Error,
"Base class for new exception not found");
return -1;
}
e = (Exception_Type *) SLcalloc (1, sizeof (Exception_Type));
if (e == NULL)
return -1;
if ((NULL == (e->name = SLang_create_slstring (name)))
|| (NULL == (e->description = SLang_create_slstring (descript))))
{
free_this_exception (e);
return -1;
}
e->error_code = Next_Exception_Code;
if ((_pSLerr_New_Exception_Hook != NULL)
&& (-1 == (*_pSLerr_New_Exception_Hook) (e->name, e->description, e->error_code)))
{
free_this_exception (e);
return -1;
}
e->parent = base;
e->next = base->subclasses;
base->subclasses = e;
Next_Exception_Code++;
return e->error_code;
}
SLwchar_Lut_Type *SLwchar_create_lut (unsigned int num_entries)
{
SLwchar_Lut_Type *r;
r = (SLwchar_Lut_Type *)SLcalloc (sizeof (SLwchar_Lut_Type), 1);
if (r == NULL)
return NULL;
r->chmin = (SLwchar_Type *) _SLcalloc (num_entries, sizeof(SLwchar_Type));
r->chmax = (SLwchar_Type *) _SLcalloc (num_entries, sizeof(SLwchar_Type));
if ((r->chmin == NULL) || (r->chmax == NULL))
{
SLwchar_free_lut (r);
return NULL;
}
r->malloced_len = num_entries;
r->utf8_mode = _pSLinterp_UTF8_Mode;
return r;
}
SLsearch_Type *SLsearch_new (SLuchar_Type *key, int flags)
{
SLsearch_Type *st, *bf_st;
SLuchar_Type *key_upper, *key_lower, *non_ascii;
size_t len, upper_len, lower_len;
if (Case_Tables_Ok == 0)
SLang_init_case_tables ();
if (key == NULL)
return NULL;
if ((0 == (flags & SLSEARCH_CASELESS))
|| (0 == (flags & SLSEARCH_UTF8)))
return bm_open_search (key, flags);
/* Otherwise the key is UTF-8 and the search is case-insensitive */
len = strlen ((char *)key);
key_upper = SLutf8_strup (key, key + len);
if (key_upper == NULL)
return NULL;
upper_len = strlen ((char *)key_upper);
if (is_bm_ok (key_upper, upper_len, &non_ascii))
{
st = bm_open_search (key_upper, flags);
SLang_free_slstring ((char *)key_upper);
return st;
}
/* Tricky part */
if (NULL == (key_lower = SLutf8_strlo (key, key + len)))
{
SLang_free_slstring ((char *)key_upper);
return NULL;
}
lower_len = strlen ((char *)key_lower);
/* Try a case-less search */
if ((lower_len == upper_len)
&& (0 == strcmp ((char *)key_upper, (char *)key_lower)))
{
flags &= ~SLSEARCH_CASELESS;
st = bm_open_search (key_upper, flags);
SLang_free_slstring ((char *)key_upper);
SLang_free_slstring ((char *)key_lower);
return st;
}
/* Now Perform a brute-force search. */
/* If the first few characters of the search string are ascii, then
* use BM for that portion
*/
bf_st = NULL;
if (non_ascii - key_upper >= 3)
{
SLuchar_Type *key1 = (SLuchar_Type *) SLmake_nstring ((char *)key_upper, non_ascii - key_upper);
/* ok to propagate NULL below */
bf_st = SLsearch_new (key1, flags);
SLfree ((char *)key1);
if (bf_st == NULL)
{
SLang_free_slstring ((char *)key_upper);
SLang_free_slstring ((char *)key_lower);
return NULL;
}
key1 = (SLuchar_Type *) SLang_create_slstring ((char *)non_ascii);
non_ascii = key_lower + (non_ascii - key_upper);
SLang_free_slstring ((char *)key_upper);
key_upper = key1;
key1 = (SLuchar_Type *)SLang_create_slstring ((char *)non_ascii);
SLang_free_slstring ((char *)key_lower);
key_lower = key1;
if ((key_lower == NULL) || (key_upper == NULL))
{
SLang_free_slstring ((char *)key_upper);
SLang_free_slstring ((char *)key_lower);
SLsearch_delete (bf_st);
return NULL;
}
upper_len = strlen ((char *)key_upper);
lower_len = strlen ((char *)key_lower);
}
st = (SLsearch_Type *)SLcalloc (sizeof (SLsearch_Type), 1);
if (st == NULL)
goto return_error;
st->free_fun = bf_free;
st->flags = flags;
st->search_fun = bf_search;
st->s.bf.st = bf_st; bf_st = NULL;
if (NULL == (st->s.bf.lower_chars = make_string_array (key_lower, lower_len, &st->s.bf.nlower_chars)))
goto return_error;
if (NULL == (st->s.bf.upper_chars = make_string_array (key_upper, upper_len, &st->s.bf.nupper_chars)))
goto return_error;
SLang_free_slstring ((char *)key_upper);
SLang_free_slstring ((char *)key_lower);
return st;
return_error:
SLsearch_delete (st);
SLsearch_delete (bf_st);
SLang_free_slstring ((char *)key_upper);
SLang_free_slstring ((char *)key_lower);
return NULL;
}
SLwchar_Map_Type *SLwchar_allocate_char_map (SLuchar_Type *from, SLuchar_Type *to)
{
SLwchar_Map_Type *map;
Char_Map_Type *list, *prev;
SLuchar_Type *from_max, *to_max;
unsigned int i;
int invert = 0, first_time;
if (*from == '^')
{
invert = 1;
from++;
}
#if 0
if (*from == 0)
{
_pSLang_verror (SL_INVALID_PARM, "Illegal empty string in character map specification");
return NULL;
}
#endif
map = (SLwchar_Map_Type *)SLcalloc (1, sizeof (SLwchar_Map_Type));
if (map == NULL)
return NULL;
map->invert = invert;
for (i = 0; i < 256; i++)
map->chmap[i] = i;
from_max = from + strlen ((char *) from);
to_max = to + strlen ((char *) to);
list = NULL;
while (from < from_max)
{
Char_Map_Type *next;
SLuchar_Type *next_to;
if (NULL == (next = (Char_Map_Type *) SLcalloc (1, sizeof (Char_Map_Type))))
goto return_error;
if (list == NULL)
map->list = next;
else
list->next = next;
list = next;
if (NULL == (from = get_lexical_element (from, from_max, 1, 1, &list->from)))
goto return_error;
if (NULL == (next_to = get_lexical_element (to, to_max, 1, 1, &list->to)))
goto return_error;
/* If the mapping is not 1-1, then the last "to" object applies to the
* remaining "from" objects. This will permit, e.g.,
* A-Za-z --> X
*/
if (next_to != to_max)
{
if (invert)
{
_pSLang_verror (SL_INVALID_PARM, "Character map inversion must specify a many-to-one mapping");
goto return_error;
}
to = next_to;
}
}
list = map->list;
prev = NULL;
first_time = 1;
while (list != NULL)
{
Char_Map_Type *next = list->next;
if (-1 == check_char_mapping (map, list, first_time))
{
_pSLang_verror (SL_INVALID_PARM, "Specified character mapping is invalid");
goto return_error;
}
first_time = 0;
if (list->map_function == NULL)
{
if (prev == NULL)
map->list = next;
else
prev->next = next;
free_char_map_type (list);
}
else prev = list;
list = next;
}
return map;
return_error:
SLwchar_free_char_map (map);
return NULL;
}
SLrline_Type *SLrline_open (unsigned int width, unsigned int flags)
{
SLrline_Type *rli;
if (_pSLutf8_mode)
flags |= SL_RLINE_UTF8_MODE;
if (NULL == (rli = (SLrline_Type *)SLcalloc (1, sizeof (SLrline_Type))))
return NULL;
if (width == 0)
width = 80;
if (width < 256) rli->buf_len = 256;
else rli->buf_len = width;
if (NULL == (rli->buf = (unsigned char *)SLmalloc (rli->buf_len)))
{
SLrline_close (rli);
return NULL;
}
*rli->buf = 0;
#ifdef REAL_UNIX_SYSTEM
rli->eof_char = 4;
#else
rli->eof_char = 26;
#endif
rli->point = 0;
rli->flags = flags;
rli->edit_width = width;
rli->hscroll = width/4;
rli->tab = 8;
rli->getkey = SLang_getkey;
rli->input_pending = SLang_input_pending;
rli->state = RLI_LINE_INVALID;
if (rli->flags & SL_RLINE_USE_ANSI)
{
if (rli->tt_goto_column == NULL) rli->tt_goto_column = ansi_goto_column;
}
if (-1 == init_keymap ())
{
SLrline_close (rli);
return NULL;
}
rli->keymap = RL_Keymap;
rli->old_upd = rli->upd_buf1;
rli->new_upd = rli->upd_buf2;
if (Char_Widths[0] == 0)
{
int ch;
/* FIXME: This does not support UTF-8 */
for (ch = 0; ch < 32; ch++) Char_Widths[ch] = 2;
for (ch = 32; ch < 256; ch++) Char_Widths[ch] = 1;
Char_Widths[127] = 2;
#ifndef IBMPC_SYSTEM
for (ch = 128; ch < 160; ch++) Char_Widths[ch] = 3;
#endif
}
return rli;
}
/* Usage: reg = onig_new (pattern, options, enc, syntax) */
static void do_onig_new (void)
{
const UChar* pattern;
const UChar* pattern_end;
OnigOptionType option;
OnigEncoding enc;
OnigSyntaxType *syntax;
OnigErrorInfo err_info;
Onig_Type *o;
int status;
syntax = ONIG_SYNTAX_PERL;
if (SLinterp_is_utf8_mode ())
enc = ONIG_ENCODING_UTF8;
else
enc = ONIG_ENCODING_ISO_8859_1;
option = ONIG_OPTION_DEFAULT;
switch (SLang_Num_Function_Args)
{
default:
SLang_verror (SL_Usage_Error, "Usage: r = onig_new (pattern [,options [,encoding [,syntax]]])");
return;
case 4:
if (NULL == (syntax = pop_onig_syntax ()))
return;
case 3:
if (NULL == (enc = pop_onig_encoding ()))
return;
case 2:
if (-1 == pop_onig_option (&option))
return;
case 1:
if (-1 == SLang_pop_slstring ((char **)&pattern))
return;
}
if (NULL == (o = (Onig_Type *) SLcalloc (1, sizeof (Onig_Type))))
{
SLfree ((char *)pattern);
return;
}
pattern_end = pattern + strlen ((char *)pattern);
status = onig_new (&o->re, pattern, pattern_end,
option, enc, syntax, &err_info);
if (status != ONIG_NORMAL)
{
throw_onig_error (status, &err_info);
SLang_free_slstring ((char *)pattern);
free_onig_type (o);
return;
}
if (NULL == (o->region = onig_region_new ()))
{
SLang_verror (slOnig_Error, "failed to allocate a region");
SLang_free_slstring ((char *)pattern);
free_onig_type (o);
return;
}
SLang_free_slstring ((char *)pattern);
(void) push_onig_type (o); /* frees it */
}
static int resize_table (SLang_Assoc_Array_Type *a)
{
int num_occupied, new_table_len;
_pSLAssoc_Array_Element_Type *old_es;
_pSLAssoc_Array_Element_Type *new_es;
num_occupied = a->num_occupied - a->num_deleted;
new_table_len = a->table_len;
if (num_occupied == 0)
num_occupied = (MIN_TABLE_SIZE >> 1);
new_table_len = a->table_len;
if (new_table_len < MIN_TABLE_SIZE)
new_table_len = MIN_TABLE_SIZE;
/* In practice, num_occupied*2 will not overflow because we would be
* out of memory if would be num_occupied objects stored.
*/
num_occupied *= 2;
while (num_occupied > new_table_len)
{
new_table_len *= 2;
if (new_table_len < 0)
{
SLang_set_error (SL_Malloc_Error);
return -1;
}
}
new_es = (_pSLAssoc_Array_Element_Type *)SLcalloc (new_table_len, sizeof (_pSLAssoc_Array_Element_Type));
if (new_es == NULL)
return -1;
if (NULL != (old_es = a->elements))
{
_pSLAssoc_Array_Element_Type *new_e, *old_e, *old_emax;
old_e = old_es;
old_emax = old_e + a->table_len;
while (old_e < old_emax)
{
SLCONST char *key = old_e->key;
if ((key == NULL) || (key == Deleted_Key))
{
old_e++;
continue;
}
/* Cannot fail */
new_e = find_empty_element (new_es, new_table_len, key, old_e->hash);
*new_e = *old_e;
old_e++;
}
SLfree ((char *)old_es);
}
a->elements = new_es;
a->table_len = new_table_len;
a->num_occupied -= a->num_deleted;
a->num_deleted = 0;
a->resize_num = 13*(new_table_len>>4);
return 0;
}
