2001-04-09 20:54:03 +01: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: index.c *
|
|
|
|
|
* comments: Indexing a Prolog predicate *
|
|
|
|
|
* *
|
2016-07-31 10:26:15 +01:00
|
|
|
|
* Last rev: $Date: 2008-08-07 20:51:21 $,$Author: vsc $
|
|
|
|
|
**
|
2004-03-25 02:19:10 +00:00
|
|
|
|
* $Log: not supported by cvs2svn $
|
2008-08-07 21:51:23 +01:00
|
|
|
|
* Revision 1.202 2008/07/11 17:02:07 vsc
|
|
|
|
|
* fixes by Bart and Tom: mostly libraries but nasty one in indexing
|
|
|
|
|
* compilation.
|
|
|
|
|
*
|
2008-07-11 18:02:10 +01:00
|
|
|
|
* Revision 1.201 2008/05/10 23:24:11 vsc
|
|
|
|
|
* fix threads and LU
|
|
|
|
|
*
|
2008-05-11 00:24:13 +01:00
|
|
|
|
* Revision 1.200 2008/04/16 17:16:47 vsc
|
|
|
|
|
* make static_clause only commit to a lause if it is sure that is the true
|
|
|
|
|
* clause. Otherwise, search for the clause.
|
|
|
|
|
*
|
2008-04-16 18:16:47 +01:00
|
|
|
|
* Revision 1.199 2008/04/14 21:20:35 vsc
|
|
|
|
|
* fixed a bug in static_clause (thanks to Jose Santos)
|
|
|
|
|
*
|
2008-04-14 22:20:36 +01:00
|
|
|
|
* Revision 1.198 2008/03/25 16:45:53 vsc
|
|
|
|
|
* make or-parallelism compile again
|
|
|
|
|
*
|
2008-03-25 16:45:53 +00:00
|
|
|
|
* Revision 1.197 2008/02/14 14:35:13 vsc
|
|
|
|
|
* fixes for indexing code.
|
|
|
|
|
*
|
2008-02-14 14:35:13 +00:00
|
|
|
|
* Revision 1.196 2008/01/30 10:35:43 vsc
|
|
|
|
|
* fix indexing in 64 bits (it would split ints from atoms :( ).
|
|
|
|
|
*
|
2008-01-30 10:35:43 +00:00
|
|
|
|
* Revision 1.195 2008/01/24 10:20:42 vsc
|
|
|
|
|
* clause should not try to discover who is fail.
|
|
|
|
|
*
|
2008-01-24 10:20:42 +00:00
|
|
|
|
* Revision 1.194 2008/01/24 00:11:59 vsc
|
|
|
|
|
* garbage collector was not asking for space.
|
|
|
|
|
* avoid 0 sized calls to mmap.
|
|
|
|
|
*
|
2008-01-24 00:11:59 +00:00
|
|
|
|
* Revision 1.193 2008/01/23 17:57:46 vsc
|
|
|
|
|
* valgrind it!
|
|
|
|
|
* enable atom garbage collection.
|
|
|
|
|
*
|
2008-01-23 17:57:56 +00:00
|
|
|
|
* Revision 1.192 2007/11/26 23:43:08 vsc
|
|
|
|
|
* fixes to support threads and assert correctly, even if inefficiently.
|
|
|
|
|
*
|
2007-11-26 23:43:10 +00:00
|
|
|
|
* Revision 1.191 2007/11/08 15:52:15 vsc
|
|
|
|
|
* fix some bugs in new dbterm code.
|
|
|
|
|
*
|
2007-11-08 15:52:15 +00:00
|
|
|
|
* Revision 1.190 2007/11/07 09:25:27 vsc
|
|
|
|
|
* speedup meta-calls
|
|
|
|
|
*
|
2007-11-07 09:25:27 +00:00
|
|
|
|
* Revision 1.189 2007/11/06 17:02:12 vsc
|
|
|
|
|
* compile ground terms away.
|
|
|
|
|
*
|
2007-11-06 17:02:13 +00:00
|
|
|
|
* Revision 1.188 2007/10/28 11:23:40 vsc
|
|
|
|
|
* fix overflow
|
|
|
|
|
*
|
2007-10-28 11:23:41 +00:00
|
|
|
|
* Revision 1.187 2007/09/22 08:38:05 vsc
|
|
|
|
|
* nb_ extra stuff plus an indexing overflow fix.
|
|
|
|
|
*
|
2007-09-22 09:38:05 +01:00
|
|
|
|
* Revision 1.186 2007/06/20 13:48:45 vsc
|
|
|
|
|
* fix bug in index emulator
|
|
|
|
|
*
|
2007-06-20 14:48:45 +01:00
|
|
|
|
* Revision 1.185 2007/05/02 11:01:37 vsc
|
|
|
|
|
* get rid of type punning warnings.
|
|
|
|
|
*
|
2007-05-02 12:01:41 +01:00
|
|
|
|
* Revision 1.184 2007/03/26 15:18:43 vsc
|
|
|
|
|
* debugging and clause/3 over tabled predicates would kill YAP.
|
|
|
|
|
*
|
2007-03-26 16:18:43 +01:00
|
|
|
|
* Revision 1.183 2007/03/21 23:23:46 vsc
|
|
|
|
|
* fix excessive trail cleaning in gc tr overflow.
|
|
|
|
|
*
|
2007-03-21 23:23:46 +00:00
|
|
|
|
* Revision 1.182 2007/01/28 14:26:36 vsc
|
|
|
|
|
* WIN32 support
|
|
|
|
|
*
|
2007-01-28 14:26:37 +00:00
|
|
|
|
* Revision 1.181 2007/01/08 08:27:19 vsc
|
|
|
|
|
* fix restore (Trevor)
|
|
|
|
|
* make indexing a bit faster on IDB
|
|
|
|
|
*
|
2007-01-08 08:27:19 +00:00
|
|
|
|
* Revision 1.180 2006/12/27 01:32:37 vsc
|
|
|
|
|
* diverse fixes
|
|
|
|
|
*
|
2006-12-27 01:32:38 +00:00
|
|
|
|
* Revision 1.179 2006/11/27 17:42:02 vsc
|
|
|
|
|
* support for UNICODE, and other bug fixes.
|
|
|
|
|
*
|
2006-11-27 17:42:03 +00:00
|
|
|
|
* Revision 1.178 2006/11/21 16:21:31 vsc
|
|
|
|
|
* fix I/O mess
|
|
|
|
|
* fix spy/reconsult mess
|
|
|
|
|
*
|
2006-11-21 16:21:33 +00:00
|
|
|
|
* Revision 1.177 2006/11/15 00:13:36 vsc
|
|
|
|
|
* fixes for indexing code.
|
|
|
|
|
*
|
2006-11-15 00:13:37 +00:00
|
|
|
|
* Revision 1.176 2006/11/08 01:53:08 vsc
|
|
|
|
|
* avoid generating suspensions on static code.
|
|
|
|
|
*
|
2006-11-08 01:53:08 +00:00
|
|
|
|
* Revision 1.175 2006/11/06 18:35:04 vsc
|
|
|
|
|
* 1estranha
|
|
|
|
|
*
|
2006-11-06 18:35:05 +00:00
|
|
|
|
* Revision 1.174 2006/10/25 02:31:07 vsc
|
|
|
|
|
* fix emulation of trust_logical
|
|
|
|
|
*
|
2006-10-25 03:31:07 +01:00
|
|
|
|
* Revision 1.173 2006/10/18 13:47:31 vsc
|
|
|
|
|
* index.c implementation of trust_logical was decrementing the wrong
|
|
|
|
|
* cp_tr
|
|
|
|
|
*
|
2006-10-18 14:47:32 +01:00
|
|
|
|
* Revision 1.172 2006/10/16 17:12:48 vsc
|
|
|
|
|
* fixes for threaded version.
|
|
|
|
|
*
|
2006-10-16 18:12:48 +01:00
|
|
|
|
* Revision 1.171 2006/10/11 14:53:57 vsc
|
|
|
|
|
* fix memory leak
|
|
|
|
|
* fix overflow handling
|
|
|
|
|
* VS: ----------------------------------------------------------------------
|
|
|
|
|
*
|
2006-10-11 15:53:57 +01:00
|
|
|
|
* Revision 1.170 2006/10/10 14:08:16 vsc
|
|
|
|
|
* small fixes on threaded implementation.
|
|
|
|
|
*
|
2006-10-10 15:08:17 +01:00
|
|
|
|
* Revision 1.169 2006/09/20 20:03:51 vsc
|
|
|
|
|
* improve indexing on floats
|
|
|
|
|
* fix sending large lists to DB
|
|
|
|
|
*
|
2006-09-20 21:03:51 +01:00
|
|
|
|
* Revision 1.168 2006/05/16 18:37:30 vsc
|
|
|
|
|
* WIN32 fixes
|
|
|
|
|
* compiler bug fixes
|
|
|
|
|
* extend interface
|
|
|
|
|
*
|
2006-05-16 19:37:31 +01:00
|
|
|
|
* Revision 1.167 2006/05/02 16:44:11 vsc
|
2015-11-05 16:38:18 +00:00
|
|
|
|
* avoid uninitialized memory at overflow.
|
2006-05-16 19:37:31 +01:00
|
|
|
|
*
|
2006-05-02 17:44:11 +01:00
|
|
|
|
* Revision 1.166 2006/05/02 16:39:06 vsc
|
|
|
|
|
* bug in indexing code
|
|
|
|
|
* fix warning messages for write.c
|
|
|
|
|
*
|
2006-05-02 17:39:06 +01:00
|
|
|
|
* Revision 1.165 2006/04/27 17:04:08 vsc
|
|
|
|
|
* don't use <= to compare with block top (libc may not have block header).
|
|
|
|
|
*
|
2006-04-27 18:04:08 +01:00
|
|
|
|
* Revision 1.164 2006/04/27 14:10:36 rslopes
|
|
|
|
|
* *** empty log message ***
|
|
|
|
|
*
|
2006-04-27 15:13:24 +01:00
|
|
|
|
* Revision 1.163 2006/04/20 15:28:08 vsc
|
|
|
|
|
* more graph stuff.
|
|
|
|
|
*
|
2006-04-20 16:28:08 +01:00
|
|
|
|
* Revision 1.162 2006/04/12 18:56:50 vsc
|
|
|
|
|
* fix bug in clause: a trust_me followed by a try should be implemented by
|
|
|
|
|
* reusing the choice-point.
|
|
|
|
|
*
|
2006-04-12 19:56:50 +01:00
|
|
|
|
* Revision 1.161 2006/04/05 00:16:54 vsc
|
|
|
|
|
* Lots of fixes (check logfile for details
|
|
|
|
|
*
|
2006-04-05 01:16:55 +01:00
|
|
|
|
* Revision 1.160 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.159 2006/03/22 20:07:28 vsc
|
|
|
|
|
* take better care of zombies
|
|
|
|
|
*
|
2006-03-22 20:07:28 +00:00
|
|
|
|
* Revision 1.158 2006/03/21 21:30:54 vsc
|
|
|
|
|
* avoid looking around when expanding for statics too.
|
|
|
|
|
*
|
2006-03-21 21:30:54 +00:00
|
|
|
|
* Revision 1.157 2006/03/21 19:20:34 vsc
|
|
|
|
|
* fix fix on index expansion
|
|
|
|
|
*
|
2006-03-21 19:20:35 +00:00
|
|
|
|
* Revision 1.156 2006/03/21 17:11:39 vsc
|
|
|
|
|
* prevent breakage
|
|
|
|
|
*
|
2006-03-21 17:11:39 +00:00
|
|
|
|
* Revision 1.155 2006/03/21 15:06:35 vsc
|
|
|
|
|
* fixes to handle expansion of dyn amic predicates more efficiently.
|
|
|
|
|
*
|
2006-03-21 15:06:36 +00:00
|
|
|
|
* Revision 1.154 2006/03/20 19:51:43 vsc
|
|
|
|
|
* fix indexing and tabling bugs
|
|
|
|
|
*
|
2006-03-20 19:51:44 +00:00
|
|
|
|
* Revision 1.153 2006/02/22 11:55:36 vsc
|
|
|
|
|
* indexing code would get confused about size of float/1, db_reference1.
|
|
|
|
|
*
|
2006-02-22 11:55:36 +00:00
|
|
|
|
* Revision 1.152 2006/02/19 02:55:46 vsc
|
|
|
|
|
* disable indexing on bigints
|
|
|
|
|
*
|
2006-02-19 02:55:46 +00:00
|
|
|
|
* Revision 1.151 2006/01/16 02:57:51 vsc
|
|
|
|
|
* fix bug with very large integers
|
|
|
|
|
* fix bug where indexing code was looking at code after a cut.
|
|
|
|
|
*
|
2006-01-16 02:57:52 +00:00
|
|
|
|
* Revision 1.150 2005/12/23 00:20:13 vsc
|
|
|
|
|
* updates to gprof
|
|
|
|
|
* support for __POWER__
|
2010-12-16 01:22:10 +00:00
|
|
|
|
* Try to saveregs before siglongjmp.
|
2006-01-16 02:57:52 +00:00
|
|
|
|
*
|
2005-12-23 00:20:14 +00:00
|
|
|
|
* Revision 1.149 2005/12/17 03:25:39 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.148 2005/11/24 15:33:52 tiagosoares
|
|
|
|
|
* removed some compilation warnings related to the cut-c code
|
|
|
|
|
*
|
2005-11-24 15:35:29 +00:00
|
|
|
|
* Revision 1.147 2005/11/18 18:48:52 tiagosoares
|
|
|
|
|
* support for executing c code when a cut occurs
|
|
|
|
|
*
|
2005-11-18 18:52:41 +00:00
|
|
|
|
* Revision 1.146 2005/10/29 02:21:47 vsc
|
|
|
|
|
* people should be able to disable indexing.
|
|
|
|
|
*
|
2005-10-29 03:21:47 +01:00
|
|
|
|
* Revision 1.145 2005/09/08 22:06:44 rslopes
|
|
|
|
|
* BEAM for YAP update...
|
|
|
|
|
*
|
2005-09-08 23:06:45 +01:00
|
|
|
|
* Revision 1.144 2005/08/17 18:48:35 vsc
|
|
|
|
|
* fix bug in processing overflows of expand_clauses.
|
|
|
|
|
*
|
2005-08-17 19:48:35 +01:00
|
|
|
|
* Revision 1.143 2005/08/02 03:09:50 vsc
|
|
|
|
|
* fix debugger to do well nonsource predicates.
|
|
|
|
|
*
|
2005-08-02 04:09:52 +01:00
|
|
|
|
* Revision 1.142 2005/08/01 15:40:37 ricroc
|
|
|
|
|
* TABLING NEW: better support for incomplete tabling
|
|
|
|
|
*
|
2005-08-01 16:40:39 +01:00
|
|
|
|
* Revision 1.141 2005/07/19 16:54:20 rslopes
|
|
|
|
|
* fix for older compilers...
|
|
|
|
|
*
|
2005-07-19 17:54:20 +01:00
|
|
|
|
* Revision 1.140 2005/07/18 17:41:16 vsc
|
|
|
|
|
* Yap should respect single argument indexing.
|
|
|
|
|
*
|
2005-07-18 18:41:16 +01:00
|
|
|
|
* Revision 1.139 2005/07/06 19:33:53 ricroc
|
2016-07-31 10:26:15 +01:00
|
|
|
|
* TABLING: answers for completed calls can now be obtained by loading (new
|
|
|
|
|
*option) or executing (default) them from the trie data structure.
|
2005-07-18 18:41:16 +01:00
|
|
|
|
*
|
2005-07-06 20:34:12 +01:00
|
|
|
|
* Revision 1.138 2005/07/05 18:32:32 vsc
|
|
|
|
|
* ifix some wierd cases in indexing code:
|
|
|
|
|
* would not look at next argument
|
|
|
|
|
* problem with pvar as last clause (R Camacho).
|
|
|
|
|
*
|
2005-07-05 19:32:32 +01:00
|
|
|
|
* Revision 1.137 2005/06/04 07:27:34 ricroc
|
|
|
|
|
* long int support for tabling
|
|
|
|
|
*
|
2005-06-04 08:28:24 +01:00
|
|
|
|
* Revision 1.136 2005/06/03 08:26:32 ricroc
|
|
|
|
|
* float support for tabling
|
|
|
|
|
*
|
2005-06-03 09:26:32 +01:00
|
|
|
|
* Revision 1.135 2005/06/01 20:25:23 vsc
|
|
|
|
|
* == and \= should not need a choice-point in ->
|
|
|
|
|
*
|
2005-06-01 21:25:23 +01:00
|
|
|
|
* Revision 1.134 2005/06/01 16:42:30 vsc
|
|
|
|
|
* put switch_list_nl back
|
|
|
|
|
*
|
2005-06-01 17:42:30 +01:00
|
|
|
|
* Revision 1.133 2005/06/01 14:02:50 vsc
|
|
|
|
|
* get_rid of try_me?, retry_me? and trust_me? instructions: they are not
|
|
|
|
|
* significantly used nowadays.
|
|
|
|
|
*
|
2005-06-01 15:02:52 +01:00
|
|
|
|
* Revision 1.132 2005/05/31 20:04:17 vsc
|
2016-07-31 10:26:15 +01:00
|
|
|
|
* fix cleanup of expand_clauses: make sure we have everything with NULL
|
|
|
|
|
*afterwards.
|
2005-06-01 15:02:52 +01:00
|
|
|
|
*
|
2005-05-31 21:04:17 +01:00
|
|
|
|
* Revision 1.131 2005/05/31 19:42:27 vsc
|
|
|
|
|
* insert some more slack for indices in LU
|
|
|
|
|
* Use doubly linked list for LU indices so that updating is less cumbersome.
|
|
|
|
|
*
|
2005-05-31 20:42:28 +01:00
|
|
|
|
* Revision 1.130 2005/05/31 04:46:06 vsc
|
|
|
|
|
* fix expand_index on tabled code.
|
|
|
|
|
*
|
2005-05-31 05:46:06 +01:00
|
|
|
|
* Revision 1.129 2005/05/31 02:15:53 vsc
|
2015-09-25 10:57:26 +01:00
|
|
|
|
* fix SYSTEM_ERROR_INTERNAL messages
|
2005-05-31 05:46:06 +01:00
|
|
|
|
*
|
2005-05-31 03:15:53 +01:00
|
|
|
|
* Revision 1.128 2005/05/30 05:26:49 vsc
|
|
|
|
|
* fix tabling
|
|
|
|
|
* allow atom gc again for now.
|
|
|
|
|
*
|
2005-05-30 06:26:50 +01:00
|
|
|
|
* Revision 1.127 2005/05/27 21:44:00 vsc
|
|
|
|
|
* Don't try to mess with sequences that don't end with a trust.
|
|
|
|
|
* A fix for the atom garbage collector actually ignore floats ;-).
|
|
|
|
|
*
|
2005-05-27 22:44:00 +01:00
|
|
|
|
* Revision 1.126 2005/05/25 18:58:37 vsc
|
|
|
|
|
* fix another bug in nth_instance, thanks to Pat Caldon
|
|
|
|
|
*
|
2005-05-25 19:58:38 +01:00
|
|
|
|
* Revision 1.125 2005/04/28 14:50:45 vsc
|
|
|
|
|
* clause should always deref before testing type
|
|
|
|
|
*
|
2005-04-28 15:50:45 +01:00
|
|
|
|
* Revision 1.124 2005/04/27 20:09:25 vsc
|
|
|
|
|
* indexing code could get confused with suspension points
|
|
|
|
|
* some further improvements on oveflow handling
|
|
|
|
|
* fix paths in Java makefile
|
|
|
|
|
* changs to support gibbs sampling in CLP(BN)
|
|
|
|
|
*
|
2005-04-27 21:09:26 +01:00
|
|
|
|
* Revision 1.123 2005/04/21 13:53:05 vsc
|
|
|
|
|
* fix bug with (var(X) -> being interpreted as var(X) by indexing code
|
|
|
|
|
*
|
2005-04-21 14:53:05 +01:00
|
|
|
|
* Revision 1.122 2005/04/10 04:01:12 vsc
|
|
|
|
|
* bug fixes, I hope!
|
|
|
|
|
*
|
2005-04-10 05:01:15 +01:00
|
|
|
|
* Revision 1.121 2005/04/07 17:48:54 ricroc
|
2016-07-31 10:26:15 +01:00
|
|
|
|
* 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-10 05:01:15 +01:00
|
|
|
|
*
|
2005-04-07 18:56:58 +01:00
|
|
|
|
* Revision 1.120 2005/03/15 18:29:23 vsc
|
|
|
|
|
* fix GPL
|
|
|
|
|
* fix idb: stuff in coroutines.
|
|
|
|
|
*
|
2005-03-15 18:29:25 +00:00
|
|
|
|
* Revision 1.119 2005/03/04 20:30:12 ricroc
|
|
|
|
|
* bug fixes for YapTab support
|
|
|
|
|
*
|
2005-03-04 20:30:14 +00:00
|
|
|
|
* Revision 1.118 2005/03/01 22:25:08 vsc
|
|
|
|
|
* fix pruning bug
|
|
|
|
|
* make DL_MALLOC less enthusiastic about walking through buckets.
|
|
|
|
|
*
|
2005-03-01 22:25:09 +00:00
|
|
|
|
* Revision 1.117 2005/02/25 00:09:06 vsc
|
|
|
|
|
* fix fix, otherwise I'd remove two choice-points :-(.
|
|
|
|
|
*
|
2005-02-25 00:09:06 +00:00
|
|
|
|
* Revision 1.116 2005/02/24 21:46:39 vsc
|
|
|
|
|
* Improve error handling routine, trying to make it more robust.
|
|
|
|
|
* Improve hole handling in stack expansion
|
|
|
|
|
* Clause interrpeter was supposed to prune _trust_me
|
|
|
|
|
* Wrong messages for acos and atanh
|
|
|
|
|
*
|
2005-02-24 21:46:40 +00:00
|
|
|
|
* Revision 1.115 2005/02/21 16:50:00 vsc
|
|
|
|
|
* amd64 fixes
|
|
|
|
|
* library fixes
|
|
|
|
|
*
|
2005-02-21 16:50:21 +00:00
|
|
|
|
* Revision 1.114 2005/01/28 23:14:36 vsc
|
|
|
|
|
* move to Yap-4.5.7
|
|
|
|
|
* Fix clause size
|
|
|
|
|
*
|
2005-01-28 23:14:41 +00:00
|
|
|
|
* Revision 1.113 2005/01/15 05:21:36 vsc
|
|
|
|
|
* fix bug in clause emulator
|
|
|
|
|
*
|
2005-01-15 05:21:36 +00:00
|
|
|
|
* Revision 1.112 2004/12/28 22:20:35 vsc
|
2016-07-31 10:26:15 +01:00
|
|
|
|
* some extra bug fixes for trail overflows: some cannot be recovered that
|
|
|
|
|
*easily,
|
2005-01-15 05:21:36 +00:00
|
|
|
|
* some can.
|
|
|
|
|
*
|
2004-12-28 22:20:37 +00:00
|
|
|
|
* Revision 1.111 2004/12/21 17:17:15 vsc
|
|
|
|
|
* miscounting of variable-only clauses in groups might lead to bug in indexing
|
|
|
|
|
* code.
|
|
|
|
|
*
|
2004-12-21 17:17:15 +00:00
|
|
|
|
* Revision 1.110 2004/12/06 04:50:22 vsc
|
|
|
|
|
* fix bug in removing first clause of a try sequence (lu preds)
|
|
|
|
|
*
|
2004-12-06 04:50:22 +00:00
|
|
|
|
* Revision 1.109 2004/12/05 05:01:24 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.108 2004/11/19 22:08:42 vsc
|
2016-07-31 10:26:15 +01:00
|
|
|
|
* replace SYSTEM_ERROR_INTERNAL by out OUT_OF_WHATEVER_ERROR whenever
|
|
|
|
|
*appropriate.
|
2004-12-05 05:01:45 +00:00
|
|
|
|
*
|
2004-11-19 22:08:43 +00:00
|
|
|
|
* Revision 1.107 2004/11/19 17:14:14 vsc
|
|
|
|
|
* a few fixes for 64 bit compiling.
|
|
|
|
|
*
|
2004-11-19 17:14:15 +00:00
|
|
|
|
* Revision 1.106 2004/11/18 22:32:36 vsc
|
2016-07-31 10:26:15 +01:00
|
|
|
|
* fix situation where we might assume nonextsing double initialization of C
|
|
|
|
|
*predicates (use
|
2004-11-19 17:14:15 +00:00
|
|
|
|
* Hidden Pred Flag).
|
2015-11-05 16:38:18 +00:00
|
|
|
|
* $host_type was double initialized.
|
2004-11-19 17:14:15 +00:00
|
|
|
|
*
|
2004-11-18 22:32:40 +00:00
|
|
|
|
* Revision 1.105 2004/11/04 18:22:32 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.104 2004/10/27 15:56:33 vsc
|
|
|
|
|
* bug fixes on memory overflows and on clauses :- fail being ignored by clause.
|
|
|
|
|
*
|
2004-10-27 16:56:34 +01:00
|
|
|
|
* Revision 1.103 2004/10/22 16:53:19 vsc
|
|
|
|
|
* bug fixes
|
|
|
|
|
*
|
2004-10-22 17:53:20 +01:00
|
|
|
|
* Revision 1.102 2004/10/04 18:56:19 vsc
|
|
|
|
|
* fixes for thread support
|
|
|
|
|
* fix indexing bug (serious)
|
|
|
|
|
*
|
2004-10-04 19:56:20 +01:00
|
|
|
|
* Revision 1.101 2004/09/30 21:37:41 vsc
|
|
|
|
|
* fixes for thread support
|
|
|
|
|
*
|
2004-09-30 22:37:41 +01:00
|
|
|
|
* Revision 1.100 2004/09/30 19:51:54 vsc
|
|
|
|
|
* fix overflow from within clause/2
|
|
|
|
|
*
|
2004-09-30 20:51:54 +01:00
|
|
|
|
* Revision 1.99 2004/09/27 20:45:03 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 21:45:04 +01:00
|
|
|
|
* Revision 1.98 2004/09/14 03:30:06 vsc
|
|
|
|
|
* make sure that condor version always grows trail!
|
|
|
|
|
*
|
2004-09-14 04:30:06 +01:00
|
|
|
|
* Revision 1.97 2004/09/03 03:11:09 vsc
|
|
|
|
|
* memory management fixes
|
|
|
|
|
*
|
2004-09-03 04:11:09 +01:00
|
|
|
|
* Revision 1.96 2004/08/27 20:18:52 vsc
|
|
|
|
|
* more small fixes
|
|
|
|
|
*
|
2004-08-27 21:18:52 +01:00
|
|
|
|
* Revision 1.95 2004/08/11 16:14:52 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 17:14:55 +01:00
|
|
|
|
* Revision 1.94 2004/07/29 18:15:18 vsc
|
|
|
|
|
* fix severe bug in indexing of floating point numbers
|
|
|
|
|
*
|
2004-07-29 19:15:19 +01:00
|
|
|
|
* Revision 1.93 2004/07/23 19:01:14 vsc
|
|
|
|
|
* fix bad ref count in expand_clauses when copying indexing block
|
|
|
|
|
*
|
2004-07-23 20:01:14 +01:00
|
|
|
|
* Revision 1.92 2004/06/29 19:04:42 vsc
|
|
|
|
|
* fix multithreaded version
|
|
|
|
|
* include new version of Ricardo's profiler
|
|
|
|
|
* new predicat atomic_concat
|
|
|
|
|
* allow multithreaded-debugging
|
|
|
|
|
* small fixes
|
|
|
|
|
*
|
2004-06-29 20:04:46 +01:00
|
|
|
|
* Revision 1.91 2004/06/17 22:07:23 vsc
|
|
|
|
|
* bad bug in indexing code.
|
|
|
|
|
*
|
2004-06-17 23:07:23 +01:00
|
|
|
|
* Revision 1.90 2004/04/29 03:44:04 vsc
|
|
|
|
|
* fix bad suspended clause counter
|
|
|
|
|
*
|
2004-04-29 04:44:04 +01:00
|
|
|
|
* Revision 1.89 2004/04/27 15:03:43 vsc
|
|
|
|
|
* more fixes for expand_clauses
|
|
|
|
|
*
|
2004-04-27 16:03:43 +01:00
|
|
|
|
* Revision 1.88 2004/04/22 03:24:17 vsc
|
|
|
|
|
* trust_logical should protect the last clause, otherwise it cannot
|
|
|
|
|
* jump there.
|
|
|
|
|
*
|
2004-04-22 04:24:17 +01:00
|
|
|
|
* Revision 1.87 2004/04/21 04:01:53 vsc
|
|
|
|
|
* fix bad ordering when inserting second clause
|
|
|
|
|
*
|
2004-04-21 05:01:53 +01:00
|
|
|
|
* Revision 1.86 2004/04/20 22:08:23 vsc
|
|
|
|
|
* fixes for corourining
|
|
|
|
|
*
|
2004-04-20 23:08:57 +01:00
|
|
|
|
* Revision 1.85 2004/04/16 19:27:31 vsc
|
|
|
|
|
* more bug fixes
|
|
|
|
|
*
|
2004-04-16 20:27:31 +01:00
|
|
|
|
* Revision 1.84 2004/04/14 19:10:38 vsc
|
|
|
|
|
* expand_clauses: keep a list of clauses to expand
|
|
|
|
|
* fix new trail scheme for multi-assignment variables
|
|
|
|
|
*
|
2004-04-14 20:10:40 +01:00
|
|
|
|
* Revision 1.83 2004/04/07 22:04:04 vsc
|
|
|
|
|
* fix memory leaks
|
|
|
|
|
*
|
2004-04-07 23:04:04 +01:00
|
|
|
|
* Revision 1.82 2004/03/31 01:02:18 vsc
|
|
|
|
|
* if number of left-over < 1/5 keep list of clauses to expand around
|
|
|
|
|
* fix call to stack expander
|
|
|
|
|
*
|
2004-03-31 02:02:18 +01:00
|
|
|
|
* Revision 1.81 2004/03/25 02:19:10 pmoura
|
|
|
|
|
* Removed debugging line to allow compilation.
|
|
|
|
|
*
|
2004-03-25 02:19:10 +00:00
|
|
|
|
* Revision 1.80 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
|
|
|
|
* *
|
2001-04-09 20:54:03 +01:00
|
|
|
|
*************************************************************************/
|
|
|
|
|
#ifdef SCCS
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static char SccsId[] = "%W% %G%";
|
2001-04-09 20:54:03 +01:00
|
|
|
|
#endif
|
|
|
|
|
|
2014-09-11 20:06:57 +01:00
|
|
|
|
/**
|
|
|
|
|
|
|
|
|
|
@file index.c
|
|
|
|
|
|
|
|
|
|
@defgroup Indexing Indexing
|
|
|
|
|
@ingroup YAPProgramming
|
|
|
|
|
|
|
|
|
|
The
|
|
|
|
|
indexation mechanism restricts the set of clauses to be tried in a
|
|
|
|
|
procedure by using information about the status of the instantiated
|
|
|
|
|
arguments of the goal. These arguments are then used as a key,
|
|
|
|
|
selecting a restricted set of a clauses from all the clauses forming the
|
|
|
|
|
procedure.
|
|
|
|
|
|
|
|
|
|
As an example, the two clauses for concatenate:
|
|
|
|
|
|
|
|
|
|
~~~~~
|
|
|
|
|
concatenate([],L,L).
|
|
|
|
|
concatenate([H|T],A,[H|NT]) :- concatenate(T,A,NT).
|
|
|
|
|
~~~~~
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
If the first argument for the goal is a list, then only the second clause
|
|
|
|
|
is of interest. If the first argument is the nil atom, the system needs to
|
|
|
|
|
look only for the first clause. The indexation generates instructions that
|
|
|
|
|
test the value of the first argument, and then proceed to a selected clause,
|
2014-09-11 20:06:57 +01:00
|
|
|
|
or group of clauses.
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Note that if the first argument was a free variable, then both clauses
|
|
|
|
|
should be tried. In general, indexation will not be useful if the first
|
2014-09-11 20:06:57 +01:00
|
|
|
|
argument is a free variable.
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
When activating a predicate, a Prolog system needs to store state
|
|
|
|
|
information. This information, stored in a structure known as choice point
|
|
|
|
|
or fail point, is necessary when backtracking to other clauses for the
|
|
|
|
|
predicate. The operations of creating and using a choice point are very
|
2014-09-11 20:06:57 +01:00
|
|
|
|
expensive, both in the terms of space used and time spent.
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Creating a choice point is not necessary if there is only a clause for
|
|
|
|
|
the predicate as there are no clauses to backtrack to. With indexation, this
|
|
|
|
|
situation is extended: in the example, if the first argument was the atom
|
|
|
|
|
nil, then only one clause would really be of interest, and it is pointless to
|
|
|
|
|
create a choice point. This feature is even more useful if the first argument
|
|
|
|
|
is a list: without indexation, execution would try the first clause, creating
|
|
|
|
|
a choice point. The clause would fail, the choice point would then be used to
|
|
|
|
|
restore the previous state of the computation and the second clause would
|
|
|
|
|
be tried. The code generated by the indexation mechanism would behave
|
|
|
|
|
much more efficiently: it would test the first argument and see whether it
|
2014-09-11 20:06:57 +01:00
|
|
|
|
is a list, and then proceed directly to the second clause.
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
An important side effect concerns the use of "cut". In the above
|
|
|
|
|
example, some programmers would use a "cut" in the first clause just to
|
|
|
|
|
inform the system that the predicate is not backtrackable and force the
|
|
|
|
|
removal the choice point just created. As a result, less space is needed but
|
|
|
|
|
with a great loss in expressive power: the "cut" would prevent some uses of
|
|
|
|
|
the procedure, like generating lists through backtracking. Of course, with
|
2014-09-11 20:06:57 +01:00
|
|
|
|
indexation the "cut" becomes useless: the choice point is not even created.
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Indexation is also very important for predicates with a large number
|
2014-09-11 20:06:57 +01:00
|
|
|
|
of clauses that are used like tables:
|
|
|
|
|
|
|
|
|
|
~~~~~
|
|
|
|
|
logician(aristoteles,greek).
|
|
|
|
|
logician(frege,german).
|
|
|
|
|
logician(russel,english).
|
|
|
|
|
logician(godel,german).
|
|
|
|
|
logician(whitehead,english).
|
|
|
|
|
~~~~~
|
|
|
|
|
|
|
|
|
|
An interpreter like C-Prolog, trying to answer the query:
|
|
|
|
|
|
|
|
|
|
~~~~~
|
|
|
|
|
?- logician(godel,X).
|
|
|
|
|
~~~~~
|
|
|
|
|
|
|
|
|
|
would blindly follow the standard Prolog strategy, trying first the
|
|
|
|
|
first clause, then the second, the third and finally finding the
|
|
|
|
|
relevant clause. Also, as there are some more clauses after the
|
|
|
|
|
important one, a choice point has to be created, even if we know the
|
|
|
|
|
next clauses will certainly fail. A "cut" would be needed to prevent
|
|
|
|
|
some possible uses for the procedure, like generating all logicians. In
|
|
|
|
|
this situation, the indexing mechanism generates instructions that
|
|
|
|
|
implement a search table. In this table, the value of the first argument
|
|
|
|
|
would be used as a key for fast search of possibly matching clauses. For
|
|
|
|
|
the query of the last example, the result of the search would be just
|
|
|
|
|
the fourth clause, and again there would be no need for a choice point.
|
|
|
|
|
|
|
|
|
|
If the first argument is a complex term, indexation will select clauses
|
|
|
|
|
just by testing its main functor. However, there is an important
|
|
|
|
|
exception: if the first argument of a clause is a list, the algorithm
|
|
|
|
|
also uses the list's head if not a variable. For instance, with the
|
|
|
|
|
following clauses,
|
|
|
|
|
|
|
|
|
|
~~~~~
|
|
|
|
|
rules([],B,B).
|
|
|
|
|
rules([n(N)|T],I,O) :- rules_for_noun(N,I,N), rules(T,N,O).
|
|
|
|
|
rules([v(V)|T],I,O) :- rules_for_verb(V,I,N), rules(T,N,O).
|
|
|
|
|
rules([q(Q)|T],I,O) :- rules_for_qualifier(Q,I,N), rules(T,N,O).
|
|
|
|
|
~~~~~
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if the first argument of the goal is a list, its head will be tested, and only
|
2014-09-11 20:06:57 +01:00
|
|
|
|
the clauses matching it will be tried during execution.
|
|
|
|
|
|
|
|
|
|
Some advice on how to take a good advantage of this mechanism:
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
+
|
2014-09-11 20:06:57 +01:00
|
|
|
|
Try to make the first argument an input argument.
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
+
|
|
|
|
|
Try to keep together all clauses whose first argument is not a
|
|
|
|
|
variable, that will decrease the number of tests since the other clauses are
|
2014-09-11 20:06:57 +01:00
|
|
|
|
always tried.
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
+
|
|
|
|
|
Try to avoid predicates having a lot of clauses with the same key.
|
2014-09-11 20:06:57 +01:00
|
|
|
|
For instance, the procedure:
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
~~~~~
|
|
|
|
|
type(n(mary),person).
|
|
|
|
|
type(n(john), person).
|
|
|
|
|
type(n(chair),object).
|
|
|
|
|
type(v(eat),active).
|
|
|
|
|
type(v(rest),passive).
|
|
|
|
|
~~~~~
|
|
|
|
|
|
|
|
|
|
becomes more efficient with:
|
|
|
|
|
|
|
|
|
|
~~~~~
|
|
|
|
|
type(n(N),T) :- type_of_noun(N,T).
|
|
|
|
|
type(v(V),T) :- type_of_verb(V,T).
|
|
|
|
|
|
|
|
|
|
type_of_noun(mary,person).
|
|
|
|
|
type_of_noun(john,person).
|
|
|
|
|
type_of_noun(chair,object).
|
|
|
|
|
|
|
|
|
|
type_of_verb(eat,active).
|
|
|
|
|
type_of_verb(rest,passive).
|
|
|
|
|
~~~~~
|
|
|
|
|
|
|
|
|
|
*/
|
|
|
|
|
|
2001-04-09 20:54:03 +01:00
|
|
|
|
/*
|
2016-07-31 10:26:15 +01:00
|
|
|
|
* This file compiles and removes the indexation code for the prolog compiler
|
2001-04-09 20:54:03 +01:00
|
|
|
|
*
|
|
|
|
|
* Some remarks: *try_me always point to inside the code;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
* try always points to outside
|
2001-04-09 20:54:03 +01:00
|
|
|
|
*
|
2003-04-30 18:46:05 +01:00
|
|
|
|
|
|
|
|
|
Algorithm:
|
|
|
|
|
|
|
|
|
|
- fetch info on all clauses
|
|
|
|
|
- if #clauses =1 return
|
|
|
|
|
- compute groups:
|
|
|
|
|
seq of variable only clauses
|
|
|
|
|
seq: of one or more type instructions
|
|
|
|
|
bound clauses
|
|
|
|
|
- sort group
|
|
|
|
|
- select constant
|
|
|
|
|
--> type instructions
|
|
|
|
|
--> count constants
|
|
|
|
|
--> switch
|
2016-07-31 10:26:15 +01:00
|
|
|
|
for all arguments:
|
|
|
|
|
select new argument
|
2003-04-30 18:46:05 +01:00
|
|
|
|
|
2001-04-09 20:54:03 +01:00
|
|
|
|
*/
|
|
|
|
|
|
2018-06-15 13:50:55 +01:00
|
|
|
|
#include <absmi.h>
|
|
|
|
|
|
2018-06-15 11:09:04 +01:00
|
|
|
|
#include <Yatom.h>
|
2018-06-15 13:50:55 +01:00
|
|
|
|
|
2017-02-20 14:21:46 +00:00
|
|
|
|
#include "YapCompile.h"
|
2013-11-15 18:25:33 +00:00
|
|
|
|
#if DEBUG
|
2001-04-09 20:54:03 +01:00
|
|
|
|
#include "yapio.h"
|
|
|
|
|
#endif
|
2016-07-31 10:26:15 +01:00
|
|
|
|
|
|
|
|
|
#include "index.h"
|
|
|
|
|
|
2001-04-09 20:54:03 +01:00
|
|
|
|
#ifndef NULL
|
|
|
|
|
#define NULL (void *)0
|
|
|
|
|
#endif
|
2003-04-30 18:46:05 +01:00
|
|
|
|
#if HAVE_STRING_H
|
|
|
|
|
#include <string.h>
|
|
|
|
|
#endif
|
2005-11-18 18:52:41 +00:00
|
|
|
|
#include "cut_c.h"
|
2003-04-30 18:46:05 +01:00
|
|
|
|
|
2012-02-17 15:04:25 +00:00
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
2014-05-30 01:06:09 +01:00
|
|
|
|
#define SET_JLBL(X) jlbl = &(ipc->y_u.X)
|
2012-02-17 15:04:25 +00:00
|
|
|
|
#else
|
|
|
|
|
#define SET_JLBL(X)
|
|
|
|
|
#endif
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static UInt do_index(ClauseDef *, ClauseDef *, struct intermediates *, UInt,
|
|
|
|
|
UInt, int, int, CELL *);
|
|
|
|
|
static UInt do_compound_index(ClauseDef *, ClauseDef *, Term *t,
|
|
|
|
|
struct intermediates *, UInt, UInt, UInt, UInt,
|
|
|
|
|
int, int, int, CELL *, int);
|
|
|
|
|
static UInt do_dbref_index(ClauseDef *, ClauseDef *, Term,
|
|
|
|
|
struct intermediates *, UInt, UInt, int, int,
|
|
|
|
|
CELL *);
|
|
|
|
|
static UInt do_blob_index(ClauseDef *, ClauseDef *, Term,
|
|
|
|
|
struct intermediates *, UInt, UInt, int, int, CELL *,
|
|
|
|
|
int);
|
|
|
|
|
|
|
|
|
|
static UInt cleanup_sw_on_clauses(CELL larg, UInt sz, OPCODE ecls) {
|
2004-04-16 20:27:31 +01:00
|
|
|
|
if (larg & 1) {
|
|
|
|
|
return sz;
|
|
|
|
|
} else {
|
|
|
|
|
yamop *xp = (yamop *)larg;
|
|
|
|
|
if (xp->opc == ecls) {
|
2014-05-30 01:06:09 +01:00
|
|
|
|
if (xp->y_u.sssllp.s3 == 1) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
UInt nsz = sz + (UInt)(NEXTOP((yamop *)NULL, sssllp)) +
|
|
|
|
|
xp->y_u.sssllp.s1 * sizeof(yamop *);
|
|
|
|
|
LOCK(ExpandClausesListLock);
|
|
|
|
|
if (ExpandClausesFirst == xp)
|
|
|
|
|
ExpandClausesFirst = xp->y_u.sssllp.snext;
|
|
|
|
|
if (ExpandClausesLast == xp) {
|
|
|
|
|
ExpandClausesLast = xp->y_u.sssllp.sprev;
|
|
|
|
|
}
|
|
|
|
|
if (xp->y_u.sssllp.sprev) {
|
|
|
|
|
xp->y_u.sssllp.sprev->y_u.sssllp.snext = xp->y_u.sssllp.snext;
|
|
|
|
|
}
|
|
|
|
|
if (xp->y_u.sssllp.snext) {
|
|
|
|
|
xp->y_u.sssllp.snext->y_u.sssllp.sprev = xp->y_u.sssllp.sprev;
|
|
|
|
|
}
|
|
|
|
|
UNLOCK(ExpandClausesListLock);
|
2004-09-03 04:11:09 +01:00
|
|
|
|
#if DEBUG
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_ExpandClauses--;
|
|
|
|
|
Yap_expand_clauses_sz -= (UInt)(NEXTOP((yamop *)NULL, sssllp)) +
|
|
|
|
|
xp->y_u.sssllp.s1 * sizeof(yamop *);
|
2004-09-03 04:11:09 +01:00
|
|
|
|
#endif
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (xp->y_u.sssllp.p->PredFlags & LogUpdatePredFlag) {
|
|
|
|
|
Yap_LUIndexSpace_EXT -= (UInt)NEXTOP((yamop *)NULL, sssllp) +
|
|
|
|
|
xp->y_u.sssllp.s1 * sizeof(yamop *);
|
|
|
|
|
} else
|
|
|
|
|
Yap_IndexSpace_EXT -= (UInt)(NEXTOP((yamop *)NULL, sssllp)) +
|
|
|
|
|
xp->y_u.sssllp.s1 * sizeof(yamop *);
|
|
|
|
|
Yap_FreeCodeSpace((char *)xp);
|
|
|
|
|
return nsz;
|
2004-04-16 20:27:31 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
xp->y_u.sssllp.s3--;
|
|
|
|
|
return sz;
|
2004-04-16 20:27:31 +01:00
|
|
|
|
}
|
|
|
|
|
} else {
|
|
|
|
|
return sz;
|
2004-08-27 21:18:52 +01:00
|
|
|
|
}
|
2004-04-16 20:27:31 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static UInt recover_from_failed_susp_on_cls(struct intermediates *cint,
|
|
|
|
|
UInt sz) {
|
2004-04-16 20:27:31 +01:00
|
|
|
|
/* we have to recover all allocated blocks,
|
|
|
|
|
just follow the code through. */
|
|
|
|
|
struct PSEUDO *cpc = cint->CodeStart;
|
|
|
|
|
OPCODE ecls = Yap_opcode(_expand_clauses);
|
2015-01-06 17:47:58 +00:00
|
|
|
|
pred_flags_t log_upd_pred = cint->CurrentPred->PredFlags & LogUpdatePredFlag;
|
2004-04-16 20:27:31 +01:00
|
|
|
|
|
|
|
|
|
while (cpc) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
switch (cpc->op) {
|
2009-02-09 21:56:40 +00:00
|
|
|
|
case enter_lu_op:
|
|
|
|
|
if (cpc->rnd4) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
yamop *code_p = (yamop *)cpc->rnd4;
|
|
|
|
|
yamop *first = code_p->y_u.Illss.l1;
|
|
|
|
|
yamop *last = code_p->y_u.Illss.l2;
|
|
|
|
|
while (first) {
|
|
|
|
|
yamop *next = first->y_u.OtaLl.n;
|
|
|
|
|
LogUpdClause *cl = first->y_u.OtaLl.d;
|
|
|
|
|
cl->ClRefCount--;
|
|
|
|
|
Yap_FreeCodeSpace((char *)first);
|
|
|
|
|
if (first == last)
|
|
|
|
|
break;
|
|
|
|
|
first = next;
|
|
|
|
|
}
|
2009-02-09 21:56:40 +00:00
|
|
|
|
}
|
|
|
|
|
cpc->rnd4 = Zero;
|
|
|
|
|
break;
|
2004-04-16 20:27:31 +01:00
|
|
|
|
case jump_v_op:
|
|
|
|
|
case jump_nv_op:
|
2004-08-27 21:18:52 +01:00
|
|
|
|
sz = cleanup_sw_on_clauses(cpc->rnd1, sz, ecls);
|
2004-04-16 20:27:31 +01:00
|
|
|
|
break;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
case switch_on_type_op: {
|
|
|
|
|
TypeSwitch *type_sw = (TypeSwitch *)(cpc->arnds);
|
|
|
|
|
sz = cleanup_sw_on_clauses(type_sw->PairEntry, sz, ecls);
|
|
|
|
|
sz = cleanup_sw_on_clauses(type_sw->ConstEntry, sz, ecls);
|
|
|
|
|
sz = cleanup_sw_on_clauses(type_sw->FuncEntry, sz, ecls);
|
|
|
|
|
sz = cleanup_sw_on_clauses(type_sw->VarEntry, sz, ecls);
|
|
|
|
|
} break;
|
2004-04-16 20:27:31 +01:00
|
|
|
|
case switch_c_op:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
case if_c_op: {
|
|
|
|
|
AtomSwiEntry *target = (AtomSwiEntry *)(cpc->rnd2);
|
|
|
|
|
int cases = cpc->rnd1, i;
|
|
|
|
|
|
|
|
|
|
for (i = 0; i < cases; i++) {
|
|
|
|
|
sz = cleanup_sw_on_clauses(target[i].u_a.Label, sz, ecls);
|
|
|
|
|
}
|
|
|
|
|
if (log_upd_pred) {
|
|
|
|
|
LogUpdIndex *lcl = ClauseCodeToLogUpdIndex(cpc->rnd2);
|
|
|
|
|
sz += sizeof(LogUpdIndex) + cases * sizeof(AtomSwiEntry);
|
|
|
|
|
Yap_LUIndexSpace_SW -=
|
|
|
|
|
sizeof(LogUpdIndex) + cases * sizeof(AtomSwiEntry);
|
|
|
|
|
Yap_FreeCodeSpace((char *)lcl);
|
|
|
|
|
} else {
|
|
|
|
|
StaticIndex *scl = ClauseCodeToStaticIndex(cpc->rnd2);
|
|
|
|
|
sz += sizeof(StaticIndex) + cases * sizeof(AtomSwiEntry);
|
|
|
|
|
Yap_IndexSpace_SW -= sizeof(StaticIndex) + cases * sizeof(AtomSwiEntry);
|
|
|
|
|
Yap_FreeCodeSpace((char *)scl);
|
2004-04-16 20:27:31 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
} break;
|
2004-04-16 20:27:31 +01:00
|
|
|
|
case switch_f_op:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
case if_f_op: {
|
|
|
|
|
FuncSwiEntry *target = (FuncSwiEntry *)(cpc->rnd2);
|
|
|
|
|
int cases = cpc->rnd1, i;
|
|
|
|
|
|
|
|
|
|
for (i = 0; i < cases; i++) {
|
|
|
|
|
sz = cleanup_sw_on_clauses(target[i].u_f.Label, sz, ecls);
|
|
|
|
|
}
|
|
|
|
|
if (log_upd_pred) {
|
|
|
|
|
LogUpdIndex *lcl = ClauseCodeToLogUpdIndex(cpc->rnd2);
|
|
|
|
|
sz += sizeof(LogUpdIndex) + cases * sizeof(FuncSwiEntry);
|
|
|
|
|
Yap_LUIndexSpace_SW -=
|
|
|
|
|
sizeof(LogUpdIndex) + cases * sizeof(FuncSwiEntry);
|
|
|
|
|
Yap_FreeCodeSpace((char *)lcl);
|
|
|
|
|
} else {
|
|
|
|
|
StaticIndex *scl = ClauseCodeToStaticIndex(cpc->rnd2);
|
|
|
|
|
Yap_IndexSpace_SW -= sizeof(StaticIndex) + cases * sizeof(FuncSwiEntry);
|
|
|
|
|
sz += sizeof(StaticIndex) + cases * sizeof(FuncSwiEntry);
|
|
|
|
|
Yap_FreeCodeSpace((char *)scl);
|
2004-04-16 20:27:31 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
} break;
|
2004-04-16 20:27:31 +01:00
|
|
|
|
default:
|
|
|
|
|
break;
|
|
|
|
|
}
|
|
|
|
|
cpc = cpc->nextInst;
|
|
|
|
|
}
|
2010-04-15 11:37:39 +01:00
|
|
|
|
Yap_ReleaseCMem(cint);
|
2009-02-09 21:56:40 +00:00
|
|
|
|
if (cint->code_addr) {
|
|
|
|
|
Yap_FreeCodeSpace((char *)cint->code_addr);
|
|
|
|
|
cint->code_addr = NULL;
|
|
|
|
|
}
|
2004-04-16 20:27:31 +01:00
|
|
|
|
return sz;
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static inline int smaller(Term t1, Term t2) {
|
2008-01-30 10:35:43 +00:00
|
|
|
|
CELL tg1 = LowTagOf(t1), tg2 = LowTagOf(t2);
|
2003-06-06 14:16:40 +01:00
|
|
|
|
if (tg1 == tg2) {
|
|
|
|
|
return t1 < t2;
|
|
|
|
|
} else
|
|
|
|
|
return tg1 < tg2;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static inline int smaller_or_eq(Term t1, Term t2) {
|
2008-01-30 10:35:43 +00:00
|
|
|
|
CELL tg1 = LowTagOf(t1), tg2 = LowTagOf(t2);
|
2003-06-06 14:16:40 +01:00
|
|
|
|
if (tg1 == tg2) {
|
|
|
|
|
return t1 <= t2;
|
|
|
|
|
} else
|
|
|
|
|
return tg1 < tg2;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static inline void clcpy(ClauseDef *d, ClauseDef *s) {
|
2018-06-30 14:33:32 +01:00
|
|
|
|
memmove((void *)d, (void *)s, sizeof(ClauseDef));
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void insort(ClauseDef base[], CELL *p, CELL *q, int my_p) {
|
2003-06-06 12:54:02 +01:00
|
|
|
|
CELL *j;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
|
2003-06-06 12:54:02 +01:00
|
|
|
|
if (my_p) {
|
|
|
|
|
p[1] = p[0];
|
2004-04-14 20:10:40 +01:00
|
|
|
|
for (j = p; j < q; j += 2) {
|
2003-06-06 12:54:02 +01:00
|
|
|
|
Term key;
|
|
|
|
|
Int off = *j;
|
|
|
|
|
CELL *i;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
|
2003-06-06 12:54:02 +01:00
|
|
|
|
key = base[off].Tag;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
i = j + 1;
|
|
|
|
|
|
2003-06-06 12:54:02 +01:00
|
|
|
|
/* we are at offset 1 */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
while (i > p + 1 && smaller(key, base[i[-2]].Tag)) {
|
|
|
|
|
i[0] = i[-2];
|
|
|
|
|
i -= 2;
|
2003-06-06 12:54:02 +01:00
|
|
|
|
}
|
|
|
|
|
i[0] = off;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
2003-06-06 12:54:02 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
for (j = p + 2; j < q; j += 2) {
|
2003-06-06 12:54:02 +01:00
|
|
|
|
Term key;
|
|
|
|
|
Int off = *j;
|
|
|
|
|
CELL *i;
|
|
|
|
|
|
|
|
|
|
key = base[off].Tag;
|
|
|
|
|
i = j;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
|
2003-06-06 12:54:02 +01:00
|
|
|
|
/* we are at offset 1 */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
while (i > p && smaller(key, base[i[-2]].Tag)) {
|
|
|
|
|
i[0] = i[-2];
|
|
|
|
|
i -= 2;
|
2003-06-06 12:54:02 +01:00
|
|
|
|
}
|
|
|
|
|
i[0] = off;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2003-06-06 12:54:02 +01:00
|
|
|
|
/* copy to a new list of terms */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void msort(ClauseDef *base, CELL *pt, Int size, int my_p) {
|
2003-06-06 12:54:02 +01:00
|
|
|
|
|
|
|
|
|
if (size > 2) {
|
|
|
|
|
Int half_size = size / 2;
|
2005-07-05 19:32:32 +01:00
|
|
|
|
CELL *pt_left, *pt_right, *end_pt, *end_pt_left;
|
2003-06-06 12:54:02 +01:00
|
|
|
|
int left_p, right_p;
|
|
|
|
|
|
|
|
|
|
if (size < 50) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
insort(base, pt, pt + 2 * size, my_p);
|
|
|
|
|
return;
|
2003-06-06 12:54:02 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
pt_right = pt + half_size * 2;
|
|
|
|
|
left_p = my_p ^ 1;
|
2003-06-06 12:54:02 +01:00
|
|
|
|
right_p = my_p;
|
|
|
|
|
msort(base, pt, half_size, left_p);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
msort(base, pt_right, size - half_size, right_p);
|
2003-06-06 12:54:02 +01:00
|
|
|
|
/* now implement a simple merge routine */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
|
2003-06-06 12:54:02 +01:00
|
|
|
|
/* pointer to after the end of the list */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
end_pt = pt + 2 * size;
|
2003-06-06 12:54:02 +01:00
|
|
|
|
/* pointer to the element after the last element to the left */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
end_pt_left = pt + half_size * 2;
|
2003-06-06 12:54:02 +01:00
|
|
|
|
/* where is left list */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
pt_left = pt + left_p;
|
2003-06-06 12:54:02 +01:00
|
|
|
|
/* where is right list */
|
|
|
|
|
pt_right += right_p;
|
|
|
|
|
/* where is new list */
|
|
|
|
|
pt += my_p;
|
|
|
|
|
/* while there are elements in the left or right vector do compares */
|
|
|
|
|
while (pt_left < end_pt_left && pt_right < end_pt) {
|
|
|
|
|
/* if the element to the left is larger than the one to the right */
|
|
|
|
|
if (smaller_or_eq(base[pt_left[0]].Tag, base[pt_right[0]].Tag)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* copy the one to the left */
|
|
|
|
|
pt[0] = pt_left[0];
|
|
|
|
|
/* and avance the two pointers */
|
|
|
|
|
pt += 2;
|
|
|
|
|
pt_left += 2;
|
2003-06-06 12:54:02 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* otherwise, copy the one to the right */
|
|
|
|
|
pt[0] = pt_right[0];
|
|
|
|
|
pt += 2;
|
|
|
|
|
pt_right += 2;
|
2003-06-06 12:54:02 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
/* if any elements were left in the left vector just copy them */
|
|
|
|
|
while (pt_left < end_pt_left) {
|
|
|
|
|
pt[0] = pt_left[0];
|
|
|
|
|
pt += 2;
|
|
|
|
|
pt_left += 2;
|
|
|
|
|
}
|
|
|
|
|
/* if any elements were left in the right vector
|
|
|
|
|
and they are in the wrong place, just copy them */
|
|
|
|
|
if (my_p != right_p) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
while (pt_right < end_pt) {
|
|
|
|
|
pt[0] = pt_right[0];
|
|
|
|
|
pt += 2;
|
|
|
|
|
pt_right += 2;
|
2003-06-06 12:54:02 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (size > 1 && smaller(base[pt[2]].Tag, base[pt[0]].Tag)) {
|
2003-06-06 12:54:02 +01:00
|
|
|
|
CELL t = pt[2];
|
2016-07-31 10:26:15 +01:00
|
|
|
|
pt[2 + my_p] = pt[0];
|
2003-06-06 12:54:02 +01:00
|
|
|
|
pt[my_p] = t;
|
|
|
|
|
} else if (my_p) {
|
|
|
|
|
pt[1] = pt[0];
|
|
|
|
|
if (size > 1)
|
2016-07-31 10:26:15 +01:00
|
|
|
|
pt[3] = pt[2];
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void copy_back(ClauseDef *dest, CELL *pt, int max) {
|
2003-06-06 12:54:02 +01:00
|
|
|
|
/* first need to say that we had no need to make a copy */
|
|
|
|
|
int i;
|
|
|
|
|
CELL *tmp = pt;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
for (i = 0; i < max; i++) {
|
2003-06-06 12:54:02 +01:00
|
|
|
|
if (*tmp != i) {
|
|
|
|
|
ClauseDef cl;
|
|
|
|
|
int j = i;
|
|
|
|
|
CELL *pnt = tmp;
|
|
|
|
|
|
|
|
|
|
/* found a chain */
|
|
|
|
|
/* make a backup copy */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clcpy(&cl, dest + i);
|
2003-06-06 12:54:02 +01:00
|
|
|
|
do {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* follow the chain */
|
|
|
|
|
int k = *pnt;
|
|
|
|
|
|
|
|
|
|
*pnt = j;
|
|
|
|
|
/* printf("i=%d, k = %d, j = %d\n",i,j,k); */
|
|
|
|
|
if (k == i) {
|
|
|
|
|
clcpy(dest + j, &cl);
|
|
|
|
|
break;
|
|
|
|
|
} else {
|
|
|
|
|
clcpy(dest + j, dest + k);
|
|
|
|
|
}
|
|
|
|
|
pnt = pt + 2 * k;
|
|
|
|
|
j = k;
|
2003-06-06 12:54:02 +01:00
|
|
|
|
} while (TRUE);
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
2003-06-06 12:54:02 +01:00
|
|
|
|
/* we don't need to do swap */
|
|
|
|
|
tmp += 2;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2003-04-30 18:46:05 +01:00
|
|
|
|
/* sort a group of clauses by using their tags */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void sort_group(GroupDef *grp, CELL *top, struct intermediates *cint) {
|
|
|
|
|
int max = (grp->LastClause - grp->FirstClause) + 1, i;
|
2010-03-31 15:51:18 +01:00
|
|
|
|
CELL *pt, *base;
|
2003-06-06 12:54:02 +01:00
|
|
|
|
|
2004-02-05 16:57:02 +00:00
|
|
|
|
#if USE_SYSTEM_MALLOC
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (!(base = (CELL *)Yap_AllocCodeSpace(2 * max * sizeof(CELL)))) {
|
2011-03-07 16:02:55 +00:00
|
|
|
|
CACHE_REGS
|
2005-12-23 00:20:14 +00:00
|
|
|
|
save_machine_regs();
|
2016-07-31 10:26:15 +01:00
|
|
|
|
LOCAL_Error_Size = 2 * max * sizeof(CELL);
|
|
|
|
|
siglongjmp(cint->CompilerBotch, 2);
|
2010-03-31 15:51:18 +01:00
|
|
|
|
}
|
2004-02-05 16:57:02 +00:00
|
|
|
|
#else
|
2010-03-31 15:51:18 +01:00
|
|
|
|
base = top;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
while (top + 2 * max > (CELL *)LOCAL_TrailTop) {
|
|
|
|
|
if (!Yap_growtrail(2 * max * CellSize, TRUE)) {
|
|
|
|
|
LOCAL_Error_Size = 2 * max * CellSize;
|
2005-12-23 00:20:14 +00:00
|
|
|
|
save_machine_regs();
|
2016-07-31 10:26:15 +01:00
|
|
|
|
siglongjmp(cint->CompilerBotch, 4);
|
2003-06-06 12:54:02 +01:00
|
|
|
|
return;
|
|
|
|
|
}
|
|
|
|
|
}
|
2010-03-31 15:51:18 +01:00
|
|
|
|
#endif
|
|
|
|
|
pt = base;
|
2015-11-05 16:38:18 +00:00
|
|
|
|
/* initialize vector */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
for (i = 0; i < max; i++) {
|
2003-06-06 12:54:02 +01:00
|
|
|
|
*pt = i;
|
|
|
|
|
pt += 2;
|
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
#define M_EVEN 0
|
2010-03-31 15:51:18 +01:00
|
|
|
|
msort(grp->FirstClause, base, max, M_EVEN);
|
|
|
|
|
copy_back(grp->FirstClause, base, max);
|
|
|
|
|
#if USE_SYSTEM_MALLOC
|
|
|
|
|
Yap_FreeCodeSpace((ADDR)base);
|
|
|
|
|
#endif
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2003-04-30 18:46:05 +01:00
|
|
|
|
/* add copy to register stack for original reg */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static int init_regcopy(wamreg regs[MAX_REG_COPIES], wamreg copy) {
|
2008-12-29 00:14:47 +00:00
|
|
|
|
regs[0] = copy;
|
|
|
|
|
return 1;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2003-06-06 12:54:02 +01:00
|
|
|
|
/* add copy to register stack for original reg */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static int is_regcopy(wamreg regs[MAX_REG_COPIES], int regs_count,
|
|
|
|
|
wamreg copy) {
|
2008-12-29 00:14:47 +00:00
|
|
|
|
int i = 0;
|
|
|
|
|
while (i < regs_count) {
|
|
|
|
|
if (regs[i] == copy) {
|
|
|
|
|
return TRUE;
|
|
|
|
|
}
|
|
|
|
|
i++;
|
|
|
|
|
}
|
|
|
|
|
/* this copy had overflowed, or it just was not there */
|
|
|
|
|
return FALSE;
|
2003-06-06 12:54:02 +01:00
|
|
|
|
}
|
|
|
|
|
|
2003-04-30 18:46:05 +01:00
|
|
|
|
/* add copy to register stack for original reg */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static int delete_regcopy(wamreg regs[MAX_REG_COPIES], int regs_count,
|
|
|
|
|
wamreg copy) {
|
2003-04-30 18:46:05 +01:00
|
|
|
|
int i = 0;
|
|
|
|
|
while (i < regs_count) {
|
|
|
|
|
if (regs[i] == copy) {
|
|
|
|
|
/* we found it */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
regs[i] = regs[regs_count - 1];
|
|
|
|
|
return regs_count - 1;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
|
|
|
|
i++;
|
|
|
|
|
}
|
2003-05-23 13:31:50 +01:00
|
|
|
|
/* this copy had overflowed, or it just was not there */
|
2003-04-30 18:46:05 +01:00
|
|
|
|
return regs_count;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2008-12-29 00:14:47 +00:00
|
|
|
|
/* add copy to register stack for original reg */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static int add_regcopy(wamreg regs[MAX_REG_COPIES], int regs_count, Int source,
|
|
|
|
|
Int copy) {
|
2008-12-29 00:14:47 +00:00
|
|
|
|
int i = 0;
|
|
|
|
|
while (i < regs_count) {
|
|
|
|
|
if (regs[i] == source) {
|
|
|
|
|
/* we found it, add new element as last element */
|
|
|
|
|
if (regs_count == MAX_REG_COPIES) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return regs_count;
|
2008-12-29 00:14:47 +00:00
|
|
|
|
}
|
|
|
|
|
regs[regs_count] = copy;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return regs_count + 1;
|
2008-12-29 00:14:47 +00:00
|
|
|
|
}
|
|
|
|
|
i++;
|
|
|
|
|
}
|
|
|
|
|
/* be careful: we may overwrite an existing copy */
|
|
|
|
|
return delete_regcopy(regs, regs_count, copy);
|
|
|
|
|
}
|
|
|
|
|
|
2003-04-30 18:46:05 +01:00
|
|
|
|
/* add copy to register stack for original reg */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
inline static int link_regcopies(wamreg regs[MAX_REG_COPIES], int regs_count,
|
|
|
|
|
Int c1, Int c2) {
|
2006-11-27 17:42:03 +00:00
|
|
|
|
int i;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
for (i = 0; i < regs_count; i++) {
|
2008-12-29 00:14:47 +00:00
|
|
|
|
if (regs[i] == c1) {
|
|
|
|
|
return add_regcopy(regs, regs_count, c1, c2);
|
|
|
|
|
}
|
|
|
|
|
if (regs[i] == c2) {
|
|
|
|
|
return add_regcopy(regs, regs_count, c2, c1);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
2006-11-27 17:42:03 +00:00
|
|
|
|
}
|
2003-04-30 18:46:05 +01:00
|
|
|
|
/* this copy could not be found */
|
2008-12-29 00:14:47 +00:00
|
|
|
|
regs_count = delete_regcopy(regs, regs_count, c1);
|
|
|
|
|
return delete_regcopy(regs, regs_count, c2);
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void add_info(ClauseDef *clause, UInt regno) {
|
2003-04-30 18:46:05 +01:00
|
|
|
|
wamreg myregs[MAX_REG_COPIES];
|
|
|
|
|
int nofregs;
|
|
|
|
|
yamop *cl;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
|
2003-06-06 12:54:02 +01:00
|
|
|
|
nofregs = init_regcopy(myregs, Yap_regnotoreg(regno));
|
2003-04-30 18:46:05 +01:00
|
|
|
|
cl = clause->CurrentCode;
|
2008-12-29 00:14:47 +00:00
|
|
|
|
#include "findclause.h"
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void add_head_info(ClauseDef *clause, UInt regno) {
|
2008-12-29 00:14:47 +00:00
|
|
|
|
wamreg iarg = Yap_regnotoreg(regno);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
|
|
|
|
|
yamop *cl = clause->CurrentCode;
|
2008-12-29 00:14:47 +00:00
|
|
|
|
#include "headclause.h"
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void move_next(ClauseDef *clause, UInt regno) {
|
2003-04-30 18:46:05 +01:00
|
|
|
|
yamop *cl = clause->CurrentCode;
|
|
|
|
|
wamreg wreg = Yap_regnotoreg(regno);
|
|
|
|
|
op_numbers op = Yap_op_from_opcode(cl->opc);
|
|
|
|
|
|
|
|
|
|
switch (op) {
|
2015-01-20 03:00:42 +00:00
|
|
|
|
#if YAP_JIT
|
|
|
|
|
case _jit_handler:
|
2009-04-08 00:32:36 +01:00
|
|
|
|
return;
|
2015-01-20 03:00:42 +00:00
|
|
|
|
#endif
|
2014-10-20 23:47:33 +01:00
|
|
|
|
#if THREADS
|
|
|
|
|
case _unlock_lu:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clause->CurrentCode = NEXTOP(cl, e);
|
2014-10-20 23:47:33 +01:00
|
|
|
|
return;
|
|
|
|
|
#endif
|
2003-04-30 18:46:05 +01:00
|
|
|
|
case _p_db_ref_x:
|
|
|
|
|
case _p_float_x:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
if (wreg == cl->y_u.xl.x) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clause->CurrentCode = NEXTOP(cl, xl);
|
|
|
|
|
}
|
2001-04-09 20:54:03 +01:00
|
|
|
|
return;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
case _get_list:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
if (wreg == cl->y_u.x.x) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clause->CurrentCode = NEXTOP(cl, x);
|
|
|
|
|
}
|
2001-04-09 20:54:03 +01:00
|
|
|
|
return;
|
2003-10-02 13:59:05 +01:00
|
|
|
|
case _glist_valx:
|
|
|
|
|
case _gl_void_vary:
|
|
|
|
|
case _gl_void_valy:
|
|
|
|
|
case _gl_void_varx:
|
|
|
|
|
case _gl_void_valx:
|
|
|
|
|
case _glist_valy:
|
|
|
|
|
return;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
case _get_atom:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
if (wreg == cl->y_u.xc.x) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clause->CurrentCode = NEXTOP(cl, xc);
|
|
|
|
|
}
|
2001-04-09 20:54:03 +01:00
|
|
|
|
return;
|
2004-09-27 21:45:04 +01:00
|
|
|
|
case _get_2atoms:
|
|
|
|
|
return;
|
|
|
|
|
case _get_3atoms:
|
|
|
|
|
return;
|
|
|
|
|
case _get_4atoms:
|
|
|
|
|
return;
|
|
|
|
|
case _get_5atoms:
|
|
|
|
|
return;
|
|
|
|
|
case _get_6atoms:
|
|
|
|
|
return;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/*
|
|
|
|
|
matching is not guaranteed:
|
|
|
|
|
case _get_float:
|
|
|
|
|
case _get_longint:
|
|
|
|
|
case _get_bigint:
|
|
|
|
|
*/
|
2003-04-30 18:46:05 +01:00
|
|
|
|
case _get_struct:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
if (wreg == cl->y_u.xfa.x) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clause->CurrentCode = NEXTOP(cl, xfa);
|
|
|
|
|
}
|
2001-04-09 20:54:03 +01:00
|
|
|
|
default:
|
2003-10-02 13:59:05 +01:00
|
|
|
|
clause->CurrentCode = clause->Code;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
return;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void add_arg_info(ClauseDef *clause, PredEntry *ap, UInt argno) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
yamop *cl;
|
2004-02-12 12:37:12 +00:00
|
|
|
|
if (ap->ModuleOfPred == IDB_MODULE) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
cl = clause->Code;
|
|
|
|
|
} else {
|
2014-02-18 09:44:01 +00:00
|
|
|
|
cl = clause->ucd.WorkPC;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2003-04-30 18:46:05 +01:00
|
|
|
|
while (TRUE) {
|
|
|
|
|
op_numbers op = Yap_op_from_opcode(cl->opc);
|
|
|
|
|
switch (op) {
|
|
|
|
|
case _glist_valx:
|
|
|
|
|
if (argno == 1) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clause->Tag = (CELL)NULL;
|
|
|
|
|
return;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
|
|
|
|
argno--;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, xx);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
break;
|
|
|
|
|
case _gl_void_vary:
|
|
|
|
|
case _gl_void_valy:
|
|
|
|
|
case _gl_void_varx:
|
|
|
|
|
case _gl_void_valx:
|
|
|
|
|
clause->Tag = (CELL)NULL;
|
|
|
|
|
return;
|
|
|
|
|
case _glist_valy:
|
|
|
|
|
if (argno == 1) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clause->Tag = (CELL)NULL;
|
|
|
|
|
return;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
2006-05-02 17:39:06 +01:00
|
|
|
|
argno = 2;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, yx);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
break;
|
|
|
|
|
case _unify_l_x_var:
|
|
|
|
|
case _unify_l_x_val:
|
|
|
|
|
case _unify_l_x_loc:
|
|
|
|
|
case _unify_x_var:
|
|
|
|
|
case _unify_x_val:
|
|
|
|
|
case _unify_x_loc:
|
|
|
|
|
if (argno == 1) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clause->Tag = (CELL)NULL;
|
|
|
|
|
return;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
|
|
|
|
argno--;
|
|
|
|
|
case _unify_l_x_var_write:
|
|
|
|
|
case _unify_l_x_val_write:
|
|
|
|
|
case _unify_l_x_loc_write:
|
|
|
|
|
case _unify_x_var_write:
|
|
|
|
|
case _unify_x_val_write:
|
|
|
|
|
case _unify_x_loc_write:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, ox);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
break;
|
|
|
|
|
case _save_pair_x_write:
|
|
|
|
|
case _save_pair_x:
|
|
|
|
|
case _save_appl_x_write:
|
|
|
|
|
case _save_appl_x:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, ox);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
break;
|
|
|
|
|
case _unify_l_x_var2:
|
|
|
|
|
case _unify_x_var2:
|
|
|
|
|
if (argno == 1 || argno == 2) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clause->Tag = (CELL)NULL;
|
|
|
|
|
return;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
|
|
|
|
argno -= 2;
|
|
|
|
|
case _unify_l_x_var2_write:
|
|
|
|
|
case _unify_x_var2_write:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, oxx);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
break;
|
|
|
|
|
case _unify_y_var:
|
|
|
|
|
case _unify_y_val:
|
|
|
|
|
case _unify_y_loc:
|
|
|
|
|
case _unify_l_y_var:
|
|
|
|
|
case _unify_l_y_val:
|
|
|
|
|
case _unify_l_y_loc:
|
|
|
|
|
/* we're just done with the head of a list, but there
|
2016-07-31 10:26:15 +01:00
|
|
|
|
is nothing inside.
|
2003-04-30 18:46:05 +01:00
|
|
|
|
*/
|
|
|
|
|
if (argno == 1) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clause->Tag = (CELL)NULL;
|
|
|
|
|
return;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
|
|
|
|
argno--;
|
|
|
|
|
case _unify_y_var_write:
|
|
|
|
|
case _unify_y_val_write:
|
|
|
|
|
case _unify_y_loc_write:
|
|
|
|
|
case _unify_l_y_var_write:
|
|
|
|
|
case _unify_l_y_val_write:
|
|
|
|
|
case _unify_l_y_loc_write:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, oy);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
break;
|
|
|
|
|
case _save_pair_y_write:
|
|
|
|
|
case _save_pair_y:
|
|
|
|
|
case _save_appl_y_write:
|
|
|
|
|
case _save_appl_y:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, oy);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
break;
|
|
|
|
|
case _unify_l_void:
|
|
|
|
|
case _unify_void:
|
|
|
|
|
if (argno == 1) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clause->Tag = (CELL)NULL;
|
|
|
|
|
return;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
|
|
|
|
argno--;
|
|
|
|
|
case _unify_l_void_write:
|
|
|
|
|
case _unify_void_write:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, o);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
break;
|
|
|
|
|
case _unify_list:
|
|
|
|
|
case _unify_l_list:
|
|
|
|
|
if (argno == 1) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clause->Tag = AbsPair(NULL);
|
|
|
|
|
clause->ucd.WorkPC = NEXTOP(cl, o);
|
|
|
|
|
return;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
|
|
|
|
argno += 1; /* 2-1: have two extra arguments to skip */
|
|
|
|
|
case _unify_list_write:
|
|
|
|
|
case _unify_l_list_write:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, o);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
break;
|
|
|
|
|
case _unify_n_voids:
|
|
|
|
|
case _unify_l_n_voids:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
if (argno <= cl->y_u.os.s) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clause->Tag = (CELL)NULL;
|
|
|
|
|
return;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
2014-05-30 01:06:09 +01:00
|
|
|
|
argno -= cl->y_u.os.s;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
case _unify_n_voids_write:
|
|
|
|
|
case _unify_l_n_voids_write:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, os);
|
|
|
|
|
break;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
case _unify_atom:
|
|
|
|
|
case _unify_l_atom:
|
|
|
|
|
if (argno == 1) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clause->Tag = cl->y_u.oc.c;
|
|
|
|
|
return;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
|
|
|
|
argno--;
|
|
|
|
|
case _unify_atom_write:
|
|
|
|
|
case _unify_l_atom_write:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, oc);
|
|
|
|
|
break;
|
2006-09-20 21:03:51 +01:00
|
|
|
|
case _unify_float_write:
|
|
|
|
|
case _unify_l_float_write:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, od);
|
|
|
|
|
break;
|
2003-10-08 01:47:04 +01:00
|
|
|
|
case _unify_float:
|
2003-04-30 18:46:05 +01:00
|
|
|
|
case _unify_l_float:
|
|
|
|
|
if (argno == 1) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clause->Tag = AbsAppl((CELL *)FunctorDouble);
|
|
|
|
|
clause->ucd.t_ptr = AbsAppl(cl->y_u.od.d);
|
|
|
|
|
return;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, od);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
argno--;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
case _unify_longint:
|
|
|
|
|
case _unify_l_longint:
|
|
|
|
|
if (argno == 1) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clause->Tag = AbsAppl((CELL *)FunctorLongInt);
|
|
|
|
|
clause->ucd.t_ptr = AbsAppl(cl->y_u.oi.i);
|
|
|
|
|
return;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
|
|
|
|
argno--;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, oi);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
case _unify_bigint:
|
|
|
|
|
case _unify_l_bigint:
|
|
|
|
|
if (argno == 1) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clause->Tag = AbsAppl((CELL *)FunctorBigInt);
|
|
|
|
|
clause->ucd.t_ptr = cl->y_u.oc.c;
|
|
|
|
|
return;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, oc);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
argno--;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
2013-12-02 14:49:41 +00:00
|
|
|
|
case _unify_string:
|
|
|
|
|
case _unify_l_string:
|
|
|
|
|
if (argno == 1) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clause->Tag = AbsAppl((CELL *)FunctorString);
|
|
|
|
|
clause->ucd.t_ptr = cl->y_u.ou.ut;
|
|
|
|
|
return;
|
2013-12-02 14:49:41 +00:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, ou);
|
2013-12-02 14:49:41 +00:00
|
|
|
|
argno--;
|
|
|
|
|
break;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
case _unify_n_atoms:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
if (argno <= cl->y_u.osc.s) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clause->Tag = cl->y_u.osc.c;
|
|
|
|
|
return;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
2014-05-30 01:06:09 +01:00
|
|
|
|
argno -= cl->y_u.osc.s;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
case _unify_n_atoms_write:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, osc);
|
|
|
|
|
break;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
case _unify_struct:
|
|
|
|
|
case _unify_l_struc:
|
|
|
|
|
if (argno == 1) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clause->Tag = AbsAppl((CELL *)cl->y_u.ofa.f);
|
|
|
|
|
clause->ucd.WorkPC = NEXTOP(cl, ofa);
|
|
|
|
|
return;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
2006-05-02 17:39:06 +01:00
|
|
|
|
/* must skip next n arguments */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
argno += cl->y_u.ofa.a - 1;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
case _unify_l_struc_write:
|
|
|
|
|
case _unify_struct_write:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, ofa);
|
|
|
|
|
break;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
case _pop:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, e);
|
|
|
|
|
break;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
case _pop_n:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, s);
|
|
|
|
|
break;
|
2006-03-24 17:13:41 +00:00
|
|
|
|
#ifdef BEAM
|
|
|
|
|
case _run_eam:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, os);
|
2006-03-24 17:13:41 +00:00
|
|
|
|
break;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
#endif
|
2014-10-20 23:47:33 +01:00
|
|
|
|
#ifdef THREADS
|
|
|
|
|
case _unlock_lu:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, e);
|
2014-10-20 23:47:33 +01:00
|
|
|
|
break;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
#endif
|
2007-11-06 17:02:13 +00:00
|
|
|
|
case _get_dbterm:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, xc);
|
|
|
|
|
break;
|
2007-11-08 15:52:15 +00:00
|
|
|
|
case _unify_dbterm:
|
|
|
|
|
case _unify_l_dbterm:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, oc);
|
|
|
|
|
break;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _unify_idb_term:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
case _copy_idb_term: {
|
|
|
|
|
Term t = clause->ucd.c_sreg[argno];
|
|
|
|
|
|
|
|
|
|
if (IsVarTerm(t)) {
|
|
|
|
|
clause->Tag = (CELL)NULL;
|
|
|
|
|
} else if (IsApplTerm(t)) {
|
|
|
|
|
CELL *pt = RepAppl(t);
|
|
|
|
|
|
|
|
|
|
clause->Tag = AbsAppl((CELL *)pt[0]);
|
|
|
|
|
if (IsExtensionFunctor(FunctorOfTerm(t))) {
|
|
|
|
|
clause->ucd.t_ptr = t;
|
|
|
|
|
} else {
|
|
|
|
|
clause->ucd.c_sreg = pt;
|
|
|
|
|
}
|
|
|
|
|
} else if (IsPairTerm(t)) {
|
|
|
|
|
CELL *pt = RepPair(t);
|
|
|
|
|
|
|
|
|
|
clause->Tag = AbsPair(NULL);
|
|
|
|
|
clause->ucd.c_sreg = pt - 1;
|
|
|
|
|
} else {
|
|
|
|
|
clause->Tag = t;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
return;
|
|
|
|
|
default:
|
|
|
|
|
return;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
2001-04-09 20:54:03 +01:00
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void skip_to_arg(ClauseDef *clause, PredEntry *ap, UInt argno,
|
|
|
|
|
int at_point) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
yamop *cl;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
int done = FALSE;
|
2004-02-12 12:37:12 +00:00
|
|
|
|
if (ap->ModuleOfPred == IDB_MODULE) {
|
2003-10-02 13:59:05 +01:00
|
|
|
|
return;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2003-10-02 13:59:05 +01:00
|
|
|
|
cl = clause->CurrentCode;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
if (!at_point) {
|
|
|
|
|
clause->CurrentCode = clause->Code;
|
|
|
|
|
return;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2003-04-30 18:46:05 +01:00
|
|
|
|
|
|
|
|
|
while (!done) {
|
|
|
|
|
op_numbers op = Yap_op_from_opcode(cl->opc);
|
|
|
|
|
switch (op) {
|
2006-03-24 17:13:41 +00:00
|
|
|
|
#ifdef BEAM
|
|
|
|
|
case _run_eam:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clause->CurrentCode = clause->Code;
|
|
|
|
|
return;
|
2006-03-24 17:13:41 +00:00
|
|
|
|
#endif
|
2003-04-30 18:46:05 +01:00
|
|
|
|
case _unify_void:
|
|
|
|
|
if (argno == 1) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clause->CurrentCode = clause->Code;
|
|
|
|
|
return;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
argno--;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
|
|
|
|
case _unify_void_write:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, o);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
break;
|
|
|
|
|
case _unify_list:
|
|
|
|
|
case _unify_l_list:
|
2003-10-02 13:59:05 +01:00
|
|
|
|
case _unify_atom:
|
|
|
|
|
case _unify_l_atom:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/*
|
|
|
|
|
unification is not guaranteed
|
|
|
|
|
case _unify_longint:
|
|
|
|
|
case _unify_l_longint:
|
|
|
|
|
case _unify_bigint:
|
|
|
|
|
case _unify_l_bigint:
|
|
|
|
|
case _unify_l_float:
|
|
|
|
|
*/
|
2003-10-02 13:59:05 +01:00
|
|
|
|
case _unify_struct:
|
|
|
|
|
case _unify_l_struc:
|
2014-02-18 09:44:01 +00:00
|
|
|
|
if (cl == clause->ucd.WorkPC) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clause->CurrentCode = cl;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clause->CurrentCode = clause->Code;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
2003-10-02 13:59:05 +01:00
|
|
|
|
return;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
case _unify_list_write:
|
|
|
|
|
case _unify_l_list_write:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, o);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
break;
|
|
|
|
|
case _unify_n_voids:
|
|
|
|
|
case _unify_l_n_voids:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
if (argno <= cl->y_u.os.s) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clause->CurrentCode = clause->Code;
|
|
|
|
|
return;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
argno -= cl->y_u.os.s;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
|
|
|
|
case _unify_n_voids_write:
|
|
|
|
|
case _unify_l_n_voids_write:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, os);
|
|
|
|
|
break;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
case _unify_atom_write:
|
|
|
|
|
case _unify_l_atom_write:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, oc);
|
|
|
|
|
break;
|
2006-09-20 21:03:51 +01:00
|
|
|
|
case _unify_float_write:
|
|
|
|
|
case _unify_l_float_write:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, od);
|
|
|
|
|
break;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
case _unify_l_struc_write:
|
|
|
|
|
case _unify_struct_write:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, ofa);
|
|
|
|
|
break;
|
2014-10-20 23:47:33 +01:00
|
|
|
|
#ifdef THREADS
|
|
|
|
|
case _unlock_lu:
|
|
|
|
|
#endif
|
2003-04-30 18:46:05 +01:00
|
|
|
|
case _pop:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, e);
|
|
|
|
|
break;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
case _pop_n:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = NEXTOP(cl, s);
|
|
|
|
|
break;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
default:
|
2003-10-02 13:59:05 +01:00
|
|
|
|
clause->CurrentCode = clause->Code;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static UInt groups_in(ClauseDef *min, ClauseDef *max, GroupDef *grp,
|
|
|
|
|
struct intermediates *cint) {
|
2011-03-07 16:02:55 +00:00
|
|
|
|
CACHE_REGS
|
2003-04-30 18:46:05 +01:00
|
|
|
|
UInt groups = 0;
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
while (min <= max) {
|
2003-04-30 18:46:05 +01:00
|
|
|
|
grp->FirstClause = min;
|
|
|
|
|
grp->AtomClauses = 0;
|
|
|
|
|
grp->PairClauses = 0;
|
|
|
|
|
grp->StructClauses = 0;
|
|
|
|
|
grp->TestClauses = 0;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (min->Tag == (_var + 1) * sizeof(CELL)) {
|
2003-04-30 18:46:05 +01:00
|
|
|
|
min++;
|
|
|
|
|
continue;
|
|
|
|
|
}
|
|
|
|
|
/* only do this for the first clauses in a group */
|
|
|
|
|
if (IsVarTerm(min->Tag)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ClauseDef *clp = min + 1;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
|
|
|
|
|
grp->VarClauses = 1;
|
|
|
|
|
do {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (clp > max || !IsVarTerm(clp->Tag)) {
|
|
|
|
|
grp->LastClause = (min = clp) - 1;
|
|
|
|
|
break;
|
|
|
|
|
}
|
|
|
|
|
if (clp->Tag != (_var + 1) * sizeof(CELL))
|
|
|
|
|
grp->VarClauses++;
|
|
|
|
|
clp++;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
} while (TRUE);
|
|
|
|
|
} else {
|
|
|
|
|
grp->VarClauses = 0;
|
|
|
|
|
do {
|
|
|
|
|
restart_loop:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (IsAtomTerm(min->Tag) || IsIntTerm(min->Tag)) {
|
|
|
|
|
grp->AtomClauses++;
|
|
|
|
|
} else if (IsPairTerm(min->Tag)) {
|
|
|
|
|
grp->PairClauses++;
|
|
|
|
|
} else if (IsApplTerm(min->Tag)) {
|
|
|
|
|
grp->StructClauses++;
|
|
|
|
|
} else {
|
|
|
|
|
grp->TestClauses++;
|
|
|
|
|
}
|
|
|
|
|
min++;
|
|
|
|
|
} while (min <= max && (!IsVarTerm(min->Tag)));
|
|
|
|
|
if (min <= max && min->Tag == (_var + 1) * sizeof(CELL)) {
|
|
|
|
|
min++;
|
|
|
|
|
if (min < max)
|
|
|
|
|
goto restart_loop;
|
|
|
|
|
}
|
|
|
|
|
grp->LastClause = min - 1;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
|
|
|
|
groups++;
|
|
|
|
|
grp++;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
while (grp + 16 > (GroupDef *)LOCAL_TrailTop) {
|
|
|
|
|
UInt sz = (groups + 16) * sizeof(GroupDef);
|
2007-09-22 09:38:05 +01:00
|
|
|
|
#if USE_SYSTEM_MALLOC
|
2011-05-23 16:19:47 +01:00
|
|
|
|
LOCAL_Error_Size = sz;
|
2007-09-22 09:38:05 +01:00
|
|
|
|
/* grow stack */
|
|
|
|
|
save_machine_regs();
|
2016-07-31 10:26:15 +01:00
|
|
|
|
siglongjmp(cint->CompilerBotch, 4);
|
2007-09-22 09:38:05 +01:00
|
|
|
|
#else
|
|
|
|
|
if (!Yap_growtrail(sz, TRUE)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
LOCAL_Error_Size = sz;
|
|
|
|
|
save_machine_regs();
|
|
|
|
|
siglongjmp(cint->CompilerBotch, 4);
|
|
|
|
|
return 0;
|
2007-09-22 09:38:05 +01:00
|
|
|
|
}
|
|
|
|
|
#endif
|
|
|
|
|
}
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
|
|
|
|
return groups;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static UInt new_label(struct intermediates *cint) {
|
2006-05-16 19:37:31 +01:00
|
|
|
|
UInt lbl = cint->i_labelno;
|
|
|
|
|
cint->i_labelno += 2;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
return lbl;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static Int has_cut(yamop *pc, PredEntry *ap) {
|
2011-07-05 07:28:28 +01:00
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
|
|
|
|
LogUpdClause *lcl = ClauseCodeToLogUpdClause(pc);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return ((lcl->ClFlags & HasCutMask) != 0);
|
|
|
|
|
} else if (ap->PredFlags & MegaClausePredFlag) {
|
2011-07-05 07:28:28 +01:00
|
|
|
|
/* must be a fact */
|
|
|
|
|
return FALSE;
|
|
|
|
|
} else {
|
|
|
|
|
StaticClause *scl;
|
|
|
|
|
|
|
|
|
|
scl = ClauseCodeToStaticClause(pc);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return ((scl->ClFlags & HasCutMask) != 0);
|
2011-07-05 07:28:28 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void emit_trust(ClauseDef *cl, struct intermediates *cint, UInt nxtlbl,
|
|
|
|
|
int clauses) {
|
2004-01-23 02:23:51 +00:00
|
|
|
|
PredEntry *ap = cint->CurrentPred;
|
2005-05-30 06:26:50 +01:00
|
|
|
|
yamop *clcode = cl->Code;
|
2004-01-23 02:23:51 +00:00
|
|
|
|
|
2005-05-30 06:26:50 +01:00
|
|
|
|
if (ap->PredFlags & TabledPredFlag)
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clcode = NEXTOP(clcode, Otapl);
|
2008-02-14 14:35:13 +00:00
|
|
|
|
if (!(ap->PredFlags & LogUpdatePredFlag)) {
|
|
|
|
|
/* this should not be generated for logical update predicates!! */
|
|
|
|
|
if (ap->PredFlags & ProfiledPredFlag) {
|
|
|
|
|
Yap_emit(retry_profiled_op, Unsigned(ap), Zero, cint);
|
|
|
|
|
}
|
|
|
|
|
if (ap->PredFlags & CountPredFlag) {
|
|
|
|
|
Yap_emit(count_retry_op, Unsigned(ap), Zero, cint);
|
|
|
|
|
}
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
|
|
|
|
if (clauses == 0) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_emit(trust_op, (CELL)clcode, has_cut(cl->Code, ap), cint);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_emit(retry_op, (CELL)clcode, (clauses << 1) | has_cut(cl->Code, ap),
|
|
|
|
|
cint);
|
2004-01-23 02:23:51 +00:00
|
|
|
|
Yap_emit(jumpi_op, nxtlbl, Zero, cint);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void emit_retry(ClauseDef *cl, struct intermediates *cint, int clauses) {
|
2004-01-23 02:23:51 +00:00
|
|
|
|
PredEntry *ap = cint->CurrentPred;
|
2005-05-30 06:26:50 +01:00
|
|
|
|
yamop *clcode = cl->Code;
|
2004-01-23 02:23:51 +00:00
|
|
|
|
|
2005-05-30 06:26:50 +01:00
|
|
|
|
if (ap->PredFlags & TabledPredFlag)
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clcode = NEXTOP(clcode, Otapl);
|
2008-02-14 14:35:13 +00:00
|
|
|
|
if (!(ap->PredFlags & LogUpdatePredFlag)) {
|
|
|
|
|
/* this should not be generated for logical update predicates!! */
|
|
|
|
|
if (ap->PredFlags & ProfiledPredFlag) {
|
|
|
|
|
Yap_emit(retry_profiled_op, Unsigned(ap), Zero, cint);
|
|
|
|
|
}
|
|
|
|
|
if (ap->PredFlags & CountPredFlag) {
|
|
|
|
|
Yap_emit(count_retry_op, Unsigned(ap), Zero, cint);
|
|
|
|
|
}
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_emit(retry_op, (CELL)clcode, (clauses << 1) | has_cut(cl->Code, ap),
|
|
|
|
|
cint);
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static compiler_vm_op emit_optry(int var_group, int first, int clauses,
|
|
|
|
|
int clleft, PredEntry *ap) {
|
2003-04-30 18:46:05 +01:00
|
|
|
|
/* var group */
|
|
|
|
|
if (var_group || clauses == 0) {
|
|
|
|
|
if (first) {
|
2003-09-15 02:25:29 +01:00
|
|
|
|
return try_op;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
} else if (clleft + clauses) {
|
2003-09-15 02:25:29 +01:00
|
|
|
|
return retry_op;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
} else {
|
2003-09-15 02:25:29 +01:00
|
|
|
|
return trust_op;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
2003-04-30 18:46:05 +01:00
|
|
|
|
} else if (clleft == 0) {
|
2003-12-18 17:23:22 +00:00
|
|
|
|
#ifdef TABLING
|
2003-12-18 16:38:40 +00:00
|
|
|
|
if (ap->PredFlags & TabledPredFlag && !first) {
|
|
|
|
|
/* we never actually get to remove the last choice-point in this case */
|
|
|
|
|
return retry_op;
|
2003-12-18 17:23:22 +00:00
|
|
|
|
} else
|
2005-04-07 18:56:58 +01:00
|
|
|
|
#endif /* TABLING */
|
2003-12-18 17:23:22 +00:00
|
|
|
|
{
|
2003-12-18 16:38:40 +00:00
|
|
|
|
/* last group */
|
|
|
|
|
return try_op;
|
|
|
|
|
}
|
2003-04-30 18:46:05 +01:00
|
|
|
|
} else {
|
|
|
|
|
/* nonvar group */
|
2003-09-15 02:25:29 +01:00
|
|
|
|
return try_in_op;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void emit_try(ClauseDef *cl, struct intermediates *cint, int var_group,
|
|
|
|
|
int first, int clauses, int clleft, UInt nxtlbl) {
|
2005-05-30 06:26:50 +01:00
|
|
|
|
PredEntry *ap = cint->CurrentPred;
|
2006-11-06 18:35:05 +00:00
|
|
|
|
yamop *clcode;
|
2005-07-19 17:54:20 +01:00
|
|
|
|
compiler_vm_op comp_op;
|
2005-05-30 06:26:50 +01:00
|
|
|
|
|
2006-11-06 18:35:05 +00:00
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
|
|
|
|
clcode = cl->Code;
|
|
|
|
|
} else if (ap->PredFlags & TabledPredFlag) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clcode = NEXTOP(cl->Code, Otapl);
|
2006-11-06 18:35:05 +00:00
|
|
|
|
} else {
|
|
|
|
|
clcode = cl->CurrentCode;
|
2005-05-30 06:26:50 +01:00
|
|
|
|
}
|
|
|
|
|
|
2005-07-19 17:54:20 +01:00
|
|
|
|
comp_op = emit_optry(var_group, first, clauses, clleft, cint->CurrentPred);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_emit(comp_op, (CELL)clcode,
|
|
|
|
|
((clauses + clleft) << 1) | has_cut(cl->Code, ap), cint);
|
2003-09-15 02:25:29 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static TypeSwitch *emit_type_switch(compiler_vm_op op,
|
|
|
|
|
struct intermediates *cint) {
|
|
|
|
|
return (TypeSwitch *)Yap_emit_extra_size(op, 0, sizeof(TypeSwitch), cint);
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static yamop *emit_switch_space(UInt n, UInt item_size,
|
|
|
|
|
struct intermediates *cint, CELL func_mask) {
|
2011-04-14 18:51:11 +01:00
|
|
|
|
CACHE_REGS
|
2004-01-23 02:23:51 +00:00
|
|
|
|
PredEntry *ap = cint->CurrentPred;
|
|
|
|
|
|
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
UInt sz = sizeof(LogUpdIndex) + n * item_size;
|
2004-03-05 15:26:33 +00:00
|
|
|
|
LogUpdIndex *cl = (LogUpdIndex *)Yap_AllocCodeSpace(sz);
|
2004-01-23 02:23:51 +00:00
|
|
|
|
if (cl == NULL) {
|
2011-05-23 16:19:47 +01:00
|
|
|
|
LOCAL_Error_Size = sz;
|
2004-01-23 02:23:51 +00:00
|
|
|
|
/* grow stack */
|
2005-12-23 00:20:14 +00:00
|
|
|
|
save_machine_regs();
|
2016-07-31 10:26:15 +01:00
|
|
|
|
siglongjmp(cint->CompilerBotch, 2);
|
2004-01-23 02:23:51 +00:00
|
|
|
|
}
|
2006-11-06 18:35:05 +00:00
|
|
|
|
Yap_LUIndexSpace_SW += sz;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl->ClFlags = SwitchTableMask | LogUpdMask | func_mask;
|
2004-03-05 15:26:33 +00:00
|
|
|
|
cl->ClSize = sz;
|
2005-12-17 03:25:39 +00:00
|
|
|
|
cl->ClPred = cint->CurrentPred;
|
2004-01-23 02:23:51 +00:00
|
|
|
|
/* insert into code chain */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_inform_profiler_of_clause(cl, (CODEADDR)cl + sz, ap,
|
|
|
|
|
GPROF_NEW_LU_SWITCH);
|
2004-01-23 02:23:51 +00:00
|
|
|
|
return cl->ClCode;
|
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
UInt sz = sizeof(StaticIndex) + n * item_size;
|
2004-03-05 15:26:33 +00:00
|
|
|
|
StaticIndex *cl = (StaticIndex *)Yap_AllocCodeSpace(sz);
|
2004-01-23 02:23:51 +00:00
|
|
|
|
if (cl == NULL) {
|
2011-05-23 16:19:47 +01:00
|
|
|
|
LOCAL_Error_Size = sz;
|
2004-01-23 02:23:51 +00:00
|
|
|
|
/* grow stack */
|
2005-12-23 00:20:14 +00:00
|
|
|
|
save_machine_regs();
|
2016-07-31 10:26:15 +01:00
|
|
|
|
siglongjmp(cint->CompilerBotch, 2);
|
2004-01-23 02:23:51 +00:00
|
|
|
|
}
|
2006-11-06 18:35:05 +00:00
|
|
|
|
Yap_IndexSpace_SW += sz;
|
2004-01-23 02:23:51 +00:00
|
|
|
|
cl->ClFlags = SwitchTableMask;
|
2004-03-05 15:26:33 +00:00
|
|
|
|
cl->ClSize = sz;
|
2005-12-17 03:25:39 +00:00
|
|
|
|
cl->ClPred = cint->CurrentPred;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_inform_profiler_of_clause(cl, (CODEADDR)cl + sz, ap,
|
|
|
|
|
GPROF_NEW_STATIC_SWITCH);
|
2004-01-23 02:23:51 +00:00
|
|
|
|
return cl->ClCode;
|
|
|
|
|
/* insert into code chain */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static AtomSwiEntry *emit_cswitch(COUNT n, yamop *fail_l,
|
|
|
|
|
struct intermediates *cint) {
|
2003-04-30 18:46:05 +01:00
|
|
|
|
compiler_vm_op op;
|
|
|
|
|
AtomSwiEntry *target;
|
|
|
|
|
|
|
|
|
|
if (n > MIN_HASH_ENTRIES) {
|
2008-01-30 10:35:43 +00:00
|
|
|
|
COUNT cases = MIN_HASH_ENTRIES, i;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
n += 1 + n / 4;
|
|
|
|
|
while (cases < n)
|
|
|
|
|
cases *= 2;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
n = cases;
|
|
|
|
|
op = switch_c_op;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
target =
|
|
|
|
|
(AtomSwiEntry *)emit_switch_space(n, sizeof(AtomSwiEntry), cint, 0);
|
|
|
|
|
for (i = 0; i < n; i++) {
|
2003-04-30 18:46:05 +01:00
|
|
|
|
target[i].Tag = Zero;
|
2014-02-18 09:44:01 +00:00
|
|
|
|
target[i].u_a.labp = fail_l;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
2004-01-23 02:23:51 +00:00
|
|
|
|
Yap_emit(op, Unsigned(n), (CELL)target, cint);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
} else {
|
2004-04-16 20:27:31 +01:00
|
|
|
|
UInt i;
|
|
|
|
|
|
2003-04-30 18:46:05 +01:00
|
|
|
|
op = if_c_op;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
target =
|
|
|
|
|
(AtomSwiEntry *)emit_switch_space(n + 1, sizeof(AtomSwiEntry), cint, 0);
|
2004-04-16 20:27:31 +01:00
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
for (i = 0; i < n; i++) {
|
2014-02-18 09:44:01 +00:00
|
|
|
|
target[i].u_a.labp = fail_l;
|
2004-04-16 20:27:31 +01:00
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
target[n].Tag = Zero;
|
2014-02-18 09:44:01 +00:00
|
|
|
|
target[n].u_a.labp = fail_l;
|
2004-01-23 02:23:51 +00:00
|
|
|
|
Yap_emit(op, Unsigned(n), (CELL)target, cint);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
|
|
|
|
return target;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static AtomSwiEntry *lookup_c_hash(Term t, yamop *tab, COUNT entries) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
AtomSwiEntry *cebase = (AtomSwiEntry *)tab;
|
|
|
|
|
int hash, d;
|
|
|
|
|
AtomSwiEntry *centry;
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
hash = (t >> HASH_SHIFT) & (entries - 1);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
centry = cebase + hash;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
d = (entries - 1) & (t | 1);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
while (centry->Tag != t) {
|
|
|
|
|
if (centry->Tag == 0L)
|
|
|
|
|
return centry;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
hash = (hash + d) & (entries - 1);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
centry = cebase + hash;
|
|
|
|
|
}
|
|
|
|
|
return centry;
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static AtomSwiEntry *fetch_centry(AtomSwiEntry *cebase, Term wt, int i, int n) {
|
2003-04-30 18:46:05 +01:00
|
|
|
|
if (n > MIN_HASH_ENTRIES) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
int cases = MIN_HASH_ENTRIES;
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
n += 1 + n / 4;
|
|
|
|
|
while (cases < n)
|
|
|
|
|
cases *= 2;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
return lookup_c_hash(wt, (yamop *)cebase, cases);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
} else {
|
|
|
|
|
return cebase + i;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static FuncSwiEntry *emit_fswitch(COUNT n, yamop *fail_l,
|
|
|
|
|
struct intermediates *cint) {
|
2003-04-30 18:46:05 +01:00
|
|
|
|
compiler_vm_op op;
|
|
|
|
|
FuncSwiEntry *target;
|
|
|
|
|
|
|
|
|
|
if (n > MIN_HASH_ENTRIES) {
|
|
|
|
|
int cases = MIN_HASH_ENTRIES, i;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
n += 1 + n / 4;
|
|
|
|
|
while (cases < n)
|
|
|
|
|
cases *= 2;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
n = cases;
|
|
|
|
|
op = switch_f_op;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
target = (FuncSwiEntry *)emit_switch_space(n, sizeof(FuncSwiEntry), cint,
|
|
|
|
|
FuncSwitchMask);
|
|
|
|
|
for (i = 0; i < n; i++) {
|
2003-04-30 18:46:05 +01:00
|
|
|
|
target[i].Tag = NULL;
|
2014-02-18 09:44:01 +00:00
|
|
|
|
target[i].u_f.labp = fail_l;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
2004-01-23 02:23:51 +00:00
|
|
|
|
Yap_emit(op, Unsigned(n), (CELL)target, cint);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
} else {
|
2004-04-16 20:27:31 +01:00
|
|
|
|
UInt i;
|
|
|
|
|
|
2003-04-30 18:46:05 +01:00
|
|
|
|
op = if_f_op;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
target = (FuncSwiEntry *)emit_switch_space(n + 1, sizeof(FuncSwiEntry),
|
|
|
|
|
cint, FuncSwitchMask);
|
|
|
|
|
for (i = 0; i < n; i++) {
|
2014-02-18 09:44:01 +00:00
|
|
|
|
target[i].u_f.labp = fail_l;
|
2004-04-16 20:27:31 +01:00
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
target[n].Tag = NULL;
|
2014-02-18 09:44:01 +00:00
|
|
|
|
target[n].u_f.labp = fail_l;
|
2004-01-23 02:23:51 +00:00
|
|
|
|
Yap_emit(op, Unsigned(n), (CELL)target, cint);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
|
|
|
|
return target;
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static FuncSwiEntry *lookup_f_hash(Functor f, yamop *tab, COUNT entries) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
FuncSwiEntry *febase = (FuncSwiEntry *)tab;
|
|
|
|
|
int hash, d;
|
|
|
|
|
FuncSwiEntry *fentry;
|
|
|
|
|
Term wt = (Term)f;
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
hash = (wt >> HASH_SHIFT) & (entries - 1);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
fentry = febase + hash;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
d = (entries - 1) & (wt | 1);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
while (fentry->Tag != f) {
|
|
|
|
|
if (fentry->Tag == NULL)
|
|
|
|
|
return fentry;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
hash = (hash + d) & (entries - 1);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
fentry = febase + hash;
|
|
|
|
|
}
|
|
|
|
|
return fentry;
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static FuncSwiEntry *fetch_fentry(FuncSwiEntry *febase, Functor ft, int i,
|
|
|
|
|
int n) {
|
2003-04-30 18:46:05 +01:00
|
|
|
|
if (n > MIN_HASH_ENTRIES) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
int cases = MIN_HASH_ENTRIES;
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
n += 1 + n / 4;
|
|
|
|
|
while (cases < n)
|
|
|
|
|
cases *= 2;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
return lookup_f_hash(ft, (yamop *)febase, cases);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
} else {
|
|
|
|
|
return febase + i;
|
|
|
|
|
}
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2003-04-30 18:46:05 +01:00
|
|
|
|
/* we assume there is at least one clause, that is, c0 < cf */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static UInt do_var_clauses(ClauseDef *c0, ClauseDef *cf, int var_group,
|
|
|
|
|
struct intermediates *cint, int first, int clleft,
|
|
|
|
|
UInt nxtlbl, UInt argno0) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
UInt labl;
|
2003-10-14 01:53:10 +01:00
|
|
|
|
UInt labl_dyn0 = 0, labl_dynf = 0;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
|
2006-05-16 19:37:31 +01:00
|
|
|
|
labl = new_label(cint);
|
2004-01-23 02:23:51 +00:00
|
|
|
|
Yap_emit(label_op, labl, Zero, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
/*
|
|
|
|
|
add expand_node if var_group == TRUE (jump on var) ||
|
2016-07-31 10:26:15 +01:00
|
|
|
|
var_group == FALSE (leaf node)
|
2003-08-27 14:30:50 +01:00
|
|
|
|
*/
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (first && cint->CurrentPred->PredFlags & LogUpdatePredFlag) {
|
2004-03-19 11:35:42 +00:00
|
|
|
|
UInt ncls;
|
2006-05-16 19:37:31 +01:00
|
|
|
|
labl_dyn0 = new_label(cint);
|
2003-10-14 01:53:10 +01:00
|
|
|
|
if (clleft)
|
|
|
|
|
labl_dynf = labl_dyn0;
|
|
|
|
|
else
|
2006-05-16 19:37:31 +01:00
|
|
|
|
labl_dynf = new_label(cint);
|
2004-03-19 11:35:42 +00:00
|
|
|
|
if (clleft == 0) /* trust*/
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ncls = (cf - c0) + 1;
|
2004-03-19 11:35:42 +00:00
|
|
|
|
else
|
|
|
|
|
ncls = 0;
|
2009-02-09 21:56:40 +00:00
|
|
|
|
Yap_emit_4ops(enter_lu_op, labl_dyn0, labl_dynf, ncls, Zero, cint);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_emit(label_op, labl_dyn0, Zero, cint);
|
2003-10-14 01:53:10 +01:00
|
|
|
|
}
|
2003-04-30 18:46:05 +01:00
|
|
|
|
if (c0 == cf) {
|
2004-01-23 02:23:51 +00:00
|
|
|
|
emit_try(c0, cint, var_group, first, 0, clleft, nxtlbl);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
} else {
|
2003-09-15 02:25:29 +01:00
|
|
|
|
|
2003-04-30 18:46:05 +01:00
|
|
|
|
if (c0 < cf) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
emit_try(c0, cint, var_group, first, cf - c0, clleft, nxtlbl);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
|
|
|
|
c0++;
|
|
|
|
|
while (c0 < cf) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
emit_retry(c0, cint, clleft + (cf - c0));
|
2003-04-30 18:46:05 +01:00
|
|
|
|
c0++;
|
|
|
|
|
}
|
|
|
|
|
if (c0 == cf) {
|
2004-01-23 02:23:51 +00:00
|
|
|
|
emit_trust(c0, cint, nxtlbl, clleft);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (!clleft && cint->CurrentPred->PredFlags & LogUpdatePredFlag) {
|
|
|
|
|
Yap_emit(label_op, labl_dynf, Zero, cint);
|
2003-09-15 02:25:29 +01:00
|
|
|
|
}
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
return labl;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
2001-04-09 20:54:03 +01:00
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static UInt do_var_group(GroupDef *grp, struct intermediates *cint,
|
|
|
|
|
int var_group, int first, int clleft, UInt nxtlbl,
|
|
|
|
|
UInt argno0) {
|
|
|
|
|
return do_var_clauses(grp->FirstClause, grp->LastClause, var_group, cint,
|
|
|
|
|
first, clleft, nxtlbl, argno0);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
|
|
|
|
|
2003-08-27 14:30:50 +01:00
|
|
|
|
/* count the number of different constants */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static UInt count_consts(GroupDef *grp) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
Term current = MkAtomTerm(AtomFoundVar);
|
|
|
|
|
UInt i = 0;
|
|
|
|
|
ClauseDef *cl = grp->FirstClause;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
|
2003-08-27 14:30:50 +01:00
|
|
|
|
while (IsAtomTerm(cl->Tag) || IsIntTerm(cl->Tag)) {
|
|
|
|
|
if (current != cl->Tag) {
|
|
|
|
|
i++;
|
|
|
|
|
current = cl->Tag;
|
|
|
|
|
}
|
|
|
|
|
if (cl == grp->LastClause) {
|
|
|
|
|
return i;
|
|
|
|
|
}
|
|
|
|
|
cl++;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
return i;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static UInt count_blobs(GroupDef *grp) {
|
2011-01-20 18:01:18 +00:00
|
|
|
|
UInt i = 1;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ClauseDef *cl = grp->FirstClause + 1;
|
2011-01-20 18:01:18 +00:00
|
|
|
|
Term current = grp->FirstClause->Tag;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
|
2011-01-20 18:01:18 +00:00
|
|
|
|
while (cl <= grp->LastClause) {
|
2003-04-30 18:46:05 +01:00
|
|
|
|
if (current != cl->Tag) {
|
|
|
|
|
i++;
|
|
|
|
|
current = cl->Tag;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
2003-04-30 18:46:05 +01:00
|
|
|
|
cl++;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
2003-04-30 18:46:05 +01:00
|
|
|
|
return i;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2003-04-30 18:46:05 +01:00
|
|
|
|
/* count the number of different constants */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static UInt count_funcs(GroupDef *grp) {
|
2003-04-30 18:46:05 +01:00
|
|
|
|
Term current = MkAtomTerm(AtomFoundVar);
|
|
|
|
|
UInt i = 0;
|
|
|
|
|
ClauseDef *cl = grp->FirstClause;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
|
2003-04-30 18:46:05 +01:00
|
|
|
|
while (IsApplTerm(cl->Tag)) {
|
|
|
|
|
if (current != cl->Tag) {
|
|
|
|
|
i++;
|
|
|
|
|
current = cl->Tag;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
2003-04-30 18:46:05 +01:00
|
|
|
|
if (cl == grp->LastClause) {
|
|
|
|
|
return i;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
2003-04-30 18:46:05 +01:00
|
|
|
|
cl++;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
2003-04-30 18:46:05 +01:00
|
|
|
|
return i;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static UInt emit_single_switch_case(ClauseDef *min, struct intermediates *cint,
|
|
|
|
|
int first, int clleft, UInt nxtlbl) {
|
2005-03-04 20:30:14 +00:00
|
|
|
|
if (cint->CurrentPred->PredFlags & TabledPredFlag) {
|
2005-05-30 06:26:50 +01:00
|
|
|
|
/* with tabling we don't clean trust at the very end of computation.
|
2003-12-18 16:38:40 +00:00
|
|
|
|
*/
|
2009-02-10 22:35:54 +00:00
|
|
|
|
if (clleft || !first) {
|
2005-05-31 05:46:06 +01:00
|
|
|
|
/*
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if we still have clauses left, means we already created a CP,
|
|
|
|
|
so I should avoid creating again
|
2005-05-31 05:46:06 +01:00
|
|
|
|
*/
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return (UInt)NEXTOP(min->Code, Otapl);
|
2009-02-10 22:35:54 +00:00
|
|
|
|
} else {
|
|
|
|
|
return (UInt)min->Code;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
}
|
2003-12-18 16:38:40 +00:00
|
|
|
|
}
|
2008-05-11 00:24:13 +01:00
|
|
|
|
if (cint->CurrentPred->PredFlags & LogUpdatePredFlag) {
|
|
|
|
|
return (UInt)(min->Code);
|
|
|
|
|
} else {
|
|
|
|
|
return (UInt)(min->CurrentCode);
|
|
|
|
|
}
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static UInt suspend_indexing(ClauseDef *min, ClauseDef *max, PredEntry *ap,
|
|
|
|
|
struct intermediates *cint) {
|
2004-03-31 02:02:18 +01:00
|
|
|
|
UInt tcls = ap->cs.p_code.NOfClauses;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
UInt cls = (max - min) + 1;
|
2004-03-31 02:02:18 +01:00
|
|
|
|
|
2004-04-14 20:10:40 +01:00
|
|
|
|
if (cint->expand_block &&
|
2005-04-27 21:09:26 +01:00
|
|
|
|
cint->expand_block != (yamop *)(&(ap->cs.p_code.ExpandCode)) &&
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cint->expand_block->y_u.sssllp.s2 < 2 * (max - min)) {
|
2014-05-30 01:06:09 +01:00
|
|
|
|
cint->expand_block->y_u.sssllp.s3++;
|
2004-04-14 20:10:40 +01:00
|
|
|
|
return (UInt)(cint->expand_block);
|
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (cls < tcls / 8) {
|
2004-04-16 20:27:31 +01:00
|
|
|
|
yamop *ncode;
|
2004-03-31 02:02:18 +01:00
|
|
|
|
yamop **st;
|
2005-05-31 20:42:28 +01:00
|
|
|
|
UInt tels;
|
|
|
|
|
UInt sz;
|
2004-03-31 02:02:18 +01:00
|
|
|
|
|
2005-05-31 20:42:28 +01:00
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
|
|
|
|
/* give it some slack */
|
|
|
|
|
tels = cls + 4;
|
|
|
|
|
} else {
|
2019-05-01 01:34:58 +01:00
|
|
|
|
tels = cls+1;
|
2005-05-31 20:42:28 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
sz = (UInt)NEXTOP((yamop *)NULL, sssllp) + tels * sizeof(yamop *);
|
2004-04-16 20:27:31 +01:00
|
|
|
|
if ((ncode = (yamop *)Yap_AllocCodeSpace(sz)) == NULL) {
|
2005-12-23 00:20:14 +00:00
|
|
|
|
save_machine_regs();
|
2010-12-16 01:22:10 +00:00
|
|
|
|
siglongjmp(cint->CompilerBotch, 2);
|
2004-04-16 20:27:31 +01:00
|
|
|
|
}
|
2008-01-23 17:57:56 +00:00
|
|
|
|
#if DEBUG
|
|
|
|
|
Yap_ExpandClauses++;
|
|
|
|
|
Yap_expand_clauses_sz += sz;
|
|
|
|
|
#endif
|
2006-11-06 18:35:05 +00:00
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
|
|
|
|
Yap_LUIndexSpace_EXT += sz;
|
|
|
|
|
} else {
|
|
|
|
|
Yap_IndexSpace_EXT += sz;
|
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_inform_profiler_of_clause(ncode, (CODEADDR)ncode + sz, ap,
|
|
|
|
|
GPROF_NEW_EXPAND_BLOCK);
|
2004-04-16 20:27:31 +01:00
|
|
|
|
/* create an expand_block */
|
2004-03-31 02:02:18 +01:00
|
|
|
|
ncode->opc = Yap_opcode(_expand_clauses);
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ncode->y_u.sssllp.p = ap;
|
|
|
|
|
ncode->y_u.sssllp.s1 = tels;
|
|
|
|
|
ncode->y_u.sssllp.s2 = cls;
|
|
|
|
|
ncode->y_u.sssllp.s3 = 1;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
st = (yamop **)NEXTOP(ncode, sssllp);
|
2004-03-31 02:02:18 +01:00
|
|
|
|
while (min <= max) {
|
|
|
|
|
*st++ = min->Code;
|
|
|
|
|
min++;
|
|
|
|
|
}
|
2005-05-31 20:42:28 +01:00
|
|
|
|
while (cls < tels) {
|
|
|
|
|
*st++ = NULL;
|
|
|
|
|
cls++;
|
|
|
|
|
}
|
2004-09-27 21:45:04 +01:00
|
|
|
|
LOCK(ExpandClausesListLock);
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ncode->y_u.sssllp.snext = ExpandClausesFirst;
|
|
|
|
|
ncode->y_u.sssllp.sprev = NULL;
|
2004-09-27 21:45:04 +01:00
|
|
|
|
if (ExpandClausesFirst)
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ExpandClausesFirst->y_u.sssllp.sprev = ncode;
|
2004-09-27 21:45:04 +01:00
|
|
|
|
ExpandClausesFirst = ncode;
|
|
|
|
|
if (ExpandClausesLast == NULL)
|
|
|
|
|
ExpandClausesLast = ncode;
|
|
|
|
|
UNLOCK(ExpandClausesListLock);
|
2004-03-31 02:02:18 +01:00
|
|
|
|
return (UInt)ncode;
|
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return (UInt) & (ap->cs.p_code.ExpandCode);
|
2004-03-31 02:02:18 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void recover_ecls_block(yamop *ipc) {
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ipc->y_u.sssllp.s3--;
|
|
|
|
|
if (!ipc->y_u.sssllp.s3) {
|
2004-09-27 21:45:04 +01:00
|
|
|
|
LOCK(ExpandClausesListLock);
|
|
|
|
|
if (ExpandClausesFirst == ipc)
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ExpandClausesFirst = ipc->y_u.sssllp.snext;
|
2004-09-27 21:45:04 +01:00
|
|
|
|
if (ExpandClausesLast == ipc) {
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ExpandClausesLast = ipc->y_u.sssllp.sprev;
|
2004-09-27 21:45:04 +01:00
|
|
|
|
}
|
2014-05-30 01:06:09 +01:00
|
|
|
|
if (ipc->y_u.sssllp.sprev) {
|
|
|
|
|
ipc->y_u.sssllp.sprev->y_u.sssllp.snext = ipc->y_u.sssllp.snext;
|
2004-09-27 21:45:04 +01:00
|
|
|
|
}
|
2014-05-30 01:06:09 +01:00
|
|
|
|
if (ipc->y_u.sssllp.snext) {
|
|
|
|
|
ipc->y_u.sssllp.snext->y_u.sssllp.sprev = ipc->y_u.sssllp.sprev;
|
2004-09-27 21:45:04 +01:00
|
|
|
|
}
|
|
|
|
|
UNLOCK(ExpandClausesListLock);
|
2004-09-03 04:11:09 +01:00
|
|
|
|
#if DEBUG
|
2008-01-23 17:57:56 +00:00
|
|
|
|
Yap_ExpandClauses--;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_expand_clauses_sz -= (UInt)(NEXTOP((yamop *)NULL, sssllp)) +
|
|
|
|
|
ipc->y_u.sssllp.s1 * sizeof(yamop *);
|
2004-09-03 04:11:09 +01:00
|
|
|
|
#endif
|
2005-12-17 03:25:39 +00:00
|
|
|
|
/* no dangling pointers for gprof */
|
2012-03-09 11:46:34 +00:00
|
|
|
|
Yap_InformOfRemoval(ipc);
|
2014-05-30 01:06:09 +01:00
|
|
|
|
if (ipc->y_u.sssllp.p->PredFlags & LogUpdatePredFlag) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_LUIndexSpace_EXT -= (UInt)NEXTOP((yamop *)NULL, sssllp) +
|
|
|
|
|
ipc->y_u.sssllp.s1 * sizeof(yamop *);
|
2006-11-06 18:35:05 +00:00
|
|
|
|
} else
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_IndexSpace_EXT -= (UInt)NEXTOP((yamop *)NULL, sssllp) +
|
|
|
|
|
ipc->y_u.sssllp.s1 * sizeof(yamop *);
|
2004-04-14 20:10:40 +01:00
|
|
|
|
Yap_FreeCodeSpace((char *)ipc);
|
|
|
|
|
}
|
|
|
|
|
}
|
2003-04-30 18:46:05 +01:00
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static UInt do_var_entries(GroupDef *grp, Term t, struct intermediates *cint,
|
|
|
|
|
UInt argno, int first, int clleft, UInt nxtlbl) {
|
2004-01-23 02:23:51 +00:00
|
|
|
|
PredEntry *ap = cint->CurrentPred;
|
|
|
|
|
|
2008-09-14 05:11:51 +01:00
|
|
|
|
if (!IsVarTerm(t) || t != 0L) {
|
2004-04-14 20:10:40 +01:00
|
|
|
|
return suspend_indexing(grp->FirstClause, grp->LastClause, ap, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return do_var_group(grp, cint, FALSE, first, clleft, nxtlbl,
|
|
|
|
|
ap->ArityOfPE + 1);
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static UInt do_consts(GroupDef *grp, Term t, struct intermediates *cint,
|
|
|
|
|
int compound_term, CELL *sreg, UInt arity, int last_arg,
|
|
|
|
|
UInt argno, int first, UInt nxtlbl, int clleft,
|
|
|
|
|
CELL *top) {
|
2008-01-30 10:35:43 +00:00
|
|
|
|
COUNT n;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
ClauseDef *min = grp->FirstClause;
|
2008-01-30 10:35:43 +00:00
|
|
|
|
COUNT i;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
UInt lbl;
|
|
|
|
|
/* generate a switch */
|
|
|
|
|
AtomSwiEntry *cs;
|
2004-01-23 02:23:51 +00:00
|
|
|
|
PredEntry *ap = cint->CurrentPred;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
|
|
|
|
|
if (!IsAtomTerm(min->Tag) && !IsIntTerm(min->Tag)) {
|
|
|
|
|
/* no clauses, just skip */
|
|
|
|
|
return nxtlbl;
|
|
|
|
|
}
|
|
|
|
|
n = count_consts(grp);
|
2006-05-16 19:37:31 +01:00
|
|
|
|
lbl = new_label(cint);
|
2004-01-23 02:23:51 +00:00
|
|
|
|
Yap_emit(label_op, lbl, Zero, cint);
|
2007-05-02 12:01:41 +01:00
|
|
|
|
cs = emit_cswitch(n, FAILCODE, cint);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
for (i = 0; i < n; i++) {
|
|
|
|
|
AtomSwiEntry *ics;
|
|
|
|
|
ClauseDef *max = min;
|
|
|
|
|
|
|
|
|
|
ics = fetch_centry(cs, min->Tag, i, n);
|
|
|
|
|
ics->Tag = min->Tag;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
while (max != grp->LastClause && (max + 1)->Tag == min->Tag)
|
2010-04-08 00:52:59 +01:00
|
|
|
|
max++;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (min != max) {
|
|
|
|
|
if (sreg != NULL) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag && max > min) {
|
|
|
|
|
ics->u_a.Label = suspend_indexing(min, max, ap, cint);
|
|
|
|
|
} else {
|
|
|
|
|
ics->u_a.Label = do_compound_index(
|
|
|
|
|
min, max, sreg, cint, compound_term, arity, argno, nxtlbl, first,
|
|
|
|
|
last_arg, clleft, top, TRUE);
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else if (ap->PredFlags & LogUpdatePredFlag) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ics->u_a.Label = suspend_indexing(min, max, cint->CurrentPred, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ics->u_a.Label =
|
|
|
|
|
do_index(min, max, cint, argno + 1, nxtlbl, first, clleft, top);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ics->u_a.Label =
|
|
|
|
|
do_index(min, max, cint, argno + 1, nxtlbl, first, clleft, top);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
grp->FirstClause = min = max + 1;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
2003-04-30 18:46:05 +01:00
|
|
|
|
return lbl;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void do_blobs(GroupDef *grp, Term t, struct intermediates *cint,
|
|
|
|
|
UInt argno, int first, UInt nxtlbl, int clleft,
|
|
|
|
|
CELL *top) {
|
2008-01-30 10:35:43 +00:00
|
|
|
|
COUNT n;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
ClauseDef *min = grp->FirstClause;
|
2008-01-30 10:35:43 +00:00
|
|
|
|
COUNT i;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
/* generate a switch */
|
|
|
|
|
AtomSwiEntry *cs;
|
2004-01-23 02:23:51 +00:00
|
|
|
|
PredEntry *ap = cint->CurrentPred;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
|
|
|
|
|
n = count_blobs(grp);
|
2007-05-02 12:01:41 +01:00
|
|
|
|
cs = emit_cswitch(n, (yamop *)nxtlbl, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
for (i = 0; i < n; i++) {
|
|
|
|
|
AtomSwiEntry *ics;
|
|
|
|
|
ClauseDef *max = min;
|
|
|
|
|
|
|
|
|
|
ics = fetch_centry(cs, min->Tag, i, n);
|
|
|
|
|
ics->Tag = min->Tag;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
while (max != grp->LastClause && (max + 1)->Tag == min->Tag)
|
|
|
|
|
max++;
|
|
|
|
|
if (min != max && (ap->PredFlags & LogUpdatePredFlag)) {
|
2014-02-18 09:44:01 +00:00
|
|
|
|
ics->u_a.Label = suspend_indexing(min, max, ap, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ics->u_a.Label =
|
|
|
|
|
do_index(min, max, cint, argno + 1, nxtlbl, first, clleft, top);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
grp->FirstClause = min = max + 1;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static UInt do_funcs(GroupDef *grp, Term t, struct intermediates *cint,
|
|
|
|
|
UInt argno, int first, int last_arg, UInt nxtlbl,
|
|
|
|
|
int clleft, CELL *top) {
|
2008-01-30 10:35:43 +00:00
|
|
|
|
COUNT n = count_funcs(grp);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
ClauseDef *min = grp->FirstClause;
|
2008-01-30 10:35:43 +00:00
|
|
|
|
COUNT i;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
FuncSwiEntry *fs;
|
|
|
|
|
UInt lbl;
|
|
|
|
|
|
2003-06-06 14:16:40 +01:00
|
|
|
|
if (min > grp->LastClause || n == 0) {
|
2003-04-30 18:46:05 +01:00
|
|
|
|
/* no clauses, just skip */
|
|
|
|
|
return nxtlbl;
|
|
|
|
|
}
|
2006-05-16 19:37:31 +01:00
|
|
|
|
lbl = new_label(cint);
|
2004-01-23 02:23:51 +00:00
|
|
|
|
Yap_emit(label_op, lbl, Zero, cint);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
/* generate a switch */
|
2007-05-02 12:01:41 +01:00
|
|
|
|
fs = emit_fswitch(n, FAILCODE, cint);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
for (i = 0; i < n; i++) {
|
2003-04-30 18:46:05 +01:00
|
|
|
|
Functor f = (Functor)RepAppl(min->Tag);
|
|
|
|
|
FuncSwiEntry *ifs;
|
|
|
|
|
ClauseDef *max = min;
|
|
|
|
|
|
|
|
|
|
ifs = fetch_fentry(fs, f, i, n);
|
|
|
|
|
ifs->Tag = f;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
while (max != grp->LastClause && (max + 1)->Tag == min->Tag)
|
|
|
|
|
max++;
|
|
|
|
|
/* delay non-trivial indexing
|
2004-04-14 20:10:40 +01:00
|
|
|
|
if (min != max &&
|
|
|
|
|
!IsExtensionFunctor(f)) {
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ifs->y_u.Label = suspend_indexing(min, max, ap, cint);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
} else
|
2003-08-27 14:30:50 +01:00
|
|
|
|
*/
|
2008-01-30 10:35:43 +00:00
|
|
|
|
|
2003-04-30 18:46:05 +01:00
|
|
|
|
if (IsExtensionFunctor(f)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (f == FunctorDBRef)
|
|
|
|
|
ifs->u_f.Label = do_dbref_index(min, max, t, cint, argno, nxtlbl, first,
|
|
|
|
|
clleft, top);
|
|
|
|
|
else if (f == FunctorLongInt || f == FunctorBigInt)
|
|
|
|
|
ifs->u_f.Label = do_blob_index(min, max, t, cint, argno, nxtlbl, first,
|
|
|
|
|
clleft, top, FALSE);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
else
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ifs->u_f.Label = do_blob_index(min, max, t, cint, argno, nxtlbl, first,
|
|
|
|
|
clleft, top, TRUE);
|
|
|
|
|
|
2003-04-30 18:46:05 +01:00
|
|
|
|
} else {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
CELL *sreg;
|
|
|
|
|
|
|
|
|
|
if (!IsVarTerm(t) && IsApplTerm(t) && FunctorOfTerm(t) == f) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
sreg = RepAppl(t) + 1;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
sreg = NULL;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ifs->u_f.Label =
|
|
|
|
|
do_compound_index(min, max, sreg, cint, 0, ArityOfFunctor(f), argno,
|
|
|
|
|
nxtlbl, first, last_arg, clleft, top, TRUE);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
grp->FirstClause = min = max + 1;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
2003-04-30 18:46:05 +01:00
|
|
|
|
return lbl;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static UInt do_pair(GroupDef *grp, Term t, struct intermediates *cint,
|
|
|
|
|
UInt argno, int first, int last_arg, UInt nxtlbl,
|
|
|
|
|
int clleft, CELL *top) {
|
2003-04-30 18:46:05 +01:00
|
|
|
|
ClauseDef *min = grp->FirstClause;
|
2003-06-06 14:16:40 +01:00
|
|
|
|
ClauseDef *max = grp->FirstClause;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
|
2003-06-06 14:16:40 +01:00
|
|
|
|
while (IsPairTerm(max->Tag) && max != grp->LastClause) {
|
|
|
|
|
max++;
|
|
|
|
|
}
|
2005-02-21 16:50:21 +00:00
|
|
|
|
if (!IsPairTerm(max->Tag)) {
|
|
|
|
|
max--;
|
|
|
|
|
}
|
2003-06-06 14:16:40 +01:00
|
|
|
|
if (min > grp->LastClause) {
|
2003-04-30 18:46:05 +01:00
|
|
|
|
/* no clauses, just skip */
|
|
|
|
|
return nxtlbl;
|
2003-06-06 14:16:40 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
grp->FirstClause = max + 1;
|
2003-06-06 14:16:40 +01:00
|
|
|
|
if (min == max) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* single clause, no need to do indexing, but we do know it is a list */
|
2008-05-11 00:24:13 +01:00
|
|
|
|
if (cint->CurrentPred->PredFlags & LogUpdatePredFlag) {
|
|
|
|
|
return (UInt)(min->Code);
|
|
|
|
|
} else {
|
|
|
|
|
return (UInt)(min->CurrentCode);
|
|
|
|
|
}
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (min != max && !IsPairTerm(t)) {
|
2008-09-14 05:11:51 +01:00
|
|
|
|
return suspend_indexing(min, max, cint->CurrentPred, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return do_compound_index(min, max, (IsPairTerm(t) ? RepPair(t) : NULL), cint,
|
|
|
|
|
0, 2, argno, nxtlbl, first, last_arg, clleft, top,
|
|
|
|
|
TRUE);
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void group_prologue(int compound_term, UInt argno, int first,
|
|
|
|
|
struct intermediates *cint) {
|
2003-04-30 18:46:05 +01:00
|
|
|
|
if (compound_term) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_emit(cache_sub_arg_op, compound_term - 1, compound_term - 1, cint);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
} else {
|
|
|
|
|
if (!first || argno != 1) {
|
2004-01-23 02:23:51 +00:00
|
|
|
|
Yap_emit(cache_arg_op, argno, argno, cint);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2003-04-30 18:46:05 +01:00
|
|
|
|
/* make sure that we can handle failure correctly */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void emit_protection_choicepoint(int first, int clleft, UInt nxtlbl,
|
|
|
|
|
struct intermediates *cint) {
|
2003-09-15 02:25:29 +01:00
|
|
|
|
|
2003-04-30 18:46:05 +01:00
|
|
|
|
if (first) {
|
|
|
|
|
if (clleft) {
|
2004-01-23 02:23:51 +00:00
|
|
|
|
if (cint->CurrentPred->PredFlags & LogUpdatePredFlag) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
UInt labl = new_label(cint);
|
2004-01-23 02:23:51 +00:00
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_emit_4ops(enter_lu_op, labl, labl, 0, Zero, cint);
|
|
|
|
|
Yap_emit(label_op, labl, Zero, cint);
|
2003-09-15 02:25:29 +01:00
|
|
|
|
}
|
2004-01-23 02:23:51 +00:00
|
|
|
|
Yap_emit(tryme_op, nxtlbl, (clleft << 1), cint);
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
} else {
|
2003-04-30 18:46:05 +01:00
|
|
|
|
/* !first */
|
|
|
|
|
if (clleft) {
|
2004-01-23 02:23:51 +00:00
|
|
|
|
Yap_emit(retryme_op, nxtlbl, (clleft << 1), cint);
|
2003-12-18 17:36:54 +00:00
|
|
|
|
} else {
|
2004-01-23 02:23:51 +00:00
|
|
|
|
Yap_emit(trustme_op, 0, 0, cint);
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static ClauseDef *cls_move(ClauseDef *min, PredEntry *ap, ClauseDef *max,
|
|
|
|
|
int compound_term, UInt argno, int last_arg) {
|
|
|
|
|
ClauseDef *cl = min;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
|
2003-04-30 18:46:05 +01:00
|
|
|
|
cl = min;
|
|
|
|
|
if (compound_term) {
|
|
|
|
|
while (cl <= max) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
skip_to_arg(cl, ap, compound_term, last_arg);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
cl++;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
} else {
|
2003-04-30 18:46:05 +01:00
|
|
|
|
while (cl <= max) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (cl->Tag == (_var + 1) * sizeof(CELL)) {
|
|
|
|
|
ClauseDef *cli = cl;
|
|
|
|
|
while (cli < max) {
|
|
|
|
|
clcpy(cli, cli + 1);
|
|
|
|
|
cli++;
|
|
|
|
|
}
|
|
|
|
|
max--;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
move_next(cl, argno);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
|
|
|
|
cl++;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
2003-04-30 18:46:05 +01:00
|
|
|
|
return max;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void purge_pvar(GroupDef *group) {
|
2003-04-30 18:46:05 +01:00
|
|
|
|
ClauseDef *max = group->LastClause;
|
|
|
|
|
ClauseDef *cl = group->FirstClause;
|
|
|
|
|
|
|
|
|
|
while (cl <= max) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (cl->Tag == (_var + 1) * sizeof(CELL)) {
|
2003-04-30 18:46:05 +01:00
|
|
|
|
ClauseDef *cli = cl;
|
|
|
|
|
while (cli < max) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clcpy(cli, cli + 1);
|
|
|
|
|
cli++;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
|
|
|
|
group->VarClauses--;
|
|
|
|
|
max--;
|
|
|
|
|
}
|
|
|
|
|
cl++;
|
|
|
|
|
}
|
|
|
|
|
group->LastClause = max;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static UInt *do_nonvar_group(GroupDef *grp, Term t, UInt compound_term,
|
|
|
|
|
CELL *sreg, UInt arity, UInt labl,
|
|
|
|
|
struct intermediates *cint, UInt argno, int first,
|
|
|
|
|
int last_arg, UInt nxtlbl, int clleft, CELL *top) {
|
2003-04-30 18:46:05 +01:00
|
|
|
|
TypeSwitch *type_sw;
|
2004-01-23 02:23:51 +00:00
|
|
|
|
PredEntry *ap = cint->CurrentPred;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
|
|
|
|
|
/* move cl pointer */
|
|
|
|
|
if (grp->AtomClauses + grp->PairClauses + grp->StructClauses > 1) {
|
2004-01-23 02:23:51 +00:00
|
|
|
|
Yap_emit(label_op, labl, Zero, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (argno == 1 && !compound_term) {
|
2004-01-23 02:23:51 +00:00
|
|
|
|
emit_protection_choicepoint(first, clleft, nxtlbl, cint);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
2004-01-23 02:23:51 +00:00
|
|
|
|
group_prologue(compound_term, argno, first, cint);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
if (grp->LastClause < grp->FirstClause) { /* only tests */
|
2003-08-27 14:30:50 +01:00
|
|
|
|
return NULL;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
2004-01-23 02:23:51 +00:00
|
|
|
|
type_sw = emit_type_switch(switch_on_type_op, cint);
|
2015-11-05 16:38:18 +00:00
|
|
|
|
/* have these first so that we will have something initialized here */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
type_sw->ConstEntry = type_sw->FuncEntry = type_sw->PairEntry =
|
|
|
|
|
type_sw->VarEntry = nxtlbl;
|
|
|
|
|
type_sw->VarEntry =
|
|
|
|
|
do_var_entries(grp, t, cint, argno, first, clleft, nxtlbl);
|
|
|
|
|
grp->LastClause = cls_move(grp->FirstClause, ap, grp->LastClause,
|
|
|
|
|
compound_term, argno, last_arg);
|
|
|
|
|
sort_group(grp, top, cint);
|
2003-06-06 14:16:40 +01:00
|
|
|
|
while (grp->FirstClause <= grp->LastClause) {
|
|
|
|
|
if (IsAtomOrIntTerm(grp->FirstClause->Tag)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
type_sw->ConstEntry =
|
|
|
|
|
do_consts(grp, t, cint, compound_term, sreg, arity, last_arg, argno,
|
|
|
|
|
first, nxtlbl, clleft, top);
|
2003-06-06 14:16:40 +01:00
|
|
|
|
} else if (IsApplTerm(grp->FirstClause->Tag)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
type_sw->FuncEntry =
|
|
|
|
|
do_funcs(grp, t, cint, argno, first, last_arg, nxtlbl, clleft, top);
|
2003-06-06 14:16:40 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
type_sw->PairEntry =
|
|
|
|
|
do_pair(grp, t, cint, argno, first, last_arg, nxtlbl, clleft, top);
|
2003-06-06 14:16:40 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
return &(type_sw->VarEntry);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_emit(label_op, labl, Zero, cint);
|
|
|
|
|
do_var_group(grp, cint, TRUE, first, clleft, nxtlbl, ap->ArityOfPE + 1);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
return NULL;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static UInt do_optims(GroupDef *group, int ngroups, UInt fail_l, ClauseDef *min,
|
|
|
|
|
struct intermediates *cint) {
|
|
|
|
|
if (ngroups == 2 && group[0].FirstClause == group[0].LastClause &&
|
2003-04-30 18:46:05 +01:00
|
|
|
|
group[0].AtomClauses == 1 && group[1].VarClauses == 1) {
|
|
|
|
|
CELL *sp;
|
|
|
|
|
UInt labl;
|
|
|
|
|
|
2006-05-16 19:37:31 +01:00
|
|
|
|
labl = new_label(cint);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
sp = Yap_emit_extra_size(if_not_op, Zero, 4 * CellSize, cint);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
sp[0] = (CELL)(group[0].FirstClause->Tag);
|
|
|
|
|
sp[1] = (CELL)(group[1].FirstClause->Code);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
sp[2] = do_var_clauses(group[0].FirstClause, group[1].LastClause, FALSE,
|
|
|
|
|
cint, TRUE, 0, (CELL)FAILCODE,
|
|
|
|
|
cint->CurrentPred->ArityOfPE + 1);
|
|
|
|
|
sp[3] = do_var_clauses(min, group[1].LastClause, FALSE, cint, TRUE, 0,
|
|
|
|
|
(CELL)FAILCODE, cint->CurrentPred->ArityOfPE + 1);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
return labl;
|
|
|
|
|
}
|
|
|
|
|
return fail_l;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static int cls_info(ClauseDef *min, ClauseDef *max, UInt argno) {
|
|
|
|
|
ClauseDef *cl = min;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
int found_pvar = FALSE;
|
|
|
|
|
|
|
|
|
|
while (cl <= max) {
|
|
|
|
|
add_info(cl, argno);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (cl->Tag == (_var + 1) * sizeof(CELL)) {
|
2003-04-30 18:46:05 +01:00
|
|
|
|
found_pvar = TRUE;
|
|
|
|
|
}
|
|
|
|
|
/* if (IsVarTerm(cl->Tag)) cl->Tag = (CELL)NULL; */
|
|
|
|
|
cl++;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
2003-04-30 18:46:05 +01:00
|
|
|
|
return found_pvar;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static int cls_head_info(ClauseDef *min, ClauseDef *max, UInt argno,
|
|
|
|
|
int in_idb) {
|
|
|
|
|
ClauseDef *cl = min;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
|
2007-01-08 08:27:19 +00:00
|
|
|
|
if (in_idb) {
|
|
|
|
|
if (argno != 2) {
|
|
|
|
|
while (cl <= max) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl->Tag = (CELL)NULL;
|
|
|
|
|
cl++;
|
|
|
|
|
}
|
2007-01-08 08:27:19 +00:00
|
|
|
|
} else {
|
|
|
|
|
while (cl <= max) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
LogUpdClause *lcl = ClauseCodeToLogUpdClause(cl->CurrentCode);
|
|
|
|
|
Term t = lcl->lusl.ClSource->Entry;
|
|
|
|
|
|
|
|
|
|
if (IsVarTerm(t)) {
|
|
|
|
|
cl->Tag = (CELL)NULL;
|
|
|
|
|
} else if (IsApplTerm(t)) {
|
|
|
|
|
CELL *pt = RepAppl(t);
|
|
|
|
|
|
|
|
|
|
cl->Tag = AbsAppl((CELL *)pt[0]);
|
|
|
|
|
if (IsExtensionFunctor(FunctorOfTerm(t))) {
|
|
|
|
|
cl->ucd.t_ptr = t;
|
|
|
|
|
} else {
|
|
|
|
|
cl->ucd.c_sreg = pt;
|
|
|
|
|
}
|
|
|
|
|
} else if (IsPairTerm(t)) {
|
|
|
|
|
CELL *pt = RepPair(t);
|
|
|
|
|
|
|
|
|
|
cl->Tag = AbsPair(NULL);
|
|
|
|
|
cl->ucd.c_sreg = pt - 1;
|
|
|
|
|
} else {
|
|
|
|
|
cl->Tag = t;
|
|
|
|
|
}
|
|
|
|
|
cl++;
|
2007-01-08 08:27:19 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
while (cl <= max) {
|
|
|
|
|
add_info(cl, argno);
|
|
|
|
|
/* if (IsVarTerm(cl->Tag)) cl->Tag = (CELL)NULL; */
|
|
|
|
|
cl++;
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
return FALSE;
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static UInt do_index(ClauseDef *min, ClauseDef *max, struct intermediates *cint,
|
|
|
|
|
UInt argno, UInt fail_l, int first, int clleft,
|
|
|
|
|
CELL *top) {
|
2011-03-07 16:02:55 +00:00
|
|
|
|
CACHE_REGS
|
2003-04-30 18:46:05 +01:00
|
|
|
|
UInt ngroups, found_pvar = FALSE;
|
|
|
|
|
UInt i = 0;
|
|
|
|
|
GroupDef *group = (GroupDef *)top;
|
2003-11-12 12:33:31 +00:00
|
|
|
|
UInt labl, labl0, lablx;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
Term t;
|
|
|
|
|
/* remember how we entered here */
|
|
|
|
|
UInt argno0 = argno;
|
2004-01-23 02:23:51 +00:00
|
|
|
|
PredEntry *ap = cint->CurrentPred;
|
2004-04-16 20:27:31 +01:00
|
|
|
|
yamop *eblk = cint->expand_block;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
|
|
|
|
|
if (min == max) {
|
|
|
|
|
/* base case, just commit to the current code */
|
2004-01-23 02:23:51 +00:00
|
|
|
|
return emit_single_switch_case(min, cint, first, clleft, fail_l);
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if ((argno > 1 && indexingMode() == TermSingle &&
|
|
|
|
|
ap->PredFlags & LogUpdatePredFlag) ||
|
|
|
|
|
indexingMode() == TermOff || ap->ArityOfPE < argno) {
|
|
|
|
|
return do_var_clauses(min, max, FALSE, cint, first, clleft, fail_l,
|
|
|
|
|
ap->ArityOfPE + 1);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
t = Deref(XREGS[argno]);
|
2003-10-28 01:16:03 +00:00
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
found_pvar =
|
|
|
|
|
cls_head_info(min, max, argno, (ap->ModuleOfPred == IDB_MODULE));
|
2003-10-28 01:16:03 +00:00
|
|
|
|
} else {
|
|
|
|
|
found_pvar = cls_info(min, max, argno);
|
|
|
|
|
}
|
2007-09-22 09:38:05 +01:00
|
|
|
|
ngroups = groups_in(min, max, group, cint);
|
2004-03-31 02:02:18 +01:00
|
|
|
|
if (IsVarTerm(t)) {
|
2006-05-16 19:37:31 +01:00
|
|
|
|
lablx = new_label(cint);
|
2004-01-23 02:23:51 +00:00
|
|
|
|
Yap_emit(label_op, lablx, Zero, cint);
|
2003-11-12 12:33:31 +00:00
|
|
|
|
while (IsVarTerm(t)) {
|
2004-04-14 20:10:40 +01:00
|
|
|
|
if (ngroups > 1 || !group->VarClauses) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
UInt susp_lab = suspend_indexing(min, max, ap, cint);
|
|
|
|
|
if (!cint->expand_block) {
|
|
|
|
|
cint->expand_block = (yamop *)susp_lab;
|
|
|
|
|
}
|
|
|
|
|
Yap_emit(jump_nv_op, susp_lab, argno, cint);
|
2004-04-14 20:10:40 +01:00
|
|
|
|
}
|
2005-07-18 18:41:16 +01:00
|
|
|
|
if (argno == ap->ArityOfPE ||
|
2016-07-31 10:26:15 +01:00
|
|
|
|
(indexingMode() == TermSingle && ap->PredFlags & LogUpdatePredFlag)) {
|
|
|
|
|
do_var_clauses(min, max, FALSE, cint, first, clleft, fail_l, argno0);
|
|
|
|
|
cint->expand_block = eblk;
|
|
|
|
|
return lablx;
|
2003-11-12 12:33:31 +00:00
|
|
|
|
}
|
|
|
|
|
argno++;
|
|
|
|
|
t = Deref(XREGS[argno]);
|
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
found_pvar =
|
|
|
|
|
cls_head_info(min, max, argno, (ap->ModuleOfPred == IDB_MODULE));
|
2003-11-12 12:33:31 +00:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
found_pvar = cls_info(min, max, argno);
|
2003-11-12 12:33:31 +00:00
|
|
|
|
}
|
2007-09-22 09:38:05 +01:00
|
|
|
|
ngroups = groups_in(min, max, group, cint);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
}
|
2006-05-16 19:37:31 +01:00
|
|
|
|
labl0 = labl = new_label(cint);
|
2003-11-12 12:33:31 +00:00
|
|
|
|
} else {
|
2006-05-16 19:37:31 +01:00
|
|
|
|
lablx = labl0 = labl = new_label(cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2004-04-16 20:27:31 +01:00
|
|
|
|
cint->expand_block = eblk;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
top = (CELL *)(group + ngroups);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (argno > 1) {
|
2003-04-30 18:46:05 +01:00
|
|
|
|
/* don't try being smart for other arguments than the first */
|
|
|
|
|
if (ngroups > 1 || group->VarClauses != 0 || found_pvar) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (ap->ArityOfPE == argno) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return do_var_clauses(min, max, FALSE, cint, first, clleft, fail_l,
|
|
|
|
|
ap->ArityOfPE + 1);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return do_index(min, max, cint, argno + 1, fail_l, first, clleft, top);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
|
|
|
|
} else {
|
|
|
|
|
ClauseDef *cl = min;
|
|
|
|
|
/*
|
2016-07-31 10:26:15 +01:00
|
|
|
|
need to reset the code pointer, otherwise I could be in
|
|
|
|
|
the middle of a compound term.
|
2003-04-30 18:46:05 +01:00
|
|
|
|
*/
|
|
|
|
|
while (cl <= max) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl->CurrentCode = cl->Code;
|
|
|
|
|
cl++;
|
|
|
|
|
}
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
|
|
|
|
} else {
|
|
|
|
|
UInt special_options;
|
2006-03-20 19:51:44 +00:00
|
|
|
|
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if ((ap->PredFlags & LogUpdatePredFlag) && ngroups > 1) {
|
2006-10-10 15:08:17 +01:00
|
|
|
|
if (ngroups > 1) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
group[0].VarClauses = ap->cs.p_code.NOfClauses;
|
|
|
|
|
group[0].AtomClauses = group[0].PairClauses = group[0].StructClauses =
|
|
|
|
|
group[0].TestClauses = 0;
|
|
|
|
|
group[0].LastClause = group[ngroups - 1].LastClause;
|
|
|
|
|
ngroups = 1;
|
|
|
|
|
}
|
|
|
|
|
} else if ((special_options =
|
|
|
|
|
do_optims(group, ngroups, fail_l, min, cint)) != fail_l) {
|
2003-04-30 18:46:05 +01:00
|
|
|
|
return special_options;
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (ngroups == 1 && group->VarClauses && !found_pvar) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return do_index(min, max, cint, argno + 1, fail_l, first, clleft, top);
|
2006-03-20 19:51:44 +00:00
|
|
|
|
} else if (found_pvar ||
|
2016-07-31 10:26:15 +01:00
|
|
|
|
(ap->PredFlags & LogUpdatePredFlag && group[0].VarClauses)) {
|
2006-03-20 19:51:44 +00:00
|
|
|
|
/* make sure we know where to suspend */
|
2004-01-23 02:23:51 +00:00
|
|
|
|
Yap_emit(label_op, labl0, Zero, cint);
|
2006-05-16 19:37:31 +01:00
|
|
|
|
labl = new_label(cint);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_emit(jump_v_op, suspend_indexing(min, max, ap, cint), Zero, cint);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
for (i = 0; i < ngroups; i++) {
|
2003-04-30 18:46:05 +01:00
|
|
|
|
UInt nextlbl;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
int left_clauses = clleft + (max - group->LastClause);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
/* a group may end up not having clauses*/
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (i < ngroups - 1) {
|
2006-05-16 19:37:31 +01:00
|
|
|
|
nextlbl = new_label(cint);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
} else {
|
|
|
|
|
nextlbl = fail_l;
|
|
|
|
|
}
|
|
|
|
|
if (found_pvar && argno == 1) {
|
|
|
|
|
purge_pvar(group);
|
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (group->FirstClause == group->LastClause && first && left_clauses == 0) {
|
2004-01-23 02:23:51 +00:00
|
|
|
|
Yap_emit(jumpi_op, (CELL)(group->FirstClause->Code), Zero, cint);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
} else {
|
|
|
|
|
if (group->VarClauses) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_emit(label_op, labl, Zero, cint);
|
|
|
|
|
do_var_group(group, cint, argno == 1, first, left_clauses, nextlbl,
|
|
|
|
|
ap->ArityOfPE + 1);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
do_nonvar_group(group, t, 0, NULL, 0, labl, cint, argno, first, TRUE,
|
|
|
|
|
nextlbl, left_clauses, top);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
first = FALSE;
|
|
|
|
|
group++;
|
|
|
|
|
labl = nextlbl;
|
|
|
|
|
}
|
2003-11-12 12:33:31 +00:00
|
|
|
|
return lablx;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static ClauseDef *copy_clauses(ClauseDef *max0, ClauseDef *min0, CELL *top,
|
|
|
|
|
struct intermediates *cint) {
|
2011-03-07 16:02:55 +00:00
|
|
|
|
CACHE_REGS
|
2016-07-31 10:26:15 +01:00
|
|
|
|
UInt sz = ((max0 + 1) - min0) * sizeof(ClauseDef);
|
|
|
|
|
if ((char *)top + sz >= LOCAL_TrailTop - 4096) {
|
2011-05-23 16:19:47 +01:00
|
|
|
|
LOCAL_Error_Size = sz;
|
2004-02-05 16:57:02 +00:00
|
|
|
|
/* grow stack */
|
2005-12-23 00:20:14 +00:00
|
|
|
|
save_machine_regs();
|
2016-07-31 10:26:15 +01:00
|
|
|
|
siglongjmp(cint->CompilerBotch, 4);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2018-06-30 14:33:32 +01:00
|
|
|
|
memmove((void *)top, (void *)min0, sz);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
return (ClauseDef *)top;
|
|
|
|
|
}
|
|
|
|
|
|
2012-06-05 00:12:13 +01:00
|
|
|
|
/* make sure that it is worth it to generate indexing code at that point */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static int several_tags(ClauseDef *min, ClauseDef *max) {
|
2012-06-05 00:12:13 +01:00
|
|
|
|
CELL tag = min->Tag;
|
|
|
|
|
while (min < max) {
|
|
|
|
|
min++;
|
2012-06-05 08:04:22 +01:00
|
|
|
|
if (!IsAtomOrIntTerm(min->Tag) || min->Tag != tag)
|
2012-06-05 00:12:13 +01:00
|
|
|
|
return TRUE;
|
|
|
|
|
}
|
|
|
|
|
return FALSE;
|
|
|
|
|
}
|
|
|
|
|
|
2003-04-30 18:46:05 +01:00
|
|
|
|
/* execute an index inside a structure */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static UInt do_compound_index(ClauseDef *min0, ClauseDef *max0, Term *sreg,
|
|
|
|
|
struct intermediates *cint, UInt i, UInt arity,
|
|
|
|
|
UInt argno, UInt fail_l, int first, int last_arg,
|
|
|
|
|
int clleft, CELL *top, int done_work) {
|
2005-02-21 16:50:21 +00:00
|
|
|
|
UInt ret_lab = 0, *newlabp;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
CELL *top0 = top;
|
|
|
|
|
ClauseDef *min, *max;
|
2004-01-23 02:23:51 +00:00
|
|
|
|
PredEntry *ap = cint->CurrentPred;
|
2015-01-06 17:47:58 +00:00
|
|
|
|
int found_index = FALSE;
|
|
|
|
|
pred_flags_t lu_pred = ap->PredFlags & LogUpdatePredFlag;
|
2012-05-28 20:40:12 +01:00
|
|
|
|
UInt old_last_depth, old_last_depth_size;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
newlabp = &ret_lab;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (min0 == max0) {
|
2003-04-30 18:46:05 +01:00
|
|
|
|
/* base case, just commit to the current code */
|
2004-01-23 02:23:51 +00:00
|
|
|
|
return emit_single_switch_case(min0, cint, first, clleft, fail_l);
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
2015-06-19 00:16:32 +01:00
|
|
|
|
if ((indexingMode() == TermSingle && ap->PredFlags & LogUpdatePredFlag) ||
|
2016-07-31 10:26:15 +01:00
|
|
|
|
(indexingDepth() &&
|
|
|
|
|
cint->term_depth - cint->last_index_new_depth > indexingDepth())) {
|
|
|
|
|
*newlabp = do_var_clauses(min0, max0, FALSE, cint, first, clleft, fail_l,
|
|
|
|
|
ap->ArityOfPE + 1);
|
|
|
|
|
return ret_lab;
|
2003-06-06 12:54:02 +01:00
|
|
|
|
}
|
2012-06-01 13:16:29 +01:00
|
|
|
|
if (sreg == NULL) {
|
2004-04-14 20:10:40 +01:00
|
|
|
|
return suspend_indexing(min0, max0, ap, cint);
|
2003-09-15 02:25:29 +01:00
|
|
|
|
}
|
2012-05-28 20:40:12 +01:00
|
|
|
|
cint->term_depth++;
|
|
|
|
|
old_last_depth = cint->last_index_new_depth;
|
|
|
|
|
old_last_depth_size = cint->last_depth_size;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (cint->last_depth_size != max0 - min0) {
|
2012-05-28 20:40:12 +01:00
|
|
|
|
cint->last_index_new_depth = cint->term_depth;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cint->last_depth_size = max0 - min0;
|
2012-05-28 20:40:12 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
while (i < arity && !found_index) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
ClauseDef *cl;
|
|
|
|
|
GroupDef *group;
|
|
|
|
|
UInt ngroups;
|
2003-10-02 13:59:05 +01:00
|
|
|
|
int isvt = IsVarTerm(Deref(sreg[i]));
|
2003-08-27 14:30:50 +01:00
|
|
|
|
|
2004-01-23 02:23:51 +00:00
|
|
|
|
min = copy_clauses(max0, min0, top, cint);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
max = min + (max0 - min0);
|
|
|
|
|
top = (CELL *)(max + 1);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
cl = min;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
/* search for a subargument */
|
|
|
|
|
while (cl <= max) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
add_arg_info(cl, ap, i + 1);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
cl++;
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
group = (GroupDef *)top;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ngroups = groups_in(min, max, group, cint);
|
|
|
|
|
if (ngroups == 1 && group->VarClauses == 0 &&
|
|
|
|
|
(i < 8 || several_tags(min, max))) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
/* ok, we are doing a sub-argument */
|
2006-11-06 18:35:05 +00:00
|
|
|
|
/* process group */
|
|
|
|
|
|
|
|
|
|
found_index = TRUE;
|
|
|
|
|
ret_lab = new_label(cint);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
top = (CELL *)(group + 1);
|
|
|
|
|
if (do_nonvar_group(group, (sreg == NULL ? 0L : Deref(sreg[i])), i + 1,
|
|
|
|
|
(isvt ? NULL : sreg), arity, *newlabp, cint, argno,
|
|
|
|
|
first, (last_arg && i + 1 == arity), fail_l, clleft,
|
|
|
|
|
top) == NULL) {
|
|
|
|
|
top = top0;
|
|
|
|
|
break;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
top = top0;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
i++;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (!found_index) {
|
2003-09-15 20:06:55 +01:00
|
|
|
|
if (!lu_pred || !done_work)
|
2016-07-31 10:26:15 +01:00
|
|
|
|
*newlabp =
|
|
|
|
|
do_index(min0, max0, cint, argno + 1, fail_l, first, clleft, top);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
else
|
2004-04-14 20:10:40 +01:00
|
|
|
|
*newlabp = suspend_indexing(min0, max0, ap, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2012-05-28 20:40:12 +01:00
|
|
|
|
cint->last_index_new_depth = old_last_depth;
|
|
|
|
|
cint->last_depth_size = old_last_depth_size;
|
|
|
|
|
cint->term_depth--;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
return ret_lab;
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static UInt do_dbref_index(ClauseDef *min, ClauseDef *max, Term t,
|
|
|
|
|
struct intermediates *cint, UInt argno, UInt fail_l,
|
|
|
|
|
int first, int clleft, CELL *top) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
UInt ngroups;
|
|
|
|
|
GroupDef *group;
|
|
|
|
|
ClauseDef *cl = min;
|
|
|
|
|
|
|
|
|
|
group = (GroupDef *)top;
|
|
|
|
|
cl = min;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
|
2003-08-27 14:30:50 +01:00
|
|
|
|
while (cl <= max) {
|
2014-02-18 09:44:01 +00:00
|
|
|
|
cl->Tag = cl->ucd.t_ptr;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
cl++;
|
|
|
|
|
}
|
2007-09-22 09:38:05 +01:00
|
|
|
|
ngroups = groups_in(min, max, group, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (ngroups > 1 || group->VarClauses) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return do_index(min, max, cint, argno + 1, fail_l, first, clleft, top);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
} else {
|
2006-05-16 19:37:31 +01:00
|
|
|
|
int labl = new_label(cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
|
2004-01-23 02:23:51 +00:00
|
|
|
|
Yap_emit(label_op, labl, Zero, cint);
|
|
|
|
|
Yap_emit(index_dbref_op, Zero, Zero, cint);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
sort_group(group, (CELL *)(group + 1), cint);
|
|
|
|
|
do_blobs(group, t, cint, argno, first, fail_l, clleft, (CELL *)(group + 1));
|
2003-08-27 14:30:50 +01:00
|
|
|
|
return labl;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static UInt do_blob_index(ClauseDef *min, ClauseDef *max, Term t,
|
|
|
|
|
struct intermediates *cint, UInt argno, UInt fail_l,
|
|
|
|
|
int first, int clleft, CELL *top, int blob) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
UInt ngroups;
|
|
|
|
|
GroupDef *group;
|
|
|
|
|
ClauseDef *cl = min;
|
|
|
|
|
|
|
|
|
|
group = (GroupDef *)top;
|
|
|
|
|
cl = min;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
|
2003-08-27 14:30:50 +01:00
|
|
|
|
while (cl <= max) {
|
2014-02-18 09:44:01 +00:00
|
|
|
|
if (cl->ucd.t_ptr == (CELL)NULL) { /* check whether it is a builtin */
|
2003-09-23 16:14:56 +01:00
|
|
|
|
cl->Tag = Zero;
|
2009-02-09 21:56:40 +00:00
|
|
|
|
} else if (blob) {
|
2014-02-18 09:44:01 +00:00
|
|
|
|
cl->Tag = Yap_Double_key(cl->ucd.t_ptr);
|
2009-02-09 21:56:40 +00:00
|
|
|
|
} else {
|
2014-02-18 09:44:01 +00:00
|
|
|
|
cl->Tag = Yap_Int_key(cl->ucd.t_ptr);
|
2003-09-23 16:14:56 +01:00
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
cl++;
|
|
|
|
|
}
|
2007-09-22 09:38:05 +01:00
|
|
|
|
ngroups = groups_in(min, max, group, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (ngroups > 1 || group->VarClauses) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return do_index(min, max, cint, argno + 1, fail_l, first, clleft, top);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2006-05-16 19:37:31 +01:00
|
|
|
|
int labl = new_label(cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
|
2004-01-23 02:23:51 +00:00
|
|
|
|
Yap_emit(label_op, labl, Zero, cint);
|
2009-02-09 21:56:40 +00:00
|
|
|
|
if (blob)
|
|
|
|
|
Yap_emit(index_blob_op, Zero, Zero, cint);
|
|
|
|
|
else
|
|
|
|
|
Yap_emit(index_long_op, Zero, Zero, cint);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
sort_group(group, (CELL *)(group + 1), cint);
|
|
|
|
|
do_blobs(group, t, cint, argno, first, fail_l, clleft, (CELL *)(group + 1));
|
2003-08-27 14:30:50 +01:00
|
|
|
|
return labl;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void init_clauses(ClauseDef *cl, PredEntry *ap) {
|
2004-09-27 21:45:04 +01:00
|
|
|
|
if (ap->PredFlags & MegaClausePredFlag) {
|
|
|
|
|
MegaClause *mcl = ClauseCodeToMegaClause(ap->cs.p_code.FirstClause);
|
2011-09-01 05:13:29 +01:00
|
|
|
|
UInt nclauses = mcl->ClPred->cs.p_code.NOfClauses;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
yamop *end = (yamop *)((char *)mcl->ClCode + nclauses * mcl->ClItemSize);
|
2004-09-27 21:45:04 +01:00
|
|
|
|
yamop *cd = mcl->ClCode;
|
|
|
|
|
while (cd < end) {
|
|
|
|
|
cl->Code = cl->CurrentCode = cd;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cd = (yamop *)((char *)cd + mcl->ClItemSize);
|
2004-09-27 21:45:04 +01:00
|
|
|
|
cl++;
|
|
|
|
|
}
|
|
|
|
|
} else {
|
2005-05-31 05:46:06 +01:00
|
|
|
|
StaticClause *scl;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
|
2005-05-31 05:46:06 +01:00
|
|
|
|
scl = ClauseCodeToStaticClause(ap->cs.p_code.FirstClause);
|
2004-09-27 21:45:04 +01:00
|
|
|
|
do {
|
|
|
|
|
cl->Code = cl->CurrentCode = scl->ClCode;
|
|
|
|
|
cl++;
|
|
|
|
|
if (scl->ClCode == ap->cs.p_code.LastClause)
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return;
|
2004-09-27 21:45:04 +01:00
|
|
|
|
scl = scl->ClNext;
|
|
|
|
|
} while (TRUE);
|
|
|
|
|
}
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void init_log_upd_clauses(ClauseDef *cl, PredEntry *ap) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
LogUpdClause *lcl = ClauseCodeToLogUpdClause(ap->cs.p_code.FirstClause);
|
|
|
|
|
|
|
|
|
|
do {
|
|
|
|
|
cl->Code = cl->CurrentCode = lcl->ClCode;
|
|
|
|
|
cl++;
|
|
|
|
|
lcl = lcl->ClNext;
|
|
|
|
|
} while (lcl != NULL);
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static UInt compile_index(struct intermediates *cint) {
|
2011-03-07 16:02:55 +00:00
|
|
|
|
CACHE_REGS
|
2004-01-23 02:23:51 +00:00
|
|
|
|
PredEntry *ap = cint->CurrentPred;
|
2003-04-30 18:46:05 +01:00
|
|
|
|
int NClauses = ap->cs.p_code.NOfClauses;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
CELL *top = (CELL *)TR;
|
2010-03-31 15:51:18 +01:00
|
|
|
|
UInt res;
|
2003-05-19 14:04:09 +01:00
|
|
|
|
|
2003-04-30 18:46:05 +01:00
|
|
|
|
/* only global variable I use directly */
|
2006-05-16 19:37:31 +01:00
|
|
|
|
cint->i_labelno = 1;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
|
2011-05-23 16:19:47 +01:00
|
|
|
|
LOCAL_Error_Size = 0;
|
2010-03-31 15:51:18 +01:00
|
|
|
|
#if USE_SYSTEM_MALLOC
|
2010-04-15 22:23:54 +01:00
|
|
|
|
if (!cint->cls) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cint->cls = (ClauseDef *)Yap_AllocCodeSpace(NClauses * sizeof(ClauseDef));
|
2010-04-15 22:23:54 +01:00
|
|
|
|
if (!cint->cls) {
|
|
|
|
|
/* tell how much space we need */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
LOCAL_Error_Size += NClauses * sizeof(ClauseDef);
|
2010-04-15 22:23:54 +01:00
|
|
|
|
/* grow stack */
|
|
|
|
|
save_machine_regs();
|
2016-07-31 10:26:15 +01:00
|
|
|
|
siglongjmp(cint->CompilerBotch, 2);
|
2010-04-15 22:23:54 +01:00
|
|
|
|
}
|
2010-03-31 15:51:18 +01:00
|
|
|
|
}
|
2014-01-19 21:15:05 +00:00
|
|
|
|
cint->freep = (char *)HR;
|
2010-03-31 15:51:18 +01:00
|
|
|
|
#else
|
2003-05-19 14:04:09 +01:00
|
|
|
|
/* reserve double the space for compiler */
|
2014-01-19 21:15:05 +00:00
|
|
|
|
cint->cls = (ClauseDef *)HR;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (cint->cls + 2 * NClauses > (ClauseDef *)(ASP - 4096)) {
|
2003-05-19 14:04:09 +01:00
|
|
|
|
/* tell how much space we need */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
LOCAL_Error_Size += NClauses * sizeof(ClauseDef);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
/* grow stack */
|
2005-12-23 00:20:14 +00:00
|
|
|
|
save_machine_regs();
|
2016-07-31 10:26:15 +01:00
|
|
|
|
siglongjmp(cint->CompilerBotch, 3);
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cint->freep = (char *)(cint->cls + NClauses);
|
2010-03-31 15:51:18 +01:00
|
|
|
|
#endif
|
2003-04-30 18:46:05 +01:00
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
|
|
|
|
/* throw away a label */
|
2006-05-16 19:37:31 +01:00
|
|
|
|
new_label(cint);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
init_log_upd_clauses(cint->cls, ap);
|
2009-02-12 21:35:31 +00:00
|
|
|
|
} else if (ap->PredFlags & UDIPredFlag) {
|
|
|
|
|
UInt lbl = new_label(cint);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_emit(user_switch_op, Unsigned(ap),
|
|
|
|
|
Unsigned(&(ap->cs.p_code.ExpandCode)), cint);
|
2009-02-12 21:35:31 +00:00
|
|
|
|
return lbl;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* prepare basic data structures */
|
|
|
|
|
init_clauses(cint->cls, ap);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
res = do_index(cint->cls, cint->cls + (NClauses - 1), cint, 1, (UInt)FAILCODE,
|
|
|
|
|
TRUE, 0, top);
|
2010-03-31 15:51:18 +01:00
|
|
|
|
return res;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void CleanCls(struct intermediates *cint) {
|
2010-04-15 22:23:54 +01:00
|
|
|
|
#if USE_SYSTEM_MALLOC
|
|
|
|
|
if (cint->cls) {
|
|
|
|
|
Yap_FreeCodeSpace((ADDR)cint->cls);
|
|
|
|
|
}
|
|
|
|
|
#endif
|
|
|
|
|
cint->cls = NULL;
|
|
|
|
|
}
|
2003-04-30 18:46:05 +01:00
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
yamop *Yap_PredIsIndexable(PredEntry *ap, UInt NSlots, yamop *next_pc) {
|
2011-03-07 16:02:55 +00:00
|
|
|
|
CACHE_REGS
|
2003-04-30 18:46:05 +01:00
|
|
|
|
yamop *indx_out;
|
2003-10-02 19:20:11 +01:00
|
|
|
|
int setjres;
|
2004-01-23 02:23:51 +00:00
|
|
|
|
struct intermediates cint;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
|
2004-01-23 02:23:51 +00:00
|
|
|
|
cint.CurrentPred = ap;
|
2009-03-27 14:05:27 +00:00
|
|
|
|
cint.code_addr = NULL;
|
2010-03-31 15:51:18 +01:00
|
|
|
|
cint.blks = NULL;
|
2010-04-15 22:23:54 +01:00
|
|
|
|
cint.cls = NULL;
|
2011-05-23 16:19:47 +01:00
|
|
|
|
LOCAL_Error_Size = 0;
|
2004-09-27 21:45:04 +01:00
|
|
|
|
|
2018-06-15 11:09:04 +01:00
|
|
|
|
if (ap->cs.p_code.NOfClauses < 2)
|
|
|
|
|
return NULL;
|
2010-12-16 01:22:10 +00:00
|
|
|
|
if ((setjres = sigsetjmp(cint.CompilerBotch, 0)) == 3) {
|
2001-04-09 20:54:03 +01:00
|
|
|
|
restore_machine_regs();
|
2004-09-27 21:45:04 +01:00
|
|
|
|
recover_from_failed_susp_on_cls(&cint, 0);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (!Yap_gcl(LOCAL_Error_Size, ap->ArityOfPE + NSlots, ENV, next_pc)) {
|
2010-04-15 22:23:54 +01:00
|
|
|
|
CleanCls(&cint);
|
2015-09-25 10:57:26 +01:00
|
|
|
|
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
|
2018-06-15 11:09:04 +01:00
|
|
|
|
return NULL;
|
2008-01-24 00:11:59 +00:00
|
|
|
|
}
|
2003-10-02 19:20:11 +01:00
|
|
|
|
} else if (setjres == 2) {
|
|
|
|
|
restore_machine_regs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
LOCAL_Error_Size = recover_from_failed_susp_on_cls(&cint, LOCAL_Error_Size);
|
|
|
|
|
if (!Yap_growheap(FALSE, LOCAL_Error_Size, NULL)) {
|
2010-04-15 22:23:54 +01:00
|
|
|
|
CleanCls(&cint);
|
2015-09-25 10:57:26 +01:00
|
|
|
|
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
|
2018-06-15 11:09:04 +01:00
|
|
|
|
return NULL;
|
2004-02-05 16:57:02 +00:00
|
|
|
|
}
|
|
|
|
|
} else if (setjres == 4) {
|
|
|
|
|
restore_machine_regs();
|
2004-09-27 21:45:04 +01:00
|
|
|
|
recover_from_failed_susp_on_cls(&cint, 0);
|
2011-05-23 16:19:47 +01:00
|
|
|
|
if (!Yap_growtrail(LOCAL_Error_Size, FALSE)) {
|
2010-04-15 22:23:54 +01:00
|
|
|
|
CleanCls(&cint);
|
2015-09-25 10:57:26 +01:00
|
|
|
|
Yap_Error(RESOURCE_ERROR_TRAIL, TermNil, LOCAL_ErrorMessage);
|
2018-06-15 11:09:04 +01:00
|
|
|
|
return NULL;
|
2003-10-02 19:20:11 +01:00
|
|
|
|
}
|
|
|
|
|
} else if (setjres != 0) {
|
2005-12-23 00:20:14 +00:00
|
|
|
|
restore_machine_regs();
|
2004-09-27 21:45:04 +01:00
|
|
|
|
recover_from_failed_susp_on_cls(&cint, 0);
|
2011-05-23 16:19:47 +01:00
|
|
|
|
if (!Yap_growheap(FALSE, LOCAL_Error_Size, NULL)) {
|
2015-09-25 10:57:26 +01:00
|
|
|
|
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
|
2010-04-15 22:23:54 +01:00
|
|
|
|
CleanCls(&cint);
|
2018-06-15 11:09:04 +01:00
|
|
|
|
return NULL;
|
2003-10-02 19:20:11 +01:00
|
|
|
|
}
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
restart_index:
|
2004-09-27 21:45:04 +01:00
|
|
|
|
Yap_BuildMegaClause(ap);
|
|
|
|
|
cint.CodeStart = cint.BlobsStart = cint.cpc = cint.icpc = NULL;
|
2004-04-14 20:10:40 +01:00
|
|
|
|
cint.expand_block = NULL;
|
2010-04-15 22:49:25 +01:00
|
|
|
|
cint.label_offset = NULL;
|
2011-05-23 16:19:47 +01:00
|
|
|
|
LOCAL_ErrorMessage = NULL;
|
2012-05-28 20:40:12 +01:00
|
|
|
|
cint.term_depth = cint.last_index_new_depth = cint.last_depth_size = 0L;
|
2004-01-23 02:23:51 +00:00
|
|
|
|
if (compile_index(&cint) == (UInt)FAILCODE) {
|
2010-04-09 17:02:24 +01:00
|
|
|
|
Yap_ReleaseCMem(&cint);
|
2010-04-15 22:23:54 +01:00
|
|
|
|
CleanCls(&cint);
|
2018-06-15 11:09:04 +01:00
|
|
|
|
return NULL;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
2013-11-15 18:25:33 +00:00
|
|
|
|
#if DEBUG
|
2011-05-25 16:40:36 +01:00
|
|
|
|
if (GLOBAL_Option['i' - 'a' + 1]) {
|
2004-01-23 02:23:51 +00:00
|
|
|
|
Yap_ShowCode(&cint);
|
2003-04-30 18:46:05 +01:00
|
|
|
|
}
|
2001-04-09 20:54:03 +01:00
|
|
|
|
#endif
|
2003-04-30 18:46:05 +01:00
|
|
|
|
/* globals for assembler */
|
2011-05-04 10:11:41 +01:00
|
|
|
|
LOCAL_IPredArity = ap->ArityOfPE;
|
2004-01-23 02:23:51 +00:00
|
|
|
|
if (cint.CodeStart) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if ((indx_out = Yap_assemble(ASSEMBLING_INDEX, TermNil, ap, FALSE, &cint,
|
|
|
|
|
cint.i_labelno + 1)) == NULL) {
|
2011-05-23 16:19:47 +01:00
|
|
|
|
if (!Yap_growheap(FALSE, LOCAL_Error_Size, NULL)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_ReleaseCMem(&cint);
|
|
|
|
|
CleanCls(&cint);
|
|
|
|
|
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
|
|
|
|
|
return NULL;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
goto restart_index;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2010-04-09 17:02:24 +01:00
|
|
|
|
Yap_ReleaseCMem(&cint);
|
2010-04-15 22:23:54 +01:00
|
|
|
|
CleanCls(&cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
return NULL;
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
2010-04-09 17:02:24 +01:00
|
|
|
|
Yap_ReleaseCMem(&cint);
|
2010-04-15 22:23:54 +01:00
|
|
|
|
CleanCls(&cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
|
|
|
|
LogUpdIndex *cl = ClauseCodeToLogUpdIndex(indx_out);
|
|
|
|
|
cl->ClFlags |= SwitchRootMask;
|
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return (indx_out);
|
2001-04-09 20:54:03 +01:00
|
|
|
|
}
|
2003-06-06 14:16:40 +01:00
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static istack_entry *push_stack(istack_entry *sp, Int arg, Term Tag, Term extra,
|
|
|
|
|
struct intermediates *cint) {
|
2011-03-07 16:02:55 +00:00
|
|
|
|
CACHE_REGS
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (sp + 1 > (istack_entry *)LOCAL_TrailTop) {
|
2005-12-23 00:20:14 +00:00
|
|
|
|
save_machine_regs();
|
2016-07-31 10:26:15 +01:00
|
|
|
|
siglongjmp(cint->CompilerBotch, 4);
|
2004-09-14 04:30:06 +01:00
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
sp->pos = arg;
|
|
|
|
|
sp->val = Tag;
|
2003-11-12 12:33:31 +00:00
|
|
|
|
sp->extra = extra;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
sp++;
|
|
|
|
|
sp->pos = 0;
|
|
|
|
|
return sp;
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static istack_entry *install_clause(ClauseDef *cls, PredEntry *ap,
|
|
|
|
|
istack_entry *stack) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
istack_entry *sp = stack;
|
|
|
|
|
while (sp->pos) {
|
|
|
|
|
if ((Int)(sp->pos) > 0) {
|
|
|
|
|
add_info(cls, sp->pos);
|
|
|
|
|
} else if (sp->pos) {
|
|
|
|
|
UInt argno = -sp->pos;
|
|
|
|
|
add_arg_info(cls, ap, argno);
|
|
|
|
|
}
|
|
|
|
|
/* if we are not talking about a variable */
|
|
|
|
|
if (cls->Tag != sp->val) {
|
|
|
|
|
if (sp->val == 0L) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
sp++;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
break;
|
|
|
|
|
} else {
|
2003-11-12 12:33:31 +00:00
|
|
|
|
if (IsApplTerm(cls->Tag)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Functor f = (Functor)RepAppl(cls->Tag);
|
|
|
|
|
if (IsExtensionFunctor(f)) {
|
|
|
|
|
if (f == FunctorDBRef) {
|
|
|
|
|
if (cls->ucd.t_ptr != sp->extra)
|
|
|
|
|
break;
|
|
|
|
|
} else if (f == FunctorDouble) {
|
|
|
|
|
if (cls->ucd.t_ptr &&
|
|
|
|
|
Yap_Double_key(sp->extra) != Yap_Double_key(cls->ucd.t_ptr))
|
|
|
|
|
break;
|
|
|
|
|
} else if (f == FunctorString) {
|
|
|
|
|
if (cls->ucd.t_ptr &&
|
|
|
|
|
Yap_String_key(sp->extra) != Yap_String_key(cls->ucd.t_ptr))
|
|
|
|
|
break;
|
|
|
|
|
} else {
|
|
|
|
|
if (cls->ucd.t_ptr &&
|
|
|
|
|
Yap_Int_key(sp->extra) != Yap_Int_key(cls->ucd.t_ptr))
|
|
|
|
|
break;
|
|
|
|
|
}
|
|
|
|
|
}
|
2003-11-12 12:33:31 +00:00
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if ((Int)(sp->pos) > 0) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
move_next(cls, sp->pos);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else if (sp->pos) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
UInt argno = -sp->pos;
|
|
|
|
|
skip_to_arg(cls, ap, argno, FALSE);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
sp++;
|
|
|
|
|
}
|
|
|
|
|
return sp;
|
2003-06-06 14:16:40 +01:00
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static ClauseDef *install_clauses(ClauseDef *cls, PredEntry *ap,
|
|
|
|
|
istack_entry *stack, yamop *beg, yamop *end) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
istack_entry *sp = stack;
|
2004-09-27 21:45:04 +01:00
|
|
|
|
if (ap->PredFlags & MegaClausePredFlag) {
|
|
|
|
|
MegaClause *mcl = ClauseCodeToMegaClause(beg);
|
2011-09-01 05:13:29 +01:00
|
|
|
|
UInt nclauses = mcl->ClPred->cs.p_code.NOfClauses;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
yamop *end = (yamop *)((char *)mcl->ClCode + nclauses * mcl->ClItemSize);
|
2004-09-27 21:45:04 +01:00
|
|
|
|
yamop *cd = mcl->ClCode;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
|
2004-09-27 21:45:04 +01:00
|
|
|
|
if (stack[0].pos == 0) {
|
|
|
|
|
while (TRUE) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cls->Code = cls->CurrentCode = cd;
|
|
|
|
|
cls->Tag = 0;
|
|
|
|
|
cls++;
|
|
|
|
|
cd = (yamop *)((char *)cd + mcl->ClItemSize);
|
|
|
|
|
if (cd == end) {
|
|
|
|
|
return cls - 1;
|
|
|
|
|
}
|
2004-09-27 21:45:04 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
while (TRUE) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cls->Code = cls->CurrentCode = cd;
|
2004-09-27 21:45:04 +01:00
|
|
|
|
sp = install_clause(cls, ap, stack);
|
|
|
|
|
/* we reached a matching clause */
|
|
|
|
|
if (!sp->pos && (sp[-1].val == 0L || cls->Tag == sp[-1].val)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cls++;
|
2004-09-27 21:45:04 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cd = (yamop *)((char *)cd + mcl->ClItemSize);
|
2004-09-27 21:45:04 +01:00
|
|
|
|
if (cd == end) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return cls - 1;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
2004-09-27 21:45:04 +01:00
|
|
|
|
} else {
|
|
|
|
|
StaticClause *cl = ClauseCodeToStaticClause(beg);
|
|
|
|
|
|
|
|
|
|
if (stack[0].pos == 0) {
|
|
|
|
|
while (TRUE) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cls->Code = cls->CurrentCode = cl->ClCode;
|
|
|
|
|
cls->Tag = 0;
|
|
|
|
|
cls++;
|
|
|
|
|
if (cl->ClCode == end) {
|
|
|
|
|
return cls - 1;
|
|
|
|
|
}
|
|
|
|
|
cl = cl->ClNext;
|
2004-09-27 21:45:04 +01:00
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2004-09-27 21:45:04 +01:00
|
|
|
|
while (TRUE) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cls->Code = cls->CurrentCode = cl->ClCode;
|
2004-09-27 21:45:04 +01:00
|
|
|
|
sp = install_clause(cls, ap, stack);
|
|
|
|
|
/* we reached a matching clause */
|
|
|
|
|
if (!sp->pos && (sp[-1].val == 0L || cls->Tag == sp[-1].val)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cls++;
|
2004-09-27 21:45:04 +01:00
|
|
|
|
}
|
2015-06-19 00:17:25 +01:00
|
|
|
|
if (cl->ClCode == end) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return cls - 1;
|
2004-09-27 21:45:04 +01:00
|
|
|
|
}
|
|
|
|
|
cl = cl->ClNext;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static ClauseDef *install_clauseseq(ClauseDef *cls, PredEntry *ap,
|
|
|
|
|
istack_entry *stack, yamop **beg,
|
|
|
|
|
yamop **end) {
|
2004-03-31 02:02:18 +01:00
|
|
|
|
istack_entry *sp = stack;
|
|
|
|
|
|
|
|
|
|
if (stack[0].pos == 0) {
|
|
|
|
|
while (TRUE) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (*beg) {
|
|
|
|
|
cls->Code = cls->CurrentCode = *beg;
|
|
|
|
|
cls->Tag = 0;
|
|
|
|
|
cls++;
|
2004-03-31 02:02:18 +01:00
|
|
|
|
}
|
|
|
|
|
beg++;
|
|
|
|
|
if (beg == end) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return cls - 1;
|
2004-03-31 02:02:18 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
while (TRUE) {
|
|
|
|
|
if (*beg) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cls->Code = cls->CurrentCode = *beg;
|
2004-03-31 02:02:18 +01:00
|
|
|
|
sp = install_clause(cls, ap, stack);
|
|
|
|
|
/* we reached a matching clause */
|
|
|
|
|
if (!sp->pos && (sp[-1].val == 0L || cls->Tag == sp[-1].val)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cls++;
|
2004-03-31 02:02:18 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
beg++;
|
|
|
|
|
if (beg == end) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return cls - 1;
|
2004-03-31 02:02:18 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void reinstall_clauses(ClauseDef *cls, ClauseDef *end, PredEntry *ap,
|
|
|
|
|
istack_entry *stack) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
do {
|
|
|
|
|
cls->CurrentCode = cls->Code;
|
|
|
|
|
install_clause(cls, ap, stack);
|
|
|
|
|
} while (cls++ != end);
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static istack_entry *install_log_upd_clause(ClauseDef *cls, PredEntry *ap,
|
|
|
|
|
istack_entry *stack) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
istack_entry *sp = stack;
|
|
|
|
|
while (sp->pos) {
|
|
|
|
|
if ((Int)(sp->pos) > 0) {
|
|
|
|
|
add_head_info(cls, sp->pos);
|
|
|
|
|
} else if (sp->pos) {
|
|
|
|
|
UInt argno = -sp->pos;
|
|
|
|
|
add_arg_info(cls, ap, argno);
|
|
|
|
|
}
|
|
|
|
|
/* if we are not talking about a variable */
|
|
|
|
|
if (cls->Tag != sp->val) {
|
|
|
|
|
if (sp->val == 0L) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
sp++;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
break;
|
|
|
|
|
} else {
|
2003-11-12 12:33:31 +00:00
|
|
|
|
if (IsApplTerm(cls->Tag)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Functor f = (Functor)RepAppl(cls->Tag);
|
|
|
|
|
if (IsExtensionFunctor(f)) {
|
|
|
|
|
if (f == FunctorDBRef) {
|
|
|
|
|
if (cls->ucd.t_ptr != sp->extra)
|
|
|
|
|
break;
|
|
|
|
|
} else if (f == FunctorDouble) {
|
|
|
|
|
if (cls->ucd.t_ptr &&
|
|
|
|
|
Yap_Double_key(sp->extra) != Yap_Double_key(cls->ucd.t_ptr))
|
|
|
|
|
break;
|
|
|
|
|
} else {
|
|
|
|
|
if (cls->ucd.t_ptr &&
|
|
|
|
|
Yap_Int_key(sp->extra) != Yap_Int_key(cls->ucd.t_ptr))
|
|
|
|
|
break;
|
|
|
|
|
}
|
|
|
|
|
}
|
2003-11-12 12:33:31 +00:00
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if ((Int)(sp->pos) > 0) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
move_next(cls, sp->pos);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else if (sp->pos) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
UInt argno = -sp->pos;
|
2012-02-17 15:04:25 +00:00
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
skip_to_arg(cls, ap, argno, FALSE);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
sp++;
|
|
|
|
|
}
|
|
|
|
|
return sp;
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static ClauseDef *install_log_upd_clauses(ClauseDef *cls, PredEntry *ap,
|
|
|
|
|
istack_entry *stack, yamop *beg,
|
|
|
|
|
yamop *end) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
istack_entry *sp = stack;
|
|
|
|
|
|
|
|
|
|
if (stack[0].pos == 0) {
|
|
|
|
|
while (TRUE) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cls->Code = cls->CurrentCode = beg;
|
|
|
|
|
cls->Tag = 0;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
cls++;
|
|
|
|
|
if (beg == end || beg == NULL) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return cls - 1;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
beg = ClauseCodeToLogUpdClause(beg)->ClNext->ClCode;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
while (TRUE) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cls->Code = cls->CurrentCode = beg;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
sp = install_log_upd_clause(cls, ap, stack);
|
|
|
|
|
/* we reached a matching clause */
|
|
|
|
|
if (!sp->pos && (sp[-1].val == 0L || cls->Tag == sp[-1].val)) {
|
|
|
|
|
cls++;
|
|
|
|
|
}
|
|
|
|
|
if (beg == end || beg == NULL) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return cls - 1;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
beg = ClauseCodeToLogUpdClause(beg)->ClNext->ClCode;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static ClauseDef *install_log_upd_clauseseq(ClauseDef *cls, PredEntry *ap,
|
|
|
|
|
istack_entry *stack, yamop **beg,
|
|
|
|
|
yamop **end) {
|
2004-03-31 02:02:18 +01:00
|
|
|
|
istack_entry *sp = stack;
|
|
|
|
|
|
|
|
|
|
if (stack[0].pos == 0) {
|
|
|
|
|
while (TRUE) {
|
|
|
|
|
if (beg) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cls->Code = cls->CurrentCode = *beg;
|
|
|
|
|
cls->Tag = 0;
|
|
|
|
|
cls++;
|
2004-03-31 02:02:18 +01:00
|
|
|
|
}
|
|
|
|
|
beg++;
|
|
|
|
|
if (beg == end) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return cls - 1;
|
2004-03-31 02:02:18 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
while (TRUE) {
|
|
|
|
|
if (*beg) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cls->Code = cls->CurrentCode = *beg;
|
2004-03-31 02:02:18 +01:00
|
|
|
|
sp = install_log_upd_clause(cls, ap, stack);
|
|
|
|
|
/* we reached a matching clause */
|
|
|
|
|
if (!sp->pos && (sp[-1].val == 0L || cls->Tag == sp[-1].val)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cls++;
|
2004-03-31 02:02:18 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
beg++;
|
|
|
|
|
if (beg == end) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return cls - 1;
|
2004-03-31 02:02:18 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void reinstall_log_upd_clauses(ClauseDef *cls, ClauseDef *end,
|
|
|
|
|
PredEntry *ap, istack_entry *stack) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
do {
|
|
|
|
|
cls->CurrentCode = cls->Code;
|
|
|
|
|
install_log_upd_clause(cls, ap, stack);
|
|
|
|
|
} while (cls++ != end);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
#if PRECOMPUTE_REGADDRESS
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
#define arg_from_x(I) (((CELL *)(I)) - XREGS)
|
2003-08-27 14:30:50 +01:00
|
|
|
|
|
|
|
|
|
#else
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
#define arg_from_x(I) (I)
|
2003-08-27 14:30:50 +01:00
|
|
|
|
|
|
|
|
|
#endif /* ALIGN_LONGS */
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static AtomSwiEntry *lookup_c(Term t, yamop *tab, COUNT entries) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
AtomSwiEntry *cebase = (AtomSwiEntry *)tab;
|
|
|
|
|
|
|
|
|
|
while (cebase->Tag != t) {
|
|
|
|
|
entries--;
|
|
|
|
|
cebase++;
|
|
|
|
|
if (entries == 0)
|
|
|
|
|
return cebase;
|
|
|
|
|
}
|
|
|
|
|
return cebase;
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static FuncSwiEntry *lookup_f(Functor f, yamop *tab, COUNT entries) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
FuncSwiEntry *febase = (FuncSwiEntry *)tab;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
|
2003-08-27 14:30:50 +01:00
|
|
|
|
while (febase->Tag != f) {
|
|
|
|
|
entries--;
|
|
|
|
|
febase++;
|
|
|
|
|
if (entries == 0)
|
|
|
|
|
return febase;
|
|
|
|
|
}
|
|
|
|
|
return febase;
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static COUNT count_clauses_left(yamop *cl, PredEntry *ap) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
|
|
|
|
LogUpdClause *c = ClauseCodeToLogUpdClause(cl);
|
|
|
|
|
COUNT i = 0;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
|
2003-08-27 14:30:50 +01:00
|
|
|
|
while (c != NULL) {
|
|
|
|
|
i++;
|
|
|
|
|
c = c->ClNext;
|
|
|
|
|
}
|
|
|
|
|
return i;
|
2004-09-27 21:45:04 +01:00
|
|
|
|
} else if (ap->PredFlags & MegaClausePredFlag) {
|
|
|
|
|
MegaClause *mcl = ClauseCodeToMegaClause(ap->cs.p_code.FirstClause);
|
2011-09-01 05:13:29 +01:00
|
|
|
|
UInt ncls = mcl->ClPred->cs.p_code.NOfClauses;
|
2004-09-27 21:45:04 +01:00
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return (ncls - 1) - ((char *)cl - (char *)mcl->ClCode) / mcl->ClItemSize;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
|
|
|
|
yamop *last = ap->cs.p_code.LastClause;
|
2005-05-31 05:46:06 +01:00
|
|
|
|
StaticClause *c;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
COUNT i = 1;
|
|
|
|
|
|
2005-05-31 05:46:06 +01:00
|
|
|
|
c = ClauseCodeToStaticClause(cl);
|
2003-11-26 18:36:35 +00:00
|
|
|
|
while (c->ClCode != last) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
i++;
|
2003-11-26 18:36:35 +00:00
|
|
|
|
c = c->ClNext;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
return i;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2006-03-21 15:06:36 +00:00
|
|
|
|
/*
|
|
|
|
|
We have jumped across indexing code. Check if we jumped within the current
|
|
|
|
|
indexing block, if we moved back to a parent, or if we jumped to a child.
|
|
|
|
|
*/
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static ClausePointer index_jmp(ClausePointer cur, ClausePointer parent,
|
|
|
|
|
yamop *ipc, int is_lu, yamop *e_code) {
|
|
|
|
|
if (cur.lui == NULL || ipc == FAILCODE || ipc == e_code ||
|
|
|
|
|
ipc->opc == Yap_opcode(_expand_clauses))
|
2006-03-21 15:06:36 +00:00
|
|
|
|
return cur;
|
|
|
|
|
if (is_lu) {
|
|
|
|
|
LogUpdIndex *lcur = cur.lui, *ncur;
|
|
|
|
|
/* check myself */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (ipc >= lcur->ClCode && ipc < (yamop *)((CODEADDR)lcur + lcur->ClSize))
|
2006-03-21 15:06:36 +00:00
|
|
|
|
return cur;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* check if I am returning back to a parent, eg
|
2006-03-21 21:30:54 +00:00
|
|
|
|
switch with intermediate node */
|
2006-03-21 15:06:36 +00:00
|
|
|
|
if (lcur->ParentIndex) {
|
|
|
|
|
LogUpdIndex *pcur = lcur->ParentIndex;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (ipc >= pcur->ClCode &&
|
|
|
|
|
ipc < (yamop *)((CODEADDR)pcur + pcur->ClSize)) {
|
|
|
|
|
cur.lui = pcur;
|
|
|
|
|
return cur;
|
2006-03-21 15:06:36 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
/* maybe I am a new group */
|
|
|
|
|
ncur = ClauseCodeToLogUpdIndex(ipc);
|
|
|
|
|
if (ncur->ParentIndex != lcur) {
|
2013-11-15 18:25:33 +00:00
|
|
|
|
#if DEBUG
|
2016-07-31 10:26:15 +01:00
|
|
|
|
fprintf(stderr, "OOPS, bad parent in lu index\n");
|
2006-03-21 15:06:36 +00:00
|
|
|
|
#endif
|
|
|
|
|
cur.lui = NULL;
|
|
|
|
|
return cur;
|
|
|
|
|
}
|
2006-03-21 17:11:39 +00:00
|
|
|
|
cur.lui = ncur;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return cur;
|
2006-03-21 15:06:36 +00:00
|
|
|
|
} else {
|
2006-04-05 01:16:55 +01:00
|
|
|
|
StaticIndex *scur = parent.si, *ncur;
|
2006-03-21 15:06:36 +00:00
|
|
|
|
/* check myself */
|
2006-04-05 01:16:55 +01:00
|
|
|
|
if (!scur)
|
|
|
|
|
return cur;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (ipc >= scur->ClCode && ipc < (yamop *)((CODEADDR)scur + scur->ClSize))
|
2006-04-05 01:16:55 +01:00
|
|
|
|
return cur;
|
|
|
|
|
ncur = ClauseCodeToStaticIndex(ipc);
|
|
|
|
|
if (ncur->ClPred == scur->ClPred) {
|
|
|
|
|
cur.si = ncur;
|
2006-03-21 15:06:36 +00:00
|
|
|
|
return cur;
|
2006-04-05 01:16:55 +01:00
|
|
|
|
}
|
2006-03-21 21:30:54 +00:00
|
|
|
|
/*
|
|
|
|
|
if (parent.si != cur.si) {
|
|
|
|
|
if (parent.si) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
StaticIndex *pcur = parent.si;
|
|
|
|
|
if (ipc >= pcur->ClCode && ipc < (yamop *)((CODEADDR)pcur+pcur->ClSize))
|
|
|
|
|
return parent;
|
2006-03-21 21:30:54 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
cur.si = ncur;
|
|
|
|
|
return cur;
|
|
|
|
|
*/
|
2006-03-21 15:06:36 +00:00
|
|
|
|
cur.si = NULL;
|
|
|
|
|
return cur;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static ClausePointer code_to_indexcl(yamop *ipc, int is_lu) {
|
2006-03-21 15:06:36 +00:00
|
|
|
|
ClausePointer ret;
|
|
|
|
|
if (is_lu)
|
|
|
|
|
ret.lui = ClauseCodeToLogUpdIndex(ipc);
|
|
|
|
|
else
|
|
|
|
|
ret.si = ClauseCodeToStaticIndex(ipc);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return ret;
|
2006-03-21 15:06:36 +00:00
|
|
|
|
}
|
|
|
|
|
|
2012-06-04 18:21:34 +01:00
|
|
|
|
/* CALLED by expand when entering sub_arg */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void increase_expand_depth(yamop *ipc, struct intermediates *cint) {
|
2012-06-04 16:29:56 +01:00
|
|
|
|
yamop *ncode;
|
|
|
|
|
|
|
|
|
|
cint->term_depth++;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (ipc->opc == Yap_opcode(_switch_on_sub_arg_type) &&
|
2014-05-30 01:06:09 +01:00
|
|
|
|
(ncode = ipc->y_u.sllll.l4)->opc == Yap_opcode(_expand_clauses)) {
|
|
|
|
|
if (ncode->y_u.sssllp.s2 != cint->last_depth_size) {
|
2012-06-04 16:29:56 +01:00
|
|
|
|
cint->last_index_new_depth = cint->term_depth;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cint->last_depth_size = ncode->y_u.sssllp.s2;
|
2012-06-04 16:29:56 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void zero_expand_depth(PredEntry *ap, struct intermediates *cint) {
|
2012-06-04 16:29:56 +01:00
|
|
|
|
cint->term_depth = cint->last_index_new_depth;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cint->last_depth_size = ap->cs.p_code.NOfClauses;
|
2012-06-04 16:29:56 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static yamop **expand_index(struct intermediates *cint) {
|
2011-03-07 16:02:55 +00:00
|
|
|
|
CACHE_REGS
|
2003-08-27 14:30:50 +01:00
|
|
|
|
/* first clause */
|
2004-01-23 02:23:51 +00:00
|
|
|
|
PredEntry *ap = cint->CurrentPred;
|
2004-02-05 16:57:02 +00:00
|
|
|
|
yamop *first, *last = NULL, *alt = NULL;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
istack_entry *stack, *sp;
|
2010-04-15 22:23:54 +01:00
|
|
|
|
ClauseDef *max;
|
2004-02-05 16:57:02 +00:00
|
|
|
|
int NClauses;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
/* last clause to experiment with */
|
2004-02-05 16:57:02 +00:00
|
|
|
|
yamop *ipc;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
/* labp should point at the beginning of the sequence */
|
2006-03-21 15:06:36 +00:00
|
|
|
|
yamop **labp = NULL;
|
|
|
|
|
ClausePointer parentcl;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
Term t = TermNil, *s_reg = NULL;
|
|
|
|
|
int is_last_arg = TRUE;
|
|
|
|
|
int argno = 1;
|
|
|
|
|
int isfirstcl = TRUE;
|
|
|
|
|
/* this is will be used as a new PC */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
CELL *top = (CELL *)TR;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
UInt arity = 0;
|
2003-09-20 04:06:15 +01:00
|
|
|
|
UInt lab, fail_l, clleft, i = 0;
|
2004-04-16 20:27:31 +01:00
|
|
|
|
int is_lu = ap->PredFlags & LogUpdatePredFlag;
|
2006-03-21 15:06:36 +00:00
|
|
|
|
yamop *e_code = (yamop *)&(ap->cs.p_code.ExpandCode);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
|
2004-02-05 16:57:02 +00:00
|
|
|
|
ipc = ap->cs.p_code.TrueCodeOfPred;
|
|
|
|
|
first = ap->cs.p_code.FirstClause;
|
|
|
|
|
NClauses = ap->cs.p_code.NOfClauses;
|
2003-09-15 20:06:55 +01:00
|
|
|
|
sp = stack = (istack_entry *)top;
|
2006-05-16 19:37:31 +01:00
|
|
|
|
cint->i_labelno = 1;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
stack[0].pos = 0;
|
|
|
|
|
/* try to refine the interval using the indexing code */
|
2012-06-04 18:21:34 +01:00
|
|
|
|
cint->term_depth = cint->last_index_new_depth = cint->last_depth_size = 0L;
|
2003-10-28 01:16:03 +00:00
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
parentcl = code_to_indexcl(ipc, is_lu);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
while (ipc != NULL) {
|
|
|
|
|
op_numbers op;
|
|
|
|
|
|
|
|
|
|
op = Yap_op_from_opcode(ipc->opc);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
switch (op) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _try_clause:
|
|
|
|
|
case _retry:
|
|
|
|
|
/* this clause had no indexing */
|
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
first = ClauseCodeToLogUpdClause(ipc->y_u.Otapl.d)->ClNext->ClCode;
|
2004-09-27 21:45:04 +01:00
|
|
|
|
} else if (ap->PredFlags & MegaClausePredFlag) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
MegaClause *mcl = ClauseCodeToMegaClause(ap->cs.p_code.FirstClause);
|
|
|
|
|
first = (yamop *)((char *)ipc->y_u.Otapl.d) + mcl->ClItemSize;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
first = ClauseCodeToStaticClause(ipc->y_u.Otapl.d)->ClNext->ClCode;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
isfirstcl = FALSE;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, Otapl);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
2005-05-31 05:46:06 +01:00
|
|
|
|
#if TABLING
|
|
|
|
|
case _table_try:
|
|
|
|
|
case _table_retry:
|
|
|
|
|
/* this clause had no indexing */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
first = ClauseCodeToStaticClause(PREVOP(ipc->y_u.Otapl.d, Otapl))
|
|
|
|
|
->ClNext->ClCode;
|
2005-05-31 05:46:06 +01:00
|
|
|
|
isfirstcl = FALSE;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, Otapl);
|
|
|
|
|
break;
|
2005-05-31 05:46:06 +01:00
|
|
|
|
#endif /* TABLING */
|
2004-09-27 21:45:04 +01:00
|
|
|
|
case _try_clause2:
|
|
|
|
|
case _try_clause3:
|
|
|
|
|
case _try_clause4:
|
|
|
|
|
case _retry2:
|
|
|
|
|
case _retry3:
|
|
|
|
|
case _retry4:
|
2003-10-28 01:16:03 +00:00
|
|
|
|
case _try_in:
|
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
first = ClauseCodeToLogUpdClause(ipc->y_u.l.l)->ClNext->ClCode;
|
2004-09-27 21:45:04 +01:00
|
|
|
|
} else if (ap->PredFlags & MegaClausePredFlag) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
MegaClause *mcl = ClauseCodeToMegaClause(ap->cs.p_code.FirstClause);
|
|
|
|
|
first = (yamop *)((char *)ipc->y_u.Otapl.d) + mcl->ClItemSize;
|
2003-10-28 01:16:03 +00:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
first = ClauseCodeToStaticClause(ipc->y_u.l.l)->ClNext->ClCode;
|
2003-10-28 01:16:03 +00:00
|
|
|
|
}
|
|
|
|
|
isfirstcl = FALSE;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, l);
|
2003-10-28 01:16:03 +00:00
|
|
|
|
break;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _retry_me:
|
2005-04-07 18:56:58 +01:00
|
|
|
|
#ifdef TABLING
|
|
|
|
|
case _table_retry_me:
|
2005-05-31 05:46:06 +01:00
|
|
|
|
#endif
|
2003-08-27 14:30:50 +01:00
|
|
|
|
isfirstcl = FALSE;
|
|
|
|
|
case _try_me:
|
2005-04-07 18:56:58 +01:00
|
|
|
|
#ifdef TABLING
|
|
|
|
|
case _table_try_me:
|
2005-05-31 05:46:06 +01:00
|
|
|
|
#endif
|
2003-08-27 14:30:50 +01:00
|
|
|
|
/* ok, we found the start for an indexing block,
|
2016-07-31 10:26:15 +01:00
|
|
|
|
but we don't if we are going to operate here or not */
|
2003-08-27 14:30:50 +01:00
|
|
|
|
/* if we are to commit here, alt will tell us where */
|
2014-05-30 01:06:09 +01:00
|
|
|
|
alt = ipc->y_u.Otapl.d;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, Otapl);
|
2003-09-23 13:41:31 +01:00
|
|
|
|
/* start of a group, reset stack */
|
|
|
|
|
sp = stack;
|
|
|
|
|
stack[0].pos = 0;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
|
|
|
|
case _profiled_trust_me:
|
|
|
|
|
case _trust_me:
|
|
|
|
|
case _count_trust_me:
|
2005-04-07 18:56:58 +01:00
|
|
|
|
#ifdef TABLING
|
|
|
|
|
case _table_trust_me:
|
|
|
|
|
#endif /* TABLING */
|
2003-08-27 14:30:50 +01:00
|
|
|
|
/* we will commit to this group for sure */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, Otapl);
|
2003-11-29 23:41:28 +00:00
|
|
|
|
alt = NULL;
|
2003-09-23 13:41:31 +01:00
|
|
|
|
/* start of a group, reset stack */
|
|
|
|
|
sp = stack;
|
|
|
|
|
stack[0].pos = 0;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
|
|
|
|
case _trust:
|
|
|
|
|
/* we should never be here */
|
2015-09-25 10:57:26 +01:00
|
|
|
|
Yap_Error(SYSTEM_ERROR_COMPILER, TermNil, "found trust in expand_index");
|
2016-07-31 10:26:15 +01:00
|
|
|
|
labp = NULL;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
ipc = NULL;
|
|
|
|
|
break;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* should we ever be here ? I think not */
|
2006-10-10 15:08:17 +01:00
|
|
|
|
case _try_logical:
|
|
|
|
|
case _retry_logical:
|
|
|
|
|
case _count_retry_logical:
|
|
|
|
|
case _profiled_retry_logical:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ipc = ipc->y_u.OtaLl.n;
|
2008-08-21 13:38:25 +01:00
|
|
|
|
break;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
case _trust_logical:
|
|
|
|
|
case _count_trust_logical:
|
|
|
|
|
case _profiled_trust_logical:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ipc = ipc->y_u.OtILl.n;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
break;
|
2003-09-15 02:25:29 +01:00
|
|
|
|
case _enter_lu_pred:
|
|
|
|
|
/* no useful info */
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ipc = ipc->y_u.Illss.l1;
|
2003-09-15 02:25:29 +01:00
|
|
|
|
break;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _retry_profiled:
|
|
|
|
|
case _count_retry:
|
|
|
|
|
/* no useful info */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, l);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
|
|
|
|
case _jump:
|
|
|
|
|
/* just skip for now, but should worry about memory management */
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ipc = ipc->y_u.l.l;
|
2006-03-21 21:30:54 +00:00
|
|
|
|
/* I don't know how up I will go */
|
|
|
|
|
parentcl.si = NULL;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
2004-02-05 16:57:02 +00:00
|
|
|
|
case _lock_lu:
|
2005-12-17 03:25:39 +00:00
|
|
|
|
case _procceed:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, p);
|
2004-02-05 16:57:02 +00:00
|
|
|
|
break;
|
2004-02-09 14:19:05 +00:00
|
|
|
|
case _unlock_lu:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, e);
|
2004-02-09 14:19:05 +00:00
|
|
|
|
break;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _jump_if_var:
|
|
|
|
|
if (IsVarTerm(Deref(ARG1))) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
labp = &(ipc->y_u.l.l);
|
|
|
|
|
ipc = ipc->y_u.l.l;
|
|
|
|
|
parentcl = index_jmp(parentcl, parentcl, ipc, is_lu, e_code);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, l);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
break;
|
2003-10-28 01:16:03 +00:00
|
|
|
|
case _jump_if_nonvar:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
argno = arg_from_x(ipc->y_u.xll.x);
|
2003-11-12 12:33:31 +00:00
|
|
|
|
t = Deref(XREGS[argno]);
|
2003-10-28 01:16:03 +00:00
|
|
|
|
i = 0;
|
|
|
|
|
/* expand_index expects to find the new argument */
|
|
|
|
|
if (!IsVarTerm(t)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
argno--;
|
|
|
|
|
labp = &(ipc->y_u.xll.l1);
|
|
|
|
|
ipc = ipc->y_u.xll.l1;
|
|
|
|
|
parentcl = index_jmp(parentcl, parentcl, ipc, is_lu, e_code);
|
2012-02-17 15:04:25 +00:00
|
|
|
|
|
2003-10-28 01:16:03 +00:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, xll);
|
2003-10-28 01:16:03 +00:00
|
|
|
|
}
|
|
|
|
|
break;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* instructions type EC */
|
|
|
|
|
/* instructions type e */
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _index_dbref:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (s_reg[-1] != (CELL)FunctorDBREF) {
|
|
|
|
|
ipc = alt;
|
|
|
|
|
alt = NULL;
|
2016-08-26 05:43:54 +01:00
|
|
|
|
break;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
}
|
|
|
|
|
t = AbsAppl(s_reg - 1);
|
2003-11-12 12:33:31 +00:00
|
|
|
|
sp[-1].extra = t;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
s_reg = NULL;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, e);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
|
|
|
|
case _index_blob:
|
2016-08-26 05:43:54 +01:00
|
|
|
|
if (s_reg[-1] != (CELL)FunctorDouble) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = alt;
|
|
|
|
|
alt = NULL;
|
2016-08-26 05:43:54 +01:00
|
|
|
|
break;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
}
|
2010-05-14 12:42:30 +01:00
|
|
|
|
t = Yap_DoubleP_key(s_reg);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
sp[-1].extra = AbsAppl(s_reg - 1);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
s_reg = NULL;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, e);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
2009-02-09 21:56:40 +00:00
|
|
|
|
case _index_long:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (s_reg[-1] != (CELL)FunctorLongInt) {
|
|
|
|
|
ipc = alt;
|
|
|
|
|
alt = NULL;
|
2016-08-26 05:43:54 +01:00
|
|
|
|
break;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
}
|
2010-05-14 12:42:30 +01:00
|
|
|
|
t = Yap_IntP_key(s_reg);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
sp[-1].extra = AbsAppl(s_reg - 1);
|
2009-02-09 21:56:40 +00:00
|
|
|
|
s_reg = NULL;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, e);
|
2009-02-09 21:56:40 +00:00
|
|
|
|
break;
|
2009-02-12 21:35:31 +00:00
|
|
|
|
case _user_switch:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
labp = &(ipc->y_u.lp.l);
|
|
|
|
|
ipc = ipc->y_u.lp.l;
|
2009-02-12 21:35:31 +00:00
|
|
|
|
break;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* instructions type e */
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _switch_on_type:
|
2012-06-04 16:29:56 +01:00
|
|
|
|
zero_expand_depth(ap, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
t = Deref(ARG1);
|
|
|
|
|
argno = 1;
|
2003-09-20 04:06:15 +01:00
|
|
|
|
i = 0;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (IsVarTerm(t)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
labp = &(ipc->y_u.llll.l4);
|
|
|
|
|
ipc = ipc->y_u.llll.l4;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else if (IsPairTerm(t)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
sp = push_stack(sp, 1, AbsPair(NULL), TermNil, cint);
|
|
|
|
|
s_reg = RepPair(t);
|
|
|
|
|
labp = &(ipc->y_u.llll.l1);
|
|
|
|
|
ipc = ipc->y_u.llll.l1;
|
|
|
|
|
increase_expand_depth(ipc, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else if (IsApplTerm(t)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
sp =
|
|
|
|
|
push_stack(sp, 1, AbsAppl((CELL *)FunctorOfTerm(t)), TermNil, cint);
|
|
|
|
|
ipc = ipc->y_u.llll.l3;
|
|
|
|
|
increase_expand_depth(ipc, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
sp = push_stack(sp, argno, t, TermNil, cint);
|
|
|
|
|
ipc = ipc->y_u.llll.l2;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2006-03-21 21:30:54 +00:00
|
|
|
|
parentcl = index_jmp(parentcl, parentcl, ipc, is_lu, e_code);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
|
|
|
|
case _switch_list_nl:
|
2012-06-04 16:29:56 +01:00
|
|
|
|
zero_expand_depth(ap, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
t = Deref(ARG1);
|
|
|
|
|
argno = 1;
|
2003-09-20 04:06:15 +01:00
|
|
|
|
i = 0;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (IsVarTerm(t)) {
|
|
|
|
|
labp = &(ipc->y_u.ollll.l4);
|
|
|
|
|
ipc = ipc->y_u.ollll.l4;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else if (IsPairTerm(t)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
s_reg = RepPair(t);
|
|
|
|
|
labp = &(ipc->y_u.ollll.l1);
|
|
|
|
|
sp = push_stack(sp, 1, AbsPair(NULL), TermNil, cint);
|
|
|
|
|
ipc = ipc->y_u.ollll.l1;
|
|
|
|
|
increase_expand_depth(ipc, cint);
|
2005-06-01 17:42:30 +01:00
|
|
|
|
} else if (t == TermNil) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
sp = push_stack(sp, 1, t, TermNil, cint);
|
|
|
|
|
ipc = ipc->y_u.ollll.l2;
|
|
|
|
|
increase_expand_depth(ipc, cint);
|
2005-06-01 17:42:30 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Term tn;
|
2005-06-01 17:42:30 +01:00
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (IsApplTerm(t)) {
|
|
|
|
|
tn = AbsAppl((CELL *)FunctorOfTerm(t));
|
|
|
|
|
} else {
|
|
|
|
|
tn = t;
|
|
|
|
|
}
|
|
|
|
|
sp = push_stack(sp, argno, tn, TermNil, cint);
|
|
|
|
|
ipc = ipc->y_u.ollll.l3;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2006-03-21 21:30:54 +00:00
|
|
|
|
parentcl = index_jmp(parentcl, parentcl, ipc, is_lu, e_code);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
|
|
|
|
case _switch_on_arg_type:
|
2012-06-04 16:29:56 +01:00
|
|
|
|
zero_expand_depth(ap, cint);
|
2014-05-30 01:06:09 +01:00
|
|
|
|
argno = arg_from_x(ipc->y_u.xllll.x);
|
2003-09-20 04:06:15 +01:00
|
|
|
|
i = 0;
|
2003-11-12 12:33:31 +00:00
|
|
|
|
t = Deref(XREGS[argno]);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (IsVarTerm(t)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
labp = &(ipc->y_u.xllll.l4);
|
|
|
|
|
ipc = ipc->y_u.xllll.l4;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else if (IsPairTerm(t)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
s_reg = RepPair(t);
|
|
|
|
|
sp = push_stack(sp, argno, AbsPair(NULL), TermNil, cint);
|
|
|
|
|
labp = &(ipc->y_u.xllll.l1);
|
|
|
|
|
ipc = ipc->y_u.xllll.l1;
|
|
|
|
|
increase_expand_depth(ipc, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else if (IsApplTerm(t)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
sp = push_stack(sp, argno, AbsAppl((CELL *)FunctorOfTerm(t)), TermNil,
|
|
|
|
|
cint);
|
|
|
|
|
ipc = ipc->y_u.xllll.l3;
|
|
|
|
|
increase_expand_depth(ipc, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
sp = push_stack(sp, argno, t, TermNil, cint);
|
|
|
|
|
ipc = ipc->y_u.xllll.l2;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2006-03-21 21:30:54 +00:00
|
|
|
|
parentcl = index_jmp(parentcl, parentcl, ipc, is_lu, e_code);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
|
|
|
|
case _switch_on_sub_arg_type:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
i = ipc->y_u.sllll.s;
|
2003-09-20 04:06:15 +01:00
|
|
|
|
t = Deref(s_reg[i]);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (i != arity - 1)
|
|
|
|
|
is_last_arg = FALSE;
|
2003-09-20 04:06:15 +01:00
|
|
|
|
t = Deref(s_reg[i]);
|
|
|
|
|
if (IsVarTerm(t)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
labp = &(ipc->y_u.sllll.l4);
|
|
|
|
|
ipc = ipc->y_u.sllll.l4;
|
|
|
|
|
i++;
|
2003-09-20 04:06:15 +01:00
|
|
|
|
} else if (IsPairTerm(t)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
s_reg = RepPair(t);
|
|
|
|
|
sp = push_stack(sp, -i - 1, AbsPair(NULL), TermNil, cint);
|
|
|
|
|
labp = &(ipc->y_u.sllll.l1);
|
|
|
|
|
ipc = ipc->y_u.sllll.l1;
|
|
|
|
|
i = 0;
|
|
|
|
|
increase_expand_depth(ipc, cint);
|
2012-06-04 18:21:34 +01:00
|
|
|
|
} else if (IsApplTerm(t)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
sp = push_stack(sp, -i - 1, AbsAppl((CELL *)FunctorOfTerm(t)), TermNil,
|
|
|
|
|
cint);
|
|
|
|
|
ipc = ipc->y_u.sllll.l3;
|
|
|
|
|
i = 0;
|
|
|
|
|
increase_expand_depth(ipc, cint);
|
2003-09-20 04:06:15 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* We don't push stack here, instead we go over to next argument
|
|
|
|
|
sp = push_stack(sp, -i-1, t, cint);
|
|
|
|
|
*/
|
|
|
|
|
sp = push_stack(sp, -i - 1, t, TermNil, cint);
|
|
|
|
|
ipc = ipc->y_u.sllll.l2;
|
|
|
|
|
i++;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2006-03-21 21:30:54 +00:00
|
|
|
|
parentcl = index_jmp(parentcl, parentcl, ipc, is_lu, e_code);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
|
|
|
|
case _if_not_then:
|
|
|
|
|
labp = NULL;
|
|
|
|
|
ipc = NULL;
|
|
|
|
|
break;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* instructions type ollll */
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _switch_on_func:
|
|
|
|
|
case _if_func:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
case _go_on_func: {
|
|
|
|
|
FuncSwiEntry *fe;
|
|
|
|
|
yamop *newpc;
|
|
|
|
|
Functor f;
|
|
|
|
|
|
|
|
|
|
s_reg = RepAppl(t);
|
|
|
|
|
f = (Functor)(*s_reg++);
|
|
|
|
|
if (op == _switch_on_func) {
|
|
|
|
|
fe = lookup_f_hash(f, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
|
|
|
|
|
} else {
|
|
|
|
|
fe = lookup_f(f, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
newpc = fe->u_f.labp;
|
|
|
|
|
|
|
|
|
|
labp = &(fe->u_f.labp);
|
|
|
|
|
if (newpc == e_code) {
|
|
|
|
|
/* we found it */
|
|
|
|
|
parentcl = code_to_indexcl(ipc->y_u.sssl.l, is_lu);
|
|
|
|
|
ipc = NULL;
|
|
|
|
|
} else {
|
|
|
|
|
ClausePointer npar = code_to_indexcl(ipc->y_u.sssl.l, is_lu);
|
|
|
|
|
ipc = newpc;
|
|
|
|
|
parentcl = index_jmp(npar, parentcl, ipc, is_lu, e_code);
|
|
|
|
|
}
|
|
|
|
|
} break;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _switch_on_cons:
|
|
|
|
|
case _if_cons:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
case _go_on_cons: {
|
|
|
|
|
AtomSwiEntry *ae;
|
|
|
|
|
|
|
|
|
|
if (op == _switch_on_cons) {
|
|
|
|
|
ae = lookup_c_hash(t, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
|
|
|
|
|
} else {
|
|
|
|
|
ae = lookup_c(t, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
|
|
|
|
|
labp = &(ae->u_a.labp);
|
|
|
|
|
if (ae->u_a.labp == e_code) {
|
|
|
|
|
/* we found it */
|
|
|
|
|
parentcl = code_to_indexcl(ipc->y_u.sssl.l, is_lu);
|
|
|
|
|
ipc = NULL;
|
|
|
|
|
} else {
|
|
|
|
|
ClausePointer npar = code_to_indexcl(ipc->y_u.sssl.l, is_lu);
|
|
|
|
|
ipc = ae->u_a.labp;
|
|
|
|
|
parentcl = index_jmp(npar, parentcl, ipc, is_lu, e_code);
|
|
|
|
|
}
|
|
|
|
|
} break;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _expand_index:
|
2004-03-31 02:02:18 +01:00
|
|
|
|
case _expand_clauses:
|
2003-09-20 04:06:15 +01:00
|
|
|
|
if (alt != NULL && ap->PredFlags & LogUpdatePredFlag) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
op_numbers fop = Yap_op_from_opcode(alt->opc);
|
|
|
|
|
if (fop == _enter_lu_pred)
|
|
|
|
|
alt = alt->y_u.Illss.l1;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
ipc = NULL;
|
|
|
|
|
break;
|
2003-09-23 13:41:31 +01:00
|
|
|
|
case _op_fail:
|
|
|
|
|
ipc = alt;
|
|
|
|
|
alt = NULL;
|
|
|
|
|
break;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
default:
|
|
|
|
|
if (alt == NULL) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_Error(SYSTEM_ERROR_COMPILER, t,
|
|
|
|
|
"unexpected instruction %d at expand_index ", op);
|
|
|
|
|
labp = NULL;
|
|
|
|
|
ipc = NULL;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* backtrack */
|
|
|
|
|
first = alt->y_u.Otapl.d;
|
|
|
|
|
ipc = alt;
|
|
|
|
|
alt = NULL;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2003-12-05 15:18:08 +00:00
|
|
|
|
/* if there was an overflow while generating the code, make sure
|
|
|
|
|
S is still correct */
|
2004-04-16 20:27:31 +01:00
|
|
|
|
if (is_lu) {
|
2006-03-21 15:06:36 +00:00
|
|
|
|
cint->current_cl.lui = parentcl.lui;
|
2004-04-16 20:27:31 +01:00
|
|
|
|
} else {
|
2006-03-21 15:06:36 +00:00
|
|
|
|
cint->current_cl.si = parentcl.si;
|
2004-04-16 20:27:31 +01:00
|
|
|
|
}
|
2003-12-05 15:18:08 +00:00
|
|
|
|
if (s_reg != NULL)
|
|
|
|
|
S = s_reg;
|
2005-05-31 05:46:06 +01:00
|
|
|
|
#ifdef TABLING
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* handle tabling hack that insertes a failcode,
|
2005-05-31 05:46:06 +01:00
|
|
|
|
this really corresponds to not having any more clauses */
|
|
|
|
|
if (alt == TRUSTFAILCODE)
|
|
|
|
|
alt = NULL;
|
|
|
|
|
#endif
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (alt == NULL) {
|
|
|
|
|
/* oops, we are at last clause */
|
|
|
|
|
fail_l = (UInt)FAILCODE;
|
|
|
|
|
clleft = 0;
|
|
|
|
|
last = ap->cs.p_code.LastClause;
|
|
|
|
|
} else {
|
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
2003-09-23 13:41:31 +01:00
|
|
|
|
op_numbers op = Yap_op_from_opcode(alt->opc);
|
2006-10-10 15:08:17 +01:00
|
|
|
|
/* can we be here */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (op >= _retry2 && op <= _retry4) {
|
|
|
|
|
last = alt->y_u.l.l;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
last = alt->y_u.Otapl.d;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
} else {
|
2003-09-23 13:41:31 +01:00
|
|
|
|
op_numbers op = Yap_op_from_opcode(alt->opc);
|
2005-05-31 05:46:06 +01:00
|
|
|
|
if (op == _retry || op == _trust) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
last = alt->y_u.Otapl.d;
|
2005-04-07 18:56:58 +01:00
|
|
|
|
#ifdef TABLING
|
2005-05-31 05:46:06 +01:00
|
|
|
|
} else if (op == _table_retry || op == _table_trust) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
last = PREVOP(alt->y_u.Otapl.d, Otapl);
|
2005-04-07 18:56:58 +01:00
|
|
|
|
#endif /* TABLING */
|
2004-09-27 21:45:04 +01:00
|
|
|
|
} else if (op >= _retry2 && op <= _retry4) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
last = alt->y_u.l.l;
|
2003-09-23 13:41:31 +01:00
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
fail_l = (UInt)alt;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clleft = count_clauses_left(last, ap);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
|
2004-03-31 02:02:18 +01:00
|
|
|
|
if (Yap_op_from_opcode((*labp)->opc) == _expand_clauses) {
|
|
|
|
|
/* ok, we know how many clauses */
|
|
|
|
|
yamop *ipc = *labp;
|
2005-04-10 05:01:15 +01:00
|
|
|
|
/* check all slots, not just the ones with values */
|
2014-05-30 01:06:09 +01:00
|
|
|
|
COUNT nclauses = ipc->y_u.sssllp.s1;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
yamop **clp = (yamop **)NEXTOP(ipc, sssllp);
|
2004-03-31 02:02:18 +01:00
|
|
|
|
|
2012-02-17 15:04:25 +00:00
|
|
|
|
cint->expand_block = ipc;
|
2010-03-31 15:51:18 +01:00
|
|
|
|
#if USE_SYSTEM_MALLOC
|
2010-04-15 22:23:54 +01:00
|
|
|
|
if (!cint->cls) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cint->cls = (ClauseDef *)Yap_AllocCodeSpace(nclauses * sizeof(ClauseDef));
|
2010-04-15 22:23:54 +01:00
|
|
|
|
if (!cint->cls) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* tell how much space we need */
|
|
|
|
|
LOCAL_Error_Size += NClauses * sizeof(ClauseDef);
|
|
|
|
|
/* grow stack */
|
|
|
|
|
save_machine_regs();
|
|
|
|
|
siglongjmp(cint->CompilerBotch, 2);
|
2010-04-15 22:23:54 +01:00
|
|
|
|
}
|
2010-03-31 15:51:18 +01:00
|
|
|
|
}
|
|
|
|
|
#else
|
2014-01-19 21:15:05 +00:00
|
|
|
|
cint->cls = (ClauseDef *)HR;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (cint->cls + 2 * nclauses > (ClauseDef *)(ASP - 4096)) {
|
2004-03-31 02:02:18 +01:00
|
|
|
|
/* tell how much space we need (worst case) */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
LOCAL_Error_Size += 2 * NClauses * sizeof(ClauseDef);
|
2004-03-31 02:02:18 +01:00
|
|
|
|
/* grow stack */
|
2005-12-23 00:20:14 +00:00
|
|
|
|
save_machine_regs();
|
2016-07-31 10:26:15 +01:00
|
|
|
|
siglongjmp(cint->CompilerBotch, 3);
|
2004-03-31 02:02:18 +01:00
|
|
|
|
}
|
2010-03-31 15:51:18 +01:00
|
|
|
|
#endif
|
2004-03-31 02:02:18 +01:00
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
max =
|
|
|
|
|
install_log_upd_clauseseq(cint->cls, ap, stack, clp, clp + nclauses);
|
2004-03-31 02:02:18 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
max = install_clauseseq(cint->cls, ap, stack, clp, clp + nclauses);
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2004-04-14 20:10:40 +01:00
|
|
|
|
cint->expand_block = NULL;
|
2010-03-31 15:51:18 +01:00
|
|
|
|
#if USE_SYSTEM_MALLOC
|
2010-04-15 22:23:54 +01:00
|
|
|
|
if (!cint->cls) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cint->cls = (ClauseDef *)Yap_AllocCodeSpace(NClauses * sizeof(ClauseDef));
|
2010-04-15 22:23:54 +01:00
|
|
|
|
if (!cint->cls) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* tell how much space we need */
|
|
|
|
|
LOCAL_Error_Size += NClauses * sizeof(ClauseDef);
|
|
|
|
|
/* grow stack */
|
|
|
|
|
save_machine_regs();
|
|
|
|
|
siglongjmp(cint->CompilerBotch, 2);
|
2010-04-15 22:23:54 +01:00
|
|
|
|
}
|
2010-03-31 15:51:18 +01:00
|
|
|
|
}
|
|
|
|
|
#else
|
2014-01-19 21:15:05 +00:00
|
|
|
|
cint->cls = (ClauseDef *)HR;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (cint->cls + 2 * NClauses > (ClauseDef *)(ASP - 4096)) {
|
2004-03-31 02:02:18 +01:00
|
|
|
|
/* tell how much space we need (worst case) */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
LOCAL_Error_Size += 2 * NClauses * sizeof(ClauseDef);
|
2005-12-23 00:20:14 +00:00
|
|
|
|
save_machine_regs();
|
2016-07-31 10:26:15 +01:00
|
|
|
|
siglongjmp(cint->CompilerBotch, 3);
|
2004-03-31 02:02:18 +01:00
|
|
|
|
}
|
2010-03-31 15:51:18 +01:00
|
|
|
|
#endif
|
2004-03-31 02:02:18 +01:00
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
2010-04-15 22:23:54 +01:00
|
|
|
|
max = install_log_upd_clauses(cint->cls, ap, stack, first, last);
|
2004-03-31 02:02:18 +01:00
|
|
|
|
} else {
|
2010-04-15 22:23:54 +01:00
|
|
|
|
max = install_clauses(cint->cls, ap, stack, first, last);
|
2004-03-31 02:02:18 +01:00
|
|
|
|
}
|
2004-04-16 20:27:31 +01:00
|
|
|
|
#if DEBUG_EXPAND
|
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
fprintf(stderr, "vsc +");
|
2004-04-14 20:10:40 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
fprintf(stderr, "vsc ");
|
2004-04-14 20:10:40 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
fprintf(stderr, " : expanding %d out of %d\n", (max - cls) + 1, NClauses);
|
2004-04-16 20:27:31 +01:00
|
|
|
|
#endif
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2003-09-20 04:06:15 +01:00
|
|
|
|
/* don't count last clause if you don't have to */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (alt && max->Code == last)
|
|
|
|
|
max--;
|
2010-04-15 22:23:54 +01:00
|
|
|
|
if (max < cint->cls && labp != NULL) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
*labp = FAILCODE;
|
2003-09-15 02:25:29 +01:00
|
|
|
|
return labp;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2010-03-31 15:51:18 +01:00
|
|
|
|
#if USE_SYSTEM_MALLOC
|
2014-01-19 21:15:05 +00:00
|
|
|
|
cint->freep = (char *)HR;
|
2010-03-31 15:51:18 +01:00
|
|
|
|
#else
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cint->freep = (char *)(max + 1);
|
2010-03-31 15:51:18 +01:00
|
|
|
|
#endif
|
2004-01-26 12:41:06 +00:00
|
|
|
|
cint->CodeStart = cint->BlobsStart = cint->cpc = cint->icpc = NULL;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
|
|
|
|
|
if (!IsVarTerm(sp[-1].val) && sp > stack) {
|
2003-10-02 13:59:05 +01:00
|
|
|
|
if (IsAtomOrIntTerm(sp[-1].val)) {
|
|
|
|
|
if (s_reg == NULL) { /* we have not yet looked into terms */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
lab = do_index(cint->cls, max, cint, argno + 1, fail_l, isfirstcl,
|
|
|
|
|
clleft, top);
|
2003-10-02 13:59:05 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
UInt arity = 0;
|
|
|
|
|
|
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
|
|
|
|
reinstall_log_upd_clauses(cint->cls, max, ap, stack);
|
|
|
|
|
} else {
|
|
|
|
|
reinstall_clauses(cint->cls, max, ap, stack);
|
|
|
|
|
}
|
|
|
|
|
sp--;
|
|
|
|
|
while (sp > stack) {
|
|
|
|
|
Term t = sp[-1].val;
|
|
|
|
|
if (IsApplTerm(t)) {
|
|
|
|
|
Functor f = (Functor)RepAppl(t);
|
|
|
|
|
if (!IsExtensionFunctor(f)) {
|
|
|
|
|
arity = ArityOfFunctor(f);
|
|
|
|
|
break;
|
|
|
|
|
} else {
|
|
|
|
|
sp--;
|
|
|
|
|
}
|
|
|
|
|
} else if (IsPairTerm(t)) {
|
|
|
|
|
arity = 2;
|
|
|
|
|
break;
|
|
|
|
|
} else {
|
|
|
|
|
sp--;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
lab = do_compound_index(cint->cls, max, s_reg, cint, i, arity, argno,
|
|
|
|
|
fail_l, isfirstcl, is_last_arg, clleft, top,
|
|
|
|
|
FALSE);
|
2003-10-02 13:59:05 +01:00
|
|
|
|
}
|
|
|
|
|
} else if (IsPairTerm(sp[-1].val) && sp > stack) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
lab = do_compound_index(cint->cls, max, s_reg, cint, i, 2, argno, fail_l,
|
|
|
|
|
isfirstcl, is_last_arg, clleft, top, FALSE);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2003-10-02 13:59:05 +01:00
|
|
|
|
Functor f = (Functor)RepAppl(sp[-1].val);
|
2003-11-12 12:33:31 +00:00
|
|
|
|
/* we are continuing within a compound term */
|
2003-10-02 13:59:05 +01:00
|
|
|
|
if (IsExtensionFunctor(f)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
lab = do_index(cint->cls, max, cint, argno + 1, fail_l, isfirstcl,
|
|
|
|
|
clleft, top);
|
2003-10-02 13:59:05 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
lab = do_compound_index(cint->cls, max, s_reg, cint, i,
|
|
|
|
|
ArityOfFunctor(f), argno, fail_l, isfirstcl,
|
|
|
|
|
is_last_arg, clleft, top, FALSE);
|
2003-10-02 13:59:05 +01:00
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
} else {
|
|
|
|
|
if (argno == ap->ArityOfPE) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
lab = do_var_clauses(cint->cls, max, FALSE, cint, isfirstcl, clleft,
|
|
|
|
|
fail_l, ap->ArityOfPE + 1);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
lab = do_index(cint->cls, max, cint, argno + 1, fail_l, isfirstcl, clleft,
|
|
|
|
|
top);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
2006-11-06 18:35:05 +00:00
|
|
|
|
if (labp && !(lab & 1)) {
|
2004-02-19 19:24:46 +00:00
|
|
|
|
*labp = (yamop *)lab; /* in case we have a single clause */
|
2006-11-06 18:35:05 +00:00
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
return labp;
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static yamop *ExpandIndex(PredEntry *ap, int ExtraArgs,
|
|
|
|
|
yamop *nextop USES_REGS) {
|
2005-12-17 03:25:39 +00:00
|
|
|
|
yamop *indx_out, *expand_clauses;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
yamop **labp;
|
|
|
|
|
int cb;
|
2004-01-23 02:23:51 +00:00
|
|
|
|
struct intermediates cint;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
|
2010-03-31 15:51:18 +01:00
|
|
|
|
cint.blks = NULL;
|
2010-04-15 22:23:54 +01:00
|
|
|
|
cint.cls = NULL;
|
2009-03-27 14:05:27 +00:00
|
|
|
|
cint.code_addr = NULL;
|
2010-04-15 22:49:25 +01:00
|
|
|
|
cint.label_offset = NULL;
|
2010-12-16 01:22:10 +00:00
|
|
|
|
if ((cb = sigsetjmp(cint.CompilerBotch, 0)) == 3) {
|
2011-03-07 16:02:55 +00:00
|
|
|
|
CACHE_REGS
|
2003-08-27 14:30:50 +01:00
|
|
|
|
restore_machine_regs();
|
2004-09-27 21:45:04 +01:00
|
|
|
|
/* grow stack */
|
|
|
|
|
recover_from_failed_susp_on_cls(&cint, 0);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_gcl(LOCAL_Error_Size, ap->ArityOfPE + ExtraArgs, ENV, nextop);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else if (cb == 2) {
|
|
|
|
|
restore_machine_regs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
LOCAL_Error_Size = recover_from_failed_susp_on_cls(&cint, LOCAL_Error_Size);
|
|
|
|
|
if (!Yap_growheap(FALSE, LOCAL_Error_Size, NULL)) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
save_machine_regs();
|
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_kill_iblock((ClauseUnion *)ClauseCodeToLogUpdIndex(
|
|
|
|
|
ap->cs.p_code.TrueCodeOfPred),
|
|
|
|
|
NULL, ap);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
StaticIndex *cl;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = ClauseCodeToStaticIndex(ap->cs.p_code.TrueCodeOfPred);
|
|
|
|
|
Yap_kill_iblock((ClauseUnion *)cl, NULL, ap);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2007-11-26 23:43:10 +00:00
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag &&
|
2016-07-31 10:26:15 +01:00
|
|
|
|
!(ap->PredFlags & ThreadLocalPredFlag) &&
|
|
|
|
|
ap->ModuleOfPred != IDB_MODULE) {
|
|
|
|
|
ap->OpcodeOfPred = LOCKPRED_OPCODE;
|
|
|
|
|
ap->cs.p_code.TrueCodeOfPred = ap->CodeOfPred =
|
|
|
|
|
(yamop *)(&(ap->OpcodeOfPred));
|
2007-11-26 23:43:10 +00:00
|
|
|
|
} else {
|
|
|
|
|
#endif
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ap->OpcodeOfPred = INDEX_OPCODE;
|
|
|
|
|
ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred =
|
|
|
|
|
(yamop *)(&(ap->OpcodeOfPred));
|
2007-11-26 23:43:10 +00:00
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
|
|
|
|
}
|
|
|
|
|
#endif
|
2015-09-25 10:57:26 +01:00
|
|
|
|
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
|
2010-04-15 22:23:54 +01:00
|
|
|
|
CleanCls(&cint);
|
2004-09-27 21:45:04 +01:00
|
|
|
|
return FAILCODE;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2004-02-05 16:57:02 +00:00
|
|
|
|
} else if (cb == 4) {
|
|
|
|
|
restore_machine_regs();
|
2010-03-31 15:51:18 +01:00
|
|
|
|
Yap_ReleaseCMem(&cint);
|
2011-05-23 16:19:47 +01:00
|
|
|
|
if (!Yap_growtrail(LOCAL_Error_Size, FALSE)) {
|
2004-02-05 16:57:02 +00:00
|
|
|
|
save_machine_regs();
|
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_kill_iblock((ClauseUnion *)ClauseCodeToLogUpdIndex(
|
|
|
|
|
ap->cs.p_code.TrueCodeOfPred),
|
|
|
|
|
NULL, ap);
|
2004-02-05 16:57:02 +00:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
StaticIndex *cl;
|
2004-02-05 16:57:02 +00:00
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl = ClauseCodeToStaticIndex(ap->cs.p_code.TrueCodeOfPred);
|
|
|
|
|
Yap_kill_iblock((ClauseUnion *)cl, NULL, ap);
|
2004-02-05 16:57:02 +00:00
|
|
|
|
}
|
2010-04-15 22:23:54 +01:00
|
|
|
|
CleanCls(&cint);
|
2004-02-19 19:24:46 +00:00
|
|
|
|
return FAILCODE;
|
2004-02-05 16:57:02 +00:00
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
restart_index:
|
2004-01-29 13:37:10 +00:00
|
|
|
|
cint.CodeStart = cint.cpc = cint.BlobsStart = cint.icpc = NIL;
|
|
|
|
|
cint.CurrentPred = ap;
|
2011-05-23 16:19:47 +01:00
|
|
|
|
LOCAL_ErrorMessage = NULL;
|
|
|
|
|
LOCAL_Error_Size = 0;
|
2005-12-17 03:25:39 +00:00
|
|
|
|
if (P->opc == Yap_opcode(_expand_clauses)) {
|
|
|
|
|
expand_clauses = P;
|
|
|
|
|
} else {
|
|
|
|
|
expand_clauses = NULL;
|
|
|
|
|
}
|
2013-11-15 18:25:33 +00:00
|
|
|
|
#if DEBUG
|
2011-05-25 16:40:36 +01:00
|
|
|
|
if (GLOBAL_Option['i' - 'a' + 1]) {
|
2019-02-28 21:57:48 +00:00
|
|
|
|
Yap_DebugWriteIndicator(ap);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
#endif
|
2004-01-23 02:23:51 +00:00
|
|
|
|
if ((labp = expand_index(&cint)) == NULL) {
|
2006-11-06 18:35:05 +00:00
|
|
|
|
if (expand_clauses) {
|
|
|
|
|
P = FAILCODE;
|
|
|
|
|
recover_ecls_block(expand_clauses);
|
|
|
|
|
}
|
2010-04-09 17:02:24 +01:00
|
|
|
|
Yap_ReleaseCMem(&cint);
|
2010-04-15 22:23:54 +01:00
|
|
|
|
CleanCls(&cint);
|
2004-02-19 19:24:46 +00:00
|
|
|
|
return FAILCODE;
|
2003-12-01 17:27:42 +00:00
|
|
|
|
}
|
|
|
|
|
if (*labp == FAILCODE) {
|
2006-11-06 18:35:05 +00:00
|
|
|
|
if (expand_clauses) {
|
|
|
|
|
P = FAILCODE;
|
|
|
|
|
recover_ecls_block(expand_clauses);
|
|
|
|
|
}
|
2010-04-09 17:02:24 +01:00
|
|
|
|
Yap_ReleaseCMem(&cint);
|
2010-04-15 22:23:54 +01:00
|
|
|
|
CleanCls(&cint);
|
2003-09-20 04:06:15 +01:00
|
|
|
|
return FAILCODE;
|
2003-12-01 17:27:42 +00:00
|
|
|
|
}
|
2013-11-15 18:25:33 +00:00
|
|
|
|
#if DEBUG
|
2011-05-25 16:40:36 +01:00
|
|
|
|
if (GLOBAL_Option['i' - 'a' + 1]) {
|
2004-01-23 02:23:51 +00:00
|
|
|
|
Yap_ShowCode(&cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
#endif
|
|
|
|
|
/* globals for assembler */
|
2011-05-04 10:11:41 +01:00
|
|
|
|
LOCAL_IPredArity = ap->ArityOfPE;
|
2004-01-23 02:23:51 +00:00
|
|
|
|
if (cint.CodeStart) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if ((indx_out = Yap_assemble(ASSEMBLING_EINDEX, TermNil, ap, FALSE, &cint,
|
|
|
|
|
cint.i_labelno + 1)) == NULL) {
|
2011-05-23 16:19:47 +01:00
|
|
|
|
if (!Yap_growheap(FALSE, LOCAL_Error_Size, NULL)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_Error(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
|
|
|
|
|
Yap_ReleaseCMem(&cint);
|
|
|
|
|
CleanCls(&cint);
|
|
|
|
|
return FAILCODE;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
goto restart_index;
|
|
|
|
|
}
|
|
|
|
|
} else {
|
2004-02-05 16:57:02 +00:00
|
|
|
|
/* single case */
|
2006-11-06 18:35:05 +00:00
|
|
|
|
if (expand_clauses) {
|
|
|
|
|
P = *labp;
|
|
|
|
|
recover_ecls_block(expand_clauses);
|
|
|
|
|
}
|
2010-04-09 17:02:24 +01:00
|
|
|
|
Yap_ReleaseCMem(&cint);
|
2010-04-15 22:23:54 +01:00
|
|
|
|
CleanCls(&cint);
|
2003-09-15 02:25:29 +01:00
|
|
|
|
return *labp;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2003-12-01 17:27:42 +00:00
|
|
|
|
if (indx_out == NULL) {
|
2006-11-06 18:35:05 +00:00
|
|
|
|
if (expand_clauses) {
|
|
|
|
|
P = FAILCODE;
|
|
|
|
|
recover_ecls_block(expand_clauses);
|
|
|
|
|
}
|
2010-04-09 17:02:24 +01:00
|
|
|
|
Yap_ReleaseCMem(&cint);
|
2010-04-15 22:23:54 +01:00
|
|
|
|
CleanCls(&cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
return FAILCODE;
|
2003-12-01 17:27:42 +00:00
|
|
|
|
}
|
2010-04-09 17:02:24 +01:00
|
|
|
|
Yap_ReleaseCMem(&cint);
|
2010-04-15 22:23:54 +01:00
|
|
|
|
CleanCls(&cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
*labp = indx_out;
|
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
|
|
|
|
/* add to head of current code children */
|
2004-04-16 20:27:31 +01:00
|
|
|
|
LogUpdIndex *ic = cint.current_cl.lui,
|
2016-07-31 10:26:15 +01:00
|
|
|
|
*nic = ClauseCodeToLogUpdIndex(indx_out);
|
2004-04-16 20:27:31 +01:00
|
|
|
|
if (ic == NULL)
|
|
|
|
|
ic = (LogUpdIndex *)Yap_find_owner_index((yamop *)labp, ap);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* insert myself in the indexing code chain */
|
2003-08-27 14:30:50 +01:00
|
|
|
|
nic->SiblingIndex = ic->ChildIndex;
|
2005-05-31 20:42:28 +01:00
|
|
|
|
nic->PrevSiblingIndex = NULL;
|
|
|
|
|
if (ic->ChildIndex) {
|
|
|
|
|
ic->ChildIndex->PrevSiblingIndex = nic;
|
|
|
|
|
}
|
2005-12-17 03:25:39 +00:00
|
|
|
|
nic->ParentIndex = ic;
|
2003-10-31 00:20:52 +00:00
|
|
|
|
nic->ClFlags &= ~SwitchRootMask;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
ic->ChildIndex = nic;
|
|
|
|
|
ic->ClRefCount++;
|
|
|
|
|
} else {
|
|
|
|
|
/* add to head of current code children */
|
2004-04-16 20:27:31 +01:00
|
|
|
|
StaticIndex *ic = cint.current_cl.si,
|
2016-07-31 10:26:15 +01:00
|
|
|
|
*nic = ClauseCodeToStaticIndex(indx_out);
|
2004-04-16 20:27:31 +01:00
|
|
|
|
if (ic == NULL)
|
|
|
|
|
ic = (StaticIndex *)Yap_find_owner_index((yamop *)labp, ap);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* insert myself in the indexing code chain */
|
2003-08-27 14:30:50 +01:00
|
|
|
|
nic->SiblingIndex = ic->ChildIndex;
|
|
|
|
|
ic->ChildIndex = nic;
|
|
|
|
|
}
|
2005-12-17 03:25:39 +00:00
|
|
|
|
if (expand_clauses) {
|
|
|
|
|
P = indx_out;
|
|
|
|
|
recover_ecls_block(expand_clauses);
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
return indx_out;
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
yamop *Yap_ExpandIndex(PredEntry *ap, UInt nargs) {
|
2011-03-07 16:02:55 +00:00
|
|
|
|
CACHE_REGS
|
|
|
|
|
return ExpandIndex(ap, nargs, CP PASS_REGS);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static path_stack_entry *push_path(path_stack_entry *sp, yamop **pipc,
|
|
|
|
|
ClauseDef *clp, struct intermediates *cint) {
|
2011-03-07 16:02:55 +00:00
|
|
|
|
CACHE_REGS
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (sp + 1 > (path_stack_entry *)LOCAL_TrailTop) {
|
2005-12-23 00:20:14 +00:00
|
|
|
|
save_machine_regs();
|
2016-07-31 10:26:15 +01:00
|
|
|
|
siglongjmp(cint->CompilerBotch, 4);
|
2004-09-14 04:30:06 +01:00
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
sp->flag = pc_entry;
|
2014-02-18 09:44:01 +00:00
|
|
|
|
sp->uip.pce.pi_pc = pipc;
|
|
|
|
|
sp->uip.pce.code = clp->Code;
|
|
|
|
|
sp->uip.pce.current_code = clp->CurrentCode;
|
|
|
|
|
sp->uip.pce.work_pc = clp->ucd.WorkPC;
|
|
|
|
|
sp->uip.pce.tag = clp->Tag;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return sp + 1;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
|
|
|
|
|
static path_stack_entry *fetch_new_block(path_stack_entry *sp, yamop **pipc,
|
|
|
|
|
PredEntry *ap,
|
|
|
|
|
struct intermediates *cint) {
|
2011-03-07 16:02:55 +00:00
|
|
|
|
CACHE_REGS
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (sp + 1 > (path_stack_entry *)LOCAL_TrailTop) {
|
2009-03-24 01:02:44 +00:00
|
|
|
|
save_machine_regs();
|
2016-07-31 10:26:15 +01:00
|
|
|
|
siglongjmp(cint->CompilerBotch, 4);
|
2009-03-24 01:02:44 +00:00
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
/* add current position */
|
|
|
|
|
sp->flag = block_entry;
|
2014-02-18 09:44:01 +00:00
|
|
|
|
sp->uip.cle.entry_code = pipc;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
2014-02-18 09:44:01 +00:00
|
|
|
|
sp->uip.cle.block = (ClauseUnion *)ClauseCodeToLogUpdIndex(*pipc);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2014-02-18 09:44:01 +00:00
|
|
|
|
sp->uip.cle.block = (ClauseUnion *)ClauseCodeToStaticIndex(*pipc);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return sp + 1;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
|
|
|
|
|
static path_stack_entry *init_block_stack(path_stack_entry *sp, yamop *ipc,
|
|
|
|
|
PredEntry *ap) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
/* add current position */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
|
2003-08-27 14:30:50 +01:00
|
|
|
|
sp->flag = block_entry;
|
2014-02-18 09:44:01 +00:00
|
|
|
|
sp->uip.cle.entry_code = NULL;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
2014-02-18 09:44:01 +00:00
|
|
|
|
sp->uip.cle.block = (ClauseUnion *)ClauseCodeToLogUpdIndex(ipc);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2014-02-18 09:44:01 +00:00
|
|
|
|
sp->uip.cle.block = (ClauseUnion *)ClauseCodeToStaticIndex(ipc);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return sp + 1;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static path_stack_entry *cross_block(path_stack_entry *sp, yamop **pipc,
|
|
|
|
|
PredEntry *ap,
|
|
|
|
|
struct intermediates *cint) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
yamop *ipc = *pipc;
|
|
|
|
|
path_stack_entry *tsp = sp;
|
|
|
|
|
ClauseUnion *block;
|
|
|
|
|
|
|
|
|
|
do {
|
2004-03-05 15:26:33 +00:00
|
|
|
|
UInt bsize;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
while ((--tsp)->flag != block_entry)
|
|
|
|
|
;
|
2014-02-18 09:44:01 +00:00
|
|
|
|
block = tsp->uip.cle.block;
|
2004-03-05 15:26:33 +00:00
|
|
|
|
if (block->lui.ClFlags & LogUpdMask)
|
|
|
|
|
bsize = block->lui.ClSize;
|
|
|
|
|
else
|
|
|
|
|
bsize = block->si.ClSize;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (ipc > (yamop *)block && ipc < (yamop *)((CODEADDR)block + bsize)) {
|
|
|
|
|
path_stack_entry *nsp = tsp + 1;
|
|
|
|
|
for (; tsp < sp; tsp++) {
|
|
|
|
|
if (tsp->flag == pc_entry) {
|
|
|
|
|
if (nsp != tsp) {
|
|
|
|
|
nsp->flag = pc_entry;
|
|
|
|
|
nsp->uip.pce.pi_pc = tsp->uip.pce.pi_pc;
|
|
|
|
|
nsp->uip.pce.code = tsp->uip.pce.code;
|
|
|
|
|
nsp->uip.pce.current_code = tsp->uip.pce.current_code;
|
|
|
|
|
nsp->uip.pce.work_pc = tsp->uip.pce.work_pc;
|
|
|
|
|
nsp->uip.pce.tag = tsp->uip.pce.tag;
|
|
|
|
|
}
|
|
|
|
|
nsp++;
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
return nsp;
|
|
|
|
|
}
|
2014-02-18 09:44:01 +00:00
|
|
|
|
} while (tsp->uip.cle.entry_code != NULL);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
/* moved to a new block */
|
2009-03-24 01:02:44 +00:00
|
|
|
|
return fetch_new_block(sp, pipc, ap, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static yamop *pop_path(path_stack_entry **spp, ClauseDef *clp, PredEntry *ap,
|
|
|
|
|
struct intermediates *cint) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
path_stack_entry *sp = *spp;
|
|
|
|
|
yamop *nipc;
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
while ((--sp)->flag != pc_entry)
|
|
|
|
|
;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
*spp = sp;
|
2014-02-18 09:44:01 +00:00
|
|
|
|
clp->Code = sp->uip.pce.code;
|
|
|
|
|
clp->CurrentCode = sp->uip.pce.current_code;
|
|
|
|
|
clp->ucd.WorkPC = sp->uip.pce.work_pc;
|
|
|
|
|
clp->Tag = sp->uip.pce.tag;
|
|
|
|
|
if (sp->uip.pce.pi_pc == NULL) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
*spp = sp;
|
|
|
|
|
return NULL;
|
|
|
|
|
}
|
2014-02-18 09:44:01 +00:00
|
|
|
|
nipc = *(sp->uip.pce.pi_pc);
|
|
|
|
|
*spp = cross_block(sp, sp->uip.pce.pi_pc, ap, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
return nipc;
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static int table_fe_overflow(yamop *pc, Functor f) {
|
2014-05-30 01:06:09 +01:00
|
|
|
|
if (pc->y_u.sssl.s <= MIN_HASH_ENTRIES) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
/* we cannot expand otherwise */
|
|
|
|
|
COUNT i;
|
2014-05-30 01:06:09 +01:00
|
|
|
|
FuncSwiEntry *csw = (FuncSwiEntry *)pc->y_u.sssl.l;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
for (i = 0; i < pc->y_u.sssl.s; i++, csw++) {
|
|
|
|
|
if (csw->Tag == f)
|
|
|
|
|
return FALSE;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
return TRUE;
|
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
COUNT free = pc->y_u.sssl.s - pc->y_u.sssl.e;
|
|
|
|
|
return (!free || pc->y_u.sssl.s / free > 4);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static int table_ae_overflow(yamop *pc, Term at) {
|
2014-05-30 01:06:09 +01:00
|
|
|
|
if (pc->y_u.sssl.s <= MIN_HASH_ENTRIES) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
/* check if we are already there */
|
|
|
|
|
COUNT i;
|
2014-05-30 01:06:09 +01:00
|
|
|
|
AtomSwiEntry *csw = (AtomSwiEntry *)pc->y_u.sssl.l;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
for (i = 0; i < pc->y_u.sssl.s; i++, csw++) {
|
|
|
|
|
if (csw->Tag == at)
|
|
|
|
|
return FALSE;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
return TRUE;
|
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
COUNT free = pc->y_u.sssl.s - pc->y_u.sssl.e;
|
|
|
|
|
return (!free || pc->y_u.sssl.s / free > 4);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void replace_index_block(ClauseUnion *parent_block, yamop *cod,
|
|
|
|
|
yamop *ncod, PredEntry *ap) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
LogUpdIndex *cl = ClauseCodeToLogUpdIndex(cod),
|
|
|
|
|
*ncl = ClauseCodeToLogUpdIndex(ncod),
|
|
|
|
|
*c = parent_block->lui.ChildIndex;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
ncl->SiblingIndex = cl->SiblingIndex;
|
2005-05-31 20:42:28 +01:00
|
|
|
|
ncl->PrevSiblingIndex = cl->PrevSiblingIndex;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
ncl->ClRefCount = cl->ClRefCount;
|
|
|
|
|
ncl->ChildIndex = cl->ChildIndex;
|
2005-12-17 03:25:39 +00:00
|
|
|
|
ncl->ParentIndex = cl->ParentIndex;
|
|
|
|
|
ncl->ClPred = cl->ClPred;
|
2008-08-07 21:51:23 +01:00
|
|
|
|
// INIT_LOCK(ncl->ClLock);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (c == cl) {
|
|
|
|
|
parent_block->lui.ChildIndex = ncl;
|
|
|
|
|
} else {
|
2008-01-23 17:57:56 +00:00
|
|
|
|
if (cl->PrevSiblingIndex)
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl->PrevSiblingIndex->SiblingIndex = ncl;
|
2005-05-31 20:42:28 +01:00
|
|
|
|
}
|
|
|
|
|
if (cl->SiblingIndex) {
|
|
|
|
|
cl->SiblingIndex->PrevSiblingIndex = ncl;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2003-09-15 02:25:29 +01:00
|
|
|
|
c = cl->ChildIndex;
|
|
|
|
|
while (c != NULL) {
|
2005-12-17 03:25:39 +00:00
|
|
|
|
c->ParentIndex = ncl;
|
2003-09-15 02:25:29 +01:00
|
|
|
|
c = c->SiblingIndex;
|
|
|
|
|
}
|
2012-03-09 11:46:34 +00:00
|
|
|
|
Yap_InformOfRemoval(cl);
|
2006-11-06 18:35:05 +00:00
|
|
|
|
Yap_LUIndexSpace_SW -= cl->ClSize;
|
2005-07-05 19:32:32 +01:00
|
|
|
|
Yap_FreeCodeSpace((char *)cl);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
StaticIndex *cl = ClauseCodeToStaticIndex(cod),
|
|
|
|
|
*ncl = ClauseCodeToStaticIndex(ncod),
|
|
|
|
|
*c = parent_block->si.ChildIndex;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
ncl->SiblingIndex = cl->SiblingIndex;
|
2005-12-17 03:25:39 +00:00
|
|
|
|
ncl->ClPred = cl->ClPred;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (c == cl) {
|
|
|
|
|
parent_block->si.ChildIndex = ncl;
|
|
|
|
|
} else {
|
|
|
|
|
while (c->SiblingIndex != cl) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
c = c->SiblingIndex;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
c->SiblingIndex = ncl;
|
|
|
|
|
}
|
2012-03-09 11:46:34 +00:00
|
|
|
|
Yap_InformOfRemoval(cl);
|
2006-11-06 18:35:05 +00:00
|
|
|
|
Yap_IndexSpace_SW -= cl->ClSize;
|
2005-07-05 19:32:32 +01:00
|
|
|
|
Yap_FreeCodeSpace((char *)cl);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
|
|
|
|
|
static AtomSwiEntry *expand_ctable(yamop *pc, ClauseUnion *blk,
|
|
|
|
|
struct intermediates *cint, Term at) {
|
2004-01-23 02:23:51 +00:00
|
|
|
|
PredEntry *ap = cint->CurrentPred;
|
2014-05-30 01:06:09 +01:00
|
|
|
|
int n = pc->y_u.sssl.s, i, i0 = n;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
UInt fail_l = Zero;
|
2014-05-30 01:06:09 +01:00
|
|
|
|
AtomSwiEntry *old_ae = (AtomSwiEntry *)(pc->y_u.sssl.l), *target;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
|
|
|
|
|
if (n > MIN_HASH_ENTRIES) {
|
|
|
|
|
AtomSwiEntry *tmp = old_ae;
|
|
|
|
|
int i;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
|
2003-08-27 14:30:50 +01:00
|
|
|
|
n = 1;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
for (i = 0; i < pc->y_u.sssl.s; i++, tmp++) {
|
|
|
|
|
if (tmp->Tag != Zero)
|
|
|
|
|
n++;
|
|
|
|
|
else
|
|
|
|
|
fail_l = tmp->u_a.Label;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
} else {
|
2014-02-18 09:44:01 +00:00
|
|
|
|
fail_l = old_ae[n].u_a.Label;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
n++;
|
|
|
|
|
}
|
|
|
|
|
if (n > MIN_HASH_ENTRIES) {
|
|
|
|
|
int cases = MIN_HASH_ENTRIES, i, n0;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
n0 = n + 1 + n / 4;
|
|
|
|
|
while (cases < n0)
|
|
|
|
|
cases *= 2;
|
2014-05-30 01:06:09 +01:00
|
|
|
|
if (cases == pc->y_u.sssl.s) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return fetch_centry(old_ae, at, n - 1, n);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2015-11-05 16:38:18 +00:00
|
|
|
|
/* initialize */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
target =
|
|
|
|
|
(AtomSwiEntry *)emit_switch_space(cases, sizeof(AtomSwiEntry), cint, 0);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
pc->opc = Yap_opcode(_switch_on_cons);
|
2014-05-30 01:06:09 +01:00
|
|
|
|
pc->y_u.sssl.s = cases;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
for (i = 0; i < cases; i++) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
target[i].Tag = Zero;
|
2014-02-18 09:44:01 +00:00
|
|
|
|
target[i].u_a.Label = fail_l;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
} else {
|
|
|
|
|
pc->opc = Yap_opcode(_if_cons);
|
2014-05-30 01:06:09 +01:00
|
|
|
|
pc->y_u.sssl.s = n;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
target =
|
|
|
|
|
(AtomSwiEntry *)emit_switch_space(n + 1, sizeof(AtomSwiEntry), cint, 0);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
target[n].Tag = Zero;
|
2014-02-18 09:44:01 +00:00
|
|
|
|
target[n].u_a.Label = fail_l;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
for (i = 0; i < i0; i++, old_ae++) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
Term tag = old_ae->Tag;
|
|
|
|
|
|
|
|
|
|
if (tag != Zero) {
|
|
|
|
|
AtomSwiEntry *ics = fetch_centry(target, tag, i, n);
|
|
|
|
|
ics->Tag = tag;
|
2014-02-18 09:44:01 +00:00
|
|
|
|
ics->u_a.Label = old_ae->u_a.Label;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
2004-02-05 16:57:02 +00:00
|
|
|
|
/* support for threads */
|
|
|
|
|
if (blk)
|
2014-05-30 01:06:09 +01:00
|
|
|
|
replace_index_block(blk, pc->y_u.sssl.l, (yamop *)target, ap);
|
|
|
|
|
pc->y_u.sssl.l = (yamop *)target;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return fetch_centry(target, at, n - 1, n);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static FuncSwiEntry *expand_ftable(yamop *pc, ClauseUnion *blk,
|
|
|
|
|
struct intermediates *cint, Functor f) {
|
2004-01-23 02:23:51 +00:00
|
|
|
|
PredEntry *ap = cint->CurrentPred;
|
2014-05-30 01:06:09 +01:00
|
|
|
|
int n = pc->y_u.sssl.s, i, i0 = n;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
UInt fail_l = Zero;
|
2014-05-30 01:06:09 +01:00
|
|
|
|
FuncSwiEntry *old_fe = (FuncSwiEntry *)(pc->y_u.sssl.l), *target;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
|
|
|
|
|
if (n > MIN_HASH_ENTRIES) {
|
|
|
|
|
FuncSwiEntry *tmp = old_fe;
|
|
|
|
|
int i;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
|
2003-08-27 14:30:50 +01:00
|
|
|
|
n = 1;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
for (i = 0; i < pc->y_u.sssl.s; i++, tmp++) {
|
|
|
|
|
if (tmp->Tag != Zero)
|
|
|
|
|
n++;
|
|
|
|
|
else
|
|
|
|
|
fail_l = tmp->u_f.Label;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
} else {
|
2014-02-18 09:44:01 +00:00
|
|
|
|
fail_l = old_fe[n].u_f.Label;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
n++;
|
|
|
|
|
}
|
|
|
|
|
if (n > MIN_HASH_ENTRIES) {
|
|
|
|
|
int cases = MIN_HASH_ENTRIES, i, n0;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
n0 = n + 1 + n / 4;
|
|
|
|
|
while (cases < n0)
|
|
|
|
|
cases *= 2;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
|
2014-05-30 01:06:09 +01:00
|
|
|
|
if (cases == pc->y_u.sssl.s) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return fetch_fentry(old_fe, f, n - 1, n);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
pc->opc = Yap_opcode(_switch_on_func);
|
2014-05-30 01:06:09 +01:00
|
|
|
|
pc->y_u.sssl.s = cases;
|
|
|
|
|
pc->y_u.sssl.e = n;
|
|
|
|
|
pc->y_u.sssl.w = 0;
|
2015-11-05 16:38:18 +00:00
|
|
|
|
/* initialize */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
target = (FuncSwiEntry *)emit_switch_space(cases, sizeof(FuncSwiEntry),
|
|
|
|
|
cint, FuncSwitchMask);
|
|
|
|
|
for (i = 0; i < cases; i++) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
target[i].Tag = NULL;
|
2014-02-18 09:44:01 +00:00
|
|
|
|
target[i].u_f.Label = fail_l;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
} else {
|
|
|
|
|
pc->opc = Yap_opcode(_if_func);
|
2014-05-30 01:06:09 +01:00
|
|
|
|
pc->y_u.sssl.s = n;
|
|
|
|
|
pc->y_u.sssl.e = n;
|
|
|
|
|
pc->y_u.sssl.w = 0;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
target = (FuncSwiEntry *)emit_switch_space(n + 1, sizeof(FuncSwiEntry),
|
|
|
|
|
cint, FuncSwitchMask);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
target[n].Tag = Zero;
|
2014-02-18 09:44:01 +00:00
|
|
|
|
target[n].u_f.Label = fail_l;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
for (i = 0; i < i0; i++, old_fe++) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
Functor f = old_fe->Tag;
|
|
|
|
|
|
|
|
|
|
if (f != NULL) {
|
|
|
|
|
FuncSwiEntry *ifs = fetch_fentry(target, f, i, n);
|
|
|
|
|
ifs->Tag = old_fe->Tag;
|
2014-02-18 09:44:01 +00:00
|
|
|
|
ifs->u_f.Label = old_fe->u_f.Label;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
2014-05-30 01:06:09 +01:00
|
|
|
|
replace_index_block(blk, pc->y_u.sssl.l, (yamop *)target, ap);
|
|
|
|
|
pc->y_u.sssl.l = (yamop *)target;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return fetch_fentry(target, f, n - 1, n);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void clean_ref_to_clause(LogUpdClause *tgl) {
|
2006-10-10 15:08:17 +01:00
|
|
|
|
tgl->ClRefCount--;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if ((tgl->ClFlags & ErasedMask) && !(tgl->ClRefCount) &&
|
2006-10-10 15:08:17 +01:00
|
|
|
|
!(tgl->ClFlags & InUseMask)) {
|
|
|
|
|
/* last ref to the clause */
|
|
|
|
|
Yap_ErLogUpdCl(tgl);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static ClauseUnion *current_block(path_stack_entry *sp) {
|
|
|
|
|
while ((--sp)->flag != block_entry)
|
|
|
|
|
;
|
2014-02-18 09:44:01 +00:00
|
|
|
|
return sp->uip.cle.block;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static path_stack_entry *kill_block(path_stack_entry *sp, PredEntry *ap) {
|
|
|
|
|
while ((--sp)->flag != block_entry)
|
|
|
|
|
;
|
2014-02-18 09:44:01 +00:00
|
|
|
|
if (sp->uip.cle.entry_code == NULL) {
|
|
|
|
|
Yap_kill_iblock(sp->uip.cle.block, NULL, ap);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
|
|
|
|
path_stack_entry *nsp = sp;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
|
|
|
|
|
while ((--nsp)->flag != block_entry)
|
|
|
|
|
;
|
2014-02-18 09:44:01 +00:00
|
|
|
|
Yap_kill_iblock(sp->uip.cle.block, nsp->uip.cle.block, ap);
|
|
|
|
|
*sp->uip.cle.entry_code = (yamop *)&(ap->cs.p_code.ExpandCode);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
return sp;
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static LogUpdClause *find_last_clause(yamop *start) {
|
|
|
|
|
while (start->y_u.OtaLl.d->ClFlags & ErasedMask)
|
2014-05-30 01:06:09 +01:00
|
|
|
|
start = start->y_u.OtaLl.n;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
/* this should be the available clause */
|
2014-05-30 01:06:09 +01:00
|
|
|
|
return start->y_u.OtaLl.d;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void remove_clause_from_index(yamop *header, LogUpdClause *cl) {
|
2014-05-30 01:06:09 +01:00
|
|
|
|
yamop **prevp = &(header->y_u.Illss.l1);
|
|
|
|
|
yamop *curp = header->y_u.Illss.l1;
|
2006-12-27 01:32:38 +00:00
|
|
|
|
|
2014-05-30 01:06:09 +01:00
|
|
|
|
if (curp->y_u.OtaLl.d == cl) {
|
|
|
|
|
yamop *newp = curp->y_u.OtaLl.n;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
newp->opc = curp->opc;
|
2006-11-06 18:35:05 +00:00
|
|
|
|
*prevp = newp;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
} else {
|
2007-01-28 14:26:37 +00:00
|
|
|
|
yamop *ocurp = NULL, *ocurp0 = curp;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
|
2014-05-30 01:06:09 +01:00
|
|
|
|
while (curp->y_u.OtaLl.d != cl) {
|
2006-10-10 15:08:17 +01:00
|
|
|
|
ocurp = curp;
|
2014-05-30 01:06:09 +01:00
|
|
|
|
curp = curp->y_u.OtaLl.n;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
}
|
|
|
|
|
/* in case we were the last */
|
2014-05-30 01:06:09 +01:00
|
|
|
|
if (curp == header->y_u.Illss.l2)
|
|
|
|
|
header->y_u.Illss.l2 = ocurp;
|
2006-11-06 18:35:05 +00:00
|
|
|
|
if (ocurp != ocurp0)
|
|
|
|
|
ocurp->opc = curp->opc;
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ocurp->y_u.OtILl.n = curp->y_u.OtaLl.n;
|
|
|
|
|
ocurp->y_u.OtILl.block = curp->y_u.OtILl.block;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
}
|
2014-05-30 01:06:09 +01:00
|
|
|
|
header->y_u.Illss.e--;
|
2013-11-15 18:25:33 +00:00
|
|
|
|
#if DEBUG
|
2006-10-11 15:53:57 +01:00
|
|
|
|
Yap_DirtyCps--;
|
|
|
|
|
Yap_FreedCps++;
|
|
|
|
|
#endif
|
2006-10-10 15:08:17 +01:00
|
|
|
|
clean_ref_to_clause(cl);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_LUIndexSpace_CP -= (UInt)NEXTOP((yamop *)NULL, OtILl);
|
2006-10-10 15:08:17 +01:00
|
|
|
|
Yap_FreeCodeSpace((ADDR)curp);
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void remove_dirty_clauses_from_index(yamop *header) {
|
2006-10-10 15:08:17 +01:00
|
|
|
|
LogUpdClause *cl;
|
|
|
|
|
yamop *previouscurp;
|
|
|
|
|
OPCODE endop = Yap_opcode(_trust_logical);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
yamop **prevp = &(header->y_u.Illss.l1), *curp = header->y_u.Illss.l1;
|
2006-12-27 01:32:38 +00:00
|
|
|
|
OPCODE startopc = curp->opc;
|
2014-05-30 01:06:09 +01:00
|
|
|
|
PredEntry *ap = curp->y_u.OtaLl.d->ClPred;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
|
|
|
|
|
if (ap->PredFlags & CountPredFlag)
|
|
|
|
|
endop = Yap_opcode(_count_trust_logical);
|
|
|
|
|
else if (ap->PredFlags & ProfiledPredFlag)
|
|
|
|
|
endop = Yap_opcode(_profiled_trust_logical);
|
2014-05-30 01:06:09 +01:00
|
|
|
|
while ((cl = curp->y_u.OtaLl.d) && (cl->ClFlags & ErasedMask)) {
|
2006-10-10 15:08:17 +01:00
|
|
|
|
yamop *ocurp = curp;
|
|
|
|
|
|
2014-05-30 01:06:09 +01:00
|
|
|
|
header->y_u.Illss.e--;
|
2013-11-15 18:25:33 +00:00
|
|
|
|
#if DEBUG
|
2006-10-11 15:53:57 +01:00
|
|
|
|
Yap_DirtyCps--;
|
|
|
|
|
Yap_FreedCps++;
|
|
|
|
|
#endif
|
2016-07-31 10:26:15 +01:00
|
|
|
|
// if (ap->ModuleOfPred!=IDB_MODULE &&
|
|
|
|
|
// !strcmp(RepAtom(NameOfFunctor(ap->FunctorOfPred))->StrOfAE,
|
|
|
|
|
// "$lgt_send_to_obj_ne_"))
|
|
|
|
|
// printf(" L %p %p %d %p\n", curp, curp->y_u.OtaLl.n, header->y_u.Illss.e,
|
|
|
|
|
// curp->opc);
|
2006-10-10 15:08:17 +01:00
|
|
|
|
clean_ref_to_clause(cl);
|
2014-05-30 01:06:09 +01:00
|
|
|
|
curp = curp->y_u.OtaLl.n;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_LUIndexSpace_CP -= (UInt)NEXTOP((yamop *)NULL, OtaLl);
|
2006-10-10 15:08:17 +01:00
|
|
|
|
Yap_FreeCodeSpace((ADDR)ocurp);
|
2014-05-30 01:06:09 +01:00
|
|
|
|
if (ocurp == header->y_u.Illss.l2) {
|
|
|
|
|
LogUpdIndex *clau = header->y_u.Illss.I;
|
2013-11-08 23:48:28 +00:00
|
|
|
|
/* no clauses left */
|
|
|
|
|
if (clau->ClFlags & ErasedMask) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_ErLogUpdIndex(clau);
|
|
|
|
|
return;
|
2013-11-08 23:48:28 +00:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
header->y_u.Illss.l1 = header->y_u.Illss.l2 = NULL;
|
|
|
|
|
header->y_u.Illss.s = header->y_u.Illss.e = 0;
|
2013-11-08 23:48:28 +00:00
|
|
|
|
return;
|
|
|
|
|
}
|
|
|
|
|
}
|
2006-10-10 15:08:17 +01:00
|
|
|
|
*prevp = curp;
|
|
|
|
|
curp->opc = startopc;
|
|
|
|
|
if (curp->opc == endop)
|
|
|
|
|
return;
|
2014-04-09 12:39:29 +01:00
|
|
|
|
// don't try to follow the chain if there is no chain.
|
2014-05-30 01:06:09 +01:00
|
|
|
|
if (header->y_u.Illss.e <= 1)
|
2011-06-24 21:08:22 +01:00
|
|
|
|
return;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
previouscurp = curp;
|
2014-05-30 01:06:09 +01:00
|
|
|
|
curp = curp->y_u.OtaLl.n;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
while (TRUE) {
|
2014-05-30 01:06:09 +01:00
|
|
|
|
if ((cl = curp->y_u.OtaLl.d)->ClFlags & ErasedMask) {
|
2006-10-10 15:08:17 +01:00
|
|
|
|
yamop *ocurp = curp;
|
|
|
|
|
|
2014-05-30 01:06:09 +01:00
|
|
|
|
header->y_u.Illss.e--;
|
2013-11-15 18:25:33 +00:00
|
|
|
|
#if DEBUG
|
2006-10-11 15:53:57 +01:00
|
|
|
|
Yap_DirtyCps--;
|
|
|
|
|
Yap_FreedCps++;
|
|
|
|
|
#endif
|
2006-10-10 15:08:17 +01:00
|
|
|
|
clean_ref_to_clause(cl);
|
|
|
|
|
if (curp->opc == endop) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
previouscurp->opc = endop;
|
|
|
|
|
previouscurp->y_u.OtILl.block = curp->y_u.OtILl.block;
|
|
|
|
|
previouscurp->y_u.OtILl.n = NULL;
|
|
|
|
|
header->y_u.Illss.l2 = previouscurp;
|
|
|
|
|
Yap_LUIndexSpace_CP -= (UInt)NEXTOP((yamop *)NULL, OtILl);
|
|
|
|
|
Yap_FreeCodeSpace((ADDR)curp);
|
|
|
|
|
return;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
}
|
2014-05-30 01:06:09 +01:00
|
|
|
|
previouscurp->y_u.OtaLl.n = curp->y_u.OtaLl.n;
|
|
|
|
|
curp = curp->y_u.OtaLl.n;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_LUIndexSpace_CP -= (UInt)NEXTOP((yamop *)NULL, OtaLl);
|
2006-10-10 15:08:17 +01:00
|
|
|
|
Yap_FreeCodeSpace((ADDR)ocurp);
|
2014-05-30 01:06:09 +01:00
|
|
|
|
if (!header->y_u.Illss.e)
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
} else {
|
|
|
|
|
previouscurp = curp;
|
|
|
|
|
if (curp->opc == endop) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
curp->y_u.OtILl.n = NULL;
|
|
|
|
|
return;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
}
|
2014-05-30 01:06:09 +01:00
|
|
|
|
curp = curp->y_u.OtaLl.n;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static path_stack_entry *kill_clause(yamop *ipc, yamop *bg, yamop *lt,
|
|
|
|
|
path_stack_entry *sp0, PredEntry *ap) {
|
2003-09-15 02:25:29 +01:00
|
|
|
|
LogUpdIndex *blk;
|
|
|
|
|
yamop *start;
|
|
|
|
|
op_numbers op0;
|
2004-06-17 23:07:23 +01:00
|
|
|
|
path_stack_entry *sp = sp0;
|
2003-09-15 02:25:29 +01:00
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
while ((--sp)->flag != block_entry)
|
|
|
|
|
;
|
2014-02-18 09:44:01 +00:00
|
|
|
|
blk = (LogUpdIndex *)(sp->uip.cle.block);
|
2003-09-15 02:25:29 +01:00
|
|
|
|
start = blk->ClCode;
|
|
|
|
|
op0 = Yap_op_from_opcode(start->opc);
|
2006-10-16 18:12:48 +01:00
|
|
|
|
while (op0 == _lock_lu) {
|
|
|
|
|
start = NEXTOP(start, p);
|
|
|
|
|
op0 = Yap_op_from_opcode(start->opc);
|
|
|
|
|
}
|
2004-03-19 11:35:42 +00:00
|
|
|
|
while (op0 == _jump_if_nonvar) {
|
2005-04-10 05:01:15 +01:00
|
|
|
|
start = NEXTOP(start, xll);
|
2004-03-19 11:35:42 +00:00
|
|
|
|
op0 = Yap_op_from_opcode(start->opc);
|
|
|
|
|
}
|
2006-10-10 15:08:17 +01:00
|
|
|
|
if (op0 != _enter_lu_pred) {
|
|
|
|
|
/* static code */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return kill_block(sp + 1, ap);
|
2006-10-10 15:08:17 +01:00
|
|
|
|
}
|
|
|
|
|
/* weird case ????? */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (!start->y_u.Illss.s) {
|
2006-10-10 15:08:17 +01:00
|
|
|
|
/* ERROR */
|
2015-09-25 10:57:26 +01:00
|
|
|
|
Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "Illss.s == 0 %p", ipc);
|
2006-10-10 15:08:17 +01:00
|
|
|
|
return sp;
|
|
|
|
|
}
|
2014-05-30 01:06:09 +01:00
|
|
|
|
if (start->y_u.Illss.s == 1) {
|
2006-10-10 15:08:17 +01:00
|
|
|
|
/* we need to discover which clause is left and then die */
|
|
|
|
|
path_stack_entry *nsp;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
find_last_clause(start->y_u.Illss.l1);
|
2003-09-15 02:25:29 +01:00
|
|
|
|
|
2006-10-10 15:08:17 +01:00
|
|
|
|
nsp = sp;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
while ((--nsp)->flag != block_entry)
|
|
|
|
|
;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
/* make us point straight at clause */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
*sp->uip.cle.entry_code = FAILCODE;
|
2014-02-18 09:44:01 +00:00
|
|
|
|
Yap_kill_iblock(sp->uip.cle.block, nsp->uip.cle.block, ap);
|
2006-10-10 15:08:17 +01:00
|
|
|
|
return sp;
|
|
|
|
|
} else {
|
|
|
|
|
if (
|
2011-04-14 18:51:11 +01:00
|
|
|
|
#if MULTIPLE_STACKS
|
2016-07-31 10:26:15 +01:00
|
|
|
|
blk->ClRefCount == 0
|
2006-10-10 15:08:17 +01:00
|
|
|
|
#else
|
2016-07-31 10:26:15 +01:00
|
|
|
|
!(blk->ClFlags & InUseMask)
|
2006-10-10 15:08:17 +01:00
|
|
|
|
#endif
|
2016-07-31 10:26:15 +01:00
|
|
|
|
) {
|
|
|
|
|
remove_clause_from_index(start, ClauseCodeToLogUpdClause(bg));
|
2004-09-27 21:45:04 +01:00
|
|
|
|
} else {
|
2006-10-10 15:08:17 +01:00
|
|
|
|
blk->ClFlags |= DirtyMask;
|
2004-03-19 11:35:42 +00:00
|
|
|
|
}
|
2006-10-10 15:08:17 +01:00
|
|
|
|
return sp;
|
2003-09-15 02:25:29 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static path_stack_entry *expanda_block(path_stack_entry *sp, PredEntry *ap,
|
|
|
|
|
ClauseDef *cls, int group1, yamop *alt,
|
|
|
|
|
struct intermediates *cint) {
|
|
|
|
|
while ((--sp)->flag != block_entry)
|
|
|
|
|
;
|
2014-02-18 09:44:01 +00:00
|
|
|
|
Yap_kill_iblock(sp->uip.cle.block, NULL, ap);
|
2006-10-10 15:08:17 +01:00
|
|
|
|
return sp;
|
2003-09-15 02:25:29 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static path_stack_entry *expandz_block(path_stack_entry *sp, PredEntry *ap,
|
|
|
|
|
ClauseDef *cls, int group1, yamop *alt,
|
|
|
|
|
struct intermediates *cint) {
|
|
|
|
|
while ((--sp)->flag != block_entry)
|
|
|
|
|
;
|
2014-02-18 09:44:01 +00:00
|
|
|
|
Yap_kill_iblock(sp->uip.cle.block, NULL, ap);
|
2006-10-10 15:08:17 +01:00
|
|
|
|
return sp;
|
2003-09-15 02:25:29 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static LogUpdClause *lu_clause(yamop *ipc, PredEntry *ap) {
|
2006-10-10 15:08:17 +01:00
|
|
|
|
if (ipc == FAILCODE)
|
|
|
|
|
return NULL;
|
2008-05-11 00:24:13 +01:00
|
|
|
|
if (ipc == (yamop *)(&(ap->OpcodeOfPred)))
|
|
|
|
|
return NULL;
|
|
|
|
|
return ClauseCodeToLogUpdClause(ipc);
|
2004-03-19 11:35:42 +00:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static StaticClause *find_static_clause(PredEntry *ap, yamop *ipc) {
|
2008-04-16 18:16:47 +01:00
|
|
|
|
StaticClause *cl = ClauseCodeToStaticClause(ap->cs.p_code.FirstClause);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
while (ipc < cl->ClCode || ipc > (yamop *)((char *)cl + cl->ClSize)) {
|
2008-04-16 18:16:47 +01:00
|
|
|
|
cl = cl->ClNext;
|
|
|
|
|
if (!cl)
|
|
|
|
|
return NULL;
|
|
|
|
|
}
|
|
|
|
|
return cl;
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static StaticClause *static_clause(yamop *ipc, PredEntry *ap, int trust) {
|
2007-03-26 16:18:43 +01:00
|
|
|
|
CELL *p;
|
2003-09-15 02:25:29 +01:00
|
|
|
|
|
2006-10-10 15:08:17 +01:00
|
|
|
|
if (ipc == FAILCODE)
|
|
|
|
|
return NULL;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (ipc == (yamop *)(&(ap->OpcodeOfPred)))
|
2008-05-11 00:24:13 +01:00
|
|
|
|
return NULL;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
if (ap->PredFlags & MegaClausePredFlag)
|
|
|
|
|
return (StaticClause *)ipc;
|
2007-03-26 16:18:43 +01:00
|
|
|
|
if (ap->PredFlags & TabledPredFlag)
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = PREVOP(ipc, Otapl);
|
2007-03-26 16:18:43 +01:00
|
|
|
|
p = (CELL *)ipc;
|
2008-04-16 18:16:47 +01:00
|
|
|
|
if (trust) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return ClauseCodeToStaticClause(p);
|
2008-04-16 18:16:47 +01:00
|
|
|
|
} else {
|
|
|
|
|
op_numbers op = Yap_op_from_opcode(ipc->opc);
|
|
|
|
|
UInt j;
|
|
|
|
|
|
|
|
|
|
/* unbound call, so we cannot optimise instructions */
|
|
|
|
|
switch (op) {
|
|
|
|
|
case _p_db_ref_x:
|
|
|
|
|
case _p_float_x:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
j = Yap_regnotoreg(ipc->y_u.xl.x);
|
2008-04-16 18:16:47 +01:00
|
|
|
|
break;
|
|
|
|
|
case _get_list:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
j = Yap_regnotoreg(ipc->y_u.x.x);
|
2008-04-16 18:16:47 +01:00
|
|
|
|
break;
|
|
|
|
|
case _get_atom:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
j = Yap_regnotoreg(ipc->y_u.xc.x);
|
2008-04-16 18:16:47 +01:00
|
|
|
|
break;
|
|
|
|
|
case _get_float:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
j = Yap_regnotoreg(ipc->y_u.xd.x);
|
2008-04-16 18:16:47 +01:00
|
|
|
|
break;
|
|
|
|
|
case _get_struct:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
j = Yap_regnotoreg(ipc->y_u.xd.x);
|
2008-04-16 18:16:47 +01:00
|
|
|
|
break;
|
|
|
|
|
case _get_2atoms:
|
|
|
|
|
case _get_3atoms:
|
|
|
|
|
case _get_4atoms:
|
|
|
|
|
case _get_5atoms:
|
|
|
|
|
case _get_6atoms:
|
|
|
|
|
return ClauseCodeToStaticClause(p);
|
|
|
|
|
default:
|
|
|
|
|
return find_static_clause(ap, ipc);
|
2003-09-15 02:25:29 +01:00
|
|
|
|
}
|
2008-04-16 18:16:47 +01:00
|
|
|
|
if (j == 1) /* must be the first instruction */
|
|
|
|
|
return ClauseCodeToStaticClause(p);
|
|
|
|
|
return find_static_clause(ap, ipc);
|
2003-09-15 02:25:29 +01:00
|
|
|
|
}
|
2006-10-10 15:08:17 +01:00
|
|
|
|
return NULL;
|
2003-09-15 02:25:29 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static StaticClause *simple_static_clause(yamop *ipc, PredEntry *ap) {
|
|
|
|
|
if (ipc == (yamop *)(&(ap->OpcodeOfPred)))
|
2008-05-11 00:24:13 +01:00
|
|
|
|
return NULL;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
if (ipc == FAILCODE)
|
2003-09-15 02:25:29 +01:00
|
|
|
|
return NULL;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
return ClauseCodeToStaticClause(ipc);
|
2003-09-15 02:25:29 +01:00
|
|
|
|
}
|
|
|
|
|
|
2006-10-10 15:08:17 +01:00
|
|
|
|
/* this code should be called when we jumped to clauses */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static path_stack_entry *kill_unsafe_block(path_stack_entry *sp, op_numbers op,
|
|
|
|
|
PredEntry *ap, int first, int remove,
|
|
|
|
|
ClauseDef *cls) {
|
2006-10-10 15:08:17 +01:00
|
|
|
|
yamop *ipc;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
while ((--sp)->flag != block_entry)
|
|
|
|
|
;
|
2014-02-18 09:44:01 +00:00
|
|
|
|
if (sp->uip.cle.entry_code == NULL) {
|
2011-02-15 20:24:48 +00:00
|
|
|
|
/* we have reached the top */
|
|
|
|
|
Yap_RemoveIndexation(ap);
|
2006-10-10 15:08:17 +01:00
|
|
|
|
return sp;
|
2011-02-15 20:24:48 +00:00
|
|
|
|
}
|
2014-02-18 09:44:01 +00:00
|
|
|
|
ipc = *sp->uip.cle.entry_code;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
if (Yap_op_from_opcode(ipc->opc) == op) {
|
|
|
|
|
/* the new block was the current clause */
|
|
|
|
|
ClauseDef cld[2];
|
2004-03-19 11:35:42 +00:00
|
|
|
|
|
2006-10-10 15:08:17 +01:00
|
|
|
|
if (remove) {
|
2014-02-18 09:44:01 +00:00
|
|
|
|
*sp->uip.cle.entry_code = FAILCODE;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
return sp;
|
2004-03-19 11:35:42 +00:00
|
|
|
|
}
|
2006-10-10 15:08:17 +01:00
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
|
|
|
|
struct intermediates intrs;
|
2008-05-11 00:24:13 +01:00
|
|
|
|
LogUpdClause *lc = lu_clause(ipc, ap);
|
2004-09-27 21:45:04 +01:00
|
|
|
|
|
2004-03-31 02:02:18 +01:00
|
|
|
|
if (first) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cld[0].Code = cls[0].Code;
|
|
|
|
|
cld[1].Code = lc->ClCode;
|
2004-10-04 19:56:20 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cld[0].Code = lc->ClCode;
|
|
|
|
|
cld[1].Code = cls[0].Code;
|
2004-03-31 02:02:18 +01:00
|
|
|
|
}
|
2004-09-27 21:45:04 +01:00
|
|
|
|
intrs.expand_block = NULL;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
*sp->uip.cle.entry_code =
|
|
|
|
|
(yamop *)suspend_indexing(cld, cld + 1, ap, &intrs);
|
2004-03-31 02:02:18 +01:00
|
|
|
|
} else {
|
2004-09-27 21:45:04 +01:00
|
|
|
|
/* static predicate, shouldn't do much, just suspend the code here */
|
2014-02-18 09:44:01 +00:00
|
|
|
|
*sp->uip.cle.entry_code = (yamop *)&(ap->cs.p_code.ExpandCode);
|
2004-09-27 21:45:04 +01:00
|
|
|
|
return sp;
|
2004-03-31 02:02:18 +01:00
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
return sp;
|
|
|
|
|
}
|
|
|
|
|
/* we didn't have protection, should kill now */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return kill_block(sp + 1, ap);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static int compacta_expand_clauses(yamop *ipc) {
|
2005-05-31 20:42:28 +01:00
|
|
|
|
/* expand clauses so that you have a hole at the beginning */
|
|
|
|
|
/* we know that there is at least one element here */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
yamop **start = (yamop **)(NEXTOP(ipc, sssllp));
|
2005-05-31 20:42:28 +01:00
|
|
|
|
yamop **ptr, **end;
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ptr = end = start + ipc->y_u.sssllp.s1;
|
2005-05-31 20:42:28 +01:00
|
|
|
|
|
2005-05-31 21:04:17 +01:00
|
|
|
|
while (ptr > start) {
|
|
|
|
|
yamop *next = *--ptr;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (next)
|
|
|
|
|
*--end = next;
|
2005-05-31 20:42:28 +01:00
|
|
|
|
}
|
2005-05-31 21:04:17 +01:00
|
|
|
|
if (ptr != end) {
|
|
|
|
|
while (end > start) {
|
|
|
|
|
*--end = NULL;
|
|
|
|
|
}
|
|
|
|
|
return TRUE;
|
|
|
|
|
}
|
|
|
|
|
return FALSE;
|
2005-05-31 20:42:28 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static int compactz_expand_clauses(yamop *ipc) {
|
2005-05-31 20:42:28 +01:00
|
|
|
|
/* expand clauses so that you have a hole at the beginning */
|
|
|
|
|
/* we know that there is at least one element here */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
yamop **start = (yamop **)(NEXTOP(ipc, sssllp));
|
2005-05-31 20:42:28 +01:00
|
|
|
|
yamop **ptr, **end;
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
end = start + ipc->y_u.sssllp.s1;
|
2005-05-31 20:42:28 +01:00
|
|
|
|
ptr = start;
|
|
|
|
|
|
|
|
|
|
while (ptr < end) {
|
|
|
|
|
yamop *next = *ptr++;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (next)
|
|
|
|
|
*start++ = next;
|
2005-05-31 20:42:28 +01:00
|
|
|
|
}
|
2005-05-31 21:04:17 +01:00
|
|
|
|
/* reset empty slots at end */
|
|
|
|
|
if (start != end) {
|
|
|
|
|
while (start < end) {
|
|
|
|
|
*start++ = NULL;
|
|
|
|
|
}
|
|
|
|
|
return TRUE;
|
|
|
|
|
}
|
|
|
|
|
return FALSE;
|
2005-05-31 20:42:28 +01:00
|
|
|
|
}
|
|
|
|
|
|
2004-03-31 02:02:18 +01:00
|
|
|
|
/* this code should be called when we jumped to clauses */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static yamop *add_to_expand_clauses(path_stack_entry **spp, yamop *ipc,
|
|
|
|
|
ClauseDef *cls, PredEntry *ap, int first,
|
|
|
|
|
struct intermediates *cint) {
|
2004-03-31 02:02:18 +01:00
|
|
|
|
path_stack_entry *sp = *spp;
|
2005-08-17 19:48:35 +01:00
|
|
|
|
yamop **clar;
|
2004-03-31 02:02:18 +01:00
|
|
|
|
|
|
|
|
|
if (first) {
|
2005-08-17 19:48:35 +01:00
|
|
|
|
|
2005-05-31 20:42:28 +01:00
|
|
|
|
do {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clar = (yamop **)NEXTOP(ipc, sssllp);
|
2005-08-17 19:48:35 +01:00
|
|
|
|
|
2005-05-31 20:42:28 +01:00
|
|
|
|
if (*clar == NULL || clar[0] == cls->Code) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
while (*clar == NULL)
|
|
|
|
|
clar++;
|
|
|
|
|
if (clar[0] != cls->Code) {
|
|
|
|
|
clar[-1] = cls->Code;
|
|
|
|
|
ipc->y_u.sssllp.s2++;
|
|
|
|
|
}
|
|
|
|
|
return pop_path(spp, cls, ap, cint);
|
2004-04-14 20:10:40 +01:00
|
|
|
|
}
|
2005-05-31 20:42:28 +01:00
|
|
|
|
} while (compacta_expand_clauses(ipc));
|
2004-03-31 02:02:18 +01:00
|
|
|
|
} else {
|
2005-05-31 20:42:28 +01:00
|
|
|
|
do {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
clar = (yamop **)NEXTOP(ipc, sssllp) + ipc->y_u.sssllp.s1;
|
|
|
|
|
if (clar[-1] == NULL || clar[-1] == cls->Code) {
|
|
|
|
|
while (*--clar == NULL)
|
|
|
|
|
;
|
|
|
|
|
if (clar[0] != cls->Code) {
|
|
|
|
|
clar[1] = cls->Code;
|
|
|
|
|
ipc->y_u.sssllp.s2++;
|
|
|
|
|
}
|
|
|
|
|
return pop_path(spp, cls, ap, cint);
|
2004-04-14 20:10:40 +01:00
|
|
|
|
}
|
2005-05-31 20:42:28 +01:00
|
|
|
|
} while (compactz_expand_clauses(ipc));
|
2004-03-31 02:02:18 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
while ((--sp)->flag != block_entry)
|
|
|
|
|
;
|
2014-02-18 09:44:01 +00:00
|
|
|
|
if (sp->uip.cle.entry_code) {
|
|
|
|
|
*sp->uip.cle.entry_code = (yamop *)&(ap->cs.p_code.ExpandCode);
|
2004-03-31 02:02:18 +01:00
|
|
|
|
}
|
2004-04-14 20:10:40 +01:00
|
|
|
|
recover_ecls_block(ipc);
|
2009-03-24 01:02:44 +00:00
|
|
|
|
return pop_path(spp, cls, ap, cint);
|
2004-03-31 02:02:18 +01:00
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
/* this code should be called when we jumped to clauses */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void nullify_expand_clause(yamop *ipc, path_stack_entry *sp,
|
|
|
|
|
ClauseDef *cls) {
|
|
|
|
|
yamop **st = (yamop **)NEXTOP(ipc, sssllp);
|
|
|
|
|
yamop **max = st + ipc->y_u.sssllp.s1;
|
2004-03-31 02:02:18 +01:00
|
|
|
|
|
2004-04-22 04:24:17 +01:00
|
|
|
|
/* make sure we get rid of the reference */
|
|
|
|
|
while (st < max) {
|
|
|
|
|
if (*st && *st == cls->Code) {
|
|
|
|
|
*st = NULL;
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ipc->y_u.sssllp.s2--;
|
2004-04-22 04:24:17 +01:00
|
|
|
|
break;
|
|
|
|
|
}
|
|
|
|
|
st++;
|
|
|
|
|
}
|
|
|
|
|
/* if the block has a single element */
|
2014-05-30 01:06:09 +01:00
|
|
|
|
if (ipc->y_u.sssllp.s2 == 1) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
yamop **st = (yamop **)NEXTOP(ipc, sssllp);
|
|
|
|
|
while ((--sp)->flag != block_entry)
|
|
|
|
|
;
|
2004-03-31 02:02:18 +01:00
|
|
|
|
while (TRUE) {
|
|
|
|
|
if (*st && *st != cls->Code) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
*sp->uip.cle.entry_code = *st;
|
|
|
|
|
recover_ecls_block(ipc);
|
|
|
|
|
return;
|
2004-03-31 02:02:18 +01:00
|
|
|
|
}
|
|
|
|
|
st++;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static yamop *add_try(PredEntry *ap, ClauseDef *cls, yamop *next,
|
|
|
|
|
struct intermediates *cint) {
|
2006-10-10 15:08:17 +01:00
|
|
|
|
yamop *newcp;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
UInt size = (UInt)NEXTOP((yamop *)NULL, OtaLl);
|
2006-11-06 18:35:05 +00:00
|
|
|
|
LogUpdClause *lcl = ClauseCodeToLogUpdClause(cls->Code);
|
2006-10-10 15:08:17 +01:00
|
|
|
|
|
|
|
|
|
if ((newcp = (yamop *)Yap_AllocCodeSpace(size)) == NULL) {
|
2010-12-16 01:22:10 +00:00
|
|
|
|
/* OOOPS, got in trouble, must do a siglongjmp and recover space */
|
2006-10-10 15:08:17 +01:00
|
|
|
|
save_machine_regs();
|
2016-07-31 10:26:15 +01:00
|
|
|
|
siglongjmp(cint->CompilerBotch, 2);
|
2006-10-10 15:08:17 +01:00
|
|
|
|
}
|
2006-11-06 18:35:05 +00:00
|
|
|
|
Yap_LUIndexSpace_CP += size;
|
2013-11-15 18:25:33 +00:00
|
|
|
|
#if DEBUG
|
2006-10-11 15:53:57 +01:00
|
|
|
|
Yap_NewCps++;
|
|
|
|
|
Yap_LiveCps++;
|
|
|
|
|
#endif
|
2006-10-10 15:08:17 +01:00
|
|
|
|
newcp->opc = Yap_opcode(_try_logical);
|
2014-05-30 01:06:09 +01:00
|
|
|
|
newcp->y_u.OtaLl.s = ap->ArityOfPE;
|
|
|
|
|
newcp->y_u.OtaLl.n = next;
|
|
|
|
|
newcp->y_u.OtaLl.d = lcl;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
lcl->ClRefCount++;
|
|
|
|
|
return newcp;
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static yamop *add_trust(LogUpdIndex *icl, ClauseDef *cls,
|
|
|
|
|
struct intermediates *cint) {
|
2006-10-10 15:08:17 +01:00
|
|
|
|
yamop *newcp;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
UInt size = (UInt)NEXTOP((yamop *)NULL, OtILl);
|
2006-11-06 18:35:05 +00:00
|
|
|
|
LogUpdClause *lcl = ClauseCodeToLogUpdClause(cls->Code);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
PredEntry *ap = lcl->ClPred;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
|
|
|
|
|
if ((newcp = (yamop *)Yap_AllocCodeSpace(size)) == NULL) {
|
2010-12-16 01:22:10 +00:00
|
|
|
|
/* OOOPS, got in trouble, must do a siglongjmp and recover space */
|
2006-10-10 15:08:17 +01:00
|
|
|
|
save_machine_regs();
|
2016-07-31 10:26:15 +01:00
|
|
|
|
siglongjmp(cint->CompilerBotch, 2);
|
2006-10-10 15:08:17 +01:00
|
|
|
|
}
|
2006-11-06 18:35:05 +00:00
|
|
|
|
Yap_LUIndexSpace_CP += size;
|
2013-11-15 18:25:33 +00:00
|
|
|
|
#if DEBUG
|
2006-10-11 15:53:57 +01:00
|
|
|
|
Yap_NewCps++;
|
|
|
|
|
Yap_LiveCps++;
|
|
|
|
|
#endif
|
2006-10-10 15:08:17 +01:00
|
|
|
|
if (ap->PredFlags & CountPredFlag)
|
|
|
|
|
newcp->opc = Yap_opcode(_count_trust_logical);
|
|
|
|
|
else if (ap->PredFlags & ProfiledPredFlag)
|
|
|
|
|
newcp->opc = Yap_opcode(_profiled_trust_logical);
|
|
|
|
|
else
|
|
|
|
|
newcp->opc = Yap_opcode(_trust_logical);
|
2014-05-30 01:06:09 +01:00
|
|
|
|
newcp->y_u.OtILl.block = icl;
|
|
|
|
|
newcp->y_u.OtILl.n = NULL;
|
|
|
|
|
newcp->y_u.OtILl.d = lcl;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
lcl->ClRefCount++;
|
|
|
|
|
return newcp;
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void add_to_index(struct intermediates *cint, int first,
|
|
|
|
|
path_stack_entry *sp, ClauseDef *cls) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
/* last clause to experiment with */
|
2004-01-23 02:23:51 +00:00
|
|
|
|
PredEntry *ap = cint->CurrentPred;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
yamop *ipc = ap->cs.p_code.TrueCodeOfPred;
|
2003-09-15 02:25:29 +01:00
|
|
|
|
int group1 = TRUE;
|
|
|
|
|
yamop *alt = NULL;
|
2003-10-02 13:59:05 +01:00
|
|
|
|
UInt current_arity = 0;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
LogUpdIndex *icl = NULL;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
|
2003-09-15 20:06:55 +01:00
|
|
|
|
sp = init_block_stack(sp, ipc, ap);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
/* try to refine the interval using the indexing code */
|
|
|
|
|
while (ipc != NULL) {
|
|
|
|
|
op_numbers op = Yap_op_from_opcode(ipc->opc);
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
switch (op) {
|
2006-10-10 15:08:17 +01:00
|
|
|
|
case _try_logical:
|
|
|
|
|
case _retry_logical:
|
|
|
|
|
case _count_retry_logical:
|
|
|
|
|
case _profiled_retry_logical:
|
|
|
|
|
case _trust_logical:
|
|
|
|
|
case _count_trust_logical:
|
|
|
|
|
case _profiled_trust_logical:
|
2006-12-27 01:32:38 +00:00
|
|
|
|
/* ERROR */
|
2006-10-10 15:08:17 +01:00
|
|
|
|
break;
|
|
|
|
|
case _enter_lu_pred:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ipc->y_u.Illss.s++;
|
|
|
|
|
icl = ipc->y_u.Illss.I;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
if (first) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (ap->PredFlags & CountPredFlag)
|
|
|
|
|
ipc->y_u.Illss.l1->opc = Yap_opcode(_count_retry_logical);
|
|
|
|
|
else if (ap->PredFlags & ProfiledPredFlag)
|
|
|
|
|
ipc->y_u.Illss.l1->opc = Yap_opcode(_profiled_retry_logical);
|
|
|
|
|
else
|
|
|
|
|
ipc->y_u.Illss.l1->opc = Yap_opcode(_retry_logical);
|
|
|
|
|
ipc->y_u.Illss.l1 = add_try(ap, cls, ipc->y_u.Illss.l1, cint);
|
2006-10-10 15:08:17 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* just go to next instruction */
|
|
|
|
|
yamop *end = add_trust(icl, cls, cint), *old = ipc->y_u.Illss.l2;
|
|
|
|
|
|
|
|
|
|
/* we used to have two clauses */
|
|
|
|
|
if (ap->PredFlags & CountPredFlag)
|
|
|
|
|
old->opc = Yap_opcode(_count_retry_logical);
|
|
|
|
|
else if (ap->PredFlags & ProfiledPredFlag)
|
|
|
|
|
old->opc = Yap_opcode(_profiled_retry_logical);
|
|
|
|
|
else
|
|
|
|
|
old->opc = Yap_opcode(_retry_logical);
|
|
|
|
|
old->y_u.OtaLl.n = end;
|
|
|
|
|
old->y_u.OtaLl.s = ap->ArityOfPE;
|
|
|
|
|
ipc->y_u.Illss.l2 = end;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
}
|
2009-03-24 01:02:44 +00:00
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
2006-10-10 15:08:17 +01:00
|
|
|
|
break;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _try_clause:
|
|
|
|
|
/* I cannot expand a predicate that starts on a variable,
|
|
|
|
|
have to expand the index.
|
|
|
|
|
*/
|
|
|
|
|
if (first) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
sp = expanda_block(sp, ap, cls, group1, alt, cint);
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* just go to next instruction */
|
|
|
|
|
ipc = NEXTOP(ipc, Otapl);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
break;
|
2004-09-27 21:45:04 +01:00
|
|
|
|
case _try_clause2:
|
|
|
|
|
case _try_clause3:
|
|
|
|
|
case _try_clause4:
|
|
|
|
|
/* I cannot expand a predicate that starts on a variable,
|
|
|
|
|
have to expand the index.
|
|
|
|
|
*/
|
|
|
|
|
if (first) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
sp = expanda_block(sp, ap, cls, group1, alt, cint);
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
2004-09-27 21:45:04 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* just go to next instruction */
|
|
|
|
|
ipc = NEXTOP(ipc, l);
|
2004-09-27 21:45:04 +01:00
|
|
|
|
}
|
|
|
|
|
break;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _retry:
|
|
|
|
|
/* this clause had no indexing */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, Otapl);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
2004-09-27 21:45:04 +01:00
|
|
|
|
case _retry2:
|
|
|
|
|
case _retry3:
|
|
|
|
|
case _retry4:
|
|
|
|
|
/* this clause had no indexing */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, l);
|
2004-09-27 21:45:04 +01:00
|
|
|
|
break;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* instructions type l */
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _retry_me:
|
2003-09-15 02:25:29 +01:00
|
|
|
|
/* should never be reached both for asserta */
|
|
|
|
|
group1 = FALSE;
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ipc = ipc->y_u.Otapl.d;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
|
|
|
|
case _try_me:
|
|
|
|
|
if (first) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, Otapl);
|
|
|
|
|
alt = ipc->y_u.Otapl.d;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = ipc->y_u.Otapl.d;
|
|
|
|
|
group1 = FALSE;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
break;
|
|
|
|
|
case _retry_profiled:
|
|
|
|
|
case _count_retry:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, Otapl);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
|
|
|
|
case _profiled_trust_me:
|
|
|
|
|
case _trust_me:
|
|
|
|
|
case _count_trust_me:
|
2003-09-15 02:25:29 +01:00
|
|
|
|
group1 = FALSE;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, Otapl);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
|
|
|
|
case _trust:
|
2004-02-17 16:27:22 +00:00
|
|
|
|
sp = expandz_block(sp, ap, cls, group1, alt, cint);
|
2009-03-24 01:02:44 +00:00
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
|
|
|
|
case _jump:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
sp = cross_block(sp, &ipc->y_u.l.l, ap, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
/* just skip for now, but should worry about memory management */
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ipc = ipc->y_u.l.l;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
|
|
|
|
case _jump_if_var:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
sp = push_path(sp, &(ipc->y_u.l.l), cls, cint);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, l);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
2003-10-28 01:16:03 +00:00
|
|
|
|
case _jump_if_nonvar:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
sp = push_path(sp, &(ipc->y_u.xll.l2), cls, cint);
|
|
|
|
|
sp = cross_block(sp, &ipc->y_u.xll.l1, ap, cint);
|
|
|
|
|
ipc = ipc->y_u.xll.l1;
|
2003-10-28 01:16:03 +00:00
|
|
|
|
break;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* instructions type EC */
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _try_in:
|
|
|
|
|
/* we are done */
|
|
|
|
|
if (first) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
sp = kill_block(sp, ap);
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, l);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
break;
|
2009-02-12 21:35:31 +00:00
|
|
|
|
case _user_switch:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ipc = ipc->y_u.lp.l;
|
2009-02-12 21:35:31 +00:00
|
|
|
|
break;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* instructions type e */
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _switch_on_type:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
sp = push_path(sp, &(ipc->y_u.llll.l4), cls, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
add_head_info(cls, 1);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
add_info(cls, 1);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
if (IsPairTerm(cls->Tag)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
yamop *nipc = ipc->y_u.llll.l1;
|
|
|
|
|
|
|
|
|
|
current_arity = 2;
|
|
|
|
|
move_next(cls, 1);
|
|
|
|
|
if (nipc == FAILCODE) {
|
|
|
|
|
/* jump straight to clause */
|
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
|
|
|
|
ipc->y_u.llll.l1 = cls->Code;
|
|
|
|
|
} else {
|
|
|
|
|
ipc->y_u.llll.l1 = cls->CurrentCode;
|
|
|
|
|
}
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
|
|
|
|
} else {
|
|
|
|
|
/* go on */
|
|
|
|
|
sp = cross_block(sp, &ipc->y_u.llll.l1, ap, cint);
|
|
|
|
|
ipc = nipc;
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else if (IsAtomOrIntTerm(cls->Tag)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
yamop *nipc = ipc->y_u.llll.l2;
|
|
|
|
|
move_next(cls, 1);
|
|
|
|
|
if (nipc == FAILCODE) {
|
|
|
|
|
/* need to expand the block */
|
|
|
|
|
sp = kill_block(sp, ap);
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
|
|
|
|
} else {
|
|
|
|
|
/* I do not have to worry about crossing a block here */
|
|
|
|
|
ipc = nipc;
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else if (IsApplTerm(cls->Tag)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
yamop *nipc = ipc->y_u.llll.l3;
|
|
|
|
|
if (nipc == FAILCODE) {
|
|
|
|
|
/* need to expand the block */
|
|
|
|
|
sp = kill_block(sp, ap);
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
|
|
|
|
} else {
|
|
|
|
|
/* I do not have to worry about crossing a block here */
|
|
|
|
|
ipc = nipc;
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* we can't separate into four groups,
|
|
|
|
|
need to restart.
|
|
|
|
|
*/
|
|
|
|
|
sp = kill_block(sp, ap);
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
break;
|
|
|
|
|
case _switch_list_nl:
|
2005-06-01 17:42:30 +01:00
|
|
|
|
sp = kill_block(sp, ap);
|
2009-03-24 01:02:44 +00:00
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
|
|
|
|
case _switch_on_arg_type:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
sp = push_path(sp, &(ipc->y_u.xllll.l4), cls, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
add_head_info(cls, Yap_regtoregno(ipc->y_u.xllll.x));
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
add_info(cls, Yap_regtoregno(ipc->y_u.xllll.x));
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
if (IsPairTerm(cls->Tag)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
yamop *nipc = ipc->y_u.xllll.l1;
|
|
|
|
|
|
|
|
|
|
current_arity = 2;
|
|
|
|
|
move_next(cls, Yap_regtoregno(ipc->y_u.xllll.x));
|
|
|
|
|
if (nipc == FAILCODE) {
|
|
|
|
|
/* jump straight to clause */
|
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
|
|
|
|
ipc->y_u.xllll.l1 = cls->Code;
|
|
|
|
|
} else {
|
|
|
|
|
ipc->y_u.xllll.l1 = cls->CurrentCode;
|
|
|
|
|
}
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
|
|
|
|
} else {
|
|
|
|
|
/* go on */
|
|
|
|
|
sp = cross_block(sp, &ipc->y_u.xllll.l1, ap, cint);
|
|
|
|
|
ipc = nipc;
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else if (IsAtomOrIntTerm(cls->Tag)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
yamop *nipc = ipc->y_u.xllll.l2;
|
|
|
|
|
move_next(cls, Yap_regtoregno(ipc->y_u.xllll.x));
|
|
|
|
|
if (nipc == FAILCODE) {
|
|
|
|
|
/* need to expand the block */
|
|
|
|
|
sp = kill_block(sp, ap);
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
|
|
|
|
} else {
|
|
|
|
|
/* I do not have to worry about crossing a block here */
|
|
|
|
|
ipc = nipc;
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else if (IsApplTerm(cls->Tag)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
yamop *nipc = ipc->y_u.xllll.l3;
|
|
|
|
|
move_next(cls, Yap_regtoregno(ipc->y_u.xllll.x));
|
|
|
|
|
if (nipc == FAILCODE) {
|
|
|
|
|
/* need to expand the block */
|
|
|
|
|
sp = kill_block(sp, ap);
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
|
|
|
|
} else {
|
|
|
|
|
/* I do not have to worry about crossing a block here */
|
|
|
|
|
ipc = nipc;
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* we can't separate into four groups,
|
|
|
|
|
need to restart.
|
|
|
|
|
*/
|
|
|
|
|
sp = kill_block(sp, ap);
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
break;
|
|
|
|
|
case _switch_on_sub_arg_type:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
sp = push_path(sp, &(ipc->y_u.sllll.l4), cls, cint);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
add_arg_info(cls, ap, ipc->y_u.sllll.s + 1);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (IsPairTerm(cls->Tag)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
yamop *nipc = ipc->y_u.sllll.l1;
|
|
|
|
|
current_arity = 2;
|
|
|
|
|
skip_to_arg(cls, ap, ipc->y_u.sllll.s, current_arity);
|
|
|
|
|
if (nipc == FAILCODE) {
|
|
|
|
|
/* jump straight to clause */
|
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
|
|
|
|
ipc->y_u.sllll.l1 = cls->Code;
|
|
|
|
|
} else {
|
|
|
|
|
ipc->y_u.sllll.l1 = cls->CurrentCode;
|
|
|
|
|
}
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
|
|
|
|
} else {
|
|
|
|
|
/* go on */
|
|
|
|
|
sp = cross_block(sp, &ipc->y_u.sllll.l1, ap, cint);
|
|
|
|
|
ipc = nipc;
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else if (IsAtomOrIntTerm(cls->Tag)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
yamop *nipc = ipc->y_u.sllll.l2;
|
|
|
|
|
skip_to_arg(cls, ap, ipc->y_u.sllll.s, current_arity);
|
|
|
|
|
if (nipc == FAILCODE) {
|
|
|
|
|
/* need to expand the block */
|
|
|
|
|
sp = kill_block(sp, ap);
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
|
|
|
|
} else {
|
|
|
|
|
/* I do not have to worry about crossing a block here */
|
|
|
|
|
ipc = nipc;
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else if (IsApplTerm(cls->Tag)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
yamop *nipc = ipc->y_u.sllll.l3;
|
|
|
|
|
skip_to_arg(cls, ap, ipc->y_u.sllll.s, current_arity);
|
|
|
|
|
if (nipc == FAILCODE) {
|
|
|
|
|
/* need to expand the block */
|
|
|
|
|
sp = kill_block(sp, ap);
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
|
|
|
|
} else {
|
|
|
|
|
/* I do not have to worry about crossing a block here */
|
|
|
|
|
ipc = nipc;
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* we can't separate into four groups,
|
|
|
|
|
need to restart.
|
|
|
|
|
*/
|
|
|
|
|
sp = kill_block(sp, ap);
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
break;
|
|
|
|
|
case _if_not_then:
|
2009-03-24 01:02:44 +00:00
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* instructions type ollll */
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _switch_on_func:
|
|
|
|
|
case _if_func:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
case _go_on_func: {
|
|
|
|
|
FuncSwiEntry *fe;
|
|
|
|
|
yamop *newpc;
|
|
|
|
|
Functor f = (Functor)RepAppl(cls->Tag);
|
|
|
|
|
|
|
|
|
|
if (op == _switch_on_func) {
|
|
|
|
|
fe = lookup_f_hash(f, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
|
|
|
|
|
} else {
|
|
|
|
|
fe = lookup_f(f, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
|
|
|
|
|
}
|
|
|
|
|
if (!IsExtensionFunctor(f)) {
|
|
|
|
|
current_arity = ArityOfFunctor(f);
|
|
|
|
|
}
|
|
|
|
|
newpc = fe->u_f.labp;
|
|
|
|
|
if (newpc == (yamop *)&(ap->cs.p_code.ExpandCode)) {
|
|
|
|
|
/* we found it */
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
|
|
|
|
} else if (newpc == FAILCODE) {
|
|
|
|
|
/* oops, nothing there */
|
|
|
|
|
if (fe->Tag != f) {
|
|
|
|
|
if (IsExtensionFunctor(f)) {
|
|
|
|
|
sp = kill_unsafe_block(sp, op, ap, first, FALSE, cls);
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
|
|
|
|
break;
|
|
|
|
|
}
|
|
|
|
|
if (table_fe_overflow(ipc, f)) {
|
|
|
|
|
fe = expand_ftable(ipc, current_block(sp), cint, f);
|
|
|
|
|
}
|
|
|
|
|
fe->Tag = f;
|
|
|
|
|
ipc->y_u.sssl.e++;
|
|
|
|
|
}
|
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
|
|
|
|
fe->u_f.labp = cls->Code;
|
|
|
|
|
} else {
|
|
|
|
|
fe->u_f.labp = cls->CurrentCode;
|
|
|
|
|
}
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
|
|
|
|
} else {
|
|
|
|
|
yamop *newpc = fe->u_f.labp;
|
|
|
|
|
sp = fetch_new_block(sp, &(ipc->y_u.sssl.l), ap, cint);
|
|
|
|
|
sp = cross_block(sp, &(fe->u_f.labp), ap, cint);
|
|
|
|
|
ipc = newpc;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
} break;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _index_dbref:
|
2014-02-18 09:44:01 +00:00
|
|
|
|
cls->Tag = cls->ucd.t_ptr;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, e);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
|
|
|
|
case _index_blob:
|
2014-02-18 09:44:01 +00:00
|
|
|
|
cls->Tag = Yap_Double_key(cls->ucd.t_ptr);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, e);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
2009-02-09 21:56:40 +00:00
|
|
|
|
case _index_long:
|
2014-02-18 09:44:01 +00:00
|
|
|
|
cls->Tag = Yap_Int_key(cls->ucd.t_ptr);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, e);
|
2009-02-09 21:56:40 +00:00
|
|
|
|
break;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _switch_on_cons:
|
|
|
|
|
case _if_cons:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
case _go_on_cons: {
|
|
|
|
|
AtomSwiEntry *ae;
|
|
|
|
|
yamop *newpc;
|
|
|
|
|
Term at = cls->Tag;
|
|
|
|
|
|
|
|
|
|
if (op == _switch_on_cons) {
|
|
|
|
|
ae = lookup_c_hash(at, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
|
|
|
|
|
} else {
|
|
|
|
|
ae = lookup_c(at, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
|
|
|
|
|
}
|
|
|
|
|
newpc = ae->u_a.labp;
|
|
|
|
|
|
|
|
|
|
if (newpc == (yamop *)&(ap->cs.p_code.ExpandCode)) {
|
|
|
|
|
/* nothing more to do */
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
|
|
|
|
} else if (newpc == FAILCODE) {
|
|
|
|
|
/* oops, nothing there */
|
|
|
|
|
if (ae->Tag != at) {
|
|
|
|
|
if (table_ae_overflow(ipc, at)) {
|
|
|
|
|
ae = expand_ctable(ipc, current_block(sp), cint, at);
|
|
|
|
|
}
|
|
|
|
|
ae->Tag = at;
|
|
|
|
|
ipc->y_u.sssl.e++;
|
|
|
|
|
}
|
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
|
|
|
|
ae->u_a.labp = cls->Code;
|
|
|
|
|
} else {
|
|
|
|
|
ae->u_a.labp = cls->CurrentCode;
|
|
|
|
|
}
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
|
|
|
|
} else {
|
|
|
|
|
yamop *newpc = ae->u_a.labp;
|
|
|
|
|
|
|
|
|
|
sp = fetch_new_block(sp, &(ipc->y_u.sssl.l), ap, cint);
|
|
|
|
|
sp = cross_block(sp, &(ae->u_a.labp), ap, cint);
|
|
|
|
|
ipc = newpc;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
} break;
|
2004-03-31 02:02:18 +01:00
|
|
|
|
case _expand_clauses:
|
2009-03-24 01:02:44 +00:00
|
|
|
|
ipc = add_to_expand_clauses(&sp, ipc, cls, ap, first, cint);
|
2004-03-31 02:02:18 +01:00
|
|
|
|
break;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _expand_index:
|
2009-03-24 01:02:44 +00:00
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
2004-02-05 16:57:02 +00:00
|
|
|
|
case _lock_lu:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, p);
|
2004-02-05 16:57:02 +00:00
|
|
|
|
break;
|
2004-04-20 23:08:57 +01:00
|
|
|
|
case _op_fail:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
while ((--sp)->flag != block_entry)
|
|
|
|
|
;
|
2014-02-18 09:44:01 +00:00
|
|
|
|
*sp->uip.cle.entry_code = cls->Code;
|
2009-03-24 01:02:44 +00:00
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
2004-04-20 23:08:57 +01:00
|
|
|
|
break;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
default:
|
2004-03-31 02:02:18 +01:00
|
|
|
|
sp = kill_unsafe_block(sp, op, ap, first, FALSE, cls);
|
2009-03-24 01:02:44 +00:00
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
void Yap_AddClauseToIndex(PredEntry *ap, yamop *beg, int first) {
|
2011-03-07 16:02:55 +00:00
|
|
|
|
CACHE_REGS
|
2003-08-27 14:30:50 +01:00
|
|
|
|
ClauseDef cl;
|
|
|
|
|
/* first clause */
|
|
|
|
|
path_stack_entry *stack, *sp;
|
|
|
|
|
int cb;
|
2004-01-23 02:23:51 +00:00
|
|
|
|
struct intermediates cint;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
|
2003-09-25 00:53:48 +01:00
|
|
|
|
if (!(ap->PredFlags & LogUpdatePredFlag)) {
|
2003-10-14 19:37:56 +01:00
|
|
|
|
if (ap->PredFlags & IndexedPredFlag)
|
|
|
|
|
Yap_RemoveIndexation(ap);
|
2003-09-25 00:53:48 +01:00
|
|
|
|
return;
|
|
|
|
|
}
|
2004-01-23 02:23:51 +00:00
|
|
|
|
cint.CurrentPred = ap;
|
2004-04-14 20:10:40 +01:00
|
|
|
|
cint.expand_block = NULL;
|
2004-04-29 04:44:04 +01:00
|
|
|
|
cint.CodeStart = cint.BlobsStart = cint.cpc = cint.icpc = NIL;
|
2012-05-28 20:40:12 +01:00
|
|
|
|
cint.term_depth = cint.last_index_new_depth = cint.last_depth_size = 0L;
|
2010-12-16 01:22:10 +00:00
|
|
|
|
if ((cb = sigsetjmp(cint.CompilerBotch, 0)) == 3) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
restore_machine_regs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_gcl(LOCAL_Error_Size, ap->ArityOfPE, ENV, CP);
|
2004-10-22 17:53:20 +01:00
|
|
|
|
save_machine_regs();
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else if (cb == 2) {
|
|
|
|
|
restore_machine_regs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_growheap(FALSE, LOCAL_Error_Size, NULL);
|
2004-10-22 17:53:20 +01:00
|
|
|
|
save_machine_regs();
|
2004-02-05 16:57:02 +00:00
|
|
|
|
} else if (cb == 4) {
|
|
|
|
|
restore_machine_regs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_growtrail(LOCAL_Error_Size, FALSE);
|
2004-10-22 17:53:20 +01:00
|
|
|
|
save_machine_regs();
|
|
|
|
|
}
|
|
|
|
|
if (cb) {
|
|
|
|
|
Yap_RemoveIndexation(ap);
|
|
|
|
|
return;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2011-05-23 16:19:47 +01:00
|
|
|
|
LOCAL_Error_Size = 0;
|
|
|
|
|
LOCAL_ErrorMessage = NULL;
|
2013-11-15 18:25:33 +00:00
|
|
|
|
#if DEBUG
|
2011-05-25 16:40:36 +01:00
|
|
|
|
if (GLOBAL_Option['i' - 'a' + 1]) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_DebugPutc(stderr, '+');
|
|
|
|
|
Yap_DebugWriteIndicator(ap);
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
#endif
|
|
|
|
|
stack = (path_stack_entry *)TR;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl.Code = cl.CurrentCode = beg;
|
2004-09-14 04:30:06 +01:00
|
|
|
|
sp = push_path(stack, NULL, &cl, &cint);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
add_to_index(&cint, first, sp, &cl);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void contract_ftable(yamop *ipc, ClauseUnion *blk, PredEntry *ap,
|
|
|
|
|
Functor f) {
|
2014-05-30 01:06:09 +01:00
|
|
|
|
int n = ipc->y_u.sssl.s;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
FuncSwiEntry *fep;
|
|
|
|
|
|
|
|
|
|
if (n > MIN_HASH_ENTRIES) {
|
2014-05-30 01:06:09 +01:00
|
|
|
|
fep = lookup_f_hash(f, ipc->y_u.sssl.l, n);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2014-05-30 01:06:09 +01:00
|
|
|
|
fep = (FuncSwiEntry *)(ipc->y_u.sssl.l);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
while (fep->Tag != f)
|
|
|
|
|
fep++;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2014-02-18 09:44:01 +00:00
|
|
|
|
fep->u_f.labp = FAILCODE;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void contract_ctable(yamop *ipc, ClauseUnion *blk, PredEntry *ap,
|
|
|
|
|
Term at) {
|
2014-05-30 01:06:09 +01:00
|
|
|
|
int n = ipc->y_u.sssl.s;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
AtomSwiEntry *cep;
|
|
|
|
|
|
|
|
|
|
if (n > MIN_HASH_ENTRIES) {
|
2014-05-30 01:06:09 +01:00
|
|
|
|
cep = lookup_c_hash(at, ipc->y_u.sssl.l, n);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2014-05-30 01:06:09 +01:00
|
|
|
|
cep = (AtomSwiEntry *)(ipc->y_u.sssl.l);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
while (cep->Tag != at)
|
|
|
|
|
cep++;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2014-02-18 09:44:01 +00:00
|
|
|
|
cep->u_a.labp = FAILCODE;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void remove_from_index(PredEntry *ap, path_stack_entry *sp,
|
|
|
|
|
ClauseDef *cls, yamop *bg, yamop *lt,
|
|
|
|
|
struct intermediates *cint) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
/* last clause to experiment with */
|
|
|
|
|
yamop *ipc = ap->cs.p_code.TrueCodeOfPred;
|
|
|
|
|
|
2003-10-14 01:53:10 +01:00
|
|
|
|
if (ap->cs.p_code.NOfClauses == 1) {
|
|
|
|
|
if (ap->PredFlags & IndexedPredFlag) {
|
|
|
|
|
Yap_RemoveIndexation(ap);
|
|
|
|
|
return;
|
|
|
|
|
}
|
|
|
|
|
ap->cs.p_code.TrueCodeOfPred = ap->cs.p_code.FirstClause;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (ap->PredFlags & (SpiedPredFlag | CountPredFlag | ProfiledPredFlag)) {
|
2003-10-14 01:53:10 +01:00
|
|
|
|
ap->OpcodeOfPred = Yap_opcode(_spy_pred);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
|
2007-11-26 23:43:10 +00:00
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
|
|
|
|
} else if (ap->PredFlags & LogUpdatePredFlag &&
|
2016-07-31 10:26:15 +01:00
|
|
|
|
!(ap->PredFlags & ThreadLocalPredFlag) &&
|
|
|
|
|
ap->ModuleOfPred != IDB_MODULE) {
|
2007-11-26 23:43:10 +00:00
|
|
|
|
ap->cs.p_code.TrueCodeOfPred = FAILCODE;
|
|
|
|
|
ap->OpcodeOfPred = LOCKPRED_OPCODE;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
|
2007-11-26 23:43:10 +00:00
|
|
|
|
#endif
|
2003-10-14 01:53:10 +01:00
|
|
|
|
} else {
|
|
|
|
|
ap->OpcodeOfPred = ap->cs.p_code.FirstClause->opc;
|
|
|
|
|
ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred;
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
return;
|
|
|
|
|
}
|
2008-01-23 17:57:56 +00:00
|
|
|
|
sp = init_block_stack(sp, ipc, ap);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
/* try to refine the interval using the indexing code */
|
|
|
|
|
while (ipc != NULL) {
|
|
|
|
|
op_numbers op = Yap_op_from_opcode(ipc->opc);
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
switch (op) {
|
2003-09-15 02:25:29 +01:00
|
|
|
|
case _retry_profiled:
|
|
|
|
|
case _count_retry:
|
|
|
|
|
ipc = NEXTOP(ipc, p);
|
|
|
|
|
break;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _try_in:
|
2003-10-28 01:16:03 +00:00
|
|
|
|
/* I cannot expand a predicate that starts on a variable,
|
|
|
|
|
have to expand the index.
|
|
|
|
|
*/
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (IN_BETWEEN(bg, ipc->y_u.l.l, lt)) {
|
|
|
|
|
sp = kill_clause(ipc, bg, lt, sp, ap);
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
2003-10-28 01:16:03 +00:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* just go to next instruction */
|
|
|
|
|
ipc = NEXTOP(ipc, l);
|
2003-10-28 01:16:03 +00:00
|
|
|
|
}
|
|
|
|
|
break;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _try_clause:
|
|
|
|
|
case _retry:
|
|
|
|
|
/* I cannot expand a predicate that starts on a variable,
|
|
|
|
|
have to expand the index.
|
|
|
|
|
*/
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (IN_BETWEEN(bg, ipc->y_u.Otapl.d, lt)) {
|
|
|
|
|
sp = kill_clause(ipc, bg, lt, sp, ap);
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* just go to next instruction */
|
|
|
|
|
ipc = NEXTOP(ipc, Otapl);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
break;
|
2004-09-27 21:45:04 +01:00
|
|
|
|
case _try_clause2:
|
|
|
|
|
case _try_clause3:
|
|
|
|
|
case _try_clause4:
|
|
|
|
|
case _retry2:
|
|
|
|
|
case _retry3:
|
|
|
|
|
case _retry4:
|
|
|
|
|
/* I cannot expand a predicate that starts on a variable,
|
|
|
|
|
have to expand the index.
|
|
|
|
|
*/
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (IN_BETWEEN(bg, ipc->y_u.l.l, lt)) {
|
|
|
|
|
sp = kill_clause(ipc, bg, lt, sp, ap);
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
2004-09-27 21:45:04 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* just go to next instruction */
|
|
|
|
|
ipc = NEXTOP(ipc, l);
|
2004-09-27 21:45:04 +01:00
|
|
|
|
}
|
|
|
|
|
break;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _trust:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (IN_BETWEEN(bg, ipc->y_u.Otapl.d, lt)) {
|
|
|
|
|
sp = kill_clause(ipc, bg, lt, sp, ap);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2009-03-24 01:02:44 +00:00
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
2003-09-15 02:25:29 +01:00
|
|
|
|
case _enter_lu_pred:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ipc->y_u.Illss.s--;
|
|
|
|
|
ipc->y_u.Illss.e++;
|
2013-11-15 18:25:33 +00:00
|
|
|
|
#if DEBUG
|
2006-10-11 15:53:57 +01:00
|
|
|
|
Yap_DirtyCps++;
|
|
|
|
|
Yap_LiveCps--;
|
|
|
|
|
#endif
|
2004-03-19 11:35:42 +00:00
|
|
|
|
sp = kill_clause(ipc, bg, lt, sp, ap);
|
2009-03-24 01:02:44 +00:00
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* instructions type l */
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _try_me:
|
|
|
|
|
case _retry_me:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
sp = push_path(sp, &(ipc->y_u.Otapl.d), cls, cint);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, Otapl);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
|
|
|
|
case _profiled_trust_me:
|
|
|
|
|
case _trust_me:
|
|
|
|
|
case _count_trust_me:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, Otapl);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
|
|
|
|
case _jump:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
sp = cross_block(sp, &ipc->y_u.l.l, ap, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
/* just skip for now, but should worry about memory management */
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ipc = ipc->y_u.l.l;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
|
|
|
|
case _jump_if_var:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
sp = push_path(sp, &(ipc->y_u.l.l), cls, cint);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, l);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
2003-10-28 01:16:03 +00:00
|
|
|
|
case _jump_if_nonvar:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
sp = push_path(sp, &(ipc->y_u.xll.l2), cls, cint);
|
|
|
|
|
sp = cross_block(sp, &ipc->y_u.xll.l1, ap, cint);
|
|
|
|
|
ipc = ipc->y_u.xll.l1;
|
2003-10-28 01:16:03 +00:00
|
|
|
|
break;
|
2009-02-12 21:35:31 +00:00
|
|
|
|
case _user_switch:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ipc = ipc->y_u.lp.l;
|
2009-02-12 21:35:31 +00:00
|
|
|
|
break;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* instructions type e */
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _switch_on_type:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
sp = push_path(sp, &(ipc->y_u.llll.l4), cls, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
add_head_info(cls, 1);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
add_info(cls, 1);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
if (IsPairTerm(cls->Tag)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
yamop *nipc = ipc->y_u.llll.l1;
|
|
|
|
|
if (IN_BETWEEN(bg, nipc, lt)) {
|
|
|
|
|
/* jump straight to clause */
|
|
|
|
|
ipc->y_u.llll.l1 = FAILCODE;
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
|
|
|
|
} else {
|
|
|
|
|
/* go on */
|
|
|
|
|
sp = cross_block(sp, &ipc->y_u.llll.l1, ap, cint);
|
|
|
|
|
ipc = nipc;
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else if (IsAtomOrIntTerm(cls->Tag)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
yamop *nipc = ipc->y_u.llll.l2;
|
|
|
|
|
if (IN_BETWEEN(bg, nipc, lt)) {
|
|
|
|
|
/* jump straight to clause */
|
|
|
|
|
ipc->y_u.llll.l2 = FAILCODE;
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
|
|
|
|
} else {
|
|
|
|
|
/* I do not have to worry about crossing a block here */
|
|
|
|
|
ipc = nipc;
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else if (IsApplTerm(cls->Tag)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
yamop *nipc = ipc->y_u.llll.l3;
|
|
|
|
|
if (IN_BETWEEN(bg, nipc, lt)) {
|
|
|
|
|
/* jump straight to clause */
|
|
|
|
|
ipc->y_u.llll.l3 = FAILCODE;
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
|
|
|
|
} else {
|
|
|
|
|
/* I do not have to worry about crossing a block here */
|
|
|
|
|
ipc = nipc;
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* we can't separate into four groups,
|
|
|
|
|
need to restart.
|
|
|
|
|
*/
|
|
|
|
|
sp = kill_block(sp, ap);
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
break;
|
|
|
|
|
case _switch_list_nl:
|
2005-06-01 17:42:30 +01:00
|
|
|
|
sp = kill_block(sp, ap);
|
2009-03-24 01:02:44 +00:00
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
|
|
|
|
case _switch_on_arg_type:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
sp = push_path(sp, &(ipc->y_u.xllll.l4), cls, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
add_head_info(cls, Yap_regtoregno(ipc->y_u.xllll.x));
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
add_info(cls, Yap_regtoregno(ipc->y_u.xllll.x));
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
if (IsPairTerm(cls->Tag)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
yamop *nipc = ipc->y_u.xllll.l1;
|
|
|
|
|
if (IN_BETWEEN(bg, nipc, lt)) {
|
|
|
|
|
/* jump straight to clause */
|
|
|
|
|
ipc->y_u.xllll.l1 = FAILCODE;
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
|
|
|
|
} else {
|
|
|
|
|
/* go on */
|
|
|
|
|
sp = cross_block(sp, &ipc->y_u.xllll.l1, ap, cint);
|
|
|
|
|
ipc = nipc;
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else if (IsAtomOrIntTerm(cls->Tag)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
yamop *nipc = ipc->y_u.xllll.l2;
|
|
|
|
|
if (IN_BETWEEN(bg, nipc, lt)) {
|
|
|
|
|
/* jump straight to clause */
|
|
|
|
|
ipc->y_u.xllll.l2 = FAILCODE;
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
|
|
|
|
} else {
|
|
|
|
|
/* I do not have to worry about crossing a block here */
|
|
|
|
|
ipc = nipc;
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else if (IsApplTerm(cls->Tag)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
yamop *nipc = ipc->y_u.xllll.l3;
|
|
|
|
|
if (IN_BETWEEN(bg, nipc, lt)) {
|
|
|
|
|
/* jump straight to clause */
|
|
|
|
|
ipc->y_u.xllll.l3 = FAILCODE;
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
|
|
|
|
} else {
|
|
|
|
|
/* I do not have to worry about crossing a block here */
|
|
|
|
|
ipc = nipc;
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* we can't separate into four groups,
|
|
|
|
|
need to restart.
|
|
|
|
|
*/
|
|
|
|
|
sp = kill_block(sp, ap);
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
break;
|
|
|
|
|
case _switch_on_sub_arg_type:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
sp = push_path(sp, &(ipc->y_u.sllll.l4), cls, cint);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
add_arg_info(cls, ap, ipc->y_u.sllll.s + 1);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (IsPairTerm(cls->Tag)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
yamop *nipc = ipc->y_u.sllll.l1;
|
|
|
|
|
if (IN_BETWEEN(bg, nipc, lt)) {
|
|
|
|
|
/* jump straight to clause */
|
|
|
|
|
ipc->y_u.sllll.l1 = FAILCODE;
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
|
|
|
|
} else {
|
|
|
|
|
/* go on */
|
|
|
|
|
sp = cross_block(sp, &ipc->y_u.sllll.l1, ap, cint);
|
|
|
|
|
ipc = nipc;
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else if (IsAtomOrIntTerm(cls->Tag)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
yamop *nipc = ipc->y_u.sllll.l2;
|
|
|
|
|
if (IN_BETWEEN(bg, nipc, lt)) {
|
|
|
|
|
/* jump straight to clause */
|
|
|
|
|
ipc->y_u.sllll.l2 = FAILCODE;
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
|
|
|
|
} else {
|
|
|
|
|
/* I do not have to worry about crossing a block here */
|
|
|
|
|
ipc = nipc;
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else if (IsApplTerm(cls->Tag)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
yamop *nipc = ipc->y_u.sllll.l3;
|
|
|
|
|
if (IN_BETWEEN(bg, nipc, lt)) {
|
|
|
|
|
/* jump straight to clause */
|
|
|
|
|
ipc->y_u.sllll.l3 = FAILCODE;
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
|
|
|
|
} else {
|
|
|
|
|
/* I do not have to worry about crossing a block here */
|
|
|
|
|
ipc = nipc;
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* we can't separate into four groups,
|
|
|
|
|
need to restart.
|
|
|
|
|
*/
|
|
|
|
|
sp = kill_block(sp, ap);
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
break;
|
|
|
|
|
case _if_not_then:
|
2009-03-24 01:02:44 +00:00
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* instructions type ollll */
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _switch_on_func:
|
|
|
|
|
case _if_func:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
case _go_on_func: {
|
|
|
|
|
FuncSwiEntry *fe;
|
|
|
|
|
yamop *newpc;
|
|
|
|
|
Functor f = (Functor)RepAppl(cls->Tag);
|
|
|
|
|
|
|
|
|
|
if (op == _switch_on_func) {
|
|
|
|
|
fe = lookup_f_hash(f, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
|
|
|
|
|
} else {
|
|
|
|
|
fe = lookup_f(f, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
|
|
|
|
|
}
|
|
|
|
|
newpc = fe->u_f.labp;
|
|
|
|
|
|
|
|
|
|
if (newpc == (yamop *)&(ap->cs.p_code.ExpandCode)) {
|
|
|
|
|
/* we found it */
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
|
|
|
|
} else if (newpc == FAILCODE) {
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
|
|
|
|
} else if (IN_BETWEEN(bg, fe->u_f.Label, lt)) {
|
|
|
|
|
/* oops, nothing there */
|
|
|
|
|
contract_ftable(ipc, current_block(sp), ap, f);
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
|
|
|
|
} else {
|
|
|
|
|
yamop *newpc = fe->u_f.labp;
|
|
|
|
|
sp = fetch_new_block(sp, &(ipc->y_u.sssl.l), ap, cint);
|
|
|
|
|
sp = cross_block(sp, &(fe->u_f.labp), ap, cint);
|
|
|
|
|
ipc = newpc;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
} break;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _index_dbref:
|
2014-02-18 09:44:01 +00:00
|
|
|
|
cls->Tag = cls->ucd.t_ptr;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, e);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
|
|
|
|
case _index_blob:
|
2014-02-18 09:44:01 +00:00
|
|
|
|
cls->Tag = Yap_Double_key(cls->ucd.t_ptr);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, e);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
2009-02-09 21:56:40 +00:00
|
|
|
|
case _index_long:
|
2014-02-18 09:44:01 +00:00
|
|
|
|
cls->Tag = Yap_Int_key(cls->ucd.t_ptr);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, e);
|
2009-02-09 21:56:40 +00:00
|
|
|
|
break;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _switch_on_cons:
|
|
|
|
|
case _if_cons:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
case _go_on_cons: {
|
|
|
|
|
AtomSwiEntry *ae;
|
|
|
|
|
yamop *newpc;
|
|
|
|
|
Term at = cls->Tag;
|
|
|
|
|
|
|
|
|
|
if (op == _switch_on_cons) {
|
|
|
|
|
ae = lookup_c_hash(at, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
|
|
|
|
|
} else {
|
|
|
|
|
ae = lookup_c(at, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
|
|
|
|
|
}
|
|
|
|
|
newpc = ae->u_a.labp;
|
|
|
|
|
|
|
|
|
|
if (newpc == (yamop *)&(ap->cs.p_code.ExpandCode)) {
|
|
|
|
|
/* we found it */
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
|
|
|
|
} else if (newpc == FAILCODE) {
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
|
|
|
|
} else if (IN_BETWEEN(bg, ae->u_a.Label, lt)) {
|
|
|
|
|
/* oops, nothing there */
|
|
|
|
|
contract_ctable(ipc, current_block(sp), ap, at);
|
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
|
|
|
|
} else {
|
|
|
|
|
yamop *newpc = ae->u_a.labp;
|
|
|
|
|
|
|
|
|
|
sp = fetch_new_block(sp, &(ipc->y_u.sssl.l), ap, cint);
|
|
|
|
|
sp = cross_block(sp, &(ae->u_a.labp), ap, cint);
|
|
|
|
|
ipc = newpc;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
} break;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _expand_index:
|
2009-03-24 01:02:44 +00:00
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
2004-03-31 02:02:18 +01:00
|
|
|
|
case _expand_clauses:
|
|
|
|
|
nullify_expand_clause(ipc, sp, cls);
|
2009-03-24 01:02:44 +00:00
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
2004-03-31 02:02:18 +01:00
|
|
|
|
break;
|
2004-02-05 16:57:02 +00:00
|
|
|
|
case _lock_lu:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, p);
|
2004-02-05 16:57:02 +00:00
|
|
|
|
break;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
default:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (IN_BETWEEN(bg, ipc, lt)) {
|
|
|
|
|
sp = kill_unsafe_block(sp, op, ap, TRUE, TRUE, cls);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2009-03-24 01:02:44 +00:00
|
|
|
|
ipc = pop_path(&sp, cls, ap, cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2004-02-19 19:24:46 +00:00
|
|
|
|
/* clause is locked */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
void Yap_RemoveClauseFromIndex(PredEntry *ap, yamop *beg) {
|
2011-03-07 16:02:55 +00:00
|
|
|
|
CACHE_REGS
|
2003-08-27 14:30:50 +01:00
|
|
|
|
ClauseDef cl;
|
|
|
|
|
/* first clause */
|
|
|
|
|
path_stack_entry *stack, *sp;
|
|
|
|
|
int cb;
|
|
|
|
|
yamop *last;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
struct intermediates cint;
|
2004-09-27 21:45:04 +01:00
|
|
|
|
|
|
|
|
|
if (ap->PredFlags & MegaClausePredFlag) {
|
|
|
|
|
return;
|
|
|
|
|
}
|
2004-04-14 20:10:40 +01:00
|
|
|
|
cint.expand_block = NULL;
|
2004-09-27 21:45:04 +01:00
|
|
|
|
cint.CodeStart = cint.BlobsStart = cint.cpc = cint.icpc = NULL;
|
2010-12-16 01:22:10 +00:00
|
|
|
|
if ((cb = sigsetjmp(cint.CompilerBotch, 0)) == 3) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
restore_machine_regs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_gcl(LOCAL_Error_Size, ap->ArityOfPE, ENV, CP);
|
2004-10-22 17:53:20 +01:00
|
|
|
|
save_machine_regs();
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else if (cb == 2) {
|
|
|
|
|
restore_machine_regs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_growheap(FALSE, LOCAL_Error_Size, NULL);
|
2004-10-22 17:53:20 +01:00
|
|
|
|
save_machine_regs();
|
2004-02-05 16:57:02 +00:00
|
|
|
|
} else if (cb == 4) {
|
|
|
|
|
restore_machine_regs();
|
2011-05-23 16:19:47 +01:00
|
|
|
|
Yap_growtrail(LOCAL_Error_Size, FALSE);
|
2004-10-22 17:53:20 +01:00
|
|
|
|
save_machine_regs();
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2011-05-23 16:19:47 +01:00
|
|
|
|
LOCAL_Error_Size = 0;
|
|
|
|
|
LOCAL_ErrorMessage = NULL;
|
2012-05-28 20:40:12 +01:00
|
|
|
|
cint.term_depth = cint.last_index_new_depth = cint.last_depth_size = 0L;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (cb || (ap->cs.p_code.NOfClauses == 2 &&
|
|
|
|
|
ap->PredFlags & IndexedPredFlag)) {
|
2004-10-22 17:53:20 +01:00
|
|
|
|
/* cannot rely on the code */
|
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_kill_iblock(
|
|
|
|
|
(ClauseUnion *)ClauseCodeToLogUpdIndex(ap->cs.p_code.TrueCodeOfPred),
|
|
|
|
|
NULL, ap);
|
2004-10-22 17:53:20 +01:00
|
|
|
|
} else {
|
|
|
|
|
StaticIndex *cl;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ap->PredFlags &= ~LogUpdatePredFlag;
|
2004-10-22 17:53:20 +01:00
|
|
|
|
cl = ClauseCodeToStaticIndex(ap->cs.p_code.TrueCodeOfPred);
|
|
|
|
|
Yap_kill_iblock((ClauseUnion *)cl, NULL, ap);
|
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ap->PredFlags &= ~IndexedPredFlag;
|
2004-10-22 17:53:20 +01:00
|
|
|
|
return;
|
|
|
|
|
}
|
2013-11-15 18:25:33 +00:00
|
|
|
|
#if DEBUG
|
2011-05-25 16:40:36 +01:00
|
|
|
|
if (GLOBAL_Option['i' - 'a' + 1]) {
|
2004-02-12 12:37:12 +00:00
|
|
|
|
Term tmod = ap->ModuleOfPred;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (!tmod)
|
|
|
|
|
tmod = TermProlog;
|
|
|
|
|
Yap_DebugPutc(stderr, '-');
|
|
|
|
|
Yap_DebugPutc(stderr, '\t');
|
2009-05-22 19:23:51 +01:00
|
|
|
|
Yap_DebugPlWrite(tmod);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_DebugPutc(stderr, ':');
|
2004-02-12 12:37:12 +00:00
|
|
|
|
if (ap->ModuleOfPred != IDB_MODULE) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (ap->ArityOfPE == 0) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Atom At = (Atom)ap->FunctorOfPred;
|
|
|
|
|
Yap_DebugPlWrite(MkAtomTerm(At));
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Functor f = ap->FunctorOfPred;
|
|
|
|
|
Atom At = NameOfFunctor(f);
|
|
|
|
|
Yap_DebugPlWrite(MkAtomTerm(At));
|
|
|
|
|
Yap_DebugPutc(stderr, '/');
|
|
|
|
|
Yap_DebugPlWrite(MkIntegerTerm(ArityOfFunctor(f)));
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2003-10-14 01:53:10 +01:00
|
|
|
|
} else {
|
|
|
|
|
if (ap->PredFlags & NumberDBPredFlag) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Int id = ap->src.IndxId;
|
|
|
|
|
Yap_DebugPlWrite(MkIntegerTerm(id));
|
2003-10-14 01:53:10 +01:00
|
|
|
|
} else if (ap->PredFlags & AtomDBPredFlag) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Atom At = (Atom)ap->FunctorOfPred;
|
|
|
|
|
Yap_DebugPlWrite(MkAtomTerm(At));
|
2003-10-14 01:53:10 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Functor f = ap->FunctorOfPred;
|
|
|
|
|
Atom At = NameOfFunctor(f);
|
|
|
|
|
Yap_DebugPlWrite(MkAtomTerm(At));
|
|
|
|
|
Yap_DebugPutc(stderr, '/');
|
|
|
|
|
Yap_DebugPlWrite(MkIntegerTerm(ArityOfFunctor(f)));
|
2003-10-14 01:53:10 +01:00
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Yap_DebugPutc(stderr, '\n');
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
#endif
|
|
|
|
|
stack = (path_stack_entry *)TR;
|
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag) {
|
|
|
|
|
LogUpdClause *c = ClauseCodeToLogUpdClause(beg);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl.Code = cl.CurrentCode = beg;
|
|
|
|
|
last = (yamop *)((CODEADDR)c + c->ClSize);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
|
|
|
|
StaticClause *c = ClauseCodeToStaticClause(beg);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
cl.Code = cl.CurrentCode = beg;
|
|
|
|
|
last = (yamop *)((CODEADDR)c + c->ClSize);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2004-09-14 04:30:06 +01:00
|
|
|
|
sp = push_path(stack, NULL, &cl, &cint);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (ap->cs.p_code.NOfClauses == 0) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* there was no indexing code */
|
2007-11-26 23:43:10 +00:00
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag && ap->ModuleOfPred != IDB_MODULE) {
|
2007-11-26 23:43:10 +00:00
|
|
|
|
ap->cs.p_code.TrueCodeOfPred = FAILCODE;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
|
2007-11-26 23:43:10 +00:00
|
|
|
|
} else {
|
|
|
|
|
#endif
|
|
|
|
|
ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred = FAILCODE;
|
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
|
|
|
|
}
|
|
|
|
|
#endif
|
2008-01-23 17:57:56 +00:00
|
|
|
|
ap->OpcodeOfPred = Yap_opcode(_op_fail);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
} else if (ap->PredFlags & IndexedPredFlag) {
|
|
|
|
|
remove_from_index(ap, sp, &cl, beg, last, &cint);
|
|
|
|
|
} else if (ap->cs.p_code.NOfClauses == 1) {
|
2012-10-23 18:22:16 +01:00
|
|
|
|
ap->cs.p_code.TrueCodeOfPred = ap->cs.p_code.FirstClause;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ap->CodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void store_clause_choice_point(Term t1, Term tb, Term tr, yamop *ipc,
|
|
|
|
|
PredEntry *pe, yamop *ap_pc,
|
|
|
|
|
yamop *cp_pc USES_REGS) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
Term tpc = MkIntegerTerm((Int)ipc);
|
|
|
|
|
Term tpe = MkIntegerTerm((Int)pe);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
CELL *tsp = ASP - 5;
|
|
|
|
|
choiceptr bptr = ((choiceptr)tsp) - 1;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
|
|
|
|
|
tsp[0] = tpe;
|
|
|
|
|
tsp[1] = tpc;
|
|
|
|
|
tsp[2] = t1;
|
|
|
|
|
tsp[3] = tb;
|
|
|
|
|
tsp[4] = tr;
|
|
|
|
|
bptr->cp_tr = TR;
|
2014-01-19 21:15:05 +00:00
|
|
|
|
HB = bptr->cp_h = HR;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
#ifdef DEPTH_LIMIT
|
|
|
|
|
bptr->cp_depth = DEPTH;
|
|
|
|
|
#endif
|
|
|
|
|
bptr->cp_b = B;
|
|
|
|
|
bptr->cp_cp = cp_pc;
|
|
|
|
|
bptr->cp_ap = ap_pc;
|
|
|
|
|
bptr->cp_env = ENV;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
/* now, install the new YREG */
|
2003-08-27 14:30:50 +01:00
|
|
|
|
ASP = (CELL *)bptr;
|
|
|
|
|
ASP[E_CB] = (CELL)bptr;
|
|
|
|
|
B = bptr;
|
|
|
|
|
#ifdef YAPOR
|
|
|
|
|
SCH_set_load(B);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
#endif /* YAPOR */
|
2003-08-27 14:30:50 +01:00
|
|
|
|
SET_BB(bptr);
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static void update_clause_choice_point(yamop *ipc, yamop *ap_pc USES_REGS) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
Term tpc = MkIntegerTerm((Int)ipc);
|
|
|
|
|
B->cp_args[1] = tpc;
|
2014-01-19 21:15:05 +00:00
|
|
|
|
B->cp_h = HR;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
B->cp_ap = ap_pc;
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
static LogUpdClause *to_clause(yamop *ipc, PredEntry *ap) {
|
2003-12-01 19:22:01 +00:00
|
|
|
|
if (ap->PredFlags & LogUpdatePredFlag)
|
2008-05-11 00:24:13 +01:00
|
|
|
|
return lu_clause(ipc, ap);
|
2004-09-27 21:45:04 +01:00
|
|
|
|
else if (ap->PredFlags & MegaClausePredFlag)
|
|
|
|
|
return (LogUpdClause *)ipc;
|
2003-12-01 19:22:01 +00:00
|
|
|
|
else
|
2008-05-11 00:24:13 +01:00
|
|
|
|
return (LogUpdClause *)simple_static_clause(ipc, ap);
|
2003-12-01 19:22:01 +00:00
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
LogUpdClause *Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3],
|
|
|
|
|
yamop *ap_pc, yamop *cp_pc) {
|
2011-03-07 16:02:55 +00:00
|
|
|
|
CACHE_REGS
|
2003-08-27 14:30:50 +01:00
|
|
|
|
CELL *s_reg = NULL;
|
|
|
|
|
Term t = TermNil;
|
2011-05-09 19:13:10 +01:00
|
|
|
|
int blob_term = FALSE;
|
2003-09-15 02:25:29 +01:00
|
|
|
|
choiceptr b0 = NULL;
|
2012-02-17 15:04:25 +00:00
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
2003-09-23 16:14:56 +01:00
|
|
|
|
yamop **jlbl = NULL;
|
2012-02-17 15:04:25 +00:00
|
|
|
|
#endif
|
2015-01-06 17:47:58 +00:00
|
|
|
|
pred_flags_t lu_pred = ap->PredFlags & LogUpdatePredFlag;
|
2008-04-16 18:16:47 +01:00
|
|
|
|
int unbounded = TRUE;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
|
2004-02-12 12:37:12 +00:00
|
|
|
|
if (ap->ModuleOfPred != IDB_MODULE) {
|
2003-12-02 01:15:50 +00:00
|
|
|
|
if (ap->ArityOfPE) {
|
2005-04-28 15:50:45 +01:00
|
|
|
|
CELL *tar = RepAppl(Deref(Terms[0]));
|
2003-12-02 01:15:50 +00:00
|
|
|
|
UInt i;
|
|
|
|
|
|
|
|
|
|
for (i = 1; i <= ap->ArityOfPE; i++) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
XREGS[i] = tar[i];
|
2003-12-02 01:15:50 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
2003-11-21 16:56:20 +00:00
|
|
|
|
/* try to refine the interval using the indexing code */
|
2003-08-27 14:30:50 +01:00
|
|
|
|
while (ipc != NULL) {
|
|
|
|
|
op_numbers op = Yap_op_from_opcode(ipc->opc);
|
2016-07-31 10:26:15 +01:00
|
|
|
|
switch (op) {
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _try_in:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
update_clause_choice_point(NEXTOP(ipc, l), ap_pc PASS_REGS);
|
2003-12-01 19:22:01 +00:00
|
|
|
|
if (lu_pred)
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return lu_clause(ipc->y_u.l.l, ap);
|
2003-12-01 19:22:01 +00:00
|
|
|
|
else
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return (LogUpdClause *)static_clause(ipc->y_u.l.l, ap, unbounded);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
|
|
|
|
case _try_clause:
|
2007-03-21 23:23:46 +00:00
|
|
|
|
#if TABLING
|
|
|
|
|
case _table_try:
|
|
|
|
|
#endif
|
2003-09-15 02:25:29 +01:00
|
|
|
|
if (b0 == NULL)
|
2016-07-31 10:26:15 +01:00
|
|
|
|
store_clause_choice_point(Terms[0], Terms[1], Terms[2],
|
|
|
|
|
NEXTOP(ipc, Otapl), ap, ap_pc,
|
|
|
|
|
cp_pc PASS_REGS);
|
2006-04-12 19:56:50 +01:00
|
|
|
|
else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
B = b0;
|
|
|
|
|
b0 = NULL;
|
|
|
|
|
update_clause_choice_point(NEXTOP(ipc, Otapl), ap_pc PASS_REGS);
|
2006-04-12 19:56:50 +01:00
|
|
|
|
}
|
2003-11-21 16:56:20 +00:00
|
|
|
|
if (lu_pred)
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return lu_clause(ipc->y_u.Otapl.d, ap);
|
2003-11-21 16:56:20 +00:00
|
|
|
|
else
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return (LogUpdClause *)static_clause(ipc->y_u.Otapl.d, ap, unbounded);
|
2004-09-27 21:45:04 +01:00
|
|
|
|
case _try_clause2:
|
|
|
|
|
case _try_clause3:
|
|
|
|
|
case _try_clause4:
|
|
|
|
|
if (b0 == NULL)
|
2016-07-31 10:26:15 +01:00
|
|
|
|
store_clause_choice_point(Terms[0], Terms[1], Terms[2], NEXTOP(ipc, l),
|
|
|
|
|
ap, ap_pc, cp_pc PASS_REGS);
|
2006-04-12 19:56:50 +01:00
|
|
|
|
else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
B = b0;
|
|
|
|
|
b0 = NULL;
|
|
|
|
|
update_clause_choice_point(NEXTOP(ipc, l), ap_pc PASS_REGS);
|
2006-04-12 19:56:50 +01:00
|
|
|
|
}
|
2004-09-27 21:45:04 +01:00
|
|
|
|
if (lu_pred)
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return lu_clause(ipc->y_u.l.l, ap);
|
2004-09-27 21:45:04 +01:00
|
|
|
|
else
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return (LogUpdClause *)static_clause(ipc->y_u.l.l, ap, unbounded);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _try_me:
|
2007-03-21 23:23:46 +00:00
|
|
|
|
#if TABLING
|
|
|
|
|
case _table_try_me:
|
|
|
|
|
#endif
|
2003-09-15 02:25:29 +01:00
|
|
|
|
if (b0 == NULL)
|
2016-07-31 10:26:15 +01:00
|
|
|
|
store_clause_choice_point(Terms[0], Terms[1], Terms[2],
|
|
|
|
|
ipc->y_u.Otapl.d, ap, ap_pc, cp_pc PASS_REGS);
|
2006-04-12 19:56:50 +01:00
|
|
|
|
else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
B = b0;
|
|
|
|
|
b0 = NULL;
|
|
|
|
|
update_clause_choice_point(ipc->y_u.Otapl.d, ap_pc PASS_REGS);
|
2006-04-12 19:56:50 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, Otapl);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
|
|
|
|
case _retry_profiled:
|
|
|
|
|
case _count_retry:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, p);
|
2003-12-01 19:22:01 +00:00
|
|
|
|
break;
|
|
|
|
|
case _retry:
|
2007-03-21 23:23:46 +00:00
|
|
|
|
#if TABLING
|
|
|
|
|
case _table_retry:
|
|
|
|
|
#endif
|
2016-07-31 10:26:15 +01:00
|
|
|
|
update_clause_choice_point(NEXTOP(ipc, Otapl), ap_pc PASS_REGS);
|
2003-11-21 16:56:20 +00:00
|
|
|
|
if (lu_pred)
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return lu_clause(ipc->y_u.Otapl.d, ap);
|
2003-11-21 16:56:20 +00:00
|
|
|
|
else
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return (LogUpdClause *)static_clause(ipc->y_u.Otapl.d, ap, TRUE);
|
2004-09-27 21:45:04 +01:00
|
|
|
|
case _retry2:
|
|
|
|
|
case _retry3:
|
|
|
|
|
case _retry4:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
update_clause_choice_point(NEXTOP(ipc, l), ap_pc PASS_REGS);
|
2004-09-27 21:45:04 +01:00
|
|
|
|
if (lu_pred)
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return lu_clause(ipc->y_u.l.l, ap);
|
2004-09-27 21:45:04 +01:00
|
|
|
|
else
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return (LogUpdClause *)static_clause(ipc->y_u.l.l, ap, TRUE);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _retry_me:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
update_clause_choice_point(ipc->y_u.Otapl.d, ap_pc PASS_REGS);
|
|
|
|
|
ipc = NEXTOP(ipc, Otapl);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
|
|
|
|
case _trust:
|
2007-03-21 23:23:46 +00:00
|
|
|
|
#if TABLING
|
|
|
|
|
case _table_trust:
|
|
|
|
|
#endif
|
2016-07-31 10:26:15 +01:00
|
|
|
|
{
|
|
|
|
|
while (POP_CHOICE_POINT(B->cp_b)) {
|
|
|
|
|
POP_EXECUTE();
|
2005-11-18 18:52:41 +00:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
}
|
2003-09-15 02:25:29 +01:00
|
|
|
|
#ifdef YAPOR
|
2005-04-07 18:56:58 +01:00
|
|
|
|
{
|
2016-07-31 10:26:15 +01:00
|
|
|
|
choiceptr cut_pt;
|
|
|
|
|
cut_pt = B->cp_b;
|
|
|
|
|
CUT_prune_to(cut_pt);
|
|
|
|
|
B = cut_pt;
|
2005-04-07 18:56:58 +01:00
|
|
|
|
}
|
2003-09-15 02:25:29 +01:00
|
|
|
|
#else
|
|
|
|
|
B = B->cp_b;
|
|
|
|
|
#endif /* YAPOR */
|
|
|
|
|
b0 = B;
|
2003-11-21 16:56:20 +00:00
|
|
|
|
if (lu_pred)
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return lu_clause(ipc->y_u.Otapl.d, ap);
|
2003-11-21 16:56:20 +00:00
|
|
|
|
else
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return (LogUpdClause *)static_clause(ipc->y_u.Otapl.d, ap, TRUE);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _profiled_trust_me:
|
|
|
|
|
case _trust_me:
|
|
|
|
|
case _count_trust_me:
|
2007-03-21 23:23:46 +00:00
|
|
|
|
#if TABLING
|
|
|
|
|
case _table_trust_me:
|
|
|
|
|
#endif
|
2006-04-12 19:56:50 +01:00
|
|
|
|
b0 = B;
|
2005-11-18 18:52:41 +00:00
|
|
|
|
{
|
2016-07-31 10:26:15 +01:00
|
|
|
|
while (POP_CHOICE_POINT(B->cp_b)) {
|
|
|
|
|
POP_EXECUTE();
|
|
|
|
|
}
|
2005-11-18 18:52:41 +00:00
|
|
|
|
}
|
2005-02-24 21:46:40 +00:00
|
|
|
|
#ifdef YAPOR
|
2005-04-07 18:56:58 +01:00
|
|
|
|
{
|
2016-07-31 10:26:15 +01:00
|
|
|
|
choiceptr cut_pt;
|
|
|
|
|
cut_pt = B->cp_b;
|
|
|
|
|
CUT_prune_to(cut_pt);
|
|
|
|
|
B = cut_pt;
|
2005-04-07 18:56:58 +01:00
|
|
|
|
}
|
2005-02-24 21:46:40 +00:00
|
|
|
|
#else
|
|
|
|
|
B = B->cp_b;
|
|
|
|
|
#endif /* YAPOR */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, Otapl);
|
|
|
|
|
break;
|
|
|
|
|
case _enter_lu_pred: {
|
|
|
|
|
LogUpdIndex *cl = ipc->y_u.Illss.I;
|
|
|
|
|
PredEntry *ap = cl->ClPred;
|
|
|
|
|
|
|
|
|
|
if (!cl)
|
|
|
|
|
return NULL; /* in case the index is empty */
|
|
|
|
|
if (ap->LastCallOfPred != LUCALL_EXEC) {
|
|
|
|
|
/*
|
|
|
|
|
only increment time stamp if we are working on current time
|
|
|
|
|
stamp
|
|
|
|
|
*/
|
|
|
|
|
if (ap->TimeStampOfPred >= TIMESTAMP_RESET)
|
|
|
|
|
Yap_UpdateTimestamps(ap);
|
|
|
|
|
ap->TimeStampOfPred++;
|
|
|
|
|
/* fprintf(stderr,"R
|
|
|
|
|
* %x--%d--%ul\n",ap,ap->TimeStampOfPred,ap->ArityOfPE);*/
|
|
|
|
|
ap->LastCallOfPred = LUCALL_EXEC;
|
|
|
|
|
}
|
|
|
|
|
*--ASP = MkIntegerTerm(ap->TimeStampOfPred);
|
|
|
|
|
/* indicate the indexing code is being used */
|
2011-04-14 18:51:11 +01:00
|
|
|
|
#if MULTIPLE_STACKS
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* just store a reference */
|
|
|
|
|
INC_CLREF_COUNT(cl);
|
|
|
|
|
TRAIL_CLREF(cl);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
#else
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (!(cl->ClFlags & InUseMask)) {
|
|
|
|
|
cl->ClFlags |= InUseMask;
|
|
|
|
|
TRAIL_CLREF(cl);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
#endif
|
|
|
|
|
}
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ipc = ipc->y_u.Illss.l1;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
case _try_logical:
|
|
|
|
|
if (b0 == NULL)
|
2016-07-31 10:26:15 +01:00
|
|
|
|
store_clause_choice_point(Terms[0], Terms[1], Terms[2],
|
|
|
|
|
ipc->y_u.OtaLl.n, ap, ap_pc, cp_pc PASS_REGS);
|
2006-10-10 15:08:17 +01:00
|
|
|
|
else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
B = b0;
|
|
|
|
|
b0 = NULL;
|
|
|
|
|
update_clause_choice_point(ipc->y_u.OtaLl.n, ap_pc PASS_REGS);
|
2004-02-18 01:43:32 +00:00
|
|
|
|
}
|
2006-10-10 15:08:17 +01:00
|
|
|
|
{
|
2016-07-31 10:26:15 +01:00
|
|
|
|
UInt timestamp = IntegerOfTerm(((CELL *)(B + 1))[5]);
|
|
|
|
|
|
|
|
|
|
if (!VALID_TIMESTAMP(timestamp, ipc->y_u.OtaLl.d)) {
|
|
|
|
|
/* jump to next instruction */
|
|
|
|
|
ipc = ipc->y_u.OtaLl.n;
|
|
|
|
|
break;
|
|
|
|
|
}
|
2004-02-17 16:27:22 +00:00
|
|
|
|
}
|
2014-05-30 01:06:09 +01:00
|
|
|
|
return ipc->y_u.OtaLl.d;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
case _retry_logical:
|
|
|
|
|
case _profiled_retry_logical:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
case _count_retry_logical: {
|
|
|
|
|
UInt timestamp = IntegerOfTerm(((CELL *)(B + 1))[5]);
|
|
|
|
|
if (!VALID_TIMESTAMP(timestamp, ipc->y_u.OtaLl.d)) {
|
|
|
|
|
/* jump to next instruction */
|
|
|
|
|
ipc = ipc->y_u.OtaLl.n;
|
|
|
|
|
break;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
update_clause_choice_point(ipc->y_u.OtaLl.n, ap_pc PASS_REGS);
|
2014-05-30 01:06:09 +01:00
|
|
|
|
return ipc->y_u.OtaLl.d;
|
2009-05-02 16:54:09 +01:00
|
|
|
|
#if TABLING
|
|
|
|
|
case _table_try_single:
|
|
|
|
|
return (LogUpdClause *)ClauseCodeToStaticClause(ipc);
|
|
|
|
|
#endif
|
2006-10-10 15:08:17 +01:00
|
|
|
|
case _trust_logical:
|
|
|
|
|
case _count_trust_logical:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
case _profiled_trust_logical: {
|
|
|
|
|
UInt timestamp = IntegerOfTerm(((CELL *)(B + 1))[5]);
|
|
|
|
|
LogUpdIndex *cl = ipc->y_u.OtILl.block;
|
|
|
|
|
LogUpdClause *newpc;
|
|
|
|
|
|
|
|
|
|
if (!VALID_TIMESTAMP(timestamp, ipc->y_u.OtILl.d)) {
|
|
|
|
|
/* jump to next instruction */
|
|
|
|
|
newpc = NULL;
|
|
|
|
|
} else {
|
|
|
|
|
newpc = ipc->y_u.OtILl.d;
|
|
|
|
|
}
|
2011-04-14 18:51:11 +01:00
|
|
|
|
#if MULTIPLE_STACKS
|
2016-07-31 10:26:15 +01:00
|
|
|
|
DEC_CLREF_COUNT(cl);
|
|
|
|
|
B->cp_tr--;
|
|
|
|
|
TR--;
|
|
|
|
|
/* actually get rid of the code */
|
|
|
|
|
if (cl->ClRefCount == 0 && cl->ClFlags & (ErasedMask | DirtyMask)) {
|
|
|
|
|
/* I am the last one using this clause, hence I don't need a lock
|
|
|
|
|
to dispose of it. But on the other hand I need to make sure
|
|
|
|
|
the clause is still there when I am back.
|
|
|
|
|
*/
|
|
|
|
|
LogUpdClause *lcl = ipc->y_u.OtILl.d;
|
|
|
|
|
if (newpc) {
|
|
|
|
|
if (lcl->ClRefCount == 1) {
|
|
|
|
|
/* make sure the clause isn't destroyed */
|
|
|
|
|
/* always add an extra reference */
|
|
|
|
|
INC_CLREF_COUNT(lcl);
|
|
|
|
|
TRAIL_CLREF(lcl);
|
|
|
|
|
B->cp_tr = TR;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
if (cl->ClFlags & ErasedMask) {
|
|
|
|
|
Yap_ErLogUpdIndex(cl);
|
|
|
|
|
} else {
|
|
|
|
|
Yap_CleanUpIndex(cl);
|
|
|
|
|
}
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
#else
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (TrailTerm(B->cp_tr - 1) == CLREF_TO_TRENTRY(cl) &&
|
|
|
|
|
B->cp_tr != B->cp_b->cp_tr) {
|
|
|
|
|
|
|
|
|
|
B->cp_tr--;
|
|
|
|
|
TR--;
|
|
|
|
|
cl->ClFlags &= ~InUseMask;
|
|
|
|
|
/* next, recover space for the indexing code if it was erased */
|
|
|
|
|
if (cl->ClFlags & (ErasedMask | DirtyMask)) {
|
|
|
|
|
LogUpdClause *lcl = ipc->y_u.OtILl.d;
|
|
|
|
|
/* make sure we don't erase the clause we are jumping to, notice that
|
|
|
|
|
ErLogUpdIndex may remove several references in one go.
|
|
|
|
|
Notice we only need to do this if we´ re jumping to the clause.
|
|
|
|
|
*/
|
|
|
|
|
if (newpc && !(lcl->ClFlags & (DirtyMask | InUseMask))) {
|
|
|
|
|
lcl->ClFlags |= InUseMask;
|
|
|
|
|
TRAIL_CLREF(lcl);
|
|
|
|
|
}
|
|
|
|
|
if (cl->ClFlags & ErasedMask) {
|
|
|
|
|
Yap_ErLogUpdIndex(cl);
|
|
|
|
|
} else {
|
|
|
|
|
Yap_CleanUpIndex(cl);
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
#endif
|
2016-07-31 10:26:15 +01:00
|
|
|
|
{
|
|
|
|
|
while (POP_CHOICE_POINT(B->cp_b)) {
|
|
|
|
|
POP_EXECUTE();
|
|
|
|
|
}
|
|
|
|
|
}
|
2006-10-25 03:31:07 +01:00
|
|
|
|
#ifdef YAPOR
|
2016-07-31 10:26:15 +01:00
|
|
|
|
{
|
|
|
|
|
choiceptr cut_pt;
|
|
|
|
|
cut_pt = B->cp_b;
|
|
|
|
|
CUT_prune_to(cut_pt);
|
|
|
|
|
B = cut_pt;
|
|
|
|
|
}
|
2006-10-25 03:31:07 +01:00
|
|
|
|
#else
|
2016-07-31 10:26:15 +01:00
|
|
|
|
B = B->cp_b;
|
2006-10-25 03:31:07 +01:00
|
|
|
|
#endif /* YAPOR */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
b0 = B;
|
|
|
|
|
return newpc;
|
|
|
|
|
}
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _jump:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ipc = ipc->y_u.l.l;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
case _jump_if_var: {
|
|
|
|
|
Term t = Deref(ARG1);
|
|
|
|
|
if (IsVarTerm(t)) {
|
|
|
|
|
SET_JLBL(l.l);
|
|
|
|
|
ipc = ipc->y_u.l.l;
|
|
|
|
|
} else {
|
|
|
|
|
ipc = NEXTOP(ipc, l);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
} break;
|
|
|
|
|
case _jump_if_nonvar: {
|
|
|
|
|
Term t = Deref(XREGS[arg_from_x(ipc->y_u.xll.x)]);
|
|
|
|
|
if (!IsVarTerm(t)) {
|
|
|
|
|
SET_JLBL(xll.l1);
|
|
|
|
|
ipc = ipc->y_u.xll.l1;
|
|
|
|
|
} else {
|
|
|
|
|
ipc = NEXTOP(ipc, xll);
|
2003-10-28 01:16:03 +00:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
} break;
|
2009-02-12 21:35:31 +00:00
|
|
|
|
case _user_switch:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ipc = ipc->y_u.lp.l;
|
2009-02-12 21:35:31 +00:00
|
|
|
|
break;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* instructions type e */
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _switch_on_type:
|
|
|
|
|
t = Deref(ARG1);
|
2011-05-09 19:13:10 +01:00
|
|
|
|
blob_term = FALSE;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (IsVarTerm(t)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
SET_JLBL(llll.l4);
|
|
|
|
|
ipc = ipc->y_u.llll.l4;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else if (IsPairTerm(t)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
unbounded = FALSE;
|
|
|
|
|
SET_JLBL(llll.l1);
|
|
|
|
|
ipc = ipc->y_u.llll.l1;
|
|
|
|
|
S = s_reg = RepPair(t);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else if (IsAtomOrIntTerm(t)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
SET_JLBL(llll.l2);
|
|
|
|
|
ipc = ipc->y_u.llll.l2;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
SET_JLBL(llll.l3);
|
|
|
|
|
ipc = ipc->y_u.llll.l3;
|
|
|
|
|
S = RepAppl(t);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
break;
|
|
|
|
|
case _switch_list_nl:
|
|
|
|
|
t = Deref(ARG1);
|
2011-05-09 19:13:10 +01:00
|
|
|
|
blob_term = FALSE;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (IsVarTerm(t)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
SET_JLBL(ollll.l4);
|
|
|
|
|
ipc = ipc->y_u.ollll.l4;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else if (IsPairTerm(t)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
unbounded = FALSE;
|
|
|
|
|
SET_JLBL(ollll.l1);
|
|
|
|
|
ipc = ipc->y_u.ollll.l1;
|
|
|
|
|
S = s_reg = RepPair(t);
|
2005-06-01 17:42:30 +01:00
|
|
|
|
} else if (t == TermNil) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
unbounded = FALSE;
|
|
|
|
|
SET_JLBL(ollll.l2);
|
|
|
|
|
ipc = ipc->y_u.ollll.l2;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
SET_JLBL(ollll.l3);
|
|
|
|
|
ipc = ipc->y_u.ollll.l3;
|
|
|
|
|
S = RepAppl(t);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
break;
|
|
|
|
|
case _switch_on_arg_type:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
t = Deref(XREGS[arg_from_x(ipc->y_u.xllll.x)]);
|
2011-05-09 19:13:10 +01:00
|
|
|
|
blob_term = FALSE;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (IsVarTerm(t)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
SET_JLBL(xllll.l4);
|
|
|
|
|
ipc = ipc->y_u.xllll.l4;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else if (IsPairTerm(t)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
unbounded = FALSE;
|
|
|
|
|
SET_JLBL(xllll.l1);
|
|
|
|
|
ipc = ipc->y_u.xllll.l1;
|
|
|
|
|
S = s_reg = RepPair(t);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else if (IsAtomOrIntTerm(t)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
SET_JLBL(xllll.l2);
|
|
|
|
|
ipc = ipc->y_u.xllll.l2;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
SET_JLBL(xllll.l3);
|
|
|
|
|
ipc = ipc->y_u.xllll.l3;
|
|
|
|
|
S = RepAppl(t);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
break;
|
|
|
|
|
case _switch_on_sub_arg_type:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
t = Deref(s_reg[ipc->y_u.sllll.s]);
|
2011-05-09 19:13:10 +01:00
|
|
|
|
blob_term = FALSE;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
if (IsVarTerm(t)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
SET_JLBL(sllll.l4);
|
|
|
|
|
ipc = ipc->y_u.sllll.l4;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else if (IsPairTerm(t)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
unbounded = FALSE;
|
|
|
|
|
SET_JLBL(sllll.l1);
|
|
|
|
|
S = s_reg = RepPair(t);
|
|
|
|
|
ipc = ipc->y_u.sllll.l1;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else if (IsAtomOrIntTerm(t)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
SET_JLBL(sllll.l2);
|
|
|
|
|
ipc = ipc->y_u.sllll.l2;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
SET_JLBL(sllll.l3);
|
|
|
|
|
ipc = ipc->y_u.sllll.l3;
|
|
|
|
|
S = RepAppl(t);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
break;
|
|
|
|
|
case _if_not_then:
|
|
|
|
|
t = Deref(ARG1);
|
2011-05-09 19:13:10 +01:00
|
|
|
|
blob_term = FALSE;
|
2003-10-02 13:59:05 +01:00
|
|
|
|
if (IsVarTerm(t)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
SET_JLBL(clll.l3);
|
|
|
|
|
ipc = ipc->y_u.clll.l3;
|
2014-05-30 01:06:09 +01:00
|
|
|
|
} else if (!IsVarTerm(t) && t != ipc->y_u.clll.c) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
SET_JLBL(clll.l1);
|
|
|
|
|
ipc = ipc->y_u.clll.l1;
|
2005-01-15 05:21:36 +00:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
SET_JLBL(clll.l2);
|
|
|
|
|
ipc = ipc->y_u.clll.l2;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
break;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* instructions type ollll */
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _switch_on_func:
|
|
|
|
|
case _if_func:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
case _go_on_func: {
|
|
|
|
|
FuncSwiEntry *fe;
|
|
|
|
|
Functor f;
|
|
|
|
|
|
|
|
|
|
unbounded = FALSE;
|
|
|
|
|
s_reg = RepAppl(t);
|
|
|
|
|
f = (Functor)s_reg[0];
|
|
|
|
|
s_reg++;
|
|
|
|
|
S = s_reg;
|
|
|
|
|
if (op == _switch_on_func) {
|
|
|
|
|
fe = lookup_f_hash(f, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
|
|
|
|
|
} else {
|
|
|
|
|
fe = lookup_f(f, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
|
|
|
|
|
}
|
2012-02-17 15:04:25 +00:00
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
2016-07-31 10:26:15 +01:00
|
|
|
|
jlbl = &(fe->u_f.labp);
|
2012-02-17 15:04:25 +00:00
|
|
|
|
#endif
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = fe->u_f.labp;
|
|
|
|
|
} break;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _index_dbref:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (s_reg[-1] != (CELL)FunctorDBREF) {
|
|
|
|
|
ipc = FAILCODE;
|
2016-08-26 05:43:54 +01:00
|
|
|
|
break;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
}
|
|
|
|
|
t = AbsAppl(s_reg - 1);
|
2011-05-09 19:13:10 +01:00
|
|
|
|
blob_term = FALSE;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, e);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
|
|
|
|
case _index_blob:
|
2016-08-26 05:43:54 +01:00
|
|
|
|
if (s_reg[-1] != (CELL)FunctorDouble) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = FAILCODE;
|
2016-08-26 05:43:54 +01:00
|
|
|
|
break;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
}
|
2010-05-14 12:42:30 +01:00
|
|
|
|
t = Yap_DoubleP_key(s_reg);
|
2011-05-09 19:13:10 +01:00
|
|
|
|
blob_term = TRUE;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, e);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
2009-02-09 21:56:40 +00:00
|
|
|
|
case _index_long:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (s_reg[-1] != (CELL)FunctorLongInt) {
|
|
|
|
|
ipc = FAILCODE;
|
2016-08-26 05:43:54 +01:00
|
|
|
|
break;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
}
|
2010-05-14 12:42:30 +01:00
|
|
|
|
t = Yap_IntP_key(s_reg);
|
2011-05-09 19:13:10 +01:00
|
|
|
|
blob_term = TRUE;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, e);
|
2009-02-09 21:56:40 +00:00
|
|
|
|
break;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _switch_on_cons:
|
|
|
|
|
case _if_cons:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
case _go_on_cons: {
|
|
|
|
|
AtomSwiEntry *ae;
|
|
|
|
|
|
|
|
|
|
unbounded = FALSE;
|
|
|
|
|
if (op == _switch_on_cons) {
|
|
|
|
|
ae = lookup_c_hash(t, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
|
|
|
|
|
} else {
|
|
|
|
|
ae = lookup_c(t, ipc->y_u.sssl.l, ipc->y_u.sssl.s);
|
|
|
|
|
}
|
2012-02-17 15:04:25 +00:00
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
2016-07-31 10:26:15 +01:00
|
|
|
|
jlbl = &(ae->u_a.labp);
|
2012-02-17 15:04:25 +00:00
|
|
|
|
#endif
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = ae->u_a.labp;
|
|
|
|
|
} break;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _expand_index:
|
2004-03-31 02:02:18 +01:00
|
|
|
|
case _expand_clauses:
|
2011-05-09 19:13:10 +01:00
|
|
|
|
if (blob_term) { /* protect garbage collector */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
XREGS[ap->ArityOfPE + 1] = (CELL)&XREGS[ap->ArityOfPE + 1];
|
|
|
|
|
XREGS[ap->ArityOfPE + 2] = TermNil;
|
2011-05-09 19:13:10 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
XREGS[ap->ArityOfPE + 1] = (CELL)s_reg;
|
|
|
|
|
XREGS[ap->ArityOfPE + 2] = t;
|
2011-05-09 19:13:10 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
XREGS[ap->ArityOfPE + 3] = Terms[0];
|
|
|
|
|
XREGS[ap->ArityOfPE + 4] = Terms[1];
|
|
|
|
|
XREGS[ap->ArityOfPE + 5] = Terms[2];
|
2004-09-30 20:51:54 +01:00
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
2004-06-29 20:04:46 +01:00
|
|
|
|
if (!same_lu_block(jlbl, ipc)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = *jlbl;
|
|
|
|
|
break;
|
2004-02-18 01:43:32 +00:00
|
|
|
|
}
|
|
|
|
|
#endif
|
2011-03-07 16:02:55 +00:00
|
|
|
|
ipc = ExpandIndex(ap, 5, cp_pc PASS_REGS);
|
2011-05-09 19:13:10 +01:00
|
|
|
|
if (!blob_term) { /* protect garbage collector */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
s_reg = (CELL *)XREGS[ap->ArityOfPE + 1];
|
|
|
|
|
t = XREGS[ap->ArityOfPE + 2];
|
2011-05-09 19:13:10 +01:00
|
|
|
|
}
|
|
|
|
|
blob_term = FALSE;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Terms[0] = XREGS[ap->ArityOfPE + 3];
|
|
|
|
|
Terms[1] = XREGS[ap->ArityOfPE + 4];
|
|
|
|
|
Terms[2] = XREGS[ap->ArityOfPE + 5];
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
2003-09-20 04:06:15 +01:00
|
|
|
|
case _undef_p:
|
2003-08-27 14:30:50 +01:00
|
|
|
|
return NULL;
|
2004-02-05 16:57:02 +00:00
|
|
|
|
case _lock_lu:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, p);
|
2004-02-05 16:57:02 +00:00
|
|
|
|
break;
|
2004-02-11 01:20:56 +00:00
|
|
|
|
#if THREADS
|
2004-02-11 16:18:16 +00:00
|
|
|
|
case _thread_local:
|
2011-03-07 16:02:55 +00:00
|
|
|
|
ap = Yap_GetThreadPred(ap PASS_REGS);
|
2004-02-11 01:20:56 +00:00
|
|
|
|
ipc = ap->CodeOfPred;
|
|
|
|
|
break;
|
2004-02-11 16:18:16 +00:00
|
|
|
|
#endif
|
2003-08-27 14:30:50 +01:00
|
|
|
|
case _spy_pred:
|
2007-11-26 23:43:10 +00:00
|
|
|
|
case _lock_pred:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if ((ap->PredFlags & IndexedPredFlag) || ap->cs.p_code.NOfClauses <= 1) {
|
|
|
|
|
ipc = ap->cs.p_code.TrueCodeOfPred;
|
|
|
|
|
break;
|
2006-11-21 16:21:33 +00:00
|
|
|
|
}
|
2004-09-30 20:51:54 +01:00
|
|
|
|
case _index_pred:
|
2011-05-09 19:13:10 +01:00
|
|
|
|
if (blob_term) { /* protect garbage collector */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
XREGS[ap->ArityOfPE + 1] = (CELL)&XREGS[ap->ArityOfPE + 1];
|
|
|
|
|
XREGS[ap->ArityOfPE + 2] = TermNil;
|
2011-05-09 19:13:10 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
XREGS[ap->ArityOfPE + 1] = (CELL)s_reg;
|
|
|
|
|
XREGS[ap->ArityOfPE + 2] = t;
|
2011-05-09 19:13:10 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
XREGS[ap->ArityOfPE + 3] = Terms[0];
|
|
|
|
|
XREGS[ap->ArityOfPE + 4] = Terms[1];
|
|
|
|
|
XREGS[ap->ArityOfPE + 5] = Terms[2];
|
2010-01-29 15:21:00 +00:00
|
|
|
|
Yap_IPred(ap, 5, cp_pc);
|
2012-02-17 15:04:25 +00:00
|
|
|
|
ipc = ap->cs.p_code.TrueCodeOfPred;
|
2011-05-09 19:13:10 +01:00
|
|
|
|
if (!blob_term) { /* protect garbage collector */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
s_reg = (CELL *)XREGS[ap->ArityOfPE + 1];
|
|
|
|
|
t = XREGS[ap->ArityOfPE + 2];
|
2011-05-09 19:13:10 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
Terms[0] = XREGS[ap->ArityOfPE + 3];
|
|
|
|
|
Terms[1] = XREGS[ap->ArityOfPE + 4];
|
|
|
|
|
Terms[2] = XREGS[ap->ArityOfPE + 5];
|
2003-08-27 14:30:50 +01:00
|
|
|
|
break;
|
2004-10-27 16:56:34 +01:00
|
|
|
|
case _op_fail:
|
|
|
|
|
if (ipc == FAILCODE)
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return NULL;
|
2003-08-27 14:30:50 +01:00
|
|
|
|
default:
|
2003-09-15 02:25:29 +01:00
|
|
|
|
if (b0) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
{
|
|
|
|
|
while (POP_CHOICE_POINT(B->cp_b)) {
|
|
|
|
|
POP_EXECUTE();
|
|
|
|
|
}
|
|
|
|
|
}
|
2003-09-15 02:25:29 +01:00
|
|
|
|
#ifdef YAPOR
|
2016-07-31 10:26:15 +01:00
|
|
|
|
{
|
|
|
|
|
choiceptr cut_pt;
|
|
|
|
|
cut_pt = B->cp_b;
|
|
|
|
|
CUT_prune_to(cut_pt);
|
|
|
|
|
B = cut_pt;
|
|
|
|
|
}
|
2003-09-15 02:25:29 +01:00
|
|
|
|
#else
|
2016-07-31 10:26:15 +01:00
|
|
|
|
B = B->cp_b;
|
2003-09-15 02:25:29 +01:00
|
|
|
|
#endif /* YAPOR */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* I did a trust */
|
2003-09-15 02:25:29 +01:00
|
|
|
|
}
|
2008-01-24 10:20:42 +00:00
|
|
|
|
if (op == _op_fail)
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return NULL;
|
2003-11-21 16:56:20 +00:00
|
|
|
|
if (lu_pred)
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return lu_clause(ipc, ap);
|
2003-11-21 16:56:20 +00:00
|
|
|
|
else
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return (LogUpdClause *)static_clause(ipc, ap, unbounded);
|
2003-08-27 14:30:50 +01:00
|
|
|
|
}
|
|
|
|
|
}
|
2003-09-15 02:25:29 +01:00
|
|
|
|
if (b0) {
|
|
|
|
|
/* I did a trust */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
{
|
|
|
|
|
while (POP_CHOICE_POINT(B->cp_b)) {
|
|
|
|
|
POP_EXECUTE();
|
2005-11-18 18:52:41 +00:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
}
|
2003-09-15 02:25:29 +01:00
|
|
|
|
#ifdef YAPOR
|
2005-04-07 18:56:58 +01:00
|
|
|
|
{
|
|
|
|
|
choiceptr cut_pt;
|
|
|
|
|
cut_pt = B->cp_b;
|
|
|
|
|
CUT_prune_to(cut_pt);
|
|
|
|
|
B = cut_pt;
|
|
|
|
|
}
|
2003-09-15 02:25:29 +01:00
|
|
|
|
#else
|
|
|
|
|
B = B->cp_b;
|
|
|
|
|
#endif /* YAPOR */
|
|
|
|
|
}
|
|
|
|
|
return NULL;
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
LogUpdClause *Yap_NthClause(PredEntry *ap, Int ncls) {
|
2011-03-07 16:02:55 +00:00
|
|
|
|
CACHE_REGS
|
2016-07-31 10:26:15 +01:00
|
|
|
|
yamop *ipc = ap->cs.p_code.TrueCodeOfPred, *alt = NULL;
|
2012-02-17 15:04:25 +00:00
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
2003-12-01 19:22:01 +00:00
|
|
|
|
yamop **jlbl = NULL;
|
2012-02-17 15:04:25 +00:00
|
|
|
|
#endif
|
2003-12-01 19:22:01 +00:00
|
|
|
|
|
|
|
|
|
/* search every clause */
|
2009-11-18 13:06:37 +00:00
|
|
|
|
if (ncls > ap->cs.p_code.NOfClauses)
|
|
|
|
|
return NULL;
|
|
|
|
|
else if (ncls == 1)
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return to_clause(ap->cs.p_code.FirstClause, ap);
|
2012-02-14 18:57:39 +00:00
|
|
|
|
else if (ap->PredFlags & MegaClausePredFlag) {
|
|
|
|
|
MegaClause *mcl = ClauseCodeToMegaClause(ap->cs.p_code.FirstClause);
|
|
|
|
|
/* fast access to nth element, all have same size */
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return (LogUpdClause *)((char *)mcl->ClCode + (ncls - 1) * mcl->ClItemSize);
|
2012-02-14 18:57:39 +00:00
|
|
|
|
} else if (ncls == ap->cs.p_code.NOfClauses) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return to_clause(ap->cs.p_code.LastClause, ap);
|
2012-02-14 18:57:39 +00:00
|
|
|
|
} else if (ncls < 0)
|
2003-12-01 19:22:01 +00:00
|
|
|
|
return NULL;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
|
2004-02-12 12:37:12 +00:00
|
|
|
|
if (ap->ModuleOfPred != IDB_MODULE) {
|
2003-12-02 01:15:50 +00:00
|
|
|
|
if (ap->ArityOfPE) {
|
|
|
|
|
UInt i;
|
|
|
|
|
|
|
|
|
|
for (i = 1; i <= ap->ArityOfPE; i++) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
XREGS[i] = MkVarTerm();
|
2003-12-02 01:15:50 +00:00
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
} else {
|
|
|
|
|
ARG2 = MkVarTerm();
|
|
|
|
|
}
|
2003-12-01 19:22:01 +00:00
|
|
|
|
while (TRUE) {
|
|
|
|
|
op_numbers op = Yap_op_from_opcode(ipc->opc);
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
switch (op) {
|
2003-12-01 19:22:01 +00:00
|
|
|
|
case _try_in:
|
|
|
|
|
if (ncls == 1)
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return to_clause(ipc->y_u.l.l, ap);
|
2003-12-01 19:22:01 +00:00
|
|
|
|
ncls--;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, l);
|
2003-12-01 19:22:01 +00:00
|
|
|
|
break;
|
|
|
|
|
case _retry_profiled:
|
|
|
|
|
case _count_retry:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, p);
|
2003-12-01 19:22:01 +00:00
|
|
|
|
case _try_clause:
|
|
|
|
|
case _retry:
|
|
|
|
|
if (ncls == 1)
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return to_clause(ipc->y_u.Otapl.d, ap);
|
2003-12-01 19:22:01 +00:00
|
|
|
|
else if (alt == NULL) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ncls--;
|
|
|
|
|
/* get there in a fell swoop */
|
|
|
|
|
if (ap->PredFlags & ProfiledPredFlag) {
|
|
|
|
|
if (ap->PredFlags & CountPredFlag) {
|
|
|
|
|
ipc = (yamop *)((char *)ipc +
|
|
|
|
|
ncls * (UInt)NEXTOP(
|
|
|
|
|
NEXTOP(NEXTOP((yamop *)NULL, Otapl), p),
|
|
|
|
|
p));
|
|
|
|
|
} else {
|
|
|
|
|
ipc =
|
|
|
|
|
(yamop *)((char *)ipc +
|
|
|
|
|
ncls * (UInt)NEXTOP(NEXTOP((yamop *)NULL, Otapl), p));
|
|
|
|
|
}
|
|
|
|
|
} else if (ap->PredFlags & CountPredFlag) {
|
|
|
|
|
ipc = (yamop *)((char *)ipc +
|
|
|
|
|
ncls * (UInt)NEXTOP(NEXTOP((yamop *)NULL, Otapl), p));
|
|
|
|
|
} else {
|
|
|
|
|
ipc = (yamop *)((char *)ipc +
|
|
|
|
|
ncls * (UInt)NEXTOP((yamop *)NULL, Otapl));
|
|
|
|
|
}
|
|
|
|
|
return to_clause(ipc->y_u.Otapl.d, ap);
|
2003-12-01 19:22:01 +00:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ncls--;
|
2003-12-01 19:22:01 +00:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, Otapl);
|
2003-12-01 19:22:01 +00:00
|
|
|
|
break;
|
2004-09-27 21:45:04 +01:00
|
|
|
|
case _try_clause2:
|
|
|
|
|
case _try_clause3:
|
|
|
|
|
case _try_clause4:
|
|
|
|
|
case _retry2:
|
|
|
|
|
case _retry3:
|
|
|
|
|
case _retry4:
|
|
|
|
|
if (ncls == 1)
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return to_clause(ipc->y_u.l.l, ap);
|
2004-09-27 21:45:04 +01:00
|
|
|
|
else if (alt == NULL) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ncls--;
|
|
|
|
|
/* get there in a fell swoop */
|
|
|
|
|
if (ap->PredFlags & ProfiledPredFlag) {
|
|
|
|
|
if (ap->PredFlags & CountPredFlag) {
|
|
|
|
|
ipc = (yamop *)((char *)ipc +
|
|
|
|
|
ncls * (UInt)NEXTOP(
|
|
|
|
|
NEXTOP(NEXTOP((yamop *)NULL, l), p), p));
|
|
|
|
|
} else {
|
|
|
|
|
ipc = (yamop *)((char *)ipc +
|
|
|
|
|
ncls * (UInt)NEXTOP(NEXTOP((yamop *)NULL, l), p));
|
|
|
|
|
}
|
|
|
|
|
} else if (ap->PredFlags & CountPredFlag) {
|
|
|
|
|
ipc = (yamop *)((char *)ipc +
|
|
|
|
|
ncls * (UInt)NEXTOP(NEXTOP((yamop *)NULL, l), p));
|
|
|
|
|
} else {
|
|
|
|
|
ipc = (yamop *)((char *)ipc + ncls * (UInt)NEXTOP((yamop *)NULL, l));
|
|
|
|
|
}
|
|
|
|
|
return to_clause(ipc->y_u.l.l, ap);
|
2004-09-27 21:45:04 +01:00
|
|
|
|
} else {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ncls--;
|
2004-09-27 21:45:04 +01:00
|
|
|
|
}
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, l);
|
2004-09-27 21:45:04 +01:00
|
|
|
|
break;
|
2003-12-01 19:22:01 +00:00
|
|
|
|
case _trust:
|
|
|
|
|
if (ncls == 1)
|
2016-07-31 10:26:15 +01:00
|
|
|
|
return to_clause(ipc->y_u.l.l, ap);
|
2003-12-01 19:22:01 +00:00
|
|
|
|
ncls--;
|
|
|
|
|
ipc = alt;
|
|
|
|
|
break;
|
|
|
|
|
case _try_me:
|
|
|
|
|
case _retry_me:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
alt = ipc->y_u.Otapl.d;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, Otapl);
|
2003-12-01 19:22:01 +00:00
|
|
|
|
break;
|
|
|
|
|
case _profiled_trust_me:
|
|
|
|
|
case _trust_me:
|
|
|
|
|
case _count_trust_me:
|
|
|
|
|
alt = NULL;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, Otapl);
|
2003-12-01 19:22:01 +00:00
|
|
|
|
break;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
case _try_logical:
|
|
|
|
|
case _retry_logical:
|
|
|
|
|
case _count_retry_logical:
|
|
|
|
|
case _profiled_retry_logical:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
if (VALID_TIMESTAMP(ap->TimeStampOfPred, ipc->y_u.OtaLl.d)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (ncls == 1)
|
|
|
|
|
return ipc->y_u.OtaLl.d;
|
|
|
|
|
ncls--;
|
2004-02-17 16:27:22 +00:00
|
|
|
|
}
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ipc = ipc->y_u.OtaLl.n;
|
2003-12-01 19:22:01 +00:00
|
|
|
|
break;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
case _trust_logical:
|
|
|
|
|
case _count_trust_logical:
|
|
|
|
|
case _profiled_trust_logical:
|
2014-05-30 01:06:09 +01:00
|
|
|
|
if (VALID_TIMESTAMP(ap->TimeStampOfPred, ipc->y_u.OtILl.d)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
if (ncls == 1)
|
|
|
|
|
return ipc->y_u.OtILl.d;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
}
|
|
|
|
|
return NULL;
|
2003-12-01 19:22:01 +00:00
|
|
|
|
case _enter_lu_pred:
|
2012-02-17 15:04:25 +00:00
|
|
|
|
SET_JLBL(Illss.l1);
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ipc = ipc->y_u.Illss.l1;
|
2003-12-01 19:22:01 +00:00
|
|
|
|
break;
|
2004-02-05 16:57:02 +00:00
|
|
|
|
case _lock_lu:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, p);
|
2004-02-05 16:57:02 +00:00
|
|
|
|
break;
|
2003-12-01 19:22:01 +00:00
|
|
|
|
case _jump:
|
2012-02-17 15:04:25 +00:00
|
|
|
|
SET_JLBL(l.l);
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ipc = ipc->y_u.l.l;
|
2003-12-01 19:22:01 +00:00
|
|
|
|
break;
|
|
|
|
|
case _jump_if_var:
|
2012-02-17 15:04:25 +00:00
|
|
|
|
SET_JLBL(l.l);
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ipc = ipc->y_u.l.l;
|
2003-12-01 19:22:01 +00:00
|
|
|
|
break;
|
|
|
|
|
case _jump_if_nonvar:
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = NEXTOP(ipc, xll);
|
2003-12-01 19:22:01 +00:00
|
|
|
|
break;
|
2009-02-12 21:35:31 +00:00
|
|
|
|
case _user_switch:
|
2012-02-17 15:04:25 +00:00
|
|
|
|
SET_JLBL(l.l);
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ipc = ipc->y_u.lp.l;
|
2009-02-12 21:35:31 +00:00
|
|
|
|
break;
|
2016-07-31 10:26:15 +01:00
|
|
|
|
/* instructions type e */
|
2003-12-01 19:22:01 +00:00
|
|
|
|
case _switch_on_type:
|
2012-02-17 15:04:25 +00:00
|
|
|
|
SET_JLBL(llll.l4);
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ipc = ipc->y_u.llll.l4;
|
2003-12-01 19:22:01 +00:00
|
|
|
|
break;
|
|
|
|
|
case _switch_list_nl:
|
2012-02-17 15:04:25 +00:00
|
|
|
|
SET_JLBL(ollll.l4);
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ipc = ipc->y_u.ollll.l4;
|
2003-12-01 19:22:01 +00:00
|
|
|
|
break;
|
|
|
|
|
case _switch_on_arg_type:
|
2012-02-17 15:04:25 +00:00
|
|
|
|
SET_JLBL(xllll.l4);
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ipc = ipc->y_u.xllll.l4;
|
2003-12-01 19:22:01 +00:00
|
|
|
|
break;
|
|
|
|
|
case _switch_on_sub_arg_type:
|
2012-02-17 15:04:25 +00:00
|
|
|
|
SET_JLBL(sllll.l4);
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ipc = ipc->y_u.sllll.l4;
|
2003-12-01 19:22:01 +00:00
|
|
|
|
break;
|
|
|
|
|
case _if_not_then:
|
2012-02-17 15:04:25 +00:00
|
|
|
|
SET_JLBL(clll.l3);
|
2014-05-30 01:06:09 +01:00
|
|
|
|
ipc = ipc->y_u.clll.l3;
|
2003-12-01 19:22:01 +00:00
|
|
|
|
break;
|
|
|
|
|
case _expand_index:
|
2004-03-31 02:02:18 +01:00
|
|
|
|
case _expand_clauses:
|
2004-02-18 01:43:32 +00:00
|
|
|
|
#if defined(YAPOR) || defined(THREADS)
|
2004-02-19 19:24:46 +00:00
|
|
|
|
if (*jlbl != (yamop *)&(ap->cs.p_code.ExpandCode)) {
|
2016-07-31 10:26:15 +01:00
|
|
|
|
ipc = *jlbl;
|
|
|
|
|
break;
|
2004-02-18 01:43:32 +00:00
|
|
|
|
}
|
|
|
|
|
#endif
|
2011-03-07 16:02:55 +00:00
|
|
|
|
ipc = ExpandIndex(ap, 0, CP PASS_REGS);
|
2007-11-26 23:43:10 +00:00
|
|
|
|
|
2003-12-01 19:22:01 +00:00
|
|
|
|
break;
|
|
|
|
|
case _op_fail:
|
|
|
|
|
ipc = alt;
|
|
|
|
|
break;
|
2007-11-26 23:43:10 +00:00
|
|
|
|
case _lock_pred:
|
2003-12-01 19:22:01 +00:00
|
|
|
|
case _index_pred:
|
|
|
|
|
case _spy_pred:
|
2010-01-29 15:21:00 +00:00
|
|
|
|
Yap_IPred(ap, 0, CP);
|
2003-12-01 19:22:01 +00:00
|
|
|
|
ipc = ap->cs.p_code.TrueCodeOfPred;
|
|
|
|
|
break;
|
2004-02-05 16:57:02 +00:00
|
|
|
|
case _undef_p:
|
2003-12-01 19:22:01 +00:00
|
|
|
|
default:
|
|
|
|
|
return NULL;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
|
2016-07-31 10:26:15 +01:00
|
|
|
|
void Yap_CleanUpIndex(LogUpdIndex *blk) {
|
2006-10-10 15:08:17 +01:00
|
|
|
|
/* just compact the code */
|
2012-02-17 15:04:25 +00:00
|
|
|
|
yamop *start = blk->ClCode;
|
2006-10-10 15:08:17 +01:00
|
|
|
|
op_numbers op = Yap_op_from_opcode(start->opc);
|
2003-09-15 02:25:29 +01:00
|
|
|
|
|
2006-10-10 15:08:17 +01:00
|
|
|
|
blk->ClFlags &= ~DirtyMask;
|
2006-10-16 18:12:48 +01:00
|
|
|
|
while (op == _lock_lu) {
|
|
|
|
|
start = NEXTOP(start, p);
|
|
|
|
|
op = Yap_op_from_opcode(start->opc);
|
|
|
|
|
}
|
2006-10-10 15:08:17 +01:00
|
|
|
|
while (op == _jump_if_nonvar) {
|
|
|
|
|
start = NEXTOP(start, xll);
|
|
|
|
|
op = Yap_op_from_opcode(start->opc);
|
2003-09-15 02:25:29 +01:00
|
|
|
|
}
|
2006-12-27 01:32:38 +00:00
|
|
|
|
remove_dirty_clauses_from_index(start);
|
2003-09-15 02:25:29 +01:00
|
|
|
|
}
|