00001 /* File: cut_xsb.h 00002 ** Author(s): Kostis Sagonas 00003 ** Contact: xsb-contact@cs.sunysb.edu 00004 ** 00005 ** Copyright (C) The Research Foundation of SUNY, 1986, 1993-1998 00006 ** 00007 ** XSB is free software; you can redistribute it and/or modify it under the 00008 ** terms of the GNU Library General Public License as published by the Free 00009 ** Software Foundation; either version 2 of the License, or (at your option) 00010 ** any later version. 00011 ** 00012 ** XSB is distributed in the hope that it will be useful, but WITHOUT ANY 00013 ** WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 00014 ** FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for 00015 ** more details. 00016 ** 00017 ** You should have received a copy of the GNU Library General Public License 00018 ** along with XSB; if not, write to the Free Software Foundation, 00019 ** Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 00020 ** 00021 ** $Id: cut_xsb.h,v 1.20 2006/05/22 15:06:48 tswift Exp $ 00022 ** 00023 */ 00024 00025 #ifndef __CUT_XSB_H__ 00026 #define __CUT_XSB_H__ 00027 00028 /*----------------------------------------------------------------------*/ 00029 /* This file contains code for cuts. It was written in December 1997 */ 00030 /* by Kostis Sagonas based on the code written by Terry Swift and Rui */ 00031 /* Marques for unwinding the trail. The input of Bart Demoen is also */ 00032 /* acknowledged. */ 00033 /* */ 00034 /* The main problem is to find which part of the trail to clean up. */ 00035 /* Cleaning the trail means deleting trail frames for bindings that are */ 00036 /* no longer conditional, i.e. unbinding these variables. In general, */ 00037 /* one needs to tidy/unwind the part of the trail that lies between the */ 00038 /* current choice point (breg) and the choice point that is immediately */ 00039 /* _after_ the choice point that we are really cut back to (cut_breg). */ 00040 /* Of course, if we are cutting to the current choice point which often */ 00041 /* happens, or if there is nothing in between, there is no need to */ 00042 /* check whether there is trail to unwind. */ 00043 /* This is the general scheme and the code that pretty much implements */ 00044 /* this, is as follows: */ 00045 /* */ 00046 /* #define cut_code(OP1) */ 00047 /* XSB_Deref(OP1); */ 00048 /* cut_breg = (CPtr)(tcpstack.high - oint_val(OP1)); */ 00049 /* cut_restore_trail_condition_registers(cut_breg); */ 00050 /* if (breg != cut_breg) { */ 00051 /* while (cp_prevbreg(breg) != cut_breg) */ 00052 /* breg = cp_prevbreg(breg); */ 00053 /* unwind_trail(breg,xtemp1,xtemp2); */ 00054 /* breg = cut_breg; */ 00055 /* } goto contcase; */ 00056 /* */ 00057 /*----------------------------------------------------------------------*/ 00058 00059 #define IS_TABLE_INSTRUC(instruc) \ 00060 (instruc == check_complete || \ 00061 instruc == resume_compl_suspension || \ 00062 instruc == answer_return || \ 00063 instruc == tabletrust || \ 00064 instruc == tableretry ) 00065 00066 00067 // if (check_table_cut && IS_TABLE_INSTRUC(instruc) && 00068 00069 #define CHECK_TABLE_CUT(instruc) \ 00070 if (IS_TABLE_INSTRUC(instruc) && !is_completed(tcp_subgoal_ptr(breg))) {\ 00071 Psc psc = TIF_PSC(subg_tif_ptr(tcp_subgoal_ptr(breg)));\ 00072 Psc call_psc = *(*((Psc **)ereg-1)-1); \ 00073 printf("Illegal cut over incomplete tabled predicate: %s/%d, from within a call to %s/%d\n", \ 00074 get_name(psc), get_arity(psc), \ 00075 get_name(call_psc), get_arity(call_psc)); \ 00076 xsb_abort("Illegal cut over a tabled predicate: %s/%d, from within a call to %s/%d\n", \ 00077 get_name(psc), get_arity(psc), \ 00078 get_name(call_psc), get_arity(call_psc)); \ 00079 } 00080 00081 #define cut_code(OP1) \ 00082 { CPtr cut_breg; \ 00083 byte inst_cut_over; \ 00084 CPtr xtemp1, xtemp2; \ 00085 \ 00086 XSB_Deref(OP1); \ 00087 cut_breg = (CPtr)(tcpstack.high - oint_val(OP1)); \ 00088 cut_restore_trail_condition_registers(cut_breg); \ 00089 if (breg != cut_breg) { /* not cutting back to the current CP */\ 00090 while (cp_prevbreg(breg) != cut_breg) { \ 00091 inst_cut_over = *cp_pcreg(breg); \ 00092 CHECK_TABLE_CUT(inst_cut_over) ; \ 00093 breg = cp_prevbreg(breg); \ 00094 } \ 00095 inst_cut_over = *cp_pcreg(breg); \ 00096 CHECK_TABLE_CUT(inst_cut_over) ; \ 00097 unwind_trail(breg,xtemp1,xtemp2); \ 00098 breg = cut_breg; \ 00099 } \ 00100 /* check_table_cut = TRUE; */ \ 00101 XSB_Next_Instr(); \ 00102 } 00103 00104 /*----------------------------------------------------------------------*/ 00105 /* Takes a pointer to the choice point frame we are cutting back to. */ 00106 /*----------------------------------------------------------------------*/ 00107 00108 #define cut_restore_trail_condition_registers(CUTB) \ 00109 restore_trail_condition_registers(CUTB) 00110 00111 /* 00112 #define cut_restore_trail_condition_registers(CUTB) \ 00113 if ((CPtr) *CUTB >= (CPtr) pdl.low || \ 00114 *CUTB == (Cell) &answer_return_inst || \ 00115 *CUTB == (Cell) &resume_compl_suspension_inst ||\ 00116 *CUTB == (Cell) &resume_compl_suspension_inst2) { \ 00117 ebreg = cp_ebreg(CUTB); \ 00118 hbreg = cp_hreg(CUTB); \ 00119 } 00120 */ 00121 00122 /* 00123 #define cut_restore_trail_condition_registers(CUTB) \ 00124 if ((CPtr) *CUTB >= (CPtr) pdl.low || \ 00125 *CUTB == (Cell) &answer_return_inst || \ 00126 *CUTB == (Cell) &resume_compl_suspension_inst) { \ 00127 ebreg = cp_ebreg(CUTB); \ 00128 hbreg = cp_hreg(CUTB); \ 00129 } 00130 */ 00131 00132 /*----------------------------------------------------------------------*/ 00133 /* Deletes all trail frames that are no longer conditional. */ 00134 /* Most probably, it does *NOT* work for cuts over tables!! */ 00135 /*----------------------------------------------------------------------*/ 00136 00137 #define trail_parent(t) ((CPtr *)*(t)) 00138 #define trail_value(t) ((CPtr *)*((t)-1)) 00139 #define trail_variable(t) ((CPtr *)*((t)-2)) 00140 #define good_trail_register(t) (conditional(((CPtr) *((t)-2)))) 00141 00142 #define unwind_trail(tbreg, t1, t2) { \ 00143 while (trreg > trfreg && \ 00144 !good_trail_register(trreg) && \ 00145 trreg > cp_trreg(tbreg)) \ 00146 trreg = trail_parent(trreg); \ 00147 (t2) = (CPtr) trail_parent((t1) = (CPtr)trreg); \ 00148 while ((t2) > (CPtr) cp_trreg(tbreg) && (t2) > (CPtr) trfreg) { \ 00149 if (!good_trail_register(t2)) { \ 00150 (t2) = (CPtr) trail_parent(t2); \ 00151 *(t1) = (Cell) (t2); \ 00152 } else { \ 00153 (t1) = (t2); \ 00154 (t2) = (CPtr) trail_parent(t2); \ 00155 } \ 00156 } \ 00157 } 00158 00159 00160 #endif /* __CUT_XSB_H__ */
1.4.5