/* * Must be called on the worker that created the bag, no check yet! */ static int p_dbag_dissolve(value vdbag, type tdbag, value vl, type tl) { aport_id_t bag_aport_id; dbag_descr_t *dbag_descr; amsg_t this_msg; amsg_ref_t *this_msg_data_hdr; pword list; register pword *car, *cdr; Check_Integer(tdbag); bag_aport_id = (aport_id_t) vdbag.nint; Check_Output_List(tl); if (aport_get_option(bag_aport_id, APORT_DATA_PTR, (aport_optval_t *) &dbag_descr) != AMSG_OK) { Bip_Error(MPS_ERROR); } this_msg = dbag_descr->first.msg; this_msg_data_hdr = dbag_descr->first.msg_data_hdr; hp_free_size((generic_ptr) dbag_descr, sizeof(dbag_descr_t)); cdr = &list; while (this_msg_data_hdr != &dbag_descr->first) { pword *pw1; amsg_t old_msg; car = TG; Push_List_Frame(); Make_List(cdr, car); cdr = car + 1; pw1 = dbformat_to_term((char*)(this_msg_data_hdr+1), D_UNKNOWN, tdict); if (!pw1) { value va; va.did = d_.abort; Bip_Throw(va, tdict); } car->val.ptr = pw1->val.ptr; car->tag.kernel = pw1->tag.kernel; old_msg = this_msg; this_msg = this_msg_data_hdr->msg; this_msg_data_hdr = this_msg_data_hdr->msg_data_hdr; (void) amsg_free(old_msg); } Make_Nil(cdr); if (aport_deallocate(bag_aport_id) != AMSG_OK) { Bip_Error(MPS_ERROR); } Return_Unify_Pw(vl, tl, list.val, list.tag); }
static int p_get_par_goal(value v, type t) { pword *pw1; if (!par_goal_msg_) { Fail_; } pw1 = dbformat_to_term((char*) amsg_data(par_goal_msg_), D_UNKNOWN, tdict); if (!pw1) { value va; va.did = d_.abort; Bip_Throw(va, tdict); } Return_Unify_Pw(v, t, pw1->val, pw1->tag); }
int ec_load_eco_from_stream(stream_id nst, int options, pword *module) { int res; pword *clause, *query, *pw; pword query_pw, kernel_pw; pword top_module = *module; int encoded = 0; /* we are expecting an eco-encoded file, but we allow text as well */ res = _read_eco_header(nst); encoded = (res == PSUCCEED); StreamMode(nst) |= SNOMACROEXP; /* to avoid problems in text-eco files */ kernel_pw.val.did = d_.kernel_sepia; kernel_pw.tag.kernel = ModuleTag(d_.kernel_sepia); for(;;) { int recreate_module = 0; pword exports_pw, language_pw; pword *new_module = 0; if (encoded) /* encoded dbformat */ { int n; word nread; char *s = ec_getstring(nst, 4, &nread); if (!(s)) return nread; /* error code */ if (nread < 4) return (nread == 0) ? PSUCCEED : UNEXPECTED_EOF; n = (unsigned char) *s++ << 24; n |= (unsigned char) *s++ << 16; n |= (unsigned char) *s++ << 8; n |= (unsigned char) *s; s = ec_getstring(nst, n, &nread); if (!(s)) return nread; /* error code */ if (nread < n) return UNEXPECTED_EOF; clause = dbformat_to_term(s, module->val.did, module->tag); if (!clause) return NOT_DUMP_FILE; } else /* text format, call the parser */ { res = ec_read_term(nst, (GlobalFlags & VARIABLE_NAMES ? VARNAMES_PLEASE : 0), &query_pw, 0, 0, module->val, module->tag); if (res != PSUCCEED) return (res == PEOF) ? PSUCCEED : NOT_DUMP_FILE; clause = &query_pw; } Dereference_(clause); if (!IsStructure(clause->tag) || !Query(clause->val.ptr->val.did)) return NOT_DUMP_FILE; pw = query = clause->val.ptr + 1; Dereference_(pw); if (IsStructure(pw->tag)) /* look for special directives */ { if (pw->val.ptr->val.did == d_.module1) { recreate_module = 1; new_module = &pw->val.ptr[1]; Make_Nil(&exports_pw); Make_Atom(&language_pw, d_eclipse_language_); } if (pw->val.ptr->val.did == d_module_interface) { recreate_module = 1; new_module = &pw->val.ptr[1]; Make_Nil(&exports_pw); Make_Atom(&language_pw, d_eclipse_language_); } else if (pw->val.ptr->val.did == d_module2) { recreate_module = 1; new_module = &pw->val.ptr[1]; exports_pw = pw->val.ptr[2]; Make_Atom(&language_pw, d_eclipse_language_); } else if (pw->val.ptr->val.did == d_module3) { recreate_module = 1; new_module = &pw->val.ptr[1]; exports_pw = pw->val.ptr[2]; language_pw = pw->val.ptr[3]; } else if (pw->val.ptr->val.did == d_begin_module) { new_module = &pw->val.ptr[1]; query = &query_pw; /* don't execute anything */ Make_Atom(query, d_.true0); } else if (pw->val.ptr->val.did == d_.pragma) { query = &query_pw; /* ignore pragmas, replace with true */ Make_Atom(query, d_.true0); } } else if (pw->val.did == d_.system || pw->val.did == d_.system_debug) { query = &query_pw; /* ignore pragmas, replace with true */ Make_Atom(query, d_.true0); } if (recreate_module) /* build translated module query */ { pword *pgoal, *pcont; query = &query_pw; Make_Struct(query, TG); /* If module changes, raise CODE_UNIT_LOADED event first */ if (module->val.did != top_module.val.did) { pcont = TG; Push_Struct_Frame(d_.comma); Make_Struct(&pcont[1], TG); pgoal = TG; Push_Struct_Frame(d_.syserror); Make_Integer(&pgoal[1], CODE_UNIT_LOADED); Make_Atom(&pgoal[2], d_.eof); pgoal[3] = *module; pgoal[4] = *module; Make_Struct(&pcont[2], TG); } pcont = TG; Push_Struct_Frame(d_.comma); Make_Struct(&pcont[1], TG); pgoal = TG; Push_Struct_Frame(d_erase_module_); pgoal[1] = *new_module; Make_Struct(&pcont[2], TG); pgoal = TG; Push_Struct_Frame(d_create_module3_); pgoal[1] = *new_module; pgoal[2] = exports_pw; pgoal[3] = language_pw; res = query_emulc(query->val, query->tag, kernel_pw.val, kernel_pw.tag); } else { /* execute the query/directive */ res = query_emulc(query->val, query->tag, module->val, module->tag); } if (res != PSUCCEED) { pw = TG; Push_Struct_Frame(d_.syserror); Make_Integer(&pw[1], QUERY_FAILED); pw[2] = *query; pw[3] = *module; pw[4] = *module; query = &query_pw; Make_Struct(query, pw); (void) query_emulc(query->val, query->tag, kernel_pw.val, kernel_pw.tag); } if (new_module) /* change to new context module */ { Dereference_(new_module); *module = *new_module; } } return PSUCCEED; }