"Fossies" - the Fresh Open Source Software Archive

Member "PDL-2.080/Basic/Core/pdlaffine.c" (18 May 2022, 12704 Bytes) of package /linux/misc/PDL-2.080.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) C and C++ source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "pdlaffine.c" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 2.079_vs_2.080.

    1 #include "pdl.h"
    2 #define PDL_IN_CORE
    3 #include "pdlcore.h"
    4 
    5 #define PDL_ALL_GENTYPES { PDL_SB, PDL_B, PDL_S, PDL_US, PDL_L, PDL_UL, PDL_IND, PDL_ULL, PDL_LL, PDL_F, PDL_D, PDL_LD, PDL_CF, PDL_CD, PDL_CLD, -1 }
    6 
    7 /* generated from:
    8 pp_def(
    9        'affineinternal',
   10        HandleBad => 1,
   11        AffinePriv => 1,
   12        P2Child => 1,
   13        ReadDataFuncName => "pdl_readdata_affineinternal",
   14        WriteBackDataFuncName => "pdl_writebackdata_affineinternal",
   15        EquivCPOffsCode => '
   16           if ($PDL(CHILD)->state & $PDL(PARENT)->state & PDL_ALLOCATED) {
   17             PDL_Indx i, poffs=$PRIV(offs), nd;
   18             for(i=0; i<$PDL(CHILD)->nvals; i++) {
   19               $EQUIVCPOFFS(i,poffs);
   20               for(nd=0; nd<$PDL(CHILD)->ndims; nd++) {
   21                 poffs += $PRIV(incs[nd]);
   22                 if( (nd<$PDL(CHILD)->ndims-1 &&
   23                      (i+1)%$PDL(CHILD)->dimincs[nd+1]) ||
   24                    nd == $PDL(CHILD)->ndims-1)
   25                         break;
   26                 poffs -= $PRIV(incs[nd]) *
   27                         $PDL(CHILD)->dims[nd];
   28               }
   29             }
   30           }',
   31        Doc => undef,    # 'internal',
   32 );
   33 */
   34 
   35 #define COPYDATA(ctype, from_id, to_id) \
   36   PDL_DECLARE_PARAMETER_BADVAL(ctype, (trans->vtable->per_pdl_flags[to_id]), to_pdl, (trans->pdls[to_id]), 1) \
   37   PDL_DECLARE_PARAMETER_BADVAL(ctype, (trans->vtable->per_pdl_flags[from_id]), from_pdl, (trans->pdls[from_id]), 1) \
   38   PDL_Indx i, poffs=trans->offs, nd; \
   39   for (i=0; i<trans->pdls[to_id]->nvals ; i++) { \
   40     to_pdl_physdatap[i] = (trans->bvalflag && from_pdl_physdatap[poffs] == from_pdl_badval) \
   41       ? to_pdl_badval : from_pdl_physdatap[poffs]; \
   42     for (nd=0; nd<trans->pdls[to_id]->ndims ; nd++) { \
   43       poffs += trans->incs[nd]; \
   44       if ((nd<trans->pdls[to_id]->ndims -1 && \
   45           (i+1)%trans->pdls[to_id]->dimincs[nd+1]) || \
   46          nd == trans->pdls[to_id]->ndims -1) \
   47               break; \
   48       poffs -= trans->incs[nd] * trans->pdls[to_id]->dims[nd]; \
   49     } \
   50   }
   51 
   52 pdl_error pdl_readdata_affine(pdl_trans *trans) {
   53   pdl_error PDL_err = {0, NULL, 0};
   54   if (!(trans->pdls[0]->state & trans->pdls[1]->state & PDL_ALLOCATED)) return PDL_err;
   55 #define X(sym, ctype, ...) COPYDATA(ctype, 0, 1)
   56   PDL_GENERICSWITCH(PDL_TYPELIST2_ALL, trans->__datatype, X, return pdl_make_error(PDL_EUSERERROR, "Not a known data type code=%d", trans->__datatype))
   57 #undef X
   58   return PDL_err;
   59 }
   60 
   61 pdl_error pdl_writebackdata_affine(pdl_trans *trans) {
   62   pdl_error PDL_err = {0, NULL, 0};
   63   if (!(trans->pdls[0]->state & trans->pdls[1]->state & PDL_ALLOCATED)) return PDL_err;
   64 #define X(sym, ctype, ...) COPYDATA(ctype, 1, 0)
   65   PDL_GENERICSWITCH(PDL_TYPELIST2_ALL, trans->__datatype, X, return pdl_make_error(PDL_EUSERERROR, "Not a known data type code=%d", trans->__datatype))
   66 #undef X
   67   return PDL_err;
   68 }
   69 
   70 /* generated from:
   71 pp_def( 'affine',
   72         P2Child => 1,
   73         TwoWay => 1,
   74         AffinePriv => 1,
   75         GlobalNew => 'affine_new',
   76         OtherPars => 'PDL_Indx offspar; PDL_Indx dims[]; PDL_Indx incs[]',
   77         Comp => 'PDL_Indx nd; PDL_Indx offset; PDL_Indx sdims[$COMP(nd)];
   78                 PDL_Indx sincs[$COMP(nd)];',
   79         MakeComp => '
   80                 PDL_Indx i = 0;
   81                 $COMP(nd) = dims_count;
   82                 if ($COMP(nd) < 0)
   83                       $CROAK("Affine: can not have negative no of dims");
   84                 if ($COMP(nd) != incs_count)
   85                       $CROAK("Affine: number of incs does not match dims");
   86                 $DOCOMPALLOC();
   87                 $COMP(offset) = offspar;
   88                 for (i=0; i<$COMP(nd); i++) {
   89                         $COMP(sdims)[i] = dims[i];
   90                         $COMP(sincs)[i] = incs[i];
   91                 }
   92                 ',
   93         RedoDims => '
   94                 PDL_Indx i;
   95                 $SETNDIMS($COMP(nd));
   96                 $DOPRIVALLOC();
   97                 $PRIV(offs) = $COMP(offset);
   98                 for (i=0;i<$PDL(CHILD)->ndims;i++) {
   99                         $PRIV(incs)[i] = $COMP(sincs)[i];
  100                         $PDL(CHILD)->dims[i] = $COMP(sdims)[i];
  101                 }
  102                 $SETDIMS();
  103                 ',
  104         Doc => undef,
  105 );
  106 */
  107 
  108 typedef struct pdl_params_affine {
  109   PDL_Indx  nd;
  110   PDL_Indx  offset;
  111   PDL_Indx  *sdims;
  112   PDL_Indx  *sincs;
  113 } pdl_params_affine;
  114 
  115 pdl_error pdl_affine_redodims(pdl_trans *trans) {
  116   pdl_error PDL_err = {0, NULL, 0};
  117   pdl_params_affine *params = trans->params;
  118   pdl *__it = trans->pdls[1];
  119   pdl_hdr_childcopy(trans);
  120   PDL_Indx i;
  121   PDL_RETERROR(PDL_err, pdl_reallocdims(__it, params->nd));
  122   trans->incs = malloc(sizeof(*trans->incs) * trans->pdls[1]->ndims);
  123   if (!trans->incs) return pdl_make_error_simple(PDL_EFATAL, "Out of Memory\n");
  124   trans->offs = params->offset;
  125   for (i=0;i<trans->pdls[1]->ndims;i++) {
  126     trans->incs[i] = params->sincs[i];
  127     trans->pdls[1]->dims[i] = params->sdims[i];
  128   }
  129   PDL_RETERROR(PDL_err, pdl_setdims_careful(__it));
  130   trans->dims_redone = 1;
  131   return PDL_err;
  132 }
  133 
  134 pdl_error pdl_affine_free(pdl_trans *trans, char destroy) {
  135   pdl_error PDL_err = {0, NULL, 0};
  136   pdl_params_affine *params = trans->params;
  137   if (destroy) {
  138     free(params->sdims);
  139     free(params->sincs);
  140   }
  141   if ((trans)->dims_redone) free(trans->incs);
  142   return PDL_err;
  143 }
  144 
  145 static pdl_datatypes pdl_affine_vtable_gentypes[] = PDL_ALL_GENTYPES;
  146 static char pdl_affine_vtable_flags[] = {
  147   PDL_TPDL_VAFFINE_OK, PDL_TPDL_VAFFINE_OK
  148 };
  149 static PDL_Indx pdl_affine_vtable_realdims[] = { 0, 0 };
  150 static char *pdl_affine_vtable_parnames[] = { "PARENT","CHILD" };
  151 static short pdl_affine_vtable_parflags[] = {
  152   0,
  153   PDL_PARAM_ISCREAT|PDL_PARAM_ISCREATEALWAYS|PDL_PARAM_ISOUT|PDL_PARAM_ISWRITE
  154 };
  155 static pdl_datatypes pdl_affine_vtable_partypes[] = { -1, -1 };
  156 static PDL_Indx pdl_affine_vtable_realdims_starts[] = { 0, 0 };
  157 static PDL_Indx pdl_affine_vtable_realdims_ind_ids[] = { 0 };
  158 static char *pdl_affine_vtable_indnames[] = { "" };
  159 pdl_transvtable pdl_affine_vtable = {
  160   0, PDL_ITRANS_ISAFFINE|PDL_ITRANS_TWOWAY|PDL_ITRANS_DO_DATAFLOW_ANY, pdl_affine_vtable_gentypes, 1, 2, pdl_affine_vtable_flags,
  161   pdl_affine_vtable_realdims, pdl_affine_vtable_parnames,
  162   pdl_affine_vtable_parflags, pdl_affine_vtable_partypes,
  163   pdl_affine_vtable_realdims_starts, pdl_affine_vtable_realdims_ind_ids, 0,
  164   0, pdl_affine_vtable_indnames,
  165   pdl_affine_redodims, NULL, NULL,
  166   pdl_affine_free,
  167   sizeof(pdl_params_affine),"affine_new"
  168 };
  169 
  170 pdl_error pdl_affine_new(pdl *PARENT,pdl *CHILD,PDL_Indx offspar,PDL_Indx *dims,PDL_Indx dims_count, PDL_Indx *incs, PDL_Indx incs_count) {
  171   pdl_error PDL_err = {0, NULL, 0};
  172   pdl_trans *trans = (void *)pdl_create_trans(&pdl_affine_vtable);
  173   pdl_params_affine *params = trans->params;
  174   trans->pdls[0] = PARENT;
  175   trans->pdls[1] = CHILD;
  176   PDL_RETERROR(PDL_err, pdl_trans_check_pdls(trans));
  177   char badflag_cache = pdl_trans_badflag_from_inputs((pdl_trans *)trans);
  178   pdl_type_coerce((pdl_trans *)trans);
  179   PARENT = trans->pdls[0];
  180   CHILD = trans->pdls[1];
  181   PDL_Indx i = 0;
  182   params->nd = dims_count;
  183   if (params->nd < 0)
  184     return pdl_make_error_simple(PDL_EUSERERROR, "Error in affine: can not have negative no of dims");
  185   if (params->nd != incs_count)
  186     return pdl_make_error_simple(PDL_EUSERERROR, "Error in affine: number of incs does not match dims");
  187   params->sdims = malloc(sizeof(* params->sdims) * params->nd);
  188   if (!params->sdims) return pdl_make_error_simple(PDL_EFATAL, "Out of Memory\n");
  189   params->sincs = malloc(sizeof(* params->sincs) * params->nd);
  190   if (!params->sincs) return pdl_make_error_simple(PDL_EFATAL, "Out of Memory\n");
  191   params->offset = offspar;
  192   for (i=0; i<params->nd; i++) {
  193     params->sdims[i] = dims[i];
  194     params->sincs[i] = incs[i];
  195   }
  196   PDL_RETERROR(PDL_err, pdl_make_trans_mutual((pdl_trans *)trans));
  197   if (badflag_cache)
  198     CHILD->state |= PDL_BADVAL;
  199   return PDL_err;
  200 }
  201 
  202 /* generated from:
  203 pp_def(
  204         'converttypei',
  205         GlobalNew => 'converttypei_new',
  206         OtherPars => 'int totype;',
  207         Identity => 1,
  208 # Forced types
  209         FTypes => {CHILD => '$COMP(totype)'},
  210         Doc => 'internal',
  211 );
  212 */
  213 
  214 typedef struct pdl_params_converttypei {
  215   int  totype;
  216 } pdl_params_converttypei;
  217 
  218 pdl_error pdl_converttypei_redodims(pdl_trans *trans) {
  219   pdl_error PDL_err = {0, NULL, 0};
  220   pdl *__it = trans->pdls[1];
  221   pdl_hdr_childcopy(trans);
  222   PDL_Indx i;
  223   PDL_RETERROR(PDL_err, pdl_reallocdims(__it, trans->pdls[0]->ndims));
  224   for (i=0; i<trans->pdls[1]->ndims; i++)
  225     trans->pdls[1]->dims[i] = trans->pdls[0]->dims[i];
  226   PDL_RETERROR(PDL_err, pdl_setdims_careful(__it));
  227   pdl_reallocbroadcastids(trans->pdls[1], trans->pdls[0]->nbroadcastids);
  228   for (i=0; i<trans->pdls[0]->nbroadcastids; i++)
  229     trans->pdls[1]->broadcastids[i] = trans->pdls[0]->broadcastids[i];
  230   trans->dims_redone = 1;
  231   return PDL_err;
  232 }
  233 
  234 #define COPYCONVERT(from_pdl, to_pdl) \
  235   { \
  236     PDL_Indx i; \
  237     for(i=0; i<trans->pdls[1]->nvals; i++) { \
  238       to_pdl ## _physdatap[i] = trans->bvalflag && from_pdl ## _physdatap[i] == from_pdl ## _badval \
  239         ? to_pdl ## _badval \
  240         : from_pdl ## _physdatap[i]; \
  241       ; \
  242     } \
  243   }
  244 
  245 pdl_error pdl_converttypei_readdata(pdl_trans *trans) {
  246   pdl_error PDL_err = {0, NULL, 0};
  247   pdl_params_converttypei *params = trans->params;
  248   PDLDEBUG_f(printf("pdl_converttypei_readdata %s=%p from parent: ", trans->vtable->name, trans); pdl_dump(trans->pdls[0]));
  249 #define X_OUTER(datatype_out, ctype_out, ...) \
  250   PDL_DECLARE_PARAMETER_BADVAL(ctype_out, (trans->vtable->per_pdl_flags[1]), CHILD, (trans->pdls[1]), 1) \
  251   PDL_GENERICSWITCH2(PDL_TYPELIST2_ALL_, trans->__datatype, X_INNER, return pdl_make_error(PDL_EUSERERROR, "Not a known data type code=%d", trans->__datatype))
  252 #define X_INNER(datatype_in, ctype_in, ...) \
  253   PDL_DECLARE_PARAMETER_BADVAL(ctype_in, (trans->vtable->per_pdl_flags[0]), PARENT, (trans->pdls[0]), 1) \
  254   COPYCONVERT(PARENT, CHILD)
  255   PDL_GENERICSWITCH(PDL_TYPELIST2_ALL, params->totype, X_OUTER, return pdl_make_error(PDL_EUSERERROR, "Not a known data type code=%d", params->totype))
  256 #undef X_INNER
  257   return PDL_err;
  258 }
  259 
  260 pdl_error pdl_converttypei_writebackdata(pdl_trans *trans) {
  261   pdl_error PDL_err = {0, NULL, 0};
  262   pdl_params_converttypei *params = trans->params;
  263   PDLDEBUG_f(printf("pdl_converttypei_writebackdata %s=%p from child: ", trans->vtable->name, trans); pdl_dump(trans->pdls[1]));
  264 #define X_INNER(datatype_in, ctype_in, ...) \
  265   PDL_DECLARE_PARAMETER_BADVAL(ctype_in, (trans->vtable->per_pdl_flags[0]), PARENT, (trans->pdls[0]), 1) \
  266   COPYCONVERT(CHILD, PARENT)
  267   PDL_GENERICSWITCH(PDL_TYPELIST2_ALL, params->totype, X_OUTER, return pdl_make_error(PDL_EUSERERROR, "Not a known data type code=%d", params->totype))
  268 #undef X_INNER
  269 #undef X_OUTER
  270   return PDL_err;
  271 }
  272 
  273 static pdl_datatypes pdl_converttypei_vtable_gentypes[] = PDL_ALL_GENTYPES;
  274 static char pdl_converttypei_vtable_flags[] = {
  275   0, 0
  276 };
  277 static PDL_Indx pdl_converttypei_vtable_realdims[] = { 0, 0 };
  278 static char *pdl_converttypei_vtable_parnames[] = { "PARENT","CHILD" };
  279 static short pdl_converttypei_vtable_parflags[] = {
  280   0,
  281   PDL_PARAM_ISCREAT|PDL_PARAM_ISCREATEALWAYS|PDL_PARAM_ISIGNORE|PDL_PARAM_ISOUT|PDL_PARAM_ISWRITE
  282 };
  283 static pdl_datatypes pdl_converttypei_vtable_partypes[] = { -1, -1 };
  284 static PDL_Indx pdl_converttypei_vtable_realdims_starts[] = { 0, 0 };
  285 static PDL_Indx pdl_converttypei_vtable_realdims_ind_ids[] = { 0 };
  286 static char *pdl_converttypei_vtable_indnames[] = { "" };
  287 pdl_transvtable pdl_converttypei_vtable = {
  288   PDL_TRANS_BADPROCESS, PDL_ITRANS_TWOWAY|PDL_ITRANS_DO_DATAFLOW_ANY, pdl_converttypei_vtable_gentypes, 1, 2, pdl_converttypei_vtable_flags,
  289   pdl_converttypei_vtable_realdims, pdl_converttypei_vtable_parnames,
  290   pdl_converttypei_vtable_parflags, pdl_converttypei_vtable_partypes,
  291   pdl_converttypei_vtable_realdims_starts, pdl_converttypei_vtable_realdims_ind_ids, 0,
  292   0, pdl_converttypei_vtable_indnames,
  293   pdl_converttypei_redodims, pdl_converttypei_readdata, pdl_converttypei_writebackdata,
  294   NULL,
  295   sizeof(pdl_params_converttypei),"converttypei_new"
  296 };
  297 
  298 pdl_error pdl_converttypei_new(pdl  *PARENT,pdl  *CHILD,int  totype) {
  299   pdl_error PDL_err = {0, NULL, 0};
  300   pdl_trans *trans = (void *)pdl_create_trans(&pdl_converttypei_vtable);
  301   pdl_params_converttypei *params = trans->params;
  302   trans->pdls[0] = PARENT;
  303   trans->pdls[1] = CHILD;
  304   PDL_RETERROR(PDL_err, pdl_trans_check_pdls(trans));
  305   char badflag_cache = pdl_trans_badflag_from_inputs((pdl_trans *)trans);
  306   pdl_type_coerce((pdl_trans *)trans);
  307   PARENT = trans->pdls[0];
  308   CHILD = trans->pdls[1];
  309   CHILD->datatype = params->totype = totype;
  310   PDL_RETERROR(PDL_err, pdl_make_trans_mutual((pdl_trans *)trans));
  311   if (badflag_cache)
  312     CHILD->state |= PDL_BADVAL;
  313   return PDL_err;
  314 }