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; }
static void termios_set_cc (void) { SLang_Array_Type *at; SLang_MMT_Type *mmt; struct termios *s; unsigned char *at_data; int i; if (-1 == SLang_pop_array_of_type (&at, SLANG_UCHAR_TYPE)) return; if (NULL == (mmt = SLang_pop_mmt (Termios_Type_Id))) goto free_and_return; s = (struct termios *) SLang_object_from_mmt (mmt); if (at->num_elements != NCCS) { SLang_verror (SL_TYPE_MISMATCH, "Expecting UChar_Type[%d]", NCCS); goto free_and_return; } at_data = (unsigned char *) at->data; for (i = 0; i < NCCS; i++) s->c_cc[i] = at_data[i]; /* drop */ free_and_return: SLang_free_array (at); SLang_free_mmt (mmt); }
/* This function gets called when the fclose intrinsic is called on an fdopen * derived object. */ void _pSLfclose_fdopen_fp (SLang_MMT_Type *mmt) { SLFile_FD_Type *f; f = FD_Type_List; while (f != NULL) { Stdio_MMT_List_Type *prev, *curr; prev = NULL; curr = f->stdio_mmt_list; while (curr != NULL) { if (curr->stdio_mmt != mmt) { prev = curr; curr = curr->next; continue; } if (prev == NULL) f->stdio_mmt_list = curr->next; else prev->next = curr->next; SLang_free_mmt (mmt); SLfree ((char *) curr); return; } f = f->next; } }
static void cl_foreach_close (SLtype type, SLang_Foreach_Context_Type *c) { (void) type; if (c == NULL) return; SLang_free_mmt (c->mmt); SLfree ((char *) c); }
static void posix_fileno (void) { FILE *fp; SLang_MMT_Type *mmt; int fd; SLFile_FD_Type *f; SLFUTURE_CONST char *name; if (-1 == SLang_pop_fileptr (&mmt, &fp)) { SLang_push_null (); return; } name = SLang_get_name_from_fileptr (mmt); fd = fileno (fp); f = SLfile_create_fd (name, fd); if (f != NULL) { /* prevent fd from being closed when it goes out of scope */ f->flags |= _SLFD_NO_AUTO_CLOSE; f->close = dummy_close; } SLang_free_mmt (mmt); if (-1 == SLfile_push_fd (f)) SLang_push_null (); SLfile_free_fd (f); }
static int posix_fileno_int (void) { int fd; SLFile_FD_Type *f; if (SLang_peek_at_stack () == SLANG_FILE_PTR_TYPE) { SLang_MMT_Type *mmt; FILE *fp; if (-1 == SLang_pop_fileptr (&mmt, &fp)) return -1; fd = fileno (fp); SLang_free_mmt (mmt); return fd; } if (-1 == SLfile_pop_fd (&f)) return -1; if (-1 == get_fd (f, &fd)) fd = -1; SLfile_free_fd (f); return fd; }
static int pop_index (unsigned int num_indices, SLang_MMT_Type **mmt, SLang_Assoc_Array_Type **a, SLstr_Type **str, unsigned long *hashp) { /* if (NULL == (*mmt = SLang_pop_mmt (SLANG_ASSOC_TYPE))) */ if (-1 == SLclass_pop_ptr_obj (SLANG_ASSOC_TYPE, (VOID_STAR *) mmt)) { *a = NULL; *str = NULL; return -1; } if ((num_indices != 1) || (-1 == SLang_pop_slstring (str))) { _pSLang_verror (SL_NOT_IMPLEMENTED, "Assoc_Type arrays require a single string index"); SLang_free_mmt (*mmt); *mmt = NULL; *a = NULL; *str = NULL; return -1; } /* *a = (SLang_Assoc_Array_Type *) SLang_object_from_mmt (*mmt); */ *a = (SLang_Assoc_Array_Type *) (*mmt)->user_data; *hashp = _pSLstring_get_hash (*str); return 0; }
static void posix_ttyname (void) { SLFile_FD_Type *f; SLang_MMT_Type *mmt; int fd; char buf[512]; int e; if (SLang_Num_Function_Args == 0) { fd = 0; f = NULL; mmt = NULL; } else if (-1 == pop_fd (&fd, &f, &mmt)) return; if (0 != (e = TTYNAME_R (fd, buf, sizeof(buf)))) { _pSLerrno_errno = e; SLang_push_null (); } else (void) SLang_push_string (buf); if (mmt != NULL) SLang_free_mmt (mmt); if (f != NULL) SLfile_free_fd (f); }
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 void _iconv_open(char *tocode, char *fromcode) { iconv_t cd; SLang_MMT_Type *mmt; cd = iconv_open(tocode, fromcode); if (cd == (iconv_t)(-1)) { SLang_verror (SL_INTRINSIC_ERROR, "Error preparing iconv to convert from '%s' to '%s'.", fromcode, tocode); return; } if (NULL == (mmt = allocate_iconv_type (cd))) { iconv_close(cd); return; } if (-1 == SLang_push_mmt (mmt)) { SLang_free_mmt (mmt); return; } return; }
static void sl_ssl_client (void){ // create an ssl object and return the memory managed type back to // SLang. It needs the file descriptor of the object upon which // communication will occur, and the protocol to use. // SSL_CTX *ctx; SSL *ssl; int proto, cret; SLang_MMT_Type *mmt, *sslmmt; SLsslctx_Type *slctx; char *cadir=NULL, *cafile=NULL; if (SLang_Num_Function_Args == 3) if (SLang_pop_slstring(&cadir) == -1) return; if (SLang_Num_Function_Args > 1) if (SLANG_NULL_TYPE==SLang_peek_at_stack()) SLdo_pop(); else if (SLang_pop_slstring(&cafile) == -1) goto free; if (SLang_pop_integer(&proto) == -1) goto free; if (proto==SSL_PROTO_SSL2) ctx = SSL_CTX_new(SSLv23_client_method()); else if (proto==SSL_PROTO_SSL3) ctx = SSL_CTX_new(SSLv3_client_method()); else if (proto==SSL_PROTO_TLS1) ctx = SSL_CTX_new(TLSv1_client_method()); else if (proto==SSL_PROTO_ANY) ctx = SSL_CTX_new(SSLv23_client_method()); cret = SSL_CTX_load_verify_locations(ctx, cafile, cadir); if (cret == 0 && SLang_Num_Function_Args > 1){ SLang_verror(SL_APPLICATION_ERROR, "Failed to load CA file or path"); goto free; } slctx = (SLsslctx_Type *)malloc(sizeof(SLsslctx_Type)); slctx->is_server = 0; slctx->ctx = (void *)ctx; sslmmt = SLang_create_mmt(SLsslctx_Type_Id, (VOID_STAR) slctx); if (0!=SLang_push_mmt(sslmmt)) SLang_free_mmt(sslmmt); free: if (NULL!=cadir) SLang_free_slstring(cadir); if (NULL!=cafile) SLang_free_slstring(cafile); }
static void test_pop_mmt (void) { SLang_MMT_Type *mmt; if (NULL == (mmt = SLang_pop_mmt (SLang_peek_at_stack ()))) return; if (-1 == SLang_push_mmt (mmt)) SLang_free_mmt (mmt); }
static SLang_MMT_Type *pop_sri_type (Slsh_Readline_Type **srip) { SLang_MMT_Type *mmt; if (NULL == (mmt = SLang_pop_mmt (Rline_Type_Id))) return NULL; if (NULL == (*srip = (Slsh_Readline_Type *)SLang_object_from_mmt (mmt))) { SLang_free_mmt (mmt); return NULL; } return mmt; }
static void free_cb_info (Rline_CB_Type *cb) { if (cb == NULL) return; if (cb->mmt != NULL) SLang_free_mmt (cb->mmt); if (cb->update_hook != NULL) SLang_free_function (cb->update_hook); if (cb->clear_cb != NULL) SLang_free_function (cb->clear_cb); if (cb->preread_cb != NULL) SLang_free_function (cb->preread_cb); if (cb->postread_cb != NULL) SLang_free_function (cb->postread_cb); if (cb->width_cb != NULL) SLang_free_function (cb->width_cb); if (cb->cd != NULL) SLang_free_anytype (cb->cd); SLfree ((char *)cb); }
static SLang_MMT_Type *pop_rli_type (SLang_RLine_Info_Type **rlip) { SLang_MMT_Type *mmt; if (NULL == (mmt = SLang_pop_mmt (Rline_Type_Id))) return NULL; if (NULL == (*rlip = (SLang_RLine_Info_Type *)SLang_object_from_mmt (mmt))) { SLang_free_mmt (mmt); return NULL; } return mmt; }
static void free_stdio_mmts (SLFile_FD_Type *f) { Stdio_MMT_List_Type *curr = f->stdio_mmt_list; while (curr != NULL) { Stdio_MMT_List_Type *next = curr->next; SLang_free_mmt (curr->stdio_mmt); SLfree ((char *) curr); curr = next; } f->stdio_mmt_list = NULL; }
static void readline_noecho_intrinsic (char *prompt) { Slsh_Readline_Type *sri = NULL; SLang_MMT_Type *mmt = NULL; if (SLang_Num_Function_Args == 2) { if (NULL == (mmt = pop_sri_type (&sri))) return; } (void) readline_intrinsic_internal (sri, prompt, 1); if (mmt != NULL) SLang_free_mmt (mmt); }
static void readline_noecho_intrinsic (char *prompt) { SLang_RLine_Info_Type *rli = NULL; SLang_MMT_Type *mmt = NULL; if (SLang_Num_Function_Args == 2) { if (NULL == (mmt = pop_rli_type (&rli))) return; } (void) readline_intrinsic_internal (rli, prompt, 1); if (mmt != NULL) SLang_free_mmt (mmt); }
static void tcgetattr_intrin (SLFile_FD_Type *f) { struct termios s; SLang_MMT_Type *mmt; if (-1 == DO_SYSCALL_STRUCT_1(tcgetattr,f,&s)) { SLang_push_null (); return; } mmt = allocate_termios (&s); /* NULL ok */ if (-1 == SLang_push_mmt (mmt)) SLang_free_mmt (mmt); }
static int push_onig_type (Onig_Type *o) { SLang_MMT_Type *mmt; if (NULL == (mmt = SLang_create_mmt (Onig_Type_Id, (VOID_STAR) o))) { free_onig_type (o); return -1; } if (-1 == SLang_push_mmt (mmt)) { SLang_free_mmt (mmt); return -1; } return 0; }
static void new_slrline_intrinsic (char *name) { SLang_RLine_Info_Type *rli; SLang_MMT_Type *mmt; if (NULL == (rli = SLrline_open2 (name, SLtt_Screen_Cols, SL_RLINE_BLINK_MATCH))) return; if (NULL == (mmt = SLang_create_mmt (Rline_Type_Id, (VOID_STAR) rli))) { SLrline_close (rli); return; } if (-1 == SLang_push_mmt (mmt)) SLang_free_mmt (mmt); }
static void new_slrline_intrinsic (char *name) { Slsh_Readline_Type *sri; SLang_MMT_Type *mmt; if (NULL == (sri = open_slsh_readline (name, SL_RLINE_BLINK_MATCH))) return; if (NULL == (mmt = SLang_create_mmt (Rline_Type_Id, (VOID_STAR) sri))) { close_slsh_readline (sri); return; } if (-1 == SLang_push_mmt (mmt)) SLang_free_mmt (mmt); }
int _pSLassoc_aget (SLtype type, unsigned int num_indices) { unsigned long hash; SLang_MMT_Type *mmt; SLstr_Type *str; _pSLAssoc_Array_Element_Type *e; SLang_Assoc_Array_Type *a; SLang_Object_Type *obj; int ret; (void) type; if (-1 == pop_index (num_indices, &mmt, &a, &str, &hash)) return -1; e = find_element (a, str, hash); if (e == NULL) { if (a->flags & HAS_DEFAULT_VALUE) obj = &a->default_value; else { ret = -1; _pSLang_verror (SL_INTRINSIC_ERROR, "No such element in Assoc Array: %s", str); goto free_and_return; } } else obj = &e->value; #if SLANG_OPTIMIZE_FOR_SPEED if (a->is_scalar_type) ret = SLang_push (obj); else #endif ret = _pSLpush_slang_obj (obj); free_and_return: _pSLang_free_slstring (str); SLang_free_mmt (mmt); return ret; }
static int assoc_anew (SLtype type, unsigned int num_dims) { SLang_MMT_Type *mmt; SLang_Assoc_Array_Type *a; int has_default_value; has_default_value = 0; switch (num_dims) { case 0: type = SLANG_ANY_TYPE; break; case 2: (void) SLreverse_stack (2); has_default_value = 1; /* drop */ case 1: if (0 == SLang_pop_datatype (&type)) break; num_dims--; /* drop */ default: SLdo_pop_n (num_dims); _pSLang_verror (SL_SYNTAX_ERROR, "Usage: Assoc_Type [DataType_Type]"); return -1; } a = alloc_assoc_array (type, has_default_value); if (a == NULL) return -1; if (NULL == (mmt = SLang_create_mmt (SLANG_ASSOC_TYPE, (VOID_STAR) a))) { delete_assoc_array (a); return -1; } if (-1 == SLang_push_mmt (mmt)) { SLang_free_mmt (mmt); return -1; } return 0; }
static int posix_isatty (void) { int ret; SLFile_FD_Type *f; SLang_MMT_Type *mmt; int fd; if (-1 == pop_fd (&fd, &f, &mmt)) return 0; /* invalid descriptor */ if (0 == (ret = isatty (fd))) _pSLerrno_errno = errno; if (mmt != NULL) SLang_free_mmt (mmt); if (f != NULL) SLfile_free_fd (f); return ret; }
static int termios_dereference (SLtype type, VOID_STAR addr) { struct termios *s; SLang_MMT_Type *mmt; (void) type; mmt = *(SLang_MMT_Type **) addr; if (NULL == (s = (struct termios *)SLang_object_from_mmt (mmt))) return -1; mmt = allocate_termios (s); if (-1 == SLang_push_mmt (mmt)) { SLang_free_mmt (mmt); return -1; } return 0; }
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 void sl_ssl_connect (void){ int fd; SLFile_FD_Type *slfd; SLsslctx_Type *ctx; SLssl_Type *slssl; SSL *ssl; SLang_MMT_Type *sslmmt; SLang_MMT_Type *sslmmto; if (SLfile_pop_fd(&slfd) == -1) return; if (NULL==(sslmmt=SLang_pop_mmt(SLsslctx_Type_Id))) return; SLfile_get_fd(slfd,&fd); SLfile_free_fd(slfd); ctx = (SLsslctx_Type *)SLang_object_from_mmt(sslmmt); // create the ssl object ssl = SSL_new((SSL_CTX *)ctx->ctx); // set the file descriptor for input/output if (0==SSL_set_fd(ssl,fd)){ return; } // fprintf(stderr,"Set client socket fd to %d\n",fd); slssl = (SLssl_Type *)malloc(sizeof(SLssl_Type)); slssl->ssl = (void *) ssl; slssl->is_server = ctx->is_server; sslmmt = SLang_create_mmt(SLssl_Type_Id, (VOID_STAR) slssl); if (0==SLang_push_mmt(sslmmt)) return; SLang_free_mmt(sslmmt); }
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); }
int _pSLassoc_aput (SLtype type, unsigned int num_indices) { SLang_MMT_Type *mmt; SLstr_Type *str; SLang_Assoc_Array_Type *a; int ret; unsigned long hash; (void) type; if (-1 == pop_index (num_indices, &mmt, &a, &str, &hash)) return -1; if (NULL == assoc_aput (a, NULL, str, hash)) ret = -1; else ret = 0; _pSLang_free_slstring (str); SLang_free_mmt (mmt); return ret; }