static char *get_init_filename(Scheme_Env *env) { Scheme_Object *f; Scheme_Thread * volatile p; mz_jmp_buf * volatile save, newbuf; p = scheme_get_current_thread(); save = p->error_buf; p->error_buf = &newbuf; if (!scheme_setjmp(newbuf)) { f = scheme_builtin_value("find-system-path"); if (f) { Scheme_Object *a[1]; a[0] = scheme_intern_symbol("init-file"); f = _scheme_apply(f, 1, a); if (SCHEME_PATHP(f)) { p->error_buf = save; return SCHEME_PATH_VAL(f); } } } p->error_buf = save; return NULL; }
static void *place_start_proc_after_stack(void *data_arg, void *stack_base) { Place_Start_Data *place_data; Scheme_Object *place_main; Scheme_Object *a[2], *channel; mzrt_thread_id ptid; intptr_t rc = 0; ptid = mz_proc_thread_self(); place_data = (Place_Start_Data *) data_arg; data_arg = NULL; /* printf("Startin place: proc thread id%u\n", ptid); */ /* create pristine THREAD_LOCAL variables*/ null_out_runtime_globals(); /* scheme_make_thread behaves differently if the above global vars are not null */ scheme_place_instance_init(stack_base); a[0] = scheme_places_deep_copy(place_data->current_library_collection_paths); scheme_current_library_collection_paths(1, a); a[0] = scheme_places_deep_copy(place_data->module); a[1] = scheme_places_deep_copy(place_data->function); a[1] = scheme_intern_exact_symbol(SCHEME_SYM_VAL(a[1]), SCHEME_SYM_LEN(a[1])); if (!SAME_TYPE(SCHEME_TYPE(place_data->channel), scheme_place_bi_channel_type)) { channel = scheme_places_deep_copy(place_data->channel); } else { channel = place_data->channel; } mzrt_sema_post(place_data->ready); place_data = NULL; # ifdef MZ_PRECISE_GC /* this prevents a master collection attempt from deadlocking with the place_data->ready semaphore above */ GC_allow_master_gc_check(); # endif /* at point point, don't refer to place_data or its content anymore, because it's allocated in the other place */ scheme_set_root_param(MZCONFIG_EXIT_HANDLER, scheme_def_place_exit_proc); { Scheme_Thread * volatile p; mz_jmp_buf * volatile saved_error_buf; mz_jmp_buf new_error_buf; p = scheme_get_current_thread(); saved_error_buf = p->error_buf; p->error_buf = &new_error_buf; if (!scheme_setjmp(new_error_buf)) { Scheme_Object *dynamic_require; dynamic_require = scheme_builtin_value("dynamic-require"); place_main = scheme_apply(dynamic_require, 2, a); a[0] = channel; scheme_apply(place_main, 1, a); } else { rc = 1; } p->error_buf = saved_error_buf; } /*printf("Leavin place: proc thread id%u\n", ptid);*/ scheme_place_instance_destroy(); return (void*) rc; }
void TpMzScheme::evalDesign(Design::Ptr d){ DesignStore::Ptr ds = Game::getGame()->getDesignStore(); if (scheme_setjmp(scheme_error_buf)) { Logger::getLogger()->warning("MzScheme Error"); } else { Scheme_Object* temp; std::ostringstream formater; formater.str(""); formater << "(define-values (struct:designType make-designType designType? designType-ref designType-set!)(make-design-type " << ds->getMaxPropertyId() << "))"; temp = scheme_eval_string(formater.str().c_str(), env); temp = scheme_eval_string("(define property-designType-set! (lambda (design id val) (designType-set! design (- id 1) val)))", env); std::set<uint32_t> propids = ds->getPropertyIds(); for(std::set<uint32_t>::iterator propit = propids.begin(); propit != propids.end(); ++propit){ // for each property type Property::Ptr p = ds->getProperty(*propit); if(p){ formater.str(""); formater << "(define designType." << p->getName() << " (make-property-accessor designType-ref " << p->getPropertyId() << " \"" << p->getName() << "\" ))"; temp = scheme_eval_string(formater.str().c_str(), env); } } propids.clear(); IdMap complist = d->getComponents(); temp = scheme_eval_string("(define design (make-designType))", env); for(std::set<uint32_t>::iterator propit = propids.begin(); propit != propids.end(); ++propit){ formater.str(""); formater << "(property-designType-set! design " << *propit << " 0.0)"; temp = scheme_eval_string(formater.str().c_str(), env); } std::map<uint32_t, std::map<uint32_t, std::list<std::string> > > propranking; for(IdMap::iterator compit = complist.begin(); compit != complist.end(); ++compit){ Component::Ptr c = ds->getComponent(compit->first); std::map<uint32_t, std::string> pilist = c->getPropertyList(); for(std::map<uint32_t, std::string>::iterator piit = pilist.begin(); piit != pilist.end(); ++piit){ Property::Ptr p = ds->getProperty(piit->first); for(uint32_t i = 0; i < compit->second; i++){ propranking[p->getRank()][p->getPropertyId()].push_back(piit->second); } } } std::map<uint32_t, PropertyValue> propertyvalues; for(std::map<uint32_t, std::map<uint32_t, std::list<std::string> > >::iterator rpiit = propranking.begin(); rpiit != propranking.end(); ++rpiit){ std::map<uint32_t, std::list<std::string> > pilist = rpiit->second; std::set<PropertyValue> localvalues; for(std::map<uint32_t, std::list<std::string> >::iterator piit = pilist.begin(); piit != pilist.end(); ++piit){ PropertyValue propval(piit->first,0.0); std::list<double> listvals; std::list<std::string> lambdas = piit->second; for(std::list<std::string>::iterator itlamb = lambdas.begin(); itlamb != lambdas.end(); ++itlamb){ temp = scheme_eval_string((std::string("(") + (*itlamb) + " design)").c_str(), env); if(!SCHEME_NUMBERP(temp)){ Logger::getLogger()->warning("MzScheme: Return not a number"); }else{ listvals.push_back(scheme_real_to_double(temp)); } } Property::Ptr p = ds->getProperty(piit->first); formater.str(""); formater << "(" << p->getTpclDisplayFunction() << " design '("; for(std::list<double>::iterator itvals = listvals.begin(); itvals != listvals.end(); ++itvals){ formater << *itvals << " "; } formater << "))"; temp = scheme_eval_string(formater.str().c_str(), env); #ifdef HAVE_MZSCHEME20X if(!SCHEME_PAIRP(temp) || !SCHEME_NUMBERP(SCHEME_CAR(temp)) || !SCHEME_STRINGP(SCHEME_CDR(temp))){ #else if(!SCHEME_PAIRP(temp) || !SCHEME_NUMBERP(SCHEME_CAR(temp)) || !SCHEME_CHAR_STRINGP(SCHEME_CDR(temp))){ #endif Logger::getLogger()->warning("MzScheme: Return not a pair, or the wrong time in the pair"); }else{ propval.setValue(scheme_real_to_double(SCHEME_CAR(temp))); #ifdef HAVE_MZSCHEME20X propval.setDisplayString(std::string(SCHEME_STR_VAL(SCHEME_CDR(temp)))); #else propval.setDisplayString(std::string((char*)SCHEME_CHAR_STR_VAL(SCHEME_CDR(temp)))); #endif localvalues.insert(propval); } } for(std::set<PropertyValue>::iterator pvit = localvalues.begin(); pvit != localvalues.end(); ++pvit){ PropertyValue pv = *pvit; formater.str(""); formater << "(property-designType-set! design " << pv.getPropertyId() << " " << pv.getValue() << ")"; temp = scheme_eval_string(formater.str().c_str(), env); propertyvalues[pv.getPropertyId()] = pv; } } d->setPropertyValues(propertyvalues); // now check if the design is valid bool valid = true; std::string feedback = ""; Logger::getLogger()->debug("About to process requirement functions"); for(IdMap::iterator compit = complist.begin(); compit != complist.end(); ++compit){ uint32_t curval = compit->first; //for each component in the design temp = scheme_eval_string((std::string("(") + ds->getComponent(curval)->getTpclRequirementsFunction() + " design)").c_str(), env); #ifdef HAVE_MZSCHEME20X if(!SCHEME_PAIRP(temp) || !SCHEME_STRINGP(SCHEME_CDR(temp))){ #else if(!SCHEME_PAIRP(temp) || !SCHEME_CHAR_STRINGP(SCHEME_CDR(temp))){ #endif Logger::getLogger()->warning("MzScheme: (a) Return not a pair, or the wrong time in the pair"); }else{ valid &= SCHEME_TRUEP(SCHEME_CAR(temp)); #ifdef HAVE_MZSCHEME20X std::string strtemp = SCHEME_STR_VAL(SCHEME_CDR(temp)); #else std::string strtemp = (char*)SCHEME_CHAR_STR_VAL(SCHEME_CDR(temp)); #endif if(strtemp.length() > 0) feedback += strtemp + " "; } } for(std::map<uint32_t, std::map<uint32_t, std::list<std::string> > >::iterator rpiit = propranking.begin(); rpiit != propranking.end(); ++rpiit){ std::map<uint32_t, std::list<std::string> > pilist = rpiit->second; for(std::map<uint32_t, std::list<std::string> >::iterator piit = pilist.begin(); piit != pilist.end(); ++piit){ temp = scheme_eval_string((std::string("(") + ds->getProperty(piit->first)->getTpclRequirementsFunction() + " design)").c_str(), env); #ifdef HAVE_MZSCHEME20X if(!SCHEME_PAIRP(temp) || !SCHEME_STRINGP(SCHEME_CDR(temp))){ #else if(!SCHEME_PAIRP(temp) || !SCHEME_CHAR_STRINGP(SCHEME_CDR(temp))){ #endif Logger::getLogger()->warning("MzScheme: (a) Return not a pair, or the wrong time in the pair"); }else{ valid &= SCHEME_TRUEP(SCHEME_CAR(temp)); #ifdef HAVE_MZSCHEME20X std::string strtemp = SCHEME_STR_VAL(SCHEME_CDR(temp)); #else std::string strtemp = (char*)SCHEME_CHAR_STR_VAL(SCHEME_CDR(temp)); #endif if(strtemp.length() > 0) feedback += strtemp + " "; } } } propranking.clear(); d->setValid(valid, feedback); Logger::getLogger()->debug("Eval'ed design"); if(!valid){ Logger::getLogger()->debug("Design %s is not valid, reason: %s", d->getName().c_str(), feedback.c_str()); } } } TpMzScheme::TpMzScheme(){ //scheme_set_stack_base(NULL, 1); /* required for OS X, only. WILL NOT WORK HERE */ bool loaded = false; env = scheme_basic_env(); if (scheme_setjmp(scheme_error_buf)) { Logger::getLogger()->warning("MzScheme warning: could not load local file, trying installed file"); } else { scheme_eval_string("(load \"../modules/tpcl/mzscheme/designstruct.scm\")",env); loaded = true; } if(loaded == false){ if (scheme_setjmp(scheme_error_buf)) { Logger::getLogger()->warning("MzScheme warning: could not load installed file"); } else { scheme_eval_string("(load \"" DATADIR "/tpserver/tpscheme/mzscheme/designstruct.scm\")", env); loaded = true; } } if(loaded == false){ Logger::getLogger()->error("MzScheme Error: failed to load designstruct.scm file"); //throw exception? } }
/* * Get the init filename for the system * * First look to see if <addon-dir>/interactive.rkt exists * * Otherwise check config file for location */ static Scheme_Object *get_init_filename(Scheme_Env *env, char *init_filename_sym, char *default_init_module, char *user_init_module) { Scheme_Object *f, *a[2], *build_path; Scheme_Thread * volatile p; mz_jmp_buf * volatile save, newbuf; p = scheme_get_current_thread(); save = p->error_buf; p->error_buf = &newbuf; if(!scheme_setjmp(newbuf)) { build_path = scheme_builtin_value("build-path"); /* First test to see if user init file exists */ f = scheme_builtin_value("find-system-path"); a[0] = scheme_intern_symbol("addon-dir"); a[0] = _scheme_apply(f, 1, a); a[1] = scheme_make_path(user_init_module); f = _scheme_apply(build_path, 2, a); if (SCHEME_PATHP(f)) { char *filename; filename = scheme_expand_filename(SCHEME_PATH_VAL(f), -1, "startup", NULL, SCHEME_GUARD_FILE_EXISTS); if(scheme_file_exists(filename)) { p->error_buf = save; return scheme_make_path(filename); } } /* Failed, next check config.rkt fo system init file */ f = scheme_builtin_value("find-main-config"); a[0] = _scheme_apply(f, 0, NULL); a[1] = scheme_make_path("config.rktd"); f = _scheme_apply(build_path, 2, a); if (SCHEME_PATHP(f)) { char *filename; filename = scheme_expand_filename(SCHEME_PATH_VAL(f), -1, "startup", NULL, SCHEME_GUARD_FILE_EXISTS | SCHEME_GUARD_FILE_READ); if(scheme_file_exists(filename)) { Scheme_Object * port; port = scheme_open_input_file(SCHEME_PATH_VAL(f), "get-init-filename"); f = scheme_read(port); scheme_close_input_port(port); if(SCHEME_HASHTRP(f)) { f = scheme_hash_tree_get((Scheme_Hash_Tree *)f, scheme_intern_symbol(init_filename_sym)); if(f) { p->error_buf = save; return f; } } } } /* Failed to load custom init file, load racket/interactive */ f = scheme_intern_symbol(default_init_module); p->error_buf = save; return f; } p->error_buf = save; return NULL; }