1 /*************************************************************************
2 *									 *
3 *	       BEAM -> Basic Extended Andorra Model                      *
4 *         BEAM extends the YAP Prolog system to support the EAM          *
5 *									 *
6 * Copyright: Ricardo Lopes and NCC - University of Porto, Portugal       *
7 *									 *
8 **************************************************************************
9 * comments:	eam compiler data structures and routines		 *
10 *************************************************************************/
11 
12 #define Print_Code 0
13 /*      To help on compiler debuging
14    1 -> show predicates info
15    2 -> show YAP abstract machine code (YAAM)
16    4 -> show YAAM after transformation
17    8 -> show indexing code
18 
19   16 -> show EAM intermediate code
20   32 -> show EAM intermediate code with direct_calls
21  128 -> show EAM abstrac machine code
22 */
23 
24 #define Variavel  1
25 #define Lista     2
26 #define Estrutura 4
27 #define Constante 8
28 
29 typedef unsigned long Cell;
30 
31 
32 typedef struct  PCODE{
33   struct PCODE *nextInst;
34   int op, new1;
35   unsigned long new4;
36 } CInstr;
37 
38 struct Clauses {
39   unsigned int idx;           /* info for indexing on first arg */
40   Cell val;                   /* atom or functor in first arg   */
41   unsigned int nr_vars;       /* nr of local vars */
42   struct Predicates *predi;   /* predicate struct */
43   int side_effects;           /* clause has side effects */
44   Cell *code;
45 
46   struct Clauses *next;        /* next clause within the same predicate */
47 };
48 
49 
50 struct HASH_TABLE {
51   Cell value;
52   Cell *code;
53   struct HASH_TABLE *next;
54 };
55 
56 struct Predicates {           /* To register information about predicates */
57   unsigned long id;
58   unsigned char *name;
59   unsigned int arity;
60   unsigned int nr_alt;        /* nr of alternativas */
61   unsigned int calls;         /* nr of existent calls to this predicate */
62   struct Clauses *first;
63   struct Clauses *last;
64   int idx;                    /* is code indexed ? 0= needs compilation  -1= no indexing possible  1= indexed */
65   unsigned int idx_var;       /* nr clauses with 1st argument var */
66   unsigned int idx_list;      /* nr clauses with 1st argument list */
67   unsigned int idx_atom;      /* nr clauses with 1st argument atom */
68   unsigned int idx_functor;   /* nr clauses with 1st argument functor */
69   short int eager_split;      /* allow eager splitting */
70 
71   Cell *code;                 /* try, retry and trust code or Indexing code */
72   struct HASH_TABLE **atom;
73   struct HASH_TABLE **functor;
74   Cell *list;
75   Cell *vars;
76   struct Predicates *next;
77 };
78 
79 /****************************  EAM TRUE STUFF *************/
80 
81 struct SUSPENSIONS {
82   struct AND_BOX *and_box;         /* And_box where the variable has suspended        */
83   short int reason;                /* suspended before executing call number nr_call  */
84   struct SUSPENSIONS *next;        /* Pointer to the next suspention                  */
85   struct SUSPENSIONS *prev;
86 };
87 
88 struct SUSPENSIONS_VAR {
89   struct AND_BOX *and_box;         /* And_box where the variable has suspended */
90   struct SUSPENSIONS_VAR *next;    /* Pointer to the next suspention           */
91 };
92 
93 struct PERM_VAR {
94   Cell value;                      /* value assigned to the variable                    */
95   struct AND_BOX *home;            /* pointer to the goal_box structure of the variable */
96   Cell *yapvar;
97   struct SUSPENSIONS_VAR *suspensions; /* Pointer to a Suspension List                  */
98   struct PERM_VAR *next;
99 };
100 
101 struct EXTERNAL_VAR {              /* to be used as some kind of trail */
102   Cell value;                      /* value assign to the variable     */
103   struct PERM_VAR *var;           /* pointer to the local_var struct  */
104   struct EXTERNAL_VAR *next;
105 };
106 
107 struct status_and {
108   struct OR_BOX *call;             /* POINTER TO A OR_BOX       */
109   Cell *locals;                    /* temporary vars vector     */
110   Cell *code;                      /* Pointer to the start code */
111   int state;                 /* State of the OR_BOX       */
112   struct status_and *previous;
113   struct status_and *next;
114 };
115 
116 struct status_or {
117   struct AND_BOX *alternative;     /* POINTER TO A AND_BOX      */
118   Cell *args;                      /* Saved Arguments           */
119   Cell *code;                      /* Pointer to Start Code     */
120   int state;                 /* State of the AND_BOX      */
121   struct status_or *previous;
122   struct status_or *next;
123 };
124 
125 struct OR_BOX {
126   struct AND_BOX *parent;
127   struct status_and *nr_call;      /* order of this box              */
128   short int nr_all_alternatives;   /* number of existing alternatives */
129   struct status_or *alternatives;  /* alternatives of the or_box      */
130   short int eager_split;
131 };
132 
133 struct AND_BOX {
134   struct OR_BOX *parent;            /* pointer to the parent or-box          */
135   struct status_or *nr_alternative; /* This box is alternative id       */
136   short int nr_all_calls;           /* numger of all goals                   */
137   struct PERM_VAR *perms;
138   struct status_and *calls;
139 
140   short int level;                 /* indicates the level in the tree       */
141   struct EXTERNAL_VAR *externals;  /* pointer to a list of external_vars    */
142   struct SUSPENSIONS *suspended;   /* pointer to a list of suspended boxes  */
143   short int side_effects;          /* to mark if are calls to builtins with side_efects (like write) */
144 };
145 
146 
147 /* TYPE OF STATES */
148 #define ZERO        0    /* No State yet */
149 #define SUCCESS     1
150 #define FAILS       2
151 #define READY       4    /* Is ready to start execution */
152 #define RUNNING     8    /* Is running                  */
153 #define RUNAGAIN    16   /* Is running again       */
154 #define SUSPEND     32   /* Has suspended               */
155 #define WAKE        64   /* Was Suspended, but now is Ready again      */
156 #define CHANGED     128  /* Has received some change on it's external variables, needs to re-run */
157 #define END         256  /* Has suspended on end, on wake up can pass to a success state */
158 #define WAITING     512  /* The clause is waiting for the previous predicates to leave the Suspended state */
159 #define FAILED     1024  /* has failed */
160 
161 #define CUT_RIGHT       2048
162 #define SKIP_VAR        4096
163 #define LEFTMOST_PARENT 8192
164 #define FIRST          16384
165 #define LEFTMOST       32768
166 
167 #define WAITING_TO_BE_FIRST             (WAITING + FIRST)
168 #define WAITING_TO_BE_LEFTMOST          (WAITING + LEFTMOST)
169 #define WAITING_TO_BE_LEFTMOST_PARENT   (WAITING + LEFTMOST_PARENT)
170 #define WAITING_TO_CUT                  (WAITING + CUT_RIGHT)
171 #define WAITING_SKIP_VAR                (WAITING + SKIP_VAR)
172 #define SUSPEND_END                     (SUSPEND+END)
173 #define WAKE_END                        (WAKE+END)
174 
175 
176 #define NORMAL_SUSPENSION    0
177 #define LEFTMOST_SUSPENSION  1
178 #define WAIT_SUSPENSION      2
179 #define CUT_SUSPENSION       3
180 #define WRITE_SUSPENSION     4
181 #define VAR_SUSPENSION       5
182 #define YAP_VAR_SUSPENSION   6
183 
184 /* TYPE OF SIDE_EFFECTS */
185 
186 #define WRITE       1
187 #define COMMIT      2
188 #define VAR         4
189 #define SEQUENCIAL  8
190 
191 #define CUT         32  /* Greater than 32 always cut */
192 
193 
194 /**********************************************************************************/
195 
196 struct EAM_TEMP {
197 
198 
199 
200   struct EAM_TEMP *previous;
201   struct EAM_TEMP *next;
202 };
203 
204 struct EAM_Global {
205   Cell *pc;
206   Cell *_H;
207   Cell *_S;
208   short _Mode;            /* read or write mode                     */
209   short ES;               /* goal shoud do Eager Split yes or no ?  */
210   short MemGoing;        /* Direction the that stacks use to grow  */
211   Cell *varlocals;        /* local vars to the working AND-BOX      */
212   struct AND_BOX  *ABX;   /* working AND-BOX                        */
213   struct OR_BOX   *OBX;   /* working OR-BOX                         */
214   struct SUSPENSIONS *su; /* list with suspended work               */
215   struct AND_BOX  *top;
216 
217   struct status_and *USE_SAME_ANDBOX;  /* when only 1 alternative   */
218   struct status_or *nr_alternative;    /* working alternative       */
219   struct status_and *nr_call;          /* working goal              */
220 
221   Cell *VAR_TRAIL;
222   int VAR_TRAIL_NR;
223   int Mem_FULL;           /*  if mem_full, then perform GC          */
224   int nr_call_forking;    /* number of splits already performed     */
225   unsigned long START_ADDR_HEAP, START_ADDR_BOXES, END_BOX, END_H;
226   unsigned int nr_gc_heap;
227   unsigned int nr_gc_boxed;
228   Cell **IndexFree;
229   Cell *NextFree;
230   Cell *sp;
231   struct PERM_VAR *NextVar;
232 
233 #if Memory_Stat
234    unsigned long TOTAL_MEM, MEM_REUSED, TOTAL_TEMPS,TEMPS_REUSED, TOTAL_PERMS, PERMS_REUSED;
235    unsigned long Memory_STAT[5000][5];
236 #endif
237 };
238 
239 
240 #define beam_X   XREGS      /* use the same X-Regs as YAP */
241 
242 #define beam_pc (eamGlobal->pc)
243 #define beam_H (eamGlobal->_H)
244 #define beam_S (eamGlobal->_S)
245 #define beam_Mode (eamGlobal->_Mode)
246 #define beam_ES (eamGlobal->ES)
247 #define beam_MemGoing (eamGlobal->MemGoing)
248 #define beam_varlocals (eamGlobal->varlocals)
249 #define beam_ABX (eamGlobal->ABX)
250 #define beam_OBX (eamGlobal->OBX)
251 #define beam_su (eamGlobal->su)
252 #define beam_top (eamGlobal->top)
253 #define beam_USE_SAME_ANDBOX (eamGlobal->USE_SAME_ANDBOX)
254 #define beam_nr_alternative (eamGlobal->nr_alternative)
255 #define beam_nr_call (eamGlobal->nr_call)
256 #define beam_VAR_TRAIL (eamGlobal->VAR_TRAIL)
257 #define beam_VAR_TRAIL_NR (eamGlobal->VAR_TRAIL_NR)
258 #define beam_Mem_FULL (eamGlobal->Mem_FULL)
259 #define beam_nr_call_forking (eamGlobal->nr_call_forking)
260 #define beam_START_ADDR_HEAP (eamGlobal->START_ADDR_HEAP)
261 #define beam_START_ADDR_BOXES (eamGlobal->START_ADDR_BOXES)
262 #define beam_END_BOX (eamGlobal->END_BOX)
263 #define beam_END_H (eamGlobal->END_H)
264 #define beam_nr_gc_heap (eamGlobal->nr_gc_heap)
265 #define beam_nr_gc_boxed (eamGlobal->nr_gc_boxed)
266 #define beam_IndexFree (eamGlobal->IndexFree)
267 #define beam_NextFree (eamGlobal->NextFree)
268 #define beam_sp (eamGlobal->sp)
269 #define beam_NextVar (eamGlobal->NextVar)
270 #if Memory_Stat
271  #define beam_TOTAL_MEM (eamGlobal->TOTAL_MEM)
272  #define beam_MEM_REUSED (eamGlobal->MEM_REUSED)
273  #define beam_TOTAL_TEMPS (eamGlobal->TOTAL_TEMPS)
274  #define beam_TEMPS_REUSED (eamGlobal->TEMPS_REUSED)
275  #define beam_TOTAL_PERMS (eamGlobal->TOTAL_PERMS)
276  #define beam_PERMS_REUSED (eamGlobal->PERMS_REUSED)
277  #define beam_Memory_STAT (eamGlobal->Memory_STAT)
278 #endif
279 
280 #define arg1  *(beam_pc+1)
281 #define arg2  *(beam_pc+2)
282 #define arg3  *(beam_pc+3)
283 #define arg4  *(beam_pc+4)
284 
285 #define CELL_SIZE  (sizeof(Cell))
286 #define POINTER_SIZE (sizeof(Cell *))
287 #define ANDBOX_SIZE (sizeof(struct AND_BOX))
288 #define ORBOX_SIZE (sizeof(struct OR_BOX))
289 #define PERM_VAR_SIZE (sizeof(struct PERM_VAR))
290 #define EXTERNAL_VAR_SIZE (sizeof(struct EXTERNAL_VAR))
291 #define SUSPENSIONS_SIZE (sizeof(struct SUSPENSIONS))
292 #define SUSPENSIONS_VAR_SIZE (sizeof(struct SUSPENSIONS_VAR))
293 #define STATUS_AND_SIZE (sizeof(struct status_and))
294 #define STATUS_OR_SIZE (sizeof(struct status_or))
295 
296