2001-04-09 19:54:03 +00:00
|
|
|
|
/*************************************************************************
|
|
|
|
|
* *
|
|
|
|
|
* YAP Prolog *
|
|
|
|
|
* *
|
|
|
|
|
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
|
|
|
|
* *
|
|
|
|
|
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
|
|
|
|
* *
|
|
|
|
|
**************************************************************************
|
|
|
|
|
* *
|
|
|
|
|
* File: absmi.c *
|
|
|
|
|
* comments: Portable abstract machine interpreter *
|
2008-08-13 01:16:26 +00:00
|
|
|
|
* Last rev: $Date: 2008-08-13 01:16:26 $,$Author: vsc $ *
|
2004-03-10 14:59:55 +00:00
|
|
|
|
* $Log: not supported by cvs2svn $
|
2008-08-13 01:16:26 +00:00
|
|
|
|
* 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.
|
|
|
|
|
*
|
2008-08-12 01:27:23 +00:00
|
|
|
|
* Revision 1.245 2008/08/07 20:51:15 vsc
|
|
|
|
|
* more threadin fixes
|
|
|
|
|
*
|
2008-08-07 20:51:23 +00:00
|
|
|
|
* Revision 1.244 2008/08/06 23:05:49 vsc
|
|
|
|
|
* fix debugging info
|
|
|
|
|
*
|
2008-08-06 23:05:49 +00:00
|
|
|
|
* Revision 1.243 2008/08/06 17:32:18 vsc
|
|
|
|
|
* more thread fixes
|
|
|
|
|
*
|
2008-08-06 17:32:22 +00:00
|
|
|
|
* 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.
|
|
|
|
|
*
|
2008-06-17 13:37:51 +00:00
|
|
|
|
* Revision 1.241 2008/06/04 14:47:18 vsc
|
|
|
|
|
* make sure we do trim_trail whenever we mess with B!
|
|
|
|
|
*
|
2008-06-04 14:47:18 +00:00
|
|
|
|
* Revision 1.240 2008/04/04 16:11:40 vsc
|
|
|
|
|
* yapor had gotten broken with recent thread changes
|
|
|
|
|
*
|
2008-04-04 16:11:40 +00:00
|
|
|
|
* 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.
|
|
|
|
|
*
|
2008-04-03 13:26:38 +00:00
|
|
|
|
* Revision 1.238 2008/04/03 10:50:23 vsc
|
|
|
|
|
* term_variables could store local variable in global.
|
|
|
|
|
*
|
2008-04-03 10:50:28 +00:00
|
|
|
|
* Revision 1.237 2008/03/26 14:37:07 vsc
|
|
|
|
|
* more icc fixes
|
|
|
|
|
*
|
2008-03-26 14:37:08 +00:00
|
|
|
|
* Revision 1.236 2008/03/25 16:45:52 vsc
|
|
|
|
|
* make or-parallelism compile again
|
|
|
|
|
*
|
2008-03-25 16:45:53 +00:00
|
|
|
|
* Revision 1.235 2008/02/12 17:03:50 vsc
|
|
|
|
|
* SWI-portability changes
|
|
|
|
|
*
|
2008-02-12 17:03:59 +00:00
|
|
|
|
* Revision 1.234 2008/01/27 11:01:06 vsc
|
|
|
|
|
* make thread code more stable
|
|
|
|
|
*
|
2008-01-27 11:01:07 +00:00
|
|
|
|
* Revision 1.233 2008/01/23 17:57:44 vsc
|
|
|
|
|
* valgrind it!
|
|
|
|
|
* enable atom garbage collection.
|
|
|
|
|
*
|
2008-01-23 17:57:56 +00:00
|
|
|
|
* Revision 1.232 2007/11/28 23:52:14 vsc
|
|
|
|
|
* junction tree algorithm
|
|
|
|
|
*
|
2007-11-28 23:52:14 +00:00
|
|
|
|
* Revision 1.231 2007/11/26 23:43:07 vsc
|
|
|
|
|
* fixes to support threads and assert correctly, even if inefficiently.
|
|
|
|
|
*
|
2007-11-26 23:43:10 +00:00
|
|
|
|
* Revision 1.230 2007/11/08 15:52:15 vsc
|
|
|
|
|
* fix some bugs in new dbterm code.
|
|
|
|
|
*
|
2007-11-08 15:52:15 +00:00
|
|
|
|
* Revision 1.229 2007/11/07 09:25:27 vsc
|
|
|
|
|
* speedup meta-calls
|
|
|
|
|
*
|
2007-11-07 09:25:27 +00:00
|
|
|
|
* Revision 1.228 2007/11/06 17:02:08 vsc
|
|
|
|
|
* compile ground terms away.
|
|
|
|
|
*
|
2007-11-06 17:02:13 +00:00
|
|
|
|
* Revision 1.227 2007/10/28 11:23:39 vsc
|
|
|
|
|
* fix overflow
|
|
|
|
|
*
|
2007-10-28 11:23:41 +00:00
|
|
|
|
* 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
|
|
|
|
|
*
|
2007-10-28 00:54:09 +00:00
|
|
|
|
* Revision 1.225 2007/10/17 09:18:26 vsc
|
|
|
|
|
* growtrail assumed SREG meant ASP?
|
|
|
|
|
*
|
2007-10-17 09:18:27 +00:00
|
|
|
|
* Revision 1.224 2007/09/24 09:02:31 vsc
|
|
|
|
|
* minor bug fixes
|
|
|
|
|
*
|
2007-09-24 09:02:33 +00:00
|
|
|
|
* Revision 1.223 2007/06/04 12:28:01 vsc
|
|
|
|
|
* interface speedups
|
|
|
|
|
* bad error message in X is foo>>2.
|
|
|
|
|
*
|
2007-06-04 12:28:02 +00:00
|
|
|
|
* Revision 1.222 2007/05/01 21:18:19 vsc
|
|
|
|
|
* fix bug in saving P at p_eq (obs from Frabrizio Riguzzi)
|
|
|
|
|
*
|
2007-05-01 21:18:19 +00:00
|
|
|
|
* Revision 1.221 2007/04/10 22:13:20 vsc
|
|
|
|
|
* fix max modules limitation
|
|
|
|
|
*
|
2007-04-10 22:13:21 +00:00
|
|
|
|
* Revision 1.220 2007/03/21 18:32:49 vsc
|
|
|
|
|
* fix memory expansion bugs.
|
|
|
|
|
*
|
2007-03-21 18:32:50 +00:00
|
|
|
|
* Revision 1.219 2007/01/24 09:57:25 vsc
|
|
|
|
|
* fix glist_void_varx
|
|
|
|
|
*
|
2007-01-24 09:57:25 +00:00
|
|
|
|
* 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.
|
|
|
|
|
*
|
2006-12-31 01:50:35 +00:00
|
|
|
|
* Revision 1.217 2006/12/30 03:25:44 vsc
|
|
|
|
|
* call_cleanup/2 and 3
|
|
|
|
|
*
|
2006-12-30 03:25:47 +00:00
|
|
|
|
* 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.
|
|
|
|
|
*
|
2006-12-29 01:57:50 +00:00
|
|
|
|
* Revision 1.215 2006/12/27 01:32:37 vsc
|
|
|
|
|
* diverse fixes
|
|
|
|
|
*
|
2006-12-27 01:32:38 +00:00
|
|
|
|
* Revision 1.214 2006/11/28 00:46:28 vsc
|
|
|
|
|
* fix bug in threaded implementation
|
|
|
|
|
*
|
2006-11-28 00:46:28 +00:00
|
|
|
|
* Revision 1.213 2006/11/27 17:42:02 vsc
|
|
|
|
|
* support for UNICODE, and other bug fixes.
|
|
|
|
|
*
|
2006-11-27 17:42:03 +00:00
|
|
|
|
* Revision 1.212 2006/11/21 16:21:30 vsc
|
|
|
|
|
* fix I/O mess
|
|
|
|
|
* fix spy/reconsult mess
|
|
|
|
|
*
|
2006-11-21 16:21:33 +00:00
|
|
|
|
* Revision 1.211 2006/11/15 00:13:36 vsc
|
|
|
|
|
* fixes for indexing code.
|
|
|
|
|
*
|
2006-11-15 00:13:37 +00:00
|
|
|
|
* Revision 1.210 2006/10/25 02:31:07 vsc
|
|
|
|
|
* fix emulation of trust_logical
|
|
|
|
|
*
|
2006-10-25 02:31:07 +00:00
|
|
|
|
* Revision 1.209 2006/10/18 13:47:31 vsc
|
|
|
|
|
* index.c implementation of trust_logical was decrementing the wrong
|
|
|
|
|
* cp_tr
|
|
|
|
|
*
|
2006-10-18 13:47:32 +00:00
|
|
|
|
* Revision 1.208 2006/10/11 14:53:57 vsc
|
|
|
|
|
* fix memory leak
|
|
|
|
|
* fix overflow handling
|
|
|
|
|
* VS: ----------------------------------------------------------------------
|
|
|
|
|
*
|
2006-10-11 14:53:57 +00:00
|
|
|
|
* 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
|
|
|
|
|
*
|
2006-10-10 20:21:42 +00:00
|
|
|
|
* Revision 1.206 2006/10/10 14:08:15 vsc
|
|
|
|
|
* small fixes on threaded implementation.
|
|
|
|
|
*
|
2006-10-10 14:08:17 +00:00
|
|
|
|
* Revision 1.205 2006/09/28 16:15:54 vsc
|
|
|
|
|
* make GMPless version compile.
|
|
|
|
|
*
|
2006-09-28 16:15:54 +00:00
|
|
|
|
* Revision 1.204 2006/09/20 20:03:51 vsc
|
|
|
|
|
* improve indexing on floats
|
|
|
|
|
* fix sending large lists to DB
|
|
|
|
|
*
|
2006-09-20 20:03:51 +00:00
|
|
|
|
* 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.
|
|
|
|
|
*
|
2006-08-07 18:51:44 +00:00
|
|
|
|
* Revision 1.202 2006/05/24 02:35:39 vsc
|
|
|
|
|
* make chr work and other minor fixes.
|
|
|
|
|
*
|
2006-05-24 02:35:39 +00:00
|
|
|
|
* Revision 1.201 2006/04/27 14:11:57 rslopes
|
|
|
|
|
* *** empty log message ***
|
|
|
|
|
*
|
2006-04-27 14:13:24 +00:00
|
|
|
|
* Revision 1.200 2006/04/12 17:14:58 rslopes
|
|
|
|
|
* fix needed by the EAM engine
|
|
|
|
|
*
|
2006-04-12 17:14:58 +00:00
|
|
|
|
* Revision 1.199 2006/04/12 15:51:23 rslopes
|
|
|
|
|
* small fixes
|
|
|
|
|
*
|
2006-04-12 15:51:23 +00:00
|
|
|
|
* Revision 1.198 2006/03/30 01:11:09 vsc
|
|
|
|
|
* fix nasty variable shunting bug in garbage collector :-(:wq
|
|
|
|
|
*
|
2006-03-30 01:11:10 +00:00
|
|
|
|
* Revision 1.197 2006/03/24 17:13:41 rslopes
|
|
|
|
|
* New update to BEAM engine.
|
|
|
|
|
* BEAM now uses YAP Indexing (JITI)
|
|
|
|
|
*
|
2006-03-24 17:13:41 +00:00
|
|
|
|
* Revision 1.196 2006/03/03 23:10:47 vsc
|
|
|
|
|
* fix MacOSX interrupt handling
|
|
|
|
|
* fix using Yap files as Yap scripts.
|
|
|
|
|
*
|
2006-03-03 23:11:30 +00:00
|
|
|
|
* Revision 1.195 2006/02/01 13:28:56 vsc
|
|
|
|
|
* bignum support fixes
|
|
|
|
|
*
|
2006-02-01 13:28:57 +00:00
|
|
|
|
* Revision 1.194 2006/01/26 19:13:24 vsc
|
|
|
|
|
* avoid compilation issues with lack of gmp (Remko Troncon)
|
|
|
|
|
*
|
2006-01-26 19:13:24 +00:00
|
|
|
|
* Revision 1.193 2006/01/18 15:34:53 vsc
|
|
|
|
|
* avoid sideffects from MkBigInt
|
|
|
|
|
*
|
2006-01-18 15:34:54 +00:00
|
|
|
|
* 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.
|
|
|
|
|
*
|
2006-01-17 14:10:42 +00:00
|
|
|
|
* 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.
|
|
|
|
|
*
|
2006-01-02 02:16:19 +00:00
|
|
|
|
* Revision 1.190 2005/12/23 00:20:13 vsc
|
|
|
|
|
* updates to gprof
|
|
|
|
|
* support for __POWER__
|
|
|
|
|
* Try to saveregs before longjmp.
|
|
|
|
|
*
|
2005-12-23 00:20:14 +00:00
|
|
|
|
* 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.
|
|
|
|
|
*
|
2005-12-17 03:25:39 +00:00
|
|
|
|
* 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.
|
|
|
|
|
*
|
2005-12-05 17:16:12 +00:00
|
|
|
|
* Revision 1.187 2005/11/26 02:57:25 vsc
|
|
|
|
|
* improvements to debugger
|
|
|
|
|
* overflow fixes
|
|
|
|
|
* reading attvars from DB was broken.
|
|
|
|
|
*
|
2005-11-26 02:57:25 +00:00
|
|
|
|
* Revision 1.186 2005/11/23 03:01:32 vsc
|
|
|
|
|
* fix several bugs in save/restore.b
|
|
|
|
|
*
|
2005-11-23 03:01:33 +00:00
|
|
|
|
* Revision 1.185 2005/11/18 18:48:51 tiagosoares
|
|
|
|
|
* support for executing c code when a cut occurs
|
|
|
|
|
*
|
2005-11-18 18:52:41 +00:00
|
|
|
|
* Revision 1.184 2005/11/15 00:50:49 vsc
|
|
|
|
|
* fixes for stack expansion and garbage collection under tabling.
|
|
|
|
|
*
|
2005-11-15 00:50:49 +00:00
|
|
|
|
* Revision 1.183 2005/11/07 15:35:47 vsc
|
|
|
|
|
* fix bugs in garbage collection of tabling.
|
|
|
|
|
*
|
2005-11-07 15:35:47 +00:00
|
|
|
|
* Revision 1.182 2005/11/05 03:02:33 vsc
|
|
|
|
|
* get rid of unnecessary ^ in setof
|
|
|
|
|
* Found bug in comparisons
|
|
|
|
|
*
|
2005-11-05 03:02:33 +00:00
|
|
|
|
* Revision 1.181 2005/11/04 15:39:14 vsc
|
|
|
|
|
* absmi should PREG, never P!!
|
|
|
|
|
*
|
2005-11-04 15:39:14 +00:00
|
|
|
|
* Revision 1.180 2005/10/28 17:38:49 vsc
|
|
|
|
|
* sveral updates
|
|
|
|
|
*
|
2005-10-28 17:38:50 +00:00
|
|
|
|
* 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.
|
|
|
|
|
*
|
2005-10-18 17:04:43 +00:00
|
|
|
|
* Revision 1.178 2005/10/15 17:05:23 rslopes
|
|
|
|
|
* enable profiling on amd64
|
|
|
|
|
*
|
2005-10-15 17:05:23 +00:00
|
|
|
|
* Revision 1.177 2005/09/09 17:24:37 vsc
|
|
|
|
|
* a new and hopefully much better implementation of atts.
|
|
|
|
|
*
|
2005-09-09 17:24:39 +00:00
|
|
|
|
* Revision 1.176 2005/09/08 22:06:44 rslopes
|
|
|
|
|
* BEAM for YAP update...
|
|
|
|
|
*
|
2005-09-08 22:06:45 +00:00
|
|
|
|
* Revision 1.175 2005/08/12 17:00:00 ricroc
|
|
|
|
|
* TABLING FIX: support for incomplete tables
|
|
|
|
|
*
|
2005-08-12 17:00:00 +00:00
|
|
|
|
* 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
|
|
|
|
|
*
|
2005-08-05 14:55:03 +00:00
|
|
|
|
* Revision 1.173 2005/08/04 15:45:49 ricroc
|
|
|
|
|
* TABLING NEW: support to limit the table space size
|
|
|
|
|
*
|
2005-08-04 15:45:56 +00:00
|
|
|
|
* Revision 1.172 2005/08/02 03:09:48 vsc
|
|
|
|
|
* fix debugger to do well nonsource predicates.
|
|
|
|
|
*
|
2005-08-02 03:09:52 +00:00
|
|
|
|
* Revision 1.171 2005/08/01 15:40:36 ricroc
|
|
|
|
|
* TABLING NEW: better support for incomplete tabling
|
|
|
|
|
*
|
2005-08-01 15:40:39 +00:00
|
|
|
|
* 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.
|
|
|
|
|
*
|
2005-07-06 19:34:12 +00:00
|
|
|
|
* Revision 1.169 2005/07/06 15:10:01 vsc
|
|
|
|
|
* improvements to compiler: merged instructions and fixes for ->
|
|
|
|
|
*
|
2005-07-06 15:10:18 +00:00
|
|
|
|
* Revision 1.168 2005/06/04 07:27:33 ricroc
|
|
|
|
|
* long int support for tabling
|
|
|
|
|
*
|
2005-06-04 07:28:24 +00:00
|
|
|
|
* Revision 1.167 2005/06/03 08:26:31 ricroc
|
|
|
|
|
* float support for tabling
|
|
|
|
|
*
|
2005-06-03 08:26:32 +00:00
|
|
|
|
* Revision 1.166 2005/06/01 20:25:22 vsc
|
|
|
|
|
* == and \= should not need a choice-point in ->
|
|
|
|
|
*
|
2005-06-01 20:25:23 +00:00
|
|
|
|
* 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.
|
|
|
|
|
*
|
2005-06-01 14:02:52 +00:00
|
|
|
|
* Revision 1.164 2005/05/26 18:07:32 vsc
|
|
|
|
|
* fix warning
|
|
|
|
|
*
|
2005-05-26 18:07:32 +00:00
|
|
|
|
* Revision 1.163 2005/04/10 04:01:07 vsc
|
|
|
|
|
* bug fixes, I hope!
|
|
|
|
|
*
|
2005-04-10 04:01:15 +00:00
|
|
|
|
* 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).
|
|
|
|
|
*
|
2005-04-07 17:56:58 +00:00
|
|
|
|
* 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).
|
|
|
|
|
*
|
2005-03-13 06:26:13 +00:00
|
|
|
|
* Revision 1.160 2005/03/07 17:49:14 vsc
|
|
|
|
|
* small fixes
|
|
|
|
|
*
|
2005-03-07 17:49:16 +00:00
|
|
|
|
* Revision 1.159 2005/03/04 20:29:55 ricroc
|
|
|
|
|
* bug fixes for YapTab support
|
|
|
|
|
*
|
2005-03-04 20:30:14 +00:00
|
|
|
|
* Revision 1.158 2005/03/01 22:25:07 vsc
|
|
|
|
|
* fix pruning bug
|
|
|
|
|
* make DL_MALLOC less enthusiastic about walking through buckets.
|
|
|
|
|
*
|
2005-03-01 22:25:09 +00:00
|
|
|
|
* Revision 1.157 2005/02/08 18:04:17 vsc
|
|
|
|
|
* library_directory may not be deterministic (usually it isn't).
|
|
|
|
|
*
|
2005-02-08 18:05:21 +00:00
|
|
|
|
* 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.
|
|
|
|
|
*
|
2005-01-13 05:47:27 +00:00
|
|
|
|
* 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.
|
|
|
|
|
*
|
2004-12-28 22:20:37 +00:00
|
|
|
|
* 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.
|
|
|
|
|
*
|
2004-12-05 05:01:45 +00:00
|
|
|
|
* Revision 1.153 2004/11/19 22:08:35 vsc
|
|
|
|
|
* replace SYSTEM_ERROR by out OUT_OF_WHATEVER_ERROR whenever appropriate.
|
|
|
|
|
*
|
2004-11-19 22:08:43 +00:00
|
|
|
|
* Revision 1.152 2004/11/19 17:14:12 vsc
|
|
|
|
|
* a few fixes for 64 bit compiling.
|
|
|
|
|
*
|
2004-11-19 17:14:15 +00:00
|
|
|
|
* 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
|
|
|
|
|
*
|
2004-11-04 18:22:36 +00:00
|
|
|
|
* Revision 1.150 2004/10/26 20:15:36 vsc
|
|
|
|
|
* More bug fixes for overflow handling
|
|
|
|
|
*
|
2004-10-26 20:16:18 +00:00
|
|
|
|
* Revision 1.149 2004/10/14 22:14:52 vsc
|
|
|
|
|
* don't use a cached version of ARG1 in choice-points
|
|
|
|
|
*
|
2004-10-14 22:14:53 +00:00
|
|
|
|
* Revision 1.148 2004/09/30 21:37:40 vsc
|
|
|
|
|
* fixes for thread support
|
|
|
|
|
*
|
2004-09-30 21:37:41 +00:00
|
|
|
|
* Revision 1.147 2004/09/30 19:51:53 vsc
|
|
|
|
|
* fix overflow from within clause/2
|
|
|
|
|
*
|
2004-09-30 19:51:54 +00:00
|
|
|
|
* 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
|
|
|
|
|
*
|
2004-09-27 20:45:04 +00:00
|
|
|
|
* Revision 1.145 2004/09/17 20:47:35 vsc
|
|
|
|
|
* fix some overflows recorded.
|
|
|
|
|
*
|
2004-09-17 20:47:35 +00:00
|
|
|
|
* Revision 1.144 2004/09/17 19:34:49 vsc
|
|
|
|
|
* simplify frozen/2
|
|
|
|
|
*
|
2004-09-17 19:34:53 +00:00
|
|
|
|
* Revision 1.143 2004/08/16 21:02:04 vsc
|
|
|
|
|
* more fixes for !
|
|
|
|
|
*
|
2004-08-16 21:02:04 +00:00
|
|
|
|
* 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
|
|
|
|
|
*
|
2004-08-11 16:14:55 +00:00
|
|
|
|
* Revision 1.141 2004/07/23 21:08:44 vsc
|
|
|
|
|
* windows fixes
|
|
|
|
|
*
|
2004-07-23 21:08:45 +00:00
|
|
|
|
* 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
|
|
|
|
|
*
|
2004-07-22 21:32:23 +00:00
|
|
|
|
* Revision 1.139 2004/07/03 03:29:24 vsc
|
|
|
|
|
* make it compile again on non-linux machines
|
|
|
|
|
*
|
2004-07-03 03:29:24 +00:00
|
|
|
|
* 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
|
|
|
|
|
*
|
2004-06-29 19:04:46 +00:00
|
|
|
|
* 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.
|
|
|
|
|
*
|
2004-06-23 17:24:20 +00:00
|
|
|
|
* Revision 1.136 2004/06/17 22:07:22 vsc
|
|
|
|
|
* bad bug in indexing code.
|
|
|
|
|
*
|
2004-06-17 22:07:23 +00:00
|
|
|
|
* Revision 1.135 2004/06/09 03:32:02 vsc
|
|
|
|
|
* fix bugs
|
|
|
|
|
*
|
2004-06-09 03:32:03 +00:00
|
|
|
|
* Revision 1.134 2004/06/05 03:36:59 vsc
|
|
|
|
|
* coroutining is now a part of attvars.
|
|
|
|
|
* some more fixes.
|
|
|
|
|
*
|
2004-06-05 03:37:01 +00:00
|
|
|
|
* Revision 1.133 2004/05/13 20:54:57 vsc
|
|
|
|
|
* debugger fixes
|
|
|
|
|
* make sure we always go back to current module, even during initizlization.
|
|
|
|
|
*
|
2004-05-13 20:54:58 +00:00
|
|
|
|
* Revision 1.132 2004/04/29 03:45:49 vsc
|
|
|
|
|
* fix garbage collection in execute_tail
|
|
|
|
|
*
|
2004-04-29 03:45:50 +00:00
|
|
|
|
* Revision 1.131 2004/04/22 20:07:02 vsc
|
|
|
|
|
* more fixes for USE_SYSTEM_MEMORY
|
|
|
|
|
*
|
2004-04-22 20:07:07 +00:00
|
|
|
|
* Revision 1.130 2004/04/22 03:24:17 vsc
|
|
|
|
|
* trust_logical should protect the last clause, otherwise it cannot
|
|
|
|
|
* jump there.
|
|
|
|
|
*
|
2004-04-22 03:24:17 +00:00
|
|
|
|
* Revision 1.129 2004/04/16 19:27:30 vsc
|
|
|
|
|
* more bug fixes
|
|
|
|
|
*
|
2004-04-16 19:27:31 +00:00
|
|
|
|
* 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
|
|
|
|
|
*
|
2004-04-14 19:10:40 +00:00
|
|
|
|
* Revision 1.127 2004/03/31 01:03:09 vsc
|
|
|
|
|
* support expand group of clauses
|
|
|
|
|
*
|
2004-03-31 01:03:10 +00:00
|
|
|
|
* 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.
|
|
|
|
|
*
|
2004-03-19 11:35:42 +00:00
|
|
|
|
* Revision 1.125 2004/03/10 14:59:54 vsc
|
|
|
|
|
* optimise -> for type tests
|
|
|
|
|
*
|
2004-03-10 14:59:55 +00:00
|
|
|
|
* Revision 1.124 2004/03/08 19:31:01 vsc
|
|
|
|
|
* move to 4.5.3
|
|
|
|
|
* *
|
2001-04-09 19:54:03 +00:00
|
|
|
|
* *
|
|
|
|
|
*************************************************************************/
|
|
|
|
|
|
2005-11-18 18:52:41 +00:00
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#define IN_ABSMI_C 1
|
2011-03-07 16:02:55 +00:00
|
|
|
|
#define HAS_CACHE_REGS 1
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
#include "absmi.h"
|
|
|
|
|
#include "heapgc.h"
|
|
|
|
|
|
2005-11-18 18:52:41 +00:00
|
|
|
|
#ifdef CUT_C
|
|
|
|
|
#include "cut_c.h"
|
|
|
|
|
#endif
|
|
|
|
|
|
2008-08-12 01:27:23 +00:00
|
|
|
|
#ifdef PUSH_X
|
|
|
|
|
#else
|
|
|
|
|
|
|
|
|
|
/* keep X as a global variable */
|
|
|
|
|
|
|
|
|
|
Term Yap_XREGS[MaxTemps]; /* 29 */
|
|
|
|
|
|
|
|
|
|
#endif
|
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#include "arith2.h"
|
|
|
|
|
|
|
|
|
|
#ifdef COROUTINING
|
|
|
|
|
/*
|
|
|
|
|
Imagine we are interrupting the execution, say, because we have a spy
|
|
|
|
|
point or because we have goals to wake up. This routine saves the current
|
|
|
|
|
live temporary registers into a structure pointed to by register ARG1.
|
|
|
|
|
The registers are then recovered by a nasty builtin
|
|
|
|
|
called
|
|
|
|
|
*/
|
|
|
|
|
static Term
|
|
|
|
|
push_live_regs(yamop *pco)
|
|
|
|
|
{
|
2011-03-07 16:02:55 +00:00
|
|
|
|
CACHE_REGS
|
2001-04-09 19:54:03 +00:00
|
|
|
|
CELL *lab = (CELL *)(pco->u.l.l);
|
|
|
|
|
CELL max = lab[0];
|
2002-02-04 16:12:54 +00:00
|
|
|
|
CELL curr = lab[1];
|
2001-04-09 19:54:03 +00:00
|
|
|
|
CELL *start = H;
|
|
|
|
|
Int tot = 0;
|
|
|
|
|
|
|
|
|
|
if (max) {
|
2002-02-04 16:12:54 +00:00
|
|
|
|
CELL i;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
lab += 2;
|
|
|
|
|
H++;
|
|
|
|
|
for (i=0; i <= max; i++) {
|
|
|
|
|
if (i == 8*CellSize) {
|
|
|
|
|
curr = lab[0];
|
|
|
|
|
lab++;
|
|
|
|
|
}
|
|
|
|
|
if (curr & 1) {
|
|
|
|
|
CELL d1;
|
|
|
|
|
|
|
|
|
|
tot+=2;
|
|
|
|
|
H[0] = MkIntTerm(i);
|
|
|
|
|
d1 = XREGS[i];
|
|
|
|
|
deref_head(d1, wake_up_unk);
|
|
|
|
|
wake_up_nonvar:
|
|
|
|
|
/* just copy it to the heap */
|
|
|
|
|
H[1] = d1;
|
|
|
|
|
H += 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 <= H) {
|
|
|
|
|
/* variable is safe */
|
|
|
|
|
H[1] = (CELL)pt0;
|
|
|
|
|
} else {
|
|
|
|
|
d1 = Unsigned(H+1);
|
|
|
|
|
RESET_VARIABLE(H+1);
|
|
|
|
|
Bind_Local(pt0, d1);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
H += 2;
|
|
|
|
|
}
|
|
|
|
|
curr >>= 1;
|
|
|
|
|
}
|
2002-11-18 18:18:05 +00:00
|
|
|
|
start[0] = (CELL)Yap_MkFunctor(AtomTrue, tot);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
return(AbsAppl(start));
|
|
|
|
|
} else {
|
|
|
|
|
return(TermNil);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
#endif
|
|
|
|
|
|
2005-07-06 15:10:18 +00:00
|
|
|
|
#if defined(ANALYST) || defined(DEBUG)
|
|
|
|
|
|
|
|
|
|
char *Yap_op_names[_std_top + 1] =
|
|
|
|
|
{
|
|
|
|
|
#define OPCODE(OP,TYPE) #OP
|
|
|
|
|
#include "YapOpcodes.h"
|
|
|
|
|
#undef OPCODE
|
|
|
|
|
};
|
|
|
|
|
|
|
|
|
|
#endif
|
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
Int
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_absmi(int inp)
|
2001-04-09 19:54:03 +00:00
|
|
|
|
{
|
2011-03-07 16:02:55 +00:00
|
|
|
|
CACHE_REGS
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#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;
|
|
|
|
|
#endif
|
|
|
|
|
|
|
|
|
|
#ifdef LONG_LIVED_REGISTERS
|
|
|
|
|
register CELL d0, d1;
|
|
|
|
|
register CELL *pt0, *pt1;
|
|
|
|
|
|
|
|
|
|
#endif /* LONG_LIVED_REGISTERS */
|
2004-03-04 21:17:40 +00:00
|
|
|
|
|
2008-03-26 14:37:08 +00:00
|
|
|
|
#ifdef SHADOW_P
|
2001-04-09 19:54:03 +00:00
|
|
|
|
register yamop *PREG = P;
|
|
|
|
|
#endif /* SHADOW_P */
|
|
|
|
|
|
2008-03-26 14:37:08 +00:00
|
|
|
|
#ifdef SHADOW_CP
|
2001-04-09 19:54:03 +00:00
|
|
|
|
register yamop *CPREG = CP;
|
|
|
|
|
#endif /* SHADOW_CP */
|
|
|
|
|
|
2008-03-26 14:37:08 +00:00
|
|
|
|
#ifdef SHADOW_HB
|
2001-04-09 19:54:03 +00:00
|
|
|
|
register CELL *HBREG = HB;
|
|
|
|
|
#endif /* SHADOW_HB */
|
|
|
|
|
|
2008-03-26 14:37:08 +00:00
|
|
|
|
#ifdef SHADOW_Y
|
2002-11-18 18:18:05 +00:00
|
|
|
|
register CELL *YREG = Yap_REGS.YENV_;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif /* SHADOW_Y */
|
|
|
|
|
|
2008-03-26 14:37:08 +00:00
|
|
|
|
#ifdef SHADOW_S
|
2002-11-18 18:18:05 +00:00
|
|
|
|
register CELL *SREG = Yap_REGS.S_;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#else
|
|
|
|
|
#define SREG S
|
|
|
|
|
#endif /* SHADOW_S */
|
|
|
|
|
|
|
|
|
|
/* The indexing register so that we will not destroy ARG1 without
|
|
|
|
|
* reason */
|
|
|
|
|
#define I_R (XREGS[0])
|
|
|
|
|
|
|
|
|
|
#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
|
|
|
|
|
#include "YapOpcodes.h"
|
|
|
|
|
#undef OPCODE
|
|
|
|
|
};
|
|
|
|
|
|
|
|
|
|
#endif /* USE_THREADED_CODE */
|
|
|
|
|
|
2008-03-26 14:37:08 +00:00
|
|
|
|
#ifdef SHADOW_REGS
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
/* work with a local pointer to the registers */
|
2002-11-18 18:18:05 +00:00
|
|
|
|
register REGSTORE *regp = &Yap_REGS;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
#endif /* SHADOW_REGS */
|
|
|
|
|
|
|
|
|
|
#if PUSH_REGS
|
|
|
|
|
|
|
|
|
|
/* useful on a X86 with -fomit-frame-pointer optimisation */
|
|
|
|
|
/* The idea is to push REGS onto the X86 stack frame */
|
|
|
|
|
|
|
|
|
|
/* first allocate local space */
|
|
|
|
|
REGSTORE absmi_regs;
|
2002-11-18 18:18:05 +00:00
|
|
|
|
REGSTORE *old_regs = Yap_regp;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
#endif /* PUSH_REGS */
|
|
|
|
|
|
2006-03-24 17:13:41 +00:00
|
|
|
|
#ifdef BEAM
|
|
|
|
|
CELL OLD_B=B;
|
|
|
|
|
extern PredEntry *bpEntry;
|
|
|
|
|
if (inp==-9000) {
|
|
|
|
|
#if PUSH_REGS
|
|
|
|
|
old_regs = &Yap_REGS;
|
|
|
|
|
init_absmi_regs(&absmi_regs);
|
2011-03-07 16:02:55 +00:00
|
|
|
|
#if THREADS
|
|
|
|
|
regcache = Yap_regp
|
|
|
|
|
#else
|
2006-03-24 17:13:41 +00:00
|
|
|
|
Yap_regp = &absmi_regs;
|
2011-03-07 16:02:55 +00:00
|
|
|
|
#endif
|
2006-03-24 17:13:41 +00:00
|
|
|
|
#endif
|
2006-04-12 17:14:58 +00:00
|
|
|
|
CACHE_A1();
|
2006-03-24 17:13:41 +00:00
|
|
|
|
PREG=bpEntry->CodeOfPred;
|
|
|
|
|
JMPNext(); /* go execute instruction at PREG */
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
#endif
|
|
|
|
|
|
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#if USE_THREADED_CODE
|
|
|
|
|
/* absmadr */
|
|
|
|
|
if (inp > 0) {
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_ABSMI_OPCODES = OpAddress;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#if BP_FREE
|
|
|
|
|
P1REG = PCBACKUP;
|
|
|
|
|
#endif
|
|
|
|
|
return(0);
|
|
|
|
|
}
|
|
|
|
|
#endif /* USE_THREADED_CODE */
|
|
|
|
|
|
|
|
|
|
#if PUSH_REGS
|
2002-11-18 18:18:05 +00:00
|
|
|
|
old_regs = &Yap_REGS;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
/* done, let us now initialise this space */
|
|
|
|
|
init_absmi_regs(&absmi_regs);
|
|
|
|
|
|
|
|
|
|
/* the registers are all set up, let's swap */
|
2004-01-23 02:23:51 +00:00
|
|
|
|
#ifdef THREADS
|
2004-02-06 17:22:24 +00:00
|
|
|
|
pthread_setspecific(Yap_yaamregs_key, (const void *)&absmi_regs);
|
2011-05-09 19:55:06 +01:00
|
|
|
|
LOCAL_ThreadHandle.current_yaam_regs = &absmi_regs;
|
2011-03-07 16:02:55 +00:00
|
|
|
|
regcache = &absmi_regs;
|
2004-01-23 02:23:51 +00:00
|
|
|
|
#else
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_regp = &absmi_regs;
|
2004-01-23 02:23:51 +00:00
|
|
|
|
#endif
|
2002-11-18 18:18:05 +00:00
|
|
|
|
#undef Yap_REGS
|
|
|
|
|
#define Yap_REGS absmi_regs
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
#endif /* PUSH_REGS */
|
|
|
|
|
|
2008-03-26 14:37:08 +00:00
|
|
|
|
#ifdef SHADOW_REGS
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
/* use regp as a copy of REGS */
|
2002-11-18 18:18:05 +00:00
|
|
|
|
regp = &Yap_REGS;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
#ifdef REGS
|
|
|
|
|
#undef REGS
|
|
|
|
|
#endif
|
|
|
|
|
#define REGS (*regp)
|
|
|
|
|
|
|
|
|
|
#endif /* SHADOW_REGS */
|
|
|
|
|
|
|
|
|
|
setregs();
|
|
|
|
|
|
|
|
|
|
CACHE_A1();
|
|
|
|
|
|
2005-12-23 00:20:14 +00:00
|
|
|
|
reset_absmi:
|
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
SP = SP0;
|
|
|
|
|
|
|
|
|
|
#if USE_THREADED_CODE
|
|
|
|
|
JMPNext(); /* go execute instruction at P */
|
|
|
|
|
|
|
|
|
|
#else
|
|
|
|
|
/* when we start we are not in write mode */
|
|
|
|
|
|
|
|
|
|
{
|
|
|
|
|
op_numbers opcode = _Ystop;
|
|
|
|
|
op_numbers old_op;
|
2005-07-06 15:10:18 +00:00
|
|
|
|
#ifdef DEBUG_XX
|
2001-04-09 19:54:03 +00:00
|
|
|
|
unsigned long ops_done;
|
|
|
|
|
#endif
|
|
|
|
|
|
|
|
|
|
goto nextop;
|
|
|
|
|
|
|
|
|
|
nextop_write:
|
|
|
|
|
|
|
|
|
|
old_op = opcode;
|
|
|
|
|
opcode = PREG->u.o.opcw;
|
|
|
|
|
goto op_switch;
|
|
|
|
|
|
|
|
|
|
nextop:
|
|
|
|
|
|
|
|
|
|
old_op = opcode;
|
|
|
|
|
opcode = PREG->opc;
|
|
|
|
|
|
|
|
|
|
op_switch:
|
|
|
|
|
|
|
|
|
|
#ifdef ANALYST
|
2011-05-25 16:40:36 +01:00
|
|
|
|
GLOBAL_opcount[opcode]++;
|
|
|
|
|
GLOBAL_2opcount[old_op][opcode]++;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#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",
|
2005-07-06 15:10:18 +00:00
|
|
|
|
ops_done,Yap_op_names[opcode],Yap_op_names[old_op],B,B->cp_h,H);*/
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif
|
|
|
|
|
#endif /* ANALYST */
|
|
|
|
|
|
|
|
|
|
switch (opcode) {
|
|
|
|
|
#endif /* USE_THREADED_CODE */
|
|
|
|
|
|
|
|
|
|
noheapleft:
|
2007-04-10 22:13:21 +00:00
|
|
|
|
{
|
|
|
|
|
CELL cut_b = LCL0-(CELL *)(SREG[E_CB]);
|
2009-04-18 15:22:51 -05:00
|
|
|
|
#ifdef SHADOW_S
|
|
|
|
|
S = SREG;
|
|
|
|
|
#endif
|
2007-04-10 22:13:21 +00:00
|
|
|
|
saveregs();
|
2008-01-23 17:57:56 +00:00
|
|
|
|
/* do a garbage collection first to check if we can recover memory */
|
2007-04-10 22:13:21 +00:00
|
|
|
|
if (!Yap_growheap(FALSE, 0, NULL)) {
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(OUT_OF_HEAP_ERROR, "YAP failed to grow heap: %s", LOCAL_ErrorMessage);
|
2007-04-10 22:13:21 +00:00
|
|
|
|
setregs();
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
2002-09-03 20:14:13 +00:00
|
|
|
|
setregs();
|
2007-04-10 22:13:21 +00:00
|
|
|
|
CACHE_A1();
|
2009-04-18 15:22:51 -05:00
|
|
|
|
#ifdef SHADOW_S
|
|
|
|
|
SREG = S;
|
|
|
|
|
#endif
|
|
|
|
|
if (SREG == ASP) {
|
|
|
|
|
SREG[E_CB] = (CELL)(LCL0-cut_b);
|
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
goto reset_absmi;
|
|
|
|
|
|
|
|
|
|
#if !OS_HANDLES_TR_OVERFLOW
|
|
|
|
|
notrailleft:
|
|
|
|
|
/* if we are within indexing code, the system may have to
|
|
|
|
|
* update a S */
|
2007-04-10 22:13:21 +00:00
|
|
|
|
{
|
2007-10-17 09:18:27 +00:00
|
|
|
|
CELL cut_b;
|
2007-04-10 22:13:21 +00:00
|
|
|
|
|
2008-03-26 14:37:08 +00:00
|
|
|
|
#ifdef SHADOW_S
|
2007-04-10 22:13:21 +00:00
|
|
|
|
S = SREG;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif
|
2007-10-17 09:18:27 +00:00
|
|
|
|
/* YREG was pointing to where we were going to build the
|
2007-04-10 22:13:21 +00:00
|
|
|
|
* next choice-point. The stack shifter will need to know this
|
|
|
|
|
* to move the local stack */
|
2011-02-14 11:29:20 -08:00
|
|
|
|
SET_ASP(YREG, E_CB*sizeof(CELL));
|
2007-10-17 09:18:27 +00:00
|
|
|
|
cut_b = LCL0-(CELL *)(ASP[E_CB]);
|
2007-04-10 22:13:21 +00:00
|
|
|
|
saveregs();
|
|
|
|
|
if(!Yap_growtrail (0, FALSE)) {
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(OUT_OF_TRAIL_ERROR,"YAP failed to reserve %ld bytes in growtrail",sizeof(CELL) * K16);
|
2007-04-10 22:13:21 +00:00
|
|
|
|
setregs();
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
2002-09-03 20:14:13 +00:00
|
|
|
|
setregs();
|
2009-04-18 15:22:51 -05:00
|
|
|
|
#ifdef SHADOW_S
|
|
|
|
|
SREG = S;
|
|
|
|
|
#endif
|
|
|
|
|
if (SREG == ASP) {
|
|
|
|
|
SREG[E_CB] = (CELL)(LCL0-cut_b);
|
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
goto reset_absmi;
|
|
|
|
|
|
|
|
|
|
#endif /* OS_HANDLES_TR_OVERFLOW */
|
|
|
|
|
|
2005-12-17 03:25:39 +00:00
|
|
|
|
BOp(Ystop, l);
|
2011-02-14 11:29:20 -08:00
|
|
|
|
SET_ASP(YREG, E_CB*sizeof(CELL));
|
2012-10-08 18:25:42 +01:00
|
|
|
|
/* make sure ASP is initialised */
|
2001-04-09 19:54:03 +00:00
|
|
|
|
saveregs();
|
2012-10-08 18:25:42 +01:00
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#if PUSH_REGS
|
|
|
|
|
restore_absmi_regs(old_regs);
|
|
|
|
|
#endif
|
|
|
|
|
#if BP_FREE
|
|
|
|
|
P1REG = PCBACKUP;
|
|
|
|
|
#endif
|
2004-09-27 20:45:04 +00:00
|
|
|
|
return 1;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
BOp(Nstop, e);
|
2011-02-14 11:29:20 -08:00
|
|
|
|
SET_ASP(YREG, E_CB*sizeof(CELL));
|
2001-04-09 19:54:03 +00:00
|
|
|
|
saveregs();
|
|
|
|
|
#if PUSH_REGS
|
|
|
|
|
restore_absmi_regs(old_regs);
|
|
|
|
|
#endif
|
|
|
|
|
#if BP_FREE
|
|
|
|
|
P1REG = PCBACKUP;
|
|
|
|
|
#endif
|
2008-06-17 13:37:51 +00:00
|
|
|
|
return 0;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
/*****************************************************************
|
|
|
|
|
* Plain try - retry - trust instructions *
|
|
|
|
|
*****************************************************************/
|
|
|
|
|
/* try_me Label,NArgs */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
Op(try_me, Otapl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* check if enough space between trail and codespace */
|
2003-08-23 19:26:08 +00:00
|
|
|
|
check_trail(TR);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
/* I use YREG =to go through the choicepoint. Usually YREG =is in a
|
2001-04-09 19:54:03 +00:00
|
|
|
|
* register, but sometimes (X86) not. In this case, have a
|
2002-11-11 17:38:10 +00:00
|
|
|
|
* new register to point at YREG =*/
|
|
|
|
|
CACHE_Y(YREG);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* store arguments for procedure */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
store_at_least_one_arg(PREG->u.Otapl.s);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* store abstract machine registers */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
store_yaam_regs(PREG->u.Otapl.d, 0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* On a try_me, set cut to point at previous choicepoint,
|
|
|
|
|
* that is, to the B before the cut.
|
|
|
|
|
*/
|
2002-11-11 17:38:10 +00:00
|
|
|
|
set_cut(S_YREG, B);
|
|
|
|
|
/* now, install the new YREG =*/
|
|
|
|
|
B = B_YREG;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifdef YAPOR
|
2002-11-11 17:38:10 +00:00
|
|
|
|
SCH_set_load(B_YREG);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif /* YAPOR */
|
2011-10-02 16:18:09 -03:00
|
|
|
|
PREG = NEXTOP(PREG, Otapl);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
SET_BB(B_YREG);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDCACHE_Y();
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
/* retry_me Label,NArgs */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
Op(retry_me, Otapl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
CACHE_Y(B);
|
|
|
|
|
/* After retry, cut should be pointing at the parent
|
|
|
|
|
* choicepoint for the current B */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
restore_yaam_regs(PREG->u.Otapl.d);
|
|
|
|
|
restore_at_least_one_arg(PREG->u.Otapl.s);
|
2003-11-07 17:50:01 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
2005-03-04 20:30:14 +00:00
|
|
|
|
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
set_cut(S_YREG, B->cp_b);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#else
|
2002-11-11 17:38:10 +00:00
|
|
|
|
set_cut(S_YREG, B_YREG->cp_b);
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#endif /* FROZEN_STACKS */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
SET_BB(B_YREG);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDCACHE_Y();
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = NEXTOP(PREG, Otapl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
/* trust_me UnusedLabel,NArgs */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
Op(trust_me, Otapl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
CACHE_Y(B);
|
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
if (SCH_top_shared_cp(B)) {
|
2002-11-11 17:38:10 +00:00
|
|
|
|
SCH_last_alternative(PREG, B_YREG);
|
2008-09-05 05:22:19 +01:00
|
|
|
|
restore_at_least_one_arg(PREG->u.Otapl.s);
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
2005-03-04 20:30:14 +00:00
|
|
|
|
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#endif /* FROZEN_STACKS */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
set_cut(S_YREG, B->cp_b);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
else
|
|
|
|
|
#endif /* YAPOR */
|
|
|
|
|
{
|
|
|
|
|
pop_yaam_regs();
|
2008-09-05 05:22:19 +01:00
|
|
|
|
pop_at_least_one_arg(PREG->u.Otapl.s);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* After trust, cut should be pointing at the new top
|
|
|
|
|
* choicepoint */
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
2005-03-04 20:30:14 +00:00
|
|
|
|
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#endif /* FROZEN_STACKS */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
set_cut(S_YREG, B);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = NEXTOP(PREG, Otapl);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
SET_BB(B_YREG);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDCACHE_Y();
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2013-01-07 09:47:14 +00:00
|
|
|
|
/*****************************************************************
|
|
|
|
|
* EXO try - retry instructions *
|
|
|
|
|
*****************************************************************/
|
2013-01-22 15:37:50 +00:00
|
|
|
|
/* enter_exo Pred,Label */
|
2013-01-07 09:47:14 +00:00
|
|
|
|
BOp(enter_exo, e);
|
|
|
|
|
{
|
|
|
|
|
yamop *pt;
|
|
|
|
|
saveregs();
|
2013-01-10 23:22:11 +00:00
|
|
|
|
pt = Yap_ExoLookup(PredFromDefCode(PREG) PASS_REGS);
|
2013-01-07 09:47:14 +00:00
|
|
|
|
setregs();
|
2013-01-08 00:40:51 +00:00
|
|
|
|
#ifdef SHADOW_S
|
|
|
|
|
SREG = S;
|
|
|
|
|
#endif
|
2013-01-07 09:47:14 +00:00
|
|
|
|
PREG = pt;
|
|
|
|
|
}
|
|
|
|
|
JMPNext();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
/* check if enough space between trail and codespace */
|
|
|
|
|
/* try_exo Pred,Label */
|
|
|
|
|
Op(try_exo, lp);
|
|
|
|
|
/* check if enough space between trail and codespace */
|
|
|
|
|
check_trail(TR);
|
|
|
|
|
/* I use YREG =to go through the choicepoint. Usually YREG =is in a
|
|
|
|
|
* register, but sometimes (X86) not. In this case, have a
|
|
|
|
|
* new register to point at YREG =*/
|
|
|
|
|
CACHE_Y(YREG);
|
2013-01-08 00:40:51 +00:00
|
|
|
|
{
|
|
|
|
|
struct index_t *i = (struct index_t *)(PREG->u.lp.l);
|
2013-06-22 20:09:20 -05:00
|
|
|
|
S_YREG[-1] = (CELL)LINK_TO_ADDRESS(i,i->links[EXO_ADDRESS_TO_OFFSET(i, SREG)]);
|
2013-01-08 00:40:51 +00:00
|
|
|
|
}
|
2013-01-07 09:47:14 +00:00
|
|
|
|
S_YREG--;
|
|
|
|
|
/* store arguments for procedure */
|
|
|
|
|
store_at_least_one_arg(PREG->u.lp.p->ArityOfPE);
|
|
|
|
|
/* store abstract machine registers */
|
|
|
|
|
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.
|
|
|
|
|
*/
|
|
|
|
|
set_cut(S_YREG, B);
|
|
|
|
|
/* now, install the new YREG =*/
|
|
|
|
|
B = B_YREG;
|
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
SCH_set_load(B_YREG);
|
|
|
|
|
#endif /* YAPOR */
|
2013-01-08 00:40:51 +00:00
|
|
|
|
PREG = NEXTOP(NEXTOP(PREG, lp),lp);
|
2013-01-07 09:47:14 +00:00
|
|
|
|
SET_BB(B_YREG);
|
|
|
|
|
ENDCACHE_Y();
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2013-04-16 20:04:53 -05:00
|
|
|
|
/* check if enough space between trail and codespace */
|
2013-07-07 16:14:08 -05:00
|
|
|
|
/* try_exo_udi Pred,Label */
|
2013-04-16 20:04:53 -05:00
|
|
|
|
Op(try_exo_udi, lp);
|
|
|
|
|
/* check if enough space between trail and codespace */
|
|
|
|
|
check_trail(TR);
|
|
|
|
|
/* I use YREG =to go through the choicepoint. Usually YREG =is in a
|
|
|
|
|
* register, but sometimes (X86) not. In this case, have a
|
|
|
|
|
* new register to point at YREG =*/
|
|
|
|
|
CACHE_Y(YREG);
|
|
|
|
|
S_YREG--;
|
|
|
|
|
/* store arguments for procedure */
|
|
|
|
|
store_at_least_one_arg(PREG->u.lp.p->ArityOfPE);
|
|
|
|
|
/* store abstract machine registers */
|
|
|
|
|
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.
|
|
|
|
|
*/
|
|
|
|
|
set_cut(S_YREG, B);
|
|
|
|
|
/* now, install the new YREG =*/
|
|
|
|
|
B = B_YREG;
|
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
SCH_set_load(B_YREG);
|
|
|
|
|
#endif /* YAPOR */
|
|
|
|
|
PREG = NEXTOP(NEXTOP(PREG, lp),lp);
|
|
|
|
|
SET_BB(B_YREG);
|
|
|
|
|
ENDCACHE_Y();
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2013-01-22 15:37:50 +00:00
|
|
|
|
/* try_udi Pred,Label */
|
|
|
|
|
Op(try_udi, p);
|
|
|
|
|
/* check if enough space between trail and codespace */
|
|
|
|
|
check_trail(TR);
|
|
|
|
|
/* I use YREG =to go through the choicepoint. Usually YREG =is in a
|
|
|
|
|
* 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--;
|
|
|
|
|
/* store arguments for procedure */
|
|
|
|
|
store_at_least_one_arg(PREG->u.lp.p->ArityOfPE);
|
|
|
|
|
/* store abstract machine registers */
|
|
|
|
|
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.
|
|
|
|
|
*/
|
|
|
|
|
set_cut(S_YREG, B);
|
|
|
|
|
/* now, install the new YREG =*/
|
|
|
|
|
B = B_YREG;
|
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
SCH_set_load(B_YREG);
|
|
|
|
|
#endif /* YAPOR */
|
|
|
|
|
PREG = NEXTOP(NEXTOP(PREG, lp),lp);
|
|
|
|
|
SET_BB(B_YREG);
|
|
|
|
|
ENDCACHE_Y();
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2013-01-08 12:35:18 +00:00
|
|
|
|
/* check if enough space between trail and codespace */
|
|
|
|
|
/* try_exo Pred,Label */
|
|
|
|
|
Op(try_all_exo, lp);
|
|
|
|
|
/* check if enough space between trail and codespace */
|
|
|
|
|
check_trail(TR);
|
|
|
|
|
/* I use YREG =to go through the choicepoint. Usually YREG =is in a
|
|
|
|
|
* register, but sometimes (X86) not. In this case, have a
|
|
|
|
|
* new register to point at YREG =*/
|
|
|
|
|
CACHE_Y(YREG);
|
|
|
|
|
{
|
|
|
|
|
struct index_t *i = (struct index_t *)(PREG->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;
|
|
|
|
|
/* store arguments for procedure */
|
|
|
|
|
store_at_least_one_arg(PREG->u.lp.p->ArityOfPE);
|
|
|
|
|
/* store abstract machine registers */
|
|
|
|
|
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.
|
|
|
|
|
*/
|
|
|
|
|
set_cut(S_YREG, B);
|
|
|
|
|
/* now, install the new YREG =*/
|
|
|
|
|
B = B_YREG;
|
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
SCH_set_load(B_YREG);
|
|
|
|
|
#endif /* YAPOR */
|
|
|
|
|
PREG = NEXTOP(NEXTOP(PREG, lp),lp);
|
|
|
|
|
SET_BB(B_YREG);
|
|
|
|
|
ENDCACHE_Y();
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2013-01-07 09:47:14 +00:00
|
|
|
|
/* retry_exo Pred */
|
|
|
|
|
Op(retry_exo, lp);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
CACHE_Y(B);
|
2013-01-10 23:22:11 +00:00
|
|
|
|
{
|
|
|
|
|
struct index_t *it = (struct index_t *)(PREG->u.lp.l);
|
2013-06-22 20:09:20 -05:00
|
|
|
|
BITS32 offset = ADDRESS_TO_LINK(it,(BITS32 *)((CELL *)(B+1))[it->arity]);
|
2013-01-10 23:22:11 +00:00
|
|
|
|
d0 = it->links[offset];
|
2013-06-22 20:09:20 -05:00
|
|
|
|
((CELL *)(B+1))[it->arity] = (CELL)LINK_TO_ADDRESS(it, d0);
|
|
|
|
|
SREG = EXO_OFFSET_TO_ADDRESS(it, offset);
|
2013-01-10 23:22:11 +00:00
|
|
|
|
}
|
2013-01-07 09:47:14 +00:00
|
|
|
|
if (d0) {
|
|
|
|
|
/* After retry, cut should be pointing at the parent
|
|
|
|
|
* choicepoint for the current B */
|
2013-04-16 20:04:53 -05:00
|
|
|
|
restore_yaam_regs(PREG);
|
|
|
|
|
restore_at_least_one_arg(PREG->u.lp.p->ArityOfPE);
|
|
|
|
|
#ifdef FROZEN_STACKS
|
|
|
|
|
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
|
|
|
|
set_cut(S_YREG, B->cp_b);
|
|
|
|
|
#else
|
|
|
|
|
set_cut(S_YREG, B_YREG->cp_b);
|
|
|
|
|
#endif /* FROZEN_STACKS */
|
|
|
|
|
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->u.lp.p->ArityOfPE);
|
|
|
|
|
#ifdef FROZEN_STACKS
|
|
|
|
|
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->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);
|
|
|
|
|
#endif /* FROZEN_STACKS */
|
|
|
|
|
set_cut(S_YREG, B);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
PREG = NEXTOP(PREG, lp);
|
|
|
|
|
ENDCACHE_Y();
|
|
|
|
|
ENDD(D0);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
/* retry_exo_udi Pred */
|
|
|
|
|
Op(retry_exo_udi, lp);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
CACHE_Y(B);
|
|
|
|
|
{
|
|
|
|
|
struct index_t *it = (struct index_t *)(PREG->u.lp.l);
|
|
|
|
|
saveregs();
|
2013-04-16 21:49:37 -05:00
|
|
|
|
d0 = ((CRetryExoIndex)it->udi_next)(it PASS_REGS);
|
2013-04-16 20:04:53 -05:00
|
|
|
|
setregs();
|
|
|
|
|
#ifdef SHADOW_S
|
|
|
|
|
SREG = S;
|
|
|
|
|
#endif
|
|
|
|
|
}
|
|
|
|
|
if (d0) {
|
|
|
|
|
/* After retry, cut should be pointing at the parent
|
|
|
|
|
* choicepoint for the current B */
|
2013-01-07 09:47:14 +00:00
|
|
|
|
restore_yaam_regs(PREG);
|
|
|
|
|
restore_at_least_one_arg(PREG->u.lp.p->ArityOfPE);
|
|
|
|
|
#ifdef FROZEN_STACKS
|
|
|
|
|
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
|
|
|
|
set_cut(S_YREG, B->cp_b);
|
|
|
|
|
#else
|
|
|
|
|
set_cut(S_YREG, B_YREG->cp_b);
|
|
|
|
|
#endif /* FROZEN_STACKS */
|
|
|
|
|
SET_BB(B_YREG);
|
|
|
|
|
} else {
|
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
if (SCH_top_shared_cp(B)) {
|
|
|
|
|
SCH_last_alternative(PREG, B_YREG);
|
2013-01-08 00:40:51 +00:00
|
|
|
|
restore_at_least_one_arg(PREG->u.lp.p->ArityOfPE);
|
2013-01-07 09:47:14 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
|
|
|
|
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
|
|
|
|
#endif /* FROZEN_STACKS */
|
|
|
|
|
set_cut(S_YREG, B->cp_b);
|
|
|
|
|
} else
|
|
|
|
|
#endif /* YAPOR */
|
|
|
|
|
{
|
|
|
|
|
pop_yaam_regs();
|
2013-01-08 00:40:51 +00:00
|
|
|
|
pop_at_least_one_arg(PREG->u.lp.p->ArityOfPE);
|
2013-01-07 09:47:14 +00:00
|
|
|
|
/* 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, lp);
|
|
|
|
|
ENDCACHE_Y();
|
|
|
|
|
ENDD(D0);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2013-01-22 15:37:50 +00:00
|
|
|
|
/* retry_exo Pred */
|
|
|
|
|
Op(retry_udi, p);
|
|
|
|
|
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();
|
|
|
|
|
#ifdef SHADOW_S
|
|
|
|
|
SREG = S;
|
|
|
|
|
#endif
|
|
|
|
|
/* 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->u.lp.p->ArityOfPE);
|
|
|
|
|
#ifdef FROZEN_STACKS
|
|
|
|
|
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
|
|
|
|
set_cut(S_YREG, B->cp_b);
|
|
|
|
|
#else
|
|
|
|
|
set_cut(S_YREG, B_YREG->cp_b);
|
|
|
|
|
#endif /* FROZEN_STACKS */
|
|
|
|
|
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->u.lp.p->ArityOfPE);
|
|
|
|
|
#ifdef FROZEN_STACKS
|
|
|
|
|
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->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);
|
|
|
|
|
#endif /* FROZEN_STACKS */
|
|
|
|
|
set_cut(S_YREG, B);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
PREG = (yamop *)SREG;
|
|
|
|
|
ENDCACHE_Y();
|
|
|
|
|
ENDD(D0);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2013-01-08 12:35:18 +00:00
|
|
|
|
/* retry_exo Pred */
|
|
|
|
|
Op(retry_all_exo, lp);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
CACHE_Y(B);
|
|
|
|
|
{
|
|
|
|
|
UInt arity = ((struct index_t *)PREG->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);
|
|
|
|
|
#else
|
|
|
|
|
set_cut(S_YREG, B_YREG->cp_b);
|
|
|
|
|
#endif /* FROZEN_STACKS */
|
|
|
|
|
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);
|
|
|
|
|
#ifdef FROZEN_STACKS
|
|
|
|
|
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 */
|
|
|
|
|
#ifdef FROZEN_STACKS
|
|
|
|
|
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
|
|
|
|
#endif /* FROZEN_STACKS */
|
|
|
|
|
set_cut(S_YREG, B);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
PREG = NEXTOP(PREG, lp);
|
|
|
|
|
ENDCACHE_Y();
|
|
|
|
|
ENDD(D0);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/*****************************************************************
|
|
|
|
|
* Profiled try - retry - trust instructions *
|
|
|
|
|
*****************************************************************/
|
|
|
|
|
|
2009-06-22 12:40:55 -05:00
|
|
|
|
/* profiled_enter_me Pred */
|
|
|
|
|
Op(enter_profiling, p);
|
|
|
|
|
LOCK(PREG->u.p.p->StatisticsForPred.lock);
|
|
|
|
|
PREG->u.p.p->StatisticsForPred.NOfEntries++;
|
|
|
|
|
UNLOCK(PREG->u.p.p->StatisticsForPred.lock);
|
|
|
|
|
PREG = NEXTOP(PREG, p);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
/* profiled_retry Label,NArgs */
|
2003-10-28 16:20:44 +00:00
|
|
|
|
Op(retry_profiled, p);
|
2003-01-29 14:47:17 +00:00
|
|
|
|
LOCK(PREG->u.p.p->StatisticsForPred.lock);
|
|
|
|
|
PREG->u.p.p->StatisticsForPred.NOfRetries++;
|
|
|
|
|
UNLOCK(PREG->u.p.p->StatisticsForPred.lock);
|
|
|
|
|
PREG = NEXTOP(PREG, p);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
/* profiled_retry_me Label,NArgs */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
Op(profiled_retry_me, Otapl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
CACHE_Y(B);
|
|
|
|
|
/* After retry, cut should be pointing at the parent
|
|
|
|
|
* choicepoint for the current B */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
LOCK(PREG->u.Otapl.p->StatisticsForPred.lock);
|
|
|
|
|
PREG->u.Otapl.p->StatisticsForPred.NOfRetries++;
|
|
|
|
|
UNLOCK(PREG->u.Otapl.p->StatisticsForPred.lock);
|
|
|
|
|
restore_yaam_regs(PREG->u.Otapl.d);
|
|
|
|
|
restore_args(PREG->u.Otapl.s);
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
2005-03-04 20:30:14 +00:00
|
|
|
|
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
set_cut(S_YREG, B->cp_b);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#else
|
2002-11-11 17:38:10 +00:00
|
|
|
|
set_cut(S_YREG, B_YREG->cp_b);
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#endif /* FROZEN_STACKS */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
SET_BB(B_YREG);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDCACHE_Y();
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = NEXTOP(PREG, Otapl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
/* profiled_trust_me UnusedLabel,NArgs */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
Op(profiled_trust_me, Otapl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
CACHE_Y(B);
|
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
if (SCH_top_shared_cp(B)) {
|
2002-11-11 17:38:10 +00:00
|
|
|
|
SCH_last_alternative(PREG, B_YREG);
|
2008-09-05 05:22:19 +01:00
|
|
|
|
restore_args(PREG->u.Otapl.s);
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
2005-03-04 20:30:14 +00:00
|
|
|
|
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#endif /* FROZEN_STACKS */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
set_cut(S_YREG, B->cp_b);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
else
|
|
|
|
|
#endif /* YAPOR */
|
|
|
|
|
{
|
|
|
|
|
pop_yaam_regs();
|
2008-09-05 05:22:19 +01:00
|
|
|
|
pop_args(PREG->u.Otapl.s);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* After trust, cut should be pointing at the new top
|
|
|
|
|
* choicepoint */
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
2005-03-04 20:30:14 +00:00
|
|
|
|
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#endif /* FROZEN_STACKS */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
set_cut(S_YREG, B);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
2002-11-11 17:38:10 +00:00
|
|
|
|
SET_BB(B_YREG);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDCACHE_Y();
|
2008-09-05 05:22:19 +01:00
|
|
|
|
LOCK(PREG->u.Otapl.p->StatisticsForPred.lock);
|
|
|
|
|
PREG->u.Otapl.p->StatisticsForPred.NOfRetries++;
|
|
|
|
|
UNLOCK(PREG->u.Otapl.p->StatisticsForPred.lock);
|
|
|
|
|
PREG = NEXTOP(PREG, Otapl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-09-05 05:22:19 +01:00
|
|
|
|
BOp(profiled_retry_logical, OtaLl);
|
2006-10-10 14:08:17 +00:00
|
|
|
|
check_trail(TR);
|
|
|
|
|
{
|
|
|
|
|
UInt timestamp;
|
|
|
|
|
CACHE_Y(B);
|
|
|
|
|
|
2008-09-05 05:22:19 +01:00
|
|
|
|
timestamp = IntegerOfTerm(((CELL *)(B_YREG+1))[PREG->u.OtaLl.s]);
|
|
|
|
|
if (!VALID_TIMESTAMP(timestamp, PREG->u.OtaLl.d)) {
|
2006-10-10 14:08:17 +00:00
|
|
|
|
/* jump to next instruction */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG=PREG->u.OtaLl.n;
|
2006-10-10 14:08:17 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
2008-09-05 05:22:19 +01:00
|
|
|
|
restore_yaam_regs(PREG->u.OtaLl.n);
|
|
|
|
|
restore_args(PREG->u.OtaLl.s);
|
|
|
|
|
LOCK(PREG->u.OtaLl.d->ClPred->StatisticsForPred.lock);
|
|
|
|
|
PREG->u.OtaLl.d->ClPred->StatisticsForPred.NOfRetries++;
|
|
|
|
|
UNLOCK(PREG->u.OtaLl.d->ClPred->StatisticsForPred.lock);
|
2010-01-26 11:40:32 +00:00
|
|
|
|
#ifdef THREADS
|
|
|
|
|
PP = PREG->u.OtaLl.d->ClPred;
|
|
|
|
|
#endif
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = PREG->u.OtaLl.d->ClCode;
|
2006-10-10 14:08:17 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
|
|
|
|
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
|
|
|
|
set_cut(S_YREG, B->cp_b);
|
|
|
|
|
#else
|
|
|
|
|
set_cut(S_YREG, B_YREG->cp_b);
|
|
|
|
|
#endif /* FROZEN_STACKS */
|
|
|
|
|
SET_BB(B_YREG);
|
|
|
|
|
ENDCACHE_Y();
|
|
|
|
|
}
|
|
|
|
|
JMPNext();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2008-09-05 05:22:19 +01:00
|
|
|
|
BOp(profiled_trust_logical, OtILl);
|
2006-10-10 14:08:17 +00:00
|
|
|
|
CACHE_Y(B);
|
|
|
|
|
{
|
2008-09-05 05:22:19 +01:00
|
|
|
|
LogUpdIndex *cl = PREG->u.OtILl.block;
|
2006-10-10 14:08:17 +00:00
|
|
|
|
PredEntry *ap = cl->ClPred;
|
2008-09-05 05:22:19 +01:00
|
|
|
|
LogUpdClause *lcl = PREG->u.OtILl.d;
|
2006-10-10 14:08:17 +00:00
|
|
|
|
UInt timestamp = IntegerOfTerm(((CELL *)(B_YREG+1))[ap->ArityOfPE]);
|
|
|
|
|
|
2006-11-27 17:42:03 +00:00
|
|
|
|
if (!VALID_TIMESTAMP(timestamp, lcl)) {
|
2006-10-10 14:08:17 +00:00
|
|
|
|
/* jump to next alternative */
|
|
|
|
|
PREG = FAILCODE;
|
|
|
|
|
} else {
|
2006-11-27 17:42:03 +00:00
|
|
|
|
LOCK(ap->StatisticsForPred.lock);
|
|
|
|
|
ap->StatisticsForPred.NOfRetries++;
|
|
|
|
|
UNLOCK(ap->StatisticsForPred.lock);
|
|
|
|
|
PREG = lcl->ClCode;
|
2006-10-10 14:08:17 +00:00
|
|
|
|
}
|
|
|
|
|
/* HEY, leave indexing block alone!! */
|
|
|
|
|
/* check if we are the ones using this code */
|
2011-04-14 18:51:11 +01:00
|
|
|
|
#if MULTIPLE_STACKS
|
2010-07-25 11:22:16 +01:00
|
|
|
|
PELOCK(1, ap);
|
2007-11-26 23:43:10 +00:00
|
|
|
|
PP = ap;
|
2006-10-10 14:08:17 +00:00
|
|
|
|
DEC_CLREF_COUNT(cl);
|
|
|
|
|
/* clear the entry from the trail */
|
2006-11-27 17:42:03 +00:00
|
|
|
|
B->cp_tr--;
|
|
|
|
|
TR = B->cp_tr;
|
2006-10-10 14:08:17 +00:00
|
|
|
|
/* actually get rid of the code */
|
|
|
|
|
if (cl->ClRefCount == 0 && (cl->ClFlags & (ErasedMask|DirtyMask))) {
|
|
|
|
|
if (PREG != FAILCODE) {
|
|
|
|
|
/* I am the last one using this clause, hence I don't need a lock
|
|
|
|
|
to dispose of it
|
|
|
|
|
*/
|
|
|
|
|
if (lcl->ClRefCount == 1) {
|
|
|
|
|
/* make sure the clause isn't destroyed */
|
|
|
|
|
/* always add an extra reference */
|
|
|
|
|
INC_CLREF_COUNT(lcl);
|
|
|
|
|
TRAIL_CLREF(lcl);
|
|
|
|
|
}
|
|
|
|
|
}
|
2006-11-27 17:42:03 +00:00
|
|
|
|
if (cl->ClFlags & ErasedMask) {
|
|
|
|
|
saveregs();
|
2006-10-10 14:08:17 +00:00
|
|
|
|
Yap_ErLogUpdIndex(cl);
|
2006-11-27 17:42:03 +00:00
|
|
|
|
setregs();
|
|
|
|
|
} else {
|
|
|
|
|
saveregs();
|
2006-10-10 14:08:17 +00:00
|
|
|
|
Yap_CleanUpIndex(cl);
|
2006-11-27 17:42:03 +00:00
|
|
|
|
setregs();
|
|
|
|
|
}
|
2006-10-10 14:08:17 +00:00
|
|
|
|
save_pc();
|
|
|
|
|
}
|
|
|
|
|
#else
|
|
|
|
|
if (TrailTerm(B->cp_tr-1) == CLREF_TO_TRENTRY(cl) &&
|
|
|
|
|
B->cp_tr != B->cp_b->cp_tr) {
|
|
|
|
|
cl->ClFlags &= ~InUseMask;
|
2011-04-22 12:20:52 +01:00
|
|
|
|
--B->cp_tr;
|
|
|
|
|
#if FROZEN_STACKS
|
|
|
|
|
if (B->cp_tr > TR_FZ)
|
|
|
|
|
#endif
|
|
|
|
|
{
|
|
|
|
|
TR = B->cp_tr;
|
|
|
|
|
}
|
2006-10-10 14:08:17 +00:00
|
|
|
|
/* next, recover space for the indexing code if it was erased */
|
|
|
|
|
if (cl->ClFlags & (ErasedMask|DirtyMask)) {
|
|
|
|
|
if (PREG != FAILCODE) {
|
2012-07-18 14:32:53 -05:00
|
|
|
|
/* make sure we don't erase the clause we are jumping to,
|
|
|
|
|
notice that we can erase a number of refs in one go. */
|
|
|
|
|
if (!(lcl->ClFlags & InUseMask)) {
|
2006-10-10 14:08:17 +00:00
|
|
|
|
lcl->ClFlags |= InUseMask;
|
|
|
|
|
TRAIL_CLREF(lcl);
|
|
|
|
|
}
|
|
|
|
|
}
|
2006-11-27 17:42:03 +00:00
|
|
|
|
if (cl->ClFlags & ErasedMask) {
|
|
|
|
|
saveregs();
|
2006-10-10 14:08:17 +00:00
|
|
|
|
Yap_ErLogUpdIndex(cl);
|
2006-11-27 17:42:03 +00:00
|
|
|
|
setregs();
|
|
|
|
|
} else {
|
|
|
|
|
saveregs();
|
2006-10-10 14:08:17 +00:00
|
|
|
|
Yap_CleanUpIndex(cl);
|
2006-11-27 17:42:03 +00:00
|
|
|
|
setregs();
|
|
|
|
|
}
|
2006-10-10 14:08:17 +00:00
|
|
|
|
save_pc();
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
#endif
|
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
if (SCH_top_shared_cp(B)) {
|
|
|
|
|
SCH_last_alternative(PREG, B_YREG);
|
2008-06-17 13:37:51 +00:00
|
|
|
|
restore_args(ap->ArityOfPE);
|
2006-10-10 14:08:17 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
|
|
|
|
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
|
|
|
|
#else
|
|
|
|
|
S_YREG++;
|
|
|
|
|
#endif /* FROZEN_STACKS */
|
|
|
|
|
set_cut(S_YREG, B->cp_b);
|
|
|
|
|
} else
|
|
|
|
|
#endif /* YAPOR */
|
|
|
|
|
{
|
|
|
|
|
pop_yaam_regs();
|
2008-06-17 13:37:51 +00:00
|
|
|
|
pop_args(ap->ArityOfPE);
|
2006-10-10 14:08:17 +00:00
|
|
|
|
S_YREG--;
|
|
|
|
|
#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();
|
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2002-09-03 14:28:09 +00:00
|
|
|
|
/*****************************************************************
|
|
|
|
|
* Call count instructions *
|
|
|
|
|
*****************************************************************/
|
|
|
|
|
|
2009-06-22 12:40:55 -05:00
|
|
|
|
/* count_enter_me Label,NArgs */
|
|
|
|
|
Op(count_call, p);
|
|
|
|
|
LOCK(PREG->u.p.p->StatisticsForPred.lock);
|
|
|
|
|
PREG->u.p.p->StatisticsForPred.NOfEntries++;
|
|
|
|
|
UNLOCK(PREG->u.p.p->StatisticsForPred.lock);
|
2011-05-04 10:11:41 +01:00
|
|
|
|
LOCAL_ReductionsCounter--;
|
|
|
|
|
if (LOCAL_ReductionsCounter == 0 && LOCAL_ReductionsCounterOn) {
|
2009-06-22 12:40:55 -05:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(CALL_COUNTER_UNDERFLOW,"");
|
2009-06-22 12:40:55 -05:00
|
|
|
|
setregs();
|
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
2011-05-04 10:11:41 +01:00
|
|
|
|
LOCAL_PredEntriesCounter--;
|
|
|
|
|
if (LOCAL_PredEntriesCounter == 0 && LOCAL_PredEntriesCounterOn) {
|
2009-06-22 12:40:55 -05:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW,"");
|
2009-06-22 12:40:55 -05:00
|
|
|
|
setregs();
|
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
|
|
|
|
PREG = NEXTOP(PREG, p);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2002-09-03 14:28:09 +00:00
|
|
|
|
/* count_retry Label,NArgs */
|
2003-01-29 14:47:17 +00:00
|
|
|
|
Op(count_retry, p);
|
|
|
|
|
LOCK(PREG->u.p.p->StatisticsForPred.lock);
|
|
|
|
|
PREG->u.p.p->StatisticsForPred.NOfRetries++;
|
|
|
|
|
UNLOCK(PREG->u.p.p->StatisticsForPred.lock);
|
2011-05-04 10:11:41 +01:00
|
|
|
|
LOCAL_RetriesCounter--;
|
|
|
|
|
if (LOCAL_RetriesCounter == 0 && LOCAL_RetriesCounterOn) {
|
2009-06-26 13:16:42 -05:00
|
|
|
|
/* act as if we had backtracked */
|
|
|
|
|
ENV = B->cp_env;
|
2002-09-03 20:14:13 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(RETRY_COUNTER_UNDERFLOW,"");
|
2002-09-03 20:14:13 +00:00
|
|
|
|
setregs();
|
2009-06-26 13:16:42 -05:00
|
|
|
|
JMPNext();
|
2002-09-03 14:28:09 +00:00
|
|
|
|
}
|
2011-05-04 10:11:41 +01:00
|
|
|
|
LOCAL_PredEntriesCounter--;
|
|
|
|
|
if (LOCAL_PredEntriesCounter == 0 && LOCAL_PredEntriesCounterOn) {
|
2009-06-26 13:16:42 -05:00
|
|
|
|
ENV = B->cp_env;
|
2002-09-03 20:14:13 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW,"");
|
2002-09-03 20:14:13 +00:00
|
|
|
|
setregs();
|
2002-09-03 14:28:09 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
2003-01-29 14:47:17 +00:00
|
|
|
|
PREG = NEXTOP(PREG, p);
|
2002-09-03 14:28:09 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
/* count_retry_me Label,NArgs */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
Op(count_retry_me, Otapl);
|
2002-09-03 14:28:09 +00:00
|
|
|
|
CACHE_Y(B);
|
2009-06-26 13:16:42 -05:00
|
|
|
|
restore_yaam_regs(PREG->u.Otapl.d);
|
|
|
|
|
restore_args(PREG->u.Otapl.s);
|
2002-09-03 14:28:09 +00:00
|
|
|
|
/* After retry, cut should be pointing at the parent
|
|
|
|
|
* choicepoint for the current B */
|
2009-06-26 13:16:42 -05:00
|
|
|
|
#ifdef FROZEN_STACKS
|
|
|
|
|
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
|
|
|
|
set_cut(S_YREG, B->cp_b);
|
|
|
|
|
#else
|
|
|
|
|
set_cut(S_YREG, B_YREG->cp_b);
|
|
|
|
|
#endif /* FROZEN_STACKS */
|
|
|
|
|
SET_BB(B_YREG);
|
|
|
|
|
ENDCACHE_Y();
|
2008-09-05 05:22:19 +01:00
|
|
|
|
LOCK(((PredEntry *)(PREG->u.Otapl.p))->StatisticsForPred.lock);
|
|
|
|
|
((PredEntry *)(PREG->u.Otapl.p))->StatisticsForPred.NOfRetries++;
|
|
|
|
|
UNLOCK(((PredEntry *)(PREG->u.Otapl.p))->StatisticsForPred.lock);
|
2011-05-04 10:11:41 +01:00
|
|
|
|
LOCAL_RetriesCounter--;
|
|
|
|
|
if (LOCAL_RetriesCounter == 0 && LOCAL_RetriesCounterOn) {
|
2002-09-03 20:14:13 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(RETRY_COUNTER_UNDERFLOW,"");
|
2002-09-03 20:14:13 +00:00
|
|
|
|
setregs();
|
2002-09-03 14:28:09 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
2011-05-04 10:11:41 +01:00
|
|
|
|
LOCAL_PredEntriesCounter--;
|
|
|
|
|
if (LOCAL_PredEntriesCounter == 0 && LOCAL_PredEntriesCounterOn) {
|
2002-09-03 20:14:13 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW,"");
|
2002-09-03 20:14:13 +00:00
|
|
|
|
setregs();
|
2002-09-03 14:28:09 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = NEXTOP(PREG, Otapl);
|
2002-09-03 14:28:09 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
/* count_trust_me UnusedLabel,NArgs */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
Op(count_trust_me, Otapl);
|
2002-09-03 14:28:09 +00:00
|
|
|
|
CACHE_Y(B);
|
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
if (SCH_top_shared_cp(B)) {
|
2002-11-11 17:38:10 +00:00
|
|
|
|
SCH_last_alternative(PREG, B_YREG);
|
2008-09-05 05:22:19 +01:00
|
|
|
|
restore_args(PREG->u.Otapl.s);
|
2002-09-03 14:28:09 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
2005-03-04 20:30:14 +00:00
|
|
|
|
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
2002-09-03 14:28:09 +00:00
|
|
|
|
#endif /* FROZEN_STACKS */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
set_cut(S_YREG, B->cp_b);
|
2002-09-03 14:28:09 +00:00
|
|
|
|
}
|
|
|
|
|
else
|
|
|
|
|
#endif /* YAPOR */
|
|
|
|
|
{
|
|
|
|
|
pop_yaam_regs();
|
2008-09-05 05:22:19 +01:00
|
|
|
|
pop_args(PREG->u.Otapl.s);
|
2002-09-03 14:28:09 +00:00
|
|
|
|
/* After trust, cut should be pointing at the new top
|
|
|
|
|
* choicepoint */
|
|
|
|
|
#ifdef FROZEN_STACKS
|
2005-03-04 20:30:14 +00:00
|
|
|
|
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
2002-09-03 14:28:09 +00:00
|
|
|
|
#endif /* FROZEN_STACKS */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
set_cut(S_YREG, B);
|
2002-09-03 14:28:09 +00:00
|
|
|
|
}
|
2002-11-11 17:38:10 +00:00
|
|
|
|
SET_BB(B_YREG);
|
2002-09-03 14:28:09 +00:00
|
|
|
|
ENDCACHE_Y();
|
2011-05-04 10:11:41 +01:00
|
|
|
|
LOCAL_RetriesCounter--;
|
|
|
|
|
if (LOCAL_RetriesCounter == 0) {
|
2002-09-03 20:14:13 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(RETRY_COUNTER_UNDERFLOW,"");
|
2002-09-03 20:14:13 +00:00
|
|
|
|
setregs();
|
2002-09-03 14:28:09 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
2011-05-04 10:11:41 +01:00
|
|
|
|
LOCAL_PredEntriesCounter--;
|
|
|
|
|
if (LOCAL_PredEntriesCounter == 0) {
|
2002-09-03 20:14:13 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW,"");
|
2002-09-03 20:14:13 +00:00
|
|
|
|
setregs();
|
2002-09-03 14:28:09 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
2008-09-05 05:22:19 +01:00
|
|
|
|
LOCK(((PredEntry *)(PREG->u.Otapl.p))->StatisticsForPred.lock);
|
|
|
|
|
((PredEntry *)(PREG->u.Otapl.p))->StatisticsForPred.NOfRetries++;
|
|
|
|
|
UNLOCK(((PredEntry *)(PREG->u.Otapl.p))->StatisticsForPred.lock);
|
|
|
|
|
PREG = NEXTOP(PREG, Otapl);
|
2002-09-03 14:28:09 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
2008-09-05 05:22:19 +01:00
|
|
|
|
BOp(count_retry_logical, OtaLl);
|
2006-10-10 14:08:17 +00:00
|
|
|
|
check_trail(TR);
|
2003-09-15 01:25:29 +00:00
|
|
|
|
{
|
2006-10-10 14:08:17 +00:00
|
|
|
|
UInt timestamp;
|
|
|
|
|
CACHE_Y(B);
|
|
|
|
|
|
2008-09-05 05:22:19 +01:00
|
|
|
|
timestamp = IntegerOfTerm(((CELL *)(B_YREG+1))[PREG->u.OtaLl.s]);
|
|
|
|
|
if (!VALID_TIMESTAMP(timestamp, PREG->u.OtaLl.d)) {
|
2006-10-10 14:08:17 +00:00
|
|
|
|
/* jump to next instruction */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG=PREG->u.OtaLl.n;
|
2004-02-18 01:43:32 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
2008-09-05 05:22:19 +01:00
|
|
|
|
restore_yaam_regs(PREG->u.OtaLl.n);
|
|
|
|
|
restore_args(PREG->u.OtaLl.s);
|
2011-05-04 10:11:41 +01:00
|
|
|
|
LOCAL_RetriesCounter--;
|
|
|
|
|
if (LOCAL_RetriesCounter == 0) {
|
2006-10-10 14:08:17 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(RETRY_COUNTER_UNDERFLOW,"");
|
2006-10-10 14:08:17 +00:00
|
|
|
|
setregs();
|
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
2011-05-04 10:11:41 +01:00
|
|
|
|
LOCAL_PredEntriesCounter--;
|
|
|
|
|
if (LOCAL_PredEntriesCounter == 0) {
|
2006-10-10 14:08:17 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW,"");
|
2006-10-10 14:08:17 +00:00
|
|
|
|
setregs();
|
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
2008-09-05 05:22:19 +01:00
|
|
|
|
LOCK(PREG->u.OtaLl.d->ClPred->StatisticsForPred.lock);
|
|
|
|
|
PREG->u.OtaLl.d->ClPred->StatisticsForPred.NOfRetries++;
|
|
|
|
|
UNLOCK(PREG->u.OtaLl.d->ClPred->StatisticsForPred.lock);
|
2010-01-26 11:40:32 +00:00
|
|
|
|
#ifdef THREADS
|
|
|
|
|
PP = PREG->u.OtaLl.d->ClPred;
|
|
|
|
|
#endif
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = PREG->u.OtaLl.d->ClCode;
|
2006-10-10 14:08:17 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
|
|
|
|
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
|
|
|
|
set_cut(S_YREG, B->cp_b);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#else
|
2006-10-10 14:08:17 +00:00
|
|
|
|
set_cut(S_YREG, B_YREG->cp_b);
|
|
|
|
|
#endif /* FROZEN_STACKS */
|
|
|
|
|
SET_BB(B_YREG);
|
|
|
|
|
ENDCACHE_Y();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
2006-10-10 14:08:17 +00:00
|
|
|
|
JMPNext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2008-09-05 05:22:19 +01:00
|
|
|
|
BOp(count_trust_logical, OtILl);
|
2006-10-10 14:08:17 +00:00
|
|
|
|
CACHE_Y(B);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
{
|
2008-09-05 05:22:19 +01:00
|
|
|
|
LogUpdIndex *cl = PREG->u.OtILl.block;
|
2006-10-10 14:08:17 +00:00
|
|
|
|
PredEntry *ap = cl->ClPred;
|
2008-09-05 05:22:19 +01:00
|
|
|
|
LogUpdClause *lcl = PREG->u.OtILl.d;
|
2006-10-10 14:08:17 +00:00
|
|
|
|
UInt timestamp = IntegerOfTerm(((CELL *)(B_YREG+1))[ap->ArityOfPE]);
|
|
|
|
|
|
2006-11-27 17:42:03 +00:00
|
|
|
|
if (!VALID_TIMESTAMP(timestamp, lcl)) {
|
2006-10-10 14:08:17 +00:00
|
|
|
|
/* jump to next alternative */
|
|
|
|
|
PREG = FAILCODE;
|
|
|
|
|
} else {
|
2011-05-04 10:11:41 +01:00
|
|
|
|
LOCAL_RetriesCounter--;
|
|
|
|
|
if (LOCAL_RetriesCounter == 0) {
|
2006-10-10 14:08:17 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(RETRY_COUNTER_UNDERFLOW,"");
|
2006-10-10 14:08:17 +00:00
|
|
|
|
setregs();
|
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
2011-05-04 10:11:41 +01:00
|
|
|
|
LOCAL_PredEntriesCounter--;
|
|
|
|
|
if (LOCAL_PredEntriesCounter == 0) {
|
2006-10-10 14:08:17 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW,"");
|
2006-10-10 14:08:17 +00:00
|
|
|
|
setregs();
|
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
2006-11-27 17:42:03 +00:00
|
|
|
|
LOCK(ap->StatisticsForPred.lock);
|
|
|
|
|
ap->StatisticsForPred.NOfRetries++;
|
2006-11-28 00:46:28 +00:00
|
|
|
|
UNLOCK(ap->StatisticsForPred.lock);
|
2006-11-27 17:42:03 +00:00
|
|
|
|
PREG = lcl->ClCode;
|
2006-10-10 14:08:17 +00:00
|
|
|
|
}
|
|
|
|
|
/* HEY, leave indexing block alone!! */
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* check if we are the ones using this code */
|
2011-04-14 18:51:11 +01:00
|
|
|
|
#if MULTIPLE_STACKS
|
2010-07-25 11:22:16 +01:00
|
|
|
|
PELOCK(2, ap);
|
2007-11-26 23:43:10 +00:00
|
|
|
|
PP = ap;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
DEC_CLREF_COUNT(cl);
|
|
|
|
|
/* clear the entry from the trail */
|
2011-04-22 12:20:52 +01:00
|
|
|
|
--B->cp_tr;
|
|
|
|
|
TR = B->cp_tr;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* actually get rid of the code */
|
2006-10-10 14:08:17 +00:00
|
|
|
|
if (cl->ClRefCount == 0 && (cl->ClFlags & (ErasedMask|DirtyMask))) {
|
|
|
|
|
if (PREG != FAILCODE) {
|
2004-04-22 03:24:17 +00:00
|
|
|
|
/* I am the last one using this clause, hence I don't need a lock
|
|
|
|
|
to dispose of it
|
|
|
|
|
*/
|
2004-04-22 20:07:07 +00:00
|
|
|
|
if (lcl->ClRefCount == 1) {
|
|
|
|
|
/* make sure the clause isn't destroyed */
|
|
|
|
|
/* always add an extra reference */
|
|
|
|
|
INC_CLREF_COUNT(lcl);
|
|
|
|
|
TRAIL_CLREF(lcl);
|
|
|
|
|
}
|
2004-04-22 03:24:17 +00:00
|
|
|
|
}
|
2006-11-27 17:42:03 +00:00
|
|
|
|
if (cl->ClFlags & ErasedMask) {
|
|
|
|
|
saveregs();
|
2006-10-10 14:08:17 +00:00
|
|
|
|
Yap_ErLogUpdIndex(cl);
|
2006-11-27 17:42:03 +00:00
|
|
|
|
setregs();
|
|
|
|
|
} else {
|
|
|
|
|
saveregs();
|
2006-10-10 14:08:17 +00:00
|
|
|
|
Yap_CleanUpIndex(cl);
|
2006-11-27 17:42:03 +00:00
|
|
|
|
setregs();
|
|
|
|
|
}
|
2005-12-23 00:20:14 +00:00
|
|
|
|
save_pc();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
#else
|
2003-12-18 16:38:40 +00:00
|
|
|
|
if (TrailTerm(B->cp_tr-1) == CLREF_TO_TRENTRY(cl) &&
|
2004-04-29 03:45:50 +00:00
|
|
|
|
B->cp_tr != B->cp_b->cp_tr) {
|
2001-04-09 19:54:03 +00:00
|
|
|
|
cl->ClFlags &= ~InUseMask;
|
2011-04-22 12:20:52 +01:00
|
|
|
|
--B->cp_tr;
|
|
|
|
|
#if FROZEN_STACKS
|
|
|
|
|
if (B->cp_tr > TR_FZ)
|
|
|
|
|
#endif
|
|
|
|
|
{
|
|
|
|
|
TR = B->cp_tr;
|
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* next, recover space for the indexing code if it was erased */
|
2006-10-10 14:08:17 +00:00
|
|
|
|
if (cl->ClFlags & (ErasedMask|DirtyMask)) {
|
|
|
|
|
if (PREG != FAILCODE) {
|
2004-04-22 03:24:17 +00:00
|
|
|
|
/* make sure we don't erase the clause we are jumping too */
|
2012-07-18 14:32:53 -05:00
|
|
|
|
if (!(lcl->ClFlags & InUseMask)) {
|
2004-04-22 03:24:17 +00:00
|
|
|
|
lcl->ClFlags |= InUseMask;
|
|
|
|
|
TRAIL_CLREF(lcl);
|
|
|
|
|
}
|
|
|
|
|
}
|
2006-11-27 17:42:03 +00:00
|
|
|
|
if (cl->ClFlags & ErasedMask) {
|
|
|
|
|
saveregs();
|
2006-10-10 14:08:17 +00:00
|
|
|
|
Yap_ErLogUpdIndex(cl);
|
2006-11-27 17:42:03 +00:00
|
|
|
|
setregs();
|
|
|
|
|
} else {
|
|
|
|
|
saveregs();
|
2006-10-10 14:08:17 +00:00
|
|
|
|
Yap_CleanUpIndex(cl);
|
2006-11-27 17:42:03 +00:00
|
|
|
|
setregs();
|
|
|
|
|
}
|
2005-12-23 00:20:14 +00:00
|
|
|
|
save_pc();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
#endif
|
2006-10-10 14:08:17 +00:00
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
if (SCH_top_shared_cp(B)) {
|
|
|
|
|
SCH_last_alternative(PREG, B_YREG);
|
2008-06-17 13:37:51 +00:00
|
|
|
|
restore_args(ap->ArityOfPE);
|
2006-10-10 14:08:17 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
|
|
|
|
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
|
|
|
|
#else
|
|
|
|
|
S_YREG++;
|
|
|
|
|
#endif /* FROZEN_STACKS */
|
|
|
|
|
set_cut(S_YREG, B->cp_b);
|
|
|
|
|
} else
|
|
|
|
|
#endif /* YAPOR */
|
|
|
|
|
{
|
|
|
|
|
pop_yaam_regs();
|
2008-06-17 13:37:51 +00:00
|
|
|
|
pop_args(ap->ArityOfPE);
|
2006-10-10 14:08:17 +00:00
|
|
|
|
S_YREG--;
|
|
|
|
|
#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();
|
|
|
|
|
JMPNext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2006-10-10 14:08:17 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
/*****************************************************************
|
|
|
|
|
* enter a logical semantics dynamic predicate *
|
|
|
|
|
*****************************************************************/
|
|
|
|
|
|
|
|
|
|
/* only meaningful with THREADS on! */
|
|
|
|
|
/* lock logical updates predicate. */
|
2008-08-29 17:27:11 +01:00
|
|
|
|
Op(lock_lu, p);
|
2011-04-14 18:51:11 +01:00
|
|
|
|
#if PARALLEL_YAP
|
2007-11-26 23:43:10 +00:00
|
|
|
|
if (PP) {
|
2006-10-10 14:08:17 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
2007-11-26 23:43:10 +00:00
|
|
|
|
PP = PREG->u.p.p;
|
2010-07-25 11:22:16 +01:00
|
|
|
|
PELOCK(3, PP);
|
2006-10-10 14:08:17 +00:00
|
|
|
|
#endif
|
|
|
|
|
PREG = NEXTOP(PREG, p);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
/* only meaningful with THREADS on! */
|
|
|
|
|
/* lock logical updates predicate. */
|
|
|
|
|
Op(unlock_lu, e);
|
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
2010-07-28 11:26:20 +01:00
|
|
|
|
UNLOCKPE(1,PP);
|
2007-11-26 23:43:10 +00:00
|
|
|
|
PP = NULL;
|
2006-10-10 14:08:17 +00:00
|
|
|
|
#endif
|
2007-11-26 23:43:10 +00:00
|
|
|
|
PREG = NEXTOP(PREG, e);
|
2006-10-10 14:08:17 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* enter logical pred */
|
2008-08-21 13:38:25 +01:00
|
|
|
|
BOp(alloc_for_logical_pred, L);
|
2007-09-24 09:02:33 +00:00
|
|
|
|
check_trail(TR);
|
2007-10-17 09:18:27 +00:00
|
|
|
|
/* say that an environment is using this clause */
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* we have our own copy for the clause */
|
2011-04-14 18:51:11 +01:00
|
|
|
|
#if MULTIPLE_STACKS
|
2001-04-09 19:54:03 +00:00
|
|
|
|
{
|
2008-08-21 13:38:25 +01:00
|
|
|
|
LogUpdClause *cl = PREG->u.L.ClBase;
|
2011-04-14 18:51:11 +01:00
|
|
|
|
#if PARALLEL_YAP
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PredEntry *ap = cl->ClPred;
|
2011-04-14 18:51:11 +01:00
|
|
|
|
#endif
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
/* always add an extra reference */
|
|
|
|
|
INC_CLREF_COUNT(cl);
|
2001-06-08 14:52:54 +00:00
|
|
|
|
TRAIL_CLREF(cl);
|
2010-07-28 11:26:20 +01:00
|
|
|
|
UNLOCKPE(2,ap);
|
2007-11-26 23:43:10 +00:00
|
|
|
|
PP = NULL;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
#else
|
2002-06-12 16:48:35 +00:00
|
|
|
|
{
|
2008-08-21 13:38:25 +01:00
|
|
|
|
LogUpdClause *cl = (LogUpdClause *)PREG->u.L.ClBase;
|
2003-11-12 12:33:31 +00:00
|
|
|
|
if (!(cl->ClFlags & InUseMask)) {
|
2002-06-12 16:48:35 +00:00
|
|
|
|
cl->ClFlags |= InUseMask;
|
|
|
|
|
TRAIL_CLREF(cl);
|
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
#endif
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, L);
|
2011-10-02 19:55:22 -03:00
|
|
|
|
JMPNext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2003-08-23 19:26:08 +00:00
|
|
|
|
/* copy database term */
|
|
|
|
|
BOp(copy_idb_term, e);
|
|
|
|
|
{
|
|
|
|
|
LogUpdClause *cl = ClauseCodeToLogUpdClause(PREG);
|
|
|
|
|
Term t;
|
|
|
|
|
|
2011-02-14 11:29:20 -08:00
|
|
|
|
SET_ASP(YREG, E_CB*sizeof(CELL));
|
2003-10-17 02:11:21 +00:00
|
|
|
|
saveregs();
|
|
|
|
|
while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) {
|
2011-05-23 16:19:47 +01:00
|
|
|
|
if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
|
|
|
|
|
LOCAL_Error_TYPE = YAP_NO_ERROR;
|
2004-09-17 19:34:53 +00:00
|
|
|
|
if (!Yap_growglobal(NULL)) {
|
2010-07-28 11:26:20 +01:00
|
|
|
|
UNLOCKPE(3,PP);
|
2007-11-26 23:43:10 +00:00
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
|
|
|
|
PP = NULL;
|
|
|
|
|
#endif
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(OUT_OF_ATTVARS_ERROR, LOCAL_ErrorMessage);
|
2004-09-17 19:34:53 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
} else {
|
2011-05-23 16:19:47 +01:00
|
|
|
|
LOCAL_Error_TYPE = YAP_NO_ERROR;
|
2004-09-17 19:34:53 +00:00
|
|
|
|
if (!Yap_gc(3, ENV, CP)) {
|
2010-07-28 11:26:20 +01:00
|
|
|
|
UNLOCKPE(4,PP);
|
2007-11-26 23:43:10 +00:00
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
|
|
|
|
PP = NULL;
|
|
|
|
|
#endif
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(OUT_OF_STACK_ERROR, LOCAL_ErrorMessage);
|
2004-09-17 19:34:53 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
2003-10-17 02:11:21 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
2003-08-23 19:26:08 +00:00
|
|
|
|
if (!Yap_IUnify(ARG2, t)) {
|
2003-10-30 22:52:46 +00:00
|
|
|
|
setregs();
|
2010-07-28 11:26:20 +01:00
|
|
|
|
UNLOCKPE(5,PP);
|
2007-11-26 23:43:10 +00:00
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
|
|
|
|
PP = NULL;
|
|
|
|
|
#endif
|
2003-08-23 19:26:08 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
if (!Yap_IUnify(ARG3, MkDBRefTerm((DBRef)cl))) {
|
2003-10-30 22:52:46 +00:00
|
|
|
|
setregs();
|
2010-07-28 11:26:20 +01:00
|
|
|
|
UNLOCKPE(6,PP);
|
2007-11-26 23:43:10 +00:00
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
|
|
|
|
PP = NULL;
|
|
|
|
|
#endif
|
2003-08-23 19:26:08 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
2003-10-30 22:52:46 +00:00
|
|
|
|
setregs();
|
2003-08-23 19:26:08 +00:00
|
|
|
|
|
2011-04-14 18:51:11 +01:00
|
|
|
|
#if MULTIPLE_STACKS
|
2003-08-23 19:26:08 +00:00
|
|
|
|
/* always add an extra reference */
|
|
|
|
|
INC_CLREF_COUNT(cl);
|
|
|
|
|
TRAIL_CLREF(cl);
|
2010-07-28 11:26:20 +01:00
|
|
|
|
UNLOCKPE(7,PP);
|
2007-11-26 23:43:10 +00:00
|
|
|
|
PP = NULL;
|
2003-08-23 19:26:08 +00:00
|
|
|
|
#else
|
2003-11-12 12:33:31 +00:00
|
|
|
|
if (!(cl->ClFlags & InUseMask)) {
|
2003-08-23 19:26:08 +00:00
|
|
|
|
/* Clause *cl = (Clause *)PREG->u.EC.ClBase;
|
|
|
|
|
|
2011-05-23 16:19:47 +01:00
|
|
|
|
PREG->u.EC.ClTrail = TR-(tr_fr_ptr)LOCAL_TrailBase;
|
2009-06-16 21:20:35 -05:00
|
|
|
|
PREG->u.EC.ClENV = LCL0-YREG;*/
|
2003-08-23 19:26:08 +00:00
|
|
|
|
cl->ClFlags |= InUseMask;
|
|
|
|
|
TRAIL_CLREF(cl);
|
|
|
|
|
}
|
|
|
|
|
#endif
|
|
|
|
|
}
|
|
|
|
|
PREG = CPREG;
|
|
|
|
|
YREG = ENV;
|
|
|
|
|
#ifdef DEPTH_LIMIT
|
|
|
|
|
DEPTH = YREG[E_DEPTH];
|
|
|
|
|
#endif
|
2011-10-02 19:55:22 -03:00
|
|
|
|
JMPNext();
|
2003-08-23 19:26:08 +00:00
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
/* unify with database term */
|
|
|
|
|
BOp(unify_idb_term, e);
|
|
|
|
|
{
|
|
|
|
|
LogUpdClause *cl = ClauseCodeToLogUpdClause(PREG);
|
|
|
|
|
|
2003-10-30 22:52:46 +00:00
|
|
|
|
saveregs();
|
2003-08-23 19:26:08 +00:00
|
|
|
|
if (!Yap_IUnify(ARG2, cl->ClSource->Entry)) {
|
2003-10-30 22:52:46 +00:00
|
|
|
|
setregs();
|
2010-07-28 11:26:20 +01:00
|
|
|
|
UNLOCKPE(8,PP);
|
2007-11-26 23:43:10 +00:00
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
|
|
|
|
PP = NULL;
|
|
|
|
|
#endif
|
2003-08-23 19:26:08 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
if (!Yap_IUnify(ARG3, MkDBRefTerm((DBRef)cl))) {
|
2003-10-30 22:52:46 +00:00
|
|
|
|
setregs();
|
2010-07-28 11:26:20 +01:00
|
|
|
|
UNLOCKPE(9,PP);
|
2007-11-26 23:43:10 +00:00
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
|
|
|
|
PP = NULL;
|
|
|
|
|
#endif
|
2003-08-23 19:26:08 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
2003-10-30 22:52:46 +00:00
|
|
|
|
setregs();
|
2003-08-23 19:26:08 +00:00
|
|
|
|
|
|
|
|
|
/* say that an environment is using this clause */
|
|
|
|
|
/* we have our own copy for the clause */
|
2011-04-14 18:51:11 +01:00
|
|
|
|
#if MULTIPLE_STACKS
|
2003-08-23 19:26:08 +00:00
|
|
|
|
/* always add an extra reference */
|
|
|
|
|
INC_CLREF_COUNT(cl);
|
|
|
|
|
TRAIL_CLREF(cl);
|
2010-07-28 11:26:20 +01:00
|
|
|
|
UNLOCKPE(10,PP);
|
2007-11-26 23:43:10 +00:00
|
|
|
|
PP = NULL;
|
2003-08-23 19:26:08 +00:00
|
|
|
|
#else
|
2003-11-12 12:33:31 +00:00
|
|
|
|
if (!(cl->ClFlags & InUseMask)) {
|
2003-08-23 19:26:08 +00:00
|
|
|
|
/* Clause *cl = (Clause *)PREG->u.EC.ClBase;
|
|
|
|
|
|
2011-05-23 16:19:47 +01:00
|
|
|
|
PREG->u.EC.ClTrail = TR-(tr_fr_ptr)LOCAL_TrailBase;
|
2009-06-16 21:20:35 -05:00
|
|
|
|
PREG->u.EC.ClENV = LCL0-YREG;*/
|
2003-08-23 19:26:08 +00:00
|
|
|
|
cl->ClFlags |= InUseMask;
|
|
|
|
|
TRAIL_CLREF(cl);
|
|
|
|
|
}
|
|
|
|
|
#endif
|
|
|
|
|
}
|
|
|
|
|
PREG = CPREG;
|
|
|
|
|
YREG = ENV;
|
|
|
|
|
#ifdef DEPTH_LIMIT
|
|
|
|
|
DEPTH = YREG[E_DEPTH];
|
|
|
|
|
#endif
|
2011-10-02 19:55:22 -03:00
|
|
|
|
JMPNext();
|
2003-08-23 19:26:08 +00:00
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
|
2010-08-02 13:04:30 +01:00
|
|
|
|
/*****************************************************************
|
|
|
|
|
* check for enough room *
|
|
|
|
|
*****************************************************************/
|
|
|
|
|
|
|
|
|
|
/* ensure_space */
|
2011-07-30 00:07:35 +01:00
|
|
|
|
BOp(ensure_space, Osbpa);
|
2010-08-02 13:04:30 +01:00
|
|
|
|
{
|
2011-07-30 00:07:35 +01:00
|
|
|
|
Int sz = PREG->u.Osbpa.i;
|
|
|
|
|
UInt arity = PREG->u.Osbpa.p->ArityOfPE;
|
2010-08-02 13:04:30 +01:00
|
|
|
|
if (Unsigned(H) + sz > Unsigned(YREG)-CreepFlag) {
|
2010-08-02 18:20:03 +01:00
|
|
|
|
YENV[E_CP] = (CELL) CPREG;
|
|
|
|
|
YENV[E_E] = (CELL) ENV;
|
|
|
|
|
#ifdef DEPTH_LIMIT
|
|
|
|
|
YENV[E_DEPTH] = DEPTH;
|
|
|
|
|
#endif /* DEPTH_LIMIT */
|
2011-07-30 00:07:35 +01:00
|
|
|
|
SET_ASP(YREG, PREG->u.Osbpa.s);
|
|
|
|
|
PREG = NEXTOP(PREG,Osbpa);
|
2010-08-02 13:04:30 +01:00
|
|
|
|
saveregs();
|
2010-10-08 10:45:50 +01:00
|
|
|
|
if (!Yap_gcl(sz, arity, YENV, PREG)) {
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(OUT_OF_STACK_ERROR,LOCAL_ErrorMessage);
|
2010-08-02 13:04:30 +01:00
|
|
|
|
setregs();
|
|
|
|
|
FAIL();
|
|
|
|
|
} else {
|
|
|
|
|
setregs();
|
|
|
|
|
}
|
2011-07-09 09:16:02 -07:00
|
|
|
|
} else {
|
2011-07-30 00:07:35 +01:00
|
|
|
|
PREG = NEXTOP(PREG,Osbpa);
|
2011-07-09 09:16:02 -07:00
|
|
|
|
}
|
2010-08-02 13:04:30 +01:00
|
|
|
|
}
|
|
|
|
|
JMPNext();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/*****************************************************************
|
|
|
|
|
* try and retry of dynamic predicates *
|
|
|
|
|
*****************************************************************/
|
|
|
|
|
|
|
|
|
|
/* spy_or_trymark */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
BOp(spy_or_trymark, Otapl);
|
2010-07-25 11:22:16 +01:00
|
|
|
|
PELOCK(5, ((PredEntry *)(PREG->u.Otapl.p)));
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = (yamop *)(&(((PredEntry *)(PREG->u.Otapl.p))->OpcodeOfPred));
|
2010-07-28 11:26:20 +01:00
|
|
|
|
UNLOCKPE(11,(PredEntry *)(PREG->u.Otapl.p));
|
2004-05-13 20:54:58 +00:00
|
|
|
|
goto dospy;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
/* try_and_mark Label,NArgs */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
BOp(try_and_mark, Otapl);
|
2003-08-23 19:26:08 +00:00
|
|
|
|
check_trail(TR);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
/* The flags I check here should never change during execution */
|
|
|
|
|
CUT_wait_leftmost();
|
|
|
|
|
#endif /* YAPOR */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
if (PREG->u.Otapl.p->PredFlags & LogUpdatePredFlag) {
|
2010-07-25 11:22:16 +01:00
|
|
|
|
PELOCK(6,PREG->u.Otapl.p);
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PP = PREG->u.Otapl.p;
|
2007-11-26 23:43:10 +00:00
|
|
|
|
}
|
2008-09-05 05:22:19 +01:00
|
|
|
|
if (PREG->u.Otapl.p->CodeOfPred != PREG) {
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* oops, someone changed the procedure under our feet,
|
|
|
|
|
fortunately this is no big deal because we haven't done
|
|
|
|
|
anything yet */
|
2007-11-26 23:43:10 +00:00
|
|
|
|
PP = NULL;
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = PREG->u.Otapl.p->CodeOfPred;
|
2010-07-28 11:26:20 +01:00
|
|
|
|
UNLOCKPE(12,PREG->u.Otapl.p);
|
2005-12-23 00:20:14 +00:00
|
|
|
|
/* for profiler */
|
|
|
|
|
save_pc();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
|
|
|
|
#endif
|
2002-11-11 17:38:10 +00:00
|
|
|
|
CACHE_Y(YREG);
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = PREG->u.Otapl.d;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/*
|
|
|
|
|
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 */
|
2010-07-28 11:26:20 +01:00
|
|
|
|
UNLOCKPE(13,((PredEntry *)(PREG->u.Otapl.p)));
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d1);
|
2008-09-05 05:22:19 +01:00
|
|
|
|
d1 = PREG->u.Otapl.s;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
store_args(d1);
|
|
|
|
|
store_yaam_regs(PREG, 0);
|
|
|
|
|
ENDD(d1);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
set_cut(S_YREG, B);
|
|
|
|
|
B = B_YREG;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifdef YAPOR
|
2002-11-11 17:38:10 +00:00
|
|
|
|
SCH_set_load(B_YREG);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif /* YAPOR */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
SET_BB(B_YREG);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDCACHE_Y();
|
2011-04-14 18:51:11 +01:00
|
|
|
|
#if MULTIPLE_STACKS
|
2003-04-30 17:46:05 +00:00
|
|
|
|
INC_CLREF_COUNT(ClauseCodeToDynamicClause(PREG));
|
2001-04-09 19:54:03 +00:00
|
|
|
|
UNLOCK(DynamicLock(PREG));
|
2003-04-30 17:46:05 +00:00
|
|
|
|
TRAIL_CLREF(ClauseCodeToDynamicClause(PREG));
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#else
|
|
|
|
|
if (FlagOff(InUseMask, DynamicFlags(PREG))) {
|
|
|
|
|
|
|
|
|
|
SetFlag(InUseMask, DynamicFlags(PREG));
|
2003-04-30 17:46:05 +00:00
|
|
|
|
TRAIL_CLREF(ClauseCodeToDynamicClause(PREG));
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
#endif
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = NEXTOP(PREG,Otapl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2008-09-05 05:22:19 +01:00
|
|
|
|
BOp(count_retry_and_mark, Otapl);
|
2011-05-04 10:11:41 +01:00
|
|
|
|
LOCAL_RetriesCounter--;
|
|
|
|
|
if (LOCAL_RetriesCounter == 0) {
|
2002-09-03 20:14:13 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(RETRY_COUNTER_UNDERFLOW,"");
|
2002-09-03 20:14:13 +00:00
|
|
|
|
setregs();
|
2002-09-03 14:28:09 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
2011-05-04 10:11:41 +01:00
|
|
|
|
LOCAL_PredEntriesCounter--;
|
|
|
|
|
if (LOCAL_PredEntriesCounter == 0) {
|
2002-09-03 20:14:13 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW,"");
|
2002-09-03 20:14:13 +00:00
|
|
|
|
setregs();
|
2002-09-03 14:28:09 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
|
|
|
|
/* enter a retry dynamic */
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2008-09-05 05:22:19 +01:00
|
|
|
|
BOp(profiled_retry_and_mark, Otapl);
|
|
|
|
|
LOCK(((PredEntry *)(PREG->u.Otapl.p))->StatisticsForPred.lock);
|
|
|
|
|
((PredEntry *)(PREG->u.Otapl.p))->StatisticsForPred.NOfRetries++;
|
|
|
|
|
UNLOCK(((PredEntry *)(PREG->u.Otapl.p))->StatisticsForPred.lock);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* enter a retry dynamic */
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
/* retry_and_mark Label,NArgs */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
BOp(retry_and_mark, Otapl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
CUT_wait_leftmost();
|
|
|
|
|
#endif /* YAPOR */
|
|
|
|
|
/* need to make the DB stable until I get the new clause */
|
2010-07-25 11:22:16 +01:00
|
|
|
|
PELOCK(7,PREG->u.Otapl.p);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
CACHE_Y(B);
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = PREG->u.Otapl.d;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
LOCK(DynamicLock(PREG));
|
2008-09-05 05:22:19 +01:00
|
|
|
|
UNLOCK(PREG->u.Otapl.p->PELock);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
restore_yaam_regs(PREG);
|
2008-09-05 05:22:19 +01:00
|
|
|
|
restore_args(PREG->u.Otapl.s);
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
2005-03-04 20:30:14 +00:00
|
|
|
|
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
set_cut(S_YREG, B->cp_b);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#else
|
2002-11-11 17:38:10 +00:00
|
|
|
|
set_cut(S_YREG, B_YREG->cp_b);
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#endif /* FROZEN_STACKS */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
SET_BB(B_YREG);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDCACHE_Y();
|
2011-04-14 18:51:11 +01:00
|
|
|
|
#if MULTIPLE_STACKS
|
2003-04-30 17:46:05 +00:00
|
|
|
|
INC_CLREF_COUNT(ClauseCodeToDynamicClause(PREG));
|
|
|
|
|
TRAIL_CLREF(ClauseCodeToDynamicClause(PREG));
|
2001-04-09 19:54:03 +00:00
|
|
|
|
UNLOCK(DynamicLock(PREG));
|
|
|
|
|
#else
|
|
|
|
|
if (FlagOff(InUseMask, DynamicFlags(PREG))) {
|
|
|
|
|
|
|
|
|
|
SetFlag(InUseMask, DynamicFlags(PREG));
|
2003-04-30 17:46:05 +00:00
|
|
|
|
TRAIL_CLREF(ClauseCodeToDynamicClause(PREG));
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
#endif
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = NEXTOP(PREG, Otapl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
/*****************************************************************
|
|
|
|
|
* Failure *
|
|
|
|
|
*****************************************************************/
|
|
|
|
|
|
|
|
|
|
/* trust_fail */
|
|
|
|
|
BOp(trust_fail, e);
|
2005-11-18 18:52:41 +00:00
|
|
|
|
#ifdef CUT_C
|
|
|
|
|
{
|
|
|
|
|
while (POP_CHOICE_POINT(B->cp_b))
|
|
|
|
|
{
|
|
|
|
|
POP_EXECUTE();
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
#endif /* CUT_C */
|
2003-12-18 16:38:40 +00:00
|
|
|
|
#ifdef YAPOR
|
2005-04-07 17:56:58 +00:00
|
|
|
|
{
|
|
|
|
|
choiceptr cut_pt;
|
|
|
|
|
cut_pt = B->cp_b;
|
|
|
|
|
CUT_prune_to(cut_pt);
|
|
|
|
|
B = cut_pt;
|
|
|
|
|
}
|
2003-12-18 16:38:40 +00:00
|
|
|
|
#else
|
2001-04-09 19:54:03 +00:00
|
|
|
|
B = B->cp_b;
|
2003-12-18 16:38:40 +00:00
|
|
|
|
#endif /* YAPOR */
|
2010-12-05 00:07:22 +00:00
|
|
|
|
goto fail;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
shared_fail:
|
2010-01-14 15:58:19 +00:00
|
|
|
|
B = Get_LOCAL_top_cp();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
SET_BB(PROTECT_FROZEN_B(B));
|
|
|
|
|
goto fail;
|
|
|
|
|
#endif /* YAPOR */
|
|
|
|
|
|
|
|
|
|
/* fail */
|
|
|
|
|
PBOp(op_fail, e);
|
|
|
|
|
|
2009-04-17 14:17:43 -05:00
|
|
|
|
if (PP) {
|
|
|
|
|
UNLOCK(PP->PELock);
|
|
|
|
|
PP = NULL;
|
|
|
|
|
}
|
2006-12-31 01:50:35 +00:00
|
|
|
|
#ifdef COROUTINING
|
|
|
|
|
CACHE_Y_AS_ENV(YREG);
|
|
|
|
|
check_stack(NoStackFail, H);
|
|
|
|
|
ENDCACHE_Y_AS_ENV();
|
|
|
|
|
#endif
|
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
fail:
|
|
|
|
|
{
|
|
|
|
|
register tr_fr_ptr pt0 = TR;
|
2004-02-05 16:57:02 +00:00
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
|
|
|
|
if (PP) {
|
2007-11-26 23:43:10 +00:00
|
|
|
|
UNLOCK(PP->PELock);
|
2004-02-05 16:57:02 +00:00
|
|
|
|
PP = NULL;
|
|
|
|
|
}
|
|
|
|
|
#endif
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = B->cp_ap;
|
2005-12-23 00:20:14 +00:00
|
|
|
|
save_pc();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
CACHE_TR(B->cp_tr);
|
|
|
|
|
PREFETCH_OP(PREG);
|
|
|
|
|
failloop:
|
|
|
|
|
if (pt0 == S_TR) {
|
|
|
|
|
SP = SP0;
|
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
2002-11-18 18:18:05 +00:00
|
|
|
|
if (Yap_do_low_level_trace) {
|
2003-10-28 16:20:44 +00:00
|
|
|
|
int go_on = TRUE;
|
|
|
|
|
yamop *ipc = PREG;
|
|
|
|
|
|
|
|
|
|
while (go_on) {
|
|
|
|
|
op_numbers opnum = Yap_op_from_opcode(ipc->opc);
|
2003-11-24 00:00:43 +00:00
|
|
|
|
|
|
|
|
|
go_on = FALSE;
|
2003-10-28 16:20:44 +00:00
|
|
|
|
switch (opnum) {
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifdef TABLING
|
2005-08-01 15:40:39 +00:00
|
|
|
|
case _table_load_answer:
|
|
|
|
|
low_level_trace(retry_table_loader, LOAD_CP(B)->cp_pred_entry, NULL);
|
|
|
|
|
break;
|
|
|
|
|
case _table_try_answer:
|
2005-07-06 19:34:12 +00:00
|
|
|
|
case _table_retry_me:
|
|
|
|
|
case _table_trust_me:
|
|
|
|
|
case _table_retry:
|
|
|
|
|
case _table_trust:
|
2003-10-28 16:20:44 +00:00
|
|
|
|
case _table_completion:
|
2011-12-22 16:50:20 +00:00
|
|
|
|
#ifdef THREADS_CONSUMER_SHARING
|
|
|
|
|
case _table_answer_resolution_completion:
|
|
|
|
|
#endif /* THREADS_CONSUMER_SHARING */
|
2009-08-07 17:29:53 +01:00
|
|
|
|
#ifdef DETERMINISTIC_TABLING
|
|
|
|
|
if (IS_DET_GEN_CP(B))
|
|
|
|
|
low_level_trace(retry_table_generator, DET_GEN_CP(B)->cp_pred_entry, NULL);
|
|
|
|
|
else
|
|
|
|
|
#endif /* DETERMINISTIC_TABLING */
|
|
|
|
|
low_level_trace(retry_table_generator, GEN_CP(B)->cp_pred_entry, (CELL *)(GEN_CP(B) + 1));
|
2003-10-28 16:20:44 +00:00
|
|
|
|
break;
|
2005-07-06 19:34:12 +00:00
|
|
|
|
case _table_answer_resolution:
|
2005-08-01 15:40:39 +00:00
|
|
|
|
low_level_trace(retry_table_consumer, CONS_CP(B)->cp_pred_entry, NULL);
|
2005-07-06 19:34:12 +00:00
|
|
|
|
break;
|
2010-04-15 01:09:59 +01:00
|
|
|
|
case _trie_trust_var:
|
|
|
|
|
case _trie_retry_var:
|
|
|
|
|
case _trie_trust_var_in_pair:
|
|
|
|
|
case _trie_retry_var_in_pair:
|
|
|
|
|
case _trie_trust_val:
|
|
|
|
|
case _trie_retry_val:
|
|
|
|
|
case _trie_trust_val_in_pair:
|
|
|
|
|
case _trie_retry_val_in_pair:
|
|
|
|
|
case _trie_trust_atom:
|
|
|
|
|
case _trie_retry_atom:
|
|
|
|
|
case _trie_trust_atom_in_pair:
|
|
|
|
|
case _trie_retry_atom_in_pair:
|
|
|
|
|
case _trie_trust_null:
|
|
|
|
|
case _trie_retry_null:
|
|
|
|
|
case _trie_trust_null_in_pair:
|
|
|
|
|
case _trie_retry_null_in_pair:
|
|
|
|
|
case _trie_trust_pair:
|
|
|
|
|
case _trie_retry_pair:
|
|
|
|
|
case _trie_trust_appl:
|
|
|
|
|
case _trie_retry_appl:
|
|
|
|
|
case _trie_trust_appl_in_pair:
|
|
|
|
|
case _trie_retry_appl_in_pair:
|
|
|
|
|
case _trie_trust_extension:
|
|
|
|
|
case _trie_retry_extension:
|
|
|
|
|
case _trie_trust_double:
|
|
|
|
|
case _trie_retry_double:
|
|
|
|
|
case _trie_trust_longint:
|
|
|
|
|
case _trie_retry_longint:
|
|
|
|
|
case _trie_trust_gterm:
|
|
|
|
|
case _trie_retry_gterm:
|
2005-07-06 19:34:12 +00:00
|
|
|
|
low_level_trace(retry_table_loader, UndefCode, NULL);
|
2003-10-28 16:20:44 +00:00
|
|
|
|
break;
|
2003-11-07 17:50:01 +00:00
|
|
|
|
#endif /* TABLING */
|
2003-10-28 16:20:44 +00:00
|
|
|
|
case _or_else:
|
|
|
|
|
case _or_last:
|
|
|
|
|
low_level_trace(retry_or, (PredEntry *)ipc, &(B->cp_a1));
|
|
|
|
|
break;
|
2004-09-27 20:45:04 +00:00
|
|
|
|
case _retry2:
|
|
|
|
|
case _retry3:
|
|
|
|
|
case _retry4:
|
2003-10-28 16:20:44 +00:00
|
|
|
|
ipc = NEXTOP(ipc,l);
|
|
|
|
|
go_on = TRUE;
|
|
|
|
|
break;
|
2006-01-26 19:13:24 +00:00
|
|
|
|
case _jump:
|
|
|
|
|
ipc = ipc->u.l.l;
|
|
|
|
|
go_on = TRUE;
|
|
|
|
|
break;
|
2003-10-28 16:20:44 +00:00
|
|
|
|
case _retry_c:
|
|
|
|
|
case _retry_userc:
|
2008-09-05 05:22:19 +01:00
|
|
|
|
low_level_trace(retry_pred, ipc->u.OtapFs.p, B->cp_args);
|
2003-10-28 16:20:44 +00:00
|
|
|
|
break;
|
|
|
|
|
case _retry_profiled:
|
|
|
|
|
case _count_retry:
|
|
|
|
|
ipc = NEXTOP(ipc,p);
|
|
|
|
|
go_on = TRUE;
|
|
|
|
|
break;
|
|
|
|
|
case _retry_me:
|
|
|
|
|
case _trust_me:
|
|
|
|
|
case _count_retry_me:
|
|
|
|
|
case _count_trust_me:
|
|
|
|
|
case _profiled_retry_me:
|
|
|
|
|
case _profiled_trust_me:
|
|
|
|
|
case _retry_and_mark:
|
|
|
|
|
case _profiled_retry_and_mark:
|
|
|
|
|
case _retry:
|
|
|
|
|
case _trust:
|
2008-09-05 05:22:19 +01:00
|
|
|
|
low_level_trace(retry_pred, ipc->u.Otapl.p, B->cp_args);
|
2003-10-28 16:20:44 +00:00
|
|
|
|
break;
|
2006-10-10 14:08:17 +00:00
|
|
|
|
case _try_logical:
|
|
|
|
|
case _retry_logical:
|
|
|
|
|
case _profiled_retry_logical:
|
|
|
|
|
case _count_retry_logical:
|
|
|
|
|
case _trust_logical:
|
|
|
|
|
case _profiled_trust_logical:
|
|
|
|
|
case _count_trust_logical:
|
2008-09-05 05:22:19 +01:00
|
|
|
|
low_level_trace(retry_pred, ipc->u.OtILl.d->ClPred, B->cp_args);
|
2006-10-10 14:08:17 +00:00
|
|
|
|
break;
|
2003-10-28 16:20:44 +00:00
|
|
|
|
case _Nstop:
|
|
|
|
|
case _Ystop:
|
|
|
|
|
low_level_trace(retry_pred, NULL, B->cp_args);
|
|
|
|
|
break;
|
|
|
|
|
default:
|
|
|
|
|
break;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
#endif /* LOW_LEVEL_TRACER */
|
2005-03-04 20:30:14 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#ifdef YAPOR_SBA
|
2011-10-02 21:01:14 -03:00
|
|
|
|
if (pt0 < TR_FZ || pt0 > (ADDR)CurrentTrailTop+MinTrailGap)
|
2005-03-04 20:30:14 +00:00
|
|
|
|
#else
|
|
|
|
|
if (pt0 < TR_FZ)
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#endif /* YAPOR_SBA */
|
2005-03-04 20:30:14 +00:00
|
|
|
|
{
|
|
|
|
|
TR = TR_FZ;
|
|
|
|
|
TRAIL_LINK(pt0);
|
|
|
|
|
} else
|
|
|
|
|
#endif /* FROZEN_STACKS */
|
2003-11-12 12:33:31 +00:00
|
|
|
|
RESTORE_TR();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d1 = TrailTerm(pt0-1);
|
|
|
|
|
pt0--;
|
|
|
|
|
if (IsVarTerm(d1)) {
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#if defined(YAPOR_SBA) && defined(YAPOR)
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* clean up the trail when we backtrack */
|
|
|
|
|
if (Unsigned((Int)(d1)-(Int)(H_FZ)) >
|
|
|
|
|
Unsigned((Int)(B_FZ)-(Int)(H_FZ))) {
|
|
|
|
|
RESET_VARIABLE(STACK_TO_SBA(d1));
|
|
|
|
|
} else
|
|
|
|
|
#endif
|
|
|
|
|
/* normal variable */
|
|
|
|
|
RESET_VARIABLE(d1);
|
|
|
|
|
goto failloop;
|
|
|
|
|
}
|
|
|
|
|
/* pointer to code space */
|
|
|
|
|
/* or updatable variable */
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#if defined(TERM_EXTENSIONS) || defined(FROZEN_STACKS) || defined(MULTI_ASSIGNMENT_VARIABLES)
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (IsPairTerm(d1))
|
2005-08-12 17:00:00 +00:00
|
|
|
|
#endif /* TERM_EXTENSIONS || FROZEN_STACKS || MULTI_ASSIGNMENT_VARIABLES */
|
2001-04-09 19:54:03 +00:00
|
|
|
|
{
|
|
|
|
|
register CELL flags;
|
2003-08-23 19:26:08 +00:00
|
|
|
|
CELL *pt1 = RepPair(d1);
|
2005-08-04 15:45:56 +00:00
|
|
|
|
#ifdef LIMIT_TABLING
|
2011-05-23 16:19:47 +01:00
|
|
|
|
if ((ADDR) pt1 == LOCAL_TrailBase) {
|
2005-08-04 15:45:56 +00:00
|
|
|
|
sg_fr_ptr sg_fr = (sg_fr_ptr) TrailVal(pt0);
|
|
|
|
|
TrailTerm(pt0) = AbsPair((CELL *)(pt0 - 1));
|
|
|
|
|
SgFr_state(sg_fr)--; /* complete_in_use --> complete : compiled_in_use --> compiled */
|
|
|
|
|
insert_into_global_sg_fr_list(sg_fr);
|
|
|
|
|
goto failloop;
|
|
|
|
|
}
|
|
|
|
|
#endif /* LIMIT_TABLING */
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#ifdef FROZEN_STACKS /* TRAIL */
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* avoid frozen segments */
|
2006-12-30 03:25:47 +00:00
|
|
|
|
if (
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#ifdef YAPOR_SBA
|
2006-12-30 03:25:47 +00:00
|
|
|
|
(ADDR) pt1 >= HeapTop
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#else
|
2011-10-02 21:01:14 -03:00
|
|
|
|
IN_BETWEEN(LOCAL_TrailBase, pt1, (ADDR)CurrentTrailTop+MinTrailGap)
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#endif /* YAPOR_SBA */
|
2006-12-30 03:25:47 +00:00
|
|
|
|
)
|
2005-08-04 15:45:56 +00:00
|
|
|
|
{
|
|
|
|
|
pt0 = (tr_fr_ptr) pt1;
|
|
|
|
|
goto failloop;
|
2006-12-30 03:25:47 +00:00
|
|
|
|
} else
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#endif /* FROZEN_STACKS */
|
2011-07-22 04:09:33 -07:00
|
|
|
|
if (IN_BETWEEN(H0,pt1,H)) {
|
|
|
|
|
if (IsAttVar(pt1)) {
|
|
|
|
|
goto failloop;
|
|
|
|
|
} else if (*pt1 == (CELL)FunctorBigInt) {
|
|
|
|
|
Yap_CleanOpaqueVariable(pt1);
|
|
|
|
|
}
|
|
|
|
|
}
|
2011-04-16 00:31:25 +01:00
|
|
|
|
#ifdef FROZEN_STACKS /* TRAIL */
|
|
|
|
|
/* don't reset frozen variables */
|
|
|
|
|
if (pt0 < TR_FZ)
|
|
|
|
|
goto failloop;
|
|
|
|
|
#endif
|
2003-08-23 19:26:08 +00:00
|
|
|
|
flags = *pt1;
|
2011-04-14 18:51:11 +01:00
|
|
|
|
#if MULTIPLE_STACKS
|
2003-12-27 00:38:53 +00:00
|
|
|
|
if (FlagOn(DBClMask, flags)) {
|
|
|
|
|
DBRef dbr = DBStructFlagsToDBStruct(pt1);
|
|
|
|
|
int erase;
|
|
|
|
|
|
|
|
|
|
LOCK(dbr->lock);
|
|
|
|
|
DEC_DBREF_COUNT(dbr);
|
|
|
|
|
erase = (dbr->Flags & ErasedMask) && (dbr->ref_count == 0);
|
|
|
|
|
UNLOCK(dbr->lock);
|
|
|
|
|
if (erase) {
|
|
|
|
|
saveregs();
|
|
|
|
|
Yap_ErDBE(dbr);
|
|
|
|
|
setregs();
|
|
|
|
|
}
|
|
|
|
|
} else {
|
2003-04-30 17:46:05 +00:00
|
|
|
|
if (flags & LogUpdMask) {
|
2003-12-27 00:38:53 +00:00
|
|
|
|
if (flags & IndexMask) {
|
|
|
|
|
LogUpdIndex *cl = ClauseFlagsToLogUpdIndex(pt1);
|
|
|
|
|
int erase;
|
2011-04-14 18:51:11 +01:00
|
|
|
|
#if PARALLEL_YAP
|
2007-11-26 23:43:10 +00:00
|
|
|
|
PredEntry *ap = cl->ClPred;
|
2011-04-14 18:51:11 +01:00
|
|
|
|
#endif
|
2003-12-27 00:38:53 +00:00
|
|
|
|
|
2010-07-25 11:22:16 +01:00
|
|
|
|
PELOCK(8,ap);
|
2003-12-27 00:38:53 +00:00
|
|
|
|
DEC_CLREF_COUNT(cl);
|
|
|
|
|
erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount);
|
|
|
|
|
if (erase) {
|
|
|
|
|
saveregs();
|
|
|
|
|
/* at this point,
|
|
|
|
|
we are the only ones accessing the clause,
|
|
|
|
|
hence we don't need to have a lock it */
|
2006-10-10 14:08:17 +00:00
|
|
|
|
Yap_ErLogUpdIndex(cl);
|
|
|
|
|
setregs();
|
|
|
|
|
} else if (cl->ClFlags & DirtyMask) {
|
|
|
|
|
saveregs();
|
|
|
|
|
/* at this point,
|
|
|
|
|
we are the only ones accessing the clause,
|
|
|
|
|
hence we don't need to have a lock it */
|
|
|
|
|
Yap_CleanUpIndex(cl);
|
2003-12-27 00:38:53 +00:00
|
|
|
|
setregs();
|
|
|
|
|
}
|
2007-11-26 23:43:10 +00:00
|
|
|
|
UNLOCK(ap->PELock);
|
2003-12-27 00:38:53 +00:00
|
|
|
|
} else {
|
|
|
|
|
LogUpdClause *cl = ClauseFlagsToLogUpdClause(pt1);
|
|
|
|
|
int erase;
|
2011-04-14 18:51:11 +01:00
|
|
|
|
#if PARALLEL_YAP
|
2007-11-26 23:43:10 +00:00
|
|
|
|
PredEntry *ap = cl->ClPred;
|
2011-04-14 18:51:11 +01:00
|
|
|
|
#endif
|
2003-12-27 00:38:53 +00:00
|
|
|
|
|
2010-07-25 11:22:16 +01:00
|
|
|
|
PELOCK(9,ap);
|
2003-12-27 00:38:53 +00:00
|
|
|
|
DEC_CLREF_COUNT(cl);
|
|
|
|
|
erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount);
|
|
|
|
|
if (erase) {
|
|
|
|
|
saveregs();
|
|
|
|
|
/* at this point,
|
|
|
|
|
we are the only ones accessing the clause,
|
|
|
|
|
hence we don't need to have a lock it */
|
|
|
|
|
Yap_ErLogUpdCl(cl);
|
|
|
|
|
setregs();
|
|
|
|
|
}
|
2007-11-26 23:43:10 +00:00
|
|
|
|
UNLOCK(ap->PELock);
|
2003-12-18 17:23:22 +00:00
|
|
|
|
}
|
2003-04-30 17:46:05 +00:00
|
|
|
|
} else {
|
2003-08-23 19:26:08 +00:00
|
|
|
|
DynamicClause *cl = ClauseFlagsToDynamicClause(pt1);
|
2003-04-30 17:46:05 +00:00
|
|
|
|
int erase;
|
2012-10-17 17:22:43 +01:00
|
|
|
|
|
2003-04-30 17:46:05 +00:00
|
|
|
|
LOCK(cl->ClLock);
|
|
|
|
|
DEC_CLREF_COUNT(cl);
|
2003-12-18 17:23:22 +00:00
|
|
|
|
erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount);
|
2003-04-30 17:46:05 +00:00
|
|
|
|
UNLOCK(cl->ClLock);
|
|
|
|
|
if (erase) {
|
|
|
|
|
saveregs();
|
|
|
|
|
/* at this point,
|
|
|
|
|
we are the only ones accessing the clause,
|
|
|
|
|
hence we don't need to have a lock it */
|
|
|
|
|
Yap_ErCl(cl);
|
|
|
|
|
setregs();
|
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
#else
|
|
|
|
|
ResetFlag(InUseMask, flags);
|
2003-08-23 19:26:08 +00:00
|
|
|
|
*pt1 = flags;
|
2006-10-10 14:08:17 +00:00
|
|
|
|
if (FlagOn((ErasedMask|DirtyMask), flags)) {
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (FlagOn(DBClMask, flags)) {
|
|
|
|
|
saveregs();
|
2003-08-23 19:26:08 +00:00
|
|
|
|
Yap_ErDBE(DBStructFlagsToDBStruct(pt1));
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
|
|
|
|
} else {
|
|
|
|
|
saveregs();
|
2003-04-30 17:46:05 +00:00
|
|
|
|
if (flags & LogUpdMask) {
|
2003-10-14 00:53:10 +00:00
|
|
|
|
if (flags & IndexMask) {
|
2006-10-10 14:08:17 +00:00
|
|
|
|
if (FlagOn(ErasedMask, flags)) {
|
|
|
|
|
Yap_ErLogUpdIndex(ClauseFlagsToLogUpdIndex(pt1));
|
|
|
|
|
} else {
|
|
|
|
|
Yap_CleanUpIndex(ClauseFlagsToLogUpdIndex(pt1));
|
|
|
|
|
}
|
2003-10-14 00:53:10 +00:00
|
|
|
|
} else {
|
|
|
|
|
Yap_ErLogUpdCl(ClauseFlagsToLogUpdClause(pt1));
|
|
|
|
|
}
|
2003-04-30 17:46:05 +00:00
|
|
|
|
} else {
|
2003-08-23 19:26:08 +00:00
|
|
|
|
Yap_ErCl(ClauseFlagsToDynamicClause(pt1));
|
2003-04-30 17:46:05 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
#endif
|
|
|
|
|
goto failloop;
|
|
|
|
|
}
|
|
|
|
|
#ifdef MULTI_ASSIGNMENT_VARIABLES
|
|
|
|
|
else /* if (IsApplTerm(d1)) */ {
|
|
|
|
|
CELL *pt = RepAppl(d1);
|
|
|
|
|
/* AbsAppl means */
|
|
|
|
|
/* multi-assignment variable */
|
|
|
|
|
/* so the next cell is the old value */
|
2005-08-12 17:00:00 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
2009-05-01 11:53:59 -05:00
|
|
|
|
--pt0;
|
|
|
|
|
pt[0] = TrailVal(pt0);
|
2001-07-04 16:48:54 +00:00
|
|
|
|
#else
|
2004-04-14 19:10:40 +00:00
|
|
|
|
pt[0] = TrailTerm(pt0-1);
|
2004-03-19 11:35:42 +00:00
|
|
|
|
pt0 -= 2;
|
2005-04-07 17:56:58 +00:00
|
|
|
|
#endif /* FROZEN_STACKS */
|
2001-04-09 19:54:03 +00:00
|
|
|
|
goto failloop;
|
|
|
|
|
}
|
|
|
|
|
#endif
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDCACHE_TR();
|
|
|
|
|
}
|
|
|
|
|
ENDPBOp();
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
/************************************************************************\
|
|
|
|
|
* Cut & Commit Instructions *
|
|
|
|
|
\************************************************************************/
|
|
|
|
|
|
|
|
|
|
/* cut */
|
2011-02-14 06:57:16 -08:00
|
|
|
|
Op(cut, s);
|
2010-12-29 09:29:42 -06:00
|
|
|
|
#ifdef COROUTINING
|
2010-12-31 12:01:10 -06:00
|
|
|
|
if (FALSE) {
|
|
|
|
|
CACHE_Y_AS_ENV(YREG);
|
|
|
|
|
check_stack(NoStackCut, H);
|
|
|
|
|
ENDCACHE_Y_AS_ENV();
|
|
|
|
|
}
|
2010-12-29 09:29:42 -06:00
|
|
|
|
do_cut:
|
|
|
|
|
#endif
|
2011-02-14 11:29:20 -08:00
|
|
|
|
SET_ASP(YREG, PREG->u.s.s);
|
2011-02-14 06:57:16 -08:00
|
|
|
|
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, s),Osbpp),l);
|
2011-02-14 11:29:20 -08:00
|
|
|
|
/* assume cut is always in stack */
|
2011-02-15 18:14:18 +00:00
|
|
|
|
saveregs();
|
2012-12-13 18:12:50 +00:00
|
|
|
|
prune((choiceptr)YREG[E_CB] PASS_REGS);
|
2011-02-15 18:14:18 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
/* cut_t */
|
|
|
|
|
/* cut_t does the same as cut */
|
2011-02-14 06:57:16 -08:00
|
|
|
|
Op(cut_t, s);
|
2010-12-29 09:29:42 -06:00
|
|
|
|
#ifdef COROUTINING
|
2010-12-31 12:01:10 -06:00
|
|
|
|
if (FALSE) {
|
|
|
|
|
CACHE_Y_AS_ENV(YREG);
|
|
|
|
|
check_stack(NoStackCutT, H);
|
|
|
|
|
ENDCACHE_Y_AS_ENV();
|
|
|
|
|
}
|
2010-12-29 09:29:42 -06:00
|
|
|
|
do_cut_t:
|
|
|
|
|
#endif
|
2011-02-14 11:29:20 -08:00
|
|
|
|
SET_ASP(YREG, PREG->u.s.s);
|
|
|
|
|
/* assume cut is always in stack */
|
2011-02-15 18:14:18 +00:00
|
|
|
|
saveregs();
|
2012-12-13 18:12:50 +00:00
|
|
|
|
prune((choiceptr)YREG[E_CB] PASS_REGS);
|
2011-02-15 18:14:18 +00:00
|
|
|
|
setregs();
|
2011-02-14 06:57:16 -08:00
|
|
|
|
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, s),Osbpp),l);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
/* cut_e */
|
2011-02-14 06:57:16 -08:00
|
|
|
|
Op(cut_e, s);
|
2010-12-29 09:29:42 -06:00
|
|
|
|
#ifdef COROUTINING
|
2010-12-31 12:01:10 -06:00
|
|
|
|
if (FALSE) {
|
|
|
|
|
CACHE_Y_AS_ENV(YREG);
|
|
|
|
|
check_stack(NoStackCutE, H);
|
|
|
|
|
ENDCACHE_Y_AS_ENV();
|
|
|
|
|
}
|
2010-12-29 09:29:42 -06:00
|
|
|
|
do_cut_e:
|
|
|
|
|
#endif
|
2011-02-14 11:29:20 -08:00
|
|
|
|
SET_ASP(YREG, PREG->u.s.s);
|
2011-02-14 06:57:16 -08:00
|
|
|
|
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, s),Osbpp),l);
|
2011-02-15 18:14:18 +00:00
|
|
|
|
saveregs();
|
2012-12-13 18:12:50 +00:00
|
|
|
|
prune((choiceptr)SREG[E_CB] PASS_REGS);
|
2011-02-15 18:14:18 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
/* save_b_x Xi */
|
|
|
|
|
Op(save_b_x, x);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = PREG->u.x.x;
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#if defined(YAPOR_SBA) && defined(FROZEN_STACKS)
|
2001-04-09 19:54:03 +00:00
|
|
|
|
XREG(d0) = MkIntegerTerm((Int)B);
|
|
|
|
|
#else
|
2005-10-18 17:04:43 +00:00
|
|
|
|
XREG(d0) = MkIntegerTerm(LCL0-(CELL *) (B));
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#endif /* YAPOR_SBA && FROZEN_STACKS */
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = NEXTOP(PREG, x);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
/* save_b_y Yi */
|
|
|
|
|
Op(save_b_y, y);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
#if defined(YAPOR_SBA)
|
|
|
|
|
INITIALIZE_PERMVAR(YREG+PREG->u.y.y,MkIntegerTerm((Int)B));
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#else
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(YREG+PREG->u.y.y,MkIntegerTerm(LCL0-(CELL *)(B)));
|
|
|
|
|
#endif /* YAPOR_SBA*/
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = NEXTOP(PREG, y);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2003-12-27 00:38:53 +00:00
|
|
|
|
/* commit_b_x Xi */
|
2011-02-14 11:29:20 -08:00
|
|
|
|
Op(commit_b_x, xps);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifdef COROUTINING
|
2002-11-11 17:38:10 +00:00
|
|
|
|
CACHE_Y_AS_ENV(YREG);
|
2003-12-27 00:38:53 +00:00
|
|
|
|
check_stack(NoStackCommitX, H);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDCACHE_Y_AS_ENV();
|
2003-12-27 00:38:53 +00:00
|
|
|
|
do_commit_b_x:
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif
|
2011-02-14 11:29:20 -08:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = XREG(PREG->u.xps.x);
|
|
|
|
|
deref_head(d0, commit_b_x_unk);
|
|
|
|
|
commit_b_x_nvar:
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* skip a void call and a label */
|
2011-02-14 11:29:20 -08:00
|
|
|
|
SET_ASP(YREG, PREG->u.xps.s);
|
|
|
|
|
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xps),Osbpp),l);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
{
|
|
|
|
|
choiceptr pt0;
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#if defined(YAPOR_SBA) && defined(FROZEN_STACKS)
|
2001-04-09 19:54:03 +00:00
|
|
|
|
pt0 = (choiceptr)IntegerOfTerm(d0);
|
|
|
|
|
#else
|
2005-10-18 17:04:43 +00:00
|
|
|
|
pt0 = (choiceptr)(LCL0-IntegerOfTerm(d0));
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#endif /* YAPOR_SBA && FROZEN_STACKS */
|
2011-02-15 18:14:18 +00:00
|
|
|
|
saveregs();
|
2012-12-13 18:12:50 +00:00
|
|
|
|
prune(pt0 PASS_REGS);
|
2011-02-15 18:14:18 +00:00
|
|
|
|
setregs();
|
2005-11-18 18:52:41 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
2011-02-14 11:29:20 -08:00
|
|
|
|
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
deref_body(d0, pt1, commit_b_x_unk, commit_b_x_nvar);
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
/* never cut to a variable */
|
|
|
|
|
/* Abort */
|
|
|
|
|
FAIL();
|
|
|
|
|
ENDD(d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDOp();
|
|
|
|
|
|
2003-12-27 00:38:53 +00:00
|
|
|
|
/* commit_b_y Yi */
|
2011-02-14 11:29:20 -08:00
|
|
|
|
Op(commit_b_y, yps);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifdef COROUTINING
|
2002-11-11 17:38:10 +00:00
|
|
|
|
CACHE_Y_AS_ENV(YREG);
|
2003-12-27 00:38:53 +00:00
|
|
|
|
check_stack(NoStackCommitY, H);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDCACHE_Y_AS_ENV();
|
2003-12-27 00:38:53 +00:00
|
|
|
|
do_commit_b_y:
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif
|
2011-02-14 11:29:20 -08:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = YREG[PREG->u.yps.y];
|
|
|
|
|
deref_head(d0, commit_b_y_unk);
|
|
|
|
|
commit_b_y_nvar:
|
|
|
|
|
SET_ASP(YREG, PREG->u.yps.s);
|
|
|
|
|
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, yps),Osbpp),l);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
{
|
|
|
|
|
choiceptr pt0;
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#if defined(YAPOR_SBA) && defined(FROZEN_STACKS)
|
2001-04-09 19:54:03 +00:00
|
|
|
|
pt0 = (choiceptr)IntegerOfTerm(d0);
|
|
|
|
|
#else
|
2005-10-18 17:04:43 +00:00
|
|
|
|
pt0 = (choiceptr)(LCL0-IntegerOfTerm(d0));
|
2011-02-14 11:29:20 -08:00
|
|
|
|
#endif
|
2011-02-15 18:14:18 +00:00
|
|
|
|
saveregs();
|
2012-12-13 18:12:50 +00:00
|
|
|
|
prune(pt0 PASS_REGS);
|
2011-02-15 18:14:18 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
GONext();
|
2011-02-14 11:29:20 -08:00
|
|
|
|
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
deref_body(d0, pt1, commit_b_y_unk, commit_b_y_nvar);
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
/* never cut to a variable */
|
|
|
|
|
/* Abort */
|
|
|
|
|
FAIL();
|
|
|
|
|
ENDD(d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
/*************************************************************************
|
|
|
|
|
* Call / Proceed instructions *
|
|
|
|
|
*************************************************************************/
|
|
|
|
|
|
|
|
|
|
/* Macros for stack trimming */
|
|
|
|
|
|
|
|
|
|
/* execute Label */
|
2005-12-17 03:25:39 +00:00
|
|
|
|
BOp(execute, pp);
|
2002-12-27 16:53:09 +00:00
|
|
|
|
{
|
|
|
|
|
PredEntry *pt0;
|
|
|
|
|
CACHE_Y_AS_ENV(YREG);
|
2005-12-17 03:25:39 +00:00
|
|
|
|
pt0 = PREG->u.pp.p;
|
2003-08-23 19:26:08 +00:00
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
|
|
|
|
if (Yap_do_low_level_trace) {
|
|
|
|
|
low_level_trace(enter_pred,pt0,XREGS+1);
|
|
|
|
|
}
|
|
|
|
|
#endif /* LOW_LEVEL_TRACE */
|
2002-12-27 16:53:09 +00:00
|
|
|
|
CACHE_A1();
|
|
|
|
|
ALWAYS_LOOKAHEAD(pt0->OpcodeOfPred);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = (CELL)B;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifndef NO_CHECKING
|
2002-12-27 16:53:09 +00:00
|
|
|
|
check_stack(NoStackExecute, H);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif
|
2002-12-27 16:53:09 +00:00
|
|
|
|
PREG = pt0->CodeOfPred;
|
2005-12-23 00:20:14 +00:00
|
|
|
|
/* for profiler */
|
|
|
|
|
save_pc();
|
2005-10-28 17:38:50 +00:00
|
|
|
|
ENV_YREG[E_CB] = d0;
|
2002-12-27 16:53:09 +00:00
|
|
|
|
ENDD(d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifdef DEPTH_LIMIT
|
2002-12-27 16:53:09 +00:00
|
|
|
|
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is prolog */
|
|
|
|
|
if (pt0->ModuleOfPred) {
|
|
|
|
|
if (DEPTH == MkIntTerm(0))
|
|
|
|
|
FAIL();
|
|
|
|
|
else DEPTH = RESET_DEPTH();
|
|
|
|
|
}
|
|
|
|
|
} else if (pt0->ModuleOfPred)
|
|
|
|
|
DEPTH -= MkIntConstant(2);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif /* DEPTH_LIMIT */
|
|
|
|
|
/* this is the equivalent to setting up the stack */
|
2002-12-27 16:53:09 +00:00
|
|
|
|
ALWAYS_GONext();
|
|
|
|
|
ALWAYS_END_PREFETCH();
|
|
|
|
|
ENDCACHE_Y_AS_ENV();
|
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
NoStackExecute:
|
2012-03-09 11:46:34 +00:00
|
|
|
|
CHECK_ALARM(JMPNext());
|
2005-12-17 03:25:39 +00:00
|
|
|
|
SREG = (CELL *) PREG->u.pp.p;
|
2008-08-30 02:39:36 +01:00
|
|
|
|
PP = PREG->u.pp.p0;
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (LOCAL_ActiveSignals & YAP_CDOVF_SIGNAL) {
|
2011-02-14 11:29:20 -08:00
|
|
|
|
SET_ASP(YREG, E_CB*sizeof(CELL));
|
2011-01-20 11:53:00 -06:00
|
|
|
|
SREG = YENV;
|
2003-08-23 19:26:08 +00:00
|
|
|
|
goto noheapleft;
|
|
|
|
|
}
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (LOCAL_ActiveSignals)
|
2001-04-09 19:54:03 +00:00
|
|
|
|
goto creep;
|
|
|
|
|
else
|
|
|
|
|
goto NoStackExec;
|
|
|
|
|
|
|
|
|
|
/* dexecute Label */
|
2008-08-28 04:43:00 +01:00
|
|
|
|
/* joint deallocate and execute */
|
2005-12-17 03:25:39 +00:00
|
|
|
|
BOp(dexecute, pp);
|
2003-08-23 19:26:08 +00:00
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
|
|
|
|
if (Yap_do_low_level_trace)
|
2005-12-17 03:25:39 +00:00
|
|
|
|
low_level_trace(enter_pred,PREG->u.pp.p,XREGS+1);
|
2003-08-23 19:26:08 +00:00
|
|
|
|
#endif /* LOW_LEVEL_TRACER */
|
|
|
|
|
CACHE_Y_AS_ENV(YREG);
|
2002-12-27 16:53:09 +00:00
|
|
|
|
{
|
|
|
|
|
PredEntry *pt0;
|
|
|
|
|
|
|
|
|
|
CACHE_A1();
|
2005-12-17 03:25:39 +00:00
|
|
|
|
pt0 = PREG->u.pp.p;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifndef NO_CHECKING
|
2002-12-27 16:53:09 +00:00
|
|
|
|
/* check stacks */
|
|
|
|
|
check_stack(NoStackDExecute, H);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif
|
|
|
|
|
#ifdef DEPTH_LIMIT
|
2002-12-27 16:53:09 +00:00
|
|
|
|
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is primitives */
|
|
|
|
|
if (pt0->ModuleOfPred) {
|
|
|
|
|
if (DEPTH == MkIntTerm(0))
|
|
|
|
|
FAIL();
|
|
|
|
|
else DEPTH = RESET_DEPTH();
|
|
|
|
|
}
|
|
|
|
|
} else if (pt0->ModuleOfPred)
|
|
|
|
|
DEPTH -= MkIntConstant(2);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif /* DEPTH_LIMIT */
|
2002-12-27 16:53:09 +00:00
|
|
|
|
PREG = pt0->CodeOfPred;
|
2005-12-23 00:20:14 +00:00
|
|
|
|
/* for profiler */
|
|
|
|
|
save_pc();
|
2002-12-27 16:53:09 +00:00
|
|
|
|
ALWAYS_LOOKAHEAD(pt0->OpcodeOfPred);
|
|
|
|
|
/* do deallocate */
|
2005-10-28 17:38:50 +00:00
|
|
|
|
CPREG = (yamop *) ENV_YREG[E_CP];
|
|
|
|
|
ENV_YREG = ENV = (CELL *) ENV_YREG[E_E];
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
2002-12-27 16:53:09 +00:00
|
|
|
|
{
|
|
|
|
|
choiceptr top_b = PROTECT_FROZEN_B(B);
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#ifdef YAPOR_SBA
|
2005-10-28 17:38:50 +00:00
|
|
|
|
if (ENV_YREG > (CELL *) top_b || ENV_YREG < H) ENV_YREG = (CELL *) top_b;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#else
|
2005-10-28 17:38:50 +00:00
|
|
|
|
if (ENV_YREG > (CELL *) top_b) ENV_YREG = (CELL *) top_b;
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#endif /* YAPOR_SBA */
|
2005-10-28 17:38:50 +00:00
|
|
|
|
else ENV_YREG = (CELL *)((CELL)ENV_YREG + ENV_Size(CPREG));
|
2002-12-27 16:53:09 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#else
|
2005-10-28 17:38:50 +00:00
|
|
|
|
if (ENV_YREG > (CELL *)B) {
|
|
|
|
|
ENV_YREG = (CELL *)B;
|
2002-12-27 16:53:09 +00:00
|
|
|
|
}
|
|
|
|
|
else {
|
2005-10-28 17:38:50 +00:00
|
|
|
|
ENV_YREG = (CELL *) ((CELL) ENV_YREG + ENV_Size(CPREG));
|
2002-12-27 16:53:09 +00:00
|
|
|
|
}
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#endif /* FROZEN_STACKS */
|
2002-12-27 16:53:09 +00:00
|
|
|
|
WRITEBACK_Y_AS_ENV();
|
|
|
|
|
/* setup GB */
|
2005-10-28 17:38:50 +00:00
|
|
|
|
ENV_YREG[E_CB] = (CELL) B;
|
2002-12-27 16:53:09 +00:00
|
|
|
|
ALWAYS_GONext();
|
|
|
|
|
ALWAYS_END_PREFETCH();
|
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDCACHE_Y_AS_ENV();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2008-09-05 05:22:19 +01:00
|
|
|
|
BOp(fcall, Osbpp);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
CACHE_Y_AS_ENV(YREG);
|
2005-10-28 17:38:50 +00:00
|
|
|
|
ENV_YREG[E_CP] = (CELL) CPREG;
|
|
|
|
|
ENV_YREG[E_E] = (CELL) ENV;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifdef DEPTH_LIMIT
|
2005-10-28 17:38:50 +00:00
|
|
|
|
ENV_YREG[E_DEPTH] = DEPTH;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif /* DEPTH_LIMIT */
|
|
|
|
|
ENDCACHE_Y_AS_ENV();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2008-09-05 05:22:19 +01:00
|
|
|
|
BOp(call, Osbpp);
|
2003-08-23 19:26:08 +00:00
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
2007-10-28 11:23:41 +00:00
|
|
|
|
if (Yap_do_low_level_trace) {
|
2008-09-05 05:22:19 +01:00
|
|
|
|
low_level_trace(enter_pred,PREG->u.Osbpp.p,XREGS+1);
|
2007-10-28 11:23:41 +00:00
|
|
|
|
}
|
2003-08-23 19:26:08 +00:00
|
|
|
|
#endif /* LOW_LEVEL_TRACER */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
CACHE_Y_AS_ENV(YREG);
|
2002-12-27 16:53:09 +00:00
|
|
|
|
{
|
|
|
|
|
PredEntry *pt;
|
2008-09-05 05:22:19 +01:00
|
|
|
|
pt = PREG->u.Osbpp.p;
|
2002-12-27 16:53:09 +00:00
|
|
|
|
CACHE_A1();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifndef NO_CHECKING
|
2002-12-27 16:53:09 +00:00
|
|
|
|
check_stack(NoStackCall, H);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif
|
2005-10-28 17:38:50 +00:00
|
|
|
|
ENV = ENV_YREG;
|
2002-12-27 16:53:09 +00:00
|
|
|
|
/* Try to preserve the environment */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
ENV_YREG = (CELL *) (((char *) ENV_YREG) + PREG->u.Osbpp.s);
|
|
|
|
|
CPREG = NEXTOP(PREG, Osbpp);
|
2002-12-27 16:53:09 +00:00
|
|
|
|
ALWAYS_LOOKAHEAD(pt->OpcodeOfPred);
|
|
|
|
|
PREG = pt->CodeOfPred;
|
2005-12-23 00:20:14 +00:00
|
|
|
|
/* for profiler */
|
|
|
|
|
save_pc();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifdef DEPTH_LIMIT
|
2003-11-18 19:22:26 +00:00
|
|
|
|
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is primitives */
|
|
|
|
|
if (pt->ModuleOfPred) {
|
|
|
|
|
if (DEPTH == MkIntTerm(0))
|
|
|
|
|
FAIL();
|
|
|
|
|
else DEPTH = RESET_DEPTH();
|
|
|
|
|
}
|
|
|
|
|
} else if (pt->ModuleOfPred)
|
|
|
|
|
DEPTH -= MkIntConstant(2);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif /* DEPTH_LIMIT */
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
2003-11-18 19:22:26 +00:00
|
|
|
|
{
|
|
|
|
|
choiceptr top_b = PROTECT_FROZEN_B(B);
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#ifdef YAPOR_SBA
|
2005-10-28 17:38:50 +00:00
|
|
|
|
if (ENV_YREG > (CELL *) top_b || ENV_YREG < H) ENV_YREG = (CELL *) top_b;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#else
|
2005-10-28 17:38:50 +00:00
|
|
|
|
if (ENV_YREG > (CELL *) top_b) ENV_YREG = (CELL *) top_b;
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#endif /* YAPOR_SBA */
|
2003-11-18 19:22:26 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#else
|
2005-10-28 17:38:50 +00:00
|
|
|
|
if (ENV_YREG > (CELL *) B) {
|
|
|
|
|
ENV_YREG = (CELL *) B;
|
2003-11-18 19:22:26 +00:00
|
|
|
|
}
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#endif /* FROZEN_STACKS */
|
2003-11-18 19:22:26 +00:00
|
|
|
|
WRITEBACK_Y_AS_ENV();
|
|
|
|
|
/* setup GB */
|
2005-10-28 17:38:50 +00:00
|
|
|
|
ENV_YREG[E_CB] = (CELL) B;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifdef YAPOR
|
2003-11-18 19:22:26 +00:00
|
|
|
|
SCH_check_requests();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif /* YAPOR */
|
2003-11-18 19:22:26 +00:00
|
|
|
|
ALWAYS_GONext();
|
|
|
|
|
ALWAYS_END_PREFETCH();
|
2002-12-27 16:53:09 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDCACHE_Y_AS_ENV();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
NoStackCall:
|
2012-03-09 11:46:34 +00:00
|
|
|
|
CHECK_ALARM(JMPNext());
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PP = PREG->u.Osbpp.p0;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* on X86 machines S will not actually be holding the pointer to pred */
|
2012-06-22 03:55:01 -05:00
|
|
|
|
if (LOCAL_ActiveSignals & (YAP_FAIL_SIGNAL|YAP_INT_SIGNAL)) {
|
|
|
|
|
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
|
|
|
|
|
Yap_Error(PURE_ABORT, TermNil, "abort from console");
|
|
|
|
|
}
|
|
|
|
|
LOCAL_ActiveSignals &= ~(YAP_FAIL_SIGNAL|YAP_INT_SIGNAL);
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (!LOCAL_ActiveSignals)
|
2010-12-04 18:45:09 +00:00
|
|
|
|
CreepFlag = CalculateStackGap();
|
|
|
|
|
goto fail;
|
|
|
|
|
}
|
2008-09-05 05:22:19 +01:00
|
|
|
|
SREG = (CELL *) PREG->u.Osbpp.p;
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (LOCAL_ActiveSignals & YAP_CDOVF_SIGNAL) {
|
2011-02-14 11:29:20 -08:00
|
|
|
|
SET_ASP(YREG, PREG->u.Osbpp.s);
|
2011-01-20 11:53:00 -06:00
|
|
|
|
SREG = YENV;
|
2002-03-08 06:33:16 +00:00
|
|
|
|
goto noheapleft;
|
|
|
|
|
}
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (LOCAL_ActiveSignals) {
|
2004-01-23 02:23:51 +00:00
|
|
|
|
goto creepc;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
2011-02-14 11:29:20 -08:00
|
|
|
|
SET_ASP(YREG, PREG->u.Osbpp.s);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
saveregs();
|
2008-09-05 05:22:19 +01:00
|
|
|
|
if (!Yap_gc(((PredEntry *)SREG)->ArityOfPE, YREG, NEXTOP(PREG, Osbpp))) {
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(OUT_OF_STACK_ERROR,LOCAL_ErrorMessage);
|
2002-10-10 05:58:49 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
|
|
|
|
|
|
|
|
|
JMPNext();
|
|
|
|
|
|
|
|
|
|
|
2003-10-06 14:33:48 +00:00
|
|
|
|
/* 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.
|
|
|
|
|
*/
|
|
|
|
|
NoStackDeallocate:
|
2012-03-09 11:46:34 +00:00
|
|
|
|
CHECK_ALARM(JMPNext());
|
2007-03-21 18:32:50 +00:00
|
|
|
|
{
|
|
|
|
|
CELL cut_b = LCL0-(CELL *)(SREG[E_CB]);
|
|
|
|
|
|
2012-06-22 03:55:01 -05:00
|
|
|
|
if (LOCAL_ActiveSignals & (YAP_FAIL_SIGNAL|YAP_INT_SIGNAL)) {
|
|
|
|
|
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
|
|
|
|
|
Yap_Error(PURE_ABORT, TermNil, "abort from console");
|
|
|
|
|
}
|
|
|
|
|
LOCAL_ActiveSignals &= ~(YAP_FAIL_SIGNAL|YAP_INT_SIGNAL);
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (!LOCAL_ActiveSignals)
|
2010-12-04 18:45:09 +00:00
|
|
|
|
CreepFlag = CalculateStackGap();
|
|
|
|
|
goto fail;
|
|
|
|
|
}
|
2008-08-28 04:43:00 +01:00
|
|
|
|
/*
|
|
|
|
|
don't do a creep here; also, if our instruction is followed by
|
|
|
|
|
a execute_c, just wait a bit more */
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if ( (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL &&
|
2010-12-19 13:52:42 +00:00
|
|
|
|
/* keep on going if there is something else */
|
2011-05-04 10:11:41 +01:00
|
|
|
|
!(LOCAL_ActiveSignals & ~YAP_CREEP_SIGNAL)) ||
|
2008-09-23 23:43:01 +01:00
|
|
|
|
(PREG->opc != Yap_opcode(_procceed) &&
|
|
|
|
|
PREG->opc != Yap_opcode(_cut_e))) {
|
2011-10-02 19:55:22 -03:00
|
|
|
|
JMPNext();
|
2010-10-11 20:10:12 +01:00
|
|
|
|
}
|
2011-03-11 19:47:21 +00:00
|
|
|
|
PP = PREVOP(PREG,p)->u.p.p;
|
2008-06-17 13:37:51 +00:00
|
|
|
|
ASP = YREG+E_CB;
|
2007-03-21 18:32:50 +00:00
|
|
|
|
/* cut_e */
|
|
|
|
|
if (SREG <= ASP) {
|
|
|
|
|
ASP = SREG-EnvSizeInCells;
|
|
|
|
|
}
|
2010-07-06 15:31:17 +01:00
|
|
|
|
if (ASP > (CELL *)PROTECT_FROZEN_B(B))
|
|
|
|
|
ASP = (CELL *)PROTECT_FROZEN_B(B);
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (LOCAL_ActiveSignals & YAP_CDOVF_SIGNAL) {
|
2007-03-21 18:32:50 +00:00
|
|
|
|
goto noheapleft;
|
|
|
|
|
}
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (LOCAL_ActiveSignals) {
|
2007-03-21 18:32:50 +00:00
|
|
|
|
if (Yap_op_from_opcode(PREG->opc) == _cut_e) {
|
|
|
|
|
/* followed by a cut */
|
|
|
|
|
ARG1 = MkIntegerTerm(LCL0-(CELL *)SREG[E_CB]);
|
|
|
|
|
SREG = (CELL *)RepPredProp(Yap_GetPredPropByFunc(FunctorCutBy,1));
|
|
|
|
|
} else {
|
|
|
|
|
SREG = (CELL *)RepPredProp(Yap_GetPredPropByAtom(AtomTrue,0));
|
|
|
|
|
}
|
|
|
|
|
goto creep;
|
|
|
|
|
}
|
|
|
|
|
saveregs();
|
|
|
|
|
if (!Yap_gc(0, ENV, CPREG)) {
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(OUT_OF_STACK_ERROR,LOCAL_ErrorMessage);
|
2007-03-21 18:32:50 +00:00
|
|
|
|
}
|
|
|
|
|
setregs();
|
|
|
|
|
SREG = ASP;
|
|
|
|
|
SREG[E_CB] = (CELL)(LCL0-cut_b);
|
2003-10-06 14:33:48 +00:00
|
|
|
|
}
|
|
|
|
|
JMPNext();
|
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifdef COROUTINING
|
|
|
|
|
|
2010-12-29 09:29:42 -06:00
|
|
|
|
/* This is easier: I know there is an environment so I cannot do allocate */
|
|
|
|
|
NoStackCut:
|
2012-03-09 11:46:34 +00:00
|
|
|
|
CHECK_ALARM(goto do_cut);
|
2010-12-29 09:29:42 -06:00
|
|
|
|
/* find something to fool S */
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (!LOCAL_ActiveSignals || LOCAL_ActiveSignals & YAP_CDOVF_SIGNAL) {
|
2010-12-29 09:29:42 -06:00
|
|
|
|
goto do_cut;
|
|
|
|
|
}
|
2012-06-22 03:55:01 -05:00
|
|
|
|
if (LOCAL_ActiveSignals & (YAP_FAIL_SIGNAL|YAP_INT_SIGNAL)) {
|
|
|
|
|
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
|
|
|
|
|
Yap_Error(PURE_ABORT, TermNil, "abort from console");
|
|
|
|
|
}
|
|
|
|
|
LOCAL_ActiveSignals &= ~(YAP_FAIL_SIGNAL|YAP_INT_SIGNAL);
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (!LOCAL_ActiveSignals)
|
2010-12-29 09:29:42 -06:00
|
|
|
|
CreepFlag = CalculateStackGap();
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (!(LOCAL_ActiveSignals & YAP_CREEP_SIGNAL)) {
|
2010-12-29 09:29:42 -06:00
|
|
|
|
SREG = (CELL *)PredRestoreRegs;
|
|
|
|
|
XREGS[0] = MkIntegerTerm(LCL0-(CELL *)YREG[E_CB]);
|
|
|
|
|
PREG = NEXTOP(PREG,e);
|
|
|
|
|
goto creep_either;
|
|
|
|
|
}
|
|
|
|
|
/* don't do debugging and friends here */
|
|
|
|
|
goto do_cut;
|
|
|
|
|
|
|
|
|
|
NoStackCutT:
|
2012-03-09 11:46:34 +00:00
|
|
|
|
CHECK_ALARM(goto do_cut_t);
|
2010-12-29 09:29:42 -06:00
|
|
|
|
/* find something to fool S */
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (!LOCAL_ActiveSignals || LOCAL_ActiveSignals & YAP_CDOVF_SIGNAL) {
|
2010-12-29 09:29:42 -06:00
|
|
|
|
goto do_cut_t;
|
|
|
|
|
}
|
2012-06-22 03:55:01 -05:00
|
|
|
|
if (LOCAL_ActiveSignals & (YAP_FAIL_SIGNAL|YAP_INT_SIGNAL)) {
|
|
|
|
|
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
|
|
|
|
|
Yap_Error(PURE_ABORT, TermNil, "abort from console");
|
|
|
|
|
}
|
|
|
|
|
LOCAL_ActiveSignals &= ~(YAP_FAIL_SIGNAL|YAP_INT_SIGNAL);
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (!LOCAL_ActiveSignals)
|
2010-12-29 09:29:42 -06:00
|
|
|
|
CreepFlag = CalculateStackGap();
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (!(LOCAL_ActiveSignals & YAP_CREEP_SIGNAL)) {
|
2010-12-29 09:29:42 -06:00
|
|
|
|
SREG = (CELL *)PredRestoreRegs;
|
2010-12-31 12:01:10 -06:00
|
|
|
|
XREGS[0] = MkIntegerTerm(LCL0-(CELL *)SREG[E_CB]);
|
2010-12-29 09:29:42 -06:00
|
|
|
|
PREG = NEXTOP(PREG,e);
|
|
|
|
|
goto creep_either;
|
|
|
|
|
}
|
|
|
|
|
/* don't do debugging and friends here */
|
|
|
|
|
goto do_cut_t;
|
|
|
|
|
|
|
|
|
|
NoStackCutE:
|
2012-03-09 11:46:34 +00:00
|
|
|
|
CHECK_ALARM(goto do_cut_e);
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (!LOCAL_ActiveSignals || LOCAL_ActiveSignals & YAP_CDOVF_SIGNAL) {
|
2012-03-09 11:46:34 +00:00
|
|
|
|
goto do_cut_e;
|
2010-12-29 09:29:42 -06:00
|
|
|
|
}
|
2012-06-22 03:55:01 -05:00
|
|
|
|
if (LOCAL_ActiveSignals & (YAP_FAIL_SIGNAL|YAP_INT_SIGNAL)) {
|
|
|
|
|
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
|
|
|
|
|
Yap_Error(PURE_ABORT, TermNil, "abort from console");
|
|
|
|
|
}
|
|
|
|
|
LOCAL_ActiveSignals &= ~(YAP_FAIL_SIGNAL|YAP_INT_SIGNAL);
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (!LOCAL_ActiveSignals)
|
2010-12-29 09:29:42 -06:00
|
|
|
|
CreepFlag = CalculateStackGap();
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (!(LOCAL_ActiveSignals & YAP_CREEP_SIGNAL)) {
|
2010-12-29 09:29:42 -06:00
|
|
|
|
SREG = (CELL *)PredRestoreRegs;
|
|
|
|
|
XREGS[0] = MkIntegerTerm(LCL0-(CELL *)SREG[E_CB]);
|
|
|
|
|
PREG = NEXTOP(PREG,e);
|
|
|
|
|
goto creep_either;
|
|
|
|
|
}
|
|
|
|
|
/* don't do debugging and friends here */
|
|
|
|
|
goto do_cut_e;
|
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* This is easier: I know there is an environment so I cannot do allocate */
|
2003-12-27 00:38:53 +00:00
|
|
|
|
NoStackCommitY:
|
2012-03-09 11:46:34 +00:00
|
|
|
|
CHECK_ALARM(goto do_commit_b_y);
|
2011-02-14 11:29:20 -08:00
|
|
|
|
PP = PREG->u.yps.p0;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* find something to fool S */
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (!LOCAL_ActiveSignals || LOCAL_ActiveSignals & YAP_CDOVF_SIGNAL) {
|
2004-01-26 12:41:06 +00:00
|
|
|
|
goto do_commit_b_y;
|
|
|
|
|
}
|
2012-06-22 03:55:01 -05:00
|
|
|
|
if (LOCAL_ActiveSignals & (YAP_FAIL_SIGNAL|YAP_INT_SIGNAL)) {
|
|
|
|
|
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
|
|
|
|
|
Yap_Error(PURE_ABORT, TermNil, "abort from console");
|
|
|
|
|
}
|
|
|
|
|
LOCAL_ActiveSignals &= ~(YAP_FAIL_SIGNAL|YAP_INT_SIGNAL);
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (!LOCAL_ActiveSignals)
|
2010-12-04 18:45:09 +00:00
|
|
|
|
CreepFlag = CalculateStackGap();
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (!(LOCAL_ActiveSignals & YAP_CREEP_SIGNAL)) {
|
2010-12-29 09:29:42 -06:00
|
|
|
|
SREG = (CELL *)PredRestoreRegs;
|
2011-02-14 11:29:20 -08:00
|
|
|
|
XREGS[0] = YREG[PREG->u.yps.y];
|
|
|
|
|
PREG = NEXTOP(PREG,yps);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
goto creep_either;
|
|
|
|
|
}
|
|
|
|
|
/* don't do debugging and friends here */
|
2003-12-27 00:38:53 +00:00
|
|
|
|
goto do_commit_b_y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
/* Problem: have I got an environment or not? */
|
2003-12-27 00:38:53 +00:00
|
|
|
|
NoStackCommitX:
|
2012-03-09 11:46:34 +00:00
|
|
|
|
CHECK_ALARM(goto do_commit_b_x);
|
2011-02-14 11:29:20 -08:00
|
|
|
|
PP = PREG->u.xps.p0;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* find something to fool S */
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (!LOCAL_ActiveSignals || LOCAL_ActiveSignals & YAP_CDOVF_SIGNAL) {
|
2004-01-26 12:41:06 +00:00
|
|
|
|
goto do_commit_b_x;
|
|
|
|
|
}
|
2012-06-22 03:55:01 -05:00
|
|
|
|
if (LOCAL_ActiveSignals & (YAP_FAIL_SIGNAL|YAP_INT_SIGNAL)) {
|
|
|
|
|
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
|
|
|
|
|
Yap_Error(PURE_ABORT, TermNil, "abort from console");
|
|
|
|
|
}
|
|
|
|
|
LOCAL_ActiveSignals &= ~(YAP_FAIL_SIGNAL|YAP_INT_SIGNAL);
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (!LOCAL_ActiveSignals)
|
2010-12-04 18:45:09 +00:00
|
|
|
|
CreepFlag = CalculateStackGap();
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (!(LOCAL_ActiveSignals & YAP_CREEP_SIGNAL)) {
|
2010-12-29 09:29:42 -06:00
|
|
|
|
SREG = (CELL *)PredRestoreRegs;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#if USE_THREADED_CODE
|
|
|
|
|
if (PREG->opc == (OPCODE)OpAddress[_fcall])
|
|
|
|
|
#else
|
|
|
|
|
if (PREG->opc == _fcall)
|
|
|
|
|
#endif
|
|
|
|
|
{
|
|
|
|
|
/* fill it up */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
CACHE_Y_AS_ENV(YREG);
|
2005-10-28 17:38:50 +00:00
|
|
|
|
ENV_YREG[E_CP] = (CELL) CPREG;
|
|
|
|
|
ENV_YREG[E_E] = (CELL) ENV;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifdef DEPTH_LIMIT
|
2005-10-28 17:38:50 +00:00
|
|
|
|
ENV_YREG[E_DEPTH] = DEPTH;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif /* DEPTH_LIMIT */
|
|
|
|
|
ENDCACHE_Y_AS_ENV();
|
|
|
|
|
}
|
2011-02-14 11:29:20 -08:00
|
|
|
|
XREGS[0] = XREG(PREG->u.xps.x);
|
|
|
|
|
PREG = NEXTOP(PREG,xps);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
goto creep_either;
|
|
|
|
|
}
|
|
|
|
|
/* don't do debugging and friends here */
|
2003-12-27 00:38:53 +00:00
|
|
|
|
goto do_commit_b_x;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
2006-12-31 01:50:35 +00:00
|
|
|
|
/* Problem: have I got an environment or not? */
|
|
|
|
|
NoStackFail:
|
2012-03-09 11:46:34 +00:00
|
|
|
|
CHECK_ALARM(goto fail);
|
2012-06-22 03:55:01 -05:00
|
|
|
|
if (LOCAL_ActiveSignals & (YAP_FAIL_SIGNAL|YAP_INT_SIGNAL)) {
|
|
|
|
|
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
|
|
|
|
|
Yap_Error(PURE_ABORT, TermNil, "abort from console");
|
|
|
|
|
}
|
|
|
|
|
LOCAL_ActiveSignals &= ~(YAP_FAIL_SIGNAL|YAP_INT_SIGNAL);
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (!LOCAL_ActiveSignals)
|
2010-12-04 18:45:09 +00:00
|
|
|
|
CreepFlag = CalculateStackGap();
|
|
|
|
|
/* we're happy */
|
|
|
|
|
goto fail;
|
|
|
|
|
}
|
2006-12-31 01:50:35 +00:00
|
|
|
|
/* find something to fool S */
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (!LOCAL_ActiveSignals || LOCAL_ActiveSignals & (YAP_CDOVF_SIGNAL)) {
|
2006-12-31 01:50:35 +00:00
|
|
|
|
goto fail;
|
|
|
|
|
}
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (!(LOCAL_ActiveSignals & YAP_CREEP_SIGNAL)) {
|
2006-12-31 01:50:35 +00:00
|
|
|
|
SREG = (CELL *)RepPredProp(Yap_GetPredPropByAtom(AtomFail,0));
|
2009-05-04 18:11:43 -05:00
|
|
|
|
/* make sure we have the correct environment for continuation */
|
|
|
|
|
ENV = B->cp_env;
|
2009-06-16 21:20:35 -05:00
|
|
|
|
YREG = (CELL *)B;
|
2006-12-31 01:50:35 +00:00
|
|
|
|
goto creep;
|
|
|
|
|
}
|
|
|
|
|
/* don't do debugging and friends here */
|
|
|
|
|
goto fail;
|
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* don't forget I cannot creep at ; */
|
|
|
|
|
NoStackEither:
|
2012-03-09 11:46:34 +00:00
|
|
|
|
CHECK_ALARM(goto either_notest);
|
2012-06-22 03:55:01 -05:00
|
|
|
|
if (LOCAL_ActiveSignals & (YAP_FAIL_SIGNAL|YAP_INT_SIGNAL)) {
|
|
|
|
|
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
|
|
|
|
|
Yap_Error(PURE_ABORT, TermNil, "abort from console");
|
|
|
|
|
}
|
|
|
|
|
LOCAL_ActiveSignals &= ~(YAP_FAIL_SIGNAL|YAP_INT_SIGNAL);
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (!LOCAL_ActiveSignals)
|
2010-12-04 18:45:09 +00:00
|
|
|
|
CreepFlag = CalculateStackGap();
|
|
|
|
|
goto fail;
|
|
|
|
|
}
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PP = PREG->u.Osblp.p0;
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL) {
|
2004-01-23 02:23:51 +00:00
|
|
|
|
goto either_notest;
|
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* find something to fool S */
|
2008-12-23 01:53:52 +00:00
|
|
|
|
SREG = (CELL *)RepPredProp(Yap_GetPredPropByFunc(FunctorRestoreRegs1,0));
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (LOCAL_ActiveSignals & YAP_CDOVF_SIGNAL) {
|
2011-02-14 11:29:20 -08:00
|
|
|
|
SET_ASP(YREG, PREG->u.Osbpp.s);
|
2011-01-20 11:53:00 -06:00
|
|
|
|
SREG = YENV;
|
2002-03-08 06:33:16 +00:00
|
|
|
|
goto noheapleft;
|
|
|
|
|
}
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (LOCAL_ActiveSignals) {
|
2004-01-23 02:23:51 +00:00
|
|
|
|
goto creep_either;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
2008-09-05 05:22:19 +01:00
|
|
|
|
ASP = (CELL *) (((char *) YREG) + PREG->u.Osbpp.s);
|
2005-11-15 00:50:49 +00:00
|
|
|
|
if (ASP > (CELL *)PROTECT_FROZEN_B(B))
|
|
|
|
|
ASP = (CELL *)PROTECT_FROZEN_B(B);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
saveregs();
|
2008-09-05 05:22:19 +01:00
|
|
|
|
if (!Yap_gc(0, YREG, NEXTOP(PREG, Osbpp))) {
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(OUT_OF_STACK_ERROR,LOCAL_ErrorMessage);
|
2002-10-10 05:58:49 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
|
|
|
|
JMPNext();
|
|
|
|
|
|
|
|
|
|
creep_either: /* do creep in either */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
ENV = YREG;
|
2008-09-05 05:22:19 +01:00
|
|
|
|
CPREG = NEXTOP(PREG, Osbpp);
|
|
|
|
|
YREG = (CELL *) (((char *) YREG) + PREG->u.Osbpp.s);
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
2001-04-09 19:54:03 +00:00
|
|
|
|
{
|
|
|
|
|
choiceptr top_b = PROTECT_FROZEN_B(B);
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#ifdef YAPOR_SBA
|
2002-11-11 17:38:10 +00:00
|
|
|
|
if (YREG > (CELL *) top_b || YREG < H) YREG = (CELL *) top_b;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#else
|
2002-11-11 17:38:10 +00:00
|
|
|
|
if (YREG > (CELL *) top_b) YREG = (CELL *) top_b;
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#endif /* YAPOR_SBA */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
else YREG = YREG + ENV_Size(CPREG);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
#else
|
2002-11-11 17:38:10 +00:00
|
|
|
|
if (YREG > (CELL *) B)
|
|
|
|
|
YREG = (CELL *) B;
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#endif /* FROZEN_STACKS */
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* setup GB */
|
|
|
|
|
ARG1 = push_live_regs(CPREG);
|
|
|
|
|
/* ARG0 has an extra argument for suspended cuts */
|
|
|
|
|
ARG2 = XREGS[0];
|
2002-11-11 17:38:10 +00:00
|
|
|
|
YREG[E_CB] = (CELL) B;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
goto creep;
|
|
|
|
|
#endif
|
|
|
|
|
|
|
|
|
|
creepc: /* do creep in call */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
ENV = YREG;
|
2008-09-05 05:22:19 +01:00
|
|
|
|
CPREG = NEXTOP(PREG, Osbpp);
|
|
|
|
|
YREG = (CELL *) (((char *) YREG) + PREG->u.Osbpp.s);
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
2001-04-09 19:54:03 +00:00
|
|
|
|
{
|
|
|
|
|
choiceptr top_b = PROTECT_FROZEN_B(B);
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#ifdef YAPOR_SBA
|
2002-11-11 17:38:10 +00:00
|
|
|
|
if (YREG > (CELL *) top_b || YREG < H) YREG = (CELL *) top_b;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#else
|
2002-11-11 17:38:10 +00:00
|
|
|
|
if (YREG > (CELL *) top_b) YREG = (CELL *) top_b;
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#endif /* YAPOR_SBA */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
else YREG = YREG + ENV_Size(CPREG);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
#else
|
2002-11-11 17:38:10 +00:00
|
|
|
|
if (YREG > (CELL *) B)
|
|
|
|
|
YREG = (CELL *) B;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
else
|
|
|
|
|
/* I am not sure about this */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
YREG = YREG + ENV_Size(CPREG);
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#endif /* FROZEN_STACKS */
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* setup GB */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
YREG[E_CB] = (CELL) B;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
goto creep;
|
|
|
|
|
|
|
|
|
|
NoStackDExecute:
|
2012-03-09 11:46:34 +00:00
|
|
|
|
CHECK_ALARM(JMPNext());
|
2012-06-22 03:55:01 -05:00
|
|
|
|
if (LOCAL_ActiveSignals & (YAP_FAIL_SIGNAL|YAP_INT_SIGNAL)) {
|
|
|
|
|
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
|
|
|
|
|
Yap_Error(PURE_ABORT, TermNil, "abort from console");
|
|
|
|
|
}
|
|
|
|
|
LOCAL_ActiveSignals &= ~(YAP_FAIL_SIGNAL|YAP_INT_SIGNAL);
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (!LOCAL_ActiveSignals)
|
2010-12-04 18:45:09 +00:00
|
|
|
|
CreepFlag = CalculateStackGap();
|
|
|
|
|
goto fail;
|
|
|
|
|
}
|
2008-08-30 02:39:36 +01:00
|
|
|
|
PP = PREG->u.pp.p0;
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (LOCAL_ActiveSignals & YAP_CREEP_SIGNAL) {
|
2008-08-30 02:39:36 +01:00
|
|
|
|
PredEntry *ap = PREG->u.pp.p;
|
2003-08-23 19:26:08 +00:00
|
|
|
|
|
2012-10-19 18:10:48 +01:00
|
|
|
|
SREG = (CELL *) ap;
|
|
|
|
|
goto creepde;
|
2003-08-23 19:26:08 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* set SREG for next instructions */
|
2002-12-27 16:53:09 +00:00
|
|
|
|
SREG = (CELL *) PREG->u.p.p;
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (LOCAL_ActiveSignals & YAP_CDOVF_SIGNAL) {
|
2002-11-11 17:38:10 +00:00
|
|
|
|
ASP = YREG+E_CB;
|
2005-11-15 00:50:49 +00:00
|
|
|
|
if (ASP > (CELL *)PROTECT_FROZEN_B(B))
|
|
|
|
|
ASP = (CELL *)PROTECT_FROZEN_B(B);
|
2011-01-20 11:53:00 -06:00
|
|
|
|
SREG = YENV;
|
2002-03-08 06:33:16 +00:00
|
|
|
|
goto noheapleft;
|
|
|
|
|
}
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (LOCAL_ActiveSignals)
|
2001-04-09 19:54:03 +00:00
|
|
|
|
goto creepde;
|
2002-02-28 18:25:55 +00:00
|
|
|
|
/* try performing garbage collection */
|
|
|
|
|
|
2002-11-11 17:38:10 +00:00
|
|
|
|
ASP = YREG+E_CB;
|
2005-11-15 00:50:49 +00:00
|
|
|
|
if (ASP > (CELL *)PROTECT_FROZEN_B(B))
|
|
|
|
|
ASP = (CELL *)PROTECT_FROZEN_B(B);
|
2002-02-28 18:25:55 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
if (!Yap_gc(((PredEntry *)(SREG))->ArityOfPE, (CELL *)YREG[E_E], (yamop *)YREG[E_CP])) {
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(OUT_OF_STACK_ERROR,LOCAL_ErrorMessage);
|
2002-10-10 05:58:49 +00:00
|
|
|
|
}
|
2002-02-28 18:25:55 +00:00
|
|
|
|
setregs();
|
|
|
|
|
/* hopefully, gc will succeeded, and we will retry
|
|
|
|
|
* the instruction */
|
|
|
|
|
JMPNext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
NoStackExec:
|
|
|
|
|
|
2012-03-09 11:46:34 +00:00
|
|
|
|
CHECK_ALARM(JMPNext());
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* try performing garbage collection */
|
2012-06-22 03:55:01 -05:00
|
|
|
|
if (LOCAL_ActiveSignals & (YAP_FAIL_SIGNAL|YAP_INT_SIGNAL)) {
|
|
|
|
|
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
|
|
|
|
|
Yap_Error(PURE_ABORT, TermNil, "abort from console");
|
|
|
|
|
}
|
|
|
|
|
LOCAL_ActiveSignals &= ~(YAP_FAIL_SIGNAL|YAP_INT_SIGNAL);
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (!LOCAL_ActiveSignals)
|
2010-12-04 18:45:09 +00:00
|
|
|
|
CreepFlag = CalculateStackGap();
|
|
|
|
|
goto fail;
|
|
|
|
|
}
|
2002-11-11 17:38:10 +00:00
|
|
|
|
ASP = YREG+E_CB;
|
2005-11-15 00:50:49 +00:00
|
|
|
|
if (ASP > (CELL *)PROTECT_FROZEN_B(B))
|
|
|
|
|
ASP = (CELL *)PROTECT_FROZEN_B(B);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
if (!Yap_gc(((PredEntry *)(SREG))->ArityOfPE, ENV, CPREG)) {
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(OUT_OF_STACK_ERROR,LOCAL_ErrorMessage);
|
2002-10-10 05:58:49 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
|
|
|
|
/* hopefully, gc will succeeded, and we will retry
|
|
|
|
|
* the instruction */
|
|
|
|
|
JMPNext();
|
|
|
|
|
|
|
|
|
|
creepde:
|
|
|
|
|
/* first, deallocate */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
CPREG = (yamop *) YREG[E_CP];
|
|
|
|
|
ENV = YREG = (CELL *) YREG[E_E];
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifdef DEPTH_LIMIT
|
2002-11-11 17:38:10 +00:00
|
|
|
|
YREG[E_DEPTH] = DEPTH;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif /* DEPTH_LIMIT */
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
2001-04-09 19:54:03 +00:00
|
|
|
|
{
|
|
|
|
|
choiceptr top_b = PROTECT_FROZEN_B(B);
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#ifdef YAPOR_SBA
|
2002-11-11 17:38:10 +00:00
|
|
|
|
if (YREG > (CELL *) top_b || YREG < H) YREG = (CELL *) top_b;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#else
|
2002-11-11 17:38:10 +00:00
|
|
|
|
if (YREG > (CELL *) top_b) YREG = (CELL *) top_b;
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#endif /* YAPOR_SBA */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
else YREG = (CELL *) ((CELL)YREG + ENV_Size(CPREG));
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
#else
|
2002-11-11 17:38:10 +00:00
|
|
|
|
if (YREG > (CELL *) B) {
|
|
|
|
|
YREG = (CELL *) B;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
else {
|
2002-11-11 17:38:10 +00:00
|
|
|
|
YREG = (CELL *) ((CELL) YREG + ENV_Size(CPREG));
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#endif /* FROZEN_STACKS */
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* setup GB */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
YREG[E_CB] = (CELL) B;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
/* and now CREEP */
|
|
|
|
|
|
|
|
|
|
creep:
|
2012-06-22 03:55:01 -05:00
|
|
|
|
if (LOCAL_ActiveSignals & (YAP_FAIL_SIGNAL|YAP_INT_SIGNAL)) {
|
|
|
|
|
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
|
|
|
|
|
Yap_Error(PURE_ABORT, TermNil, "abort from console");
|
|
|
|
|
}
|
|
|
|
|
LOCAL_ActiveSignals &= ~(YAP_FAIL_SIGNAL|YAP_INT_SIGNAL);
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (!LOCAL_ActiveSignals)
|
2010-12-04 18:45:09 +00:00
|
|
|
|
CreepFlag = CalculateStackGap();
|
|
|
|
|
goto fail;
|
|
|
|
|
}
|
2008-03-26 14:37:08 +00:00
|
|
|
|
#if defined(_MSC_VER) || defined(__MINGW32__)
|
2002-02-12 18:24:21 +00:00
|
|
|
|
/* I need this for Windows and other systems where SIGINT
|
|
|
|
|
is not proceesed by same thread as absmi */
|
2011-05-04 10:11:41 +01:00
|
|
|
|
LOCK(LOCAL_SignalLock);
|
2011-05-25 16:40:36 +01:00
|
|
|
|
if (LOCAL_PrologMode & (AbortMode|InterruptMode)) {
|
2006-03-03 23:11:30 +00:00
|
|
|
|
CreepFlag = CalculateStackGap();
|
2011-05-04 10:11:41 +01:00
|
|
|
|
UNLOCK(LOCAL_SignalLock);
|
2004-01-23 02:23:51 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
2011-05-04 10:11:41 +01:00
|
|
|
|
UNLOCK(LOCAL_SignalLock);
|
2002-02-12 18:24:21 +00:00
|
|
|
|
#endif
|
2008-03-26 14:37:08 +00:00
|
|
|
|
#ifdef SHADOW_S
|
2004-01-23 02:23:51 +00:00
|
|
|
|
S = SREG;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif
|
2008-08-30 02:39:36 +01:00
|
|
|
|
/* tell whether we can creep or not, this is hard because we will
|
|
|
|
|
lose the info RSN
|
|
|
|
|
*/
|
2004-01-23 02:23:51 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = ((PredEntry *)(SREG))->ArityOfPE;
|
|
|
|
|
if (d0 == 0) {
|
|
|
|
|
H[1] = MkAtomTerm((Atom) ((PredEntry *)(SREG))->FunctorOfPred);
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
H[d0 + 2] = AbsAppl(H);
|
|
|
|
|
*H = (CELL) ((PredEntry *)(SREG))->FunctorOfPred;
|
|
|
|
|
H++;
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
pt1 = XREGS + 1;
|
|
|
|
|
for (; d0 > 0; --d0) {
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = pt1;
|
|
|
|
|
d1 = *pt0;
|
|
|
|
|
deref_head(d1, creep_unk);
|
|
|
|
|
creep_nonvar:
|
|
|
|
|
/* just copy it to the heap */
|
|
|
|
|
pt1++;
|
|
|
|
|
*H++ = d1;
|
|
|
|
|
continue;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
2004-01-23 02:23:51 +00:00
|
|
|
|
derefa_body(d1, pt0, creep_unk, creep_nonvar);
|
|
|
|
|
if (pt0 <= H) {
|
|
|
|
|
/* variable is safe */
|
|
|
|
|
*H++ = (CELL)pt0;
|
|
|
|
|
pt1++;
|
|
|
|
|
} else {
|
|
|
|
|
/* bind it, in case it is a local variable */
|
|
|
|
|
d1 = Unsigned(H);
|
|
|
|
|
RESET_VARIABLE(H);
|
|
|
|
|
pt1++;
|
|
|
|
|
H += 1;
|
|
|
|
|
Bind_Local(pt0, d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
2004-01-23 02:23:51 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
2004-01-23 02:23:51 +00:00
|
|
|
|
ENDP(pt1);
|
|
|
|
|
}
|
|
|
|
|
ENDD(d0);
|
2004-02-12 12:37:12 +00:00
|
|
|
|
H[0] = Yap_Module_Name((PredEntry *)SREG);
|
2004-01-23 02:23:51 +00:00
|
|
|
|
ARG1 = (Term) AbsPair(H);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
2004-01-23 02:23:51 +00:00
|
|
|
|
H += 2;
|
2011-05-04 10:11:41 +01:00
|
|
|
|
LOCK(LOCAL_SignalLock);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifdef COROUTINING
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (LOCAL_ActiveSignals & YAP_WAKEUP_SIGNAL) {
|
2008-08-30 02:39:36 +01:00
|
|
|
|
CreepFlag = CalculateStackGap();
|
2011-05-04 10:11:41 +01:00
|
|
|
|
LOCAL_ActiveSignals &= ~YAP_WAKEUP_SIGNAL;
|
|
|
|
|
UNLOCK(LOCAL_SignalLock);
|
2004-01-23 02:23:51 +00:00
|
|
|
|
ARG2 = Yap_ListOfWokenGoals();
|
|
|
|
|
SREG = (CELL *) (WakeUpCode);
|
|
|
|
|
/* no more goals to wake up */
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_UpdateTimedVar(LOCAL_WokenGoals,TermNil);
|
2004-01-23 02:23:51 +00:00
|
|
|
|
} else
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif
|
2008-08-30 02:39:36 +01:00
|
|
|
|
{
|
|
|
|
|
CreepFlag = CalculateStackGap();
|
|
|
|
|
SREG = (CELL *) CreepCode;
|
2011-05-04 10:11:41 +01:00
|
|
|
|
UNLOCK(LOCAL_SignalLock);
|
2008-08-30 02:39:36 +01:00
|
|
|
|
}
|
|
|
|
|
PREG = ((PredEntry *)SREG)->CodeOfPred;
|
2003-09-25 00:48:04 +00:00
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
2002-11-18 18:18:05 +00:00
|
|
|
|
if (Yap_do_low_level_trace)
|
2001-10-30 16:42:05 +00:00
|
|
|
|
low_level_trace(enter_pred,(PredEntry *)(SREG),XREGS+1);
|
2001-07-04 16:48:54 +00:00
|
|
|
|
#endif /* LOW_LEVEL_TRACE */
|
2005-12-23 00:20:14 +00:00
|
|
|
|
/* for profiler */
|
|
|
|
|
save_pc();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
CACHE_A1();
|
|
|
|
|
JMPNext();
|
|
|
|
|
|
2005-12-17 03:25:39 +00:00
|
|
|
|
BOp(procceed, p);
|
2003-09-24 23:53:48 +00:00
|
|
|
|
CACHE_Y_AS_ENV(YREG);
|
2009-03-05 16:12:21 +00:00
|
|
|
|
ALWAYS_LOOKAHEAD(CPREG->opc);
|
2002-01-14 22:26:53 +00:00
|
|
|
|
PREG = CPREG;
|
2005-12-23 00:20:14 +00:00
|
|
|
|
/* for profiler */
|
|
|
|
|
save_pc();
|
2005-10-28 17:38:50 +00:00
|
|
|
|
ENV_YREG = ENV;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifdef DEPTH_LIMIT
|
2005-10-28 17:38:50 +00:00
|
|
|
|
DEPTH = ENV_YREG[E_DEPTH];
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif
|
2003-09-24 23:53:48 +00:00
|
|
|
|
WRITEBACK_Y_AS_ENV();
|
2009-03-05 16:12:21 +00:00
|
|
|
|
ALWAYS_GONext();
|
|
|
|
|
ALWAYS_END_PREFETCH();
|
2003-09-24 23:53:48 +00:00
|
|
|
|
ENDCACHE_Y_AS_ENV();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
Op(allocate, e);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
CACHE_Y_AS_ENV(YREG);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = NEXTOP(PREG, e);
|
2005-10-28 17:38:50 +00:00
|
|
|
|
ENV_YREG[E_CP] = (CELL) CPREG;
|
|
|
|
|
ENV_YREG[E_E] = (CELL) ENV;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifdef DEPTH_LIMIT
|
2005-10-28 17:38:50 +00:00
|
|
|
|
ENV_YREG[E_DEPTH] = DEPTH;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif /* DEPTH_LIMIT */
|
2005-10-28 17:38:50 +00:00
|
|
|
|
ENV = ENV_YREG;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDCACHE_Y_AS_ENV();
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-30 16:24:44 +01:00
|
|
|
|
Op(deallocate, p);
|
2003-09-24 14:51:42 +00:00
|
|
|
|
CACHE_Y_AS_ENV(YREG);
|
2010-10-12 22:02:51 +01:00
|
|
|
|
check_trail(TR);
|
2008-08-30 16:24:44 +01:00
|
|
|
|
PREG = NEXTOP(PREG, p);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* other instructions do depend on S being set by deallocate
|
|
|
|
|
:-( */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
SREG = YREG;
|
2005-10-28 17:38:50 +00:00
|
|
|
|
CPREG = (yamop *) ENV_YREG[E_CP];
|
|
|
|
|
ENV = ENV_YREG = (CELL *) ENV_YREG[E_E];
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifdef DEPTH_LIMIT
|
2005-10-28 17:38:50 +00:00
|
|
|
|
DEPTH = ENV_YREG[E_DEPTH];
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif /* DEPTH_LIMIT */
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
2001-04-09 19:54:03 +00:00
|
|
|
|
{
|
|
|
|
|
choiceptr top_b = PROTECT_FROZEN_B(B);
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#ifdef YAPOR_SBA
|
2005-10-28 17:38:50 +00:00
|
|
|
|
if (ENV_YREG > (CELL *) top_b || ENV_YREG < H) ENV_YREG = (CELL *) top_b;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#else
|
2005-10-28 17:38:50 +00:00
|
|
|
|
if (ENV_YREG > (CELL *) top_b) ENV_YREG = (CELL *) top_b;
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#endif /* YAPOR_SBA */
|
2005-10-28 17:38:50 +00:00
|
|
|
|
else ENV_YREG = (CELL *)((CELL) ENV_YREG + ENV_Size(CPREG));
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
#else
|
2005-10-28 17:38:50 +00:00
|
|
|
|
if (ENV_YREG > (CELL *) B)
|
|
|
|
|
ENV_YREG = (CELL *) B;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
else
|
2005-10-28 17:38:50 +00:00
|
|
|
|
ENV_YREG = (CELL *) ((CELL) ENV_YREG + ENV_Size(CPREG));
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#endif /* FROZEN_STACKS */
|
2003-09-24 14:51:42 +00:00
|
|
|
|
WRITEBACK_Y_AS_ENV();
|
2003-09-26 14:30:59 +00:00
|
|
|
|
#ifndef NO_CHECKING
|
|
|
|
|
/* check stacks */
|
|
|
|
|
check_stack(NoStackDeallocate, H);
|
|
|
|
|
#endif
|
2003-09-24 14:51:42 +00:00
|
|
|
|
ENDCACHE_Y_AS_ENV();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
/**********************************************
|
|
|
|
|
* OPTYap instructions *
|
|
|
|
|
**********************************************/
|
|
|
|
|
|
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
#include "or.insts.i"
|
|
|
|
|
#endif /* YAPOR */
|
|
|
|
|
#ifdef TABLING
|
|
|
|
|
#include "tab.insts.i"
|
|
|
|
|
#include "tab.tries.insts.i"
|
|
|
|
|
#endif /* TABLING */
|
|
|
|
|
|
|
|
|
|
|
2005-09-08 22:06:45 +00:00
|
|
|
|
|
|
|
|
|
#ifdef BEAM
|
|
|
|
|
extern int eam_am(PredEntry *);
|
2006-04-27 14:13:24 +00:00
|
|
|
|
|
|
|
|
|
Op(retry_eam, e);
|
|
|
|
|
printf("Aqui estou eu..................\n");
|
|
|
|
|
if (!eam_am(2)) {
|
|
|
|
|
abort_eam("Falhei\n");
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
goto procceed;
|
|
|
|
|
PREG = NEXTOP(PREG, e);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2006-03-24 17:13:41 +00:00
|
|
|
|
Op(run_eam, os);
|
2013-01-07 09:47:14 +00:00
|
|
|
|
if (inp==-9000) { /* use indexing to find out valid alternatives */
|
2006-03-24 17:13:41 +00:00
|
|
|
|
extern CELL *beam_ALTERNATIVES;
|
|
|
|
|
*beam_ALTERNATIVES= (CELL *) PREG->u.os.opcw;
|
|
|
|
|
beam_ALTERNATIVES++;
|
|
|
|
|
if (OLD_B!=B) goto fail;
|
|
|
|
|
#if PUSH_REGS
|
|
|
|
|
Yap_regp=old_regs;
|
|
|
|
|
#endif
|
|
|
|
|
return(0);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
saveregs();
|
|
|
|
|
if (!eam_am((PredEntry *) PREG->u.os.s)) FAIL();
|
|
|
|
|
setregs();
|
2006-04-27 14:13:24 +00:00
|
|
|
|
|
|
|
|
|
/* cut */
|
|
|
|
|
BACKUP_B();
|
|
|
|
|
#ifdef CUT_C
|
|
|
|
|
while (POP_CHOICE_POINT(B->cp_b)) {
|
|
|
|
|
POP_EXECUTE();
|
|
|
|
|
}
|
|
|
|
|
#endif /* CUT_C */
|
|
|
|
|
B = B->cp_b; /* cut_fail */
|
|
|
|
|
HB = B->cp_h; /* cut_fail */
|
|
|
|
|
RECOVER_B();
|
|
|
|
|
|
|
|
|
|
if (0) { register choiceptr ccp;
|
|
|
|
|
/* initialize ccp */
|
|
|
|
|
#define NORM_CP(CP) ((choiceptr)(CP))
|
|
|
|
|
|
2009-06-16 21:20:35 -05:00
|
|
|
|
YREG = (CELL *) (NORM_CP(YREG) - 1);
|
|
|
|
|
ccp = NORM_CP(YREG);
|
2006-04-27 14:13:24 +00:00
|
|
|
|
store_yaam_reg_cpdepth(ccp);
|
|
|
|
|
ccp->cp_tr = TR;
|
|
|
|
|
ccp->cp_ap = BEAM_RETRY_CODE;
|
|
|
|
|
ccp->cp_h = H;
|
|
|
|
|
ccp->cp_b = B;
|
|
|
|
|
ccp->cp_env= ENV;
|
|
|
|
|
ccp->cp_cp = CPREG;
|
|
|
|
|
B = ccp;
|
|
|
|
|
SET_BB(B);
|
|
|
|
|
}
|
2006-03-24 17:13:41 +00:00
|
|
|
|
goto procceed;
|
|
|
|
|
PREG = NEXTOP(PREG, os);
|
2005-09-08 22:06:45 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
#endif
|
|
|
|
|
|
|
|
|
|
|
2013-01-07 09:47:14 +00:00
|
|
|
|
|
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/************************************************************************\
|
|
|
|
|
* Get Instructions *
|
|
|
|
|
\************************************************************************/
|
|
|
|
|
|
|
|
|
|
Op(get_x_var, xx);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = XREG(PREG->u.xx.xr);
|
|
|
|
|
XREG(PREG->u.xx.xl) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, xx);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(get_y_var, yx);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGP(pt0);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
pt0 = YREG + PREG->u.yx.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d0 = XREG(PREG->u.yx.x);
|
|
|
|
|
PREG = NEXTOP(PREG, yx);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0,d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2009-03-03 10:04:13 +00:00
|
|
|
|
Op(get_yy_var, yyxx);
|
|
|
|
|
CACHE_Y(YREG);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = S_YREG + PREG->u.yyxx.y1;
|
|
|
|
|
d0 = XREG(PREG->u.yyxx.x1);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
pt1 = S_YREG + PREG->u.yyx.y2;
|
|
|
|
|
d1 = XREG(PREG->u.yyxx.x2);
|
|
|
|
|
PREG = NEXTOP(PREG, yyxx);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0,d0);
|
|
|
|
|
INITIALIZE_PERMVAR(pt1,d1);
|
2009-03-03 10:04:13 +00:00
|
|
|
|
ENDP(pt1);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDCACHE_Y();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* The code for get_x_val is hard to follow because I use a
|
|
|
|
|
* lot of jumps. The convention is that in the label
|
2002-11-11 17:38:10 +00:00
|
|
|
|
* gval_X_YREG X refers to the state of the first argument, and
|
|
|
|
|
* YREG to the state of the second argument */
|
2001-04-09 19:54:03 +00:00
|
|
|
|
Op(get_x_val, xx);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = XREG(PREG->u.xx.xl);
|
|
|
|
|
deref_head(d0, gvalx_unk);
|
|
|
|
|
|
|
|
|
|
/* d0 will keep the first argument */
|
|
|
|
|
gvalx_nonvar:
|
|
|
|
|
/* first argument is bound */
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d1 = XREG(PREG->u.xx.xr);
|
|
|
|
|
deref_head(d1, gvalx_nonvar_unk);
|
|
|
|
|
|
|
|
|
|
gvalx_nonvar_nonvar:
|
|
|
|
|
/* both arguments are bound */
|
|
|
|
|
/* we may have to bind structures */
|
|
|
|
|
PREG = NEXTOP(PREG, xx);
|
|
|
|
|
UnifyBound(d0, d1);
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
/* deref second argument */
|
|
|
|
|
deref_body(d1, pt0, gvalx_nonvar_unk, gvalx_nonvar_nonvar);
|
|
|
|
|
/* first argument bound, second unbound */
|
2009-03-05 16:12:21 +00:00
|
|
|
|
PREG = NEXTOP(PREG, xx);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
/* first argument may be unbound */
|
|
|
|
|
deref_body(d0, pt0, gvalx_unk, gvalx_nonvar);
|
|
|
|
|
/* first argument is unbound and in pt0 and in d0 */
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d1 = XREG(PREG->u.xx.xr);
|
|
|
|
|
deref_head(d1, gvalx_var_unk);
|
|
|
|
|
|
|
|
|
|
gvalx_var_nonvar:
|
|
|
|
|
/* first unbound, second bound */
|
|
|
|
|
PREG = NEXTOP(PREG, xx);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
deref_body(d1, pt1, gvalx_var_unk, gvalx_var_nonvar);
|
|
|
|
|
/* both arguments are unbound */
|
|
|
|
|
PREG = NEXTOP(PREG, xx);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
UnifyCells(pt0, pt1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
/* The code for get_y_val mostly uses the code for get_x_val
|
|
|
|
|
*/
|
|
|
|
|
|
|
|
|
|
Op(get_y_val, yx);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
BEGP(pt0);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
pt0 = YREG + PREG->u.yx.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d0 = *pt0;
|
|
|
|
|
|
|
|
|
|
/* From now on, it's just a copy of the code for get_x_val */
|
|
|
|
|
|
|
|
|
|
deref_head(d0, gvaly_unk);
|
|
|
|
|
gvaly_nonvar:
|
|
|
|
|
|
|
|
|
|
/* first argument is bound */
|
|
|
|
|
d1 = XREG(PREG->u.yx.x);
|
|
|
|
|
deref_head(d1, gvaly_nonvar_unk);
|
|
|
|
|
gvaly_nonvar_nonvar:
|
|
|
|
|
|
|
|
|
|
/* both arguments are bound */
|
|
|
|
|
/* we may have to bind structures */
|
|
|
|
|
PREG = NEXTOP(PREG, yx);
|
|
|
|
|
UnifyBound(d0, d1);
|
|
|
|
|
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
/* deref second argument */
|
|
|
|
|
deref_body(d1, pt1, gvaly_nonvar_unk, gvaly_nonvar_nonvar);
|
|
|
|
|
/* first argument bound, second unbound */
|
|
|
|
|
PREG = NEXTOP(PREG, yx);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt1, d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
/* first argument may be unbound */
|
|
|
|
|
derefa_body(d0, pt0, gvaly_unk, gvaly_nonvar);
|
|
|
|
|
/* first argument is unbound */
|
|
|
|
|
d1 = XREG(PREG->u.yx.x);
|
|
|
|
|
deref_head(d1, gvaly_var_unk);
|
|
|
|
|
|
|
|
|
|
gvaly_var_nonvar:
|
|
|
|
|
/* first unbound, second bound */
|
|
|
|
|
PREG = NEXTOP(PREG, yx);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
deref_body(d1, pt1, gvaly_var_unk, gvaly_var_nonvar);
|
|
|
|
|
/* both arguments are unbound */
|
|
|
|
|
PREG = NEXTOP(PREG, yx);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
UnifyCells(pt0, pt1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(get_atom, xc);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
/* fetch arguments */
|
|
|
|
|
d0 = XREG(PREG->u.xc.x);
|
|
|
|
|
d1 = PREG->u.xc.c;
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_head(d0, gatom_unk);
|
|
|
|
|
/* argument is nonvar */
|
|
|
|
|
gatom_nonvar:
|
|
|
|
|
if (d0 == d1) {
|
|
|
|
|
PREG = NEXTOP(PREG, xc);
|
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
deref_body(d0, pt0, gatom_unk, gatom_nonvar);
|
|
|
|
|
/* argument is a variable */
|
|
|
|
|
PREG = NEXTOP(PREG, xc);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2013-01-07 09:47:14 +00:00
|
|
|
|
Op(get_atom_exo, x);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
/* fetch arguments */
|
2013-01-08 00:40:51 +00:00
|
|
|
|
d0 = XREG(PREG->u.x.x);
|
|
|
|
|
d1 = *SREG;
|
|
|
|
|
SREG++;
|
2013-01-07 09:47:14 +00:00
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
2013-01-09 09:21:07 +00:00
|
|
|
|
deref_head(d0, gatom_exo_unk);
|
|
|
|
|
/* argument is nonvar */
|
|
|
|
|
gatom_exo_nonvar:
|
2013-01-07 09:47:14 +00:00
|
|
|
|
if (d0 == d1) {
|
|
|
|
|
PREG = NEXTOP(PREG, x);
|
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
2013-01-09 09:21:07 +00:00
|
|
|
|
deref_body(d0, pt0, gatom_exo_unk, gatom_exo_nonvar);
|
2013-01-07 09:47:14 +00:00
|
|
|
|
/* argument is a variable */
|
2013-01-08 13:09:31 +00:00
|
|
|
|
pt0 = (CELL *)d0;
|
2013-01-07 09:47:14 +00:00
|
|
|
|
PREG = NEXTOP(PREG, x);
|
|
|
|
|
Bind(pt0, d1);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2004-09-27 20:45:04 +00:00
|
|
|
|
Op(get_2atoms, cc);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
/* fetch arguments */
|
|
|
|
|
d0 = ARG1;
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_head(d0, gatom_2unk);
|
|
|
|
|
/* argument is nonvar */
|
|
|
|
|
gatom_2nonvar:
|
|
|
|
|
if (d0 == PREG->u.cc.c1) {
|
|
|
|
|
goto gatom_2b;
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
deref_body(d0, pt0, gatom_2unk, gatom_2nonvar);
|
|
|
|
|
/* argument is a variable */
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, PREG->u.cc.c1);
|
2004-09-27 20:45:04 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
gatom_2b:
|
|
|
|
|
/* fetch arguments */
|
|
|
|
|
d0 = ARG2;
|
|
|
|
|
d1 = PREG->u.cc.c2;
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_head(d0, gatom_2bunk);
|
|
|
|
|
/* argument is nonvar */
|
|
|
|
|
gatom_2bnonvar:
|
|
|
|
|
if (d0 == d1) {
|
|
|
|
|
PREG = NEXTOP(PREG, cc);
|
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
deref_body(d0, pt0, gatom_2bunk, gatom_2bnonvar);
|
|
|
|
|
/* argument is a variable */
|
|
|
|
|
PREG = NEXTOP(PREG, cc);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, d1);
|
2004-09-27 20:45:04 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(get_3atoms, ccc);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
/* fetch arguments */
|
|
|
|
|
d0 = ARG1;
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_head(d0, gatom_3unk);
|
|
|
|
|
/* argument is nonvar */
|
|
|
|
|
gatom_3nonvar:
|
|
|
|
|
if (d0 == PREG->u.ccc.c1) {
|
|
|
|
|
goto gatom_3b;
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
deref_body(d0, pt0, gatom_3unk, gatom_3nonvar);
|
|
|
|
|
/* argument is a variable */
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, PREG->u.ccc.c1);
|
2004-09-27 20:45:04 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
gatom_3b:
|
|
|
|
|
/* fetch arguments */
|
|
|
|
|
d0 = ARG2;
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_head(d0, gatom_3bunk);
|
|
|
|
|
/* argument is nonvar */
|
|
|
|
|
gatom_3bnonvar:
|
|
|
|
|
if (d0 == PREG->u.ccc.c2) {
|
|
|
|
|
goto gatom_3c;
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
deref_body(d0, pt0, gatom_3bunk, gatom_3bnonvar);
|
|
|
|
|
/* argument is a variable */
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, PREG->u.ccc.c2);
|
2004-09-27 20:45:04 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
gatom_3c:
|
|
|
|
|
/* fetch arguments */
|
|
|
|
|
d0 = ARG3;
|
|
|
|
|
d1 = PREG->u.ccc.c3;
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_head(d0, gatom_3cunk);
|
|
|
|
|
/* argument is nonvar */
|
|
|
|
|
gatom_3cnonvar:
|
|
|
|
|
if (d0 == d1) {
|
|
|
|
|
PREG = NEXTOP(PREG, ccc);
|
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
deref_body(d0, pt0, gatom_3cunk, gatom_3cnonvar);
|
|
|
|
|
/* argument is a variable */
|
|
|
|
|
PREG = NEXTOP(PREG, ccc);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, d1);
|
2004-09-27 20:45:04 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(get_4atoms, cccc);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
/* fetch arguments */
|
|
|
|
|
d0 = ARG1;
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_head(d0, gatom_4unk);
|
|
|
|
|
/* argument is nonvar */
|
|
|
|
|
gatom_4nonvar:
|
|
|
|
|
if (d0 == PREG->u.cccc.c1) {
|
|
|
|
|
goto gatom_4b;
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
deref_body(d0, pt0, gatom_4unk, gatom_4nonvar);
|
|
|
|
|
/* argument is a variable */
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, PREG->u.cccc.c1);
|
2004-09-27 20:45:04 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
gatom_4b:
|
|
|
|
|
/* fetch arguments */
|
|
|
|
|
d0 = ARG2;
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_head(d0, gatom_4bunk);
|
|
|
|
|
/* argument is nonvar */
|
|
|
|
|
gatom_4bnonvar:
|
|
|
|
|
if (d0 == PREG->u.cccc.c2) {
|
|
|
|
|
goto gatom_4c;
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
deref_body(d0, pt0, gatom_4bunk, gatom_4bnonvar);
|
|
|
|
|
/* argument is a variable */
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, PREG->u.cccc.c2);
|
2004-09-27 20:45:04 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
gatom_4c:
|
|
|
|
|
/* fetch arguments */
|
|
|
|
|
d0 = ARG3;
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_head(d0, gatom_4cunk);
|
|
|
|
|
/* argument is nonvar */
|
|
|
|
|
gatom_4cnonvar:
|
|
|
|
|
if (d0 == PREG->u.cccc.c3) {
|
|
|
|
|
goto gatom_4d;
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
deref_body(d0, pt0, gatom_4cunk, gatom_4cnonvar);
|
|
|
|
|
/* argument is a variable */
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, PREG->u.cccc.c3);
|
2004-09-27 20:45:04 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
gatom_4d:
|
|
|
|
|
/* fetch arguments */
|
|
|
|
|
d0 = ARG4;
|
|
|
|
|
d1 = PREG->u.cccc.c4;
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_head(d0, gatom_4dunk);
|
|
|
|
|
/* argument is nonvar */
|
|
|
|
|
gatom_4dnonvar:
|
|
|
|
|
if (d0 == d1) {
|
|
|
|
|
PREG = NEXTOP(PREG, cccc);
|
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
deref_body(d0, pt0, gatom_4dunk, gatom_4dnonvar);
|
|
|
|
|
/* argument is a variable */
|
|
|
|
|
PREG = NEXTOP(PREG, cccc);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, d1);
|
2004-09-27 20:45:04 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(get_5atoms, ccccc);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
/* fetch arguments */
|
|
|
|
|
d0 = ARG1;
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_head(d0, gatom_5unk);
|
|
|
|
|
/* argument is nonvar */
|
|
|
|
|
gatom_5nonvar:
|
|
|
|
|
if (d0 == PREG->u.ccccc.c1) {
|
|
|
|
|
goto gatom_5b;
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
deref_body(d0, pt0, gatom_5unk, gatom_5nonvar);
|
|
|
|
|
/* argument is a variable */
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, PREG->u.ccccc.c1);
|
2004-09-27 20:45:04 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
gatom_5b:
|
|
|
|
|
/* fetch arguments */
|
|
|
|
|
d0 = ARG2;
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_head(d0, gatom_5bunk);
|
|
|
|
|
/* argument is nonvar */
|
|
|
|
|
gatom_5bnonvar:
|
|
|
|
|
if (d0 == PREG->u.ccccc.c2) {
|
|
|
|
|
goto gatom_5c;
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
deref_body(d0, pt0, gatom_5bunk, gatom_5bnonvar);
|
|
|
|
|
/* argument is a variable */
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, PREG->u.ccccc.c2);
|
2004-09-27 20:45:04 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
gatom_5c:
|
|
|
|
|
/* fetch arguments */
|
|
|
|
|
d0 = ARG3;
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_head(d0, gatom_5cunk);
|
|
|
|
|
/* argument is nonvar */
|
|
|
|
|
gatom_5cnonvar:
|
|
|
|
|
if (d0 == PREG->u.ccccc.c3) {
|
|
|
|
|
goto gatom_5d;
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
deref_body(d0, pt0, gatom_5cunk, gatom_5cnonvar);
|
|
|
|
|
/* argument is a variable */
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, PREG->u.ccccc.c3);
|
2004-09-27 20:45:04 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
gatom_5d:
|
|
|
|
|
/* fetch arguments */
|
|
|
|
|
d0 = ARG4;
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_head(d0, gatom_5dunk);
|
|
|
|
|
/* argument is nonvar */
|
|
|
|
|
gatom_5dnonvar:
|
|
|
|
|
if (d0 == PREG->u.ccccc.c4) {
|
|
|
|
|
goto gatom_5e;
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
deref_body(d0, pt0, gatom_5dunk, gatom_5dnonvar);
|
|
|
|
|
/* argument is a variable */
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, PREG->u.ccccc.c4);
|
2004-09-27 20:45:04 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
gatom_5e:
|
|
|
|
|
/* fetch arguments */
|
|
|
|
|
d0 = ARG5;
|
|
|
|
|
d1 = PREG->u.ccccc.c5;
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_head(d0, gatom_5eunk);
|
|
|
|
|
/* argument is nonvar */
|
|
|
|
|
gatom_5enonvar:
|
|
|
|
|
if (d0 == d1) {
|
|
|
|
|
PREG = NEXTOP(PREG, ccccc);
|
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
deref_body(d0, pt0, gatom_5eunk, gatom_5enonvar);
|
|
|
|
|
/* argument is a variable */
|
|
|
|
|
PREG = NEXTOP(PREG, ccccc);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, d1);
|
2004-09-27 20:45:04 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(get_6atoms, cccccc);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
/* fetch arguments */
|
|
|
|
|
d0 = ARG1;
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_head(d0, gatom_6unk);
|
|
|
|
|
/* argument is nonvar */
|
|
|
|
|
gatom_6nonvar:
|
|
|
|
|
if (d0 == PREG->u.cccccc.c1) {
|
|
|
|
|
goto gatom_6b;
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
deref_body(d0, pt0, gatom_6unk, gatom_6nonvar);
|
|
|
|
|
/* argument is a variable */
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, PREG->u.cccccc.c1);
|
2004-09-27 20:45:04 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
gatom_6b:
|
|
|
|
|
/* fetch arguments */
|
|
|
|
|
d0 = ARG2;
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_head(d0, gatom_6bunk);
|
|
|
|
|
/* argument is nonvar */
|
|
|
|
|
gatom_6bnonvar:
|
|
|
|
|
if (d0 == PREG->u.cccccc.c2) {
|
|
|
|
|
goto gatom_6c;
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
deref_body(d0, pt0, gatom_6bunk, gatom_6bnonvar);
|
|
|
|
|
/* argument is a variable */
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, PREG->u.cccccc.c2);
|
2004-09-27 20:45:04 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
gatom_6c:
|
|
|
|
|
/* fetch arguments */
|
|
|
|
|
d0 = ARG3;
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_head(d0, gatom_6cunk);
|
|
|
|
|
/* argument is nonvar */
|
|
|
|
|
gatom_6cnonvar:
|
|
|
|
|
if (d0 == PREG->u.cccccc.c3) {
|
|
|
|
|
goto gatom_6d;
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
deref_body(d0, pt0, gatom_6cunk, gatom_6cnonvar);
|
|
|
|
|
/* argument is a variable */
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, PREG->u.cccccc.c3);
|
2004-09-27 20:45:04 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
gatom_6d:
|
|
|
|
|
/* fetch arguments */
|
|
|
|
|
d0 = ARG4;
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_head(d0, gatom_6dunk);
|
|
|
|
|
/* argument is nonvar */
|
|
|
|
|
gatom_6dnonvar:
|
|
|
|
|
if (d0 == PREG->u.cccccc.c4) {
|
|
|
|
|
goto gatom_6e;
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
deref_body(d0, pt0, gatom_6dunk, gatom_6dnonvar);
|
|
|
|
|
/* argument is a variable */
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, PREG->u.cccccc.c4);
|
2004-09-27 20:45:04 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
gatom_6e:
|
|
|
|
|
/* fetch arguments */
|
|
|
|
|
d0 = ARG5;
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_head(d0, gatom_6eunk);
|
|
|
|
|
/* argument is nonvar */
|
|
|
|
|
gatom_6enonvar:
|
|
|
|
|
if (d0 == PREG->u.cccccc.c5) {
|
|
|
|
|
goto gatom_6f;
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
deref_body(d0, pt0, gatom_6eunk, gatom_6enonvar);
|
|
|
|
|
/* argument is a variable */
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, PREG->u.cccccc.c5);
|
2004-09-27 20:45:04 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
gatom_6f:
|
|
|
|
|
/* fetch arguments */
|
|
|
|
|
d0 = ARG6;
|
|
|
|
|
d1 = PREG->u.cccccc.c6;
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_head(d0, gatom_6funk);
|
|
|
|
|
/* argument is nonvar */
|
|
|
|
|
gatom_6fnonvar:
|
|
|
|
|
if (d0 == d1) {
|
|
|
|
|
PREG = NEXTOP(PREG, cccccc);
|
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
deref_body(d0, pt0, gatom_6funk, gatom_6fnonvar);
|
|
|
|
|
/* argument is a variable */
|
|
|
|
|
PREG = NEXTOP(PREG, cccccc);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, d1);
|
2004-09-27 20:45:04 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* The next instructions can lead to either the READ stream
|
|
|
|
|
* or the write stream */
|
|
|
|
|
|
|
|
|
|
OpRW(get_list, x);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = XREG(PREG->u.x.x);
|
|
|
|
|
deref_head(d0, glist_unk);
|
|
|
|
|
|
|
|
|
|
glist_nonvar:
|
|
|
|
|
/* did we find a list? */
|
|
|
|
|
if (!IsPairTerm(d0)) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
START_PREFETCH(x);
|
|
|
|
|
PREG = NEXTOP(PREG, x);
|
|
|
|
|
/* enter read mode */
|
|
|
|
|
SREG = RepPair(d0);
|
|
|
|
|
GONext();
|
|
|
|
|
END_PREFETCH();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, glist_unk, glist_nonvar);
|
|
|
|
|
/* glist var */
|
|
|
|
|
/* enter write mode */
|
|
|
|
|
CACHE_S();
|
|
|
|
|
S_SREG = H;
|
|
|
|
|
START_PREFETCH_W(x);
|
|
|
|
|
PREG = NEXTOP(PREG, x);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = AbsPair(S_SREG);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, d0);
|
|
|
|
|
S_SREG = H;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* don't put an ENDD just after a label */
|
|
|
|
|
H = S_SREG + 2;
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
WRITEBACK_S(S_SREG);
|
|
|
|
|
GONextW();
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
END_PREFETCH_W();
|
|
|
|
|
ENDCACHE_S();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOpRW();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
OpRW(get_struct, xfa);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
d0 = XREG(PREG->u.xfa.x);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
deref_head(d0, gstruct_unk);
|
|
|
|
|
|
|
|
|
|
gstruct_nonvar:
|
|
|
|
|
if (!IsApplTerm(d0))
|
|
|
|
|
FAIL();
|
|
|
|
|
/* we have met a compound term */
|
2008-08-21 13:38:25 +01:00
|
|
|
|
START_PREFETCH(xfa);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
CACHE_S();
|
|
|
|
|
S_SREG = RepAppl(d0);
|
|
|
|
|
/* check functor */
|
2008-08-21 13:38:25 +01:00
|
|
|
|
d0 = (CELL) (PREG->u.xfa.f);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (*S_SREG != d0) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
WRITEBACK_S(S_SREG+1);
|
|
|
|
|
ENDCACHE_S();
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, xfa);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* enter read mode */
|
|
|
|
|
GONext();
|
|
|
|
|
END_PREFETCH();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, gstruct_unk, gstruct_nonvar);
|
|
|
|
|
/* Enter Write mode */
|
|
|
|
|
/* set d1 to be the new structure we are going to create */
|
2008-08-21 13:38:25 +01:00
|
|
|
|
START_PREFETCH_W(xfa);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d1);
|
|
|
|
|
d1 = AbsAppl(H);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* now, set pt0 to point to the heap where we are going to
|
|
|
|
|
* build our term */
|
|
|
|
|
pt0 = H;
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
/* first, put the functor */
|
2008-08-21 13:38:25 +01:00
|
|
|
|
d0 = (CELL) (PREG->u.xfa.f);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
*pt0++ = d0;
|
2008-08-21 13:38:25 +01:00
|
|
|
|
H = pt0 + PREG->u.xfa.a;
|
|
|
|
|
PREG = NEXTOP(PREG, xfa);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* set SREG */
|
|
|
|
|
SREG = pt0;
|
|
|
|
|
/* update H */
|
|
|
|
|
GONextW();
|
|
|
|
|
END_PREFETCH_W();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOpRW();
|
|
|
|
|
|
2006-09-20 20:03:51 +00:00
|
|
|
|
Op(get_float, xd);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2006-09-20 20:03:51 +00:00
|
|
|
|
d0 = XREG(PREG->u.xd.x);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
deref_head(d0, gfloat_unk);
|
|
|
|
|
|
|
|
|
|
gfloat_nonvar:
|
|
|
|
|
if (!IsApplTerm(d0))
|
|
|
|
|
FAIL();
|
|
|
|
|
/* we have met a preexisting float */
|
2006-09-20 20:03:51 +00:00
|
|
|
|
START_PREFETCH(xd);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = RepAppl(d0);
|
|
|
|
|
/* check functor */
|
|
|
|
|
if (*pt0 != (CELL)FunctorDouble) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
BEGP(pt1);
|
2006-09-20 20:03:51 +00:00
|
|
|
|
pt1 = PREG->u.xd.d;
|
|
|
|
|
PREG = NEXTOP(PREG, xd);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (
|
|
|
|
|
pt1[1] != pt0[1]
|
|
|
|
|
#if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
|
|
|
|
|
|| pt1[2] != pt0[2]
|
|
|
|
|
#endif
|
|
|
|
|
) FAIL();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
/* enter read mode */
|
|
|
|
|
GONext();
|
|
|
|
|
END_PREFETCH();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, gfloat_unk, gfloat_nonvar);
|
|
|
|
|
/* Enter Write mode */
|
|
|
|
|
/* set d1 to be the new structure we are going to create */
|
|
|
|
|
START_PREFETCH(xc);
|
|
|
|
|
BEGD(d1);
|
2006-09-20 20:03:51 +00:00
|
|
|
|
d1 = AbsAppl(PREG->u.xd.d);
|
|
|
|
|
PREG = NEXTOP(PREG, xd);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
END_PREFETCH();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2006-09-20 20:03:51 +00:00
|
|
|
|
Op(get_longint, xi);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2006-09-20 20:03:51 +00:00
|
|
|
|
d0 = XREG(PREG->u.xi.x);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
deref_head(d0, glongint_unk);
|
|
|
|
|
|
|
|
|
|
glongint_nonvar:
|
|
|
|
|
if (!IsApplTerm(d0))
|
|
|
|
|
FAIL();
|
|
|
|
|
/* we have met a preexisting longint */
|
2006-09-20 20:03:51 +00:00
|
|
|
|
START_PREFETCH(xi);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = RepAppl(d0);
|
|
|
|
|
/* check functor */
|
|
|
|
|
if (*pt0 != (CELL)FunctorLongInt) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
2006-09-20 20:03:51 +00:00
|
|
|
|
if (PREG->u.xi.i[1] != (CELL)pt0[1]) FAIL();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
2006-09-20 20:03:51 +00:00
|
|
|
|
PREG = NEXTOP(PREG, xi);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* enter read mode */
|
|
|
|
|
GONext();
|
|
|
|
|
END_PREFETCH();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, glongint_unk, glongint_nonvar);
|
|
|
|
|
/* Enter Write mode */
|
|
|
|
|
/* set d1 to be the new structure we are going to create */
|
2006-09-20 20:03:51 +00:00
|
|
|
|
START_PREFETCH(xi);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d1);
|
2006-09-20 20:03:51 +00:00
|
|
|
|
d1 = AbsAppl(PREG->u.xi.i);
|
|
|
|
|
PREG = NEXTOP(PREG, xi);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
END_PREFETCH();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2010-12-16 22:21:46 +00:00
|
|
|
|
Op(get_bigint, xN);
|
2006-01-02 02:16:19 +00:00
|
|
|
|
#ifdef USE_GMP
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2010-12-16 22:21:46 +00:00
|
|
|
|
d0 = XREG(PREG->u.xN.x);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
deref_head(d0, gbigint_unk);
|
|
|
|
|
|
|
|
|
|
gbigint_nonvar:
|
|
|
|
|
if (!IsApplTerm(d0))
|
|
|
|
|
FAIL();
|
|
|
|
|
/* we have met a preexisting bigint */
|
2010-12-16 22:21:46 +00:00
|
|
|
|
START_PREFETCH(xN);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = RepAppl(d0);
|
|
|
|
|
/* check functor */
|
|
|
|
|
if (*pt0 != (CELL)FunctorBigInt)
|
|
|
|
|
{
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
2010-12-16 22:21:46 +00:00
|
|
|
|
if (Yap_gmp_tcmp_big_big(d0,PREG->u.xN.b))
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
2010-12-16 22:21:46 +00:00
|
|
|
|
PREG = NEXTOP(PREG, xN);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
/* enter read mode */
|
|
|
|
|
GONext();
|
|
|
|
|
END_PREFETCH();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, gbigint_unk, gbigint_nonvar);
|
|
|
|
|
/* Enter Write mode */
|
|
|
|
|
/* set d1 to be the new structure we are going to create */
|
2010-12-16 22:21:46 +00:00
|
|
|
|
START_PREFETCH(xN);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d1);
|
2010-12-16 22:21:46 +00:00
|
|
|
|
d1 = PREG->u.xN.b;
|
|
|
|
|
PREG = NEXTOP(PREG, xN);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
END_PREFETCH();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
ENDD(d0);
|
2006-01-02 02:16:19 +00:00
|
|
|
|
#else
|
|
|
|
|
FAIL();
|
|
|
|
|
#endif
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDOp();
|
2007-11-06 17:02:13 +00:00
|
|
|
|
|
|
|
|
|
|
2010-12-16 20:39:53 +00:00
|
|
|
|
Op(get_dbterm, xD);
|
2007-11-06 17:02:13 +00:00
|
|
|
|
BEGD(d0);
|
2010-12-16 20:39:53 +00:00
|
|
|
|
d0 = XREG(PREG->u.xD.x);
|
2007-11-06 17:02:13 +00:00
|
|
|
|
deref_head(d0, gdbterm_unk);
|
|
|
|
|
|
|
|
|
|
gdbterm_nonvar:
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
/* we have met a preexisting dbterm */
|
2010-12-16 20:39:53 +00:00
|
|
|
|
d1 = PREG->u.xD.D;
|
|
|
|
|
PREG = NEXTOP(PREG, xD);
|
2007-11-06 17:02:13 +00:00
|
|
|
|
UnifyBound(d0,d1);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, gdbterm_unk, gdbterm_nonvar);
|
|
|
|
|
/* Enter Write mode */
|
|
|
|
|
/* set d1 to be the new structure we are going to create */
|
2010-12-16 20:39:53 +00:00
|
|
|
|
START_PREFETCH(xD);
|
2007-11-06 17:02:13 +00:00
|
|
|
|
BEGD(d1);
|
2010-12-16 20:39:53 +00:00
|
|
|
|
d1 = PREG->u.xD.D;
|
|
|
|
|
PREG = NEXTOP(PREG, xD);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, d1);
|
2007-11-06 17:02:13 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
END_PREFETCH();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
/************************************************************************\
|
|
|
|
|
* Optimised Get List Instructions *
|
|
|
|
|
\************************************************************************/
|
|
|
|
|
OpRW(glist_valx, xx);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = XREG(PREG->u.xx.xl);
|
|
|
|
|
deref_head(d0, glist_valx_write);
|
|
|
|
|
glist_valx_read:
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
/* did we find a list? */
|
|
|
|
|
if (!IsPairTerm(d0))
|
|
|
|
|
FAIL();
|
|
|
|
|
/* enter read mode */
|
|
|
|
|
START_PREFETCH(xx);
|
|
|
|
|
pt0 = RepPair(d0);
|
|
|
|
|
SREG = pt0 + 1;
|
|
|
|
|
/* start unification with first argument */
|
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, glist_valx_unk);
|
|
|
|
|
|
|
|
|
|
/* first argument is in d0 */
|
|
|
|
|
glist_valx_nonvar:
|
|
|
|
|
/* first argument is bound */
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d1 = XREG(PREG->u.xx.xr);
|
|
|
|
|
deref_head(d1, glist_valx_nonvar_unk);
|
|
|
|
|
|
|
|
|
|
glist_valx_nonvar_nonvar:
|
|
|
|
|
/* both arguments are bound */
|
|
|
|
|
/* we may have to bind structures */
|
|
|
|
|
PREG = NEXTOP(PREG, xx);
|
|
|
|
|
UnifyBound(d0, d1);
|
|
|
|
|
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
/* deref second argument */
|
|
|
|
|
deref_body(d1, pt1, glist_valx_nonvar_unk, glist_valx_nonvar_nonvar);
|
|
|
|
|
/* head bound, argument unbound */
|
|
|
|
|
PREG = NEXTOP(PREG, xx);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt1, d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
|
|
|
|
|
/* head may be unbound */
|
|
|
|
|
derefa_body(d0, pt0, glist_valx_unk, glist_valx_nonvar);
|
|
|
|
|
/* head is unbound, pt0 has the value */
|
|
|
|
|
d0 = XREG(PREG->u.xx.xr);
|
|
|
|
|
deref_head(d0, glist_valx_var_unk);
|
|
|
|
|
|
|
|
|
|
glist_valx_var_nonvar:
|
|
|
|
|
/* head is unbound, second arg bound */
|
|
|
|
|
PREG = NEXTOP(PREG, xx);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind_Global(pt0, d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
deref_body(d0, pt1, glist_valx_var_unk, glist_valx_var_nonvar);
|
|
|
|
|
/* head and second argument are unbound */
|
|
|
|
|
PREG = NEXTOP(PREG, xx);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
UnifyGlobalCellToCell(pt0, pt1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
END_PREFETCH();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, glist_valx_write, glist_valx_read);
|
|
|
|
|
CACHE_S();
|
|
|
|
|
/* enter write mode */
|
|
|
|
|
S_SREG = H;
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d1 = XREG(PREG->u.xx.xr);
|
|
|
|
|
d0 = AbsPair(S_SREG);
|
|
|
|
|
S_SREG[0] = d1;
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ALWAYS_START_PREFETCH_W(xx);
|
|
|
|
|
PREG = NEXTOP(PREG, xx);
|
|
|
|
|
H = S_SREG + 2;
|
|
|
|
|
WRITEBACK_S(S_SREG+1);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ALWAYS_GONextW();
|
|
|
|
|
ALWAYS_END_PREFETCH_W();
|
|
|
|
|
ENDCACHE_S();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOpRW();
|
|
|
|
|
|
2009-03-05 16:12:21 +00:00
|
|
|
|
OpRW(glist_valy, yx);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2009-03-05 16:12:21 +00:00
|
|
|
|
d0 = XREG(PREG->u.yx.x);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
deref_head(d0, glist_valy_write);
|
|
|
|
|
glist_valy_read:
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
/* did we find a list? */
|
|
|
|
|
if (!IsPairTerm(d0))
|
|
|
|
|
FAIL();
|
2009-03-05 16:12:21 +00:00
|
|
|
|
START_PREFETCH(yx);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* enter read mode */
|
|
|
|
|
pt0 = RepPair(d0);
|
|
|
|
|
SREG = pt0 + 1;
|
|
|
|
|
/* start unification with first argument */
|
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, glist_valy_unk);
|
|
|
|
|
|
|
|
|
|
glist_valy_nonvar:
|
|
|
|
|
/* first argument is bound */
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
BEGP(pt1);
|
2009-03-05 16:12:21 +00:00
|
|
|
|
pt1 = YREG + PREG->u.yx.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d1 = *pt1;
|
2009-03-05 16:12:21 +00:00
|
|
|
|
PREG = NEXTOP(PREG, yx);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
deref_head(d1, glist_valy_nonvar_unk);
|
|
|
|
|
|
|
|
|
|
glist_valy_nonvar_nonvar:
|
|
|
|
|
/* both arguments are bound */
|
|
|
|
|
/* we may have to bind structures */
|
|
|
|
|
SREG = pt0 + 1;
|
|
|
|
|
UnifyBound(d0, d1);
|
|
|
|
|
|
|
|
|
|
/* deref second argument */
|
|
|
|
|
derefa_body(d1, pt1, glist_valy_nonvar_unk, glist_valy_nonvar_nonvar);
|
|
|
|
|
/* first argument bound, second unbound */
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt1, d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
|
|
|
|
|
/* first argument may be unbound */
|
|
|
|
|
derefa_body(d0, pt0, glist_valy_unk, glist_valy_nonvar);
|
|
|
|
|
/* first argument is unbound */
|
|
|
|
|
BEGP(pt1);
|
2009-03-05 16:12:21 +00:00
|
|
|
|
pt1 = YREG+PREG->u.yx.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d1 = *pt1;
|
|
|
|
|
deref_head(d1, glist_valy_var_unk);
|
|
|
|
|
glist_valy_var_nonvar:
|
|
|
|
|
/* first unbound, second bound */
|
2009-03-05 16:12:21 +00:00
|
|
|
|
PREG = NEXTOP(PREG, yx);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind_Global(pt0, d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
derefa_body(d1, pt1, glist_valy_var_unk, glist_valy_var_nonvar);
|
|
|
|
|
/* both arguments are unbound */
|
2009-03-05 16:12:21 +00:00
|
|
|
|
PREG = NEXTOP(PREG, yx);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
UnifyGlobalCellToCell(pt0, pt1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
|
|
|
|
|
END_PREFETCH();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, glist_valy_write, glist_valy_read);
|
|
|
|
|
/* enter write mode */
|
2009-03-05 16:12:21 +00:00
|
|
|
|
START_PREFETCH_W(yx);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGP(pt1);
|
|
|
|
|
pt1 = H;
|
|
|
|
|
d0 = AbsPair(pt1);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
/* include XREG on it */
|
2009-03-05 16:12:21 +00:00
|
|
|
|
d0 = YREG[PREG->u.yx.y];
|
2001-04-09 19:54:03 +00:00
|
|
|
|
pt1[0] = d0;
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
H = pt1 + 2;
|
|
|
|
|
SREG = pt1 + 1;
|
|
|
|
|
ENDP(pt1);
|
2009-03-05 16:12:21 +00:00
|
|
|
|
PREG = NEXTOP(PREG, yx);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONextW();
|
|
|
|
|
END_PREFETCH_W();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOpRW();
|
|
|
|
|
|
|
|
|
|
Op(gl_void_varx, xx);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = XREG(PREG->u.xx.xl);
|
|
|
|
|
deref_head(d0, glist_void_varx_write);
|
|
|
|
|
glist_void_varx_read:
|
|
|
|
|
/* did we find a list? */
|
|
|
|
|
if (!IsPairTerm(d0))
|
|
|
|
|
FAIL();
|
|
|
|
|
ALWAYS_START_PREFETCH(xx);
|
|
|
|
|
/* enter read mode */
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = RepPair(d0);
|
|
|
|
|
d0 = pt0[1];
|
|
|
|
|
XREG(PREG->u.xx.xr) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, xx);
|
|
|
|
|
ALWAYS_GONext();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ALWAYS_END_PREFETCH();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, glist_void_varx_write, glist_void_varx_read);
|
|
|
|
|
/* enter write mode */
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
pt1 = H;
|
|
|
|
|
/* include XREG on it */
|
|
|
|
|
XREG(PREG->u.xx.xr) =
|
|
|
|
|
Unsigned(pt1 + 1);
|
|
|
|
|
RESET_VARIABLE(pt1);
|
|
|
|
|
RESET_VARIABLE(pt1+1);
|
|
|
|
|
H = pt1 + 2;
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = AbsPair(pt1);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = NEXTOP(PREG, xx);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2009-03-05 16:12:21 +00:00
|
|
|
|
Op(gl_void_vary, yx);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2009-03-05 16:12:21 +00:00
|
|
|
|
d0 = XREG(PREG->u.yx.x);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
deref_head(d0, glist_void_vary_write);
|
|
|
|
|
glist_void_vary_read:
|
|
|
|
|
/* did we find a list? */
|
|
|
|
|
if (!IsPairTerm(d0))
|
|
|
|
|
FAIL();
|
|
|
|
|
/* enter read mode */
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = RepPair(d0);
|
|
|
|
|
d0 = pt0[1];
|
|
|
|
|
ENDP(pt0);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(YREG+PREG->u.yx.y,d0);
|
2009-03-05 16:12:21 +00:00
|
|
|
|
PREG = NEXTOP(PREG, yx);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, glist_void_vary_write, glist_void_vary_read);
|
|
|
|
|
/* enter write mode */
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
pt1 = H;
|
|
|
|
|
/* include XREG on it */
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(YREG+PREG->u.yx.y,Unsigned(pt1 + 1));
|
2009-03-05 16:12:21 +00:00
|
|
|
|
PREG = NEXTOP(PREG, yx);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
RESET_VARIABLE(pt1);
|
|
|
|
|
RESET_VARIABLE(pt1+1);
|
|
|
|
|
d0 = AbsPair(pt1);
|
|
|
|
|
H = pt1 + 2;
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(gl_void_valx, xx);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = XREG(PREG->u.xx.xl);
|
|
|
|
|
deref_head(d0, glist_void_valx_write);
|
|
|
|
|
glist_void_valx_read:
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
/* did we find a list? */
|
|
|
|
|
if (!IsPairTerm(d0))
|
|
|
|
|
FAIL();
|
|
|
|
|
/* enter read mode */
|
|
|
|
|
pt0 = RepPair(d0)+1;
|
|
|
|
|
/* start unification with first argument */
|
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, glist_void_valx_unk);
|
|
|
|
|
|
|
|
|
|
glist_void_valx_nonvar:
|
|
|
|
|
/* first argument is bound */
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d1 = XREG(PREG->u.xx.xr);
|
|
|
|
|
deref_head(d1, glist_void_valx_nonvar_unk);
|
|
|
|
|
|
|
|
|
|
glist_void_valx_nonvar_nonvar:
|
|
|
|
|
/* both arguments are bound */
|
|
|
|
|
/* we may have to bind structures */
|
|
|
|
|
PREG = NEXTOP(PREG, xx);
|
|
|
|
|
UnifyBound(d0, d1);
|
|
|
|
|
|
|
|
|
|
/* deref second argument */
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
deref_body(d1, pt1, glist_void_valx_nonvar_unk, glist_void_valx_nonvar_nonvar);
|
|
|
|
|
/* first argument bound, second unbound */
|
|
|
|
|
PREG = NEXTOP(PREG, xx);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt1, d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
|
|
|
|
|
/* first argument may be unbound */
|
|
|
|
|
derefa_body(d0, pt0, glist_void_valx_unk, glist_void_valx_nonvar);
|
|
|
|
|
/* first argument is unbound */
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d1 = XREG(PREG->u.xx.xr);
|
|
|
|
|
deref_head(d1, glist_void_valx_var_unk);
|
|
|
|
|
|
|
|
|
|
glist_void_valx_var_nonvar:
|
|
|
|
|
/* first unbound, second bound */
|
|
|
|
|
PREG = NEXTOP(PREG, xx);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind_Global(pt0, d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
deref_body(d1, pt1, glist_void_valx_var_unk, glist_void_valx_var_nonvar);
|
|
|
|
|
/* both arguments are unbound */
|
|
|
|
|
PREG = NEXTOP(PREG, xx);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
UnifyGlobalCellToCell(pt0, pt1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, glist_void_valx_write, glist_void_valx_read);
|
|
|
|
|
/* enter write mode */
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
pt1 = H;
|
2007-01-24 09:57:25 +00:00
|
|
|
|
d0 = AbsPair(pt1);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, d0);
|
|
|
|
|
pt1 = H;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
/* include XREG on it */
|
|
|
|
|
d0 = XREG(PREG->u.xx.xr);
|
|
|
|
|
RESET_VARIABLE(pt1);
|
|
|
|
|
pt1[1] = d0;
|
|
|
|
|
H = pt1 + 2;
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
PREG = NEXTOP(PREG, xx);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2009-03-05 16:12:21 +00:00
|
|
|
|
Op(gl_void_valy, yx);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2009-03-05 16:12:21 +00:00
|
|
|
|
d0 = XREG(PREG->u.yx.x);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
deref_head(d0, glist_void_valy_write);
|
|
|
|
|
glist_void_valy_read:
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
/* did we find a list? */
|
|
|
|
|
if (!IsPairTerm(d0))
|
|
|
|
|
FAIL();
|
|
|
|
|
/* enter read mode */
|
|
|
|
|
pt0 = RepPair(d0)+1;
|
|
|
|
|
/* start unification with first argument */
|
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, glist_void_valy_unk);
|
|
|
|
|
|
|
|
|
|
glist_void_valy_nonvar:
|
|
|
|
|
/* first argument is bound */
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
BEGP(pt1);
|
2009-03-05 16:12:21 +00:00
|
|
|
|
pt1 = YREG+PREG->u.yx.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d1 = *pt1;
|
|
|
|
|
deref_head(d1, glist_void_valy_nonvar_unk);
|
|
|
|
|
|
|
|
|
|
glist_void_valy_nonvar_nonvar:
|
|
|
|
|
/* both arguments are bound */
|
|
|
|
|
/* we may have to bind structures */
|
2009-03-05 16:12:21 +00:00
|
|
|
|
PREG = NEXTOP(PREG, yx);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
UnifyBound(d0, d1);
|
|
|
|
|
|
|
|
|
|
/* deref second argument */
|
|
|
|
|
derefa_body(d1, pt1, glist_void_valy_nonvar_unk, glist_void_valy_nonvar_nonvar);
|
|
|
|
|
/* first argument bound, second unbound */
|
2009-03-05 16:12:21 +00:00
|
|
|
|
PREG = NEXTOP(PREG, yx);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt1, d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
|
|
|
|
|
/* first argument may be unbound */
|
|
|
|
|
derefa_body(d0, pt0, glist_void_valy_unk, glist_void_valy_nonvar);
|
|
|
|
|
/* first argument is unbound */
|
|
|
|
|
BEGP(pt1);
|
2009-03-05 16:12:21 +00:00
|
|
|
|
pt1 = YREG+PREG->u.yx.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d1 = *pt1;
|
|
|
|
|
deref_head(d1, glist_void_valy_var_unk);
|
|
|
|
|
|
|
|
|
|
glist_void_valy_var_nonvar:
|
|
|
|
|
/* first unbound, second bound */
|
2009-03-05 16:12:21 +00:00
|
|
|
|
PREG = NEXTOP(PREG, yx);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind_Global(pt0, d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
deref_body(d1, pt1, glist_void_valy_var_unk, glist_void_valy_var_nonvar);
|
|
|
|
|
/* both arguments are unbound */
|
2009-03-05 16:12:21 +00:00
|
|
|
|
PREG = NEXTOP(PREG, yx);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
UnifyGlobalCellToCell(pt0, pt1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, glist_void_valy_write, glist_void_valy_read);
|
|
|
|
|
/* enter write mode */
|
|
|
|
|
CACHE_S();
|
|
|
|
|
S_SREG = H;
|
|
|
|
|
d0 = AbsPair(S_SREG);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, d0);
|
|
|
|
|
S_SREG = H;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* include XREG on it */
|
|
|
|
|
BEGD(d1);
|
2009-03-05 16:12:21 +00:00
|
|
|
|
d1 = YREG[PREG->u.yx.y];
|
2001-04-09 19:54:03 +00:00
|
|
|
|
RESET_VARIABLE(S_SREG);
|
|
|
|
|
S_SREG[1] = d1;
|
|
|
|
|
ENDD(d1);
|
2009-03-05 16:12:21 +00:00
|
|
|
|
PREG = NEXTOP(PREG, yx);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
H = S_SREG + 2;
|
|
|
|
|
ENDCACHE_S();
|
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
/************************************************************************\
|
|
|
|
|
* Unify instructions *
|
|
|
|
|
\************************************************************************/
|
|
|
|
|
|
|
|
|
|
Op(unify_x_var, ox);
|
|
|
|
|
CACHE_S();
|
|
|
|
|
READ_IN_S();
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = *S_SREG;
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#ifdef YAPOR_SBA
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (d0 == 0)
|
|
|
|
|
d0 = (CELL)S_SREG;
|
|
|
|
|
#endif
|
|
|
|
|
WRITEBACK_S(S_SREG+1);
|
|
|
|
|
ALWAYS_START_PREFETCH(ox);
|
|
|
|
|
XREG(PREG->u.ox.x) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, ox);
|
|
|
|
|
ALWAYS_GONext();
|
|
|
|
|
ALWAYS_END_PREFETCH();
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDCACHE_S();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
OpW(unify_x_var_write, ox);
|
|
|
|
|
CACHE_S();
|
|
|
|
|
READ_IN_S();
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = &XREG(PREG->u.ox.x);
|
|
|
|
|
PREG = NEXTOP(PREG, ox);
|
|
|
|
|
RESET_VARIABLE(S_SREG);
|
|
|
|
|
*pt0 = (CELL) S_SREG;
|
|
|
|
|
WRITEBACK_S(S_SREG+1);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDCACHE_S();
|
|
|
|
|
GONextW();
|
|
|
|
|
ENDOpW();
|
|
|
|
|
|
|
|
|
|
BOp(unify_l_x_var, ox);
|
|
|
|
|
ALWAYS_START_PREFETCH(ox);
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = SREG[0];
|
|
|
|
|
pt0 = &XREG(PREG->u.ox.x);
|
|
|
|
|
PREG = NEXTOP(PREG, ox);
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#ifdef YAPOR_SBA
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (d0 == 0)
|
|
|
|
|
d0 = (CELL)SREG;
|
|
|
|
|
#endif
|
|
|
|
|
*pt0 = d0;
|
|
|
|
|
ALWAYS_GONext();
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ALWAYS_END_PREFETCH();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
BOp(unify_l_x_var_write, ox);
|
|
|
|
|
ALWAYS_START_PREFETCH(ox);
|
|
|
|
|
CACHE_S();
|
|
|
|
|
READ_IN_S();
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = &XREG(PREG->u.ox.x);
|
|
|
|
|
PREG = NEXTOP(PREG, ox);
|
|
|
|
|
RESET_VARIABLE(S_SREG);
|
|
|
|
|
*pt0 = (CELL)S_SREG;
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDCACHE_S();
|
|
|
|
|
ALWAYS_GONext();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
ALWAYS_END_PREFETCH();
|
|
|
|
|
|
|
|
|
|
BOp(unify_x_var2, oxx);
|
|
|
|
|
CACHE_S();
|
|
|
|
|
ALWAYS_START_PREFETCH(oxx);
|
|
|
|
|
READ_IN_S();
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = &XREG(PREG->u.oxx.xr);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = S_SREG[0];
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d1 = S_SREG[1];
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#ifdef YAPOR_SBA
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (d0 == 0)
|
|
|
|
|
d0 = (CELL)S_SREG;
|
|
|
|
|
if (d1 == 0)
|
|
|
|
|
d1 = (CELL)(S_SREG+1);
|
|
|
|
|
#endif
|
|
|
|
|
WRITEBACK_S(S_SREG+2);
|
|
|
|
|
XREG(PREG->u.oxx.xl) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, oxx);
|
|
|
|
|
*pt0 = d1;
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ALWAYS_GONext();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
ALWAYS_END_PREFETCH();
|
|
|
|
|
ENDCACHE_S();
|
|
|
|
|
|
|
|
|
|
OpW(unify_x_var2_write, oxx);
|
|
|
|
|
CACHE_S();
|
|
|
|
|
READ_IN_S();
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = &XREG(PREG->u.oxx.xr);
|
|
|
|
|
RESET_VARIABLE(S_SREG);
|
|
|
|
|
XREG(PREG->u.oxx.xl) = (CELL) S_SREG;
|
|
|
|
|
S_SREG++;
|
|
|
|
|
PREG = NEXTOP(PREG, oxx);
|
|
|
|
|
RESET_VARIABLE(S_SREG);
|
|
|
|
|
*pt0 = (CELL) S_SREG;
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
WRITEBACK_S(S_SREG+1);
|
|
|
|
|
ENDCACHE_S();
|
|
|
|
|
GONextW();
|
|
|
|
|
ENDOpW();
|
|
|
|
|
|
|
|
|
|
BOp(unify_l_x_var2, oxx);
|
|
|
|
|
ALWAYS_START_PREFETCH(oxx);
|
|
|
|
|
CACHE_S();
|
|
|
|
|
READ_IN_S();
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = &XREG(PREG->u.oxx.xr);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = S_SREG[0];
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d1 = S_SREG[1];
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#ifdef YAPOR_SBA
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (d0 == 0)
|
|
|
|
|
XREG(PREG->u.oxx.xl) = (CELL)S_SREG;
|
|
|
|
|
else
|
|
|
|
|
#endif
|
|
|
|
|
XREG(PREG->u.oxx.xl) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, oxx);
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#ifdef YAPOR_SBA
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (d1 == 0)
|
|
|
|
|
*pt0 = (CELL)(S_SREG+1);
|
|
|
|
|
else
|
|
|
|
|
#endif
|
|
|
|
|
*pt0 = d1;
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDCACHE_S();
|
|
|
|
|
ALWAYS_GONext();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
ALWAYS_END_PREFETCH();
|
|
|
|
|
|
|
|
|
|
Op(unify_l_x_var2_write, oxx);
|
|
|
|
|
CACHE_S();
|
|
|
|
|
READ_IN_S();
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = &XREG(PREG->u.oxx.xr);
|
|
|
|
|
XREG(PREG->u.oxx.xl) = (CELL) S_SREG;
|
|
|
|
|
RESET_VARIABLE(S_SREG);
|
|
|
|
|
S_SREG++;
|
|
|
|
|
*pt0 = (CELL) S_SREG;
|
|
|
|
|
PREG = NEXTOP(PREG, oxx);
|
|
|
|
|
RESET_VARIABLE(S_SREG);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDCACHE_S();
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(unify_y_var, oy);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = *SREG++;
|
2011-09-15 15:40:47 +01:00
|
|
|
|
#ifdef YAPOR_SBA
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (d0 == 0) {
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(YREG+PREG->u.oy.y,(CELL)(SREG-1));
|
2001-04-09 19:54:03 +00:00
|
|
|
|
} else
|
|
|
|
|
#else
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(YREG+PREG->u.oy.y,d0);
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#endif /* YAPOR_SBA */
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = NEXTOP(PREG, oy);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
OpW(unify_y_var_write, oy);
|
|
|
|
|
CACHE_S();
|
|
|
|
|
READ_IN_S();
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(YREG+PREG->u.oy.y,(CELL) S_SREG);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = NEXTOP(PREG, oy);
|
|
|
|
|
RESET_VARIABLE(S_SREG);
|
|
|
|
|
WRITEBACK_S(S_SREG+1);
|
|
|
|
|
ENDCACHE_S();
|
|
|
|
|
GONextW();
|
|
|
|
|
ENDOpW();
|
|
|
|
|
|
|
|
|
|
Op(unify_l_y_var, oy);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = SREG[0];
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#ifdef YAPOR_SBA
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (d0 == 0) {
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(YREG+PREG->u.oy.y,(CELL)SREG);
|
|
|
|
|
} else
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#else
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(YREG+PREG->u.oy.y,d0);
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#endif /* YAPOR_SBA */
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = NEXTOP(PREG, oy);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(unify_l_y_var_write, oy);
|
|
|
|
|
CACHE_S();
|
|
|
|
|
READ_IN_S();
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(YREG+PREG->u.oy.y,(CELL) S_SREG);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = NEXTOP(PREG, oy);
|
|
|
|
|
RESET_VARIABLE(S_SREG);
|
|
|
|
|
ENDCACHE_S();
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
/* We assume the value in X is pointing to an object in the
|
|
|
|
|
* global stack */
|
|
|
|
|
Op(unify_x_val, ox);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = SREG;
|
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, uvalx_unk);
|
|
|
|
|
|
|
|
|
|
uvalx_nonvar:
|
|
|
|
|
/* first argument is bound */
|
|
|
|
|
d1 = XREG(PREG->u.ox.x);
|
|
|
|
|
deref_head(d1, uvalx_nonvar_unk);
|
|
|
|
|
|
|
|
|
|
uvalx_nonvar_nonvar:
|
|
|
|
|
/* both arguments are bound */
|
|
|
|
|
/* we may have to bind structures */
|
|
|
|
|
PREG = NEXTOP(PREG, ox);
|
|
|
|
|
SREG++;
|
|
|
|
|
UnifyBound(d0, d1);
|
|
|
|
|
|
|
|
|
|
/* deref second argument */
|
|
|
|
|
/* pt0 is in the structure and pt1 the register */
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
deref_body(d1, pt1, uvalx_nonvar_unk, uvalx_nonvar_nonvar);
|
|
|
|
|
/* first argument bound, second unbound */
|
|
|
|
|
PREG = NEXTOP(PREG, ox);
|
|
|
|
|
SREG++;
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt1, d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
2011-09-15 15:40:47 +01:00
|
|
|
|
ENDP(pt1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
/* first argument may be unbound */
|
|
|
|
|
derefa_body(d0, pt0, uvalx_unk, uvalx_nonvar);
|
|
|
|
|
/* first argument is unbound */
|
|
|
|
|
d1 = XREG(PREG->u.ox.x);
|
|
|
|
|
deref_head(d1, uvalx_var_unk);
|
|
|
|
|
|
|
|
|
|
uvalx_var_nonvar:
|
|
|
|
|
/* first unbound, second bound */
|
|
|
|
|
PREG = NEXTOP(PREG, ox);
|
|
|
|
|
SREG++;
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind_Global(pt0, d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
deref_body(d1, pt1, uvalx_var_unk, uvalx_var_nonvar);
|
|
|
|
|
/* both arguments are unbound */
|
|
|
|
|
PREG = NEXTOP(PREG, ox);
|
|
|
|
|
SREG++;
|
2011-03-18 19:34:58 +00:00
|
|
|
|
UnifyGlobalCellToCell(pt0, pt1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
OpW(unify_x_val_write, ox);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* we are in write mode */
|
2008-08-21 13:38:25 +01:00
|
|
|
|
*SREG++ = XREG(PREG->u.ox.x);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = NEXTOP(PREG, ox);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
GONextW();
|
|
|
|
|
ENDOpW();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
/* We assume the value in X is pointing to an object in the
|
|
|
|
|
* global stack */
|
|
|
|
|
Op(unify_l_x_val, ox);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = SREG;
|
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, ulvalx_unk);
|
|
|
|
|
|
|
|
|
|
ulvalx_nonvar:
|
|
|
|
|
/* first argument is bound */
|
|
|
|
|
d1 = XREG(PREG->u.ox.x);
|
|
|
|
|
deref_head(d1, ulvalx_nonvar_unk);
|
|
|
|
|
|
|
|
|
|
ulvalx_nonvar_nonvar:
|
|
|
|
|
/* both arguments are bound */
|
|
|
|
|
/* we may have to bind structures */
|
|
|
|
|
PREG = NEXTOP(PREG, ox);
|
|
|
|
|
UnifyBound(d0, d1);
|
|
|
|
|
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
/* deref second argument */
|
|
|
|
|
deref_body(d1, pt1, ulvalx_nonvar_unk, ulvalx_nonvar_nonvar);
|
|
|
|
|
/* first argument bound, second unbound */
|
|
|
|
|
PREG = NEXTOP(PREG, ox);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt1, d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
|
|
|
|
|
/* first argument may be unbound */
|
|
|
|
|
derefa_body(d0, pt0, ulvalx_unk, ulvalx_nonvar);
|
|
|
|
|
/* first argument is unbound */
|
|
|
|
|
d1 = XREG(PREG->u.ox.x);
|
|
|
|
|
deref_head(d1, ulvalx_var_unk);
|
|
|
|
|
|
|
|
|
|
ulvalx_var_nonvar:
|
|
|
|
|
/* first unbound, second bound */
|
|
|
|
|
PREG = NEXTOP(PREG, ox);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind_Global(pt0, d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
deref_body(d1, pt1, ulvalx_var_unk, ulvalx_var_nonvar);
|
|
|
|
|
/* both arguments are unbound */
|
|
|
|
|
PREG = NEXTOP(PREG, ox);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
UnifyGlobalCellToCell(pt0, pt1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(unify_l_x_val_write, ox);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* we are in write mode */
|
2008-08-21 13:38:25 +01:00
|
|
|
|
SREG[0] = XREG(PREG->u.ox.x);
|
|
|
|
|
PREG = NEXTOP(PREG, ox);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
/* We assume the value in X is pointing to an object in the
|
|
|
|
|
* global stack */
|
|
|
|
|
Op(unify_y_val, oy);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = SREG;
|
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, uvaly_unk);
|
|
|
|
|
|
|
|
|
|
uvaly_nonvar:
|
|
|
|
|
/* first argument is bound */
|
|
|
|
|
BEGP(pt1);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
pt1 = YREG+PREG->u.oy.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d1 = *pt1;
|
|
|
|
|
deref_head(d1, uvaly_nonvar_unk);
|
|
|
|
|
|
|
|
|
|
uvaly_nonvar_nonvar:
|
|
|
|
|
/* both arguments are bound */
|
|
|
|
|
/* we may have to bind structures */
|
|
|
|
|
PREG = NEXTOP(PREG, oy);
|
|
|
|
|
SREG++;
|
|
|
|
|
UnifyBound(d0, d1);
|
|
|
|
|
|
|
|
|
|
/* deref second argument */
|
|
|
|
|
derefa_body(d1, pt1, uvaly_nonvar_unk, uvaly_nonvar_nonvar);
|
|
|
|
|
/* first argument bound, second unbound */
|
|
|
|
|
PREG = NEXTOP(PREG, oy);
|
|
|
|
|
SREG++;
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt1, d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
|
|
|
|
|
/* first argument may be unbound */
|
|
|
|
|
derefa_body(d0, pt0, uvaly_unk, uvaly_nonvar);
|
|
|
|
|
/* first argument is unbound */
|
|
|
|
|
BEGP(pt1);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
pt1 = YREG+PREG->u.oy.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d1 = *pt1;
|
|
|
|
|
deref_head(d1, uvaly_var_unk);
|
|
|
|
|
|
|
|
|
|
uvaly_var_nonvar:
|
|
|
|
|
/* first unbound, second bound */
|
|
|
|
|
PREG = NEXTOP(PREG, oy);
|
|
|
|
|
SREG++;
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind_Global(pt0, d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
derefa_body(d1, pt1, uvaly_var_unk, uvaly_var_nonvar);
|
|
|
|
|
/* both arguments are unbound */
|
|
|
|
|
PREG = NEXTOP(PREG, oy);
|
|
|
|
|
SREG++;
|
2011-03-18 19:34:58 +00:00
|
|
|
|
UnifyGlobalCellToCell(pt0, pt1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
OpW(unify_y_val_write, oy);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* we are in write mode */
|
|
|
|
|
BEGD(d0);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
d0 = YREG[PREG->u.oy.y];
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#ifdef YAPOR_SBA
|
2008-08-21 13:38:25 +01:00
|
|
|
|
if (d0 == 0) /* free variable */
|
|
|
|
|
*SREG++ = (CELL)(YREG+PREG->u.oy.y);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
else
|
|
|
|
|
#endif
|
2008-08-21 13:38:25 +01:00
|
|
|
|
*SREG++ = d0;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDD(d0);
|
|
|
|
|
PREG = NEXTOP(PREG, oy);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
GONextW();
|
|
|
|
|
ENDOpW();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
/* We assume the value in X is pointing to an object in the
|
|
|
|
|
* global stack */
|
|
|
|
|
Op(unify_l_y_val, oy);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = SREG;
|
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, ulvaly_unk);
|
|
|
|
|
|
|
|
|
|
ulvaly_nonvar:
|
|
|
|
|
/* first argument is bound */
|
|
|
|
|
BEGP(pt1);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
pt1 = YREG+PREG->u.oy.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d1 = *pt1;
|
|
|
|
|
deref_head(d1, ulvaly_nonvar_unk);
|
|
|
|
|
|
|
|
|
|
ulvaly_nonvar_nonvar:
|
|
|
|
|
/* both arguments are bound */
|
|
|
|
|
/* we may have to bind structures */
|
|
|
|
|
PREG = NEXTOP(PREG, oy);
|
|
|
|
|
UnifyBound(d0, d1);
|
|
|
|
|
|
|
|
|
|
/* deref second argument */
|
|
|
|
|
derefa_body(d1, pt1, ulvaly_nonvar_unk, ulvaly_nonvar_nonvar);
|
|
|
|
|
/* first argument bound, second unbound */
|
|
|
|
|
PREG = NEXTOP(PREG, oy);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt1, d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
|
|
|
|
|
/* first argument may be unbound */
|
|
|
|
|
derefa_body(d0, pt0, ulvaly_unk, ulvaly_nonvar);
|
|
|
|
|
/* first argument is unbound */
|
|
|
|
|
BEGP(pt1);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
pt1 = YREG+PREG->u.oy.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d1 = *pt1;
|
|
|
|
|
deref_head(d1, ulvaly_var_unk);
|
|
|
|
|
|
|
|
|
|
ulvaly_var_nonvar:
|
|
|
|
|
/* first unbound, second bound */
|
|
|
|
|
PREG = NEXTOP(PREG, oy);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind_Global(pt0, d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
/* Here we are in trouble: we have a clash between pt1 and
|
|
|
|
|
* SREG. We address this by storing SREG in d0 for the duration. */
|
|
|
|
|
derefa_body(d1, pt1, ulvaly_var_unk, ulvaly_var_nonvar);
|
|
|
|
|
/* both arguments are unbound */
|
|
|
|
|
PREG = NEXTOP(PREG, oy);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
UnifyGlobalCellToCell(pt0, pt1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(unify_l_y_val_write, oy);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* we are in write mode */
|
|
|
|
|
BEGD(d0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
d0 = YREG[PREG->u.oy.y];
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#ifdef YAPOR_SBA
|
2008-08-21 13:38:25 +01:00
|
|
|
|
if (d0 == 0) /* new variable */
|
|
|
|
|
SREG[0] = (CELL)(YREG+PREG->u.oy.y);
|
|
|
|
|
else
|
|
|
|
|
#endif
|
|
|
|
|
SREG[0] = d0;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDD(d0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, oy);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
/* In the next instructions, we do not know anything about
|
|
|
|
|
* what is in X */
|
|
|
|
|
Op(unify_x_loc, ox);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = SREG;
|
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, uvalx_loc_unk);
|
|
|
|
|
|
|
|
|
|
uvalx_loc_nonvar:
|
|
|
|
|
/* first argument is bound */
|
|
|
|
|
d1 = XREG(PREG->u.ox.x);
|
|
|
|
|
deref_head(d1, uvalx_loc_nonvar_unk);
|
|
|
|
|
|
|
|
|
|
uvalx_loc_nonvar_nonvar:
|
|
|
|
|
/* both arguments are bound */
|
|
|
|
|
/* we may have to bind structures */
|
|
|
|
|
PREG = NEXTOP(PREG, ox);
|
|
|
|
|
SREG++;
|
|
|
|
|
UnifyBound(d0, d1);
|
|
|
|
|
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
/* deref second argument */
|
|
|
|
|
deref_body(d1, pt1, uvalx_loc_nonvar_unk, uvalx_loc_nonvar_nonvar);
|
|
|
|
|
/* first argument bound, second unbound */
|
|
|
|
|
PREG = NEXTOP(PREG, ox);
|
|
|
|
|
SREG++;
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt1, d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
/* first argument may be unbound */
|
|
|
|
|
derefa_body(d0, pt0, uvalx_loc_unk, uvalx_loc_nonvar);
|
|
|
|
|
/* first argument is unbound */
|
|
|
|
|
d1 = XREG(PREG->u.ox.x);
|
|
|
|
|
deref_head(d1, uvalx_loc_var_unk);
|
|
|
|
|
|
|
|
|
|
uvalx_loc_var_nonvar:
|
|
|
|
|
/* first unbound, second bound */
|
|
|
|
|
PREG = NEXTOP(PREG, ox);
|
|
|
|
|
SREG++;
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind_Global(pt0, d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
/* Here we are in trouble: we have a clash between pt1 and
|
|
|
|
|
* SREG. We address this by storing SREG in d0 for the duration. */
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
deref_body(d1, pt1, uvalx_loc_var_unk, uvalx_loc_var_nonvar);
|
|
|
|
|
/* both arguments are unbound */
|
|
|
|
|
PREG = NEXTOP(PREG, ox);
|
|
|
|
|
SREG++;
|
2011-03-18 19:34:58 +00:00
|
|
|
|
UnifyCells(pt0, pt1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
OpW(unify_x_loc_write, ox);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* we are in write mode */
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = XREG(PREG->u.ox.x);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
deref_head(d0, unify_x_loc_unk);
|
|
|
|
|
unify_x_loc_nonvar:
|
|
|
|
|
*SREG++ = d0;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = NEXTOP(PREG, ox);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
GONextW();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
deref_body(d0, pt0, unify_x_loc_unk, unify_x_loc_nonvar);
|
|
|
|
|
/* move ahead in the instructions */
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = NEXTOP(PREG, ox);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
/* d0 is a variable, check whether we need to globalise it */
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (pt0 < H) {
|
|
|
|
|
/* variable is global */
|
2008-08-21 13:38:25 +01:00
|
|
|
|
*SREG++ = Unsigned(pt0);
|
|
|
|
|
GONextW();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
else {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
/* bind our variable to the structure */
|
|
|
|
|
CACHE_S();
|
|
|
|
|
READ_IN_S();
|
|
|
|
|
Bind_Local(pt0, Unsigned(S_SREG));
|
|
|
|
|
RESET_VARIABLE(S_SREG);
|
|
|
|
|
WRITEBACK_S(S_SREG+1);
|
|
|
|
|
ENDCACHE_S();
|
|
|
|
|
GONextW();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOpW();
|
|
|
|
|
|
|
|
|
|
/* In the next instructions, we do not know anything about
|
|
|
|
|
* what is in X */
|
|
|
|
|
Op(unify_l_x_loc, ox);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = SREG;
|
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, ulvalx_loc_unk);
|
|
|
|
|
|
|
|
|
|
ulvalx_loc_nonvar:
|
|
|
|
|
/* first argument is bound */
|
|
|
|
|
d1 = XREG(PREG->u.ox.x);
|
|
|
|
|
deref_head(d1, ulvalx_loc_nonvar_unk);
|
|
|
|
|
|
|
|
|
|
ulvalx_loc_nonvar_nonvar:
|
|
|
|
|
/* both arguments are bound */
|
|
|
|
|
/* we may have to bind structures */
|
|
|
|
|
PREG = NEXTOP(PREG, ox);
|
|
|
|
|
UnifyBound(d0, d1);
|
|
|
|
|
|
|
|
|
|
/* deref second argument */
|
|
|
|
|
deref_body(d1, pt0, ulvalx_loc_nonvar_unk, ulvalx_loc_nonvar_nonvar);
|
|
|
|
|
/* first argument bound, second unbound */
|
|
|
|
|
PREG = NEXTOP(PREG, ox);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
/* first argument may be unbound */
|
|
|
|
|
derefa_body(d0, pt0, ulvalx_loc_unk, ulvalx_loc_nonvar);
|
|
|
|
|
/* first argument is unbound */
|
|
|
|
|
d1 = XREG(PREG->u.ox.x);
|
|
|
|
|
deref_head(d1, ulvalx_loc_var_unk);
|
|
|
|
|
|
|
|
|
|
ulvalx_loc_var_nonvar:
|
|
|
|
|
/* first unbound, second bound */
|
|
|
|
|
PREG = NEXTOP(PREG, ox);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind_Global(pt0, d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
deref_body(d1, pt1, ulvalx_loc_var_unk, ulvalx_loc_var_nonvar);
|
|
|
|
|
/* both arguments are unbound */
|
|
|
|
|
PREG = NEXTOP(PREG, ox);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
UnifyGlobalCellToCell(pt0, pt1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(unify_l_x_loc_write, ox);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* we are in write mode */
|
|
|
|
|
BEGD(d0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
d0 = XREG(PREG->u.ox.x);
|
|
|
|
|
deref_head(d0, ulnify_x_loc_unk);
|
|
|
|
|
ulnify_x_loc_nonvar:
|
|
|
|
|
SREG[0] = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, ox);
|
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, ulnify_x_loc_unk, ulnify_x_loc_nonvar);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* d0 is a variable, check whether we need to globalise it */
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, ox);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (pt0 < H) {
|
|
|
|
|
/* variable is global */
|
2008-08-21 13:38:25 +01:00
|
|
|
|
SREG[0] = Unsigned(pt0);
|
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
/* create a new Heap variable and bind our variable to it */
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Bind_Local(pt0, Unsigned(SREG));
|
|
|
|
|
RESET_VARIABLE(SREG);
|
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOpW();
|
|
|
|
|
|
|
|
|
|
Op(unify_y_loc, oy);
|
|
|
|
|
/* we are in read mode */
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = SREG;
|
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, uvaly_loc_unk);
|
|
|
|
|
|
|
|
|
|
uvaly_loc_nonvar:
|
|
|
|
|
/* structure is bound */
|
|
|
|
|
BEGP(pt1);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
pt1 = YREG+PREG->u.oy.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d1 = *pt1;
|
|
|
|
|
deref_head(d1, uvaly_loc_nonvar_unk);
|
|
|
|
|
|
|
|
|
|
uvaly_loc_nonvar_nonvar:
|
|
|
|
|
/* both arguments are bound */
|
|
|
|
|
/* we may have to bind structures */
|
|
|
|
|
PREG = NEXTOP(PREG, oy);
|
|
|
|
|
SREG++;
|
|
|
|
|
UnifyBound(d0, d1);
|
|
|
|
|
|
|
|
|
|
/* deref second argument */
|
|
|
|
|
derefa_body(d1, pt1, uvaly_loc_nonvar_unk, uvaly_loc_nonvar_nonvar);
|
|
|
|
|
/* first argument bound, second unbound */
|
|
|
|
|
PREG = NEXTOP(PREG, oy);
|
|
|
|
|
SREG++;
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt1, d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
|
|
|
|
|
/* first argument may be unbound */
|
|
|
|
|
derefa_body(d0, pt0, uvaly_loc_unk, uvaly_loc_nonvar);
|
|
|
|
|
/* first argument is unbound */
|
|
|
|
|
BEGP(pt1);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
pt1 = YREG+PREG->u.oy.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d1 = *pt1;
|
|
|
|
|
deref_head(d1, uvaly_loc_var_unk);
|
|
|
|
|
|
|
|
|
|
uvaly_loc_var_nonvar:
|
|
|
|
|
/* first unbound, second bound */
|
|
|
|
|
PREG = NEXTOP(PREG, oy);
|
|
|
|
|
SREG++;
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind_Global(pt0, d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
/* Here we are in trouble: we have a clash between pt1 and
|
|
|
|
|
* SREG. We address this by storing SREG in d0 for the duration. */
|
|
|
|
|
derefa_body(d1, pt1, uvaly_loc_var_unk, uvaly_loc_var_nonvar);
|
|
|
|
|
/* both arguments are unbound */
|
|
|
|
|
PREG = NEXTOP(PREG, oy);
|
|
|
|
|
SREG++;
|
2011-03-18 19:34:58 +00:00
|
|
|
|
UnifyCells(pt0, pt1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
OpW(unify_y_loc_write, oy);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* we are in write mode */
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGP(pt0);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
pt0 = YREG+PREG->u.oy.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d0 = *pt0;
|
2008-08-21 13:38:25 +01:00
|
|
|
|
deref_head(d0, unify_y_loc_unk);
|
|
|
|
|
unify_y_loc_nonvar:
|
|
|
|
|
*SREG++ = d0;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = NEXTOP(PREG, oy);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
GONextW();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
derefa_body(d0, pt0, unify_y_loc_unk, unify_y_loc_nonvar);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* d0 is a variable, check whether we need to globalise it */
|
|
|
|
|
PREG = NEXTOP(PREG, oy);
|
|
|
|
|
if (pt0 < H) {
|
|
|
|
|
/* variable is global */
|
2008-08-21 13:38:25 +01:00
|
|
|
|
*SREG++ = Unsigned(pt0);
|
|
|
|
|
GONextW();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
/* create a new Heap variable and bind our variable to it */
|
|
|
|
|
CACHE_S();
|
|
|
|
|
READ_IN_S();
|
|
|
|
|
Bind_Local(pt0, Unsigned(S_SREG));
|
|
|
|
|
RESET_VARIABLE(S_SREG);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
WRITEBACK_S(S_SREG+1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDCACHE_S();
|
2008-08-21 13:38:25 +01:00
|
|
|
|
GONextW();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
ENDOpW();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
Op(unify_l_y_loc, oy);
|
|
|
|
|
/* else we are in read mode */
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = SREG;
|
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, ulvaly_loc_unk);
|
|
|
|
|
|
|
|
|
|
ulvaly_loc_nonvar:
|
|
|
|
|
/* structure is bound */
|
|
|
|
|
BEGP(pt1);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
pt1 = YREG+PREG->u.oy.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d1 = *pt1;
|
|
|
|
|
deref_head(d1, ulvaly_loc_nonvar_unk);
|
|
|
|
|
|
|
|
|
|
ulvaly_loc_nonvar_nonvar:
|
|
|
|
|
/* both arguments are bound */
|
|
|
|
|
/* we may have to bind structures */
|
|
|
|
|
PREG = NEXTOP(PREG, oy);
|
|
|
|
|
UnifyBound(d0, d1);
|
|
|
|
|
|
|
|
|
|
/* deref second argument */
|
|
|
|
|
derefa_body(d1, pt1, ulvaly_loc_nonvar_unk, ulvaly_loc_nonvar_nonvar);
|
|
|
|
|
/* first argument bound, second unbound */
|
|
|
|
|
PREG = NEXTOP(PREG, oy);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt1, d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
|
|
|
|
|
/* first argument may be unbound */
|
|
|
|
|
derefa_body(d0, pt0, ulvaly_loc_unk, ulvaly_loc_nonvar);
|
|
|
|
|
/* first argument is unbound */
|
|
|
|
|
BEGP(pt1);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
pt1 = YREG+PREG->u.oy.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d1 = *pt1;
|
|
|
|
|
deref_head(d1, ulvaly_loc_var_unk);
|
|
|
|
|
|
|
|
|
|
ulvaly_loc_var_nonvar:
|
|
|
|
|
/* first unbound, second bound */
|
|
|
|
|
PREG = NEXTOP(PREG, oy);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind_Global(pt0, d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
/* Here we are in trouble: we have a clash between pt1 and
|
|
|
|
|
* SREG. We address this by storing SREG in d0 for the duration. */
|
|
|
|
|
derefa_body(d1, pt1, ulvaly_loc_var_unk, ulvaly_loc_var_nonvar);
|
|
|
|
|
/* both arguments are unbound */
|
|
|
|
|
PREG = NEXTOP(PREG, oy);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
UnifyGlobalCellToCell(pt0, pt1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(unify_l_y_loc_write, oy);
|
|
|
|
|
/* we are in write mode */
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = YREG+PREG->u.oy.y;
|
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, ulunify_y_loc_unk);
|
|
|
|
|
ulunify_y_loc_nonvar:
|
|
|
|
|
SREG[0] = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, oy);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
derefa_body(d0, pt0, ulunify_y_loc_unk, ulunify_y_loc_nonvar);
|
|
|
|
|
/* d0 is a variable, check whether we need to globalise it */
|
|
|
|
|
PREG = NEXTOP(PREG, oy);
|
|
|
|
|
if (pt0 < H) {
|
|
|
|
|
/* variable is global */
|
|
|
|
|
SREG[0] = Unsigned(pt0);
|
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
/* create a new Heap variable and bind our variable to it */
|
|
|
|
|
CACHE_S();
|
|
|
|
|
READ_IN_S();
|
|
|
|
|
Bind_Local(pt0, Unsigned(S_SREG));
|
|
|
|
|
RESET_VARIABLE(S_SREG);
|
|
|
|
|
ENDCACHE_S();
|
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(unify_void, o);
|
2011-10-03 15:29:57 -03:00
|
|
|
|
START_PREFETCH(o);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, o);
|
2011-10-03 15:29:57 -03:00
|
|
|
|
SREG++;
|
2008-08-21 13:38:25 +01:00
|
|
|
|
GONext();
|
2011-10-03 15:29:57 -03:00
|
|
|
|
END_PREFETCH();
|
2008-08-21 13:38:25 +01:00
|
|
|
|
ENDOp();
|
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
OpW(unify_void_write, o);
|
|
|
|
|
CACHE_S();
|
|
|
|
|
READ_IN_S();
|
|
|
|
|
PREG = NEXTOP(PREG, o);
|
|
|
|
|
RESET_VARIABLE(S_SREG);
|
|
|
|
|
WRITEBACK_S(S_SREG+1);
|
|
|
|
|
ENDCACHE_S();
|
|
|
|
|
GONextW();
|
|
|
|
|
ENDOpW();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(unify_l_void, o);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = NEXTOP(PREG, o);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(unify_l_void_write, o);
|
|
|
|
|
PREG = NEXTOP(PREG, o);
|
|
|
|
|
RESET_VARIABLE(SREG);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(unify_n_voids, os);
|
|
|
|
|
SREG += PREG->u.os.s;
|
|
|
|
|
PREG = NEXTOP(PREG, os);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
OpW(unify_n_voids_write, os);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
CACHE_S();
|
|
|
|
|
d0 = PREG->u.os.s;
|
|
|
|
|
READ_IN_S();
|
|
|
|
|
PREG = NEXTOP(PREG, os);
|
|
|
|
|
for (; d0 > 0; d0--) {
|
|
|
|
|
RESET_VARIABLE(S_SREG);
|
|
|
|
|
S_SREG++;
|
|
|
|
|
}
|
|
|
|
|
WRITEBACK_S(S_SREG);
|
|
|
|
|
ENDCACHE_S();
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
GONextW();
|
|
|
|
|
ENDOpW();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(unify_l_n_voids, os);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = NEXTOP(PREG, os);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(unify_l_n_voids_write, os);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = PREG->u.os.s;
|
|
|
|
|
PREG = NEXTOP(PREG, os);
|
|
|
|
|
CACHE_S();
|
|
|
|
|
READ_IN_S();
|
|
|
|
|
for (; d0 > 0; d0--) {
|
|
|
|
|
RESET_VARIABLE(S_SREG);
|
|
|
|
|
S_SREG++;
|
|
|
|
|
}
|
|
|
|
|
ENDCACHE_S();
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(unify_atom, oc);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = SREG++;
|
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, uatom_unk);
|
|
|
|
|
uatom_nonvar:
|
|
|
|
|
if (d0 != PREG->u.oc.c) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
PREG = NEXTOP(PREG, oc);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
derefa_body(d0, pt0, uatom_unk, uatom_nonvar);
|
|
|
|
|
d0 = PREG->u.oc.c;
|
|
|
|
|
PREG = NEXTOP(PREG, oc);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind_Global(pt0, d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
OpW(unify_atom_write, oc);
|
|
|
|
|
* SREG++ = PREG->u.oc.c;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = NEXTOP(PREG, oc);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
GONextW();
|
|
|
|
|
ENDOpW();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
Op(unify_l_atom, oc);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = SREG;
|
|
|
|
|
d0 = *SREG;
|
|
|
|
|
deref_head(d0, ulatom_unk);
|
|
|
|
|
ulatom_nonvar:
|
|
|
|
|
if (d0 != PREG->u.oc.c) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
PREG = NEXTOP(PREG, oc);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
derefa_body(d0, pt0, ulatom_unk, ulatom_nonvar);
|
|
|
|
|
d0 = PREG->u.oc.c;
|
|
|
|
|
PREG = NEXTOP(PREG, oc);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind_Global(pt0, d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(unify_l_atom_write, oc);
|
|
|
|
|
SREG[0] = PREG->u.oc.c;
|
|
|
|
|
PREG = NEXTOP(PREG, oc);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
Op(unify_n_atoms, osc);
|
|
|
|
|
{
|
|
|
|
|
register Int i = PREG->u.osc.s; /* not enough registers */
|
|
|
|
|
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d1 = PREG->u.osc.c;
|
|
|
|
|
for (; i > 0; i--) {
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = SREG++;
|
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, uatom_n_var);
|
|
|
|
|
uatom_n_nonvar:
|
|
|
|
|
if (d0 != d1) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
continue;
|
|
|
|
|
|
|
|
|
|
derefa_body(d0, pt0, uatom_n_var, uatom_n_nonvar);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind_Global(pt0, d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
continue;
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
}
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
}
|
|
|
|
|
PREG = NEXTOP(PREG, osc);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
OpW(unify_n_atoms_write, osc);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d0 = PREG->u.osc.s;
|
|
|
|
|
d1 = PREG->u.osc.c;
|
|
|
|
|
/* write N atoms */
|
|
|
|
|
CACHE_S();
|
|
|
|
|
READ_IN_S();
|
|
|
|
|
PREG = NEXTOP(PREG, osc);
|
|
|
|
|
for (; d0 > 0; d0--)
|
|
|
|
|
*S_SREG++ = d1;
|
|
|
|
|
WRITEBACK_S(S_SREG);
|
|
|
|
|
ENDCACHE_S();
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
GONextW();
|
|
|
|
|
ENDOpW();
|
|
|
|
|
|
2006-09-20 20:03:51 +00:00
|
|
|
|
Op(unify_float, od);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = SREG++;
|
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, ufloat_unk);
|
|
|
|
|
ufloat_nonvar:
|
2002-04-09 16:53:00 +00:00
|
|
|
|
if (!IsApplTerm(d0)) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* look inside term */
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = RepAppl(d0);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = *pt0;
|
|
|
|
|
if (d0 != (CELL)FunctorDouble) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
BEGP(pt1);
|
2006-09-20 20:03:51 +00:00
|
|
|
|
pt1 = PREG->u.od.d;
|
|
|
|
|
PREG = NEXTOP(PREG, od);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (
|
|
|
|
|
pt1[1] != pt0[1]
|
|
|
|
|
#if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
|
|
|
|
|
|| pt1[2] != pt0[2]
|
|
|
|
|
#endif
|
|
|
|
|
) FAIL();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
derefa_body(d0, pt0, ufloat_unk, ufloat_nonvar);
|
|
|
|
|
BEGD(d1);
|
2006-09-20 20:03:51 +00:00
|
|
|
|
d1 = AbsAppl(PREG->u.od.d);
|
|
|
|
|
PREG = NEXTOP(PREG, od);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind_Global(pt0, d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
OpW(unify_float_write, od);
|
|
|
|
|
* SREG++ = AbsAppl(PREG->u.od.d);
|
|
|
|
|
PREG = NEXTOP(PREG, od);
|
|
|
|
|
GONextW();
|
|
|
|
|
ENDOpW();
|
|
|
|
|
|
2006-09-20 20:03:51 +00:00
|
|
|
|
Op(unify_l_float, od);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
CACHE_S();
|
|
|
|
|
READ_IN_S();
|
|
|
|
|
d0 = *S_SREG;
|
|
|
|
|
deref_head(d0, ulfloat_unk);
|
|
|
|
|
ulfloat_nonvar:
|
2002-04-09 16:53:00 +00:00
|
|
|
|
if (!IsApplTerm(d0)) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = RepAppl(d0);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = *pt0;
|
|
|
|
|
if (d0 != (CELL)FunctorDouble) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
BEGP(pt1);
|
2006-09-20 20:03:51 +00:00
|
|
|
|
pt1 = PREG->u.od.d;
|
|
|
|
|
PREG = NEXTOP(PREG, od);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (
|
|
|
|
|
pt1[1] != pt0[1]
|
|
|
|
|
#if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
|
|
|
|
|
|| pt1[2] != pt0[2]
|
|
|
|
|
#endif
|
|
|
|
|
) FAIL();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
derefa_body(d0, S_SREG, ulfloat_unk, ulfloat_nonvar);
|
|
|
|
|
BEGD(d1);
|
2006-09-20 20:03:51 +00:00
|
|
|
|
d1 = AbsAppl(PREG->u.od.d);
|
|
|
|
|
PREG = NEXTOP(PREG, od);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind_Global(S_SREG, d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDCACHE_S();
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(unify_l_float_write, od);
|
|
|
|
|
SREG[0] = AbsAppl(PREG->u.od.d);
|
|
|
|
|
PREG = NEXTOP(PREG, od);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2006-09-20 20:03:51 +00:00
|
|
|
|
Op(unify_longint, oi);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = SREG++;
|
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, ulongint_unk);
|
|
|
|
|
ulongint_nonvar:
|
|
|
|
|
/* look inside term */
|
2002-04-09 16:53:00 +00:00
|
|
|
|
if (!IsApplTerm(d0)) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = RepAppl(d0);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = *pt0;
|
|
|
|
|
if (d0 != (CELL)FunctorLongInt) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
BEGP(pt1);
|
2006-09-20 20:03:51 +00:00
|
|
|
|
pt1 = PREG->u.oi.i;
|
|
|
|
|
PREG = NEXTOP(PREG, oi);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (pt1[1] != pt0[1]) FAIL();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
derefa_body(d0, pt0, ulongint_unk, ulongint_nonvar);
|
|
|
|
|
BEGD(d1);
|
2006-09-20 20:03:51 +00:00
|
|
|
|
d1 = AbsAppl(PREG->u.oi.i);
|
|
|
|
|
PREG = NEXTOP(PREG, oi);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind_Global(pt0, d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
OpW(unify_longint_write, oi);
|
|
|
|
|
* SREG++ = AbsAppl(PREG->u.oi.i);
|
|
|
|
|
PREG = NEXTOP(PREG, oi);
|
|
|
|
|
GONextW();
|
|
|
|
|
ENDOpW();
|
|
|
|
|
|
2006-09-20 20:03:51 +00:00
|
|
|
|
Op(unify_l_longint, oi);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
CACHE_S();
|
|
|
|
|
READ_IN_S();
|
|
|
|
|
d0 = *S_SREG;
|
|
|
|
|
deref_head(d0, ullongint_unk);
|
|
|
|
|
ullongint_nonvar:
|
2002-04-09 16:53:00 +00:00
|
|
|
|
if (!IsApplTerm(d0)) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = RepAppl(d0);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = *pt0;
|
|
|
|
|
if (d0 != (CELL)FunctorLongInt) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
BEGP(pt1);
|
2006-09-20 20:03:51 +00:00
|
|
|
|
pt1 = PREG->u.oi.i;
|
|
|
|
|
PREG = NEXTOP(PREG, oi);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (pt1[1] != pt0[1]) FAIL();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
derefa_body(d0, S_SREG, ullongint_unk, ullongint_nonvar);
|
|
|
|
|
BEGD(d1);
|
2006-09-20 20:03:51 +00:00
|
|
|
|
d1 = AbsAppl(PREG->u.oi.i);
|
|
|
|
|
PREG = NEXTOP(PREG, oi);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind_Global(S_SREG, d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDCACHE_S();
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(unify_l_longint_write, oi);
|
|
|
|
|
SREG[0] = AbsAppl(PREG->u.oi.i);
|
|
|
|
|
PREG = NEXTOP(PREG, oi);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2010-12-16 22:21:46 +00:00
|
|
|
|
Op(unify_bigint, oN);
|
2006-01-02 02:16:19 +00:00
|
|
|
|
#ifdef USE_GMP
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = SREG++;
|
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, ubigint_unk);
|
|
|
|
|
ubigint_nonvar:
|
|
|
|
|
/* look inside term */
|
2002-04-09 16:53:00 +00:00
|
|
|
|
if (!IsApplTerm(d0)) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = RepAppl(d0);
|
2006-01-02 02:16:19 +00:00
|
|
|
|
BEGD(d1);
|
|
|
|
|
d1 = *pt0;
|
|
|
|
|
if (d1 != (CELL)FunctorBigInt)
|
2001-04-09 19:54:03 +00:00
|
|
|
|
{
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
2006-01-02 02:16:19 +00:00
|
|
|
|
ENDD(d1);
|
2010-12-16 22:21:46 +00:00
|
|
|
|
if (Yap_gmp_tcmp_big_big(d0,PREG->u.oN.b))
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
2010-12-16 22:21:46 +00:00
|
|
|
|
PREG = NEXTOP(PREG, oN);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
derefa_body(d0, pt0, ubigint_unk, ubigint_nonvar);
|
|
|
|
|
BEGD(d1);
|
2010-12-16 22:21:46 +00:00
|
|
|
|
d1 = PREG->u.oN.b;
|
|
|
|
|
PREG = NEXTOP(PREG, oN);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind_Global(pt0, d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
2006-01-02 02:16:19 +00:00
|
|
|
|
#else
|
|
|
|
|
FAIL();
|
|
|
|
|
#endif
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDOp();
|
|
|
|
|
|
2010-12-16 22:21:46 +00:00
|
|
|
|
Op(unify_l_bigint, oN);
|
2006-01-02 02:16:19 +00:00
|
|
|
|
#ifdef USE_GMP
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
CACHE_S();
|
|
|
|
|
READ_IN_S();
|
|
|
|
|
d0 = *S_SREG;
|
|
|
|
|
deref_head(d0, ulbigint_unk);
|
|
|
|
|
ulbigint_nonvar:
|
2002-04-09 16:53:00 +00:00
|
|
|
|
if (!IsApplTerm(d0)) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = RepAppl(d0);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = *pt0;
|
|
|
|
|
if (d0 != (CELL)FunctorBigInt)
|
|
|
|
|
{
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
ENDD(d0);
|
2010-12-16 22:21:46 +00:00
|
|
|
|
if (Yap_gmp_tcmp_big_big(d0,PREG->u.oN.b))
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
2010-12-16 22:21:46 +00:00
|
|
|
|
PREG = NEXTOP(PREG, oN);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
derefa_body(d0, S_SREG, ulbigint_unk, ulbigint_nonvar);
|
|
|
|
|
BEGD(d1);
|
2010-12-16 22:21:46 +00:00
|
|
|
|
d1 = PREG->u.oN.b;
|
|
|
|
|
PREG = NEXTOP(PREG, oN);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind_Global(S_SREG, d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDCACHE_S();
|
|
|
|
|
ENDD(d0);
|
2006-01-02 02:16:19 +00:00
|
|
|
|
#else
|
|
|
|
|
FAIL();
|
|
|
|
|
#endif
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDOp();
|
|
|
|
|
|
2010-12-16 20:39:53 +00:00
|
|
|
|
Op(unify_dbterm, oD);
|
2007-11-06 17:02:13 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = SREG++;
|
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, udbterm_unk);
|
|
|
|
|
udbterm_nonvar:
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
/* we have met a preexisting dbterm */
|
2010-12-16 20:39:53 +00:00
|
|
|
|
d1 = PREG->u.oD.D;
|
|
|
|
|
PREG = NEXTOP(PREG, oD);
|
2007-11-06 17:02:13 +00:00
|
|
|
|
UnifyBound(d0,d1);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
|
|
|
|
|
derefa_body(d0, pt0, udbterm_unk, udbterm_nonvar);
|
|
|
|
|
BEGD(d1);
|
2010-12-16 20:39:53 +00:00
|
|
|
|
d1 = PREG->u.oD.D;
|
|
|
|
|
PREG = NEXTOP(PREG, oD);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind_Global(pt0, d1);
|
2007-11-06 17:02:13 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2010-12-16 20:39:53 +00:00
|
|
|
|
Op(unify_l_dbterm, oD);
|
2007-11-06 17:02:13 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
CACHE_S();
|
|
|
|
|
READ_IN_S();
|
|
|
|
|
d0 = *S_SREG;
|
|
|
|
|
deref_head(d0, uldbterm_unk);
|
|
|
|
|
uldbterm_nonvar:
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
/* we have met a preexisting dbterm */
|
2010-12-16 20:39:53 +00:00
|
|
|
|
d1 = PREG->u.oD.D;
|
|
|
|
|
PREG = NEXTOP(PREG, oD);
|
2007-11-06 17:02:13 +00:00
|
|
|
|
UnifyBound(d0,d1);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
|
|
|
|
|
derefa_body(d0, S_SREG, uldbterm_unk, uldbterm_nonvar);
|
|
|
|
|
BEGD(d1);
|
2010-12-16 20:39:53 +00:00
|
|
|
|
d1 = PREG->u.oD.D;
|
|
|
|
|
PREG = NEXTOP(PREG, oD);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind_Global(S_SREG, d1);
|
2007-11-06 17:02:13 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDCACHE_S();
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
OpRW(unify_list, o);
|
|
|
|
|
*--SP = Unsigned(SREG + 1);
|
|
|
|
|
*--SP = READ_MODE;
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = SREG;
|
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, ulist_unk);
|
|
|
|
|
ulist_nonvar:
|
|
|
|
|
if (!IsPairTerm(d0)) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
/* we continue in read mode */
|
|
|
|
|
START_PREFETCH(o);
|
|
|
|
|
SREG = RepPair(d0);
|
|
|
|
|
PREG = NEXTOP(PREG, o);
|
|
|
|
|
GONext();
|
|
|
|
|
END_PREFETCH();
|
|
|
|
|
|
|
|
|
|
derefa_body(d0, pt0, ulist_unk, ulist_nonvar);
|
|
|
|
|
/* we enter write mode */
|
|
|
|
|
START_PREFETCH_W(o);
|
|
|
|
|
CACHE_S();
|
|
|
|
|
READ_IN_S();
|
|
|
|
|
S_SREG = H;
|
|
|
|
|
PREG = NEXTOP(PREG, o);
|
|
|
|
|
H = S_SREG + 2;
|
|
|
|
|
d0 = AbsPair(S_SREG);
|
|
|
|
|
WRITEBACK_S(S_SREG);
|
|
|
|
|
ENDCACHE_S();
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind_Global(pt0, d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONextW();
|
|
|
|
|
END_PREFETCH_W();
|
|
|
|
|
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOpRW();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
OpW(unify_list_write, o);
|
|
|
|
|
PREG = NEXTOP(PREG, o);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = AbsPair(H);
|
|
|
|
|
CACHE_S();
|
|
|
|
|
READ_IN_S();
|
2008-08-21 13:38:25 +01:00
|
|
|
|
SP -= 2;
|
|
|
|
|
SP[0] = WRITE_MODE;
|
|
|
|
|
SP[1] = Unsigned(S_SREG + 1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
S_SREG[0] = d0;
|
|
|
|
|
S_SREG = H;
|
|
|
|
|
H = S_SREG + 2;
|
|
|
|
|
WRITEBACK_S(S_SREG);
|
|
|
|
|
ENDCACHE_S();
|
|
|
|
|
GONextW();
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOpW();
|
|
|
|
|
|
|
|
|
|
OpRW(unify_l_list, o);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = SREG;
|
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, ullist_unk);
|
|
|
|
|
ullist_nonvar:
|
|
|
|
|
START_PREFETCH(o);
|
|
|
|
|
if (!IsPairTerm(d0)) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
/* we continue in read mode */
|
|
|
|
|
PREG = NEXTOP(PREG, o);
|
|
|
|
|
SREG = RepPair(d0);
|
|
|
|
|
GONext();
|
|
|
|
|
END_PREFETCH();
|
|
|
|
|
|
|
|
|
|
derefa_body(d0, pt0, ullist_unk, ullist_nonvar);
|
|
|
|
|
/* we enter write mode */
|
|
|
|
|
START_PREFETCH_W(o);
|
|
|
|
|
PREG = NEXTOP(PREG, o);
|
|
|
|
|
CACHE_S();
|
|
|
|
|
READ_IN_S();
|
|
|
|
|
S_SREG = H;
|
|
|
|
|
H = S_SREG + 2;
|
|
|
|
|
d0 = AbsPair(S_SREG);
|
|
|
|
|
WRITEBACK_S(S_SREG);
|
|
|
|
|
ENDCACHE_S();
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind_Global(pt0, d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONextW();
|
|
|
|
|
END_PREFETCH_W();
|
|
|
|
|
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOpRW();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
OpW(unify_l_list_write, o);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* we continue in write mode */
|
|
|
|
|
BEGD(d0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
d0 = AbsPair(H);
|
|
|
|
|
PREG = NEXTOP(PREG, o);
|
|
|
|
|
CACHE_S();
|
|
|
|
|
READ_IN_S();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
S_SREG[0] = d0;
|
|
|
|
|
S_SREG = H;
|
2008-08-21 13:38:25 +01:00
|
|
|
|
H = S_SREG + 2;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
WRITEBACK_S(S_SREG);
|
|
|
|
|
ENDCACHE_S();
|
|
|
|
|
GONextW();
|
2008-08-21 13:38:25 +01:00
|
|
|
|
ENDD(d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDOpW();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
OpRW(unify_struct, ofa);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
*--SP = Unsigned(SREG + 1);
|
|
|
|
|
*--SP = READ_MODE;
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = SREG;
|
|
|
|
|
d0 = *pt0;
|
2008-08-21 13:38:25 +01:00
|
|
|
|
START_PREFETCH(ofa);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
deref_head(d0, ustruct_unk);
|
|
|
|
|
ustruct_nonvar:
|
|
|
|
|
/* we are in read mode */
|
|
|
|
|
if (!IsApplTerm(d0)) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
CACHE_S();
|
|
|
|
|
READ_IN_S();
|
|
|
|
|
/* we continue in read mode */
|
|
|
|
|
S_SREG = RepAppl(d0);
|
|
|
|
|
/* just check functor */
|
2008-08-21 13:38:25 +01:00
|
|
|
|
d0 = (CELL) (PREG->u.ofa.f);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (*S_SREG != d0) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, ofa);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
WRITEBACK_S(S_SREG+1);
|
|
|
|
|
ENDCACHE_S();
|
|
|
|
|
GONext();
|
|
|
|
|
END_PREFETCH();
|
|
|
|
|
|
|
|
|
|
derefa_body(d0, pt0, ustruct_unk, ustruct_nonvar);
|
|
|
|
|
/* Enter Write mode */
|
2008-08-21 13:38:25 +01:00
|
|
|
|
START_PREFETCH_W(ofa);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* set d1 to be the new structure we are going to create */
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d1 = AbsAppl(H);
|
|
|
|
|
/* we know the variable must be in the heap */
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind_Global(pt0, d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* now, set pt0 to point to the heap where we are going to
|
|
|
|
|
* build our term */
|
|
|
|
|
pt0 = H;
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
/* first, put the functor */
|
2008-08-21 13:38:25 +01:00
|
|
|
|
d0 = (CELL) (PREG->u.ofa.f);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
*pt0++ = d0;
|
2008-08-21 13:38:25 +01:00
|
|
|
|
H = pt0 + PREG->u.ofa.a;
|
|
|
|
|
PREG = NEXTOP(PREG, ofa);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* set SREG */
|
|
|
|
|
SREG = pt0;
|
|
|
|
|
/* update H */
|
|
|
|
|
GONextW();
|
|
|
|
|
END_PREFETCH_W();
|
|
|
|
|
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOpRW();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
OpW(unify_struct_write, ofa);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
CACHE_S();
|
|
|
|
|
READ_IN_S();
|
2008-08-21 13:38:25 +01:00
|
|
|
|
*--SP = Unsigned(S_SREG + 1);
|
|
|
|
|
*--SP = WRITE_MODE;
|
|
|
|
|
/* we continue in write mode */
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = AbsAppl(H);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
S_SREG[0] = d0;
|
|
|
|
|
S_SREG = H;
|
2008-08-21 13:38:25 +01:00
|
|
|
|
d0 = (CELL) (PREG->u.ofa.f);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
*S_SREG++ = d0;
|
2008-08-21 13:38:25 +01:00
|
|
|
|
H = S_SREG + PREG->u.ofa.a;
|
|
|
|
|
PREG = NEXTOP(PREG, ofa);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
WRITEBACK_S(S_SREG);
|
|
|
|
|
ENDCACHE_S();
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
GONextW();
|
|
|
|
|
ENDOpW();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
OpRW(unify_l_struc, ofa);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = SREG;
|
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, ulstruct_unk);
|
|
|
|
|
ulstruct_nonvar:
|
|
|
|
|
/* we are in read mode */
|
2008-08-21 13:38:25 +01:00
|
|
|
|
START_PREFETCH(ofa);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (!IsApplTerm(d0)) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
/* we continue in read mode */
|
|
|
|
|
SREG = RepAppl(d0);
|
|
|
|
|
/* just check functor */
|
2008-08-21 13:38:25 +01:00
|
|
|
|
d0 = (CELL) (PREG->u.ofa.f);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (*SREG++ != d0) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, ofa);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
END_PREFETCH();
|
|
|
|
|
|
|
|
|
|
derefa_body(d0, pt0, ulstruct_unk, ulstruct_nonvar);
|
|
|
|
|
/* Enter Write mode */
|
|
|
|
|
/* set d1 to be the new structure we are going to create */
|
2008-08-21 13:38:25 +01:00
|
|
|
|
START_PREFETCH_W(ofa);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d1);
|
|
|
|
|
d1 = AbsAppl(H);
|
|
|
|
|
/* we know the variable must be in the heap */
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind_Global(pt0, d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* now, set pt0 to point to the heap where we are going to
|
|
|
|
|
* build our term */
|
|
|
|
|
pt0 = H;
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
/* first, put the functor */
|
2008-08-21 13:38:25 +01:00
|
|
|
|
d0 = (CELL) (PREG->u.ofa.f);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
*pt0++ = d0;
|
2008-08-21 13:38:25 +01:00
|
|
|
|
H = pt0 + PREG->u.ofa.a;
|
|
|
|
|
PREG = NEXTOP(PREG, ofa);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* set SREG */
|
|
|
|
|
SREG = pt0;
|
|
|
|
|
/* update H */
|
|
|
|
|
GONextW();
|
|
|
|
|
END_PREFETCH_W();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOpRW();
|
2008-08-21 13:38:25 +01:00
|
|
|
|
|
|
|
|
|
OpW(unify_l_struc_write, ofa);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = AbsAppl(H);
|
|
|
|
|
CACHE_S();
|
|
|
|
|
READ_IN_S();
|
|
|
|
|
S_SREG[0] = d0;
|
|
|
|
|
S_SREG = H;
|
|
|
|
|
d0 = (CELL) (PREG->u.ofa.f);
|
|
|
|
|
*S_SREG++ = d0;
|
|
|
|
|
H = S_SREG + PREG->u.ofa.a;
|
|
|
|
|
PREG = NEXTOP(PREG, ofa);
|
|
|
|
|
WRITEBACK_S(S_SREG);
|
|
|
|
|
ENDCACHE_S();
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
GONextW();
|
|
|
|
|
ENDOpW();
|
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
/************************************************************************\
|
|
|
|
|
* Put Instructions *
|
|
|
|
|
\************************************************************************/
|
|
|
|
|
|
|
|
|
|
Op(put_x_var, xx);
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = H;
|
|
|
|
|
XREG(PREG->u.xx.xl) = Unsigned(pt0);
|
|
|
|
|
H = pt0 + 1;
|
|
|
|
|
XREG(PREG->u.xx.xr) = Unsigned(pt0);
|
|
|
|
|
PREG = NEXTOP(PREG, xx);
|
|
|
|
|
RESET_VARIABLE(pt0);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(put_y_var, yx);
|
|
|
|
|
BEGP(pt0);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
pt0 = YREG + PREG->u.yx.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
XREG(PREG->u.yx.x) = (CELL) pt0;
|
|
|
|
|
PREG = NEXTOP(PREG, yx);
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#if defined(YAPOR_SBA) && defined(FROZEN_STACKS)
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* We must initialise a shared variable to point to the SBA */
|
|
|
|
|
if (Unsigned((Int)(pt0)-(Int)(H_FZ)) >
|
|
|
|
|
Unsigned((Int)(B_FZ)-(Int)(H_FZ))) {
|
|
|
|
|
*pt0 = (CELL)STACK_TO_SBA(pt0);
|
|
|
|
|
} else
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#endif /* YAPOR_SBA && FROZEN_STACKS */
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0, (CELL)pt0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(put_x_val, xx);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = XREG(PREG->u.xx.xl);
|
|
|
|
|
XREG(PREG->u.xx.xr) = d0;
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
PREG = NEXTOP(PREG, xx);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2005-07-06 15:10:18 +00:00
|
|
|
|
Op(put_xx_val, xxxx);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d0 = XREG(PREG->u.xxxx.xl1);
|
|
|
|
|
d1 = XREG(PREG->u.xxxx.xl2);
|
|
|
|
|
XREG(PREG->u.xxxx.xr1) = d0;
|
|
|
|
|
XREG(PREG->u.xxxx.xr2) = d1;
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
PREG = NEXTOP(PREG, xxxx);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
Op(put_y_val, yx);
|
|
|
|
|
BEGD(d0);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
d0 = YREG[PREG->u.yx.y];
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#ifdef YAPOR_SBA
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (d0 == 0) /* new variable */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
XREG(PREG->u.yx.x) = (CELL)(YREG+PREG->u.yx.y);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
else
|
|
|
|
|
#endif
|
|
|
|
|
XREG(PREG->u.yx.x) = d0;
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
PREG = NEXTOP(PREG, yx);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2009-03-03 10:04:13 +00:00
|
|
|
|
Op(put_y_vals, yyxx);
|
|
|
|
|
ALWAYS_START_PREFETCH(yyxx);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = YREG[PREG->u.yyxx.y1];
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#ifdef YAPOR_SBA
|
2009-03-03 10:04:13 +00:00
|
|
|
|
if (d0 == 0) /* new variable */
|
|
|
|
|
XREG(PREG->u.yyxx.x1) = (CELL)(YREG+PREG->u.yyxx.y1);
|
|
|
|
|
else
|
|
|
|
|
#endif
|
|
|
|
|
XREG(PREG->u.yyxx.x1) = d0;
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
/* allow for some prefetching */
|
|
|
|
|
PREG = NEXTOP(PREG, yyxx);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d1 = YREG[PREVOP(PREG,yyxx)->u.yyxx.y2];
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#ifdef YAPOR_SBA
|
2009-03-03 10:04:13 +00:00
|
|
|
|
if (d1 == 0) /* new variable */
|
|
|
|
|
XREG(PREVOP(PREG->u.yyxx,yyxx).x2) = (CELL)(YREG+PREG->u.yyxx.y2);
|
|
|
|
|
else
|
|
|
|
|
#endif
|
|
|
|
|
XREG(PREVOP(PREG,yyxx)->u.yyxx.x2) = d1;
|
|
|
|
|
ENDD(d1);
|
2011-10-21 19:11:25 +01:00
|
|
|
|
ALWAYS_GONext();
|
2009-03-03 10:04:13 +00:00
|
|
|
|
ALWAYS_END_PREFETCH();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
Op(put_unsafe, yx);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGP(pt0);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
pt0 = YREG+PREG->u.yx.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, punsafe_unk);
|
|
|
|
|
punsafe_nonvar:
|
|
|
|
|
XREG(PREG->u.yx.x) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, yx);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
derefa_body(d0, pt0, punsafe_unk, punsafe_nonvar);
|
|
|
|
|
/* d0 is a variable, check whether we need to globalise it */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
if (pt0 <= H || pt0 >= YREG) {
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* variable is safe */
|
|
|
|
|
XREG(PREG->u.yx.x) = Unsigned(pt0);
|
|
|
|
|
PREG = NEXTOP(PREG, yx);
|
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
/* create a new Heap variable and bind our variable to it */
|
|
|
|
|
Bind_Local(pt0, Unsigned(H));
|
|
|
|
|
XREG(PREG->u.yx.x) = (CELL) H;
|
|
|
|
|
RESET_VARIABLE(H);
|
|
|
|
|
H++;
|
|
|
|
|
PREG = NEXTOP(PREG, yx);
|
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(put_atom, xc);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = PREG->u.xc.c;
|
|
|
|
|
XREG(PREG->u.xc.x) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, xc);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
2010-12-16 22:21:46 +00:00
|
|
|
|
|
|
|
|
|
Op(put_dbterm, xD);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = PREG->u.xD.D;
|
|
|
|
|
XREG(PREG->u.xD.x) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, xD);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
2010-12-16 22:21:46 +00:00
|
|
|
|
Op(put_bigint, xN);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = PREG->u.xN.b;
|
|
|
|
|
XREG(PREG->u.xN.x) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, xN);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(put_float, xd);
|
2006-09-20 20:03:51 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = AbsAppl(PREG->u.xd.d);
|
|
|
|
|
XREG(PREG->u.xd.x) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, xd);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(put_longint, xi);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = AbsAppl(PREG->u.xi.i);
|
|
|
|
|
XREG(PREG->u.xi.x) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, xi);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
Op(put_list, x);
|
|
|
|
|
CACHE_S();
|
|
|
|
|
READ_IN_S();
|
|
|
|
|
S_SREG = H;
|
|
|
|
|
H += 2;
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = AbsPair(S_SREG);
|
|
|
|
|
XREG(PREG->u.x.x) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, x);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
WRITEBACK_S(S_SREG);
|
|
|
|
|
ENDCACHE_S();
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(put_struct, xfa);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = AbsAppl(H);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
XREG(PREG->u.xfa.x) = d0;
|
|
|
|
|
d0 = (CELL) (PREG->u.xfa.f);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
*H++ = d0;
|
|
|
|
|
SREG = H;
|
2008-08-21 13:38:25 +01:00
|
|
|
|
H += PREG->u.xfa.a;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDD(d0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, xfa);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
/************************************************************************\
|
|
|
|
|
* Write Instructions *
|
|
|
|
|
\************************************************************************/
|
|
|
|
|
|
|
|
|
|
Op(write_x_var, x);
|
|
|
|
|
XREG(PREG->u.x.x) = Unsigned(SREG);
|
|
|
|
|
PREG = NEXTOP(PREG, x);
|
|
|
|
|
RESET_VARIABLE(SREG);
|
|
|
|
|
SREG++;
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(write_void, e);
|
|
|
|
|
PREG = NEXTOP(PREG, e);
|
|
|
|
|
RESET_VARIABLE(SREG);
|
|
|
|
|
SREG++;
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(write_n_voids, s);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = PREG->u.s.s;
|
|
|
|
|
PREG = NEXTOP(PREG, s);
|
|
|
|
|
for (; d0 > 0; d0--) {
|
|
|
|
|
RESET_VARIABLE(SREG);
|
|
|
|
|
SREG++;
|
|
|
|
|
}
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(write_y_var, y);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(YREG+PREG->u.y.y,Unsigned(SREG));
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = NEXTOP(PREG, y);
|
|
|
|
|
RESET_VARIABLE(SREG);
|
|
|
|
|
SREG++;
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(write_x_val, x);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = XREG(PREG->u.x.x);
|
|
|
|
|
*SREG++ = d0;
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
PREG = NEXTOP(PREG, x);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(write_x_loc, x);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = XREG(PREG->u.x.x);
|
2003-01-30 16:27:45 +00:00
|
|
|
|
PREG = NEXTOP(PREG, x);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
deref_head(d0, w_x_unk);
|
|
|
|
|
w_x_bound:
|
|
|
|
|
*SREG++ = d0;
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, w_x_unk, w_x_bound);
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#if defined(YAPOR_SBA) && defined(FROZEN_STACKS)
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (pt0 > H && pt0<(CELL *)B_FZ) {
|
|
|
|
|
#else
|
|
|
|
|
if (pt0 > H) {
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#endif /* YAPOR_SBA && FROZEN_STACKS */
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* local variable: let us bind it to the list */
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#ifdef FROZEN_STACKS /* TRAIL */
|
2001-04-09 19:54:03 +00:00
|
|
|
|
Bind_Local(pt0, Unsigned(SREG));
|
|
|
|
|
#else
|
|
|
|
|
TRAIL_LOCAL(pt0, Unsigned(SREG));
|
|
|
|
|
*pt0 = Unsigned(SREG);
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#endif /* FROZEN_STACKS */
|
2001-04-09 19:54:03 +00:00
|
|
|
|
RESET_VARIABLE(SREG);
|
|
|
|
|
SREG++;
|
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
*SREG++ = Unsigned(pt0);
|
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(write_y_val, y);
|
|
|
|
|
BEGD(d0);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
d0 = YREG[PREG->u.y.y];
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#ifdef YAPOR_SBA
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (d0 == 0) /* new variable */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
*SREG++ = (CELL)(YREG+PREG->u.y.y);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
else
|
|
|
|
|
#endif
|
|
|
|
|
*SREG++ = d0;
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
PREG = NEXTOP(PREG, y);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(write_y_loc, y);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGP(pt0);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
pt0 = YREG+PREG->u.y.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, w_y_unk);
|
|
|
|
|
w_y_bound:
|
|
|
|
|
PREG = NEXTOP(PREG, y);
|
|
|
|
|
*SREG++ = d0;
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
derefa_body(d0, pt0, w_y_unk, w_y_bound);
|
2008-12-09 12:54:27 +00:00
|
|
|
|
if (pt0 > H
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#if defined(YAPOR_SBA) && defined(FROZEN_STACKS)
|
2008-12-09 12:54:27 +00:00
|
|
|
|
&& pt0<(CELL *)B_FZ
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#endif /* YAPOR_SBA && FROZEN_STACKS */
|
2008-12-09 12:54:27 +00:00
|
|
|
|
) {
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = NEXTOP(PREG, y);
|
|
|
|
|
/* local variable: let us bind it to the list */
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
2001-04-09 19:54:03 +00:00
|
|
|
|
Bind_Local(pt0, Unsigned(SREG));
|
|
|
|
|
#else
|
|
|
|
|
*pt0 = Unsigned(SREG);
|
|
|
|
|
TRAIL_LOCAL(pt0, Unsigned(SREG));
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#endif /* FROZEN_STACKS */
|
2001-04-09 19:54:03 +00:00
|
|
|
|
RESET_VARIABLE(SREG);
|
|
|
|
|
SREG++;
|
|
|
|
|
GONext();
|
2008-12-09 12:54:27 +00:00
|
|
|
|
} else {
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = NEXTOP(PREG, y);
|
|
|
|
|
*SREG++ = Unsigned(pt0);
|
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(write_atom, c);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = PREG->u.c.c;
|
|
|
|
|
*SREG++ = d0;
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
PREG = NEXTOP(PREG, c);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2010-12-16 22:21:46 +00:00
|
|
|
|
Op(write_bigint, N);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = PREG->u.N.b;
|
|
|
|
|
*SREG++ = d0;
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
PREG = NEXTOP(PREG, N);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(write_dbterm, D);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = PREG->u.D.D;
|
|
|
|
|
*SREG++ = d0;
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
PREG = NEXTOP(PREG, D);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2006-09-20 20:03:51 +00:00
|
|
|
|
Op(write_float, d);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = AbsAppl(PREG->u.d.d);
|
|
|
|
|
*SREG++ = d0;
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
PREG = NEXTOP(PREG, d);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(write_longint, i);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = AbsAppl(PREG->u.i.i);
|
|
|
|
|
*SREG++ = d0;
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
PREG = NEXTOP(PREG, i);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
Op(write_n_atoms, sc);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d0 = PREG->u.sc.s;
|
|
|
|
|
d1 = PREG->u.sc.c;
|
|
|
|
|
for (; d0 > 0; d0--)
|
|
|
|
|
*SREG++ = d1;
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
PREG = NEXTOP(PREG, sc);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(write_list, e);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = AbsPair(H);
|
|
|
|
|
*SREG++ = d0;
|
|
|
|
|
/* I will not actually store the mode in the stack */
|
|
|
|
|
SP[-1] = Unsigned(SREG);
|
|
|
|
|
SP[-2] = 1; /* Put instructions follow the main stream */
|
|
|
|
|
SP -= 2;
|
|
|
|
|
SREG = H;
|
|
|
|
|
H += 2;
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
PREG = NEXTOP(PREG, e);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(write_l_list, e);
|
|
|
|
|
ALWAYS_START_PREFETCH(e);
|
|
|
|
|
PREG = NEXTOP(PREG, e);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
CACHE_S();
|
|
|
|
|
READ_IN_S();
|
|
|
|
|
d0 = AbsPair(H);
|
|
|
|
|
*S_SREG = d0;
|
|
|
|
|
WRITEBACK_S(H);
|
|
|
|
|
H += 2;
|
|
|
|
|
ENDCACHE_S();
|
|
|
|
|
ENDD(d0);
|
2011-10-21 19:11:25 +01:00
|
|
|
|
ALWAYS_GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ALWAYS_END_PREFETCH();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(write_struct, fa);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = AbsAppl(H);
|
|
|
|
|
*SREG++ = d0;
|
|
|
|
|
SP[-1] = Unsigned(SREG);
|
|
|
|
|
SP[-2] = 1; /* Put instructions follow the main stream */
|
|
|
|
|
SP -= 2;
|
2008-08-21 13:38:25 +01:00
|
|
|
|
d0 = (CELL) (PREG->u.fa.f);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
*H++ = d0;
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
BEGD(d0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
d0 = PREG->u.fa.a;
|
|
|
|
|
PREG = NEXTOP(PREG, fa);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
SREG = H;
|
|
|
|
|
H += d0;
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(write_l_struc, fa);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = AbsAppl(H);
|
|
|
|
|
*SREG = d0;
|
2008-08-21 13:38:25 +01:00
|
|
|
|
d0 = (CELL) (PREG->u.fa.f);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
*H++ = d0;
|
|
|
|
|
SREG = H;
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
BEGD(d0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
d0 = PREG->u.fa.a;
|
|
|
|
|
PREG = NEXTOP(PREG, fa);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
H += d0;
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
/************************************************************************\
|
|
|
|
|
* Save last unified struct or list *
|
|
|
|
|
\************************************************************************/
|
|
|
|
|
|
|
|
|
|
/* vitor: I think I should kill these two instructions, by expanding the
|
|
|
|
|
* othe instructions.
|
|
|
|
|
*/
|
|
|
|
|
|
|
|
|
|
Op(save_pair_x, ox);
|
|
|
|
|
XREG(PREG->u.ox.x) = AbsPair(SREG);
|
|
|
|
|
PREG = NEXTOP(PREG, ox);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
OpW(save_pair_x_write, ox);
|
|
|
|
|
XREG(PREG->u.ox.x) = AbsPair(SREG);
|
|
|
|
|
PREG = NEXTOP(PREG, ox);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONextW();
|
|
|
|
|
ENDOpW();
|
|
|
|
|
|
|
|
|
|
Op(save_pair_y, oy);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(YREG+PREG->u.oy.y,AbsPair(SREG));
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = NEXTOP(PREG, oy);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
OpW(save_pair_y_write, oy);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(YREG+PREG->u.oy.y,AbsPair(SREG));
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, oy);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONextW();
|
|
|
|
|
ENDOpW();
|
|
|
|
|
|
|
|
|
|
Op(save_appl_x, ox);
|
|
|
|
|
XREG(PREG->u.ox.x) = AbsAppl(SREG - 1);
|
|
|
|
|
PREG = NEXTOP(PREG, ox);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
OpW(save_appl_x_write, ox);
|
|
|
|
|
XREG(PREG->u.ox.x) = AbsAppl(SREG - 1);
|
|
|
|
|
PREG = NEXTOP(PREG, ox);
|
|
|
|
|
GONextW();
|
|
|
|
|
ENDOpW();
|
|
|
|
|
|
|
|
|
|
Op(save_appl_y, oy);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(YREG+PREG->u.oy.y,AbsAppl(SREG-1));
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = NEXTOP(PREG, oy);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
OpW(save_appl_y_write, oy);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(YREG+PREG->u.oy.y,AbsAppl(SREG-1));
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = NEXTOP(PREG, oy);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
GONextW();
|
|
|
|
|
ENDOpW();
|
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
/************************************************************************\
|
|
|
|
|
* Instructions for implemeting 'or;' *
|
|
|
|
|
\************************************************************************/
|
|
|
|
|
|
|
|
|
|
BOp(jump, l);
|
2002-12-27 16:53:09 +00:00
|
|
|
|
PREG = PREG->u.l.l;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
/* This instruction is called when the previous goal
|
|
|
|
|
was interrupted when waking up goals
|
|
|
|
|
*/
|
|
|
|
|
BOp(move_back, l);
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = (yamop *)(((char *)PREG)-(Int)(NEXTOP((yamop *)NULL,Osbpp)));
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
/* This instruction is called when the previous goal
|
|
|
|
|
was interrupted when waking up goals
|
|
|
|
|
*/
|
|
|
|
|
BOp(skip, l);
|
|
|
|
|
PREG = NEXTOP(PREG,l);
|
|
|
|
|
JMPNext();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2008-09-05 05:22:19 +01:00
|
|
|
|
Op(either, Osblp);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
2002-11-18 18:18:05 +00:00
|
|
|
|
if (Yap_do_low_level_trace) {
|
2001-04-09 19:54:03 +00:00
|
|
|
|
low_level_trace(try_or, (PredEntry *)PREG, NULL);
|
|
|
|
|
}
|
|
|
|
|
#endif
|
|
|
|
|
#ifdef COROUTINING
|
2002-11-11 17:38:10 +00:00
|
|
|
|
CACHE_Y_AS_ENV(YREG);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
check_stack(NoStackEither, H);
|
|
|
|
|
ENDCACHE_Y_AS_ENV();
|
2004-01-23 02:23:51 +00:00
|
|
|
|
either_notest:
|
2004-01-29 13:37:10 +00:00
|
|
|
|
#endif
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
/* Try to preserve the environment */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
d0 = PREG->u.Osblp.s;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGCHO(pt1);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
pt1 = (choiceptr) ((char *) YREG + (yslot) d0);
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
2001-04-09 19:54:03 +00:00
|
|
|
|
{
|
|
|
|
|
choiceptr top_b = PROTECT_FROZEN_B(B);
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#ifdef YAPOR_SBA
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (pt1 > top_b || pt1 < (choiceptr)H) pt1 = top_b;
|
|
|
|
|
#else
|
|
|
|
|
if (pt1 > top_b) pt1 = top_b;
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#endif /* YAPOR_SBA */
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
#else
|
|
|
|
|
if (pt1 > B) {
|
|
|
|
|
pt1 = B;
|
|
|
|
|
}
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#endif /* FROZEN_STACKS */
|
2001-04-09 19:54:03 +00:00
|
|
|
|
pt1 = (choiceptr)(((CELL *) pt1)-1);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
*(CELL **) pt1 = YREG;
|
2008-09-05 05:22:19 +01:00
|
|
|
|
store_yaam_regs_for_either(PREG->u.Osblp.l, PREG);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
SREG = (CELL *) (B = pt1);
|
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
SCH_set_load(pt1);
|
|
|
|
|
#endif /* YAPOR */
|
|
|
|
|
SET_BB(pt1);
|
|
|
|
|
ENDCHO(pt1);
|
|
|
|
|
/* skip the current instruction plus the next one */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = NEXTOP(NEXTOP(PREG, Osblp),l);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-09-05 05:22:19 +01:00
|
|
|
|
Op(or_else, Osblp);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
H = HBREG = PROTECT_FROZEN_H(B);
|
|
|
|
|
ENV = B->cp_env;
|
|
|
|
|
B->cp_cp = PREG;
|
|
|
|
|
#ifdef DEPTH_LIMIT
|
|
|
|
|
DEPTH = B->cp_depth;
|
|
|
|
|
#endif /* DEPTH_LIMIT */
|
|
|
|
|
SET_BB(PROTECT_FROZEN_B(B));
|
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
if (SCH_top_shared_cp(B)) {
|
2008-09-05 05:22:19 +01:00
|
|
|
|
SCH_new_alternative(PREG, PREG->u.Osblp.l);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
} else
|
|
|
|
|
#endif /* YAPOR */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
B->cp_ap = PREG->u.Osblp.l;
|
|
|
|
|
PREG = NEXTOP(PREG, Osblp);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
YREG = (CELL *) B->cp_a1;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
#ifdef YAPOR
|
2008-09-05 05:22:19 +01:00
|
|
|
|
Op(or_last, Osblp);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#else
|
2004-10-26 20:16:18 +00:00
|
|
|
|
Op(or_last, p);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif /* YAPOR */
|
|
|
|
|
BEGCHO(pt0);
|
|
|
|
|
pt0 = B;
|
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
if (SCH_top_shared_cp(B)) {
|
|
|
|
|
H = HBREG = PROTECT_FROZEN_H(pt0);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
YREG = (CELL *) pt0->cp_a1;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENV = pt0->cp_env;
|
|
|
|
|
#ifdef DEPTH_LIMIT
|
|
|
|
|
DEPTH = pt0->cp_depth;
|
|
|
|
|
#endif /* DEPTH_LIMIT */
|
|
|
|
|
SCH_new_alternative(PREG, NULL);
|
|
|
|
|
}
|
|
|
|
|
else
|
|
|
|
|
#endif /* YAPOR */
|
|
|
|
|
{
|
|
|
|
|
B = pt0->cp_b;
|
|
|
|
|
H = PROTECT_FROZEN_H(pt0);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
YREG = (CELL *) pt0->cp_a1;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENV = pt0->cp_env;
|
|
|
|
|
#ifdef DEPTH_LIMIT
|
|
|
|
|
DEPTH = pt0->cp_depth;
|
|
|
|
|
#endif /* DEPTH_LIMIT */
|
|
|
|
|
HBREG = PROTECT_FROZEN_H(B);
|
|
|
|
|
}
|
|
|
|
|
#ifdef YAPOR
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = NEXTOP(PREG, Osblp);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#else
|
2004-10-26 20:16:18 +00:00
|
|
|
|
PREG = NEXTOP(PREG, p);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif /* YAPOR */
|
|
|
|
|
SET_BB(PROTECT_FROZEN_B(B));
|
|
|
|
|
GONext();
|
|
|
|
|
ENDCHO(pt0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
/************************************************************************\
|
|
|
|
|
* Pop operations *
|
|
|
|
|
\************************************************************************/
|
|
|
|
|
|
|
|
|
|
OpRW(pop_n, s);
|
|
|
|
|
/* write mode might have been called from read mode */
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = PREG->u.os.s;
|
|
|
|
|
SP = (CELL *) (((char *) SP) + d0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = SP[0];
|
|
|
|
|
if (d0) {
|
|
|
|
|
START_PREFETCH(s);
|
|
|
|
|
SREG = (CELL *) (SP[1]);
|
|
|
|
|
SP += 2;
|
|
|
|
|
PREG = NEXTOP(PREG, s);
|
|
|
|
|
GONext();
|
|
|
|
|
END_PREFETCH();
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
START_PREFETCH_W(s);
|
|
|
|
|
SREG = (CELL *) (SP[1]);
|
|
|
|
|
SP += 2;
|
|
|
|
|
PREG = NEXTOP(PREG, s);
|
|
|
|
|
GONextW();
|
|
|
|
|
END_PREFETCH_W();
|
|
|
|
|
}
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOpRW();
|
|
|
|
|
|
|
|
|
|
OpRW(pop, e);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = SP[0];
|
|
|
|
|
SREG = (CELL *) (SP[1]);
|
|
|
|
|
SP += 2;
|
|
|
|
|
if (d0) {
|
|
|
|
|
START_PREFETCH(e);
|
|
|
|
|
PREG = NEXTOP(PREG, e);
|
|
|
|
|
GONext();
|
|
|
|
|
END_PREFETCH();
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
START_PREFETCH_W(e);
|
|
|
|
|
PREG = NEXTOP(PREG, e);
|
|
|
|
|
GONextW();
|
|
|
|
|
END_PREFETCH_W();
|
|
|
|
|
}
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOpRW();
|
|
|
|
|
|
|
|
|
|
/************************************************************************\
|
|
|
|
|
* Call C predicates instructions *
|
|
|
|
|
\************************************************************************/
|
|
|
|
|
|
2008-09-05 05:22:19 +01:00
|
|
|
|
BOp(call_cpred, Osbpp);
|
2009-06-26 14:08:15 -05:00
|
|
|
|
check_trail(TR);
|
2012-10-19 18:10:48 +01:00
|
|
|
|
if (!(PREG->u.Osbpp.p->PredFlags & (SafePredFlag))) {
|
2005-10-28 17:38:50 +00:00
|
|
|
|
CACHE_Y_AS_ENV(YREG);
|
|
|
|
|
check_stack(NoStackCall, H);
|
|
|
|
|
ENDCACHE_Y_AS_ENV();
|
|
|
|
|
}
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
2001-04-09 19:54:03 +00:00
|
|
|
|
{
|
|
|
|
|
choiceptr top_b = PROTECT_FROZEN_B(B);
|
2005-09-08 22:06:45 +00:00
|
|
|
|
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#ifdef YAPOR_SBA
|
2002-11-11 17:38:10 +00:00
|
|
|
|
if (YREG > (CELL *) top_b || YREG < H) ASP = (CELL *)top_b;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#else
|
2002-11-11 17:38:10 +00:00
|
|
|
|
if (YREG > (CELL *) top_b) ASP = (CELL *)top_b;
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#endif /* YAPOR_SBA */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
else ASP = (CELL *)(((char *)YREG) + PREG->u.Osbpp.s);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
#else
|
2011-02-17 00:57:49 +00:00
|
|
|
|
SET_ASP(YREG, PREG->u.Osbpp.s);
|
2002-10-17 00:05:29 +00:00
|
|
|
|
/* for slots to work */
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#endif /* FROZEN_STACKS */
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
2002-11-18 18:18:05 +00:00
|
|
|
|
if (Yap_do_low_level_trace)
|
2008-09-05 05:22:19 +01:00
|
|
|
|
low_level_trace(enter_pred,PREG->u.Osbpp.p,XREGS+1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif /* LOW_LEVEL_TRACE */
|
|
|
|
|
BEGD(d0);
|
2008-09-05 05:22:19 +01:00
|
|
|
|
CPredicate f = PREG->u.Osbpp.p->cs.f_code;
|
|
|
|
|
PREG = NEXTOP(PREG, Osbpp);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
saveregs();
|
2011-03-07 16:02:55 +00:00
|
|
|
|
d0 = (f)(PASS_REGS1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
2008-03-26 14:37:08 +00:00
|
|
|
|
#ifdef SHADOW_S
|
2007-10-28 00:54:09 +00:00
|
|
|
|
SREG = Yap_REGS.S_;
|
|
|
|
|
#endif
|
2001-10-30 16:42:05 +00:00
|
|
|
|
if (!d0) {
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
CACHE_A1();
|
2001-10-30 16:42:05 +00:00
|
|
|
|
ENDD(d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2008-08-28 04:43:00 +01:00
|
|
|
|
/* execute Label */
|
|
|
|
|
BOp(execute_cpred, pp);
|
2009-06-26 14:08:15 -05:00
|
|
|
|
check_trail(TR);
|
2008-08-28 04:43:00 +01:00
|
|
|
|
{
|
|
|
|
|
PredEntry *pt0;
|
2009-05-02 10:54:09 -05:00
|
|
|
|
|
2008-08-28 04:43:00 +01:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
CACHE_Y_AS_ENV(YREG);
|
|
|
|
|
#ifdef FROZEN_STACKS
|
2009-05-02 10:54:09 -05:00
|
|
|
|
{
|
|
|
|
|
choiceptr top_b = PROTECT_FROZEN_B(B);
|
2008-08-28 04:43:00 +01:00
|
|
|
|
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#ifdef YAPOR_SBA
|
2009-05-02 10:54:09 -05:00
|
|
|
|
if (YREG > (CELL *) top_b || YREG < H) ASP = (CELL *)top_b;
|
2008-08-28 04:43:00 +01:00
|
|
|
|
#else
|
2009-05-02 10:54:09 -05:00
|
|
|
|
if (YREG > (CELL *) top_b) ASP = (CELL *)top_b;
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#endif /* YAPOR_SBA */
|
2009-05-02 10:54:09 -05:00
|
|
|
|
else ASP = YREG+E_CB;
|
|
|
|
|
}
|
2008-08-28 04:43:00 +01:00
|
|
|
|
#else
|
2011-02-17 00:57:49 +00:00
|
|
|
|
SET_ASP(YREG, E_CB*sizeof(CELL));
|
2009-05-02 10:54:09 -05:00
|
|
|
|
/* for slots to work */
|
2008-08-28 04:43:00 +01:00
|
|
|
|
#endif /* FROZEN_STACKS */
|
2009-05-02 10:54:09 -05:00
|
|
|
|
pt0 = PREG->u.pp.p;
|
2008-08-28 04:43:00 +01:00
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
2009-05-02 10:54:09 -05:00
|
|
|
|
if (Yap_do_low_level_trace) {
|
|
|
|
|
low_level_trace(enter_pred,pt0,XREGS+1);
|
|
|
|
|
}
|
2008-08-28 04:43:00 +01:00
|
|
|
|
#endif /* LOW_LEVEL_TRACE */
|
2009-05-02 10:54:09 -05:00
|
|
|
|
CACHE_A1();
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = (CELL)B;
|
2008-08-28 04:43:00 +01:00
|
|
|
|
#ifndef NO_CHECKING
|
2009-05-02 10:54:09 -05:00
|
|
|
|
check_stack(NoStackExecute, H);
|
2008-08-28 04:43:00 +01:00
|
|
|
|
#endif
|
2009-05-02 10:54:09 -05:00
|
|
|
|
/* for profiler */
|
|
|
|
|
save_pc();
|
|
|
|
|
ENV_YREG[E_CB] = d0;
|
|
|
|
|
ENDD(d0);
|
2008-08-28 04:43:00 +01:00
|
|
|
|
#ifdef DEPTH_LIMIT
|
2009-05-02 10:54:09 -05:00
|
|
|
|
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is prolog */
|
|
|
|
|
if (pt0->ModuleOfPred) {
|
|
|
|
|
if (DEPTH == MkIntTerm(0))
|
|
|
|
|
FAIL();
|
|
|
|
|
else DEPTH = RESET_DEPTH();
|
|
|
|
|
}
|
|
|
|
|
} else if (pt0->ModuleOfPred) {
|
|
|
|
|
DEPTH -= MkIntConstant(2);
|
2008-08-28 04:43:00 +01:00
|
|
|
|
}
|
|
|
|
|
#endif /* DEPTH_LIMIT */
|
|
|
|
|
/* now call C-Code */
|
2009-05-02 10:54:09 -05:00
|
|
|
|
{
|
|
|
|
|
CPredicate f = PREG->u.pp.p->cs.f_code;
|
|
|
|
|
yamop *oldPREG = PREG;
|
|
|
|
|
saveregs();
|
2011-03-07 16:02:55 +00:00
|
|
|
|
d0 = (f)(PASS_REGS1);
|
2009-05-02 10:54:09 -05:00
|
|
|
|
setregs();
|
2008-08-28 04:43:00 +01:00
|
|
|
|
#ifdef SHADOW_S
|
2009-05-02 10:54:09 -05:00
|
|
|
|
SREG = Yap_REGS.S_;
|
2008-08-28 04:43:00 +01:00
|
|
|
|
#endif
|
2009-05-02 10:54:09 -05:00
|
|
|
|
if (!d0) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
if (oldPREG == PREG) {
|
|
|
|
|
/* we did not update PREG */
|
|
|
|
|
/* we can proceed */
|
|
|
|
|
PREG = CPREG;
|
|
|
|
|
ENV_YREG = ENV;
|
2008-08-28 04:43:00 +01:00
|
|
|
|
#ifdef DEPTH_LIMIT
|
2009-05-02 10:54:09 -05:00
|
|
|
|
DEPTH = ENV_YREG[E_DEPTH];
|
2008-08-28 04:43:00 +01:00
|
|
|
|
#endif
|
2009-05-02 10:54:09 -05:00
|
|
|
|
WRITEBACK_Y_AS_ENV();
|
|
|
|
|
} else {
|
|
|
|
|
/* call the new code */
|
|
|
|
|
CACHE_A1();
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
JMPNext();
|
|
|
|
|
ENDCACHE_Y_AS_ENV();
|
|
|
|
|
ENDD(d0);
|
2008-08-28 04:43:00 +01:00
|
|
|
|
}
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* Like previous, the only difference is that we do not */
|
|
|
|
|
/* trust the C-function we are calling and hence we must */
|
|
|
|
|
/* guarantee that *all* machine registers are saved and */
|
|
|
|
|
/* restored */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
BOp(call_usercpred, Osbpp);
|
2005-10-28 17:38:50 +00:00
|
|
|
|
CACHE_Y_AS_ENV(YREG);
|
|
|
|
|
check_stack(NoStackCall, H);
|
|
|
|
|
ENDCACHE_Y_AS_ENV();
|
2009-05-09 23:30:20 -04:00
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
|
|
|
|
if (Yap_do_low_level_trace) {
|
2010-05-03 16:34:20 +01:00
|
|
|
|
low_level_trace(enter_pred,PREG->u.Osbpp.p,XREGS+1);
|
2009-05-09 23:30:20 -04:00
|
|
|
|
}
|
|
|
|
|
#endif /* LOW_LEVEL_TRACE */
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
2001-04-09 19:54:03 +00:00
|
|
|
|
{
|
|
|
|
|
choiceptr top_b = PROTECT_FROZEN_B(B);
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#ifdef YAPOR_SBA
|
2002-11-11 17:38:10 +00:00
|
|
|
|
if (YREG > (CELL *) top_b || YREG < H) ASP = (CELL *) top_b;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#else
|
2002-11-11 17:38:10 +00:00
|
|
|
|
if (YREG > (CELL *) top_b) ASP = (CELL *) top_b;
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#endif /* YAPOR_SBA */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
else ASP = (CELL *)(((char *)YREG) + PREG->u.Osbpp.s);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
#else
|
2011-02-17 00:57:49 +00:00
|
|
|
|
SET_ASP(YREG, PREG->u.Osbpp.s);
|
2002-05-14 18:24:34 +00:00
|
|
|
|
/* for slots to work */
|
2009-07-17 18:39:50 -05:00
|
|
|
|
#endif /* FROZEN_STACKS */
|
2002-12-27 16:53:09 +00:00
|
|
|
|
{
|
2010-08-17 13:02:50 +01:00
|
|
|
|
/* make sure that we can still have access to our old PREG after calling user defined goals and backtracking or failing */
|
|
|
|
|
yamop *savedP;
|
2010-06-01 00:40:58 +01:00
|
|
|
|
|
2011-03-07 16:02:55 +00:00
|
|
|
|
Yap_StartSlots( PASS_REGS1 );
|
2011-05-25 16:40:36 +01:00
|
|
|
|
LOCAL_PrologMode = UserCCallMode;
|
2010-08-17 13:02:50 +01:00
|
|
|
|
{
|
|
|
|
|
PredEntry *p = PREG->u.Osbpp.p;
|
|
|
|
|
|
|
|
|
|
PREG = NEXTOP(PREG, Osbpp);
|
|
|
|
|
savedP = PREG;
|
|
|
|
|
saveregs();
|
|
|
|
|
save_machine_regs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
2010-08-17 13:02:50 +01:00
|
|
|
|
SREG = (CELL *) YAP_Execute(p, p->cs.f_code);
|
|
|
|
|
}
|
2011-03-07 16:02:55 +00:00
|
|
|
|
Yap_CloseSlots( PASS_REGS1 );
|
2010-08-17 13:02:50 +01:00
|
|
|
|
setregs();
|
2011-05-25 16:40:36 +01:00
|
|
|
|
LOCAL_PrologMode = UserMode;
|
2010-08-17 13:02:50 +01:00
|
|
|
|
restore_machine_regs();
|
|
|
|
|
PREG = savedP;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
2010-07-21 12:49:06 +01:00
|
|
|
|
if (EX) {
|
|
|
|
|
struct DB_TERM *exp = EX;
|
|
|
|
|
EX = NULL;
|
|
|
|
|
Yap_JumpToEnv(Yap_PopTermFromDB(exp));
|
2013-03-03 08:54:46 -06:00
|
|
|
|
SREG = NULL;
|
2010-07-21 12:49:06 +01:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (!SREG) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
2009-11-27 13:14:30 +00:00
|
|
|
|
/* in case we call Execute */
|
2010-07-20 11:28:56 +01:00
|
|
|
|
YENV = ENV;
|
|
|
|
|
YREG = ENV;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2008-12-09 12:54:27 +00:00
|
|
|
|
BOp(call_c_wfail, slp);
|
2009-05-09 23:30:20 -04:00
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
|
|
|
|
if (Yap_do_low_level_trace) {
|
|
|
|
|
low_level_trace(enter_pred,PREG->u.slp.p,XREGS+1);
|
|
|
|
|
}
|
|
|
|
|
#endif /* LOW_LEVEL_TRACE */
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
2001-04-09 19:54:03 +00:00
|
|
|
|
{
|
|
|
|
|
choiceptr top_b = PROTECT_FROZEN_B(B);
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#ifdef YAPOR_SBA
|
2002-11-11 17:38:10 +00:00
|
|
|
|
if (YREG > (CELL *) top_b || YREG < H) ASP = (CELL *) top_b;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#else
|
2002-11-11 17:38:10 +00:00
|
|
|
|
if (YREG > (CELL *) top_b) ASP = (CELL *) top_b;
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#endif /* YAPOR_SBA */
|
2001-04-09 19:54:03 +00:00
|
|
|
|
else {
|
|
|
|
|
BEGD(d0);
|
2008-12-09 12:54:27 +00:00
|
|
|
|
d0 = PREG->u.slp.s;
|
2002-11-11 17:38:10 +00:00
|
|
|
|
ASP = ((CELL *)YREG) + d0;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDD(d0);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
#else
|
2002-11-11 17:38:10 +00:00
|
|
|
|
if (YREG > (CELL *) B)
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ASP = (CELL *) B;
|
|
|
|
|
else {
|
|
|
|
|
BEGD(d0);
|
2008-12-09 12:54:27 +00:00
|
|
|
|
d0 = PREG->u.slp.s;
|
2002-11-11 17:38:10 +00:00
|
|
|
|
ASP = ((CELL *) YREG) + d0;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDD(d0);
|
|
|
|
|
}
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#endif /* FROZEN_STACKS */
|
2002-12-27 16:53:09 +00:00
|
|
|
|
{
|
2008-12-09 12:54:27 +00:00
|
|
|
|
CPredicate f = PREG->u.slp.p->cs.f_code;
|
2002-12-27 16:53:09 +00:00
|
|
|
|
saveregs();
|
2011-03-07 16:02:55 +00:00
|
|
|
|
SREG = (CELL *)((f)(PASS_REGS1));
|
2004-06-09 03:32:03 +00:00
|
|
|
|
setregs();
|
2002-12-27 16:53:09 +00:00
|
|
|
|
}
|
2009-05-09 23:40:17 -04:00
|
|
|
|
if (!SREG) {
|
|
|
|
|
/* be careful about error handling */
|
|
|
|
|
if (PREG != FAILCODE)
|
|
|
|
|
PREG = PREG->u.slp.l;
|
|
|
|
|
} else {
|
2008-12-09 12:54:27 +00:00
|
|
|
|
PREG = NEXTOP(PREG, slp);
|
2009-05-09 23:40:17 -04:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
CACHE_A1();
|
|
|
|
|
JMPNext();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2008-09-05 05:22:19 +01:00
|
|
|
|
BOp(try_c, OtapFs);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
CUT_wait_leftmost();
|
|
|
|
|
#endif /* YAPOR */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
CACHE_Y(YREG);
|
2005-11-18 18:52:41 +00:00
|
|
|
|
#ifdef CUT_C
|
|
|
|
|
/* Alocate space for the cut_c structure*/
|
2008-09-05 05:22:19 +01:00
|
|
|
|
CUT_C_PUSH(NEXTOP(NEXTOP(PREG,OtapFs),OtapFs),S_YREG);
|
2005-11-18 18:52:41 +00:00
|
|
|
|
#endif
|
2008-09-05 05:22:19 +01:00
|
|
|
|
S_YREG = S_YREG - PREG->u.OtapFs.extra;
|
|
|
|
|
store_args(PREG->u.OtapFs.s);
|
|
|
|
|
store_yaam_regs(NEXTOP(PREG, OtapFs), 0);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
B = B_YREG;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifdef YAPOR
|
2002-11-11 17:38:10 +00:00
|
|
|
|
SCH_set_load(B_YREG);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif /* YAPOR */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
SET_BB(B_YREG);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDCACHE_Y();
|
|
|
|
|
|
|
|
|
|
TRYCC:
|
2001-05-02 14:19:10 +00:00
|
|
|
|
ASP = (CELL *)B;
|
2002-12-27 16:53:09 +00:00
|
|
|
|
{
|
2008-09-05 05:22:19 +01:00
|
|
|
|
CPredicate f = (CPredicate)(PREG->u.OtapFs.f);
|
2002-12-27 16:53:09 +00:00
|
|
|
|
saveregs();
|
2011-03-07 16:02:55 +00:00
|
|
|
|
SREG = (CELL *) ((f) (PASS_REGS1));
|
2009-06-01 15:30:22 -05:00
|
|
|
|
/* This last instruction changes B B*/
|
2005-11-18 18:52:41 +00:00
|
|
|
|
#ifdef CUT_C
|
|
|
|
|
while (POP_CHOICE_POINT(B)){
|
|
|
|
|
cut_c_pop();
|
|
|
|
|
}
|
|
|
|
|
#endif
|
2009-06-01 15:30:22 -05:00
|
|
|
|
setregs();
|
2002-12-27 16:53:09 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (!SREG) {
|
2005-11-18 18:52:41 +00:00
|
|
|
|
#ifdef CUT_C
|
|
|
|
|
/* Removes the cut functions from the stack
|
|
|
|
|
without executing them because we have fail
|
|
|
|
|
and not cuted the predicate*/
|
|
|
|
|
while(POP_CHOICE_POINT(B))
|
|
|
|
|
cut_c_pop();
|
|
|
|
|
#endif
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
2002-11-11 17:38:10 +00:00
|
|
|
|
if ((CELL *) B == YREG && ASP != (CELL *) B) {
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* 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 */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
YREG = ASP;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
HBREG = PROTECT_FROZEN_H(B);
|
|
|
|
|
SET_BB(B);
|
|
|
|
|
}
|
2002-12-27 16:53:09 +00:00
|
|
|
|
PREG = CPREG;
|
2002-11-11 17:38:10 +00:00
|
|
|
|
YREG = ENV;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2008-09-05 05:22:19 +01:00
|
|
|
|
BOp(retry_c, OtapFs);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
CUT_wait_leftmost();
|
|
|
|
|
#endif /* YAPOR */
|
|
|
|
|
CACHE_Y(B);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
CPREG = B_YREG->cp_cp;
|
|
|
|
|
ENV = B_YREG->cp_env;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
H = PROTECT_FROZEN_H(B);
|
|
|
|
|
#ifdef DEPTH_LIMIT
|
|
|
|
|
DEPTH =B->cp_depth;
|
|
|
|
|
#endif
|
|
|
|
|
HBREG = H;
|
2008-09-05 05:22:19 +01:00
|
|
|
|
restore_args(PREG->u.OtapFs.s);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDCACHE_Y();
|
|
|
|
|
goto TRYCC;
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2005-11-18 18:52:41 +00:00
|
|
|
|
#ifdef CUT_C
|
2008-09-05 05:22:19 +01:00
|
|
|
|
BOp(cut_c, OtapFs);
|
2005-11-18 18:52:41 +00:00
|
|
|
|
/*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__);
|
|
|
|
|
#endif /*DEBUG*/
|
|
|
|
|
ENDBOp();
|
|
|
|
|
#endif
|
|
|
|
|
|
2008-09-05 05:22:19 +01:00
|
|
|
|
BOp(try_userc, OtapFs);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
CUT_wait_leftmost();
|
|
|
|
|
#endif /* YAPOR */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
CACHE_Y(YREG);
|
2005-11-18 18:52:41 +00:00
|
|
|
|
#ifdef CUT_C
|
|
|
|
|
/* Alocate space for the cut_c structure*/
|
2008-09-05 05:22:19 +01:00
|
|
|
|
CUT_C_PUSH(NEXTOP(NEXTOP(PREG,OtapFs),OtapFs),S_YREG);
|
2005-11-18 18:52:41 +00:00
|
|
|
|
#endif
|
2008-09-05 05:22:19 +01:00
|
|
|
|
S_YREG = S_YREG - PREG->u.OtapFs.extra;
|
|
|
|
|
store_args(PREG->u.OtapFs.s);
|
|
|
|
|
store_yaam_regs(NEXTOP(PREG, OtapFs), 0);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
B = B_YREG;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifdef YAPOR
|
2002-11-11 17:38:10 +00:00
|
|
|
|
SCH_set_load(B_YREG);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif
|
2002-11-11 17:38:10 +00:00
|
|
|
|
SET_BB(B_YREG);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDCACHE_Y();
|
2011-05-25 16:40:36 +01:00
|
|
|
|
LOCAL_PrologMode = UserCCallMode;
|
2009-06-16 21:20:35 -05:00
|
|
|
|
ASP = YREG;
|
2009-06-01 15:30:22 -05:00
|
|
|
|
/* for slots to work */
|
2011-03-07 16:02:55 +00:00
|
|
|
|
Yap_StartSlots( PASS_REGS1 );
|
2001-04-09 19:54:03 +00:00
|
|
|
|
saveregs();
|
|
|
|
|
save_machine_regs();
|
2009-06-01 15:30:22 -05:00
|
|
|
|
SREG = (CELL *) YAP_ExecuteFirst(PREG->u.OtapFs.p, (CPredicate)(PREG->u.OtapFs.f));
|
2013-01-18 14:27:46 +00:00
|
|
|
|
EX = NULL;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
restore_machine_regs();
|
|
|
|
|
setregs();
|
2011-05-25 16:40:36 +01:00
|
|
|
|
LOCAL_PrologMode = UserMode;
|
2011-03-07 16:02:55 +00:00
|
|
|
|
Yap_CloseSlots( PASS_REGS1 );
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (!SREG) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
2002-11-11 17:38:10 +00:00
|
|
|
|
if ((CELL *) B == YREG && ASP != (CELL *) B) {
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* 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 */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
YREG = ASP;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
HBREG = PROTECT_FROZEN_H(B);
|
|
|
|
|
}
|
2002-12-27 16:53:09 +00:00
|
|
|
|
PREG = CPREG;
|
2002-11-11 17:38:10 +00:00
|
|
|
|
YREG = ENV;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
CACHE_A1();
|
|
|
|
|
JMPNext();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2008-09-05 05:22:19 +01:00
|
|
|
|
BOp(retry_userc, OtapFs);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
CUT_wait_leftmost();
|
|
|
|
|
#endif /* YAPOR */
|
|
|
|
|
CACHE_Y(B);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
CPREG = B_YREG->cp_cp;
|
|
|
|
|
ENV = B_YREG->cp_env;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
H = PROTECT_FROZEN_H(B);
|
|
|
|
|
#ifdef DEPTH_LIMIT
|
|
|
|
|
DEPTH =B->cp_depth;
|
|
|
|
|
#endif
|
|
|
|
|
HBREG = H;
|
2008-09-05 05:22:19 +01:00
|
|
|
|
restore_args(PREG->u.OtapFs.s);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDCACHE_Y();
|
2009-06-01 15:30:22 -05:00
|
|
|
|
|
2011-05-25 16:40:36 +01:00
|
|
|
|
LOCAL_PrologMode = UserCCallMode;
|
2011-02-17 00:57:49 +00:00
|
|
|
|
SET_ASP(YREG, E_CB*sizeof(CELL));
|
2009-06-01 15:30:22 -05:00
|
|
|
|
/* for slots to work */
|
2011-03-07 16:02:55 +00:00
|
|
|
|
Yap_StartSlots( PASS_REGS1 );
|
2009-06-01 15:30:22 -05:00
|
|
|
|
saveregs();
|
|
|
|
|
save_machine_regs();
|
|
|
|
|
SREG = (CELL *) YAP_ExecuteNext(PREG->u.OtapFs.p, (CPredicate)(PREG->u.OtapFs.f));
|
2013-01-18 14:27:46 +00:00
|
|
|
|
EX = NULL;
|
2009-06-01 15:30:22 -05:00
|
|
|
|
restore_machine_regs();
|
|
|
|
|
setregs();
|
2011-05-25 16:40:36 +01:00
|
|
|
|
LOCAL_PrologMode = UserMode;
|
2011-03-07 16:02:55 +00:00
|
|
|
|
Yap_CloseSlots( PASS_REGS1 );
|
2009-06-01 15:30:22 -05:00
|
|
|
|
if (!SREG) {
|
|
|
|
|
#ifdef CUT_C
|
|
|
|
|
/* Removes the cut functions from the stack
|
|
|
|
|
without executing them because we have fail
|
|
|
|
|
and not cuted the predicate*/
|
|
|
|
|
while(POP_CHOICE_POINT(B))
|
|
|
|
|
cut_c_pop();
|
|
|
|
|
#endif
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
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 */
|
|
|
|
|
YREG = ASP;
|
|
|
|
|
HBREG = PROTECT_FROZEN_H(B);
|
|
|
|
|
}
|
|
|
|
|
PREG = CPREG;
|
|
|
|
|
YREG = ENV;
|
|
|
|
|
CACHE_A1();
|
|
|
|
|
JMPNext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDBOp();
|
2005-11-18 18:52:41 +00:00
|
|
|
|
|
|
|
|
|
#ifdef CUT_C
|
2008-09-05 05:22:19 +01:00
|
|
|
|
BOp(cut_userc, OtapFs);
|
2005-11-18 18:52:41 +00:00
|
|
|
|
/*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__);
|
|
|
|
|
#endif /*DEBUG*/
|
2012-01-21 18:19:57 +00:00
|
|
|
|
CACHE_A1();
|
|
|
|
|
JMPNext();
|
2005-11-18 18:52:41 +00:00
|
|
|
|
ENDBOp();
|
|
|
|
|
#endif
|
|
|
|
|
|
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/************************************************************************\
|
|
|
|
|
* support instructions *
|
|
|
|
|
\************************************************************************/
|
|
|
|
|
|
2007-11-26 23:43:10 +00:00
|
|
|
|
BOp(lock_pred, e);
|
|
|
|
|
{
|
|
|
|
|
PredEntry *ap = PredFromDefCode(PREG);
|
2010-07-25 11:22:16 +01:00
|
|
|
|
PELOCK(10,ap);
|
2007-11-26 23:43:10 +00:00
|
|
|
|
PP = ap;
|
|
|
|
|
if (!ap->cs.p_code.NOfClauses) {
|
2011-03-15 09:08:09 +00:00
|
|
|
|
UNLOCKPE(11,ap);
|
2007-11-26 23:43:10 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
/*
|
|
|
|
|
we do not lock access to the predicate,
|
|
|
|
|
we must take extra care here
|
|
|
|
|
*/
|
|
|
|
|
if (ap->cs.p_code.NOfClauses > 1 &&
|
|
|
|
|
!(ap->PredFlags & IndexedPredFlag)) {
|
|
|
|
|
/* update ASP before calling IPred */
|
2011-02-14 11:29:20 -08:00
|
|
|
|
SET_ASP(YREG, E_CB*sizeof(CELL));
|
2007-11-26 23:43:10 +00:00
|
|
|
|
saveregs();
|
2010-01-29 15:21:00 +00:00
|
|
|
|
Yap_IPred(ap, 0, CP);
|
2007-11-26 23:43:10 +00:00
|
|
|
|
/* IPred can generate errors, it thus must get rid of the lock itself */
|
|
|
|
|
setregs();
|
|
|
|
|
CACHE_A1();
|
|
|
|
|
/* for profiler */
|
|
|
|
|
save_pc();
|
|
|
|
|
}
|
|
|
|
|
PREG = ap->cs.p_code.TrueCodeOfPred;
|
|
|
|
|
}
|
|
|
|
|
JMPNext();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BOp(index_pred, e);
|
2003-12-27 00:38:53 +00:00
|
|
|
|
{
|
|
|
|
|
PredEntry *ap = PredFromDefCode(PREG);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
|
|
|
|
/*
|
|
|
|
|
we do not lock access to the predicate,
|
|
|
|
|
we must take extra care here
|
|
|
|
|
*/
|
2007-11-26 23:43:10 +00:00
|
|
|
|
if (!PP) {
|
2010-07-25 11:22:16 +01:00
|
|
|
|
PELOCK(11,ap);
|
2007-11-26 23:43:10 +00:00
|
|
|
|
}
|
2003-12-27 00:38:53 +00:00
|
|
|
|
if (ap->OpcodeOfPred != INDEX_OPCODE) {
|
|
|
|
|
/* someone was here before we were */
|
2010-07-25 11:22:16 +01:00
|
|
|
|
if (!PP) {
|
|
|
|
|
UNLOCKPE(11,ap);
|
|
|
|
|
}
|
2003-12-27 00:38:53 +00:00
|
|
|
|
PREG = ap->CodeOfPred;
|
2005-12-23 00:20:14 +00:00
|
|
|
|
/* for profiler */
|
|
|
|
|
save_pc();
|
2003-12-27 00:38:53 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
2002-10-17 00:05:29 +00:00
|
|
|
|
#endif
|
|
|
|
|
/* update ASP before calling IPred */
|
2011-02-14 11:29:20 -08:00
|
|
|
|
SET_ASP(YREG, E_CB*sizeof(CELL));
|
2004-06-09 03:32:03 +00:00
|
|
|
|
saveregs();
|
2010-01-29 15:21:00 +00:00
|
|
|
|
Yap_IPred(ap, 0, CP);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* IPred can generate errors, it thus must get rid of the lock itself */
|
2003-12-27 00:38:53 +00:00
|
|
|
|
setregs();
|
2005-05-26 18:07:32 +00:00
|
|
|
|
CACHE_A1();
|
2003-12-27 00:38:53 +00:00
|
|
|
|
PREG = ap->CodeOfPred;
|
2005-12-23 00:20:14 +00:00
|
|
|
|
/* for profiler */
|
|
|
|
|
save_pc();
|
2007-11-26 23:43:10 +00:00
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
|
|
|
|
if (!PP)
|
|
|
|
|
#endif
|
2010-07-28 11:26:20 +01:00
|
|
|
|
UNLOCKPE(14,ap);
|
2007-11-26 23:43:10 +00:00
|
|
|
|
|
2003-12-27 00:38:53 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2004-02-05 16:57:02 +00:00
|
|
|
|
#if THREADS
|
|
|
|
|
BOp(thread_local, e);
|
|
|
|
|
{
|
|
|
|
|
PredEntry *ap = PredFromDefCode(PREG);
|
2011-03-07 16:02:55 +00:00
|
|
|
|
ap = Yap_GetThreadPred(ap PASS_REGS);
|
2004-02-05 16:57:02 +00:00
|
|
|
|
PREG = ap->CodeOfPred;
|
2005-12-23 00:20:14 +00:00
|
|
|
|
/* for profiler */
|
|
|
|
|
save_pc();
|
2004-02-05 16:57:02 +00:00
|
|
|
|
}
|
|
|
|
|
JMPNext();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
#endif
|
|
|
|
|
|
2003-08-23 19:26:08 +00:00
|
|
|
|
BOp(expand_index, e);
|
|
|
|
|
{
|
|
|
|
|
PredEntry *pe = PredFromExpandCode(PREG);
|
2003-10-28 01:16:03 +00:00
|
|
|
|
yamop *pt0;
|
|
|
|
|
|
2003-08-23 19:26:08 +00:00
|
|
|
|
/* update ASP before calling IPred */
|
2011-02-14 11:29:20 -08:00
|
|
|
|
SET_ASP(YREG, E_CB*sizeof(CELL));
|
2004-02-05 16:57:02 +00:00
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
2007-11-26 23:43:10 +00:00
|
|
|
|
if (!PP) {
|
2010-07-25 11:22:16 +01:00
|
|
|
|
PELOCK(12,pe);
|
2004-02-28 01:08:59 +00:00
|
|
|
|
}
|
2004-06-23 17:24:20 +00:00
|
|
|
|
if (!same_lu_block(PREG_ADDR, PREG)) {
|
2004-02-18 01:43:32 +00:00
|
|
|
|
PREG = *PREG_ADDR;
|
2010-07-25 11:22:16 +01:00
|
|
|
|
if (!PP) {
|
2010-07-28 11:26:20 +01:00
|
|
|
|
UNLOCKPE(15,pe);
|
2010-07-25 11:22:16 +01:00
|
|
|
|
}
|
2004-02-05 16:57:02 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
|
|
|
|
#endif
|
2009-08-19 20:22:04 -05:00
|
|
|
|
#ifdef SHADOW_S
|
|
|
|
|
S = SREG;
|
|
|
|
|
#endif /* SHADOW_S */
|
2004-02-19 19:24:46 +00:00
|
|
|
|
saveregs();
|
2004-09-30 19:51:54 +00:00
|
|
|
|
pt0 = Yap_ExpandIndex(pe, 0);
|
2003-08-23 19:26:08 +00:00
|
|
|
|
/* restart index */
|
2004-02-18 01:43:32 +00:00
|
|
|
|
setregs();
|
2009-08-19 20:22:04 -05:00
|
|
|
|
#ifdef SHADOW_S
|
|
|
|
|
SREG = S;
|
|
|
|
|
#endif /* SHADOW_S */
|
2003-11-28 01:26:53 +00:00
|
|
|
|
PREG = pt0;
|
2004-02-28 01:08:59 +00:00
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
2010-07-25 11:22:16 +01:00
|
|
|
|
if (!PP) {
|
|
|
|
|
UNLOCKPE(12,pe);
|
|
|
|
|
}
|
2004-02-28 01:08:59 +00:00
|
|
|
|
#endif
|
2003-08-23 19:26:08 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
BOp(expand_clauses, sssllp);
|
2004-03-31 01:03:10 +00:00
|
|
|
|
{
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PredEntry *pe = PREG->u.sssllp.p;
|
2004-03-31 01:03:10 +00:00
|
|
|
|
yamop *pt0;
|
|
|
|
|
|
|
|
|
|
/* update ASP before calling IPred */
|
2011-02-14 11:29:20 -08:00
|
|
|
|
SET_ASP(YREG, E_CB*sizeof(CELL));
|
2004-03-31 01:03:10 +00:00
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
|
|
|
|
if (PP == NULL) {
|
2010-07-25 11:22:16 +01:00
|
|
|
|
PELOCK(13,pe);
|
2004-03-31 01:03:10 +00:00
|
|
|
|
}
|
2004-06-23 17:24:20 +00:00
|
|
|
|
if (!same_lu_block(PREG_ADDR, PREG)) {
|
2004-03-31 01:03:10 +00:00
|
|
|
|
PREG = *PREG_ADDR;
|
2007-11-26 23:43:10 +00:00
|
|
|
|
if (!PP) {
|
2010-07-28 11:26:20 +01:00
|
|
|
|
UNLOCKPE(16,pe);
|
2004-03-31 01:03:10 +00:00
|
|
|
|
}
|
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
|
|
|
|
#endif
|
|
|
|
|
saveregs();
|
2004-09-30 19:51:54 +00:00
|
|
|
|
pt0 = Yap_ExpandIndex(pe, 0);
|
2004-03-31 01:03:10 +00:00
|
|
|
|
/* restart index */
|
|
|
|
|
setregs();
|
2010-07-28 11:26:20 +01:00
|
|
|
|
UNLOCKPE(17,pe);
|
2013-05-01 19:27:00 -05:00
|
|
|
|
#ifdef DEBUG_LOCK
|
|
|
|
|
{ PredEntry *ap = pe;
|
|
|
|
|
if (ap->ArityOfPE) {
|
|
|
|
|
if ( ap->ModuleOfPred != IDB_MODULE)
|
|
|
|
|
printf("L9 %s\n", AtomName(NameOfFunctor(ap->FunctorOfPred)));
|
|
|
|
|
else
|
|
|
|
|
{
|
|
|
|
|
if (ap->PredFlags & NumberDBPredFlag) {
|
|
|
|
|
printf("L9 %ld\n", ap->src.IndxId);
|
|
|
|
|
} else if (ap->PredFlags & AtomDBPredFlag) {
|
|
|
|
|
printf("L9 %s\n", AtomName((Atom)(ap->FunctorOfPred)));
|
|
|
|
|
} else {
|
|
|
|
|
printf("L9 %s\n", AtomName(NameOfFunctor(ap->FunctorOfPred)));
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
#endif
|
2004-03-31 01:03:10 +00:00
|
|
|
|
PREG = pt0;
|
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
2007-11-26 23:43:10 +00:00
|
|
|
|
if (!PP) {
|
2010-07-28 11:26:20 +01:00
|
|
|
|
UNLOCKPE(18,pe);
|
2004-03-31 01:03:10 +00:00
|
|
|
|
}
|
|
|
|
|
#endif
|
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BOp(undef_p, e);
|
|
|
|
|
/* save S for module name */
|
|
|
|
|
{
|
|
|
|
|
PredEntry *pe = PredFromDefCode(PREG);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
/* avoid trouble with undefined dynamic procedures */
|
2008-08-19 13:33:45 +00:00
|
|
|
|
if ((pe->PredFlags & (DynamicPredFlag|LogUpdatePredFlag|MultiFileFlag)) ||
|
|
|
|
|
(UndefCode->OpcodeOfPred == UNDEF_OPCODE)) {
|
2007-11-26 23:43:10 +00:00
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
|
|
|
|
PP = NULL;
|
|
|
|
|
#endif
|
2010-07-28 11:26:20 +01:00
|
|
|
|
UNLOCKPE(19,pe);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
d0 = pe->ArityOfPE;
|
2010-07-28 11:26:20 +01:00
|
|
|
|
UNLOCKPE(19,pe);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (d0 == 0) {
|
2001-10-30 16:42:05 +00:00
|
|
|
|
H[1] = MkAtomTerm((Atom)(pe->FunctorOfPred));
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
H[d0 + 2] = AbsAppl(H);
|
|
|
|
|
*H = (CELL) pe->FunctorOfPred;
|
|
|
|
|
H++;
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
pt1 = XREGS + 1;
|
|
|
|
|
for (; d0 > 0; --d0) {
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = pt1++;
|
|
|
|
|
d1 = *pt0;
|
|
|
|
|
deref_head(d1, undef_unk);
|
|
|
|
|
undef_nonvar:
|
|
|
|
|
/* just copy it to the heap */
|
|
|
|
|
*H++ = d1;
|
|
|
|
|
continue;
|
|
|
|
|
|
|
|
|
|
derefa_body(d1, pt0, undef_unk, undef_nonvar);
|
|
|
|
|
if (pt0 <= H) {
|
|
|
|
|
/* variable is safe */
|
|
|
|
|
*H++ = (CELL)pt0;
|
|
|
|
|
} else {
|
|
|
|
|
/* bind it, in case it is a local variable */
|
|
|
|
|
d1 = Unsigned(H);
|
|
|
|
|
RESET_VARIABLE(H);
|
|
|
|
|
H += 1;
|
|
|
|
|
Bind_Local(pt0, d1);
|
|
|
|
|
}
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
}
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
}
|
|
|
|
|
ENDD(d0);
|
2004-02-12 12:37:12 +00:00
|
|
|
|
H[0] = Yap_Module_Name(pe);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ARG1 = (Term) AbsPair(H);
|
|
|
|
|
H += 2;
|
2004-02-17 18:24:44 +00:00
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
|
|
|
|
if (Yap_do_low_level_trace)
|
|
|
|
|
low_level_trace(enter_pred,UndefCode,XREGS+1);
|
|
|
|
|
#endif /* LOW_LEVEL_TRACE */
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
|
2002-12-27 16:53:09 +00:00
|
|
|
|
PREG = UndefCode->CodeOfPred;
|
2005-12-23 00:20:14 +00:00
|
|
|
|
/* for profiler */
|
|
|
|
|
save_pc();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
CACHE_A1();
|
|
|
|
|
JMPNext();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
BOp(spy_pred, e);
|
|
|
|
|
dospy:
|
|
|
|
|
{
|
|
|
|
|
PredEntry *pe = PredFromDefCode(PREG);
|
|
|
|
|
BEGD(d0);
|
2010-07-25 11:22:16 +01:00
|
|
|
|
PELOCK(14,pe);
|
2006-11-21 16:21:33 +00:00
|
|
|
|
if (!(pe->PredFlags & IndexedPredFlag) &&
|
|
|
|
|
pe->cs.p_code.NOfClauses > 1) {
|
|
|
|
|
/* update ASP before calling IPred */
|
2011-02-14 11:29:20 -08:00
|
|
|
|
SET_ASP(YREG, E_CB*sizeof(CELL));
|
2006-11-21 16:21:33 +00:00
|
|
|
|
saveregs();
|
2010-01-29 15:21:00 +00:00
|
|
|
|
Yap_IPred(pe, 0, CP);
|
2006-11-21 16:21:33 +00:00
|
|
|
|
/* IPred can generate errors, it thus must get rid of the lock itself */
|
|
|
|
|
setregs();
|
|
|
|
|
}
|
2009-06-22 11:12:56 -05:00
|
|
|
|
/* first check if we need to increase the counter */
|
|
|
|
|
if ((pe->PredFlags & CountPredFlag)) {
|
|
|
|
|
LOCK(pe->StatisticsForPred.lock);
|
|
|
|
|
pe->StatisticsForPred.NOfEntries++;
|
|
|
|
|
UNLOCK(pe->StatisticsForPred.lock);
|
2011-05-04 10:11:41 +01:00
|
|
|
|
LOCAL_ReductionsCounter--;
|
|
|
|
|
if (LOCAL_ReductionsCounter == 0 && LOCAL_ReductionsCounterOn) {
|
2010-07-28 11:26:20 +01:00
|
|
|
|
UNLOCKPE(20,pe);
|
2009-06-22 11:12:56 -05:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(CALL_COUNTER_UNDERFLOW,"");
|
2009-06-22 11:12:56 -05:00
|
|
|
|
setregs();
|
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
2011-05-04 10:11:41 +01:00
|
|
|
|
LOCAL_PredEntriesCounter--;
|
|
|
|
|
if (LOCAL_PredEntriesCounter == 0 && LOCAL_PredEntriesCounterOn) {
|
2010-07-28 11:26:20 +01:00
|
|
|
|
UNLOCKPE(21,pe);
|
2009-06-22 11:12:56 -05:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW,"");
|
2009-06-22 11:12:56 -05:00
|
|
|
|
setregs();
|
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
|
|
|
|
if ((pe->PredFlags & (CountPredFlag|ProfiledPredFlag|SpiedPredFlag)) ==
|
|
|
|
|
CountPredFlag) {
|
2009-06-23 06:50:53 -05:00
|
|
|
|
PREG = pe->cs.p_code.TrueCodeOfPred;
|
2010-07-28 11:26:20 +01:00
|
|
|
|
UNLOCKPE(22,pe);
|
2009-06-22 11:12:56 -05:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
/* standard profiler */
|
|
|
|
|
if ((pe->PredFlags & ProfiledPredFlag)) {
|
|
|
|
|
LOCK(pe->StatisticsForPred.lock);
|
|
|
|
|
pe->StatisticsForPred.NOfEntries++;
|
|
|
|
|
UNLOCK(pe->StatisticsForPred.lock);
|
|
|
|
|
if (!(pe->PredFlags & SpiedPredFlag)) {
|
|
|
|
|
PREG = pe->cs.p_code.TrueCodeOfPred;
|
2010-07-28 11:26:20 +01:00
|
|
|
|
UNLOCKPE(23,pe);
|
2009-06-22 12:40:55 -05:00
|
|
|
|
JMPNext();
|
2009-06-22 11:12:56 -05:00
|
|
|
|
}
|
|
|
|
|
}
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (!LOCAL_DebugOn) {
|
2008-09-02 03:48:02 +01:00
|
|
|
|
PREG = pe->cs.p_code.TrueCodeOfPred;
|
2010-07-28 11:26:20 +01:00
|
|
|
|
UNLOCKPE(24,pe);
|
2008-09-02 03:48:02 +01:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
2010-07-28 11:26:20 +01:00
|
|
|
|
UNLOCKPE(25,pe);
|
2008-09-02 03:48:02 +01:00
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d0 = pe->ArityOfPE;
|
2006-11-21 16:21:33 +00:00
|
|
|
|
/* save S for ModuleName */
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (d0 == 0) {
|
2001-10-30 16:42:05 +00:00
|
|
|
|
H[1] = MkAtomTerm((Atom)(pe->FunctorOfPred));
|
2001-04-09 19:54:03 +00:00
|
|
|
|
} else {
|
|
|
|
|
*H = (CELL) pe->FunctorOfPred;
|
|
|
|
|
H[d0 + 2] = AbsAppl(H);
|
|
|
|
|
H++;
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
pt1 = XREGS + 1;
|
|
|
|
|
for (; d0 > 0; --d0) {
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = pt1++;
|
|
|
|
|
d1 = *pt0;
|
|
|
|
|
deref_head(d1, dospy_unk);
|
|
|
|
|
dospy_nonvar:
|
|
|
|
|
/* just copy it to the heap */
|
|
|
|
|
*H++ = d1;
|
|
|
|
|
continue;
|
|
|
|
|
|
|
|
|
|
derefa_body(d1, pt0, dospy_unk, dospy_nonvar);
|
|
|
|
|
if (pt0 <= H) {
|
|
|
|
|
/* variable is safe */
|
|
|
|
|
*H++ = (CELL)pt0;
|
|
|
|
|
} else {
|
|
|
|
|
/* bind it, in case it is a local variable */
|
|
|
|
|
d1 = Unsigned(H);
|
|
|
|
|
RESET_VARIABLE(H);
|
|
|
|
|
H += 1;
|
|
|
|
|
Bind_Local(pt0, d1);
|
|
|
|
|
}
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
}
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
}
|
|
|
|
|
ENDD(d0);
|
2004-02-12 12:37:12 +00:00
|
|
|
|
H[0] = Yap_Module_Name(pe);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
ARG1 = (Term) AbsPair(H);
|
|
|
|
|
H += 2;
|
2001-10-30 16:42:05 +00:00
|
|
|
|
{
|
|
|
|
|
PredEntry *pt0;
|
2008-04-04 16:11:40 +00:00
|
|
|
|
#ifdef THREADS
|
2011-05-10 10:06:51 +01:00
|
|
|
|
LOCK(GLOBAL_ThreadHandlesLock);
|
2008-04-04 16:11:40 +00:00
|
|
|
|
#endif
|
2001-10-30 16:42:05 +00:00
|
|
|
|
pt0 = SpyCode;
|
|
|
|
|
P_before_spy = PREG;
|
2002-12-27 16:53:09 +00:00
|
|
|
|
PREG = pt0->CodeOfPred;
|
2005-12-23 00:20:14 +00:00
|
|
|
|
/* for profiler */
|
2008-04-03 13:26:38 +00:00
|
|
|
|
#ifdef THREADS
|
2011-05-10 10:06:51 +01:00
|
|
|
|
UNLOCK(GLOBAL_ThreadHandlesLock);
|
2008-04-04 16:11:40 +00:00
|
|
|
|
#endif
|
2005-12-23 00:20:14 +00:00
|
|
|
|
save_pc();
|
2001-10-30 16:42:05 +00:00
|
|
|
|
CACHE_A1();
|
2001-07-04 16:48:54 +00:00
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
2002-11-18 18:18:05 +00:00
|
|
|
|
if (Yap_do_low_level_trace)
|
2001-10-30 16:42:05 +00:00
|
|
|
|
low_level_trace(enter_pred,pt0,XREGS+1);
|
2001-07-04 16:48:54 +00:00
|
|
|
|
#endif /* LOW_LEVEL_TRACE */
|
2001-10-30 16:42:05 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
2006-01-17 14:10:42 +00:00
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
/************************************************************************\
|
|
|
|
|
* Try / Retry / Trust for main indexing blocks *
|
|
|
|
|
\************************************************************************/
|
|
|
|
|
|
2008-09-05 05:22:19 +01:00
|
|
|
|
BOp(try_clause, Otapl);
|
2003-08-23 19:26:08 +00:00
|
|
|
|
check_trail(TR);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
CACHE_Y(YREG);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* Point AP to the code that follows this instruction */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
store_at_least_one_arg(PREG->u.Otapl.s);
|
|
|
|
|
store_yaam_regs(NEXTOP(PREG, Otapl), 0);
|
|
|
|
|
PREG = PREG->u.Otapl.d;
|
2002-11-11 17:38:10 +00:00
|
|
|
|
set_cut(S_YREG, B);
|
|
|
|
|
B = B_YREG;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifdef YAPOR
|
2002-11-11 17:38:10 +00:00
|
|
|
|
SCH_set_load(B_YREG);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif /* YAPOR */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
SET_BB(B_YREG);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDCACHE_Y();
|
|
|
|
|
JMPNext();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2004-09-27 20:45:04 +00:00
|
|
|
|
BOp(try_clause2, l);
|
|
|
|
|
check_trail(TR);
|
|
|
|
|
CACHE_Y(YREG);
|
|
|
|
|
/* Point AP to the code that follows this instruction */
|
|
|
|
|
{
|
|
|
|
|
register CELL x2 = ARG2;
|
2004-10-14 22:14:53 +00:00
|
|
|
|
register CELL x1 = ARG1;
|
2004-09-27 20:45:04 +00:00
|
|
|
|
|
|
|
|
|
store_yaam_regs(NEXTOP(PREG, l), 2);
|
|
|
|
|
B_YREG->cp_a1 = x1;
|
|
|
|
|
B_YREG->cp_a2 = x2;
|
|
|
|
|
}
|
|
|
|
|
PREG = PREG->u.l.l;
|
|
|
|
|
set_cut(S_YREG, B);
|
|
|
|
|
B = B_YREG;
|
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
SCH_set_load(B_YREG);
|
|
|
|
|
#endif /* YAPOR */
|
|
|
|
|
SET_BB(B_YREG);
|
|
|
|
|
ENDCACHE_Y();
|
|
|
|
|
JMPNext();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
BOp(try_clause3, l);
|
|
|
|
|
check_trail(TR);
|
|
|
|
|
CACHE_Y(YREG);
|
|
|
|
|
/* Point AP to the code that follows this instruction */
|
|
|
|
|
{
|
|
|
|
|
store_yaam_regs(NEXTOP(PREG, l), 3);
|
2004-10-14 22:14:53 +00:00
|
|
|
|
B_YREG->cp_a1 = ARG1;
|
2004-09-27 20:45:04 +00:00
|
|
|
|
B_YREG->cp_a2 = ARG2;
|
|
|
|
|
B_YREG->cp_a3 = ARG3;
|
|
|
|
|
}
|
|
|
|
|
PREG = PREG->u.l.l;
|
|
|
|
|
set_cut(S_YREG, B);
|
|
|
|
|
B = B_YREG;
|
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
SCH_set_load(B_YREG);
|
|
|
|
|
#endif /* YAPOR */
|
|
|
|
|
SET_BB(B_YREG);
|
|
|
|
|
ENDCACHE_Y();
|
|
|
|
|
JMPNext();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
BOp(try_clause4, l);
|
|
|
|
|
check_trail(TR);
|
|
|
|
|
CACHE_Y(YREG);
|
|
|
|
|
/* Point AP to the code that follows this instruction */
|
|
|
|
|
{
|
|
|
|
|
store_yaam_regs(NEXTOP(PREG, l), 4);
|
2004-10-14 22:14:53 +00:00
|
|
|
|
B_YREG->cp_a1 = ARG1;
|
2004-09-27 20:45:04 +00:00
|
|
|
|
B_YREG->cp_a2 = ARG2;
|
|
|
|
|
B_YREG->cp_a3 = ARG3;
|
|
|
|
|
B_YREG->cp_a4 = ARG4;
|
|
|
|
|
}
|
|
|
|
|
PREG = PREG->u.l.l;
|
|
|
|
|
set_cut(S_YREG, B);
|
|
|
|
|
B = B_YREG;
|
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
SCH_set_load(B_YREG);
|
|
|
|
|
#endif /* YAPOR */
|
|
|
|
|
SET_BB(B_YREG);
|
|
|
|
|
ENDCACHE_Y();
|
|
|
|
|
JMPNext();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2008-09-05 05:22:19 +01:00
|
|
|
|
BOp(retry, Otapl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
CACHE_Y(B);
|
2008-09-05 05:22:19 +01:00
|
|
|
|
restore_yaam_regs(NEXTOP(PREG, Otapl));
|
|
|
|
|
restore_at_least_one_arg(PREG->u.Otapl.s);
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
2005-03-04 20:30:14 +00:00
|
|
|
|
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
set_cut(S_YREG, B->cp_b);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#else
|
2002-11-11 17:38:10 +00:00
|
|
|
|
set_cut(S_YREG, B_YREG->cp_b);
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#endif /* FROZEN_STACKS */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
SET_BB(B_YREG);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDCACHE_Y();
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = PREG->u.Otapl.d;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2004-09-27 20:45:04 +00:00
|
|
|
|
BOp(retry2, l);
|
|
|
|
|
CACHE_Y(B);
|
|
|
|
|
restore_yaam_regs(NEXTOP(PREG, l));
|
|
|
|
|
PREG = PREG->u.l.l;
|
|
|
|
|
ARG1 = B_YREG->cp_a1;
|
|
|
|
|
ARG2 = B_YREG->cp_a2;
|
|
|
|
|
#ifdef FROZEN_STACKS
|
2005-03-04 20:30:14 +00:00
|
|
|
|
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
2004-09-27 20:45:04 +00:00
|
|
|
|
set_cut(S_YREG, B->cp_b);
|
|
|
|
|
#else
|
|
|
|
|
set_cut(S_YREG, B_YREG->cp_b);
|
|
|
|
|
#endif /* FROZEN_STACKS */
|
|
|
|
|
SET_BB(B_YREG);
|
|
|
|
|
ENDCACHE_Y();
|
|
|
|
|
JMPNext();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
BOp(retry3, l);
|
|
|
|
|
CACHE_Y(B);
|
|
|
|
|
restore_yaam_regs(NEXTOP(PREG, l));
|
|
|
|
|
PREG = PREG->u.l.l;
|
|
|
|
|
ARG1 = B_YREG->cp_a1;
|
|
|
|
|
ARG2 = B_YREG->cp_a2;
|
|
|
|
|
ARG3 = B_YREG->cp_a3;
|
|
|
|
|
#ifdef FROZEN_STACKS
|
2005-03-04 20:30:14 +00:00
|
|
|
|
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
2004-09-27 20:45:04 +00:00
|
|
|
|
set_cut(S_YREG, B->cp_b);
|
|
|
|
|
#else
|
|
|
|
|
set_cut(S_YREG, B_YREG->cp_b);
|
|
|
|
|
#endif /* FROZEN_STACKS */
|
|
|
|
|
SET_BB(B_YREG);
|
|
|
|
|
ENDCACHE_Y();
|
|
|
|
|
JMPNext();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
BOp(retry4, l);
|
|
|
|
|
CACHE_Y(B);
|
|
|
|
|
restore_yaam_regs(NEXTOP(PREG, l));
|
|
|
|
|
PREG = PREG->u.l.l;
|
|
|
|
|
ARG1 = B_YREG->cp_a1;
|
|
|
|
|
ARG2 = B_YREG->cp_a2;
|
|
|
|
|
ARG3 = B_YREG->cp_a3;
|
|
|
|
|
ARG4 = B_YREG->cp_a4;
|
|
|
|
|
#ifdef FROZEN_STACKS
|
2005-03-04 20:30:14 +00:00
|
|
|
|
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
2004-09-27 20:45:04 +00:00
|
|
|
|
set_cut(S_YREG, B->cp_b);
|
|
|
|
|
#else
|
|
|
|
|
set_cut(S_YREG, B_YREG->cp_b);
|
|
|
|
|
#endif /* FROZEN_STACKS */
|
|
|
|
|
SET_BB(B_YREG);
|
|
|
|
|
ENDCACHE_Y();
|
|
|
|
|
JMPNext();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2008-09-05 05:22:19 +01:00
|
|
|
|
BOp(trust, Otapl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
CACHE_Y(B);
|
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
if (SCH_top_shared_cp(B)) {
|
2002-11-11 17:38:10 +00:00
|
|
|
|
SCH_last_alternative(PREG, B_YREG);
|
2008-09-05 05:22:19 +01:00
|
|
|
|
restore_at_least_one_arg(PREG->u.Otapl.s);
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
2005-03-04 20:30:14 +00:00
|
|
|
|
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#endif /* FROZEN_STACKS */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
set_cut(S_YREG, B->cp_b);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
else
|
|
|
|
|
#endif /* YAPOR */
|
|
|
|
|
{
|
|
|
|
|
pop_yaam_regs();
|
2008-09-05 05:22:19 +01:00
|
|
|
|
pop_at_least_one_arg(PREG->u.Otapl.s);
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
2005-03-04 20:30:14 +00:00
|
|
|
|
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
2002-05-03 15:30:36 +00:00
|
|
|
|
#endif /* FROZEN_STACKS */
|
2002-11-11 17:38:10 +00:00
|
|
|
|
set_cut(S_YREG, B);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
2002-11-11 17:38:10 +00:00
|
|
|
|
SET_BB(B_YREG);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDCACHE_Y();
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = PREG->u.Otapl.d;
|
2003-04-30 17:46:05 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
BOp(try_in, l);
|
|
|
|
|
B->cp_ap = NEXTOP(PREG, l);
|
|
|
|
|
PREG = PREG->u.l.l;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
ENDBOp();
|
2003-04-30 17:46:05 +00:00
|
|
|
|
|
|
|
|
|
|
2006-10-10 14:08:17 +00:00
|
|
|
|
|
|
|
|
|
/************************************************************************\
|
|
|
|
|
* Logical Updates *
|
|
|
|
|
\************************************************************************/
|
|
|
|
|
|
|
|
|
|
/* enter logical pred */
|
2011-06-24 21:08:22 +01:00
|
|
|
|
BOp(enter_lu_pred, Illss);
|
2007-09-24 09:02:33 +00:00
|
|
|
|
check_trail(TR);
|
2006-10-10 14:08:17 +00:00
|
|
|
|
/* mark the indexing code */
|
|
|
|
|
{
|
2011-06-24 21:08:22 +01:00
|
|
|
|
LogUpdIndex *cl = PREG->u.Illss.I;
|
2006-10-10 14:08:17 +00:00
|
|
|
|
PredEntry *ap = cl->ClPred;
|
|
|
|
|
|
|
|
|
|
if (ap->LastCallOfPred != LUCALL_EXEC) {
|
|
|
|
|
/*
|
|
|
|
|
only increment time stamp if we are working on current time
|
|
|
|
|
stamp
|
|
|
|
|
*/
|
2006-11-15 00:13:37 +00:00
|
|
|
|
if (ap->TimeStampOfPred >= TIMESTAMP_RESET)
|
|
|
|
|
Yap_UpdateTimestamps(ap);
|
2006-10-10 14:08:17 +00:00
|
|
|
|
ap->TimeStampOfPred++;
|
|
|
|
|
ap->LastCallOfPred = LUCALL_EXEC;
|
|
|
|
|
/* fprintf(stderr,"R %x--%d--%ul\n",ap,ap->TimeStampOfPred,ap->ArityOfPE);*/
|
|
|
|
|
}
|
2009-06-16 21:20:35 -05:00
|
|
|
|
*--YREG = MkIntegerTerm(ap->TimeStampOfPred);
|
2011-06-24 21:08:22 +01:00
|
|
|
|
/* fprintf(stderr,"> %p/%p %d %d\n",cl,ap,ap->TimeStampOfPred,PREG->u.Illss.s);*/
|
|
|
|
|
PREG = PREG->u.Illss.l1;
|
2006-10-10 14:08:17 +00:00
|
|
|
|
/* indicate the indexing code is being used */
|
2011-04-14 18:51:11 +01:00
|
|
|
|
#if MULTIPLE_STACKS
|
2006-10-10 14:08:17 +00:00
|
|
|
|
/* just store a reference */
|
|
|
|
|
INC_CLREF_COUNT(cl);
|
|
|
|
|
TRAIL_CLREF(cl);
|
|
|
|
|
#else
|
|
|
|
|
if (!(cl->ClFlags & InUseMask)) {
|
|
|
|
|
cl->ClFlags |= InUseMask;
|
|
|
|
|
TRAIL_CLREF(cl);
|
|
|
|
|
}
|
|
|
|
|
#endif
|
|
|
|
|
}
|
2011-10-02 19:55:22 -03:00
|
|
|
|
JMPNext();
|
2006-10-10 14:08:17 +00:00
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2008-09-05 05:22:19 +01:00
|
|
|
|
BOp(try_logical, OtaLl);
|
2006-10-10 14:08:17 +00:00
|
|
|
|
check_trail(TR);
|
|
|
|
|
{
|
|
|
|
|
UInt timestamp;
|
|
|
|
|
|
|
|
|
|
CACHE_Y(YREG);
|
|
|
|
|
timestamp = IntegerOfTerm(S_YREG[0]);
|
2008-09-05 05:22:19 +01:00
|
|
|
|
/* fprintf(stderr,"+ %p/%p %d %d %d--%u\n",PREG,PREG->u.OtaLl.d->ClPred,timestamp,PREG->u.OtaLl.d->ClPred->TimeStampOfPred,PREG->u.OtaLl.d->ClTimeStart,PREG->u.OtaLl.d->ClTimeEnd);*/
|
2006-10-10 14:08:17 +00:00
|
|
|
|
/* Point AP to the code that follows this instruction */
|
|
|
|
|
/* always do this, even if we are not going to use it */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
store_args(PREG->u.OtaLl.s);
|
|
|
|
|
store_yaam_regs(PREG->u.OtaLl.n, 0);
|
2006-10-10 14:08:17 +00:00
|
|
|
|
set_cut(S_YREG, B);
|
|
|
|
|
B = B_YREG;
|
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
SCH_set_load(B_YREG);
|
2010-01-26 11:40:32 +00:00
|
|
|
|
#endif /* YAPOR */
|
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
PP = PREG->u.OtaLl.d->ClPred;
|
2006-10-10 14:08:17 +00:00
|
|
|
|
#endif /* YAPOR */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
if (!VALID_TIMESTAMP(timestamp, PREG->u.OtaLl.d)) {
|
2006-10-10 14:08:17 +00:00
|
|
|
|
/* jump to next alternative */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG=PREG->u.OtaLl.n;
|
2006-10-10 14:08:17 +00:00
|
|
|
|
} else {
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = PREG->u.OtaLl.d->ClCode;
|
2006-10-10 14:08:17 +00:00
|
|
|
|
}
|
|
|
|
|
SET_BB(B_YREG);
|
|
|
|
|
ENDCACHE_Y();
|
|
|
|
|
}
|
|
|
|
|
JMPNext();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2008-09-05 05:22:19 +01:00
|
|
|
|
BOp(retry_logical, OtaLl);
|
2006-10-10 14:08:17 +00:00
|
|
|
|
check_trail(TR);
|
|
|
|
|
{
|
|
|
|
|
UInt timestamp;
|
|
|
|
|
CACHE_Y(B);
|
|
|
|
|
|
2007-11-26 23:43:10 +00:00
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
2008-08-06 17:32:22 +00:00
|
|
|
|
if (!PP) {
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PP = PREG->u.OtaLl.d->ClPred;
|
2010-07-25 11:22:16 +01:00
|
|
|
|
PELOCK(15,PP);
|
2008-08-06 17:32:22 +00:00
|
|
|
|
}
|
2007-11-26 23:43:10 +00:00
|
|
|
|
#endif
|
2008-09-05 05:22:19 +01:00
|
|
|
|
timestamp = IntegerOfTerm(((CELL *)(B_YREG+1))[PREG->u.OtaLl.s]);
|
|
|
|
|
/* fprintf(stderr,"^ %p/%p %d %d %d--%u\n",PREG,PREG->u.OtaLl.d->ClPred,timestamp,PREG->u.OtaLl.d->ClPred->TimeStampOfPred,PREG->u.OtaLl.d->ClTimeStart,PREG->u.OtaLl.d->ClTimeEnd);*/
|
|
|
|
|
if (!VALID_TIMESTAMP(timestamp, PREG->u.OtaLl.d)) {
|
2006-10-10 14:08:17 +00:00
|
|
|
|
/* jump to next instruction */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG=PREG->u.OtaLl.n;
|
2006-10-10 14:08:17 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
2008-09-05 05:22:19 +01:00
|
|
|
|
restore_yaam_regs(PREG->u.OtaLl.n);
|
|
|
|
|
restore_at_least_one_arg(PREG->u.OtaLl.s);
|
2010-01-26 11:40:32 +00:00
|
|
|
|
#ifdef THREADS
|
|
|
|
|
PP = PREG->u.OtaLl.d->ClPred;
|
|
|
|
|
#endif
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = PREG->u.OtaLl.d->ClCode;
|
2006-10-10 14:08:17 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
|
|
|
|
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
|
|
|
|
set_cut(S_YREG, B->cp_b);
|
|
|
|
|
#else
|
|
|
|
|
set_cut(S_YREG, B_YREG->cp_b);
|
|
|
|
|
#endif /* FROZEN_STACKS */
|
|
|
|
|
SET_BB(B_YREG);
|
|
|
|
|
ENDCACHE_Y();
|
|
|
|
|
}
|
|
|
|
|
JMPNext();
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2008-09-05 05:22:19 +01:00
|
|
|
|
BOp(trust_logical, OtILl);
|
2006-10-10 14:08:17 +00:00
|
|
|
|
CACHE_Y(B);
|
|
|
|
|
{
|
2008-09-05 05:22:19 +01:00
|
|
|
|
LogUpdIndex *cl = PREG->u.OtILl.block;
|
2006-10-10 14:08:17 +00:00
|
|
|
|
PredEntry *ap = cl->ClPred;
|
2008-09-05 05:22:19 +01:00
|
|
|
|
LogUpdClause *lcl = PREG->u.OtILl.d;
|
2006-10-10 14:08:17 +00:00
|
|
|
|
UInt timestamp = IntegerOfTerm(((CELL *)(B_YREG+1))[ap->ArityOfPE]);
|
|
|
|
|
|
2008-09-05 05:22:19 +01:00
|
|
|
|
/* fprintf(stderr,"- %p/%p %d %d %p\n",PREG,ap,timestamp,ap->TimeStampOfPred,PREG->u.OtILl.d->ClCode);*/
|
2008-08-06 17:32:22 +00:00
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
|
|
|
|
if (!PP) {
|
2010-07-25 11:22:16 +01:00
|
|
|
|
PELOCK(16,ap);
|
2008-08-06 17:32:22 +00:00
|
|
|
|
PP = ap;
|
|
|
|
|
}
|
|
|
|
|
#endif
|
2006-11-27 17:42:03 +00:00
|
|
|
|
if (!VALID_TIMESTAMP(timestamp, lcl)) {
|
2006-10-10 14:08:17 +00:00
|
|
|
|
/* jump to next alternative */
|
|
|
|
|
PREG = FAILCODE;
|
|
|
|
|
} else {
|
2006-11-27 17:42:03 +00:00
|
|
|
|
PREG = lcl->ClCode;
|
2006-10-10 14:08:17 +00:00
|
|
|
|
}
|
|
|
|
|
/* HEY, leave indexing block alone!! */
|
|
|
|
|
/* check if we are the ones using this code */
|
2011-04-14 18:51:11 +01:00
|
|
|
|
#if MULTIPLE_STACKS
|
2006-10-10 14:08:17 +00:00
|
|
|
|
DEC_CLREF_COUNT(cl);
|
|
|
|
|
/* clear the entry from the trail */
|
2006-11-27 17:42:03 +00:00
|
|
|
|
B->cp_tr--;
|
|
|
|
|
TR = B->cp_tr;
|
2006-10-10 14:08:17 +00:00
|
|
|
|
/* actually get rid of the code */
|
|
|
|
|
if (cl->ClRefCount == 0 && (cl->ClFlags & (ErasedMask|DirtyMask))) {
|
|
|
|
|
if (PREG != FAILCODE) {
|
|
|
|
|
if (lcl->ClRefCount == 1) {
|
|
|
|
|
/* make sure the clause isn't destroyed */
|
|
|
|
|
/* always add an extra reference */
|
|
|
|
|
INC_CLREF_COUNT(lcl);
|
|
|
|
|
TRAIL_CLREF(lcl);
|
2006-11-27 17:42:03 +00:00
|
|
|
|
B->cp_tr = TR;
|
2006-10-10 14:08:17 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
2006-11-27 17:42:03 +00:00
|
|
|
|
if (cl->ClFlags & ErasedMask) {
|
|
|
|
|
saveregs();
|
2006-10-10 14:08:17 +00:00
|
|
|
|
Yap_ErLogUpdIndex(cl);
|
2006-11-27 17:42:03 +00:00
|
|
|
|
setregs();
|
|
|
|
|
} else {
|
|
|
|
|
saveregs();
|
2006-10-10 14:08:17 +00:00
|
|
|
|
Yap_CleanUpIndex(cl);
|
2006-11-27 17:42:03 +00:00
|
|
|
|
setregs();
|
|
|
|
|
}
|
2006-10-10 14:08:17 +00:00
|
|
|
|
save_pc();
|
|
|
|
|
}
|
|
|
|
|
#else
|
|
|
|
|
if (TrailTerm(B->cp_tr-1) == CLREF_TO_TRENTRY(cl) &&
|
|
|
|
|
B->cp_tr != B->cp_b->cp_tr) {
|
|
|
|
|
cl->ClFlags &= ~InUseMask;
|
2006-11-27 17:42:03 +00:00
|
|
|
|
B->cp_tr--;
|
2011-04-22 12:20:52 +01:00
|
|
|
|
#if FROZEN_STACKS
|
|
|
|
|
if (B->cp_tr > TR_FZ)
|
|
|
|
|
#endif
|
|
|
|
|
{
|
|
|
|
|
TR = B->cp_tr;
|
|
|
|
|
}
|
2006-10-10 14:08:17 +00:00
|
|
|
|
/* next, recover space for the indexing code if it was erased */
|
|
|
|
|
if (cl->ClFlags & (ErasedMask|DirtyMask)) {
|
|
|
|
|
if (PREG != FAILCODE) {
|
|
|
|
|
/* make sure we don't erase the clause we are jumping too */
|
2012-07-18 14:32:53 -05:00
|
|
|
|
if (!(lcl->ClFlags & InUseMask)) {
|
2006-10-10 14:08:17 +00:00
|
|
|
|
lcl->ClFlags |= InUseMask;
|
|
|
|
|
TRAIL_CLREF(lcl);
|
2006-11-27 17:42:03 +00:00
|
|
|
|
B->cp_tr = TR;
|
2006-10-10 14:08:17 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
2006-11-27 17:42:03 +00:00
|
|
|
|
if (cl->ClFlags & ErasedMask) {
|
|
|
|
|
saveregs();
|
2006-10-10 14:08:17 +00:00
|
|
|
|
Yap_ErLogUpdIndex(cl);
|
2006-11-27 17:42:03 +00:00
|
|
|
|
setregs();
|
|
|
|
|
} else {
|
|
|
|
|
saveregs();
|
2006-10-10 14:08:17 +00:00
|
|
|
|
Yap_CleanUpIndex(cl);
|
2006-11-27 17:42:03 +00:00
|
|
|
|
setregs();
|
|
|
|
|
}
|
2006-10-10 14:08:17 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
#endif
|
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
if (SCH_top_shared_cp(B)) {
|
|
|
|
|
SCH_last_alternative(PREG, B_YREG);
|
2008-06-17 13:37:51 +00:00
|
|
|
|
restore_args(ap->ArityOfPE);
|
2006-10-10 14:08:17 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
|
|
|
|
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
|
|
|
|
|
#else
|
|
|
|
|
S_YREG++;
|
|
|
|
|
#endif /* FROZEN_STACKS */
|
|
|
|
|
set_cut(S_YREG, B->cp_b);
|
|
|
|
|
} else
|
|
|
|
|
#endif /* YAPOR */
|
|
|
|
|
{
|
|
|
|
|
pop_yaam_regs();
|
2008-06-17 13:37:51 +00:00
|
|
|
|
pop_args(ap->ArityOfPE);
|
2006-10-10 14:08:17 +00:00
|
|
|
|
S_YREG--;
|
|
|
|
|
#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();
|
2008-08-06 17:32:22 +00:00
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
|
|
|
|
if (PREG == FAILCODE) {
|
2010-07-28 11:26:20 +01:00
|
|
|
|
UNLOCKPE(26,PP);
|
2008-08-06 17:32:22 +00:00
|
|
|
|
PP = NULL;
|
|
|
|
|
}
|
|
|
|
|
#endif
|
2006-10-10 14:08:17 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
/************************************************************************\
|
2003-04-30 17:46:05 +00:00
|
|
|
|
* Indexing in ARG1 *
|
2001-04-09 19:54:03 +00:00
|
|
|
|
\************************************************************************/
|
|
|
|
|
|
2009-02-12 21:35:31 +00:00
|
|
|
|
BOp(user_switch, lp);
|
|
|
|
|
{
|
|
|
|
|
yamop *new = Yap_udi_search(PREG->u.lp.p);
|
|
|
|
|
if (!new) {
|
|
|
|
|
PREG = PREG->u.lp.l;
|
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
|
|
|
|
PREG = new;
|
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2003-04-30 17:46:05 +00:00
|
|
|
|
BOp(switch_on_type, llll);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2003-04-30 17:46:05 +00:00
|
|
|
|
d0 = CACHED_A1();
|
|
|
|
|
deref_head(d0, swt_unk);
|
|
|
|
|
/* nonvar */
|
|
|
|
|
swt_nvar:
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (IsPairTerm(d0)) {
|
|
|
|
|
/* pair */
|
|
|
|
|
SREG = RepPair(d0);
|
2004-02-05 16:57:02 +00:00
|
|
|
|
copy_jmp_address(PREG->u.llll.l1);
|
2003-04-30 17:46:05 +00:00
|
|
|
|
PREG = PREG->u.llll.l1;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
2003-04-30 17:46:05 +00:00
|
|
|
|
}
|
|
|
|
|
else if (!IsApplTerm(d0)) {
|
|
|
|
|
/* constant */
|
2004-02-05 16:57:02 +00:00
|
|
|
|
copy_jmp_address(PREG->u.llll.l2);
|
2003-04-30 17:46:05 +00:00
|
|
|
|
PREG = PREG->u.llll.l2;
|
|
|
|
|
I_R = d0;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
2003-04-30 17:46:05 +00:00
|
|
|
|
}
|
|
|
|
|
else {
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* appl */
|
2004-02-05 16:57:02 +00:00
|
|
|
|
copy_jmp_address(PREG->u.llll.l3);
|
2003-04-30 17:46:05 +00:00
|
|
|
|
PREG = PREG->u.llll.l3;
|
|
|
|
|
SREG = RepAppl(d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
2003-04-30 17:46:05 +00:00
|
|
|
|
deref_body(d0, pt0, swt_unk, swt_nvar);
|
|
|
|
|
/* variable */
|
2004-02-05 16:57:02 +00:00
|
|
|
|
copy_jmp_address(PREG->u.llll.l4);
|
2003-04-30 17:46:05 +00:00
|
|
|
|
PREG = PREG->u.llll.l4;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2003-04-30 17:46:05 +00:00
|
|
|
|
/* specialised case where the arguments may be:
|
|
|
|
|
* a list;
|
|
|
|
|
* the empty list;
|
|
|
|
|
* some other atom;
|
|
|
|
|
* a variable;
|
|
|
|
|
*
|
|
|
|
|
*/
|
|
|
|
|
BOp(switch_list_nl, ollll);
|
|
|
|
|
ALWAYS_LOOKAHEAD(PREG->u.ollll.pop);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = CACHED_A1();
|
|
|
|
|
#if UNIQUE_TAG_FOR_PAIRS
|
|
|
|
|
deref_list_head(d0, swlnl_unk_p);
|
|
|
|
|
swlnl_list_p:
|
|
|
|
|
{
|
|
|
|
|
#else
|
|
|
|
|
deref_head(d0, swlnl_unk_p);
|
|
|
|
|
/* non variable */
|
|
|
|
|
swlnl_nvar_p:
|
2011-10-04 06:42:01 -03:00
|
|
|
|
if (__builtin_expect(IsPairTerm(d0),1)) {
|
2003-04-30 17:46:05 +00:00
|
|
|
|
/* pair */
|
|
|
|
|
#endif
|
2004-02-05 16:57:02 +00:00
|
|
|
|
copy_jmp_address(PREG->u.ollll.l1);
|
2003-10-28 16:20:44 +00:00
|
|
|
|
PREG = PREG->u.ollll.l1;
|
2003-04-30 17:46:05 +00:00
|
|
|
|
SREG = RepPair(d0);
|
|
|
|
|
ALWAYS_GONext();
|
|
|
|
|
}
|
|
|
|
|
#if UNIQUE_TAG_FOR_PAIRS
|
|
|
|
|
swlnl_nlist_p:
|
|
|
|
|
#endif
|
|
|
|
|
if (d0 == TermNil) {
|
|
|
|
|
/* empty list */
|
2003-10-28 16:20:44 +00:00
|
|
|
|
PREG = PREG->u.ollll.l2;
|
2003-04-30 17:46:05 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
/* appl or constant */
|
|
|
|
|
if (IsApplTerm(d0)) {
|
2004-02-05 16:57:02 +00:00
|
|
|
|
copy_jmp_address(PREG->u.ollll.l3);
|
2003-10-28 16:20:44 +00:00
|
|
|
|
PREG = PREG->u.ollll.l3;
|
2004-02-05 16:57:02 +00:00
|
|
|
|
SREG = RepAppl(d0);
|
2003-04-30 17:46:05 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
} else {
|
2004-02-05 16:57:02 +00:00
|
|
|
|
copy_jmp_address(PREG->u.ollll.l3);
|
2003-10-28 16:20:44 +00:00
|
|
|
|
PREG = PREG->u.ollll.l3;
|
2004-02-05 16:57:02 +00:00
|
|
|
|
I_R = d0;
|
2003-04-30 17:46:05 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
2003-04-30 17:46:05 +00:00
|
|
|
|
BEGP(pt0);
|
|
|
|
|
#if UNIQUE_TAG_FOR_PAIRS
|
|
|
|
|
swlnl_unk_p:
|
|
|
|
|
deref_list_body(d0, pt0, swlnl_list_p, swlnl_nlist_p);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#else
|
2003-04-30 17:46:05 +00:00
|
|
|
|
deref_body(d0, pt0, swlnl_unk_p, swlnl_nvar_p);
|
|
|
|
|
#endif
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
/* variable */
|
2004-02-05 16:57:02 +00:00
|
|
|
|
copy_jmp_address(PREG->u.ollll.l4);
|
2003-10-28 16:20:44 +00:00
|
|
|
|
PREG = PREG->u.ollll.l4;
|
2003-04-30 17:46:05 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
}
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
BOp(switch_on_arg_type, xllll);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2003-04-30 17:46:05 +00:00
|
|
|
|
d0 = XREG(PREG->u.xllll.x);
|
|
|
|
|
deref_head(d0, arg_swt_unk);
|
|
|
|
|
/* nonvar */
|
|
|
|
|
arg_swt_nvar:
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (IsPairTerm(d0)) {
|
|
|
|
|
/* pair */
|
2004-02-05 16:57:02 +00:00
|
|
|
|
copy_jmp_address(PREG->u.xllll.l1);
|
2003-04-30 17:46:05 +00:00
|
|
|
|
PREG = PREG->u.xllll.l1;
|
2004-02-05 16:57:02 +00:00
|
|
|
|
SREG = RepPair(d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
2003-04-30 17:46:05 +00:00
|
|
|
|
}
|
|
|
|
|
else if (!IsApplTerm(d0)) {
|
|
|
|
|
/* constant */
|
2004-02-05 16:57:02 +00:00
|
|
|
|
copy_jmp_address(PREG->u.xllll.l2);
|
2003-04-30 17:46:05 +00:00
|
|
|
|
PREG = PREG->u.xllll.l2;
|
|
|
|
|
I_R = d0;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
2003-04-30 17:46:05 +00:00
|
|
|
|
}
|
|
|
|
|
else {
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* appl */
|
2004-02-05 16:57:02 +00:00
|
|
|
|
copy_jmp_address(PREG->u.xllll.l3);
|
2003-04-30 17:46:05 +00:00
|
|
|
|
PREG = PREG->u.xllll.l3;
|
|
|
|
|
SREG = RepAppl(d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
2003-04-30 17:46:05 +00:00
|
|
|
|
deref_body(d0, pt0, arg_swt_unk, arg_swt_nvar);
|
|
|
|
|
/* variable */
|
2004-02-05 16:57:02 +00:00
|
|
|
|
copy_jmp_address(PREG->u.xllll.l4);
|
2003-04-30 17:46:05 +00:00
|
|
|
|
PREG = PREG->u.xllll.l4;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2003-04-30 17:46:05 +00:00
|
|
|
|
BOp(switch_on_sub_arg_type, sllll);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2003-04-30 17:46:05 +00:00
|
|
|
|
d0 = SREG[PREG->u.sllll.s];
|
|
|
|
|
deref_head(d0, sub_arg_swt_unk);
|
|
|
|
|
/* nonvar */
|
|
|
|
|
sub_arg_swt_nvar:
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (IsPairTerm(d0)) {
|
|
|
|
|
/* pair */
|
2004-02-05 16:57:02 +00:00
|
|
|
|
copy_jmp_address(PREG->u.sllll.l1);
|
2003-04-30 17:46:05 +00:00
|
|
|
|
PREG = PREG->u.sllll.l1;
|
2004-02-05 16:57:02 +00:00
|
|
|
|
SREG = RepPair(d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
2003-04-30 17:46:05 +00:00
|
|
|
|
}
|
|
|
|
|
else if (!IsApplTerm(d0)) {
|
|
|
|
|
/* constant */
|
2004-02-05 16:57:02 +00:00
|
|
|
|
copy_jmp_address(PREG->u.sllll.l2);
|
2003-04-30 17:46:05 +00:00
|
|
|
|
PREG = PREG->u.sllll.l2;
|
|
|
|
|
I_R = d0;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
2003-04-30 17:46:05 +00:00
|
|
|
|
}
|
|
|
|
|
else {
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* appl */
|
2004-02-05 16:57:02 +00:00
|
|
|
|
copy_jmp_address(PREG->u.sllll.l3);
|
2003-04-30 17:46:05 +00:00
|
|
|
|
PREG = PREG->u.sllll.l3;
|
|
|
|
|
SREG = RepAppl(d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
2003-04-30 17:46:05 +00:00
|
|
|
|
deref_body(d0, pt0, sub_arg_swt_unk, sub_arg_swt_nvar);
|
|
|
|
|
/* variable */
|
2004-02-05 16:57:02 +00:00
|
|
|
|
copy_jmp_address(PREG->u.sllll.l4);
|
2003-04-30 17:46:05 +00:00
|
|
|
|
PREG = PREG->u.sllll.l4;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2003-04-30 17:46:05 +00:00
|
|
|
|
BOp(jump_if_var, l);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = CACHED_A1();
|
|
|
|
|
deref_head(d0, jump_if_unk);
|
|
|
|
|
/* non var */
|
2003-10-28 01:16:03 +00:00
|
|
|
|
jump0_if_nonvar:
|
2003-04-30 17:46:05 +00:00
|
|
|
|
PREG = NEXTOP(PREG, l);
|
|
|
|
|
JMPNext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
2003-04-30 17:46:05 +00:00
|
|
|
|
BEGP(pt0);
|
2003-10-28 01:16:03 +00:00
|
|
|
|
deref_body(d0, pt0, jump_if_unk, jump0_if_nonvar);
|
2003-04-30 17:46:05 +00:00
|
|
|
|
/* variable */
|
2004-02-05 16:57:02 +00:00
|
|
|
|
copy_jmp_address(PREG->u.l.l);
|
2003-04-30 17:46:05 +00:00
|
|
|
|
PREG = PREG->u.l.l;
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
JMPNext();
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2005-04-10 04:01:15 +00:00
|
|
|
|
BOp(jump_if_nonvar, xll);
|
2003-10-28 01:16:03 +00:00
|
|
|
|
BEGD(d0);
|
2005-04-10 04:01:15 +00:00
|
|
|
|
d0 = XREG(PREG->u.xll.x);
|
2003-10-28 01:16:03 +00:00
|
|
|
|
deref_head(d0, jump2_if_unk);
|
|
|
|
|
/* non var */
|
|
|
|
|
jump2_if_nonvar:
|
2005-04-10 04:01:15 +00:00
|
|
|
|
copy_jmp_address(PREG->u.xll.l1);
|
|
|
|
|
PREG = PREG->u.xll.l1;
|
2003-10-28 01:16:03 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, jump2_if_unk, jump2_if_nonvar);
|
|
|
|
|
/* variable */
|
2005-04-10 04:01:15 +00:00
|
|
|
|
PREG = NEXTOP(PREG, xll);
|
2003-10-28 01:16:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
JMPNext();
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2003-10-02 12:59:05 +00:00
|
|
|
|
BOp(if_not_then, clll);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2003-04-30 17:46:05 +00:00
|
|
|
|
d0 = CACHED_A1();
|
|
|
|
|
deref_head(d0, if_n_unk);
|
|
|
|
|
if_n_nvar:
|
|
|
|
|
/* not variable */
|
2003-10-02 12:59:05 +00:00
|
|
|
|
if (d0 == PREG->u.clll.c) {
|
2003-04-30 17:46:05 +00:00
|
|
|
|
/* equal to test value */
|
2004-02-05 16:57:02 +00:00
|
|
|
|
copy_jmp_address(PREG->u.clll.l2);
|
2003-10-02 12:59:05 +00:00
|
|
|
|
PREG = PREG->u.clll.l2;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
2003-04-30 17:46:05 +00:00
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
/* different from test value */
|
|
|
|
|
/* the case to optimise */
|
2004-02-05 16:57:02 +00:00
|
|
|
|
copy_jmp_address(PREG->u.clll.l1);
|
2003-10-02 12:59:05 +00:00
|
|
|
|
PREG = PREG->u.clll.l1;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
2003-04-30 17:46:05 +00:00
|
|
|
|
deref_body(d0, pt0, if_n_unk, if_n_nvar);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
2003-04-30 17:46:05 +00:00
|
|
|
|
/* variable */
|
2004-02-05 16:57:02 +00:00
|
|
|
|
copy_jmp_address(PREG->u.clll.l3);
|
2003-10-02 12:59:05 +00:00
|
|
|
|
PREG = PREG->u.clll.l3;
|
2003-04-30 17:46:05 +00:00
|
|
|
|
JMPNext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2003-04-30 17:46:05 +00:00
|
|
|
|
/************************************************************************\
|
|
|
|
|
* Indexing on ARG1 *
|
|
|
|
|
\************************************************************************/
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
#define HASH_SHIFT 6
|
|
|
|
|
|
2004-03-31 01:03:10 +00:00
|
|
|
|
BOp(switch_on_func, sssl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d1);
|
|
|
|
|
d1 = *SREG++;
|
|
|
|
|
/* we use a very simple hash function to find elements in a
|
|
|
|
|
* switch table */
|
|
|
|
|
{
|
2005-12-17 03:25:39 +00:00
|
|
|
|
CELL
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* first, calculate the mask */
|
2004-03-31 01:03:10 +00:00
|
|
|
|
Mask = (PREG->u.sssl.s - 1) << 1, /* next, calculate the hash function */
|
2001-04-09 19:54:03 +00:00
|
|
|
|
hash = d1 >> (HASH_SHIFT - 1) & Mask;
|
2005-12-17 03:25:39 +00:00
|
|
|
|
CELL *base;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
2005-12-17 03:25:39 +00:00
|
|
|
|
base = (CELL *)PREG->u.sssl.l;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* PREG now points at the beginning of the hash table */
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
/* pt0 will always point at the item */
|
2005-12-17 03:25:39 +00:00
|
|
|
|
pt0 = base + hash;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = pt0[0];
|
|
|
|
|
/* a match happens either if we found the value, or if we
|
|
|
|
|
* found an empty slot */
|
|
|
|
|
if (d0 == d1 || d0 == 0) {
|
2004-02-05 16:57:02 +00:00
|
|
|
|
copy_jmp_addressa(pt0+1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = (yamop *) (pt0[1]);
|
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
/* ooops, collision, look for other items */
|
|
|
|
|
register CELL d = ((d1 | 1) << 1) & Mask;
|
|
|
|
|
|
|
|
|
|
while (1) {
|
|
|
|
|
hash = (hash + d) & Mask;
|
2005-12-17 03:25:39 +00:00
|
|
|
|
pt0 = base + hash;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d0 = pt0[0];
|
|
|
|
|
if (d0 == d1 || d0 == 0) {
|
2004-02-05 16:57:02 +00:00
|
|
|
|
copy_jmp_addressa(pt0+1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = (yamop *) pt0[1];
|
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
}
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2004-06-17 22:07:23 +00:00
|
|
|
|
BOp(switch_on_cons, sssl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d1);
|
|
|
|
|
d1 = I_R;
|
|
|
|
|
/* we use a very simple hash function to find elements in a
|
|
|
|
|
* switch table */
|
|
|
|
|
{
|
2005-12-17 03:25:39 +00:00
|
|
|
|
CELL
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* first, calculate the mask */
|
2004-03-31 01:03:10 +00:00
|
|
|
|
Mask = (PREG->u.sssl.s - 1) << 1, /* next, calculate the hash function */
|
2001-04-09 19:54:03 +00:00
|
|
|
|
hash = d1 >> (HASH_SHIFT - 1) & Mask;
|
2005-12-17 03:25:39 +00:00
|
|
|
|
CELL *base;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
2005-12-17 03:25:39 +00:00
|
|
|
|
base = (CELL *)PREG->u.sssl.l;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* PREG now points at the beginning of the hash table */
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
/* pt0 will always point at the item */
|
2005-12-17 03:25:39 +00:00
|
|
|
|
pt0 = base + hash;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = pt0[0];
|
|
|
|
|
/* a match happens either if we found the value, or if we
|
|
|
|
|
* found an empty slot */
|
|
|
|
|
if (d0 == d1 || d0 == 0) {
|
2004-02-05 16:57:02 +00:00
|
|
|
|
copy_jmp_addressa(pt0+1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = (yamop *) (pt0[1]);
|
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
/* ooops, collision, look for other items */
|
|
|
|
|
register CELL d = ((d1 | 1) << 1) & Mask;
|
|
|
|
|
|
|
|
|
|
while (1) {
|
|
|
|
|
hash = (hash + d) & Mask;
|
2005-12-17 03:25:39 +00:00
|
|
|
|
pt0 = base + hash;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d0 = pt0[0];
|
|
|
|
|
if (d0 == d1 || d0 == 0) {
|
2004-02-05 16:57:02 +00:00
|
|
|
|
copy_jmp_addressa(pt0+1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = (yamop *) pt0[1];
|
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
}
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2004-03-31 01:03:10 +00:00
|
|
|
|
BOp(go_on_func, sssl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2003-08-23 19:26:08 +00:00
|
|
|
|
{
|
2004-03-31 01:03:10 +00:00
|
|
|
|
CELL *pt = (CELL *)(PREG->u.sssl.l);
|
2003-08-23 19:26:08 +00:00
|
|
|
|
|
|
|
|
|
d0 = *SREG++;
|
|
|
|
|
if (d0 == pt[0]) {
|
2004-02-05 16:57:02 +00:00
|
|
|
|
copy_jmp_addressa(pt+1);
|
2003-08-23 19:26:08 +00:00
|
|
|
|
PREG = (yamop *) pt[1];
|
|
|
|
|
JMPNext();
|
|
|
|
|
} else {
|
2004-02-05 16:57:02 +00:00
|
|
|
|
copy_jmp_addressa(pt+3);
|
2003-08-23 19:26:08 +00:00
|
|
|
|
PREG = (yamop *) pt[3];
|
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2004-03-31 01:03:10 +00:00
|
|
|
|
BOp(go_on_cons, sssl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2003-08-23 19:26:08 +00:00
|
|
|
|
{
|
2004-03-31 01:03:10 +00:00
|
|
|
|
CELL *pt = (CELL *)(PREG->u.sssl.l);
|
2003-08-23 19:26:08 +00:00
|
|
|
|
|
|
|
|
|
d0 = I_R;
|
|
|
|
|
if (d0 == pt[0]) {
|
2004-02-05 16:57:02 +00:00
|
|
|
|
copy_jmp_addressa(pt+1);
|
2003-08-23 19:26:08 +00:00
|
|
|
|
PREG = (yamop *) pt[1];
|
|
|
|
|
JMPNext();
|
|
|
|
|
} else {
|
2004-02-05 16:57:02 +00:00
|
|
|
|
copy_jmp_addressa(pt+3);
|
2003-08-23 19:26:08 +00:00
|
|
|
|
PREG = (yamop *) pt[3];
|
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2004-03-31 01:03:10 +00:00
|
|
|
|
BOp(if_func, sssl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d1);
|
|
|
|
|
BEGP(pt0);
|
2004-03-31 01:03:10 +00:00
|
|
|
|
pt0 = (CELL *) PREG->u.sssl.l;
|
2003-08-23 19:26:08 +00:00
|
|
|
|
d1 = *SREG++;
|
|
|
|
|
while (pt0[0] != d1 && pt0[0] != (CELL)NULL ) {
|
|
|
|
|
pt0 += 2;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
2004-02-05 16:57:02 +00:00
|
|
|
|
copy_jmp_addressa(pt0+1);
|
2003-08-23 19:26:08 +00:00
|
|
|
|
PREG = (yamop *) (pt0[1]);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2004-03-31 01:03:10 +00:00
|
|
|
|
BOp(if_cons, sssl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d1);
|
|
|
|
|
BEGP(pt0);
|
2004-03-31 01:03:10 +00:00
|
|
|
|
pt0 = (CELL *) PREG->u.sssl.l;
|
2003-08-23 19:26:08 +00:00
|
|
|
|
d1 = I_R;
|
|
|
|
|
while (pt0[0] != d1 && pt0[0] != 0L ) {
|
|
|
|
|
pt0 += 2;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
2004-02-05 16:57:02 +00:00
|
|
|
|
copy_jmp_addressa(pt0+1);
|
2003-08-23 19:26:08 +00:00
|
|
|
|
PREG = (yamop *) (pt0[1]);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDBOp();
|
2003-08-23 19:26:08 +00:00
|
|
|
|
|
|
|
|
|
Op(index_dbref, e);
|
|
|
|
|
PREG = NEXTOP(PREG, e);
|
|
|
|
|
I_R = AbsAppl(SREG-1);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(index_blob, e);
|
|
|
|
|
PREG = NEXTOP(PREG, e);
|
2010-05-14 12:42:30 +01:00
|
|
|
|
I_R = Yap_DoubleP_key(SREG);
|
2003-08-23 19:26:08 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2009-02-09 21:56:40 +00:00
|
|
|
|
Op(index_long, e);
|
|
|
|
|
PREG = NEXTOP(PREG, e);
|
2010-05-14 12:42:30 +01:00
|
|
|
|
I_R = Yap_IntP_key(SREG);
|
2009-02-09 21:56:40 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2003-08-23 19:26:08 +00:00
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
/************************************************************************\
|
2009-04-07 23:55:16 +01:00
|
|
|
|
* Native Code Execution *
|
|
|
|
|
\************************************************************************/
|
|
|
|
|
|
|
|
|
|
/* native_me */
|
|
|
|
|
BOp(native_me, aFlp);
|
|
|
|
|
|
|
|
|
|
if (PREG->u.aFlp.n)
|
|
|
|
|
EXEC_NATIVE(PREG->u.aFlp.n);
|
|
|
|
|
else {
|
|
|
|
|
PREG->u.aFlp.n++;
|
|
|
|
|
if (PREG->u.aFlp.n == MAX_INVOCATION)
|
|
|
|
|
PREG->u.aFlp.n = Yapc_Compile(PREG->u.aFlp.p);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
PREG = NEXTOP(PREG, aFlp);
|
2011-10-02 19:55:22 -03:00
|
|
|
|
JMPNext();
|
2009-04-07 23:55:16 +01:00
|
|
|
|
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
/************************************************************************\
|
2001-04-09 19:54:03 +00:00
|
|
|
|
* Basic Primitive Predicates *
|
|
|
|
|
\************************************************************************/
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(p_atom_x, xl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
d0 = XREG(PREG->u.xl.x);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
deref_head(d0, atom_x_unk);
|
|
|
|
|
atom_x_nvar:
|
2012-03-01 22:03:41 +00:00
|
|
|
|
if (IsAtomTerm(d0) && !IsBlob(AtomOfTerm(d0))) {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, xl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
else {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.xl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, atom_x_unk, atom_x_nvar);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.xl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(p_atom_y, yl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGP(pt0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
pt0 = YREG + PREG->u.yl.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, atom_y_unk);
|
|
|
|
|
atom_y_nvar:
|
2012-03-01 22:03:41 +00:00
|
|
|
|
if (IsAtomTerm(d0) && !IsBlob(AtomOfTerm(d0))) {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, yl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
else {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.yl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
derefa_body(d0, pt0, atom_y_unk, atom_y_nvar);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.yl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(p_atomic_x, xl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
d0 = XREG(PREG->u.xl.x);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
deref_head(d0, atomic_x_unk);
|
|
|
|
|
atomic_x_nvar:
|
|
|
|
|
/* non variable */
|
|
|
|
|
if (IsAtomicTerm(d0)) {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, xl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
else {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.xl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, atomic_x_unk, atomic_x_nvar);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.xl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(p_atomic_y, yl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGP(pt0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
pt0 = YREG + PREG->u.yl.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, atomic_y_unk);
|
|
|
|
|
atomic_y_nvar:
|
|
|
|
|
/* non variable */
|
|
|
|
|
if (IsAtomicTerm(d0)) {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, yl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
else {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.yl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
derefa_body(d0, pt0, atomic_y_unk, atomic_y_nvar);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.yl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(p_integer_x, xl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
d0 = XREG(PREG->u.xl.x);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
deref_head(d0, integer_x_unk);
|
|
|
|
|
integer_x_nvar:
|
|
|
|
|
/* non variable */
|
2002-12-27 16:53:09 +00:00
|
|
|
|
if (IsIntTerm(d0)) {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, xl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
2002-12-27 16:53:09 +00:00
|
|
|
|
if (IsApplTerm(d0)) {
|
|
|
|
|
Functor f0 = FunctorOfTerm(d0);
|
|
|
|
|
if (IsExtensionFunctor(f0)) {
|
|
|
|
|
switch ((CELL)f0) {
|
|
|
|
|
case (CELL)FunctorLongInt:
|
|
|
|
|
case (CELL)FunctorBigInt:
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, xl);
|
2002-12-27 16:53:09 +00:00
|
|
|
|
GONext();
|
|
|
|
|
default:
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.xl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2002-12-27 16:53:09 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.xl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, integer_x_unk, integer_x_nvar);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.xl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(p_integer_y, yl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGP(pt0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
pt0 = YREG + PREG->u.yl.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, integer_y_unk);
|
|
|
|
|
integer_y_nvar:
|
|
|
|
|
/* non variable */
|
2002-12-27 16:53:09 +00:00
|
|
|
|
if (IsIntTerm(d0)) {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, yl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
2002-12-27 16:53:09 +00:00
|
|
|
|
if (IsApplTerm(d0)) {
|
|
|
|
|
Functor f0 = FunctorOfTerm(d0);
|
|
|
|
|
if (IsExtensionFunctor(f0)) {
|
|
|
|
|
switch ((CELL)f0) {
|
|
|
|
|
case (CELL)FunctorLongInt:
|
|
|
|
|
#ifdef USE_GMP
|
|
|
|
|
case (CELL)FunctorBigInt:
|
|
|
|
|
#endif
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, yl);
|
2002-12-27 16:53:09 +00:00
|
|
|
|
GONext();
|
|
|
|
|
default:
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.yl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2002-12-27 16:53:09 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.yl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
derefa_body(d0, pt0, integer_y_unk, integer_y_nvar);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.yl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(p_nonvar_x, xl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
d0 = XREG(PREG->u.xl.x);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
deref_head(d0, nonvar_x_unk);
|
|
|
|
|
nonvar_x_nvar:
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, xl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, nonvar_x_unk, nonvar_x_nvar);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.xl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(p_nonvar_y, yl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGP(pt0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
pt0 = YREG + PREG->u.yl.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, nonvar_y_unk);
|
|
|
|
|
nonvar_y_nvar:
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, yl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
derefa_body(d0, pt0, nonvar_y_unk, nonvar_y_nvar);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.yl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(p_number_x, xl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
d0 = XREG(PREG->u.xl.x);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
deref_head(d0, number_x_unk);
|
|
|
|
|
number_x_nvar:
|
|
|
|
|
/* non variable */
|
2002-12-27 16:53:09 +00:00
|
|
|
|
if (IsIntTerm(d0)) {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, xl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
2002-12-27 16:53:09 +00:00
|
|
|
|
if (IsApplTerm(d0)) {
|
|
|
|
|
Functor f0 = FunctorOfTerm(d0);
|
|
|
|
|
if (IsExtensionFunctor(f0)) {
|
|
|
|
|
switch ((CELL)f0) {
|
|
|
|
|
case (CELL)FunctorLongInt:
|
|
|
|
|
case (CELL)FunctorDouble:
|
|
|
|
|
#ifdef USE_GMP
|
|
|
|
|
case (CELL)FunctorBigInt:
|
|
|
|
|
#endif
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, xl);
|
2002-12-27 16:53:09 +00:00
|
|
|
|
GONext();
|
|
|
|
|
default:
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.xl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2002-12-27 16:53:09 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.xl.F;
|
2004-04-16 19:27:31 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, number_x_unk, number_x_nvar);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.xl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-10-07 22:00:38 +01:00
|
|
|
|
Op(p_number_y, yl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGP(pt0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
pt0 = YREG + PREG->u.yl.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, number_y_unk);
|
|
|
|
|
number_y_nvar:
|
|
|
|
|
/* non variable */
|
2002-12-27 16:53:09 +00:00
|
|
|
|
/* non variable */
|
|
|
|
|
if (IsIntTerm(d0)) {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, xl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
2002-12-27 16:53:09 +00:00
|
|
|
|
if (IsApplTerm(d0)) {
|
|
|
|
|
Functor f0 = FunctorOfTerm(d0);
|
|
|
|
|
if (IsExtensionFunctor(f0)) {
|
|
|
|
|
switch ((CELL)f0) {
|
|
|
|
|
case (CELL)FunctorLongInt:
|
|
|
|
|
case (CELL)FunctorDouble:
|
|
|
|
|
#ifdef USE_GMP
|
|
|
|
|
case (CELL)FunctorBigInt:
|
|
|
|
|
#endif
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, yl);
|
2002-12-27 16:53:09 +00:00
|
|
|
|
GONext();
|
|
|
|
|
default:
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.yl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2002-12-27 16:53:09 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.xl.F;
|
2004-04-16 19:27:31 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
derefa_body(d0, pt0, number_y_unk, number_y_nvar);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.yl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(p_var_x, xl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
d0 = XREG(PREG->u.xl.x);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
deref_head(d0, var_x_unk);
|
|
|
|
|
var_x_nvar:
|
|
|
|
|
/* non variable */
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.xl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, var_x_unk, var_x_nvar);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, xl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(p_var_y, yl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGP(pt0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
pt0 = YREG + PREG->u.yl.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, var_y_unk);
|
|
|
|
|
var_y_nvar:
|
|
|
|
|
/* non variable */
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.yl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
derefa_body(d0, pt0, var_y_unk, var_y_nvar);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, yl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(p_db_ref_x, xl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
d0 = XREG(PREG->u.xl.x);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
deref_head(d0, dbref_x_unk);
|
|
|
|
|
dbref_x_nvar:
|
|
|
|
|
/* non variable */
|
|
|
|
|
if (IsDBRefTerm(d0)) {
|
|
|
|
|
/* only allow references to the database, not general references
|
|
|
|
|
* to go through. */
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, xl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
else {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.xl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, dbref_x_unk, dbref_x_nvar);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.xl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(p_db_ref_y, yl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGP(pt0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
pt0 = YREG + PREG->u.yl.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, dbref_y_unk);
|
|
|
|
|
dbref_y_nvar:
|
|
|
|
|
/* non variable */
|
|
|
|
|
if (IsDBRefTerm(d0)) {
|
|
|
|
|
/* only allow references to the database, not general references
|
|
|
|
|
* to go through. */
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, yl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
else {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.yl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
derefa_body(d0, pt0, dbref_y_unk, dbref_y_nvar);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.yl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(p_primitive_x, xl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
d0 = XREG(PREG->u.xl.x);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
deref_head(d0, primi_x_unk);
|
|
|
|
|
primi_x_nvar:
|
|
|
|
|
/* non variable */
|
|
|
|
|
if (IsPrimitiveTerm(d0)) {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, xl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
else {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.xl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, primi_x_unk, primi_x_nvar);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.xl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(p_primitive_y, yl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGP(pt0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
pt0 = YREG + PREG->u.yl.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, primi_y_unk);
|
|
|
|
|
primi_y_nvar:
|
|
|
|
|
/* non variable */
|
|
|
|
|
if (IsPrimitiveTerm(d0)) {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, yl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
else {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.yl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
derefa_body(d0, pt0, primi_y_unk, primi_y_nvar);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.yl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(p_compound_x, xl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
d0 = XREG(PREG->u.xl.x);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
deref_head(d0, compound_x_unk);
|
|
|
|
|
compound_x_nvar:
|
|
|
|
|
/* non variable */
|
|
|
|
|
if (IsPairTerm(d0)) {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, xl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
else if (IsApplTerm(d0)) {
|
|
|
|
|
if (IsExtensionFunctor(FunctorOfTerm(d0))) {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.xl.F;
|
2004-04-16 19:27:31 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, xl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
else {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.xl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, compound_x_unk, compound_x_nvar);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.xl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(p_compound_y, yl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGP(pt0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
pt0 = YREG + PREG->u.yl.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, compound_y_unk);
|
|
|
|
|
compound_y_nvar:
|
|
|
|
|
/* non variable */
|
|
|
|
|
if (IsPairTerm(d0)) {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, yl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
else if (IsApplTerm(d0)) {
|
|
|
|
|
if (IsExtensionFunctor(FunctorOfTerm(d0))) {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.yl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, yl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
else {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.yl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
derefa_body(d0, pt0, compound_y_unk, compound_y_nvar);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.yl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(p_float_x, xl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
d0 = XREG(PREG->u.xl.x);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
deref_head(d0, float_x_unk);
|
|
|
|
|
float_x_nvar:
|
|
|
|
|
/* non variable */
|
|
|
|
|
if (IsFloatTerm(d0)) {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, xl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.xl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, float_x_unk, float_x_nvar);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.xl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(p_float_y, yl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGP(pt0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
pt0 = YREG + PREG->u.yl.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d0 = *pt0;
|
|
|
|
|
deref_head(d0, float_y_unk);
|
|
|
|
|
float_y_nvar:
|
|
|
|
|
/* non variable */
|
|
|
|
|
if (IsFloatTerm(d0)) {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, yl);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.yl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
derefa_body(d0, pt0, float_y_unk, float_y_nvar);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.yl.F;
|
2004-03-10 14:59:55 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(p_plus_vv, xxx);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d0 = XREG(PREG->u.xxx.x1);
|
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, plus_vv_unk);
|
|
|
|
|
plus_vv_nvar:
|
|
|
|
|
d1 = XREG(PREG->u.xxx.x2);
|
|
|
|
|
/* next check A2 */
|
|
|
|
|
deref_head(d1, plus_vv_nvar_unk);
|
|
|
|
|
plus_vv_nvar_nvar:
|
|
|
|
|
/* d0 and d1 are where I want them */
|
|
|
|
|
if (IsIntTerm(d0) && IsIntTerm(d1)) {
|
|
|
|
|
d0 = MkIntegerTerm(IntOfTerm(d0) + IntOfTerm(d1));
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_plus(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
XREG(PREG->u.xxx.x) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, xxx);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, plus_vv_unk, plus_vv_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is _+B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d1, pt0, plus_vv_nvar_unk, plus_vv_nvar_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A+B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-29 17:27:11 +01:00
|
|
|
|
Op(p_plus_vc, xxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-29 17:27:11 +01:00
|
|
|
|
d0 = XREG(PREG->u.xxn.xi);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, plus_vc_unk);
|
|
|
|
|
plus_vc_nvar:
|
|
|
|
|
{
|
2008-08-29 17:27:11 +01:00
|
|
|
|
Int d1 = PREG->u.xxn.c;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (IsIntTerm(d0)) {
|
|
|
|
|
d0 = MkIntegerTerm(IntOfTerm(d0) + d1);
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_plus(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
2008-08-29 17:27:11 +01:00
|
|
|
|
XREG(PREG->u.xxn.x) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, xxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, plus_vc_unk, plus_vc_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2012-02-13 09:36:05 +00:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A + " Int_FORMAT, PREG->u.xxn.c);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(p_plus_y_vv, yxx);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d0 = XREG(PREG->u.yxx.x1);
|
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, plus_y_vv_unk);
|
|
|
|
|
plus_y_vv_nvar:
|
|
|
|
|
d1 = XREG(PREG->u.xxx.x2);
|
|
|
|
|
/* next check A2 */
|
|
|
|
|
deref_head(d1, plus_y_vv_nvar_unk);
|
|
|
|
|
plus_y_vv_nvar_nvar:
|
|
|
|
|
/* d0 and d1 are where I want them */
|
|
|
|
|
if (IsIntTerm(d0) && IsIntTerm(d1)) {
|
|
|
|
|
d0 = MkIntegerTerm(IntOfTerm(d0) + IntOfTerm(d1));
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_plus(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
BEGP(pt0);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
pt0 = YREG + PREG->u.yxx.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = NEXTOP(PREG, yxx);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0,d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, plus_y_vv_unk, plus_y_vv_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A+B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d1, pt0, plus_y_vv_nvar_unk, plus_y_vv_nvar_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A+B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-30 23:00:50 +01:00
|
|
|
|
Op(p_plus_y_vc, yxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
d0 = XREG(PREG->u.yxn.xi);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, plus_y_vc_unk);
|
|
|
|
|
plus_y_vc_nvar:
|
|
|
|
|
{
|
2008-08-30 23:00:50 +01:00
|
|
|
|
Int d1 = PREG->u.yxn.c;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (IsIntTerm(d0)) {
|
|
|
|
|
d0 = MkIntegerTerm(IntOfTerm(d0) + d1);
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_plus(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
BEGP(pt0);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
pt0 = YREG + PREG->u.yxn.y;
|
|
|
|
|
PREG = NEXTOP(PREG, yxn);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0,d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, plus_y_vc_unk, plus_y_vc_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2012-02-13 09:36:05 +00:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A + " Int_FORMAT, PREG->u.yxn.c);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(p_minus_vv, xxx);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d0 = XREG(PREG->u.xxx.x1);
|
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, minus_vv_unk);
|
|
|
|
|
minus_vv_nvar:
|
|
|
|
|
d1 = XREG(PREG->u.xxx.x2);
|
|
|
|
|
/* next check A2 */
|
|
|
|
|
deref_head(d1, minus_vv_nvar_unk);
|
|
|
|
|
minus_vv_nvar_nvar:
|
|
|
|
|
/* d0 and d1 are where I want them */
|
|
|
|
|
if (IsIntTerm(d0) && IsIntTerm(d1)) {
|
|
|
|
|
d0 = MkIntegerTerm(IntOfTerm(d0) - IntOfTerm(d1));
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_minus(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
XREG(PREG->u.xxx.x) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, xxx);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, minus_vv_unk, minus_vv_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A-B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d1, pt0, minus_vv_nvar_unk, minus_vv_nvar_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A-B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-29 17:27:11 +01:00
|
|
|
|
Op(p_minus_cv, xxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-29 17:27:11 +01:00
|
|
|
|
d0 = XREG(PREG->u.xxn.xi);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, minus_cv_unk);
|
|
|
|
|
minus_cv_nvar:
|
|
|
|
|
{
|
2008-08-29 17:27:11 +01:00
|
|
|
|
Int d1 = PREG->u.xxn.c;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (IsIntTerm(d0)) {
|
|
|
|
|
d0 = MkIntegerTerm(d1 - IntOfTerm(d0));
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_minus(MkIntegerTerm(d1),Yap_Eval(d0) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
2008-08-29 17:27:11 +01:00
|
|
|
|
XREG(PREG->u.xxn.x) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, xxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, minus_cv_unk, minus_cv_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is " Int_FORMAT "-A", PREG->u.xxn.c);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(p_minus_y_vv, yxx);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d0 = XREG(PREG->u.yxx.x1);
|
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, minus_y_vv_unk);
|
|
|
|
|
minus_y_vv_nvar:
|
|
|
|
|
d1 = XREG(PREG->u.xxx.x2);
|
|
|
|
|
/* next check A2 */
|
|
|
|
|
deref_head(d1, minus_y_vv_nvar_unk);
|
|
|
|
|
minus_y_vv_nvar_nvar:
|
|
|
|
|
/* d0 and d1 are where I want them */
|
|
|
|
|
if (IsIntTerm(d0) && IsIntTerm(d1)) {
|
|
|
|
|
d0 = MkIntegerTerm(IntOfTerm(d0) - IntOfTerm(d1));
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_minus(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
BEGP(pt0);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
pt0 = YREG + PREG->u.yxx.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = NEXTOP(PREG, yxx);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0,d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, minus_y_vv_unk, minus_y_vv_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A-B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d1, pt0, minus_y_vv_nvar_unk, minus_y_vv_nvar_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A-B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-30 23:00:50 +01:00
|
|
|
|
Op(p_minus_y_cv, yxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
d0 = XREG(PREG->u.yxn.xi);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, minus_y_cv_unk);
|
|
|
|
|
minus_y_cv_nvar:
|
|
|
|
|
{
|
2008-08-30 23:00:50 +01:00
|
|
|
|
Int d1 = PREG->u.yxn.c;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (IsIntTerm(d0)) {
|
|
|
|
|
d0 = MkIntegerTerm(d1 - IntOfTerm(d0));
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_minus(MkIntegerTerm(d1), Yap_Eval(d0) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
BEGP(pt0);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
pt0 = YREG + PREG->u.yxn.y;
|
|
|
|
|
PREG = NEXTOP(PREG, yxn);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0,d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, minus_y_cv_unk, minus_y_cv_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is " Int_FORMAT "-A", PREG->u.yxn.c);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(p_times_vv, xxx);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d0 = XREG(PREG->u.xxx.x1);
|
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, times_vv_unk);
|
|
|
|
|
times_vv_nvar:
|
|
|
|
|
d1 = XREG(PREG->u.xxx.x2);
|
|
|
|
|
/* next check A2 */
|
|
|
|
|
deref_head(d1, times_vv_nvar_unk);
|
|
|
|
|
times_vv_nvar_nvar:
|
|
|
|
|
/* d0 and d1 are where I want them */
|
|
|
|
|
if (IsIntTerm(d0) && IsIntTerm(d1)) {
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = times_int(IntOfTerm(d0), IntOfTerm(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_times(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
XREG(PREG->u.xxx.x) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, xxx);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, times_vv_unk, times_vv_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A*B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d1, pt0, times_vv_nvar_unk, times_vv_nvar_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A*B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-29 17:27:11 +01:00
|
|
|
|
Op(p_times_vc, xxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-29 17:27:11 +01:00
|
|
|
|
d0 = XREG(PREG->u.xxn.xi);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, times_vc_unk);
|
|
|
|
|
times_vc_nvar:
|
|
|
|
|
{
|
2008-08-29 17:27:11 +01:00
|
|
|
|
Int d1 = PREG->u.xxn.c;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (IsIntTerm(d0)) {
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = times_int(IntOfTerm(d0), d1 PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_times(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
2008-08-29 17:27:11 +01:00
|
|
|
|
XREG(PREG->u.xxn.x) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, xxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, times_vc_unk, times_vc_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A* " Int_FORMAT, PREG->u.xxn.c);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(p_times_y_vv, yxx);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d0 = XREG(PREG->u.yxx.x1);
|
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, times_y_vv_unk);
|
|
|
|
|
times_y_vv_nvar:
|
|
|
|
|
d1 = XREG(PREG->u.xxx.x2);
|
|
|
|
|
/* next check A2 */
|
|
|
|
|
deref_head(d1, times_y_vv_nvar_unk);
|
|
|
|
|
times_y_vv_nvar_nvar:
|
|
|
|
|
/* d0 and d1 are where I want them */
|
|
|
|
|
if (IsIntTerm(d0) && IsIntTerm(d1)) {
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = times_int(IntOfTerm(d0), IntOfTerm(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_times(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
BEGP(pt0);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
pt0 = YREG + PREG->u.yxx.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = NEXTOP(PREG, yxx);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0,d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, times_y_vv_unk, times_y_vv_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A*B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d1, pt0, times_y_vv_nvar_unk, times_y_vv_nvar_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A*B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-30 23:00:50 +01:00
|
|
|
|
Op(p_times_y_vc, yxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
d0 = XREG(PREG->u.yxn.xi);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, times_y_vc_unk);
|
|
|
|
|
times_y_vc_nvar:
|
|
|
|
|
{
|
2008-08-30 23:00:50 +01:00
|
|
|
|
Int d1 = PREG->u.yxn.c;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (IsIntTerm(d0)) {
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = times_int(IntOfTerm(d0), d1 PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_times(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
BEGP(pt0);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
pt0 = YREG + PREG->u.yxn.y;
|
|
|
|
|
PREG = NEXTOP(PREG, yxn);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0,d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, times_y_vc_unk, times_y_vc_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A* " Int_FORMAT, PREG->u.yxn.c);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(p_div_vv, xxx);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d0 = XREG(PREG->u.xxx.x1);
|
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, div_vv_unk);
|
|
|
|
|
div_vv_nvar:
|
|
|
|
|
d1 = XREG(PREG->u.xxx.x2);
|
|
|
|
|
/* next check A2 */
|
|
|
|
|
deref_head(d1, div_vv_nvar_unk);
|
|
|
|
|
div_vv_nvar_nvar:
|
|
|
|
|
/* d0 and d1 are where I want them */
|
|
|
|
|
if (IsIntTerm(d0) && IsIntTerm(d1)) {
|
|
|
|
|
Int div = IntOfTerm(d1);
|
|
|
|
|
if (div == 0) {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(EVALUATION_ERROR_ZERO_DIVISOR,"// /2");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
d0 = MkIntTerm(IntOfTerm(d0) / div);
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_div(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
XREG(PREG->u.xxx.x) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, xxx);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, div_vv_unk, div_vv_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A//B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d1, pt0, div_vv_nvar_unk, div_vv_nvar_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A//B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-29 17:27:11 +01:00
|
|
|
|
Op(p_div_vc, xxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-29 17:27:11 +01:00
|
|
|
|
d0 = XREG(PREG->u.xxn.xi);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, div_vc_unk);
|
|
|
|
|
div_vc_nvar:
|
|
|
|
|
{
|
2008-08-29 17:27:11 +01:00
|
|
|
|
Int d1 = PREG->u.xxn.c;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (IsIntTerm(d0)) {
|
|
|
|
|
d0 = MkIntTerm(IntOfTerm(d0) / d1);
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_div(Yap_Eval(d0),MkIntegerTerm(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
2008-08-29 17:27:11 +01:00
|
|
|
|
XREG(PREG->u.xxn.x) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, xxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, div_vc_unk, div_vc_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A//B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-29 17:27:11 +01:00
|
|
|
|
Op(p_div_cv, xxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-29 17:27:11 +01:00
|
|
|
|
d0 = XREG(PREG->u.xxn.xi);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, div_cv_unk);
|
|
|
|
|
div_cv_nvar:
|
|
|
|
|
{
|
2008-08-29 17:27:11 +01:00
|
|
|
|
Int d1 = PREG->u.xxn.c;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (IsIntTerm(d0)) {
|
|
|
|
|
Int div = IntOfTerm(d0);
|
|
|
|
|
if (div == 0){
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(EVALUATION_ERROR_ZERO_DIVISOR,"// /2");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
d0 = MkIntegerTerm(d1 / div);
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_div(MkIntegerTerm(d1),Yap_Eval(d0) PASS_REGS);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
2008-08-29 17:27:11 +01:00
|
|
|
|
XREG(PREG->u.xxn.x) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, xxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, div_cv_unk, div_cv_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is " Int_FORMAT "// A", PREG->u.xxn.c);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(p_div_y_vv, yxx);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d0 = XREG(PREG->u.yxx.x1);
|
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, div_y_vv_unk);
|
|
|
|
|
div_y_vv_nvar:
|
|
|
|
|
d1 = XREG(PREG->u.xxx.x2);
|
|
|
|
|
/* next check A2 */
|
|
|
|
|
deref_head(d1, div_y_vv_nvar_unk);
|
|
|
|
|
div_y_vv_nvar_nvar:
|
|
|
|
|
/* d0 and d1 are where I want them */
|
|
|
|
|
if (IsIntTerm(d0) && IsIntTerm(d1)) {
|
|
|
|
|
Int div = IntOfTerm(d1);
|
|
|
|
|
if (div == 0) {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(EVALUATION_ERROR_ZERO_DIVISOR,"// /2");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
d0 = MkIntTerm(IntOfTerm(d0) / div);
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_div(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
BEGP(pt0);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
pt0 = YREG + PREG->u.yxx.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = NEXTOP(PREG, yxx);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0,d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, div_y_vv_unk, div_y_vv_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A//B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d1, pt0, div_y_vv_nvar_unk, div_y_vv_nvar_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A//B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-30 23:00:50 +01:00
|
|
|
|
Op(p_div_y_vc, yxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
d0 = XREG(PREG->u.yxn.xi);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, div_y_vc_unk);
|
|
|
|
|
div_y_vc_nvar:
|
|
|
|
|
{
|
2008-08-30 23:00:50 +01:00
|
|
|
|
Int d1 = PREG->u.yxn.c;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (IsIntTerm(d0)) {
|
|
|
|
|
d0 = MkIntTerm(IntOfTerm(d0)/d1);
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_div(Yap_Eval(d0),MkIntegerTerm(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
BEGP(pt0);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
pt0 = YREG + PREG->u.yxn.y;
|
|
|
|
|
PREG = NEXTOP(PREG, yxn);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0,d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, div_y_vc_unk, div_y_vc_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A//B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-30 23:00:50 +01:00
|
|
|
|
Op(p_div_y_cv, yxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
d0 = XREG(PREG->u.yxn.xi);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, div_y_cv_unk);
|
|
|
|
|
div_y_cv_nvar:
|
|
|
|
|
{
|
2008-08-30 23:00:50 +01:00
|
|
|
|
Int d1 = PREG->u.yxn.c;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (IsIntTerm(d0)) {
|
|
|
|
|
Int div = IntOfTerm(d0);
|
|
|
|
|
if (div == 0) {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(EVALUATION_ERROR_ZERO_DIVISOR,"// /2");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
d0 = MkIntegerTerm(d1 / div);
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_div(MkIntegerTerm(d1), Yap_Eval(d0) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
BEGP(pt0);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
pt0 = YREG + PREG->u.yxn.y;
|
|
|
|
|
PREG = NEXTOP(PREG, yxn);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0,d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, div_y_cv_unk, div_y_cv_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is " Int_FORMAT "// A", PREG->u.yxn.c);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Op(p_and_vv, xxx);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d0 = XREG(PREG->u.xxx.x1);
|
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, and_vv_unk);
|
|
|
|
|
and_vv_nvar:
|
|
|
|
|
d1 = XREG(PREG->u.xxx.x2);
|
|
|
|
|
/* next check A2 */
|
|
|
|
|
deref_head(d1, and_vv_nvar_unk);
|
|
|
|
|
and_vv_nvar_nvar:
|
|
|
|
|
/* d0 and d1 are where I want them */
|
|
|
|
|
if (IsIntTerm(d0) && IsIntTerm(d1)) {
|
|
|
|
|
d0 = MkIntegerTerm(IntOfTerm(d0) & IntOfTerm(d1));
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_and(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
XREG(PREG->u.xxx.x) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, xxx);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, and_vv_unk, and_vv_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A/\\B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d1, pt0, and_vv_nvar_unk, and_vv_nvar_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A/\\B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-29 17:27:11 +01:00
|
|
|
|
Op(p_and_vc, xxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-29 17:27:11 +01:00
|
|
|
|
d0 = XREG(PREG->u.xxn.xi);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, and_vc_unk);
|
|
|
|
|
and_vc_nvar:
|
|
|
|
|
{
|
2008-08-29 17:27:11 +01:00
|
|
|
|
Int d1 = PREG->u.xxn.c;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (IsIntTerm(d0)) {
|
|
|
|
|
d0 = MkIntegerTerm(IntOfTerm(d0) & d1);
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_and(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
2008-08-29 17:27:11 +01:00
|
|
|
|
XREG(PREG->u.xxn.x) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, xxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, and_vc_unk, and_vc_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A /\\ " Int_FORMAT , PREG->u.xxn.c);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(p_and_y_vv, yxx);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d0 = XREG(PREG->u.yxx.x1);
|
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, and_y_vv_unk);
|
|
|
|
|
and_y_vv_nvar:
|
|
|
|
|
d1 = XREG(PREG->u.xxx.x2);
|
|
|
|
|
/* next check A2 */
|
|
|
|
|
deref_head(d1, and_y_vv_nvar_unk);
|
|
|
|
|
and_y_vv_nvar_nvar:
|
|
|
|
|
/* d0 and d1 are where I want them */
|
|
|
|
|
if (IsIntTerm(d0) && IsIntTerm(d1)) {
|
|
|
|
|
d0 = MkIntegerTerm(IntOfTerm(d0) & IntOfTerm(d1));
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_and(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
BEGP(pt0);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
pt0 = YREG + PREG->u.yxx.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = NEXTOP(PREG, yxx);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0,d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, and_y_vv_unk, and_y_vv_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A/\\B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d1, pt0, and_y_vv_nvar_unk, and_y_vv_nvar_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A/\\B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-30 23:00:50 +01:00
|
|
|
|
Op(p_and_y_vc, yxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
d0 = XREG(PREG->u.yxn.xi);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, and_y_vc_unk);
|
|
|
|
|
and_y_vc_nvar:
|
|
|
|
|
{
|
2008-08-30 23:00:50 +01:00
|
|
|
|
Int d1 = PREG->u.yxn.c;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (IsIntTerm(d0)) {
|
|
|
|
|
d0 = MkIntegerTerm(IntOfTerm(d0) & d1);
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_and(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
BEGP(pt0);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
pt0 = YREG + PREG->u.yxn.y;
|
|
|
|
|
PREG = NEXTOP(PREG, yxn);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0,d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, and_y_vc_unk, and_y_vc_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A /\\ " Int_FORMAT , PREG->u.yxn.c);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Op(p_or_vv, xxx);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d0 = XREG(PREG->u.xxx.x1);
|
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, or_vv_unk);
|
|
|
|
|
or_vv_nvar:
|
|
|
|
|
d1 = XREG(PREG->u.xxx.x2);
|
|
|
|
|
/* next check A2 */
|
|
|
|
|
deref_head(d1, or_vv_nvar_unk);
|
|
|
|
|
or_vv_nvar_nvar:
|
|
|
|
|
/* d0 and d1 are where I want them */
|
|
|
|
|
if (IsIntTerm(d0) && IsIntTerm(d1)) {
|
|
|
|
|
d0 = MkIntegerTerm(IntOfTerm(d0) | IntOfTerm(d1));
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_or(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
XREG(PREG->u.xxx.x) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, xxx);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, or_vv_unk, or_vv_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A\\/B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d1, pt0, or_vv_nvar_unk, or_vv_nvar_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A\\/B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-29 17:27:11 +01:00
|
|
|
|
Op(p_or_vc, xxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-29 17:27:11 +01:00
|
|
|
|
d0 = XREG(PREG->u.xxn.xi);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, or_vc_unk);
|
|
|
|
|
or_vc_nvar:
|
|
|
|
|
{
|
2008-08-29 17:27:11 +01:00
|
|
|
|
Int d1 = PREG->u.xxn.c;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (IsIntTerm(d0)) {
|
|
|
|
|
d0 = MkIntegerTerm(IntOfTerm(d0) | d1);
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_or(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
2008-08-29 17:27:11 +01:00
|
|
|
|
XREG(PREG->u.xxn.x) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, xxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, or_vc_unk, or_vc_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A \\/ " Int_FORMAT , PREG->u.xxn.c);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(p_or_y_vv, yxx);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d0 = XREG(PREG->u.yxx.x1);
|
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, or_y_vv_unk);
|
|
|
|
|
or_y_vv_nvar:
|
|
|
|
|
d1 = XREG(PREG->u.xxx.x2);
|
|
|
|
|
/* next check A2 */
|
|
|
|
|
deref_head(d1, or_y_vv_nvar_unk);
|
|
|
|
|
or_y_vv_nvar_nvar:
|
|
|
|
|
/* d0 and d1 are where I want them */
|
|
|
|
|
if (IsIntTerm(d0) && IsIntTerm(d1)) {
|
|
|
|
|
d0 = MkIntegerTerm(IntOfTerm(d0) | IntOfTerm(d1));
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_or(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
BEGP(pt0);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
pt0 = YREG + PREG->u.yxx.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = NEXTOP(PREG, yxx);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0,d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, or_y_vv_unk, or_y_vv_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A\\/B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d1, pt0, or_y_vv_nvar_unk, or_y_vv_nvar_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A\\/B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-30 23:00:50 +01:00
|
|
|
|
Op(p_or_y_vc, yxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
d0 = XREG(PREG->u.yxn.xi);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, or_y_vc_unk);
|
|
|
|
|
or_y_vc_nvar:
|
|
|
|
|
{
|
2008-08-30 23:00:50 +01:00
|
|
|
|
Int d1 = PREG->u.yxn.c;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (IsIntTerm(d0)) {
|
|
|
|
|
d0 = MkIntegerTerm(IntOfTerm(d0) | d1);
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_or(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
BEGP(pt0);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
pt0 = YREG + PREG->u.yxn.y;
|
|
|
|
|
PREG = NEXTOP(PREG, yxn);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0,d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, or_y_vc_unk, or_y_vc_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A \\/ " Int_FORMAT , PREG->u.yxn.c);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(p_sll_vv, xxx);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d0 = XREG(PREG->u.xxx.x1);
|
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, sll_vv_unk);
|
|
|
|
|
sll_vv_nvar:
|
|
|
|
|
d1 = XREG(PREG->u.xxx.x2);
|
|
|
|
|
/* next check A2 */
|
|
|
|
|
deref_head(d1, sll_vv_nvar_unk);
|
|
|
|
|
sll_vv_nvar_nvar:
|
|
|
|
|
/* d0 and d1 are where I want them */
|
|
|
|
|
if (IsIntTerm(d0) && IsIntTerm(d1)) {
|
2006-01-02 02:16:19 +00:00
|
|
|
|
Int i2 = IntOfTerm(d1);
|
|
|
|
|
if (i2 < 0)
|
2011-11-16 07:36:34 +00:00
|
|
|
|
d0 = MkIntegerTerm(SLR(IntOfTerm(d0), -i2));
|
2006-01-02 02:16:19 +00:00
|
|
|
|
else
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = do_sll(IntOfTerm(d0),i2 PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_sll(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
|
|
|
|
}
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2006-01-02 02:16:19 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
XREG(PREG->u.xxx.x) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, xxx);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, sll_vv_unk, sll_vv_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A<<B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d1, pt0, sll_vv_nvar_unk, sll_vv_nvar_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A<<B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-29 17:27:11 +01:00
|
|
|
|
Op(p_sll_vc, xxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-29 17:27:11 +01:00
|
|
|
|
d0 = XREG(PREG->u.xxn.xi);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, sll_vc_unk);
|
|
|
|
|
sll_vc_nvar:
|
|
|
|
|
{
|
2008-08-29 17:27:11 +01:00
|
|
|
|
Int d1 = PREG->u.xxn.c;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (IsIntTerm(d0)) {
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = do_sll(IntOfTerm(d0), (Int)d1 PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_sll(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
|
|
|
|
}
|
|
|
|
|
}
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2006-01-02 02:16:19 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2008-08-29 17:27:11 +01:00
|
|
|
|
XREG(PREG->u.xxn.x) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, xxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, sll_vc_unk, sll_vc_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A<<B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-29 17:27:11 +01:00
|
|
|
|
Op(p_sll_cv, xxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-29 17:27:11 +01:00
|
|
|
|
d0 = XREG(PREG->u.xxn.xi);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, sll_cv_unk);
|
|
|
|
|
sll_cv_nvar:
|
|
|
|
|
{
|
2008-08-29 17:27:11 +01:00
|
|
|
|
Int d1 = PREG->u.xxn.c;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (IsIntTerm(d0)) {
|
2006-01-02 02:16:19 +00:00
|
|
|
|
Int i2 = IntOfTerm(d0);
|
|
|
|
|
if (i2 < 0)
|
2011-11-16 07:36:34 +00:00
|
|
|
|
d0 = MkIntegerTerm(SLR(d1, -i2));
|
2006-01-02 02:16:19 +00:00
|
|
|
|
else
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = do_sll(d1,i2 PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_sll(MkIntegerTerm(d1), Yap_Eval(d0) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
|
|
|
|
}
|
|
|
|
|
}
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2006-01-02 02:16:19 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2008-08-29 17:27:11 +01:00
|
|
|
|
XREG(PREG->u.xxn.x) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, xxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, sll_cv_unk, sll_cv_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A<<B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(p_sll_y_vv, yxx);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d0 = XREG(PREG->u.yxx.x1);
|
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, sll_y_vv_unk);
|
|
|
|
|
sll_y_vv_nvar:
|
|
|
|
|
d1 = XREG(PREG->u.xxx.x2);
|
|
|
|
|
/* next check A2 */
|
|
|
|
|
deref_head(d1, sll_y_vv_nvar_unk);
|
|
|
|
|
sll_y_vv_nvar_nvar:
|
|
|
|
|
/* d0 and d1 are where I want them */
|
|
|
|
|
if (IsIntTerm(d0) && IsIntTerm(d1)) {
|
2006-01-02 02:16:19 +00:00
|
|
|
|
Int i2 = IntOfTerm(d1);
|
|
|
|
|
if (i2 < 0)
|
2011-11-16 07:36:34 +00:00
|
|
|
|
d0 = MkIntegerTerm(SLR(IntOfTerm(d0), -i2));
|
2006-01-02 02:16:19 +00:00
|
|
|
|
else
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = do_sll(IntOfTerm(d0),i2 PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_sll(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
|
|
|
|
}
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2006-01-02 02:16:19 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGP(pt0);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
pt0 = YREG + PREG->u.yxx.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = NEXTOP(PREG, yxx);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0,d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, sll_y_vv_unk, sll_y_vv_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A<<B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d1, pt0, sll_y_vv_nvar_unk, sll_y_vv_nvar_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A<<B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-30 23:00:50 +01:00
|
|
|
|
Op(p_sll_y_vc, yxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
d0 = XREG(PREG->u.yxn.xi);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, sll_y_vc_unk);
|
|
|
|
|
sll_y_vc_nvar:
|
|
|
|
|
{
|
2008-08-30 23:00:50 +01:00
|
|
|
|
Int d1 = PREG->u.yxn.c;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (IsIntTerm(d0)) {
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = do_sll(IntOfTerm(d0), Yap_Eval(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_sll(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
|
|
|
|
}
|
|
|
|
|
}
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2006-01-02 02:16:19 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGP(pt0);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
pt0 = YREG + PREG->u.yxn.y;
|
|
|
|
|
PREG = NEXTOP(PREG, yxn);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0,d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, sll_y_vc_unk, sll_y_vc_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A<<B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
|
2008-08-30 23:00:50 +01:00
|
|
|
|
Op(p_sll_y_cv, yxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
d0 = XREG(PREG->u.yxn.xi);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, sll_y_cv_unk);
|
|
|
|
|
sll_y_cv_nvar:
|
|
|
|
|
{
|
2008-08-30 23:00:50 +01:00
|
|
|
|
Int d1 = PREG->u.yxn.c;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (IsIntTerm(d0)) {
|
2006-01-02 02:16:19 +00:00
|
|
|
|
Int i2 = IntOfTerm(d0);
|
|
|
|
|
if (i2 < 0)
|
2011-11-16 07:36:34 +00:00
|
|
|
|
d0 = MkIntegerTerm(SLR(d1, -i2));
|
2006-01-02 02:16:19 +00:00
|
|
|
|
else
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = do_sll(d1,i2 PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_sll(MkIntegerTerm(d1), Yap_Eval(0) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
|
|
|
|
}
|
|
|
|
|
}
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2006-01-02 02:16:19 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGP(pt0);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
pt0 = YREG + PREG->u.yxn.y;
|
|
|
|
|
PREG = NEXTOP(PREG, yxn);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0,d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, sll_y_cv_unk, sll_y_cv_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A<<B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(p_slr_vv, xxx);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d0 = XREG(PREG->u.xxx.x1);
|
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, slr_vv_unk);
|
|
|
|
|
slr_vv_nvar:
|
|
|
|
|
d1 = XREG(PREG->u.xxx.x2);
|
|
|
|
|
/* next check A2 */
|
|
|
|
|
deref_head(d1, slr_vv_nvar_unk);
|
|
|
|
|
slr_vv_nvar_nvar:
|
|
|
|
|
/* d0 and d1 are where I want them */
|
|
|
|
|
if (IsIntTerm(d0) && IsIntTerm(d1)) {
|
2006-01-02 02:16:19 +00:00
|
|
|
|
Int i2 = IntOfTerm(d1);
|
|
|
|
|
if (i2 < 0)
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = do_sll(IntOfTerm(d0), -i2 PASS_REGS);
|
2006-01-02 02:16:19 +00:00
|
|
|
|
else
|
2011-11-16 07:36:34 +00:00
|
|
|
|
d0 = MkIntTerm(SLR(IntOfTerm(d0), i2));
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_slr(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
|
|
|
|
}
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2006-01-02 02:16:19 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
XREG(PREG->u.xxx.x) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, xxx);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, slr_vv_unk, slr_vv_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A>>B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d1, pt0, slr_vv_nvar_unk, slr_vv_nvar_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A>>B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-29 17:27:11 +01:00
|
|
|
|
Op(p_slr_vc, xxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-29 17:27:11 +01:00
|
|
|
|
d0 = XREG(PREG->u.xxn.xi);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, slr_vc_unk);
|
|
|
|
|
slr_vc_nvar:
|
|
|
|
|
{
|
2008-08-29 17:27:11 +01:00
|
|
|
|
Int d1 = PREG->u.xxn.c;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (IsIntTerm(d0)) {
|
2011-11-16 07:36:34 +00:00
|
|
|
|
d0 = MkIntTerm(SLR(IntOfTerm(d0), d1));
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_slr(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
2008-08-29 17:27:11 +01:00
|
|
|
|
XREG(PREG->u.xxn.x) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, xxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, slr_vc_unk, slr_vc_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A>>B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-29 17:27:11 +01:00
|
|
|
|
Op(p_slr_cv, xxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-29 17:27:11 +01:00
|
|
|
|
d0 = XREG(PREG->u.xxn.xi);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, slr_cv_unk);
|
|
|
|
|
slr_cv_nvar:
|
|
|
|
|
{
|
2008-08-29 17:27:11 +01:00
|
|
|
|
Int d1 = PREG->u.xxn.c;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (IsIntTerm(d0)) {
|
2006-01-02 02:16:19 +00:00
|
|
|
|
Int i2 = IntOfTerm(d0);
|
|
|
|
|
if (i2 < 0)
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = do_sll(d1, -i2 PASS_REGS);
|
2006-01-02 02:16:19 +00:00
|
|
|
|
else
|
2011-11-16 07:36:34 +00:00
|
|
|
|
d0 = MkIntegerTerm(SLR(d1, i2));
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_slr(MkIntegerTerm(d1), Yap_Eval(d0) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
|
|
|
|
}
|
|
|
|
|
}
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2006-01-02 02:16:19 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2008-08-29 17:27:11 +01:00
|
|
|
|
XREG(PREG->u.xxn.x) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, xxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, slr_cv_unk, slr_cv_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A>>B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(p_slr_y_vv, yxx);
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d0 = XREG(PREG->u.yxx.x1);
|
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, slr_y_vv_unk);
|
|
|
|
|
slr_y_vv_nvar:
|
|
|
|
|
d1 = XREG(PREG->u.xxx.x2);
|
|
|
|
|
/* next check A2 */
|
|
|
|
|
deref_head(d1, slr_y_vv_nvar_unk);
|
|
|
|
|
slr_y_vv_nvar_nvar:
|
|
|
|
|
/* d0 and d1 are where I want them */
|
|
|
|
|
if (IsIntTerm(d0) && IsIntTerm(d1)) {
|
2006-01-02 02:16:19 +00:00
|
|
|
|
Int i2 = IntOfTerm(d1);
|
|
|
|
|
if (i2 < 0)
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = do_sll(IntOfTerm(d0), -i2 PASS_REGS);
|
2006-01-02 02:16:19 +00:00
|
|
|
|
else
|
2011-11-16 07:36:34 +00:00
|
|
|
|
d0 = MkIntTerm(SLR(IntOfTerm(d0), i2));
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_slr(Yap_Eval(d0), Yap_Eval(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
|
|
|
|
}
|
|
|
|
|
BEGP(pt0);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2006-01-02 02:16:19 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2002-11-11 17:38:10 +00:00
|
|
|
|
pt0 = YREG + PREG->u.yxx.y;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
PREG = NEXTOP(PREG, yxx);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0,d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, slr_y_vv_unk, slr_y_vv_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A>>B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d1, pt0, slr_y_vv_nvar_unk, slr_y_vv_nvar_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A>>B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-30 23:00:50 +01:00
|
|
|
|
Op(p_slr_y_vc, yxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
d0 = XREG(PREG->u.yxn.xi);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, slr_y_vc_unk);
|
|
|
|
|
slr_y_vc_nvar:
|
|
|
|
|
{
|
2008-08-30 23:00:50 +01:00
|
|
|
|
Int d1 = PREG->u.yxn.c;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (IsIntTerm(d0)) {
|
2011-11-16 07:36:34 +00:00
|
|
|
|
d0 = MkIntTerm(SLR(IntOfTerm(d0), d1));
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_slr(Yap_Eval(d0), MkIntegerTerm(d1) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
BEGP(pt0);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
pt0 = YREG + PREG->u.yxn.y;
|
|
|
|
|
PREG = NEXTOP(PREG, yxn);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0,d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, slr_y_vc_unk, slr_y_vc_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A>>B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-30 23:00:50 +01:00
|
|
|
|
Op(p_slr_y_cv, yxn);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
d0 = XREG(PREG->u.yxn.xi);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* first check pt1 */
|
|
|
|
|
deref_head(d0, slr_y_cv_unk);
|
|
|
|
|
slr_y_cv_nvar:
|
|
|
|
|
{
|
2008-08-30 23:00:50 +01:00
|
|
|
|
Int d1 = PREG->u.yxn.c;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (IsIntTerm(d0)) {
|
2006-01-02 02:16:19 +00:00
|
|
|
|
Int i2 = IntOfTerm(d0);
|
|
|
|
|
if (i2 < 0)
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = do_sll(d1, -i2 PASS_REGS);
|
2006-01-02 02:16:19 +00:00
|
|
|
|
else
|
2011-11-16 07:36:34 +00:00
|
|
|
|
d0 = MkIntegerTerm(SLR(d1, i2));
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
saveregs();
|
2013-03-26 15:01:52 -05:00
|
|
|
|
d0 = p_slr(MkIntegerTerm(d1), Yap_Eval(d0) PASS_REGS);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
setregs();
|
|
|
|
|
}
|
|
|
|
|
}
|
2010-02-18 10:56:59 +00:00
|
|
|
|
if (d0 == 0L) {
|
|
|
|
|
saveregs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_Error(LOCAL_Error_TYPE, LOCAL_Error_Term, LOCAL_ErrorMessage);
|
2010-02-18 10:56:59 +00:00
|
|
|
|
setregs();
|
2006-01-02 02:16:19 +00:00
|
|
|
|
FAIL();
|
2010-02-18 10:56:59 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGP(pt0);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
pt0 = YREG + PREG->u.yxn.y;
|
|
|
|
|
PREG = NEXTOP(PREG, yxn);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0,d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, slr_y_cv_unk, slr_y_cv_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(INSTANTIATION_ERROR, "X is A>>B");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
BOp(call_bfunc_xx, plxxs);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
d0 = XREG(PREG->u.plxxs.x1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
call_bfunc_xx_nvar:
|
2008-08-21 13:38:25 +01:00
|
|
|
|
d1 = XREG(PREG->u.plxxs.x2);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
call_bfunc_xx2_nvar:
|
|
|
|
|
deref_head(d0, call_bfunc_xx_unk);
|
|
|
|
|
deref_head(d1, call_bfunc_xx2_unk);
|
|
|
|
|
if (IsIntTerm(d0) && IsIntTerm(d1)) {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
COUNT flags;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
Int v = IntOfTerm(d0) - IntOfTerm(d1);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
flags = PREG->u.plxxs.flags;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (v > 0) {
|
|
|
|
|
if (flags & GT_OK_IN_CMP) {
|
2009-03-05 16:12:21 +00:00
|
|
|
|
yamop *nextp = NEXTOP(PREG, plxxs);
|
|
|
|
|
ALWAYS_LOOKAHEAD(nextp->opc);
|
|
|
|
|
PREG = nextp;
|
|
|
|
|
ALWAYS_GONext();
|
|
|
|
|
ALWAYS_END_PREFETCH();
|
2003-12-27 00:38:53 +00:00
|
|
|
|
} else {
|
2009-03-05 16:12:21 +00:00
|
|
|
|
yamop *nextp = PREG->u.plxxs.f;
|
|
|
|
|
ALWAYS_LOOKAHEAD(nextp->opc);
|
|
|
|
|
PREG = nextp;
|
|
|
|
|
ALWAYS_GONext();
|
|
|
|
|
ALWAYS_END_PREFETCH();
|
2003-12-27 00:38:53 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
} else if (v < 0) {
|
|
|
|
|
if (flags & LT_OK_IN_CMP) {
|
2009-03-05 16:12:21 +00:00
|
|
|
|
yamop *nextp = NEXTOP(PREG, plxxs);
|
|
|
|
|
ALWAYS_LOOKAHEAD(nextp->opc);
|
|
|
|
|
PREG = nextp;
|
|
|
|
|
ALWAYS_GONext();
|
|
|
|
|
ALWAYS_END_PREFETCH();
|
2003-12-27 00:38:53 +00:00
|
|
|
|
} else {
|
2009-03-05 16:12:21 +00:00
|
|
|
|
yamop *nextp = PREG->u.plxxs.f;
|
|
|
|
|
ALWAYS_LOOKAHEAD(nextp->opc);
|
|
|
|
|
PREG = nextp;
|
|
|
|
|
ALWAYS_GONext();
|
|
|
|
|
ALWAYS_END_PREFETCH();
|
2003-12-27 00:38:53 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
} else /* if (v == 0) */ {
|
|
|
|
|
if (flags & EQ_OK_IN_CMP) {
|
2009-03-05 16:12:21 +00:00
|
|
|
|
yamop *nextp = NEXTOP(PREG, plxxs);
|
|
|
|
|
ALWAYS_LOOKAHEAD(nextp->opc);
|
|
|
|
|
PREG = nextp;
|
|
|
|
|
ALWAYS_GONext();
|
|
|
|
|
ALWAYS_END_PREFETCH();
|
2003-12-27 00:38:53 +00:00
|
|
|
|
} else {
|
2009-03-05 16:12:21 +00:00
|
|
|
|
yamop *nextp = PREG->u.plxxs.f;
|
|
|
|
|
ALWAYS_LOOKAHEAD(nextp->opc);
|
|
|
|
|
PREG = nextp;
|
|
|
|
|
ALWAYS_GONext();
|
|
|
|
|
ALWAYS_END_PREFETCH();
|
2003-12-27 00:38:53 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
exec_bin_cmp_xx:
|
2002-12-27 16:53:09 +00:00
|
|
|
|
{
|
2008-08-21 13:38:25 +01:00
|
|
|
|
CmpPredicate f = PREG->u.plxxs.p->cs.d_code;
|
2002-12-27 16:53:09 +00:00
|
|
|
|
saveregs();
|
|
|
|
|
d0 = (CELL) (f) (d0,d1);
|
2004-03-06 00:31:48 +00:00
|
|
|
|
setregs();
|
2002-12-27 16:53:09 +00:00
|
|
|
|
}
|
2009-05-22 18:44:05 -05:00
|
|
|
|
if (PREG == FAILCODE) {
|
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
2009-04-07 23:55:16 +01:00
|
|
|
|
if (!d0) {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.plxxs.f;
|
2003-12-27 00:38:53 +00:00
|
|
|
|
JMPNext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, plxxs);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, call_bfunc_xx_unk, call_bfunc_xx_nvar);
|
2005-11-05 03:02:33 +00:00
|
|
|
|
d1 = Deref(d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
goto exec_bin_cmp_xx;
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d1, pt0, call_bfunc_xx2_unk, call_bfunc_xx2_nvar);
|
|
|
|
|
goto exec_bin_cmp_xx;
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
BOp(call_bfunc_yx, plxys);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
BEGP(pt0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
pt0 = YREG + PREG->u.plxys.y;
|
|
|
|
|
d1 = XREG(PREG->u.plxys.x);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d0 = *pt0;
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
deref_head(d0, call_bfunc_yx_unk);
|
|
|
|
|
call_bfunc_yx_nvar:
|
|
|
|
|
deref_head(d1, call_bfunc_yx2_unk);
|
|
|
|
|
call_bfunc_yx2_nvar:
|
|
|
|
|
if (IsIntTerm(d0) && IsIntTerm(d1)) {
|
|
|
|
|
int flags;
|
|
|
|
|
|
|
|
|
|
Int v = IntOfTerm(d0) - IntOfTerm(d1);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
flags = PREG->u.plxys.flags;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (v > 0) {
|
|
|
|
|
if (flags & GT_OK_IN_CMP) {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, plxys);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
2003-12-27 00:38:53 +00:00
|
|
|
|
} else {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.plxys.f;
|
2003-12-27 00:38:53 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
} else if (v < 0) {
|
|
|
|
|
if (flags & LT_OK_IN_CMP) {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, plxys);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
2003-12-27 00:38:53 +00:00
|
|
|
|
} else {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.plxys.f;
|
2003-12-27 00:38:53 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
} else /* if (v == 0) */ {
|
|
|
|
|
if (flags & EQ_OK_IN_CMP) {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, plxys);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
2003-12-27 00:38:53 +00:00
|
|
|
|
} else {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.plxys.f;
|
2003-12-27 00:38:53 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
exec_bin_cmp_yx:
|
2002-12-27 16:53:09 +00:00
|
|
|
|
{
|
2008-08-21 13:38:25 +01:00
|
|
|
|
CmpPredicate f = PREG->u.plxys.p->cs.d_code;
|
2002-12-27 16:53:09 +00:00
|
|
|
|
saveregs();
|
|
|
|
|
d0 = (CELL) (f) (d0,d1);
|
2004-03-06 00:31:48 +00:00
|
|
|
|
setregs();
|
2002-12-27 16:53:09 +00:00
|
|
|
|
}
|
2009-03-26 00:37:57 +00:00
|
|
|
|
if (!d0 || PREG == FAILCODE) {
|
2004-03-06 00:31:48 +00:00
|
|
|
|
if (PREG != FAILCODE)
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.plxys.f;
|
2003-12-27 00:38:53 +00:00
|
|
|
|
JMPNext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, plxys);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, call_bfunc_yx_unk, call_bfunc_yx_nvar);
|
2005-11-05 03:02:33 +00:00
|
|
|
|
d1 = Deref(d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
goto exec_bin_cmp_yx;
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d1, pt0, call_bfunc_yx2_unk, call_bfunc_yx2_nvar);
|
|
|
|
|
goto exec_bin_cmp_yx;
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
BOp(call_bfunc_xy, plxys);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
BEGP(pt0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
pt0 = YREG + PREG->u.plxys.y;
|
|
|
|
|
d0 = XREG(PREG->u.plxys.x);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d1 = *pt0;
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
deref_head(d0, call_bfunc_xy_unk);
|
|
|
|
|
call_bfunc_xy_nvar:
|
|
|
|
|
deref_head(d1, call_bfunc_xy2_unk);
|
|
|
|
|
call_bfunc_xy2_nvar:
|
|
|
|
|
if (IsIntTerm(d0) && IsIntTerm(d1)) {
|
|
|
|
|
int flags;
|
|
|
|
|
|
|
|
|
|
Int v = IntOfTerm(d0) - IntOfTerm(d1);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
flags = PREG->u.plxys.flags;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (v > 0) {
|
|
|
|
|
if (flags & GT_OK_IN_CMP) {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, plxys);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
2003-12-27 00:38:53 +00:00
|
|
|
|
} else {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.plxys.f;
|
2003-12-27 00:38:53 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
} else if (v < 0) {
|
|
|
|
|
if (flags & LT_OK_IN_CMP) {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, plxys);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
2003-12-27 00:38:53 +00:00
|
|
|
|
} else {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.plxys.f;
|
2003-12-27 00:38:53 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
} else /* if (v == 0) */ {
|
|
|
|
|
if (flags & EQ_OK_IN_CMP) {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, plxys);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
2003-12-27 00:38:53 +00:00
|
|
|
|
} else {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.plxys.f;
|
2003-12-27 00:38:53 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
exec_bin_cmp_xy:
|
2002-12-27 16:53:09 +00:00
|
|
|
|
{
|
2008-08-21 13:38:25 +01:00
|
|
|
|
CmpPredicate f = PREG->u.plxys.p->cs.d_code;
|
2002-12-27 16:53:09 +00:00
|
|
|
|
saveregs();
|
|
|
|
|
d0 = (CELL) (f) (d0,d1);
|
2004-03-06 00:31:48 +00:00
|
|
|
|
setregs();
|
2002-12-27 16:53:09 +00:00
|
|
|
|
}
|
2009-03-26 00:37:57 +00:00
|
|
|
|
if (!d0 || PREG == FAILCODE) {
|
2004-03-06 00:31:48 +00:00
|
|
|
|
if (PREG != FAILCODE)
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.plxys.f;
|
2003-12-27 00:38:53 +00:00
|
|
|
|
JMPNext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, plxys);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, call_bfunc_xy_unk, call_bfunc_xy_nvar);
|
2005-11-05 03:02:33 +00:00
|
|
|
|
d1 = Deref(d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
goto exec_bin_cmp_xy;
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d1, pt0, call_bfunc_xy2_unk, call_bfunc_xy2_nvar);
|
|
|
|
|
goto exec_bin_cmp_xy;
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
BOp(call_bfunc_yy, plyys);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
BEGP(pt0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
pt0 = YREG + PREG->u.plyys.y1;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGP(pt1);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
pt1 = YREG + PREG->u.plyys.y2;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
d0 = *pt0;
|
|
|
|
|
d1 = *pt1;
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
deref_head(d0, call_bfunc_yy_unk);
|
|
|
|
|
call_bfunc_yy_nvar:
|
|
|
|
|
deref_head(d1, call_bfunc_yy2_unk);
|
|
|
|
|
call_bfunc_yy2_nvar:
|
|
|
|
|
if (IsIntTerm(d0) && IsIntTerm(d1)) {
|
|
|
|
|
int flags;
|
|
|
|
|
|
|
|
|
|
Int v = IntOfTerm(d0) - IntOfTerm(d1);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
flags = PREG->u.plyys.flags;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
if (v > 0) {
|
|
|
|
|
if (flags & GT_OK_IN_CMP) {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, plyys);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
2003-12-27 00:38:53 +00:00
|
|
|
|
} else {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.plyys.f;
|
2003-12-27 00:38:53 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
} else if (v < 0) {
|
|
|
|
|
if (flags & LT_OK_IN_CMP) {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, plyys);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
2003-12-27 00:38:53 +00:00
|
|
|
|
} else {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.plyys.f;
|
2003-12-27 00:38:53 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
} else /* if (v == 0) */ {
|
|
|
|
|
if (flags & EQ_OK_IN_CMP) {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, plyys);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
2003-12-27 00:38:53 +00:00
|
|
|
|
} else {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.plyys.f;
|
2003-12-27 00:38:53 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
exec_bin_cmp_yy:
|
2002-12-27 16:53:09 +00:00
|
|
|
|
{
|
2008-08-21 13:38:25 +01:00
|
|
|
|
CmpPredicate f = PREG->u.plyys.p->cs.d_code;
|
2002-12-27 16:53:09 +00:00
|
|
|
|
saveregs();
|
|
|
|
|
d0 = (CELL) (f) (d0,d1);
|
2009-03-26 00:37:57 +00:00
|
|
|
|
setregs();
|
2002-12-27 16:53:09 +00:00
|
|
|
|
}
|
2009-03-26 00:37:57 +00:00
|
|
|
|
if (!d0 || PREG == FAILCODE) {
|
2004-03-06 00:31:48 +00:00
|
|
|
|
if (PREG != FAILCODE)
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = PREG->u.plyys.f;
|
2003-12-27 00:38:53 +00:00
|
|
|
|
JMPNext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
2008-08-21 13:38:25 +01:00
|
|
|
|
PREG = NEXTOP(PREG, plyys);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
JMPNext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, call_bfunc_yy_unk, call_bfunc_yy_nvar);
|
2005-11-05 03:02:33 +00:00
|
|
|
|
d1 = Deref(d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
goto exec_bin_cmp_yy;
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d1, pt0, call_bfunc_yy2_unk, call_bfunc_yy2_nvar);
|
|
|
|
|
goto exec_bin_cmp_yy;
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
Op(p_equal, e);
|
|
|
|
|
save_hb();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
if (Yap_IUnify(ARG1, ARG2) == FALSE) {
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
PREG = NEXTOP(PREG, e);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2005-06-01 20:25:23 +00:00
|
|
|
|
Op(p_dif, l);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
2002-11-18 18:18:05 +00:00
|
|
|
|
if (Yap_do_low_level_trace)
|
2008-12-23 01:53:52 +00:00
|
|
|
|
low_level_trace(enter_pred,RepPredProp(Yap_GetPredPropByFunc(FunctorDiff,0)),XREGS+1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif /* LOW_LEVEL_TRACE */
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d0 = ARG1;
|
|
|
|
|
deref_head(d0, dif_unk1);
|
|
|
|
|
dif_nvar1:
|
|
|
|
|
/* first argument is bound */
|
|
|
|
|
d1 = ARG2;
|
|
|
|
|
deref_head(d1, dif_nvar1_unk2);
|
|
|
|
|
dif_nvar1_nvar2:
|
|
|
|
|
/* both arguments are bound */
|
|
|
|
|
if (d0 == d1) {
|
2005-06-01 20:25:23 +00:00
|
|
|
|
PREG = PREG->u.l.l;
|
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
if (IsAtomOrIntTerm(d0) || IsAtomOrIntTerm(d1)) {
|
2005-06-01 20:25:23 +00:00
|
|
|
|
PREG = NEXTOP(PREG, l);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
{
|
2005-12-05 17:16:12 +00:00
|
|
|
|
Int opresult;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifdef COROUTINING
|
|
|
|
|
/*
|
|
|
|
|
* We may wake up goals during our attempt to unify the
|
|
|
|
|
* two terms. If we are adding to the tail of a list of
|
|
|
|
|
* woken goals that should be ok, but otherwise we need
|
2011-05-04 10:11:41 +01:00
|
|
|
|
* to restore LOCAL_WokenGoals to its previous value.
|
2001-04-09 19:54:03 +00:00
|
|
|
|
*/
|
2011-05-04 10:11:41 +01:00
|
|
|
|
CELL OldWokenGoals = Yap_ReadTimedVar(LOCAL_WokenGoals);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
#endif
|
|
|
|
|
/* We will have to look inside compound terms */
|
|
|
|
|
register tr_fr_ptr pt0;
|
|
|
|
|
/* store the old value of TR for clearing bindings */
|
|
|
|
|
pt0 = TR;
|
|
|
|
|
BEGCHO(pt1);
|
|
|
|
|
pt1 = B;
|
|
|
|
|
/* make B and HB point to H to guarantee all bindings will
|
|
|
|
|
* be trailed
|
|
|
|
|
*/
|
|
|
|
|
HBREG = H;
|
|
|
|
|
B = (choiceptr) H;
|
2008-01-23 17:57:56 +00:00
|
|
|
|
B->cp_h = H;
|
2001-04-09 19:54:03 +00:00
|
|
|
|
SET_BB(B);
|
|
|
|
|
save_hb();
|
2005-12-05 17:16:12 +00:00
|
|
|
|
opresult = Yap_IUnify(d0, d1);
|
2005-10-28 17:38:50 +00:00
|
|
|
|
#ifdef COROUTINING
|
2005-12-05 17:16:12 +00:00
|
|
|
|
/* now restore Woken Goals to its old value */
|
2011-05-04 10:11:41 +01:00
|
|
|
|
Yap_UpdateTimedVar(LOCAL_WokenGoals, OldWokenGoals);
|
2005-12-05 17:16:12 +00:00
|
|
|
|
if (OldWokenGoals == TermNil) {
|
|
|
|
|
Yap_undo_signal(YAP_WAKEUP_SIGNAL);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
2005-12-05 17:16:12 +00:00
|
|
|
|
#endif
|
|
|
|
|
/* restore B */
|
2001-04-09 19:54:03 +00:00
|
|
|
|
B = pt1;
|
|
|
|
|
SET_BB(PROTECT_FROZEN_B(pt1));
|
2005-12-05 17:16:12 +00:00
|
|
|
|
#ifdef COROUTINING
|
|
|
|
|
H = HBREG;
|
|
|
|
|
#endif
|
|
|
|
|
HBREG = B->cp_h;
|
2002-11-18 18:18:05 +00:00
|
|
|
|
/* untrail all bindings made by Yap_IUnify */
|
2001-04-09 19:54:03 +00:00
|
|
|
|
while (TR != pt0) {
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d1 = TrailTerm(--TR);
|
2003-08-23 19:26:08 +00:00
|
|
|
|
if (IsVarTerm(d1)) {
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#if defined(YAPOR_SBA) && defined(YAPOR)
|
2003-08-23 19:26:08 +00:00
|
|
|
|
/* clean up the trail when we backtrack */
|
|
|
|
|
if (Unsigned((Int)(d1)-(Int)(H_FZ)) >
|
|
|
|
|
Unsigned((Int)(B_FZ)-(Int)(H_FZ))) {
|
|
|
|
|
RESET_VARIABLE(STACK_TO_SBA(d1));
|
|
|
|
|
} else
|
|
|
|
|
#endif
|
|
|
|
|
/* normal variable */
|
|
|
|
|
RESET_VARIABLE(d1);
|
|
|
|
|
#ifdef MULTI_ASSIGNMENT_VARIABLES
|
|
|
|
|
} else /* if (IsApplTerm(d1)) */ {
|
|
|
|
|
CELL *pt = RepAppl(d1);
|
|
|
|
|
/* AbsAppl means */
|
|
|
|
|
/* multi-assignment variable */
|
|
|
|
|
/* so the next cell is the old value */
|
2005-08-12 17:00:00 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
2003-08-23 19:26:08 +00:00
|
|
|
|
pt[0] = TrailVal(--TR);
|
|
|
|
|
#else
|
|
|
|
|
pt[0] = TrailTerm(--TR);
|
2004-04-14 19:10:40 +00:00
|
|
|
|
TR--;
|
2005-08-12 17:00:00 +00:00
|
|
|
|
#endif /* FROZEN_STACKS */
|
|
|
|
|
#endif /* MULTI_ASSIGNMENT_VARIABLES */
|
2003-08-23 19:26:08 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDD(d1);
|
|
|
|
|
}
|
2005-12-05 17:16:12 +00:00
|
|
|
|
if (opresult) {
|
|
|
|
|
/* restore B, no need to restore HB */
|
|
|
|
|
PREG = PREG->u.l.l;
|
|
|
|
|
GONext();
|
2005-10-28 17:38:50 +00:00
|
|
|
|
}
|
2005-12-05 17:16:12 +00:00
|
|
|
|
/* restore B, and later HB */
|
|
|
|
|
PREG = NEXTOP(PREG, l);
|
|
|
|
|
ENDCHO(pt1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, dif_unk1, dif_nvar1);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
/* first argument is unbound */
|
2005-06-01 20:25:23 +00:00
|
|
|
|
PREG = PREG->u.l.l;
|
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d1, pt0, dif_nvar1_unk2, dif_nvar1_nvar2);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
/* second argument is unbound */
|
2005-06-01 20:25:23 +00:00
|
|
|
|
PREG = PREG->u.l.l;
|
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2005-06-01 20:25:23 +00:00
|
|
|
|
Op(p_eq, l);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
2002-11-18 18:18:05 +00:00
|
|
|
|
if (Yap_do_low_level_trace)
|
2008-12-23 01:53:52 +00:00
|
|
|
|
low_level_trace(enter_pred,RepPredProp(Yap_GetPredPropByFunc(FunctorSame,0)),XREGS+1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif /* LOW_LEVEL_TRACE */
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d0 = ARG1;
|
|
|
|
|
deref_head(d0, p_eq_unk1);
|
|
|
|
|
p_eq_nvar1:
|
|
|
|
|
/* first argument is bound */
|
|
|
|
|
d1 = ARG2;
|
|
|
|
|
deref_head(d1, p_eq_nvar1_unk2);
|
|
|
|
|
p_eq_nvar1_nvar2:
|
|
|
|
|
/* both arguments are bound */
|
|
|
|
|
if (d0 == d1) {
|
2005-06-01 20:25:23 +00:00
|
|
|
|
PREG = NEXTOP(PREG, l);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
if (IsPairTerm(d0)) {
|
|
|
|
|
if (!IsPairTerm(d1)) {
|
2005-06-01 20:25:23 +00:00
|
|
|
|
PREG = PREG->u.l.l;
|
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
BEGD(d2);
|
|
|
|
|
always_save_pc();
|
|
|
|
|
d2 = iequ_complex(RepPair(d0)-1, RepPair(d0)+1,RepPair(d1)-1);
|
|
|
|
|
if (d2 == FALSE) {
|
2005-06-01 20:25:23 +00:00
|
|
|
|
PREG = PREG->u.l.l;
|
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
ENDD(d2);
|
|
|
|
|
always_set_pc();
|
2005-06-01 20:25:23 +00:00
|
|
|
|
PREG = NEXTOP(PREG, l);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
if (IsApplTerm(d0)) {
|
|
|
|
|
Functor f0 = FunctorOfTerm(d0);
|
|
|
|
|
Functor f1;
|
|
|
|
|
|
|
|
|
|
/* f1 must be a compound term, even if it is a suspension */
|
|
|
|
|
if (!IsApplTerm(d1)) {
|
2005-06-01 20:25:23 +00:00
|
|
|
|
PREG = PREG->u.l.l;
|
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
f1 = FunctorOfTerm(d1);
|
|
|
|
|
|
|
|
|
|
/* we now know f1 is true */
|
|
|
|
|
/* deref if a compound term */
|
|
|
|
|
if (IsExtensionFunctor(f0)) {
|
|
|
|
|
switch ((CELL)f0) {
|
|
|
|
|
case (CELL)FunctorDBRef:
|
2005-06-01 20:25:23 +00:00
|
|
|
|
if (d0 == d1) {
|
|
|
|
|
PREG = NEXTOP(PREG, l);
|
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
PREG = PREG->u.l.l;
|
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
case (CELL)FunctorLongInt:
|
2005-06-01 20:25:23 +00:00
|
|
|
|
if (f1 != FunctorLongInt) {
|
|
|
|
|
PREG = PREG->u.l.l;
|
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
if (LongIntOfTerm(d0) == LongIntOfTerm(d1)) {
|
|
|
|
|
PREG = NEXTOP(PREG, l);
|
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
PREG = PREG->u.l.l;
|
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifdef USE_GMP
|
|
|
|
|
case (CELL)FunctorBigInt:
|
2005-06-01 20:25:23 +00:00
|
|
|
|
if (f1 != FunctorBigInt) {
|
|
|
|
|
PREG = PREG->u.l.l;
|
|
|
|
|
GONext();
|
|
|
|
|
}
|
2010-05-28 12:07:01 +01:00
|
|
|
|
if (Yap_gmp_tcmp_big_big(d0,d1) == 0) {
|
2005-06-01 20:25:23 +00:00
|
|
|
|
PREG = NEXTOP(PREG, l);
|
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
PREG = PREG->u.l.l;
|
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif
|
|
|
|
|
case (CELL)FunctorDouble:
|
2005-06-01 20:25:23 +00:00
|
|
|
|
if (f1 != FunctorDouble) {
|
|
|
|
|
PREG = PREG->u.l.l;
|
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
if (FloatOfTerm(d0) == FloatOfTerm(d1)) {
|
|
|
|
|
PREG = NEXTOP(PREG, l);
|
|
|
|
|
GONext();
|
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
default:
|
2005-06-01 20:25:23 +00:00
|
|
|
|
PREG = PREG->u.l.l;
|
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
if (f0 != f1) {
|
2005-06-01 20:25:23 +00:00
|
|
|
|
PREG = PREG->u.l.l;
|
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
always_save_pc();
|
|
|
|
|
BEGD(d2);
|
|
|
|
|
d2 = iequ_complex(RepAppl(d0), RepAppl(d0)+ArityOfFunctor(f0), RepAppl(d1));
|
|
|
|
|
if (d2 == FALSE) {
|
2005-06-01 20:25:23 +00:00
|
|
|
|
PREG = PREG->u.l.l;
|
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
ENDD(d2);
|
|
|
|
|
always_set_pc();
|
2007-05-01 21:18:19 +00:00
|
|
|
|
PREG = NEXTOP(PREG, l);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
2005-07-06 15:10:18 +00:00
|
|
|
|
PREG = PREG->u.l.l;
|
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d1, pt0, p_eq_nvar1_unk2, p_eq_nvar1_nvar2);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
/* first argument is bound */
|
|
|
|
|
/* second argument is unbound */
|
|
|
|
|
/* I don't need to worry about co-routining because an
|
|
|
|
|
unbound variable may never be == to a constrained variable!! */
|
2005-06-01 20:25:23 +00:00
|
|
|
|
PREG = PREG->u.l.l;
|
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDD(d1);
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, p_eq_unk1, p_eq_nvar1);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d1 = ARG2;
|
|
|
|
|
deref_head(d1, p_eq_var1_unk2);
|
|
|
|
|
p_eq_var1_nvar2:
|
|
|
|
|
/* I don't need to worry about co-routining because an
|
|
|
|
|
unbound variable may never be == to a constrained variable!! */
|
2005-06-01 20:25:23 +00:00
|
|
|
|
PREG = PREG->u.l.l;
|
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
deref_body(d1, pt1, p_eq_var1_unk2, p_eq_var1_nvar2);
|
|
|
|
|
/* first argument is unbound */
|
|
|
|
|
/* second argument is unbound */
|
|
|
|
|
if (pt1 != pt0) {
|
2005-06-01 20:25:23 +00:00
|
|
|
|
PREG = PREG->u.l.l;
|
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
2005-06-01 20:25:23 +00:00
|
|
|
|
PREG = NEXTOP(PREG, l);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2001-04-20 15:48:04 +00:00
|
|
|
|
Op(p_arg_vv, xxx);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
2002-11-18 18:18:05 +00:00
|
|
|
|
if (Yap_do_low_level_trace) {
|
2001-04-20 15:48:04 +00:00
|
|
|
|
H[0] = XREG(PREG->u.xxx.x1);
|
|
|
|
|
H[1] = XREG(PREG->u.xxx.x2);
|
|
|
|
|
RESET_VARIABLE(H+2);
|
2008-12-23 01:53:52 +00:00
|
|
|
|
low_level_trace(enter_pred,RepPredProp(Yap_GetPredPropByFunc(FunctorArg,0)),H);
|
2001-04-20 15:48:04 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif /* LOW_LEVEL_TRACE */
|
|
|
|
|
BEGD(d0);
|
2001-04-20 15:48:04 +00:00
|
|
|
|
d0 = XREG(PREG->u.xxx.x1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
deref_head(d0, arg_arg1_unk);
|
|
|
|
|
arg_arg1_nvar:
|
|
|
|
|
/* ARG1 is ok! */
|
|
|
|
|
if (IsIntTerm(d0))
|
|
|
|
|
d0 = IntOfTerm(d0);
|
|
|
|
|
else if (IsLongIntTerm(d0)) {
|
|
|
|
|
d0 = LongIntOfTerm(d0);
|
|
|
|
|
} else {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(TYPE_ERROR_INTEGER,d0,"arg 1 of arg/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* d0 now got the argument we want */
|
|
|
|
|
BEGD(d1);
|
2001-04-20 15:48:04 +00:00
|
|
|
|
d1 = XREG(PREG->u.xxx.x2);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
deref_head(d1, arg_arg2_unk);
|
|
|
|
|
arg_arg2_nvar:
|
|
|
|
|
/* d1 now got the structure we want to fetch the argument
|
|
|
|
|
* from */
|
|
|
|
|
if (IsApplTerm(d1)) {
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = RepAppl(d1);
|
|
|
|
|
d1 = *pt0;
|
|
|
|
|
if (IsExtensionFunctor((Functor) d1)) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
if ((Int)d0 <= 0 ||
|
2002-02-04 16:12:54 +00:00
|
|
|
|
(Int)d0 > ArityOfFunctor((Functor) d1)) {
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* don't complain here for Prolog compatibility
|
|
|
|
|
if ((Int)d0 <= 0) {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,
|
2001-04-09 19:54:03 +00:00
|
|
|
|
MkIntegerTerm(d0),"arg 1 of arg/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
*/
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
2001-04-20 15:48:04 +00:00
|
|
|
|
XREG(PREG->u.xxx.x) = pt0[d0];
|
|
|
|
|
PREG = NEXTOP(PREG, xxx);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
}
|
|
|
|
|
else if (IsPairTerm(d1)) {
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = RepPair(d1);
|
2001-04-20 15:48:04 +00:00
|
|
|
|
if (d0 != 1 && d0 != 2) {
|
|
|
|
|
if ((Int)d0 < 0) {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,
|
2001-04-20 15:48:04 +00:00
|
|
|
|
MkIntegerTerm(d0),"arg 1 of arg/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
2001-04-20 15:48:04 +00:00
|
|
|
|
FAIL();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
2001-04-20 15:48:04 +00:00
|
|
|
|
XREG(PREG->u.xxx.x) = pt0[d0-1];
|
|
|
|
|
PREG = NEXTOP(PREG, xxx);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
}
|
|
|
|
|
else {
|
2010-07-19 14:38:17 +01:00
|
|
|
|
/*
|
|
|
|
|
don't complain here for SWI Prolog compatibility
|
|
|
|
|
saveregs();
|
|
|
|
|
Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3");
|
|
|
|
|
setregs();
|
|
|
|
|
*/
|
2001-04-20 15:48:04 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d1, pt0, arg_arg2_unk, arg_arg2_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(INSTANTIATION_ERROR, d1,"arg 2 of arg/3");;
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-20 15:48:04 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
FAIL();
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, arg_arg1_unk, arg_arg1_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(INSTANTIATION_ERROR, d0, "arg 1 of arg/3");;
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-20 15:48:04 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
FAIL();
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-29 17:27:11 +01:00
|
|
|
|
Op(p_arg_cv, xxn);
|
2001-04-20 15:48:04 +00:00
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
2002-11-18 18:18:05 +00:00
|
|
|
|
if (Yap_do_low_level_trace) {
|
2001-04-20 15:48:04 +00:00
|
|
|
|
CELL *Ho = H;
|
2008-08-29 17:27:11 +01:00
|
|
|
|
Term t = MkIntegerTerm(PREG->u.xxn.c);
|
2001-04-20 15:48:04 +00:00
|
|
|
|
H[0] = t;
|
2008-08-29 17:27:11 +01:00
|
|
|
|
H[1] = XREG(PREG->u.xxn.xi);
|
2001-04-20 15:48:04 +00:00
|
|
|
|
RESET_VARIABLE(H+2);
|
2008-12-23 01:53:52 +00:00
|
|
|
|
low_level_trace(enter_pred,RepPredProp(Yap_GetPredPropByFunc(FunctorArg,0)),H);
|
2001-04-20 15:48:04 +00:00
|
|
|
|
H = Ho;
|
|
|
|
|
}
|
|
|
|
|
#endif /* LOW_LEVEL_TRACE */
|
|
|
|
|
BEGD(d0);
|
2008-08-29 17:27:11 +01:00
|
|
|
|
d0 = PREG->u.xxn.c;
|
2001-04-20 15:48:04 +00:00
|
|
|
|
/* d0 now got the argument we want */
|
|
|
|
|
BEGD(d1);
|
2008-08-29 17:27:11 +01:00
|
|
|
|
d1 = XREG(PREG->u.xxn.xi);
|
2001-04-20 15:48:04 +00:00
|
|
|
|
deref_head(d1, arg_arg2_vc_unk);
|
|
|
|
|
arg_arg2_vc_nvar:
|
|
|
|
|
/* d1 now got the structure we want to fetch the argument
|
|
|
|
|
* from */
|
|
|
|
|
if (IsApplTerm(d1)) {
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = RepAppl(d1);
|
|
|
|
|
d1 = *pt0;
|
|
|
|
|
if (IsExtensionFunctor((Functor) d1)) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
if ((Int)d0 <= 0 ||
|
2002-02-04 16:12:54 +00:00
|
|
|
|
(Int)d0 > ArityOfFunctor((Functor) d1)) {
|
2001-04-20 15:48:04 +00:00
|
|
|
|
/* don't complain here for Prolog compatibility
|
|
|
|
|
if ((Int)d0 <= 0) {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,
|
2001-04-20 15:48:04 +00:00
|
|
|
|
MkIntegerTerm(d0),"arg 1 of arg/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
2001-04-20 15:48:04 +00:00
|
|
|
|
*/
|
|
|
|
|
FAIL();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
2008-08-29 17:27:11 +01:00
|
|
|
|
XREG(PREG->u.xxn.x) = pt0[d0];
|
|
|
|
|
PREG = NEXTOP(PREG, xxn);
|
2001-04-20 15:48:04 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
}
|
|
|
|
|
else if (IsPairTerm(d1)) {
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = RepPair(d1);
|
|
|
|
|
if (d0 != 1 && d0 != 2) {
|
|
|
|
|
if ((Int)d0 < 0) {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,
|
2001-04-20 15:48:04 +00:00
|
|
|
|
MkIntegerTerm(d0),"arg 1 of arg/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-20 15:48:04 +00:00
|
|
|
|
}
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
2008-08-29 17:27:11 +01:00
|
|
|
|
XREG(PREG->u.xxn.x) = pt0[d0-1];
|
|
|
|
|
PREG = NEXTOP(PREG, xxn);
|
2001-04-20 15:48:04 +00:00
|
|
|
|
GONext();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
}
|
|
|
|
|
else {
|
2010-07-19 14:38:17 +01:00
|
|
|
|
/*
|
|
|
|
|
keep SWI Prolog compatibility, just fail on trying to obtain an argument of a compound term.
|
|
|
|
|
saveregs();
|
|
|
|
|
Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3");
|
|
|
|
|
setregs();
|
|
|
|
|
*/
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
2001-04-20 15:48:04 +00:00
|
|
|
|
deref_body(d1, pt0, arg_arg2_vc_unk, arg_arg2_vc_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(INSTANTIATION_ERROR, d1,"arg 2 of arg/3");;
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
FAIL();
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
|
2001-04-20 15:48:04 +00:00
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(p_arg_y_vv, yxx);
|
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
2002-11-18 18:18:05 +00:00
|
|
|
|
if (Yap_do_low_level_trace) {
|
2001-04-20 15:48:04 +00:00
|
|
|
|
H[0] = XREG(PREG->u.yxx.x1);
|
|
|
|
|
H[1] = XREG(PREG->u.yxx.x2);
|
2009-11-10 11:25:39 +00:00
|
|
|
|
H[2] = YREG[PREG->u.yxx.y];
|
2001-04-20 15:48:04 +00:00
|
|
|
|
RESET_VARIABLE(H+2);
|
2008-12-23 01:53:52 +00:00
|
|
|
|
low_level_trace(enter_pred,RepPredProp(Yap_GetPredPropByFunc(FunctorArg,0)),H);
|
2001-04-20 15:48:04 +00:00
|
|
|
|
}
|
|
|
|
|
#endif /* LOW_LEVEL_TRACE */
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = XREG(PREG->u.yxx.x1);
|
|
|
|
|
deref_head(d0, arg_y_arg1_unk);
|
|
|
|
|
arg_y_arg1_nvar:
|
|
|
|
|
/* ARG1 is ok! */
|
|
|
|
|
if (IsIntTerm(d0))
|
|
|
|
|
d0 = IntOfTerm(d0);
|
|
|
|
|
else if (IsLongIntTerm(d0)) {
|
|
|
|
|
d0 = LongIntOfTerm(d0);
|
|
|
|
|
} else {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(TYPE_ERROR_INTEGER,d0,"arg 1 of arg/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-20 15:48:04 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* d0 now got the argument we want */
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d1 = XREG(PREG->u.yxx.x2);
|
|
|
|
|
deref_head(d1, arg_y_arg2_unk);
|
|
|
|
|
arg_y_arg2_nvar:
|
|
|
|
|
/* d1 now got the structure we want to fetch the argument
|
|
|
|
|
* from */
|
|
|
|
|
if (IsApplTerm(d1)) {
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = RepAppl(d1);
|
|
|
|
|
d1 = *pt0;
|
|
|
|
|
if (IsExtensionFunctor((Functor) d1)) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
if ((Int)d0 <= 0 ||
|
2002-02-04 16:12:54 +00:00
|
|
|
|
(Int)d0 > ArityOfFunctor((Functor) d1)) {
|
2001-04-20 15:48:04 +00:00
|
|
|
|
/* don't complain here for Prolog compatibility
|
|
|
|
|
if ((Int)d0 <= 0) {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,
|
2001-04-20 15:48:04 +00:00
|
|
|
|
MkIntegerTerm(d0),"arg 1 of arg/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2001-04-20 15:48:04 +00:00
|
|
|
|
}
|
|
|
|
|
*/
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
BEGP(pt1);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
pt1 = YREG + PREG->u.yxx.y;
|
2001-04-20 15:48:04 +00:00
|
|
|
|
PREG = NEXTOP(PREG, yxx);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt1,pt0[d0]);
|
2001-04-20 15:48:04 +00:00
|
|
|
|
ENDP(pt1);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
}
|
|
|
|
|
else if (IsPairTerm(d1)) {
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = RepPair(d1);
|
|
|
|
|
if (d0 != 1 && d0 != 2) {
|
|
|
|
|
if ((Int)d0 < 0) {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,
|
2001-04-20 15:48:04 +00:00
|
|
|
|
MkIntegerTerm(d0),"arg 1 of arg/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-20 15:48:04 +00:00
|
|
|
|
}
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
BEGP(pt1);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
pt1 = YREG + PREG->u.yxx.y;
|
2001-04-20 15:48:04 +00:00
|
|
|
|
PREG = NEXTOP(PREG, yxx);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt1,pt0[d0-1]);
|
2001-04-20 15:48:04 +00:00
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
}
|
|
|
|
|
else {
|
2010-07-19 14:38:17 +01:00
|
|
|
|
/*
|
|
|
|
|
don't complain here for SWI Prolog compatibility
|
|
|
|
|
saveregs();
|
|
|
|
|
Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3");
|
|
|
|
|
setregs();
|
|
|
|
|
*/
|
2001-04-20 15:48:04 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
BEGP(pt0);
|
2001-04-20 15:48:04 +00:00
|
|
|
|
deref_body(d1, pt0, arg_y_arg2_unk, arg_y_arg2_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(INSTANTIATION_ERROR, d1,"arg 2 of arg/3");;
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-20 15:48:04 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
FAIL();
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, arg_y_arg1_unk, arg_y_arg1_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(INSTANTIATION_ERROR, d0, "arg 1 of arg/3");;
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
FAIL();
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-30 23:00:50 +01:00
|
|
|
|
Op(p_arg_y_cv, yxn);
|
2001-04-20 15:48:04 +00:00
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
2002-11-18 18:18:05 +00:00
|
|
|
|
if (Yap_do_low_level_trace) {
|
2001-04-20 15:48:04 +00:00
|
|
|
|
CELL *Ho = H;
|
2008-08-30 23:00:50 +01:00
|
|
|
|
Term t = MkIntegerTerm(PREG->u.yxn.c);
|
2001-04-20 15:48:04 +00:00
|
|
|
|
H[0] = t;
|
2008-08-30 23:00:50 +01:00
|
|
|
|
H[1] = XREG(PREG->u.yxn.xi);
|
2009-11-10 11:25:39 +00:00
|
|
|
|
H[2] = YREG[PREG->u.yxn.y];
|
2001-04-20 15:48:04 +00:00
|
|
|
|
RESET_VARIABLE(H+2);
|
2008-12-23 01:53:52 +00:00
|
|
|
|
low_level_trace(enter_pred,RepPredProp(Yap_GetPredPropByFunc(FunctorArg,0)),H);
|
2001-04-20 15:48:04 +00:00
|
|
|
|
H = Ho;
|
|
|
|
|
}
|
|
|
|
|
#endif /* LOW_LEVEL_TRACE */
|
|
|
|
|
BEGD(d0);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
d0 = PREG->u.yxn.c;
|
2001-04-20 15:48:04 +00:00
|
|
|
|
/* d0 now got the argument we want */
|
|
|
|
|
BEGD(d1);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
d1 = XREG(PREG->u.yxn.xi);
|
2001-04-20 15:48:04 +00:00
|
|
|
|
deref_head(d1, arg_y_arg2_vc_unk);
|
|
|
|
|
arg_y_arg2_vc_nvar:
|
|
|
|
|
/* d1 now got the structure we want to fetch the argument
|
|
|
|
|
* from */
|
|
|
|
|
if (IsApplTerm(d1)) {
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = RepAppl(d1);
|
|
|
|
|
d1 = *pt0;
|
|
|
|
|
if (IsExtensionFunctor((Functor) d1)) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
if ((Int)d0 <= 0 ||
|
2002-02-04 16:12:54 +00:00
|
|
|
|
(Int)d0 > ArityOfFunctor((Functor) d1)) {
|
2001-04-20 15:48:04 +00:00
|
|
|
|
/* don't complain here for Prolog compatibility
|
|
|
|
|
if ((Int)d0 <= 0) {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,
|
2001-04-20 15:48:04 +00:00
|
|
|
|
MkIntegerTerm(d0),"arg 1 of arg/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-20 15:48:04 +00:00
|
|
|
|
}
|
|
|
|
|
*/
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
BEGP(pt1);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
pt1 = YREG + PREG->u.yxn.y;
|
|
|
|
|
PREG = NEXTOP(PREG, yxn);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt1,pt0[d0]);
|
2001-04-20 15:48:04 +00:00
|
|
|
|
ENDP(pt1);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
}
|
|
|
|
|
else if (IsPairTerm(d1)) {
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
pt0 = RepPair(d1);
|
|
|
|
|
if (d0 != 1 && d0 != 2) {
|
|
|
|
|
if ((Int)d0 < 0) {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,
|
2001-04-20 15:48:04 +00:00
|
|
|
|
MkIntegerTerm(d0),"arg 1 of arg/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-20 15:48:04 +00:00
|
|
|
|
}
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
BEGP(pt1);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
pt1 = YREG + PREG->u.yxn.y;
|
|
|
|
|
PREG = NEXTOP(PREG, yxn);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt1,pt0[d0-1]);
|
2001-04-20 15:48:04 +00:00
|
|
|
|
ENDP(pt1);
|
|
|
|
|
GONext();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
}
|
|
|
|
|
else {
|
2010-07-19 14:38:17 +01:00
|
|
|
|
/*
|
|
|
|
|
don't complain here for SWI Prolog compatibility
|
|
|
|
|
saveregs();
|
|
|
|
|
Yap_Error(TYPE_ERROR_COMPOUND, d1, "arg 2 of arg/3");
|
|
|
|
|
setregs();
|
|
|
|
|
*/
|
2001-04-20 15:48:04 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d1, pt0, arg_y_arg2_vc_unk, arg_y_arg2_vc_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(INSTANTIATION_ERROR, d1,"arg 2 of arg/3");;
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-20 15:48:04 +00:00
|
|
|
|
ENDP(pt0);
|
|
|
|
|
FAIL();
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2001-04-23 20:41:58 +00:00
|
|
|
|
Op(p_func2s_vv, xxx);
|
|
|
|
|
/* A1 is a variable */
|
|
|
|
|
restart_func2s:
|
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
2002-11-18 18:18:05 +00:00
|
|
|
|
if (Yap_do_low_level_trace) {
|
2001-04-23 20:41:58 +00:00
|
|
|
|
RESET_VARIABLE(H);
|
|
|
|
|
H[1] = XREG(PREG->u.xxx.x1);
|
|
|
|
|
H[2] = XREG(PREG->u.xxx.x2);
|
2008-12-23 01:53:52 +00:00
|
|
|
|
low_level_trace(enter_pred,RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor,0)),H);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
}
|
|
|
|
|
#endif /* LOW_LEVEL_TRACE */
|
|
|
|
|
/* We have to build the structure */
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = XREG(PREG->u.xxx.x1);
|
|
|
|
|
deref_head(d0, func2s_unk);
|
|
|
|
|
func2s_nvar:
|
|
|
|
|
/* we do, let's get the third argument */
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d1 = XREG(PREG->u.xxx.x2);
|
|
|
|
|
deref_head(d1, func2s_unk2);
|
|
|
|
|
func2s_nvar2:
|
|
|
|
|
/* Uuuff, the second and third argument are bound */
|
|
|
|
|
if (IsIntegerTerm(d1))
|
|
|
|
|
d1 = IntegerOfTerm(d1);
|
|
|
|
|
else {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2009-05-29 22:34:50 -05:00
|
|
|
|
if (IsBigIntTerm(d1)) {
|
|
|
|
|
Yap_Error(RESOURCE_ERROR_STACK, d1, "functor/3");
|
|
|
|
|
} else {
|
|
|
|
|
Yap_Error(TYPE_ERROR_INTEGER, d1, "functor/3");
|
|
|
|
|
}
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-23 20:41:58 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
if (!IsAtomicTerm(d0)) {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(TYPE_ERROR_ATOM,d0,"functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-23 20:41:58 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
/* We made it!!!!! we got in d0 the name, in d1 the arity and
|
|
|
|
|
* in pt0 the variable to bind it to. */
|
|
|
|
|
if (d0 == TermDot && d1 == 2) {
|
|
|
|
|
RESET_VARIABLE(H);
|
|
|
|
|
RESET_VARIABLE(H+1);
|
|
|
|
|
d0 = AbsPair(H);
|
|
|
|
|
H += 2;
|
|
|
|
|
/* else if arity is 0 just pass d0 through */
|
|
|
|
|
/* Ding, ding, we made it */
|
|
|
|
|
XREG(PREG->u.xxx.x) = d0;
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxx),Osbpp),l);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
else if ((Int)d1 > 0) {
|
|
|
|
|
/* now let's build a compound term */
|
|
|
|
|
if (!IsAtomTerm(d0)) {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(TYPE_ERROR_ATOM,d0,"functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-23 20:41:58 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
if (!IsAtomTerm(d0)) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
else
|
2002-11-18 18:18:05 +00:00
|
|
|
|
d0 = (CELL) Yap_MkFunctor(AtomOfTerm(d0), (Int) d1);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
pt1 = H;
|
|
|
|
|
*pt1++ = d0;
|
|
|
|
|
d0 = AbsAppl(H);
|
|
|
|
|
if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
|
|
|
|
|
/* make sure we have something to show for our trouble */
|
|
|
|
|
saveregs();
|
2008-09-05 05:22:19 +01:00
|
|
|
|
if (!Yap_gcl((1+d1)*sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG,xxx),Osbpp))) {
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(OUT_OF_STACK_ERROR,LOCAL_ErrorMessage);
|
2002-10-10 05:58:49 +00:00
|
|
|
|
setregs();
|
|
|
|
|
JMPNext();
|
|
|
|
|
} else {
|
|
|
|
|
setregs();
|
|
|
|
|
}
|
2001-04-23 20:41:58 +00:00
|
|
|
|
goto restart_func2s;
|
|
|
|
|
}
|
|
|
|
|
while ((Int)d1--) {
|
|
|
|
|
RESET_VARIABLE(pt1);
|
|
|
|
|
pt1++;
|
|
|
|
|
}
|
|
|
|
|
H = pt1;
|
|
|
|
|
/* done building the term */
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
/* else if arity is 0 just pass d0 through */
|
|
|
|
|
/* Ding, ding, we made it */
|
|
|
|
|
XREG(PREG->u.xxx.x) = d0;
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxx),Osbpp),l);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
GONext();
|
|
|
|
|
} else if ((Int)d1 == 0) {
|
|
|
|
|
XREG(PREG->u.xxx.x) = d0;
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxx),Osbpp),l);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
GONext();
|
|
|
|
|
} else {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,MkIntegerTerm(d1),"functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-23 20:41:58 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
deref_body(d1, pt1, func2s_unk2, func2s_nvar2);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(INSTANTIATION_ERROR, d1, "functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-23 20:41:58 +00:00
|
|
|
|
ENDP(pt1);
|
|
|
|
|
/* Oops, third argument was unbound */
|
|
|
|
|
FAIL();
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
deref_body(d0, pt1, func2s_unk, func2s_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(INSTANTIATION_ERROR, d0, "functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-23 20:41:58 +00:00
|
|
|
|
ENDP(pt1);
|
|
|
|
|
/* Oops, second argument was unbound too */
|
|
|
|
|
FAIL();
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2009-12-06 00:37:48 +00:00
|
|
|
|
Op(p_func2s_cv, xxc);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
/* A1 is a variable */
|
|
|
|
|
restart_func2s_cv:
|
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
2002-11-18 18:18:05 +00:00
|
|
|
|
if (Yap_do_low_level_trace) {
|
2001-04-23 20:41:58 +00:00
|
|
|
|
RESET_VARIABLE(H);
|
2009-12-06 00:37:48 +00:00
|
|
|
|
H[1] = PREG->u.xxc.c;
|
|
|
|
|
H[2] = XREG(PREG->u.xxc.xi);
|
2008-12-23 01:53:52 +00:00
|
|
|
|
low_level_trace(enter_pred,RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor,0)),H);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
}
|
|
|
|
|
#endif /* LOW_LEVEL_TRACE */
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
/* We have to build the structure */
|
2009-12-06 00:37:48 +00:00
|
|
|
|
d0 = PREG->u.xxc.c;
|
2001-04-23 20:41:58 +00:00
|
|
|
|
/* we do, let's get the third argument */
|
|
|
|
|
BEGD(d1);
|
2009-12-06 00:37:48 +00:00
|
|
|
|
d1 = XREG(PREG->u.xxc.xi);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
deref_head(d1, func2s_unk2_cv);
|
|
|
|
|
func2s_nvar2_cv:
|
|
|
|
|
/* Uuuff, the second and third argument are bound */
|
|
|
|
|
if (IsIntegerTerm(d1))
|
|
|
|
|
d1 = IntegerOfTerm(d1);
|
|
|
|
|
else {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2009-05-29 22:34:50 -05:00
|
|
|
|
if (IsBigIntTerm(d1)) {
|
|
|
|
|
Yap_Error(RESOURCE_ERROR_STACK, d1, "functor/3");
|
|
|
|
|
} else {
|
|
|
|
|
Yap_Error(TYPE_ERROR_INTEGER,d1,"functor/3");
|
|
|
|
|
}
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-23 20:41:58 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
/* We made it!!!!! we got in d0 the name, in d1 the arity and
|
|
|
|
|
* in pt0 the variable to bind it to. */
|
|
|
|
|
if (d0 == TermDot && d1 == 2) {
|
|
|
|
|
RESET_VARIABLE(H);
|
|
|
|
|
RESET_VARIABLE(H+1);
|
|
|
|
|
d0 = AbsPair(H);
|
|
|
|
|
H += 2;
|
|
|
|
|
/* else if arity is 0 just pass d0 through */
|
|
|
|
|
/* Ding, ding, we made it */
|
2009-12-06 00:37:48 +00:00
|
|
|
|
XREG(PREG->u.xxc.x) = d0;
|
|
|
|
|
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxc),Osbpp),l);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
GONext();
|
|
|
|
|
} else if ((Int)d1 > 0) {
|
|
|
|
|
/* now let's build a compound term */
|
|
|
|
|
if (!IsAtomTerm(d0)) {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(TYPE_ERROR_ATOM,d0,"functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-23 20:41:58 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
if (!IsAtomTerm(d0)) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
else
|
2002-11-18 18:18:05 +00:00
|
|
|
|
d0 = (CELL) Yap_MkFunctor(AtomOfTerm(d0), (Int) d1);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
pt1 = H;
|
|
|
|
|
*pt1++ = d0;
|
|
|
|
|
d0 = AbsAppl(H);
|
|
|
|
|
if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
|
|
|
|
|
/* make sure we have something to show for our trouble */
|
|
|
|
|
saveregs();
|
2009-12-06 00:37:48 +00:00
|
|
|
|
if (!Yap_gcl((1+d1)*sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG,xxc),Osbpp))) {
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(OUT_OF_STACK_ERROR,LOCAL_ErrorMessage);
|
2002-10-10 05:58:49 +00:00
|
|
|
|
setregs();
|
|
|
|
|
JMPNext();
|
|
|
|
|
} else {
|
|
|
|
|
setregs();
|
|
|
|
|
}
|
2001-04-23 20:41:58 +00:00
|
|
|
|
goto restart_func2s_cv;
|
|
|
|
|
}
|
|
|
|
|
while ((Int)d1--) {
|
|
|
|
|
RESET_VARIABLE(pt1);
|
|
|
|
|
pt1++;
|
|
|
|
|
}
|
|
|
|
|
/* done building the term */
|
|
|
|
|
H = pt1;
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
/* else if arity is 0 just pass d0 through */
|
|
|
|
|
/* Ding, ding, we made it */
|
2009-12-06 00:37:48 +00:00
|
|
|
|
XREG(PREG->u.xxc.x) = d0;
|
|
|
|
|
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxc),Osbpp),l);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
GONext();
|
|
|
|
|
} else if (d1 == 0) {
|
2009-12-06 00:37:48 +00:00
|
|
|
|
XREG(PREG->u.xxc.x) = d0;
|
|
|
|
|
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxc),Osbpp),l);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
GONext();
|
|
|
|
|
} else {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,MkIntegerTerm(d1),"functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-23 20:41:58 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
deref_body(d1, pt1, func2s_unk2_cv, func2s_nvar2_cv);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(INSTANTIATION_ERROR, d1, "functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-23 20:41:58 +00:00
|
|
|
|
ENDP(pt1);
|
|
|
|
|
/* Oops, third argument was unbound */
|
|
|
|
|
FAIL();
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-29 17:27:11 +01:00
|
|
|
|
Op(p_func2s_vc, xxn);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
/* A1 is a variable */
|
|
|
|
|
restart_func2s_vc:
|
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
2002-11-18 18:18:05 +00:00
|
|
|
|
if (Yap_do_low_level_trace) {
|
2001-04-23 20:41:58 +00:00
|
|
|
|
Term ti;
|
|
|
|
|
CELL *hi = H;
|
|
|
|
|
|
2009-12-06 00:37:48 +00:00
|
|
|
|
ti = MkIntegerTerm(PREG->u.xxn.c);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
RESET_VARIABLE(H);
|
2008-08-29 17:27:11 +01:00
|
|
|
|
H[1] = XREG(PREG->u.xxn.xi);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
H[2] = ti;
|
2008-12-23 01:53:52 +00:00
|
|
|
|
low_level_trace(enter_pred,RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor,0)),H);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
H = hi;
|
|
|
|
|
}
|
|
|
|
|
#endif /* LOW_LEVEL_TRACE */
|
|
|
|
|
/* We have to build the structure */
|
|
|
|
|
BEGD(d0);
|
2008-08-29 17:27:11 +01:00
|
|
|
|
d0 = XREG(PREG->u.xxn.xi);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
deref_head(d0, func2s_unk_vc);
|
|
|
|
|
func2s_nvar_vc:
|
|
|
|
|
BEGD(d1);
|
2008-08-29 17:27:11 +01:00
|
|
|
|
d1 = PREG->u.xxn.c;
|
2001-04-23 20:41:58 +00:00
|
|
|
|
if (!IsAtomicTerm(d0)) {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(TYPE_ERROR_ATOM,d0,"functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-23 20:41:58 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
/* We made it!!!!! we got in d0 the name, in d1 the arity and
|
|
|
|
|
* in pt0 the variable to bind it to. */
|
|
|
|
|
if (d0 == TermDot && d1 == 2) {
|
|
|
|
|
RESET_VARIABLE(H);
|
|
|
|
|
RESET_VARIABLE(H+1);
|
|
|
|
|
d0 = AbsPair(H);
|
|
|
|
|
H += 2;
|
|
|
|
|
/* else if arity is 0 just pass d0 through */
|
|
|
|
|
/* Ding, ding, we made it */
|
2008-08-29 17:27:11 +01:00
|
|
|
|
XREG(PREG->u.xxn.x) = d0;
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxn),Osbpp),l);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
/* now let's build a compound term */
|
|
|
|
|
if (d1 == 0) {
|
2008-08-29 17:27:11 +01:00
|
|
|
|
XREG(PREG->u.xxn.x) = d0;
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxn),Osbpp),l);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
if (!IsAtomTerm(d0)) {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(TYPE_ERROR_ATOM,d0,"functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-23 20:41:58 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
if (!IsAtomTerm(d0)) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
else
|
2002-11-18 18:18:05 +00:00
|
|
|
|
d0 = (CELL) Yap_MkFunctor(AtomOfTerm(d0), (Int) d1);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
pt1 = H;
|
|
|
|
|
*pt1++ = d0;
|
|
|
|
|
d0 = AbsAppl(H);
|
|
|
|
|
if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
|
|
|
|
|
/* make sure we have something to show for our trouble */
|
|
|
|
|
saveregs();
|
2008-09-05 05:22:19 +01:00
|
|
|
|
if (!Yap_gc(0, YREG, NEXTOP(NEXTOP(PREG,xxn),Osbpp))) {
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(OUT_OF_STACK_ERROR,LOCAL_ErrorMessage);
|
2002-10-10 05:58:49 +00:00
|
|
|
|
setregs();
|
|
|
|
|
JMPNext();
|
|
|
|
|
} else {
|
|
|
|
|
setregs();
|
|
|
|
|
}
|
2001-04-23 20:41:58 +00:00
|
|
|
|
goto restart_func2s_vc;
|
|
|
|
|
}
|
|
|
|
|
while ((Int)d1--) {
|
|
|
|
|
RESET_VARIABLE(pt1);
|
|
|
|
|
pt1++;
|
|
|
|
|
}
|
|
|
|
|
/* done building the term */
|
|
|
|
|
H = pt1;
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
/* else if arity is 0 just pass d0 through */
|
|
|
|
|
/* Ding, ding, we made it */
|
2008-08-29 17:27:11 +01:00
|
|
|
|
XREG(PREG->u.xxn.x) = d0;
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xxn),Osbpp),l);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
deref_body(d0, pt1, func2s_unk_vc, func2s_nvar_vc);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(INSTANTIATION_ERROR, d0, "functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-23 20:41:58 +00:00
|
|
|
|
ENDP(pt1);
|
|
|
|
|
/* Oops, second argument was unbound too */
|
|
|
|
|
FAIL();
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(p_func2s_y_vv, yxx);
|
|
|
|
|
/* A1 is a variable */
|
|
|
|
|
restart_func2s_y:
|
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
2002-11-18 18:18:05 +00:00
|
|
|
|
if (Yap_do_low_level_trace) {
|
2001-04-23 20:41:58 +00:00
|
|
|
|
RESET_VARIABLE(H);
|
|
|
|
|
H[1] = XREG(PREG->u.yxx.x1);
|
|
|
|
|
H[2] = XREG(PREG->u.yxx.x2);
|
2008-12-23 01:53:52 +00:00
|
|
|
|
low_level_trace(enter_pred,RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor,0)),H);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
}
|
|
|
|
|
#endif /* LOW_LEVEL_TRACE */
|
|
|
|
|
/* We have to build the structure */
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = XREG(PREG->u.yxx.x1);
|
|
|
|
|
deref_head(d0, func2s_y_unk);
|
|
|
|
|
func2s_y_nvar:
|
|
|
|
|
/* we do, let's get the third argument */
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d1 = XREG(PREG->u.yxx.x2);
|
|
|
|
|
deref_head(d1, func2s_y_unk2);
|
|
|
|
|
func2s_y_nvar2:
|
|
|
|
|
/* Uuuff, the second and third argument are bound */
|
|
|
|
|
if (IsIntegerTerm(d1))
|
|
|
|
|
d1 = IntegerOfTerm(d1);
|
|
|
|
|
else {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2009-05-29 22:34:50 -05:00
|
|
|
|
if (IsBigIntTerm(d1)) {
|
|
|
|
|
Yap_Error(RESOURCE_ERROR_STACK, d1, "functor/3");
|
|
|
|
|
} else {
|
|
|
|
|
Yap_Error(TYPE_ERROR_INTEGER,d1,"functor/3");
|
|
|
|
|
}
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-23 20:41:58 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
if (!IsAtomicTerm(d0)) {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(TYPE_ERROR_ATOM,d0,"functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-23 20:41:58 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
/* We made it!!!!! we got in d0 the name, in d1 the arity and
|
|
|
|
|
* in pt0 the variable to bind it to. */
|
|
|
|
|
if (d0 == TermDot && d1 == 2) {
|
|
|
|
|
RESET_VARIABLE(H);
|
|
|
|
|
RESET_VARIABLE(H+1);
|
|
|
|
|
d0 = AbsPair(H);
|
|
|
|
|
H += 2;
|
|
|
|
|
BEGP(pt1);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
pt1 = YREG + PREG->u.yxx.y;
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, yxx),Osbpp),l);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt1,d0);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
ENDP(pt1);
|
|
|
|
|
GONext();
|
|
|
|
|
} else if ((Int)d1 > 0) {
|
|
|
|
|
/* now let's build a compound term */
|
|
|
|
|
if (!IsAtomTerm(d0)) {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(TYPE_ERROR_ATOM,d0,"functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-23 20:41:58 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
if (!IsAtomTerm(d0)) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
else
|
2002-11-18 18:18:05 +00:00
|
|
|
|
d0 = (CELL) Yap_MkFunctor(AtomOfTerm(d0), (Int) d1);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
pt1 = H;
|
|
|
|
|
*pt1++ = d0;
|
|
|
|
|
d0 = AbsAppl(H);
|
|
|
|
|
if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
|
|
|
|
|
/* make sure we have something to show for our trouble */
|
|
|
|
|
saveregs();
|
2008-09-05 05:22:19 +01:00
|
|
|
|
if (!Yap_gcl((1+d1)*sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG,yxx),Osbpp))) {
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(OUT_OF_STACK_ERROR,LOCAL_ErrorMessage);
|
2002-10-10 05:58:49 +00:00
|
|
|
|
setregs();
|
|
|
|
|
JMPNext();
|
|
|
|
|
} else {
|
|
|
|
|
setregs();
|
|
|
|
|
}
|
2001-04-23 20:41:58 +00:00
|
|
|
|
goto restart_func2s_y;
|
|
|
|
|
}
|
|
|
|
|
while ((Int)d1--) {
|
|
|
|
|
RESET_VARIABLE(pt1);
|
|
|
|
|
pt1++;
|
|
|
|
|
}
|
|
|
|
|
/* done building the term */
|
|
|
|
|
H = pt1;
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
/* else if arity is 0 just pass d0 through */
|
|
|
|
|
/* Ding, ding, we made it */
|
|
|
|
|
BEGP(pt1);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
pt1 = YREG + PREG->u.yxx.y;
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, yxx),Osbpp),l);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt1,d0);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
ENDP(pt1);
|
|
|
|
|
GONext();
|
|
|
|
|
} else if (d1 == 0) {
|
|
|
|
|
BEGP(pt1);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
pt1 = YREG + PREG->u.yxx.y;
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, yxx),Osbpp),l);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt1,d0);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
ENDP(pt1);
|
|
|
|
|
GONext();
|
|
|
|
|
} else {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,MkIntegerTerm(d1),"functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-23 20:41:58 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
deref_body(d1, pt1, func2s_y_unk2, func2s_y_nvar2);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(INSTANTIATION_ERROR, d1, "functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-23 20:41:58 +00:00
|
|
|
|
ENDP(pt1);
|
|
|
|
|
/* Oops, third argument was unbound */
|
|
|
|
|
FAIL();
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
deref_body(d0, pt1, func2s_y_unk, func2s_y_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(INSTANTIATION_ERROR, d0, "functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-23 20:41:58 +00:00
|
|
|
|
ENDP(pt1);
|
|
|
|
|
/* Oops, second argument was unbound too */
|
|
|
|
|
FAIL();
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-30 23:00:50 +01:00
|
|
|
|
Op(p_func2s_y_cv, yxn);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
/* A1 is a variable */
|
|
|
|
|
restart_func2s_y_cv:
|
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
2002-11-18 18:18:05 +00:00
|
|
|
|
if (Yap_do_low_level_trace) {
|
2001-04-23 20:41:58 +00:00
|
|
|
|
RESET_VARIABLE(H);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
H[1] = PREG->u.yxn.c;
|
|
|
|
|
H[2] = XREG(PREG->u.yxn.xi);
|
2008-12-23 01:53:52 +00:00
|
|
|
|
low_level_trace(enter_pred,RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor,0)),H);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
}
|
|
|
|
|
#endif /* LOW_LEVEL_TRACE */
|
|
|
|
|
/* We have to build the structure */
|
|
|
|
|
BEGD(d0);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
d0 = PREG->u.yxn.c;
|
2001-04-23 20:41:58 +00:00
|
|
|
|
/* we do, let's get the third argument */
|
|
|
|
|
BEGD(d1);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
d1 = XREG(PREG->u.yxn.xi);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
deref_head(d1, func2s_y_unk_cv);
|
|
|
|
|
func2s_y_nvar_cv:
|
|
|
|
|
/* Uuuff, the second and third argument are bound */
|
|
|
|
|
if (IsIntegerTerm(d1)) {
|
|
|
|
|
d1 = IntegerOfTerm(d1);
|
|
|
|
|
} else {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2009-05-29 22:34:50 -05:00
|
|
|
|
if (IsBigIntTerm(d1)) {
|
|
|
|
|
Yap_Error(RESOURCE_ERROR_STACK, d1, "functor/3");
|
|
|
|
|
} else {
|
|
|
|
|
Yap_Error(TYPE_ERROR_INTEGER,d1,"functor/3");
|
|
|
|
|
}
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-23 20:41:58 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
/* We made it!!!!! we got in d0 the name, in d1 the arity and
|
|
|
|
|
* in pt0 the variable to bind it to. */
|
|
|
|
|
if (d0 == TermDot && d1 == 2) {
|
|
|
|
|
RESET_VARIABLE(H);
|
|
|
|
|
RESET_VARIABLE(H+1);
|
|
|
|
|
d0 = AbsPair(H);
|
|
|
|
|
H += 2;
|
|
|
|
|
/* else if arity is 0 just pass d0 through */
|
|
|
|
|
/* Ding, ding, we made it */
|
|
|
|
|
BEGP(pt1);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
pt1 = YREG + PREG->u.yxn.y;
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, yxn),Osbpp),l);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt1,d0);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
ENDP(pt1);
|
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
else if ((Int)d1 > 0) {
|
|
|
|
|
/* now let's build a compound term */
|
|
|
|
|
if (!IsAtomTerm(d0)) {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(TYPE_ERROR_ATOM,d0,"functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-23 20:41:58 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
if (!IsAtomTerm(d0)) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
else
|
2002-11-18 18:18:05 +00:00
|
|
|
|
d0 = (CELL) Yap_MkFunctor(AtomOfTerm(d0), (Int) d1);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
BEGP(pt1);
|
|
|
|
|
pt1 = H;
|
|
|
|
|
*pt1++ = d0;
|
|
|
|
|
d0 = AbsAppl(H);
|
|
|
|
|
if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
|
|
|
|
|
/* make sure we have something to show for our trouble */
|
|
|
|
|
saveregs();
|
2008-09-05 05:22:19 +01:00
|
|
|
|
if (!Yap_gcl((1+d1)*sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG,yxn),Osbpp))) {
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(OUT_OF_STACK_ERROR,LOCAL_ErrorMessage);
|
2002-10-10 05:58:49 +00:00
|
|
|
|
setregs();
|
|
|
|
|
JMPNext();
|
|
|
|
|
} else {
|
|
|
|
|
setregs();
|
|
|
|
|
}
|
2001-04-23 20:41:58 +00:00
|
|
|
|
goto restart_func2s_y_cv;
|
|
|
|
|
}
|
|
|
|
|
while ((Int)d1--) {
|
|
|
|
|
RESET_VARIABLE(pt1);
|
|
|
|
|
pt1++;
|
|
|
|
|
}
|
|
|
|
|
/* done building the term */
|
|
|
|
|
H = pt1;
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
/* else if arity is 0 just pass d0 through */
|
|
|
|
|
/* Ding, ding, we made it */
|
|
|
|
|
BEGP(pt1);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
pt1 = YREG + PREG->u.yxn.y;
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, yxn),Osbpp),l);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt1,d0);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
ENDP(pt1);
|
|
|
|
|
GONext();
|
|
|
|
|
} else if (d1 == 0) {
|
|
|
|
|
BEGP(pt1);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
pt1 = YREG + PREG->u.yxn.y;
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, yxn),Osbpp),l);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt1,d0);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
ENDP(pt1);
|
|
|
|
|
GONext();
|
|
|
|
|
} else {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,MkIntegerTerm(d1),"functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-23 20:41:58 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
deref_body(d1, pt1, func2s_y_unk_cv, func2s_y_nvar_cv);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(INSTANTIATION_ERROR, d1, "functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-23 20:41:58 +00:00
|
|
|
|
ENDP(pt1);
|
|
|
|
|
/* Oops, third argument was unbound */
|
|
|
|
|
FAIL();
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-30 23:00:50 +01:00
|
|
|
|
Op(p_func2s_y_vc, yxn);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
/* A1 is a variable */
|
|
|
|
|
restart_func2s_y_vc:
|
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
2002-11-18 18:18:05 +00:00
|
|
|
|
if (Yap_do_low_level_trace) {
|
2001-04-23 20:41:58 +00:00
|
|
|
|
Term ti;
|
|
|
|
|
CELL *hi = H;
|
|
|
|
|
|
2008-08-30 23:00:50 +01:00
|
|
|
|
ti = MkIntegerTerm((Int)(PREG->u.yxn.c));
|
2001-04-23 20:41:58 +00:00
|
|
|
|
RESET_VARIABLE(H);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
H[1] = XREG(PREG->u.yxn.xi);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
H[2] = ti;
|
2008-12-23 01:53:52 +00:00
|
|
|
|
low_level_trace(enter_pred,RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor,0)),H);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
H = hi;
|
|
|
|
|
}
|
|
|
|
|
#endif /* LOW_LEVEL_TRACE */
|
|
|
|
|
/* We have to build the structure */
|
|
|
|
|
BEGD(d0);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
d0 = XREG(PREG->u.yxn.xi);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
deref_head(d0, func2s_y_unk_vc);
|
|
|
|
|
func2s_y_nvar_vc:
|
|
|
|
|
BEGD(d1);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
d1 = PREG->u.yxn.c;
|
2001-04-23 20:41:58 +00:00
|
|
|
|
if (!IsAtomicTerm(d0)) {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(TYPE_ERROR_ATOM,d0,"functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-23 20:41:58 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
/* We made it!!!!! we got in d0 the name, in d1 the arity and
|
|
|
|
|
* in pt0 the variable to bind it to. */
|
|
|
|
|
if (d0 == TermDot && d1 == 2) {
|
|
|
|
|
RESET_VARIABLE(H);
|
|
|
|
|
RESET_VARIABLE(H+1);
|
|
|
|
|
d0 = AbsPair(H);
|
|
|
|
|
H += 2;
|
|
|
|
|
/* else if arity is 0 just pass d0 through */
|
|
|
|
|
/* Ding, ding, we made it */
|
|
|
|
|
BEGP(pt1);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
pt1 = YREG + PREG->u.yxn.y;
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, yxn),Osbpp),l);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt1,d0);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
ENDP(pt1);
|
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
if (d1 == 0) {
|
|
|
|
|
BEGP(pt1);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
pt1 = YREG + PREG->u.yxn.y;
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, yxn),Osbpp),l);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt1,d0);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
ENDP(pt1);
|
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
if (!IsAtomTerm(d0)) {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(TYPE_ERROR_ATOM,d0,"functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-23 20:41:58 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
/* now let's build a compound term */
|
|
|
|
|
if (!IsAtomTerm(d0)) {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(TYPE_ERROR_ATOM,d0,"functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-23 20:41:58 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
if (!IsAtomTerm(d0)) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
else
|
2002-11-18 18:18:05 +00:00
|
|
|
|
d0 = (CELL) Yap_MkFunctor(AtomOfTerm(d0), (Int) d1);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
pt1 = H;
|
|
|
|
|
*pt1++ = d0;
|
|
|
|
|
d0 = AbsAppl(H);
|
|
|
|
|
if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
|
|
|
|
|
/* make sure we have something to show for our trouble */
|
|
|
|
|
saveregs();
|
2008-09-05 05:22:19 +01:00
|
|
|
|
if (!Yap_gcl((1+d1)*sizeof(CELL), 0, YREG, NEXTOP(NEXTOP(PREG,yxn),Osbpp))) {
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(OUT_OF_STACK_ERROR,LOCAL_ErrorMessage);
|
2002-10-10 05:58:49 +00:00
|
|
|
|
setregs();
|
|
|
|
|
JMPNext();
|
|
|
|
|
} else {
|
|
|
|
|
setregs();
|
|
|
|
|
}
|
2001-04-23 20:41:58 +00:00
|
|
|
|
goto restart_func2s_y_vc;
|
|
|
|
|
}
|
|
|
|
|
while ((Int)d1--) {
|
|
|
|
|
RESET_VARIABLE(pt1);
|
|
|
|
|
pt1++;
|
|
|
|
|
}
|
|
|
|
|
/* done building the term */
|
|
|
|
|
H = pt1;
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
/* else if arity is 0 just pass d0 through */
|
|
|
|
|
/* Ding, ding, we made it */
|
|
|
|
|
BEGP(pt1);
|
2008-08-30 23:00:50 +01:00
|
|
|
|
pt1 = YREG + PREG->u.yxn.y;
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, yxn),Osbpp),l);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt1,d0);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
ENDP(pt1);
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
deref_body(d0, pt1, func2s_y_unk_vc, func2s_y_nvar_vc);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(INSTANTIATION_ERROR, d0, "functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-23 20:41:58 +00:00
|
|
|
|
ENDP(pt1);
|
|
|
|
|
/* Oops, second argument was unbound too */
|
|
|
|
|
FAIL();
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(p_func2f_xx, xxx);
|
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
2002-11-18 18:18:05 +00:00
|
|
|
|
if (Yap_do_low_level_trace) {
|
2001-04-23 20:41:58 +00:00
|
|
|
|
H[0] = XREG(PREG->u.xxx.x);
|
|
|
|
|
RESET_VARIABLE(H+1);
|
|
|
|
|
RESET_VARIABLE(H+2);
|
2008-12-23 01:53:52 +00:00
|
|
|
|
low_level_trace(enter_pred,RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor,0)),H);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
}
|
|
|
|
|
#endif /* LOW_LEVEL_TRACE */
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = XREG(PREG->u.xxx.x);
|
|
|
|
|
deref_head(d0, func2f_xx_unk);
|
|
|
|
|
func2f_xx_nvar:
|
|
|
|
|
if (IsApplTerm(d0)) {
|
|
|
|
|
Functor d1 = FunctorOfTerm(d0);
|
|
|
|
|
if (IsExtensionFunctor(d1)) {
|
|
|
|
|
XREG(PREG->u.xxx.x1) = d0;
|
|
|
|
|
XREG(PREG->u.xxx.x2) = MkIntTerm(0);
|
|
|
|
|
PREG = NEXTOP(PREG, xxx);
|
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
XREG(PREG->u.xxx.x1) = MkAtomTerm(NameOfFunctor(d1));
|
|
|
|
|
XREG(PREG->u.xxx.x2) = MkIntegerTerm(ArityOfFunctor(d1));
|
|
|
|
|
PREG = NEXTOP(PREG, xxx);
|
|
|
|
|
GONext();
|
|
|
|
|
} else if (IsPairTerm(d0)) {
|
|
|
|
|
XREG(PREG->u.xxx.x1) = TermDot;
|
|
|
|
|
XREG(PREG->u.xxx.x2) = MkIntTerm(2);
|
|
|
|
|
PREG = NEXTOP(PREG, xxx);
|
|
|
|
|
GONext();
|
|
|
|
|
} else {
|
|
|
|
|
XREG(PREG->u.xxx.x1) = d0;
|
|
|
|
|
XREG(PREG->u.xxx.x2) = MkIntTerm(0);
|
|
|
|
|
PREG = NEXTOP(PREG, xxx);
|
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
deref_body(d0, pt1, func2f_xx_unk, func2f_xx_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(INSTANTIATION_ERROR, d0, "functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-23 20:41:58 +00:00
|
|
|
|
ENDP(pt1);
|
|
|
|
|
/* Oops, second argument was unbound too */
|
|
|
|
|
FAIL();
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2008-08-21 13:38:25 +01:00
|
|
|
|
Op(p_func2f_xy, xxy);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
2002-11-18 18:18:05 +00:00
|
|
|
|
if (Yap_do_low_level_trace) {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
H[0] = XREG(PREG->u.xxy.x);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
RESET_VARIABLE(H+1);
|
|
|
|
|
RESET_VARIABLE(H+2);
|
2008-12-23 01:53:52 +00:00
|
|
|
|
low_level_trace(enter_pred,RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor,0)),H);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
}
|
|
|
|
|
#endif /* LOW_LEVEL_TRACE */
|
|
|
|
|
BEGD(d0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
d0 = XREG(PREG->u.xxy.x);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
deref_head(d0, func2f_xy_unk);
|
|
|
|
|
func2f_xy_nvar:
|
|
|
|
|
if (IsApplTerm(d0)) {
|
|
|
|
|
Functor d1 = FunctorOfTerm(d0);
|
2008-08-21 13:38:25 +01:00
|
|
|
|
CELL *pt0 = YREG+PREG->u.xxy.y2;
|
2001-04-23 20:41:58 +00:00
|
|
|
|
if (IsExtensionFunctor(d1)) {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
XREG(PREG->u.xxy.x1) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, xxy);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0, MkIntTerm(0));
|
2001-04-23 20:41:58 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
2008-08-21 13:38:25 +01:00
|
|
|
|
XREG(PREG->u.xxy.x1) = MkAtomTerm(NameOfFunctor(d1));
|
|
|
|
|
PREG = NEXTOP(PREG, xxy);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0, MkIntegerTerm(ArityOfFunctor(d1)));
|
2001-04-23 20:41:58 +00:00
|
|
|
|
GONext();
|
|
|
|
|
} else if (IsPairTerm(d0)) {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
CELL *pt0 = YREG+PREG->u.xxy.y2;
|
|
|
|
|
XREG(PREG->u.xxy.x1) = TermDot;
|
|
|
|
|
PREG = NEXTOP(PREG, xxy);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0, MkIntTerm(2));
|
2001-04-23 20:41:58 +00:00
|
|
|
|
GONext();
|
|
|
|
|
} else {
|
2008-08-21 13:38:25 +01:00
|
|
|
|
CELL *pt0 = YREG+PREG->u.xxy.y2;
|
|
|
|
|
XREG(PREG->u.xxy.x1) = d0;
|
|
|
|
|
PREG = NEXTOP(PREG, xxy);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0, MkIntTerm(0));
|
2001-04-23 20:41:58 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
deref_body(d0, pt1, func2f_xy_unk, func2f_xy_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(INSTANTIATION_ERROR, d0, "functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-23 20:41:58 +00:00
|
|
|
|
ENDP(pt1);
|
|
|
|
|
/* Oops, second argument was unbound too */
|
|
|
|
|
FAIL();
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(p_func2f_yx, yxx);
|
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
2002-11-18 18:18:05 +00:00
|
|
|
|
if (Yap_do_low_level_trace) {
|
2001-04-23 20:41:58 +00:00
|
|
|
|
H[0] = XREG(PREG->u.yxx.x2);
|
|
|
|
|
RESET_VARIABLE(H+1);
|
|
|
|
|
RESET_VARIABLE(H+2);
|
2008-12-23 01:53:52 +00:00
|
|
|
|
low_level_trace(enter_pred,RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor,0)),H);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
}
|
|
|
|
|
#endif /* LOW_LEVEL_TRACE */
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = XREG(PREG->u.yxx.x2);
|
|
|
|
|
deref_head(d0, func2f_yx_unk);
|
|
|
|
|
func2f_yx_nvar:
|
|
|
|
|
if (IsApplTerm(d0)) {
|
|
|
|
|
Functor d1 = FunctorOfTerm(d0);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
CELL *pt0 = YREG+PREG->u.yxx.y;
|
2001-04-23 20:41:58 +00:00
|
|
|
|
if (IsExtensionFunctor(d1)) {
|
|
|
|
|
XREG(PREG->u.yxx.x1) = MkIntTerm(0);
|
|
|
|
|
PREG = NEXTOP(PREG, yxx);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0, d0);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
XREG(PREG->u.yxx.x1) = MkIntegerTerm(ArityOfFunctor(d1));
|
|
|
|
|
PREG = NEXTOP(PREG, yxx);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0, MkAtomTerm(NameOfFunctor(d1)));
|
2001-04-23 20:41:58 +00:00
|
|
|
|
GONext();
|
|
|
|
|
} else if (IsPairTerm(d0)) {
|
2002-11-11 17:38:10 +00:00
|
|
|
|
CELL *pt0 = YREG+PREG->u.yxx.y;
|
2001-04-23 20:41:58 +00:00
|
|
|
|
XREG(PREG->u.yxx.x1) = MkIntTerm(2);
|
|
|
|
|
PREG = NEXTOP(PREG, yxx);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0 ,TermDot);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
GONext();
|
|
|
|
|
} else {
|
2002-11-11 17:38:10 +00:00
|
|
|
|
CELL *pt0 = YREG+PREG->u.yxx.y;
|
2001-04-23 20:41:58 +00:00
|
|
|
|
XREG(PREG->u.yxx.x1) = MkIntTerm(0);
|
|
|
|
|
PREG = NEXTOP(PREG, yxx);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0, d0);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
deref_body(d0, pt1, func2f_yx_unk, func2f_yx_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(INSTANTIATION_ERROR, d0, "functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-23 20:41:58 +00:00
|
|
|
|
ENDP(pt1);
|
|
|
|
|
/* Oops, second argument was unbound too */
|
|
|
|
|
FAIL();
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
|
|
|
|
Op(p_func2f_yy, yyx);
|
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
2002-11-18 18:18:05 +00:00
|
|
|
|
if (Yap_do_low_level_trace) {
|
2001-04-23 20:41:58 +00:00
|
|
|
|
H[0] = XREG(PREG->u.yyx.x);
|
|
|
|
|
RESET_VARIABLE(H+1);
|
|
|
|
|
RESET_VARIABLE(H+2);
|
2008-12-23 01:53:52 +00:00
|
|
|
|
low_level_trace(enter_pred,RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor,0)),H);
|
2001-04-23 20:41:58 +00:00
|
|
|
|
}
|
|
|
|
|
#endif /* LOW_LEVEL_TRACE */
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = XREG(PREG->u.yyx.x);
|
|
|
|
|
deref_head(d0, func2f_yy_unk);
|
|
|
|
|
func2f_yy_nvar:
|
|
|
|
|
if (IsApplTerm(d0)) {
|
|
|
|
|
Functor d1 = FunctorOfTerm(d0);
|
2002-11-11 17:38:10 +00:00
|
|
|
|
CELL *pt0 = YREG+PREG->u.yyx.y1;
|
|
|
|
|
CELL *pt1 = YREG+PREG->u.yyx.y2;
|
2001-04-23 20:41:58 +00:00
|
|
|
|
if (IsExtensionFunctor(d1)) {
|
|
|
|
|
PREG = NEXTOP(PREG, yyx);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0, d0);
|
|
|
|
|
INITIALIZE_PERMVAR(pt1, MkIntTerm(0));
|
2001-04-23 20:41:58 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
PREG = NEXTOP(PREG, yyx);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0, MkAtomTerm(NameOfFunctor(d1)));
|
|
|
|
|
INITIALIZE_PERMVAR(pt1, MkIntegerTerm(ArityOfFunctor(d1)));
|
2001-04-23 20:41:58 +00:00
|
|
|
|
GONext();
|
|
|
|
|
} else if (IsPairTerm(d0)) {
|
2002-11-11 17:38:10 +00:00
|
|
|
|
CELL *pt0 = YREG+PREG->u.yyx.y1;
|
|
|
|
|
CELL *pt1 = YREG+PREG->u.yyx.y2;
|
2001-04-23 20:41:58 +00:00
|
|
|
|
PREG = NEXTOP(PREG, yyx);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0, TermDot);
|
|
|
|
|
INITIALIZE_PERMVAR(pt1, MkIntTerm(2));
|
2001-04-23 20:41:58 +00:00
|
|
|
|
GONext();
|
|
|
|
|
} else {
|
2002-11-11 17:38:10 +00:00
|
|
|
|
CELL *pt0 = YREG+PREG->u.yyx.y1;
|
|
|
|
|
CELL *pt1 = YREG+PREG->u.yyx.y2;
|
2001-04-23 20:41:58 +00:00
|
|
|
|
PREG = NEXTOP(PREG, yyx);
|
2011-09-15 15:40:47 +01:00
|
|
|
|
INITIALIZE_PERMVAR(pt0, d0);
|
|
|
|
|
INITIALIZE_PERMVAR(pt1, MkIntTerm(0));
|
2001-04-23 20:41:58 +00:00
|
|
|
|
GONext();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
deref_body(d0, pt1, func2f_yy_unk, func2f_yy_nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(INSTANTIATION_ERROR, d0, "functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-23 20:41:58 +00:00
|
|
|
|
ENDP(pt1);
|
|
|
|
|
/* Oops, second argument was unbound too */
|
|
|
|
|
FAIL();
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
Op(p_functor, e);
|
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
2002-11-18 18:18:05 +00:00
|
|
|
|
if (Yap_do_low_level_trace)
|
2008-12-23 01:53:52 +00:00
|
|
|
|
low_level_trace(enter_pred,RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor,0)),XREGS+1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#endif /* LOW_LEVEL_TRACE */
|
|
|
|
|
restart_functor:
|
|
|
|
|
BEGD(d0);
|
|
|
|
|
d0 = ARG1;
|
|
|
|
|
deref_head(d0, func_unk);
|
|
|
|
|
func_nvar:
|
|
|
|
|
/* A1 is bound */
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
if (IsApplTerm(d0)) {
|
|
|
|
|
d1 = *RepAppl(d0);
|
|
|
|
|
if (IsExtensionFunctor((Functor) d1)) {
|
|
|
|
|
if (d1 <= (CELL)FunctorDouble && d1 >= (CELL)FunctorLongInt ) {
|
|
|
|
|
d1 = MkIntTerm(0);
|
|
|
|
|
} else
|
|
|
|
|
FAIL();
|
|
|
|
|
} else {
|
|
|
|
|
d0 = MkAtomTerm(NameOfFunctor((Functor) d1));
|
|
|
|
|
d1 = MkIntTerm(ArityOfFunctor((Functor) d1));
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
else if (IsPairTerm(d0)) {
|
|
|
|
|
d0 = TermDot;
|
|
|
|
|
d1 = MkIntTerm(2);
|
|
|
|
|
}
|
|
|
|
|
else {
|
|
|
|
|
d1 = MkIntTerm(0);
|
|
|
|
|
}
|
|
|
|
|
/* d1 and d0 now have the two arguments */
|
|
|
|
|
/* let's go and bind them */
|
|
|
|
|
{
|
|
|
|
|
register CELL arity = d1;
|
|
|
|
|
|
|
|
|
|
d1 = ARG2;
|
|
|
|
|
deref_head(d1, func_nvar_unk);
|
|
|
|
|
func_nvar_nvar:
|
|
|
|
|
/* A2 was bound */
|
|
|
|
|
if (d0 != d1) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
/* I have to this here so that I don't have a jump to a closing bracket */
|
|
|
|
|
d0 = arity;
|
|
|
|
|
goto func_bind_x3;
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d1, pt0, func_nvar_unk, func_nvar_nvar);
|
|
|
|
|
/* A2 is a variable, go and bind it */
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* I have to this here so that I don't have a jump to a closing bracket */
|
|
|
|
|
d0 = arity;
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
func_bind_x3:
|
|
|
|
|
/* now let's process A3 */
|
|
|
|
|
d1 = ARG3;
|
|
|
|
|
deref_head(d1, func_nvar3_unk);
|
|
|
|
|
func_nvar3_nvar:
|
|
|
|
|
/* A3 was bound */
|
|
|
|
|
if (d0 != d1) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
/* Done */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, e),Osbmp),l);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d1, pt0, func_nvar3_unk, func_nvar3_nvar);
|
|
|
|
|
/* A3 is a variable, go and bind it */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, e),Osbmp),l);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
/* Done */
|
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
|
|
|
|
|
BEGP(pt0);
|
|
|
|
|
deref_body(d0, pt0, func_unk, func_nvar);
|
|
|
|
|
/* A1 is a variable */
|
|
|
|
|
/* We have to build the structure */
|
|
|
|
|
d0 = ARG2;
|
|
|
|
|
deref_head(d0, func_var_2unk);
|
|
|
|
|
func_var_2nvar:
|
|
|
|
|
/* we do, let's get the third argument */
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d1 = ARG3;
|
|
|
|
|
deref_head(d1, func_var_3unk);
|
|
|
|
|
func_var_3nvar:
|
|
|
|
|
/* Uuuff, the second and third argument are bound */
|
|
|
|
|
if (IsIntTerm(d1))
|
|
|
|
|
d1 = IntOfTerm(d1);
|
|
|
|
|
else {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(TYPE_ERROR_INTEGER,ARG3,"functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
if (!IsAtomicTerm(d0)) {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(TYPE_ERROR_ATOM,d0,"functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
} /* We made it!!!!! we got in d0 the name, in d1 the arity and
|
|
|
|
|
* in pt0 the variable to bind it to. */
|
|
|
|
|
if (d0 == TermDot && d1 == 2) {
|
|
|
|
|
RESET_VARIABLE(H);
|
|
|
|
|
RESET_VARIABLE(H+1);
|
|
|
|
|
d0 = AbsPair(H);
|
|
|
|
|
H += 2;
|
|
|
|
|
}
|
|
|
|
|
else if ((Int)d1 > 0) {
|
|
|
|
|
/* now let's build a compound term */
|
|
|
|
|
if (!IsAtomTerm(d0)) {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(TYPE_ERROR_ATOM,d0,"functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
if (!IsAtomTerm(d0)) {
|
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
else
|
2002-11-18 18:18:05 +00:00
|
|
|
|
d0 = (CELL) Yap_MkFunctor(AtomOfTerm(d0), (Int) d1);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
pt1 = H;
|
|
|
|
|
*pt1++ = d0;
|
|
|
|
|
d0 = AbsAppl(H);
|
|
|
|
|
if (pt1+d1 > ENV || pt1+d1 > (CELL *)B) {
|
|
|
|
|
/* make sure we have something to show for our trouble */
|
|
|
|
|
saveregs();
|
2008-09-05 05:22:19 +01:00
|
|
|
|
if (!Yap_gcl((1+d1)*sizeof(CELL), 3, YREG, NEXTOP(NEXTOP(PREG,e),Osbmp))) {
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(OUT_OF_STACK_ERROR,LOCAL_ErrorMessage);
|
2002-10-10 05:58:49 +00:00
|
|
|
|
setregs();
|
|
|
|
|
JMPNext();
|
|
|
|
|
} else {
|
|
|
|
|
setregs();
|
|
|
|
|
}
|
2009-05-29 22:34:50 -05:00
|
|
|
|
goto restart_functor; /* */
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
2001-04-23 20:41:58 +00:00
|
|
|
|
while ((Int)d1--) {
|
2001-04-09 19:54:03 +00:00
|
|
|
|
RESET_VARIABLE(pt1);
|
|
|
|
|
pt1++;
|
|
|
|
|
}
|
|
|
|
|
/* done building the term */
|
|
|
|
|
H = pt1;
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
} else if ((Int)d1 < 0) {
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,MkIntegerTerm(d1),"functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
FAIL();
|
|
|
|
|
}
|
|
|
|
|
/* else if arity is 0 just pass d0 through */
|
|
|
|
|
/* Ding, ding, we made it */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, e),Osbpp),l);
|
2011-03-18 19:34:58 +00:00
|
|
|
|
Bind(pt0, d0);
|
2001-04-09 19:54:03 +00:00
|
|
|
|
GONext();
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
deref_body(d1, pt1, func_var_3unk, func_var_3nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(INSTANTIATION_ERROR, d1, "functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt1);
|
|
|
|
|
/* Oops, third argument was unbound */
|
|
|
|
|
FAIL();
|
|
|
|
|
ENDD(d1);
|
|
|
|
|
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
deref_body(d0, pt1, func_var_2unk, func_var_2nvar);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(INSTANTIATION_ERROR, d0, "functor/3");
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
ENDP(pt1);
|
|
|
|
|
/* Oops, second argument was unbound too */
|
|
|
|
|
FAIL();
|
|
|
|
|
ENDP(pt0);
|
|
|
|
|
ENDD(d0);
|
|
|
|
|
ENDOp();
|
|
|
|
|
|
2012-08-13 23:35:37 -05:00
|
|
|
|
/* join all the meta-call code into a single procedure with three entry points */
|
2007-11-07 09:25:27 +00:00
|
|
|
|
{
|
|
|
|
|
CACHE_Y_AS_ENV(YREG);
|
2012-08-13 23:35:37 -05:00
|
|
|
|
BEGD(d0); /* term to be meta-called */
|
|
|
|
|
Term mod; /* module to be used */
|
|
|
|
|
PredEntry *pen; /* predicate */
|
|
|
|
|
choiceptr b_ptr; /* cut point */
|
|
|
|
|
Functor f;
|
|
|
|
|
|
|
|
|
|
/* we are doing the rhs of a , */
|
|
|
|
|
BOp(p_execute_tail, Osbmp);
|
|
|
|
|
|
|
|
|
|
FETCH_Y_FROM_ENV(YREG);
|
|
|
|
|
/* place to cut to */
|
|
|
|
|
b_ptr = (choiceptr)ENV_YREG[E_CB];
|
|
|
|
|
/* original goal */
|
|
|
|
|
d0 = ENV_YREG[-EnvSizeInCells-1];
|
|
|
|
|
/* predicate we had used */
|
|
|
|
|
pen = RepPredProp((Prop)IntegerOfTerm(ENV_YREG[-EnvSizeInCells-2]));
|
|
|
|
|
/* current module at the time */
|
|
|
|
|
mod = ENV_YREG[-EnvSizeInCells-3];
|
2012-08-22 09:41:09 -05:00
|
|
|
|
/* set YREG */
|
|
|
|
|
/* Try to preserve the environment */
|
|
|
|
|
ENV_YREG = (CELL *) (((char *) YREG) + PREG->u.Osbmp.s);
|
2007-11-07 09:25:27 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
|
|
|
|
{
|
|
|
|
|
choiceptr top_b = PROTECT_FROZEN_B(B);
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#ifdef YAPOR_SBA
|
2007-11-07 09:25:27 +00:00
|
|
|
|
if (ENV_YREG > (CELL *) top_b || ENV_YREG < H) ENV_YREG = (CELL *) top_b;
|
|
|
|
|
#else
|
|
|
|
|
if (ENV_YREG > (CELL *) top_b) ENV_YREG = (CELL *) top_b;
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#endif /* YAPOR_SBA */
|
2007-11-07 09:25:27 +00:00
|
|
|
|
}
|
|
|
|
|
#else
|
2012-08-22 09:41:09 -05:00
|
|
|
|
if (ENV_YREG > (CELL *) B) {
|
|
|
|
|
ENV_YREG = (CELL *) B;
|
2007-11-07 09:25:27 +00:00
|
|
|
|
}
|
2012-08-13 23:35:37 -05:00
|
|
|
|
#endif /* FROZEN_STACKS */
|
|
|
|
|
/* now, jump to actual execution */
|
|
|
|
|
if (pen->ArityOfPE) {
|
|
|
|
|
f = pen->FunctorOfPred;
|
2012-08-22 09:41:09 -05:00
|
|
|
|
/* reuse environment if we are continuining a comma, ie, (g1,g2,g3) */
|
|
|
|
|
/* can only do it deterministically */
|
2012-09-07 00:21:57 -05:00
|
|
|
|
/* broken
|
2012-08-23 09:03:42 -05:00
|
|
|
|
if (f == FunctorComma && (CELL *)B >= ENV) {
|
2012-08-22 09:41:09 -05:00
|
|
|
|
ENV_YREG = ENV;
|
|
|
|
|
ENV = (CELL *)ENV[E_E];
|
|
|
|
|
}
|
2012-09-07 00:21:57 -05:00
|
|
|
|
*/
|
2012-08-13 23:35:37 -05:00
|
|
|
|
goto execute_pred_f;
|
|
|
|
|
} else
|
|
|
|
|
goto execute_pred_a;
|
|
|
|
|
ENDBOp();
|
2007-11-07 09:25:27 +00:00
|
|
|
|
|
2012-08-13 23:35:37 -05:00
|
|
|
|
/* fetch the module from ARG2 */
|
|
|
|
|
BOp(p_execute2, Osbpp);
|
2007-11-07 09:25:27 +00:00
|
|
|
|
|
2012-08-13 23:35:37 -05:00
|
|
|
|
mod = ARG2;
|
|
|
|
|
deref_head(mod, execute2_unk0);
|
|
|
|
|
execute2_nvar0:
|
|
|
|
|
if (!IsAtomTerm(mod)) {
|
|
|
|
|
saveregs();
|
|
|
|
|
Yap_Error(TYPE_ERROR_ATOM, mod, "call/2");
|
|
|
|
|
setregs();
|
2007-11-07 09:25:27 +00:00
|
|
|
|
}
|
2012-08-13 23:35:37 -05:00
|
|
|
|
goto start_execute;
|
2007-11-07 09:25:27 +00:00
|
|
|
|
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
deref_body(mod, pt1, execute2_unk0, execute2_nvar0);
|
|
|
|
|
saveregs();
|
|
|
|
|
Yap_Error(INSTANTIATION_ERROR, mod, "call/2");
|
|
|
|
|
setregs();
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
/* Oops, second argument was unbound too */
|
|
|
|
|
FAIL();
|
2012-08-13 23:35:37 -05:00
|
|
|
|
ENDBOp();
|
2007-11-07 09:25:27 +00:00
|
|
|
|
|
2008-09-05 05:22:19 +01:00
|
|
|
|
BOp(p_execute, Osbmp);
|
2012-08-13 23:35:37 -05:00
|
|
|
|
/* fetch the module from PREG */
|
|
|
|
|
mod = PREG->u.Osbmp.mod;
|
|
|
|
|
start_execute:
|
|
|
|
|
b_ptr = B;
|
|
|
|
|
/* we have mod, and ARG1 has the goal, let us roll */
|
2003-01-29 14:47:17 +00:00
|
|
|
|
/* Try to preserve the environment */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
ENV_YREG = (CELL *) (((char *) YREG) + PREG->u.Osbmp.s);
|
2003-01-29 14:47:17 +00:00
|
|
|
|
#ifdef FROZEN_STACKS
|
|
|
|
|
{
|
|
|
|
|
choiceptr top_b = PROTECT_FROZEN_B(B);
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#ifdef YAPOR_SBA
|
2005-10-28 17:38:50 +00:00
|
|
|
|
if (ENV_YREG > (CELL *) top_b || ENV_YREG < H) ENV_YREG = (CELL *) top_b;
|
2003-01-29 14:47:17 +00:00
|
|
|
|
#else
|
2005-10-28 17:38:50 +00:00
|
|
|
|
if (ENV_YREG > (CELL *) top_b) ENV_YREG = (CELL *) top_b;
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#endif /* YAPOR_SBA */
|
2003-01-29 14:47:17 +00:00
|
|
|
|
}
|
|
|
|
|
#else
|
2005-10-28 17:38:50 +00:00
|
|
|
|
if (ENV_YREG > (CELL *) B) {
|
|
|
|
|
ENV_YREG = (CELL *) B;
|
2003-01-29 14:47:17 +00:00
|
|
|
|
}
|
|
|
|
|
#endif /* FROZEN_STACKS */
|
2001-10-30 16:42:05 +00:00
|
|
|
|
d0 = ARG1;
|
2012-08-13 23:35:37 -05:00
|
|
|
|
if (PRED_GOAL_EXPANSION_ALL) {
|
|
|
|
|
goto execute_metacall;
|
|
|
|
|
}
|
2003-01-29 14:47:17 +00:00
|
|
|
|
restart_execute:
|
2001-10-30 16:42:05 +00:00
|
|
|
|
deref_head(d0, execute_unk);
|
|
|
|
|
execute_nvar:
|
|
|
|
|
if (IsApplTerm(d0)) {
|
2012-08-13 23:35:37 -05:00
|
|
|
|
f = FunctorOfTerm(d0);
|
2001-10-30 16:42:05 +00:00
|
|
|
|
if (IsExtensionFunctor(f)) {
|
2003-01-29 14:47:17 +00:00
|
|
|
|
goto execute_metacall;
|
2001-10-30 16:42:05 +00:00
|
|
|
|
}
|
2001-11-15 00:01:43 +00:00
|
|
|
|
pen = RepPredProp(PredPropByFunc(f, mod));
|
2012-08-13 23:35:37 -05:00
|
|
|
|
execute_pred_f:
|
2004-12-05 05:01:45 +00:00
|
|
|
|
if (pen->PredFlags & (MetaPredFlag|GoalExPredFlag)) {
|
2012-08-13 23:35:37 -05:00
|
|
|
|
/* just strip all of M:G */
|
2001-11-15 00:01:43 +00:00
|
|
|
|
if (f == FunctorModule) {
|
2003-01-29 14:47:17 +00:00
|
|
|
|
Term tmod = ArgOfTerm(1,d0);
|
2012-08-13 23:35:37 -05:00
|
|
|
|
/* loop on modules */
|
2003-01-29 14:47:17 +00:00
|
|
|
|
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
|
2001-11-15 00:01:43 +00:00
|
|
|
|
d0 = ArgOfTerm(2,d0);
|
2004-02-12 12:37:12 +00:00
|
|
|
|
mod = tmod;
|
2001-11-15 00:01:43 +00:00
|
|
|
|
goto execute_nvar;
|
|
|
|
|
}
|
2012-08-13 23:35:37 -05:00
|
|
|
|
goto execute_metacall;
|
|
|
|
|
}
|
|
|
|
|
if (f == FunctorComma) {
|
|
|
|
|
Term nmod = mod;
|
|
|
|
|
|
|
|
|
|
/* optimise conj */
|
2003-01-29 14:47:17 +00:00
|
|
|
|
SREG = RepAppl(d0);
|
|
|
|
|
BEGD(d1);
|
|
|
|
|
d1 = SREG[2];
|
2012-08-13 23:35:37 -05:00
|
|
|
|
/* create an environment to execute the call */
|
2003-01-29 14:47:17 +00:00
|
|
|
|
deref_head(d1, execute_comma_unk);
|
|
|
|
|
execute_comma_nvar:
|
|
|
|
|
if (IsAtomTerm(d1)) {
|
2012-08-13 23:35:37 -05:00
|
|
|
|
/* atomic goal is simpler */
|
|
|
|
|
ENV_YREG[-EnvSizeInCells-2] = MkIntegerTerm((Int)PredPropByAtom(AtomOfTerm(d1),nmod));
|
2003-01-29 14:47:17 +00:00
|
|
|
|
} else if (IsApplTerm(d1)) {
|
2012-08-13 23:35:37 -05:00
|
|
|
|
Functor f1 = FunctorOfTerm(d1);
|
|
|
|
|
if (IsExtensionFunctor(f1)) {
|
2003-01-29 14:47:17 +00:00
|
|
|
|
goto execute_metacall;
|
|
|
|
|
} else {
|
2012-08-13 23:35:37 -05:00
|
|
|
|
/* check for modules when looking up */
|
|
|
|
|
if (f1 == FunctorModule) {
|
|
|
|
|
Term tmod = ArgOfTerm(1,d1);
|
|
|
|
|
/* loop on modules */
|
|
|
|
|
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
|
|
|
|
|
d1 = ArgOfTerm(2,d1);
|
|
|
|
|
nmod = tmod;
|
|
|
|
|
goto execute_comma_nvar;
|
|
|
|
|
}
|
|
|
|
|
goto execute_metacall;
|
|
|
|
|
}
|
|
|
|
|
ENV_YREG[-EnvSizeInCells-2] = MkIntegerTerm((Int)PredPropByFunc(f1,nmod));
|
2003-01-29 14:47:17 +00:00
|
|
|
|
}
|
|
|
|
|
} else {
|
|
|
|
|
goto execute_metacall;
|
|
|
|
|
}
|
2012-08-22 09:41:09 -05:00
|
|
|
|
ENV_YREG[-EnvSizeInCells-3] = mod;
|
2012-08-13 23:35:37 -05:00
|
|
|
|
/* now, we can create the new environment for the meta-call */
|
2012-08-22 09:41:09 -05:00
|
|
|
|
/* notice that we are at a call, so we should ignore CP */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
ENV_YREG[E_CP] = (CELL)NEXTOP(PREG,Osbmp);
|
2012-08-13 23:35:37 -05:00
|
|
|
|
ENV_YREG[E_CB] = (CELL)b_ptr;
|
2005-10-28 17:38:50 +00:00
|
|
|
|
ENV_YREG[E_E] = (CELL)ENV;
|
2003-01-29 14:47:17 +00:00
|
|
|
|
#ifdef DEPTH_LIMIT
|
2005-10-28 17:38:50 +00:00
|
|
|
|
ENV_YREG[E_DEPTH] = DEPTH;
|
2003-01-29 14:47:17 +00:00
|
|
|
|
#endif /* DEPTH_LIMIT */
|
2005-10-28 17:38:50 +00:00
|
|
|
|
ENV_YREG[-EnvSizeInCells-1] = d1;
|
|
|
|
|
ENV = ENV_YREG;
|
|
|
|
|
ENV_YREG -= EnvSizeInCells+3;
|
2012-08-22 09:41:09 -05:00
|
|
|
|
CPREG = NEXTOP(PREG, Osbmp);
|
2003-01-29 14:47:17 +00:00
|
|
|
|
PREG = COMMA_CODE;
|
2012-08-13 23:35:37 -05:00
|
|
|
|
/* for profiler */
|
2005-12-23 00:20:14 +00:00
|
|
|
|
save_pc();
|
2003-01-29 14:47:17 +00:00
|
|
|
|
d0 = SREG[1];
|
|
|
|
|
goto restart_execute;
|
|
|
|
|
|
|
|
|
|
BEGP(pt1);
|
|
|
|
|
deref_body(d1, pt1, execute_comma_unk, execute_comma_nvar);
|
|
|
|
|
goto execute_metacall;
|
|
|
|
|
ENDP(pt1);
|
|
|
|
|
ENDD(d1);
|
2003-01-30 16:27:45 +00:00
|
|
|
|
} else if (mod != CurrentModule) {
|
|
|
|
|
goto execute_metacall;
|
2002-10-18 14:52:58 +00:00
|
|
|
|
}
|
2001-10-30 16:42:05 +00:00
|
|
|
|
}
|
2012-08-13 23:35:37 -05:00
|
|
|
|
|
|
|
|
|
/* copy arguments of meta-call to XREGS */
|
2001-10-30 16:42:05 +00:00
|
|
|
|
BEGP(pt1);
|
|
|
|
|
pt1 = RepAppl(d0);
|
|
|
|
|
BEGD(d2);
|
|
|
|
|
for (d2 = ArityOfFunctor(f); d2; d2--) {
|
2011-03-30 15:32:59 +01:00
|
|
|
|
#ifdef YAPOR_SBA
|
2001-10-30 16:42:05 +00:00
|
|
|
|
BEGD(d1);
|
|
|
|
|
d1 = pt1[d2];
|
2003-01-29 14:47:17 +00:00
|
|
|
|
if (d1 == 0) {
|
2001-10-30 16:42:05 +00:00
|
|
|
|
XREGS[d2] = (CELL)(pt1+d2);
|
2003-01-29 14:47:17 +00:00
|
|
|
|
} else {
|
2001-10-30 16:42:05 +00:00
|
|
|
|
XREGS[d2] = d1;
|
2003-01-29 14:47:17 +00:00
|
|
|
|
}
|
2001-10-30 16:42:05 +00:00
|
|
|
|
#else
|
|
|
|
|
XREGS[d2] = pt1[d2];
|
|
|
|
|
#endif
|
|
|
|
|
}
|
|
|
|
|
ENDD(d2);
|
|
|
|
|
ENDP(pt1);
|
2001-10-30 23:07:58 +00:00
|
|
|
|
CACHE_A1();
|
2001-10-30 16:42:05 +00:00
|
|
|
|
} else if (IsAtomTerm(d0)) {
|
2012-08-13 23:35:37 -05:00
|
|
|
|
pen = RepPredProp(PredPropByAtom(AtomOfTerm(d0), mod));
|
|
|
|
|
execute_pred_a:
|
|
|
|
|
/* handle extra pruning */
|
|
|
|
|
if (pen->FunctorOfPred == (Functor)AtomCut) {
|
|
|
|
|
if (b_ptr != B) {
|
|
|
|
|
saveregs();
|
2012-12-13 18:12:50 +00:00
|
|
|
|
prune(b_ptr PASS_REGS);
|
2012-08-13 23:35:37 -05:00
|
|
|
|
setregs();
|
|
|
|
|
}
|
2003-01-29 14:47:17 +00:00
|
|
|
|
}
|
2001-10-30 16:42:05 +00:00
|
|
|
|
} else {
|
2003-01-29 14:47:17 +00:00
|
|
|
|
goto execute_metacall;
|
2001-10-30 16:42:05 +00:00
|
|
|
|
}
|
|
|
|
|
|
2012-08-13 23:35:37 -05:00
|
|
|
|
/* execute, byt test first for interrupts */
|
2003-01-29 14:47:17 +00:00
|
|
|
|
execute_end:
|
2001-10-30 16:42:05 +00:00
|
|
|
|
/* code copied from call */
|
2003-04-30 17:14:10 +00:00
|
|
|
|
#ifndef NO_CHECKING
|
|
|
|
|
check_stack(NoStackPExecute, H);
|
|
|
|
|
#endif
|
2008-09-05 05:22:19 +01:00
|
|
|
|
CPREG = NEXTOP(PREG, Osbmp);
|
2001-10-30 16:42:05 +00:00
|
|
|
|
ALWAYS_LOOKAHEAD(pen->OpcodeOfPred);
|
2002-12-27 16:53:09 +00:00
|
|
|
|
PREG = pen->CodeOfPred;
|
2005-12-23 00:20:14 +00:00
|
|
|
|
/* for profiler */
|
|
|
|
|
save_pc();
|
2001-10-30 16:42:05 +00:00
|
|
|
|
#ifdef DEPTH_LIMIT
|
|
|
|
|
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is primitives */
|
2001-10-30 16:59:16 +00:00
|
|
|
|
if (pen->ModuleOfPred) {
|
2001-10-30 16:42:05 +00:00
|
|
|
|
if (DEPTH == MkIntTerm(0))
|
|
|
|
|
FAIL();
|
|
|
|
|
else DEPTH = RESET_DEPTH();
|
|
|
|
|
}
|
2001-10-30 16:59:16 +00:00
|
|
|
|
} else if (pen->ModuleOfPred)
|
2001-10-30 16:42:05 +00:00
|
|
|
|
DEPTH -= MkIntConstant(2);
|
|
|
|
|
#endif /* DEPTH_LIMIT */
|
|
|
|
|
#ifdef LOW_LEVEL_TRACER
|
2002-11-18 18:18:05 +00:00
|
|
|
|
if (Yap_do_low_level_trace)
|
2001-10-30 16:42:05 +00:00
|
|
|
|
low_level_trace(enter_pred,pen,XREGS+1);
|
|
|
|
|
#endif /* LOW_LEVEL_TRACER */
|
|
|
|
|
WRITEBACK_Y_AS_ENV();
|
|
|
|
|
/* setup GB */
|
2012-08-22 09:41:09 -05:00
|
|
|
|
ENV_YREG[E_CB] = (CELL) b_ptr;
|
2001-10-30 16:42:05 +00:00
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
SCH_check_requests();
|
|
|
|
|
#endif /* YAPOR */
|
2005-08-02 03:09:52 +00:00
|
|
|
|
CACHE_A1();
|
2001-10-30 16:42:05 +00:00
|
|
|
|
ALWAYS_GONext();
|
|
|
|
|
ALWAYS_END_PREFETCH();
|
|
|
|
|
|
2012-08-13 23:35:37 -05:00
|
|
|
|
/* meta-call: Prolog to the rescue */
|
2001-10-30 16:42:05 +00:00
|
|
|
|
BEGP(pt1);
|
|
|
|
|
deref_body(d0, pt1, execute_unk, execute_nvar);
|
2003-01-29 14:47:17 +00:00
|
|
|
|
execute_metacall:
|
|
|
|
|
ARG1 = ARG3 = d0;
|
|
|
|
|
pen = PredMetaCall;
|
2012-08-13 23:35:37 -05:00
|
|
|
|
ARG2 = Yap_cp_as_integer(b_ptr);
|
2004-02-12 12:37:12 +00:00
|
|
|
|
if (mod)
|
|
|
|
|
ARG4 = mod;
|
|
|
|
|
else
|
|
|
|
|
ARG4 = TermProlog;
|
2003-01-29 14:47:17 +00:00
|
|
|
|
goto execute_end;
|
2001-10-30 16:42:05 +00:00
|
|
|
|
ENDP(pt1);
|
2003-01-29 14:47:17 +00:00
|
|
|
|
|
2012-08-13 23:35:37 -05:00
|
|
|
|
/* at this point, we have the arguments all set in the argument registers, pen says who is the current predicate. don't remove. */
|
2003-02-07 12:05:39 +00:00
|
|
|
|
NoStackPExecute:
|
2012-03-09 11:46:34 +00:00
|
|
|
|
CHECK_ALARM(goto execute_end);
|
2012-06-22 03:55:01 -05:00
|
|
|
|
if (LOCAL_ActiveSignals & (YAP_FAIL_SIGNAL|YAP_INT_SIGNAL)) {
|
|
|
|
|
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
|
|
|
|
|
Yap_Error(PURE_ABORT, TermNil, "abort from console");
|
|
|
|
|
}
|
|
|
|
|
LOCAL_ActiveSignals &= ~(YAP_FAIL_SIGNAL|YAP_INT_SIGNAL);
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (!LOCAL_ActiveSignals)
|
2010-12-04 18:45:09 +00:00
|
|
|
|
CreepFlag = CalculateStackGap();
|
|
|
|
|
goto fail;
|
|
|
|
|
}
|
2012-08-13 23:35:37 -05:00
|
|
|
|
PP = NULL;
|
|
|
|
|
SREG = (CELL *) pen;
|
2005-10-28 17:38:50 +00:00
|
|
|
|
ASP = ENV_YREG;
|
2010-07-06 15:31:17 +01:00
|
|
|
|
if (ASP > (CELL *)PROTECT_FROZEN_B(B))
|
|
|
|
|
ASP = (CELL *)PROTECT_FROZEN_B(B);
|
2003-02-07 12:05:39 +00:00
|
|
|
|
/* setup GB */
|
|
|
|
|
WRITEBACK_Y_AS_ENV();
|
|
|
|
|
YREG[E_CB] = (CELL) B;
|
2011-05-04 10:11:41 +01:00
|
|
|
|
if (LOCAL_ActiveSignals) {
|
2003-08-23 19:26:08 +00:00
|
|
|
|
goto creep_pe;
|
2004-07-22 21:32:23 +00:00
|
|
|
|
}
|
2003-10-28 01:16:03 +00:00
|
|
|
|
saveregs_and_ycache();
|
2012-08-13 23:35:37 -05:00
|
|
|
|
if (!Yap_gc(pen->ArityOfPE, ENV, NEXTOP(PREG, Osbmp))) {
|
2011-10-02 21:01:14 -03:00
|
|
|
|
Yap_NilError(OUT_OF_STACK_ERROR,LOCAL_ErrorMessage);
|
2003-02-07 12:05:39 +00:00
|
|
|
|
}
|
2003-10-28 01:16:03 +00:00
|
|
|
|
setregs_and_ycache();
|
2003-04-30 17:14:10 +00:00
|
|
|
|
goto execute_end;
|
2012-08-13 23:35:37 -05:00
|
|
|
|
ENDBOp();
|
|
|
|
|
|
|
|
|
|
ENDD(d0);
|
2001-10-30 16:42:05 +00:00
|
|
|
|
ENDCACHE_Y_AS_ENV();
|
|
|
|
|
}
|
|
|
|
|
|
2003-08-23 19:26:08 +00:00
|
|
|
|
creep_pe: /* do creep in call */
|
2008-09-05 05:22:19 +01:00
|
|
|
|
CPREG = NEXTOP(PREG, Osbmp);
|
2003-08-23 19:26:08 +00:00
|
|
|
|
goto creep;
|
|
|
|
|
|
2001-04-09 19:54:03 +00:00
|
|
|
|
#if !USE_THREADED_CODE
|
|
|
|
|
default:
|
2002-01-29 05:37:31 +00:00
|
|
|
|
saveregs();
|
2002-11-18 18:18:05 +00:00
|
|
|
|
Yap_Error(SYSTEM_ERROR, MkIntegerTerm(opcode), "trying to execute invalid YAAM instruction %d", opcode);
|
2002-01-29 05:37:31 +00:00
|
|
|
|
setregs();
|
|
|
|
|
FAIL();
|
2001-04-09 19:54:03 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
#endif
|
|
|
|
|
|
|
|
|
|
#if USE_THREADED_CODE
|
|
|
|
|
#if PUSH_REGS
|
|
|
|
|
restore_absmi_regs(old_regs);
|
|
|
|
|
#endif
|
|
|
|
|
#if BP_FREE
|
|
|
|
|
P1REG = PCBACKUP;
|
|
|
|
|
#endif
|
|
|
|
|
return (0);
|
|
|
|
|
#endif
|
|
|
|
|
|
|
|
|
|
}
|
|
|
|
|
|
2004-06-29 19:04:46 +00:00
|
|
|
|
/* dummy function that is needed for profiler */
|
2004-07-23 21:08:45 +00:00
|
|
|
|
int Yap_absmiEND(void)
|
2004-06-29 19:04:46 +00:00
|
|
|
|
{
|
|
|
|
|
return 1;
|
|
|
|
|
}
|