Skip to content

AFNI/NIfTI Server

Sections
Personal tools
You are here: Home » AFNI » Documentation

Doxygen Source Code Documentation


Main Page   Alphabetical List   Data Structures   File List   Data Fields   Globals   Search  

vax.c File Reference

#include "defs.h"
#include "pccdefs.h"
#include "output.h"

Go to the source code of this file.


Functions

void prconi (FILEP fp, ftnint n)
void prcona (FILEP fp, ftnint a)
void prconr (FILEP fp, Constp x, int k)
char * memname (int stg, long mem)
void addrlit Argdcl ((Addrp))
expptr make_int_expr (expptr e)
expptr prune_left_conv (expptr e)
void write_comment (Void)
int * count_args (Void)
void awalk Argdcl ((expptr))
void aawalk (struct Primblock *P)
void afwalk (struct Primblock *P)
void awalk (expptr e)
chainp argsort (chainp p0)
void prolog (FILE *outfile, register chainp p)

Variables

int regnum []
int wrote_comment
FILE * comment_file
int nu
int * refs
int * used

Function Documentation

void aawalk struct Primblock   P [static]
 

Definition at line 236 of file vax.c.

References Primblock::argsp, awalk(), Chain::datap, Primblock::fcharp, Primblock::lcharp, Listblock::listp, Primblock::namep, Chain::nextp, p, q, Expression::tag, TCONST, and Nameblock::vtype.

Referenced by awalk().

00238 {
00239         chainp p;
00240         expptr q;
00241 
00242         if (P->argsp)
00243                 for(p = P->argsp->listp; p; p = p->nextp) {
00244                         q = (expptr)p->datap;
00245                         if (q->tag != TCONST)
00246                                 awalk(q);
00247                         }
00248         if (P->namep->vtype == TYCHAR) {
00249                 if (q = P->fcharp)
00250                         awalk(q);
00251                 if (q = P->lcharp)
00252                         awalk(q);
00253                 }
00254         }

void afwalk struct Primblock   P [static]
 

Definition at line 261 of file vax.c.

References Nameblock::argno, Primblock::argsp, awalk(), CLPROC, Chain::datap, Listblock::listp, Primblock::namep, Chain::nextp, nu, p, Expression::primblock, PTHISPROC, q, refs, Expression::tag, TCONST, TPRIM, used, Nameblock::vclass, Nameblock::vdim, Nameblock::vknownarg, and Nameblock::vprocclass.

Referenced by awalk().

00263 {
00264         chainp p;
00265         expptr q;
00266         Namep np;
00267 
00268         for(p = P->argsp->listp; p; p = p->nextp) {
00269                 q = (expptr)p->datap;
00270                 switch(q->tag) {
00271                   case TPRIM:
00272                         np = q->primblock.namep;
00273                         if (np->vknownarg)
00274                                 if (!refs[np->argno]++)
00275                                         used[nu++] = np->argno;
00276                         if (q->primblock.argsp == 0) {
00277                                 if (q->primblock.namep->vclass == CLPROC
00278                                  && q->primblock.namep->vprocclass
00279                                                 != PTHISPROC
00280                                  || q->primblock.namep->vdim != NULL)
00281                                         continue;
00282                                 }
00283                   default:
00284                         awalk(q);
00285                         /* no break */
00286                   case TCONST:
00287                         continue;
00288                   }
00289                 }
00290         }

void awalk Argdcl (expptr   [static]
 

void addrlit Argdcl (Addrp  
 

chainp argsort chainp    p0 [static]
 

Definition at line 340 of file vax.c.

References Nameblock::argno, args, awalk(), Dimblock::basexpr, CHNULL, ckalloc(), Chain::datap, Dimblock::dims, errstr(), frchain(), free, Nameblock::fvarname, i, mkchain(), Dimblock::ndim, Chain::nextp, nu, p, q, refs, used, and Nameblock::vdim.

Referenced by prolog().

00342 {
00343         Namep *args, q, *stack;
00344         int i, nargs, nout, nst;
00345         chainp *d, *da, p, rv, *rvp;
00346         struct Dimblock *dp;
00347 
00348         if (!p0)
00349                 return p0;
00350         for(nargs = 0, p = p0; p; p = p->nextp)
00351                 nargs++;
00352         args = (Namep *)ckalloc(i = nargs*(sizeof(Namep) + 2*sizeof(chainp)
00353                         + 2*sizeof(int)));
00354         memset((char *)args, 0, i);
00355         stack = args + nargs;
00356         d = (chainp *)(stack + nargs);
00357         refs = (int *)(d + nargs);
00358         used = refs + nargs;
00359 
00360         for(p = p0; p; p = p->nextp) {
00361                 q = (Namep) p->datap;
00362                 args[q->argno] = q;
00363                 }
00364         for(p = p0; p; p = p->nextp) {
00365                 q = (Namep) p->datap;
00366                 if (!(dp = q->vdim))
00367                         continue;
00368                 i = dp->ndim;
00369                 while(--i >= 0)
00370                         awalk(dp->dims[i].dimexpr);
00371                 awalk(dp->basexpr);
00372                 while(nu > 0) {
00373                         refs[i = used[--nu]] = 0;
00374                         d[i] = mkchain((char *)q, d[i]);
00375                         }
00376                 }
00377         for(i = nst = 0; i < nargs; i++)
00378                 for(p = d[i]; p; p = p->nextp)
00379                         refs[((Namep)p->datap)->argno]++;
00380         while(--i >= 0)
00381                 if (!refs[i])
00382                         stack[nst++] = args[i];
00383         if (nst == nargs) {
00384                 rv = p0;
00385                 goto done;
00386                 }
00387         nout = 0;
00388         rv = 0;
00389         rvp = &rv;
00390         while(nst > 0) {
00391                 nout++;
00392                 q = stack[--nst];
00393                 *rvp = p = mkchain((char *)q, CHNULL);
00394                 rvp = &p->nextp;
00395                 da = d + q->argno;
00396                 for(p = *da; p; p = p->nextp)
00397                         if (!--refs[(q = (Namep)p->datap)->argno])
00398                                 stack[nst++] = q;
00399                 frchain(da);
00400                 }
00401         if (nout < nargs)
00402                 for(i = 0; i < nargs; i++)
00403                         if (refs[i]) {
00404                                 q = args[i];
00405                                 errstr("Can't adjust %.38s correctly\n\
00406         due to dependencies among arguments.",
00407                                         q->fvarname);
00408                                 *rvp = p = mkchain((char *)q, CHNULL);
00409                                 rvp = &p->nextp;
00410                                 frchain(d+i);
00411                                 }
00412  done:
00413         free((char *)args);
00414         return rv;
00415         }

void awalk expptr    e [static]
 

Definition at line 297 of file vax.c.

References aawalk(), afwalk(), Nameblock::argno, badtag(), CLVAR, nu, refs, TADDR, TCONST, TERROR, TEXPR, TLIST, top, TPRIM, UNAM_NAME, used, Nameblock::vclass, and Nameblock::vknownarg.

Referenced by aawalk(), afwalk(), and argsort().

00299 {
00300         Namep np;
00301  top:
00302         if (!e)
00303                 return;
00304         switch(e->tag) {
00305           default:
00306                 badtag("awalk", e->tag);
00307           case TCONST:
00308           case TERROR:
00309           case TLIST:
00310                 return;
00311           case TADDR:
00312                 if (e->addrblock.uname_tag == UNAM_NAME) {
00313                         np = e->addrblock.user.name;
00314                         if (np->vknownarg && !refs[np->argno]++)
00315                                 used[nu++] = np->argno;
00316                         }
00317                 e = e->addrblock.memoffset;
00318                 goto top;
00319           case TPRIM:
00320                 np = e->primblock.namep;
00321                 if (np->vknownarg && !refs[np->argno]++)
00322                         used[nu++] = np->argno;
00323                 if (e->primblock.argsp && np->vclass != CLVAR)
00324                         afwalk((struct Primblock *)e);
00325                 else
00326                         aawalk((struct Primblock *)e);
00327                 return;
00328           case TEXPR:
00329                 awalk(e->exprblock.rightp);
00330                 e = e->exprblock.leftp;
00331                 goto top;
00332           }
00333         }

int* count_args Void    [static]
 

Definition at line 212 of file vax.c.

References Entrypoint::arglist, ckalloc(), Chain::datap, Entrypoint::entnextp, Chain::nextp, and q.

Referenced by prolog().

00213 {
00214         register int *ac;
00215         register chainp cp;
00216         register struct Entrypoint *ep;
00217         register Namep q;
00218 
00219         ac = (int *)ckalloc(nallargs*sizeof(int));
00220 
00221         for(ep = entries; ep; ep = ep->entnextp)
00222                 for(cp = ep->arglist; cp; cp = cp->nextp)
00223                         if (q = (Namep)cp->datap)
00224                                 ac[q->argno]++;
00225         return ac;
00226         }

expptr make_int_expr expptr    e
 

Definition at line 139 of file vax.c.

References addrlit(), Chain::datap, ENULL, mkexpr(), Chain::nextp, OPWHATSIN, STGARG, TADDR, Addrblock::tag, TEXPR, TLIST, UNAM_CONST, and Addrblock::uname_tag.

Referenced by dim_finish().

00141 {
00142     chainp listp;
00143     Addrp ap;
00144 
00145     if (e != ENULL)
00146         switch (e -> tag) {
00147             case TADDR:
00148                 if (e -> addrblock.vstg == STGARG
00149                  && !e->addrblock.isarray)
00150                     e = mkexpr (OPWHATSIN, e, ENULL);
00151                 break;
00152             case TEXPR:
00153                 e -> exprblock.leftp = make_int_expr (e -> exprblock.leftp);
00154                 e -> exprblock.rightp = make_int_expr (e -> exprblock.rightp);
00155                 break;
00156             case TLIST:
00157                 for(listp = e->listblock.listp; listp; listp = listp->nextp)
00158                         if ((ap = (Addrp)listp->datap)
00159                          && ap->tag == TADDR
00160                          && ap->uname_tag == UNAM_CONST)
00161                                 addrlit(ap);
00162                 break;
00163             default:
00164                 break;
00165         } /* switch */
00166 
00167     return e;
00168 } /* make_int_expr */

char* memname int    stg,
long    mem
 

Definition at line 98 of file vax.c.

References badstg(), STGBSS, STGCOMMON, STGCONST, STGEQUIV, STGEXT, and STGINIT.

Referenced by dataname().

00100 {
00101         static char s[20];
00102 
00103         switch(stg)
00104         {
00105         case STGCOMMON:
00106         case STGEXT:
00107                 sprintf(s, "_%s", extsymtab[mem].cextname);
00108                 break;
00109 
00110         case STGBSS:
00111         case STGINIT:
00112                 sprintf(s, "v.%ld", mem);
00113                 break;
00114 
00115         case STGCONST:
00116                 sprintf(s, "L%ld", mem);
00117                 break;
00118 
00119         case STGEQUIV:
00120                 sprintf(s, "q.%ld", mem+eqvstart);
00121                 break;
00122 
00123         default:
00124                 badstg("memname", stg);
00125         }
00126         return(s);
00127 }

void prcona FILEP    fp,
ftnint    a
 

Definition at line 55 of file vax.c.

References a, and FILEP.

Referenced by setdata().

00057 {
00058         fprintf(fp, "\tL%ld\n", a);
00059 }

void prconi FILEP    fp,
ftnint    n
 

Definition at line 39 of file vax.c.

References FILEP.

Referenced by setdata().

00041 {
00042         fprintf(fp, "\t%ld\n", n);
00043 }

void prconr FILEP    fp,
Constp    x,
int    k
 

Definition at line 69 of file vax.c.

References Constant::cd, cds(), Constant::cds, Constblock::Const, dtos(), FILEP, Constblock::vstg, and x0.

Referenced by setdata().

00071 {
00072         char *x0, *x1;
00073         char cdsbuf0[64], cdsbuf1[64];
00074 
00075         if (k > 1) {
00076                 if (x->vstg) {
00077                         x0 = x->Const.cds[0];
00078                         x1 = x->Const.cds[1];
00079                         }
00080                 else {
00081                         x0 = cds(dtos(x->Const.cd[0]), cdsbuf0);
00082                         x1 = cds(dtos(x->Const.cd[1]), cdsbuf1);
00083                         }
00084                 fprintf(fp, "\t%s %s\n", x0, x1);
00085                 }
00086         else
00087                 fprintf(fp, "\t%s\n", x->vstg ? x->Const.cds[0]
00088                                 : cds(dtos(x->Const.cd[0]), cdsbuf0));
00089 }

void prolog FILE *    outfile,
register chainp    p
 

Definition at line 423 of file vax.c.

References Nameblock::argno, argsort(), Dimblock::baseoffset, Dimblock::basexpr, Constant::ci, CLBLOCK, comment_file, Constblock::Const, Expression::constblock, count_args(), cpexpr(), Nameblock::cvarname, Chain::datap, Dimblock::dims, fixtype(), frchain(), free, i, ISICON, mkconv(), mkexpr(), Dimblock::ndim, next_tab, Chain::nextp, nice_printf(), OPASSIGN, OPMINUSEQ, OPSTAR, out_and_free_statement(), prev_tab, prune_left_conv(), q, TYINT, Nameblock::vdim, Nameblock::vlastdim, Nameblock::vleng, Nameblock::vtype, write_comment(), and wrote_comment.

Referenced by procode().

00425 {
00426         int addif, addif0, i, nd, size;
00427         int *ac;
00428         register Namep q;
00429         register struct Dimblock *dp;
00430         chainp p0, p1;
00431 
00432         if(procclass == CLBLOCK)
00433                 return;
00434         p0 = p;
00435         p1 = p = argsort(p);
00436         wrote_comment = 0;
00437         comment_file = outfile;
00438         ac = 0;
00439 
00440 /* Compute the base addresses and offsets for the array parameters, and
00441    assign these values to local variables */
00442 
00443         addif = addif0 = nentry > 1;
00444         for(; p ; p = p->nextp)
00445         {
00446             q = (Namep) p->datap;
00447             if(dp = q->vdim)    /* if this param is an array ... */
00448             {
00449                 expptr Q, expr;
00450 
00451                 /* See whether to protect the following with an if. */
00452                 /* This only happens when there are multiple entries. */
00453 
00454                 nd = dp->ndim - 1;
00455                 if (addif0) {
00456                         if (!ac)
00457                                 ac = count_args();
00458                         if (ac[q->argno] == nentry)
00459                                 addif = 0;
00460                         else if (dp->basexpr
00461                                     || dp->baseoffset->constblock.Const.ci)
00462                                 addif = 1;
00463                         else for(addif = i = 0; i <= nd; i++)
00464                                 if (dp->dims[i].dimexpr
00465                                 && (i < nd || !q->vlastdim)) {
00466                                         addif = 1;
00467                                         break;
00468                                         }
00469                         if (addif) {
00470                                 write_comment();
00471                                 nice_printf(outfile, "if (%s) {\n", /*}*/
00472                                                 q->cvarname);
00473                                 next_tab(outfile);
00474                                 }
00475                         }
00476                 for(i = 0 ; i <= nd; ++i)
00477 
00478 /* Store the variable length of each dimension (which is fixed upon
00479    runtime procedure entry) into a local variable */
00480 
00481                     if ((Q = dp->dims[i].dimexpr)
00482                         && (i < nd || !q->vlastdim)) {
00483                         expr = (expptr)cpexpr(Q);
00484                         write_comment();
00485                         out_and_free_statement (outfile, mkexpr (OPASSIGN,
00486                                 fixtype(cpexpr(dp->dims[i].dimsize)), expr));
00487                     } /* if dp -> dims[i].dimexpr */
00488 
00489 /* size   will equal the size of a single element, or -1 if the type is
00490    variable length character type */
00491 
00492                 size = typesize[ q->vtype ];
00493                 if(q->vtype == TYCHAR)
00494                     if( ISICON(q->vleng) )
00495                         size *= q->vleng->constblock.Const.ci;
00496                     else
00497                         size = -1;
00498 
00499                 /* Fudge the argument pointers for arrays so subscripts
00500                  * are 0-based. Not done if array bounds are being checked.
00501                  */
00502                 if(dp->basexpr) {
00503 
00504 /* Compute the base offset for this procedure */
00505 
00506                     write_comment();
00507                     out_and_free_statement (outfile, mkexpr (OPASSIGN,
00508                             cpexpr(fixtype(dp->baseoffset)),
00509                             cpexpr(fixtype(dp->basexpr))));
00510                 } /* if dp -> basexpr */
00511 
00512                 if(! checksubs) {
00513                     if(dp->basexpr) {
00514                         expptr tp;
00515 
00516 /* If the base of this array has a variable adjustment ... */
00517 
00518                         tp = (expptr) cpexpr (dp -> baseoffset);
00519                         if(size < 0 || q -> vtype == TYCHAR)
00520                             tp = mkexpr (OPSTAR, tp, cpexpr (q -> vleng));
00521 
00522                         write_comment();
00523                         tp = mkexpr (OPMINUSEQ,
00524                                 mkconv (TYADDR, (expptr)p->datap),
00525                                 mkconv(TYINT, fixtype
00526                                 (fixtype (tp))));
00527 /* Avoid type clash by removing the type conversion */
00528                         tp = prune_left_conv (tp);
00529                         out_and_free_statement (outfile, tp);
00530                     } else if(dp->baseoffset->constblock.Const.ci != 0) {
00531 
00532 /* if the base of this array has a nonzero constant adjustment ... */
00533 
00534                         expptr tp;
00535 
00536                         write_comment();
00537                         if(size > 0 && q -> vtype != TYCHAR) {
00538                             tp = prune_left_conv (mkexpr (OPMINUSEQ,
00539                                     mkconv (TYADDR, (expptr)p->datap),
00540                                     mkconv (TYINT, fixtype
00541                                     (cpexpr (dp->baseoffset)))));
00542                             out_and_free_statement (outfile, tp);
00543                         } else {
00544                             tp = prune_left_conv (mkexpr (OPMINUSEQ,
00545                                     mkconv (TYADDR, (expptr)p->datap),
00546                                     mkconv (TYINT, fixtype
00547                                     (mkexpr (OPSTAR, cpexpr (dp -> baseoffset),
00548                                     cpexpr (q -> vleng))))));
00549                             out_and_free_statement (outfile, tp);
00550                         } /* else */
00551                     } /* if dp -> baseoffset -> const */
00552                 } /* if !checksubs */
00553 
00554                 if (addif) {
00555                         nice_printf(outfile, /*{*/ "}\n");
00556                         prev_tab(outfile);
00557                         }
00558             }
00559         }
00560         if (wrote_comment)
00561             nice_printf (outfile, "\n/* Function Body */\n");
00562         if (ac)
00563                 free((char *)ac);
00564         if (p0 != p1)
00565                 frchain(&p1);
00566 } /* prolog */

expptr prune_left_conv expptr    e
 

Definition at line 181 of file vax.c.

References charptr, free, Exprblock::leftp, OPCONV, and TEXPR.

Referenced by prolog().

00183 {
00184     struct Exprblock *leftp;
00185 
00186     if (e && e -> tag == TEXPR && e -> exprblock.leftp &&
00187             e -> exprblock.leftp -> tag == TEXPR) {
00188         leftp = &(e -> exprblock.leftp -> exprblock);
00189         if (leftp -> opcode == OPCONV) {
00190             e -> exprblock.leftp = leftp -> leftp;
00191             free ((charptr) leftp);
00192         }
00193     }
00194 
00195     return e;
00196 } /* prune_left_conv */

void write_comment Void    [static]
 

Definition at line 203 of file vax.c.

References comment_file, nice_printf(), and wrote_comment.

Referenced by prolog().

00204 {
00205         if (!wrote_comment) {
00206                 wrote_comment = 1;
00207                 nice_printf (comment_file, "/* Parameter adjustments */\n");
00208                 }
00209         }

Variable Documentation

FILE* comment_file [static]
 

Definition at line 200 of file vax.c.

Referenced by prolog(), and write_comment().

int nu [static]
 

Definition at line 228 of file vax.c.

Referenced by afwalk(), argsort(), and awalk().

int * refs [static]
 

Definition at line 228 of file vax.c.

Referenced by afwalk(), argsort(), and awalk().

int regnum[]
 

Initial value:

  {
        11, 10, 9, 8, 7, 6 }

Definition at line 28 of file vax.c.

int * used [static]
 

Definition at line 228 of file vax.c.

Referenced by afwalk(), argsort(), and awalk().

int wrote_comment [static]
 

Definition at line 199 of file vax.c.

Referenced by prolog(), and write_comment().

 

Powered by Plone

This site conforms to the following standards: