2
** Author(s): Warren, Swift, Xu, Sagonas
3
** Contact: xsb-contact@cs.sunysb.edu
5
** Copyright (C) The Research Foundation of SUNY, 1986, 1993-1998
6
** Copyright (C) ECRC, Germany, 1990
8
** XSB is free software; you can redistribute it and/or modify it under the
9
** terms of the GNU Library General Public License as published by the Free
10
** Software Foundation; either version 2 of the License, or (at your option)
13
** XSB is distributed in the hope that it will be useful, but WITHOUT ANY
14
** WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
15
** FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for
18
** You should have received a copy of the GNU Library General Public License
19
** along with XSB; if not, write to the Free Software Foundation,
20
** Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
22
** $Id: emudef.h,v 1.59 2006/02/06 20:20:03 tswift Exp $
26
#include "debugs/debug_attv.h"
36
CPtr ereg; /* last activation record */
37
CPtr breg; /* last choice point */
38
CPtr hreg; /* top of heap */
39
CPtr *trreg; /* top of trail stack */
40
CPtr hbreg; /* heap back track point */
41
CPtr sreg; /* current build or unify field */
42
byte *cpreg; /* return point register */
43
byte *pcreg; /* program counter */
44
CPtr ebreg; /* breg into environment stack */
57
/* TLS 08/05: Root address is the address of the first tabled choice
58
point on the thread's stack. It is used to reclaim freeze
59
registers, but could be removed, I think. */
66
/* demand-freeze registers */
79
* interrupt_reg points to interrupt_counter, which stores the number of
80
* interrupts in the interrupt chain for attributed variables.
82
Cell interrupt_counter;
83
CPtr interrupt_reg = &interrupt_counter;
85
#endif /* MULTI_THREAD */
88
* Ptr to the beginning of instr. array
92
char *nil_string, *true_string;
96
Psc list_psc, comma_psc, true_psc, if_psc, colon_psc;
97
Psc tnot_psc, delay_psc;
101
* Ret PSC's are used to store substitution factors for subgoal calls
102
* or answers. A psc with a new arity will be created when needed,
103
* except that ret_psc[0] stores the pointer to STRING "ret" and is
104
* initialized when the system is started.
106
Psc ret_psc[MAX_ARITY];
108
/* TLS: changed name to accord with new global conventions. */
109
char *list_dot_string;
112
int asynint_code = 0;
116
int next_free_code = 0;
117
unsigned long enc[16] = {0xffffffff,0xffffffff,0xffffffff,0xffffffff,
118
0xffffffff,0xffffffff,0xffffffff,0xffffffff,
119
0xffffffff,0xffffffff,0xffffffff,0xffffffff,
120
0xffffffff,0xffffffff,0xffffffff,0xffffffff};
121
unsigned long dec[8] = {0xffffffff,0xffffffff,0xffffffff,0xffffffff,
122
0xffffffff,0xffffffff,0xffffffff,0xffffffff};
124
/* Replacements for labelled code in emusubs.i */
126
#define nunify_with_nil(op) \
130
bind_nil((CPtr)(op)); \
132
else if (isnil(op)) {XSB_Next_Instr();} /* op == [] */ \
133
else if (isattv(op)) { \
134
xsb_dbgmsg((LOG_ATTV,">>>> ATTV nunify_with_nil, interrupt needed\n")); \
135
/* add_interrupt(op, makenil); */ \
136
add_interrupt(CTXTc cell(((CPtr)dec_addr(op1) + 1)),makenil); \
137
bind_copy((CPtr)dec_addr(op1), makenil); \
139
else Fail1; /* op is LIST, INT, or FLOAT */
141
/*======================================================================*/
143
#define nunify_with_con(OP1,OP2) \
147
bind_string((CPtr)(OP1), (char *)OP2); \
149
else if (isstring(OP1)) { \
150
if (string_val(OP1) == (char *)OP2) {XSB_Next_Instr();} else Fail1; \
152
else if (isattv(OP1)) { \
153
xsb_dbgmsg((LOG_ATTV,">>>> ATTV nunify_with_con, interrupt needed\n")); \
154
/* add_interrupt(OP1, makestring((char *)OP2)); */ \
155
add_interrupt(CTXTc cell(((CPtr)dec_addr(op1) + 1)),makestring((char *)OP2)); \
156
bind_string((CPtr)dec_addr(op1),(char *)OP2); \
161
/*======================================================================*/
163
#define nunify_with_num(OP1,OP2) \
164
/* op1 is general, op2 has number (untagged) */ \
168
bind_oint((CPtr)(OP1), (Integer)OP2); \
170
else if (isinteger(OP1)) { \
171
if (oint_val(OP1) == (Integer)OP2) {XSB_Next_Instr();} else Fail1; \
173
else if (isattv(OP1)) { \
174
xsb_dbgmsg((LOG_ATTV,">>>> ATTV nunify_with_num, interrupt needed\n")); \
175
/* add_interrupt(OP1, OP2); */ \
176
add_interrupt(CTXTc cell(((CPtr)dec_addr(op1) + 1)),makeint(OP2)); \
177
bind_oint((CPtr)dec_addr(op1), (Integer)OP2); \
179
else Fail1; /* op1 is STRING, FLOAT, STRUCT, or LIST */
181
/*======================================================================*/
183
#define nunify_with_float(OP1,OP2) \
187
bind_float_tagged(vptr(OP1), makefloat(OP2)); \
189
else if (isofloat(OP1)) { \
190
if ( (float)ofloat_val(OP1) == OP2) { \
195
else if (isattv(OP1)) { \
196
xsb_dbgmsg((LOG_ATTV,">>>> ATTV nunify_with_float, interrupt needed\n")); \
197
/* add_interrupt(OP1, OP2); */ \
198
add_interrupt(CTXTc cell(((CPtr)dec_addr(op1) + 1)),makefloat(OP2)); \
199
bind_float_tagged((CPtr)dec_addr(op1), makefloat(OP2)); \
201
else Fail1; /* op1 is INT, STRING, STRUCT, or LIST */
203
/*======================================================================*/
205
#define nunify_with_float_get(OP1,OP2) \
209
bind_boxedfloat(vptr(OP1), OP2); \
211
else if (isofloat(OP1)) { \
212
if ( (float)ofloat_val(OP1) == OP2) { \
217
else if (isattv(OP1)) { \
218
xsb_dbgmsg((LOG_ATTV,">>>> ATTV nunify_with_float, interrupt needed\n")); \
219
/* add_interrupt(OP1, OP2); */ \
220
add_interrupt(CTXTc cell(((CPtr)dec_addr(op1) + 1)),makefloat(OP2)); \
221
bind_boxedfloat((CPtr)dec_addr(op1), OP2); \
223
else Fail1; /* op1 is INT, STRING, STRUCT, or LIST */
225
/*======================================================================*/
227
#define nunify_with_str(OP1,OP2) \
228
/* struct psc_rec *str_ptr; using op2 */ \
232
bind_cs((CPtr)(OP1), (Pair)hreg); \
233
new_heap_functor(hreg, (Psc)OP2); \
236
else if (isconstr(OP1)) { \
237
OP1 = (Cell)(cs_val(OP1)); \
238
if (*((Psc *)OP1) == (Psc)OP2) { \
240
sreg = (CPtr)OP1 + 1; \
244
else if ((Psc)OP2 == box_psc) { \
247
bld_boxedfloat(CTXTc &ignore_addr, float_val(OP1)); \
248
else if (isinteger(OP1)) \
249
{bld_oint(&ignore_addr, int_val(OP1));} \
252
} else if (isattv(OP1)) { \
253
xsb_dbgmsg((LOG_ATTV,">>>> ATTV nunify_with_str, interrupt needed\n")); \
254
/* add_interrupt(OP1, makecs(hreg)); */ \
255
add_interrupt(CTXTc cell(((CPtr)dec_addr(op1) + 1)),makecs(hreg)); \
256
bind_copy((CPtr)dec_addr(op1), makecs(hreg)); \
257
new_heap_functor(hreg, (Psc)OP2); \
262
/*======================================================================*/
264
#define nunify_with_list_sym(OP1) \
268
bind_list((CPtr)(OP1), hreg); \
271
else if (islist(OP1)) { \
272
sreg = clref_val(OP1); \
275
else if (isattv(OP1)) { \
276
xsb_dbgmsg((LOG_ATTV,">>>> ATTV nunify_with_list_sym, interrupt needed\n")); \
277
/* add_interrupt(OP1, makelist(hreg)); */ \
278
add_interrupt(CTXTc cell(((CPtr)dec_addr(op1) + 1)),makelist(hreg));\
279
bind_copy((CPtr)dec_addr(op1), makelist(hreg)); \
284
/*======================================================================*/
287
* In getattv, the flag will always be WRITE. The unification will be
289
* This operation is used in the getattv instruction, emitted for
290
* asserted code with attributed variables.
297
* Put [reference to href + 1|X] in the interrupt queue.
299
* Set the WRITE flag to have the next instructions put the attribute
302
* The interrupt should not be handled before the attribute is created.
304
#define nunify_with_attv(OP1) { \
307
bind_attv((CPtr)(OP1), hreg); \
308
new_heap_free(hreg); /* the VAR part of the attv */ \
311
xsb_dbgmsg((LOG_ATTV,">>>> nunify_with_attv, interrupt needed\n")); \
312
/* add_interrupt(makeattv(hreg), OP1); */ \
313
*hreg = OP1; hreg++; \
314
add_interrupt(CTXTc (Integer)hreg, OP1); \
319
/*======================================================================*/
321
/* TLS: refactored to support Thread Cancellation */
323
#define call_sub(PSC) { \
324
if ( !(asynint_val) & !int_val(cell(interrupt_reg)) ) { \
325
lpcreg = (pb)get_ep(PSC); \
328
if (asynint_val & KEYINT_MARK) { \
329
synint_proc(CTXTc PSC, MYSIG_KEYB); \
331
asynint_val = asynint_val & ~KEYINT_MARK; \
333
} else if (asynint_val & PROFINT_MARK) { \
334
asynint_val &= ~PROFINT_MARK; \
335
log_prog_ctr(lpcreg); \
336
lpcreg = (byte *)get_ep(PSC); \
337
} else if (asynint_val & MSGINT_MARK) { \
338
pcreg = (byte *)get_ep(PSC); \
339
intercept(CTXTc PSC); \
341
} else if (asynint_val & THREADINT_MARK) { \
342
printf("Entered thread cancel: call_sub\n"); \
343
synint_proc(CTXTc PSC, THREADSIG_CANCEL); \
348
lpcreg = (byte *)get_ep(PSC); \
351
} else if (int_val(cell(interrupt_reg))) { \
352
synint_proc(CTXTc PSC, MYSIG_ATTV); \
358
#define proceed_sub { \
359
if ( !(asynint_val) & !int_val(cell(interrupt_reg)) ) { \
363
if (asynint_val & KEYINT_MARK) { \
364
synint_proc(CTXTc true_psc, MYSIG_KEYB); \
366
asynint_val = asynint_val & ~KEYINT_MARK; \
368
} else if (asynint_val & MSGINT_MARK) { \
369
lpcreg = cpreg; /* ignore MSGINT in proceed */ \
370
} else if (asynint_val & PROFINT_MARK) { \
371
asynint_val &= ~PROFINT_MARK; \
372
log_prog_ctr(lpcreg); \
375
} else if (asynint_val & THREADINT_MARK) { \
376
printf("Entered thread cancel: proceed\n"); \
377
synint_proc(CTXTc true_psc, THREADSIG_CANCEL); \
385
} else if (int_val(cell(interrupt_reg))) { \
386
synint_proc(CTXTc true_psc, MYSIG_ATTV); \
added
removed
emu/emudef.h
