home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / octa21fs.zip / octave / f2c / libi77 / fmt.c < prev    next >
C/C++ Source or Header  |  2000-01-15  |  8KB  |  489 lines
  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 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 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 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 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. }
  489.