Example #1
0
static GMQCC_INLINE ast_expression *fold_op_mul(fold_t *fold, ast_value *a, ast_value *b) {
    if (isfloat(a)) {
        if (isvector(b)) {
            if (fold_can_2(a, b))
                return fold_constgen_vector(fold, vec3_mulvf(fold_immvalue_vector(b), fold_immvalue_float(a)));
        } else {
            if (fold_can_2(a, b))
                return fold_constgen_float(fold, fold_immvalue_float(a) * fold_immvalue_float(b));
        }
    } else if (isvector(a)) {
        if (isfloat(b)) {
            if (fold_can_2(a, b))
                return fold_constgen_vector(fold, vec3_mulvf(fold_immvalue_vector(a), fold_immvalue_float(b)));
        } else {
            if (fold_can_2(a, b)) {
                return fold_constgen_float(fold, vec3_mulvv(fold_immvalue_vector(a), fold_immvalue_vector(b)));
            } else if (OPTS_OPTIMIZATION(OPTIM_VECTOR_COMPONENTS) && fold_can_1(a)) {
                ast_expression *out;
                if ((out = fold_op_mul_vec(fold, fold_immvalue_vector(a), b, "xyz"))) return out;
                if ((out = fold_op_mul_vec(fold, fold_immvalue_vector(a), b, "yxz"))) return out;
                if ((out = fold_op_mul_vec(fold, fold_immvalue_vector(a), b, "zxy"))) return out;
            } else if (OPTS_OPTIMIZATION(OPTIM_VECTOR_COMPONENTS) && fold_can_1(b)) {
                ast_expression *out;
                if ((out = fold_op_mul_vec(fold, fold_immvalue_vector(b), a, "xyz"))) return out;
                if ((out = fold_op_mul_vec(fold, fold_immvalue_vector(b), a, "yxz"))) return out;
                if ((out = fold_op_mul_vec(fold, fold_immvalue_vector(b), a, "zxy"))) return out;
            }
        }
    }
    return NULL;
}
Example #2
0
static GMQCC_INLINE ast_expression *fold_op_cmp(fold_t *fold, ast_value *a, ast_value *b, bool ne) {
    if (fold_can_2(a, b)) {
        if (isfloat(a) && isfloat(b)) {
            float la = fold_immvalue_float(a);
            float lb = fold_immvalue_float(b);
            return (ast_expression*)fold->imm_float[!(ne ? la == lb : la != lb)];
        } if (isvector(a) && isvector(b)) {
            vec3_t la = fold_immvalue_vector(a);
            vec3_t lb = fold_immvalue_vector(b);
            return (ast_expression*)fold->imm_float[!(ne ? vec3_cmp(la, lb) : !vec3_cmp(la, lb))];
        }
    }
    return NULL;
}
Example #3
0
static value_t fl_length(value_t *args, u_int32_t nargs)
{
    argcount("length", nargs, 1);
    value_t a = args[0];
    cvalue_t *cv;
    if (isvector(a)) {
        return fixnum(vector_size(a));
    }
    else if (iscprim(a)) {
        cv = (cvalue_t*)ptr(a);
        if (cp_class(cv) == bytetype)
            return fixnum(1);
        else if (cp_class(cv) == wchartype)
            return fixnum(u8_charlen(*(uint32_t*)cp_data((cprim_t*)cv)));
    }
    else if (iscvalue(a)) {
        cv = (cvalue_t*)ptr(a);
        if (cv_class(cv)->eltype != NULL)
            return size_wrap(cvalue_arraylen(a));
    }
    else if (a == FL_NIL) {
        return fixnum(0);
    }
    else if (iscons(a)) {
        return fixnum(llength(a));
    }
    type_error("length", "sequence", a);
}
Example #4
0
static GMQCC_INLINE ast_expression *fold_op_div(fold_t *fold, ast_value *a, ast_value *b) {
    if (isfloat(a)) {
        if (fold_can_2(a, b)) {
            return fold_constgen_float(fold, fold_immvalue_float(a) / fold_immvalue_float(b));
        } else if (fold_can_1(b)) {
            return (ast_expression*)ast_binary_new(
                fold_ctx(fold),
                INSTR_MUL_F,
                (ast_expression*)a,
                fold_constgen_float(fold, 1.0f / fold_immvalue_float(b))
            );
        }
    } else if (isvector(a)) {
        if (fold_can_2(a, b)) {
            return fold_constgen_vector(fold, vec3_mulvf(fold_immvalue_vector(a), 1.0f / fold_immvalue_float(b)));
        } else {
            return (ast_expression*)ast_binary_new(
                fold_ctx(fold),
                INSTR_MUL_VF,
                (ast_expression*)a,
                (fold_can_1(b))
                    ? (ast_expression*)fold_constgen_float(fold, 1.0f / fold_immvalue_float(b))
                    : (ast_expression*)ast_binary_new(
                                            fold_ctx(fold),
                                            INSTR_DIV_F,
                                            (ast_expression*)fold->imm_float[1],
                                            (ast_expression*)b
                    )
            );
        }
    }
    return NULL;
}
Example #5
0
static GMQCC_INLINE ast_expression *fold_op_sub(fold_t *fold, ast_value *a, ast_value *b) {
    if (isfloat(a)) {
        if (fold_can_2(a, b))
            return fold_constgen_float(fold, fold_immvalue_float(a) - fold_immvalue_float(b));
    } else if (isvector(a)) {
        if (fold_can_2(a, b))
            return fold_constgen_vector(fold, vec3_sub(fold_immvalue_vector(a), fold_immvalue_vector(b)));
    }
    return NULL;
}
Example #6
0
static GMQCC_INLINE ast_expression *fold_op_neg(fold_t *fold, ast_value *a) {
    if (isfloat(a)) {
        if (fold_can_1(a))
            return fold_constgen_float(fold, -fold_immvalue_float(a));
    } else if (isvector(a)) {
        if (fold_can_1(a))
            return fold_constgen_vector(fold, vec3_neg(fold_immvalue_vector(a)));
    }
    return NULL;
}
Example #7
0
void print_traverse(value_t v)
{
    value_t *bp;
    while (iscons(v)) {
        if (ismarked(v)) {
            bp = (value_t*)ptrhash_bp(&printconses, (void*)v);
            if (*bp == (value_t)HT_NOTFOUND)
                *bp = fixnum(printlabel++);
            return;
        }
        mark_cons(v);
        print_traverse(car_(v));
        v = cdr_(v);
    }
    if (!ismanaged(v) || issymbol(v))
        return;
    if (ismarked(v)) {
        bp = (value_t*)ptrhash_bp(&printconses, (void*)v);
        if (*bp == (value_t)HT_NOTFOUND)
            *bp = fixnum(printlabel++);
        return;
    }
    if (isvector(v)) {
        if (vector_size(v) > 0)
            mark_cons(v);
        unsigned int i;
        for(i=0; i < vector_size(v); i++)
            print_traverse(vector_elt(v,i));
    }
    else if (iscprim(v)) {
        mark_cons(v);
    }
    else if (isclosure(v)) {
        mark_cons(v);
        function_t *f = (function_t*)ptr(v);
        print_traverse(f->bcode);
        print_traverse(f->vals);
        print_traverse(f->env);
    }
    else {
        assert(iscvalue(v));
        cvalue_t *cv = (cvalue_t*)ptr(v);
        // don't consider shared references to ""
        if (!cv_isstr(cv) || cv_len(cv)!=0)
            mark_cons(v);
        fltype_t *t = cv_class(cv);
        if (t->vtable != NULL && t->vtable->print_traverse != NULL)
            t->vtable->print_traverse(v);
    }
}
Example #8
0
static GMQCC_INLINE ast_expression *fold_op_xor(fold_t *fold, ast_value *a, ast_value *b) {
    if (isfloat(a)) {
        if (fold_can_2(a, b))
            return fold_constgen_float(fold, (qcfloat_t)(((qcint_t)fold_immvalue_float(a)) ^ ((qcint_t)fold_immvalue_float(b))));
    } else {
        if (fold_can_2(a, b)) {
            if (isvector(b))
                return fold_constgen_vector(fold, vec3_xor(fold_immvalue_vector(a), fold_immvalue_vector(b)));
            else
                return fold_constgen_vector(fold, vec3_xorvf(fold_immvalue_vector(a), fold_immvalue_float(b)));
        }
    }
    return NULL;
}
Example #9
0
 const array::array_proxy array::operator()(const index &s0) const
 {
     index z = index(0);
     if(isvector()){
         switch(numDims(this->arr)) {
             case 1: return gen_indexing(*this, s0, z, z, z);
             case 2: return gen_indexing(*this, z, s0, z, z);
             case 3: return gen_indexing(*this, z, z, s0, z);
             case 4: return gen_indexing(*this, z, z, z, s0);
             default: AF_THROW_ERR("ndims for Array is invalid", AF_ERR_SIZE);
         }
     }
     else {
         return gen_indexing(*this, s0, z, z, z, true);
     }
 }
pointer EUSPINHOLE_CAMERA_MODEL_PROJECT_3D_TO_PIXEL(register context *ctx,int n,pointer *argv)
{
  ckarg(2);
  image_geometry::PinholeCameraModel *pcm = (image_geometry::PinholeCameraModel *)(intval(argv[0]));
  if(!isvector(argv[1])) error(E_NOVECTOR);
  eusfloat_t *pos = argv[1]->c.fvec.fv;

  cv::Point3d xyz = cv::Point3d(pos[0]/1000.0, pos[1]/1000.0, pos[2]/1000.0);
  cv::Point2d uv = pcm->project3dToPixel(xyz);

  pointer vs = makefvector(2);
  vpush(vs);
  vs->c.fvec.fv[0] = uv.x;
  vs->c.fvec.fv[1] = uv.y;
  vpop();
  return(vs);
}
Example #11
0
static GMQCC_INLINE ast_expression *fold_op_not(fold_t *fold, ast_value *a) {
    if (isfloat(a)) {
        if (fold_can_1(a))
            return fold_constgen_float(fold, !fold_immvalue_float(a));
    } else if (isvector(a)) {
        if (fold_can_1(a))
            return fold_constgen_float(fold, vec3_notf(fold_immvalue_vector(a)));
    } else if (isstring(a)) {
        if (fold_can_1(a)) {
            if (OPTS_FLAG(TRUE_EMPTY_STRINGS))
                return fold_constgen_float(fold, !fold_immvalue_string(a));
            else
                return fold_constgen_float(fold, !fold_immvalue_string(a) || !*fold_immvalue_string(a));
        }
    }
    return NULL;
}
pointer EUSPINHOLE_CAMERA_MODEL_PROJECT_PIXEL_TO_3DRAY(register context *ctx,int n,pointer *argv)
{
  ckarg(2);
  image_geometry::PinholeCameraModel *pcm = (image_geometry::PinholeCameraModel *)(intval(argv[0]));
  if(!isvector(argv[1])) error(E_NOVECTOR);
  eusfloat_t *pixel = argv[1]->c.fvec.fv;

  cv::Point2d uv = cv::Point2d(pixel[0], pixel[1]);
  cv::Point3d xyz = pcm->projectPixelTo3dRay(uv);

  pointer vs = makefvector(3);
  vpush(vs);
  vs->c.fvec.fv[0] = xyz.x;
  vs->c.fvec.fv[1] = xyz.y;
  vs->c.fvec.fv[2] = xyz.z;
  vpop();
  return(vs);
}
Example #13
0
static int smallp(value_t v)
{
    if (tinyp(v)) return 1;
    if (fl_isnumber(v)) return 1;
    if (iscons(v)) {
        if (tinyp(car_(v)) && (tinyp(cdr_(v)) ||
                               (iscons(cdr_(v)) && tinyp(car_(cdr_(v))) &&
                                cdr_(cdr_(v))==NIL)))
            return 1;
        return 0;
    }
    if (isvector(v)) {
        size_t s = vector_size(v);
        return (s == 0 || (tinyp(vector_elt(v,0)) &&
                           (s == 1 || (s == 2 &&
                                       tinyp(vector_elt(v,1))))));
    }
    return 0;
}
Example #14
0
void fl_print_child(ios_t *f, value_t v)
{
    char *name, *str;
    char buf[64];
    if (print_level >= 0 && P_LEVEL >= print_level &&
        (iscons(v) || isvector(v) || isclosure(v))) {
        outc('#', f);
        return;
    }
    P_LEVEL++;

    switch (tag(v)) {
    case TAG_NUM :
    case TAG_NUM1: //HPOS+=ios_printf(f, "%ld", numval(v)); break;
        str = uint2str(&buf[1], sizeof(buf)-1, labs(numval(v)), 10);
        if (numval(v)<0)
            *(--str) = '-';
        outs(str, f);
        break;
    case TAG_SYM:
        name = symbol_name(v);
        if (print_princ)
            outs(name, f);
        else if (ismanaged(v)) {
            outsn("#:", f, 2);
            outs(name, f);
        }
        else
            print_symbol_name(f, name);
        break;
    case TAG_FUNCTION:
        if (v == FL_T) {
            outsn("#t", f, 2);
        }
        else if (v == FL_F) {
            outsn("#f", f, 2);
        }
        else if (v == FL_NIL) {
            outsn("()", f, 2);
        }
        else if (v == FL_EOF) {
            outsn("#<eof>", f, 6);
        }
        else if (isbuiltin(v)) {
            if (!print_princ)
                outsn("#.", f, 2);
            outs(builtin_names[uintval(v)], f);
        }
        else {
            assert(isclosure(v));
            if (!print_princ) {
                if (print_circle_prefix(f, v)) break;
                function_t *fn = (function_t*)ptr(v);
                outs("#fn(", f);
                char *data = cvalue_data(fn->bcode);
                size_t i, sz = cvalue_len(fn->bcode);
                for(i=0; i < sz; i++) data[i] += 48;
                fl_print_child(f, fn->bcode);
                for(i=0; i < sz; i++) data[i] -= 48;
                outc(' ', f);
                fl_print_child(f, fn->vals);
                if (fn->env != NIL) {
                    outc(' ', f);
                    fl_print_child(f, fn->env);
                }
                if (fn->name != LAMBDA) {
                    outc(' ', f);
                    fl_print_child(f, fn->name);
                }
                outc(')', f);
            }
            else {
                outs("#<function>", f);
            }
        }
        break;
    case TAG_CVALUE:
    case TAG_CPRIM:
        if (v == UNBOUND) { outs("#<undefined>", f); break; }
    case TAG_VECTOR:
    case TAG_CONS:
        if (print_circle_prefix(f, v)) break;
        if (isvector(v)) {
            outc('[', f);
            int newindent = HPOS, est;
            int i, sz = vector_size(v);
            for(i=0; i < sz; i++) {
                if (print_length >= 0 && i >= print_length && i < sz-1) {
                    outsn("...", f, 3);
                    break;
                }
                fl_print_child(f, vector_elt(v,i));
                if (i < sz-1) {
                    if (!print_pretty) {
                        outc(' ', f);
                    }
                    else {
                        est = lengthestimate(vector_elt(v,i+1));
                        if (HPOS > SCR_WIDTH-4 ||
                            (est!=-1 && (HPOS+est > SCR_WIDTH-2)) ||
                            (HPOS > SCR_WIDTH/2 &&
                             !smallp(vector_elt(v,i+1)) &&
                             !tinyp(vector_elt(v,i))))
                            newindent = outindent(newindent, f);
                        else
                            outc(' ', f);
                    }
                }
            }
            outc(']', f);
            break;
        }
        if (iscvalue(v) || iscprim(v))
            cvalue_print(f, v);
        else
            print_pair(f, v);
        break;
    }
    P_LEVEL--;
}
Example #15
0
// strange comparisons are resolved arbitrarily but consistently.
// ordering: number < cprim < function < vector < cvalue < symbol < cons
static value_t bounded_compare(value_t a, value_t b, int bound, int eq)
{
    value_t d;

 compare_top:
    if (a == b) return fixnum(0);
    if (bound <= 0)
        return NIL;
    int taga = tag(a);
    int tagb = cmptag(b);
    int c;
    switch (taga) {
    case TAG_NUM :
    case TAG_NUM1:
        if (isfixnum(b)) {
            return (numval(a) < numval(b)) ? fixnum(-1) : fixnum(1);
        }
        if (iscprim(b)) {
            if (cp_class((cprim_t*)ptr(b)) == wchartype)
                return fixnum(1);
            return fixnum(numeric_compare(a, b, eq, 1, NULL));
        }
        return fixnum(-1);
    case TAG_SYM:
        if (eq) return fixnum(1);
        if (tagb < TAG_SYM) return fixnum(1);
        if (tagb > TAG_SYM) return fixnum(-1);
        return fixnum(strcmp(symbol_name(a), symbol_name(b)));
    case TAG_VECTOR:
        if (isvector(b))
            return bounded_vector_compare(a, b, bound, eq);
        break;
    case TAG_CPRIM:
        if (cp_class((cprim_t*)ptr(a)) == wchartype) {
            if (!iscprim(b) || cp_class((cprim_t*)ptr(b)) != wchartype)
                return fixnum(-1);
        }
        else if (iscprim(b) && cp_class((cprim_t*)ptr(b)) == wchartype) {
            return fixnum(1);
        }
        c = numeric_compare(a, b, eq, 1, NULL);
        if (c != 2)
            return fixnum(c);
        break;
    case TAG_CVALUE:
        if (iscvalue(b)) {
            if (cv_isPOD((cvalue_t*)ptr(a)) && cv_isPOD((cvalue_t*)ptr(b)))
                return cvalue_compare(a, b);
            return fixnum(1);
        }
        break;
    case TAG_FUNCTION:
        if (tagb == TAG_FUNCTION) {
            if (uintval(a) > N_BUILTINS && uintval(b) > N_BUILTINS) {
                function_t *fa = (function_t*)ptr(a);
                function_t *fb = (function_t*)ptr(b);
                d = bounded_compare(fa->bcode, fb->bcode, bound-1, eq);
                if (d==NIL || numval(d) != 0) return d;
                d = bounded_compare(fa->vals, fb->vals, bound-1, eq);
                if (d==NIL || numval(d) != 0) return d;
                d = bounded_compare(fa->env, fb->env, bound-1, eq);
                if (d==NIL || numval(d) != 0) return d;
                return fixnum(0);
            }
            return (uintval(a) < uintval(b)) ? fixnum(-1) : fixnum(1);
        }
        break;
    case TAG_CONS:
        if (tagb < TAG_CONS) return fixnum(1);
        d = bounded_compare(car_(a), car_(b), bound-1, eq);
        if (d==NIL || numval(d) != 0) return d;
        a = cdr_(a); b = cdr_(b);
        bound--;
        goto compare_top;
    }
    return (taga < tagb) ? fixnum(-1) : fixnum(1);
}
Example #16
0
static value_t cyc_compare(value_t a, value_t b, htable_t *table, int eq)
{
    value_t d, ca, cb;
 cyc_compare_top:
    if (a==b)
        return fixnum(0);
    if (iscons(a)) {
        if (iscons(b)) {
            value_t aa = car_(a); value_t da = cdr_(a);
            value_t ab = car_(b); value_t db = cdr_(b);
            int tagaa = tag(aa); int tagda = tag(da);
            int tagab = tag(ab); int tagdb = tag(db);
            if (leafp(aa) || leafp(ab)) {
                d = bounded_compare(aa, ab, 1, eq);
                if (d!=NIL && numval(d)!=0) return d;
            }
            else if (tagaa < tagab)
                return fixnum(-1);
            else if (tagaa > tagab)
                return fixnum(1);
            if (leafp(da) || leafp(db)) {
                d = bounded_compare(da, db, 1, eq);
                if (d!=NIL && numval(d)!=0) return d;
            }
            else if (tagda < tagdb)
                return fixnum(-1);
            else if (tagda > tagdb)
                return fixnum(1);

            ca = eq_class(table, a);
            cb = eq_class(table, b);
            if (ca!=NIL && ca==cb)
                return fixnum(0);

            eq_union(table, a, b, ca, cb);
            d = cyc_compare(aa, ab, table, eq);
            if (numval(d)!=0) return d;
            a = da;
            b = db;
            goto cyc_compare_top;
        }
        else {
            return fixnum(1);
        }
    }
    else if (isvector(a) && isvector(b)) {
        return cyc_vector_compare(a, b, table, eq);
    }
    else if (isclosure(a) && isclosure(b)) {
        function_t *fa = (function_t*)ptr(a);
        function_t *fb = (function_t*)ptr(b);
        d = bounded_compare(fa->bcode, fb->bcode, 1, eq);
        if (numval(d) != 0) return d;
        
        ca = eq_class(table, a);
        cb = eq_class(table, b);
        if (ca!=NIL && ca==cb)
            return fixnum(0);
        
        eq_union(table, a, b, ca, cb);
        d = cyc_compare(fa->vals, fb->vals, table, eq);
        if (numval(d) != 0) return d;
        a = fa->env;
        b = fb->env;
        goto cyc_compare_top;
    }
    return bounded_compare(a, b, 1, eq);
}