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: split related functions *
10 *************************************************************************/
11
12 void do_forking_andbox(struct AND_BOX *a);
13 Cell copy_structures(Cell c);
14 void replicate_local_variables(struct AND_BOX *a);
15 struct OR_BOX *copy_orbox(struct OR_BOX *o,struct AND_BOX *parent,struct status_and *nr_call);
16 struct AND_BOX *copy_andbox(struct AND_BOX *a,struct OR_BOX *parent);
17
18
do_forking_andbox(struct AND_BOX * a)19 void do_forking_andbox(struct AND_BOX *a)
20 {
21 struct OR_BOX *op,*opp, *new_orbox;
22 struct AND_BOX *ap, *new_andbox;
23 int nr_all_alternatives, nr_all_calls;
24 struct status_and *nr_call,*new_call;
25 struct status_or *nr_alternative, *alternatives, *new_alternatives;
26
27 beam_nr_call_forking++;
28 op=a->parent; /* or box parent */
29 ap=op->parent; /* and box parent */
30 opp=ap->parent; /* or box parent parent */
31 if (opp==NULL) {
32 abort_eam("Forking with orbox parent parent NULL, maybe I'm on top ?????");
33 }
34
35 alternatives=opp->alternatives;
36 nr_all_alternatives=opp->nr_all_alternatives;
37 nr_alternative=ap->nr_alternative;
38 nr_all_calls=ap->nr_all_calls;
39 nr_call=op->nr_call;
40
41 new_andbox=(struct AND_BOX *) request_memory(ANDBOX_SIZE);
42 new_orbox=(struct OR_BOX *) request_memory(ORBOX_SIZE);
43 new_andbox->parent=opp;
44 // new_andbox->nr_alternative=nr_alternative; /* seted after creating a new status_or */
45 new_andbox->nr_all_calls=nr_all_calls;
46 new_andbox->level=ap->level;
47 new_andbox->perms=ap->perms;
48 new_andbox->suspended=NULL;
49 if (ap->suspended) new_andbox->suspended=addto_suspensions_list(new_andbox,ap->suspended->reason);
50 new_andbox->side_effects=ap->side_effects;
51
52 if (ap->externals) {
53 struct EXTERNAL_VAR *old_externals, *list=NULL;
54 old_externals=ap->externals;
55 while (old_externals) {
56 struct EXTERNAL_VAR *e;
57 struct SUSPENSIONS_VAR *s;
58
59 e=(struct EXTERNAL_VAR *) request_memory(EXTERNAL_VAR_SIZE);
60 e->value=old_externals->value;
61 e->var=(struct PERM_VAR *) old_externals->var;
62 e->next=list;
63 list=e;
64
65 if (isvar(e->var)) {
66 s=(struct SUSPENSIONS_VAR *) request_memory(SUSPENSIONS_VAR_SIZE); /* Add and_box to suspension list of var*/
67 s->and_box=new_andbox;
68 s->next=e->var->suspensions;
69 e->var->suspensions=s;
70 }
71
72 old_externals=old_externals->next;
73 }
74 new_andbox->externals=list;
75 } else new_andbox->externals=NULL;
76
77 new_call=(struct status_and *) request_memory(STATUS_AND_SIZE);
78 new_call->call=new_orbox;
79 new_call->locals=nr_call->locals;
80 new_call->code=nr_call->code;
81 new_call->state=WAKE;
82 nr_call->state=WAKE; /* NEW PARA TORNAR A CALL NUM WAKE STATE */
83
84 new_orbox->parent=new_andbox;
85 new_orbox->nr_call=new_call;
86 new_orbox->nr_all_alternatives=1;
87 new_alternatives=a->nr_alternative;
88 new_orbox->alternatives=new_alternatives;
89
90 /* remove andbox from op */
91 op->nr_all_alternatives-=1;
92 if (new_alternatives->previous==NULL) op->alternatives=new_alternatives->next;
93 else new_alternatives->previous->next=new_alternatives->next;
94 if (new_alternatives->next!=NULL) new_alternatives->next->previous=new_alternatives->previous;
95 new_alternatives->next=NULL;
96 new_alternatives->previous=NULL;
97
98 a->parent=new_orbox;
99
100 /* increase the nr_alternatives by 1 in opp or_box parent parent and conect new_andbox*/
101 new_alternatives=(struct status_or *) request_memory(STATUS_OR_SIZE);
102 new_andbox->nr_alternative=new_alternatives;
103
104 new_alternatives->next=nr_alternative;
105 new_alternatives->previous=nr_alternative->previous;
106 if (nr_alternative->previous==NULL) opp->alternatives=new_alternatives;
107 else nr_alternative->previous->next=new_alternatives;
108 nr_alternative->previous=new_alternatives;
109
110 new_alternatives->args=nr_alternative->args;
111 new_alternatives->code=nr_alternative->code;
112 new_alternatives->state=nr_alternative->state;
113 new_alternatives->alternative=new_andbox;
114
115 opp->nr_all_alternatives=nr_all_alternatives+1;
116
117 /* copy and_box ap to new_and-box */
118 { struct status_and *first=NULL, *last=NULL,*calls,*calls_new;
119 calls=ap->calls;
120 while(calls!=NULL) {
121 if (calls==nr_call) {
122 calls_new=new_call;
123 } else {
124 calls_new=(struct status_and *) request_memory(STATUS_AND_SIZE);
125 calls_new->code=calls->code;
126 calls_new->locals=calls->locals;
127 calls_new->state=calls->state;
128 calls_new->call=copy_orbox(calls->call,new_andbox,calls_new); /* Do a exact copy of the tree*/
129
130 }
131 if (first==NULL) first=calls_new;
132 else last->next=calls_new;
133 calls_new->previous=last;
134 calls_new->next=NULL;
135 last=calls_new;
136 calls=calls->next;
137 }
138 new_andbox->calls=first;
139
140 }
141
142
143 /* remove and_box a from suspension list on vars */
144 if (a->externals) {
145 struct EXTERNAL_VAR *e;
146 e=a->externals;
147 while(e) {
148 if (e->var->home->level>=a->parent->parent->level)
149 remove_from_perm_var_suspensions(e->var,a);
150 e=e->next;
151 }
152 }
153
154 /* Now we have to create new local vars and refresh the external vars to point to those */
155
156 if (beam_MemGoing==1) {
157 beam_VAR_TRAIL=((Cell *) beam_START_ADDR_BOXES)-1;
158 } else beam_VAR_TRAIL=(Cell *) beam_START_ADDR_HEAP;
159 beam_VAR_TRAIL_NR=0;
160 replicate_local_variables(new_andbox);
161 }
162
163
copy_orbox(struct OR_BOX * o,struct AND_BOX * parent,struct status_and * nr_call)164 struct OR_BOX *copy_orbox(struct OR_BOX *o,struct AND_BOX *parent,struct status_and *nr_call)
165 {
166 struct OR_BOX *new_orbox;
167 struct status_or *old,*new,*first=NULL,*last=NULL;
168
169 if (o==NULL) return(NULL);
170
171 new_orbox=(struct OR_BOX *) request_memory(ORBOX_SIZE);
172 new_orbox->parent=parent;
173 new_orbox->nr_call=nr_call;
174 new_orbox->nr_all_alternatives=o->nr_all_alternatives;
175 old=o->alternatives;
176 while(old!=NULL) {
177 new=(struct status_or *) request_memory(STATUS_OR_SIZE);
178 new->args=old->args;
179 new->code=old->code;
180 new->state=old->state;
181 new->alternative=copy_andbox(old->alternative,new_orbox);
182 if (new->alternative!=NULL) new->alternative->nr_alternative=new;
183
184 if (first==NULL) first=new;
185 else last->next=new;
186 new->previous=last;
187 new->next=NULL;
188 last=new;
189 old=old->next;
190 }
191 new_orbox->alternatives=first;
192
193 return(new_orbox);
194 }
195
copy_andbox(struct AND_BOX * a,struct OR_BOX * parent)196 struct AND_BOX *copy_andbox(struct AND_BOX *a,struct OR_BOX *parent)
197 {
198 struct AND_BOX *new_andbox;
199
200 if (a==NULL) return(NULL);
201
202 new_andbox=(struct AND_BOX *) request_memory(ANDBOX_SIZE);
203 new_andbox->parent=parent;
204 // new_andbox->nr_alternative=a->nr_alternative; /* this is seted in the copy_orbox, after calling copy_andbox */
205 new_andbox->nr_all_calls=a->nr_all_calls;
206 new_andbox->level=a->level;
207 new_andbox->perms=a->perms;
208 new_andbox->externals=a->externals;
209 new_andbox->side_effects=a->side_effects;
210 new_andbox->suspended=NULL;
211 if (a->suspended) {
212 new_andbox->suspended=addto_suspensions_list(new_andbox,a->suspended->reason);
213 }
214
215 { struct status_and *first=NULL, *last=NULL,*calls,*calls_new;
216 calls=a->calls;
217 while(calls!=NULL) {
218 calls_new=(struct status_and *) request_memory(STATUS_AND_SIZE);
219 calls_new->code=calls->code;
220 calls_new->locals=calls->locals;
221 calls_new->state=calls->state;
222 calls_new->call=copy_orbox(calls->call,new_andbox,calls_new); /* Do a exact copy of the tree*/
223
224 if (first==NULL) first=calls_new;
225 else last->next=calls_new;
226 calls_new->previous=last;
227 calls_new->next=NULL;
228 last=calls_new;
229 calls=calls->next;
230 }
231 new_andbox->calls=first;
232 }
233
234 return(new_andbox);
235 }
236
237
replicate_local_variables(struct AND_BOX * a)238 void replicate_local_variables(struct AND_BOX *a) /* used by fork -ABX is set*/
239 {
240 struct PERM_VAR *l,*new_list;
241 int i,OLD_VAR_TRAIL_NR;
242 struct EXTERNAL_VAR *old_externals,*externals;
243
244 if (a==NULL) return;
245
246 OLD_VAR_TRAIL_NR=beam_VAR_TRAIL_NR;
247 l=a->perms;
248 new_list=NULL;
249 while(l) {
250 struct PERM_VAR *new;
251 Cell *c;
252
253 new=request_permVar(a);
254 new->yapvar=l->yapvar;
255 new->next=new_list;
256 new_list=new;
257
258 c=&l->value;
259 beam_VAR_TRAIL[beam_VAR_TRAIL_NR]=(Cell) c;
260 beam_VAR_TRAIL_NR-=beam_MemGoing;
261 beam_VAR_TRAIL[beam_VAR_TRAIL_NR]=(Cell) *c;
262 beam_VAR_TRAIL_NR-=beam_MemGoing;
263
264 if ((Cell *)*c==c) {
265 new->value=(Cell) &new->value;
266 *c=new->value;
267 } else {
268 new->value= (Cell) *c;
269 *c=(Cell) &new->value;
270 }
271 l=l->next;
272 }
273 a->perms=new_list;
274 l=new_list;
275 while(l) {
276 l->value=copy_structures(l->value);
277 l=l->next;
278 }
279
280 /* At this point all old local vars are pointing to the new local vars */
281
282 if (a==beam_ABX) { /* Nao preciso de criar um novo vector das externals */
283 old_externals=a->externals;
284 while(old_externals) {
285 if (old_externals->var->home->level>=beam_ABX->parent->parent->level) {
286 old_externals->value=copy_structures((Cell ) old_externals->value);
287 old_externals->var=(struct PERM_VAR *) old_externals->var->value;
288 if (isvar(old_externals->var)) {
289 struct SUSPENSIONS_VAR *s;
290 s=(struct SUSPENSIONS_VAR *) request_memory(SUSPENSIONS_VAR_SIZE); /* Add and_box to suspension list of var*/
291 s->and_box=a;
292 s->next=old_externals->var->suspensions;
293 old_externals->var->suspensions=s;
294 }
295 }
296 old_externals=old_externals->next;
297 }
298 } else {
299
300 old_externals=a->externals;
301 externals=NULL;
302 a->externals=NULL;
303
304 while(old_externals) {
305 struct EXTERNAL_VAR *e;
306 struct SUSPENSIONS_VAR *s;
307
308 e=(struct EXTERNAL_VAR *) request_memory(EXTERNAL_VAR_SIZE);
309 e->next=externals;
310 externals=e;
311
312 if (old_externals->var->home->level>=beam_ABX->parent->parent->level) {
313 e->value=copy_structures((Cell ) old_externals->value);
314 e->var=(struct PERM_VAR *) old_externals->var->value;
315 } else {
316 e->value=old_externals->value;
317 e->var=(struct PERM_VAR *) old_externals->var->value;
318 }
319
320 if (isvar(e->var)) {
321 s=(struct SUSPENSIONS_VAR *) request_memory(SUSPENSIONS_VAR_SIZE); /* Add and_box to suspension list of var*/
322 s->and_box=a;
323 s->next=e->var->suspensions;
324 e->var->suspensions=s;
325 }
326
327 old_externals=old_externals->next;
328 }
329 a->externals=externals;
330 }
331
332
333 /* CUIDADO: Preciso agora de duplicar os vectores das variaveis locais */
334 { struct status_and *calls;
335 #if !Fast_go
336 Cell **backup=NULL; int i, counted=0,max=1000;
337 backup=(Cell **) malloc(max);
338 #else
339 Cell *backup[1000]; int i, counted=0;
340 #endif
341
342 calls=a->calls;
343 while(calls!=NULL) {
344 if (calls->locals!=NULL) {
345 /* primeiro vou ver se j� foi copiado */
346 for(i=0;i<counted;i+=2) {
347 if (backup[i]==calls->locals) {
348 calls->locals=backup[i+1];
349 break;
350 }
351 }
352 if (i==counted) { /* afinal ainda nao foi copiado: fazer copia em duas fases*/
353 Cell *c, *newvars, *oldvars; int nr;
354
355 oldvars=calls->locals;
356 nr=oldvars[-1];
357 newvars=request_memory_locals_noinit(nr);
358 calls->locals=newvars;
359 /* primeiro actualizo as variaveis */
360 for(i=0;i<nr;i++) {
361 c=&oldvars[i];
362 beam_VAR_TRAIL[beam_VAR_TRAIL_NR]=(Cell) c;
363 beam_VAR_TRAIL_NR-=beam_MemGoing;
364 beam_VAR_TRAIL[beam_VAR_TRAIL_NR]=(Cell) *c;
365 beam_VAR_TRAIL_NR-=beam_MemGoing;
366
367 if ((Cell *)*c==c) {
368 newvars[i]=(Cell) &newvars[i];
369 *c=newvars[i];
370 } else {
371 newvars[i]= (Cell) *c;
372 *c=(Cell) &newvars[i];
373 }
374 }
375 /* depois copio as estruturas */
376 for(i=0;i<nr;i++) {
377 newvars[i]=copy_structures(oldvars[i]);
378 }
379 #if !Fast_go
380 if (max<counted+2) {
381 max+=200;
382 backup=realloc(backup,max);
383 if (backup==NULL) abort_eam("No more memory... realloc in gc \n");
384 }
385 #else
386 if (counted>=998) abort_eam("No more memory... realloc in gc \n");
387 #endif
388 backup[counted]=oldvars;
389 backup[counted+1]=newvars;
390 counted+=2;
391 }
392 }
393 calls=calls->next;
394 }
395 #if !Fast_go
396 free(backup);
397 #endif
398 }
399
400 /* redo the process to the inner boxes */
401 { struct status_and *calls;
402
403 calls=a->calls;
404 while(calls!=NULL) {
405
406 if (calls->call!=NULL) {
407 register struct OR_BOX *o;
408 register struct status_or *nr;
409
410 o=calls->call;
411 nr=o->alternatives;
412 while(nr!=NULL) {
413 replicate_local_variables(nr->alternative);
414 nr=nr->next;
415 }
416 }
417 calls=calls->next;
418 }
419 }
420
421 if (beam_MemGoing==1) {
422 for(i=OLD_VAR_TRAIL_NR;i>beam_VAR_TRAIL_NR;i-=2) {
423 Cell *c;
424 c=(Cell *) beam_VAR_TRAIL[i];
425 *c=(Cell) beam_VAR_TRAIL[i-1];
426 }
427 } else {
428 for(i=OLD_VAR_TRAIL_NR;i<beam_VAR_TRAIL_NR;i+=2) {
429 Cell *c;
430 c=(Cell *) beam_VAR_TRAIL[i];
431 *c=(Cell) beam_VAR_TRAIL[i+1];
432 }
433 }
434
435 beam_VAR_TRAIL_NR=OLD_VAR_TRAIL_NR;
436 }
437
438
439
copy_structures(Cell c)440 Cell copy_structures(Cell c)
441 {
442 Cell *NewC, *NewH;
443 Cell OldC,OldH;
444
445 OldC=deref((Cell) c);
446
447 if (isvar(OldC)) {
448 return(OldC);
449 }
450 if (isatom(OldC)) {
451 return(OldC);
452 }
453
454 OldH=(Cell) beam_H;
455 NewH=beam_H;
456 if (isappl(OldC)) {
457 int i,arity;
458
459 NewC=(Cell *) repappl(OldC);
460 arity = ((int) ArityOfFunctor((Functor) *NewC));
461 *NewH++=*NewC++;
462 beam_H+=arity+1;
463 for(i=0;i<arity ;i++) {
464 *NewH=copy_structures((Cell) NewC);
465 NewH++;
466 NewC++;
467 }
468 return(absappl(OldH));
469 }
470 /* else if (ispair(c)) { */
471 NewC=(Cell *) reppair(OldC);
472 beam_H+=2;
473 *NewH=copy_structures((Cell) NewC);
474 NewC++;
475 NewH++;
476 *NewH=copy_structures((Cell) NewC);
477 return(abspair(OldH));
478 }
479