@z
This file was created by Aleksandar Donev as part of the Sphere Packing Project.
Feel free to use any portion of it and contact me at adonev@princeton.edu
@x

\Title{Manipulating Fortran 95 Array Descriptors}
\author{Aleksandar Donev}
\date{\today}
\maketitle

@*0 Compiler-Specific Array Descriptors.   

@*1 Vendor-Specific Macros.

@#if(F90C==nf95)

   @m _Triplet_Declaration @;
   // Rank-1 descriptor
   typedef struct {
      int extent,mult,lower;
   } Triplet;

   @m _ArrayDescriptor_Declaration(rank_) @;
	typedef struct {
	  void* addr;
	  int offset;
	  Triplet dim[rank_];
	} Dope@e@&rank_;

   @m _lower(dim_) (array->dim[dim_].lower) @;
   @m _upper(dim_) (array->dim[dim_].lower+array->dim[dim_].extent-1) @;
   @m _extent(dim_) (array->dim[dim_].extent) @;
   @m _stride(dim_) (array->dim[dim_].mult) @;
      
@#elif(F90C==ifc)
   // I found this one manually--some fields may be incorrect!

   @m _Triplet_Declaration @;
   // Rank-1 descriptor
	typedef struct {
	  int lower,upper,mult;
	} Triplet;

   @m _ArrayDescriptor_Declaration(rank_) @;
	typedef struct {
	  void *lower_addr, *addr;
	  int size;
	  int kind, kind_extra;
	  unsigned char rank, non_contiguous; // The flag is 0 for contiguous arrays!
	  Triplet dim[rank_];
	} Dope@e@&rank_;

   @m _lower(dim_) (array->dim[dim_].lower) @;
   @m _upper(dim_) (array->dim[dim_].upper) @;
   @m _extent(dim_) (array->dim[dim_].upper-array->dim[dim_].lower+1) @;
   @m _stride(dim_) (array->dim[dim_].mult) @;   

@#elif(F90C==lf95)
   @m _Triplet_Declaration @;
   // Rank-1 descriptor
	typedef struct {
	  int lower,upper,mult,extent;
	} Triplet;

   @m _ArrayDescriptor_Declaration(rank_) @;
	typedef struct {
	  void* addr;
	  int alloc_size;
	  int size;
	  Triplet dim[rank_];
	} Dope@e@&rank_;

   @m _lower(dim_) (array->dim[dim_].lower) @;
   @m _upper(dim_) (array->dim[dim_].upper) @;
   @m _extent(dim_) (array->dim[dim_].extent) @;
   @m _stride(dim_) (array->dim[dim_].mult) @;
         
@#endif

@*1 Creating array descriptors.

Since we cannot include preprocessing directives inside macros in FWEB, we extract the compiler-dependent pieces into conditionally-defined macros:
   
    @#if(F90C==nf95)
      @m _AssignStrides(dim_, type_) @;
         _stride(dim_)=strides[dim_]*sizeof(type_);
         _extent(dim_)=upper_bounds[dim_]-lower_bounds[dim_]+1;
      @m _AssignOffset @;
         array->offset=(void *)address-(void *)offset_address;
      @m _AssignMisc(type_,rank_) @;
    @#elif(F90C==ifc)
      @m _AssignStrides(dim_, type_) @;    
         _stride(dim_)=strides[dim_]; // Intel does not use byte strides here
         _upper(dim_)=upper_bounds[dim_];
      @m _AssignOffset @;
         array->lower_addr=(void *)offset_address;
      @m _AssignMisc(type_,rank_) @;
        array->size=size;
		  array->kind=sizeof(type_);
		  array->kind_extra=sizeof(type_);
		  array->rank=rank_;
		  array->non_contiguous=1; // I am not going to bother checking this here!           
    @#elif(F90C==lf95)
      @m _AssignStrides(dim_, type_) @;      
         _stride(dim_)=strides[dim_]*sizeof(type_);
         _upper(dim_)=upper_bounds[dim_];
         _extent(dim_)=upper_bounds[dim_]-lower_bounds[dim_]+1;
      @m _AssignOffset @;   
      @m _AssignMisc(type_,rank_) @;
		  array->alloc_size=0; // This is not allocated here
		  array->size=size;      
    @#endif 
      
@m _MakeArrayDescriptor_C_Body(type_,kind_,rank_) @;
void _BoundProcedure(MakeArrayDescriptor_C_@e@&kind_@e@&rank_) \
   (Dope@e@&rank_ *array, _PassedByValue(void*,void_address), \
   int lower_bounds[], int upper_bounds[], int strides[]) @;
{
   _AcceptValue(void*,void_address) @;

   int dim, offset, size;
   type_ *address, *offset_address;   

   offset=0; // This is used in address calculations and some descriptors pre-store it
   size=1; // Total array size
   for(dim=0;dim<rank_;dim++)
   {
      _lower(dim)=lower_bounds[dim];      
      _AssignStrides(dim, type_) @;
      offset -= strides[dim]*lower_bounds[dim]; 
      size *= _extent(dim);
   }

   address=(type_ *)void_address;
   offset_address=address+offset;
   array->addr=void_address;   
   _AssignOffset @;

   _AssignMisc(type_,rank_) @;        
}

@m _MakeArrayDescriptor_C_Body_TR(tk_number_,rank_) @;
   _MakeArrayDescriptor_C_Body(_AllCTypes(tk_number_),_AllCKinds(tk_number_),rank_) @;
      
@a
#include <stdbool.h>

_Triplet_Declaration @;
_CallMacroDo(7,_ArrayDescriptor_Declaration) @;

_GenerateBody_TKR_Array(N_TC_ALL,_MakeArrayDescriptor_C_Body_TR) @;

@
@I Macros.hweb
@I C_Interop.hweb

@%% EOF