SLFUTURE_VOID *SLdebug_calloc (unsigned long n, unsigned long size)
{
char *p;
unsigned int m;
/* This is tough -- hope this is a good assumption!! */
if (size >= Chunk) m = 1; else m = Chunk;
if ((p = (char *) SLCALLOC (n + m + m, size)) == NULL) return NULL;
fixup ((unsigned char *) p, size * n, "CALLOC");
return (SLFUTURE_VOID *)(p + Chunk);
}
char *_jdfits_allocate_bytes_of_type (int type, unsigned int nelements)
{
char *s;
unsigned int len;
switch (type)
{
case JDFITS_INT16_TYPE:
len = sizeof (int16);
break;
case JDFITS_INT32_TYPE:
len = sizeof (int32);
break;
case JDFITS_FLOAT32_TYPE:
len = sizeof (float32);
break;
case JDFITS_FLOAT64_TYPE:
len = sizeof (float64);
break;
case JDFITS_STRING_TYPE:
len = 1;
nelements++; /* allow for null termination */
break;
case JDFITS_BOOL_TYPE:
case JDFITS_BIT_TYPE:
case JDFITS_BYTE_TYPE:
default:
jdfits_error ("_jdfits_allocate_bytes_of_type: Field type '%d' is not implemented.", type);
return NULL;
}
if (nelements == 0)
nelements = 1;
if (NULL == (s = (char *) SLCALLOC (nelements, len)))
jdfits_error ("_jdfits_allocate_bytes_of_type: calloc error.");
return s;
}
/* Find articles with the same subject and put them into the same thread. */
static void link_same_subjects (void) /*{{{*/
{
Slrn_Header_Type **header_list, *h;
unsigned int i, nparents;
int use_hook = 0;
void (*qsort_fun) (char *, unsigned int, unsigned int, int (*)(Slrn_Header_Type **, Slrn_Header_Type **));
/* This is a silly hack to make up for braindead compilers and the lack of
* uniformity in prototypes for qsort.
*/
qsort_fun = (void (*)(char *,
unsigned int, unsigned int,
int (*)(Slrn_Header_Type **, Slrn_Header_Type **)))
qsort;
/* Count number of threads we might want to link. */
h = Slrn_First_Header;
nparents = 0;
while (h != NULL)
{
if (h->parent == NULL)
nparents++;
h = h->real_next;
}
if (nparents < 2) return;
/* Allocate an array for them, fill and qsort() it. */
if (NULL == (header_list = (Slrn_Header_Type **) SLCALLOC (sizeof (Slrn_Header_Type *), nparents)))
{
slrn_error (_("link_same_subjects: memory allocation failure."));
return;
}
h = Slrn_First_Header;
i = 0;
while (i < nparents)
{
if (h->parent == NULL) header_list[i++] = h;
h = h->real_next;
}
(*qsort_fun) ((char *) header_list,
nparents, sizeof (Slrn_Header_Type *), qsort_subject_cmp);
if (0 != slrn_is_hook_defined(HOOK_SUBJECT_COMPARE))
use_hook = 1;
h = header_list[0];
for (i = 1; i < nparents; i++)
{
Slrn_Header_Type *h1 = header_list[i];
int differ;
differ = _art_subject_cmp (h->subject, h1->subject);
if (differ && use_hook)
{
int rslt;
(void) slrn_run_hooks (HOOK_SUBJECT_COMPARE, 2, h->subject, h1->subject);
if (-1 != SLang_pop_integer (&rslt))
differ = rslt;
}
if (differ == 0)
{
/* h and h1 have the same subject. Now make h1 a (faked) child of h. */
insert_fake_child (h, h1);
if (h1->flags & FAKE_CHILDREN)
{
/* h1 has fake children, we have to link them up to the new
* parent. That is, h1 will become their sister. So,
* extract the adopted children of h1 and make them the sister,
*/
Slrn_Header_Type *child = h1->child, *last_child;
last_child = child;
/* child CANNOT be NULL here!! (the parent claims to have
* children) */
child = child->sister;
while ((child != NULL) && ((child->flags & FAKE_PARENT) == 0))
{
last_child = child;
child = child->sister;
}
if (last_child->flags & FAKE_PARENT) /* h1 has only fake children */
{
child = last_child;
h1->child = NULL;
}
else
last_child->sister = NULL;
last_child = child;
while (last_child != NULL)
{
child = last_child->sister;
insert_fake_child (h, last_child);
last_child = child;
}
h1->flags &= ~FAKE_CHILDREN;
} /* if (h1 had faked children) */
} /* if (found same subject) */
else h = h1;
} /* traversing the array */
SLFREE (header_list);
}
/* This function is called to sort the headers in article mode. */
void slrn_sort_headers (void) /*{{{*/
{
Slrn_Header_Type **header_list, *h;
unsigned int i, nheaders;
static char *prev_sort_order = NULL;
char *sort_order;
int do_threading;
void (*qsort_fun) (char *, unsigned int,
unsigned int, int (*)(Slrn_Header_Type **, Slrn_Header_Type **));
/* This is a silly hack to make up for braindead compilers and the lack of
* uniformity in prototypes for qsort.
*/
qsort_fun = (void (*)(char *, unsigned int,
unsigned int, int (*)(Slrn_Header_Type **, Slrn_Header_Type **)))
qsort;
/* Maybe we must (re-)compile Sort_Functions first */
sort_order = get_current_sort_order (&do_threading);
if ((sort_order != NULL) &&
((prev_sort_order == NULL) ||
(strcmp (prev_sort_order, sort_order))))
{
slrn_free (prev_sort_order);
prev_sort_order = slrn_safe_strmalloc (sort_order);
recompile_sortorder (sort_order);
}
/* Pre-sort by thread / server number */
if (do_threading)
sort_by_threads ();
else
_art_sort_by_server_number();
/* sort_by_threads already did the sorting inside of the threads; what's
* left to us is the sorting of headers that don't have parents.
* First, count their number and get memory for an array of them. */
nheaders = 0;
h = Slrn_First_Header;
while (h != NULL)
{
if (h->parent == NULL) nheaders++;
h = h->real_next;
}
if (nheaders < 2)
goto cleanup_screen_and_return;
if (NULL == (header_list = (Slrn_Header_Type **) SLCALLOC (sizeof (Slrn_Header_Type *), nheaders + 1)))
{
slrn_error (_("slrn_sort_headers(): memory allocation failure."));
goto cleanup_screen_and_return;
}
/* Now, fill the array and call qsort on it; use our header_initial_cmp function
* to do the comparison. */
h = Slrn_First_Header;
nheaders = 0;
while (h != NULL)
{
if (h->parent == NULL)
header_list[nheaders++] = h;
h = h->real_next;
}
header_list[nheaders] = NULL;
(*qsort_fun) ((char *) header_list, nheaders, sizeof (Slrn_Header_Type *), header_initial_cmp);
/* What we do now depends on the threading state. If the headers are
* unthreaded, simply link them in the order returned by qsort. */
if (!do_threading)
{
header_list[0]->next = header_list[1];
header_list[0]->prev = NULL;
for (i = 1; i < nheaders; i++)
{
h = header_list[i];
h->next = header_list[i + 1];
h->prev = header_list[i - 1];
}
}
else
{
/* If the headers are threaded, we have sorted parents. Always link
* them with the last child of the previous thread. */
h = NULL;
for (i = 0; i <= nheaders; i++)
{
Slrn_Header_Type *h1 = header_list[i];
if (h != NULL)
{
h->sister = h1;
while (h->child != NULL)
{
h = h->child;
while (h->sister != NULL) h = h->sister;
}
h->next = h1;
}
if (h1 != NULL) h1->prev = h;
h = h1;
}
}
/* Finally, free the array and clean up the screen. */
_art_Headers = header_list[0];
SLFREE (header_list);
cleanup_screen_and_return:
_art_find_header_line_num ();
Slrn_Full_Screen_Update = 1;
if (!Slrn_Uncollapse_Threads)
slrn_collapse_threads (1);
}
static int parse_headers (JDFits_Header_Type *ht)
{
unsigned char *p, ch;
unsigned int i;
unsigned int n = ht->num_keywords;
int naxis;
int bitpix;
JDFits_Keyword_Type *kwt;
off_t naxis_product;
kwt = (JDFits_Keyword_Type *) SLCALLOC (n, sizeof (JDFits_Keyword_Type));
if (kwt == NULL)
{
jdfits_error ("parse_headers: Memory allocation error.");
return -1;
}
ht->keys = kwt;
p = ht->header_data_buf;
for (i = 0; i < n; i++)
{
unsigned char *p1 = p + 8, *nextp = p + JDFITS_CARD_SIZE;
kwt->name = (char *) p;
ch = *p1;
*p1-- = 0;
while ((p1 >= p) && (*p1 == ' '))
*p1-- = 0;
if ((ch == '=')
&& (0 == is_commentary_keyword (kwt->name)))
{
/* value */
if (p1 + 1 == p)
{
jdfits_warning ("Card %d appears corrupt.", i);
}
p1 = p + 9;
while ((p1 < nextp) && (*p1 == ' ')) p1++;
if ((p1 == nextp) || (*p1 == '/'))
{
jdfits_warning ("Card %d (%s) has no value.", i, kwt->name);
kwt->type = JDFITS_UNPARSED_TYPE | JDFITS_STRING_TYPE;
}
else switch (*p1)
{
case '\'':
kwt->type = JDFITS_STRING_TYPE | JDFITS_UNPARSED_TYPE;
break;
case 'F':
case 'T':
kwt->type = JDFITS_BOOL_TYPE | JDFITS_UNPARSED_TYPE;
if (p1 == p + 29) break;
if (*p1 != 'F')
{
jdfits_warning ("Boolean card %d (%s) has value in wrong column.", i, kwt->name);
break;
}
/* Drop */
case 'A': case 'a':
case 'B': case 'b':
case 'C': case 'c':
case 'D': case 'd':
case 'E': case 'e':
case 'f':
/* we can have integers, floats or decimals.
* Anything else?
*/
case '-': case '+': case '.':
case '0': case '1': case '2': case '3': case '4': case '5':
case '6': case '7': case '8': case '9':
kwt->type = JDFITS_NUMBER_MASK | JDFITS_UNPARSED_TYPE;
break;
default:
jdfits_warning ("Card %d (%s) appears corrupt. Assuming a string.",
i, kwt->name);
kwt->type = JDFITS_STRING_TYPE | JDFITS_UNPARSED_TYPE;
}
kwt->v.sval = (char *)p1;
kwt->comment = (char *) nextp; /* for unparsed cards, this
* field points to the end
*/
}
/* END of VALUE CARDS */
else
{
/* According to the 1990 FITS User's Guide, any thing else is a
* comment card
*/
kwt->type = JDFITS_COMMENT_TYPE;
p[8] = ch;
kwt->v.sval = kwt->comment = (char *)p + 8;
kwt->comment_len = (int) ((char *)nextp - kwt->comment);
}
p = nextp + 1;
kwt++;
} /* End of for loop */
/* Do a minimial parse so that the data size and name of the header or
* extension can be determined. According to the 1993 NOST 100-1.0
* definition of the FITS format, the header must begin with the keywords:
* @ SIMPLE
* @ BITPIX
* @ NAXIS
* @ NAXIS[n], n = 1..NAXIS
* @ EXTEND (presence not required)
* The size of the primary header is:
* @ abs(BITPIX) * NAXIS[1] * ... * NAXIS[n]
* If the header represents an extension, it looks like:
* @ XTENSION
* @ BITPIX
* @ NAXIS
* @ NAXIS[n], n = 1..NAXIS
* @ (zero or more other keywords including:)
* @ PCOUNT
* @ GCOUNT
* The size of the extension is:
* @ abs(BITPIX) * GCOUNT * (PCOUNT + NAXIS[1] * ... * NAXIS[n])
*/
kwt = ht->keys;
ht->name = NULL;
if ((kwt->type & JDFITS_STRING_TYPE) && !strcmp (kwt->name, "XTENSION"))
{
ht->type = JDFITS_EXTENSION_HEADER;
if (0 == parse_string (kwt))
{
ht->name = kwt->v.sval;
if (!strcmp ((char *) ht->name, "BINTABLE")) ht->type = JDFITS_BINTABLE_HEADER;
}
}
else if ((kwt->type & JDFITS_BOOL_TYPE) && !strcmp(kwt->name, "SIMPLE"))
{
ht->type = JDFITS_SIMPLE_HEADER;
(void) parse_bool (kwt);
}
else
{
jdfits_error ("Header is not a fits header. Expected to see SIMPLE or XTENSION.");
goto error_return;
}
if ((0 == (kwt[1].type & JDFITS_NUMBER_MASK))
|| strcmp (kwt[1].name, "BITPIX")
|| (-1 == parse_int (kwt + 1)))
{
jdfits_error ("BITPIX keyword missing or has a bad value.");
goto error_return;
}
ht->bitpix = bitpix = kwt[1].v.ival;
if ((bitpix != 8) && (bitpix != 16) && (bitpix != 32)
&& (bitpix != -32) && (bitpix != -64))
jdfits_warning ("The BITPIX keyword has a non-standard value: %d", bitpix);
if ((0 == (kwt[2].type & JDFITS_NUMBER_MASK))
|| strcmp (kwt[2].name, "NAXIS")
|| (-1 == parse_int (kwt + 2))
|| ((naxis = kwt[2].v.ival) < 0))
{
jdfits_error ("NAXIS keyword missing or has a bad value.");
goto error_return;
}
ht->naxis = naxis;
if (naxis) naxis_product = 1; else naxis_product = 0;
kwt += 3;
for (i = 1; i <= (unsigned int) naxis; i++)
{
char naxis_str[9];
sprintf (naxis_str, "NAXIS%d", i);
if ((0 == (kwt->type & JDFITS_NUMBER_MASK))
|| strcmp (kwt->name, naxis_str)
|| (-1 == parse_int (kwt))
|| ((naxis_product = naxis_product * kwt->v.ival) < 0))
{
jdfits_error ("NAXIS keyword missing or has a bad value.");
goto error_return;
}
kwt++;
}
if (naxis)
{
ht->kw_naxis1 = kwt - naxis;
}
else ht->kw_naxis1 = NULL;
/* Now if this is an extension header, look for the PCOUNT and GCOUNT
* fields. The reference makes it seem that PCOUNT comes first. However,
* other documentation is not as explicit.
*/
if (ht->type != JDFITS_SIMPLE_HEADER)
{
JDFits_Keyword_Type *kwmax = ht->keys + ht->num_keywords;
ht->pcount = ht->gcount = -1;
while (kwt < kwmax)
{
if (kwt->type & JDFITS_NUMBER_MASK)
{
if ((ht->pcount == -1) && !strcmp (kwt->name, "PCOUNT"))
{
if ((-1 == parse_int (kwt))
|| ((ht->pcount = kwt->v.ival) < 0))
{
jdfits_error ("PCOUNT card is defective.");
goto error_return;
}
if (ht->gcount != -1) break;
}
else if ((ht->gcount == -1) && !strcmp (kwt->name, "GCOUNT"))
{
if ((-1 == parse_int (kwt))
|| ((ht->gcount = kwt->v.ival) <= 0))
{
jdfits_error ("GCOUNT card is defective.");
goto error_return;
}
if (ht->pcount != -1) break;
}
}
kwt++;
}
if (ht->pcount == -1)
{
jdfits_warning ("PCOUNT card is missing. Assuming a value of zero.");
ht->pcount = 0;
}
if (ht->gcount == -1)
{
jdfits_warning ("GCOUNT card is missing. Assuming a value of one.");
ht->gcount = 1;
}
}
else
{
ht->pcount = 0;
ht->gcount = 1;
}
ht->size = ht->gcount * (ht->pcount + naxis_product);
ht->size *= abs (bitpix) / 8; /* convert to 8 bit BYTES */
return 0;
error_return:
SLFREE (ht->keys);
ht->keys = NULL;
ht->name = NULL;
ht->type = 0;
return -1;
}
int jdfits_bintable_parse_headers (JDFits_Type *ft) /*{{{*/
{
JDFits_Header_Type *h = NULL;
JDFits_Keyword_Type *kwt = NULL;
JDFits_Bintable_Type *bt = NULL;
JDFits_Bintable_Field_Type *bft = NULL;
int tfields, i;
/* Check to make sure this is a bintable */
if ((ft == NULL) || (NULL == (h = ft->header)))
{
jdfits_error ("jdfits_bintable_parse_headers: header is NULL.");
return -1;
}
if (h->type == JDFITS_EXTENSION_HEADER)
{
if ((h->name != NULL) && !strcmp ((char *) h->name, "BINTABLE"))
h->type = JDFITS_BINTABLE_HEADER;
}
if (h->type != JDFITS_BINTABLE_HEADER)
{
jdfits_error ("jdfits_bintable_parse_headers: Not a BINTABLE header.");
return -1;
}
/* Check to make sure the header meets the other basic requirements. */
if ((h->bitpix != 8)
|| (h->naxis != 2)
|| (h->gcount != 1))
{
jdfits_error ("jdfits_bintable_parse_headers: Header does not meet bintable requirements.");
return -1;
}
if (h->ext.bintable != NULL)
return 0; /* already parsed */
/* Now look for the tfields header. */
if ((NULL == (kwt = jdfits_parse_keyword (h, "TFIELDS", JDFITS_INT_TYPE)))
|| ((tfields = kwt->v.ival) < 0) || (tfields > 999))
{
jdfits_error ("jdfits_bintable_parse_headers: Bad or missing TFIELDS entry.");
goto free_error;
}
if (NULL == (bt = (JDFits_Bintable_Type *) SLMALLOC (sizeof (JDFits_Bintable_Type))))
{
jdfits_error ("jdfits_bintable_parse_headers: Malloc Error.");
goto free_error;
}
memset ((char *) bt, 0, sizeof (JDFits_Bintable_Type));
if (0 != tfields)
{
bft = (JDFits_Bintable_Field_Type *) SLCALLOC (tfields, sizeof (JDFits_Bintable_Field_Type));
if (bft == NULL)
{
jdfits_error ("jdfits_bintable_parse_headers: Calloc Error.");
goto free_error;
}
}
bt->finfo = bft;
bt->tfields = tfields;
if (NULL != (kwt = jdfits_parse_keyword (h, "EXTNAME", JDFITS_STRING_TYPE)))
bt->extname = (char *) kwt->v.sval;
for (i = 1; i <= tfields; i++)
{
char buf[9], *b;
unsigned char ch;
unsigned int repeat, type, size;
char *fmt, *default_format;
JDFits_Bintable_Field_Type *bfti = bft + (i - 1);
sprintf (buf, "TFORM%d", i);
kwt = jdfits_parse_keyword (h, buf, JDFITS_STRING_TYPE);
if (kwt == NULL)
{
jdfits_error ("jdfits_bintable_parse_headers: Bad or missing %s entry.", buf);
goto free_error;
}
b = (char *) kwt->v.sval;
ch = *b;
/* Some files produced by ftools use spaces like: " 1J " */
while (ch == ' ')
{
b++;
ch = *b;
}
if (isdigit (ch) == 0)
repeat = 1;
else
{
repeat = 0;
while (((ch = (unsigned char) *b) != 0) && isdigit (ch))
{
repeat = 10 * repeat + (ch - '0');
b++;
}
}
bfti->repeat = repeat;
default_format = "% 16.9E";
type = 0;
pointer_type_label:
switch (ch)
{
case 'L':
type |= JDFITS_BOOL_TYPE;
size = 8;
fmt = "%d";
break;
case 'X':
switch (repeat)
{
/* FIXME: I need to use hex formats, but that requires
* proper parsing of the format string in the dump function.
*/
case 8:
type |= JDFITS_BYTE_TYPE;
bfti->repeat = 1;
size = 8;
fmt = "%d";
break;
case 16:
type |= JDFITS_INT16_TYPE;
bfti->repeat = 1;
size = 16;
fmt = JDFITS_FMT_16;
break;
case 32:
type |= JDFITS_INT32_TYPE;
bfti->repeat = 1;
size = 32;
fmt = JDFITS_FMT_32;
break;
default:
type |= JDFITS_BIT_TYPE;
size = 1;
fmt = "%X";
break;
}
break;
case 'B':
type |= JDFITS_BYTE_TYPE;
size = 8;
fmt = "%c";
break;
case 'I':
type |= JDFITS_INT16_TYPE;
size = 16;
fmt = JDFITS_FMT_16;
break;
case 'P': /* variable length array */
if (repeat > 1)
{
jdfits_error ("jdfits_bintable_parse_headers: The repeat count must be 0 or 1 for P type.");
goto free_error;
}
if (repeat) repeat = 2;
bfti->repeat = repeat;
b++;
ch = *b;
type = JDFITS_POINTER_FLAG;
goto pointer_type_label;
case 'J':
type |= JDFITS_INT32_TYPE;
size = 32;
fmt = JDFITS_FMT_32;
break;
case 'A':
type |= JDFITS_STRING_TYPE;
size = 8;
fmt = "%s";
break;
case 'E':
type |= JDFITS_FLOAT32_TYPE;
fmt = "% 15.7E";
size = 32;
break;
case 'D':
type |= JDFITS_FLOAT64_TYPE;
size = 64;
fmt = "% 16.9E";
break;
case 0:
ch = '0';
/* drop */
case 'C': /* complex */
case 'M': /* double precision complex */
default:
jdfits_error ("jdfits_bintable_parse_headers: Field type '%c' is not implemented. (%s)",
ch, buf);
goto free_error;
}
bfti->size = size;
bfti->type = type;
/* Now pick up the remaining indexed keywords. */
if (NULL == (kwt = bt_parse_index_kw (h, "TTYPE", i, JDFITS_STRING_TYPE)))
bfti->ttype = NULL;
else bfti->ttype = kwt->v.sval;
if (NULL == (kwt = bt_parse_index_kw (h, "TUNIT", i, JDFITS_STRING_TYPE)))
bfti->tunit = NULL;
else bfti->tunit = kwt->v.sval;
if (NULL == (kwt = bt_parse_index_kw (h, "TDIM", i, JDFITS_STRING_TYPE)))
bfti->tdim = NULL;
else bfti->tdim = kwt->v.sval;
if (NULL == (kwt = bt_parse_index_kw (h, "TNULL", i, JDFITS_INT_TYPE)))
bfti->tnull = 0;
else bfti->tnull = kwt->v.ival;
bfti->has_scaling = 0;
if (NULL == (kwt = bt_parse_index_kw (h, "TSCAL", i, JDFITS_FLOAT64_TYPE)))
{
bfti->tscal = 1.0;
}
else
{
bfti->tscal = kwt->v.dval;
bfti->has_scaling = 1;
}
if (NULL == (kwt = bt_parse_index_kw (h, "TZERO", i, JDFITS_FLOAT64_TYPE)))
bfti->tzero = 0.0;
else
{
bfti->tzero = kwt->v.dval;
bfti->has_scaling = 1;
}
if (NULL == (kwt = bt_parse_index_kw (h, "TCRPX", i, JDFITS_FLOAT64_TYPE)))
bfti->tcrpx = 0.0;
else
{
bfti->tcrpx = kwt->v.dval;
bfti->has_scaling = 1;
}
if (NULL == (kwt = bt_parse_index_kw (h, "TCRVL", i, JDFITS_FLOAT64_TYPE)))
bfti->tcrvl = 0.0;
else
{
bfti->tcrvl = kwt->v.dval;
bfti->has_scaling = 1;
}
if (NULL == (kwt = bt_parse_index_kw (h, "TCDLT", i, JDFITS_FLOAT64_TYPE)))
bfti->tcdlt = 1.0;
else
{
bfti->tcdlt = kwt->v.dval;
bfti->has_scaling = 1;
}
#if 0
/* We do not yet handled the unsigned int hack. So avoid float format */
if (bfti->has_scaling) fmt = default_format;
#endif
if ((NULL == (kwt = bt_parse_index_kw (h, "TDISP", i, JDFITS_STRING_TYPE)))
|| (-1 == jdfits_ffmt_to_cfmt (kwt->v.sval, bfti->tdisp)))
strcpy ((char *) bfti->tdisp, fmt);
}
h->ext.bintable = bt;
h->free_routine = free_bintable;
/* Now set up the remaining fields. Note that the positions of
* naxis1 and naxis2 are fixed.
*/
bt->naxis1 = h->keys[3].v.ival;
bt->naxis2 = h->keys[4].v.ival;
return 0;
/* Only get here if something goes wrong. Here all malloced items in this
* function are freed.
*/
free_error:
h->ext.bintable = NULL;
if (bt != NULL) SLFREE (bt);
if (bft != NULL) SLFREE (bft);
return -1;
}
