static void alarm_intrinsic (void) { #ifndef HAVE_ALARM SLang_set_error (SL_NotImplemented_Error); #else SLang_Ref_Type *ref = NULL; unsigned int secs; Signal_Type *s; if (SLang_Num_Function_Args == 2) { if (-1 == SLang_pop_ref (&ref)) return; } if (-1 == SLang_pop_uint (&secs)) { SLang_free_ref (ref); /* NULL ok */ return; } #ifdef SIGALRM if ((NULL != (s = find_signal (SIGALRM))) && s->forbidden) { SLang_set_error (SL_Forbidden_Error); return; } #endif secs = alarm (secs); if (ref != NULL) (void) SLang_assign_to_ref (ref, SLANG_UINT_TYPE, &secs); #endif }
static void read_image (int flipped) { int color_type; char *file; SLang_Ref_Type *ref = NULL; SLang_Array_Type *at; if ((SLang_Num_Function_Args == 2) && (-1 == SLang_pop_ref (&ref))) return; if (-1 == SLang_pop_slstring (&file)) { file = NULL; goto free_return; } if (NULL == (at = read_image_internal (file, flipped, &color_type))) goto free_return; if ((ref != NULL) && (-1 == SLang_assign_to_ref (ref, SLANG_INT_TYPE, &color_type))) { SLang_free_array (at); goto free_return; } (void) SLang_push_array (at, 1); free_return: SLang_free_slstring (file); if (ref != NULL) SLang_free_ref (ref); }
SLang_Name_Type *SLang_pop_function (void) { SLang_Ref_Type *ref; SLang_Name_Type *f; if (SLang_peek_at_stack () == SLANG_STRING_TYPE) { char *name; if (-1 == SLang_pop_slstring (&name)) return NULL; if (NULL == (f = SLang_get_function (name))) { _pSLang_verror (SL_UNDEFINED_NAME, "Function %s does not exist", name); SLang_free_slstring (name); return NULL; } SLang_free_slstring (name); return f; } if (-1 == SLang_pop_ref (&ref)) return NULL; f = SLang_get_fun_from_ref (ref); SLang_free_ref (ref); return f; }
static void sl_ssl_read(void){ SLssl_Type *ssl; SLang_MMT_Type *sslmmt; SLang_Ref_Type *buff; void *ibuff; SLang_BString_Type *data; int r, rlen; if (SLang_pop_integer(&rlen)==-1 || SLang_pop_ref(&buff)==-1 || NULL==(sslmmt=SLang_pop_mmt(SLssl_Type_Id))) return; ssl=(SLssl_Type *)SLang_object_from_mmt(sslmmt); ibuff=(void *)malloc(rlen); r=SSL_read((SSL *)ssl->ssl,ibuff,rlen); data=SLbstring_create((unsigned char *)ibuff,r); SLang_assign_to_ref(buff, SLANG_BSTRING_TYPE, (VOID_STAR)&data); if (r>=0) SLang_push_integer(r); else SLang_verror(r,"SSL read returned error code %d", SSL_get_error((SSL *)ssl->ssl,r)); SLang_free_ref(buff); }
static void accept_intrin (void) { SLFile_FD_Type *f; Socket_Type *s, *s1; Domain_Methods_Type *methods; int nargs = SLang_Num_Function_Args; SLang_Ref_Type *refs[MAX_ACCEPT_REF_ARGS]; int i; if (nargs <= 0) { SLang_verror (SL_Usage_Error, "s1 = accept (s [,&v...])"); return; } if (-1 == SLroll_stack (-nargs)) return; if (NULL == (s = pop_socket (&f))) return; nargs--; if (nargs > MAX_ACCEPT_REF_ARGS) { SLang_verror (SL_NumArgs_Error, "accept: too many reference args"); SLfile_free_fd (f); } memset ((char *)refs, 0, sizeof (refs)); i = nargs; while (i != 0) { i--; if (-1 == SLang_pop_ref (refs+i)) goto free_return; } methods = s->methods; if (NULL != (s1 = (*methods->accept)(s, nargs, refs))) (void) push_socket (s1); /* frees it upon error */ /* drop */ free_return: for (i = 0; i < nargs; i++) { if (refs[i] != NULL) SLang_free_ref (refs[i]); } SLfile_free_fd (f); }
static int is_callable_intrinsic (void) { SLang_Ref_Type *ref; int ret; if (SLang_peek_at_stack () != SLANG_REF_TYPE) { (void) SLdo_pop (); return 0; } if (-1 == SLang_pop_ref (&ref)) return -1; ret = _pSLang_ref_is_callable (ref); SLang_free_ref (ref); return ret; }
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 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); }
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); }
/* FIXME: This function does not handle LONG_LONG */ int _pSLang_sscanf (void) { int num; unsigned int num_refs; char *format; char *input_string, *input_string_max; SLFUTURE_CONST char *f, *s; unsigned char map8[256], map10[256], map16[256]; if (SLang_Num_Function_Args < 2) { _pSLang_verror (SL_INVALID_PARM, "Int_Type sscanf (str, format, ...)"); return -1; } num_refs = (unsigned int) SLang_Num_Function_Args; if (-1 == SLreverse_stack (num_refs)) return -1; num_refs -= 2; if (-1 == SLang_pop_slstring (&input_string)) return -1; if (-1 == SLang_pop_slstring (&format)) { SLang_free_slstring (input_string); return -1; } f = format; s = input_string; input_string_max = input_string + strlen (input_string); init_map (map8, 8); init_map (map10, 10); init_map (map16, 16); num = 0; while (num_refs != 0) { SLang_Object_Type obj; SLang_Ref_Type *ref; SLFUTURE_CONST char *smax; unsigned char *map; int base; int no_assign; int is_short; int is_long; int status; char chf; unsigned int width; int has_width; chf = *f++; if (chf == 0) { /* Hmmm.... what is the most useful thing to do?? */ #if 1 break; #else _pSLang_verror (SL_INVALID_PARM, "sscanf: format not big enough for output list"); goto return_error; #endif } if (isspace (chf)) { char *s1 = _pSLskip_whitespace (s); if (s1 == s) break; s = s1; continue; } if ((chf != '%') || ((chf = *f++) == '%')) { if (*s != chf) break; s++; continue; } no_assign = 0; is_short = 0; is_long = 0; width = 0; smax = input_string_max; /* Look for the flag character */ if (chf == '*') { no_assign = 1; chf = *f++; } /* Width */ has_width = isdigit (chf); if (has_width) { f--; (void) parse_uint (&f, f + strlen(f), &width, 10, map10); chf = *f++; } /* Now the type modifier */ switch (chf) { case 'h': is_short = 1; chf = *f++; break; case 'L': /* not implemented */ case 'l': is_long = 1; chf = *f++; break; } status = -1; if ((chf != 'c') && (chf != '[')) { s = _pSLskip_whitespace (s); if (*s == 0) break; } if (has_width) { if (width > (unsigned int) (input_string_max - s)) width = (unsigned int) (input_string_max - s); smax = s + width; } /* Now the format descriptor */ map = map10; base = 10; try_again: /* used by i, x, and o, conversions */ switch (chf) { case 0: _pSLang_verror (SL_INVALID_PARM, "sscanf: Unexpected end of format"); goto return_error; case 'D': is_long = 1; case 'd': if (is_short) { obj.o_data_type = SLANG_SHORT_TYPE; status = parse_short (&s, smax, &obj.v.short_val, base, map); } else if (is_long) { obj.o_data_type = SLANG_LONG_TYPE; status = parse_long (&s, smax, &obj.v.long_val, base, map); } else { obj.o_data_type = SLANG_INT_TYPE; status = parse_int (&s, smax, &obj.v.int_val, base, map); } break; case 'U': is_long = 1; case 'u': if (is_short) { obj.o_data_type = SLANG_USHORT_TYPE; status = parse_ushort (&s, smax, &obj.v.ushort_val, base, map); } else if (is_long) { obj.o_data_type = SLANG_ULONG_TYPE; status = parse_ulong (&s, smax, &obj.v.ulong_val, base, map); } else { obj.o_data_type = SLANG_INT_TYPE; status = parse_uint (&s, smax, &obj.v.uint_val, base, map); } break; case 'I': is_long = 1; case 'i': if ((s + 1 >= smax) || (*s != 0)) chf = 'd'; else if (((s[1] == 'x') || (s[1] == 'X')) && (s + 2 < smax)) { s += 2; chf = 'x'; } else chf = 'o'; goto try_again; case 'O': is_long = 1; case 'o': map = map8; base = 8; chf = 'd'; goto try_again; case 'X': is_long = 1; case 'x': base = 16; map = map16; chf = 'd'; goto try_again; case 'E': case 'F': is_long = 1; case 'e': case 'f': case 'g': #if SLANG_HAS_FLOAT if (is_long) { obj.o_data_type = SLANG_DOUBLE_TYPE; status = parse_double (&s, smax, &obj.v.double_val); } else { obj.o_data_type = SLANG_FLOAT_TYPE; status = parse_float (&s, smax, &obj.v.float_val); } #else _pSLang_verror (SL_NOT_IMPLEMENTED, "This version of the S-Lang does not support floating point"); status = -1; #endif break; case 's': obj.o_data_type = SLANG_STRING_TYPE; status = parse_string (&s, smax, &obj.v.s_val); break; case 'c': if (has_width == 0) { obj.o_data_type = SLANG_UCHAR_TYPE; obj.v.uchar_val = *s++; status = 1; break; } obj.o_data_type = SLANG_STRING_TYPE; status = parse_bstring (&s, smax, &obj.v.s_val); break; case '[': obj.o_data_type = SLANG_STRING_TYPE; status = parse_range (&s, smax, &f, &obj.v.s_val); break; case 'n': obj.o_data_type = SLANG_UINT_TYPE; obj.v.uint_val = (unsigned int) (s - input_string); status = 1; break; default: status = -1; _pSLang_verror (SL_NOT_IMPLEMENTED, "format specifier '%c' is not supported", chf); break; } if (status == 0) break; if (status == -1) goto return_error; if (no_assign) { SLang_free_object (&obj); continue; } if (-1 == SLang_pop_ref (&ref)) { SLang_free_object (&obj); goto return_error; } if (-1 == SLang_push (&obj)) { SLang_free_object (&obj); SLang_free_ref (ref); goto return_error; } if (-1 == _pSLang_deref_assign (ref)) { SLang_free_ref (ref); goto return_error; } SLang_free_ref (ref); num++; num_refs--; } if (-1 == SLdo_pop_n (num_refs)) goto return_error; SLang_free_slstring (format); SLang_free_slstring (input_string); return num; return_error: /* NULLS ok */ SLang_free_slstring (format); SLang_free_slstring (input_string); return -1; }