4.3BSD - /usr/src/usr.bin/efl/tailor.c

   1: #include "defs"
   2: 
   3: 
   4: setopt(p,q)
   5: char *p;
   6: char *q;
   7: {
   8: int qval;
   9: qval = (q!=NULL) && ( equals(q, "yes") || equals(q, "on") );
  10: 
  11: if(equals(p,"debug")) dbgopt = 1;
  12: else if(equals(p,"ndebug")) dbgopt = 0;
  13: else if(equals(p,"pfort")) langopt = 0;
  14: else if(equals(p,"ratfor")) langopt = 1;
  15: else if(equals(p,"efl")) langopt = 2;
  16: else if(equals(p,"dots"))
  17:     dotsopt = qval;
  18: else if(equals(p,"ioerror"))
  19:     {
  20:     if(equals(q,"none"))
  21:         tailor.errmode = IOERRNONE;
  22:     else if(equals(q,"ibm"))
  23:         tailor.errmode = IOERRIBM;
  24:     else if(equals(q,"fortran77"))
  25:         tailor.errmode = IOERRFORT77;
  26:     else execerr("unknown ioerror option %s", q);
  27:     }
  28: else if(equals(p, "system"))
  29:     {
  30:     register struct system *sysp;
  31:     for(sysp = systab ; sysp->sysname ; ++sysp)
  32:         if( equals(q, sysp->sysname) )
  33:             break;
  34: 
  35:     if(sysp->sysname)
  36:         tailinit(sysp);
  37:     else
  38:         execerr("unknown system %s", q);
  39:     }
  40: else if(equals(p, "continue"))
  41:         tailor.ftncontnu = equals(q, "column1");
  42: else if(equals(p, "procheader"))
  43:     tailor.procheader = (q ? copys(q) : 0);
  44: else if(equals(p, "hollincall"))
  45:     tailor.hollincall = qval;
  46: else if(equals(p, "longcomplextype"))
  47:     {
  48:     tailor.lngcxtype = (q ? copys(q) : CNULL);
  49:     if(qval)
  50:         eflftn[TYLCOMPLEX] = FTNDCOMPLEX;
  51:     }
  52: else if(equals(p, "longcomplexprefix"))
  53:     tailor.lngcxprefix = (q ? copys(q) : CNULL);
  54: else if(equals(p, "fortran77"))
  55:     {
  56:     if(tailor.ftn77 = (q==NULL || qval) )
  57:         tailor.errmode = IOERRFORT77;
  58:     else if(tailor.errmode == IOERRFORT77)
  59:         tailor.errmode = IOERRNONE;
  60:     }
  61: 
  62: else if( !tailop(p,q) )
  63:     execerr("unknown option %s", p);
  64: 
  65: if(langopt==2)
  66:     setdot(dotsopt);
  67: else if(langopt==1)
  68:     setdot(1);
  69: }
  70: 
  71: 
  72: 
  73: 
  74: tailinit(sysp)
  75: register struct system *sysp;
  76: {
  77: register int sysf = sysp->sysno;
  78: tailor.ftncontnu = (sysf==UNIX);
  79: tailor.ftnsys = sysf;
  80: tailor.ftnin = 5;
  81: tailor.ftnout = 6;
  82: tailor.errmode = (sysf==UNIX ? IOERRFORT77 : IOERRIBM);
  83: tailor.charcomp = 2;
  84: tailor.hollincall = YES;
  85: tailor.deltastno = 1;
  86: tailor.dclintrinsics = YES;
  87: 
  88: tailsize(sysp->chperwd);
  89: tailfmt(sysp->idig, sysp->rdig, sysp->ddig);
  90: }
  91: 
  92: 
  93: 
  94: 
  95: 
  96: tailsize(wordsize)
  97: int wordsize;
  98: {
  99: int i;
 100: 
 101: tailor.ftnchwd = wordsize;
 102: tailor.ftnsize[FTNINT] = wordsize;
 103: tailor.ftnsize[FTNREAL] = wordsize;
 104: tailor.ftnsize[FTNLOG] = wordsize;
 105: tailor.ftnsize[FTNCOMPLEX] = 2*wordsize;
 106: tailor.ftnsize[FTNDOUBLE] = 2*wordsize;
 107: tailor.ftnsize[FTNDCOMPLEX] = 2*wordsize;
 108: 
 109: for(i = 0 ; i<NFTNTYPES ; ++i)
 110:     tailor.ftnalign[i] = tailor.ftnsize[i];
 111: }
 112: 
 113: 
 114: 
 115: 
 116: tailfmt(idig, rdig, ddig)
 117: int idig, rdig, ddig;
 118: {
 119: sprintf(msg, "i%d", idig);
 120: tailor.dfltfmt[TYINT] = copys(msg);
 121: 
 122: sprintf(msg, "e%d.%d", rdig+8, rdig);
 123: tailor.dfltfmt[TYREAL] = copys(msg);
 124: 
 125: sprintf(msg, "d%d.%d", ddig+8, ddig);
 126: tailor.dfltfmt[TYLREAL] = copys(msg);
 127: 
 128: sprintf(msg, "1h(,1p%s,2h, ,%s,1h)",
 129:     tailor.dfltfmt[TYREAL], tailor.dfltfmt[TYREAL]);
 130: tailor.dfltfmt[TYCOMPLEX] = copys(msg);
 131: 
 132: sprintf(msg, "1h(,1p%s,2h, ,%s,1h)",
 133:     tailor.dfltfmt[TYLREAL], tailor.dfltfmt[TYLREAL]);
 134: tailor.dfltfmt[TYLCOMPLEX] = copys(msg);
 135: 
 136: tailor.dfltfmt[TYLOG] = "l2";
 137: }
 138: 
 139: 
 140: 
 141: 
 142: tailop(n,v)
 143: char *n, *v;
 144: {
 145: int val;
 146: struct itable { char *optn; int *ioptloc; } *ip;
 147: struct ctable { char *optn; char **coptloc; } *cp;
 148: static struct ctable formats[ ] =  {
 149:     "iformat",  &tailor.dfltfmt[TYINT],
 150:     "rformat",  &tailor.dfltfmt[TYREAL],
 151:     "dformat",  &tailor.dfltfmt[TYLREAL],
 152:     "zformat",  &tailor.dfltfmt[TYCOMPLEX],
 153:     "zdformat", &tailor.dfltfmt[TYLCOMPLEX],
 154:     "lformat",  &tailor.dfltfmt[TYLOG],
 155:     0, 0  };
 156: 
 157: static struct itable ints[ ] = {
 158:     "ftnin",    &tailor.ftnin,
 159:     "ftnout",   &tailor.ftnout,
 160:     "charperint",  &tailor.ftnchwd,
 161:     "charcomp", &tailor.charcomp,
 162:     "deltastno",    &tailor.deltastno,
 163:     "dclintrinsics",    &tailor.dclintrinsics,
 164:     "isize",    &tailor.ftnsize[FTNINT],
 165:     "rsize",    &tailor.ftnsize[FTNREAL],
 166:     "dsize",    &tailor.ftnsize[FTNDOUBLE],
 167:     "lsize",    &tailor.ftnsize[FTNLOG],
 168:     "zsize",    &tailor.ftnsize[FTNCOMPLEX],
 169:     "ialign",   &tailor.ftnalign[FTNINT],
 170:     "ralign",   &tailor.ftnalign[FTNREAL],
 171:     "dalign",   &tailor.ftnalign[FTNDOUBLE],
 172:     "lalign",   &tailor.ftnalign[FTNLOG],
 173:     "zalign",   &tailor.ftnalign[FTNCOMPLEX],
 174:     0, 0 };
 175: 
 176: for(cp = formats; cp->optn ; ++cp)
 177:     if(equals(n, cp->optn))
 178:         {
 179:         *(cp->coptloc) = copys(v);
 180:         return(1);
 181:         }
 182: 
 183: for(ip = ints ; ip->optn ; ++ip)
 184:     if(equals(n, ip->optn))
 185:         {
 186:         if( equals(v, "yes") || equals(v, "on") )
 187:             val = 1;
 188:         else if( equals(v, "no") || equals(v, "off") )
 189:             val = 0;
 190:         else    val = convci(v);
 191:         *(ip->ioptloc) = val;
 192:         return(1);
 193:         }
 194: 
 195: return(0);
 196: }

Defined functions

Defined struct's