1
2
3
4
5
6
7
8 /*************************************************************************
9 * *
10 * YAP Prolog %W% %G% *
11 * Yap Prolog was developed at NCCUP - Universidade do Porto *
12 * *
13 * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
14 * *
15 **************************************************************************
16 * *
17 * File: TermExt.h *
18 * mods: *
19 * comments: Extensions to standard terms for YAP *
20 * version: $Id: TermExt.h,v 1.9 2002-06-01 04:29:01 vsc Exp $ *
21 *************************************************************************/
22
23 #if USE_OFFSETS
24 #define AtomFoundVar ((Atom)(&(((special_functors *)(NULL))->AtFoundVar)))
25 #define AtomNil ((Atom)(&(((special_functors *)(NULL))->AtNil)))
26 #define AtomDot ((Atom)(&(((special_functors *)(NULL))->AtDot)))
27 #else
28 #define AtomFoundVar AbsAtom(&(SF_STORE->AtFoundVar))
29 #define AtomNil AbsAtom(&(SF_STORE->AtNil))
30 #define AtomDot AbsAtom(&(SF_STORE->AtDot))
31 #endif
32
33 #define TermFoundVar MkAtomTerm(AtomFoundVar)
34 #define TermNil MkAtomTerm(AtomNil)
35 #define TermDot MkAtomTerm(AtomDot)
36
37 #ifdef IN_SECOND_QUADRANT
38 typedef enum {
39 db_ref_e = sizeof(Functor *)|RBIT,
40 long_int_e = 2*sizeof(Functor *)|RBIT,
41 #ifdef USE_GMP
42 big_int_e = 3*sizeof(Functor *)|RBIT,
43 double_e = 4*sizeof(Functor *)|RBIT
44 #else
45 double_e = 3*sizeof(Functor *)|RBIT
46 #endif
47 } blob_type;
48 #else
49 typedef enum {
50 db_ref_e = sizeof(Functor *),
51 long_int_e = 2*sizeof(Functor *),
52 #ifdef USE_GMP
53 big_int_e = 3*sizeof(Functor *),
54 double_e = 4*sizeof(Functor *)
55 #else
56 double_e = 3*sizeof(Functor *)
57 #endif
58 } blob_type;
59 #endif
60
61 #define FunctorDBRef ((Functor)(db_ref_e))
62 #define FunctorLongInt ((Functor)(long_int_e))
63 #ifdef USE_GMP
64 #define FunctorBigInt ((Functor)(big_int_e))
65 #endif
66 #define FunctorDouble ((Functor)(double_e))
67 #define EndSpecials (double_e)
68
69
70 inline EXTERN blob_type BlobOfFunctor(Functor f);
71
BlobOfFunctor(Functor f)72 inline EXTERN blob_type BlobOfFunctor(Functor f)
73 {
74 return (blob_type) ((CELL)f);
75 }
76
77
78
79 #define SF_STORE ((special_functors *)HEAP_INIT_BASE)
80
81 #ifdef COROUTINING
82
83 typedef struct {
84 /* what to do when someone tries to bind our term to someone else
85 in some predefined context */
86 void (*bind_op)(Term *, Term);
87 /* what to do if someone wants to copy our constraint */
88 int (*copy_term_op)(CELL *, CELL ***, CELL *);
89 /* copy the constraint into a term and back */
90 Term (*to_term_op)(CELL *);
91 int (*term_to_op)(Term, Term);
92 /* op called to do marking in GC */
93 void (*mark_op)(CELL *);
94 } ext_op;
95
96 /* known delays */
97 typedef enum {
98 empty_ext = 0*sizeof(ext_op), /* default op, this should never be called */
99 susp_ext = 1*sizeof(ext_op), /* support for delayable goals */
100 attvars_ext = 2*sizeof(ext_op), /* support for attributed variables */
101 /* add your own extensions here */
102 /* keep this one */
103 } exts;
104
105
106 /* array with the ops for your favourite extensions */
107 extern ext_op attas[attvars_ext+1];
108
109 #endif
110
111 /* make sure that these data structures are the first thing to be allocated
112 in the heap when we start the system */
113 typedef struct special_functors_struct
114 {
115 AtomEntry AtFoundVar;
116 char AtFoundVarChars[8];
117 AtomEntry AtNil;
118 char AtNilChars[8];
119 AtomEntry AtDot;
120 char AtDotChars[8];
121 }
122 special_functors;
123
124 #if SIZEOF_DOUBLE == SIZEOF_LONG_INT
125
126 inline EXTERN Term MkFloatTerm(Float);
127
MkFloatTerm(Float dbl)128 inline EXTERN Term MkFloatTerm(Float dbl)
129 {
130 return (Term) ((H[0] = (CELL)FunctorDouble, *(Float *)(H+1) = dbl, H[2]=((2*sizeof(CELL)+EndSpecials)|MBIT),H+=3,AbsAppl(H-3)));
131 }
132
133
134
135
136 inline EXTERN Float FloatOfTerm(Term t);
137
FloatOfTerm(Term t)138 inline EXTERN Float FloatOfTerm(Term t)
139 {
140 return (Float) (*(Float *)(RepAppl(t)+1));
141 }
142
143
144
145 #define InitUnalignedFloat()
146
147 #else
148
149 #if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
150
151 #ifdef i386X
152 #define DOUBLE_ALIGNED(ADDR) TRUE
153 #else
154 /* first, need to address the alignment problem */
155 #define DOUBLE_ALIGNED(ADDR) ((CELL)(ADDR) & 0x4)
156 #endif
157
158 inline EXTERN Float STD_PROTO(CpFloatUnaligned,(CELL *));
159
160
161 inline EXTERN void STD_PROTO(AlignGlobalForDouble,(void));
162
163 inline EXTERN Float
CpFloatUnaligned(CELL * ptr)164 CpFloatUnaligned(CELL *ptr)
165 {
166 union { Float f; CELL d[2]; } u;
167 u.d[0] = ptr[1];
168 u.d[1] = ptr[2];
169 return(u.f);
170 }
171
172
173 inline EXTERN Term MkFloatTerm(Float);
174
MkFloatTerm(Float dbl)175 inline EXTERN Term MkFloatTerm(Float dbl)
176 {
177 return (Term) ((AlignGlobalForDouble(), H[0] = (CELL)FunctorDouble, *(Float *)(H+1) = dbl, H[3]=((3*sizeof(CELL)+EndSpecials)|MBIT), H+=4, AbsAppl(H-4)));
178 }
179
180
181
182
183 inline EXTERN Float FloatOfTerm(Term t);
184
FloatOfTerm(Term t)185 inline EXTERN Float FloatOfTerm(Term t)
186 {
187 return (Float) ((DOUBLE_ALIGNED(RepAppl(t)) ? *(Float *)(RepAppl(t)+1) : CpFloatUnaligned(RepAppl(t))));
188 }
189
190
191 /* no alignment problems for 64 bit machines */
192 #else
193 /* OOPS, YAP only understands Floats that are as large as cells or that
194 take two cells!!! */
195 #endif
196 #endif
197
198
199 inline EXTERN int IsFloatTerm(Term);
200
IsFloatTerm(Term t)201 inline EXTERN int IsFloatTerm(Term t)
202 {
203 return (int) (IsApplTerm(t) && FunctorOfTerm(t) == FunctorDouble);
204 }
205
206
207
208
209 /* extern Functor FunctorLongInt; */
210
211 inline EXTERN Term MkLongIntTerm(Int);
212
MkLongIntTerm(Int i)213 inline EXTERN Term MkLongIntTerm(Int i)
214 {
215 return (Term) ((H[0] = (CELL)FunctorLongInt,H[1] = (CELL)(i),H[2]=((2*sizeof(CELL)+EndSpecials)|MBIT),H+=3,AbsAppl(H-3)));
216 }
217
218
219
220 inline EXTERN Int LongIntOfTerm(Term t);
221
LongIntOfTerm(Term t)222 inline EXTERN Int LongIntOfTerm(Term t)
223 {
224 return (Int) (RepAppl(t)[1]);
225 }
226
227
228
229 inline EXTERN int IsLongIntTerm(Term);
230
IsLongIntTerm(Term t)231 inline EXTERN int IsLongIntTerm(Term t)
232 {
233 return (int) (IsApplTerm(t) && FunctorOfTerm(t) == FunctorLongInt);
234 }
235
236
237
238
239 #ifdef USE_GMP
240 #include <stdio.h>
241 #include <gmp.h>
242
243
244 MP_INT *STD_PROTO(PreAllocBigNum,(void));
245 MP_INT *STD_PROTO(InitBigNum,(Int));
246 Term STD_PROTO(MkBigIntTerm, (MP_INT *));
247 MP_INT *STD_PROTO(BigIntOfTerm, (Term));
248 void STD_PROTO(CleanBigNum,(void));
249
250
251 inline EXTERN int IsBigIntTerm(Term);
252
IsBigIntTerm(Term t)253 inline EXTERN int IsBigIntTerm(Term t)
254 {
255 return (int) (IsApplTerm(t) && FunctorOfTerm(t) == FunctorBigInt);
256 }
257
258
259
260
261 inline EXTERN int IsLargeIntTerm(Term);
262
IsLargeIntTerm(Term t)263 inline EXTERN int IsLargeIntTerm(Term t)
264 {
265 return (int) (IsApplTerm(t) && ((FunctorOfTerm(t) <= FunctorBigInt) && (FunctorOfTerm(t) >= FunctorLongInt)));
266 }
267
268
269
270 #else
271
272
273 inline EXTERN int IsBigIntTerm(Term);
274
IsBigIntTerm(Term t)275 inline EXTERN int IsBigIntTerm(Term t)
276 {
277 return (int) (FALSE);
278 }
279
280
281
282
283 inline EXTERN int IsLargeIntTerm(Term);
284
IsLargeIntTerm(Term t)285 inline EXTERN int IsLargeIntTerm(Term t)
286 {
287 return (int) (IsApplTerm(t) && FunctorOfTerm(t) == FunctorLongInt);
288 }
289
290
291
292 #endif
293
294 /* extern Functor FunctorLongInt; */
295
296 inline EXTERN int IsLargeNumTerm(Term);
297
IsLargeNumTerm(Term t)298 inline EXTERN int IsLargeNumTerm(Term t)
299 {
300 return (int) (IsApplTerm(t) && ((FunctorOfTerm(t) <= FunctorDouble) && (FunctorOfTerm(t) >= FunctorLongInt)));
301 }
302
303
304
305
306 inline EXTERN int IsNumTerm(Term);
307
IsNumTerm(Term t)308 inline EXTERN int IsNumTerm(Term t)
309 {
310 return (int) ((IsIntTerm(t) || IsLargeNumTerm(t)));
311 }
312
313
314
315
316 inline EXTERN Int IsAtomicTerm(Term);
317
IsAtomicTerm(Term t)318 inline EXTERN Int IsAtomicTerm(Term t)
319 {
320 return (Int) (IsAtomOrIntTerm(t) || IsLargeNumTerm(t));
321 }
322
323
324
325
326 inline EXTERN Int IsExtensionFunctor(Functor);
327
IsExtensionFunctor(Functor f)328 inline EXTERN Int IsExtensionFunctor(Functor f)
329 {
330 return (Int) (f <= FunctorDouble);
331 }
332
333
334
335 inline EXTERN Int IsBlobFunctor(Functor);
336
IsBlobFunctor(Functor f)337 inline EXTERN Int IsBlobFunctor(Functor f)
338 {
339 return (Int) ((f <= FunctorDouble && f >= FunctorDBRef));
340 }
341
342
343
344 inline EXTERN Int IsPrimitiveTerm(Term);
345
IsPrimitiveTerm(Term t)346 inline EXTERN Int IsPrimitiveTerm(Term t)
347 {
348 return (Int) ((IsAtomOrIntTerm(t) || (IsApplTerm(t) && IsBlobFunctor(FunctorOfTerm(t)))));
349 }
350
351
352
353 #ifdef TERM_EXTENSIONS
354
355
356 inline EXTERN Int IsAttachFunc(Functor);
357
IsAttachFunc(Functor f)358 inline EXTERN Int IsAttachFunc(Functor f)
359 {
360 return (Int) (FALSE);
361 }
362
363
364
365
366 inline EXTERN Int IsAttachedTerm(Term);
367
IsAttachedTerm(Term t)368 inline EXTERN Int IsAttachedTerm(Term t)
369 {
370 return (Int) ((IsVarTerm(t) && VarOfTerm(t) < H0) );
371 }
372
373
374
375
376 inline EXTERN exts ExtFromCell(CELL *);
377
ExtFromCell(CELL * pt)378 inline EXTERN exts ExtFromCell(CELL * pt)
379 {
380 return (exts) (pt[1]);
381 }
382
383
384
385 #else
386
387
388 inline EXTERN Int IsAttachFunc(Functor);
389
IsAttachFunc(Functor f)390 inline EXTERN Int IsAttachFunc(Functor f)
391 {
392 return (Int) (FALSE);
393 }
394
395
396
397
398 inline EXTERN Int IsAttachedTerm(Term);
399
IsAttachedTerm(Term t)400 inline EXTERN Int IsAttachedTerm(Term t)
401 {
402 return (Int) (FALSE);
403 }
404
405
406
407
408 #endif
409
410 EXTERN int STD_PROTO(unify_extension,(Functor, CELL, CELL *, CELL));
411
412 inline EXTERN int
unify_extension(Functor f,CELL d0,CELL * pt0,CELL d1)413 unify_extension(Functor f, CELL d0, CELL *pt0, CELL d1)
414 {
415 switch(BlobOfFunctor(f)) {
416 case db_ref_e:
417 return (d0 == d1);
418 case long_int_e:
419 return(pt0[1] == RepAppl(d1)[1]);
420 #ifdef USE_GMP
421 case big_int_e:
422 return (mpz_cmp(BigIntOfTerm(d0),BigIntOfTerm(d1)) == 0);
423 #endif /* USE_GMP */
424 case double_e:
425 {
426 CELL *pt1 = RepAppl(d1);
427 return (pt0[1] == pt1[1]
428 #if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
429 && pt0[2] == pt1[2]
430 #endif
431 );
432 }
433 }
434 return(FALSE);
435 }
436
437