SLcurses_Window_Type *SLcurses_newwin (unsigned int nrows, unsigned int ncols,
unsigned int r, unsigned int c)
{
SLcurses_Window_Type *win;
SLcurses_Cell_Type **lines;
if (r >= (unsigned int) SLtt_Screen_Rows)
return NULL;
if (c >= (unsigned int) SLtt_Screen_Cols)
return NULL;
if (NULL == (win = (SLcurses_Window_Type *) SLmalloc (sizeof (SLcurses_Window_Type))))
return NULL;
SLMEMSET ((char *) win, 0, sizeof (SLcurses_Window_Type));
if (nrows == 0)
nrows = (unsigned int) SLtt_Screen_Rows - r;
if (ncols == 0)
ncols = (unsigned int) SLtt_Screen_Cols - c;
lines = (SLcurses_Cell_Type **) SLmalloc (nrows * sizeof (SLcurses_Cell_Type *));
if (lines == NULL)
{
SLcurses_delwin (win);
return NULL;
}
SLMEMSET ((char *) lines, 0, nrows * sizeof (SLcurses_Cell_Type *));
win->lines = lines;
win->scroll_max = win->nrows = nrows;
win->ncols = ncols;
win->_begy = r;
win->_begx = c;
win->_maxx = (c + ncols) - 1;
win->_maxy = (r + nrows) - 1;
win->modified = 1;
win->delay_off = -1;
for (r = 0; r < nrows; r++)
{
SLcurses_Cell_Type *b;
b = (SLcurses_Cell_Type *) SLmalloc (ncols * sizeof (SLcurses_Cell_Type));
if (b == NULL)
{
SLcurses_delwin (win);
return NULL;
}
lines [r] = b;
blank_line (b, ncols, 0);
}
return win;
}
SLcurses_Window_Type *SLcurses_subwin (SLcurses_Window_Type *orig,
unsigned int nlines, unsigned int ncols,
unsigned int begin_y, unsigned int begin_x)
{
SLcurses_Window_Type *sw;
int r, c;
unsigned int i;
if (orig == NULL)
return NULL;
sw = (SLcurses_Window_Type *) SLmalloc (sizeof (SLcurses_Window_Type));
if (sw == NULL)
return NULL;
SLMEMSET ((char *)sw, 0, sizeof (SLcurses_Window_Type));
#if 1
r = begin_y - orig->_begy;
#else
r = 1 + ((int)orig->nrows - (int)nlines) / 2;
#endif
if (r < 0) r = 0;
if (r + nlines > orig->nrows) nlines = orig->nrows - r;
c = ((int)orig->ncols - (int)ncols) / 2;
if (c < 0) c = 0;
if (c + ncols > orig->ncols) ncols = orig->ncols - c;
sw->scroll_min = 0;
sw->scroll_max = sw->nrows = nlines;
sw->ncols = ncols;
sw->_begy = begin_y;
sw->_begx = begin_x;
sw->_maxx = (begin_x + ncols) - 1;
sw->_maxy = (begin_y + nlines) - 1;
sw->lines = (SLcurses_Cell_Type **) SLmalloc (nlines * sizeof (SLcurses_Cell_Type *));
if (sw->lines == NULL)
{
SLcurses_delwin (sw);
return NULL;
}
for (i = 0; i < nlines; i++)
{
sw->lines [i] = orig->lines [r + i] + c;
}
sw->is_subwin = 1;
return sw;
}
static int init_smg (void)
{
unsigned int i, len;
SLsmg_Char_Type *old, *neew;
Smg_Inited = 0;
#ifdef REQUIRES_NON_BCE_SUPPORT
Bce_Color_Offset = _pSLtt_get_bce_color_offset ();
#endif
Screen_Rows = *tt_Screen_Rows;
if (Screen_Rows > SLTT_MAX_SCREEN_ROWS)
Screen_Rows = SLTT_MAX_SCREEN_ROWS;
Screen_Cols = *tt_Screen_Cols;
This_Col = This_Row = Start_Col = Start_Row = 0;
This_Alt_Char = 0;
SLsmg_set_color (0);
Cls_Flag = 1;
init_acs (ACS_MODE_AUTO);
len = Screen_Cols + 3;
for (i = 0; i < Screen_Rows; i++)
{
if ((NULL == (old = (SLsmg_Char_Type *) SLmalloc (sizeof(SLsmg_Char_Type) * len)))
|| ((NULL == (neew = (SLsmg_Char_Type *) SLmalloc (sizeof(SLsmg_Char_Type) * len)))))
{
SLfree ((char *) old);
return -1;
}
blank_line (old, len, ' ');
blank_line (neew, len, ' ');
SL_Screen[i].old = old;
SL_Screen[i].neew = neew;
SL_Screen[i].flags = 0;
#ifndef IBMPC_SYSTEM
Blank_Hash = compute_hash (old, Screen_Cols);
SL_Screen[i].new_hash = SL_Screen[i].old_hash = Blank_Hash;
#endif
}
_pSLtt_color_changed_hook = SLsmg_touch_screen;
Screen_Trashed = 1;
Smg_Inited = 1;
return 0;
}
/* This returns a MALLOCED string */
char *SLpath_dircat (SLFUTURE_CONST char *dir, SLFUTURE_CONST char *name)
{
unsigned int len, dirlen;
char *file;
#ifndef VMS
int requires_fixup;
#endif
if (name == NULL)
name = "";
if ((dir == NULL)
#if !TEST_VMS_ON_UNIX
|| (SLpath_is_absolute_path (name))
#endif
)
dir = "";
/* Both VMS and MSDOS have default directories associated with each drive.
* That is, the meaning of something like C:X depends upon more than just
* the syntax of the string. Since this concept has more power under VMS
* it will be honored here. However, I am going to treat C:X as C:\X
* under MSDOS.
*
* Note!!!
* VMS has problems of its own regarding path names, so I am simply
* going to strcat. Hopefully the VMS RTL is smart enough to deal with
* the result.
*/
dirlen = strlen (dir);
#ifndef VMS
# if TEST_VMS_ON_UNIX
requires_fixup = 0;
# else
requires_fixup = (dirlen && (0 == IS_PATH_SEP(dir[dirlen - 1])));
# endif
#endif
len = dirlen + strlen (name) + 2;
if (NULL == (file = (char *)SLmalloc (len)))
return NULL;
strcpy (file, dir);
#ifndef VMS
if (requires_fixup)
file[dirlen++] = PATH_SEP;
#endif
strcpy (file + dirlen, name);
#if defined(IBMPC_SYSTEM)
convert_slashes (file);
#endif
#if TEST_VMS_ON_UNIX || defined (VMS)
return vms_fixup_filename (file);
#else
return file;
#endif
}
static void chksum_close (Chksum_Object_Type *obj)
{
unsigned char *digest;
unsigned int digest_len;
SLChksum_Type *c;
if (NULL == (c = obj->c))
{
(void) SLang_push_null ();
return;
}
digest_len = c->digest_len;
if (NULL == (digest = (unsigned char *)SLmalloc(2*digest_len+1)))
return;
if (-1 == c->close (c, digest))
{
SLfree ((char *)digest);
return;
}
obj->c = NULL;
hexify_string (digest, digest_len);
(void) SLang_push_malloced_string ((char *)digest);
}
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;
}
void create_undo_ring() /*{{{*/
{
Undo_Type *ur;
Undo_Object_Type *uo;
int n;
if (NULL == (ur = (Undo_Type *) SLmalloc (sizeof(Undo_Type))))
{
msg_error("Unable to malloc space for undo!");
return;
}
CBuf->undo = ur;
uo = ur->Undo_Ring;
ur->Last_Undo = ur->First_Undo = uo;
#ifdef UNDO_HAS_REDO
ur->Current_Undo = NULL;
#endif
n = MAX_UNDOS;
while (n--)
{
uo->type = 0;
uo++;
}
}
SLFile_FD_Type *SLfile_create_fd (SLFUTURE_CONST char *name, int fd)
{
SLFile_FD_Type *f;
if (name == NULL)
name = "";
if (NULL == (f = (SLFile_FD_Type *) SLmalloc (sizeof (SLFile_FD_Type))))
return NULL;
memset ((char *) f, 0, sizeof (SLFile_FD_Type));
if (NULL == (f->name = SLang_create_slstring (name)))
{
SLfree ((char *)f);
return NULL;
}
f->fd = fd;
f->num_refs = 1;
f->clientdata_id = 0;
f->clientdata = NULL;
/* If NULL, use the standard routines on a file descriptor */
f->close = NULL;
f->read = NULL;
f->write = NULL;
chain_fd_type (f);
return f;
}
static SLang_Foreach_Context_Type *
cl_foreach_open (SLtype 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
{
_pSLang_verror (SL_NOT_IMPLEMENTED,
"using '%s' not supported by SLassoc_Type",
s);
_pSLang_free_slstring (s);
SLang_free_mmt (mmt);
return NULL;
}
_pSLang_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);
#if SLANG_OPTIMIZE_FOR_SPEED
c->is_scalar = (SLANG_CLASS_TYPE_SCALAR == _pSLang_get_class_type (c->a->type));
#endif
return c;
}
SLang_NameSpace_Type *_SLns_allocate_namespace (char *name, unsigned int size)
{
SLang_NameSpace_Type *table_list;
SLang_Name_Type **nt;
static int num;
char namebuf[64];
if (name == NULL)
{
sprintf (namebuf, " *** internal ns <%d> *** ", num);
name = namebuf;
num++;
}
if (NULL != (table_list = find_name_table (name)))
return table_list;
if (NULL == (name = SLang_create_slstring (name)))
return NULL;
if (NULL == (table_list = (SLang_NameSpace_Type *)
SLmalloc (sizeof (SLang_NameSpace_Type))))
{
SLang_free_slstring (name);
return NULL;
}
if (NULL == (nt = (SLang_Name_Type **) SLmalloc (sizeof (SLang_Name_Type *) * size)))
{
SLang_free_slstring (name);
SLfree ((char *)table_list);
return NULL;
}
memset ((char *)nt, 0, size * sizeof (SLang_Name_Type *));
memset ((char *) table_list, 0, sizeof (SLang_NameSpace_Type));
table_list->name = name;
table_list->table = nt;
table_list->table_size = size;
table_list->next = Namespace_Tables;
Namespace_Tables = table_list;
return table_list;
}
static SLang_BString_Type *create_bstring_of_type (char *bytes, unsigned int len, int type)
{
SLang_BString_Type *b;
unsigned int size;
unsigned int malloced_len = len;
size = sizeof(SLang_BString_Type);
if (type == IS_BSTRING)
{
unsigned int dlen = BSTRING_EXTRA_BYTES(len);
malloced_len = len + dlen;
if ((malloced_len < len)
|| (size + malloced_len < size))
{
SLang_verror (SL_Malloc_Error, "Unable to create a binary string of the desired size");
return NULL;
}
size += malloced_len;
}
if (NULL == (b = (SLang_BString_Type *)SLmalloc (size)))
return NULL;
b->len = len;
b->malloced_len = malloced_len;
b->num_refs = 1;
b->ptr_type = type;
switch (type)
{
default:
case IS_BSTRING:
if (bytes != NULL) memcpy ((char *) b->v.bytes, bytes, len);
/* Now \0 terminate it because we want to also use it as a C string
* whenever possible. Note that sizeof(SLang_BString_Type) includes
* space for 1 character and we allocated len extra bytes. Thus, it is
* ok to add a \0 to the end.
*/
b->v.bytes[len] = 0;
break;
case IS_SLSTRING:
if (NULL == (b->v.ptr = (unsigned char *)SLang_create_nslstring (bytes, len)))
{
SLfree ((char *) b);
return NULL;
}
break;
case IS_MALLOCED:
case IS_NOT_TO_BE_FREED:
b->v.ptr = (unsigned char *)bytes;
bytes [len] = 0; /* NULL terminate */
break;
}
return b;
}
static Stdio_MMT_List_Type *alloc_stdio_list_elem (void)
{
Stdio_MMT_List_Type *elem;
elem = (Stdio_MMT_List_Type *) SLmalloc(sizeof(Stdio_MMT_List_Type));
if (elem != NULL)
memset ((char *)elem, 0, sizeof (Stdio_MMT_List_Type));
return elem;
}
void SLang_doerror (char *error)
{
char *str = NULL;
char *err;
char *malloced_err_buf;
char err_buf [1024];
malloced_err_buf = NULL;
if (((SLang_Error == SL_USER_ERROR)
|| (SLang_Error == SL_USAGE_ERROR))
&& (error != NULL) && (*error != 0))
err = error;
else
{
char *sle = "S-Lang Error: ";
unsigned int len = 0;
char *fmt = "%s%s%s";
str = get_error_string ();
if ((error == NULL) || (*error == 0))
error = "";
else if (SLang_Error == SL_UNKNOWN_ERROR)
/* Do not display an unknown error message if error is non-NULL */
str = "";
else {
fmt = "%s%s: %s";
len = 2; /* ": " */
}
len += strlen (sle) + strlen (str) + strlen(error) + 1 /* trailing 0 */;
err = err_buf;
if (len > sizeof (err_buf))
{
if (NULL == (malloced_err_buf = SLmalloc (len)))
err = NULL;
else
err = malloced_err_buf;
}
if (err != NULL) sprintf (err, fmt, sle, str, error);
else err = "Out of memory";
}
if (SLang_Error_Hook == NULL)
{
fputs (err, stderr);
fputs("\r\n", stderr);
fflush (stderr);
}
else
(*SLang_Error_Hook)(err);
SLfree (malloced_err_buf);
}
/* reverse index converter from John Davis */
static SLang_Array_Type *convert_reverse_indices (SLindex_Type *r, SLindex_Type num_r, SLindex_Type num_h)
{
SLang_Array_Type *new_r;
SLang_Array_Type **new_r_data;
SLindex_Type i, *lens;
if (NULL == (new_r = SLang_create_array (SLANG_ARRAY_TYPE, 0, NULL, &num_h, 1)))
return NULL;
if (NULL == (lens = (SLindex_Type *)SLmalloc (num_h * sizeof (SLindex_Type))))
{
SLang_free_array (new_r);
return NULL;
}
memset ((char *)lens, 0, num_h*sizeof(SLindex_Type));
for (i = 0; i < num_r; i++)
{
SLindex_Type r_i = r[i];
if (r_i >= 0)
lens[r_i]++;
}
new_r_data = (SLang_Array_Type **) new_r->data;
for (i = 0; i < num_h; i++)
{
if (NULL == (new_r_data[i] = SLang_create_array (SLANG_ARRAY_INDEX_TYPE, 0, NULL, &lens[i], 1)))
goto return_error;
lens[i] = 0;
}
for (i = 0; i < num_r; i++)
{
SLang_Array_Type *at;
SLindex_Type r_i = r[i];
if (r_i < 0)
continue;
at = new_r_data[r_i];
((SLindex_Type *)at->data)[lens[r_i]] = i;
lens[r_i]++;
}
SLfree ((char *)lens);
return new_r;
return_error:
SLfree ((char *) lens);
SLang_free_array (new_r);
return NULL;
}
int SLclass_add_binary_op (SLtype a, SLtype b,
int (*f) (int,
SLtype, VOID_STAR, unsigned int,
SLtype, VOID_STAR, unsigned int,
VOID_STAR),
int (*r) (int, SLtype, SLtype, SLtype *))
{
SL_OOBinary_Type *ab;
SLang_Class_Type *cl;
if ((f == NULL) || (r == NULL)
|| ((a == SLANG_VOID_TYPE) && (b == SLANG_VOID_TYPE)))
{
_pSLang_verror (SL_INVALID_PARM, "SLclass_add_binary_op");
return -1;
}
if (NULL == (ab = (SL_OOBinary_Type *) SLmalloc (sizeof(SL_OOBinary_Type))))
return -1;
ab->binary_function = f;
ab->binary_result = r;
if (a == SLANG_VOID_TYPE)
{
cl = _pSLclass_get_class (b);
ab->data_type = a;
ab->next = NULL;
cl->cl_void_binary_this = ab;
}
else if (b == SLANG_VOID_TYPE)
{
cl = _pSLclass_get_class (a);
ab->data_type = b;
ab->next = NULL;
cl->cl_this_binary_void = ab;
}
else
{
cl = _pSLclass_get_class (a);
ab->next = cl->cl_binary_ops;
ab->data_type = b;
cl->cl_binary_ops = ab;
}
if ((a != SLANG_ARRAY_TYPE)
&& (b != SLANG_ARRAY_TYPE))
{
if ((-1 == _pSLarray_add_bin_op (a))
|| (-1 == _pSLarray_add_bin_op (b)))
return -1;
}
return 0;
}
static Png_Type *alloc_png_type (int mode)
{
Png_Type *p;
if (NULL != (p = (Png_Type *)SLmalloc (sizeof (Png_Type))))
{
memset ((char *) p, 0, sizeof (Png_Type));
p->mode = mode;
}
return p;
}
int _pSLstring_list_init (_pSLString_List_Type *p, unsigned int max_num, unsigned int delta_num)
{
if (NULL == (p->buf = (char **) SLmalloc (max_num * sizeof (char *))))
return -1;
p->max_num = max_num;
p->num = 0;
p->delta_num = delta_num;
p->is_malloced = 0;
return 0;
}
/* returns pointer to malloced space */
static unsigned char *read_terminfo_section (FILE *fp, unsigned int size)
{
char *s;
if (NULL == (s = (char *) SLmalloc (size))) return NULL;
if (size != fread (s, 1, size, fp))
{
SLfree (s);
return NULL;
}
return (unsigned char *) s;
}
static void new_test_type (void)
{
Test_Type *t;
if (NULL == (t = (Test_Type *)SLmalloc (sizeof(Test_Type))))
return;
memset ((char *)t, 0, sizeof(Test_Type));
t->field1 = -1;
t->field2 = -1;
t->num_refs = 1;
(void) push_test_type (t);
free_test_type (t);
}
static SLang_MMT_Type *allocate_termios (struct termios *s)
{
struct termios *s1;
SLang_MMT_Type *mmt;
s1 = (struct termios *) SLmalloc (sizeof (struct termios));
if (s1 == NULL)
return NULL;
memcpy (s1, s, sizeof (struct termios));
if (NULL == (mmt = SLang_create_mmt (Termios_Type_Id, (VOID_STAR) s1)))
SLfree ((char *) s1);
return mmt;
}
VFILE *vstream(int fd, unsigned int size, unsigned int mode) /*{{{*/
{
VFILE *v;
if (NULL == (v = (VFILE *) SLmalloc(sizeof(VFILE)))) return(NULL);
v->bmax = v->bp = v->buf = NULL;
v->fd = fd;
v->eof = NULL;
v->size = size;
if (mode == 0) mode = VFile_Mode;
v->mode = mode;
v->cr_flag = 0;
return v;
}
_pSLString_List_Type *_pSLstring_list_new (unsigned int max_num, unsigned int delta_num)
{
_pSLString_List_Type *p;
p = (_pSLString_List_Type *)SLmalloc (sizeof (_pSLString_List_Type));
if (p == NULL)
return NULL;
if (-1 == _pSLstring_list_init (p, max_num, delta_num))
{
SLfree ((char *) p);
return NULL;
}
p->is_malloced = 1;
return p;
}
static char *combine_host_and_domain (char *a, char *b)
{
unsigned int len;
char *c, *cc;
len = strlen (a) + strlen (b) + 2;
if (NULL == (c = SLmalloc (len)))
return NULL;
if (*b == '.') b++;
sprintf (c, "%s.%s", a, b);
cc = SLang_create_slstring (c);
SLfree (c);
return cc;
}
char *SLpath_getcwd (void)
{
char cwd[4096];
char *p;
size_t len;
#ifndef HAVE_GETCWD
p = getwd (cwd);
#else
# if defined (__EMX__)
p = _getcwd2(cwd, sizeof(cwd)); /* includes drive specifier */
# else
p = getcwd(cwd, sizeof(cwd)); /* djggp includes drive specifier */
# endif
#endif
if (p == NULL)
return NULL;
#ifdef IBMPC_SYSTEM
convert_slashes (cwd);
#endif
len = strlen (cwd);
p = (char *) SLmalloc (len+2); /* \0 + trailing / */
if (p == NULL)
{
#ifdef ENOMEM
errno = ENOMEM;
#endif
return NULL;
}
strcpy (p, cwd);
#ifndef VMS
if (len && (p[len-1] != PATH_SEP))
{
p[len++] = PATH_SEP;
p[len] = 0;
}
#endif
return p;
}
static void set_rline_update_hook (void)
{
Rline_CB_Type *cb;
SLrline_Type *rli;
if (NULL == (cb = (Rline_CB_Type *)SLmalloc(sizeof(Rline_CB_Type))))
return;
memset ((char *)cb, 0, sizeof(Rline_CB_Type));
switch (SLang_Num_Function_Args)
{
default:
SLang_verror (SL_Usage_Error, "Usage: rline_set_update_hook (rli [,&hook [,clientdata]]);");
return;
case 3:
if (-1 == SLang_pop_anytype (&cb->cd))
return;
/* drop */
case 2:
if (NULL == (cb->update_hook = SLang_pop_function ()))
goto free_and_return;
/* drop */
case 1:
if (NULL == (cb->mmt = pop_sri_type (&cb->sri)))
goto free_and_return;
}
cb->sri->output_newline = 0;
rli = cb->sri->rli;
SLrline_set_update_clear_cb (rli, rline_update_clear_cb);
SLrline_set_update_preread_cb (rli, rline_update_preread_cb);
SLrline_set_update_postread_cb (rli, rline_update_postread_cb);
SLrline_set_update_width_cb (rli, rline_update_width_cb);
if (0 == SLrline_set_update_hook (rli, rline_call_update_hook, (VOID_STAR)cb))
{
SLrline_set_free_update_cb (rli, free_rli_update_data_cb);
return;
}
/* drop */
free_and_return:
free_cb_info (cb);
}
static SLang_BString_Type *create_bstring_of_type (char *bytes, unsigned int len, int type)
{
SLang_BString_Type *b;
unsigned int size;
size = sizeof(SLang_BString_Type);
if (type == 0)
size += len;
if (NULL == (b = (SLang_BString_Type *)SLmalloc (size)))
return NULL;
b->len = len;
b->num_refs = 1;
b->ptr_type = type;
switch (type)
{
case 0:
if (bytes != NULL) memcpy ((char *) b->v.bytes, bytes, len);
/* Now \0 terminate it because we want to also use it as a C string
* whenever possible. Note that sizeof(SLang_BString_Type) includes
* space for 1 character and we allocated len extra bytes. Thus, it is
* ok to add a \0 to the end.
*/
b->v.bytes[len] = 0;
break;
case IS_SLSTRING:
if (NULL == (b->v.ptr = (unsigned char *)SLang_create_nslstring (bytes, len)))
{
SLfree ((char *) b);
return NULL;
}
break;
case IS_MALLOCED:
case IS_NOT_TO_BE_FREED:
b->v.ptr = (unsigned char *)bytes;
bytes [len] = 0; /* NULL terminate */
break;
}
return b;
}
static MMap_Type *mmap_file (char *file, size_t offset, size_t num_bytes)
{
FILE *fp;
int fd;
struct stat st;
VOID_STAR addr;
MMap_Type *m;
fp = fopen (file, "rb");
if (fp == NULL)
{
SLang_verror (SL_OBJ_NOPEN, "mmap_array: unable to open %s for reading", file);
return NULL;
}
fd = fileno (fp);
if (-1 == fstat (fd, &st))
{
SLang_verror (SL_INTRINSIC_ERROR, "mmap_array: stat %s failed", file);
fclose (fp);
return NULL;
}
if (NULL == (m = (MMap_Type *) SLmalloc (sizeof (MMap_Type))))
{
fclose (fp);
return NULL;
}
m->size_mmapped = num_bytes + offset;
addr = (VOID_STAR)mmap (NULL, m->size_mmapped, PROT_READ, MAP_SHARED, fd, 0);
if (addr == (VOID_STAR)MAP_FAILED)
{
SLang_verror (SL_INTRINSIC_ERROR, "mmap_array: mmap %s failed", file);
SLfree ((char *) m);
fclose (fp);
return NULL;
}
m->addr = addr;
m->data = (VOID_STAR) ((char *)addr + offset);
fclose (fp);
return m;
}
static SLang_MMT_Type *allocate_iconv_type (iconv_t cd)
{
ICONV_Type *it;
SLang_MMT_Type *mmt;
it = (ICONV_Type *) SLmalloc (sizeof (ICONV_Type));
if (it == NULL)
return NULL;
it->cd = cd;
if (NULL == (mmt = SLang_create_mmt (ICONV_Type_Id, (VOID_STAR) it)))
{
free_iconv_type (it);
return NULL;
}
return mmt;
}
int SLang_push_complex (double r, double i)
{
double *c;
c = (double *) SLmalloc (2 * sizeof (double));
if (c == NULL)
return -1;
c[0] = r;
c[1] = i;
if (-1 == SLclass_push_ptr_obj (SLANG_COMPLEX_TYPE, (VOID_STAR) c))
{
SLfree ((char *) c);
return -1;
}
return 0;
}
/* returns SLmalloced string */
static char *find_file (SLFUTURE_CONST char *path, SLFUTURE_CONST char *file)
{
char *dirfile;
char *extname;
char *filebuf;
char *filesl, *fileslc;
unsigned int len;
if (NULL != (dirfile = SLpath_find_file_in_path (path, file)))
return dirfile;
/* Not found, or an error occured. */
if (_pSLang_Error)
return NULL;
extname = SLpath_extname (file);
if (*extname != 0)
return NULL;
/* No extension. So look for .slc and .sl forms */
len = (extname - file);
filebuf = SLmalloc (len + 5);
strcpy (filebuf, file);
strcpy (filebuf + len, ".sl");
filesl = SLpath_find_file_in_path (path, filebuf);
if ((filesl == NULL) && _pSLang_Error)
{
SLfree (filebuf);
return NULL;
}
strcpy (filebuf + len, ".slc");
fileslc = SLpath_find_file_in_path (path, filebuf);
SLfree (filebuf);
dirfile = more_recent (filesl, fileslc);
if (dirfile != filesl)
SLfree (filesl);
if (dirfile != fileslc)
SLfree (fileslc);
return dirfile;
}
