YAP
7.1.0
or.sba_amiops.h
1
/************************************************************************
2
** **
3
** The YapTab/YapOr/OPTYap systems **
4
** **
5
** YapTab extends the Yap Prolog engine to support sequential tabling **
6
** YapOr extends the Yap Prolog engine to support or-parallelism **
7
** OPTYap extends the Yap Prolog engine to support or-parallel tabling **
8
** **
9
** **
10
** Yap Prolog was developed at University of Porto, Portugal **
11
** **
12
************************************************************************/
13
14
#ifdef SCCS
15
static
char
SccsId[] =
"%W% %G%"
;
16
#endif
/* SCCS */
17
18
// keep eclipse happy, avoiding collisions with amiops.h
19
#ifdef YAPOR_SBA
20
21
#define IsArrayReference(a) ((a)->array_access_func == FunctorArrayAccess)
22
23
/* dereferencing macros */
24
25
/************************************************************
26
27
Dereferencing macros
28
29
*************************************************************/
30
31
/* For DEREFD, D has both the input and the exit argument */
32
/* A is only used locally */
33
34
#define deref_head(D,Label) if (IsVarTerm(D)) goto Label
35
36
#define deref_body(D,A,LabelUnk,LabelNonVar) \
37
do { \
38
if(!IsVarTerm(D)) goto LabelNonVar; \
39
LabelUnk: \
40
(A) = (CELL *)(D); \
41
(D) = *(CELL *)(D); \
42
} while (0 != (D))
43
44
#define derefa_body(D,A,LabelUnk,LabelNonVar) \
45
do { \
46
(A) = (CELL *)(D); \
47
(D) = *(CELL *)(D); \
48
if(!IsVarTerm(D)) goto LabelNonVar; \
49
LabelUnk: \
50
} while (0 != (D))
51
52
#if UNIQUE_TAG_FOR_PAIRS
53
54
/* If you have an unique tag for pairs you can use these macros which will
55
speed up detection of dereferenced pairs, but will be slow
56
for the other cases.
57
58
The only instruction where this seems useful is
59
switch_list_nl
60
*/
61
62
#define deref_list_head(D,Label) if (!IsPairTerm(D)) goto Label
63
64
#define deref_list_body(D,A,LabelList,LabelNonVar) \
65
do { \
66
if (!IsVarTerm(D)) goto LabelNonVar; \
67
(A) = (CELL *)(D); \
68
(D) = *(A); \
69
if (0 == (D)) break; \
70
if (IsPairTerm(D)) goto LabelList; \
71
} while (TRUE);
72
#endif
/* UNIQUE_TAG_FOR_PAIRS */
73
74
EXTERN
inline
Term Deref(Term a)
75
{
76
while
(IsVarTerm(a)) {
77
Term *b = (Term *) a;
78
a = *b;
79
if
(a==0)
return
(Term)b;
80
}
81
return
(a);
82
}
83
84
EXTERN
inline
Term Derefa(CELL *b)
85
{
86
Term a = *b;
87
restart:
88
if
(!IsVarTerm(a)) {
89
return
(a);
90
}
else
if
(a == 0) {
91
return
((CELL)b);
92
}
else
{
93
b = (CELL *)a;
94
a = *b;
95
goto
restart;
96
}
97
}
98
99
/************************************************************
100
101
TRAIL VARIABLE
102
103
A contains the address of the variable that is to be trailed
104
105
*************************************************************/
106
107
108
/* #define TRAIL(A) if ((A) < HBREG || (A) > B) TrailTerm(TR++) = Unsigned(A)
109
*/
110
111
#define RESET_VARIABLE(V) (*(CELL *)(V) = 0)
112
113
#if SIZEOF_DOUBLE == 2*SIZEOF_INT_P
114
inline
EXTERN
void
115
AlignGlobalForDouble(
void
)
116
{
117
/* Force Alignment for floats. Note that garbage collector may
118
break the alignment; */
119
if
(!DOUBLE_ALIGNED(H)) {
120
RESET_VARIABLE(H);
121
H++;
122
}
123
}
124
#endif
/* SIZEOF_DOUBLE == 2*SIZEOF_INT_P */
125
126
#ifdef YAPOR
127
128
#define DO_TRAIL(TERM, VAL) \
129
{ \
130
register tr_fr_ptr r; \
131
r = TR; \
132
TR = r + 1; \
133
TrailTerm(r) = (CELL) (TERM); \
134
TrailVal(r) = (VAL); \
135
}
136
137
#define DO_MATRAIL(TERM, OLDVAL, NEWVAL) \
138
{ \
139
register tr_fr_ptr r = TR+1; \
140
TrailTerm(TR) = (OLDVAL);
/* disgusting hack */
\
141
TrailTerm(r) = AbsAppl(TERM); \
142
TrailVal(r) = (NEWVAL); \
143
TR = r+1; \
144
}
145
146
#define TRAIL_REF(REF) TrailTerm(TR++) = AbsPair(((CELL *)(REF)))
147
148
/* convert to offset */
149
#define STACK_TO_SBA(A) (CELL *)(((char *)(A)+sba_offset))
150
151
#define IN_SBA(A) ((CELL)((char *)(A)-binding_array) < sba_size)
152
153
#define SBA_TO_STACK(A) (CELL *)(((char *)(A)-sba_offset))
154
155
/* put the binding in the SBA and force ptr to point there */
156
#define BIND_SHARED_VARIABLE(A, D) { \
157
CELL *ptr; \
158
/*shared_binds++;*/
\
159
if (IN_SBA(A)) { \
160
ptr = SBA_TO_STACK(A); \
161
DO_TRAIL(ptr,D); \
162
*(A) = (D); \
163
} else { \
164
DO_TRAIL((A),D); \
165
ptr = STACK_TO_SBA(A); \
166
*(A) = (CELL)ptr; \
167
*ptr = (D); \
168
} \
169
}
170
171
/* put the binding in the SBA and force ptr to point there */
172
#define MABIND_SHARED_VARIABLE(A, D) { \
173
/*shared_binds++;*/
\
174
if (IN_SBA(A)) { \
175
CELL *sptr = SBA_TO_STACK(A); \
176
DO_MATRAIL(sptr, *(A), D); \
177
*(A) = (D); \
178
} else { \
179
CELL *ptr3; \
180
DO_MATRAIL((A), *(A), D); \
181
ptr3 = STACK_TO_SBA(A); \
182
*(A) = (CELL)ptr3; \
183
*ptr3 = (D); \
184
} \
185
}
186
187
extern
int
condit_binds, shared_binds, uncond_binds;
188
189
/* put the binding in the stacks even though it is conditional */
190
#define BIND_CONDITIONALLY(A, D) { \
191
DO_TRAIL(A,D); \
192
/*condit_binds++; */
\
193
*(A) = (D); \
194
}
195
196
/* put the binding in the stacks even though it is conditional */
197
#define MABIND_CONDITIONALLY(A, D) { \
198
DO_MATRAIL(A,*(A),D); \
199
/*condit_binds++; */
\
200
*(A) = (D); \
201
}
202
203
#define DO_CONDITIONAL_BINDING(A,D) { \
204
if (Unsigned((Int)(A)-(Int)(H_FZ)) > \
205
Unsigned((Int)(B_FZ)-(Int)(H_FZ))) \
206
{ BIND_SHARED_VARIABLE(A, D); } \
207
else { BIND_CONDITIONALLY(A,D); } \
208
}
209
210
#define DO_CONDITIONAL_MABINDING(A,D) { \
211
if (Unsigned((Int)(A)-(Int)(H_FZ)) > \
212
Unsigned((Int)(B_FZ)-(Int)(H_FZ))) \
213
{ MABIND_SHARED_VARIABLE(A, D); } \
214
else { MABIND_CONDITIONALLY(A,D); } \
215
}
216
217
#define YapBind(A,D) { \
218
if (Unsigned((Int)(A)-(Int)(HBREG)) > \
219
Unsigned(BBREG)-(Int)(HBREG)) \
220
{ DO_CONDITIONAL_BINDING(A, D); } \
221
else
/* uncond_binds++, */
*(A) = (D); \
222
}
223
224
#define BIND(A,D,L) YapBind(A,D)
225
226
#define MaBind(A,D) { \
227
if (Unsigned((Int)(A)-(Int)(HBREG)) > \
228
Unsigned(BBREG)-(Int)(HBREG)) \
229
{ DO_CONDITIONAL_MABINDING(A, D); } \
230
else
/* uncond_binds++, */
*(A) = (D); \
231
}
232
233
/* I can't gain much here because of the frozen registers */
234
#define Bind_Global(A,D) YapBind(A,D)
235
236
#define Bind_Local(A,D) YapBind(A,D)
237
238
#define BIND_GLOBAL(A,D,L) YapBind(A,D)
239
240
#define BIND_GLOBAL2(A,D,L1,L2) YapBind(A,D)
241
242
#define BIND_GLOBALCELL(A,D) YapBind(A,D); continue
243
244
#else
/* YAPOR */
245
#ifdef TABLING
246
#define DO_TRAIL(TERM, VAL) \
247
{ \
248
register tr_fr_ptr r; \
249
r = TR; \
250
TR = r + 1; \
251
TrailTerm(r) = (CELL) (TERM); \
252
TrailVal(r) = (VAL); \
253
}
254
255
#define DO_MATRAIL(TERM, OLDVAL, VAL) \
256
{ \
257
register tr_fr_ptr r = TR+1; \
258
TrailTerm(TR) = (OLDVAL);
/* disgusting hack */
\
259
TR = r + 1; \
260
TrailTerm(r) = AbsAppl((CELL *)(TERM)); \
261
TrailVal(r) = (NEWVAL); \
262
}
263
264
#define TRAIL(TERM, VAL) \
265
if (Unsigned((Int)(TERM)-(Int)(HBREG)) > \
266
Unsigned((Int)(B)-(Int)(HBREG))) \
267
DO_TRAIL(TERM, VAL)
268
269
#define MATRAIL(TERM, OVAL, VAL) \
270
if (Unsigned((Int)(TERM)-(Int)(HBREG)) > \
271
Unsigned((Int)(B)-(Int)(HBREG))) \
272
DO_MATRAIL(TERM, OVAL, VAL)
273
274
#define TRAIL_GLOBAL(TERM, VAL) \
275
if ((TERM) < HBREG) DO_TRAIL(TERM, VAL)
276
277
#define TRAIL_LOCAL(TERM, VAL) \
278
if ((TERM) > (CELL *)B) DO_TRAIL(TERM, VAL)
279
280
#define TRAIL_REF(REF) TrailTerm(TR++) = AbsPair(((CELL *)(REF)))
281
282
#define YapBind(A,D) { TRAIL(A,D); *(A) = (D); }
283
284
#define MaBind(A,D) { MATRAIL(A,*(A),D); *(A) = (D); }
285
286
#define Bind_Global(A,D) { TRAIL_GLOBAL(A,D); *(A) = (D); }
287
288
#define Bind_Local(A,D) { TRAIL_LOCAL(A,D); *(A) = (D); }
289
290
#else
/* TABLING */
291
292
#ifdef i386
293
294
#define DO_TRAIL(A) \
295
{ \
296
register tr_fr_ptr r; \
297
r = TR; \
298
TR = r+1; \
299
TrailTerm(r) = (CELL)(A); \
300
}
301
302
303
#define TRAIL(A) if (Unsigned((Int)(A)-(Int)(HBREG)) > \
304
Unsigned((Int)(B)-(Int)(HBREG))) \
305
DO_TRAIL(A);
306
307
#define TRAIL_GLOBAL(A) if ((A) < HBREG) DO_TRAIL(A);
308
309
#define TRAIL_LOCAL(A) if ((A) > (CELL *)B) DO_TRAIL(A);
310
311
312
#elif __alpha
313
314
/* alpha machines have a move conditional instruction, which avoids a
315
branch when jumping */
316
#define TRAIL(A) TrailTerm(TR) = (CELL)(A); \
317
if (Unsigned((Int)(A)-(Int)(HBREG)) > \
318
Unsigned((Int)(B)-(Int)(HBREG))) \
319
TR++
320
321
#define TRAIL_GLOBAL(A) TR[0] = (CELL)(A); if ((A) < HBREG) TR++
322
323
#define TRAIL_LOCAL(A) TR[0] = (CELL)(A); if ((A) > ((CELL *)(B))) TR++
324
325
#else
326
327
#define DO_TRAIL(A) TrailTerm(TR++) = (CELL)(A)
328
329
#define TRAIL(A) if (Unsigned((Int)(A)-(Int)(HBREG)) > \
330
Unsigned((Int)(B)-(Int)(HBREG))) \
331
DO_TRAIL(A)
332
333
#define TRAIL_GLOBAL(A) if ((A) < HBREG) DO_TRAIL(A)
334
335
#define TRAIL_LOCAL(A) if ((A) > ((CELL *)B)) DO_TRAIL(A)
336
337
#endif
/* i386, _alpha */
338
339
#define TRAIL_REF(Ref) (TrailTerm(TR++) = AbsPair(((CELL *)(Ref))))
340
341
/************************************************************
342
343
BINDING MACROS
344
345
A contains the address of the variable that is to be bound
346
D contains the value it will be bound to
347
348
*************************************************************/
349
350
#define YapBind(A,D) { TRAIL(A); *(A) = (D); }
351
352
#define Bind_Global(A,D) { TRAIL_GLOBAL(A); *(A) = (D); }
353
354
#define Bind_Local(A,D) { TRAIL_LOCAL(A); *(A) = (D); }
355
356
/************************************************************
357
358
Binding Macros for Multiple Assignment Variables.
359
360
************************************************************/
361
362
#define MA_TRAIL(A) if (Unsigned((Int)(A)-(Int)(HBREG)) > \
363
Unsigned((Int)(B)-(Int)(HBREG))) \
364
{ TrailTerm(TR++) = *(A); \
365
TrailTerm(TR++) = AbsAppl(A); \
366
}
367
368
#define MaBind(A,D) { MA_TRAIL(A); *(A) = (D); }
369
370
#endif
/* TABLING */
371
#endif
/* YAPOR */
372
373
#ifdef YAPOR
374
375
/* these two fields are used for memory management with the
376
clean_up_node instruction in the YAPOR/SBA implementation */
377
#define CP_FREE(B) ((int)((B)->cp_env))
378
#define CP_NEXT(B) ((choiceptr)((B)->cp_cp))
379
380
#endif
/* YAPOR */
381
382
#define DBIND(A,D,L) BIND(A,D,L)
383
384
#define EQ_OK_IN_CMP 1
385
#define LT_OK_IN_CMP 2
386
#define GT_OK_IN_CMP 4
387
388
#endif
/* YAPOR_SBA */
OPTYap
or.sba_amiops.h
Generated by
1.9.3