/* Copyright 1997 J"orn Rennecke */ #include "common.h" #include "alloc.h" #include "interpret.h" #include "object.h" #include "uid.h" struct array nil_array = { T_LARRAY, /* type */ 1, /* ref */ 0, /* major ref */ }; struct array_x nil_array_x = { &nil_uid, 0, /* length */ }; svalue allocate_array(p_int size, struct uid *uid) { if (size > UINT16_MAX) { svalue xsv, result; struct array_x *x; xsv = ALLOC(T_INTERNAL, IT_X_ARRAY, sizeof *x); if (!xsv.p) return SV_NULL; x = (struct array_x *)(void *)&xsv.p[3]; x->uid = uid; x->len = size; uid->num_array++; uid->total_array += size; result = ALLOC_TTS(T_ARRAY, 1, 1, offsetof(struct array, member) + size * sizeof (char *)); if (result.p) { SV_ARRAY(result).x.x = x; return result; } uid = x->uid; uid->num_array--; uid->total_array -= size; free_block(xsv.p, sizeof *x); return SV_NULL; } else { svalue result = ALLOC_TTS(T_ARRAY, 1, size, offsetof(struct array, member) + size * sizeof (char *)); if (result.p) { SV_ARRAY(result).x.uid = uid; uid->num_array++; uid->total_array += size; } return result; } } svalue *f_range(svalue *sp, struct frame *fp, svalue end, int flags) { svalue start, a, range; if (!SV_IS_NUMBER (end)) { bad_efun_arg(3); return sp+1; } end.i >>= 1; start = *sp; if (!SV_IS_NUMBER (start)) { bad_efun_arg(2); return sp; } start.i >>= 1; a = *--sp; switch(SV_TYPE(a)) { case T_LSTRING: case T_GLSTRING: case T_ILSTRING: { uint8 *str = SV_LSTRING(a); mp_int len = SV_LSTRLEN(a); goto got_string; case T_STRING: case T_GSTRING: case T_ISTRING: str = SV_STRING(a); len = SV_STRLEN(a); got_string: if (flags < 0) start.i = len - start.i; if (start.i < 0) start.i = 0; if (flags & 1) end.i += len; if (len > end.i) len = end.i + 1; len -= start.i; if (len < 0) len = 0; str += start.i; range = make_string(str, len); break; } case T_LARRAY: { svalue *src, *dest; mp_int len = SV_LARRAY_LEN(a); goto got_array; case T_ARRAY: len = SV_ARRAY_LEN(a); got_array: src = &SV_ARRAY(a).member[0]; if (flags < 0) start.i = len - start.i; if (start.i < 0) start.i = 0; if (flags & 1) end.i = len - end.i; if (len > end.i) len = end.i + 1; len -= start.i; if (len < 0) len = 0; src += start.i; range = allocate_array(len, SV_OBJECT(fp->object).x.uid->self); if (range.p) for (dest = &SV_ARRAY(range).member[0]; --len >= 0; src++, dest++) *dest = COPY_SVALUE(*src); break; } } *sp = range; FREE_SVALUE(a); return sp; } svalue *f_member(svalue *sp) { svalue search = *sp; svalue base = *--sp; if (SV_IS_NUMBER(base)) { if (!SV_IS_NUMBER(search)) { FREE_ALLOCED_SVALUE(search); sp->i = 0; return sp; } search.u >>= 1; *sp = INT_SVALUE(search.u < 8 * sizeof(p_int) && base.u & 2 << search.u); return sp; } switch (SV_TYPE(base)) { case T_LSTRING: case T_ILSTRING: case T_GLSTRING: { uint8 *str = SV_LSTRING(base), *found; mp_int len = SV_LSTRLEN(base); goto base_string; case T_STRING: case T_ISTRING: case T_GSTRING: str = SV_STRING(base); len = SV_STRLEN(base); base_string: if (!SV_IS_NUMBER(search)) { FREE_ALLOCED_SVALUE(search); found = 0; } else { found = memchr(str, search.i >> 1, len); } *sp = INT_SVALUE(found ? found - str : -1); FREE_ALLOCED_SVALUE(base); return sp; } case T_LARRAY: { p_int len = SV_LARRAY_LEN(base); svalue *start; goto base_array; case T_ARRAY: len = SV_ARRAY_LEN(base); base_array: start = &SV_ARRAY(base).member[0]; if (SV_IS_NUMBER(search)) { if (search.i) goto search_same; goto search_0; } else switch (SV_TYPE(search)) { case T_DESTRUCTED: { svalue *svp; FREE_ALLOCED_SVALUE(search); search.i = 0; search_0: for (svp = start; --len >= 0; svp++) { svalue sv = *svp; if (!sv.i || !SV_IS_NUMBER(sv) && SV_TYPE(sv) == T_DESTRUCTED) { *sp = INT_SVALUE(svp - start); FREE_ALLOCED_SVALUE(base); return sp; } } *sp = INT_SVALUE(-1); FREE_ALLOCED_SVALUE(base); return sp; } case T_MAPPING: case T_SPACE: case T_ARRAY: case T_OBJECT: { svalue *svp; FREE_ALLOCED_SVALUE(search); search_same: for (svp = start; --len >= 0; svp++) if (svp->p == search.p) { *sp = INT_SVALUE(svp - start); FREE_ALLOCED_SVALUE(base); return sp; } *sp = INT_SVALUE(-1); FREE_ALLOCED_SVALUE(base); return sp; } case T_STRING: case T_ISTRING: case T_LSTRING: case T_ILSTRING: search = make_string_global(search); case T_GSTRING: case T_GLSTRING: { struct counted_string srchstr = sv_string2(search); svalue *svp; for (svp = start; --len >= 0; svp++) { svalue sv = *svp; if (sv.p == search.p) { found_string: *sp = INT_SVALUE(svp - start); FREE_ALLOCED_SVALUE(search); FREE_ALLOCED_SVALUE(base); return sp; } if (!SV_IS_NUMBER(sv)) switch(SV_TYPE(sv)) { case T_ISTRING: if (SV_ISTRING(sv).p == search.p) goto found_string; break; case T_ILSTRING: if (SV_ILSTRING(sv).p == search.p) goto found_string; break; case T_LSTRING: { uint8 *str = SV_LSTRING(sv); mp_int len = SV_LSTRLEN(sv); goto search_string; case T_STRING: str = SV_STRING(sv); len = SV_STRLEN(sv); search_string: if (len == srchstr.len && !memcmp(srchstr.start, str, len)) goto found_string; break; } } } *sp = INT_SVALUE(-1); FREE_ALLOCED_SVALUE(search); FREE_ALLOCED_SVALUE(base); return sp; } default: /* Similar code in get_map_lvalue() . */ { svalue *svp; p_int mk0, mk1, m2, mk2, m3, mk3; m2 = 0; m3 = 0; goto search_value; case T_FLOAT: m2 = ~0; mk2 = SV_KEY(search)[2]; m3 = 0; goto search_value; case T_CLOSURE: switch(SV_CLOSURE(search).g.closure_type) { case CLOSURE_BOUND_LAMBDA: m2 = ~0; mk2 = SV_KEY(search)[2]; m3 = 0; break; case CLOSURE_ALIEN_LFUN: m2 = S2I32(0, 0xffff); mk2 = SV_KEY(search)[2]; m3 = ~0; mk3 = SV_KEY(search)[3]; break; case CLOSURE_LFUN: case CLOSURE_IDENTIFIER: m2 = S2I32(0, 0xffff); mk2 = SV_KEY(search)[2]; m3 = 0; break; default: m2 = 0; m3 = 0; break; } case T_QUOTED: /* byte 4..7:sv byte 2..3:quotes byte 0:type */ m2 = 0; m3 = 0; search_value: mk0 = SV_KEY(search)[0]; EXTRACT_T_WORD(mk0); mk1 = SV_KEY(search)[1]; mk2 &= m2; mk3 &= m3; FREE_ALLOCED_SVALUE(search); for (svp = start; --len >= 0; svp++) { svalue sv = *svp; p_int tmp = SV_KEY(sv)[0]; EXTRACT_T_WORD(tmp); if (mk0 == tmp && mk1 == SV_KEY(sv)[1] && mk2 == (SV_KEY(sv)[2] & m2) && mk3 == (SV_KEY(sv)[3] & m3)) { *sp = INT_SVALUE(svp - start); FREE_ALLOCED_SVALUE(base); return sp; } } *sp = INT_SVALUE(-1); FREE_ALLOCED_SVALUE(base); return sp; } } } case T_MAPPING: *sp = INT_SVALUE(get_map_lvalue(base, search, 0) == EMPTY_CMAP); FREE_ALLOCED_SVALUE(base); FREE_SVALUE(search); return sp; default: bad_efun_arg(1); return sp+1; } }