YAP 7.1.0
clause_list.c
1#include "Yap.h"
2#include "clause.h"
3#include "tracer.h"
4#ifdef YAPOR
5#include "or.macros.h"
6#endif /* YAPOR */
7#include "clause_list.h"
8
9/* need to fix overflow handling */
10
11static void mk_blob(int sz USES_REGS) {
12 MP_INT *dst;
13
14 HR[0] = (CELL)FunctorBigInt;
15 HR[1] = CLAUSE_LIST;
16 dst = (MP_INT *)(HR + 2);
17 dst->_mp_size = 0L;
18 dst->_mp_alloc = sz;
19 HR += (1 + sizeof(MP_INT) / sizeof(CELL));
20 HR[sz] = CloseExtension((CELL*)(dst-1)-2);
21 HR += sz + 1;
22}
23
24static CELL *extend_blob(CELL *start, int sz USES_REGS) {
25 UInt osize;
26 MP_INT *dst;
27
28 if (HR + sz > ASP)
29 return NULL;
30 dst = (MP_INT *)(start + 2);
31 osize = dst->_mp_alloc;
32 start += (1 + sizeof(MP_INT) / sizeof(CELL));
33 start[sz + osize] = CloseExtension(start);
34 dst->_mp_alloc += sz;
35 HR += sz;
36 return start + osize;
37}
38
39/*init of ClasuseList*/
40 clause_list_t Yap_ClauseListInit(clause_list_t in) {
41 CACHE_REGS in->n = 0;
42 in->start = HR;
43 mk_blob(0 PASS_REGS);
44 in->end = HR;
45 return in;
46}
47
48/*add clause to ClauseList
49 returns FALSE on error*/
50 int Yap_ClauseListExtend(clause_list_t cl, void *clause, void *pred) {
51 CACHE_REGS
52 PredEntry *ap = (PredEntry *)pred;
53
54 /* fprintf(stderr,"cl=%p\n",clause); */
55 if (cl->end != HR)
56 return FALSE;
57 if (cl->n == 0) {
58 void **ptr;
59 if (!(ptr = (void **)extend_blob(cl->start, 1 PASS_REGS)))
60 return FALSE;
61 ptr[0] = clause;
62 } else if (cl->n == 1) {
63 yamop **ptr;
64 yamop *code_p, *fclause;
65
66 if (!(ptr = (yamop **)extend_blob(
67 cl->start, 2 * (CELL)NEXTOP((yamop *)NULL, Otapl) / sizeof(CELL) -
68 1 PASS_REGS)))
69 return FALSE;
70 fclause = ptr[-1];
71 code_p = (yamop *)(ptr - 1);
72 code_p->opc = Yap_opcode(_try_clause);
73 code_p->y_u.Otapl.d = fclause;
74 code_p->y_u.Otapl.s = ap->ArityOfPE;
75 code_p->y_u.Otapl.p = ap;
76#ifdef TABLING
77 code_p->y_u.Otapl.te = ap->TableOfPred;
78#endif
79#ifdef YAPOR
80 INIT_YAMOP_LTT(code_p, 0);
81#endif /* YAPOR */
82 code_p = NEXTOP(code_p, Otapl);
83 code_p->opc = Yap_opcode(_trust);
84 code_p->y_u.Otapl.d = clause;
85 code_p->y_u.Otapl.s = ap->ArityOfPE;
86 code_p->y_u.Otapl.p = ap;
87#ifdef TABLING
88 code_p->y_u.Otapl.te = ap->TableOfPred;
89#endif
90#ifdef YAPOR
91 INIT_YAMOP_LTT(code_p, 0);
92#endif /* YAPOR */
93 } else {
94 yamop *code_p;
95
96 if (!(code_p = (yamop *)extend_blob(cl->start,
97 ((CELL)NEXTOP((yamop *)NULL, Otapl)) /
98 sizeof(CELL) PASS_REGS)))
99 return FALSE;
100 code_p->opc = Yap_opcode(_trust);
101 code_p->y_u.Otapl.d = clause;
102 code_p->y_u.Otapl.s = ap->ArityOfPE;
103 code_p->y_u.Otapl.p = ap;
104#ifdef TABLING
105 code_p->y_u.Otapl.te = ap->TableOfPred;
106#endif
107#ifdef YAPOR
108 INIT_YAMOP_LTT(code_p, 0);
109#endif /* YAPOR */
110 code_p = PREVOP(code_p, Otapl);
111 code_p->opc = Yap_opcode(_retry);
112 }
113 cl->end = HR;
114 cl->n++;
115 return TRUE;
116}
117
118/*closes the clause list*/
119 void Yap_ClauseListClose(clause_list_t cl) { /* no need to do nothing */
120}
121
122/*destroys the clause list freeing memory*/
123 int Yap_ClauseListDestroy(clause_list_t cl) {
124 CACHE_REGS
125 if (cl->end != HR)
126 return FALSE;
127 HR = cl->start;
128 return TRUE;
129}
130
131/*destroys clause list and returns only first clause*/
132 void *Yap_ClauseListToClause(clause_list_t cl) {
133 CACHE_REGS
134 void **ptr;
135 if (cl->end != HR)
136 return NULL;
137 if (cl->n != 1)
138 return NULL;
139 if (!(ptr = (void **)extend_blob(cl->start, 0 PASS_REGS)))
140 return NULL;
141 return ptr[-1];
142}
143
144/*return pointer to start of try-retry-trust sequence*/
145 void *Yap_ClauseListCode(clause_list_t cl) {
146 CELL *ptr;
147 ptr = (CELL *)cl->start;
148 ptr += (1 + sizeof(MP_INT) / sizeof(CELL));
149 return (void *)ptr;
150}
151
152/* where to fail */
153 void *Yap_FAILCODE(void) { return (void *)FAILCODE; }
Main definitions.
Definition: Yatom.h:544
Definition: amidefs.h:264