negate_const(Constp cp)
#endif
{
if (cp == (struct Constblock *) NULL)
return;
switch (cp -> vtype) {
case TYINT1:
case TYSHORT:
case TYLONG:
#ifdef TYQUAD
case TYQUAD:
#endif
cp -> Const.ci = - cp -> Const.ci;
break;
case TYCOMPLEX:
case TYDCOMPLEX:
if (cp->vstg)
switch(*cp->Const.cds[1]) {
case '-':
++cp->Const.cds[1];
break;
case '0':
break;
default:
--cp->Const.cds[1];
}
else
cp->Const.cd[1] = -cp->Const.cd[1];
/* no break */
case TYREAL:
case TYDREAL:
if (cp->vstg)
switch(*cp->Const.cds[0]) {
case '-':
++cp->Const.cds[0];
break;
case '0':
break;
default:
--cp->Const.cds[0];
}
else
cp->Const.cd[0] = -cp->Const.cd[0];
break;
case TYCHAR:
case TYLOGICAL1:
case TYLOGICAL2:
case TYLOGICAL:
erri ("negate_const: can't negate type '%d'", cp -> vtype);
break;
default:
erri ("negate_const: bad type '%d'",
cp -> vtype);
break;
} /* switch */
} /* negate_const */
p1_expr(expptr expr)
#endif
{
/* An opcode of 0 means a null entry */
if (expr == ENULL) {
p1putdd (P1_EXPR, 0, TYUNKNOWN); /* Should this be TYERROR? */
return;
} /* if (expr == ENULL) */
switch (expr -> tag) {
case TNAME:
p1_name ((Namep) expr);
return;
case TCONST:
p1_const(&expr->constblock);
return;
case TEXPR:
/* Fall through the switch */
break;
case TADDR:
p1_addr (&(expr -> addrblock));
goto freeup;
case TPRIM:
warn ("p1_expr: got TPRIM");
return;
case TLIST:
p1_list (&(expr->listblock));
frchain( &(expr->listblock.listp) );
return;
case TERROR:
return;
default:
erri ("p1_expr: bad tag '%d'", (int) (expr -> tag));
return;
}
/* Now we know that the tag is TEXPR */
if (is_unary_op (expr -> exprblock.opcode))
p1_unary (&(expr -> exprblock));
else if (is_binary_op (expr -> exprblock.opcode))
p1_binary (&(expr -> exprblock));
else
erri ("p1_expr: bad opcode '%d'", (int) expr -> exprblock.opcode);
freeup:
free((char *)expr);
} /* p1_expr */
p1_unary(struct Exprblock *e)
#endif
{
if (e == (struct Exprblock *) NULL)
return;
p1putdd (P1_EXPR, (int) e -> opcode, e -> vtype);
p1_expr (e -> vleng);
switch (e -> opcode) {
case OPNEG:
case OPNEG1:
case OPNOT:
case OPABS:
case OPBITNOT:
case OPPREINC:
case OPPREDEC:
case OPADDR:
case OPIDENTITY:
case OPCHARCAST:
case OPDABS:
p1_expr(e -> leftp);
break;
default:
erri ("p1_unary: bad opcode '%d'", (int) e -> opcode);
break;
} /* switch */
} /* p1_unary */
wr_struct(FILE *outfile, chainp var_list)
#endif
{
int last_type = -1;
int did_one = 0;
chainp this_var;
for (this_var = var_list; this_var; this_var = this_var -> nextp) {
Namep var = (Namep) this_var -> datap;
int type;
char *comment = NULL;
if (var == (Namep) NULL)
err ("wr_struct: null variable");
else if (var -> tag != TNAME)
erri ("wr_struct: bad tag on variable '%d'",
var -> tag);
type = var -> vtype;
if (last_type == type && did_one)
nice_printf (outfile, ", ");
else {
if (did_one)
nice_printf (outfile, ";\n");
nice_printf (outfile, "%s ",
c_type_decl (type, var -> vclass == CLPROC));
} /* else */
/* Character type is really a string type. Put out a '*' for parameters
with unknown length and functions returning character */
if (var -> vtype == TYCHAR && (!ISICON ((var -> vleng))
|| var -> vclass == CLPROC))
nice_printf (outfile, "*");
var -> vstg = STGAUTO;
out_name (outfile, var);
if (var -> vclass == CLPROC)
nice_printf (outfile, "()");
else if (var -> vdim)
comment = wr_ardecls(outfile, var->vdim,
var->vtype == TYCHAR && ISICON(var->vleng)
? var->vleng->constblock.Const.ci : 1L);
else if (var -> vtype == TYCHAR && var -> vclass != CLPROC &&
ISICON ((var -> vleng)))
nice_printf (outfile, "[%ld]",
var -> vleng -> constblock.Const.ci);
if (comment)
nice_printf (outfile, "%s", comment);
did_one = 1;
last_type = type;
} /* for this_var */
if (did_one)
nice_printf (outfile, ";\n");
} /* wr_struct */
p1_const(register Constp cp)
#endif
{
int type = cp->vtype;
expptr vleng = cp->vleng;
union Constant *c = &cp->Const;
char cdsbuf0[64], cdsbuf1[64];
char *cds0, *cds1;
switch (type) {
case TYINT1:
case TYSHORT:
case TYLONG:
#ifdef TYQUAD0
case TYQUAD:
#endif
case TYLOGICAL:
case TYLOGICAL1:
case TYLOGICAL2:
fprintf(pass1_file, "%d: %d %ld\n", P1_CONST, type, c->ci);
break;
#ifndef NO_LONG_LONG
case TYQUAD:
fprintf(pass1_file, "%d: %d %llx\n", P1_CONST, type, c->cq);
break;
#endif
case TYREAL:
case TYDREAL:
fprintf(pass1_file, "%d: %d %s\n", P1_CONST, type,
cp->vstg ? c->cds[0] : cds(dtos(c->cd[0]), cdsbuf0));
break;
case TYCOMPLEX:
case TYDCOMPLEX:
if (cp->vstg) {
cds0 = c->cds[0];
cds1 = c->cds[1];
}
else {
cds0 = cds(dtos(c->cd[0]), cdsbuf0);
cds1 = cds(dtos(c->cd[1]), cdsbuf1);
}
fprintf(pass1_file, "%d: %d %s %s\n", P1_CONST, type,
cds0, cds1);
break;
case TYCHAR:
if (vleng && !ISICON (vleng))
err("p1_const: bad vleng\n");
else
fprintf(pass1_file, "%d: %d %lx\n", P1_CONST, type,
cpexpr((expptr)cp));
break;
default:
erri ("p1_const: bad constant type '%d'", type);
break;
} /* switch */
} /* p1_const */
mktmpn(int nelt, register int type, expptr lengp)
#endif
{
ftnint leng;
chainp p, oldp;
register Addrp q;
extern int krparens;
if(type==TYUNKNOWN || type==TYERROR)
badtype("mktmpn", type);
if(type==TYCHAR)
if(lengp && ISICON(lengp) )
leng = lengp->constblock.Const.ci;
else {
err("adjustable length");
return( (Addrp) errnode() );
}
else if (type > TYCHAR || type < TYADDR) {
erri("mktmpn: unexpected type %d", type);
exit(1);
}
/*
* if a temporary of appropriate shape is on the templist,
* remove it from the list and return it
*/
if (krparens == 2 && ONEOF(type,M(TYREAL)|M(TYCOMPLEX)))
type++;
for(oldp=CHNULL, p=templist[type]; p ; oldp=p, p=p->nextp)
{
q = (Addrp) (p->datap);
if(q->ntempelt==nelt &&
(type!=TYCHAR || q->vleng->constblock.Const.ci==leng) )
{
if(oldp)
oldp->nextp = p->nextp;
else
templist[type] = p->nextp;
free( (charptr) p);
return(q);
}
}
q = autovar(nelt, type, lengp, "");
return(q);
}
op_assign(int opcode)
#endif
{
int retval = -1;
switch (opcode) {
case OPPLUS: retval = OPPLUSEQ; break;
case OPMINUS: retval = OPMINUSEQ; break;
case OPSTAR: retval = OPSTAREQ; break;
case OPSLASH: retval = OPSLASHEQ; break;
case OPMOD: retval = OPMODEQ; break;
case OPLSHIFT: retval = OPLSHIFTEQ; break;
case OPRSHIFT: retval = OPRSHIFTEQ; break;
case OPBITAND: retval = OPBITANDEQ; break;
case OPBITXOR: retval = OPBITXOREQ; break;
case OPBITOR: retval = OPBITOREQ; break;
default:
erri ("op_assign: bad opcode '%d'", opcode);
break;
} /* switch */
return retval;
} /* op_assign */
int main (int argc, char *argv[]) {
FILE *anafp;
char in1root[MAXL];
char in2root[MAXL];
char outroot[MAXL];
char imgfile[MAXL];
char program[MAXL], string[MAXL], *ptr;
struct dsr hdr;
short *img1, *img2, *imgo;
int xdim, ydim, zdim, dimension;
int img1max = 0, img2max = 0;
int img1min = 0, img2min = 0;
int swab_img1 = 0, swab_img2 = 0, swab_imgo = 0;
char orient, control = '\0';
int nbin = NBIN;
int *hist, *mrg1, *mrg2;
int histmax = 0;
int range1, range2;
int binwid1, binwid2;
int grid1, grid2;
short valmax = 0;
float ftmp;
int c, i, j, k;
/*********/
/* flags */
/*********/
int status = 0;
int debug = 0;
int do_grid = 1;
if (ptr = strrchr (argv[0], '/')) ptr++; else ptr = argv[0];
strcpy (program, ptr);
printf ("%s\n", rcsid);
/************************/
/* process command line */
/************************/
for (k = 0, i = 1; i < argc; i++) if (*argv[i] == '-') {
strcpy (string, argv[i]); ptr = string;
while (c = *ptr++) switch (c) {
case 'd': debug++; break;
case 'g': do_grid = 0; break;
case '@': control = *ptr++; *ptr = '\0'; break;
case 'r': j = atoi (ptr++);
ptr++; /* skip over ":" */
switch (j) {
case 1: getrangei (ptr, &img1min, &img1max); break;
case 2: getrangei (ptr, &img2min, &img2max); break;
default: usage (program); break;
} *ptr = '\0'; break;
}
} else switch (k) {
case 0: getroot (argv[i], in1root); k++; break;
case 1: getroot (argv[i], in2root); k++; break;
case 2: getroot (argv[i], outroot); k++; break;
}
if (k < 3) usage (program);
fprintf (stdout, "img1: %s\nimg2: %s\n", in1root, in2root);
sprintf (imgfile, "%s.hdr", in1root);
if (!(anafp = fopen (imgfile, "rb")) || fread (&hdr, sizeof (struct dsr), 1, anafp) != 1
|| fclose (anafp)) errr (program, imgfile);
if (hdr.hk.sizeof_hdr != sizeof (struct dsr)) {
printf ("converting %s byte order\n", in1root);
swab_hdr (&hdr);
swab_img1++;
}
if (hdr.dime.bitpix != 16) erri (program, imgfile);
xdim = hdr.dime.dim[1];
ydim = hdr.dime.dim[2];
zdim = hdr.dime.dim[3];
orient = hdr.hist.orient;
dimension = xdim * ydim * zdim;
sprintf (imgfile, "%s.hdr", in2root);
if (!(anafp = fopen (imgfile, "rb")) || fread (&hdr, sizeof (struct dsr), 1, anafp) != 1
|| fclose (anafp)) errr (program, imgfile);
if (hdr.hk.sizeof_hdr != sizeof (struct dsr)) {
printf ("converting %s byte order\n", in2root);
swab_hdr (&hdr);
swab_img2++;
}
if (hdr.dime.bitpix != 16) erri (program, imgfile);
if (xdim != hdr.dime.dim[1] || ydim != hdr.dime.dim[2] || zdim != hdr.dime.dim[3] || orient != hdr.hist.orient) {
fprintf (stderr, "%s: %s %s dimension/orientation mismatch\n", program, in1root, in2root);
exit (-1);
}
img1 = (short *) malloc (dimension * sizeof (short));
img2 = (short *) malloc (dimension * sizeof (short));
mrg1 = (int *) calloc (nbin, sizeof (int));
mrg2 = (int *) calloc (nbin, sizeof (int));
hist = (int *) calloc (nbin*nbin, sizeof (int));
imgo = (short *) malloc (nbin*nbin * sizeof (short));
if (!img1 || !img2 || !hist || !mrg1 || !mrg2 || !imgo) errm (program);
sprintf (imgfile, "%s.img", outroot); startrece (imgfile, argc, argv, rcsid, control);
sprintf (imgfile, "%s.img", in1root); catrec (imgfile);
printf ("Reading: %s\n", imgfile);
if (!(anafp = fopen (imgfile, "rb"))
|| fread (img1, sizeof (short), dimension, anafp) != dimension || fclose (anafp)) errr (program, imgfile);
if (swab_img1) for (i = 0; i < dimension; i++) swab2 ((char *) &img1[i]);
sprintf (imgfile, "%s.img", in2root); catrec (imgfile);
printf ("Reading: %s\n", imgfile);
if (!(anafp = fopen (imgfile, "rb"))
|| fread (img2, sizeof (short), dimension, anafp) != dimension || fclose (anafp)) errr (program, imgfile);
if (swab_img2) for (i = 0; i < dimension; i++) swab2 ((char *) &img2[i]);
if (!img1max && !img1min) {
img1max -32768; img1min = 32767;
for (i = 0; i < dimension; i++) {
if (img1[i] > img1max) img1max = img1[i];
if (img1[i] < img1min) img1min = img1[i];
}
} else {
for (i = 0; i < dimension; i++) {
if (img1[i] > img1max) img1[i] = img1max;
if (img1[i] < img1min) img1[i] = img1min;
}
}
range1 = img1max - img1min;
if (!img2max && !img2min) {
img2max -32768; img2min = 32767;
for (i = 0; i < dimension; i++) {
if (img2[i] > img2max) img2max = img2[i];
if (img2[i] < img2min) img2min = img2[i];
}
} else {
for (i = 0; i < dimension; i++) {
if (img2[i] > img2max) img2[i] = img2max;
if (img2[i] < img2min) img2[i] = img2min;
}
}
range2 = img2max - img2min;
fprintf (stdout, "img1: min=%6d\tmax=%6d\trange=%6d\n", img1min, img1max, range1);
fprintf (stdout, "img2: min=%6d\tmax=%6d\trange=%6d\n", img2min, img2max, range2);
sprintf (string, "before auto range adjust\n"); printrec (string);
sprintf (string, "img1: min=%6d\tmax=%6d\trange=%6d\n", img1min, img1max, range1); printrec (string);
sprintf (string, "img2: min=%6d\tmax=%6d\trange=%6d\n", img2min, img2max, range2); printrec (string);
for (i = 0; i < dimension; i++) {
k = (nbin * (img1[i] - img1min)) / range1;
if (k < nbin && k > 0) mrg1[k]++;
k = (nbin * (img2[i] - img2min)) / range2;
if (k < nbin && k > 0) mrg2[k]++;
}
for (k = 2; k < nbin; k++) {
mrg1[k] += mrg1[k - 1];
mrg2[k] += mrg2[k - 1];
}
if (debug) for (k = 0; k < nbin; k++) {
printf ("%6d %10.6f %10.6f\n", k,
(float) mrg1[k] / (float) mrg1[nbin - 1], (float) mrg2[k] / (float) mrg2[nbin - 1]);
}
for (i = 1; i < nbin; i++) if (((float) mrg1[i] / (float) mrg1[nbin - 1]) > CUM_D) break;
for (j = 1; j < nbin; j++) if (((float) mrg1[j] / (float) mrg1[nbin - 1]) > 1.0-CUM_D) break;
if (debug) printf ("img1: first_bin=%d\tlast_bin=%d\n", i, j);
img1min += (float) (range1 * i) / nbin;
range1 *= (float) (j - i) / nbin;
binwid1 = (float) range1 / nbin;
if (!binwid1) binwid1++;
range1 = binwid1 * nbin;
img1min += binwid1 - (img1min + range1) % binwid1;
for (i = 1; i < nbin; i++) if (((float) mrg2[i] / (float) mrg2[nbin - 1]) > CUM_D) break;
for (j = 1; j < nbin; j++) if (((float) mrg2[j] / (float) mrg2[nbin - 1]) > 1.0-CUM_D) break;
if (debug) printf ("img2: first_bin=%d\tlast_bin=%d\n", i, j);
img2min += (float) (range2 * i) / nbin;
range2 *= (float) (j - i) / nbin;
binwid2 = (float) range2 / nbin;
if (!binwid2) binwid2++;
range2 = binwid2 * nbin;
img2min += binwid2 - (img2min + range2) % binwid2;
fprintf (stdout, "img1: min=%6d\tmax=%6d\trange=%6d\tbinwidth=%d\n", img1min, img1min + range1, range1, binwid1);
fprintf (stdout, "img2: min=%6d\tmax=%6d\trange=%6d\tbinwidth=%d\n", img2min, img2min + range2, range2, binwid2);
sprintf (string, "after auto range adjust\n");
printrec (string);
sprintf (string, "img1: min=%6d\tmax=%6d\trange=%6d\tbinwidth=%d\n", img1min, img1min + range1, range1, binwid1);
printrec (string);
sprintf (string, "img2: min=%6d\tmax=%6d\trange=%6d\tbinwidth=%d\n", img2min, img2min + range2, range2, binwid2);
printrec (string);
if (!range1 || !range2) exit (-1);
for (k = 0; k < dimension; k++) {
i = (img1[k] - img1min) / binwid1;
j = (img2[k] - img2min) / binwid2;
if (i < 0 || i >= nbin || j < 0 || j >= nbin) continue;
hist[nbin * j + i]++;
if (!hist[nbin * j + i]) {
fprintf (stderr, "2Dhist: histogram bin overflow\n");
exit (-1);
}
if (hist[nbin * j + i] > histmax) histmax = hist[nbin * j + i];
}
fprintf (stdout, "maximum bin count=%d\n", histmax);
/***************************/
/* write histogram to imgo */
/***************************/
for (k = 0; k < nbin*nbin; k++) {
if (hist[k]) {
ftmp = 100 * log ((double) hist[k]);
imgo[k] = (short) ftmp;
} else imgo[k] = 0;
if (imgo[k] > valmax) valmax = imgo[k];
}
if (do_grid) {
grid1 = range1 / 10; grid1 /= 10; grid1 *= 10;
for (i = k = 0; i < nbin; k += grid1) {
i = (k - img1min) / binwid1;
if (i >= 0 && i < nbin) for (j = 0; j < nbin; j++) imgo[nbin * j + i] = valmax / 2;
}
sprintf (string, "img1: grid interval=%d\n", grid1); printrec (string);
grid2 = range2 / 10; grid2 /= 10; grid2 *= 10;
for (j = k = 0; j < nbin; k += grid2) {
j = (k - img2min) / binwid2;
if (j >= 0 && j < nbin) for (i = 0; i < nbin; i++) imgo[nbin * j + i] = valmax / 2;
}
sprintf (string, "img2: grid interval=%d\n", grid2); printrec (string);
}
swab_imgo = ((CPU_is_bigendian() != 0) && (control == 'l' || control == 'L'))
|| ((CPU_is_bigendian() == 0) && (control == 'b' || control == 'B'));
if (swab_imgo) for (i = 0; i < nbin*nbin; i++) swab2 ((char *) &imgo[i]);
sprintf (imgfile, "%s.img", outroot); fprintf (stdout, "Writing: %s\n", imgfile);
if (!(anafp = fopen (imgfile, "wb")) || fwrite (imgo, sizeof (short), nbin*nbin, anafp) != nbin*nbin
|| fclose (anafp)) errw (program, imgfile);
hdr.dime.dim[0] = 2;
hdr.dime.dim[1] = nbin;
hdr.dime.dim[2] = nbin;
hdr.dime.dim[3] = 1;
hdr.dime.datatype = 4;
hdr.dime.pixdim[1] = 1;
hdr.dime.pixdim[2] = 1;
hdr.dime.pixdim[3] = 1;
hdr.dime.glmax = valmax;
hdr.dime.glmin = 0;
hdr.hist.orient = 0;
if (swab_imgo) swab_hdr (&hdr);
sprintf (imgfile, "%s.hdr", outroot);
fprintf (stdout, "Writing: %s\n", imgfile);
if (!(anafp = fopen (imgfile, "wb"))
|| fwrite (&hdr, sizeof (struct dsr), 1, anafp) != 1 || fclose (anafp)) errw (program, imgfile);
free (img1); free (img2); free (imgo);
free (mrg1); free (mrg2);
free (hist);
endrec ();
exit (status);
}
p1_addr(register struct Addrblock *addrp)
#endif
{
int stg;
if (addrp == (struct Addrblock *) NULL)
return;
stg = addrp -> vstg;
if (ONEOF(stg, M(STGINIT)|M(STGREG))
|| ONEOF(stg, M(STGCOMMON)|M(STGEQUIV)) &&
(!ISICON(addrp->memoffset)
|| (addrp->uname_tag == UNAM_NAME
? addrp->memoffset->constblock.Const.ci
!= addrp->user.name->voffset
: addrp->memoffset->constblock.Const.ci))
|| ONEOF(stg, M(STGBSS)|M(STGINIT)|M(STGAUTO)|M(STGARG)) &&
(!ISICON(addrp->memoffset)
|| addrp->memoffset->constblock.Const.ci)
|| addrp->Field || addrp->isarray || addrp->vstg == STGLENG)
{
p1_big_addr (addrp);
return;
}
/* Write out a level of indirection for non-array arguments, which have
addrp -> memoffset set and are handled by p1_big_addr().
Lengths are passed by value, so don't check STGLENG
28-Jun-89 (dmg) Added the check for != TYCHAR
*/
if (oneof_stg ( addrp -> uname_tag == UNAM_NAME ? addrp -> user.name : NULL,
stg, M(STGARG)|M(STGEQUIV)) && addrp->vtype != TYCHAR) {
p1putdd (P1_EXPR, OPWHATSIN, addrp -> vtype);
p1_expr (ENULL); /* Put dummy vleng */
} /* if stg == STGARG */
switch (addrp -> uname_tag) {
case UNAM_NAME:
p1_name (addrp -> user.name);
break;
case UNAM_IDENT:
p1putdds(P1_IDENT, addrp->vtype, addrp->vstg,
addrp->user.ident);
break;
case UNAM_CHARP:
p1putdds(P1_CHARP, addrp->vtype, addrp->vstg,
addrp->user.Charp);
break;
case UNAM_EXTERN:
p1putd (P1_EXTERN, (long) addrp -> memno);
if (addrp->vclass == CLPROC)
extsymtab[addrp->memno].extype = addrp->vtype;
break;
case UNAM_CONST:
if (addrp -> memno != BAD_MEMNO)
p1_literal (addrp -> memno);
else
p1_const((struct Constblock *)addrp);
break;
case UNAM_UNKNOWN:
default:
erri ("p1_addr: unknown uname_tag '%d'", addrp -> uname_tag);
break;
} /* switch */
} /* p1_addr */
