# -*-perl-*-

use strict;
use warnings;
use Config;
use File::Basename qw(&basename &dirname);

# how many variable types (ie PDL_Byte, ...) are there?
require './Types.pm';
my $ntypes = $#PDL::Types::names;
my $PDL_DATATYPES = PDL::Types::datatypes_header();

require './Config.pm';
die "No PDL::Config found" unless %PDL::Config;
my $mymalloc = $PDL::Config{MALLOCDBG}->{define} // '';

my $file = shift @ARGV;
print "Extracting $file\n";
open OUT,">$file" or die "Can't create $file: $!";
chmod 0644, $file;

# In this section, perl variables will be expanded during extraction.
# You can use $Config{...} to use Configure variables.

print OUT <<"!GROK!THIS!";

/*
 * THIS FILE IS GENERATED FROM pdl.h.PL! Do NOT edit!
 */

#ifndef __PDL_H
#define __PDL_H

#define PDL_DEBUGGING 1

#ifdef PDL_DEBUGGING
extern int pdl_debugging;
#define PDLDEBUG_f(a)           if(pdl_debugging) a
#else
#define PDLDEBUG_f(a)
#endif

#define ANYVAL_TO_SV(outsv,inany) do { switch (inany.type) { \\
                case PDL_B:   outsv = newSViv( (IV)(inany.value.B) ); break; \\
                case PDL_S:   outsv = newSViv( (IV)(inany.value.S) ); break; \\
                case PDL_US:  outsv = newSViv( (IV)(inany.value.U) ); break; \\
                case PDL_L:   outsv = newSViv( (IV)(inany.value.L) ); break; \\
                case PDL_IND: outsv = newSViv( (IV)(inany.value.N) ); break; \\
                case PDL_LL:  outsv = newSViv( (IV)(inany.value.Q) ); break; \\
                case PDL_F:   outsv = newSVnv( (NV)(inany.value.F) ); break; \\
                case PDL_D:   outsv = newSVnv( (NV)(inany.value.D) ); break; \\
                default:      outsv = &PL_sv_undef; \\
            } \\
        } while (0)

#define ANYVAL_FROM_CTYPE(outany,avtype,inval) do { switch (avtype) { \\
                case PDL_B:   outany.type = avtype; outany.value.B = (PDL_Byte)(inval);     break; \\
                case PDL_S:   outany.type = avtype; outany.value.S = (PDL_Short)(inval);    break; \\
                case PDL_US:  outany.type = avtype; outany.value.U = (PDL_Ushort)(inval);   break; \\
                case PDL_L:   outany.type = avtype; outany.value.L = (PDL_Long)(inval);     break; \\
                case PDL_IND: outany.type = avtype; outany.value.N = (PDL_Indx)(inval);     break; \\
                case PDL_LL:  outany.type = avtype; outany.value.Q = (PDL_LongLong)(inval); break; \\
                case PDL_F:   outany.type = avtype; outany.value.F = (PDL_Float)(inval);    break; \\
                case PDL_D:   outany.type = avtype; outany.value.D = (PDL_Double)(inval);   break; \\
                default:      outany.type = -1;     outany.value.B = 0; \\
            } \\
        } while (0)

#define ANYVAL_TO_CTYPE(outval,ctype,inany) do { switch (inany.type) { \\
                case PDL_B:   outval = (ctype)(inany.value.B); break; \\
                case PDL_S:   outval = (ctype)(inany.value.S); break; \\
                case PDL_US:  outval = (ctype)(inany.value.U); break; \\
                case PDL_L:   outval = (ctype)(inany.value.L); break; \\
                case PDL_IND: outval = (ctype)(inany.value.N); break; \\
                case PDL_LL:  outval = (ctype)(inany.value.Q); break; \\
                case PDL_F:   outval = (ctype)(inany.value.F); break; \\
                case PDL_D:   outval = (ctype)(inany.value.D); break; \\
                default:      outval = 0; \\
            } \\
        } while (0)

/* Auto-PThreading (i.e. multi-threading) settings for PDL functions */
/*  Target number of pthreads: Actual will be this number or less.
    A 0 here means no pthreading */
extern int pdl_autopthread_targ;

/*  Actual number of pthreads: This is the number of pthreads created for the last
    operation where pthreading was used
    A 0 here means no pthreading */
extern int pdl_autopthread_actual;
/* Minimum size of the target PDL involved in pdl function to attempt pthreading (in MBytes )
    For small PDLs, it probably isn't worth starting multiple pthreads, so this variable
    is used to define that threshold (in M-elements, or 2^20 elements ) */
extern int pdl_autopthread_size;

typedef struct pdl pdl;

$PDL_DATATYPES

extern int _anyval_eq_anyval(PDL_Anyval, PDL_Anyval);

#define ANYVAL_EQ_ANYVAL(x,y) (_anyval_eq_anyval(x,y))

$mymalloc
!GROK!THIS!

# set up the badvalues structure
# - for binary compatability, this is created whatever the
#   value of $bvalflag and $usenan
print OUT "typedef struct badvals {\n";
foreach my $i ( reverse(0 .. $ntypes) ) {
    my $name = $PDL::Types::names[$i];
    my $realctype = $PDL::Types::typehash{$name}->{realctype};
    my $cname     = $PDL::Types::typehash{$name}->{ctype};
    $cname =~ s/^PDL_//;
    printf OUT "   %18s   %s;\n",$realctype,$cname;
    printf OUT "   %18s   default_%s;\n",$realctype,$cname;
}
print OUT "} badvals;\n";

print OUT <<'!NO!SUBS!';

/*
 * Define the pdl C data structure which maps onto the original PDL
 * perl data structure.
 *
 * Note: pdl.sv is defined as a void pointer to avoid having to
 * include perl.h in C code which just needs the pdl data.
 *
 * We start with the meanings of the pdl.flags bitmapped flagset,
 * continue with a prerequisite "trans" structure that represents
 * transformations between linked PDLs, and finish withthe PD
 * structure itself.
*/

#define PDL_NDIMS      6 /* Number of dims[] to preallocate */
#define PDL_NCHILDREN  8 /* Number of children ptrs to preallocate */
#define PDL_NTHREADIDS 4 /* Number of different threadids/pdl to preallocate */

/* Constants for pdl.state - not all combinations make sense */

  /* data allocated for this pdl.  this implies that the data               */
  /* is up to date if !PDL_PARENTCHANGED                                    */
#define  PDL_ALLOCATED           0x0001
  /* Parent data has been altered without changing this pdl                 */
#define  PDL_PARENTDATACHANGED   0x0002
  /* Parent dims or incs has been altered without changing this pdl.        */
#define  PDL_PARENTDIMSCHANGED   0x0004
  /* Physical data representation of the parent has changed (e.g.           */
  /* physical transposition), so incs etc. need to be recalculated.         */
#define  PDL_PARENTREPRCHANGED   0x0008
#define  PDL_ANYCHANGED          (PDL_PARENTDATACHANGED|PDL_PARENTDIMSCHANGED|PDL_PARENTREPRCHANGED)
  /* Dataflow tracking flags -- F/B for forward/back.  These get set        */
  /* by transformations when they are set up.                               */
#define  PDL_DATAFLOW_F          0x0010
#define  PDL_DATAFLOW_B          0x0020
#define  PDL_DATAFLOW_ANY        (PDL_DATAFLOW_F|PDL_DATAFLOW_B)
  /* Was this PDL null originally?                                          */
#define  PDL_NOMYDIMS            0x0040
  /* Dims should be received via trans.                                     */
#define  PDL_MYDIMS_TRANS        0x0080
  /* OK to attach a vaffine transformation (i.e. a slice)                   */
#define  PDL_OPT_VAFFTRANSOK     0x0100
#define  PDL_OPT_ANY_OK          (PDL_OPT_VAFFTRANSOK)
  /* This is the hdrcpy flag                                                */
#define  PDL_HDRCPY              0x0200
  /* This is a badval flag for this PDL (hmmm -- there is also a flag       */
  /* in the struct itself -- must be clearer about what this is for. --CED) */
#define  PDL_BADVAL              0x0400
  /* Debugging flag                                                         */
#define  PDL_TRACEDEBUG          0x0800
  /* inplace flag                                                           */
#define  PDL_INPLACE             0x1000
  /* Flag indicating destruction in progress                                */
#define         PDL_DESTROYING          0x2000
  /* If this flag is set, you must not alter the data pointer nor           */
  /* free this piddle nor use datasv (which should be null).                */
  /* This means e.g. that the piddle is mmapped from a file                 */
#define         PDL_DONTTOUCHDATA       0x4000
  /* Not sure what this does, but PP uses it a lot. -- CED                  */
#define PDL_CR_SETDIMSCOND(wtrans,pdl) (((pdl)->state & PDL_MYDIMS_TRANS) \
                && (pdl)->trans == (pdl_trans *)(wtrans))

/**************************************************
 *
 * Transformation structure
 *
 * The structure is general enough to deal with functional transforms
 * (which were originally intended) but only slices and retype transforms
 * were implemented.
 *
 */

typedef enum pdl_transtype { PDL_SLICE, PDL_RETYPE }
        pdl_transtype;

/* Transformation flags */
#define         PDL_TRANS_AFFINE        0x0001

/* Transpdl flags */
#define         PDL_TPDL_VAFFINE_OK     0x01

typedef struct pdl_trans pdl_trans;

typedef struct pdl_transvtable {
        pdl_transtype transtype;
        int flags;
        int nparents;
        int npdls;
        char *per_pdl_flags;
        void (*redodims)(pdl_trans *tr);      /* Only dims and internal trans (makes phys) */
        void (*readdata)(pdl_trans *tr);      /* Only data, to "data" ptr  */
        void (*writebackdata)(pdl_trans *tr); /* "data" ptr to parent or granny */
        void (*freetrans)(pdl_trans *tr);     /* Free both the contents and it of
                                                 the trans member */
        void (*dump)(pdl_trans *tr);          /* Dump this transformation */
        void (*findvparent)(pdl_trans *tr);   /* Find a virtual parent and make ready for
                                                 readdata etc. */
        pdl_trans *(*copy)(pdl_trans *tr);    /* Full copy */
        int structsize;
        char *name;                           /* For debuggers, mostly */
} pdl_transvtable;

/* All trans must start with this */

/* Trans flags */

        /* Reversible transform -- flag indicates data can flow both ways.  */
        /* This is critical in routines that both input from and output to  */
        /* a non-single-valued pdl: updating must occur.  (Note that the    */         
        /* transform is not necessarily mathematically reversible)          */
#define  PDL_ITRANS_REVERSIBLE        0x0001
        /* Whether, if a child is changed, this trans should be destroyed or not */
        /* (flow if set; sever if clear) */
#define  PDL_ITRANS_DO_DATAFLOW_F     0x0002
#define  PDL_ITRANS_DO_DATAFLOW_B     0x0004
#define  PDL_ITRANS_DO_DATAFLOW_ANY   (PDL_ITRANS_DO_DATAFLOW_F|PDL_ITRANS_DO_DATAFLOW_B)

#define  PDL_ITRANS_ISAFFINE          0x1000
#define  PDL_ITRANS_VAFFINEVALID      0x2000
#define  PDL_ITRANS_NONMUTUAL         0x4000  /* flag for destruction */

// These define struct pdl_trans and all derived structures. There are many
// structures that defined in other parts of the code that can be referenced
// like a pdl_trans* because all of these structures have the same pdl_trans
// initial piece. These structures can contain multiple pdl* elements in them.
// Thus pdl_trans itself ends with a flexible pdl*[] array, which can be used to
// reference any number of pdl objects. As a result pdl_trans itself can NOT be
// instantiated

// vparent is the "virtual parent" which is either
// the parent or grandparent or whatever. The trans -structure must store
// both the relationship with our current parent and, if necessary, the
// virtual parent.

#define PDL_TRANS_START_COMMON                                          \
  int magicno;                                                          \
  short flags;                                                          \
  pdl_transvtable *vtable;                                              \
  void (*freeproc)(struct pdl_trans *);  /* Call to free this           \
                                          (means whether malloced or not) */ \
  int bvalflag;  /* required for binary compatability even if WITH_BADVAL=0 */ \
  int has_badvalue;                                                     \
  PDL_Anyval badvalue;                                                      \
  int __datatype

#define PDL_TRANS_START(np) \
  PDL_TRANS_START_COMMON; \
  /* The pdls involved in the transformation */ \
  pdl *pdls[np]

#define PDL_TRANS_START_FLEXIBLE() \
  PDL_TRANS_START_COMMON; \
  /* The pdls involved in the transformation */ \
  pdl *pdls[]

#ifdef PDL_DEBUGGING
#define PDL_CHKMAGIC_GENERAL(it,this_magic,type) if((it)->magicno != this_magic) croak("INVALID " #type "MAGIC NO 0x%p %d\n",it,(int)((it)->magicno)); else (void)0
#else
#define PDL_CHKMAGIC_GENERAL(it,this_magic,type)
#endif

#define PDL_TR_MAGICNO      0x91827364
#define PDL_TR_SETMAGIC(it) it->magicno = PDL_TR_MAGICNO
#define PDL_TR_CLRMAGIC(it) it->magicno = 0x99876134
#define PDL_TR_CHKMAGIC(it) PDL_CHKMAGIC_GENERAL(it, PDL_TR_MAGICNO, "TRANS ")

// This is a generic parent of all the trans structures. It is a flexible array
// (can store an arbitrary number of pdl objects). Thus this can NOT be
// instantiated, only "child" structures can
struct pdl_trans {
  PDL_TRANS_START_FLEXIBLE();
} ;

typedef struct pdl_trans_affine {
        PDL_TRANS_START(2);
/* affine relation to parent */
	PDL_Indx *incs; PDL_Indx offs;
} pdl_trans_affine;

/* Need to make compatible with pdl_trans_affine */
typedef struct pdl_vaffine {
	PDL_TRANS_START(2);
	PDL_Indx *incs; PDL_Indx offs;
	int ndims;
	PDL_Indx def_incs[PDL_NDIMS];
	pdl *from;
} pdl_vaffine;

#define PDL_VAFFOK(pdl) (pdl->state & PDL_OPT_VAFFTRANSOK)
#define PDL_REPRINC(pdl,which) (PDL_VAFFOK(pdl) ? \
                pdl->vafftrans->incs[which] : pdl->dimincs[which])

#define PDL_REPROFFS(pdl) (PDL_VAFFOK(pdl) ? pdl->vafftrans->offs : 0)

#define PDL_REPRP(pdl) (PDL_VAFFOK(pdl) ? pdl->vafftrans->from->data : pdl->data)

#define PDL_REPRP_TRANS(pdl,flag) ((PDL_VAFFOK(pdl) && \
      (flag & PDL_TPDL_VAFFINE_OK)) ? pdl->vafftrans->from->data : pdl->data)

#define VAFFINE_FLAG_OK(flags,i) ((flags == NULL) ? 1 : (flags[i] & \
                                  PDL_TPDL_VAFFINE_OK))

typedef struct pdl_children {
        pdl_trans *trans[PDL_NCHILDREN];
        struct pdl_children *next;
} pdl_children;

struct pdl_magic;

/****************************************
 * PDL structure
 * Should be kept under 250 bytes if at all possible, for
 * easier segmentation...
 *
 * The 'sv', 'datasv', and 'hdrsv' fields are all void * to avoid having to
 * load perl.h for C codes that only use PDLs and not the Perl API.
 *
 * Similarly, the 'magic' field is void * to avoid having to typedef pdl_magic
 * here -- it is declared in "pdl_magic.h".
 */

#define PDL_MAGICNO 0x24645399
#define PDL_CHKMAGIC(it) PDL_CHKMAGIC_GENERAL(it,PDL_MAGICNO,"")

struct pdl {
   unsigned long magicno; /* Always stores PDL_MAGICNO as a sanity check */
     /* This is first so most pointer accesses to wrong type are caught */
   int state;        /* What's in this pdl */

   pdl_trans *trans; /* Opaque pointer to internals of transformation from
                        parent */

   pdl_vaffine *vafftrans; /* pointer to vaffine transformation
                              a vafftrans is an optimization that is possible
                              for some types of trans (slice etc)
                              - unused for non-affine transformations
                            */

   void*    sv;      /* (optional) pointer back to original sv.
                          ALWAYS check for non-null before use.
                          We cannot inc refcnt on this one or we'd
                          never get destroyed */
   void *datasv;        /* Pointer to SV containing data. We own one inc of refcnt */
   void *data;            /* Pointer to actual data (in SV), or NULL if we have no data      */
   /* bad value stored as double, since get_badvalue returns a double */
   PDL_Anyval badvalue; /* BAD value is stored as a PDL_Anyval for portability */
   int has_badvalue;     /* flag is required by pdlapi.c (compare to PDL_BADVAL above -- why two? --CED) */
   PDL_Indx nvals; /* Actual size of data (not quite nelem in case of dummy) */
   pdl_datatypes datatype; /* One of the usual suspects (PDL_L, PDL_D, etc.) */
   PDL_Indx   *dims;      /* Array of data dimensions - could point below or to an allocated array */
   PDL_Indx   *dimincs;   /* Array of data default increments, aka strides through memory for each dim (0 for dummies) */
   short    ndims;     /* Number of data dimensions in dims and dimincs */

   unsigned char *threadids;  /* Starting index of the thread index set n */
   unsigned char nthreadids;

   pdl_children children;

   PDL_Indx   def_dims[PDL_NDIMS];   /* Preallocated space for efficiency */
   PDL_Indx   def_dimincs[PDL_NDIMS];   /* Preallocated space for efficiency */
   unsigned char def_threadids[PDL_NTHREADIDS];

   struct pdl_magic *magic;

   void *hdrsv; /* "header", settable from Perl */
};


/*************
 * Some macros for looping over the children of a given PDL
 */
#define PDL_DECL_CHILDLOOP(p) \
                int p##__i; pdl_children *p##__c;
#define PDL_START_CHILDLOOP(p) \
                p##__c = &p->children; \
                do { \
                        for(p##__i=0; p##__i<PDL_NCHILDREN; p##__i++) { \
                                if(p##__c->trans[p##__i]) {
#define PDL_CHILDLOOP_THISCHILD(p) p##__c->trans[p##__i]
#define PDL_END_CHILDLOOP(p) \
                                } \
                        } \
                        if(!p##__c) break; \
                        if(!p##__c->next) break; \
                        p##__c=p##__c->next; \
                } while(1);


#define PDLMAX(a,b) ((a) > (b) ? (a) : (b))

/***************
 * Some macros to guard against dataflow infinite recursion.
 */
#define DECL_RECURSE_GUARD static int __nrec=0;
#define START_RECURSE_GUARD __nrec++; if(__nrec > 1000) {__nrec=0; die("PDL:Internal Error: data structure recursion limit exceeded (max 1000 levels)\n\tThis could mean that you have found an infinite-recursion error in PDL, or\n\tthat you are building data structures with very long dataflow dependency\n\tchains.  You may want to try using sever() to break the dependency.\n");}
#define ABORT_RECURSE_GUARD __nrec=0;
#define END_RECURSE_GUARD __nrec--;

#define PDL_ENSURE_ALLOCATED(it) ( (void)((it->state & PDL_ALLOCATED) || ((pdl_allocdata(it)),1)) )
#define PDL_ENSURE_VAFFTRANS(it) \
  ( ((!it->vafftrans) || (it->vafftrans->ndims < it->ndims)) && \
    (pdl_vafftrans_alloc(it),1) )

/* __PDL_H */
#endif

!NO!SUBS!