![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to tailor.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / usr.bin / efl|
Return to tailor.c CVS log | Up to [CSRG BSD Unix] / 43BSD / usr.bin / efl |
1.1 ! root 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: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.