static int test_type_sput (SLtype type, SLFUTURE_CONST char *name)
{
Test_Type *t;
int status;
(void) type;
if (-1 == pop_test_type (&t))
return -1;
status = -1;
if (0 == strcmp (name, "field1"))
status = SLang_pop_int (&t->field1);
else if (0 == strcmp (name, "field2"))
status = SLang_pop_int (&t->field2);
else if (0 == strcmp (name, "any"))
{
SLang_Any_Type *any;
if (0 == (status = SLang_pop_anytype (&any)))
{
SLang_free_anytype (t->any);
t->any = any;
}
}
else
SLang_verror (SL_INVALID_PARM,
"Test_Type.%s is invalid", name);
free_test_type (t);
return status;
}
static void encode_csv_row_intrin (void)
{
SLang_Array_Type *at;
CSV_Type *csv;
SLang_MMT_Type *mmt;
int flags;
int has_flags;
char *str;
if (SLang_Num_Function_Args == 3)
{
if (-1 == SLang_pop_int (&flags))
return;
has_flags = 1;
}
else has_flags = 0;
if (-1 == SLang_pop_array_of_type (&at, SLANG_STRING_TYPE))
return;
if (NULL == (csv = pop_csv_type (&mmt)))
{
SLang_free_array (at);
return;
}
if (0 == has_flags)
flags = csv->flags;
str = csv_encode (csv, (char **)at->data, at->num_elements, flags);
SLang_free_mmt (mmt);
SLang_free_array (at);
(void) SLang_push_malloced_string (str);
}
static int pop_signal (Signal_Type **sp)
{
int sig;
Signal_Type *s;
if (-1 == SLang_pop_int (&sig))
return -1;
s = Signal_Table;
while (s->name != NULL)
{
if (s->sig == sig)
{
if (s->forbidden)
{
SLang_set_error (SL_Forbidden_Error);
return -1;
}
*sp = s;
return 0;
}
s++;
}
_pSLang_verror (SL_INVALID_PARM, "Signal %d invalid or unknown", sig);
return -1;
}
static int fdtype_datatype_deref (SLtype type)
{
SLFile_FD_Type *f;
int status;
int fd;
(void) type;
if (-1 == SLang_pop_int (&fd))
return -1;
#ifdef F_GETFL
while (-1 == fcntl (fd, F_GETFL))
{
if (is_interrupt (errno, 1))
continue;
return SLang_push_null ();
}
#endif
f = find_chained_fd (fd);
if (f != NULL)
return SLfile_push_fd (f);
/* The descriptor is valid, but we have no record of what it is. So make sure
* it is not automatically closed.
*/
if (NULL == (f = SLfile_create_fd (NULL, fd)))
return -1;
f->flags |= _SLFD_NO_AUTO_CLOSE;
status = SLfile_push_fd (f);
SLfile_free_fd (f);
return status;
}
static int pop_onig_option (OnigOptionType *optp)
{
int iopt;
if (-1 == SLang_pop_int (&iopt))
return -1;
*optp = (OnigOptionType) iopt;
return 0;
}
static int set_int_sockopt (Socket_Type *s, int level, int optname)
{
int val;
if (-1 == SLang_pop_int (&val))
return -1;
return do_setsockopt (s->fd, level, optname, (void *)&val, sizeof(int));
}
static SLCONST char *intrin_errno_string (void)
{
int e;
if (SLang_Num_Function_Args == 0)
return SLerrno_strerror (_pSLerrno_errno);
if (-1 == SLang_pop_int (&e))
return NULL;
return SLerrno_strerror (e);
}
static void set_frame_variable (void)
{
char *name;
int depth;
if (-1 == SLroll_stack (3))
return;
if (-1 == SLang_pop_slstring (&name))
return;
if (0 == SLang_pop_int (&depth))
(void) _pSLang_set_frame_variable ((unsigned int) depth, name);
SLang_free_slstring (name);
}
static int pop_fd (int *fdp)
{
SLFile_FD_Type *f;
int status;
if (SLang_peek_at_stack () == SLANG_INT_TYPE)
return SLang_pop_int (fdp);
if (-1 == SLfile_pop_fd (&f))
return -1;
status = SLfile_get_fd (f, fdp);
SLfile_free_fd (f);
return status;
}
static int getsid_cmd (void)
{
int ipid = 0;
pid_t pid;
if ((SLang_Num_Function_Args == 1)
&& (-1 == SLang_pop_int (&ipid)))
return -1;
pid = getsid (ipid);
if (pid == (pid_t)-1)
_pSLerrno_errno = errno;
return pid;
}
/*}}}*/
#if defined(PF_INET) && defined(AF_INET) /*{{{*/
static int pop_host_port (SLFUTURE_CONST char *what, int nargs, char **hostp, int *portp)
{
char *host;
int port;
if (nargs != 2)
{
SLang_verror (SL_NumArgs_Error, "%s on an PF_INET socket requires a hostname and portnumber", what);
return -1;
}
*hostp = NULL;
if ((-1 == SLang_pop_int (&port))
|| (-1 == SLang_pop_slstring (&host)))
return -1;
*hostp = host;
*portp = port;
return 0;
}
static void sigprocmask_intrinsic (void)
{
sigset_t mask, oldmask;
SLang_Ref_Type *ref = NULL;
int how;
if (SLang_Num_Function_Args == 3)
{
if (-1 == SLang_pop_ref (&ref))
return;
}
if (-1 == pop_signal_mask (&mask))
{
SLang_free_ref (ref);
return;
}
if (-1 == SLang_pop_int (&how))
{
SLang_free_ref (ref);
return;
}
if ((how != SIG_BLOCK) && (how != SIG_UNBLOCK) && (how != SIG_SETMASK))
{
_pSLang_verror (SL_InvalidParm_Error, "sigprocmask: invalid operation");
SLang_free_ref (ref);
return;
}
do_sigprocmask (how, &mask, &oldmask);
if (ref == NULL)
return;
if (-1 == assign_mask_to_ref (&oldmask, ref))
do_sigprocmask (SIG_SETMASK, &oldmask, NULL);
SLang_free_ref (ref);
}
static void new_csv_encoder_intrin (void)
{
CSV_Type *csv;
SLang_MMT_Type *mmt;
if (NULL == (csv = (CSV_Type *)SLmalloc(sizeof(CSV_Type))))
return;
memset ((char *)csv, 0, sizeof(CSV_Type));
if ((-1 == SLang_pop_int (&csv->flags))
||(-1 == SLang_pop_char (&csv->quotechar))
|| (-1 == SLang_pop_char (&csv->delimchar))
|| (NULL == (mmt = SLang_create_mmt (CSV_Type_Id, (VOID_STAR)csv))))
{
free_csv_type (csv);
return;
}
if (-1 == SLang_push_mmt (mmt))
SLang_free_mmt (mmt);
}
static int pop_fd (int *fdp, SLFile_FD_Type **fp, SLang_MMT_Type **mmtp)
{
int fd;
*fp = NULL; *mmtp = NULL;
switch (SLang_peek_at_stack ())
{
case SLANG_FILE_PTR_TYPE:
{
SLang_MMT_Type *mmt;
FILE *p;
if (-1 == SLang_pop_fileptr (&mmt, &p))
return -1;
fd = fileno (p);
*mmtp = mmt;
}
break;
case SLANG_FILE_FD_TYPE:
{
SLFile_FD_Type *f;
if (-1 == SLfile_pop_fd (&f))
return -1;
if (-1 == get_fd (f, &fd))
{
SLfile_free_fd (f);
return -1;
}
}
break;
default:
if (-1 == SLang_pop_int (&fd))
return -1;
}
*fdp = fd;
return 0;
}
static void getrusage_intrin (void)
{
RUsage_Type rut;
int who = RUSAGE_SELF;
if ((SLang_Num_Function_Args == 1)
&& (-1 == SLang_pop_int (&who)))
return;
if (-1 == getrusage (who, &rut.r))
{
_pSLerrno_errno = errno;
(void) SLang_push_null ();
return;
}
rut.ru_stimesecs
= (double)rut.r.ru_stime.tv_sec + 1e-6*rut.r.ru_stime.tv_usec;
rut.ru_utimesecs
= (double)rut.r.ru_utime.tv_sec + 1e-6*rut.r.ru_utime.tv_usec;
(void) SLang_push_cstruct ((VOID_STAR) &rut, RUsage_Struct);
}
static void decode_csv_row_intrin (void)
{
CSV_Type *csv;
SLang_MMT_Type *mmt;
int flags = 0;
int has_flags = 0;
if (SLang_Num_Function_Args == 2)
{
if (-1 == SLang_pop_int (&flags))
return;
has_flags = 1;
}
if (NULL == (csv = pop_csv_type (&mmt)))
return;
if (has_flags == 0)
flags = csv->flags;
(void) decode_csv_row (csv, flags);
SLang_free_mmt (mmt);
}
static void setitimer_intrinsic (void)
{
SLang_Ref_Type *interval_ref = NULL, *value_ref = NULL;
int w;
struct itimerval new_value, old_value;
double interval = 0.0, value;
int argc = SLang_Num_Function_Args;
if (SLang_peek_at_stack () == SLANG_REF_TYPE)
{
if (-1 == SLang_pop_ref (&value_ref))
return;
argc--;
if (SLang_peek_at_stack() == SLANG_REF_TYPE)
{
interval_ref = value_ref;
if (-1 == SLang_pop_ref (&value_ref))
goto free_and_return;
argc--;
}
}
switch (argc)
{
case 3:
if (-1 == SLang_pop_double (&interval))
goto free_and_return;
/* drop */
case 2:
default:
if ((-1 == SLang_pop_double (&value))
|| (-1 == SLang_pop_int (&w)))
goto free_and_return;
}
double_to_timeval (interval, &new_value.it_interval);
double_to_timeval (value, &new_value.it_value);
if (-1 == setitimer (w, &new_value, &old_value))
{
SLerrno_set_errno (errno);
SLang_verror (SL_OS_Error, "setitimer failed: %s", SLerrno_strerror (errno));
goto free_and_return;
}
if (value_ref != NULL)
{
value = timeval_to_double (&old_value.it_value);
if (-1 == SLang_assign_to_ref (value_ref, SLANG_DOUBLE_TYPE, &value))
goto free_and_return;
}
if (interval_ref != NULL)
{
interval = timeval_to_double (&old_value.it_interval);
if (-1 == SLang_assign_to_ref (interval_ref, SLANG_DOUBLE_TYPE, &interval))
goto free_and_return;
}
free_and_return:
if (value_ref != NULL)
SLang_free_ref (value_ref);
if (interval_ref != NULL)
SLang_free_ref (interval_ref);
}
/* Usage: get/setsockopt (socket, level, optname, value) */
static void getset_sockopt (int set)
{
Socket_Type *s;
SLFile_FD_Type *f;
int level, optname;
SockOpt_Type *table;
if (-1 == SLreverse_stack (SLang_Num_Function_Args))
return;
if (NULL == (s = pop_socket (&f)))
return;
if ((-1 == SLang_pop_int (&level))
|| (-1 == SLang_pop_int (&optname)))
{
SLfile_free_fd (f);
return;
}
switch (level)
{
#ifdef SOL_SOCKET
case SOL_SOCKET: table = SO_Option_Table; break;
#endif
#ifdef SOL_IP
case SOL_IP: table = IP_Option_Table; break;
#endif
default:
SLang_verror (SL_NotImplemented_Error, "get/setsockopt level %d is not supported", level);
goto free_return;
}
while (1)
{
if (table->optname == optname)
{
int (*func)(Socket_Type *, int, int);
if (set)
func = table->setopt;
else
func = table->getopt;
if (func == NULL)
goto not_implemented_error;
(void)(*func)(s, level, optname);
break;
}
if (table->optname == -1)
goto free_return;
table++;
}
/* drop */
free_return:
SLfile_free_fd (f);
return;
not_implemented_error:
SLang_verror (SL_NotImplemented_Error, "get/setsockopt option %d is not supported at level %d", optname, level);
SLfile_free_fd (f);
}
static void signal_intrinsic (void)
{
SLang_Name_Type *f;
Signal_Type *s;
void (*old_handler) (int);
SLang_Ref_Type *old_ref;
if (SLang_Num_Function_Args == 3)
{
if (-1 == SLang_pop_ref (&old_ref))
return;
}
else old_ref = NULL;
if (SLang_Num_Function_Args == 0)
{
SLang_verror (SL_Internal_Error, "signal called with 0 args");
return;
}
if (SLANG_INT_TYPE == SLang_peek_at_stack ())
{
int h;
if ((-1 == SLang_pop_int (&h))
|| (-1 == pop_signal (&s)))
{
SLang_free_ref (old_ref);
return;
}
/* If this signal has already been caught, deliver it now to the old handler */
if (s->pending)
handle_signal (s);
/* Note that the signal has the potential of being lost if the user has
* blocked its delivery. For this reason, the unblock_signal intrinsic
* will have to deliver the signal via an explicit kill if it is pending.
*/
if (h == SIG_IGN_CONSTANT)
old_handler = SLsignal_intr (s->sig, SIG_IGN);
else if (h == SIG_DFL_CONSTANT)
old_handler = SLsignal_intr (s->sig, SIG_DFL);
else if (h == SIG_APP_CONSTANT)
old_handler = SLsignal_intr (s->sig, s->c_handler);
else
{
SLang_free_ref (old_ref);
_pSLang_verror (SL_INVALID_PARM, "Signal handler '%d' is invalid", h);
return;
}
if (-1 == set_old_handler (s, old_ref, old_handler))
{
SLang_free_ref (old_ref);
return;
}
if (s->handler != NULL)
{
SLang_free_function (s->handler);
s->handler = NULL;
}
SLang_free_ref (old_ref);
return;
}
if (NULL == (f = SLang_pop_function ()))
{
SLang_free_ref (old_ref);
return;
}
if (-1 == pop_signal (&s))
{
SLang_free_ref (old_ref);
SLang_free_function (f);
return;
}
old_handler = SLsignal_intr (s->sig, signal_handler);
if (-1 == set_old_handler (s, old_ref, old_handler))
{
SLang_free_ref (old_ref);
SLang_free_function (f);
return;
}
if (s->handler != NULL)
SLang_free_function (s->handler);
s->handler = f;
SLang_free_ref (old_ref);
}
static void write_image (int flip)
{
char *file;
SLang_Array_Type *at;
int with_alpha = 0;
int has_with_alpha = 0;
int color_type;
void (*write_fun) (png_struct *, png_byte *, SLindex_Type, png_byte *);
if (SLang_Num_Function_Args == 3)
{
if (-1 == SLang_pop_int (&with_alpha))
return;
has_with_alpha = 1;
}
if (-1 == SLang_pop_array (&at, 0))
return;
if (at->num_dims != 2)
{
SLang_verror (SL_InvalidParm_Error, "Expecting a 2-d array");
SLang_free_array (at);
return;
}
switch (SLang_get_int_size (at->data_type))
{
case -8:
case 8:
if (with_alpha)
{
write_fun = write_gray_to_gray_alpha;
color_type = PNG_COLOR_TYPE_GRAY_ALPHA;
}
else
{
write_fun = write_gray_to_gray;
color_type = PNG_COLOR_TYPE_GRAY;
}
break;
case -16:
case 16:
if (has_with_alpha && (with_alpha == 0))
{
write_fun = write_gray_alpha_to_gray;
color_type = PNG_COLOR_TYPE_GRAY;
}
else
{
write_fun = write_gray_alpha_to_gray_alpha;
color_type = PNG_COLOR_TYPE_GRAY_ALPHA;
}
break;
case -32:
case 32:
if (with_alpha)
{
write_fun = write_rgb_alpha_to_rgb_alpha;
color_type = PNG_COLOR_TYPE_RGBA;
}
else
{
write_fun = write_rgb_to_rgb;
color_type = PNG_COLOR_TYPE_RGB;
}
break;
default:
SLang_verror (SL_InvalidParm_Error, "Expecting an 8, 16, or 32 bit integer array");
SLang_free_array (at);
return;
}
if (-1 == SLang_pop_slstring (&file))
{
SLang_free_array (at);
return;
}
(void) write_image_internal (file, at, color_type, write_fun, flip);
SLang_free_slstring (file);
SLang_free_array (at);
}
/* Usage: onig_search (o, str [start, end] [,option]) */
static int do_onig_search (void)
{
int start_pos = 0, end_pos = -1;
char *str, *str_end;
SLang_BString_Type *bstr = NULL;
Onig_Type *o;
SLang_MMT_Type *mmt;
int status = -1;
OnigOptionType option = ONIG_OPTION_NONE;
switch (SLang_Num_Function_Args)
{
default:
SLang_verror (SL_Usage_Error, "Usage: n = onig_search (compiled_pattern, str [,start_ofs, end_ofs] [,option])");
return -1;
case 5:
if (-1 == pop_onig_option (&option))
return -1;
/* drop */
case 4:
if (-1 == SLang_pop_int (&end_pos))
return -1;
if (-1 == SLang_pop_int (&start_pos))
return -1;
break;
case 3:
if (-1 == pop_onig_option (&option))
return -1;
break;
case 2:
break;
}
switch(SLang_peek_at_stack())
{
case SLANG_STRING_TYPE:
if (-1 == SLang_pop_slstring (&str))
return -1;
str_end = str + strlen (str);
break;
case SLANG_BSTRING_TYPE:
default:
{
unsigned int len;
if (-1 == SLang_pop_bstring(&bstr))
return -1;
str = (char *)SLbstring_get_pointer(bstr, &len);
if (str == NULL)
{
SLbstring_free (bstr);
return -1;
}
str_end = str + len;
}
break;
}
if (end_pos < 0)
end_pos = (int) (str_end - str);
if (NULL == (mmt = SLang_pop_mmt (Onig_Type_Id)))
goto free_and_return;
o = (Onig_Type *)SLang_object_from_mmt (mmt);
status = do_onig_search_internal (o, option, (UChar *)str, (UChar *)str_end, start_pos, end_pos);
if (status >= 0)
{
o->match_pos = status;
status = o->region->num_regs;
goto free_and_return;
}
o->match_pos = -1;
if (status == -1)
{ /* no match */
status = 0;
goto free_and_return;
}
/* Else an error occurred */
/* drop */
free_and_return:
SLang_free_mmt (mmt);
if (bstr != NULL)
SLbstring_free (bstr);
else
SLang_free_slstring (str);
return status;
}
static int rl_complete (SLrline_Type *rli)
{
char *line;
unsigned int i, n, nbytes;
char **strings, *str0, ch0;
int start_point, delta;
SLang_Array_Type *at;
SLang_Name_Type *completion_callback;
SLang_Name_Type *list_completions_callback;
if (NULL == (completion_callback = rli->completion_callback))
{
completion_callback = Default_Completion_Callback;
if (completion_callback == NULL)
return SLrline_ins (rli, "\t", 1);
}
if (NULL == (list_completions_callback = rli->list_completions_callback))
list_completions_callback = Default_List_Completions_Callback;
if (NULL == (line = SLrline_get_line (rli)))
return -1;
if ((-1 == SLang_start_arg_list ())
|| (-1 == SLang_push_string (line))
|| (-1 == SLang_push_int (rli->point))
|| (-1 == SLang_end_arg_list ())
|| (-1 == SLexecute_function (completion_callback)))
{
SLfree (line);
return -1;
}
SLfree (line);
if (-1 == SLang_pop_int (&start_point))
return -1;
if (start_point < 0)
start_point = 0;
if (-1 == SLang_pop_array_of_type (&at, SLANG_STRING_TYPE))
return -1;
strings = (char **) at->data;
n = at->num_elements;
if (n == 0)
{
SLang_free_array (at);
return 0;
}
if ((n != 1) && (list_completions_callback != NULL))
{
if ((-1 == SLang_start_arg_list ())
|| (-1 == SLang_push_array (at, 0))
|| (-1 == SLang_end_arg_list ())
|| (-1 == SLexecute_function (list_completions_callback)))
{
SLang_free_array (at);
return -1;
}
(void) SLrline_redraw (rli);
}
str0 = strings[0];
nbytes = 0;
while (0 != (ch0 = str0[nbytes]))
{
for (i = 1; i < n; i++)
{
char ch1 = strings[i][nbytes];
if (ch0 != ch1)
break;
}
if (i != n)
break;
nbytes++;
}
delta = start_point - rli->point;
if (delta < 0)
{
(void) SLrline_move (rli, delta);
delta = -delta;
}
(void) SLrline_del (rli, (unsigned int) delta);
(void) SLrline_ins (rli, str0, nbytes);
/* How should the completion be ended?
* "foo/ --> "foo/
* "foo/bar --> "foo/bar"
* "foo --> "foo"
* foo --> fooSPACE
* foo/bar --> fooSPACE
*/
if ((n == 1)
&& nbytes && (str0[nbytes-1] != '/') && (str0[nbytes-1] != '\\'))
{
char qch = ' ';
if (start_point > 0)
{
ch0 = rli->buf[start_point-1];
if ((ch0 == '"') || (ch0 == '\''))
qch = ch0;
}
if (qch != 0)
(void) SLrline_ins (rli, &qch, 1);
}
SLang_free_array (at);
return 0;
}