Logo Search packages:      
Sourcecode: yap version File versions  Download package

eam_split.c

/*************************************************************************
*                                                      *
*            BEAM -> Basic Extended Andorra Model                      *
*         BEAM extends the YAP Prolog system to support the EAM          *
*                                                      *
* Copyright: Ricardo Lopes and NCC - University of Porto, Portugal       *
*                                                      *
**************************************************************************
* comments: split related functions                                  *
*************************************************************************/

void do_forking_andbox(struct AND_BOX *a);
Cell copy_structures(Cell c);
void replicate_local_variables(struct AND_BOX *a);
struct OR_BOX *copy_orbox(struct OR_BOX *o,struct AND_BOX *parent,struct status_and *nr_call);
struct AND_BOX *copy_andbox(struct AND_BOX *a,struct OR_BOX *parent);


void do_forking_andbox(struct AND_BOX *a)
{
struct OR_BOX *op,*opp, *new_orbox;
struct AND_BOX *ap, *new_andbox;
int nr_all_alternatives, nr_all_calls;
struct status_and *nr_call,*new_call;
struct status_or *nr_alternative, *alternatives, *new_alternatives;

  beam_nr_call_forking++;
  op=a->parent;     /* or box parent */
  ap=op->parent;    /* and box parent */
  opp=ap->parent;   /* or box parent parent */
  if (opp==NULL) {
    abort_eam("Forking with orbox parent parent NULL, maybe I'm on top ?????");
  }

  alternatives=opp->alternatives;
  nr_all_alternatives=opp->nr_all_alternatives;
  nr_alternative=ap->nr_alternative;
  nr_all_calls=ap->nr_all_calls;
  nr_call=op->nr_call;

  new_andbox=(struct AND_BOX *) request_memory(ANDBOX_SIZE); 
  new_orbox=(struct OR_BOX *) request_memory(ORBOX_SIZE);
  new_andbox->parent=opp;
  //  new_andbox->nr_alternative=nr_alternative;    /* seted after creating a new status_or */
  new_andbox->nr_all_calls=nr_all_calls;
  new_andbox->level=ap->level;
  new_andbox->perms=ap->perms;
  new_andbox->suspended=NULL;
  if (ap->suspended) new_andbox->suspended=addto_suspensions_list(new_andbox,ap->suspended->reason);
  new_andbox->side_effects=ap->side_effects;
 
  if (ap->externals) {
    struct EXTERNAL_VAR *old_externals, *list=NULL;
    old_externals=ap->externals;
    while (old_externals) {
      struct EXTERNAL_VAR *e;
      struct SUSPENSIONS_VAR *s;
      
      e=(struct  EXTERNAL_VAR *) request_memory(EXTERNAL_VAR_SIZE);
      e->value=old_externals->value;
      e->var=(struct PERM_VAR *) old_externals->var;
      e->next=list;
      list=e;

      if (isvar(e->var)) {
        s=(struct SUSPENSIONS_VAR *) request_memory(SUSPENSIONS_VAR_SIZE); /* Add and_box to suspension list of var*/
        s->and_box=new_andbox;
        s->next=e->var->suspensions;
        e->var->suspensions=s;
      }

      old_externals=old_externals->next;
    }
    new_andbox->externals=list;
  } else new_andbox->externals=NULL; 

  new_call=(struct status_and *) request_memory(STATUS_AND_SIZE);
  new_call->call=new_orbox;
  new_call->locals=nr_call->locals;
  new_call->code=nr_call->code;
  new_call->state=WAKE;
  nr_call->state=WAKE;     /* NEW PARA TORNAR A CALL NUM WAKE STATE   */

  new_orbox->parent=new_andbox;
  new_orbox->nr_call=new_call;
  new_orbox->nr_all_alternatives=1;
  new_alternatives=a->nr_alternative;
  new_orbox->alternatives=new_alternatives;

  /* remove  andbox from op */
  op->nr_all_alternatives-=1;
  if (new_alternatives->previous==NULL) op->alternatives=new_alternatives->next; 
  else new_alternatives->previous->next=new_alternatives->next;
  if (new_alternatives->next!=NULL) new_alternatives->next->previous=new_alternatives->previous;
  new_alternatives->next=NULL;
  new_alternatives->previous=NULL;

  a->parent=new_orbox;

  /* increase the nr_alternatives by 1 in opp or_box parent parent and conect new_andbox*/
  new_alternatives=(struct status_or *) request_memory(STATUS_OR_SIZE);
  new_andbox->nr_alternative=new_alternatives;   
  
  new_alternatives->next=nr_alternative;
  new_alternatives->previous=nr_alternative->previous;
  if (nr_alternative->previous==NULL) opp->alternatives=new_alternatives;
  else nr_alternative->previous->next=new_alternatives;
  nr_alternative->previous=new_alternatives;

  new_alternatives->args=nr_alternative->args;
  new_alternatives->code=nr_alternative->code;
  new_alternatives->state=nr_alternative->state;
  new_alternatives->alternative=new_andbox;

  opp->nr_all_alternatives=nr_all_alternatives+1;

  /* copy and_box ap to new_and-box  */
  { struct status_and *first=NULL, *last=NULL,*calls,*calls_new;
     calls=ap->calls;
     while(calls!=NULL) {
       if (calls==nr_call) {
       calls_new=new_call;
       } else {
        calls_new=(struct status_and *) request_memory(STATUS_AND_SIZE);
      calls_new->code=calls->code;
      calls_new->locals=calls->locals;
      calls_new->state=calls->state;
      calls_new->call=copy_orbox(calls->call,new_andbox,calls_new);  /* Do a exact copy of the tree*/

       }
       if (first==NULL) first=calls_new;
       else  last->next=calls_new; 
       calls_new->previous=last;
       calls_new->next=NULL;
       last=calls_new;
       calls=calls->next;
     }
     new_andbox->calls=first;

  }

   
  /* remove and_box a from suspension list on vars */
  if (a->externals) {
    struct EXTERNAL_VAR *e;
    e=a->externals;
    while(e) {
      if (e->var->home->level>=a->parent->parent->level)
         remove_from_perm_var_suspensions(e->var,a);    
      e=e->next;
    }
  }

  /* Now we have to create new local vars and refresh the external vars to point to those */

  if (beam_MemGoing==1) { 
         beam_VAR_TRAIL=((Cell *) beam_START_ADDR_BOXES)-1;
  } else beam_VAR_TRAIL=(Cell *) beam_START_ADDR_HEAP;
  beam_VAR_TRAIL_NR=0;
  replicate_local_variables(new_andbox);
}


struct OR_BOX *copy_orbox(struct OR_BOX *o,struct AND_BOX *parent,struct status_and *nr_call)
{
struct OR_BOX *new_orbox;
struct status_or *old,*new,*first=NULL,*last=NULL;

   if (o==NULL) return(NULL);
   
   new_orbox=(struct OR_BOX *) request_memory(ORBOX_SIZE);
   new_orbox->parent=parent;
   new_orbox->nr_call=nr_call;
   new_orbox->nr_all_alternatives=o->nr_all_alternatives;
   old=o->alternatives;
   while(old!=NULL) {
     new=(struct status_or *) request_memory(STATUS_OR_SIZE);
     new->args=old->args;
     new->code=old->code;
     new->state=old->state;
     new->alternative=copy_andbox(old->alternative,new_orbox);
     if (new->alternative!=NULL) new->alternative->nr_alternative=new;

     if (first==NULL) first=new;
     else last->next=new;
     new->previous=last;
     new->next=NULL;
     last=new;                
     old=old->next;
   }
   new_orbox->alternatives=first;

return(new_orbox);
}

struct AND_BOX *copy_andbox(struct AND_BOX *a,struct OR_BOX *parent)
{
struct AND_BOX *new_andbox;

  if (a==NULL) return(NULL);

  new_andbox=(struct AND_BOX *) request_memory(ANDBOX_SIZE); 
  new_andbox->parent=parent;
  //  new_andbox->nr_alternative=a->nr_alternative;  /* this is seted in the copy_orbox, after calling copy_andbox */
  new_andbox->nr_all_calls=a->nr_all_calls;
  new_andbox->level=a->level;
  new_andbox->perms=a->perms;
  new_andbox->externals=a->externals;
  new_andbox->side_effects=a->side_effects;
  new_andbox->suspended=NULL;
  if (a->suspended) {
     new_andbox->suspended=addto_suspensions_list(new_andbox,a->suspended->reason);
  }

  { struct status_and *first=NULL, *last=NULL,*calls,*calls_new;
     calls=a->calls;
     while(calls!=NULL) {
        calls_new=(struct status_and *) request_memory(STATUS_AND_SIZE);
      calls_new->code=calls->code;
      calls_new->locals=calls->locals;
      calls_new->state=calls->state;
      calls_new->call=copy_orbox(calls->call,new_andbox,calls_new);  /* Do a exact copy of the tree*/

        if (first==NULL) first=calls_new;
        else  last->next=calls_new;
        calls_new->previous=last;
      calls_new->next=NULL;
        last=calls_new;
        calls=calls->next;
     }
     new_andbox->calls=first;
  }

return(new_andbox);
}


void replicate_local_variables(struct AND_BOX *a) /* used by fork -ABX is set*/
{
struct PERM_VAR *l,*new_list;
int i,OLD_VAR_TRAIL_NR;
struct EXTERNAL_VAR *old_externals,*externals;

if (a==NULL) return;

  OLD_VAR_TRAIL_NR=beam_VAR_TRAIL_NR; 
  l=a->perms;
  new_list=NULL;
  while(l) {
        struct PERM_VAR *new;
        Cell *c;
    
        new=request_permVar(a);
      new->yapvar=l->yapvar;
      new->next=new_list;
      new_list=new;

        c=&l->value;
        beam_VAR_TRAIL[beam_VAR_TRAIL_NR]=(Cell) c;
      beam_VAR_TRAIL_NR-=beam_MemGoing;
        beam_VAR_TRAIL[beam_VAR_TRAIL_NR]=(Cell) *c;
      beam_VAR_TRAIL_NR-=beam_MemGoing;

        if ((Cell *)*c==c) {
           new->value=(Cell) &new->value;
           *c=new->value;
      } else {
           new->value= (Cell) *c;
           *c=(Cell) &new->value;
      }
        l=l->next;
  }
  a->perms=new_list;
  l=new_list;
  while(l) {
      l->value=copy_structures(l->value);
        l=l->next;
  }

  /* At this point all old local vars are pointing to the new local vars */

  if (a==beam_ABX) {   /* Nao preciso de criar um novo vector das externals */
    old_externals=a->externals;
    while(old_externals) {
      if (old_externals->var->home->level>=beam_ABX->parent->parent->level) {
        old_externals->value=copy_structures((Cell ) old_externals->value);
        old_externals->var=(struct PERM_VAR *) old_externals->var->value;
          if (isvar(old_externals->var)) {
          struct SUSPENSIONS_VAR *s;
          s=(struct SUSPENSIONS_VAR *) request_memory(SUSPENSIONS_VAR_SIZE); /* Add and_box to suspension list of var*/
          s->and_box=a;
          s->next=old_externals->var->suspensions;
          old_externals->var->suspensions=s;
        }
      }
      old_externals=old_externals->next;
    }
 } else {

  old_externals=a->externals;
  externals=NULL;
  a->externals=NULL;

  while(old_externals) {
      struct EXTERNAL_VAR *e;
      struct SUSPENSIONS_VAR *s;

      e=(struct  EXTERNAL_VAR *) request_memory(EXTERNAL_VAR_SIZE);
      e->next=externals;
      externals=e;

      if (old_externals->var->home->level>=beam_ABX->parent->parent->level) {
      e->value=copy_structures((Cell ) old_externals->value);
      e->var=(struct PERM_VAR *) old_externals->var->value;
      } else {
      e->value=old_externals->value;
      e->var=(struct PERM_VAR *) old_externals->var->value;
      }
      
      if (isvar(e->var)) {
      s=(struct SUSPENSIONS_VAR *) request_memory(SUSPENSIONS_VAR_SIZE); /* Add and_box to suspension list of var*/
      s->and_box=a;
      s->next=e->var->suspensions;
      e->var->suspensions=s;
      }

      old_externals=old_externals->next;
   }
   a->externals=externals;
 }


 /* CUIDADO: Preciso agora de duplicar os vectores das variaveis locais */     
  { struct status_and *calls;
#if !Fast_go
    Cell **backup=NULL; int i, counted=0,max=1000;
    backup=(Cell **) malloc(max);
#else
    Cell *backup[1000]; int i, counted=0;
#endif
   
   calls=a->calls;
   while(calls!=NULL) {
        if (calls->locals!=NULL) {
        /* primeiro vou ver se jŠ foi copiado */
        for(i=0;i<counted;i+=2) {
          if (backup[i]==calls->locals) {
            calls->locals=backup[i+1];
            break;
          }
        }
        if (i==counted) { /* afinal ainda nao foi copiado: fazer copia em duas fases*/
          Cell *c, *newvars, *oldvars; int nr;

          oldvars=calls->locals;
          nr=oldvars[-1];
                newvars=request_memory_locals_noinit(nr);
          calls->locals=newvars;
          /* primeiro actualizo as variaveis */
          for(i=0;i<nr;i++) {
            c=&oldvars[i];
              beam_VAR_TRAIL[beam_VAR_TRAIL_NR]=(Cell) c;
            beam_VAR_TRAIL_NR-=beam_MemGoing;
              beam_VAR_TRAIL[beam_VAR_TRAIL_NR]=(Cell) *c;
            beam_VAR_TRAIL_NR-=beam_MemGoing;       

              if ((Cell *)*c==c) {
              newvars[i]=(Cell) &newvars[i];
              *c=newvars[i];
            } else {
            newvars[i]= (Cell) *c;
              *c=(Cell) &newvars[i];
            }           
          }
          /* depois copio as estruturas */
          for(i=0;i<nr;i++) {
            newvars[i]=copy_structures(oldvars[i]);
          }
#if !Fast_go
          if (max<counted+2) { 
             max+=200;  
             backup=realloc(backup,max); 
             if (backup==NULL) abort_eam("No more memory... realloc in gc \n");
          } 
#else
          if (counted>=998) abort_eam("No more memory... realloc in gc \n");
#endif
          backup[counted]=oldvars;
          backup[counted+1]=newvars;
          counted+=2;
        }
        }
      calls=calls->next;
   }
#if !Fast_go
   free(backup);
#endif
  }

  /* redo the process to the inner boxes */
  { struct status_and *calls;

   calls=a->calls;
   while(calls!=NULL) {
     
    if (calls->call!=NULL) {
      register struct OR_BOX *o;
      register struct status_or *nr;

      o=calls->call;
      nr=o->alternatives;
      while(nr!=NULL) {
      replicate_local_variables(nr->alternative); 
      nr=nr->next;
      }
    }
    calls=calls->next;
   }
  }

  if (beam_MemGoing==1) {
     for(i=OLD_VAR_TRAIL_NR;i>beam_VAR_TRAIL_NR;i-=2) {
        Cell *c;
        c=(Cell *) beam_VAR_TRAIL[i];
        *c=(Cell) beam_VAR_TRAIL[i-1];
     }
  } else {
     for(i=OLD_VAR_TRAIL_NR;i<beam_VAR_TRAIL_NR;i+=2) {
        Cell *c;
        c=(Cell *) beam_VAR_TRAIL[i];
        *c=(Cell) beam_VAR_TRAIL[i+1];
     }
  }

  beam_VAR_TRAIL_NR=OLD_VAR_TRAIL_NR;
}



Cell copy_structures(Cell c) 
{
Cell *NewC, *NewH;
Cell OldC,OldH;

  OldC=deref((Cell) c);

  if (isvar(OldC)) {
    return(OldC);
  }
  if (isatom(OldC)) { 
    return(OldC);
  }

  OldH=(Cell) beam_H;
  NewH=beam_H;
  if (isappl(OldC)) {
    int i,arity;

    NewC=(Cell *) repappl(OldC);
    arity = ((int) ArityOfFunctor((Functor) *NewC));
    *NewH++=*NewC++;
    beam_H+=arity+1;
    for(i=0;i<arity ;i++) {
       *NewH=copy_structures((Cell) NewC);
       NewH++;
       NewC++;
    }
    return(absappl(OldH));
  } 
  /* else if (ispair(c)) { */
     NewC=(Cell *) reppair(OldC);
     beam_H+=2;
     *NewH=copy_structures((Cell) NewC);
     NewC++; 
     NewH++;
     *NewH=copy_structures((Cell) NewC);
     return(abspair(OldH));
}

Generated by  Doxygen 1.6.0   Back to index