Return to fmt.c CVS log

Up to [Research Unix] / researchv10dc / libI77

Annotation of researchv10dc/libI77/fmt.c, revision 1.1

1.1     ! root        1: #include "f2c.h"
        !             2: #include "fio.h"
        !             3: #include "fmt.h"
        !             4: #define skip(s) while(*s==' ') s++
        !             5: #ifdef interdata
        !             6: #define SYLMX 300
        !             7: #endif
        !             8: #ifdef pdp11
        !             9: #define SYLMX 300
        !            10: #endif
        !            11: #ifdef vax
        !            12: #define SYLMX 300
        !            13: #endif
        !            14: #ifndef SYLMX
        !            15: #define SYLMX 300
        !            16: #endif
        !            17: #define GLITCH '\2'
        !            18:        /* special quote character for stu */
        !            19: extern int f__cursor,f__scale;
        !            20: extern flag f__cblank,f__cplus;        /*blanks in I and compulsory plus*/
        !            21: struct f__syl f__syl[SYLMX];
        !            22: int f__parenlvl,f__pc,f__revloc;
        !            23: 
        !            24: #ifdef KR_headers
        !            25: char *ap_end(s) char *s;
        !            26: #else
        !            27: char *ap_end(char *s)
        !            28: #endif
        !            29: {      char quote;
        !            30:        quote= *s++;
        !            31:        for(;*s;s++)
        !            32:        {       if(*s!=quote) continue;
        !            33:                if(*++s!=quote) return(s);
        !            34:        }
        !            35:        if(f__elist->cierr) {
        !            36:                errno = 100;
        !            37:                return(NULL);
        !            38:        }
        !            39:        f__fatal(100, "bad string");
        !            40:        /*NOTREACHED*/ return 0;
        !            41: }
        !            42: #ifdef KR_headers
        !            43: op_gen(a,b,c,d)
        !            44: #else
        !            45: op_gen(int a, int b, int c, int d)
        !            46: #endif
        !            47: {      struct f__syl *p= &f__syl[f__pc];
        !            48:        if(f__pc>=SYLMX)
        !            49:        {       fprintf(stderr,"format too complicated:\n");
        !            50:                sig_die(f__fmtbuf, 1);
        !            51:        }
        !            52:        p->op=a;
        !            53:        p->p1=b;
        !            54:        p->p2=c;
        !            55:        p->p3=d;
        !            56:        return(f__pc++);
        !            57: }
        !            58: #ifdef KR_headers
        !            59: char *f_list();
        !            60: char *gt_num(s,n) char *s; int *n;
        !            61: #else
        !            62: char *f_list(char*);
        !            63: char *gt_num(char *s, int *n)
        !            64: #endif
        !            65: {      int m=0,f__cnt=0;
        !            66:        char c;
        !            67:        for(c= *s;;c = *s)
        !            68:        {       if(c==' ')
        !            69:                {       s++;
        !            70:                        continue;
        !            71:                }
        !            72:                if(c>'9' || c<'0') break;
        !            73:                m=10*m+c-'0';
        !            74:                f__cnt++;
        !            75:                s++;
        !            76:        }
        !            77:        if(f__cnt==0) *n=1;
        !            78:        else *n=m;
        !            79:        return(s);
        !            80: }
        !            81: #ifdef KR_headers
        !            82: char *f_s(s,curloc) char *s;
        !            83: #else
        !            84: char *f_s(char *s, int curloc)
        !            85: #endif
        !            86: {
        !            87:        skip(s);
        !            88:        if(*s++!='(')
        !            89:        {
        !            90:                return(NULL);
        !            91:        }
        !            92:        if(f__parenlvl++ ==1) f__revloc=curloc;
        !            93:        if(op_gen(RET1,curloc,0,0)<0 ||
        !            94:                (s=f_list(s))==NULL)
        !            95:        {
        !            96:                return(NULL);
        !            97:        }
        !            98:        skip(s);
        !            99:        return(s);
        !           100: }
        !           101: #ifdef KR_headers
        !           102: ne_d(s,p) char *s,**p;
        !           103: #else
        !           104: ne_d(char *s, char **p)
        !           105: #endif
        !           106: {      int n,x,sign=0;
        !           107:        struct f__syl *sp;
        !           108:        switch(*s)
        !           109:        {
        !           110:        default:
        !           111:                return(0);
        !           112:        case ':': (void) op_gen(COLON,0,0,0); break;
        !           113:        case '$':
        !           114:                (void) op_gen(NONL, 0, 0, 0); break;
        !           115:        case 'B':
        !           116:        case 'b':
        !           117:                if(*++s=='z' || *s == 'Z') (void) op_gen(BZ,0,0,0);
        !           118:                else (void) op_gen(BN,0,0,0);
        !           119:                break;
        !           120:        case 'S':
        !           121:        case 's':
        !           122:                if(*(s+1)=='s' || *(s+1) == 'S')
        !           123:                {       x=SS;
        !           124:                        s++;
        !           125:                }
        !           126:                else if(*(s+1)=='p' || *(s+1) == 'P')
        !           127:                {       x=SP;
        !           128:                        s++;
        !           129:                }
        !           130:                else x=S;
        !           131:                (void) op_gen(x,0,0,0);
        !           132:                break;
        !           133:        case '/': (void) op_gen(SLASH,0,0,0); break;
        !           134:        case '-': sign=1;
        !           135:        case '+':       s++;    /*OUTRAGEOUS CODING TRICK*/
        !           136:        case '0': case '1': case '2': case '3': case '4':
        !           137:        case '5': case '6': case '7': case '8': case '9':
        !           138:                s=gt_num(s,&n);
        !           139:                switch(*s)
        !           140:                {
        !           141:                default:
        !           142:                        return(0);
        !           143:                case 'P':
        !           144:                case 'p': if(sign) n= -n; (void) op_gen(P,n,0,0); break;
        !           145:                case 'X':
        !           146:                case 'x': (void) op_gen(X,n,0,0); break;
        !           147:                case 'H':
        !           148:                case 'h':
        !           149:                        sp = &f__syl[op_gen(H,n,0,0)];
        !           150:                        *(char **)&sp->p2 = s + 1;
        !           151:                        s+=n;
        !           152:                        break;
        !           153:                }
        !           154:                break;
        !           155:        case GLITCH:
        !           156:        case '"':
        !           157:        case '\'':
        !           158:                sp = &f__syl[op_gen(APOS,0,0,0)];
        !           159:                *(char **)&sp->p2 = s;
        !           160:                if((*p = ap_end(s)) == NULL)
        !           161:                        return(0);
        !           162:                return(1);
        !           163:        case 'T':
        !           164:        case 't':
        !           165:                if(*(s+1)=='l' || *(s+1) == 'L')
        !           166:                {       x=TL;
        !           167:                        s++;
        !           168:                }
        !           169:                else if(*(s+1)=='r'|| *(s+1) == 'R')
        !           170:                {       x=TR;
        !           171:                        s++;
        !           172:                }
        !           173:                else x=T;
        !           174:                s=gt_num(s+1,&n);
        !           175:                s--;
        !           176:                (void) op_gen(x,n,0,0);
        !           177:                break;
        !           178:        case 'X':
        !           179:        case 'x': (void) op_gen(X,1,0,0); break;
        !           180:        case 'P':
        !           181:        case 'p': (void) op_gen(P,1,0,0); break;
        !           182:        }
        !           183:        s++;
        !           184:        *p=s;
        !           185:        return(1);
        !           186: }
        !           187: #ifdef KR_headers
        !           188: e_d(s,p) char *s,**p;
        !           189: #else
        !           190: e_d(char *s, char **p)
        !           191: #endif
        !           192: {      int i,im,n,w,d,e,found=0,x=0;
        !           193:        char *sv=s;
        !           194:        s=gt_num(s,&n);
        !           195:        (void) op_gen(STACK,n,0,0);
        !           196:        switch(*s++)
        !           197:        {
        !           198:        default: break;
        !           199:        case 'E':
        !           200:        case 'e':       x=1;
        !           201:        case 'G':
        !           202:        case 'g':
        !           203:                found=1;
        !           204:                s=gt_num(s,&w);
        !           205:                if(w==0) break;
        !           206:                if(*s=='.')
        !           207:                {       s++;
        !           208:                        s=gt_num(s,&d);
        !           209:                }
        !           210:                else d=0;
        !           211:                if(*s!='E' && *s != 'e')
        !           212:                        (void) op_gen(x==1?E:G,w,d,0);  /* default is Ew.dE2 */
        !           213:                else
        !           214:                {       s++;
        !           215:                        s=gt_num(s,&e);
        !           216:                        (void) op_gen(x==1?EE:GE,w,d,e);
        !           217:                }
        !           218:                break;
        !           219:        case 'O':
        !           220:        case 'o':
        !           221:                i = O;
        !           222:                im = OM;
        !           223:                goto finish_I;
        !           224:        case 'Z':
        !           225:        case 'z':
        !           226:                i = Z;
        !           227:                im = ZM;
        !           228:                goto finish_I;
        !           229:        case 'L':
        !           230:        case 'l':
        !           231:                found=1;
        !           232:                s=gt_num(s,&w);
        !           233:                if(w==0) break;
        !           234:                (void) op_gen(L,w,0,0);
        !           235:                break;
        !           236:        case 'A':
        !           237:        case 'a':
        !           238:                found=1;
        !           239:                skip(s);
        !           240:                if(*s>='0' && *s<='9')
        !           241:                {       s=gt_num(s,&w);
        !           242:                        if(w==0) break;
        !           243:                        (void) op_gen(AW,w,0,0);
        !           244:                        break;
        !           245:                }
        !           246:                (void) op_gen(A,0,0,0);
        !           247:                break;
        !           248:        case 'F':
        !           249:        case 'f':
        !           250:                found=1;
        !           251:                s=gt_num(s,&w);
        !           252:                if(w==0) break;
        !           253:                if(*s=='.')
        !           254:                {       s++;
        !           255:                        s=gt_num(s,&d);
        !           256:                }
        !           257:                else d=0;
        !           258:                (void) op_gen(F,w,d,0);
        !           259:                break;
        !           260:        case 'D':
        !           261:        case 'd':
        !           262:                found=1;
        !           263:                s=gt_num(s,&w);
        !           264:                if(w==0) break;
        !           265:                if(*s=='.')
        !           266:                {       s++;
        !           267:                        s=gt_num(s,&d);
        !           268:                }
        !           269:                else d=0;
        !           270:                (void) op_gen(D,w,d,0);
        !           271:                break;
        !           272:        case 'I':
        !           273:        case 'i':
        !           274:                i = I;
        !           275:                im = IM;
        !           276:  finish_I:
        !           277:                found=1;
        !           278:                s=gt_num(s,&w);
        !           279:                if(w==0) break;
        !           280:                if(*s!='.')
        !           281:                {       (void) op_gen(i,w,0,0);
        !           282:                        break;
        !           283:                }
        !           284:                s++;
        !           285:                s=gt_num(s,&d);
        !           286:                (void) op_gen(im,w,d,0);
        !           287:                break;
        !           288:        }
        !           289:        if(found==0)
        !           290:        {       f__pc--; /*unSTACK*/
        !           291:                *p=sv;
        !           292:                return(0);
        !           293:        }
        !           294:        *p=s;
        !           295:        return(1);
        !           296: }
        !           297: #ifdef KR_headers
        !           298: char *i_tem(s) char *s;
        !           299: #else
        !           300: char *i_tem(char *s)
        !           301: #endif
        !           302: {      char *t;
        !           303:        int n,curloc;
        !           304:        if(*s==')') return(s);
        !           305:        if(ne_d(s,&t)) return(t);
        !           306:        if(e_d(s,&t)) return(t);
        !           307:        s=gt_num(s,&n);
        !           308:        if((curloc=op_gen(STACK,n,0,0))<0) return(NULL);
        !           309:        return(f_s(s,curloc));
        !           310: }
        !           311: #ifdef KR_headers
        !           312: char *f_list(s) char *s;
        !           313: #else
        !           314: char *f_list(char *s)
        !           315: #endif
        !           316: {
        !           317:        for(;*s!=0;)
        !           318:        {       skip(s);
        !           319:                if((s=i_tem(s))==NULL) return(NULL);
        !           320:                skip(s);
        !           321:                if(*s==',') s++;
        !           322:                else if(*s==')')
        !           323:                {       if(--f__parenlvl==0)
        !           324:                        {
        !           325:                                (void) op_gen(REVERT,f__revloc,0,0);
        !           326:                                return(++s);
        !           327:                        }
        !           328:                        (void) op_gen(GOTO,0,0,0);
        !           329:                        return(++s);
        !           330:                }
        !           331:        }
        !           332:        return(NULL);
        !           333: }
        !           334: 
        !           335: #ifdef KR_headers
        !           336: pars_f(s) char *s;
        !           337: #else
        !           338: pars_f(char *s)
        !           339: #endif
        !           340: {
        !           341:        f__parenlvl=f__revloc=f__pc=0;
        !           342:        if(f_s(s,0) == NULL)
        !           343:        {
        !           344:                return(-1);
        !           345:        }
        !           346:        return(0);
        !           347: }
        !           348: #define STKSZ 10
        !           349: int f__cnt[STKSZ],f__ret[STKSZ],f__cp,f__rp;
        !           350: flag f__workdone, f__nonl;
        !           351: 
        !           352: #ifdef KR_headers
        !           353: type_f(n)
        !           354: #else
        !           355: type_f(int n)
        !           356: #endif
        !           357: {
        !           358:        switch(n)
        !           359:        {
        !           360:        default:
        !           361:                return(n);
        !           362:        case RET1:
        !           363:                return(RET1);
        !           364:        case REVERT: return(REVERT);
        !           365:        case GOTO: return(GOTO);
        !           366:        case STACK: return(STACK);
        !           367:        case X:
        !           368:        case SLASH:
        !           369:        case APOS: case H:
        !           370:        case T: case TL: case TR:
        !           371:                return(NED);
        !           372:        case F:
        !           373:        case I:
        !           374:        case IM:
        !           375:        case A: case AW:
        !           376:        case O: case OM:
        !           377:        case L:
        !           378:        case E: case EE: case D:
        !           379:        case G: case GE:
        !           380:        case Z: case ZM:
        !           381:                return(ED);
        !           382:        }
        !           383: }
        !           384: #ifdef KR_headers
        !           385: integer do_fio(number,ptr,len) ftnint *number; ftnlen len; char *ptr;
        !           386: #else
        !           387: integer do_fio(ftnint *number, char *ptr, ftnlen len)
        !           388: #endif
        !           389: {      struct f__syl *p;
        !           390:        int n,i;
        !           391:        for(i=0;i<*number;i++,ptr+=len)
        !           392:        {
        !           393: loop:  switch(type_f((p= &f__syl[f__pc])->op))
        !           394:        {
        !           395:        default:
        !           396:                fprintf(stderr,"unknown code in do_fio: %d\n%s\n",
        !           397:                        p->op,f__fmtbuf);
        !           398:                err(f__elist->cierr,100,"do_fio");
        !           399:        case NED:
        !           400:                if((*f__doned)(p))
        !           401:                {       f__pc++;
        !           402:                        goto loop;
        !           403:                }
        !           404:                f__pc++;
        !           405:                continue;
        !           406:        case ED:
        !           407:                if(f__cnt[f__cp]<=0)
        !           408:                {       f__cp--;
        !           409:                        f__pc++;
        !           410:                        goto loop;
        !           411:                }
        !           412:                if(ptr==NULL)
        !           413:                        return((*f__doend)());
        !           414:                f__cnt[f__cp]--;
        !           415:                f__workdone=1;
        !           416:                if((n=(*f__doed)(p,ptr,len))>0)
        !           417:                        errfl(f__elist->cierr,errno,"fmt");
        !           418:                if(n<0)
        !           419:                        err(f__elist->ciend,(EOF),"fmt");
        !           420:                continue;
        !           421:        case STACK:
        !           422:                f__cnt[++f__cp]=p->p1;
        !           423:                f__pc++;
        !           424:                goto loop;
        !           425:        case RET1:
        !           426:                f__ret[++f__rp]=p->p1;
        !           427:                f__pc++;
        !           428:                goto loop;
        !           429:        case GOTO:
        !           430:                if(--f__cnt[f__cp]<=0)
        !           431:                {       f__cp--;
        !           432:                        f__rp--;
        !           433:                        f__pc++;
        !           434:                        goto loop;
        !           435:                }
        !           436:                f__pc=1+f__ret[f__rp--];
        !           437:                goto loop;
        !           438:        case REVERT:
        !           439:                f__rp=f__cp=0;
        !           440:                f__pc = p->p1;
        !           441:                if(ptr==NULL)
        !           442:                        return((*f__doend)());
        !           443:                if(!f__workdone) return(0);
        !           444:                if((n=(*f__dorevert)()) != 0) return(n);
        !           445:                goto loop;
        !           446:        case COLON:
        !           447:                if(ptr==NULL)
        !           448:                        return((*f__doend)());
        !           449:                f__pc++;
        !           450:                goto loop;
        !           451:        case NONL:
        !           452:                f__nonl = 1;
        !           453:                f__pc++;
        !           454:                goto loop;
        !           455:        case S:
        !           456:        case SS:
        !           457:                f__cplus=0;
        !           458:                f__pc++;
        !           459:                goto loop;
        !           460:        case SP:
        !           461:                f__cplus = 1;
        !           462:                f__pc++;
        !           463:                goto loop;
        !           464:        case P: f__scale=p->p1;
        !           465:                f__pc++;
        !           466:                goto loop;
        !           467:        case BN:
        !           468:                f__cblank=0;
        !           469:                f__pc++;
        !           470:                goto loop;
        !           471:        case BZ:
        !           472:                f__cblank=1;
        !           473:                f__pc++;
        !           474:                goto loop;
        !           475:        }
        !           476:        }
        !           477:        return(0);
        !           478: }
        !           479: en_fio(Void)
        !           480: {      ftnint one=1;
        !           481:        return(do_fio(&one,(char *)NULL,(ftnint)0));
        !           482: }
        !           483:  VOID
        !           484: fmt_bg(Void)
        !           485: {
        !           486:        f__workdone=f__cp=f__rp=f__pc=f__cursor=0;
        !           487:        f__cnt[0]=f__ret[0]=0;
        !           488: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.