diff --git a/C/absmi.c b/C/absmi.c index 87250d96c..1d167381b 100644 --- a/C/absmi.c +++ b/C/absmi.c @@ -10,8 +10,11 @@ * * * File: absmi.c * * comments: Portable abstract machine interpreter * -* Last rev: $Date: 2007-11-06 17:02:08 $,$Author: vsc $ * +* Last rev: $Date: 2007-11-07 09:25:27 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.228 2007/11/06 17:02:08 vsc +* compile ground terms away. +* * Revision 1.227 2007/10/28 11:23:39 vsc * fix overflow * @@ -13227,6 +13230,209 @@ Yap_absmi(int inp) ENDD(d0); ENDOp(); + BOp(p_execute2, sla); + { + PredEntry *pen; + Term mod = ARG2; + + deref_head(mod, execute2_unk0); + execute2_nvar0: + if (!IsAtomTerm(mod)) { + saveregs(); + Yap_Error(TYPE_ERROR_ATOM, mod, "call/2"); + setregs(); + } + CACHE_Y_AS_ENV(YREG); + /* Try to preserve the environment */ + ENV_YREG = (CELL *) (((char *) YREG) + PREG->u.sla.s); +#ifdef FROZEN_STACKS + { + choiceptr top_b = PROTECT_FROZEN_B(B); +#ifdef SBA + if (ENV_YREG > (CELL *) top_b || ENV_YREG < H) ENV_YREG = (CELL *) top_b; +#else + if (ENV_YREG > (CELL *) top_b) ENV_YREG = (CELL *) top_b; +#endif /* SBA */ + } +#else + if (ENV_YREG > (CELL *) B) { + ENV_YREG = (CELL *) B; + } +#endif /* FROZEN_STACKS */ + BEGD(d0); + d0 = ARG1; + restart_execute2: + deref_head(d0, execute2_unk); + execute2_nvar: + if (IsApplTerm(d0)) { + Functor f = FunctorOfTerm(d0); + if (IsExtensionFunctor(f)) { + goto execute2_metacall; + } + pen = RepPredProp(PredPropByFunc(f, mod)); + if (pen->PredFlags & (MetaPredFlag|GoalExPredFlag)) { + if (f == FunctorModule) { + Term tmod = ArgOfTerm(1,d0); + if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) { + d0 = ArgOfTerm(2,d0); + mod = tmod; + goto execute2_nvar; + } + } else if (f == FunctorComma) { + SREG = RepAppl(d0); + BEGD(d1); + d1 = SREG[2]; + /* create an to execute2 the call */ + deref_head(d1, execute2_comma_unk); + execute2_comma_nvar: + if (IsAtomTerm(d1)) { + ENV_YREG[-EnvSizeInCells-2] = MkIntegerTerm((Int)PredPropByAtom(AtomOfTerm(d1),mod)); + ENV_YREG[-EnvSizeInCells-3] = mod; + } else if (IsApplTerm(d1)) { + Functor f = FunctorOfTerm(d1); + if (IsExtensionFunctor(f)) { + goto execute2_metacall; + } else { + if (f == FunctorModule) goto execute2_metacall; + ENV_YREG[-EnvSizeInCells-2] = MkIntegerTerm((Int)PredPropByFunc(f,mod)); + ENV_YREG[-EnvSizeInCells-3] = mod; + } + } else { + goto execute2_metacall; + } + ENV_YREG[E_CP] = (CELL)NEXTOP(PREG,sla); + ENV_YREG[E_CB] = (CELL)B; + ENV_YREG[E_E] = (CELL)ENV; +#ifdef DEPTH_LIMIT + ENV_YREG[E_DEPTH] = DEPTH; +#endif /* DEPTH_LIMIT */ + ENV_YREG[-EnvSizeInCells-1] = d1; + ENV = ENV_YREG; + ENV_YREG -= EnvSizeInCells+3; + PREG = COMMA_CODE; + /* for profiler */ + save_pc(); + d0 = SREG[1]; + goto restart_execute2; + + BEGP(pt1); + deref_body(d1, pt1, execute2_comma_unk, execute2_comma_nvar); + goto execute2_metacall; + ENDP(pt1); + ENDD(d1); + } else if (mod != CurrentModule) { + goto execute2_metacall; + } + } + if (PRED_GOAL_EXPANSION_ALL) { + goto execute2_metacall; + } + + BEGP(pt1); + pt1 = RepAppl(d0); + BEGD(d2); + for (d2 = ArityOfFunctor(f); d2; d2--) { +#if SBA + BEGD(d1); + d1 = pt1[d2]; + if (d1 == 0) { + XREGS[d2] = (CELL)(pt1+d2); + } else { + XREGS[d2] = d1; + } +#else + XREGS[d2] = pt1[d2]; +#endif + } + ENDD(d2); + ENDP(pt1); + CACHE_A1(); + } else if (IsAtomTerm(d0)) { + if (PRED_GOAL_EXPANSION_ALL) { + goto execute2_metacall; + } else { + pen = RepPredProp(PredPropByAtom(AtomOfTerm(d0), mod)); + } + } else { + goto execute2_metacall; + } + + execute2_end: + /* code copied from call */ +#ifndef NO_CHECKING + check_stack(NoStackPExecute2, H); +#endif + CPREG = NEXTOP(PREG, sla); + ALWAYS_LOOKAHEAD(pen->OpcodeOfPred); + PREG = pen->CodeOfPred; + /* for profiler */ + save_pc(); +#ifdef DEPTH_LIMIT + if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is primitives */ + if (pen->ModuleOfPred) { + if (DEPTH == MkIntTerm(0)) + FAIL(); + else DEPTH = RESET_DEPTH(); + } + } else if (pen->ModuleOfPred) + DEPTH -= MkIntConstant(2); +#endif /* DEPTH_LIMIT */ +#ifdef LOW_LEVEL_TRACER + if (Yap_do_low_level_trace) + low_level_trace(enter_pred,pen,XREGS+1); +#endif /* LOW_LEVEL_TRACER */ + WRITEBACK_Y_AS_ENV(); + /* setup GB */ + ENV_YREG[E_CB] = (CELL) B; +#ifdef YAPOR + SCH_check_requests(); +#endif /* YAPOR */ + CACHE_A1(); + ALWAYS_GONext(); + ALWAYS_END_PREFETCH(); + + BEGP(pt1); + deref_body(d0, pt1, execute2_unk, execute2_nvar); + execute2_metacall: + ARG1 = ARG3 = d0; + pen = PredMetaCall; + ARG2 = Yap_cp_as_integer(B); + if (mod) + ARG4 = mod; + else + ARG4 = TermProlog; + goto execute2_end; + ENDP(pt1); + + ENDD(d0); + NoStackPExecute2: + SREG = (CELL *) pen; + ASP = ENV_YREG; + /* setup GB */ + WRITEBACK_Y_AS_ENV(); + YREG[E_CB] = (CELL) B; + if (ActiveSignals) { + goto creep_pe; + } + saveregs_and_ycache(); + if (!Yap_gc(((PredEntry *)SREG)->ArityOfPE, ENV, NEXTOP(PREG, sla))) { + Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage); + } + setregs_and_ycache(); + goto execute2_end; + ENDCACHE_Y_AS_ENV(); + + BEGP(pt1); + deref_body(mod, pt1, execute2_unk0, execute2_nvar0); + saveregs(); + Yap_Error(INSTANTIATION_ERROR, mod, "call/2"); + setregs(); + ENDP(pt1); + /* Oops, second argument was unbound too */ + FAIL(); + } + ENDBOp(); + BOp(p_execute, sla); { PredEntry *pen; diff --git a/C/amasm.c b/C/amasm.c index d02a1d225..d7c3913d8 100644 --- a/C/amasm.c +++ b/C/amasm.c @@ -11,8 +11,11 @@ * File: amasm.c * * comments: abstract machine assembler * * * -* Last rev: $Date: 2007-11-06 17:02:09 $ * +* Last rev: $Date: 2007-11-07 09:25:27 $ * * $Log: not supported by cvs2svn $ +* Revision 1.96 2007/11/06 17:02:09 vsc +* compile ground terms away. +* * Revision 1.95 2007/06/23 17:31:50 vsc * pin cluses with floats. * @@ -1229,6 +1232,8 @@ a_p(op_numbers opcode, clause_info *clinfo, yamop *code_p, int pass_no, struct i } else { if (RepPredProp(fe)->FunctorOfPred == FunctorExecuteInMod) { code_p->opc = emit_op(_p_execute); + } else if (RepPredProp(fe)->FunctorOfPred == FunctorExecute2InMod) { + code_p->opc = emit_op(_p_execute2); } else { code_p->opc = emit_op(_call_cpred); } diff --git a/C/cdmgr.c b/C/cdmgr.c index 8057cedd3..413e6de21 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -11,8 +11,11 @@ * File: cdmgr.c * * comments: Code manager * * * -* Last rev: $Date: 2007-11-06 17:02:11 $,$Author: vsc $ * +* Last rev: $Date: 2007-11-07 09:25:27 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.209 2007/11/06 17:02:11 vsc +* compile ground terms away. +* * Revision 1.208 2007/11/01 10:01:35 vsc * fix uninitalised lock and reconsult test. * @@ -3998,6 +4001,7 @@ ClauseInfoForCode(yamop *codeptr, CODEADDR *startp, CODEADDR *endp) { /* instructions type sla */ case _p_execute_tail: case _p_execute: + case _p_execute2: clause_code = TRUE; pp = RepPredProp(Yap_GetPredPropByFunc(FunctorCall, CurrentModule)); *startp = (CODEADDR)&(pp->OpcodeOfPred); @@ -4740,6 +4744,51 @@ p_system_pred(void) pe->OpcodeOfPred == Yap_opcode(_try_userc)); } +static Int /* $system_predicate(P) */ +p_all_system_pred(void) +{ + PredEntry *pe; + + Term t1 = Deref(ARG1); + Term mod = Deref(ARG2); + + restart_system_pred: + if (IsVarTerm(t1)) + return TRUE; + if (IsAtomTerm(t1)) { + pe = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t1), mod)); + } else if (IsApplTerm(t1)) { + Functor funt = FunctorOfTerm(t1); + if (IsExtensionFunctor(funt)) { + return FALSE; + } + if (funt == FunctorModule) { + Term nmod = ArgOfTerm(1, t1); + if (IsVarTerm(nmod)) { + Yap_Error(INSTANTIATION_ERROR,ARG1,"system_predicate/1"); + return FALSE; + } + if (!IsAtomTerm(nmod)) { + Yap_Error(TYPE_ERROR_ATOM,ARG1,"system_predicate/1"); + return FALSE; + } + t1 = ArgOfTerm(2, t1); + goto restart_system_pred; + } + pe = RepPredProp(Yap_GetPredPropByFunc(funt, mod)); + } else if (IsPairTerm(t1)) { + return TRUE; + } else + return FALSE; + if (EndOfPAEntr(pe)) + return FALSE; + return(!pe->ModuleOfPred || /* any predicate in prolog module */ + /* any C-pred */ + pe->PredFlags & (UserCPredFlag|CPredFlag|BinaryTestPredFlag|AsmPredFlag|TestPredFlag) || + /* any weird user built-in */ + pe->OpcodeOfPred == Yap_opcode(_try_userc)); +} + static Int /* $system_predicate(P) */ p_hide_predicate(void) { @@ -6021,6 +6070,7 @@ Yap_InitCdMgr(void) Yap_InitCPred("$set_pred_module", 2, p_set_pred_module, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$parent_pred", 3, p_parent_pred, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$system_predicate", 2, p_system_pred, SafePredFlag|HiddenPredFlag); + Yap_InitCPred("$all_system_predicate", 2, p_all_system_pred, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$hide_predicate", 2, p_hide_predicate, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$hidden_predicate", 2, p_hidden_predicate, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$pred_for_code", 5, p_pred_for_code, SyncPredFlag|HiddenPredFlag); diff --git a/C/exec.c b/C/exec.c index d469391df..ef01a5458 100644 --- a/C/exec.c +++ b/C/exec.c @@ -2039,6 +2039,7 @@ Yap_InitExecFs(void) Yap_InitCPred("$execute", 11, p_execute11, HiddenPredFlag); Yap_InitCPred("$execute", 12, p_execute12, HiddenPredFlag); Yap_InitCPred("$execute_in_mod", 2, p_execute_in_mod, HiddenPredFlag); + Yap_InitCPred("$execute_wo_mod", 2, p_execute_in_mod, HiddenPredFlag); Yap_InitCPred("$call_with_args", 2, p_execute_0, HiddenPredFlag); Yap_InitCPred("$call_with_args", 3, p_execute_1, HiddenPredFlag); Yap_InitCPred("$call_with_args", 4, p_execute_2, HiddenPredFlag); diff --git a/C/index.c b/C/index.c index aede243af..9a8f3cbf7 100644 --- a/C/index.c +++ b/C/index.c @@ -11,8 +11,11 @@ * File: index.c * * comments: Indexing a Prolog predicate * * * -* Last rev: $Date: 2007-11-06 17:02:12 $,$Author: vsc $ * +* Last rev: $Date: 2007-11-07 09:25:27 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.189 2007/11/06 17:02:12 vsc +* compile ground terms away. +* * Revision 1.188 2007/10/28 11:23:40 vsc * fix overflow * @@ -1044,6 +1047,7 @@ has_cut(yamop *pc) break; /* instructions type sla */ case _p_execute: + case _p_execute2: case _fcall: case _call: #ifdef YAPOR @@ -1721,6 +1725,7 @@ add_info(ClauseDef *clause, UInt regno) clause->Tag = (CELL)NULL; return; case _p_execute: + case _p_execute2: case _fcall: case _call: #ifdef YAPOR diff --git a/C/init.c b/C/init.c index 194021107..db9c6b730 100644 --- a/C/init.c +++ b/C/init.c @@ -1180,6 +1180,7 @@ InitCodes(void) Yap_heap_regs->functor_csult = Yap_MkFunctor(AtomCsult, 1); Yap_heap_regs->functor_eq = Yap_MkFunctor(AtomEq, 2); Yap_heap_regs->functor_execute_in_mod = Yap_MkFunctor(Yap_FullLookupAtom("$execute_in_mod"), 2); + Yap_heap_regs->functor_execute2_in_mod = Yap_MkFunctor(Yap_FullLookupAtom("$execute_wo_mod"), 2); Yap_heap_regs->functor_execute_within = Yap_MkFunctor(Yap_FullLookupAtom("$execute_within"), 1); Yap_heap_regs->functor_g_atom = Yap_MkFunctor(Yap_LookupAtom("atom"), 1); Yap_heap_regs->functor_g_atomic = Yap_MkFunctor(Yap_LookupAtom("atomic"), 1); diff --git a/C/tracer.c b/C/tracer.c index 63b9c0d8a..528932fc2 100644 --- a/C/tracer.c +++ b/C/tracer.c @@ -162,6 +162,9 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) sc = Yap_heap_regs; vsc_count++; #ifdef COMMENTED + if (vsc_count == 40650191LL) + jmp_deb(1); + return; if (vsc_count > 1388060LL && vsc_count < 1388070LL) { if (vsc_count==1388061LL) jmp_deb(1); diff --git a/H/Heap.h b/H/Heap.h index 9c4256182..54e7badd0 100644 --- a/H/Heap.h +++ b/H/Heap.h @@ -10,7 +10,7 @@ * File: Heap.h * * mods: * * comments: Heap Init Structure * -* version: $Id: Heap.h,v 1.119 2007-11-06 17:02:12 vsc Exp $ * +* version: $Id: Heap.h,v 1.120 2007-11-07 09:25:27 vsc Exp $ * *************************************************************************/ /* information that can be stored in Code Space */ @@ -445,6 +445,7 @@ typedef struct various_codes { functor_cut_by, functor_eq, functor_execute_in_mod, + functor_execute2_in_mod, functor_execute_within, functor_g_atom, functor_g_atomic, @@ -750,6 +751,7 @@ struct various_codes *Yap_heap_regs; #define FunctorCutBy Yap_heap_regs->functor_cut_by #define FunctorEq Yap_heap_regs->functor_eq #define FunctorExecuteInMod Yap_heap_regs->functor_execute_in_mod +#define FunctorExecute2InMod Yap_heap_regs->functor_execute2_in_mod #define FunctorExecuteWithin Yap_heap_regs->functor_execute_within #define FunctorGAtom Yap_heap_regs->functor_g_atom #define FunctorGAtomic Yap_heap_regs->functor_g_atomic diff --git a/H/YapOpcodes.h b/H/YapOpcodes.h index 497fed09d..2b1f7b1f4 100644 --- a/H/YapOpcodes.h +++ b/H/YapOpcodes.h @@ -11,8 +11,11 @@ * File: YapOpcodes.h * * comments: Central Table with all YAP opcodes * * * -* Last rev: $Date: 2007-11-06 17:02:12 $ * +* Last rev: $Date: 2007-11-07 09:25:27 $ * * $Log: not supported by cvs2svn $ +* Revision 1.41 2007/11/06 17:02:12 vsc +* compile ground terms away. +* * Revision 1.40 2006/10/10 14:08:17 vsc * small fixes on threaded implementation. * @@ -481,6 +484,7 @@ OPCODE(p_func2f_yx ,yxx), OPCODE(p_func2f_yy ,yyx), OPCODE(p_execute ,sla), + OPCODE(p_execute2 ,sla), OPCODE(p_execute_tail ,e) diff --git a/H/Yatom.h b/H/Yatom.h index c5fa4cd00..aa7f99e1a 100644 --- a/H/Yatom.h +++ b/H/Yatom.h @@ -1328,7 +1328,7 @@ EXTERN inline UInt STD_PROTO(PRED_HASH, (FunctorEntry *, Term, UInt)); EXTERN inline UInt PRED_HASH(FunctorEntry *fe, Term cur_mod, UInt size) { - return ((CELL)fe+cur_mod) % size; + return (((CELL)fe+cur_mod)>>2) % size; } EXTERN inline Prop STD_PROTO(GetPredPropByFuncHavingLock, (FunctorEntry *, Term)); diff --git a/H/rclause.h b/H/rclause.h index 8e585081c..1d8ad794c 100644 --- a/H/rclause.h +++ b/H/rclause.h @@ -12,8 +12,11 @@ * File: rclause.h * * comments: walk through a clause * * * -* Last rev: $Date: 2007-11-06 17:02:12 $,$Author: vsc $ * +* Last rev: $Date: 2007-11-07 09:25:27 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.19 2007/11/06 17:02:12 vsc +* compile ground terms away. +* * Revision 1.18 2006/11/27 17:42:03 vsc * support for UNICODE, and other bug fixes. * @@ -380,6 +383,7 @@ restore_opcodes(yamop *pc) /* instructions type sla */ case _p_execute_tail: case _p_execute: + case _p_execute2: pc->u.sla.sla_u.p = PtoPredAdjust(pc->u.sla.sla_u.p); if (pc->u.sla.sla_u.mod != 0) { pc->u.sla.sla_u.mod = AtomTermAdjust(pc->u.sla.sla_u.mod); diff --git a/H/rheap.h b/H/rheap.h index 062792771..d6978bf2f 100644 --- a/H/rheap.h +++ b/H/rheap.h @@ -11,8 +11,11 @@ * File: rheap.h * * comments: walk through heap code * * * -* Last rev: $Date: 2007-11-06 17:02:12 $,$Author: vsc $ * +* Last rev: $Date: 2007-11-07 09:25:27 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.78 2007/11/06 17:02:12 vsc +* compile ground terms away. +* * Revision 1.77 2007/10/10 09:44:24 vsc * some more fixes to make YAP swi compatible * fix absolute_file_name (again) @@ -678,6 +681,7 @@ restore_codes(void) Yap_heap_regs->functor_csult = FuncAdjust(Yap_heap_regs->functor_csult); Yap_heap_regs->functor_eq = FuncAdjust(Yap_heap_regs->functor_eq); Yap_heap_regs->functor_execute_in_mod = FuncAdjust(Yap_heap_regs->functor_execute_in_mod); + Yap_heap_regs->functor_execute2_in_mod = FuncAdjust(Yap_heap_regs->functor_execute2_in_mod); Yap_heap_regs->functor_execute_within = FuncAdjust(Yap_heap_regs->functor_execute_within); Yap_heap_regs->functor_g_atom = FuncAdjust(Yap_heap_regs->functor_g_atom); Yap_heap_regs->functor_g_atomic = FuncAdjust(Yap_heap_regs->functor_g_atomic); diff --git a/pl/modules.yap b/pl/modules.yap index ebe20ffb4..7f11d70d5 100644 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -257,7 +257,7 @@ module(N) :- '$module_expansion'(false,false,false,_,_,_,_) :- !. % if I don't know what the module is, I cannot do anything to the goal, % so I just put a call for later on. -'$module_expansion'(M:G,call(M:G),call(M:G),_,_,_,_) :- var(M), !. +'$module_expansion'(M:G,call(M:G),'$execute_wo_mod'(G,M),_,_,_,_) :- var(M), !. '$module_expansion'(M:G,G1,GO,_,_,TM,HVars) :- '$module_expansion'(G,G1,GO,M,M,TM,HVars). % if M1 is given explicitly process G within M1's context. @@ -308,7 +308,7 @@ module(N) :- user:goal_expansion(G,M,GI), !, '$module_expansion'(GI,G1,G2,M,CM,TM,HVars). '$complete_goal_expansion'(G, M, CM, TM, G1, G2, HVars) :- - '$system_predicate'(G,M), !, + '$all_system_predicate'(G,M), !, '$c_built_in'(G,M,Gi), (Gi \== G -> '$module_expansion'(Gi,_,G2,M,CM,TM,HVars),