int p_print_array(value va, type ta, value vm, type tm) { int size = 1; /* number of array elements */ pword *p; uword *dim; dident wdid; int arity; Error_If_Ref(ta); if (IsAtom(ta)) /* a global variable */ wdid = va.did; else /* an array */ { Get_Functor_Did(va, ta, wdid); Get_Visible_Array_Header(wdid, vm, tm, p); if (!IsStructure(p->tag)) /* error if not prolog */ { Error(TYPE_ERROR); } dim = (uword *) p->val.ptr; dim++; /* skip the did */ for (arity = DidArity(wdid); arity; arity--) size *= *dim++; /* compute the size */ } Get_Visible_Array_Address(wdid, vm, tm, p); for (; size; size--, p++) { Write(p->val, p->tag, Current_Output); Fprintf(Current_Output, " "); } Succeed; }
static int _heap_arr_set(t_ext_ptr h, int i, pword pw) /* expected to be dereferenced */ { pword copy_pw; pword *pheap; int err, arity; pheap = ((t_heap_array*)h)->array; arity = DidArity(pheap[0].val.did); if (i >= 1 && i <= arity) { if ((err = create_heapterm(©_pw, pw.val, pw.tag)) != PSUCCEED) { Bip_Error(err); } a_mutex_lock(&SharedDataLock); free_heapterm(&pheap[i]); move_heapterm(©_pw, &pheap[i]); a_mutex_unlock(&SharedDataLock); } else if (i == 0) { if (IsStructure(pw.tag) && pw.val.ptr->val.did == pheap[0].val.did) { pword *aux = TG; Push_Struct_Frame(pheap[0].val.did); for (i=1; i<=arity; ++i) { pword *parg = &pw.val.ptr[i]; Dereference_(parg); if ((err = create_heapterm(aux+i, parg->val, parg->tag)) != PSUCCEED) { TG = aux; Bip_Error(err); } } a_mutex_lock(&SharedDataLock); for (i=1; i<=arity; ++i) { free_heapterm(&pheap[i]); move_heapterm(aux+i, &pheap[i]); } a_mutex_unlock(&SharedDataLock); TG = aux; } else { Bip_Error(RANGE_ERROR); } } else { Bip_Error(RANGE_ERROR); } Succeed_; }
static int p_tool_body(value vi, type ti, value vb, type tb, value vmb, type tmb, value vm, type tm) { dident di; pri *procb, *proci; int flags, arity; dident module; dident pdid; pword *ptr = Gbl_Tg; vmcode *code; int err; Prepare_Requests; Check_Module(tm, vm); Get_Proc_Did(vi, ti, di); if (!IsRef(tb) && (!IsStructure(tb) || vb.ptr->val.did != d_.quotient)) { Bip_Error(TYPE_ERROR); } Check_Output_Atom_Or_Nil(vmb, tmb); if (!(proci = visible_procedure(di, vm.did, tm, PRI_CREATE))) { Get_Bip_Error(err); Bip_Error(err); } if (!_tool_body(proci, &pdid, &arity, &module)) { Get_Bip_Error(err); Bip_Error(err); } Gbl_Tg += 3; Check_Gc; ptr[0].tag.kernel = TDICT; ptr[0].val.did = d_.quotient; ptr[1].tag.kernel = TDICT; ptr[1].val.did = add_dict(pdid, 0); ptr[2].tag.kernel = TINT; ptr[2].val.nint = arity; Request_Unify_Atom(vmb, tmb, module); Request_Unify_Structure(vb, tb, ptr); Return_Unify; }
void Bindable::ValidateWithEventsVarsInHandlesListsAndSynthesizePropertiesIfRequired() { BCSYM_Container *ContainerOfHandlingMethods = CurrentContainer(); if (!IsClass(ContainerOfHandlingMethods) && !IsStructure(ContainerOfHandlingMethods) && !IsStdModule(ContainerOfHandlingMethods)) { return; } Symbols SymbolFactory( CurrentCompilerInstance(), CurrentAllocator(), NULL, CurrentGenericBindingCache()); BCITER_CHILD Members(ContainerOfHandlingMethods); while(BCSYM_NamedRoot *Member = Members.GetNext()) { // only method implementations can have handles clauses if (!Member->IsMethodImpl()) { continue; } BCSYM_Proc *Proc = Member->PProc(); BCITER_Handles iterHandles(Member->PMethodImpl()); BCSYM_HandlesList *Handles = iterHandles.GetNext(); if (!Handles) { continue; } ErrorTable *ErrorLog = CurrentErrorLog(Proc); for(; Handles; Handles = iterHandles.GetNext()) { if (Handles->IsMyBase() || Handles->IsEventFromMeOrMyClass()) { continue; } bool FoundInBase; BCSYM_Variable *WithEventsVar = GetWithEventsVarReferredToInHandlesClause( Handles, FoundInBase); if (!WithEventsVar) { // "Handles clause requires a WithEvents variable." ReportErrorAtLocation( ERRID_NoWithEventsVarOnHandlesList, ErrorLog, Handles->GetLocationOfWithEventsVar()); Handles->SetIsBad(); } else if (WithEventsVar->IsBad() || WithEventsVar->IsBadVariableType() || // the type of the variable is good, but is not a class or interface WithEventsVar->GetType()->IsBad()) // the type of the variable is bad { // Any metadata errors on a symbol should be reported at the location // the symbol is used in source code // if (DefinedInMetaData(WithEventsVar->GetContainer())) { VSASSERT( !DefinedInMetaData(CurrentContainer()), "How can Current Context for handles clauses not be in VB Source Code ?!"); WithEventsVar->ReportError( CurrentCompilerInstance(), ErrorLog, Handles->GetLocationOfWithEventsVar()); } Handles->SetIsBad(); } else { // get the withevents property if possible BCSYM_Property *WithEventsProperty = GetWithEventsPropertyForWithEventsVariable(WithEventsVar->PVariable()); // Create it if it doesn't exist (for handling events defined on // WithEvent vars that exist on a base class). // if (!WithEventsProperty) { VSASSERT(FoundInBase, "Why do we have to synthesize a property for a withevents variable in the current class ? It should already have been synthesized in declared!!"); WithEventsProperty = SynthesizeWithEventsProperty(WithEventsVar->PVariable(), SymbolFactory); WithEventsProperty->SetCreatedByHandlesClause(Handles); } Handles->SetWithEventsProperty(WithEventsProperty); } } } }
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; }