source: CIVL/text/include/civlc-omp.cvl@ 09d949f

// civlc-omp.cvl: implementations of functions and types in civlc-omp.cvh

#include<civlc-omp.cvh>
#include<civlc.cvh>
#include<pointer.cvh>
#include<seq.cvh>
#include<concurrency.cvh>
#include<domain.cvh>

/* Completes the definition of struct OMP_gshared given in civlc-omp.cvh.
 */
struct OMP_gshared {
  _Bool init[]; // which threads have joined
  void * original; // pointer to original variable
};

/* Completes the definition of struct OMP_shared given in civlc-omp.cvh.
 */
struct OMP_shared {
  $omp_gshared gshared;
  /* The thread id */
  int tid;
  /* Pointer to the local copy of the shared variable.
   * This provides the thread's "private view" of the variable. */
  void * local;
  /* Pointer to the local status variable */
  void * status;
};

/* Completes the definition of struct OMP_work_record
 * given in civlc-omp.cvh. */
struct OMP_work_record {
  int kind; // loop, barrier, sections, or single
  int location; // location in model of construct
  _Bool arrived; // has this thread arrived yet?
  //$domain loop_domain; // full loop domain; null if not loop
  $domain subdomain; // tasks this thread must do
  // reduction operation?
};

struct OMP_gteam {
  /* scope in which data is allocated in heap */
  $scope scope;
  /* number of threads in team */
  int nthreads;
  /* which threads have joined this gteam */
  _Bool init[];
  /* work queues.  Length nthreads. For each thread,
   * a FIFO queue of work records */
  $omp_work_record work[][];
  /* the shared object data. */
  $omp_gshared shared[];
  $gbarrier gbarrier;
};

struct OMP_team {
  $omp_gteam gteam;
  $scope scope;
  int tid;
  $omp_shared shared[];
  $barrier barrier;
};


/* *********************** Functions *********************** */

$omp_gteam $omp_gteam_create($scope scope, int nthreads) {
  $omp_work_record empty[];
  $omp_gteam result = ($omp_gteam)$malloc(scope, sizeof(struct OMP_gteam));
  _Bool f = $false;

  $seq_init(&empty, 0, NULL);
  result->scope = scope;
  result->nthreads = nthreads;
  $seq_init(&result->init, nthreads, &f);
  $seq_init(&result->work, nthreads, &empty);
  $seq_init(&result->shared, 0, NULL);
  result->gbarrier = $gbarrier_create(scope, nthreads);
  return result;
}

void $omp_gteam_destroy($omp_gteam gteam) {
  int nthreads = gteam->nthreads;

  //$assert $seq_length(&gteam->shared)==0 :
  //"shared objects must be deallocated before freeing gteam";
  for (int i=0; i<nthreads; i++) {
    int numRecords = $seq_length(&gteam->work[i]);

    $assert numRecords == 0 :
            "Thread %d still has %d queued worksharing events",
            i, numRecords;
  }
  $free(gteam->gbarrier);
  $free(gteam);
}

/* creates new local team object for a specific thread. */
$omp_team $omp_team_create($scope scope, $omp_gteam gteam, int tid) {
  $omp_team result = ($omp_team)$malloc(scope, sizeof(struct OMP_team));

  $assert !gteam->init[tid] :
          "Thread %d has already joined gteam",
          tid;
  gteam->init[tid] = $true;
  result->gteam = gteam;
  result->scope = scope;
  result->tid = tid;
  $seq_init(&result->shared, 0, NULL);
  result->barrier = $barrier_create(scope, gteam->gbarrier, tid);
  return result;
}

/* destroys the local team object */
void $omp_team_destroy($omp_team team) {
  int numShared = $seq_length(&team->shared);

  for(int i = 0; i < numShared; i++){
    $free(team->shared[i]);
  }
  $free(team->barrier);
  $free(team);
}

/* creates new global shared object, associated to the given
 * global team. A pointer to the shared variable that this
 * object corresponds to is given.
 */
$omp_gshared $omp_gshared_create($omp_gteam gteam,
                                 void *original) {
  $omp_gshared result =
    ($omp_gshared)$malloc(gteam->scope, sizeof(struct OMP_gshared));
  _Bool f = $false;
 
  $seq_init(&result->init, gteam->nthreads, &f);
  result->original = original;
  //result->status = status;
  return result;
}

/* destroys the global shared object, copying the content
 * to the original variable.
 */
void $omp_gshared_destroy($omp_gshared gshared) {
  $free(gshared);
}

$omp_shared $omp_shared_create($omp_team team,
                               $omp_gshared gshared, void *local, void *status) {
  $omp_shared result =
    ($omp_shared)$malloc(team->scope, sizeof(struct OMP_shared));

  $assert !gshared->init[team->tid] :
  "Thread %d has already created its local copy for %p.\n", 
    team->tid, gshared;
  result->gshared = gshared;
  result->tid = team->tid;
  result->local = local;
  result->status = status;
  $seq_append(&team->shared, &result, 1);
  return result;
}

void $omp_shared_destroy($omp_shared shared) {
  $free(shared);
}

void $omp_read($omp_shared shared, void *result, void *ref) {
  int tid = shared->tid;
  int *status_ref = (int*)$translate_ptr(ref, shared->status);
  int status = *status_ref;

  if(status == EMPTY){
    void *global = $translate_ptr(ref, shared->gshared->original);
 
    $copy(ref, global); // copy shared to local
    *status_ref = FULL; // set status to FULL
  }
  // read local
  $copy(result, ref);
}

void $omp_write($omp_shared shared, void *ref, void *value) {
  int tid = shared->tid;
  int *status_ref = (int*)$translate_ptr(ref, shared->status);
  
  $copy(ref, value);
  *status_ref = MODIFIED;
}

void $omp_apply_assoc($omp_shared shared,
                      $operation op,
                      void *local){
  $atomic {
    void *shared_ref = $translate_ptr(local, shared->gshared->original);
    
    $apply(shared_ref, op, local, shared_ref);
  }
}

void $omp_flush($omp_shared shared, void *ref) {
  // need to drill down into all leaf nodes of the object
  // being flushed...
  // also, it should be ok to flush a memory unit if you are not
  // the owner but you also have no reads or writes to that variable
  $omp_gshared gshared = shared->gshared;
  int tid = shared->tid;
  void *refs[];
  int numRefs;
  
  // get all leaf node pointers
  $leaf_node_ptrs(&refs, ref);
  numRefs = $seq_length(&refs);
  for(int i = 0; i < numRefs; i++){
    void *leaf = refs[i];
    int *leaf_status = (int *)$translate_ptr(leaf, shared->status);
    void *leaf_local = (int *)$translate_ptr(leaf, shared->local);
    void *leaf_shared = (int *)$translate_ptr(leaf, gshared->original);
    
    switch(*leaf_status){
      case EMPTY:
        break;
      case MODIFIED:
        $copy(leaf_shared, leaf_local);
      case FULL:
        *leaf_status = EMPTY;
        $set_default(leaf_local);
        break;
    }
  }
}

void $omp_flush_all($omp_team team) {
   int num_shared = $seq_length(&team->shared);

   for (int i=0; i<num_shared; i++) {
     $omp_shared shared = team->shared[i];
     
     $omp_flush(shared, shared->local);
   }
}

void $omp_barrier($omp_team team){
  $barrier_call(team->barrier);
}

void $omp_barrier_and_flush($omp_team team) {
  // this is a collective operation: all members of team call
  $barrier_call(team->barrier);
  $omp_flush_all(team);
  $barrier_call(team->barrier);
}

$domain $omp_arrive_loop($omp_team team, $domain loop_dom, 
    $domain_strategy strategy){
  $omp_gteam gteam = team->gteam;
  int tid = team->tid;
  int numWorkrecords, nthreads = gteam->nthreads;
  $domain_decomposition decomposition;
  $domain result;
  
  $assert gteam->init[tid] : "The current thread %d has not joined the gteam!", tid;
  numWorkrecords = $seq_length(&gteam->work[tid]);
  for(int i = 0; i < numWorkrecords; i++){
    $omp_work_record workrecord = gteam->work[tid][i];
    
    if(!workrecord.arrived)
      return workrecord.subdomain;
  }
  decomposition = $domain_partition(loop_dom, strategy, nthreads);
  for(int i = 0; i< nthreads; i++){
    $omp_work_record workrecord;
    
    workrecord.kind = LOOP; 
    workrecord.location = 0; // TODO: how to specify the location?
    if(i != tid){
      workrecord.arrived = $false;
    }else{
      workrecord.arrived = $true;
      result = decomposition.subdomains[i];
    }
    workrecord.subdomain = decomposition.subdomains[i];
    $seq_append(&gteam->work[i], &workrecord, 1);
  }
  return result;
}

$domain(1) $omp_arrive_sections($omp_team team, int numSections){
  int low = team->tid, high = numSections - 1, step = team->gteam->nthreads;
  $range range = low .. high # step;
  $domain(1) dom = ($domain(1)) {range};
  
  return dom;
}

int $omp_arrive_single($omp_team team){
  return 0;
}