From fd7582b6189d1cd0d00450b3f0d379d37cd6d5c9 Mon Sep 17 00:00:00 2001 From: vsc Date: Fri, 6 Feb 2004 02:26:23 +0000 Subject: [PATCH] improve save/restore git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@966 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- C/agc.c | 6 +- C/amasm.c | 2 +- C/c_interface.c | 1 - C/cdmgr.c | 1 + C/init.c | 100 +++++++------- C/modules.c | 18 ++- C/save.c | 31 ++--- C/stdpreds.c | 1 + C/tracer.c | 3 - H/Yapproto.h | 3 +- H/rheap.h | 341 ++++++++++++++++++++++++------------------------ m4/sshift.h.m4 | 5 + 12 files changed, 265 insertions(+), 247 deletions(-) diff --git a/C/agc.c b/C/agc.c index c1fccc15d..12f692192 100644 --- a/C/agc.c +++ b/C/agc.c @@ -29,7 +29,6 @@ static char SccsId[] = "@(#)agc.c 1.3 3/15/90"; #endif STATIC_PROTO(void RestoreEntries, (PropEntry *)); -STATIC_PROTO(void ConvDBList, (Term, char *,CELL)); static int agc_calls; @@ -124,8 +123,13 @@ AtomAdjust(Atom a) #define DelayAddrAdjust(P) (P) #define DBRefAdjust(P) (P) #define DBRefPAdjust(P) (P) +#define DBTermAdjust(P) (P) +#define LUIndexAdjust(P) (P) +#define SIndexAdjust(P) (P) #define LocalAddrAdjust(P) (P) #define GlobalAddrAdjust(P) (P) +#define PtoLUCAdjust(P) (P) +#define PtoStCAdjust(P) (P) #define PtoArrayEAdjust(P) (P) #define PtoDelayAdjust(P) (P) #define PtoGloAdjust(P) (P) diff --git a/C/amasm.c b/C/amasm.c index 433c1191c..9db128efc 100644 --- a/C/amasm.c +++ b/C/amasm.c @@ -2170,8 +2170,8 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp cl_u->lui.SiblingIndex = NULL; cl_u->lui.u.pred = cip->CurrentPred; cl_u->lui.ClRefCount = 0; -#if defined(YAPOR) || defined(THREADS) INIT_LOCK(cl_u->lui.ClLock); +#if defined(YAPOR) || defined(THREADS) INIT_CLREF_COUNT(&(cl_u->lui)); #endif } diff --git a/C/c_interface.c b/C/c_interface.c index 0c573558a..74c5f898e 100644 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -890,7 +890,6 @@ YAP_Init(YAP_init_args *yap_init) } else { Heap = yap_init->HeapSize; } - Yap_InitWorkspace(Heap, Stack, Trail, yap_init->NumberWorkers, yap_init->SchedulerLoop, diff --git a/C/cdmgr.c b/C/cdmgr.c index 0873f2f4c..ad150f5ae 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -3526,6 +3526,7 @@ Yap_InitCdMgr(void) Yap_InitCPred("$pred_exists", 2, p_pred_exists, TestPredFlag | SafePredFlag); Yap_InitCPred("$number_of_clauses", 3, p_number_of_clauses, SafePredFlag|SyncPredFlag); Yap_InitCPred("$undefined", 2, p_undefined, SafePredFlag|TestPredFlag); + fprintf(stderr,"initialised\n"); Yap_InitCPred("$optimizer_on", 0, p_optimizer_on, SafePredFlag|SyncPredFlag); Yap_InitCPred("$clean_up_dead_clauses", 0, p_clean_up_dead_clauses, SyncPredFlag); Yap_InitCPred("$optimizer_off", 0, p_optimizer_off, SafePredFlag|SyncPredFlag); diff --git a/C/init.c b/C/init.c index 58ffdd2b3..5c6db3b3e 100644 --- a/C/init.c +++ b/C/init.c @@ -450,14 +450,14 @@ InitDebug(void) } #endif /* Set at full leash */ - At = Yap_LookupAtom("$leash"); + At = Yap_FullLookupAtom("$leash"); Yap_PutValue(At, MkIntTerm(15)); } void Yap_InitCPred(char *Name, unsigned long int Arity, CPredicate code, int flags) { - Atom atom = Yap_LookupAtom(Name); + Atom atom = Yap_FullLookupAtom(Name); PredEntry *pe; yamop *p_code = ((StaticClause *)NULL)->ClCode; StaticClause *cl; @@ -532,7 +532,7 @@ Yap_InitCmpPred(char *Name, unsigned long int Arity, CmpPredicate cmp_code, int void Yap_InitAsmPred(char *Name, unsigned long int Arity, int code, CPredicate def, int flags) { - Atom atom = Yap_LookupAtom(Name); + Atom atom = Yap_FullLookupAtom(Name); PredEntry *pe; if (Arity) @@ -600,7 +600,7 @@ void Yap_InitCPredBack(char *Name, unsigned long int Arity, unsigned int Extra, CPredicate Start, CPredicate Cont, int flags) { PredEntry *pe; - Atom atom = Yap_LookupAtom(Name); + Atom atom = Yap_FullLookupAtom(Name); if (Arity) pe = RepPredProp(PredPropByFunc(Yap_MkFunctor(atom, Arity),CurrentModule)); @@ -841,32 +841,32 @@ InitCodes(void) */ heap_regs->primitives_module = 0; heap_regs->user_module = 1; - heap_regs->atom_abol = Yap_LookupAtom("$abol"); + heap_regs->atom_abol = Yap_FullLookupAtom("$abol"); AtomAltNot = Yap_LookupAtom("not"); heap_regs->atom_append = Yap_LookupAtom ("append"); - heap_regs->atom_array = Yap_LookupAtom("$array"); + heap_regs->atom_array = Yap_FullLookupAtom("$array"); #ifdef COROUTINING - AtomArrayAccess = Yap_LookupAtom("$array_arg"); + AtomArrayAccess = Yap_FullLookupAtom("$array_arg"); #endif AtomArrow = Yap_LookupAtom("->"); heap_regs->atom_assert = Yap_LookupAtom(":-"); - heap_regs->atom_alarm = Yap_LookupAtom("$alarm"); + heap_regs->atom_alarm = Yap_FullLookupAtom("$alarm"); #if HAVE_SIGACTION - heap_regs->atom_sig_pending = Yap_LookupAtom("$sig_pending"); + heap_regs->atom_sig_pending = Yap_FullLookupAtom("$sig_pending"); #endif AtomBraces = Yap_LookupAtom("{}"); - heap_regs->atom_b = Yap_LookupAtom("$last_choice_pt"); - heap_regs->atom_break = Yap_LookupAtom("$break"); + heap_regs->atom_b = Yap_FullLookupAtom("$last_choice_pt"); + heap_regs->atom_break = Yap_FullLookupAtom("$break"); heap_regs->atom_call = Yap_LookupAtom("call"); - heap_regs->atom_catch = Yap_LookupAtom("$catch"); + heap_regs->atom_catch = Yap_FullLookupAtom("$catch"); heap_regs->atom_comma = Yap_LookupAtom(","); heap_regs->atom_cpu_time = Yap_LookupAtom("cputime"); - heap_regs->atom_csult = Yap_LookupAtom("$csult"); + heap_regs->atom_csult = Yap_FullLookupAtom("$csult"); heap_regs->atom_cut = Yap_LookupAtom("!"); - heap_regs->atom_cut_by = Yap_LookupAtom("$cut_by"); + heap_regs->atom_cut_by = Yap_FullLookupAtom("$cut_by"); #ifdef EUROTRA #ifdef SFUNC - heap_regs->atom_dollar_undef = MkAtomTerm(Yap_LookupAtom("$undef")); + heap_regs->atom_dollar_undef = MkAtomTerm(Yap_FullLookupAtom("$undef")); #endif #endif heap_regs->atom_e = Yap_LookupAtom("e"); @@ -878,45 +878,45 @@ InitCodes(void) #endif heap_regs->atom_fail = Yap_LookupAtom("fail"); heap_regs->atom_false = Yap_LookupAtom("false"); - heap_regs->atom_fast = Yap_LookupAtom("$fast"); + heap_regs->atom_fast = Yap_FullLookupAtom("$fast"); heap_regs->atom_g_t = Yap_LookupAtom(">"); - heap_regs->atom_gc = Yap_LookupAtom("$gc"); - heap_regs->atom_gc_margin = Yap_LookupAtom("$gc_margin"); - heap_regs->atom_gc_trace = Yap_LookupAtom("$gc_trace"); - heap_regs->atom_gc_verbose = Yap_LookupAtom("$gc_verbose"); - heap_regs->atom_gc_very_verbose = Yap_LookupAtom("$gc_very_verbose"); + heap_regs->atom_gc = Yap_FullLookupAtom("$gc"); + heap_regs->atom_gc_margin = Yap_FullLookupAtom("$gc_margin"); + heap_regs->atom_gc_trace = Yap_FullLookupAtom("$gc_trace"); + heap_regs->atom_gc_verbose = Yap_FullLookupAtom("$gc_verbose"); + heap_regs->atom_gc_very_verbose = Yap_FullLookupAtom("$gc_very_verbose"); AtomGVar = Yap_LookupAtom("var"); heap_regs->atom_global = Yap_LookupAtom("global_sp"); heap_regs->atom_heap_used = Yap_LookupAtom("heapused"); heap_regs->atom_inf = Yap_LookupAtom("inf"); heap_regs->atom_l_t = Yap_LookupAtom("<"); heap_regs->atom_local = Yap_LookupAtom("local_sp"); - heap_regs->atom_meta_call = Yap_LookupAtom("$call"); + heap_regs->atom_meta_call = Yap_FullLookupAtom("$call"); heap_regs->atom_minus = Yap_LookupAtom("-"); heap_regs->atom_nan = Yap_LookupAtom("nan"); AtomNot = Yap_LookupAtom("\\+"); heap_regs->atom_otherwise = Yap_LookupAtom("otherwise"); heap_regs->atom_pi = Yap_LookupAtom("pi"); heap_regs->atom_plus = Yap_LookupAtom("+"); - heap_regs->atom_portray = Yap_LookupAtom("$portray"); - heap_regs->atom_profile = Yap_LookupAtom("$profile"); + heap_regs->atom_portray = Yap_FullLookupAtom("$portray"); + heap_regs->atom_profile = Yap_FullLookupAtom("$profile"); AtomQuery = Yap_LookupAtom("?-"); heap_regs->atom_random = Yap_LookupAtom("random"); heap_regs->atom_read = Yap_LookupAtom("read"); heap_regs->atom_repeat = Yap_LookupAtom("repeat"); - heap_regs->atom_restore_regs = Yap_LookupAtom("$restore_regs"); + heap_regs->atom_restore_regs = Yap_FullLookupAtom("$restore_regs"); AtomSemic = Yap_LookupAtom(";"); heap_regs->atom_stack_free = Yap_LookupAtom("stackfree"); - AtomStream = Yap_LookupAtom ("$stream"); - AtomStreamPos = Yap_LookupAtom ("$stream_position"); + AtomStream = Yap_FullLookupAtom("$stream"); + AtomStreamPos = Yap_FullLookupAtom("$stream_position"); heap_regs->atom_true = Yap_LookupAtom("true"); AtomCreep = Yap_LookupAtom("$creep"); heap_regs->atom_user = Yap_LookupAtom ("user"); heap_regs->atom_usr_err = Yap_LookupAtom ("user_error"); heap_regs->atom_usr_in = Yap_LookupAtom ("user_input"); heap_regs->atom_usr_out = Yap_LookupAtom ("user_output"); - AtomVar = Yap_LookupAtom("$VAR"); - heap_regs->atom_version_number = Yap_LookupAtom("$version_name"); + AtomVar = Yap_FullLookupAtom("$VAR"); + heap_regs->atom_version_number = Yap_FullLookupAtom("$version_name"); heap_regs->atom_write = Yap_LookupAtom ("write"); #ifdef USE_SOCKET heap_regs->functor_af_inet = Yap_MkFunctor(Yap_LookupAtom("AF_INET"),2); @@ -930,17 +930,17 @@ InitCodes(void) heap_regs->functor_arrow = Yap_MkFunctor(AtomArrow, 2); heap_regs->functor_assert = Yap_MkFunctor(AtomAssert, 2); #ifdef COROUTINING - heap_regs->functor_att_goal = Yap_MkFunctor(Yap_LookupAtom("$att_do"),2); + heap_regs->functor_att_goal = Yap_MkFunctor(Yap_FullLookupAtom("$att_do"),2); #endif heap_regs->functor_braces = Yap_MkFunctor(AtomBraces, 1); heap_regs->functor_call = Yap_MkFunctor(AtomCall, 1); heap_regs->functor_cut_by = Yap_MkFunctor(AtomCutBy, 1); - heap_regs->functor_clist = Yap_MkFunctor(Yap_LookupAtom("$when"), 4); + heap_regs->functor_clist = Yap_MkFunctor(Yap_FullLookupAtom("$when"), 4); heap_regs->functor_comma = Yap_MkFunctor(AtomComma, 2); heap_regs->functor_csult = Yap_MkFunctor(AtomCsult, 1); heap_regs->functor_eq = Yap_MkFunctor(AtomEq, 2); - heap_regs->functor_execute_in_mod = Yap_MkFunctor(Yap_LookupAtom("$execute_in_mod"), 2); - heap_regs->functor_execute_within = Yap_MkFunctor(Yap_LookupAtom("$execute_within"), 1); + heap_regs->functor_execute_in_mod = Yap_MkFunctor(Yap_FullLookupAtom("$execute_in_mod"), 2); + heap_regs->functor_execute_within = Yap_MkFunctor(Yap_FullLookupAtom("$execute_within"), 1); heap_regs->functor_g_atom = Yap_MkFunctor(Yap_LookupAtom("atom"), 1); heap_regs->functor_g_atomic = Yap_MkFunctor(Yap_LookupAtom("atomic"), 1); heap_regs->functor_g_compound = Yap_MkFunctor(Yap_LookupAtom("compound"), 1); @@ -949,11 +949,11 @@ InitCodes(void) heap_regs->functor_g_number = Yap_MkFunctor(Yap_LookupAtom("number"), 1); heap_regs->functor_g_primitive = Yap_MkFunctor(Yap_LookupAtom("primitive"), 1); heap_regs->functor_g_var = Yap_MkFunctor(AtomGVar, 1); - heap_regs->functor_last_execute_within = Yap_MkFunctor(Yap_LookupAtom("$last_execute_within"), 1); + heap_regs->functor_last_execute_within = Yap_MkFunctor(Yap_FullLookupAtom("$last_execute_within"), 1); heap_regs->functor_list = Yap_MkFunctor(Yap_LookupAtom("."), 2); heap_regs->functor_module = Yap_MkFunctor(Yap_LookupAtom(":"), 2); #ifdef MULTI_ASSIGNMENT_VARIABLES - heap_regs->functor_mutable = Yap_MkFunctor(Yap_LookupAtom("$mutable_variable"), + heap_regs->functor_mutable = Yap_MkFunctor(Yap_FullLookupAtom("$mutable_variable"), sizeof(timed_var)/sizeof(CELL)); #endif heap_regs->functor_not = Yap_MkFunctor(AtomNot, 1); @@ -964,19 +964,19 @@ InitCodes(void) heap_regs->functor_stream = Yap_MkFunctor (AtomStream, 1); heap_regs->functor_stream_pos = Yap_MkFunctor (AtomStreamPos, 3); heap_regs->functor_stream_eOS = Yap_MkFunctor (Yap_LookupAtom("end_of_stream"), 1); - heap_regs->functor_thread_run = Yap_MkFunctor (Yap_LookupAtom("$top_thread_goal"), 1); - heap_regs->functor_change_module = Yap_MkFunctor (Yap_LookupAtom("$change_module"), 1); - heap_regs->functor_current_module = Yap_MkFunctor (Yap_LookupAtom("$current_module"), 1); - FunctorThrow = Yap_MkFunctor( Yap_LookupAtom("throw"), 1); + heap_regs->functor_thread_run = Yap_MkFunctor (Yap_FullLookupAtom("$top_thread_goal"), 1); + heap_regs->functor_change_module = Yap_MkFunctor (Yap_FullLookupAtom("$change_module"), 1); + heap_regs->functor_current_module = Yap_MkFunctor (Yap_FullLookupAtom("$current_module"), 1); + FunctorThrow = Yap_MkFunctor( Yap_FullLookupAtom("throw"), 1); heap_regs->functor_u_minus = Yap_MkFunctor (heap_regs->atom_minus, 1); heap_regs->functor_u_plus = Yap_MkFunctor (heap_regs->atom_plus, 1); heap_regs->functor_v_bar = Yap_MkFunctor(Yap_LookupAtom("|"), 2); heap_regs->functor_var = Yap_MkFunctor(AtomVar, 1); #ifdef EUROTRA - heap_regs->term_dollar_u = MkAtomTerm(Yap_LookupAtom("$u")); + heap_regs->term_dollar_u = MkAtomTerm(Yap_FullLookupAtom("$u")); #endif heap_regs->term_prolog = MkAtomTerm(Yap_LookupAtom("prolog")); - heap_regs->term_refound_var = MkAtomTerm(Yap_LookupAtom("$I_FOUND_THE_VARIABLE_AGAIN")); + heap_regs->term_refound_var = MkAtomTerm(Yap_FullLookupAtom("$I_FOUND_THE_VARIABLE_AGAIN")); heap_regs->dyn_array_list = NULL; heap_regs->n_of_file_aliases = 0; heap_regs->file_aliases = NULL; @@ -1009,13 +1009,13 @@ InitCodes(void) heap_regs->env_for_yes_code.p0 = RepPredProp(PredPropByAtom(heap_regs->atom_true,0)); heap_regs->pred_meta_call = RepPredProp(PredPropByFunc(Yap_MkFunctor(heap_regs->atom_meta_call,4),0)); - heap_regs->pred_dollar_catch = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("$catch"),3),0)); - heap_regs->pred_recorded_with_key = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("$recorded_with_key"),3),0)); - heap_regs->pred_log_upd_clause = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("$do_log_upd_clause"),5),0)); - heap_regs->pred_log_upd_clause0 = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("$do_log_upd_clause"),4),0)); - heap_regs->pred_static_clause = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("$do_static_clause"),5),0)); + heap_regs->pred_dollar_catch = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_FullLookupAtom("$catch"),3),0)); + heap_regs->pred_recorded_with_key = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_FullLookupAtom("$recorded_with_key"),3),0)); + heap_regs->pred_log_upd_clause = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_FullLookupAtom("$do_log_upd_clause"),5),0)); + heap_regs->pred_log_upd_clause0 = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_FullLookupAtom("$do_log_upd_clause"),4),0)); + heap_regs->pred_static_clause = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_FullLookupAtom("$do_static_clause"),5),0)); heap_regs->pred_throw = RepPredProp(PredPropByFunc(FunctorThrow,0)); - heap_regs->pred_handle_throw = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("$handle_throw"),3),0)); + heap_regs->pred_handle_throw = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_FullLookupAtom("$handle_throw"),3),0)); heap_regs->pred_goal_expansion = RepPredProp(PredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("goal_expansion"),3),1)); heap_regs->env_for_trustfail_code.p = heap_regs->env_for_trustfail_code.p0 = @@ -1026,8 +1026,8 @@ InitCodes(void) modp->PredFlags |= MetaPredFlag; } #ifdef YAPOR - heap_regs->getworkcode.u.ld.p = RepPredProp(PredPropByAtom(Yap_LookupAtom("$getwork"), 0)); - heap_regs->getworkcode_seq.u.ld.p = RepPredProp(PredPropByAtom(Yap_LookupAtom("$getwork_seq"), 0)); + heap_regs->getworkcode.u.ld.p = RepPredProp(PredPropByAtom(Yap_FullLookupAtom("$getwork"), 0)); + heap_regs->getworkcode_seq.u.ld.p = RepPredProp(PredPropByAtom(Yap_FullLookupAtom("$getwork_seq"), 0)); #endif heap_regs->db_erased_marker = (DBRef)Yap_AllocCodeSpace(sizeof(DBStruct)); @@ -1044,7 +1044,7 @@ InitCodes(void) static void InitVersion(void) { - Yap_PutValue(Yap_LookupAtom("$version_name"), + Yap_PutValue(Yap_FullLookupAtom("$version_name"), MkAtomTerm(Yap_LookupAtom(YAP_VERSION))); } diff --git a/C/modules.c b/C/modules.c index 5f447ee6b..d71953545 100644 --- a/C/modules.c +++ b/C/modules.c @@ -133,6 +133,18 @@ init_current_module(void) return (cont_current_module()); } +void +Yap_InitModulesC(void) +{ + Yap_InitCPred("$current_module", 2, p_current_module, SafePredFlag|SyncPredFlag); + Yap_InitCPred("$current_module", 1, p_current_module1, SafePredFlag|SyncPredFlag); + Yap_InitCPred("$change_module", 1, p_change_module, SafePredFlag|SyncPredFlag); + Yap_InitCPred("$module_number", 2, p_module_number, SafePredFlag); + Yap_InitCPredBack("$all_current_modules", 1, 1, init_current_module, cont_current_module, + SafePredFlag|SyncPredFlag); +} + + void Yap_InitModules(void) { @@ -144,10 +156,4 @@ Yap_InitModules(void) MkAtomTerm(Yap_LookupAtom("idb")); NoOfModules = 3; CurrentModule = 0; - Yap_InitCPred("$current_module", 2, p_current_module, SafePredFlag|SyncPredFlag); - Yap_InitCPred("$current_module", 1, p_current_module1, SafePredFlag|SyncPredFlag); - Yap_InitCPred("$change_module", 1, p_change_module, SafePredFlag|SyncPredFlag); - Yap_InitCPred("$module_number", 2, p_module_number, SafePredFlag); - Yap_InitCPredBack("$all_current_modules", 1, 1, init_current_module, cont_current_module, - SafePredFlag|SyncPredFlag); } diff --git a/C/save.c b/C/save.c index 3b02c56c9..a3589aae5 100644 --- a/C/save.c +++ b/C/save.c @@ -102,12 +102,10 @@ STATIC_PROTO(void get_insts, (OPCODE [])); STATIC_PROTO(void get_hash, (void)); STATIC_PROTO(void CopyCode, (void)); STATIC_PROTO(void CopyStacks, (void)); -STATIC_PROTO(int get_coded, (int, OPCODE [])); +STATIC_PROTO(void get_coded, (int, OPCODE [])); STATIC_PROTO(void restore_codes, (void)); -STATIC_PROTO(void ConvDBList, (Term, char *,CELL)); -STATIC_PROTO(Term AdjustDBTerm, (Term)); +STATIC_PROTO(Term AdjustDBTerm, (Term, Term *)); STATIC_PROTO(void RestoreDB, (DBEntry *)); -STATIC_PROTO(void RestoreClause, (yamop *, PredEntry *, int)); STATIC_PROTO(void CleanClauses, (yamop *, yamop *,PredEntry *)); STATIC_PROTO(void rehash, (CELL *, int, int)); STATIC_PROTO(void CleanCode, (PredEntry *)); @@ -122,11 +120,10 @@ STATIC_PROTO(void ShowEntries, (PropEntry *)); STATIC_PROTO(int OpenRestore, (char *, char *, CELL *, CELL *, CELL *, CELL *)); STATIC_PROTO(void CloseRestore, (void)); STATIC_PROTO(int check_opcodes, (OPCODE [])); -STATIC_PROTO(void RestoreHeap, (OPCODE [], int)); +STATIC_PROTO(void RestoreHeap, (OPCODE [])); STATIC_PROTO(Int p_restore, (void)); STATIC_PROTO(void restore_heap_regs, (void)); STATIC_PROTO(void restore_regs, (int)); -STATIC_PROTO(void ConvDBStruct, (Term, char *, CELL)); #ifdef MACYAP STATIC_PROTO(void NewFileInfo, (long, long)); extern int DefVol; @@ -828,11 +825,10 @@ CopyTrailEntries(void) } /* get things which are saved in the file */ -static int +static void get_coded(int flag, OPCODE old_ops[]) { char my_end_msg[256]; - int funcs_moved = FALSE; get_regs(flag); get_insts(old_ops); @@ -850,7 +846,6 @@ get_coded(int flag, OPCODE old_ops[]) myread(splfild, my_end_msg, 256); if (strcmp(end_msg,my_end_msg) != 0) Yap_Error(FATAL_ERROR,TermNil,"corrupt saved state (bad trailing CRC)"); - return(funcs_moved); } /* restore some heap registers */ @@ -1305,13 +1300,13 @@ check_opcodes(OPCODE old_ops[]) } static void -RestoreHeap(OPCODE old_ops[], int functions_moved) +RestoreHeap(OPCODE old_ops[]) { int heap_moved = (OldHeapBase != Yap_HeapBase), opcodes_moved; opcodes_moved = check_opcodes(old_ops); /* opcodes_moved has side-effects and should be tried first */ - if (heap_moved || opcodes_moved || functions_moved) { + if (heap_moved || opcodes_moved) { restore_heap(); } /* This must be done after restore_heap */ @@ -1319,8 +1314,15 @@ RestoreHeap(OPCODE old_ops[], int functions_moved) RestoreFreeSpace(); } Yap_InitAbsmi(); - if (!(Yap_ReInitConstExps() && Yap_ReInitUnaryExps() && Yap_ReInitBinaryExps())) + if (opcodes_moved) { + Yap_InitCPreds(); + Yap_InitBackCPreds(); + } + if (!(Yap_ReInitConstExps() && + Yap_ReInitUnaryExps() && + Yap_ReInitBinaryExps())) { Yap_Error(SYSTEM_ERROR, TermNil, "arithmetic operator not in saved state"); + } #ifdef DEBUG_RESTORE1 fprintf(errout, "phase 1 done\n"); #endif @@ -1399,7 +1401,6 @@ static int Restore(char *s, char *lib_dir) { int restore_mode; - int funcs_moved; OPCODE old_ops[_std_top+1]; @@ -1408,11 +1409,11 @@ Restore(char *s, char *lib_dir) return(FALSE); Yap_ShutdownLoadForeign(); in_limbo = TRUE; - funcs_moved = get_coded(restore_mode, old_ops); + get_coded(restore_mode, old_ops); restore_regs(restore_mode); in_limbo = FALSE; /*#endif*/ - RestoreHeap(old_ops, funcs_moved); + RestoreHeap(old_ops); switch(restore_mode) { case DO_EVERYTHING: if (OldHeapBase != Yap_HeapBase || diff --git a/C/stdpreds.c b/C/stdpreds.c index 0e6a53398..96de57c53 100644 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -2689,6 +2689,7 @@ Yap_InitCPreds(void) Yap_InitCoroutPreds(); Yap_InitArrayPreds(); Yap_InitLoadForeign(); + Yap_InitModulesC(); Yap_InitUserCPreds(); Yap_InitUtilCPreds(); diff --git a/C/tracer.c b/C/tracer.c index d48856532..62080473c 100644 --- a/C/tracer.c +++ b/C/tracer.c @@ -115,9 +115,6 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) /* extern int gc_calls; */ vsc_count++; - if (vsc_count == 71808) vsc_xstop = 1; - if (vsc_count < 71000) - return; #ifdef COMMENTED if (port != enter_pred || !pred || diff --git a/H/Yapproto.h b/H/Yapproto.h index b5de04e74..cd7ceb38b 100644 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -10,7 +10,7 @@ * File: Yap.proto * * mods: * * comments: Function declarations for YAP * -* version: $Id: Yapproto.h,v 1.43 2004-02-05 16:57:01 vsc Exp $ * +* version: $Id: Yapproto.h,v 1.44 2004-02-06 02:26:23 vsc Exp $ * *************************************************************************/ /* prototype file for Yap */ @@ -214,6 +214,7 @@ Term STD_PROTO(Yap_UpdateTimedVar,(Term, Term)); SMALLUNSGN STD_PROTO(Yap_LookupModule,(Term)); Term STD_PROTO(Yap_Module_Name, (CODEADDR)); void STD_PROTO(Yap_InitModules, (void)); +void STD_PROTO(Yap_InitModulesC, (void)); #if HAVE_MPI /* mpi.c */ diff --git a/H/rheap.h b/H/rheap.h index 7e1e685ae..c1df5f86e 100644 --- a/H/rheap.h +++ b/H/rheap.h @@ -346,107 +346,45 @@ restore_codes(void) /* Restoring the heap */ -/* Converts a structure of the DB, as it was saved in the heap */ -/* uses a variable base */ -static void -ConvDBStruct(Term Struct, char *tbase, CELL size) -{ - CELL *TermP; - Functor f; - int Arity, i; - - TermP = (CELL *)(tbase + (CELL)RepAppl(Struct)); - f = (Functor)(*TermP); - if (IsExtensionFunctor(f)) { - return; - } - f = FuncAdjust(f); - *(Functor *)TermP = f; - Arity = ArityOfFunctor(f); - TermP++; - for (i = 0; i < Arity; i++) { - register Term t = *TermP; - if (IsVarTerm(t)) { - /* do nothing */ - } else if (IsAtomTerm(t)) { - /* these are the only ones that may actually need to be changed */ - *TermP = AtomTermAdjust(t); - } else if (IsApplTerm(t)) { - CELL offset = (CELL)RepAppl(t); - if (offset > size) { - *TermP = AbsAppl(CellPtoHeapAdjust(RepAppl(t))); - } else { - ConvDBStruct(t, tbase, size); - } - } else if (IsPairTerm(t)) { - ConvDBList(t, tbase, size); - } - TermP++; - } -} - -/* Converts a list of the DB, as it was saved in the heap */ -/* uses a variable base */ -static void -ConvDBList(Term List, char *tbase, CELL size) -{ - CELL *TermP; - int i; - TermP = (CELL *)(tbase + (CELL) RepPair(List)); - for (i = 0; i < 2; i++) { - register Term t = *TermP; - if (IsVarTerm(t)) { - /* do nothing */ - } else if (IsAtomTerm(t)) - *TermP = AtomTermAdjust(t); - else if (IsPairTerm(t)) - ConvDBList(t, tbase, size); - else if (IsApplTerm(t)) { - CELL offset = (CELL)RepAppl(t); - if (offset > size) { - *TermP = AbsAppl(CellPtoHeapAdjust(RepAppl(t))); - } else { - ConvDBStruct(t, tbase, size); - } - } - TermP++; - } -} - /* adjusts terms stored in the data base, when they have no variables */ static Term -AdjustDBTerm(Term trm) +AdjustDBTerm(Term trm, Term *p_base) { - Term *p; - if (IsAtomTerm(trm)) - return (AtomTermAdjust(trm)); + return AtomTermAdjust(trm); if (IsPairTerm(trm)) { + Term *p; + p = PtoHeapCellAdjust(RepPair(trm)); - *p = AdjustDBTerm(*p); - ++p; - *p = AdjustDBTerm(*p); - return (AbsPair(p-1)); + if (p > p_base) { + p[0] = AdjustDBTerm(p[0], p); + p[1] = AdjustDBTerm(p[1], p); + } + return AbsPair(p); } if (IsApplTerm(trm)) { + Term *p; Functor f; Term *p0 = p = PtoHeapCellAdjust(RepAppl(trm)); - f = (Functor)*p; - if (!IsExtensionFunctor(f)) { - int Arity, i; + /* if it is before the current position, then we are looking + at old code */ + if (p > p_base) { + f = (Functor)p[0]; + if (!IsExtensionFunctor(f)) { + UInt Arity, i; - f = FuncAdjust(f); - *p = (Term)f; - Arity = ArityOfFunctor(f); - p++; - for (i = 0; i < Arity; ++i) { - *p = AdjustDBTerm(*p); - p++; + f = FuncAdjust(f); + *p++ = (Term)f; + Arity = ArityOfFunctor(f); + for (i = 0; i < Arity; ++i) { + *p = AdjustDBTerm(*p, p0); + p++; + } } } - return (AbsAppl(p0)); + return AbsAppl(p0); } - return (trm); + return trm; } static void @@ -454,70 +392,46 @@ RestoreDBTerm(DBTerm *dbr) { #ifdef COROUTINING if (dbr->attachments) - dbr->attachments = AdjustDBTerm(dbr->attachments); + dbr->attachments = AdjustDBTerm(dbr->attachments, dbr->Contents); #endif - if (dbr->DBRefs != NULL) + if (dbr->DBRefs != NULL) { + DBRef *cp; + DBRef tm; + dbr->DBRefs = DBRefPAdjust(dbr->DBRefs); - if (IsAtomTerm(dbr->Entry)) { - dbr->Entry = AtomTermAdjust(dbr->Entry); - return; - } - if (IsApplTerm(dbr->Entry)) { - ConvDBStruct(dbr->Entry, CharP(dbr->Contents-1), dbr->NOfCells*sizeof(CELL)); - } else if (IsPairTerm(dbr->Entry)) { - ConvDBList(dbr->Entry, CharP(dbr->Contents-1), dbr->NOfCells*sizeof(CELL)); + cp = dbr->DBRefs; + while ((tm = *--cp) != 0) + *cp = DBRefAdjust(tm); } + dbr->Entry = AdjustDBTerm(dbr->Entry, dbr->Contents); } static void RestoreDBEntry(DBRef dbr) { #ifdef DEBUG_RESTORE - YP_fprintf(errout, "Restoring at %x", dbr); + fprintf(stderr, "Restoring at %x", dbr); if (dbr->Flags & DBAtomic) - YP_fprintf(errout, " an atomic term\n"); + fprintf(stderr, " an atomic term\n"); else if (dbr->Flags & DBNoVars) - YP_fprintf(errout, " with no vars\n"); + fprintf(stderr, " with no vars\n"); else if (dbr->Flags & DBComplex) - YP_fprintf(errout, " complex term\n"); + fprintf(stderr, " complex term\n"); else if (dbr->Flags & DBIsRef) - YP_fprintf(errout, " a ref\n"); + fprintf(stderr, " a ref\n"); else - YP_fprintf(errout, " a var\n"); + fprintf(stderr, " a var\n"); #endif + RestoreDBTerm(&(dbr->DBT)); dbr->Parent = (DBProp)AddrAdjust((ADDR)(dbr->Parent)); -#ifdef COROUTINING - if (dbr->DBT.attachments) - dbr->DBT.attachments = AdjustDBTerm(dbr->DBT.attachments); -#endif if (dbr->Code != NULL) dbr->Code = PtoOpAdjust(dbr->Code); - if (dbr->Flags & DBWithRefs) { - DBRef *cp; - DBRef tm; - - dbr->DBT.DBRefs = DBRefPAdjust(dbr->DBT.DBRefs); - cp = dbr->DBT.DBRefs; - while ((tm = *--cp) != 0) - *cp = DBRefAdjust(tm); - } - if (dbr->Flags & DBAtomic) { - if (IsAtomTerm(dbr->DBT.Entry)) - dbr->DBT.Entry = AtomTermAdjust(dbr->DBT.Entry); - } else if (dbr->Flags & DBNoVars) - dbr->DBT.Entry = (CELL) AdjustDBTerm((Term) dbr->DBT.Entry); - else if (dbr->Flags & DBComplex) { - if (IsApplTerm(dbr->DBT.Entry)) - ConvDBStruct(dbr->DBT.Entry, CharP(dbr->DBT.Contents-1), dbr->DBT.NOfCells*sizeof(CELL)); - else - ConvDBList(dbr->DBT.Entry, CharP(dbr->DBT.Contents-1), dbr->DBT.NOfCells*sizeof(CELL)); - } if (dbr->Prev != NULL) dbr->Prev = DBRefAdjust(dbr->Prev); if (dbr->Next != NULL) dbr->Next = DBRefAdjust(dbr->Next); #ifdef DEBUG_RESTORE2 - YP_fprintf(errout, "Recomputing masks\n"); + fprintf(stderr, "Recomputing masks\n"); #endif recompute_mask(dbr); } @@ -567,48 +481,26 @@ static void RestoreBB(BlackBoardEntry *pp) { if (pp->Element) { - register DBTerm *dbr; - - pp->Element = (DBTerm *)AdjustDBTerm((Term)pp->Element); - dbr = pp->Element; - RestoreDBTerm(dbr); + pp->Element = DBTermAdjust(pp->Element); + RestoreDBTerm(pp->Element); } pp->KeyOfBB = AtomAdjust(pp->KeyOfBB); } -/* Restores a prolog clause, in its compiled form */ static void -RestoreClause(yamop *pc, PredEntry *pp, int mode) -/* - * Cl points to the start of the code, IsolFlag tells if we have a single - * clause for this predicate or not - */ +restore_opcodes(yamop *pc) { - if (mode == ASSEMBLING_CLAUSE) { - if (pp->PredFlags & DynamicPredFlag) { - DynamicClause *cl = ClauseCodeToDynamicClause(pc); - if (cl->ClPrevious != NULL) { - cl->ClPrevious = PtoOpAdjust(cl->ClPrevious); - } - } else if (pp->PredFlags & LogUpdatePredFlag) { - LogUpdClause *cl = ClauseCodeToLogUpdClause(pc); - - if (cl->ClFlags & LogUpdRuleMask) { - cl->ClExt = PtoOpAdjust(cl->ClExt); - } - } - } do { op_numbers op = Yap_op_from_opcode(pc->opc); pc->opc = Yap_opcode(op); #ifdef DEBUG_RESTORE2 - YP_fprintf(errout, "%s\n", op_names[op]); + fprintf(stderr, "%s ", op_names[op]); #endif switch (op) { case _Ystop: case _Nstop: #ifdef DEBUG_RESTORE2 - YP_fprintf(errout, "left OK\n"); + fprintf(stderr, "OK\n"); #endif return; /* instructions type ld */ @@ -705,6 +597,8 @@ RestoreClause(yamop *pc, PredEntry *pp, int mode) /* instructions type e */ case _unify_idb_term: case _copy_idb_term: + /* don't need no _Ystop to know we're done */ + return; case _trust_fail: case _op_fail: case _cut: @@ -1129,7 +1023,7 @@ RestoreClause(yamop *pc, PredEntry *pp, int mode) oldcode += 2; } rehash(startcode, i, Funcs); - pc = (yamop *)oldcode; + pc = NEXTOP(pc,sl); } break; /* switch_on_cons */ @@ -1158,7 +1052,7 @@ RestoreClause(yamop *pc, PredEntry *pp, int mode) #if !USE_OFFSETS rehash(startcode, i, Atomics); #endif - pc = (yamop *)oldcode; + pc = NEXTOP(pc,sl); } break; case _go_on_func: @@ -1357,6 +1251,66 @@ RestoreClause(yamop *pc, PredEntry *pp, int mode) } while (TRUE); } +/* Restores a prolog clause, in its compiled form */ +static void +RestoreStaticClause(StaticClause *cl, PredEntry *pp) +/* + * Cl points to the start of the code, IsolFlag tells if we have a single + * clause for this predicate or not + */ +{ + if (cl->ClFlags & FactMask) { + cl->usc.ClPred = PtoPredAdjust(cl->usc.ClPred); + } else { + cl->usc.ClSource = DBTermAdjust(cl->usc.ClSource); + } + if (cl->ClNext) { + cl->ClNext = PtoStCAdjust(cl->ClNext); + } + restore_opcodes(cl->ClCode); +} + +/* Restores a prolog clause, in its compiled form */ +static void +RestoreDynamicClause(DynamicClause *cl, PredEntry *pp) +/* + * Cl points to the start of the code, IsolFlag tells if we have a single + * clause for this predicate or not + */ +{ + if (cl->ClPrevious != NULL) { + cl->ClPrevious = PtoOpAdjust(cl->ClPrevious); + } + INIT_LOCK(cl->ClLock); + restore_opcodes(cl->ClCode); +} + +/* Restores a prolog clause, in its compiled form */ +static void +RestoreLUClause(LogUpdClause *cl, PredEntry *pp) +/* + * Cl points to the start of the code, IsolFlag tells if we have a single + * clause for this predicate or not + */ +{ + INIT_LOCK(cl->ClLock); + if (cl->ClFlags & LogUpdRuleMask) { + cl->ClExt = PtoOpAdjust(cl->ClExt); + } + if (cl->ClSource) { + cl->ClSource = DBTermAdjust(cl->ClSource); + RestoreDBTerm(cl->ClSource); + } + if (cl->ClPrev) { + cl->ClPrev = PtoLUCAdjust(cl->ClPrev); + } + if (cl->ClNext) { + cl->ClNext = PtoLUCAdjust(cl->ClNext); + } + cl->ClPred = PtoPredAdjust(cl->ClPred); + restore_opcodes(cl->ClCode); +} + /* * Restores a group of clauses for the same predicate, starting with First * and ending with Last, First may be equal to Last @@ -1368,29 +1322,69 @@ CleanClauses(yamop *First, yamop *Last, PredEntry *pp) LogUpdClause *cl = ClauseCodeToLogUpdClause(First); while (cl != NULL) { - RestoreClause(cl->ClCode, pp, ASSEMBLING_CLAUSE); + RestoreLUClause(cl, pp); cl = cl->ClNext; } } else if (pp->PredFlags & DynamicPredFlag) { yamop *cl = First; do { - RestoreClause(cl, pp, ASSEMBLING_CLAUSE); + RestoreDynamicClause(ClauseCodeToDynamicClause(cl), pp); if (cl == Last) return; cl = NextDynamicClause(cl); } while (TRUE); } else { - yamop *cl = First; + StaticClause *cl = ClauseCodeToStaticClause(First); do { - RestoreClause(cl, pp, ASSEMBLING_CLAUSE); - if (cl == Last) return; - cl = ClauseCodeToStaticClause(cl)->ClNext->ClCode; + RestoreStaticClause(cl, pp); + if (cl->ClCode == Last) return; + cl = cl->ClNext; } while (TRUE); } } +static void +CleanLUIndex(LogUpdIndex *idx) +{ + idx->ClRefCount = 0; + INIT_LOCK(idx->ClLock); + if (idx->ClFlags & SwitchRootMask) { + idx->u.pred = PtoPredAdjust(idx->u.pred); + } else { + idx->u.ParentIndex = LUIndexAdjust(idx->u.ParentIndex); + } + if (idx->SiblingIndex) { + idx->SiblingIndex = LUIndexAdjust(idx->SiblingIndex); + CleanLUIndex(idx->SiblingIndex); + } + if (idx->ChildIndex) { + idx->ChildIndex = LUIndexAdjust(idx->ChildIndex); + CleanLUIndex(idx->ChildIndex); + } + if (!(idx->ClFlags & SwitchTableMask)) { + restore_opcodes(idx->ClCode); + } +} + +static void +CleanSIndex(StaticIndex *idx) +{ + if (idx->SiblingIndex) { + idx->SiblingIndex = SIndexAdjust(idx->SiblingIndex); + CleanSIndex(idx->SiblingIndex); + } + if (idx->ChildIndex) { + idx->ChildIndex = SIndexAdjust(idx->ChildIndex); + CleanSIndex(idx->ChildIndex); + } + if (!(idx->ClFlags & SwitchTableMask)) { + restore_opcodes(idx->ClCode); + } +} + + static void restore_static_array(StaticArrayEntry *ae) { @@ -1476,7 +1470,7 @@ restore_static_array(StaticArrayEntry *ae) if (reg == NULL) { base++; } else { - *base++ = reg = (DBTerm *)AdjustDBTerm((Term)reg); + *base++ = reg = DBTermAdjust(reg); RestoreDBTerm(reg); } } @@ -1532,14 +1526,23 @@ CleanCode(PredEntry *pp) return; } #ifdef DEBUG_RESTORE2 - YP_fprintf(errout, "at %lx Correcting clauses from %lx to %lx\n", *(OPCODE *) FirstC, FirstC, LastC); + fprintf(stderr, "at %ux Correcting clauses from %p to %p\n", *(OPCODE *) FirstC, FirstC, LastC); #endif CleanClauses(FirstC, LastC, pp); - if (flag & (DynamicPredFlag|IndexedPredFlag)) { + if (flag & IndexedPredFlag) { #ifdef DEBUG_RESTORE2 - YP_fprintf(errout, "Correcting dynamic/indexed code\n"); + fprintf(stderr, "Correcting indexed code\n"); #endif - RestoreClause(pp->cs.p_code.TrueCodeOfPred,pp, ASSEMBLING_INDEX); + if (flag & LogUpdatePredFlag) { + CleanLUIndex(ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred)); + } else { + CleanSIndex(ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred)); + } + } else if (flag & DynamicPredFlag) { +#ifdef DEBUG_RESTORE2 + fprintf(stderr, "Correcting dynamic code\n"); +#endif + RestoreDynamicClause(ClauseCodeToDynamicClause(pp->cs.p_code.TrueCodeOfPred),pp); } } /* we are pointing at ourselves */ @@ -1627,7 +1630,7 @@ RestoreEntries(PropEntry *pp) case CodeLogUpdDBProperty: case CodeDBProperty: #ifdef DEBUG_RESTORE2 - YP_fprintf(errout, "Correcting data base clause at %p\n", pp); + fprintf(stderr, "Correcting data base clause at %p\n", pp); #endif { DBEntry *de = (DBEntry *) pp; diff --git a/m4/sshift.h.m4 b/m4/sshift.h.m4 index 2ee994fb4..a68f16119 100644 --- a/m4/sshift.h.m4 +++ b/m4/sshift.h.m4 @@ -77,6 +77,9 @@ Inline(AtomEntryAdjust, AtomEntry *, AtomEntry *, at, (AtomEntry *)(CharP(at)+HD Inline(ConsultObjAdjust, union CONSULT_OBJ *, union CONSULT_OBJ *, co, (union CONSULT_OBJ *)(CharP(co)+HDiff) ) Inline(DBRefAdjust, DBRef, DBRef, dbr, (DBRef)(CharP(dbr)+HDiff) ) Inline(DBRefPAdjust, DBRef *, DBRef *, dbrp, (DBRef *)(CharP(dbrp)+HDiff) ) +Inline(DBTermAdjust, DBTerm *, DBTerm *, dbtp, (DBTerm *)(CharP(dbtp)+HDiff) ) +Inline(SIndexAdjust, struct static_index *, struct static_index *, si, (struct static_index *)(CharP(si)+HDiff) ) +Inline(LUIndexAdjust, struct logic_upd_index *, struct logic_upd_index *, lui, (struct logic_upd_index *)(CharP(lui)+HDiff) ) Inline(CodeAdjust, Term, Term, dbr, ((Term)(dbr)+HDiff) ) Inline(AddrAdjust, ADDR, ADDR, addr, (ADDR)(CharP(addr)+HDiff) ) Inline(CodeAddrAdjust, CODEADDR, CODEADDR, addr, (CODEADDR)(CharP(addr)+HDiff) ) @@ -85,6 +88,8 @@ Inline(PtoOpAdjust, yamop *, yamop *, ptr, ((yamop *)(CharP(ptr) + HDiff)) ) Inline(PtoHeapCellAdjust, CELL *, CELL *, ptr, ((CELL *)(CharP(ptr) + HDiff)) ) Inline(PtoPredAdjust, PredEntry *, PredEntry *, ptr, ((PredEntry *)(CharP(ptr) + HDiff)) ) Inline(PtoArrayEAdjust, ArrayEntry *, ArrayEntry *, ptr, ((ArrayEntry *)(CharP(ptr) + HDiff)) ) +Inline(PtoLUCAdjust, struct logic_upd_clause *, struct logic_upd_clause *, ptr, ((struct logic_upd_clause *)(CharP(ptr) + HDiff)) ) +Inline(PtoStCAdjust, struct static_clause *, struct static_clause *, ptr, ((struct static_upd_clause *)(CharP(ptr) + HDiff)) ) #if PRECOMPUTE_REGADDRESS Inline(XAdjust, wamreg, wamreg, reg, (wamreg)((reg)+XDiff) ) #else