caValue* selector_advance(caValue* value, caValue* selectorElement, caValue* error) { if (is_int(selectorElement)) { int selectorIndex = as_int(selectorElement); if (!is_list(value)) { set_error_string(error, "Value is not indexable: "); string_append_quoted(error, value); return NULL; } if (selectorIndex >= list_length(value)) { set_error_string(error, "Index "); string_append(error, selectorIndex); string_append(error, " is out of range"); return NULL; } return get_index(value, selectorIndex); } else if (is_string(selectorElement)) { caValue* field = get_field(value, as_cstring(selectorElement)); if (field == NULL) { set_error_string(error, "Field not found: "); string_append(error, selectorElement); return NULL; } return field; } else { set_error_string(error, "Unrecognized selector element: "); string_append_quoted(error, selectorElement); return NULL; } }
static void dump_element(int to, void *to_arg, Eterm x) { if (is_list(x)) { erts_print(to, to_arg, "H" PTR_FMT, list_val(x)); } else if (is_boxed(x)) { erts_print(to, to_arg, "H" PTR_FMT, boxed_val(x)); } else if (is_immed(x)) { if (is_atom(x)) { unsigned char* s = atom_tab(atom_val(x))->name; int len = atom_tab(atom_val(x))->len; int i; erts_print(to, to_arg, "A%X:", atom_tab(atom_val(x))->len); for (i = 0; i < len; i++) { erts_putc(to, to_arg, *s++); } } else if (is_small(x)) { erts_print(to, to_arg, "I%T", x); } else if (is_pid(x)) { erts_print(to, to_arg, "P%T", x); } else if (is_port(x)) { erts_print(to, to_arg, "p<%beu.%beu>", port_channel_no(x), port_number(x)); } else if (is_nil(x)) { erts_putc(to, to_arg, 'N'); } } }
static bool file_source_is_filesystem_backed(Value* file_source) { return is_list(file_source) && (list_length(file_source) >= 1) && (is_symbol(list_get(file_source, 0))) && (as_symbol(list_get(file_source, 0)) == s_Filesystem); }
term_t cbif_spawn3(proc_t *proc, term_t *regs) { term_t m = regs[0]; term_t f = regs[1]; term_t args = regs[2]; if (!is_atom(m)) badarg(m); if (!is_atom(f)) badarg(f); if (!is_list(args)) badarg(args); if (list_len(args) < 0) badarg(args); // too odd proc_t *new_proc = proc_make(proc->group_leader); int x = proc_spawn_N(new_proc, m, f, args); if (x < 0) { proc_destroy(new_proc); // safe fail(err_to_term(x)); } return new_proc->pid; }
const char *tiz_rcfile_get_value (const char *ap_section, const char *ap_key) { keyval_t *p_kv = NULL; tiz_rcfile_t *p_rc = tiz_rcfile_get_handle (); if (NULL == p_rc) { return NULL; } assert (ap_section); assert (ap_key); assert (is_list (ap_key) == false); TIZ_LOG (TIZ_PRIORITY_TRACE, "Retrieving value for Key [%s] in section [%s]", ap_key, ap_section); p_kv = find_node (p_rc, ap_key); if (p_kv && p_kv->p_value_list) { return p_kv->p_value_list->p_value; } return NULL; }
BIF_RETTYPE unique_integer_1(BIF_ALIST_1) { Eterm modlist = BIF_ARG_1; int monotonic = 0; int positive = 0; BIF_RETTYPE res; while (is_list(modlist)) { Eterm *consp = list_val(modlist); switch (CAR(consp)) { case am_monotonic: monotonic = 1; break; case am_positive: positive = 1; break; default: BIF_ERROR(BIF_P, BADARG); } modlist = CDR(consp); } if (is_not_nil(modlist)) BIF_ERROR(BIF_P, BADARG); if (monotonic) res = unique_monotonic_integer_bif(BIF_P, positive); else res = unique_integer_bif(BIF_P, positive); BIF_RET(res); }
static void proc_hash(Term t) { if(is_list(t)) { for(;t;t=ListTail(t)) proc_hash(ListFirst(t)); return; } if(is_compound(t)) { int i; for(i=1;i<=CompoundArity(t);i++) { Term t1=CompoundArgN(t,i); if(is_compound(t1)&&CompoundName(t1)==OPR_HASH) { char cbuf[1024]; int n=0; List l,al; t1=ConsumeCompoundArg(t,i); al=OperToList(t1,OPR_HASH); for(l=al;l;l=ListTail(l)) n+=sWriteTerm(cbuf+n,ListFirst(l)); FreeAtomic(al); SetCompoundArg(t,i,NewAtom(cbuf,0)); } else proc_hash(t1); } } return; }
void print_ptree(std::ostream& os, const boost::property_tree::ptree& pt, int depth) { typedef bp::ptree::const_iterator c_it; if(pt.empty()) os << "'" << pt.data() << "'\n"; else { std::string pad(""); pad.assign(depth*4,' '); ++depth; std::string pad2 = pad + " "; if(is_list(pt)) { os << "[\n"; for(c_it it=pt.begin(); it!=pt.end(); ++it) { os << pad2; print_ptree(os, it->second, depth); } os << pad << "]\n"; } else { os << "{\n"; for(c_it it=pt.begin(); it!=pt.end(); ++it) { os << pad2 << "'" << it->first << "': "; print_ptree(os, it->second, depth); } os << pad << "}\n"; } } }
term_t cbif_sha_update2(proc_t *proc, term_t *regs) { term_t Context = regs[0]; term_t Data = regs[1]; if (!is_boxed_binary(Context)) badarg(Context); bits_t bs, dst; bits_get_real(peel_boxed(Context), &bs); if (bs.ends -bs.starts != sizeof(struct sha1_ctx) *8) badarg(Context); struct sha1_ctx ctx; bits_init_buf((uint8_t *)&ctx, sizeof(ctx), &dst); bits_copy(&bs, &dst); if (!is_boxed_binary(Data) && !is_list(Data)) badarg(Data); int sz = iolist_size(Data); if (sz < 0) badarg(Data); assert(sz <= 65536); //TODO: use heap_tmp_buf for larger Data uint8_t buf[sz]; iolist_flatten(Data, buf); sha1_update(&ctx, sz, buf); uint8_t *ptr; term_t bin = heap_make_bin(&proc->hp, sizeof(ctx), &ptr); memcpy(ptr, &ctx, sizeof(ctx)); return bin; }
static void lablist(Term t) { if(is_list(t)) { List l; for(l=t;l;l=ListTail(l)) { Term m=ListFirst(l); if(is_label(m) && !ListMember(labl,m)) labl=AppendFirst(labl,m); else lablist(m); } } if(is_compound(t)) { int i; for(i=1;i<=CompoundArity(t);i++) { Term m=CompoundArgN(t,i); if(is_label(m) && !ListMember(labl,m)) labl=AppendFirst(labl,m); else lablist(m); } } }
static void chlabs(Term t) { if(is_list(t)) { List l; for(l=t;l;l=ListTail(l)) { Term m=ListFirst(l); if(is_label(m)) ChangeList(l,ListNth(labm,ListMember(labl,m))); else chlabs(m); } } if(is_compound(t)) { int i; for(i=1;i<=CompoundArity(t);i++) { Term m=CompoundArgN(t,i); if(is_label(m)) SetCompoundArg(t,i,ListNth(labm,ListMember(labl,m))); else chlabs(m); } } }
NODE *lbutlast(NODE *args) { NODE *val = UNBOUND, *lastnode = NIL, *tnode, *arg; arg = bfable_arg(args); if (NOT_THROWING) { if (is_list(arg)) { args = arg; val = NIL; while (cdr(args) != NIL) { tnode = cons(car(args), NIL); if (val == NIL) { val = tnode; lastnode = tnode; } else { setcdr(lastnode, tnode); lastnode = tnode; } args = cdr(args); if (check_throwing) break; } } else { setcar(args, cnv_node_to_strnode(arg)); arg = car(args); if (getstrlen(arg) > 1) val = make_strnode(getstrptr(arg), getstrhead(arg), getstrlen(arg) - 1, nodetype(arg), strnzcpy); else val = Null_Word; } } return(val); }
NODE *memberp_help(NODE *args, BOOLEAN notp, BOOLEAN substr) { NODE *obj1, *obj2, *val; int leng; int caseig = varTrue(Caseignoredp); val = FalseName(); obj1 = car(args); obj2 = cadr(args); if (is_list(obj2)) { if (substr) return FalseName(); while (obj2 != NIL && NOT_THROWING) { if (equalp_help(obj1, car(obj2), caseig)) return (notp ? obj2 : TrueName()); obj2 = cdr(obj2); if (check_throwing) break; } return (notp ? NIL : FalseName()); } else if (nodetype(obj2) == ARRAY) { int len = getarrdim(obj2); NODE **data = getarrptr(obj2); if (notp) err_logo(BAD_DATA_UNREC,obj2); if (substr) return FalseName(); while (--len >= 0 && NOT_THROWING) { if (equalp_help(obj1, *data++, caseig)) return TrueName(); } return FalseName(); } else { NODE *tmp; int i; if (aggregate(obj1)) return (notp ? Null_Word : FalseName()); setcar (cdr(args), cnv_node_to_strnode(obj2)); obj2 = cadr(args); setcar (args, cnv_node_to_strnode(obj1)); obj1 = car(args); tmp = NIL; if (obj1 != UNBOUND && obj2 != UNBOUND && getstrlen(obj1) <= getstrlen(obj2) && (substr || (getstrlen(obj1) == 1))) { leng = getstrlen(obj2) - getstrlen(obj1); setcar(cdr(args),make_strnode(getstrptr(obj2), getstrhead(obj2), getstrlen(obj1), nodetype(obj2), strnzcpy)); tmp = cadr(args); for (i = 0; i <= leng; i++) { if (equalp_help(obj1, tmp, caseig)) { if (notp) { setstrlen(tmp,leng+getstrlen(obj1)-i); return tmp; } else return TrueName(); } setstrptr(tmp, getstrptr(tmp) + 1); } } return (notp ? Null_Word : FalseName()); } }
NODE *lsentence(NODE *args) { NODE *tnode = NIL, *lastnode = NIL, *val = NIL, *arg = NIL; while (args != NIL && NOT_THROWING) { arg = car(args); while (nodetype(arg) == ARRAY && NOT_THROWING) { setcar(args, err_logo(BAD_DATA, arg)); arg = car(args); } args = cdr(args); if (stopping_flag == THROWING) break; if (is_list(arg)) { if (args == NIL) { /* 5.2 */ if (val == NIL) val = arg; else setcdr(lastnode, arg); break; } else while (arg != NIL && NOT_THROWING) { tnode = cons(car(arg), NIL); arg = cdr(arg); if (val == NIL) val = tnode; else setcdr(lastnode, tnode); lastnode = tnode; } } else { tnode = cons(arg, NIL); if (val == NIL) val = tnode; else setcdr(lastnode, tnode); lastnode = tnode; } } if (stopping_flag == THROWING) { return UNBOUND; } return(val); }
static Eterm pd_hash_get_keys(Process *p, Eterm value) { Eterm *hp; Eterm res = NIL; ProcDict *pd = p->dictionary; unsigned int i, num; Eterm tmp, tmp2; if (pd == NULL) { return res; } num = HASH_RANGE(pd); for (i = 0; i < num; ++i) { tmp = ARRAY_GET(pd, i); if (is_boxed(tmp)) { ASSERT(is_tuple(tmp)); if (EQ(tuple_val(tmp)[2], value)) { hp = HAlloc(p, 2); res = CONS(hp, tuple_val(tmp)[1], res); } } else if (is_list(tmp)) { while (tmp != NIL) { tmp2 = TCAR(tmp); if (EQ(tuple_val(tmp2)[2], value)) { hp = HAlloc(p, 2); res = CONS(hp, tuple_val(tmp2)[1], res); } tmp = TCDR(tmp); } } } return res; }
NODE *loneof(NODE *args) { NODE *val = UNBOUND, *argcopy; if (!is_list(car(args))) { setcar(args, cons(car(args), NIL)); } /* now the first arg is always a list of objects */ /* make sure they're really objects */ argcopy = car(args); while (argcopy != NIL && NOT_THROWING) { while (!is_object(car(argcopy)) && NOT_THROWING) { setcar(argcopy, err_logo(BAD_DATA, car(argcopy))); } argcopy = cdr(argcopy); } if (NOT_THROWING) { val = newobj(); setparents(val, car(args)); /* apply [[InitList] [Exist Output Self]] cdr(args) */ return make_cont(withobject_continuation, cons(val, make_cont(begin_apply, cons(askexist, cons(cons(cdr(args), NIL), NIL))))); } return val; }
static Eterm pd_hash_get_all(Process *p, ProcDict *pd) { Eterm* hp; Eterm res = NIL; Eterm tmp, tmp2; unsigned int i; unsigned int num; if (pd == NULL) { return res; } num = HASH_RANGE(pd); hp = HAlloc(p, pd->numElements * 2); for (i = 0; i < num; ++i) { tmp = ARRAY_GET(pd, i); if (is_boxed(tmp)) { ASSERT(is_tuple(tmp)); res = CONS(hp, tmp, res); hp += 2; } else if (is_list(tmp)) { while (tmp != NIL) { tmp2 = TCAR(tmp); res = CONS(hp, tmp2, res); hp += 2; tmp = TCDR(tmp); } } } return res; }
NODE *lkindof(NODE *args) { NODE *argcopy = args; NODE *val = UNBOUND; if (is_list(car(args))) { if (cdr(args) != NIL) { err_logo(TOO_MUCH, NIL); /* too many inputs */ } args = car(args); } /* now args is always a list of objects */ /* make sure they're all really objects */ for (argcopy = args; (argcopy != NIL && NOT_THROWING); argcopy = cdr(argcopy)) { while (!is_object(car(argcopy)) && NOT_THROWING) { setcar(argcopy, err_logo(BAD_DATA, car(argcopy))); } } if (NOT_THROWING) { val = newobj(); setparents(val, args); } return val; }
BIF_RETTYPE lists_member_2(BIF_ALIST_2) { Eterm term; Eterm list; Eterm item; int non_immed_key; int max_iter = 10 * CONTEXT_REDS; if (is_nil(BIF_ARG_2)) { BIF_RET(am_false); } else if (is_not_list(BIF_ARG_2)) { BIF_ERROR(BIF_P, BADARG); } term = BIF_ARG_1; non_immed_key = is_not_immed(term); list = BIF_ARG_2; while (is_list(list)) { if (--max_iter < 0) { BUMP_ALL_REDS(BIF_P); BIF_TRAP2(bif_export[BIF_lists_member_2], BIF_P, term, list); } item = CAR(list_val(list)); if ((item == term) || (non_immed_key && eq(item, term))) { BIF_RET2(am_true, CONTEXT_REDS - max_iter/10); } list = CDR(list_val(list)); } if (is_not_nil(list)) { BIF_ERROR(BIF_P, BADARG); } BIF_RET2(am_false, CONTEXT_REDS - max_iter/10); }
/* Make a list of the next n expressions, where n is between min and max. * Set args to immediately after the last expression. */ NODE *gather_some_args(int min, int max, NODE **args, BOOLEAN inparen, NODE **ifnode) { NODE *paren_infix(NODE *left, NODE **rest, int old_pri, BOOLEAN inparen); if (*args == NIL || car(*args) == Right_Paren || (nodetype(car(*args)) == CASEOBJ && nodetype(procnode__caseobj(car(*args))) == INFIX)) { if (min > 0) return cons(Not_Enough_Node, NIL); } else if (max == 0) { if (ifnode != (NODE **)NIL && is_list(car(*args))) { /* if -> ifelse kludge */ NODE *retval; err_logo(IF_WARNING, NIL); *ifnode = theName(Name_ifelse); retval = paren_expr(args, FALSE); retval = paren_infix(retval, args, -1, inparen); return cons(retval, gather_some_args(min, max, args, inparen, (NODE **)NIL)); } } else { if (max < 0) max = 0; /* negative max means unlimited */ if (car(*args) != Right_Paren && (nodetype(car(*args)) != CASEOBJ || nodetype(procnode__caseobj(car(*args))) != INFIX)) { NODE *retval = paren_expr(args, FALSE); retval = paren_infix(retval, args, -1, inparen); return cons(retval, gather_some_args(min - 1, max - 1, args, inparen, ifnode)); } } return NIL; }
/* Merges the the global environment and the given {Key, Value} list into env, * unsetting all keys whose value is either 'false' or NIL. The behavior on * NIL is undocumented and perhaps surprising, but the previous implementation * worked in this manner. */ static int merge_global_environment(erts_osenv_t *env, Eterm key_value_pairs) { const erts_osenv_t *global_env = erts_sys_rlock_global_osenv(); erts_osenv_merge(env, global_env, 0); erts_sys_runlock_global_osenv(); while (is_list(key_value_pairs)) { Eterm *cell, *tuple; cell = list_val(key_value_pairs); if(!is_tuple_arity(CAR(cell), 2)) { return -1; } tuple = tuple_val(CAR(cell)); key_value_pairs = CDR(cell); if(is_nil(tuple[2]) || tuple[2] == am_false) { if(erts_osenv_unset_term(env, tuple[1]) < 0) { return -1; } } else { if(erts_osenv_put_term(env, tuple[1], tuple[2]) < 0) { return -1; } } } if(!is_nil(key_value_pairs)) { return -1; } return 0; }
void untreeify_line(NODE *line) { if (line != NIL && is_list(line)) { untreeify_line(car(line)); untreeify_line(cdr(line)); untreeify(line); } }
term_t cbif_spawn_link3(proc_t *proc, term_t *regs) { term_t m = regs[0]; term_t f = regs[1]; term_t args = regs[2]; if (!is_atom(m)) badarg(m); if (!is_atom(f)) badarg(f); if (!is_list(args)) badarg(args); if (list_len(args) < 0) badarg(args); // too odd proc_t *new_proc = proc_make(proc->group_leader); int x = proc_spawn_N(new_proc, m, f, args); if (x == 0) x = inter_link_establish_N(&new_proc->links, proc->pid); if (x == 0) x = inter_link_establish_N(&proc->links, new_proc->pid); if (x < 0) { proc_destroy(new_proc); // no need to unlink, new_proc might have a link to proc but it is destroyed anyway fail(err_to_term(x)); } return new_proc->pid; }
static void pd_check(ProcDict *pd) { unsigned int i; Uint num; if (pd == NULL) return; ASSERT(pd->size >= pd->used); ASSERT(HASH_RANGE(pd) <= MAX_HASH); for (i = 0, num = 0; i < pd->used; ++i) { Eterm t = pd->data[i]; if (is_nil(t)) { continue; } else if (is_tuple(t)) { ++num; ASSERT(arityval(*tuple_val(t)) == 2); continue; } else if (is_list(t)) { while (t != NIL) { ++num; ASSERT(is_tuple(TCAR(t))); ASSERT(arityval(*(tuple_val(TCAR(t)))) == 2); t = TCDR(t); } continue; } else { erl_exit(1, "Found tag 0x%08x in process dictionary at position %d", (unsigned long) t, (int) i); } } ASSERT(num == pd->numElements); ASSERT(pd->splitPosition <= pd->homeSize); }
SRL_STATIC_INLINE void srl_parse_array(pTHX_ srl_path_t *path, int expr_idx, SV *route) { int range[3]; const char *loc_str; STRLEN loc_len; SV *loc; assert(route != NULL); assert(expr_idx >= 0); assert(expr_idx <= av_len(path->expr)); assert(srl_iterator_stack(aTHX_ path->iter) != NULL); loc = *av_fetch(path->expr, expr_idx, 0); loc_str = SvPV(loc, loc_len); if (is_all(loc_str, loc_len)) { // * srl_parse_array_all(aTHX_ path, expr_idx, route); } else if (is_number(loc_str, loc_len)) { // [10] srl_parse_array_item(aTHX_ path, expr_idx, route, atoi(loc_str)); } else if (is_list(loc_str, loc_len)) { // [0,1,2] srl_parse_array_list(aTHX_ path, expr_idx, route, loc_str, loc_len); } else if (is_range(loc_str, loc_len, (int*) &range)) { // [start:stop:step] srl_parse_array_range(aTHX_ path, expr_idx, route, (int*) &range); } }
/* * Called from process_info/1,2. */ Eterm erts_dictionary_copy(Process *p, ProcDict *pd) { Eterm* hp; Eterm* heap_start; Eterm res = NIL; Eterm tmp, tmp2; unsigned int i, num; if (pd == NULL) { return res; } PD_CHECK(pd); num = HASH_RANGE(pd); heap_start = hp = (Eterm *) erts_alloc(ERTS_ALC_T_TMP, sizeof(Eterm) * pd->numElements * 2); for (i = 0; i < num; ++i) { tmp = ARRAY_GET(pd, i); if (is_boxed(tmp)) { ASSERT(is_tuple(tmp)); res = CONS(hp, tmp, res); hp += 2; } else if (is_list(tmp)) { while (tmp != NIL) { tmp2 = TCAR(tmp); res = CONS(hp, tmp2, res); hp += 2; tmp = TCDR(tmp); } } } res = copy_object(res, p); erts_free(ERTS_ALC_T_TMP, (void *) heap_start); return res; }
// // Flatten the valid iolist to the buffer of // appropriate size pointed to by ptr // uint8_t *iolist_flatten(term_t l, uint8_t *ptr) { if (is_nil(l)) return ptr; if (is_cons(l)) { do { uint32_t *term_data = peel_cons(l); term_t e = term_data[0]; if (is_int(e)) *ptr++ = int_value(e); else { assert(is_list(e) || (is_boxed(e) && is_binary(peel_boxed(e)))); ptr = iolist_flatten(e, ptr); } l = term_data[1]; if (is_boxed(l) && is_binary(peel_boxed(l))) return iolist_flatten(l, ptr); } while (is_cons(l)); assert(is_nil(l)); } else // is_binary() { bits_t bs, to; bits_get_real(peel_boxed(l), &bs); bits_init_buf(ptr, (bs.ends +7) /8, &to); ptr += (bs.ends - bs.starts) /8; bits_copy(&bs, &to); assert(bs.starts == bs.ends); } return ptr; }
Eterm erts_pd_hash_get(Process *p, Eterm id) { unsigned int hval; Eterm tmp; ProcDict *pd = p->dictionary; if (pd == NULL) return am_undefined; hval = pd_hash_value(pd, id); tmp = ARRAY_GET(pd, hval); if (is_boxed(tmp)) { /* Tuple */ ASSERT(is_tuple(tmp)); if (EQ(tuple_val(tmp)[1], id)) { return tuple_val(tmp)[2]; } } else if (is_list(tmp)) { for (; tmp != NIL && !EQ(tuple_val(TCAR(tmp))[1], id); tmp = TCDR(tmp)) { ; } if (tmp != NIL) { return tuple_val(TCAR(tmp))[2]; } } else if (is_not_nil(tmp)) { #ifdef DEBUG erts_fprintf(stderr, "Process dictionary for process %T is broken, trying to " "display term found in line %d:\n" "%T\n", p->common.id, __LINE__, tmp); #endif erl_exit(1, "Damaged process dictionary found during get/1."); } return am_undefined; }
static bool file_source_is_tarball_backed(Value* file_source) { return is_list(file_source) && (list_length(file_source) >= 1) && (is_symbol(list_get(file_source, 0))) && (as_symbol(list_get(file_source, 0)) == s_Tarball); }
static void rename_ind(Term t, Label from, Label to) { if(is_list(t)) { List l; l=t; while(!is_empty_list(l)) { Term u; u=ListFirst(l); if(u==from) ChangeList(l,to); else rename_ind(u,from,to); l=ListTail(l); } return; } if(is_compound(t)) { int i,ac; ac=CompoundArity(t); for(i=1;i<=ac;i++) { Term u; u=CompoundArgN(t,i); if(u==from) SetCompoundArg(t,i,to); else rename_ind(u,from,to); } } return; }