mrb_value
mrb_vm_const_get(mrb_state *mrb, mrb_sym sym)
{
struct RClass *c = mrb->c->ci->proc->target_class;
if (!c) c = mrb->c->ci->target_class;
if (c) {
struct RClass *c2;
mrb_value v;
if (c->iv && iv_get(mrb, c->iv, sym, &v)) {
return v;
}
if (c->tt == MRB_TT_SCLASS) {
mrb_value klass;
klass = mrb_obj_iv_get(mrb, (struct RObject *)c,
mrb_intern_lit(mrb, "__attached__"));
c2 = mrb_class_ptr(klass);
if (c2->tt == MRB_TT_CLASS)
c = c2;
}
c2 = c;
for (;;) {
c2 = mrb_class_outer_module(mrb, c2);
if (!c2) break;
if (c2->iv && iv_get(mrb, c2->iv, sym, &v)) {
return v;
}
}
}
return const_get(mrb, c, sym);
}
mrb_value
mrb_vm_const_get(mrb_state *mrb, mrb_sym sym)
{
struct RClass *c;
struct RClass *c2;
mrb_value v;
struct RProc *proc;
c = MRB_PROC_TARGET_CLASS(mrb->c->ci->proc);
if (iv_get(mrb, c->iv, sym, &v)) {
return v;
}
c2 = c;
while (c2 && c2->tt == MRB_TT_SCLASS) {
mrb_value klass;
if (!iv_get(mrb, c2->iv, mrb_intern_lit(mrb, "__attached__"), &klass)) {
c2 = NULL;
break;
}
c2 = mrb_class_ptr(klass);
}
if (c2 && (c2->tt == MRB_TT_CLASS || c2->tt == MRB_TT_MODULE)) c = c2;
mrb_assert(!MRB_PROC_CFUNC_P(mrb->c->ci->proc));
proc = mrb->c->ci->proc;
while (proc) {
c2 = MRB_PROC_TARGET_CLASS(proc);
if (c2 && iv_get(mrb, c2->iv, sym, &v)) {
return v;
}
proc = proc->upper;
}
return const_get(mrb, c, sym);
}
mrb_value
mrb_vm_const_get(mrb_state *mrb, mrb_sym sym)
{
struct RClass *c = mrb->c->ci->proc->target_class;
struct RClass *c2;
mrb_value v;
mrb_irep *irep;
if (!c) c = mrb->c->ci->target_class;
mrb_assert(c != NULL);
if (c->iv && iv_get(mrb, c->iv, sym, &v)) {
return v;
}
c2 = c;
while (c2 && c2->tt == MRB_TT_SCLASS) {
mrb_value klass;
klass = mrb_obj_iv_get(mrb, (struct RObject *)c2,
mrb_intern_lit(mrb, "__attached__"));
c2 = mrb_class_ptr(klass);
}
if (c2->tt == MRB_TT_CLASS || c2->tt == MRB_TT_MODULE) c = c2;
mrb_assert(!MRB_PROC_CFUNC_P(mrb->c->ci->proc));
irep = mrb->c->ci->proc->body.irep;
while (irep) {
if (irep->target_class) {
c2 = irep->target_class;
if (c2->iv && iv_get(mrb, c2->iv, sym, &v)) {
return v;
}
}
irep = irep->outer;
}
return const_get(mrb, c, sym);
}
void
mrb_mod_cv_set(mrb_state *mrb, struct RClass * c, mrb_sym sym, mrb_value v)
{
struct RClass * cls = c;
while (c) {
if (c->iv) {
iv_tbl *t = c->iv;
if (iv_get(mrb, t, sym, NULL)) {
mrb_write_barrier(mrb, (struct RBasic*)c);
iv_put(mrb, t, sym, v);
return;
}
}
c = c->super;
}
if (!cls->iv) {
cls->iv = iv_new(mrb);
}
mrb_write_barrier(mrb, (struct RBasic*)cls);
iv_put(mrb, cls->iv, sym, v);
}
void
mrb_vm_cv_set(mrb_state *mrb, mrb_sym sym, mrb_value v)
{
struct RClass *c = mrb->ci->proc->target_class;
if (!c) c = mrb->ci->target_class;
while (c) {
if (c->iv) {
iv_tbl *t = c->iv;
if (iv_get(mrb, t, sym, NULL)) {
mrb_write_barrier(mrb, (struct RBasic*)c);
iv_put(mrb, t, sym, v);
return;
}
}
c = c->super;
}
c = mrb->ci->target_class;
if (!c->iv) {
c->iv = iv_new(mrb);
}
mrb_write_barrier(mrb, (struct RBasic*)c);
iv_put(mrb, c->iv, sym, v);
}
static mrb_value
const_get(mrb_state *mrb, struct RClass *base, mrb_sym sym)
{
struct RClass *c = base;
mrb_value v;
iv_tbl *t;
mrb_bool retry = FALSE;
mrb_value name;
L_RETRY:
while (c) {
if (c->iv) {
t = c->iv;
if (iv_get(mrb, t, sym, &v))
return v;
}
c = c->super;
}
if (!retry && base && base->tt == MRB_TT_MODULE) {
c = mrb->object_class;
retry = TRUE;
goto L_RETRY;
}
name = mrb_symbol_value(sym);
return mrb_funcall_argv(mrb, mrb_obj_value(base), mrb_intern_lit(mrb, "const_missing"), 1, &name);
}
mrb_value
mrb_obj_iv_get(mrb_state *mrb, struct RObject *obj, mrb_sym sym)
{
mrb_value v;
if (obj->iv && iv_get(mrb, obj->iv, sym, &v))
return v;
return mrb_nil_value();
}
MRB_API mrb_value
mrb_gv_get(mrb_state *mrb, mrb_sym sym)
{
mrb_value v;
if (iv_get(mrb, mrb->globals, sym, &v))
return v;
return mrb_nil_value();
}
mrb_bool
mrb_const_defined(mrb_state *mrb, mrb_value mod, mrb_sym sym)
{
struct RClass *m = mrb_class_ptr(mod);
iv_tbl *t = m->iv;
if (!t) return FALSE;
return iv_get(mrb, t, sym, NULL);
}
mrb_bool
mrb_obj_iv_defined(mrb_state *mrb, struct RObject *obj, mrb_sym sym)
{
iv_tbl *t;
t = obj->iv;
if (t) {
return iv_get(mrb, t, sym, NULL);
}
return FALSE;
}
MRB_API mrb_bool
mrb_mod_cv_defined(mrb_state *mrb, struct RClass * c, mrb_sym sym)
{
while (c) {
iv_tbl *t = c->iv;
if (iv_get(mrb, t, sym, NULL)) return TRUE;
c = c->super;
}
return FALSE;
}
int
Tcl_AppInit(Tcl_Interp *interp)
{
if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
return TCL_ERROR;
}
if (Tcl_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
theInterp = interp;
new If_Int("if_int", &if_int);
new If_Int("if_intCb",
new If_GetCb<int, A>(&A::i, &a));
new If_Bool("if_bool", &if_bool);
new If_Real("if_real", &if_real);
if_realVec = v_get(5);
new If_RealVec("if_realVec", &if_realVec);
if_realMat = m_get(2,3);
new If_RealMat("if_realMat", &if_realMat);
if_intVec = iv_get(3);
new If_IntVec("if_intVec", &if_intVec);
new If_IntVec("if_intVecp",
new If_GetCb<const IVECP, A>(&A::intVecp, &a),
new If_SetCb<const IVECP, A>(&A::set_intVecp, &a));
new If_String("if_string", &if_string);
new If_String("if_stringCb",
new If_GetCb<const char *, A>(&A::string, &a),
new If_SetCb<const char *, A>(&A::set_string, &a));
new If_StdString("if_stdString",
new If_GetCb<const std::string&, A>(&A::stdString, &a),
new If_SetCb<const std::string&, A>(&A::set_stdString, &a));
new If_Procedure("if_procedure", &if_procedure);
new If_Method<A>("if_method", &A::if_method, &a);
Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY);
return TCL_OK;
}
void
mrb_obj_iv_ifnone(mrb_state *mrb, struct RObject *obj, mrb_sym sym, mrb_value v)
{
iv_tbl *t = obj->iv;
if (!t) {
t = obj->iv = iv_new(mrb);
}
else if (iv_get(mrb, t, sym, &v)) {
return;
}
mrb_write_barrier(mrb, (struct RBasic*)obj);
iv_put(mrb, t, sym, v);
}
mrb_value
mrb_vm_const_get(mrb_state *mrb, mrb_sym sym)
{
struct RClass *c = mrb->ci->proc->target_class;
if (!c) c = mrb->ci->target_class;
if (c) {
struct RClass *c2 = c;
mrb_value v;
if (c->iv && iv_get(mrb, c->iv, sym, &v)) {
return v;
}
c2 = c;
for (;;) {
c2 = mrb_class_outer_module(mrb, c2);
if (!c2) break;
if (c2->iv && iv_get(mrb, c2->iv, sym, &v)) {
return v;
}
}
}
return const_get(mrb, c, sym);
}
//-------------------------------------------------------------------------
Prg_ASCEND::Prg_ASCEND()
{
_nvars = 0;
_nrels = 0;
_vars = NULL;
_rels = NULL;
_obj = NULL;
_safe_calc = TRUE;
_var_lb = v_resize(v_get(1), 0);
_var_ub = v_resize(v_get(1), 0);
_var_asc2hqp = iv_resize(iv_get(1), 0);
_derivatives = v_resize(v_get(1), 0);
_var_master_idxs = iv_resize(iv_get(1), 0);
_var_solver_idxs = iv_resize(iv_get(1), 0);
_Inf = 1e38; // todo: should be initialized from ASCEND data
_me_bounds = 0;
_m_bounds = 0;
memset(&_slv_status, 0, sizeof(slv_status_t));
// create interface elements
_ifList.append(new If_Int("prg_safe_calc", &_safe_calc));
slv_register_client(Prg_ASCEND::slv_register, NULL, NULL);
}
extern int iv_get_vars(int dim,...)
{
va_list ap;
int i=0;
IVEC **par;
va_start(ap, dim);
while (par = va_arg(ap,IVEC **)) { /* NULL ends the list*/
*par = iv_get(dim);
i++;
}
va_end(ap);
return i;
}
MRB_API mrb_value
mrb_mod_cv_get(mrb_state *mrb, struct RClass *c, mrb_sym sym)
{
struct RClass * cls = c;
mrb_value v;
int given = FALSE;
while (c) {
if (c->iv && iv_get(mrb, c->iv, sym, &v)) {
given = TRUE;
}
c = c->super;
}
if (given) return v;
if (cls && cls->tt == MRB_TT_SCLASS) {
mrb_value klass;
klass = mrb_obj_iv_get(mrb, (struct RObject *)cls,
mrb_intern_lit(mrb, "__attached__"));
c = mrb_class_ptr(klass);
if (c->tt == MRB_TT_CLASS || c->tt == MRB_TT_MODULE) {
given = FALSE;
while (c) {
if (c->iv && iv_get(mrb, c->iv, sym, &v)) {
given = TRUE;
}
c = c->super;
}
if (given) return v;
}
}
mrb_name_error(mrb, sym, "uninitialized class variable %S in %S",
mrb_sym2str(mrb, sym), mrb_obj_value(cls));
/* not reached */
return mrb_nil_value();
}
MRB_API void
mrb_mod_cv_set(mrb_state *mrb, struct RClass *c, mrb_sym sym, mrb_value v)
{
struct RClass * cls = c;
while (c) {
if (c->iv) {
iv_tbl *t = c->iv;
if (iv_get(mrb, t, sym, NULL)) {
mrb_write_barrier(mrb, (struct RBasic*)c);
iv_put(mrb, t, sym, v);
return;
}
}
c = c->super;
}
if (cls && cls->tt == MRB_TT_SCLASS) {
mrb_value klass;
klass = mrb_obj_iv_get(mrb, (struct RObject*)cls,
mrb_intern_lit(mrb, "__attached__"));
switch (mrb_type(klass)) {
case MRB_TT_CLASS:
case MRB_TT_MODULE:
case MRB_TT_SCLASS:
c = mrb_class_ptr(klass);
break;
default:
c = cls;
break;
}
}
else{
c = cls;
}
if (!c->iv) {
c->iv = iv_new(mrb);
}
mrb_write_barrier(mrb, (struct RBasic*)c);
iv_put(mrb, c->iv, sym, v);
}
mrb_value
mrb_vm_cv_get(mrb_state *mrb, mrb_sym sym)
{
struct RClass *c = mrb->ci->proc->target_class;
if (!c) c = mrb->ci->target_class;
while (c) {
if (c->iv) {
iv_tbl *t = c->iv;
mrb_value v;
if (iv_get(mrb, t, sym, &v))
return v;
}
c = c->super;
}
return mrb_nil_value();
}
mrb_value
mrb_mod_cv_get(mrb_state *mrb, struct RClass * c, mrb_sym sym)
{
struct RClass * cls = c;
while (c) {
if (c->iv) {
iv_tbl *t = c->iv;
mrb_value v;
if (iv_get(mrb, t, sym, &v))
return v;
}
c = c->super;
}
mrb_raisef(mrb, E_NAME_ERROR, "uninitialized class variable %s in %s",
mrb_sym2name(mrb, sym), mrb_class_name(mrb, cls));
/* not reached */
return mrb_nil_value();
}
mrb_value
mrb_mod_cv_get(mrb_state *mrb, struct RClass * c, mrb_sym sym)
{
struct RClass * cls = c;
while (c) {
if (c->iv) {
iv_tbl *t = c->iv;
mrb_value v;
if (iv_get(mrb, t, sym, &v))
return v;
}
c = c->super;
}
mrb_name_error(mrb, sym, "uninitialized class variable %S in %S",
mrb_sym2str(mrb, sym), cls);
/* not reached */
return mrb_nil_value();
}
static mrb_bool
mrb_const_defined_0(mrb_state *mrb, struct RClass *klass, mrb_sym id, mrb_bool exclude, mrb_bool recurse)
{
struct RClass * tmp;
mrb_bool mod_retry = 0;
tmp = klass;
retry:
while (tmp) {
if (tmp->iv && iv_get(mrb, tmp->iv, id, NULL)) {
return TRUE;
}
if (!recurse && (klass != mrb->object_class)) break;
tmp = tmp->super;
}
if (!exclude && !mod_retry && (klass->tt == MRB_TT_MODULE)) {
mod_retry = 1;
tmp = mrb->object_class;
goto retry;
}
return FALSE;
}
static int
mrb_const_defined_0(mrb_state *mrb, struct RClass *klass, mrb_sym id, int exclude, int recurse)
{
struct RClass * tmp;
int mod_retry = 0;
tmp = klass;
retry:
while (tmp) {
if (tmp->iv && iv_get(mrb, tmp->iv, id, NULL)) {
return 1;
}
if (!recurse && (klass != mrb->object_class)) break;
tmp = tmp->super;
}
if (!exclude && !mod_retry && (klass->tt == MRB_TT_MODULE)) {
mod_retry = 1;
tmp = mrb->object_class;
goto retry;
}
return (int)0/*Qfalse*/;
}
static mrb_value
const_get(mrb_state *mrb, struct RClass *base, mrb_sym sym)
{
struct RClass *c = base;
mrb_value v;
iv_tbl *t;
mrb_bool retry = 0;
mrb_sym cm;
L_RETRY:
while (c) {
if (c->iv) {
t = c->iv;
if (iv_get(mrb, t, sym, &v))
return v;
}
c = c->super;
}
if (!retry && base && base->tt == MRB_TT_MODULE) {
c = mrb->object_class;
retry = 1;
goto L_RETRY;
}
c = base;
cm = mrb_intern2(mrb, "const_missing", 13);
while (c) {
if (mrb_respond_to(mrb, mrb_obj_value(c), cm)) {
mrb_value name = mrb_symbol_value(sym);
return mrb_funcall_argv(mrb, mrb_obj_value(c), cm, 1, &name);
}
c = c->super;
}
mrb_raisef(mrb, E_NAME_ERROR, "uninitialized constant %s",
mrb_sym2name(mrb, sym));
/* not reached */
return mrb_nil_value();
}
//--------------------------------------------------------------------------
void Hqp_IpRedSpBKP::init(const Hqp_Program *qp)
{
IVEC *degree, *neigh_start, *neighs;
SPMAT *QCTC;
SPROW *r1, *r2;
int i, j;
int len, dim;
Real sum;
_n = qp->c->dim;
_me = qp->b->dim;
_m = qp->d->dim;
dim = _n + _me;
// reallocations
_pivot = px_resize(_pivot, dim);
_blocks = px_resize(_blocks, dim);
_zw = v_resize(_zw, _m);
_scale = v_resize(_scale, _n);
_r12 = v_resize(_r12, dim);
_xy = v_resize(_xy, dim);
// store C' for further computations
// analyze structure of C'*C
_CT = sp_transp(qp->C, _CT);
sp_ones(_CT);
v_ones(_zw);
QCTC = sp_get(_n, _n, 10);
r1 = _CT->row;
for (i=0; i<_n; i++, r1++) {
r2 = r1;
for (j=i; j<_n; j++, r2++) {
sum = sprow_inprod(r1, _zw, r2);
if (sum != 0.0) {
sp_set_val(QCTC, i, j, sum);
if (i != j)
sp_set_val(QCTC, j, i, sum);
}
}
}
_CTC_degree = iv_resize(_CTC_degree, _n);
_CTC_neigh_start = iv_resize(_CTC_neigh_start, _n + 1);
_CTC_neighs = sp_rcm_scan(QCTC, SMNULL, SMNULL,
_CTC_degree, _CTC_neigh_start, _CTC_neighs);
// initialize structure of reduced qp
QCTC = sp_add(qp->Q, QCTC, QCTC);
// determine RCM ordering
degree = iv_get(dim);
neigh_start = iv_get(dim + 1);
neighs = sp_rcm_scan(QCTC, qp->A, SMNULL, degree, neigh_start, IVNULL);
_QP2J = sp_rcm_order(degree, neigh_start, neighs, _QP2J);
_sbw = sp_rcm_sbw(neigh_start, neighs, _QP2J);
_J2QP = px_inv(_QP2J, _J2QP);
iv_free(degree);
iv_free(neigh_start);
iv_free(neighs);
len = 1 + (int)(log((double)dim) / log(2.0));
sp_free(_J);
sp_free(_J_raw);
_J_raw = sp_get(dim, dim, len);
_J = SMNULL;
// fill up data (to allocate _J_raw)
sp_into_symsp(QCTC, -1.0, _J_raw, _QP2J, 0, 0);
spT_into_symsp(qp->A, 1.0, _J_raw, _QP2J, 0, _n);
sp_into_symsp(qp->A, 1.0, _J_raw, _QP2J, _n, 0);
sp_free(QCTC);
// prepare iterations
update(qp);
}
A(): _i(11),
_stdString("initial stdString value") {
_intVecp = iv_get(2);
_string = strdup("initial string value");
}
