diff --git a/C/absmi.c b/C/absmi.c index 84f7c1f00..d38457e0c 100755 --- a/C/absmi.c +++ b/C/absmi.c @@ -10,487 +10,14 @@ * * * File: absmi.c * * comments: Portable abstract machine interpreter * -* Last rev: $Date: 2008-08-13 01:16:26 $,$Author: vsc $ * +* Last rev: $Date: 2008-08-13 01:16:26 $,$Author: vsc $ +** * $Log: not supported by cvs2svn $ * Revision 1.246 2008/08/12 01:27:22 vsc -* MaxOS fixes -* Avoid a thread deadlock -* improvements to SWI predicates. -* make variables_in_term system builtin. -* -* Revision 1.245 2008/08/07 20:51:15 vsc -* more threadin fixes -* -* Revision 1.244 2008/08/06 23:05:49 vsc -* fix debugging info -* -* Revision 1.243 2008/08/06 17:32:18 vsc -* more thread fixes -* -* Revision 1.242 2008/06/17 13:37:48 vsc -* fix c_interface not to crash when people try to recover slots that are -* not there. -* fix try_logical and friends to handle case where predicate has arity 0. -* -* Revision 1.241 2008/06/04 14:47:18 vsc -* make sure we do trim_trail whenever we mess with B! -* -* Revision 1.240 2008/04/04 16:11:40 vsc -* yapor had gotten broken with recent thread changes -* -* Revision 1.239 2008/04/03 13:26:37 vsc -* protect signal handling with locks for threaded version. -* fix close/1 entry in manual (obs from Nicos). -* fix -f option in chr Makefile. -* -* Revision 1.238 2008/04/03 10:50:23 vsc -* term_variables could store local variable in global. -* -* Revision 1.237 2008/03/26 14:37:07 vsc -* more icc fixes -* -* Revision 1.236 2008/03/25 16:45:52 vsc -* make or-parallelism compile again -* -* Revision 1.235 2008/02/12 17:03:50 vsc -* SWI-portability changes -* -* Revision 1.234 2008/01/27 11:01:06 vsc -* make thread code more stable -* -* Revision 1.233 2008/01/23 17:57:44 vsc -* valgrind it! -* enable atom garbage collection. -* -* Revision 1.232 2007/11/28 23:52:14 vsc -* junction tree algorithm -* -* Revision 1.231 2007/11/26 23:43:07 vsc -* fixes to support threads and assert correctly, even if inefficiently. -* -* Revision 1.230 2007/11/08 15:52:15 vsc -* fix some bugs in new dbterm code. -* -* Revision 1.229 2007/11/07 09:25:27 vsc -* speedup meta-calls -* -* 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 -* -* Revision 1.226 2007/10/28 00:54:09 vsc -* new version of viterbi implementation -* fix all:atvars reporting bad info -* fix bad S info in x86_64 -* -* Revision 1.225 2007/10/17 09:18:26 vsc -* growtrail assumed SREG meant ASP? -* -* Revision 1.224 2007/09/24 09:02:31 vsc -* minor bug fixes -* -* Revision 1.223 2007/06/04 12:28:01 vsc -* interface speedups -* bad error message in X is foo>>2. -* -* Revision 1.222 2007/05/01 21:18:19 vsc -* fix bug in saving P at p_eq (obs from Frabrizio Riguzzi) -* -* Revision 1.221 2007/04/10 22:13:20 vsc -* fix max modules limitation -* -* Revision 1.220 2007/03/21 18:32:49 vsc -* fix memory expansion bugs. -* -* Revision 1.219 2007/01/24 09:57:25 vsc -* fix glist_void_varx -* -* Revision 1.218 2006/12/31 01:50:34 vsc -* fix some bugs in call_cleanup: the result of action should not matter, -* and !,fail would not wakeup the delayed goal. -* -* Revision 1.217 2006/12/30 03:25:44 vsc -* call_cleanup/2 and 3 -* -* Revision 1.216 2006/12/29 01:57:50 vsc -* allow coroutining plus tabling, this means fixing some trouble with the -* gc and a bug in global variable handling. -* -* Revision 1.215 2006/12/27 01:32:37 vsc -* diverse fixes -* -* Revision 1.214 2006/11/28 00:46:28 vsc -* fix bug in threaded implementation -* -* Revision 1.213 2006/11/27 17:42:02 vsc -* support for UNICODE, and other bug fixes. -* -* Revision 1.212 2006/11/21 16:21:30 vsc -* fix I/O mess -* fix spy/reconsult mess -* -* Revision 1.211 2006/11/15 00:13:36 vsc -* fixes for indexing code. -* -* Revision 1.210 2006/10/25 02:31:07 vsc -* fix emulation of trust_logical -* -* Revision 1.209 2006/10/18 13:47:31 vsc -* index.c implementation of trust_logical was decrementing the wrong -* cp_tr -* -* Revision 1.208 2006/10/11 14:53:57 vsc -* fix memory leak -* fix overflow handling -* VS: ---------------------------------------------------------------------- -* -* Revision 1.207 2006/10/10 20:21:42 vsc -* fix new indexing code to actually recover space -* fix predicate info to work for LUs -* -* Revision 1.206 2006/10/10 14:08:15 vsc -* small fixes on threaded implementation. -* -* Revision 1.205 2006/09/28 16:15:54 vsc -* make GMPless version compile. -* -* Revision 1.204 2006/09/20 20:03:51 vsc -* improve indexing on floats -* fix sending large lists to DB -* -* Revision 1.203 2006/08/07 18:51:44 vsc -* fix garbage collector not to try to garbage collect when we ask for large -* chunks of stack in a single go. -* -* Revision 1.202 2006/05/24 02:35:39 vsc -* make chr work and other minor fixes. -* -* Revision 1.201 2006/04/27 14:11:57 rslopes -* *** empty log message *** -* -* Revision 1.200 2006/04/12 17:14:58 rslopes -* fix needed by the EAM engine -* -* Revision 1.199 2006/04/12 15:51:23 rslopes -* small fixes -* -* Revision 1.198 2006/03/30 01:11:09 vsc -* fix nasty variable shunting bug in garbage collector :-(:wq -* -* Revision 1.197 2006/03/24 17:13:41 rslopes -* New update to BEAM engine. -* BEAM now uses YAP Indexing (JITI) -* -* Revision 1.196 2006/03/03 23:10:47 vsc -* fix MacOSX interrupt handling -* fix using Yap files as Yap scripts. -* -* Revision 1.195 2006/02/01 13:28:56 vsc -* bignum support fixes -* -* Revision 1.194 2006/01/26 19:13:24 vsc -* avoid compilation issues with lack of gmp (Remko Troncon) -* -* Revision 1.193 2006/01/18 15:34:53 vsc -* avoid sideffects from MkBigInt -* -* Revision 1.192 2006/01/17 14:10:40 vsc -* YENV may be an HW register (breaks some tabling code) -* All YAAM instructions are now brackedted, so Op introduced an { and EndOp introduces an }. This is because Ricardo assumes that. -* Fix attvars when COROUTING is undefined. -* -* Revision 1.191 2006/01/02 02:16:17 vsc -* support new interface between YAP and GMP, so that we don't rely on our own -* allocation routines. -* Several big fixes. -* -* Revision 1.190 2005/12/23 00:20:13 vsc -* updates to gprof -* support for __POWER__ -* Try to saveregs before longjmp. -* -* Revision 1.189 2005/12/17 03:25:38 vsc -* major changes to support online event-based profiling -* improve error discovery and restart on scanner. -* -* Revision 1.188 2005/12/05 17:16:10 vsc -* write_depth/3 -* overflow handlings and garbage collection -* Several ipdates to CLPBN -* dif/2 could be broken in the presence of attributed variables. -* -* Revision 1.187 2005/11/26 02:57:25 vsc -* improvements to debugger -* overflow fixes -* reading attvars from DB was broken. -* -* Revision 1.186 2005/11/23 03:01:32 vsc -* fix several bugs in save/restore.b -* -* Revision 1.185 2005/11/18 18:48:51 tiagosoares -* support for executing c code when a cut occurs -* -* Revision 1.184 2005/11/15 00:50:49 vsc -* fixes for stack expansion and garbage collection under tabling. -* -* Revision 1.183 2005/11/07 15:35:47 vsc -* fix bugs in garbage collection of tabling. -* -* Revision 1.182 2005/11/05 03:02:33 vsc -* get rid of unnecessary ^ in setof -* Found bug in comparisons -* -* Revision 1.181 2005/11/04 15:39:14 vsc -* absmi should PREG, never P!! -* -* Revision 1.180 2005/10/28 17:38:49 vsc -* sveral updates -* -* Revision 1.179 2005/10/18 17:04:43 vsc -* 5.1: -* - improvements to GC -* 2 generations -* generic speedups -* - new scheme for attvars -* - hProlog like interface also supported -* - SWI compatibility layer -* - extra predicates -* - global variables -* - moved to Prolog module -* - CLP(R) by Leslie De Koninck, Tom Schrijvers, Cristian Holzbaur, Bart -* Demoen and Jan Wielemacker -* - load_files/2 -* -* from 5.0.1 -* -* - WIN32 missing include files (untested) -* - -L trouble (my thanks to Takeyuchi Shiramoto-san)! -* - debugging of backtrable user-C preds would core dump. -* - redeclaring a C-predicate as Prolog core dumps. -* - badly protected YapInterface.h. -* - break/0 was failing at exit. -* - YAP_cut_fail and YAP_cut_succeed were different from manual. -* - tracing through data-bases could core dump. -* - cut could break on very large computations. -* - first pass at BigNum issues (reported by Roberto). -* - debugger could get go awol after fail port. -* - weird message on wrong debugger option. -* -* Revision 1.178 2005/10/15 17:05:23 rslopes -* enable profiling on amd64 -* -* Revision 1.177 2005/09/09 17:24:37 vsc -* a new and hopefully much better implementation of atts. -* -* Revision 1.176 2005/09/08 22:06:44 rslopes -* BEAM for YAP update... -* -* Revision 1.175 2005/08/12 17:00:00 ricroc -* TABLING FIX: support for incomplete tables -* -* Revision 1.174 2005/08/05 14:55:02 vsc -* first steps to allow mavars with tabling -* fix trailing for tabling with multiple get_cons -* -* Revision 1.173 2005/08/04 15:45:49 ricroc -* TABLING NEW: support to limit the table space size -* -* Revision 1.172 2005/08/02 03:09:48 vsc -* fix debugger to do well nonsource predicates. -* -* Revision 1.171 2005/08/01 15:40:36 ricroc -* TABLING NEW: better support for incomplete tabling -* -* Revision 1.170 2005/07/06 19:33:51 ricroc -* TABLING: answers for completed calls can now be obtained by loading (new option) or executing (default) them from the trie data structure. -* -* Revision 1.169 2005/07/06 15:10:01 vsc -* improvements to compiler: merged instructions and fixes for -> -* -* Revision 1.168 2005/06/04 07:27:33 ricroc -* long int support for tabling -* -* Revision 1.167 2005/06/03 08:26:31 ricroc -* float support for tabling -* -* Revision 1.166 2005/06/01 20:25:22 vsc -* == and \= should not need a choice-point in -> -* -* Revision 1.165 2005/06/01 14:02:45 vsc -* get_rid of try_me?, retry_me? and trust_me? instructions: they are not -* significantly used nowadays. -* -* Revision 1.164 2005/05/26 18:07:32 vsc -* fix warning -* -* Revision 1.163 2005/04/10 04:01:07 vsc -* bug fixes, I hope! -* -* Revision 1.162 2005/04/07 17:48:53 ricroc -* Adding tabling support for mixed strategy evaluation (batched and local scheduling) -* UPDATE: compilation flags -DTABLING_BATCHED_SCHEDULING and -DTABLING_LOCAL_SCHEDULING removed. To support tabling use -DTABLING in the Makefile or --enable-tabling in configure. -* NEW: yap_flag(tabling_mode,MODE) changes the tabling execution mode of all tabled predicates to MODE (batched, local or default). -* NEW: tabling_mode(PRED,MODE) changes the default tabling execution mode of predicate PRED to MODE (batched or local). -* -* Revision 1.161 2005/03/13 06:26:09 vsc -* fix excessive pruning in meta-calls -* fix Term->int breakage in compiler -* improve JPL (at least it does something now for amd64). -* -* Revision 1.160 2005/03/07 17:49:14 vsc -* small fixes -* -* Revision 1.159 2005/03/04 20:29:55 ricroc -* bug fixes for YapTab support -* -* Revision 1.158 2005/03/01 22:25:07 vsc -* fix pruning bug -* make DL_MALLOC less enthusiastic about walking through buckets. -* -* Revision 1.157 2005/02/08 18:04:17 vsc -* library_directory may not be deterministic (usually it isn't). -* -* Revision 1.156 2005/01/13 05:47:25 vsc -* lgamma broke arithmetic optimisation -* integer_y has type y -* pass original source to checker (and maybe even use option in parser) -* use warning mechanism for checker messages. -* -* Revision 1.155 2004/12/28 22:20:34 vsc -* some extra bug fixes for trail overflows: some cannot be recovered that easily, -* some can. -* -* Revision 1.154 2004/12/05 05:01:21 vsc -* try to reduce overheads when running with goal expansion enabled. -* CLPBN fixes -* Handle overflows when allocating big clauses properly. -* -* Revision 1.153 2004/11/19 22:08:35 vsc -* replace SYSTEM_ERROR_INTERNAL by out OUT_OF_WHATEVER_ERROR whenever appropriate. -* -* Revision 1.152 2004/11/19 17:14:12 vsc -* a few fixes for 64 bit compiling. -* -* Revision 1.151 2004/11/04 18:22:28 vsc -* don't ever use memory that has been freed (that was done by LU). -* generic fixes for WIN32 libraries -* -* Revision 1.150 2004/10/26 20:15:36 vsc -* More bug fixes for overflow handling -* -* Revision 1.149 2004/10/14 22:14:52 vsc -* don't use a cached version of ARG1 in choice-points -* -* Revision 1.148 2004/09/30 21:37:40 vsc -* fixes for thread support -* -* Revision 1.147 2004/09/30 19:51:53 vsc -* fix overflow from within clause/2 -* -* Revision 1.146 2004/09/27 20:45:02 vsc -* Mega clauses -* Fixes to sizeof(expand_clauses) which was being overestimated -* Fixes to profiling+indexing -* Fixes to reallocation of memory after restoring -* Make sure all clauses, even for C, end in _Ystop -* Don't reuse space for Streams -* Fix Stream_F on StreaNo+1 -* -* Revision 1.145 2004/09/17 20:47:35 vsc -* fix some overflows recorded. -* -* Revision 1.144 2004/09/17 19:34:49 vsc -* simplify frozen/2 -* -* Revision 1.143 2004/08/16 21:02:04 vsc -* more fixes for ! -* -* Revision 1.142 2004/08/11 16:14:51 vsc -* whole lot of fixes: -* - memory leak in indexing -* - memory management in WIN32 now supports holes -* - extend Yap interface, more support for SWI-Interface -* - new predicate mktime in system -* - buffer console I/O in WIN32 -* -* Revision 1.141 2004/07/23 21:08:44 vsc -* windows fixes -* -* Revision 1.140 2004/07/22 21:32:20 vsc -* debugger fixes -* initial support for JPL -* bad calls to garbage collector and gc -* debugger fixes -* -* Revision 1.139 2004/07/03 03:29:24 vsc -* make it compile again on non-linux machines -* -* Revision 1.138 2004/06/29 19:04:40 vsc -* fix multithreaded version -* include new version of Ricardo's profiler -* new predicat atomic_concat -* allow multithreaded-debugging -* small fixes -* -* Revision 1.137 2004/06/23 17:24:19 vsc -* New comment-based message style -* Fix thread support (at least don't deadlock with oneself) -* small fixes for coroutining predicates -* force Yap to recover space in arrays of dbrefs -* use private predicates in debugger. -* -* Revision 1.136 2004/06/17 22:07:22 vsc -* bad bug in indexing code. -* -* Revision 1.135 2004/06/09 03:32:02 vsc -* fix bugs -* -* Revision 1.134 2004/06/05 03:36:59 vsc -* coroutining is now a part of attvars. -* some more fixes. -* -* Revision 1.133 2004/05/13 20:54:57 vsc -* debugger fixes -* make sure we always go back to current module, even during initizlization. -* -* Revision 1.132 2004/04/29 03:45:49 vsc -* fix garbage collection in execute_tail -* -* Revision 1.131 2004/04/22 20:07:02 vsc -* more fixes for USE_SYSTEM_MEMORY -* -* Revision 1.130 2004/04/22 03:24:17 vsc -* trust_logical should protect the last clause, otherwise it cannot -* jump there. -* -* Revision 1.129 2004/04/16 19:27:30 vsc -* more bug fixes -* -* Revision 1.128 2004/04/14 19:10:22 vsc -* expand_clauses: keep a list of clauses to expand -* fix new trail scheme for multi-assignment variables -* -* Revision 1.127 2004/03/31 01:03:09 vsc -* support expand group of clauses -* -* Revision 1.126 2004/03/19 11:35:42 vsc -* trim_trail for default machine -* be more aggressive about try-retry-trust chains. -* - handle cases where block starts with a wait -* - don't use _killed instructions, just let the thing rot by itself. -* -* Revision 1.125 2004/03/10 14:59:54 vsc -* optimise -> for type tests -* -* Revision 1.124 2004/03/08 19:31:01 vsc -* move to 4.5.3 * * * * *************************************************************************/ - /** @file absmi.c @@ -512,15 +39,10 @@ loop(Env) :- ~~~~~ */ - - - - #define IN_ABSMI_C 1 #define _INATIVE 1 #define HAS_CACHE_REGS 1 - #include "absmi.h" #include "heapgc.h" @@ -533,7 +55,7 @@ TraceContext **curtrace; yamop *curpreg; BlocksContext **globalcurblock; COUNT ineedredefinedest; -yamop* headoftrace; +yamop *headoftrace; NativeContext *NativeArea; IntermediatecodeContext *IntermediatecodeArea; @@ -546,10 +68,7 @@ Environment *Yap_ExpEnvP, Yap_ExpEnv; void **Yap_ABSMI_ControlLabels; -static Int traced_absmi(void) -{ - return Yap_traced_absmi(); -} +static Int traced_absmi(void) { return Yap_traced_absmi(); } #endif @@ -560,13 +79,12 @@ void **Yap_ABSMI_OPCODES; /* keep X as a global variable */ -Term Yap_XREGS[MaxTemps]; /* 29 */ +Term Yap_XREGS[MaxTemps]; /* 29 */ #endif #include "arith2.h" - // #include "print_preg.h" //#include "sprint_op.hpp" //#include "print_op.hpp" @@ -579,17 +97,15 @@ Term Yap_XREGS[MaxTemps]; /* 29 */ The registers are then recovered by a nasty builtin called */ -static Term -push_live_regs(yamop *pco) -{ +static Term push_live_regs(yamop *pco) { CACHE_REGS CELL *lab = (CELL *)(pco->y_u.l.l); CELL max = lab[0]; CELL curr = lab[1]; Term tp = MkIntegerTerm((Int)pco); Term tcp = MkIntegerTerm((Int)CP); - Term tenv = MkIntegerTerm((Int)(LCL0-ENV)); - Term tyenv = MkIntegerTerm((Int)(LCL0-YENV)); + Term tenv = MkIntegerTerm((Int)(LCL0 - ENV)); + Term tyenv = MkIntegerTerm((Int)(LCL0 - YENV)); CELL *start = HR; Int tot = 0; @@ -600,92 +116,87 @@ push_live_regs(yamop *pco) *HR++ = tyenv; tot += 4; { - CELL i; + CELL i; lab += 2; - for (i=0; i <= max; i++) { - if (i == 8*CellSize) { - curr = lab[0]; - lab++; + for (i = 0; i <= max; i++) { + if (i == 8 * CellSize) { + curr = lab[0]; + lab++; } if (curr & 1) { - CELL d1; + CELL d1; - tot+=2; - HR[0] = MkIntTerm(i); - d1 = XREGS[i]; - deref_head(d1, wake_up_unk); + tot += 2; + HR[0] = MkIntTerm(i); + d1 = XREGS[i]; + deref_head(d1, wake_up_unk); wake_up_nonvar: - /* just copy it to the heap */ - HR[1] = d1; - HR += 2; - continue; + /* just copy it to the heap */ + HR[1] = d1; + HR += 2; + continue; - { - CELL *pt0; - deref_body(d1, pt0, wake_up_unk, wake_up_nonvar); - /* bind it, in case it is a local variable */ - if (pt0 <= HR) { - /* variable is safe */ - HR[1] = (CELL)pt0; - } else { - d1 = Unsigned(HR+1); - RESET_VARIABLE(HR+1); - Bind_Local(pt0, d1); - } - } - HR += 2; + { + CELL *pt0; + deref_body(d1, pt0, wake_up_unk, wake_up_nonvar); + /* bind it, in case it is a local variable */ + if (pt0 <= HR) { + /* variable is safe */ + HR[1] = (CELL)pt0; + } else { + d1 = Unsigned(HR + 1); + RESET_VARIABLE(HR + 1); + Bind_Local(pt0, d1); + } + } + HR += 2; } curr >>= 1; } start[0] = (CELL)Yap_MkFunctor(AtomTrue, tot); - return(AbsAppl(start)); + return (AbsAppl(start)); } } #endif #if USE_THREADED_CODE && (defined(ANALYST) || defined(DEBUG)) -char *Yap_op_names[] = -{ -#define OPCODE(OP,TYPE) #OP +char *Yap_op_names[] = { +#define OPCODE(OP, TYPE) #OP #include "YapOpcodes.h" -#undef OPCODE +#undef OPCODE }; #endif -static int -check_alarm_fail_int(int CONT USES_REGS) -{ -#if defined(_MSC_VER) || defined(__MINGW32__) +static int check_alarm_fail_int(int CONT USES_REGS) { +#if defined(_MSC_VER) || defined(__MINGW32__) /* I need this for Windows and any system where SIGINT is not proceesed by same thread as absmi */ - if (LOCAL_PrologMode & (AbortMode|InterruptMode)) - { - CalculateStackGap( PASS_REGS1 ); - return CONT; - } + if (LOCAL_PrologMode & (AbortMode | InterruptMode)) { + CalculateStackGap(PASS_REGS1); + return CONT; + } #endif - if (Yap_get_signal( YAP_FAIL_SIGNAL )) { - return false; + if (Yap_get_signal(YAP_FAIL_SIGNAL)) { + return false; } if (!Yap_has_a_signal()) { - /* no need to look into GC */ - CalculateStackGap( PASS_REGS1 ); + /* no need to look into GC */ + CalculateStackGap(PASS_REGS1); } // fail even if there are more signals, they will have to be dealt later. return -1; } -static int -stack_overflow( PredEntry *pe, CELL *env, yamop *cp, arity_t nargs USES_REGS) -{ - if ((Int)(Unsigned(YREG) - Unsigned(HR)) < StackGap( PASS_REGS1 ) || - Yap_get_signal( YAP_STOVF_SIGNAL )) { +static int stack_overflow(PredEntry *pe, CELL *env, yamop *cp, + arity_t nargs USES_REGS) { + if ((Int)(Unsigned(YREG) - Unsigned(HR)) < StackGap(PASS_REGS1) || + Yap_get_signal(YAP_STOVF_SIGNAL)) { S = (CELL *)pe; if (!Yap_locked_gc(nargs, env, cp)) { - Yap_NilError(RESOURCE_ERROR_STACK,LOCAL_ErrorMessage); + Yap_NilError(RESOURCE_ERROR_STACK, LOCAL_ErrorMessage); return 0; } return 1; @@ -693,29 +204,26 @@ stack_overflow( PredEntry *pe, CELL *env, yamop *cp, arity_t nargs USES_REGS) return -1; } -static int -code_overflow( CELL *yenv USES_REGS ) -{ - if (Yap_get_signal( YAP_CDOVF_SIGNAL )) { - CELL cut_b = LCL0-(CELL *)(yenv[E_CB]); +static int code_overflow(CELL *yenv USES_REGS) { + if (Yap_get_signal(YAP_CDOVF_SIGNAL)) { + CELL cut_b = LCL0 - (CELL *)(yenv[E_CB]); /* do a garbage collection first to check if we can recover memory */ if (!Yap_locked_growheap(false, 0, NULL)) { - Yap_NilError(RESOURCE_ERROR_HEAP, "YAP failed to grow heap: %s", LOCAL_ErrorMessage); + Yap_NilError(RESOURCE_ERROR_HEAP, "YAP failed to grow heap: %s", + LOCAL_ErrorMessage); return 0; } CACHE_A1(); if (yenv == ASP) { - yenv[E_CB] = (CELL)(LCL0-cut_b); + yenv[E_CB] = (CELL)(LCL0 - cut_b); } return 1; } return -1; } -static int -interrupt_handler( PredEntry *pe USES_REGS ) -{ +static int interrupt_handler(PredEntry *pe USES_REGS) { // printf("D %lx %p\n", LOCAL_ActiveSignals, P); /* tell whether we can creep or not, this is hard because we will @@ -724,11 +232,10 @@ interrupt_handler( PredEntry *pe USES_REGS ) BEGD(d0); d0 = pe->ArityOfPE; if (d0 == 0) { - HR[1] = MkAtomTerm((Atom) pe->FunctorOfPred); - } - else { + HR[1] = MkAtomTerm((Atom)pe->FunctorOfPred); + } else { HR[d0 + 2] = AbsAppl(HR); - *HR = (CELL) pe->FunctorOfPred; + *HR = (CELL)pe->FunctorOfPred; HR++; BEGP(pt1); pt1 = XREGS + 1; @@ -746,16 +253,16 @@ interrupt_handler( PredEntry *pe USES_REGS ) derefa_body(d1, pt0, creep_unk, creep_nonvar); if (pt0 <= HR) { - /* variable is safe */ - *HR++ = (CELL)pt0; - pt1++; + /* variable is safe */ + *HR++ = (CELL)pt0; + pt1++; } else { - /* bind it, in case it is a local variable */ - d1 = Unsigned(HR); - RESET_VARIABLE(HR); - pt1++; - HR += 1; - Bind_Local(pt0, d1); + /* bind it, in case it is a local variable */ + d1 = Unsigned(HR); + RESET_VARIABLE(HR); + pt1++; + HR += 1; + Bind_Local(pt0, d1); } ENDP(pt0); ENDD(d1); @@ -764,38 +271,35 @@ interrupt_handler( PredEntry *pe USES_REGS ) } ENDD(d0); HR[0] = Yap_Module_Name(pe); - ARG1 = (Term) AbsPair(HR); + ARG1 = (Term)AbsPair(HR); HR += 2; #ifdef COROUTINING - if (Yap_get_signal( YAP_WAKEUP_SIGNAL )) { - CalculateStackGap( PASS_REGS1 ); + if (Yap_get_signal(YAP_WAKEUP_SIGNAL)) { + CalculateStackGap(PASS_REGS1); ARG2 = Yap_ListOfWokenGoals(); pe = WakeUpCode; /* no more goals to wake up */ - Yap_UpdateTimedVar(LOCAL_WokenGoals,TermNil); + Yap_UpdateTimedVar(LOCAL_WokenGoals, TermNil); } else #endif - { - CalculateStackGap( PASS_REGS1 ); - pe = CreepCode; - } + { + CalculateStackGap(PASS_REGS1); + pe = CreepCode; + } P = pe->CodeOfPred; #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) - low_level_trace(enter_pred,pe,XREGS+1); -#endif /* LOW_LEVEL_TRACE */ + low_level_trace(enter_pred, pe, XREGS + 1); +#endif /* LOW_LEVEL_TRACE */ /* for profiler */ CACHE_A1(); return true; } - // interrupt handling code that sets up the case when we do not have // a guaranteed environment. -static int -safe_interrupt_handler( PredEntry *pe USES_REGS ) -{ +static int safe_interrupt_handler(PredEntry *pe USES_REGS) { CELL *npt = HR; // printf("D %lx %p\n", LOCAL_ActiveSignals, P); @@ -806,12 +310,11 @@ safe_interrupt_handler( PredEntry *pe USES_REGS ) S = (CELL *)pe; d0 = pe->ArityOfPE; if (d0 == 0) { - HR[1] = MkAtomTerm((Atom) pe->FunctorOfPred); - } - else { + HR[1] = MkAtomTerm((Atom)pe->FunctorOfPred); + } else { HR[d0 + 2] = AbsAppl(HR); - HR += d0+1+2; - *npt++ = (CELL) pe->FunctorOfPred; + HR += d0 + 1 + 2; + *npt++ = (CELL)pe->FunctorOfPred; BEGP(pt1); pt1 = XREGS + 1; for (; d0 > 0; --d0) { @@ -819,21 +322,21 @@ safe_interrupt_handler( PredEntry *pe USES_REGS ) d1 = *pt1; loop: if (!IsVarTerm(d1)) { - /* just copy it to the heap */ - pt1++; - *npt++ = d1; + /* just copy it to the heap */ + pt1++; + *npt++ = d1; } else { - if (VarOfTerm(d1) < H0 || VarOfTerm(d1) > HR) { - d1 = Deref(d1); - if (VarOfTerm(d1) < H0 || VarOfTerm(d1) > HR) { - Term v = MkVarTerm(); - YapBind( VarOfTerm(d1),v ); - } else { - goto loop; - } - } else { - *npt++ = d1; - } + if (VarOfTerm(d1) < H0 || VarOfTerm(d1) > HR) { + d1 = Deref(d1); + if (VarOfTerm(d1) < H0 || VarOfTerm(d1) > HR) { + Term v = MkVarTerm(); + YapBind(VarOfTerm(d1), v); + } else { + goto loop; + } + } else { + *npt++ = d1; + } } ENDD(d1); } @@ -845,26 +348,26 @@ safe_interrupt_handler( PredEntry *pe USES_REGS ) HR += 2; #ifdef COROUTINING - if (Yap_get_signal( YAP_WAKEUP_SIGNAL )) { - CalculateStackGap( PASS_REGS1 ); + if (Yap_get_signal(YAP_WAKEUP_SIGNAL)) { + CalculateStackGap(PASS_REGS1); ARG2 = Yap_ListOfWokenGoals(); pe = WakeUpCode; /* no more goals to wake up */ - Yap_UpdateTimedVar(LOCAL_WokenGoals,TermNil); + Yap_UpdateTimedVar(LOCAL_WokenGoals, TermNil); } else #endif - { - CalculateStackGap( PASS_REGS1 ); - pe = CreepCode; - } + { + CalculateStackGap(PASS_REGS1); + pe = CreepCode; + } // allocate and fill out an environment YENV = ASP; CACHE_Y_AS_ENV(YREG); - ENV_YREG[E_CP] = (CELL) CP; - ENV_YREG[E_E] = (CELL) ENV; + ENV_YREG[E_CP] = (CELL)CP; + ENV_YREG[E_E] = (CELL)ENV; #ifdef DEPTH_LIMIT ENV_YREG[E_DEPTH] = DEPTH; -#endif /* DEPTH_LIMIT */ +#endif /* DEPTH_LIMIT */ ENV = ENV_YREG; ENV_YREG = (CELL *)((CELL)ENV_YREG + ENV_Size(CP)); WRITEBACK_Y_AS_ENV(); @@ -872,77 +375,80 @@ safe_interrupt_handler( PredEntry *pe USES_REGS ) CP = P; P = pe->CodeOfPred; #ifdef DEPTH_LIMIT - if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is primitives */ + if (DEPTH <= MkIntTerm(1)) { /* I assume Module==0 is primitives */ if (pe->ModuleOfPred) { if (DEPTH == MkIntTerm(0)) - return false; - else DEPTH = RESET_DEPTH(); + return false; + else + DEPTH = RESET_DEPTH(); } } else if (pe->ModuleOfPred) { DEPTH -= MkIntConstant(2); } -#endif /* DEPTH_LIMIT */ +#endif /* DEPTH_LIMIT */ return true; } -static int -interrupt_handlerc( PredEntry *pe USES_REGS ) -{ +static int interrupt_handlerc(PredEntry *pe USES_REGS) { /* do creep in call */ ENV = YENV; CP = NEXTOP(P, Osbpp); - YENV = (CELL *) (((char *) YENV) + P->y_u.Osbpp.s); + YENV = (CELL *)(((char *)YENV) + P->y_u.Osbpp.s); #ifdef FROZEN_STACKS { choiceptr top_b = PROTECT_FROZEN_B(B); #ifdef YAPOR_SBA - if (YENV > (CELL *) top_b || YENV < HR) YENV = (CELL *) top_b; + if (YENV > (CELL *)top_b || YENV < HR) + YENV = (CELL *)top_b; #else - if (YENV > (CELL *) top_b) YENV = (CELL *) top_b; + if (YENV > (CELL *)top_b) + YENV = (CELL *)top_b; #endif /* YAPOR_SBA */ - else YENV = YENV + ENV_Size(CP); + else + YENV = YENV + ENV_Size(CP); } #else - if (YENV > (CELL *) B) - YENV = (CELL *) B; + if (YENV > (CELL *)B) + YENV = (CELL *)B; else /* I am not sure about this */ YENV = YENV + ENV_Size(CP); #endif /* FROZEN_STACKS */ /* setup GB */ - YENV[E_CB] = (CELL) B; - return interrupt_handler( pe PASS_REGS ); + YENV[E_CB] = (CELL)B; + return interrupt_handler(pe PASS_REGS); } -static int -interrupt_handler_either( Term t_cut, PredEntry *pe USES_REGS ) -{ - int rc; +static int interrupt_handler_either(Term t_cut, PredEntry *pe USES_REGS) { + int rc; - ARG1 = push_live_regs(NEXTOP(P, Osbpp)); + ARG1 = push_live_regs(NEXTOP(P, Osbpp)); #ifdef FROZEN_STACKS { choiceptr top_b = PROTECT_FROZEN_B(B); - // protect registers before we mess about. - // recompute YENV and get ASP +// protect registers before we mess about. +// recompute YENV and get ASP #ifdef YAPOR_SBA - if (YENV > (CELL *) top_b || YENV < HR) YENV = (CELL *) top_b; + if (YENV > (CELL *)top_b || YENV < HR) + YENV = (CELL *)top_b; #else - if (YENV > (CELL *) top_b) YENV = (CELL *) top_b; + if (YENV > (CELL *)top_b) + YENV = (CELL *)top_b; #endif /* YAPOR_SBA */ - else YENV = YENV + ENV_Size(CP); + else + YENV = YENV + ENV_Size(CP); } #else - if (YENV > (CELL *) B) - YENV = (CELL *) B; + if (YENV > (CELL *)B) + YENV = (CELL *)B; #endif /* FROZEN_STACKS */ P = NEXTOP(P, Osbpp); // should we cut? If t_cut == INT(0) no ARG2 = t_cut; // ASP - SET_ASP(YENV, E_CB*sizeof(CELL)); - // do the work. - rc = safe_interrupt_handler( pe PASS_REGS ); + SET_ASP(YENV, E_CB * sizeof(CELL)); + // do the work. + rc = safe_interrupt_handler(pe PASS_REGS); return rc; } @@ -953,339 +459,347 @@ interrupt_handler_either( Term t_cut, PredEntry *pe USES_REGS ) static int trace_interrupts = true; #endif -static int -interrupt_fail( USES_REGS1 ) -{ +static int interrupt_fail(USES_REGS1) { #ifdef DEBUG_INTERRUPTS - if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \ - __FUNCTION__, __LINE__,YENV,ENV,ASP); + if (trace_interrupts) + fprintf(stderr, "[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", + worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, + __FUNCTION__, __LINE__, YENV, ENV, ASP); #endif - check_alarm_fail_int( false PASS_REGS ); + check_alarm_fail_int(false PASS_REGS); /* don't do debugging and stack expansion here: space will be recovered. automatically by fail, so better wait. */ - if (Yap_has_signal( YAP_CREEP_SIGNAL ) ) { + if (Yap_has_signal(YAP_CREEP_SIGNAL)) { return false; } - if (Yap_has_signal( YAP_CDOVF_SIGNAL ) ) { + if (Yap_has_signal(YAP_CDOVF_SIGNAL)) { return false; } /* make sure we have the correct environment for continuation */ ENV = B->cp_env; - YENV = (CELL *)B; - return interrupt_handler( RepPredProp(Yap_GetPredPropByAtom(AtomFail,0)) PASS_REGS ); + YENV = (CELL *)B; + return interrupt_handler(RepPredProp(Yap_GetPredPropByAtom(AtomFail, 0)) + PASS_REGS); } -static int -interrupt_execute( USES_REGS1 ) -{ +static int interrupt_execute(USES_REGS1) { int v; #ifdef DEBUG_INTERRUPTS - if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \ - __FUNCTION__, __LINE__,YENV,ENV,ASP); + if (trace_interrupts) + fprintf(stderr, "[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id, + LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, __FUNCTION__, + __LINE__, YENV, ENV, ASP); #endif - if ((v = check_alarm_fail_int( true PASS_REGS )) >= 0) { + if ((v = check_alarm_fail_int(true PASS_REGS)) >= 0) { return v; } - if (PP) UNLOCKPE(1,PP); - PP = P->y_u.pp.p0; - if ((P->y_u.pp.p->PredFlags & (NoTracePredFlag|HiddenPredFlag)) && Yap_only_has_signal(YAP_CREEP_SIGNAL)) { + if (PP) + UNLOCKPE(1, PP); + PP = P->y_u.pp.p0; + if ((P->y_u.pp.p->PredFlags & (NoTracePredFlag | HiddenPredFlag)) && + Yap_only_has_signal(YAP_CREEP_SIGNAL)) { return 2; } - SET_ASP(YENV, E_CB*sizeof(CELL)); + SET_ASP(YENV, E_CB * sizeof(CELL)); if ((v = code_overflow(YENV PASS_REGS)) >= 0) { return v; } - if ((v = stack_overflow(P->y_u.pp.p, ENV, CP, P->y_u.pp.p->ArityOfPE PASS_REGS )) >= 0) { + if ((v = stack_overflow(P->y_u.pp.p, ENV, CP, + P->y_u.pp.p->ArityOfPE PASS_REGS)) >= 0) { return v; } - return interrupt_handler( P->y_u.pp.p PASS_REGS ); + return interrupt_handler(P->y_u.pp.p PASS_REGS); } -static int -interrupt_call( USES_REGS1 ) -{ +static int interrupt_call(USES_REGS1) { int v; #ifdef DEBUG_INTERRUPTS - if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \ - __FUNCTION__, __LINE__,YENV,ENV,ASP); + if (trace_interrupts) + fprintf(stderr, "[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", + worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, + __FUNCTION__, __LINE__, YENV, ENV, ASP); #endif - if ((v = check_alarm_fail_int( true PASS_REGS )) >= 0) { + if ((v = check_alarm_fail_int(true PASS_REGS)) >= 0) { return v; } - if (PP) UNLOCKPE(1,PP); + if (PP) + UNLOCKPE(1, PP); PP = P->y_u.Osbpp.p0; if (Yap_only_has_signal(YAP_CREEP_SIGNAL) && - (P->y_u.Osbpp.p->PredFlags & (NoTracePredFlag|HiddenPredFlag)) ) { + (P->y_u.Osbpp.p->PredFlags & (NoTracePredFlag | HiddenPredFlag))) { return 2; } SET_ASP(YENV, P->y_u.Osbpp.s); if ((v = code_overflow(YENV PASS_REGS)) >= 0) { return v; } - if ((v = stack_overflow( P->y_u.Osbpp.p, YENV, NEXTOP(P, Osbpp), P->y_u.Osbpp.p->ArityOfPE PASS_REGS )) >= 0) { + if ((v = stack_overflow(P->y_u.Osbpp.p, YENV, NEXTOP(P, Osbpp), + P->y_u.Osbpp.p->ArityOfPE PASS_REGS)) >= 0) { return v; } - return interrupt_handlerc( P->y_u.Osbpp.p PASS_REGS ); + return interrupt_handlerc(P->y_u.Osbpp.p PASS_REGS); } -static int -interrupt_pexecute( PredEntry *pen USES_REGS ) -{ +static int interrupt_pexecute(PredEntry *pen USES_REGS) { int v; #ifdef DEBUG_INTERRUPTS - if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \ - __FUNCTION__, __LINE__,YENV,ENV,ASP); + if (trace_interrupts) + fprintf(stderr, "[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", + worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, + __FUNCTION__, __LINE__, YENV, ENV, ASP); #endif - if ((v = check_alarm_fail_int( 2 PASS_REGS )) >= 0) { + if ((v = check_alarm_fail_int(2 PASS_REGS)) >= 0) { return v; } - if (PP) UNLOCKPE(1,PP); + if (PP) + UNLOCKPE(1, PP); PP = NULL; if (Yap_only_has_signal(YAP_CREEP_SIGNAL)) { return 2; /* keep on creeping */ } - SET_ASP(YENV, E_CB*sizeof(CELL)); + SET_ASP(YENV, E_CB * sizeof(CELL)); /* setup GB */ - YENV[E_CB] = (CELL) B; + YENV[E_CB] = (CELL)B; if ((v = code_overflow(YENV PASS_REGS)) >= 0) { return v; } - if ((v = stack_overflow( pen, ENV, NEXTOP(P, Osbmp), pen->ArityOfPE PASS_REGS )) >= 0) { - return v; + if ((v = stack_overflow(pen, ENV, NEXTOP(P, Osbmp), + pen->ArityOfPE PASS_REGS)) >= 0) { + return v; } CP = NEXTOP(P, Osbmp); - return interrupt_handler( pen PASS_REGS ); + return interrupt_handler(pen PASS_REGS); } -static void -execute_dealloc( USES_REGS1 ) -{ - /* other instructions do depend on S being set by deallocate - */ +static void execute_dealloc(USES_REGS1) { + /* other instructions do depend on S being set by deallocate + */ CELL *ENVYREG = YENV; S = ENVYREG; - CP = (yamop *) ENVYREG[E_CP]; - ENV = ENVYREG = (CELL *) ENVYREG[E_E]; + CP = (yamop *)ENVYREG[E_CP]; + ENV = ENVYREG = (CELL *)ENVYREG[E_E]; #ifdef DEPTH_LIMIT DEPTH = ENVYREG[E_DEPTH]; -#endif /* DEPTH_LIMIT */ +#endif /* DEPTH_LIMIT */ #ifdef FROZEN_STACKS { choiceptr top_b = PROTECT_FROZEN_B(B); #ifdef YAPOR_SBA - if (ENVYREG > (CELL *) top_b || ENVYREG < HR) ENVYREG = (CELL *) top_b; + if (ENVYREG > (CELL *)top_b || ENVYREG < HR) + ENVYREG = (CELL *)top_b; #else - if (ENVYREG > (CELL *) top_b) ENVYREG = (CELL *) top_b; + if (ENVYREG > (CELL *)top_b) + ENVYREG = (CELL *)top_b; #endif /* YAPOR_SBA */ - else ENVYREG = (CELL *)((CELL) ENVYREG + ENV_Size(CP)); + else + ENVYREG = (CELL *)((CELL)ENVYREG + ENV_Size(CP)); } #else - if (ENVYREG > (CELL *) B) - ENVYREG = (CELL *) B; - else - ENV_YREG = (CELL *) ((CELL) ENV_YREG + ENV_Size(CP)); + if (ENVYREG > (CELL *)B) + ENVYREG = (CELL *)B; + else + ENV_YREG = (CELL *)((CELL)ENV_YREG + ENV_Size(CP)); #endif /* FROZEN_STACKS */ YENV = ENVYREG; - P = NEXTOP(P,p); - + P = NEXTOP(P, p); } - /* don't forget I cannot creep at deallocate (where to?) */ - /* also, this is unusual in that I have already done deallocate, - so I don't need to redo it. - */ -static int -interrupt_deallocate( USES_REGS1 ) -{ +/* don't forget I cannot creep at deallocate (where to?) */ +/* also, this is unusual in that I have already done deallocate, + so I don't need to redo it. + */ +static int interrupt_deallocate(USES_REGS1) { int v; #ifdef DEBUG_INTERRUPTS - if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s:%d (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \ - __FUNCTION__, __LINE__,YENV,ENV,ASP); + if (trace_interrupts) + fprintf(stderr, "[%d] %lu--%lu %s:%d (YENV=%p ENV=%p ASP=%p)\n", worker_id, + LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, __FUNCTION__, + __LINE__, YENV, ENV, ASP); #endif - if ((v = check_alarm_fail_int( true PASS_REGS )) >= 0) { + if ((v = check_alarm_fail_int(true PASS_REGS)) >= 0) { return v; } /* don't do a creep here; also, if our instruction is followed by a execute_c, just wait a bit more */ - if ( Yap_only_has_signal( YAP_CREEP_SIGNAL ) || - /* keep on going if there is something else */ - (P->opc != Yap_opcode(_procceed) && - P->opc != Yap_opcode(_cut_e))) { - execute_dealloc( PASS_REGS1 ); + if (Yap_only_has_signal(YAP_CREEP_SIGNAL) || + /* keep on going if there is something else */ + (P->opc != Yap_opcode(_procceed) && P->opc != Yap_opcode(_cut_e))) { + execute_dealloc(PASS_REGS1); return 1; } else { - CELL cut_b = LCL0-(CELL *)(S[E_CB]); + CELL cut_b = LCL0 - (CELL *)(S[E_CB]); - if (PP) UNLOCKPE(1,PP); - PP = PREVOP(P,p)->y_u.p.p; - ASP = YENV+E_CB; + if (PP) + UNLOCKPE(1, PP); + PP = PREVOP(P, p)->y_u.p.p; + ASP = YENV + E_CB; /* cut_e */ - SET_ASP(YENV, E_CB*sizeof(CELL)); + SET_ASP(YENV, E_CB * sizeof(CELL)); if ((v = code_overflow(YENV PASS_REGS)) >= 0) { return v; } if (Yap_has_a_signal()) { - PredEntry *pe; + PredEntry *pe; if (Yap_op_from_opcode(P->opc) == _cut_e) { - /* followed by a cut */ - ARG1 = MkIntegerTerm(LCL0-(CELL *)S[E_CB]); - pe = RepPredProp(Yap_GetPredPropByFunc(FunctorCutBy,1)); + /* followed by a cut */ + ARG1 = MkIntegerTerm(LCL0 - (CELL *)S[E_CB]); + pe = RepPredProp(Yap_GetPredPropByFunc(FunctorCutBy, 1)); } else { - pe = RepPredProp(Yap_GetPredPropByAtom(AtomTrue,0)); + pe = RepPredProp(Yap_GetPredPropByAtom(AtomTrue, 0)); } - return interrupt_handler( pe PASS_REGS ); + return interrupt_handler(pe PASS_REGS); } if (!Yap_locked_gc(0, ENV, YESCODE)) { - Yap_NilError(RESOURCE_ERROR_STACK,LOCAL_ErrorMessage); + Yap_NilError(RESOURCE_ERROR_STACK, LOCAL_ErrorMessage); } S = ASP; - S[E_CB] = (CELL)(LCL0-cut_b); + S[E_CB] = (CELL)(LCL0 - cut_b); } return 1; } -static int -interrupt_cut( USES_REGS1 ) -{ - Term t_cut = MkIntegerTerm(LCL0-(CELL *)YENV[E_CB]); +static int interrupt_cut(USES_REGS1) { + Term t_cut = MkIntegerTerm(LCL0 - (CELL *)YENV[E_CB]); int v; #ifdef DEBUG_INTERRUPTS - if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s:%d (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \ - __FUNCTION__, __LINE__,YENV,ENV,ASP); + if (trace_interrupts) + fprintf(stderr, "[%d] %lu--%lu %s:%d (YENV=%p ENV=%p ASP=%p)\n", worker_id, + LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, __FUNCTION__, + __LINE__, YENV, ENV, ASP); #endif - if ((v = check_alarm_fail_int( 2 PASS_REGS )) >= 0) { + if ((v = check_alarm_fail_int(2 PASS_REGS)) >= 0) { return v; } - if (!Yap_has_a_signal() - || Yap_only_has_signals(YAP_CDOVF_SIGNAL , YAP_CREEP_SIGNAL )) { + if (!Yap_has_a_signal() || + Yap_only_has_signals(YAP_CDOVF_SIGNAL, YAP_CREEP_SIGNAL)) { return 2; } /* find something to fool S */ - P = NEXTOP(P,s); - return interrupt_handler_either( t_cut, PredRestoreRegs PASS_REGS ); + P = NEXTOP(P, s); + return interrupt_handler_either(t_cut, PredRestoreRegs PASS_REGS); } -static int -interrupt_cut_t( USES_REGS1 ) -{ - Term t_cut = MkIntegerTerm(LCL0-(CELL *)YENV[E_CB]); +static int interrupt_cut_t(USES_REGS1) { + Term t_cut = MkIntegerTerm(LCL0 - (CELL *)YENV[E_CB]); int v; #ifdef DEBUG_INTERRUPTS - if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \ - __FUNCTION__, __LINE__,YENV,ENV,ASP); + if (trace_interrupts) + fprintf(stderr, "[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id, + LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, __FUNCTION__, + __LINE__, YENV, ENV, ASP); #endif - if ((v = check_alarm_fail_int( 2 PASS_REGS )) >= 0) { + if ((v = check_alarm_fail_int(2 PASS_REGS)) >= 0) { return v; } - if (!Yap_has_a_signal() - || Yap_only_has_signals(YAP_CDOVF_SIGNAL , YAP_CREEP_SIGNAL )) { + if (!Yap_has_a_signal() || + Yap_only_has_signals(YAP_CDOVF_SIGNAL, YAP_CREEP_SIGNAL)) { return 2; } /* find something to fool S */ - P = NEXTOP(P,s); - return interrupt_handler_either( t_cut, PredRestoreRegs PASS_REGS ); + P = NEXTOP(P, s); + return interrupt_handler_either(t_cut, PredRestoreRegs PASS_REGS); } -static int -interrupt_cut_e( USES_REGS1 ) -{ - Term t_cut = MkIntegerTerm(LCL0-(CELL *)S[E_CB]); +static int interrupt_cut_e(USES_REGS1) { + Term t_cut = MkIntegerTerm(LCL0 - (CELL *)S[E_CB]); int v; #ifdef DEBUG_INTERRUPTS - if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \ - __FUNCTION__, __LINE__,YENV,ENV,ASP); + if (trace_interrupts) + fprintf(stderr, "[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id, + LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, __FUNCTION__, + __LINE__, YENV, ENV, ASP); #endif - if ((v = check_alarm_fail_int( 2 PASS_REGS )) >= 0) { + if ((v = check_alarm_fail_int(2 PASS_REGS)) >= 0) { return v; } - if (!Yap_only_has_signals(YAP_CDOVF_SIGNAL , YAP_CREEP_SIGNAL )) { + if (!Yap_only_has_signals(YAP_CDOVF_SIGNAL, YAP_CREEP_SIGNAL)) { return 2; } /* find something to fool S */ - P = NEXTOP(P,s); - return interrupt_handler_either( t_cut, PredRestoreRegs PASS_REGS ); + P = NEXTOP(P, s); + return interrupt_handler_either(t_cut, PredRestoreRegs PASS_REGS); } -static int -interrupt_commit_y( USES_REGS1 ) -{ +static int interrupt_commit_y(USES_REGS1) { int v; Term t_cut = YENV[P->y_u.yps.y]; - #ifdef DEBUG_INTERRUPTS - if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \ - __FUNCTION__, __LINE__,YENV,ENV,ASP); +#ifdef DEBUG_INTERRUPTS + if (trace_interrupts) + fprintf(stderr, "[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id, + LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, __FUNCTION__, + __LINE__, YENV, ENV, ASP); #endif - if ((v = check_alarm_fail_int( 2 PASS_REGS )) >= 0) { + if ((v = check_alarm_fail_int(2 PASS_REGS)) >= 0) { return v; } - if (!Yap_has_a_signal() - || Yap_only_has_signals(YAP_CDOVF_SIGNAL , YAP_CREEP_SIGNAL )) { + if (!Yap_has_a_signal() || + Yap_only_has_signals(YAP_CDOVF_SIGNAL, YAP_CREEP_SIGNAL)) { return 2; } /* find something to fool S */ - P = NEXTOP(P,yps); - return interrupt_handler_either( t_cut, PredRestoreRegs PASS_REGS ); + P = NEXTOP(P, yps); + return interrupt_handler_either(t_cut, PredRestoreRegs PASS_REGS); } -static int -interrupt_commit_x( USES_REGS1 ) -{ +static int interrupt_commit_x(USES_REGS1) { int v; Term t_cut = XREG(P->y_u.xps.x); - #ifdef DEBUG_INTERRUPTS - if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s:%d (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \ - __FUNCTION__, __LINE__,YENV,ENV,ASP); +#ifdef DEBUG_INTERRUPTS + if (trace_interrupts) + fprintf(stderr, "[%d] %lu--%lu %s:%d (YENV=%p ENV=%p ASP=%p)\n", worker_id, + LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, __FUNCTION__, + __LINE__, YENV, ENV, ASP); #endif - if ((v = check_alarm_fail_int( 2 PASS_REGS )) >= 0) { + if ((v = check_alarm_fail_int(2 PASS_REGS)) >= 0) { return v; } - if (Yap_only_has_signals(YAP_CDOVF_SIGNAL , YAP_CREEP_SIGNAL )) { + if (Yap_only_has_signals(YAP_CDOVF_SIGNAL, YAP_CREEP_SIGNAL)) { return 2; } - if (PP) UNLOCKPE(1,PP); + if (PP) + UNLOCKPE(1, PP); PP = P->y_u.xps.p0; /* find something to fool S */ if (P->opc == Yap_opcode(_fcall)) { /* fill it up */ CACHE_Y_AS_ENV(YREG); - ENV_YREG[E_CP] = (CELL) CP; - ENV_YREG[E_E] = (CELL) ENV; + ENV_YREG[E_CP] = (CELL)CP; + ENV_YREG[E_E] = (CELL)ENV; #ifdef DEPTH_LIMIT ENV_YREG[E_DEPTH] = DEPTH; -#endif /* DEPTH_LIMIT */ +#endif /* DEPTH_LIMIT */ ENDCACHE_Y_AS_ENV(); } - P = NEXTOP(P,xps); - return interrupt_handler_either( t_cut, PredRestoreRegs PASS_REGS ); + P = NEXTOP(P, xps); + return interrupt_handler_either(t_cut, PredRestoreRegs PASS_REGS); } -static int -interrupt_either( USES_REGS1 ) -{ +static int interrupt_either(USES_REGS1) { int v; #ifdef DEBUGX - //if (trace_interrupts) - fprintf(stderr,"[%d] %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id, \ - __FUNCTION__, __LINE__,YENV,ENV,ASP); + // if (trace_interrupts) + fprintf(stderr, "[%d] %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id, + __FUNCTION__, __LINE__, YENV, ENV, ASP); #endif - if ((v = check_alarm_fail_int( 2 PASS_REGS )) >= 0) { + if ((v = check_alarm_fail_int(2 PASS_REGS)) >= 0) { return v; } if (Yap_only_has_signal(YAP_CREEP_SIGNAL)) { return 2; } - if (PP) UNLOCKPE(1,PP); + if (PP) + UNLOCKPE(1, PP); PP = P->y_u.Osblp.p0; /* find something to fool S */ SET_ASP(YENV, P->y_u.Osbpp.s); @@ -1294,108 +808,114 @@ interrupt_either( USES_REGS1 ) if ((v = code_overflow(YENV PASS_REGS)) >= 0) { return v; } - //P = NEXTOP(P, Osblp); - if ((v = stack_overflow(RepPredProp(Yap_GetPredPropByFunc(FunctorRestoreRegs1,0)), YENV, NEXTOP(P,Osblp), 0 PASS_REGS )) >= 0) { - //P = PREVOP(P, Osblp); + // P = NEXTOP(P, Osblp); + if ((v = stack_overflow( + RepPredProp(Yap_GetPredPropByFunc(FunctorRestoreRegs1, 0)), YENV, + NEXTOP(P, Osblp), 0 PASS_REGS)) >= 0) { + // P = PREVOP(P, Osblp); return v; } // P = PREVOP(P, Osblp); - return interrupt_handler_either( MkIntTerm(0), RepPredProp(Yap_GetPredPropByFunc(FunctorRestoreRegs1,0)) PASS_REGS ); + return interrupt_handler_either( + MkIntTerm(0), + RepPredProp(Yap_GetPredPropByFunc(FunctorRestoreRegs1, 0)) PASS_REGS); } -static int -interrupt_dexecute( USES_REGS1 ) -{ +static int interrupt_dexecute(USES_REGS1) { int v; PredEntry *pe; #ifdef DEBUG_INTERRUPTS - if (trace_interrupts) fprintf(stderr,"[%d] %lu--%lu %s/%d (YENV=%p ENV=%p ASP=%p)\n", worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, \ - __FUNCTION__, __LINE__,YENV,ENV,ASP); + if (trace_interrupts) + fprintf(stderr, "[%d] %lu--%lu %s/%d (YENV=%p ENV=%p ASP=%p)\n", worker_id, + LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, __FUNCTION__, + __LINE__, YENV, ENV, ASP); #endif - if (PP) UNLOCKPE(1,PP); + if (PP) + UNLOCKPE(1, PP); PP = P->y_u.pp.p0; pe = P->y_u.pp.p; - if ((pe->PredFlags & (NoTracePredFlag|HiddenPredFlag)) && Yap_only_has_signal(YAP_CREEP_SIGNAL)) { + if ((pe->PredFlags & (NoTracePredFlag | HiddenPredFlag)) && + Yap_only_has_signal(YAP_CREEP_SIGNAL)) { return 2; } /* set S for next instructions */ - ASP = YENV+E_CB; + ASP = YENV + E_CB; if (ASP > (CELL *)PROTECT_FROZEN_B(B)) ASP = (CELL *)PROTECT_FROZEN_B(B); if ((v = code_overflow(YENV PASS_REGS)) >= 0) { return v; } - if ((v = stack_overflow( P->y_u.pp.p, (CELL *)YENV[E_E], (yamop *)YENV[E_CP], P->y_u.pp.p->ArityOfPE PASS_REGS )) >= 0) { - return v; + if ((v = stack_overflow(P->y_u.pp.p, (CELL *)YENV[E_E], (yamop *)YENV[E_CP], + P->y_u.pp.p->ArityOfPE PASS_REGS)) >= 0) { + return v; } -/* first, deallocate */ - CP = (yamop *) YENV[E_CP]; - ENV = YENV = (CELL *) YENV[E_E]; + /* first, deallocate */ + CP = (yamop *)YENV[E_CP]; + ENV = YENV = (CELL *)YENV[E_E]; #ifdef DEPTH_LIMIT YENV[E_DEPTH] = DEPTH; -#endif /* DEPTH_LIMIT */ +#endif /* DEPTH_LIMIT */ #ifdef FROZEN_STACKS { choiceptr top_b = PROTECT_FROZEN_B(B); #ifdef YAPOR_SBA - if (YENV > (CELL *) top_b || YENV < HR) YENV = (CELL *) top_b; + if (YENV > (CELL *)top_b || YENV < HR) + YENV = (CELL *)top_b; #else - if (YENV > (CELL *) top_b) YENV = (CELL *) top_b; + if (YENV > (CELL *)top_b) + YENV = (CELL *)top_b; #endif /* YAPOR_SBA */ - else YENV = (CELL *) ((CELL)YENV + ENV_Size(CPREG)); + else + YENV = (CELL *)((CELL)YENV + ENV_Size(CPREG)); } #else - if (YENV > (CELL *) B) { - YENV = (CELL *) B; - } - else { - YENV = (CELL *) ((CELL) YENV + ENV_Size(CPREG)); + if (YENV > (CELL *)B) { + YENV = (CELL *)B; + } else { + YENV = (CELL *)((CELL)YENV + ENV_Size(CPREG)); } #endif /* FROZEN_STACKS */ /* setup GB */ - YENV[E_CB] = (CELL) B; + YENV[E_CB] = (CELL)B; /* and now CREEP */ - return interrupt_handler( pe PASS_REGS ); + return interrupt_handler(pe PASS_REGS); } -static void -undef_goal( USES_REGS1 ) -{ +static void undef_goal(USES_REGS1) { PredEntry *pe = PredFromDefCode(P); if (Yap_UnknownFlag(CurrentModule) == TermFail) { P = FAILCODE; return; } BEGD(d0); - /* avoid trouble with undefined dynamic procedures */ - /* I assume they were not locked beforehand */ +/* avoid trouble with undefined dynamic procedures */ +/* I assume they were not locked beforehand */ #if defined(YAPOR) || defined(THREADS) if (!PP) { - PELOCK(19,pe); + PELOCK(19, pe); PP = pe; } #endif - if (pe->PredFlags & (DynamicPredFlag|LogUpdatePredFlag|MultiFileFlag)) { + if (pe->PredFlags & (DynamicPredFlag | LogUpdatePredFlag | MultiFileFlag)) { #if defined(YAPOR) || defined(THREADS) - UNLOCKPE(19,PP); + UNLOCKPE(19, PP); PP = NULL; #endif P = FAILCODE; return; } #if defined(YAPOR) || defined(THREADS) - UNLOCKPE(19,PP); + UNLOCKPE(19, PP); PP = NULL; #endif d0 = pe->ArityOfPE; if (d0 == 0) { HR[1] = MkAtomTerm((Atom)(pe->FunctorOfPred)); - } - else { + } else { HR[d0 + 2] = AbsAppl(HR); - *HR = (CELL) pe->FunctorOfPred; + *HR = (CELL)pe->FunctorOfPred; HR++; BEGP(pt1); pt1 = XREGS + 1; @@ -1412,14 +932,14 @@ undef_goal( USES_REGS1 ) derefa_body(d1, pt0, undef_unk, undef_nonvar); if (pt0 <= HR) { - /* variable is safe */ - *HR++ = (CELL)pt0; + /* variable is safe */ + *HR++ = (CELL)pt0; } else { - /* bind it, in case it is a local variable */ - d1 = Unsigned(HR); - RESET_VARIABLE(HR); - HR += 1; - Bind_Local(pt0, d1); + /* bind it, in case it is a local variable */ + d1 = Unsigned(HR); + RESET_VARIABLE(HR); + HR += 1; + Bind_Local(pt0, d1); } ENDP(pt0); ENDD(d1); @@ -1428,40 +948,36 @@ undef_goal( USES_REGS1 ) } ENDD(d0); HR[0] = Yap_Module_Name(pe); - ARG1 = (Term) AbsPair(HR); + ARG1 = (Term)AbsPair(HR); ARG2 = Yap_getUnknownModule(Yap_GetModuleEntry(HR[0])); HR += 2; #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) - low_level_trace(enter_pred,UndefCode,XREGS+1); -#endif /* LOW_LEVEL_TRACE */ + low_level_trace(enter_pred, UndefCode, XREGS + 1); +#endif /* LOW_LEVEL_TRACE */ P = UndefCode->CodeOfPred; } - -static void -spy_goal( USES_REGS1 ) -{ +static void spy_goal(USES_REGS1) { PredEntry *pe = PredFromDefCode(P); #if defined(YAPOR) || defined(THREADS) if (!PP) { - PELOCK(14,pe); + PELOCK(14, pe); PP = pe; } #endif BEGD(d0); - if (!(pe->PredFlags & IndexedPredFlag) && - pe->cs.p_code.NOfClauses > 1) { + if (!(pe->PredFlags & IndexedPredFlag) && pe->cs.p_code.NOfClauses > 1) { /* update ASP before calling IPred */ - SET_ASP(YREG, E_CB*sizeof(CELL)); + SET_ASP(YREG, E_CB * sizeof(CELL)); Yap_IPred(pe, 0, CP); /* IPred can generate errors, it thus must get rid of the lock itself */ if (P == FAILCODE) { #if defined(YAPOR) || defined(THREADS) - if (PP && !(PP->PredFlags & LogUpdatePredFlag)){ - UNLOCKPE(20,pe); - PP = NULL; + if (PP && !(PP->PredFlags & LogUpdatePredFlag)) { + UNLOCKPE(20, pe); + PP = NULL; } #endif return; @@ -1476,30 +992,30 @@ spy_goal( USES_REGS1 ) if (LOCAL_ReductionsCounter == 0 && LOCAL_ReductionsCounterOn) { #if defined(YAPOR) || defined(THREADS) if (PP) { - UNLOCKPE(20,pe); - PP = NULL; + UNLOCKPE(20, pe); + PP = NULL; } #endif - Yap_NilError(CALL_COUNTER_UNDERFLOW_EVENT,""); + Yap_NilError(CALL_COUNTER_UNDERFLOW_EVENT, ""); return; } LOCAL_PredEntriesCounter--; if (LOCAL_PredEntriesCounter == 0 && LOCAL_PredEntriesCounterOn) { #if defined(YAPOR) || defined(THREADS) if (PP) { - UNLOCKPE(21,pe); - PP = NULL; + UNLOCKPE(21, pe); + PP = NULL; } #endif - Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT,""); + Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT, ""); return; } - if ((pe->PredFlags & (CountPredFlag|ProfiledPredFlag|SpiedPredFlag)) == - CountPredFlag) { + if ((pe->PredFlags & (CountPredFlag | ProfiledPredFlag | SpiedPredFlag)) == + CountPredFlag) { #if defined(YAPOR) || defined(THREADS) if (PP) { - UNLOCKPE(22,pe); - PP = NULL; + UNLOCKPE(22, pe); + PP = NULL; } #endif P = pe->cs.p_code.TrueCodeOfPred; @@ -1515,8 +1031,8 @@ spy_goal( USES_REGS1 ) P = pe->cs.p_code.TrueCodeOfPred; #if defined(YAPOR) || defined(THREADS) if (PP) { - UNLOCKPE(23,pe); - PP = NULL; + UNLOCKPE(23, pe); + PP = NULL; } #endif return; @@ -1524,7 +1040,7 @@ spy_goal( USES_REGS1 ) } #if defined(YAPOR) || defined(THREADS) if (PP) { - UNLOCKPE(25,pe); + UNLOCKPE(25, pe); PP = NULL; } #endif @@ -1534,7 +1050,7 @@ spy_goal( USES_REGS1 ) if (d0 == 0) { HR[1] = MkAtomTerm((Atom)(pe->FunctorOfPred)); } else { - *HR = (CELL) pe->FunctorOfPred; + *HR = (CELL)pe->FunctorOfPred; HR[d0 + 2] = AbsAppl(HR); HR++; BEGP(pt1); @@ -1552,14 +1068,14 @@ spy_goal( USES_REGS1 ) derefa_body(d1, pt0, dospy_unk, dospy_nonvar); if (pt0 <= HR) { - /* variable is safe */ - *HR++ = (CELL)pt0; + /* variable is safe */ + *HR++ = (CELL)pt0; } else { - /* bind it, in case it is a local variable */ - d1 = Unsigned(HR); - RESET_VARIABLE(HR); - HR += 1; - Bind_Local(pt0, d1); + /* bind it, in case it is a local variable */ + d1 = Unsigned(HR); + RESET_VARIABLE(HR); + HR += 1; + Bind_Local(pt0, d1); } ENDP(pt0); ENDD(d1); @@ -1569,7 +1085,7 @@ spy_goal( USES_REGS1 ) ENDD(d0); HR[0] = Yap_Module_Name(pe); - ARG1 = (Term) AbsPair(HR); + ARG1 = (Term)AbsPair(HR); HR += 2; { PredEntry *pt0; @@ -1579,25 +1095,23 @@ spy_goal( USES_REGS1 ) pt0 = SpyCode; P_before_spy = P; P = pt0->CodeOfPred; - /* for profiler */ +/* for profiler */ #if THREADS UNLOCK(GLOBAL_ThreadHandlesLock); #endif #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) - low_level_trace(enter_pred,pt0,XREGS+1); -#endif /* LOW_LEVEL_TRACE */ + low_level_trace(enter_pred, pt0, XREGS + 1); +#endif /* LOW_LEVEL_TRACE */ } } -Int -Yap_absmi(int inp) -{ +Int Yap_absmi(int inp) { CACHE_REGS #if BP_FREE /* some function might be using bp for an internal variable, it is the callee's responsability to save it */ - yamop* PCBACKUP = P1REG; + yamop *PCBACKUP = P1REG; #endif #ifdef LONG_LIVED_REGISTERS @@ -1628,18 +1142,22 @@ Yap_absmi(int inp) #define SREG S #endif /* SHADOW_S */ - /* The indexing register so that we will not destroy ARG1 without - * reason */ +/* The indexing register so that we will not destroy ARG1 without + * reason */ #define I_R (XREGS[0]) #if YAP_JIT - Yap_ExpEnvP = & Yap_ExpEnv; - static void *control_labels[] = { &&fail, &&NoStackCut, &&NoStackCommitY, &&NoStackCutT, &&NoStackEither, &&NoStackExecute, &&NoStackCall, &&NoStackDExecute, &&NoStackDeallocate, &¬railleft, &&NoStackFail, &&NoStackCommitX }; + Yap_ExpEnvP = &Yap_ExpEnv; + static void *control_labels[] = { + &&fail, &&NoStackCut, &&NoStackCommitY, + &&NoStackCutT, &&NoStackEither, &&NoStackExecute, + &&NoStackCall, &&NoStackDExecute, &&NoStackDeallocate, + &¬railleft, &&NoStackFail, &&NoStackCommitX}; curtrace = NULL; curpreg = NULL; globalcurblock = NULL; ineedredefinedest = 0; - NativeArea = (NativeContext*)malloc(sizeof(NativeContext)); + NativeArea = (NativeContext *)malloc(sizeof(NativeContext)); NativeArea->area.p = NULL; NativeArea->area.ok = NULL; NativeArea->area.pc = NULL; @@ -1653,7 +1171,8 @@ Yap_absmi(int inp) NativeArea->t_runs = NULL; #endif NativeArea->n = 0; - IntermediatecodeArea = (IntermediatecodeContext*)malloc(sizeof(IntermediatecodeContext)); + IntermediatecodeArea = + (IntermediatecodeContext *)malloc(sizeof(IntermediatecodeContext)); IntermediatecodeArea->area.t = NULL; IntermediatecodeArea->area.ok = NULL; IntermediatecodeArea->area.isactive = NULL; @@ -1667,30 +1186,31 @@ Yap_absmi(int inp) #endif /* YAP_JIT */ #if USE_THREADED_CODE -/************************************************************************/ -/* Abstract Machine Instruction Address Table */ -/* This must be declared inside the function. We use the asm directive */ -/* to make it available outside this function */ -/************************************************************************/ - static void *OpAddress[] = - { -#define OPCODE(OP,TYPE) && _##OP + /************************************************************************/ + /* Abstract Machine Instruction Address Table */ + /* This must be declared inside the function. We use the asm directive */ + /* to make it available outside this function */ + /************************************************************************/ + static void *OpAddress[] = { +#define OPCODE(OP, TYPE) &&_##OP #include "YapOpcodes.h" -#undef OPCODE +#undef OPCODE }; #if YAP_JIT ExpEnv.config_struc.TOTAL_OF_OPCODES = - sizeof(OpAddress)/(2*sizeof(void*)); + sizeof(OpAddress) / (2 * sizeof(void *)); #endif #endif /* USE_THREADED_CODE */ - /*static void* (*nat_glist_valx)(yamop**,yamop**,CELL**,void**,int*); +/*static void* (*nat_glist_valx)(yamop**,yamop**,CELL**,void**,int*); - if (nat_glist_valx == NULL) { - nat_glist_valx = (void*(*)(yamop**,yamop**,CELL**,void**,int*))call_JIT_Compiler(J, _glist_valx); - }*/ + if (nat_glist_valx == NULL) { + nat_glist_valx = + (void*(*)(yamop**,yamop**,CELL**,void**,int*))call_JIT_Compiler(J, + _glist_valx); + }*/ #ifdef SHADOW_REGS @@ -1701,7 +1221,7 @@ Yap_absmi(int inp) #if PUSH_REGS -/* useful on a X86 with -fomit-frame-pointer optimisation */ + /* useful on a X86 with -fomit-frame-pointer optimisation */ /* The idea is to push REGS onto the X86 stack frame */ /* first allocate local space */ @@ -1711,27 +1231,25 @@ Yap_absmi(int inp) #endif /* PUSH_REGS */ #ifdef BEAM - CELL OLD_B=B; + CELL OLD_B = B; extern PredEntry *bpEntry; - if (inp==-9000) { + if (inp == -9000) { #if PUSH_REGS old_regs = &Yap_REGS; init_absmi_regs(&absmi_regs); #if THREADS - regcache = Yap_regp - LOCAL_PL_local_data_p->reg_cache = regcache; + regcache = Yap_regp LOCAL_PL_local_data_p->reg_cache = regcache; #else Yap_regp = &absmi_regs; #endif #endif CACHE_A1(); - PREG=bpEntry->CodeOfPred; - JMPNext(); /* go execute instruction at PREG */ + PREG = bpEntry->CodeOfPred; + JMPNext(); /* go execute instruction at PREG */ } #endif - #if USE_THREADED_CODE /* absmadr */ if (inp > 0) { @@ -1742,7 +1260,7 @@ Yap_absmi(int inp) #if BP_FREE P1REG = PCBACKUP; #endif - return(0); + return (0); } #endif /* USE_THREADED_CODE */ @@ -1752,12 +1270,12 @@ Yap_absmi(int inp) /* done, let us now initialize this space */ init_absmi_regs(&absmi_regs); - /* the registers are all set up, let's swap */ +/* the registers are all set up, let's swap */ #ifdef THREADS pthread_setspecific(Yap_yaamregs_key, (const void *)&absmi_regs); LOCAL_ThreadHandle.current_yaam_regs = &absmi_regs; regcache = &absmi_regs; - // LOCAL_PL_local_data_p->reg_cache = regcache; +// LOCAL_PL_local_data_p->reg_cache = regcache; #else Yap_regp = &absmi_regs; #endif @@ -1782,14 +1300,15 @@ Yap_absmi(int inp) CACHE_A1(); - reset_absmi: +reset_absmi: SP = SP0; #if USE_THREADED_CODE -//___androidlog_print(ANDROID_LOG_INFO, "YAP ", "%s", Yap_op_names[Yap_op_from_opcode(PREG->opc)]); + //___androidlog_print(ANDROID_LOG_INFO, "YAP ", "%s", + // Yap_op_names[Yap_op_from_opcode(PREG->opc)]); - JMPNext(); /* go execute instruction at P */ + JMPNext(); /* go execute instruction at P */ #else /* when we start we are not in write mode */ @@ -1821,9 +1340,9 @@ Yap_absmi(int inp) GLOBAL_2opcount[old_op][opcode]++; #ifdef DEBUG_XX ops_done++; - /* if (B->cp_b > 0x103fff90) - fprintf(stderr,"(%ld) doing %s, done %s, B is %p, HB is %p, H is %p\n", - ops_done,Yap_op_names[opcode],Yap_op_names[old_op],B,B->cp_h,HR);*/ +/* if (B->cp_b > 0x103fff90) + fprintf(stderr,"(%ld) doing %s, done %s, B is %p, HB is %p, H is %p\n", + ops_done,Yap_op_names[opcode],Yap_op_names[old_op],B,B->cp_h,HR);*/ #endif #endif /* ANALYST */ @@ -1831,35 +1350,37 @@ Yap_absmi(int inp) #endif /* USE_THREADED_CODE */ #if !OS_HANDLES_TR_OVERFLOW - notrailleft: - /* if we are within indexing code, the system may have to - * update a S */ - { - CELL cut_b; +notrailleft: + /* if we are within indexing code, the system may have to + * update a S */ + { + CELL cut_b; #ifdef SHADOW_S - S = SREG; + S = SREG; #endif - /* YREG was pointing to where we were going to build the - * next choice-point. The stack shifter will need to know this - * to move the local stack */ - SET_ASP(YREG, E_CB*sizeof(CELL)); - cut_b = LCL0-(CELL *)(ASP[E_CB]); - saveregs(); - if(!Yap_growtrail (0, false)) { - Yap_NilError(RESOURCE_ERROR_TRAIL,"YAP failed to reserve %ld bytes in growtrail",sizeof(CELL) * K16); - setregs(); - FAIL(); - } - setregs(); + /* YREG was pointing to where we were going to build the + * next choice-point. The stack shifter will need to know this + * to move the local stack */ + SET_ASP(YREG, E_CB * sizeof(CELL)); + cut_b = LCL0 - (CELL *)(ASP[E_CB]); + saveregs(); + if (!Yap_growtrail(0, false)) { + Yap_NilError(RESOURCE_ERROR_TRAIL, + "YAP failed to reserve %ld bytes in growtrail", + sizeof(CELL) * K16); + setregs(); + FAIL(); + } + setregs(); #ifdef SHADOW_S - SREG = S; + SREG = S; #endif - if (SREG == ASP) { - SREG[E_CB] = (CELL)(LCL0-cut_b); - } - } - goto reset_absmi; + if (SREG == ASP) { + SREG[E_CB] = (CELL)(LCL0 - cut_b); + } + } + goto reset_absmi; #endif /* OS_HANDLES_TR_OVERFLOW */ @@ -1867,31 +1388,28 @@ Yap_absmi(int inp) // so that they are easier to analyse. #include "absmi_insts.h" - #if !USE_THREADED_CODE - default: - saveregs(); - Yap_Error(SYSTEM_ERROR_INTERNAL, MkIntegerTerm(opcode), "trying to execute invalid YAAM instruction %d", opcode); - setregs(); - FAIL(); - } - } +default: + saveregs(); + Yap_Error(SYSTEM_ERROR_INTERNAL, MkIntegerTerm(opcode), + "trying to execute invalid YAAM instruction %d", opcode); + setregs(); + FAIL(); +} +} #else #if PUSH_REGS - restore_absmi_regs(old_regs); + restore_absmi_regs(old_regs); #endif #if BP_FREE - P1REG = PCBACKUP; + P1REG = PCBACKUP; #endif - return (0); + return (0); #endif } /* dummy function that is needed for profiler */ -int Yap_absmiEND(void) -{ - return 1; -} +int Yap_absmiEND(void) { return 1; } diff --git a/C/absmi_insts.h b/C/absmi_insts.h index 2bce8d02b..7b3f98091 100644 --- a/C/absmi_insts.h +++ b/C/absmi_insts.h @@ -8,9 +8,9 @@ { #endif /* INDENT_CODE */ - -BOp(Ystop, l); - SET_ASP(YREG, E_CB*sizeof(CELL)); + BOp(Ystop, l); + LOCAL_CBorder = 0; + SET_ASP(YREG, E_CB * sizeof(CELL)); /* make sure ASP is initialized */ saveregs(); @@ -20,11 +20,12 @@ BOp(Ystop, l); #if BP_FREE P1REG = PCBACKUP; #endif + LOCAL_CBorder = 0; return 1; ENDBOp(); BOp(Nstop, e); - SET_ASP(YREG, E_CB*sizeof(CELL)); + SET_ASP(YREG, E_CB * sizeof(CELL)); saveregs(); #if PUSH_REGS restore_absmi_regs(old_regs); @@ -32,55 +33,60 @@ BOp(Ystop, l); #if BP_FREE P1REG = PCBACKUP; #endif + if (LOCAL_Error_TYPE == THROW_EVENT) { + LOCAL_Error_TYPE = YAP_NO_ERROR; + return 1; + } return 0; ENDBOp(); - - - /************************************************************************\ - * Native Code Execution * +/************************************************************************\ + * Native Code Execution * \************************************************************************/ #if YAP_JIT - static void *OpAddress_JIT[] = - { -#define OPCODE(OP,TYPE) && _##OP + static void *OpAddress_JIT[] = { +#define OPCODE(OP, TYPE) &&_##OP #include "YapOpcodes.h" -#undef OPCODE +#undef OPCODE }; - - /* native_me */ - BOp(jit_handler, J); - if (!PREG->y_u.J.jh->fi.bcst.c) PREG->y_u.J.jh->mf.isground = IsGround(PREG); - PREG->y_u.J.jh->fi.bcst.c++; - /* Did PREG reach threshold value to become critical? */ - if (PREG->y_u.J.jh->fi.bcst.c == (COUNT)(ExpEnv.config_struc.frequency_bound*(ExpEnv.config_struc.profiling_startp)) && !PREG->y_u.J.jh->mf.isground) { + /* native_me */ + BOp(jit_handler, J); + if (!PREG->y_u.J.jh->fi.bcst.c) + PREG->y_u.J.jh->mf.isground = IsGround(PREG); + PREG->y_u.J.jh->fi.bcst.c++; + + /* Did PREG reach threshold value to become critical? */ + if (PREG->y_u.J.jh->fi.bcst.c == + (COUNT)(ExpEnv.config_struc.frequency_bound * + (ExpEnv.config_struc.profiling_startp)) && + !PREG->y_u.J.jh->mf.isground) { #if YAP_DBG_PREDS - if (ExpEnv.debug_struc.pprint_me.criticals != 0 && ExpEnv.debug_struc.pprint_me.criticals != 0x1) { - fprintf(stderr, "%s:%d\n", __FILE__, __LINE__); - fprintf(stderr, "%s", (char*)ExpEnv.debug_struc.pprint_me.criticals); - } -#endif - traced_absmi(); - + if (ExpEnv.debug_struc.pprint_me.criticals != 0 && + ExpEnv.debug_struc.pprint_me.criticals != 0x1) { + fprintf(stderr, "%s:%d\n", __FILE__, __LINE__); + fprintf(stderr, "%s", (char *)ExpEnv.debug_struc.pprint_me.criticals); } -#if YAP_DBG_PREDS - print_main_when_head(PREG, ON_INTERPRETER); #endif - PREG = NEXTOP(PREG, J); - JMPNext(); - ENDBOp(); + traced_absmi(); + } +#if YAP_DBG_PREDS + print_main_when_head(PREG, ON_INTERPRETER); +#endif + PREG = NEXTOP(PREG, J); + JMPNext(); + ENDBOp(); #endif -#include "cp_absmi_insts.h" -#include "lu_absmi_insts.h" -#include "fail_absmi_insts.h" #include "control_absmi_insts.h" -#include "unify_absmi_insts.h" +#include "cp_absmi_insts.h" +#include "fail_absmi_insts.h" #include "fli_absmi_insts.h" -#include "or_absmi_insts.h" -#include "index_absmi_insts.h" -#include "type_absmi_insts.h" -#include "prim_absmi_insts.h" -#include "meta_absmi_insts.h" +#include "index_absmi_insts.h" +#include "lu_absmi_insts.h" +#include "meta_absmi_insts.h" +#include "or_absmi_insts.h" +#include "prim_absmi_insts.h" +#include "type_absmi_insts.h" +#include "unify_absmi_insts.h" diff --git a/C/absmi_insts.i b/C/absmi_insts.i index c6a9fabc6..54e96ce02 100644 --- a/C/absmi_insts.i +++ b/C/absmi_insts.i @@ -6440,7 +6440,8 @@ #endif /* YAPOR */ CACHE_Y(YREG); /* Alocate space for the cut_c structure*/ - CUT_C_PUSH(NEXTOP(NEXTOP(PREG,OtapFs),OtapFs),S_YREG); + + (NEXTOP(NEXTOP(PREG,OtapFs),OtapFs),S_YREG); S_YREG = S_YREG - PREG->y_u.OtapFs.extra; store_args(PREG->y_u.OtapFs.s); store_yaam_regs(NEXTOP(PREG, OtapFs), 0); diff --git a/C/c_interface.c b/C/c_interface.c index 0fa349b93..2e88b05d3 100755 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -25,12 +25,12 @@ #define C_INTERFACE_C 1 -#include + #include "Yap.h" +#include "attvar.h" #include "clause.h" #include "yapio.h" -#include "Foreign.h" -#include "attvar.h" +#include #if HAVE_UNISTD_H #include #endif @@ -53,8 +53,8 @@ #ifdef YAPOR #include "or.macros.h" #endif /* YAPOR */ -#include "threads.h" #include "cut_c.h" +#include "threads.h" #if HAVE_MALLOC_H #include #endif @@ -62,11 +62,11 @@ typedef void *atom_t; typedef void *functor_t; - typedef enum { - FRG_FIRST_CALL = 0, /* Initial call */ - FRG_CUTTED = 1, /* Context was cutted */ - FRG_REDO = 2 /* Normal redo */ - } frg_code; +typedef enum { + FRG_FIRST_CALL = 0, /* Initial call */ + FRG_CUTTED = 1, /* Context was cutted */ + FRG_REDO = 2 /* Normal redo */ +} frg_code; struct foreign_context { uintptr_t context; /* context value */ @@ -987,7 +987,7 @@ static uintptr_t execute_cargs_back(PredEntry *pe, CPredicate exec_code, static uintptr_t complete_fail(choiceptr ptr, int has_cp USES_REGS) { // this case is easy, jut be sure to throw everything // after the old B; - while (B != ptr) { + while (B && B->cp_b && B->cp_b <= ptr) { B = B->cp_b; } if (has_cp) @@ -1066,16 +1066,9 @@ Int YAP_Execute(PredEntry *pe, CPredicate exec_code) { complete_fail(((choiceptr)(LCL0 - OASP)), FALSE PASS_REGS); // CurrentModule = omod; if (!ret) { - Term t; - - LOCAL_BallTerm = EX; - EX = NULL; - if ((t = Yap_GetException())) { - Yap_JumpToEnv(t); - return FALSE; + Yap_RaiseException(); } - } - return ret; + return ret; } #define FRG_REDO_MASK 0x00000003L @@ -1107,15 +1100,8 @@ Int YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code) { Yap_CloseSlots(CurSlot); PP = NULL; if (val == 0) { - Term t; - - LOCAL_BallTerm = EX; - EX = NULL; - if ((t = Yap_GetException())) { - cut_c_pop(); - B = B->cp_b; - Yap_JumpToEnv(t); - return FALSE; + if (Yap_RaiseException()) { + return false; } return complete_fail(((choiceptr)(LCL0 - ocp)), TRUE PASS_REGS); } else if (val == 1) { /* TRUE */ @@ -1132,15 +1118,8 @@ Int YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code) { Int ret = (exec_code)(PASS_REGS1); Yap_CloseSlots(CurSlot); if (!ret) { - Term t; - - LOCAL_BallTerm = EX; - EX = NULL; - if ((t = Yap_GetException())) { - Yap_JumpToEnv(t); - return FALSE; - } - } + Yap_RaiseException(); + } return ret; } } @@ -1148,13 +1127,16 @@ Int YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code) { Int YAP_ExecuteOnCut(PredEntry *pe, CPredicate exec_code, struct cut_c_str *top) { CACHE_REGS - choiceptr oB = B; + Int oB = LCL0-(CELL*)B; Int val; /* for slots to work */ yhandle_t CurSlot = Yap_StartSlots(); /* find out where we belong */ - while (B->cp_b < (choiceptr)top) + while (B < (choiceptr)top) { + oB = LCL0 - (CELL *)B; B = B->cp_b; + + } PP = pe; if (pe->PredFlags & (SWIEnvPredFlag | CArgsPredFlag)) { // SWI Emulation @@ -1163,7 +1145,7 @@ Int YAP_ExecuteOnCut(PredEntry *pe, CPredicate exec_code, (struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE, 1)); CELL *args = B->cp_args; - B = oB; + B = (choiceptr)(LCL0 - oB); ctx->control = FRG_CUTTED; ctx->engine = NULL; //(PL_local_data *)Yap_regp; if (pe->PredFlags & CArgsPredFlag) { @@ -1172,27 +1154,22 @@ Int YAP_ExecuteOnCut(PredEntry *pe, CPredicate exec_code, val = codev(Yap_InitSlots(pe->ArityOfPE, args), 0, ctx); } } else { + Int oYENV = LCL0 - YENV; + yamop *oP = P, *oCP = CP; // YAP Native + B = (choiceptr)(LCL0 - oB); val = exec_code(PASS_REGS1); - B = oB; + YENV = LCL0 - oYENV; + P = oP; + CP = oCP; } Yap_CloseSlots(CurSlot); - PP = NULL; // B = LCL0-(CELL*)oB; - if (val == 0) { - Term t; - - LOCAL_BallTerm = EX; - EX = NULL; - if ((t = Yap_GetException())) { - cut_c_pop(); - Yap_JumpToEnv(t); - return FALSE; - } - return FALSE; + if (false && Yap_RaiseException()) { + return false; } else { /* TRUE */ - return TRUE; + return true; } } @@ -1220,14 +1197,7 @@ Int YAP_ExecuteNext(PredEntry *pe, CPredicate exec_code) { /* make sure we clean up the frames left by the user */ PP = NULL; if (val == 0) { - Term t; - - LOCAL_BallTerm = EX; - EX = NULL; - if ((t = Yap_GetException())) { - cut_c_pop(); - B = B->cp_b; - Yap_JumpToEnv(t); + if (Yap_RaiseException()) { return FALSE; } else { return complete_fail(((choiceptr)(LCL0 - ocp)), TRUE PASS_REGS); @@ -1246,15 +1216,8 @@ Int YAP_ExecuteNext(PredEntry *pe, CPredicate exec_code) { Int ret = (exec_code)(PASS_REGS1); Yap_CloseSlots(CurSlot); if (!ret) { - Term t; - - LOCAL_BallTerm = EX; - EX = NULL; - if ((t = Yap_GetException())) { - Yap_JumpToEnv(t); - return FALSE; - } - } + Yap_RaiseException(); + } return ret; } } @@ -1292,6 +1255,7 @@ X_API void *YAP_ReallocSpaceFromYap(void *ptr, size_t size) { RECOVER_MACHINE_REGS(); return new_ptr; } + X_API void *YAP_AllocSpaceFromYap(size_t size) { CACHE_REGS void *ptr; @@ -1531,8 +1495,8 @@ X_API Term YAP_NWideBufferToAtomList(const wchar_t *s, size_t len) { } /* copy a string of size len to a buffer */ -X_API Term -YAP_NWideBufferToAtomDiffList(const wchar_t *s, Term t0, size_t len) { +X_API Term YAP_NWideBufferToAtomDiffList(const wchar_t *s, Term t0, + size_t len) { Term t; BACKUP_H(); @@ -1802,16 +1766,11 @@ X_API Int YAP_RunGoal(Term t) { LOCAL_AllowRestart = FALSE; LOCAL_PrologMode = UserMode; - out = Yap_RunTopGoal(t); + out = Yap_RunTopGoal(t, true); LOCAL_PrologMode = UserCCallMode; // should we catch the exception or pass it through? // We'll pass it through - if (EX) { - Term ball = Yap_PopTermFromDB(EX); - EX = NULL; - Yap_JumpToEnv(ball); - return FALSE; - } + Yap_RaiseException(); if (out) { P = (yamop *)ENV[E_CP]; ENV = (CELL *)ENV[E_E]; @@ -1896,7 +1855,7 @@ X_API Int YAP_RunGoalOnce(Term t) { CSlot = Yap_StartSlots(); LOCAL_PrologMode = UserMode; // Yap_heap_regs->yap_do_low_level_trace=true; - out = Yap_RunTopGoal(t); + out = Yap_RunTopGoal(t, true); LOCAL_PrologMode = oldPrologMode; Yap_CloseSlots(CSlot); if (!(oldPrologMode & UserCCallMode)) { @@ -1907,12 +1866,7 @@ X_API Int YAP_RunGoalOnce(Term t) { } // should we catch the exception or pass it through? // We'll pass it through - if (EX) { - Term ball = Yap_PopTermFromDB(EX); - EX = NULL; - Yap_JumpToEnv(ball); - return FALSE; - } + Yap_RaiseException(); if (out) { choiceptr cut_pt, ob; @@ -2044,47 +1998,16 @@ X_API void YAP_PruneGoal(YAP_dogoalinfo *gi) { X_API bool YAP_GoalHasException(Term *t) { CACHE_REGS - int out = FALSE; BACKUP_MACHINE_REGS(); - if (EX) { - do { - LOCAL_Error_TYPE = YAP_NO_ERROR; - *t = Yap_FetchTermFromDB(EX); - if (LOCAL_Error_TYPE == YAP_NO_ERROR) { - RECOVER_MACHINE_REGS(); - return TRUE; - } else if (LOCAL_Error_TYPE == RESOURCE_ERROR_ATTRIBUTED_VARIABLES) { - LOCAL_Error_TYPE = YAP_NO_ERROR; - if (!Yap_growglobal(NULL)) { - Yap_Error(RESOURCE_ERROR_ATTRIBUTED_VARIABLES, TermNil, - LOCAL_ErrorMessage); - RECOVER_MACHINE_REGS(); - return FALSE; - } - } else { - LOCAL_Error_TYPE = YAP_NO_ERROR; - if (!Yap_growstack(EX->NOfCells * CellSize)) { - Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); - RECOVER_MACHINE_REGS(); - return FALSE; - } - } - } while (*t == (CELL)0); - out = TRUE; - } - RECOVER_MACHINE_REGS(); - return out; -} + if (t) + *t = Yap_PeekException(); + return Yap_PeekException(); + } X_API void YAP_ClearExceptions(void) { CACHE_REGS - if (EX) { - LOCAL_BallTerm = EX; - } - EX = NULL; - Yap_ResetExceptionTerm(0); - LOCAL_UncaughtThrow = FALSE; + Yap_ResetException(worker_id); } X_API int YAP_InitConsult(int mode, const char *filename, int *osnop) { @@ -2101,11 +2024,11 @@ X_API int YAP_InitConsult(int mode, const char *filename, int *osnop) { const char *full = Yap_AbsoluteFile(filename, true); if (!full) return -1; - f = fopen( full, "r"); + f = fopen(full, "r"); if (!f) return -1; else - free( (char *)full ); + free((char *)full); sno = Yap_OpenStream(f, NULL, TermNil, Input_Stream_f); *osnop = Yap_CheckAlias(AtomLoopStream); if (!Yap_AddAlias(AtomLoopStream, sno)) { @@ -2154,7 +2077,6 @@ X_API Term YAP_Read(FILE *f) { return o; } - X_API Term YAP_ReadFromStream(int sno) { Term o; @@ -2283,7 +2205,7 @@ static void do_bootfile(char *bootfilename USES_REGS) { YAP_Reset(YAP_FULL_RESET); Yap_StartSlots(); t = YAP_ReadClauseFromStream(bootfile); - // Yap_DebugPlWrite(t);fprintf(stderr, "\n"); + //Yap_DebugPlWriteln(t); if (t == 0) { fprintf(stderr, "[ SYNTAX ERROR: while parsing bootfile %s at line %d ]\n", @@ -2349,7 +2271,7 @@ Int YAP_Init(YAP_init_args *yap_init) { int restore_result; int do_bootstrap = (yap_init->YapPrologBootFile != NULL); CELL Trail = 0, Stack = 0, Heap = 0, Atts = 0; - char boot_file[YAP_FILENAME_MAX+1]; + char boot_file[YAP_FILENAME_MAX + 1]; static int initialized = FALSE; /* ignore repeated calls to YAP_Init */ @@ -2368,7 +2290,8 @@ Int YAP_Init(YAP_init_args *yap_init) { GLOBAL_argc = yap_init->Argc; #if BOOT_FROM_SAVED_STATE if (!yap_init->SavedState) { - yap_init->SavedState = Yap_locateFile(YAP_STARTUP, boot_file, sizeof(boot_file)-1); + yap_init->SavedState = + Yap_locateFile(YAP_STARTUP, boot_file, sizeof(boot_file) - 1); } #else @@ -2717,24 +2640,30 @@ X_API void YAP_PredicateInfo(void *p, Atom *a, UInt *arity, Term *m) { *m = TermProlog; } -X_API void YAP_UserCPredicate(const char *name, CPredicate def, UInt arity) { +X_API void YAP_UserCPredicate(const char *name, CPredicate def, arity_t arity) { Yap_InitCPred(name, arity, def, UserCPredFlag); } -X_API void YAP_UserBackCPredicate(const char *name, CPredicate init, - CPredicate cont, UInt arity, - unsigned int extra) { +X_API void YAP_UserBackCPredicate_(const char *name, CPredicate init, + CPredicate cont, arity_t arity, + arity_t extra) { Yap_InitCPredBackCut(name, arity, extra, init, cont, NULL, UserCPredFlag); } X_API void YAP_UserBackCutCPredicate(const char *name, CPredicate init, CPredicate cont, CPredicate cut, - UInt arity, unsigned int extra) { + arity_t arity, arity_t extra) { Yap_InitCPredBackCut(name, arity, extra, init, cont, cut, UserCPredFlag); } -X_API void YAP_UserCPredicateWithArgs(const char *a, CPredicate f, UInt arity, - Term mod) { +X_API void YAP_UserBackCPredicate(const char *name, CPredicate init, + CPredicate cont, arity_t arity, + arity_t extra) { + Yap_InitCPredBackCut(name, arity, extra, init, cont, NULL, UserCPredFlag); +} + +X_API void YAP_UserCPredicateWithArgs(const char *a, CPredicate f, + arity_t arity, Term mod) { CACHE_REGS PredEntry *pe; Term cm = CurrentModule; @@ -3398,11 +3327,11 @@ X_API int YAP_RequiresExtraStack(size_t sz) { return TRUE; } - atom_t *TR_Atoms; - functor_t *TR_Functors; - size_t AtomTranslations, MaxAtomTranslations; - size_t FunctorTranslations, MaxFunctorTranslations; - +atom_t *TR_Atoms; +functor_t *TR_Functors; +size_t AtomTranslations, MaxAtomTranslations; +size_t FunctorTranslations, MaxFunctorTranslations; + X_API Int YAP_AtomToInt(Atom At) { TranslationEntry *te = Yap_GetTranslationProp(At, 0); if (te != NIL) @@ -3438,9 +3367,9 @@ X_API Int YAP_FunctorToInt(Functor f) { Yap_PutAtomTranslation(At, arity, FunctorTranslations); FunctorTranslations++; if (FunctorTranslations == MaxFunctorTranslations) { - functor_t *nt = - (functor_t *)malloc(sizeof(functor_t) * 2 * MaxFunctorTranslations), - *ot = TR_Functors; + functor_t *nt = (functor_t *)malloc(sizeof(functor_t) * 2 * + MaxFunctorTranslations), + *ot = TR_Functors; if (nt == NULL) { Yap_Error(SYSTEM_ERROR_INTERNAL, MkAtomTerm(At), "No more room for translations"); diff --git a/C/cdmgr.c b/C/cdmgr.c index d0382a80a..dd3305be8 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -20,9 +20,9 @@ static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98"; #include "Yap.h" #include "clause.h" -#include "yapio.h" #include "eval.h" #include "tracer.h" +#include "yapio.h" #ifdef YAPOR #include "or.macros.h" #endif /* YAPOR */ @@ -32,9 +32,9 @@ static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98"; #if HAVE_STRING_H #include #endif +#include #include #include -#include static void retract_all(PredEntry *, int); static void add_first_static(PredEntry *, yamop *, int); @@ -63,7 +63,6 @@ static Int p_optimizer_on(USES_REGS1); static Int p_optimizer_off(USES_REGS1); static Int p_is_dynamic(USES_REGS1); static Int p_kill_dynamic(USES_REGS1); -static Int p_compile_mode(USES_REGS1); static Int p_is_profiled(USES_REGS1); static Int p_profile_info(USES_REGS1); static Int p_profile_reset(USES_REGS1); @@ -1936,7 +1935,6 @@ static Int p_compile(USES_REGS1) { /* '$compile'(+C,+Flags,+C0,-Ref) */ Term t1 = Deref(ARG2); Term mod = Deref(ARG4); yamop *code_adr; - int mode; if (IsVarTerm(t1) || !IsAtomicTerm(t1)) return false; @@ -2712,18 +2710,6 @@ static Int p_optimizer_off(USES_REGS1) { /* '$optimizer_off' */ return (TRUE); } -static Int p_compile_mode(USES_REGS1) { /* $compile_mode(Old,New) */ - Term t2, t3 = MkIntTerm(compile_mode); - if (!Yap_unify_constant(ARG1, t3)) - return (FALSE); - t2 = Deref(ARG2); - - if (IsVarTerm(t2) || !IsIntTerm(t2)) - return (FALSE); - compile_mode = IntOfTerm(t2) & 1; - return (TRUE); -} - static Int p_is_profiled(USES_REGS1) { Term t = Deref(ARG1); char *s; @@ -2908,7 +2894,6 @@ static Int p_clean_up_dead_clauses(USES_REGS1) { } void Yap_HidePred(PredEntry *pe) { - Prop p0 = AbsPredProp(pe); pe->PredFlags |= (HiddenPredFlag | NoSpyPredFlag | NoTracePredFlag); } diff --git a/C/cp_absmi_insts.h b/C/cp_absmi_insts.h index f564714eb..47b64a205 100644 --- a/C/cp_absmi_insts.h +++ b/C/cp_absmi_insts.h @@ -27,7 +27,7 @@ B = B_YREG; #ifdef YAPOR SCH_set_load(B_YREG); -#endif /* YAPOR */ +#endif /* YAPOR */ PREG = NEXTOP(PREG, Otapl); SET_BB(B_YREG); ENDCACHE_Y(); @@ -42,7 +42,7 @@ restore_yaam_regs(PREG->y_u.Otapl.d); restore_at_least_one_arg(PREG->y_u.Otapl.s); #ifdef FROZEN_STACKS - S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); + S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG); set_cut(S_YREG, B->cp_b); #else set_cut(S_YREG, B_YREG->cp_b); @@ -58,25 +58,24 @@ CACHE_Y(B); #ifdef YAPOR if (SCH_top_shared_cp(B)) { - SCH_last_alternative(PREG, B_YREG); - restore_at_least_one_arg(PREG->y_u.Otapl.s); + SCH_last_alternative(PREG, B_YREG); + restore_at_least_one_arg(PREG->y_u.Otapl.s); #ifdef FROZEN_STACKS - S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); + S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG); #endif /* FROZEN_STACKS */ - set_cut(S_YREG, B->cp_b); + set_cut(S_YREG, B->cp_b); + } else +#endif /* YAPOR */ + { + pop_yaam_regs(); + pop_at_least_one_arg(PREG->y_u.Otapl.s); +/* After trust, cut should be pointing at the new top + * choicepoint */ +#ifdef FROZEN_STACKS + S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG); +#endif /* FROZEN_STACKS */ + set_cut(S_YREG, B); } - else -#endif /* YAPOR */ - { - pop_yaam_regs(); - pop_at_least_one_arg(PREG->y_u.Otapl.s); - /* After trust, cut should be pointing at the new top - * choicepoint */ -#ifdef FROZEN_STACKS - S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); -#endif /* FROZEN_STACKS */ - set_cut(S_YREG, B); - } PREG = NEXTOP(PREG, Otapl); SET_BB(B_YREG); ENDCACHE_Y(); @@ -89,14 +88,14 @@ /* enter_exo Pred,Label */ BOp(enter_exo, e); { - yamop *pt; - saveregs(); - pt = Yap_ExoLookup(PredFromDefCode(PREG) PASS_REGS); - setregs(); + yamop *pt; + saveregs(); + pt = Yap_ExoLookup(PredFromDefCode(PREG) PASS_REGS); + setregs(); #ifdef SHADOW_S - SREG = S; + SREG = S; #endif - PREG = pt; + PREG = pt; } JMPNext(); ENDBOp(); @@ -111,14 +110,15 @@ * new register to point at YREG =*/ CACHE_Y(YREG); { - struct index_t *i = (struct index_t *)(PREG->y_u.lp.l); - S_YREG[-1] = (CELL)LINK_TO_ADDRESS(i,i->links[EXO_ADDRESS_TO_OFFSET(i, SREG)]); + struct index_t *i = (struct index_t *)(PREG->y_u.lp.l); + S_YREG[-1] = + (CELL)LINK_TO_ADDRESS(i, i->links[EXO_ADDRESS_TO_OFFSET(i, SREG)]); } S_YREG--; /* store arguments for procedure */ store_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); /* store abstract machine registers */ - store_yaam_regs(NEXTOP(PREG,lp), 0); + store_yaam_regs(NEXTOP(PREG, lp), 0); /* On a try_me, set cut to point at previous choicepoint, * that is, to the B before the cut. */ @@ -127,8 +127,8 @@ B = B_YREG; #ifdef YAPOR SCH_set_load(B_YREG); -#endif /* YAPOR */ - PREG = NEXTOP(NEXTOP(PREG, lp),lp); +#endif /* YAPOR */ + PREG = NEXTOP(NEXTOP(PREG, lp), lp); SET_BB(B_YREG); ENDCACHE_Y(); GONext(); @@ -147,7 +147,7 @@ /* store arguments for procedure */ store_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); /* store abstract machine registers */ - store_yaam_regs(NEXTOP(PREG,lp), 0); + store_yaam_regs(NEXTOP(PREG, lp), 0); /* On a try_me, set cut to point at previous choicepoint, * that is, to the B before the cut. */ @@ -156,8 +156,8 @@ B = B_YREG; #ifdef YAPOR SCH_set_load(B_YREG); -#endif /* YAPOR */ - PREG = NEXTOP(NEXTOP(PREG, lp),lp); +#endif /* YAPOR */ + PREG = NEXTOP(NEXTOP(PREG, lp), lp); SET_BB(B_YREG); ENDCACHE_Y(); GONext(); @@ -171,14 +171,12 @@ * register, but sometimes (X86) not. In this case, have a * new register to point at YREG =*/ CACHE_Y(YREG); - { - S_YREG[-1] = (CELL)SREG; /* the udi code did S = (CELL*)judyp; */ - } + { S_YREG[-1] = (CELL)SREG; /* the udi code did S = (CELL*)judyp; */ } S_YREG--; /* store arguments for procedure */ store_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); /* store abstract machine registers */ - store_yaam_regs(NEXTOP(PREG,lp), 0); + store_yaam_regs(NEXTOP(PREG, lp), 0); /* On a try_me, set cut to point at previous choicepoint, * that is, to the B before the cut. */ @@ -187,8 +185,8 @@ B = B_YREG; #ifdef YAPOR SCH_set_load(B_YREG); -#endif /* YAPOR */ - PREG = NEXTOP(NEXTOP(PREG, lp),lp); +#endif /* YAPOR */ + PREG = NEXTOP(NEXTOP(PREG, lp), lp); SET_BB(B_YREG); ENDCACHE_Y(); GONext(); @@ -204,16 +202,16 @@ * new register to point at YREG =*/ CACHE_Y(YREG); { - struct index_t *i = (struct index_t *)(PREG->y_u.lp.l); - SREG = i->cls; - S_YREG[-2] = (CELL)(SREG+i->arity); - S_YREG[-1] = (CELL)(SREG+i->arity*i->nels); + struct index_t *i = (struct index_t *)(PREG->y_u.lp.l); + SREG = i->cls; + S_YREG[-2] = (CELL)(SREG + i->arity); + S_YREG[-1] = (CELL)(SREG + i->arity * i->nels); } - S_YREG-=2; + S_YREG -= 2; /* store arguments for procedure */ store_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); /* store abstract machine registers */ - store_yaam_regs(NEXTOP(PREG,lp), 0); + store_yaam_regs(NEXTOP(PREG, lp), 0); /* On a try_me, set cut to point at previous choicepoint, * that is, to the B before the cut. */ @@ -222,8 +220,8 @@ B = B_YREG; #ifdef YAPOR SCH_set_load(B_YREG); -#endif /* YAPOR */ - PREG = NEXTOP(NEXTOP(PREG, lp),lp); +#endif /* YAPOR */ + PREG = NEXTOP(NEXTOP(PREG, lp), lp); SET_BB(B_YREG); ENDCACHE_Y(); GONext(); @@ -234,45 +232,46 @@ BEGD(d0); CACHE_Y(B); { - struct index_t *it = (struct index_t *)(PREG->y_u.lp.l); - BITS32 offset = ADDRESS_TO_LINK(it,(BITS32 *)((CELL *)(B+1))[it->arity]); - d0 = it->links[offset]; - ((CELL *)(B+1))[it->arity] = (CELL)LINK_TO_ADDRESS(it, d0); - SREG = EXO_OFFSET_TO_ADDRESS(it, offset); + struct index_t *it = (struct index_t *)(PREG->y_u.lp.l); + BITS32 offset = + ADDRESS_TO_LINK(it, (BITS32 *)((CELL *)(B + 1))[it->arity]); + d0 = it->links[offset]; + ((CELL *)(B + 1))[it->arity] = (CELL)LINK_TO_ADDRESS(it, d0); + SREG = EXO_OFFSET_TO_ADDRESS(it, offset); } if (d0) { - /* After retry, cut should be pointing at the parent - * choicepoint for the current B */ - restore_yaam_regs(PREG); - restore_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); + /* After retry, cut should be pointing at the parent + * choicepoint for the current B */ + restore_yaam_regs(PREG); + restore_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); #ifdef FROZEN_STACKS - S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); - set_cut(S_YREG, B->cp_b); + S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG); + set_cut(S_YREG, B->cp_b); #else - set_cut(S_YREG, B_YREG->cp_b); + set_cut(S_YREG, B_YREG->cp_b); #endif /* FROZEN_STACKS */ - SET_BB(B_YREG); + SET_BB(B_YREG); } else { #ifdef YAPOR - if (SCH_top_shared_cp(B)) { - SCH_last_alternative(PREG, B_YREG); - restore_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); + if (SCH_top_shared_cp(B)) { + SCH_last_alternative(PREG, B_YREG); + restore_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); #ifdef FROZEN_STACKS - S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); + S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG); #endif /* FROZEN_STACKS */ - set_cut(S_YREG, B->cp_b); - } else -#endif /* YAPOR */ - { - pop_yaam_regs(); - pop_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); - /* After trust, cut should be pointing at the new top - * choicepoint */ + set_cut(S_YREG, B->cp_b); + } else +#endif /* YAPOR */ + { + pop_yaam_regs(); + pop_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); +/* After trust, cut should be pointing at the new top + * choicepoint */ #ifdef FROZEN_STACKS - S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); + S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG); #endif /* FROZEN_STACKS */ - set_cut(S_YREG, B); - } + set_cut(S_YREG, B); + } } PREG = NEXTOP(PREG, lp); ENDCACHE_Y(); @@ -285,47 +284,47 @@ BEGD(d0); CACHE_Y(B); { - struct index_t *it = (struct index_t *)(PREG->y_u.lp.l); - saveregs(); - d0 = ((CRetryExoIndex)it->udi_next)(it PASS_REGS); - setregs(); + struct index_t *it = (struct index_t *)(PREG->y_u.lp.l); + saveregs(); + d0 = ((CRetryExoIndex)it->udi_next)(it PASS_REGS); + setregs(); #ifdef SHADOW_S - SREG = S; + SREG = S; #endif } if (d0) { - /* After retry, cut should be pointing at the parent - * choicepoint for the current B */ - restore_yaam_regs(PREG); - restore_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); + /* After retry, cut should be pointing at the parent + * choicepoint for the current B */ + restore_yaam_regs(PREG); + restore_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); #ifdef FROZEN_STACKS - S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); - set_cut(S_YREG, B->cp_b); + S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG); + set_cut(S_YREG, B->cp_b); #else - set_cut(S_YREG, B_YREG->cp_b); + set_cut(S_YREG, B_YREG->cp_b); #endif /* FROZEN_STACKS */ - SET_BB(B_YREG); + SET_BB(B_YREG); } else { #ifdef YAPOR - if (SCH_top_shared_cp(B)) { - SCH_last_alternative(PREG, B_YREG); - restore_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); + if (SCH_top_shared_cp(B)) { + SCH_last_alternative(PREG, B_YREG); + restore_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); #ifdef FROZEN_STACKS - S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); + S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG); #endif /* FROZEN_STACKS */ - set_cut(S_YREG, B->cp_b); - } else -#endif /* YAPOR */ - { - pop_yaam_regs(); - pop_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); - /* After trust, cut should be pointing at the new top - * choicepoint */ + set_cut(S_YREG, B->cp_b); + } else +#endif /* YAPOR */ + { + pop_yaam_regs(); + pop_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); +/* After trust, cut should be pointing at the new top + * choicepoint */ #ifdef FROZEN_STACKS - S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); + S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG); #endif /* FROZEN_STACKS */ - set_cut(S_YREG, B); - } + set_cut(S_YREG, B); + } } PREG = NEXTOP(PREG, lp); ENDCACHE_Y(); @@ -338,49 +337,50 @@ BEGD(d0); CACHE_Y(B); { - // struct udi_index_t *jp = (struct udi_index_t *)((CELL *)(B+1))[it->arity]; - /* operation has a side-effect: S = (CELL*)NextClause */ - saveregs(); - d0 = 0L; // Yap_UDI_NextAlt(jp); - setregs(); + // struct udi_index_t *jp = (struct udi_index_t *)((CELL + // *)(B+1))[it->arity]; + /* operation has a side-effect: S = (CELL*)NextClause */ + saveregs(); + d0 = 0L; // Yap_UDI_NextAlt(jp); + setregs(); #ifdef SHADOW_S - SREG = S; + SREG = S; #endif - /* d0 says if we're last */ + /* d0 says if we're last */ } if (d0) { - /* After retry, cut should be pointing at the parent - * choicepoint for the current B */ - restore_yaam_regs(PREG); - restore_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); + /* After retry, cut should be pointing at the parent + * choicepoint for the current B */ + restore_yaam_regs(PREG); + restore_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); #ifdef FROZEN_STACKS - S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); - set_cut(S_YREG, B->cp_b); + S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG); + set_cut(S_YREG, B->cp_b); #else - set_cut(S_YREG, B_YREG->cp_b); + set_cut(S_YREG, B_YREG->cp_b); #endif /* FROZEN_STACKS */ - SET_BB(B_YREG); + SET_BB(B_YREG); } else { #ifdef YAPOR - if (SCH_top_shared_cp(B)) { - SCH_last_alternative(PREG, B_YREG); - restore_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); + if (SCH_top_shared_cp(B)) { + SCH_last_alternative(PREG, B_YREG); + restore_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); #ifdef FROZEN_STACKS - S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); + S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG); #endif /* FROZEN_STACKS */ - set_cut(S_YREG, B->cp_b); - } else -#endif /* YAPOR */ - { - pop_yaam_regs(); - pop_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); - /* After trust, cut should be pointing at the new top - * choicepoint */ + set_cut(S_YREG, B->cp_b); + } else +#endif /* YAPOR */ + { + pop_yaam_regs(); + pop_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); +/* After trust, cut should be pointing at the new top + * choicepoint */ #ifdef FROZEN_STACKS - S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); + S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG); #endif /* FROZEN_STACKS */ - set_cut(S_YREG, B); - } + set_cut(S_YREG, B); + } } PREG = (yamop *)SREG; ENDCACHE_Y(); @@ -393,45 +393,45 @@ BEGD(d0); CACHE_Y(B); { - UInt arity = ((struct index_t *)PREG->y_u.lp.l)->arity; - CELL *extras = (CELL *)(B+1); - SREG = (CELL *)extras[arity]; - d0 = (SREG+arity != (CELL *)extras[arity+1]); - if (d0) { - extras[arity] = (CELL)(SREG+arity); - /* After retry, cut should be pointing at the parent - * choicepoint for the current B */ - restore_yaam_regs(PREG); - restore_at_least_one_arg(arity); + UInt arity = ((struct index_t *)PREG->y_u.lp.l)->arity; + CELL *extras = (CELL *)(B + 1); + SREG = (CELL *)extras[arity]; + d0 = (SREG + arity != (CELL *)extras[arity + 1]); + if (d0) { + extras[arity] = (CELL)(SREG + arity); + /* After retry, cut should be pointing at the parent + * choicepoint for the current B */ + restore_yaam_regs(PREG); + restore_at_least_one_arg(arity); #ifdef FROZEN_STACKS - S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); - set_cut(S_YREG, B->cp_b); + S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG); + set_cut(S_YREG, B->cp_b); #else - set_cut(S_YREG, B_YREG->cp_b); + set_cut(S_YREG, B_YREG->cp_b); #endif /* FROZEN_STACKS */ - SET_BB(B_YREG); - } else { + SET_BB(B_YREG); + } else { #ifdef YAPOR - if (SCH_top_shared_cp(B)) { - SCH_last_alternative(PREG, B_YREG); - restore_at_least_one_arg(arity); + if (SCH_top_shared_cp(B)) { + SCH_last_alternative(PREG, B_YREG); + restore_at_least_one_arg(arity); #ifdef FROZEN_STACKS - S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); + S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG); #endif /* FROZEN_STACKS */ - set_cut(S_YREG, B->cp_b); - } else -#endif /* YAPOR */ - { - pop_yaam_regs(); - pop_at_least_one_arg(arity); - /* After trust, cut should be pointing at the new top - * choicepoint */ + set_cut(S_YREG, B->cp_b); + } else +#endif /* YAPOR */ + { + pop_yaam_regs(); + pop_at_least_one_arg(arity); +/* After trust, cut should be pointing at the new top + * choicepoint */ #ifdef FROZEN_STACKS - S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); + S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG); #endif /* FROZEN_STACKS */ - set_cut(S_YREG, B); - } - } + set_cut(S_YREG, B); + } + } } PREG = NEXTOP(PREG, lp); ENDCACHE_Y(); @@ -472,7 +472,7 @@ restore_yaam_regs(PREG->y_u.Otapl.d); restore_args(PREG->y_u.Otapl.s); #ifdef FROZEN_STACKS - S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); + S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG); set_cut(S_YREG, B->cp_b); #else set_cut(S_YREG, B_YREG->cp_b); @@ -488,25 +488,24 @@ CACHE_Y(B); #ifdef YAPOR if (SCH_top_shared_cp(B)) { - SCH_last_alternative(PREG, B_YREG); - restore_args(PREG->y_u.Otapl.s); + SCH_last_alternative(PREG, B_YREG); + restore_args(PREG->y_u.Otapl.s); #ifdef FROZEN_STACKS - S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); + S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG); #endif /* FROZEN_STACKS */ - set_cut(S_YREG, B->cp_b); + set_cut(S_YREG, B->cp_b); + } else +#endif /* YAPOR */ + { + pop_yaam_regs(); + pop_args(PREG->y_u.Otapl.s); +/* After trust, cut should be pointing at the new top + * choicepoint */ +#ifdef FROZEN_STACKS + S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG); +#endif /* FROZEN_STACKS */ + set_cut(S_YREG, B); } - else -#endif /* YAPOR */ - { - pop_yaam_regs(); - pop_args(PREG->y_u.Otapl.s); - /* After trust, cut should be pointing at the new top - * choicepoint */ -#ifdef FROZEN_STACKS - S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); -#endif /* FROZEN_STACKS */ - set_cut(S_YREG, B); - } SET_BB(B_YREG); ENDCACHE_Y(); LOCK(PREG->y_u.Otapl.p->StatisticsForPred->lock); @@ -516,9 +515,9 @@ GONext(); ENDOp(); - /***************************************************************** - * Call count instructions * - *****************************************************************/ + /***************************************************************** + * Call count instructions * + *****************************************************************/ /* count_enter_me Label,NArgs */ Op(count_call, p); @@ -527,17 +526,17 @@ UNLOCK(PREG->y_u.p.p->StatisticsForPred->lock); LOCAL_ReductionsCounter--; if (LOCAL_ReductionsCounter == 0 && LOCAL_ReductionsCounterOn) { - saveregs(); - Yap_NilError(CALL_COUNTER_UNDERFLOW_EVENT,""); - setregs(); - JMPNext(); + saveregs(); + Yap_NilError(CALL_COUNTER_UNDERFLOW_EVENT, ""); + setregs(); + JMPNext(); } LOCAL_PredEntriesCounter--; if (LOCAL_PredEntriesCounter == 0 && LOCAL_PredEntriesCounterOn) { - saveregs(); - Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT,""); - setregs(); - JMPNext(); + saveregs(); + Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT, ""); + setregs(); + JMPNext(); } PREG = NEXTOP(PREG, p); GONext(); @@ -550,20 +549,20 @@ UNLOCK(PREG->y_u.p.p->StatisticsForPred->lock); LOCAL_RetriesCounter--; if (LOCAL_RetriesCounter == 0 && LOCAL_RetriesCounterOn) { - /* act as if we had backtracked */ - ENV = B->cp_env; - saveregs(); - Yap_NilError(RETRY_COUNTER_UNDERFLOW_EVENT,""); - setregs(); - JMPNext(); + /* act as if we had backtracked */ + ENV = B->cp_env; + saveregs(); + Yap_NilError(RETRY_COUNTER_UNDERFLOW_EVENT, ""); + setregs(); + JMPNext(); } LOCAL_PredEntriesCounter--; if (LOCAL_PredEntriesCounter == 0 && LOCAL_PredEntriesCounterOn) { - ENV = B->cp_env; - saveregs(); - Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT,""); - setregs(); - JMPNext(); + ENV = B->cp_env; + saveregs(); + Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT, ""); + setregs(); + JMPNext(); } PREG = NEXTOP(PREG, p); GONext(); @@ -574,10 +573,10 @@ CACHE_Y(B); restore_yaam_regs(PREG->y_u.Otapl.d); restore_args(PREG->y_u.Otapl.s); - /* After retry, cut should be pointing at the parent - * choicepoint for the current B */ +/* After retry, cut should be pointing at the parent + * choicepoint for the current B */ #ifdef FROZEN_STACKS - S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); + S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG); set_cut(S_YREG, B->cp_b); #else set_cut(S_YREG, B_YREG->cp_b); @@ -589,17 +588,17 @@ UNLOCK(((PredEntry *)(PREG->y_u.Otapl.p))->StatisticsForPred->lock); LOCAL_RetriesCounter--; if (LOCAL_RetriesCounter == 0 && LOCAL_RetriesCounterOn) { - saveregs(); - Yap_NilError(RETRY_COUNTER_UNDERFLOW_EVENT,""); - setregs(); - JMPNext(); + saveregs(); + Yap_NilError(RETRY_COUNTER_UNDERFLOW_EVENT, ""); + setregs(); + JMPNext(); } LOCAL_PredEntriesCounter--; if (LOCAL_PredEntriesCounter == 0 && LOCAL_PredEntriesCounterOn) { - saveregs(); - Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT,""); - setregs(); - JMPNext(); + saveregs(); + Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT, ""); + setregs(); + JMPNext(); } PREG = NEXTOP(PREG, Otapl); GONext(); @@ -610,40 +609,39 @@ CACHE_Y(B); #ifdef YAPOR if (SCH_top_shared_cp(B)) { - SCH_last_alternative(PREG, B_YREG); - restore_args(PREG->y_u.Otapl.s); + SCH_last_alternative(PREG, B_YREG); + restore_args(PREG->y_u.Otapl.s); #ifdef FROZEN_STACKS - S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); + S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG); #endif /* FROZEN_STACKS */ - set_cut(S_YREG, B->cp_b); + set_cut(S_YREG, B->cp_b); + } else +#endif /* YAPOR */ + { + pop_yaam_regs(); + pop_args(PREG->y_u.Otapl.s); +/* After trust, cut should be pointing at the new top + * choicepoint */ +#ifdef FROZEN_STACKS + S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG); +#endif /* FROZEN_STACKS */ + set_cut(S_YREG, B); } - else -#endif /* YAPOR */ - { - pop_yaam_regs(); - pop_args(PREG->y_u.Otapl.s); - /* After trust, cut should be pointing at the new top - * choicepoint */ -#ifdef FROZEN_STACKS - S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); -#endif /* FROZEN_STACKS */ - set_cut(S_YREG, B); - } SET_BB(B_YREG); ENDCACHE_Y(); LOCAL_RetriesCounter--; if (LOCAL_RetriesCounter == 0) { - saveregs(); - Yap_NilError(RETRY_COUNTER_UNDERFLOW_EVENT,""); - setregs(); - JMPNext(); + saveregs(); + Yap_NilError(RETRY_COUNTER_UNDERFLOW_EVENT, ""); + setregs(); + JMPNext(); } LOCAL_PredEntriesCounter--; if (LOCAL_PredEntriesCounter == 0) { - saveregs(); - Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT,""); - setregs(); - JMPNext(); + saveregs(); + Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT, ""); + setregs(); + JMPNext(); } LOCK(((PredEntry *)(PREG->y_u.Otapl.p))->StatisticsForPred->lock); ((PredEntry *)(PREG->y_u.Otapl.p))->StatisticsForPred->NOfRetries++; @@ -659,28 +657,28 @@ /* ensure_space */ BOp(ensure_space, Osbpa); { - Int sz = PREG->y_u.Osbpa.i; - UInt arity = PREG->y_u.Osbpa.p->ArityOfPE; + Int sz = PREG->y_u.Osbpa.i; + UInt arity = PREG->y_u.Osbpa.p->ArityOfPE; - if (Unsigned(HR) + sz > Unsigned(YREG)-StackGap( PASS_REGS1 )) { - YENV[E_CP] = (CELL) CPREG; - YENV[E_E] = (CELL) ENV; + if (Unsigned(HR) + sz > Unsigned(YREG) - StackGap(PASS_REGS1)) { + YENV[E_CP] = (CELL)CPREG; + YENV[E_E] = (CELL)ENV; #ifdef DEPTH_LIMIT - YENV[E_DEPTH] = DEPTH; -#endif /* DEPTH_LIMIT */ - SET_ASP(YREG, PREG->y_u.Osbpa.s); - PREG = NEXTOP(PREG,Osbpa); - saveregs(); - if (!Yap_gcl(sz, arity, YENV, PREG)) { - Yap_NilError(RESOURCE_ERROR_STACK,LOCAL_ErrorMessage); - setregs(); - FAIL(); - } else { - setregs(); - } - } else { - PREG = NEXTOP(PREG,Osbpa); - } + YENV[E_DEPTH] = DEPTH; +#endif /* DEPTH_LIMIT */ + SET_ASP(YREG, PREG->y_u.Osbpa.s); + PREG = NEXTOP(PREG, Osbpa); + saveregs(); + if (!Yap_gcl(sz, arity, YENV, PREG)) { + Yap_NilError(RESOURCE_ERROR_STACK, LOCAL_ErrorMessage); + setregs(); + FAIL(); + } else { + setregs(); + } + } else { + PREG = NEXTOP(PREG, Osbpa); + } } JMPNext(); ENDBOp(); @@ -693,9 +691,9 @@ BOp(spy_or_trymark, Otapl); PELOCK(5, ((PredEntry *)(PREG->y_u.Otapl.p))); PREG = (yamop *)(&(((PredEntry *)(PREG->y_u.Otapl.p))->OpcodeOfPred)); - UNLOCKPE(11,(PredEntry *)(PREG->y_u.Otapl.p)); + UNLOCKPE(11, (PredEntry *)(PREG->y_u.Otapl.p)); saveregs(); - spy_goal( PASS_REGS1 ); + spy_goal(PASS_REGS1); setregs(); ENDBOp(); @@ -708,30 +706,30 @@ CUT_wait_leftmost(); #endif /* YAPOR */ if (PREG->y_u.Otapl.p->PredFlags & LogUpdatePredFlag) { - PELOCK(6,PREG->y_u.Otapl.p); - PP = PREG->y_u.Otapl.p; + PELOCK(6, PREG->y_u.Otapl.p); + PP = PREG->y_u.Otapl.p; } if (PREG->y_u.Otapl.p->CodeOfPred != PREG) { - /* oops, someone changed the procedure under our feet, - fortunately this is no big deal because we haven't done - anything yet */ - PP = NULL; - PREG = PREG->y_u.Otapl.p->CodeOfPred; - UNLOCKPE(12,PREG->y_u.Otapl.p); - /* for profiler */ - save_pc(); - JMPNext(); + /* oops, someone changed the procedure under our feet, + fortunately this is no big deal because we haven't done + anything yet */ + PP = NULL; + PREG = PREG->y_u.Otapl.p->CodeOfPred; + UNLOCKPE(12, PREG->y_u.Otapl.p); + /* for profiler */ + save_pc(); + JMPNext(); } #endif CACHE_Y(YREG); PREG = PREG->y_u.Otapl.d; /* - I've got a read lock on the DB, so I don't need to care... - niaaahh.... niahhhh... + I've got a read lock on the DB, so I don't need to care... + niaaahh.... niahhhh... */ LOCK(DynamicLock(PREG)); /* one can now mess around with the predicate */ - UNLOCKPE(13,((PredEntry *)(PREG->y_u.Otapl.p))); + UNLOCKPE(13, ((PredEntry *)(PREG->y_u.Otapl.p))); BEGD(d1); d1 = PREG->y_u.Otapl.s; store_args(d1); @@ -741,7 +739,7 @@ B = B_YREG; #ifdef YAPOR SCH_set_load(B_YREG); -#endif /* YAPOR */ +#endif /* YAPOR */ SET_BB(B_YREG); ENDCACHE_Y(); #if MULTIPLE_STACKS @@ -751,11 +749,11 @@ #else if (FlagOff(InUseMask, DynamicFlags(PREG))) { - SetFlag(InUseMask, DynamicFlags(PREG)); - TRAIL_CLREF(ClauseCodeToDynamicClause(PREG)); + SetFlag(InUseMask, DynamicFlags(PREG)); + TRAIL_CLREF(ClauseCodeToDynamicClause(PREG)); } #endif - PREG = NEXTOP(PREG,Otapl); + PREG = NEXTOP(PREG, Otapl); JMPNext(); ENDBOp(); @@ -763,17 +761,17 @@ BOp(count_retry_and_mark, Otapl); LOCAL_RetriesCounter--; if (LOCAL_RetriesCounter == 0) { - saveregs(); - Yap_NilError(RETRY_COUNTER_UNDERFLOW_EVENT,""); - setregs(); - JMPNext(); + saveregs(); + Yap_NilError(RETRY_COUNTER_UNDERFLOW_EVENT, ""); + setregs(); + JMPNext(); } LOCAL_PredEntriesCounter--; if (LOCAL_PredEntriesCounter == 0) { - saveregs(); - Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT,""); - setregs(); - JMPNext(); + saveregs(); + Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT, ""); + setregs(); + JMPNext(); } /* enter a retry dynamic */ ENDBOp(); @@ -791,7 +789,7 @@ CUT_wait_leftmost(); #endif /* YAPOR */ /* need to make the DB stable until I get the new clause */ - PELOCK(7,PREG->y_u.Otapl.p); + PELOCK(7, PREG->y_u.Otapl.p); CACHE_Y(B); PREG = PREG->y_u.Otapl.d; LOCK(DynamicLock(PREG)); @@ -799,7 +797,7 @@ restore_yaam_regs(PREG); restore_args(PREG->y_u.Otapl.s); #ifdef FROZEN_STACKS - S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); + S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG); set_cut(S_YREG, B->cp_b); #else set_cut(S_YREG, B_YREG->cp_b); @@ -813,15 +811,14 @@ #else if (FlagOff(InUseMask, DynamicFlags(PREG))) { - SetFlag(InUseMask, DynamicFlags(PREG)); - TRAIL_CLREF(ClauseCodeToDynamicClause(PREG)); + SetFlag(InUseMask, DynamicFlags(PREG)); + TRAIL_CLREF(ClauseCodeToDynamicClause(PREG)); } #endif PREG = NEXTOP(PREG, Otapl); JMPNext(); ENDBOp(); - /************************************************************************\ * Try / Retry / Trust for main indexing blocks * @@ -838,7 +835,7 @@ B = B_YREG; #ifdef YAPOR SCH_set_load(B_YREG); -#endif /* YAPOR */ +#endif /* YAPOR */ SET_BB(B_YREG); ENDCACHE_Y(); JMPNext(); @@ -861,7 +858,7 @@ B = B_YREG; #ifdef YAPOR SCH_set_load(B_YREG); -#endif /* YAPOR */ +#endif /* YAPOR */ SET_BB(B_YREG); ENDCACHE_Y(); JMPNext(); @@ -882,7 +879,7 @@ B = B_YREG; #ifdef YAPOR SCH_set_load(B_YREG); -#endif /* YAPOR */ +#endif /* YAPOR */ SET_BB(B_YREG); ENDCACHE_Y(); JMPNext(); @@ -904,7 +901,7 @@ B = B_YREG; #ifdef YAPOR SCH_set_load(B_YREG); -#endif /* YAPOR */ +#endif /* YAPOR */ SET_BB(B_YREG); ENDCACHE_Y(); JMPNext(); @@ -915,7 +912,7 @@ restore_yaam_regs(NEXTOP(PREG, Otapl)); restore_at_least_one_arg(PREG->y_u.Otapl.s); #ifdef FROZEN_STACKS - S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); + S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG); set_cut(S_YREG, B->cp_b); #else set_cut(S_YREG, B_YREG->cp_b); @@ -933,7 +930,7 @@ ARG1 = B_YREG->cp_a1; ARG2 = B_YREG->cp_a2; #ifdef FROZEN_STACKS - S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); + S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG); set_cut(S_YREG, B->cp_b); #else set_cut(S_YREG, B_YREG->cp_b); @@ -951,7 +948,7 @@ ARG2 = B_YREG->cp_a2; ARG3 = B_YREG->cp_a3; #ifdef FROZEN_STACKS - S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); + S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG); set_cut(S_YREG, B->cp_b); #else set_cut(S_YREG, B_YREG->cp_b); @@ -970,7 +967,7 @@ ARG3 = B_YREG->cp_a3; ARG4 = B_YREG->cp_a4; #ifdef FROZEN_STACKS - S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); + S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG); set_cut(S_YREG, B->cp_b); #else set_cut(S_YREG, B_YREG->cp_b); @@ -987,20 +984,19 @@ SCH_last_alternative(PREG, B_YREG); restore_at_least_one_arg(PREG->y_u.Otapl.s); #ifdef FROZEN_STACKS - S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); + S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG); #endif /* FROZEN_STACKS */ - set_cut(S_YREG, B->cp_b); - } - else -#endif /* YAPOR */ - { - pop_yaam_regs(); - pop_at_least_one_arg(PREG->y_u.Otapl.s); + set_cut(S_YREG, B->cp_b); + } else +#endif /* YAPOR */ + { + pop_yaam_regs(); + pop_at_least_one_arg(PREG->y_u.Otapl.s); #ifdef FROZEN_STACKS - S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); + S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG); #endif /* FROZEN_STACKS */ - set_cut(S_YREG, B); - } + set_cut(S_YREG, B); + } SET_BB(B_YREG); ENDCACHE_Y(); PREG = PREG->y_u.Otapl.d; diff --git a/C/errors.c b/C/errors.c index 7868ef672..8d08ec74b 100755 --- a/C/errors.c +++ b/C/errors.c @@ -262,7 +262,19 @@ static void error_exit_yap(int value) { #endif } fprintf(stderr, "\n Exiting ....\n"); - Yap_exit(value); +#if HAVE_BACKTRACE + void *callstack[256]; + int i; + int frames = backtrace(callstack, 256); + char** strs = backtrace_symbols(callstack, frames); + fprintf(stderr, "Execution stack:\n"); + for (i = 0; i < frames; ++i) { + fprintf(stderr, " %s\n", strs[i]); + + } + free(strs); +#endif + Yap_exit(value); } /* This needs to be a static because I can't trust the stack (WIN32), and @@ -370,7 +382,7 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno, CELL nt[3]; Functor fun; bool serious; - Term tf, error_t, comment, culprit = TermNil; + Term tf, error_t, comment; char *format; char s[MAXPATHLEN]; @@ -470,8 +482,8 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno, IsApplTerm(where) && FunctorOfTerm(where) == FunctorError) { error_t = where; - Yap_JumpToEnv(error_t); P = (yamop *)FAILCODE; + Yap_JumpToEnv(error_t); LOCAL_PrologMode &= ~InErrorMode; return P; } @@ -596,25 +608,14 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno, LOCAL_Signals = 0; CalculateStackGap(PASS_REGS1); LOCAL_PrologMode &= ~InErrorMode; - /* we might be in the middle of a critical region */ - if (LOCAL_InterruptsDisabled) { - LOCAL_InterruptsDisabled = 0; - LOCAL_UncaughtThrow = TRUE; - Yap_RestartYap(1); - } #if DEBUG // DumpActiveGoals( PASS_REGS1 ); #endif /* wait if we we are in user code, it's up to her to decide */ fun = FunctorError; - if (LOCAL_PrologMode & UserCCallMode) { - error_t = Yap_MkApplTerm(fun, 2, nt); - if (!(EX = Yap_StoreTermInDB(error_t, 2))) { - /* fat chance */ - Yap_RestartYap(1); - } - } else { + error_t = Yap_MkApplTerm(fun, 2, nt); + if (type == ABORT_EVENT) { error_t = MkAtomTerm(AtomDAbort); } else { @@ -622,7 +623,7 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno, } Yap_JumpToEnv(error_t); P = (yamop *)FAILCODE; - } + LOCAL_PrologMode &= ~InErrorMode; return P; diff --git a/C/exec.c b/C/exec.c index 9649b8a72..ac8509e05 100755 --- a/C/exec.c +++ b/C/exec.c @@ -19,13 +19,14 @@ static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98"; #endif #include "absmi.h" -#include "yapio.h" #include "attvar.h" #include "cut_c.h" +#include "yapio.h" +#include "yapio.h" -static Int CallPredicate(PredEntry *, choiceptr, yamop *CACHE_TYPE); +static bool CallPredicate(PredEntry *, choiceptr, yamop *CACHE_TYPE); // must hold thread worker comm lock at call. -static Int EnterCreepMode(Term, Term CACHE_TYPE); +static bool EnterCreepMode(Term, Term CACHE_TYPE); static Int current_choice_point(USES_REGS1); static Int execute(USES_REGS1); static Int execute0(USES_REGS1); @@ -38,13 +39,28 @@ static choiceptr cp_from_integer(Term cpt USES_REGS) { return (choiceptr)(LCL0 - IntegerOfTerm(cpt)); } +/** + * Represents a choice-point as an offset to the top of local stack. This should + * *be stable acroos gc or stack shifts. + * @method Yap_cp_as_integer + * @param cp pointer to choice-point + * @return Term with offset + */ Term Yap_cp_as_integer(choiceptr cp) { CACHE_REGS return cp_as_integer(cp PASS_REGS); } -static inline Int CallPredicate(PredEntry *pen, choiceptr cut_pt, - yamop *code USES_REGS) { +/** + * Sets up the engine to run a different predicate. + * @method CallPredicate + * @param pen the new code + * @param cut_pt cut boundary + * @param USES_REGS thread support + * @return success + */ +static inline bool CallPredicate(PredEntry *pen, choiceptr cut_pt, + yamop *code USES_REGS) { #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) low_level_trace(enter_pred, pen, XREGS + 1); @@ -78,7 +94,14 @@ static inline Int CallPredicate(PredEntry *pen, choiceptr cut_pt, return true; } -inline static Int CallMetaCall(Term t, Term mod USES_REGS) { +/** + * calls a meta-predicate or anything weird + * @method CallMetaCall + * @param t the called goal + * @param USES_REGS MT + * @return did we fiid it? + */ +inline static bool CallMetaCall(Term t, Term mod USES_REGS) { // we have a creep requesr waiting ARG1 = t; @@ -97,6 +120,12 @@ inline static Int CallMetaCall(Term t, Term mod USES_REGS) { } } +/** + * Transfer control to a meta-call in ARG1, cut up to B. + * @method Yap_ExecuteCallMetaCall + * @param mod current module + * @return su + */ Term Yap_ExecuteCallMetaCall(Term mod) { CACHE_REGS Term ts[4]; @@ -134,7 +163,7 @@ Term Yap_PredicateIndicator(Term t, Term mod) { return t; } -static Int CallError(yap_error_number err, Term t, Term mod USES_REGS) { +static bool CallError(yap_error_number err, Term t, Term mod USES_REGS) { if (isoLanguageFlag()) { return (CallMetaCall(t, mod PASS_REGS)); } else { @@ -142,11 +171,11 @@ static Int CallError(yap_error_number err, Term t, Term mod USES_REGS) { t = Yap_StripModule(t, &mod); } Yap_Error(err, t, "call/1"); - return FALSE; + return false; } } -/** @pred current_choice_point( -_CP_ ) +/** @pred current_choice_point( -CP ) * * unify the logic variable _CP_ with a number that gives the offset of the * current choice-point. This number is only valid as long as we do not @@ -177,21 +206,13 @@ static Int save_env_b(USES_REGS1) { return (FALSE); td = cp_as_integer((choiceptr)YENV[E_CB] PASS_REGS); YapBind((CELL *)t, td); - return TRUE; + return true; } -static Int trail_suspension_marker(USES_REGS1) { - Term t = Deref(ARG1); - - TrailTerm(TR) = AbsPair((CELL *)t); - TR++; - return TRUE; -} - -inline static Int do_execute(Term t, Term mod USES_REGS) { +inline static bool do_execute(Term t, Term mod USES_REGS) { Term t0 = t; /* first do predicate expansion, even before you process signals. - This way you don't get to spy goal_expansion(). */ + This way you don't get to spy goal_expansion(). */ if (Yap_has_a_signal() && !LOCAL_InterruptsDisabled && !(LOCAL_PrologMode & (AbortMode | InterruptMode | SystemMode))) { return EnterCreepMode(t, mod PASS_REGS); @@ -236,8 +257,8 @@ restart_exec: } /* now let us do what we wanted to do from the beginning !! */ /* I cannot use the standard macro here because - otherwise I would dereference the argument and - might skip a svar */ + otherwise I would dereference the argument and + might skip a svar */ pt = RepAppl(t) + 1; for (i = 1; i <= arity; i++) { #if YAPOR_SBA @@ -257,11 +278,11 @@ restart_exec: Atom a = AtomOfTerm(t); if (a == AtomTrue || a == AtomOtherwise || a == AtomCut) - return (TRUE); + return true; else if (a == AtomFail || (a == AtomFalse && !RepPredProp(PredPropByAtom(a, mod))->ModuleOfPred)) - return (FALSE); + return false; /* call may not define new system predicates!! */ pe = RepPredProp(PredPropByAtom(a, mod)); return (CallPredicate(pe, B, pe->CodeOfPred PASS_REGS)); @@ -307,7 +328,7 @@ static Term copy_execn_to_heap(Functor f, CELL *pt, unsigned int n, return tf; } -inline static Int do_execute_n(Term t, Term mod, unsigned int n USES_REGS) { +inline static bool do_execute_n(Term t, Term mod, unsigned int n USES_REGS) { Functor f; Atom Name; register CELL *pt; @@ -370,8 +391,8 @@ restart_exec: } /* now let us do what we wanted to do from the beginning !! */ /* I cannot use the standard macro here because - otherwise I would dereference the argument and - might skip a svar */ + otherwise I would dereference the argument and + might skip a svar */ for (i = 1; i <= arity - n; i++) { #if YAPOR_SBA Term d0 = *pt++; @@ -390,7 +411,7 @@ restart_exec: } // enter locked -static Int EnterCreepMode(Term t, Term mod USES_REGS) { +static bool EnterCreepMode(Term t, Term mod USES_REGS) { PredEntry *PredCreep; if (Yap_get_signal(YAP_CDOVF_SIGNAL)) { @@ -424,10 +445,7 @@ static Int execute(USES_REGS1) { /* '$execute'(Goal) */ return do_execute(t, CurrentModule PASS_REGS); } -bool - -Yap_Execute( Term t USES_REGS ) -{ /* '$execute'(Goal) */ +bool Yap_Execute(Term t USES_REGS) { /* '$execute'(Goal) */ return do_execute(t, CurrentModule PASS_REGS); } @@ -604,8 +622,8 @@ restart_exec: return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS); } /* I cannot use the standard macro here because - otherwise I would dereference the argument and - might skip a svar */ + otherwise I would dereference the argument and + might skip a svar */ pt = RepAppl(t) + 1; for (i = 1; i <= arity; ++i) { #if YAPOR_SBA @@ -638,6 +656,383 @@ static Int execute_in_mod(USES_REGS1) { /* '$execute'(Goal) */ return do_execute(Deref(ARG1), Deref(ARG2) PASS_REGS); } +typedef enum { + CALLED_FROM_CALL = 0x1, + CALLED_FROM_ANSWER = 0x2, + CALLED_FROM_EXIT = 0x4, + CALLED_FROM_RETRY = 0x8, + CALLED_FROM_FAIL = 0x18, + CALLED_FROM_CUT = 0x20, + CALLED_FROM_EXCEPTION = 0x40, + CALLED_FROM_THROW = 0x80 +} execution_port; + +INLINE_ONLY inline bool called_from_forward(execution_port port) { + return port & (CALLED_FROM_EXIT | CALLED_FROM_CALL | CALLED_FROM_ANSWER | + CALLED_FROM_CUT | CALLED_FROM_THROW); +} + +INLINE_ONLY inline bool called_from_backward(execution_port port) { + return port & (CALLED_FROM_RETRY | CALLED_FROM_FAIL | CALLED_FROM_EXCEPTION); +} + +/** + * remove choice points created since a call to top-goal. + * + * @method prune_inner_computation + */ +static void prune_inner_computation(choiceptr parent) { + /* code */ + choiceptr cut_pt; + yamop *oP = P, *oCP = CP; + Int oENV = LCL0 - ENV; + + cut_pt = B; + while (cut_pt < parent) { + /* make sure we + e C-choicepoints */ + if (POP_CHOICE_POINT(cut_pt->cp_b)) { + POP_EXECUTE(); + } + cut_pt = cut_pt->cp_b; + } +#ifdef YAPOR + CUT_prune_to(cut_pt); +#endif + B = parent; + Yap_TrimTrail(); + LOCAL_AllowRestart = FALSE; + P = oP; + CP = oCP; + ENV = LCL0 - oENV; +} +/** + * restore abstract machine state + * after completing a computation. + * @method complete_inner_computation + */ +static void complete_inner_computation(choiceptr old_B) { + choiceptr myB = B; + if (myB == NULL) { + return; + } else if (myB->cp_b == old_B) { + B = old_B; +#ifdef DEPTH_LIMIT + DEPTH = myB->cp_depth; +#endif + } else if (myB->cp_b && myB->cp_b < old_B) { + while (myB->cp_b < old_B) { + // we're recovering from a non-deterministic computation... + myB = myB->cp_b; + } + } else { + return; + } + // restore environment at call... + CP = myB->cp_cp; + ENV = myB->cp_env; +} + +static inline Term *GetTermAddress(CELL a) { + Term *b = NULL; +restart: + if (!IsVarTerm(a)) { + return (b); + } else if (a == (CELL)b) { + return (b); + } else { + b = (CELL *)a; + a = *b; + goto restart; + } +} + +/** + * call a cleanup routine taking care with the status variable. + */ +static bool call_cleanup(Term t3, Term t4, Term cleanup, + choiceptr B0 USES_REGS) { + CELL *pt = GetTermAddress(t3); + DBTerm *ball = Yap_RefToException(); + if (pt == NULL) + return false; + *pt = cleanup; + bool out = Yap_RunTopGoal(t4, true); + if (out) { + prune_inner_computation(B0); + } else { + complete_inner_computation(B0); + } + pt = GetTermAddress(t3); + if (ball) + Yap_CopyException(ball); + if (pt == NULL) { + return false; + } + RESET_VARIABLE(pt); + return true; +} + +/** + * What to do when we exit a protected call + * @method exit_set_call + * @param exec_result result of call (0 or 1) + * @param b0 original choicepointer (pointed to by root) + * @param t3 state + * @param b0 user goal to call on port. + * + * @param USES_REGS [description] + * @return [description] + */ +static bool exit_set_call(execution_port exec_result, choiceptr B0, yamop *oCP, + Term t3, Term t4 USES_REGS) { + Term rc; + + switch (exec_result) { + // we failed + // Exception: we'll pass it through + case CALLED_FROM_EXCEPTION: + // internal exception + { + Term ball = Yap_PeekException(); + Term signal = Yap_MkApplTerm(FunctorException, 1, &ball); + rc = signal; + B = B0; + } + break; + case CALLED_FROM_THROW: + // internal exception + { + Term ball = Yap_PeekException(); + Term signal = Yap_MkApplTerm(FunctorException, 1, &ball); + rc = signal; + B = B0; + } + break; + case CALLED_FROM_RETRY: + // external exception + rc = TermRetry; + // internal failure + return true; + break; + case CALLED_FROM_FAIL: + B = B0; + rc = TermFail; + break; + case CALLED_FROM_EXIT: + // deterministic exit + rc = TermExit; + if (B->cp_b == B0) { + CP = B->cp_cp; + ENV = B->cp_env; + ASP = (CELL *)B; + B = B0; + } + break; + case CALLED_FROM_CUT: + if (B->cp_b == B0) { + CP = B->cp_cp; + ENV = B->cp_env; + ASP = (CELL *)B; + B = B0; + } + rc = TermCut; + break; + case CALLED_FROM_CALL: + // cut exit + rc = TermCall; + break; + case CALLED_FROM_ANSWER: + // cut exit + rc = TermAnswer; + // non deterministic + choiceptr saved_b = B; + CELL *pt = ASP; + CUT_C_PUSH( + NEXTOP(NEXTOP(PredProtectStack->cs.p_code.FirstClause, OtapFs), OtapFs), + pt); // this is where things get complicated, we need to + // protect the stack and be able to backtrack + pt -= 4; + pt[3] = t4; + pt[2] = t3; + pt[1] = MkAddressTerm(oCP); + pt[0] = MkIntegerTerm(LCL0 - (CELL *)B0); + B = (choiceptr)pt; + B--; + B->cp_h = HR; + B->cp_tr = TR; + B->cp_cp = oCP; + B->cp_ap = NEXTOP(PredProtectStack->cs.p_code.FirstClause, OtapFs); + B->cp_env = ENV; + B->cp_b = saved_b; +#ifdef DEPTH_LIMIT + B->cp_depth = saved_b->cp_depth; +#endif /* DEPTH_LIMIT */ + YENV = ASP = (CELL *)B; + YENV[E_CB] = (CELL)B; + HB = HR; + + return true; + } + call_cleanup(t3, t4, rc, B PASS_REGS); + + return true; +} + +static Int protect_stack_from_cut(USES_REGS1) { + // called after backtracking.. + /* reinitialize the engine */ + /* the first real choice-point will also have AP=FAIL */ + /* always have an empty slots for people to use */ + YENV = ASP = (CELL *)B; + call_cleanup(B->cp_a3, B->cp_a4, (P == FAILCODE ? TermException : TermCut), + B PASS_REGS); + return true; +} + +/** + * external backtrack to current stack frame: call method + * and control backtracking. + * + * @` + * method protect_stack_from_restore + * @param USES_REGS1 [env for threaded execution] + * @return c + [next answer] + */ +static Int protect_stack_from_retry(USES_REGS1) { + // called after backtracking.. + // + yamop *oP = P; + Int oENV = LCL0 - ENV; + yamop *oCP = (yamop *)AddressOfTerm(B->cp_a2); + Term t3 = B->cp_a3; + Term t4 = B->cp_a4; + Int b0 = IntegerOfTerm(ARG1); + choiceptr B0 = (choiceptr)(LCL0 - b0); + + cut_c_pop(); + + // call_cleanup(t3, t4, TermRetry, B0 USES_REGS); + // binding to t3 should be undone + // by next backtrack. + /* first, destroy the current choice-point, + */ + B = B->cp_b; + // B should lead to CP with _ystop,, + P = FAILCODE; + bool res = Yap_exec_absmi(false, CurrentModule); + /* reinitialize the engine */ + /* the first real choice-point will also have AP=FAIL */ + /* always have an empty slots for people to use */ + // ensure that we have slots where we need the + execution_port p; + if (res) { + if (Yap_HasException()) { + p = CALLED_FROM_THROW; + } else if (B->cp_b >= B0) { + p = CALLED_FROM_EXIT; + } else + p = CALLED_FROM_ANSWER; + } else { + if (Yap_HasException()) + p = CALLED_FROM_EXCEPTION; + else + p = CALLED_FROM_FAIL; + } + Int rc = exit_set_call(p, B0, oCP, t3, t4 PASS_REGS); + if (rc) { + CP = oCP; + P = oP; + ENV = LCL0 - oENV; + } + if (Yap_RaiseException()) + return false; + return res; +} + +/** + * First call to non deterministic predicate. Just leaves a choice-point + * hanging about for the future. + * + * @method protect_stack + * @param USES_REGS1 [env for threaded execution] + * @return [always succeed] + */ +static Int protect_stack(USES_REGS1) { + + // just create the choice-point; + return true; +} + +static Int setup_call_cleanup(USES_REGS1) { + Term Setup = Deref(ARG1); + Term cmod = CurrentModule; + Int oENV = LCL0 - ENV; + choiceptr B0 = B; + Term t3, t4; + yhandle_t hl = Yap_StartSlots(); + yhandle_t h2 = Yap_InitHandle(ARG2); + yhandle_t h3 = Yap_InitHandle(t3 = Deref(ARG3)); + yhandle_t h4 = Yap_InitHandle(ARG4); + yamop *oCP = CP, *oP = P; + bool rc; + + + Yap_DisableInterrupts(worker_id); + rc = Yap_RunTopGoal(Setup, false); + Yap_EnableInterrupts(worker_id); + if (Yap_RaiseException()) { + return false; + } + if (!rc) { + complete_inner_computation(B0); + // We'll pass it through + return false; + } else { + prune_inner_computation(B0); + } + // at this point starts actual goal execution.... + cmod = CurrentModule; + rc = Yap_RunTopGoal(Yap_GetFromSlot(h2), false); + complete_inner_computation(B); + t4 = Yap_GetFromSlot(h4); + t3 = Yap_GetFromSlot(h3); + // make sure that t3 point to our nice cell. + Yap_CloseSlots(hl); + + execution_port port; + if (rc) { + // ignore empty choice + while (B->cp_ap->opc == FAIL_OPCODE) + B = B->cp_b; + if (Yap_HasException()) { + port = CALLED_FROM_THROW; + } else if (B->cp_b < B0) { + port = CALLED_FROM_ANSWER; + } else { + port = CALLED_FROM_EXIT; + } + } else { + if (Yap_HasException()) + port = CALLED_FROM_EXCEPTION; + else + port = CALLED_FROM_FAIL; + } + // store the correct CP, ENV can be recovered from last env. + bool e = exit_set_call(port, B0, oCP, t3, t4 PASS_REGS); + // ensure we have same P + // also, we cannot trust recovered ENV and CP + if (e) { + P = oP; + CP = oCP; + ENV = LCL0 - oENV; + } + if (Yap_RaiseException()) + return false; + return rc; +} + static bool complete_ge(bool out, Term omod, yhandle_t sl, bool creeping) { CACHE_REGS if (creeping) { @@ -650,7 +1045,6 @@ static bool complete_ge(bool out, Term omod, yhandle_t sl, bool creeping) { return out; } - static Int _user_expand_goal(USES_REGS1) { yhandle_t sl = Yap_StartSlots(); Int creeping = Yap_get_signal(YAP_CREEP_SIGNAL); @@ -733,7 +1127,6 @@ static Int do_term_expansion(USES_REGS1) { return complete_ge(false, omod, sl, creeping); } - static Int execute0(USES_REGS1) { /* '$execute0'(Goal,Mod) */ Term t = Deref(ARG1), t0 = t; Term mod = Deref(ARG2); @@ -746,7 +1139,7 @@ static Int execute0(USES_REGS1) { /* '$execute0'(Goal,Mod) */ restart_exec: if (IsVarTerm(t)) { Yap_Error(INSTANTIATION_ERROR, ARG3, "call/1"); - return FALSE; + return false; } else if (IsAtomTerm(t)) { Atom a = AtomOfTerm(t); pe = PredPropByAtom(a, mod); @@ -772,14 +1165,14 @@ restart_exec: } } pe = PredPropByFunc(f, mod); - // Yap_DebugPlWrite(mod);fprintf(stderr,"\n"); + // Yap_DebugPlWrite(mod);ffprintf(stderr, stderr,"\n"); arity = ArityOfFunctor(f); if (arity > MaxTemps) { return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS); } /* I cannot use the standard macro here because - otherwise I would dereference the argument and - might skip a svar */ + otherwise I would dereference the argument and + might skip a svar */ pt = RepAppl(t) + 1; for (i = 1; i <= arity; ++i) { #if YAPOR_SBA @@ -794,7 +1187,7 @@ restart_exec: } } else { Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1"); - return FALSE; + return false; } /* N = arity; */ /* call may not define new system predicates!! */ @@ -803,7 +1196,7 @@ restart_exec: } static Int execute_nonstop(USES_REGS1) { /* '$execute_nonstop'(Goal,Mod) - */ + */ Term t = Deref(ARG1), t0 = t; Term mod = Deref(ARG2); unsigned int arity; @@ -849,8 +1242,8 @@ restart_exec: return CallError(TYPE_ERROR_CALLABLE, t, mod PASS_REGS); } /* I cannot use the standard macro here because - otherwise I would dereference the argument and - might skip a svar */ + otherwise I would dereference the argument and + might skip a svar */ pt = RepAppl(t) + 1; for (i = 1; i <= arity; ++i) { #if YAPOR_SBA @@ -925,18 +1318,18 @@ static Term slice_module_for_call_with_args(Term tin, Term *modp, int arity) { static Int execute_0(USES_REGS1) { /* '$execute_0'(Goal) */ Term mod = CurrentModule; Term t = slice_module_for_call_with_args(Deref(ARG1), &mod, 0); - if (!t) - return FALSE; + if (t == 0) + return false; return do_execute(t, mod PASS_REGS); } -static Int call_with_args(int i USES_REGS) { +static bool call_with_args(int i USES_REGS) { Term mod = CurrentModule, t; int j; t = slice_module_for_call_with_args(Deref(ARG1), &mod, i); - if (!t) - return FALSE; + if (t == 0) + return false; for (j = 0; j < i; j++) heap_store(Deref(XREGS[j + 2]) PASS_REGS); return (do_execute_n(t, mod, i PASS_REGS)); @@ -987,13 +1380,13 @@ static Int execute_depth_limit(USES_REGS1) { Term d = Deref(ARG2); if (IsVarTerm(d)) { Yap_Error(INSTANTIATION_ERROR, d, "depth_bound_call/2"); - return FALSE; + return false; } else if (!IsIntegerTerm(d)) { if (IsFloatTerm(d) && isinf(FloatOfTerm(d))) { DEPTH = RESET_DEPTH(); } else { Yap_Error(TYPE_ERROR_INTEGER, d, "depth_bound_call/2"); - return FALSE; + return false; } } else { DEPTH = MkIntTerm(IntegerOfTerm(d) * 2); @@ -1002,9 +1395,10 @@ static Int execute_depth_limit(USES_REGS1) { } #endif -static Int exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) { +static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) { int lval, out; - + Int OldBorder = LOCAL_CBorder; + LOCAL_CBorder = LCL0 - (CELL *)B; if (top && (lval = sigsetjmp(LOCAL_RestartEnv, 1)) != 0) { switch (lval) { case 1: { /* restart */ @@ -1027,17 +1421,20 @@ static Int exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) { } break; case 2: { /* arithmetic exception */ - /* must be done here, otherwise siglongjmp will clobber all the registers + /* must be done here, otherwise siglongjmp will clobber all the + * registers */ Yap_Error(LOCAL_matherror, TermNil, NULL); - /* reset the registers so that we don't have trash in abstract machine */ + /* reset the registers so that we don't have trash in abstract + * machine */ Yap_set_fpu_exceptions( getAtomicGlobalPrologFlag(ARITHMETIC_EXCEPTIONS_FLAG)); P = (yamop *)FAILCODE; LOCAL_PrologMode = UserMode; } break; case 3: { /* saved state */ - return false; + LOCAL_CBorder = OldBorder; + return false; } default: /* do nothing */ @@ -1053,14 +1450,15 @@ static Int exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) { Yap_get_signal(YAP_FAIL_SIGNAL); if (!Yap_has_a_signal()) CalculateStackGap(PASS_REGS1); - return out; + LOCAL_CBorder = OldBorder; + return out; } void Yap_PrepGoal(UInt arity, CELL *pt, choiceptr saved_b USES_REGS) { /* create an initial pseudo environment so that when garbage - collection is going up in the environment chain it doesn't get - confused */ - EX = NULL; + collection is going up in the environment chain it doesn't get + confused */ + Yap_ResetException(worker_id); // sl = Yap_InitSlot(t); YENV = ASP; YENV[E_CP] = (CELL)YESCODE; @@ -1100,9 +1498,9 @@ void Yap_PrepGoal(UInt arity, CELL *pt, choiceptr saved_b USES_REGS) { CP = YESCODE; } -static Int do_goal(yamop *CodeAdr, int arity, CELL *pt, bool top USES_REGS) { +static bool do_goal(yamop *CodeAdr, int arity, CELL *pt, bool top USES_REGS) { choiceptr saved_b = B; - Int out; + bool out; Yap_PrepGoal(arity, pt, saved_b PASS_REGS); P = (yamop *)CodeAdr; @@ -1110,33 +1508,40 @@ static Int do_goal(yamop *CodeAdr, int arity, CELL *pt, bool top USES_REGS) { PredPropByFunc(Yap_MkFunctor(AtomCall, 1), 0))); /* A1 mishaps */ out = exec_absmi(top, YAP_EXEC_ABSMI PASS_REGS); - Yap_flush(); + if (top) + Yap_flush(); // if (out) { // out = Yap_GetFromSlot(sl); // } // Yap_RecoverSlots(1); + LOCAL_PrologMode &= ~TopGoalMode; return out; } -Int Yap_exec_absmi(bool top, yap_reset_t has_reset) { +bool Yap_exec_absmi(bool top, yap_reset_t has_reset) { CACHE_REGS return exec_absmi(top, has_reset PASS_REGS); } +/** + * Fails computation up to choice-point bb + * @method Yap_fail_all + * @param USES_REGS [description] + */ void Yap_fail_all(choiceptr bb USES_REGS) { yamop *saved_p, *saved_cp; saved_p = P; saved_cp = CP; /* prune away choicepoints */ - while (B && B->cp_b != bb) { + while (B->cp_b && B->cp_b != bb && B->cp_ap != NOCODE) { B = B->cp_b; #ifdef YAPOR CUT_prune_to(B); #endif } P = FAILCODE; - Yap_exec_absmi(true, YAP_EXEC_ABSMI); + exec_absmi(true, YAP_EXEC_ABSMI PASS_REGS); /* recover stack space */ HR = B->cp_h; TR = B->cp_tr; @@ -1154,31 +1559,34 @@ void Yap_fail_all(choiceptr bb USES_REGS) { } ENV = (CELL *)(ENV[E_E]); /* ASP should be set to the top of the local stack when we - did the call */ + did the call */ ASP = B->cp_env; /* YENV should be set to the current environment */ YENV = ENV = (CELL *)((B->cp_env)[E_E]); - B = B->cp_b; + if (B->cp_b) { + B = B->cp_b; + } // SET_BB(B); HB = PROTECT_FROZEN_H(B); CP = saved_cp; P = saved_p; } -int Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) { +bool Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) { yamop *saved_p, *saved_cp; yamop *CodeAdr; - Int out; + bool out; saved_p = P; saved_cp = CP; + LOCAL_PrologMode |= TopGoalMode; PELOCK(81, ppe); CodeAdr = ppe->CodeOfPred; UNLOCK(ppe->PELock); out = do_goal(CodeAdr, ppe->ArityOfPE, pt, false PASS_REGS); - if (out == 1) { + if (out) { choiceptr cut_B; /* we succeeded, let's prune */ /* restore the old environment */ @@ -1186,7 +1594,7 @@ int Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) { cut_B = (choiceptr)ENV[E_CB]; { /* Note that - cut_B == (choiceptr)ENV[E_CB] */ + cut_B == (choiceptr)ENV[E_CB] */ while (POP_CHOICE_POINT(ENV[E_CB])) { POP_EXECUTE(); } @@ -1213,19 +1621,17 @@ int Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) { #endif ENV = (CELL *)(ENV[E_E]); /* we have failed, and usually we would backtrack to this B, - trouble is, we may also have a delayed cut to do */ + trouble is, we may also have a delayed cut to do */ if (B != NULL) HB = B->cp_h; YENV = ENV; // should we catch the exception or pass it through? // We'll pass it through - if (EX && pass_ex) { - Term ball = Yap_PopTermFromDB(EX); - EX = NULL; - Yap_JumpToEnv(ball); - return FALSE; + if (pass_ex && Yap_HasException()) { + Yap_RaiseException(); + return false; } - return TRUE; + return true; } else if (out == 0) { P = saved_p; CP = saved_cp; @@ -1234,7 +1640,7 @@ int Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) { DEPTH = B->cp_depth; #endif /* ASP should be set to the top of the local stack when we - did the call */ + did the call */ ASP = B->cp_env; /* YENV should be set to the current environment */ YENV = ENV = (CELL *)((B->cp_env)[E_E]); @@ -1243,27 +1649,25 @@ int Yap_execute_pred(PredEntry *ppe, CELL *pt, bool pass_ex USES_REGS) { HB = PROTECT_FROZEN_H(B); // should we catch the exception or pass it through? // We'll pass it through - if (EX && pass_ex) { - Term ball = Yap_PopTermFromDB(EX); - EX = NULL; - Yap_JumpToEnv(ball); - return FALSE; + if (pass_ex) { + Yap_RaiseException(); } - return (FALSE); + return false; } else { Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "emulator crashed"); - return (FALSE); + return false; } } -Int Yap_execute_goal(Term t, int nargs, Term mod, bool pass_ex) { +bool Yap_execute_goal(Term t, int nargs, Term mod, bool pass_ex) { CACHE_REGS Prop pe; PredEntry *ppe; CELL *pt; /* preserve the current restart environment */ /* visualc*/ - /* just keep the difference because of possible garbage collections */ + /* just keep the difference because of possible garbage collections + */ if (IsAtomTerm(t)) { Atom a = AtomOfTerm(t); @@ -1274,16 +1678,16 @@ Int Yap_execute_goal(Term t, int nargs, Term mod, bool pass_ex) { if (IsBlobFunctor(f)) { Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1"); - return (FALSE); + return false; } /* I cannot use the standard macro here because - otherwise I would dereference the argument and - might skip a svar */ + otherwise I would dereference the argument and + might skip a svar */ pt = RepAppl(t) + 1; pe = PredPropByFunc(f, mod); } else { Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1"); - return (FALSE); + return false; } ppe = RepPredProp(pe); if (pe == NIL) { @@ -1310,7 +1714,7 @@ void Yap_trust_last(void) { } } -Term Yap_RunTopGoal(Term t) { +Term Yap_RunTopGoal(Term t, bool handle_errors) { CACHE_REGS yamop *CodeAdr; Prop pe; @@ -1319,9 +1723,14 @@ Term Yap_RunTopGoal(Term t) { UInt arity; Term mod = CurrentModule; Term goal_out = 0; + LOCAL_PrologMode |= TopGoalMode; restart_runtopgoal: - if (IsAtomTerm(t)) { + if (IsVarTerm(t)) { + Yap_Error(INSTANTIATION_ERROR, t, "call/1"); + LOCAL_PrologMode &= ~TopGoalMode; + return (FALSE); + } else if (IsAtomTerm(t)) { Atom a = AtomOfTerm(t); pt = NULL; pe = PredPropByAtom(a, CurrentModule); @@ -1331,6 +1740,7 @@ restart_runtopgoal: if (IsBlobFunctor(f)) { Yap_Error(TYPE_ERROR_CALLABLE, t, "call/1"); + LOCAL_PrologMode &= ~TopGoalMode; return (FALSE); } if (f == FunctorModule) { @@ -1345,22 +1755,25 @@ restart_runtopgoal: } else { Yap_Error(TYPE_ERROR_ATOM, t, "call/1"); } + LOCAL_PrologMode &= ~TopGoalMode; return FALSE; } } /* I cannot use the standard macro here because - otherwise I would dereference the argument and - might skip a svar */ + otherwise I would dereference the argument and + might skip a svar */ pe = PredPropByFunc(f, mod); pt = RepAppl(t) + 1; arity = ArityOfFunctor(f); } else { Yap_Error(TYPE_ERROR_CALLABLE, Yap_PredicateIndicator(t, mod), "call/1"); + LOCAL_PrologMode &= ~TopGoalMode; return (FALSE); } ppe = RepPredProp(pe); if (pe == NIL) { /* we must always start the emulator with Prolog code */ + LOCAL_PrologMode &= ~TopGoalMode; return FALSE; } PELOCK(82, ppe); @@ -1374,7 +1787,7 @@ restart_runtopgoal: "unable to boot because of too little Trail space"); } #endif - goal_out = do_goal(CodeAdr, arity, pt, true PASS_REGS); + goal_out = do_goal(CodeAdr, arity, pt, handle_errors PASS_REGS); return goal_out; } @@ -1409,7 +1822,9 @@ static Int restore_regs(USES_REGS1) { return (TRUE); } -/* low level voodoo to cut and then restore temporary registers after a call */ +/* low level voodoo to cut and then restore temporary registers after + * a + * call */ static Int restore_regs2(USES_REGS1) { Term t = Deref(ARG1), d0; @@ -1527,17 +1942,12 @@ bool Yap_Reset(yap_reset_t mode) { CACHE_REGS int res = TRUE; - if (EX) { - LOCAL_BallTerm = EX; - } - EX = NULL; - Yap_ResetExceptionTerm(0); - LOCAL_UncaughtThrow = FALSE; + Yap_ResetException(worker_id); /* first, backtrack to the root */ while (B->cp_b) { B = B->cp_b; } - // B shoul lead to CP with _ystop0,, + // B shoul lead to CP with _ystop0, P = FAILCODE; res = Yap_exec_absmi(true, mode); /* reinitialize the engine */ @@ -1564,111 +1974,86 @@ bool is_cleanup_cp(choiceptr cp_b) { pe = cp_b->cp_ap->y_u.p.p; #endif /* YAPOR */ /* - it has to be a cleanup and it has to be a completed goal, - otherwise the throw will be caught anyway. - */ + it has to be a cleanup and it has to be a completed goal, + otherwise the throw will be caught anyway. + */ return pe == PredSafeCallCleanup; } -static Int JumpToEnv(Term t USES_REGS) { -#ifndef YAPOR - yamop *pos = NEXTOP(PredDollarCatch->cs.p_code.TrueCodeOfPred, l), - *catchpos = NEXTOP(PredHandleThrow->cs.p_code.TrueCodeOfPred, l); -#else - yamop *pos = NEXTOP(PredDollarCatch->cs.p_code.TrueCodeOfPred, Otapl), - *catchpos = NEXTOP(PredHandleThrow->cs.p_code.TrueCodeOfPred, Otapl); -#endif - CELL *env, *env1; - choiceptr handler, previous = NULL; - - /* throws cannot interrupt throws */ - if (EX) - return FALSE; - /* just keep the throwed object away, we don't need to care about it */ - if (!(LOCAL_BallTerm = Yap_StoreTermInDB(t, 0))) { - Yap_RestartYap(1); - } +static Int JumpToEnv() { + choiceptr handler = B, oh = NULL; + /* just keep the throwm object away, we don't need to care about it + */ /* careful, previous step may have caused a stack shift, - so get pointers here */ - handler = B; - env1 = ENV; - do { - /* find the first choicepoint that may be a catch */ - while (handler && handler->cp_ap != pos) { - /* we are already doing a catch */ - if (handler->cp_ap == catchpos || handler->cp_ap == NOCODE) { - P = (yamop *)FAILCODE; - /* make sure failure will be seen at next port */ - if (LOCAL_PrologMode & AsyncIntMode) { - Yap_signal(YAP_FAIL_SIGNAL); - } - HB = handler->cp_h; - B = handler; - return TRUE; - } - /* make sure we prune C-choicepoints */ - while (POP_CHOICE_POINT(handler->cp_b)) { - POP_EXECUTE(); - } - handler = handler->cp_b; + so get pointers here */ + /* find the first choicepoint that may be a catch */ + //DBTerm *dbt = Yap_RefToException(); + while (handler && + Yap_PredForChoicePt(handler, NULL) != PredDollarCatch) { + while (POP_CHOICE_POINT(handler)) { + POP_FAIL_EXECUTE(handler); } - /* uncaught throw */ - if (handler == NULL) { - LOCAL_UncaughtThrow = TRUE; - Yap_RestartYap(1); - } - /* is it a continuation? */ - env = handler->cp_env; - while (env > env1) { - env1 = ENV_Parent(env1); - } - /* yes, we found it ! */ - // while (env < ENV) - // env = ENV_Paren t(env); - if (env == env1) { - break; - } - /* oops, try next */ - handler = handler->cp_b; - } while (TRUE); - /* step one environment above, otherwise we'll redo the original goal */ - if (previous == NULL) { - B = handler; - } else { - // EX = t; - previous->cp_b = handler; + /* we are already doing a catch */ + /* make sure we prune C-choicepoints */ + if (handler->cp_ap == NOCODE && handler >= (choiceptr)(LCL0 - LOCAL_CBorder)) { + break; + } + oh = handler; + handler = handler->cp_b; } - /* make sure we get rid of trash in the trail */ - handler->cp_cp = (yamop *)env[E_CP]; - handler->cp_env = (CELL *)env[E_E]; - handler->cp_ap = catchpos; - - /* can recover Heap thanks to copy term :-( */ - /* B->cp_h = H; */ - /* I could backtrack here, but it is easier to leave the unwinding - to the emulator */ if (LOCAL_PrologMode & AsyncIntMode) { Yap_signal(YAP_FAIL_SIGNAL); } - P = (yamop *)FAILCODE; - HB = B->cp_h; + POP_FAIL(handler); + B = handler; + //Yap_CopyException(ref); + if (Yap_PredForChoicePt(B, NULL) == PredDollarCatch) { + /* can recover Heap thanks to copy term :-( */ + /* B->cp_h = H; */ + /* I could backtrack here, but it is easier to leave the unwinding + to the emulator */ + // handler->cp_h = HR; /* try to recover space */ /* can only do that when we recover space */ - /* first, simulate backtracking */ - /* so that I will execute op_fail */ - return TRUE; + /* first, backtrack */ + /* so that I recover memory execute op_fail */ + // now put the ball in place + //Yap_CopyException(dbt); + Term t = Yap_GetException(); + if (t == 0) { + return false; + } + t = Yap_MkApplTerm(FunctorThrow, 1, &t); + B->cp_h = HR; + HB = HR; + Yap_unify(t, B->cp_a2); + B->cp_tr = TR; + } + P = FAILCODE; + return true; } -Int Yap_JumpToEnv(Term t) { +bool Yap_JumpToEnv(Term t) { CACHE_REGS - if (LOCAL_PrologMode & BootMode) { - return FALSE; - } - return JumpToEnv(t PASS_REGS); + LOCAL_BallTerm = Yap_StoreTermInDB(t, 0); + if (!LOCAL_BallTerm) + return false; + if (LOCAL_PrologMode & TopGoalMode) + return true; + return JumpToEnv(PASS_REGS); } /* This does very nasty stuff!!!!! */ -static Int jump_env(USES_REGS1) { return (JumpToEnv(Deref(ARG1) PASS_REGS)); } +static Int jump_env(USES_REGS1) { + Term t = Deref(ARG1); + Yap_PutException(t); + bool out = JumpToEnv(PASS_REGS1); + if (P == FAILCODE && B->cp_ap == NOCODE && LCL0-(CELL*)B > LOCAL_CBorder) { + // we're failing up to the top layer + LOCAL_Error_TYPE = THROW_EVENT; + } + return out; +} /* set up a meta-call based on . context info */ static Int generate_pred_info(USES_REGS1) { @@ -1683,7 +2068,7 @@ void Yap_InitYaamRegs(int myworker_id) { // getchar(); #if PUSH_REGS /* Guarantee that after a longjmp we go back to the original abstract - machine registers */ + machine registers */ #ifdef THREADS if (myworker_id) { REGSTORE *rs = REMOTE_ThreadHandle(myworker_id).default_yaam_regs; @@ -1696,7 +2081,7 @@ void Yap_InitYaamRegs(int myworker_id) { #endif #endif /* PUSH_REGS */ CACHE_REGS - Yap_ResetExceptionTerm(myworker_id); + Yap_ResetException(worker_id); Yap_PutValue(AtomBreak, MkIntTerm(0)); TR = (tr_fr_ptr)REMOTE_TrailBase(myworker_id); HR = H0 = ((CELL *)REMOTE_GlobalBase(myworker_id)) + @@ -1759,58 +2144,47 @@ void Yap_InitYaamRegs(int myworker_id) { #endif } -static Int uncaught_throw(USES_REGS1) { - Int out = LOCAL_UncaughtThrow; - LOCAL_UncaughtThrow = FALSE; /* just caught it */ - return out; -} - Term Yap_GetException(void) { CACHE_REGS - Term t = 0L; + Term t = 0; + if (LOCAL_BallTerm) { - do { - t = Yap_PopTermFromDB(LOCAL_BallTerm); - if (t == 0) { - if (LOCAL_Error_TYPE == RESOURCE_ERROR_ATTRIBUTED_VARIABLES) { - LOCAL_Error_TYPE = YAP_NO_ERROR; - if (!Yap_growglobal(NULL)) { - Yap_Error(RESOURCE_ERROR_ATTRIBUTED_VARIABLES, TermNil, - LOCAL_ErrorMessage); - return FALSE; - } - } else { - LOCAL_Error_TYPE = YAP_NO_ERROR; - if (!Yap_growstack(LOCAL_BallTerm->NOfCells * CellSize)) { - Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); - return FALSE; - } - } - } - } while (t == 0); - LOCAL_BallTerm = NULL; + t = Yap_PopTermFromDB(LOCAL_BallTerm); } + LOCAL_BallTerm = NULL; return t; } -static Int reset_exception(USES_REGS1) { - Term t; - EX = NULL; - t = Yap_GetException(); - if (!t) - return FALSE; - return Yap_unify(t, ARG1); +Term Yap_PeekException(void) { return Yap_FetchTermFromDB(LOCAL_BallTerm); } + +bool Yap_RaiseException(void) { + if (LOCAL_BallTerm == NULL) + return false; + return JumpToEnv(); } -void Yap_ResetExceptionTerm(int wid) { - Yap_ReleaseTermFromDB(REMOTE_BallTerm(wid)); - REMOTE_BallTerm(wid) = NULL; +bool Yap_PutException(Term t) { + CACHE_REGS + if ((LOCAL_BallTerm = Yap_StoreTermInDB(t, 0)) != NULL) + return true; + + return false; } +bool Yap_ResetException(int wid) { + if (REMOTE_BallTerm(wid)) { + Yap_PopTermFromDB(REMOTE_BallTerm(wid)); + } + REMOTE_BallTerm(wid) = NULL; + return true; +} + +static Int reset_exception(USES_REGS1) { return Yap_ResetException(worker_id); } + static Int get_exception(USES_REGS1) { Term t = Yap_GetException(); - if (!t) - return FALSE; + if (t == 0) + return false; return Yap_unify(t, ARG1); } @@ -1879,7 +2253,6 @@ void Yap_InitExecFs(void) { Yap_InitCPred("current_choice_point", 1, current_choice_point, 0); Yap_InitCPred("current_choicepoint", 1, current_choice_point, 0); Yap_InitCPred("env_choice_point", 1, save_env_b, 0); - Yap_InitCPred("trail_suspension_marker", 1, trail_suspension_marker, 0); Yap_InitCPred("cut_at", 1, clean_ifcp, SafePredFlag); CurrentModule = cm; Yap_InitCPred("$restore_regs", 1, restore_regs, @@ -1891,9 +2264,11 @@ void Yap_InitExecFs(void) { SafePredFlag); Yap_InitCPred("$jump_env_and_store_ball", 1, jump_env, 0); Yap_InitCPred("$generate_pred_info", 4, generate_pred_info, 0); - Yap_InitCPred("$uncaught_throw", 0, uncaught_throw, 0); Yap_InitCPred("$reset_exception", 1, reset_exception, 0); Yap_InitCPred("_user_expand_goal", 2, _user_expand_goal, 0); Yap_InitCPred("$do_term_expansion", 2, do_term_expansion, 0); Yap_InitCPred("$get_exception", 1, get_exception, 0); + Yap_InitCPred("$setup_call_catcher_cleanup", 4, setup_call_cleanup, 0); + Yap_InitCPredBackCut("$protect_stack", 4, 0, protect_stack, + protect_stack_from_retry, protect_stack_from_cut, 0); } diff --git a/C/fli_absmi_insts.h b/C/fli_absmi_insts.h index 018a807f6..d0e52c61d 100644 --- a/C/fli_absmi_insts.h +++ b/C/fli_absmi_insts.h @@ -2,7 +2,6 @@ * Call C predicates instructions * \************************************************************************/ - #ifdef INDENT_CODE { { @@ -11,43 +10,48 @@ BOp(call_cpred, Osbpp); #if __ANDROID__ && STRONG_DEBUG - char *s; Atom name; + char *s; + Atom name; if (PREG->y_u.Osbpp.p->ArityOfPE) { - Functor f = PREG->y_u.Osbpp.p->FunctorOfPred; - name = f->NameOfFE; + Functor f = PREG->y_u.Osbpp.p->FunctorOfPred; + name = f->NameOfFE; } else { - name = (Atom)(PREG->y_u.Osbpp.p->FunctorOfPred); + name = (Atom)(PREG->y_u.Osbpp.p->FunctorOfPred); } s = name->StrOfAE; - LOG( " %s ", s); + LOG(" %s ", s); #endif check_trail(TR); - if (!(PREG->y_u.Osbpp.p->PredFlags & (SafePredFlag|NoTracePredFlag|HiddenPredFlag))) { + if (!(PREG->y_u.Osbpp.p->PredFlags & + (SafePredFlag | NoTracePredFlag | HiddenPredFlag))) { CACHE_Y_AS_ENV(YREG); check_stack(NoStackCCall, HR); ENDCACHE_Y_AS_ENV(); } - do_c_call: + do_c_call : #ifdef FROZEN_STACKS - { - choiceptr top_b = PROTECT_FROZEN_B(B); + { + choiceptr top_b = PROTECT_FROZEN_B(B); #ifdef YAPOR_SBA - if (YREG > (CELL *) top_b || YREG < HR) ASP = (CELL *)top_b; + if (YREG > (CELL *)top_b || YREG < HR) + ASP = (CELL *)top_b; #else - if (YREG > (CELL *) top_b) ASP = (CELL *)top_b; + if (YREG > (CELL *)top_b) + ASP = (CELL *)top_b; #endif /* YAPOR_SBA */ - else ASP = (CELL *)(((char *)YREG) + PREG->y_u.Osbpp.s); - } + else + ASP = (CELL *)(((char *)YREG) + PREG->y_u.Osbpp.s); + } #else SET_ASP(YREG, PREG->y_u.Osbpp.s); - /* for slots to work */ +/* for slots to work */ #endif /* FROZEN_STACKS */ #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) - low_level_trace(enter_pred,PREG->y_u.Osbpp.p,XREGS+1); -#endif /* LOW_LEVEL_TRACE */ + low_level_trace(enter_pred, PREG->y_u.Osbpp.p, XREGS + 1); +#endif /* LOW_LEVEL_TRACE */ BEGD(d0); CPredicate f = PREG->y_u.Osbpp.p->cs.f_code; PREG = NEXTOP(PREG, Osbpp); @@ -79,29 +83,32 @@ CACHE_Y_AS_ENV(YREG); #ifndef NO_CHECKING check_stack(NoStackExecuteC, HR); - do_executec: + do_executec : #endif #ifdef FROZEN_STACKS - { - choiceptr top_b = PROTECT_FROZEN_B(B); + { + choiceptr top_b = PROTECT_FROZEN_B(B); #ifdef YAPOR_SBA - if (YREG > (CELL *) top_b || YREG < HR) ASP = (CELL *)top_b; + if (YREG > (CELL *)top_b || YREG < HR) + ASP = (CELL *)top_b; #else - if (YREG > (CELL *) top_b) ASP = (CELL *)top_b; + if (YREG > (CELL *)top_b) + ASP = (CELL *)top_b; #endif /* YAPOR_SBA */ - else ASP = YREG+E_CB; - } + else + ASP = YREG + E_CB; + } #else - SET_ASP(YREG, E_CB*sizeof(CELL)); - /* for slots to work */ + SET_ASP(YREG, E_CB * sizeof(CELL)); +/* for slots to work */ #endif /* FROZEN_STACKS */ pt0 = PREG->y_u.pp.p; #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) { - low_level_trace(enter_pred,pt0,XREGS+1); + low_level_trace(enter_pred, pt0, XREGS + 1); } -#endif /* LOW_LEVEL_TRACE */ +#endif /* LOW_LEVEL_TRACE */ CACHE_A1(); BEGD(d0); d0 = (CELL)B; @@ -110,18 +117,18 @@ ENV_YREG[E_CB] = d0; ENDD(d0); #ifdef DEPTH_LIMIT - if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is prolog */ + if (DEPTH <= MkIntTerm(1)) { /* I assume Module==0 is prolog */ if (pt0->ModuleOfPred) { if (DEPTH == MkIntTerm(0)) { FAIL(); - } else{ - DEPTH = RESET_DEPTH(); - } + } else { + DEPTH = RESET_DEPTH(); + } } } else if (pt0->ModuleOfPred) { DEPTH -= MkIntConstant(2); } -#endif /* DEPTH_LIMIT */ +#endif /* DEPTH_LIMIT */ /* now call C-Code */ { CPredicate f = PREG->y_u.pp.p->cs.f_code; @@ -169,25 +176,29 @@ do_user_call: #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) { - low_level_trace(enter_pred,PREG->y_u.Osbpp.p,XREGS+1); + low_level_trace(enter_pred, PREG->y_u.Osbpp.p, XREGS + 1); } -#endif /* LOW_LEVEL_TRACE */ +#endif /* LOW_LEVEL_TRACE */ #ifdef FROZEN_STACKS { choiceptr top_b = PROTECT_FROZEN_B(B); #ifdef YAPOR_SBA - if (YREG > (CELL *) top_b || YREG < HR) ASP = (CELL *) top_b; + if (YREG > (CELL *)top_b || YREG < HR) + ASP = (CELL *)top_b; #else - if (YREG > (CELL *) top_b) ASP = (CELL *) top_b; + if (YREG > (CELL *)top_b) + ASP = (CELL *)top_b; #endif /* YAPOR_SBA */ - else ASP = (CELL *)(((char *)YREG) + PREG->y_u.Osbpp.s); + else + ASP = (CELL *)(((char *)YREG) + PREG->y_u.Osbpp.s); } #else SET_ASP(YREG, PREG->y_u.Osbpp.s); - /* for slots to work */ +/* for slots to work */ #endif /* FROZEN_STACKS */ { - /* make sure that we can still have access to our old PREG after calling user defined goals and backtracking or failing */ + /* make sure that we can still have access to our old PREG after calling + * user defined goals and backtracking or failing */ yamop *savedP; LOCAL_PrologMode |= UserCCallMode; @@ -199,17 +210,15 @@ saveregs(); save_machine_regs(); - SREG = (CELL *) YAP_Execute(p, p->cs.f_code); + SREG = (CELL *)YAP_Execute(p, p->cs.f_code); } setregs(); LOCAL_PrologMode &= ~UserCCallMode; restore_machine_regs(); PREG = savedP; } - if (EX) { - struct DB_TERM *exp = EX; - EX = NULL; - Yap_JumpToEnv(Yap_PopTermFromDB(exp)); + if (Yap_HasException()) { + Yap_RaiseException(); SREG = NULL; } if (!SREG) { @@ -228,16 +237,18 @@ BOp(call_c_wfail, slpp); #ifdef LOW_LEVEL_TRACER if (Yap_do_low_level_trace) { - low_level_trace(enter_pred,PREG->y_u.slpp.p,XREGS+1); + low_level_trace(enter_pred, PREG->y_u.slpp.p, XREGS + 1); } -#endif /* LOW_LEVEL_TRACE */ +#endif /* LOW_LEVEL_TRACE */ #ifdef FROZEN_STACKS { choiceptr top_b = PROTECT_FROZEN_B(B); #ifdef YAPOR_SBA - if (YREG > (CELL *) top_b || YREG < HR) ASP = (CELL *) top_b; + if (YREG > (CELL *)top_b || YREG < HR) + ASP = (CELL *)top_b; #else - if (YREG > (CELL *) top_b) ASP = (CELL *) top_b; + if (YREG > (CELL *)top_b) + ASP = (CELL *)top_b; #endif /* YAPOR_SBA */ else { BEGD(d0); @@ -247,12 +258,12 @@ } } #else - if (YREG > (CELL *) B) - ASP = (CELL *) B; + if (YREG > (CELL *)B) + ASP = (CELL *)B; else { BEGD(d0); d0 = PREG->y_u.slpp.s; - ASP = ((CELL *) YREG) + d0; + ASP = ((CELL *)YREG) + d0; ENDD(d0); } #endif /* FROZEN_STACKS */ @@ -279,14 +290,14 @@ #endif /* YAPOR */ CACHE_Y(YREG); /* Alocate space for the cut_c structure*/ - CUT_C_PUSH(NEXTOP(NEXTOP(PREG,OtapFs),OtapFs),S_YREG); + CUT_C_PUSH(NEXTOP(NEXTOP(PREG, OtapFs), OtapFs), S_YREG); S_YREG = S_YREG - PREG->y_u.OtapFs.extra; store_args(PREG->y_u.OtapFs.s); - store_yaam_regs(NEXTOP(PREG, OtapFs), 0); + store_yaam_regs(NEXTOP(P, OtapFs), 0); B = B_YREG; #ifdef YAPOR SCH_set_load(B_YREG); -#endif /* YAPOR */ +#endif /* YAPOR */ SET_BB(B_YREG); ENDCACHE_Y(); @@ -295,9 +306,9 @@ { CPredicate f = (CPredicate)(PREG->y_u.OtapFs.f); saveregs(); - SREG = (CELL *) ((f) (PASS_REGS1)); + SREG = (CELL *)((f)(PASS_REGS1)); /* This last instruction changes B B*/ - while (POP_CHOICE_POINT(B)){ + while (POP_CHOICE_POINT(B)) { cut_c_pop(); } setregs(); @@ -306,11 +317,11 @@ /* Removes the cut functions from the stack without executing them because we have fail and not cuted the predicate*/ - while(POP_CHOICE_POINT(B)) + while (POP_CHOICE_POINT(B)) cut_c_pop(); FAIL(); } - if ((CELL *) B == YREG && ASP != (CELL *) B) { + if ((CELL *)B == YREG && ASP != (CELL *)B) { /* as Luis says, the predicate that did the try C might * have left some data on the stack. We should preserve * it, unless the builtin also did cut */ @@ -332,7 +343,7 @@ ENV = B_YREG->cp_env; HR = PROTECT_FROZEN_H(B); #ifdef DEPTH_LIMIT - DEPTH =B->cp_depth; + DEPTH = B->cp_depth; #endif HBREG = HR; restore_args(PREG->y_u.OtapFs.s); @@ -341,11 +352,12 @@ ENDBOp(); BOp(cut_c, OtapFs); - /*This is a phantom instruction. This is not executed by the WAM*/ +/*This is a phantom instruction. This is not executed by the WAM*/ #ifdef DEBUG /*If WAM executes this instruction, probably there's an error when we put this instruction, cut_c, after retry_c*/ - printf ("ERROR: Should not print this message FILE: absmi.c %d\n",__LINE__); + printf("ERROR: Should not print this message FILE: absmi.c %d\n", + __LINE__); #endif /*DEBUG*/ ENDBOp(); @@ -355,7 +367,7 @@ #endif /* YAPOR */ CACHE_Y(YREG); /* Alocate space for the cut_c structure*/ - CUT_C_PUSH(NEXTOP(NEXTOP(PREG,OtapFs),OtapFs),S_YREG); + CUT_C_PUSH(NEXTOP(NEXTOP(PREG, OtapFs), OtapFs), S_YREG); S_YREG = S_YREG - PREG->y_u.OtapFs.extra; store_args(PREG->y_u.OtapFs.s); store_yaam_regs(NEXTOP(PREG, OtapFs), 0); @@ -369,15 +381,16 @@ ASP = YREG; saveregs(); save_machine_regs(); - SREG = (CELL *) YAP_ExecuteFirst(PREG->y_u.OtapFs.p, (CPredicate)(PREG->y_u.OtapFs.f)); - EX = NULL; + SREG = (CELL *)YAP_ExecuteFirst(PREG->y_u.OtapFs.p, + (CPredicate)(PREG->y_u.OtapFs.f)); + Yap_ResetException( worker_id ); restore_machine_regs(); setregs(); LOCAL_PrologMode &= UserMode; if (!SREG) { FAIL(); } - if ((CELL *) B == YREG && ASP != (CELL *) B) { + if ((CELL *)B == YREG && ASP != (CELL *)B) { /* as Luis says, the predicate that did the try C might * have left some data on the stack. We should preserve * it, unless the builtin also did cut */ @@ -399,18 +412,19 @@ ENV = B_YREG->cp_env; HR = PROTECT_FROZEN_H(B); #ifdef DEPTH_LIMIT - DEPTH =B->cp_depth; + DEPTH = B->cp_depth; #endif HBREG = HR; restore_args(PREG->y_u.OtapFs.s); ENDCACHE_Y(); LOCAL_PrologMode |= UserCCallMode; - SET_ASP(YREG, E_CB*sizeof(CELL)); + SET_ASP(YREG, E_CB * sizeof(CELL)); saveregs(); save_machine_regs(); - SREG = (CELL *) YAP_ExecuteNext(PREG->y_u.OtapFs.p, (CPredicate)(PREG->y_u.OtapFs.f)); - EX = NULL; + SREG = (CELL *)YAP_ExecuteNext(PREG->y_u.OtapFs.p, + (CPredicate)(PREG->y_u.OtapFs.f)); + Yap_ResetException( worker_id); restore_machine_regs(); setregs(); LOCAL_PrologMode &= ~UserCCallMode; @@ -418,11 +432,11 @@ /* Removes the cut functions from the stack without executing them because we have fail and not cuted the predicate*/ - while(POP_CHOICE_POINT(B)) + while (POP_CHOICE_POINT(B)) cut_c_pop(); FAIL(); } - if ((CELL *) B == YREG && ASP != (CELL *) B) { + if ((CELL *)B == YREG && ASP != (CELL *)B) { /* as Luis says, the predicate that did the try C might * have left some data on the stack. We should preserve * it, unless the builtin also did cut */ @@ -436,17 +450,17 @@ ENDBOp(); BOp(cut_userc, OtapFs); - /*This is a phantom instruction. This is not executed by the WAM*/ +/*This is a phantom instruction. This is not executed by the WAM*/ #ifdef DEBUG /*If WAM executes this instruction, probably there's an error when we put this instruction, cut_userc, after retry_userc*/ - printf ("ERROR: Should not print this message FILE: absmi.c %d\n",__LINE__); + printf("ERROR: Should not print this message FILE: absmi.c %d\n", + __LINE__); #endif /*DEBUG*/ CACHE_A1(); JMPNext(); ENDBOp(); - /************************************************************************\ * support instructions * \************************************************************************/ @@ -454,10 +468,10 @@ BOp(lock_pred, e); { PredEntry *ap = PredFromDefCode(PREG); - PELOCK(10,ap); + PELOCK(10, ap); PP = ap; if (!ap->cs.p_code.NOfClauses) { - UNLOCKPE(11,ap); + UNLOCKPE(11, ap); FAIL(); } /* @@ -467,10 +481,11 @@ if (ap->cs.p_code.NOfClauses > 1 && !(ap->PredFlags & IndexedPredFlag)) { /* update ASP before calling IPred */ - SET_ASP(YREG, E_CB*sizeof(CELL)); + SET_ASP(YREG, E_CB * sizeof(CELL)); saveregs(); Yap_IPred(ap, 0, CP); - /* IPred can generate errors, it thus must get rid of the lock itself */ + /* IPred can generate errors, it thus must get rid of the lock itself + */ setregs(); CACHE_A1(); /* for profiler */ @@ -490,12 +505,12 @@ we must take extra care here */ if (!PP) { - PELOCK(11,ap); + PELOCK(11, ap); } if (ap->OpcodeOfPred != INDEX_OPCODE) { /* someone was here before we were */ if (!PP) { - UNLOCKPE(11,ap); + UNLOCKPE(11, ap); } PREG = ap->CodeOfPred; /* for profiler */ @@ -504,7 +519,7 @@ } #endif /* update ASP before calling IPred */ - SET_ASP(YREG, E_CB*sizeof(CELL)); + SET_ASP(YREG, E_CB * sizeof(CELL)); saveregs(); Yap_IPred(ap, 0, CP); /* IPred can generate errors, it thus must get rid of the lock itself */ @@ -516,8 +531,7 @@ #if defined(YAPOR) || defined(THREADS) if (!PP) #endif - UNLOCKPE(14,ap); - + UNLOCKPE(14, ap); } JMPNext(); ENDBOp(); @@ -541,15 +555,15 @@ yamop *pt0; /* update ASP before calling IPred */ - SET_ASP(YREG, E_CB*sizeof(CELL)); + SET_ASP(YREG, E_CB * sizeof(CELL)); #if defined(YAPOR) || defined(THREADS) if (!PP) { - PELOCK(12,pe); + PELOCK(12, pe); } if (!same_lu_block(PREG_ADDR, PREG)) { PREG = *PREG_ADDR; if (!PP) { - UNLOCKPE(15,pe); + UNLOCKPE(15, pe); } JMPNext(); } @@ -567,7 +581,7 @@ PREG = pt0; #if defined(YAPOR) || defined(THREADS) if (!PP) { - UNLOCKPE(12,pe); + UNLOCKPE(12, pe); } #endif JMPNext(); @@ -580,37 +594,37 @@ yamop *pt0; /* update ASP before calling IPred */ - SET_ASP(YREG, E_CB*sizeof(CELL)); + SET_ASP(YREG, E_CB * sizeof(CELL)); #if defined(YAPOR) || defined(THREADS) if (PP == NULL) { - PELOCK(13,pe); + PELOCK(13, pe); } if (!same_lu_block(PREG_ADDR, PREG)) { PREG = *PREG_ADDR; if (!PP) { - UNLOCKPE(16,pe); + UNLOCKPE(16, pe); } JMPNext(); - } + } #endif - saveregs(); - pt0 = Yap_ExpandIndex(pe, 0); - /* restart index */ - setregs(); - PREG = pt0; + saveregs(); + pt0 = Yap_ExpandIndex(pe, 0); + /* restart index */ + setregs(); + PREG = pt0; #if defined(YAPOR) || defined(THREADS) - if (!PP) { - UNLOCKPE(18,pe); - } + if (!PP) { + UNLOCKPE(18, pe); + } #endif - JMPNext(); + JMPNext(); } ENDBOp(); BOp(undef_p, e); /* save S for module name */ saveregs(); - undef_goal( PASS_REGS1 ); + undef_goal(PASS_REGS1); setregs(); /* for profiler */ CACHE_A1(); @@ -619,10 +633,8 @@ BOp(spy_pred, e); saveregs(); - spy_goal( PASS_REGS1 ); + spy_goal(PASS_REGS1); setregs(); CACHE_A1(); JMPNext(); ENDBOp(); - - diff --git a/C/init.c b/C/init.c index c83dd84ca..13e56e318 100755 --- a/C/init.c +++ b/C/init.c @@ -25,11 +25,12 @@ static char SccsId[] = "%W% %G%"; #define __INIT_C__ 1 -#include #include "Yap.h" +#include "alloc.h" #include "clause.h" #include "yapio.h" -#include "alloc.h" +#include + #include "Foreign.h" #ifdef LOW_LEVEL_TRACER @@ -462,7 +463,7 @@ static UInt update_flags_from_prolog(UInt flags, PredEntry *pe) { return flags; } -void Yap_InitCPred(const char *Name, UInt Arity, CPredicate code, +void Yap_InitCPred(const char *Name, arity_t Arity, CPredicate code, pred_flags_t flags) { CACHE_REGS Atom atom = NIL; @@ -606,7 +607,7 @@ bool Yap_AddCutToFli(PredEntry *pe, CPredicate CUT) { } } -void Yap_InitCmpPred(const char *Name, UInt Arity, CmpPredicate cmp_code, +void Yap_InitCmpPred(const char *Name, arity_t Arity, CmpPredicate cmp_code, pred_flags_t flags) { CACHE_REGS Atom atom = NIL; @@ -685,7 +686,7 @@ void Yap_InitCmpPred(const char *Name, UInt Arity, CmpPredicate cmp_code, p_code->y_u.l.l = cl->ClCode; } -void Yap_InitAsmPred(const char *Name, UInt Arity, int code, CPredicate def, +void Yap_InitAsmPred(const char *Name, arity_t Arity, int code, CPredicate def, pred_flags_t flags) { CACHE_REGS Atom atom = NIL; @@ -825,18 +826,18 @@ static void CleanBack(PredEntry *pe, CPredicate Start, CPredicate Cont, code->y_u.OtapFs.f = Cut; } -void Yap_InitCPredBack(const char *Name, UInt Arity, unsigned int Extra, - CPredicate Start, CPredicate Cont, pred_flags_t flags) { - Yap_InitCPredBack_(Name, Arity, Extra, Start, Cont, NULL, flags); +void Yap_InitCPredBack(const char *Name, arity_t Arity, arity_t Extra, + CPredicate Call, CPredicate Retry, pred_flags_t flags) { + Yap_InitCPredBack_(Name, Arity, Extra, Call, Retry, NULL, flags); } -void Yap_InitCPredBackCut(const char *Name, UInt Arity, unsigned int Extra, +void Yap_InitCPredBackCut(const char *Name, arity_t Arity, arity_t Extra, CPredicate Start, CPredicate Cont, CPredicate Cut, pred_flags_t flags) { Yap_InitCPredBack_(Name, Arity, Extra, Start, Cont, Cut, flags); } -void Yap_InitCPredBack_(const char *Name, UInt Arity, unsigned int Extra, +void Yap_InitCPredBack_(const char *Name, arity_t Arity, arity_t Extra, CPredicate Start, CPredicate Cont, CPredicate Cut, pred_flags_t flags) { CACHE_REGS @@ -1002,29 +1003,28 @@ static void InitOtaplInst(yamop start[1], OPCODE opc, PredEntry *pe) { } static void InitDBErasedMarker(void) { - DBErasedMarker = (DBRef)Yap_AllocCodeSpace(sizeof(DBStruct)); + DBErasedMarker = (DBRef)Yap_AllocCodeSpace(sizeof(DBStruct)); Yap_LUClauseSpace += sizeof(DBStruct); - DBErasedMarker->id = FunctorDBRef; - DBErasedMarker->Flags = ErasedMask; - DBErasedMarker->Code = NULL; - DBErasedMarker->DBT.DBRefs = NULL; - DBErasedMarker->Parent = NULL; + DBErasedMarker->id = FunctorDBRef; + DBErasedMarker->Flags = ErasedMask; + DBErasedMarker->Code = NULL; + DBErasedMarker->DBT.DBRefs = NULL; + DBErasedMarker->Parent = NULL; } static void InitLogDBErasedMarker(void) { - LogDBErasedMarker = (LogUpdClause *)Yap_AllocCodeSpace( + LogDBErasedMarker = (LogUpdClause *)Yap_AllocCodeSpace( sizeof(LogUpdClause) + (UInt)NEXTOP((yamop *)NULL, e)); Yap_LUClauseSpace += sizeof(LogUpdClause) + (UInt)NEXTOP((yamop *)NULL, e); - LogDBErasedMarker->Id = FunctorDBRef; - LogDBErasedMarker->ClFlags = ErasedMask | LogUpdMask; - LogDBErasedMarker->lusl.ClSource = NULL; - LogDBErasedMarker->ClRefCount = 0; - LogDBErasedMarker->ClExt = NULL; - LogDBErasedMarker->ClPrev = NULL; - LogDBErasedMarker->ClNext = NULL; - LogDBErasedMarker->ClSize = - (UInt)NEXTOP(((LogUpdClause *)NULL)->ClCode, e); - LogDBErasedMarker->ClCode->opc = Yap_opcode(_op_fail); + LogDBErasedMarker->Id = FunctorDBRef; + LogDBErasedMarker->ClFlags = ErasedMask | LogUpdMask; + LogDBErasedMarker->lusl.ClSource = NULL; + LogDBErasedMarker->ClRefCount = 0; + LogDBErasedMarker->ClExt = NULL; + LogDBErasedMarker->ClPrev = NULL; + LogDBErasedMarker->ClNext = NULL; + LogDBErasedMarker->ClSize = (UInt)NEXTOP(((LogUpdClause *)NULL)->ClCode, e); + LogDBErasedMarker->ClCode->opc = Yap_opcode(_op_fail); INIT_CLREF_COUNT(LogDBErasedMarker); } diff --git a/C/modules.c b/C/modules.c index 6c9c0fb82..9835ed74f 100644 --- a/C/modules.c +++ b/C/modules.c @@ -19,8 +19,8 @@ static char SccsId[] = "%W% %G%"; #endif #include "Yap.h" -#include "Yatom.h" #include "YapHeap.h" +#include "Yatom.h" static Int current_module(USES_REGS1); static Int current_module1(USES_REGS1); @@ -36,28 +36,27 @@ static ModEntry *FetchModuleEntry(Atom at); * @param ae module name. * * @return a new module structure - *//** */ -static ModEntry * -initMod( AtomEntry *toname, AtomEntry *ae) { - CACHE_REGS - ModEntry *n, *parent; + */ /** */ +static ModEntry *initMod(AtomEntry *toname, AtomEntry *ae) { + CACHE_REGS + ModEntry *n, *parent; - if (toname == NULL) - parent = NULL; - else { - parent = FetchModuleEntry( toname ); - } - n = (ModEntry *)Yap_AllocAtomSpace(sizeof(*n)); - INIT_RWLOCK(n->ModRWLock); - n->KindOfPE = ModProperty; - n->PredForME = NULL; - n->NextME = CurrentModules; - CurrentModules = n; - n->AtomOfME = ae; - n->OwnerFile = Yap_ConsultingFile( PASS_REGS1); - AddPropToAtom(ae, (PropEntry *)n); - Yap_setModuleFlags(n, parent); - return n; + if (toname == NULL) + parent = NULL; + else { + parent = FetchModuleEntry(toname); + } + n = (ModEntry *)Yap_AllocAtomSpace(sizeof(*n)); + INIT_RWLOCK(n->ModRWLock); + n->KindOfPE = ModProperty; + n->PredForME = NULL; + n->NextME = CurrentModules; + CurrentModules = n; + n->AtomOfME = ae; + n->OwnerFile = Yap_ConsultingFile(PASS_REGS1); + AddPropToAtom(ae, (PropEntry *)n); + Yap_setModuleFlags(n, parent); + return n; } /** @@ -67,8 +66,7 @@ initMod( AtomEntry *toname, AtomEntry *ae) { * * @return module descriptorxs */ - static ModEntry *GetModuleEntry(Atom at USES_REGS) -{ +static ModEntry *GetModuleEntry(Atom at USES_REGS) { Prop p0; AtomEntry *ae = RepAtom(at); @@ -84,12 +82,12 @@ initMod( AtomEntry *toname, AtomEntry *ae) { } READ_UNLOCK(ae->ARWLock); - return initMod( ( CurrentModule == PROLOG_MODULE ? NULL : AtomOfTerm( CurrentModule ) ), at ); + return initMod( + (CurrentModule == PROLOG_MODULE ? NULL : AtomOfTerm(CurrentModule)), at); } /** get entry for ap/arity; assumes one is there. */ - static ModEntry *FetchModuleEntry(Atom at) -{ +static ModEntry *FetchModuleEntry(Atom at) { Prop p0; AtomEntry *ae = RepAtom(at); @@ -119,19 +117,18 @@ Term Yap_getUnknownModule(ModEntry *m) { } } -bool Yap_getUnknown ( Term mod) { - ModEntry *m = LookupModule( mod ); - return Yap_getUnknownModule( m ); +bool Yap_getUnknown(Term mod) { + ModEntry *m = LookupModule(mod); + return Yap_getUnknownModule(m); } - - bool Yap_CharacterEscapes(Term mt) { - CACHE_REGS - if (mt == PROLOG_MODULE) mt = TermProlog; +bool Yap_CharacterEscapes(Term mt) { + CACHE_REGS + if (mt == PROLOG_MODULE) + mt = TermProlog; return GetModuleEntry(AtomOfTerm(mt) PASS_REGS)->flags & M_CHARESCAPE; } - #define ByteAdr(X) ((char *)&(X)) Term Yap_Module_Name(PredEntry *ap) { CACHE_REGS @@ -150,7 +147,6 @@ Term Yap_Module_Name(PredEntry *ap) { else { return ap->ModuleOfPred; } - } static ModEntry *LookupSystemModule(Term a) { @@ -158,7 +154,6 @@ static ModEntry *LookupSystemModule(Term a) { Atom at; ModEntry *me; - /* prolog module */ if (a == 0) { a = TermProlog; @@ -168,11 +163,10 @@ static ModEntry *LookupSystemModule(Term a) { if (!me) return NULL; me->flags |= M_SYSTEM; - me->OwnerFile = Yap_ConsultingFile( PASS_REGS1 ); + me->OwnerFile = Yap_ConsultingFile(PASS_REGS1); return me; } - static ModEntry *LookupModule(Term a) { CACHE_REGS Atom at; @@ -189,9 +183,7 @@ static ModEntry *LookupModule(Term a) { bool Yap_isSystemModule(Term a) { ModEntry *me = LookupModule(a); - return - me != NULL && - me->flags & M_SYSTEM; + return me != NULL && me->flags & M_SYSTEM; } Term Yap_Module(Term tmod) { @@ -204,7 +196,6 @@ ModEntry *Yap_GetModuleEntry(Term mod) { if (!(me = LookupModule(mod))) return NULL; return me; - } Term Yap_GetModuleFromEntry(ModEntry *me) { @@ -270,7 +261,6 @@ static Int current_module1(USES_REGS1) { /* $current_module(Old) return Yap_unify_constant(ARG1, TermProlog); } - static Int cont_current_module(USES_REGS1) { ModEntry *imod = AddressOfTerm(EXTRA_CBACK_ARG(1, 1)), *next; Term t = MkAtomTerm(imod->AtomOfME); @@ -313,7 +303,7 @@ static Int cont_ground_module(USES_REGS1) { } static Int init_ground_module(USES_REGS1) { - /* current_module(?ModuleName) */ + /* current_module(?ModuleName) */ Term t1 = Deref(ARG1), tmod = CurrentModule, t3; if (tmod == PROLOG_MODULE) { tmod = TermProlog; @@ -334,11 +324,10 @@ static Int init_ground_module(USES_REGS1) { } cut_fail(); } - if (!Yap_unify(ARG2, tmod) || - !Yap_unify(ARG3, t3) ) { - cut_fail(); - } - // make sure we keep the binding + if (!Yap_unify(ARG2, tmod) || !Yap_unify(ARG3, t3)) { + cut_fail(); + } + // make sure we keep the binding B->cp_tr = TR; B->cp_h = HR; EXTRA_CBACK_ARG(3, 1) = MkAddressTerm(CurrentModules); @@ -352,33 +341,31 @@ static Int init_ground_module(USES_REGS1) { * * @return */ -static Int is_system_module( USES_REGS1 ) -{ +static Int is_system_module(USES_REGS1) { Term t; - if (IsVarTerm(t = Deref (ARG1))) { + if (IsVarTerm(t = Deref(ARG1))) { return false; } if (!IsAtomTerm(t)) { Yap_Error(TYPE_ERROR_ATOM, t, "load_files/2"); return false; } - return Yap_isSystemModule( t ); + return Yap_isSystemModule(t); } -static Int new_system_module( USES_REGS1 ) -{ +static Int new_system_module(USES_REGS1) { ModEntry *me; Term t; - if (IsVarTerm(t = Deref (ARG1))) { - Yap_Error( INSTANTIATION_ERROR, t, NULL); + if (IsVarTerm(t = Deref(ARG1))) { + Yap_Error(INSTANTIATION_ERROR, t, NULL); return false; } if (!IsAtomTerm(t)) { Yap_Error(TYPE_ERROR_ATOM, t, NULL); return false; } - if ((me = LookupSystemModule( t ) )) - me->OwnerFile = Yap_ConsultingFile( PASS_REGS1); + if ((me = LookupSystemModule(t))) + me->OwnerFile = Yap_ConsultingFile(PASS_REGS1); return me != NULL; } @@ -477,7 +464,7 @@ static Int source_module(USES_REGS1) { Term Yap_StripModule(Term t, Term *modp) { CACHE_REGS - Term tmod; + Term tmod; if (modp) tmod = *modp; diff --git a/C/qlyr.c b/C/qlyr.c index 4168cbec8..a98cf3e96 100755 --- a/C/qlyr.c +++ b/C/qlyr.c @@ -17,19 +17,19 @@ *************************************************************************/ #include "absmi.h" -#include "Foreign.h" #include "alloc.h" -#include "yapio.h" -#include "iopreds.h" #include "attvar.h" +#include "iopreds.h" +#include "yapio.h" +#include #if HAVE_STRING_H #include #endif #include "qly.h" -static void RestoreEntries(PropEntry *, int USES_REGS); -static void CleanCode(PredEntry * USES_REGS); +static void RestoreEntries(PropEntry *, int USES_REGS); +static void CleanCode(PredEntry *USES_REGS); typedef enum { OUT_OF_TEMP_SPACE = 0, @@ -47,23 +47,21 @@ typedef enum { BAD_HEADER = 12 } qlfr_err_t; -static char * -qlyr_error[] = { "out of temporary space", - "out of temporary space", - "out of code space", - "unknown atom in saved space", - "unknown functor in saved space", - "unknown predicate in saved space", - "unknown YAAM opcode in saved space", - "unknown data-base reference in saved space", - "corrupted atom in saved space", - "formatting mismatch in saved space", - "foreign predicate has different definition in saved space", - "bad read" }; +static char *qlyr_error[] = { + "out of temporary space", + "out of temporary space", + "out of code space", + "unknown atom in saved space", + "unknown functor in saved space", + "unknown predicate in saved space", + "unknown YAAM opcode in saved space", + "unknown data-base reference in saved space", + "corrupted atom in saved space", + "formatting mismatch in saved space", + "foreign predicate has different definition in saved space", + "bad read"}; -static char * -Yap_AlwaysAllocCodeSpace(UInt size) -{ +static char *Yap_AlwaysAllocCodeSpace(UInt size) { char *out; while (!(out = Yap_AllocCodeSpace(size))) { if (!Yap_growheap(FALSE, size, NULL)) { @@ -73,20 +71,18 @@ Yap_AlwaysAllocCodeSpace(UInt size) return out; } -static void -QLYR_ERROR(qlfr_err_t my_err) -{ - // __android_log_print(ANDROID_LOG_INFO, "YAP ", "error %s in saved state %s",GLOBAL_RestoreFile, qlyr_error[my_err]); - Yap_Error(SYSTEM_ERROR_SAVED_STATE,TermNil,"error %s in saved state %s",GLOBAL_RestoreFile, qlyr_error[my_err]); +static void QLYR_ERROR(qlfr_err_t my_err) { + // __android_log_print(ANDROID_LOG_INFO, "YAP ", "error %s in saved state + // %s",GLOBAL_RestoreFile, qlyr_error[my_err]); + Yap_Error(SYSTEM_ERROR_SAVED_STATE, TermNil, "error %s in saved state %s", + GLOBAL_RestoreFile, qlyr_error[my_err]); Yap_exit(1); } -static Atom -LookupAtom(Atom oat) -{ - CACHE_REGS - CELL hash = (CELL)(oat) % LOCAL_ImportAtomHashTableSize; - import_atom_hash_entry_t *a; +static Atom LookupAtom(Atom oat) { + CACHE_REGS + CELL hash = (CELL)(oat) % LOCAL_ImportAtomHashTableSize; + import_atom_hash_entry_t *a; a = LOCAL_ImportAtomHashChain[hash]; while (a) { @@ -95,14 +91,13 @@ LookupAtom(Atom oat) } a = a->next; } - // __android_log_print(ANDROID_LOG_INFO, "YAP ", "error %p in saved state ", oat); + // __android_log_print(ANDROID_LOG_INFO, "YAP ", "error %p in saved state ", + // oat); QLYR_ERROR(UNKNOWN_ATOM); return NIL; } -static void -InsertAtom(Atom oat, Atom at) -{ +static void InsertAtom(Atom oat, Atom at) { CACHE_REGS CELL hash = (CELL)(oat) % LOCAL_ImportAtomHashTableSize; import_atom_hash_entry_t *a; @@ -124,9 +119,7 @@ InsertAtom(Atom oat, Atom at) LOCAL_ImportAtomHashChain[hash] = a; } -static Functor -LookupFunctor(Functor ofun) -{ +static Functor LookupFunctor(Functor ofun) { CACHE_REGS CELL hash = (CELL)(ofun) % LOCAL_ImportFunctorHashTableSize; import_functor_hash_entry_t *f; @@ -142,9 +135,7 @@ LookupFunctor(Functor ofun) return NIL; } -static void -InsertFunctor(Functor ofun, Functor fun) -{ +static void InsertFunctor(Functor ofun, Functor fun) { CACHE_REGS CELL hash = (CELL)(ofun) % LOCAL_ImportFunctorHashTableSize; import_functor_hash_entry_t *f; @@ -156,7 +147,8 @@ InsertFunctor(Functor ofun, Functor fun) } f = f->next; } - f = (import_functor_hash_entry_t *)malloc(sizeof(import_functor_hash_entry_t)); + f = (import_functor_hash_entry_t *)malloc( + sizeof(import_functor_hash_entry_t)); if (!f) { return; } @@ -166,9 +158,7 @@ InsertFunctor(Functor ofun, Functor fun) LOCAL_ImportFunctorHashChain[hash] = f; } -static PredEntry * -LookupPredEntry(PredEntry *op) -{ +static PredEntry *LookupPredEntry(PredEntry *op) { CACHE_REGS CELL hash; import_pred_entry_hash_entry_t *p; @@ -187,9 +177,7 @@ LookupPredEntry(PredEntry *op) return NIL; } -static void -InsertPredEntry(PredEntry *op, PredEntry *pe) -{ +static void InsertPredEntry(PredEntry *op, PredEntry *pe) { CACHE_REGS CELL hash; import_pred_entry_hash_entry_t *p; @@ -204,7 +192,8 @@ InsertPredEntry(PredEntry *op, PredEntry *pe) } p = p->next; } - p = (import_pred_entry_hash_entry_t *)malloc(sizeof(import_pred_entry_hash_entry_t)); + p = (import_pred_entry_hash_entry_t *)malloc( + sizeof(import_pred_entry_hash_entry_t)); if (!p) { return; } @@ -214,9 +203,7 @@ InsertPredEntry(PredEntry *op, PredEntry *pe) LOCAL_ImportPredEntryHashChain[hash] = p; } -static OPCODE -LookupOPCODE(OPCODE op) -{ +static OPCODE LookupOPCODE(OPCODE op) { CACHE_REGS CELL hash = (CELL)(op) % LOCAL_ImportOPCODEHashTableSize; import_opcode_hash_entry_t *f; @@ -232,9 +219,7 @@ LookupOPCODE(OPCODE op) return NIL; } -static int -OpcodeID(OPCODE op) -{ +static int OpcodeID(OPCODE op) { CACHE_REGS CELL hash = (CELL)(op) % LOCAL_ImportOPCODEHashTableSize; import_opcode_hash_entry_t *f; @@ -250,9 +235,7 @@ OpcodeID(OPCODE op) return NIL; } -static void -InsertOPCODE(OPCODE op0, int i, OPCODE op) -{ +static void InsertOPCODE(OPCODE op0, int i, OPCODE op) { CACHE_REGS CELL hash = (CELL)(op0) % LOCAL_ImportOPCODEHashTableSize; import_opcode_hash_entry_t *f; @@ -274,9 +257,7 @@ InsertOPCODE(OPCODE op0, int i, OPCODE op) LOCAL_ImportOPCODEHashChain[hash] = f; } -static DBRef -LookupDBRef(DBRef dbr, int inc_ref) -{ +static DBRef LookupDBRef(DBRef dbr, int inc_ref) { CACHE_REGS CELL hash; import_dbref_hash_entry_t *p; @@ -288,7 +269,7 @@ LookupDBRef(DBRef dbr, int inc_ref) while (p) { if (p->oval == dbr) { if (inc_ref) { - p->count++; + p->count++; } return p->val; } @@ -298,9 +279,7 @@ LookupDBRef(DBRef dbr, int inc_ref) return NIL; } -static LogUpdClause * -LookupMayFailDBRef(DBRef dbr) -{ +static LogUpdClause *LookupMayFailDBRef(DBRef dbr) { CACHE_REGS CELL hash; import_dbref_hash_entry_t *p; @@ -319,9 +298,7 @@ LookupMayFailDBRef(DBRef dbr) return NULL; } -static void -InsertDBRef(DBRef dbr0, DBRef dbr) -{ +static void InsertDBRef(DBRef dbr0, DBRef dbr) { CACHE_REGS CELL hash = (CELL)(dbr0) % LOCAL_ImportDBRefHashTableSize; import_dbref_hash_entry_t *p; @@ -344,20 +321,18 @@ InsertDBRef(DBRef dbr0, DBRef dbr) LOCAL_ImportDBRefHashChain[hash] = p; } -static void -InitHash(void) -{ +static void InitHash(void) { CACHE_REGS LOCAL_ImportOPCODEHashTableSize = EXPORT_OPCODE_TABLE_SIZE; - LOCAL_ImportOPCODEHashChain = (import_opcode_hash_entry_t **)calloc(1, sizeof(import_opcode_hash_entry_t *)* LOCAL_ImportOPCODEHashTableSize); + LOCAL_ImportOPCODEHashChain = (import_opcode_hash_entry_t **)calloc( + 1, + sizeof(import_opcode_hash_entry_t *) * LOCAL_ImportOPCODEHashTableSize); } -static void -CloseHash(void) -{ +static void CloseHash(void) { CACHE_REGS UInt i; - for (i=0; i < LOCAL_ImportFunctorHashTableSize; i++) { + for (i = 0; i < LOCAL_ImportFunctorHashTableSize; i++) { import_functor_hash_entry_t *a = LOCAL_ImportFunctorHashChain[i]; while (a) { import_functor_hash_entry_t *a0 = a; @@ -368,7 +343,7 @@ CloseHash(void) LOCAL_ImportFunctorHashTableSize = 0; free(LOCAL_ImportFunctorHashChain); LOCAL_ImportFunctorHashChain = NULL; - for (i=0; i < LOCAL_ImportAtomHashTableSize; i++) { + for (i = 0; i < LOCAL_ImportAtomHashTableSize; i++) { import_atom_hash_entry_t *a = LOCAL_ImportAtomHashChain[i]; while (a) { import_atom_hash_entry_t *a0 = a; @@ -379,7 +354,7 @@ CloseHash(void) LOCAL_ImportAtomHashTableSize = 0; free(LOCAL_ImportAtomHashChain); LOCAL_ImportAtomHashChain = NULL; - for (i=0; i < LOCAL_ImportOPCODEHashTableSize; i++) { + for (i = 0; i < LOCAL_ImportOPCODEHashTableSize; i++) { import_opcode_hash_entry_t *a = LOCAL_ImportOPCODEHashChain[i]; while (a) { import_opcode_hash_entry_t *a0 = a; @@ -390,7 +365,7 @@ CloseHash(void) LOCAL_ImportOPCODEHashTableSize = 0; free(LOCAL_ImportOPCODEHashChain); LOCAL_ImportOPCODEHashChain = NULL; - for (i=0; i < LOCAL_ImportPredEntryHashTableSize; i++) { + for (i = 0; i < LOCAL_ImportPredEntryHashTableSize; i++) { import_pred_entry_hash_entry_t *a = LOCAL_ImportPredEntryHashChain[i]; while (a) { import_pred_entry_hash_entry_t *a0 = a; @@ -401,13 +376,13 @@ CloseHash(void) LOCAL_ImportPredEntryHashTableSize = 0; free(LOCAL_ImportPredEntryHashChain); LOCAL_ImportPredEntryHashChain = NULL; - for (i=0; i < LOCAL_ImportDBRefHashTableSize; i++) { + for (i = 0; i < LOCAL_ImportDBRefHashTableSize; i++) { import_dbref_hash_entry_t *a = LOCAL_ImportDBRefHashChain[i]; while (a) { import_dbref_hash_entry_t *a0 = a; #ifdef DEBUG if (!a->count) { - fprintf(stderr,"WARNING: unused reference %p %p\n",a->val, a->oval); + fprintf(stderr, "WARNING: unused reference %p %p\n", a->val, a->oval); } #endif a = a->next; @@ -419,29 +394,18 @@ CloseHash(void) LOCAL_ImportDBRefHashChain = NULL; } -static inline Atom -AtomAdjust(Atom a) -{ - return LookupAtom(a); -} +static inline Atom AtomAdjust(Atom a) { return LookupAtom(a); } -static inline Functor -FuncAdjust(Functor f) -{ +static inline Functor FuncAdjust(Functor f) { return LookupFunctor(f); return f; } - -static inline Term -AtomTermAdjust(Term t) -{ +static inline Term AtomTermAdjust(Term t) { return MkAtomTerm(LookupAtom(AtomOfTerm(t))); } -static inline Term -TermToGlobalOrAtomAdjust(Term t) -{ +static inline Term TermToGlobalOrAtomAdjust(Term t) { if (t && IsAtomTerm(t)) return AtomTermAdjust(t); return t; @@ -466,14 +430,12 @@ TermToGlobalOrAtomAdjust(Term t) #define NoAGCAtomAdjust(P) (P) #define OrArgAdjust(P) #define TabEntryAdjust(P) -#define IntegerAdjust(D) (D) +#define IntegerAdjust(D) (D) #define AddrAdjust(P) (P) #define MFileAdjust(P) (P) #define CodeVarAdjust(P) CodeVarAdjust__(P PASS_REGS) -static inline Term -CodeVarAdjust__ (Term var USES_REGS) -{ +static inline Term CodeVarAdjust__(Term var USES_REGS) { if (var == 0L) return var; return (Term)(CharP(var) + LOCAL_HDiff); @@ -484,25 +446,17 @@ CodeVarAdjust__ (Term var USES_REGS) #define DoubleInCodeAdjust(P) #define IntegerInCodeAdjust(Pxb) -static inline PredEntry * -PtoPredAdjust(PredEntry *p) -{ +static inline PredEntry *PtoPredAdjust(PredEntry *p) { return LookupPredEntry(p); } -static inline PredEntry * -PredEntryAdjust(PredEntry *p) -{ +static inline PredEntry *PredEntryAdjust(PredEntry *p) { return LookupPredEntry(p); } -static inline OPCODE -OpcodeAdjust(OPCODE OP) { - return LookupOPCODE(OP); -} +static inline OPCODE OpcodeAdjust(OPCODE OP) { return LookupOPCODE(OP); } -static inline Term -ModuleAdjust(Term M) { +static inline Term ModuleAdjust(Term M) { if (!M) return M; return AtomTermAdjust(M); @@ -515,30 +469,22 @@ ModuleAdjust(Term M) { #define GlobalEntryAdjust(P) (P) #define BlobTermInCodeAdjust(P) BlobTermInCodeAdjust__(P PASS_REGS) #if TAGS_FAST_OPS -static inline Term -BlobTermInCodeAdjust__ (Term t USES_REGS) -{ - return (Term) ((char *)(t) - LOCAL_HDiff); +static inline Term BlobTermInCodeAdjust__(Term t USES_REGS) { + return (Term)((char *)(t)-LOCAL_HDiff); } #else -static inline Term -BlobTermInCodeAdjust__ (Term t USES_REGS) -{ - return (Term) ((char *)(t) + LOCAL_HDiff); +static inline Term BlobTermInCodeAdjust__(Term t USES_REGS) { + return (Term)((char *)(t) + LOCAL_HDiff); } #endif #define DBTermAdjust(P) DBTermAdjust__(P PASS_REGS) -static inline DBTerm * -DBTermAdjust__ (DBTerm * dbtp USES_REGS) -{ - return (DBTerm *) (CharP (dbtp) + LOCAL_HDiff); +static inline DBTerm *DBTermAdjust__(DBTerm *dbtp USES_REGS) { + return (DBTerm *)(CharP(dbtp) + LOCAL_HDiff); } #define CellPtoHeapAdjust(P) CellPtoHeapAdjust__(P PASS_REGS) -static inline CELL * -CellPtoHeapAdjust__ (CELL * dbtp USES_REGS) -{ - return (CELL *) (CharP (dbtp) + LOCAL_HDiff); +static inline CELL *CellPtoHeapAdjust__(CELL *dbtp USES_REGS) { + return (CELL *)(CharP(dbtp) + LOCAL_HDiff); } #define PtoAtomHashEntryAdjust(P) (P) @@ -551,17 +497,13 @@ CellPtoHeapAdjust__ (CELL * dbtp USES_REGS) #define GlobalAdjust(P) (P) #define DBRefAdjust(P, Ref) DBRefAdjust__(P, Ref PASS_REGS) -static inline DBRef -DBRefAdjust__ (DBRef dbtp, int do_reference USES_REGS) -{ +static inline DBRef DBRefAdjust__(DBRef dbtp, int do_reference USES_REGS) { return LookupDBRef(dbtp, do_reference); } #define DBRefPAdjust(P) DBRefPAdjust__(P PASS_REGS) -static inline DBRef * -DBRefPAdjust__ (DBRef * dbtp USES_REGS) -{ - return (DBRef *) ((char *)(dbtp) + LOCAL_HDiff); +static inline DBRef *DBRefPAdjust__(DBRef *dbtp USES_REGS) { + return (DBRef *)((char *)(dbtp) + LOCAL_HDiff); } #define LUIndexAdjust(P) (P) @@ -572,10 +514,8 @@ DBRefPAdjust__ (DBRef * dbtp USES_REGS) #define PtoLUCAdjust(P) PtoLUCAdjust__(P PASS_REGS) #define PtoLUClauseAdjust(P) PtoLUCAdjust__(P PASS_REGS) -static inline LogUpdClause * -PtoLUCAdjust__ (LogUpdClause * dbtp USES_REGS) -{ - return (LogUpdClause *) ((char *)(dbtp) + LOCAL_HDiff); +static inline LogUpdClause *PtoLUCAdjust__(LogUpdClause *dbtp USES_REGS) { + return (LogUpdClause *)((char *)(dbtp) + LOCAL_HDiff); } #define PtoStCAdjust(P) (P) @@ -587,13 +527,11 @@ PtoLUCAdjust__ (LogUpdClause * dbtp USES_REGS) #define PtoLocAdjust(P) (P) #define PtoHeapCellAdjust(P) PtoHeapCellAdjust__(P PASS_REGS) -static inline CELL * -PtoHeapCellAdjust__ (CELL * ptr USES_REGS) -{ +static inline CELL *PtoHeapCellAdjust__(CELL *ptr USES_REGS) { LogUpdClause *out; if ((out = LookupMayFailDBRef((DBRef)ptr))) return (CELL *)out; - return (CELL *) (CharP (ptr) + LOCAL_HDiff); + return (CELL *)(CharP(ptr) + LOCAL_HDiff); } #define TermToGlobalAdjust(P) (P) @@ -602,7 +540,7 @@ static inline yamop *PtoOpAdjust__(yamop *ptr USES_REGS) { if (ptr) { if (ptr == LOCAL_ImportFAILCODE) return FAILCODE; - return (yamop *) ((char *) (ptr) + LOCAL_HDiff); + return (yamop *)((char *)(ptr) + LOCAL_HDiff); } return ptr; } @@ -615,10 +553,8 @@ static inline yamop *PtoOpAdjust__(yamop *ptr USES_REGS) { #define TrailAddrAdjust(P) (P) #if PRECOMPUTE_REGADDRESS #define XAdjust(P) XAdjust__(P PASS_REGS) -static inline wamreg -XAdjust__ (wamreg reg USES_REGS) -{ - return (wamreg) ((wamreg) ((reg) + LOCAL_XDiff)); +static inline wamreg XAdjust__(wamreg reg USES_REGS) { + return (wamreg)((wamreg)((reg) + LOCAL_XDiff)); } #else #define XAdjust(X) (X) @@ -638,144 +574,115 @@ XAdjust__ (wamreg reg USES_REGS) #define Yap_op_from_opcode(OP) OpcodeID(OP) -static void RestoreFlags( UInt NFlags ) -{ -} +static void RestoreFlags(UInt NFlags) {} #include "rheap.h" -static void -RestoreHashPreds( USES_REGS1 ) -{ -} +static void RestoreHashPreds(USES_REGS1) {} +static void RestoreAtomList(Atom atm USES_REGS) {} -static void -RestoreAtomList(Atom atm USES_REGS) -{ -} - -static size_t -read_bytes(FILE *stream, void *ptr, size_t sz) -{ +static size_t read_bytes(FILE *stream, void *ptr, size_t sz) { return fread(ptr, sz, 1, stream); } -static unsigned char -read_byte(FILE *stream) -{ - return getc(stream); -} +static unsigned char read_byte(FILE *stream) { return getc(stream); } -static BITS16 -read_bits16(FILE *stream) -{ +static BITS16 read_bits16(FILE *stream) { BITS16 v; read_bytes(stream, &v, sizeof(BITS16)); return v; } -static UInt -read_UInt(FILE *stream) -{ +static UInt read_UInt(FILE *stream) { UInt v; read_bytes(stream, &v, sizeof(UInt)); return v; } -static Int -read_Int(FILE *stream) -{ +static Int read_Int(FILE *stream) { Int v; read_bytes(stream, &v, sizeof(Int)); return v; } -static qlf_tag_t -read_tag(FILE *stream) -{ +static qlf_tag_t read_tag(FILE *stream) { int ch = read_byte(stream); return ch; } -static pred_flags_t -read_predFlags(FILE *stream) -{ +static pred_flags_t read_predFlags(FILE *stream) { pred_flags_t v; read_bytes(stream, &v, sizeof(pred_flags_t)); return v; } -static bool -checkChars(FILE *stream, char s[]) -{ +static bool checkChars(FILE *stream, char s[]) { int ch, c; char *p = s; while ((ch = *p++)) { - if ((c = read_byte(stream)) != ch ) { + if ((c = read_byte(stream)) != ch) { return false; } } return TRUE; } -static Atom -do_header(FILE *stream) -{ +static Atom do_header(FILE *stream) { char s[256], *p = s, ch; Atom at; - if (!checkChars( stream, "#!/bin/sh\nexec_dir=${YAPBINDIR:-" )) + if (!checkChars(stream, "#!/bin/sh\nexec_dir=${YAPBINDIR:-")) return NIL; - while ((ch = read_byte(stream)) != '\n'); - if (!checkChars( stream, "exec $exec_dir/yap $0 \"$@\"\nsaved " )) + while ((ch = read_byte(stream)) != '\n') + ; + if (!checkChars(stream, "exec $exec_dir/yap $0 \"$@\"\nsaved ")) return NIL; while ((ch = read_byte(stream)) != ',') *p++ = ch; *p++ = '\0'; - at = Yap_LookupAtom( s ); - while ((ch = read_byte(stream))); + at = Yap_LookupAtom(s); + while ((ch = read_byte(stream))) + ; return at; } -static Int -get_header( USES_REGS1 ) -{ +static Int get_header(USES_REGS1) { FILE *stream; Term t1 = Deref(ARG1); Atom at; - Int rc; + Int rc; if (IsVarTerm(t1)) { - Yap_Error(INSTANTIATION_ERROR,t1,"read_program/3"); + Yap_Error(INSTANTIATION_ERROR, t1, "read_program/3"); return FALSE; } - if (!(stream = Yap_GetInputStream(t1, "header scanning in qload")) ) { + if (!(stream = Yap_GetInputStream(t1, "header scanning in qload"))) { return FALSE; } - if ((at = do_header( stream )) == NIL) + if ((at = do_header(stream)) == NIL) rc = FALSE; - else rc = Yap_unify( ARG2, MkAtomTerm( at ) ); - return rc; + else + rc = Yap_unify(ARG2, MkAtomTerm(at)); + return rc; } -static void -ReadHash(FILE *stream) -{ +static void ReadHash(FILE *stream) { CACHE_REGS UInt i; RCHECK(read_tag(stream) == QLY_START_X); LOCAL_XDiff = (char *)(&ARG1) - (char *)read_UInt(stream); RCHECK(read_tag(stream) == QLY_START_OPCODES); RCHECK(read_Int(stream) == _std_top); - for (i= 0; i <= _std_top; i++) { + for (i = 0; i <= _std_top; i++) { InsertOPCODE((OPCODE)read_UInt(stream), i, Yap_opcode(i)); } RCHECK(read_tag(stream) == QLY_START_ATOMS); LOCAL_ImportAtomHashTableNum = read_UInt(stream); - LOCAL_ImportAtomHashTableSize = LOCAL_ImportAtomHashTableNum*2; - LOCAL_ImportAtomHashChain = (import_atom_hash_entry_t **)calloc(LOCAL_ImportAtomHashTableSize, sizeof(import_atom_hash_entry_t *)); + LOCAL_ImportAtomHashTableSize = LOCAL_ImportAtomHashTableNum * 2; + LOCAL_ImportAtomHashChain = (import_atom_hash_entry_t **)calloc( + LOCAL_ImportAtomHashTableSize, sizeof(import_atom_hash_entry_t *)); for (i = 0; i < LOCAL_ImportAtomHashTableNum; i++) { Atom oat = (Atom)read_UInt(stream); Atom at; @@ -786,27 +693,31 @@ ReadHash(FILE *stream) UInt len; len = read_UInt(stream); - if (!EnoughTempSpace(len)) QLYR_ERROR(OUT_OF_TEMP_SPACE); - read_bytes(stream, rep, (len+1)*sizeof(wchar_t)); + if (!EnoughTempSpace(len)) + QLYR_ERROR(OUT_OF_TEMP_SPACE); + read_bytes(stream, rep, (len + 1) * sizeof(wchar_t)); while (!(at = Yap_LookupWideAtom(rep))) { - if (!Yap_growheap(FALSE, 0, NULL)) { - exit(1); - } + if (!Yap_growheap(FALSE, 0, NULL)) { + exit(1); + } } - if (at == NIL) QLYR_ERROR(OUT_OF_ATOM_SPACE); + if (at == NIL) + QLYR_ERROR(OUT_OF_ATOM_SPACE); } else if (tg == QLY_ATOM) { char *rep = (char *)AllocTempSpace(); UInt len; len = read_UInt(stream); - if (!EnoughTempSpace(len)) QLYR_ERROR(OUT_OF_TEMP_SPACE); - read_bytes(stream, rep, (len+1)*sizeof(char)); + if (!EnoughTempSpace(len)) + QLYR_ERROR(OUT_OF_TEMP_SPACE); + read_bytes(stream, rep, (len + 1) * sizeof(char)); while (!(at = Yap_FullLookupAtom(rep))) { - if (!Yap_growheap(FALSE, 0, NULL)) { - exit(1); - } + if (!Yap_growheap(FALSE, 0, NULL)) { + exit(1); + } } - if (at == NIL) QLYR_ERROR(OUT_OF_ATOM_SPACE); + if (at == NIL) + QLYR_ERROR(OUT_OF_ATOM_SPACE); } else { QLYR_ERROR(BAD_ATOM); return; @@ -816,8 +727,9 @@ ReadHash(FILE *stream) /* functors */ RCHECK(read_tag(stream) == QLY_START_FUNCTORS); LOCAL_ImportFunctorHashTableNum = read_UInt(stream); - LOCAL_ImportFunctorHashTableSize = 2*LOCAL_ImportFunctorHashTableNum; - LOCAL_ImportFunctorHashChain = (import_functor_hash_entry_t **)calloc(LOCAL_ImportFunctorHashTableSize, sizeof(import_functor_hash_entry_t *)); + LOCAL_ImportFunctorHashTableSize = 2 * LOCAL_ImportFunctorHashTableNum; + LOCAL_ImportFunctorHashChain = (import_functor_hash_entry_t **)calloc( + LOCAL_ImportFunctorHashTableSize, sizeof(import_functor_hash_entry_t *)); for (i = 0; i < LOCAL_ImportFunctorHashTableNum; i++) { Functor of = (Functor)read_UInt(stream); UInt arity = read_UInt(stream); @@ -826,15 +738,17 @@ ReadHash(FILE *stream) Functor f; while (!(f = Yap_MkFunctor(at, arity))) { if (!Yap_growheap(FALSE, 0, NULL)) { - exit(1); + exit(1); } } InsertFunctor(of, f); } RCHECK(read_tag(stream) == QLY_START_PRED_ENTRIES); LOCAL_ImportPredEntryHashTableNum = read_UInt(stream); - LOCAL_ImportPredEntryHashTableSize = 2*LOCAL_ImportPredEntryHashTableNum; - LOCAL_ImportPredEntryHashChain = (import_pred_entry_hash_entry_t **)calloc( LOCAL_ImportPredEntryHashTableSize, sizeof(import_pred_entry_hash_entry_t *)); + LOCAL_ImportPredEntryHashTableSize = 2 * LOCAL_ImportPredEntryHashTableNum; + LOCAL_ImportPredEntryHashChain = (import_pred_entry_hash_entry_t **)calloc( + LOCAL_ImportPredEntryHashTableSize, + sizeof(import_pred_entry_hash_entry_t *)); for (i = 0; i < LOCAL_ImportPredEntryHashTableNum; i++) { PredEntry *ope = (PredEntry *)read_UInt(stream), *pe; UInt arity = read_UInt(stream); @@ -843,53 +757,55 @@ ReadHash(FILE *stream) if (omod) { mod = MkAtomTerm(AtomAdjust(omod)); - if (mod == TermProlog) mod = 0; + if (mod == TermProlog) + mod = 0; } else { mod = TermProlog; } if (mod != IDB_MODULE) { if (arity) { - Functor of = (Functor)read_UInt(stream); - Functor f = LookupFunctor(of); - while(!(pe = RepPredProp(PredPropByFuncAndMod(f,mod)))) { - if (!Yap_growheap(FALSE, 0, NULL)) { - exit(1); - } - } + Functor of = (Functor)read_UInt(stream); + Functor f = LookupFunctor(of); + while (!(pe = RepPredProp(PredPropByFuncAndMod(f, mod)))) { + if (!Yap_growheap(FALSE, 0, NULL)) { + exit(1); + } + } } else { - Atom oa = (Atom)read_UInt(stream); - Atom a = LookupAtom(oa); - pe = RepPredProp(PredPropByAtomAndMod(a,mod)); + Atom oa = (Atom)read_UInt(stream); + Atom a = LookupAtom(oa); + pe = RepPredProp(PredPropByAtomAndMod(a, mod)); } } else { /* IDB */ if (arity == (UInt)-1) { - UInt i = read_UInt(stream); - pe = Yap_FindLUIntKey(i); - } else if (arity == (UInt)(-2)) { - Atom oa = (Atom)read_UInt(stream); - Atom a = LookupAtom(oa); - pe = RepPredProp(PredPropByAtomAndMod(a,mod)); - pe->PredFlags |= AtomDBPredFlag; + UInt i = read_UInt(stream); + pe = Yap_FindLUIntKey(i); + } else if (arity == (UInt)(-2)) { + Atom oa = (Atom)read_UInt(stream); + Atom a = LookupAtom(oa); + pe = RepPredProp(PredPropByAtomAndMod(a, mod)); + pe->PredFlags |= AtomDBPredFlag; } else { - Functor of = (Functor)read_UInt(stream); - Functor f = LookupFunctor(of); - pe = RepPredProp(PredPropByFuncAndMod(f,mod)); + Functor of = (Functor)read_UInt(stream); + Functor f = LookupFunctor(of); + pe = RepPredProp(PredPropByFuncAndMod(f, mod)); } pe->PredFlags |= LogUpdatePredFlag; pe->ArityOfPE = 3; if (pe->OpcodeOfPred == UNDEF_OPCODE) { - pe->OpcodeOfPred = Yap_opcode(_op_fail); - pe->cs.p_code.TrueCodeOfPred = pe->CodeOfPred = FAILCODE; + pe->OpcodeOfPred = Yap_opcode(_op_fail); + pe->cs.p_code.TrueCodeOfPred = pe->CodeOfPred = FAILCODE; } } InsertPredEntry(ope, pe); } RCHECK(read_tag(stream) == QLY_START_DBREFS); LOCAL_ImportDBRefHashTableNum = read_UInt(stream); - LOCAL_ImportDBRefHashTableSize = 2*LOCAL_ImportDBRefHashTableNum+17; - LOCAL_ImportDBRefHashChain = (import_dbref_hash_entry_t **)calloc(LOCAL_ImportDBRefHashTableSize, sizeof(import_dbref_hash_entry_t *)); + LOCAL_ImportDBRefHashTableSize = 2 * LOCAL_ImportDBRefHashTableNum + 17; + LOCAL_ImportDBRefHashChain = (import_dbref_hash_entry_t **)calloc( + LOCAL_ImportDBRefHashTableSize, sizeof(import_dbref_hash_entry_t *)); for (i = 0; i < LOCAL_ImportDBRefHashTableNum; i++) { LogUpdClause *ocl = (LogUpdClause *)read_UInt(stream); UInt sz = read_UInt(stream); @@ -900,14 +816,14 @@ ReadHash(FILE *stream) } ncl->Id = FunctorDBRef; ncl->ClRefCount = nrefs; - InsertDBRef((DBRef)ocl,(DBRef)ncl); + InsertDBRef((DBRef)ocl, (DBRef)ncl); } RCHECK(read_tag(stream) == QLY_FAILCODE); LOCAL_ImportFAILCODE = (yamop *)read_UInt(stream); } -static void -read_clauses(FILE *stream, PredEntry *pp, UInt nclauses, pred_flags_t flags) { +static void read_clauses(FILE *stream, PredEntry *pp, UInt nclauses, + pred_flags_t flags) { CACHE_REGS if (flags & LogUpdatePredFlag) { /* first, clean up whatever was there */ @@ -915,9 +831,9 @@ read_clauses(FILE *stream, PredEntry *pp, UInt nclauses, pred_flags_t flags) { LogUpdClause *cl; cl = ClauseCodeToLogUpdClause(pp->cs.p_code.FirstClause); do { - LogUpdClause *ncl = cl->ClNext; - Yap_ErLogUpdCl(cl); - cl = ncl; + LogUpdClause *ncl = cl->ClNext; + Yap_ErLogUpdCl(cl); + cl = ncl; } while (cl != NULL); } if (!nclauses) { @@ -930,14 +846,14 @@ read_clauses(FILE *stream, PredEntry *pp, UInt nclauses, pred_flags_t flags) { Int nrefs = 0; if ((cl = LookupMayFailDBRef((DBRef)base))) { - nrefs = cl->ClRefCount; + nrefs = cl->ClRefCount; } else { - cl = (LogUpdClause *)Yap_AlwaysAllocCodeSpace(size); + cl = (LogUpdClause *)Yap_AlwaysAllocCodeSpace(size); } read_bytes(stream, cl, size); cl->ClFlags &= ~InUseMask; cl->ClRefCount = nrefs; - LOCAL_HDiff = (char *)cl-base; + LOCAL_HDiff = (char *)cl - base; RestoreLUClause(cl, pp PASS_REGS); Yap_AssertzClause(pp, cl->ClCode); } @@ -951,12 +867,10 @@ read_clauses(FILE *stream, PredEntry *pp, UInt nclauses, pred_flags_t flags) { if (nclauses) { Yap_Abolish(pp); } - LOCAL_HDiff = (char *)cl-base; + LOCAL_HDiff = (char *)cl - base; read_bytes(stream, cl, size); cl->ClFlags = mask; - pp->cs.p_code.FirstClause = - pp->cs.p_code.LastClause = - cl->ClCode; + pp->cs.p_code.FirstClause = pp->cs.p_code.LastClause = cl->ClCode; pp->PredFlags |= MegaClausePredFlag; /* enter index mode */ if (mask & ExoMask) { @@ -967,7 +881,8 @@ read_clauses(FILE *stream, PredEntry *pp, UInt nclauses, pred_flags_t flags) { } else { pp->OpcodeOfPred = INDEX_OPCODE; } - pp->CodeOfPred = pp->cs.p_code.TrueCodeOfPred = (yamop *)(&(pp->OpcodeOfPred)); + pp->CodeOfPred = pp->cs.p_code.TrueCodeOfPred = + (yamop *)(&(pp->OpcodeOfPred)); /* This must be set for restoremegaclause */ pp->cs.p_code.NOfClauses = nclauses; RestoreMegaClause(cl PASS_REGS); @@ -979,7 +894,7 @@ read_clauses(FILE *stream, PredEntry *pp, UInt nclauses, pred_flags_t flags) { UInt size = read_UInt(stream); DynamicClause *cl = (DynamicClause *)Yap_AlwaysAllocCodeSpace(size); - LOCAL_HDiff = (char *)cl-base; + LOCAL_HDiff = (char *)cl - base; read_bytes(stream, cl, size); INIT_LOCK(cl->ClLock); RestoreDynamicClause(cl, pp PASS_REGS); @@ -989,10 +904,9 @@ read_clauses(FILE *stream, PredEntry *pp, UInt nclauses, pred_flags_t flags) { } else { UInt i; - if (flags & SYSTEM_PRED_FLAGS) { if (nclauses) { - QLYR_ERROR(INCONSISTENT_CPRED); + QLYR_ERROR(INCONSISTENT_CPRED); } return; } @@ -1002,7 +916,7 @@ read_clauses(FILE *stream, PredEntry *pp, UInt nclauses, pred_flags_t flags) { UInt size = read_UInt(stream); StaticClause *cl = (StaticClause *)Yap_AlwaysAllocCodeSpace(size); - LOCAL_HDiff = (char *)cl-base; + LOCAL_HDiff = (char *)cl - base; read_bytes(stream, cl, size); RestoreStaticClause(cl PASS_REGS); Yap_AssertzClause(pp, cl->ClCode); @@ -1010,9 +924,8 @@ read_clauses(FILE *stream, PredEntry *pp, UInt nclauses, pred_flags_t flags) { } } -static void -read_pred(FILE *stream, Term mod) { - pred_flags_t flags, fl1; +static void read_pred(FILE *stream, Term mod) { + pred_flags_t flags; UInt nclauses; PredEntry *ap; @@ -1021,10 +934,10 @@ read_pred(FILE *stream, Term mod) { #if 0 if (ap->ArityOfPE && ap->ModuleOfPred != IDB_MODULE) // __android_log_print(ANDROID_LOG_INFO, "YAP ", " %s/%ld %llx %llx\n", NameOfFunctor(ap->FunctorOfPred)->StrOfAE, ap->ArityOfPE, ap->PredFlags, flags); - printf(" %s/%ld %llx %llx\n", NameOfFunctor(ap->FunctorOfPred)->StrOfAE, ap->ArityOfPE, ap->PredFlags, flags); + printf(" %s/%ld %llx %llx\n", NameOfFunctor(ap->FunctorOfPred)->StrOfAE, ap->ArityOfPE, ap->PredFlags, flags); else if (ap->ModuleOfPred != IDB_MODULE) //__android_log_print(ANDROID_LOG_INFO, "YAP "," %s/%ld %llx %llx\n", ((Atom)(ap->FunctorOfPred))->StrOfAE, ap->ArityOfPE, flags); - printf(" %s/%ld %llx %llx\n", ((Atom)(ap->FunctorOfPred))->StrOfAE, ap->ArityOfPE, ap->PredFlags, flags); + printf(" %s/%ld %llx %llx\n", ((Atom)(ap->FunctorOfPred))->StrOfAE, ap->ArityOfPE, ap->PredFlags, flags); //else // __android_log_print(ANDROID_LOG_INFO, "YAP "," number\n"); #endif @@ -1039,8 +952,8 @@ read_pred(FILE *stream, Term mod) { if (ap->PredFlags & IndexedPredFlag) { Yap_RemoveIndexation(ap); } - //fl1 = flags & ((pred_flags_t)STATIC_PRED_FLAGS|(UInt)EXTRA_PRED_FLAGS); - //ap->PredFlags &= ~((UInt)STATIC_PRED_FLAGS|(UInt)EXTRA_PRED_FLAGS); + // fl1 = flags & ((pred_flags_t)STATIC_PRED_FLAGS|(UInt)EXTRA_PRED_FLAGS); + // ap->PredFlags &= ~((UInt)STATIC_PRED_FLAGS|(UInt)EXTRA_PRED_FLAGS); ap->PredFlags = flags & ~StatePredFlags; if (flags & NumberDBPredFlag) { ap->src.IndxId = read_UInt(stream); @@ -1059,7 +972,7 @@ read_pred(FILE *stream, Term mod) { if (nclauses) read_clauses(stream, ap, nclauses, flags); #if DEBUG - //Yap_PrintPredName( ap ); +// Yap_PrintPredName( ap ); #endif if (flags & HiddenPredFlag) { @@ -1067,8 +980,7 @@ read_pred(FILE *stream, Term mod) { } } -static void -read_ops(FILE *stream) { +static void read_ops(FILE *stream) { Int x; while ((x = read_tag(stream)) != QLY_END_OPS) { Atom at = (Atom)read_UInt(stream); @@ -1079,16 +991,14 @@ read_ops(FILE *stream) { if (mod) mod = MkAtomTerm(AtomAdjust(AtomOfTerm(mod))); op = Yap_OpPropForModule(at, mod); - op->Prefix = read_bits16(stream); - op->Infix = read_bits16(stream); - op->Posfix = read_bits16(stream); + op->Prefix = read_bits16(stream); + op->Infix = read_bits16(stream); + op->Posfix = read_bits16(stream); WRITE_UNLOCK(op->OpRWLock); } } - -static void -read_module(FILE *stream) { +static void read_module(FILE *stream) { qlf_tag_t x; InitHash(); @@ -1100,91 +1010,82 @@ read_module(FILE *stream) { mod = MkAtomTerm(AtomAdjust(AtomOfTerm(mod))); if (mod) while ((x = read_tag(stream)) == QLY_START_PREDICATE) { - read_pred(stream, mod); + read_pred(stream, mod); } } read_ops(stream); CloseHash(); } -static Int -p_read_module_preds( USES_REGS1 ) -{ +static Int p_read_module_preds(USES_REGS1) { FILE *stream; Term t1 = Deref(ARG1); if (IsVarTerm(t1)) { - Yap_Error(INSTANTIATION_ERROR,t1,"read_qly/3"); + Yap_Error(INSTANTIATION_ERROR, t1, "read_qly/3"); return FALSE; } if (!IsAtomTerm(t1)) { - Yap_Error(TYPE_ERROR_ATOM,t1,"read_qly/3"); - return(FALSE); + Yap_Error(TYPE_ERROR_ATOM, t1, "read_qly/3"); + return (FALSE); } - if (!(stream = Yap_GetInputStream(t1, "scanning preducate modules")) ) { + if (!(stream = Yap_GetInputStream(t1, "scanning preducate modules"))) { return FALSE; } read_module(stream); return TRUE; } -static void -ReInitProlog(void) -{ +static void ReInitProlog(void) { Term t = MkAtomTerm(AtomInitProlog); YAP_RunGoalOnce(t); } - - -static Int -qload_program( USES_REGS1 ) -{ +static Int qload_program(USES_REGS1) { FILE *stream; Term t1 = Deref(ARG1); if (IsVarTerm(t1)) { - Yap_Error(INSTANTIATION_ERROR,t1,"read_program/3"); + Yap_Error(INSTANTIATION_ERROR, t1, "read_program/3"); return FALSE; } - if ((stream = Yap_GetInputStream(t1, "from read_program")) ) { + if ((stream = Yap_GetInputStream(t1, "from read_program"))) { return FALSE; } - Yap_Reset( YAP_RESET_FROM_RESTORE ); - if (do_header( stream ) == NIL) + Yap_Reset(YAP_RESET_FROM_RESTORE); + if (do_header(stream) == NIL) return FALSE; read_module(stream); - fclose( stream ); + fclose(stream); /* back to the top level we go */ ReInitProlog(); return true; } -int -Yap_Restore(const char *s, char *lib_dir) -{ +int Yap_Restore(const char *s, char *lib_dir) { CACHE_REGS - - FILE *stream = Yap_OpenRestore(s, lib_dir); + + FILE *stream = Yap_OpenRestore(s, lib_dir); if (!stream) return -1; GLOBAL_RestoreFile = s; - if (do_header( stream ) == NIL) + if (do_header(stream) == NIL) return FALSE; read_module(stream); - fclose( stream ); + fclose(stream); GLOBAL_RestoreFile = NULL; - CurrentModule = USER_MODULE; + LOCAL_SourceModule = CurrentModule = USER_MODULE; return DO_ONLY_CODE; } - -void Yap_InitQLYR(void) -{ - Yap_InitCPred("$qload_module_preds", 1, p_read_module_preds, SyncPredFlag|UserCPredFlag|HiddenPredFlag); - Yap_InitCPred("$qload_file_preds", 1, p_read_module_preds, SyncPredFlag|HiddenPredFlag); - Yap_InitCPred("$qload_program", 1, qload_program, SyncPredFlag|HiddenPredFlag); - Yap_InitCPred("$q_header", 2, get_header, SyncPredFlag|HiddenPredFlag); +void Yap_InitQLYR(void) { + Yap_InitCPred("$qload_module_preds", 1, p_read_module_preds, + SyncPredFlag | UserCPredFlag | HiddenPredFlag); + Yap_InitCPred("$qload_file_preds", 1, p_read_module_preds, + SyncPredFlag | HiddenPredFlag); + Yap_InitCPred("$qload_program", 1, qload_program, + SyncPredFlag | HiddenPredFlag); + Yap_InitCPred("$q_header", 2, get_header, SyncPredFlag | HiddenPredFlag); if (FALSE) { restore_codes(); } diff --git a/C/save.c b/C/save.c index 228bec8a8..e0b2a0fae 100755 --- a/C/save.c +++ b/C/save.c @@ -413,8 +413,6 @@ save_regs(int mode USES_REGS) return -1; if (putout(EventFlag) < 0) return -1; - if (putcellptr((CELL *)EX) < 0) - return -1; #if defined(YAPOR_SBA) || defined(TABLING) if (putcellptr(H_FZ) < 0) return -1; @@ -859,9 +857,6 @@ get_regs(int flag USES_REGS) EventFlag = get_cell(); if (LOCAL_ErrorMessage) return -1; - EX = (struct DB_TERM *)get_cellptr(); - if (LOCAL_ErrorMessage) - return -1; #if defined(YAPOR_SBA) || defined(TABLING) H_FZ = get_cellptr(); if (LOCAL_ErrorMessage) @@ -1067,10 +1062,6 @@ restore_regs(int flag USES_REGS) HB = PtoLocAdjust(HB); YENV = PtoLocAdjust(YENV); S = PtoGloAdjust(S); - if (EX) { - EX = DBTermAdjust(EX); - RestoreDBTerm(EX, false, TRUE PASS_REGS); - } LOCAL_WokenGoals = AbsAppl(PtoGloAdjust(RepAppl(LOCAL_WokenGoals))); } } @@ -1203,12 +1194,6 @@ rehash(CELL *oldcode, int NOfE, int KindOfEntries USES_REGS) } } -static void -RestoreSWIHash(void) -{ - // Yap_InitSWIHash(); -} - static void RestoreFlags( UInt NFlags ) { diff --git a/C/signals.c b/C/signals.c index bd1e1c369..9fe5c8d60 100755 --- a/C/signals.c +++ b/C/signals.c @@ -183,6 +183,21 @@ inline static bool get_signal(yap_signals sig USES_REGS) { #endif } +bool Yap_DisableInterrupts(int wid) +{ + LOCAL_InterruptsDisabled = true; + YAPEnterCriticalSection(); + return true; +} + +bool Yap_EnableInterrupts(int wid) +{ + LOCAL_InterruptsDisabled = false; + YAPLeaveCriticalSection(); + return true; +} + + /** Function called to handle delayed interrupts. */ diff --git a/C/stdpreds.c b/C/stdpreds.c index a2746c89f..f79470f91 100755 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -1415,8 +1415,9 @@ static Int p_break(USES_REGS1) { return FALSE; } + void Yap_InitBackCPreds(void) { - Yap_InitCPredBack("$current_predicate", 4, 1, current_predicate, + Yap_InitCPredBack("$current_predicate", 4, 1, current_predicate, cont_current_predicate, SafePredFlag | SyncPredFlag); Yap_InitCPredBack("$current_op", 5, 1, init_current_op, cont_current_op, SafePredFlag | SyncPredFlag); diff --git a/C/tracer.c b/C/tracer.c index 77c5d0f12..877dbce93 100644 --- a/C/tracer.c +++ b/C/tracer.c @@ -19,12 +19,12 @@ #ifdef LOW_LEVEL_TRACER -#include "Yatom.h" #include "YapHeap.h" +#include "Yatom.h" #include "attvar.h" -#include "yapio.h" #include "clause.h" #include "tracer.h" +#include "yapio.h" static void send_tracer_message(char *start, char *name, Int arity, char *mname, CELL *args) { @@ -137,8 +137,8 @@ check_area(void) } */ -//PredEntry *old_p[10000]; -//Term old_x1[10000], old_x2[10000], old_x3[10000]; +// PredEntry *old_p[10000]; +// Term old_x1[10000], old_x2[10000], old_x3[10000]; // static CELL oldv; @@ -321,6 +321,7 @@ void low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) { } #endif fprintf(stderr, "%lld %ld ", vsc_count, LCL0 - (CELL *)B); + fprintf(stderr, "%ld ", LCL0 - (CELL *)Yap_REGS.CUT_C_TOP); #if defined(THREADS) || defined(YAPOR) fprintf(stderr, "(%d)", worker_id); #endif @@ -331,12 +332,12 @@ void low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) { } if (pred->ModuleOfPred == PROLOG_MODULE) { if (!LOCAL_do_trace_primitives) { - UNLOCK(Yap_low_level_trace_lock); - return; + UNLOCK(Yap_low_level_trace_lock); + return; } mname = "prolog"; } else { - mname = RepAtom(AtomOfTerm(Yap_Module_Name(pred)))->StrOfAE; + mname = RepAtom(AtomOfTerm(Yap_Module_Name(pred)))->StrOfAE; } switch (port) { case enter_pred: diff --git a/C/write.c b/C/write.c index 89ba06d03..9b011726d 100644 --- a/C/write.c +++ b/C/write.c @@ -19,14 +19,14 @@ static char SccsId[] = "%W% %G%"; #endif -#include -#include #include "Yap.h" -#include "Yatom.h" #include "YapHeap.h" #include "YapText.h" -#include "yapio.h" +#include "Yatom.h" #include "clause.h" +#include "yapio.h" +#include +#include #if COROUTINING #include "attvar.h" #endif @@ -88,21 +88,21 @@ static bool callPortray(Term t, struct DB_TERM **old_EXp, int sno USES_REGS) { PredEntry *pe; Int b0 = LCL0 - (CELL *)B; - EX = NULL; + *old_EXp = Yap_RefToException(); UNLOCK(GLOBAL_Stream[sno].streamlock); if ((pe = RepPredProp(Yap_GetPredPropByFunc(FunctorPortray, USER_MODULE))) && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && Yap_execute_pred(pe, &t, true PASS_REGS)) { choiceptr B0 = (choiceptr)(LCL0 - b0); - if (EX && !*old_EXp) - *old_EXp = EX; + if (Yap_HasException() && !*old_EXp) + *old_EXp = Yap_RefToException(); Yap_fail_all(B0 PASS_REGS); LOCK(GLOBAL_Stream[sno].streamlock); return true; } LOCK(GLOBAL_Stream[sno].streamlock); - if (EX && !*old_EXp) - *old_EXp = EX; + if (Yap_HasException() && !*old_EXp) + *old_EXp = Yap_RefToException(); return false; } @@ -472,9 +472,7 @@ static wtype AtomIsSymbols(unsigned char *s) /* Is this atom just formed by symbols ? */ { int ch; - if ( Yap_chtype[(int)s[0]] == SL && - s[1] == '\0' - ) + if (Yap_chtype[(int)s[0]] == SL && s[1] == '\0') return (separator); while ((ch = *s++) != '\0') { if (Yap_chtype[ch] != SY) @@ -738,8 +736,8 @@ static CELL *restore_from_write(struct rewind_term *rwt, CELL *ptr; if (wglb->Keep_terms) { - ptr = Yap_GetPtrFromSlot(rwt->u_sd.s.ptr ); - Yap_RecoverSlots(2, rwt->u_sd.s.old ); + ptr = Yap_GetPtrFromSlot(rwt->u_sd.s.ptr); + Yap_RecoverSlots(2, rwt->u_sd.s.old); // printf("leak=%d %d\n", LOCALCurSlot,rwt->u_sd.s.old) ; } else { ptr = rwt->u_sd.d.ptr; @@ -875,9 +873,9 @@ static void write_list(Term t, int direction, int depth, } restore_from_write(&nrwt, wglb); } else if (ti != MkAtomTerm(AtomNil)) { - if (lastw == symbol || lastw == separator) { - wrputc(' ', wglb->stream); - } + if (lastw == symbol || lastw == separator) { + wrputc(' ', wglb->stream); + } wrputc('|', wglb->stream); lastw = separator; writeTerm(from_pointer(RepPair(t) + 1, &nrwt, wglb), 999, depth, FALSE, @@ -901,8 +899,8 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, putAtom(Atom3Dots, wglb->Quote_illegal, wglb); return; } - DBTerm *oEX = EX; - EX = NULL; + DBTerm *ex; + Yap_ResetException(worker_id); t = Deref(t); if (IsVarTerm(t)) { write_var((CELL *)t, wglb, &nrwt); @@ -924,12 +922,12 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, FALSE, wglb, &nrwt); restore_from_write(&nrwt, wglb); wrclose_bracket(wglb, TRUE); - EX = oEX; return; } if (wglb->Use_portray) - if (callPortray(t, &EX, wglb->stream - GLOBAL_Stream PASS_REGS)) { - EX = oEX; + if (callPortray(t, &ex, wglb->stream - GLOBAL_Stream PASS_REGS)) { + Yap_CopyException(ex); + Yap_RaiseException(); return; } if (trueGlobalPrologFlag(WRITE_STRINGS_FLAG) && IsCodesTerm(t)) { @@ -950,19 +948,19 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, if (IsExtensionFunctor(functor)) { switch ((CELL)functor) { - case (CELL) FunctorDouble: + case (CELL)FunctorDouble: wrputf(FloatOfTerm(t), wglb); return; - case (CELL) FunctorString: + case (CELL)FunctorString: write_string(UStringOfTerm(t), wglb); return; - case (CELL) FunctorAttVar: + case (CELL)FunctorAttVar: write_var(RepAppl(t) + 1, wglb, &nrwt); return; - case (CELL) FunctorDBRef: + case (CELL)FunctorDBRef: wrputref(RefOfTerm(t), wglb->Quote_illegal, wglb); return; - case (CELL) FunctorLongInt: + case (CELL)FunctorLongInt: wrputn(LongIntOfTerm(t), wglb); return; /* case (CELL)FunctorBigInt: */ @@ -1002,8 +1000,9 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, } #endif if (wglb->Use_portray) { - if (callPortray(t, &EX, wglb->stream - GLOBAL_Stream PASS_REGS)) { - EX = oEX; + if (callPortray(t, &ex, wglb->stream - GLOBAL_Stream PASS_REGS)) { + Yap_CopyException(ex); + Yap_RaiseException(); return; } } @@ -1133,17 +1132,14 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, if (op > p) { wrclose_bracket(wglb, TRUE); } - } else if ( functor == FunctorDollarVar) { + } else if (functor == FunctorDollarVar) { Term ti = ArgOfTerm(1, t); if (lastw == alphanum) { wrputc(' ', wglb->stream); } - if (wglb->Handle_vars && - !IsVarTerm(ti) && - (IsIntTerm(ti) || - IsCodesTerm(ti) || - IsAtomTerm(ti) || - IsStringTerm(ti) )) { + if (wglb->Handle_vars && !IsVarTerm(ti) && + (IsIntTerm(ti) || IsCodesTerm(ti) || IsAtomTerm(ti) || + IsStringTerm(ti))) { if (IsIntTerm(ti)) { Int k = IntOfTerm(ti); if (k == -1) { @@ -1177,8 +1173,8 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, } else if (!wglb->Ignore_ops && functor == FunctorBraces) { wrputc('{', wglb->stream); lastw = separator; - writeTerm(from_pointer(RepAppl(t) + 1, &nrwt, wglb), GLOBAL_MaxPriority, depth + 1, - FALSE, wglb, &nrwt); + writeTerm(from_pointer(RepAppl(t) + 1, &nrwt, wglb), GLOBAL_MaxPriority, + depth + 1, FALSE, wglb, &nrwt); restore_from_write(&nrwt, wglb); wrputc('}', wglb->stream); lastw = separator; @@ -1222,7 +1218,6 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg, wrclose_bracket(wglb, TRUE); } } - EX = oEX; } void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, @@ -1292,7 +1287,7 @@ char *Yap_TermToString(Term t, char *s, size_t sz, size_t *length, s = Yap_MemExportStreamPtr(sno); Yap_CloseStream(sno); LOCAL_c_output_stream = old_output_stream; - if (EX == 0) - return s; - return NULL; + if (Yap_HasException()) + return NULL; + return s; }