home *** CD-ROM | disk | FTP | other *** search
/ minnie.tuhs.org / unixen.tar / unixen / PDP-11 / Trees / V7 / usr / src / cmd / bc.y < prev    next >
Encoding:
Lex Description  |  1979-01-10  |  11.9 KB  |  598 lines
  1. %{
  2.     int *getout();
  3. %}
  4. %right '='
  5. %left '+' '-'
  6. %left '*' '/' '%'
  7. %right '^'
  8. %left UMINUS
  9.  
  10. %term LETTER DIGIT SQRT LENGTH _IF  FFF EQ
  11. %term _WHILE _FOR NE LE GE INCR DECR
  12. %term _RETURN _BREAK _DEFINE BASE OBASE SCALE
  13. %term EQPL EQMI EQMUL EQDIV EQREM EQEXP
  14. %term _AUTO DOT
  15. %term QSTR
  16.  
  17. %{
  18. #include <stdio.h>
  19. int in;
  20. char cary[1000], *cp = { cary };
  21. char string[1000], *str = {string};
  22. int crs = '0';
  23. int rcrs = '0';  /* reset crs */
  24. int bindx = 0;
  25. int lev = 0;
  26. int ln;
  27. char *ss;
  28. int bstack[10] = { 0 };
  29. char *numb[15] = {
  30.   " 0", " 1", " 2", " 3", " 4", " 5",
  31.   " 6", " 7", " 8", " 9", " 10", " 11",
  32.   " 12", " 13", " 14" };
  33. int *pre, *post;
  34. %}
  35. %%
  36. start    : 
  37.     |  start stat tail
  38.         = output( $2 );
  39.     |  start def dargs ')' '{' dlist slist '}'
  40.         ={    bundle( 6,pre, $7, post ,"0",numb[lev],"Q");
  41.             conout( $$, $2 );
  42.             rcrs = crs;
  43.             output( "" );
  44.             lev = bindx = 0;
  45.             }
  46.     ;
  47.  
  48. dlist    :  tail
  49.     | dlist _AUTO dlets tail
  50.     ;
  51.  
  52. stat    :  e 
  53.         ={ bundle(2, $1, "ps." ); }
  54.     | 
  55.         ={ bundle(1, "" ); }
  56.     |  QSTR
  57.         ={ bundle(3,"[",$1,"]P");}
  58.     |  LETTER '=' e
  59.         ={ bundle(3, $3, "s", $1 ); }
  60.     |  LETTER '[' e ']' '=' e
  61.         ={ bundle(4, $6, $3, ":", geta($1)); }
  62.     |  LETTER EQOP e
  63.         ={ bundle(6, "l", $1, $3, $2, "s", $1 ); }
  64.     |  LETTER '[' e ']' EQOP e
  65.         ={ bundle(8,$3, ";", geta($1), $6, $5, $3, ":", geta($1));}
  66.     |  _BREAK
  67.         ={ bundle(2, numb[lev-bstack[bindx-1]], "Q" ); }
  68.     |  _RETURN '(' e ')'
  69.         = bundle(4, $3, post, numb[lev], "Q" );
  70.     |  _RETURN '(' ')'
  71.         = bundle(4, "0", post, numb[lev], "Q" );
  72.     | _RETURN
  73.         = bundle(4,"0",post,numb[lev],"Q");
  74.     | SCALE '=' e
  75.         = bundle(2, $3, "k");
  76.     | SCALE EQOP e
  77.         = bundle(4,"K",$3,$2,"k");
  78.     | BASE '=' e
  79.         = bundle(2,$3, "i");
  80.     | BASE EQOP e
  81.         = bundle(4,"I",$3,$2,"i");
  82.     | OBASE '=' e
  83.         = bundle(2,$3,"o");
  84.     | OBASE EQOP e
  85.         = bundle(4,"O",$3,$2,"o");
  86.     |  '{' slist '}'
  87.         ={ $$ = $2; }
  88.     |  FFF
  89.         ={ bundle(1,"fY"); }
  90.     |  error
  91.         ={ bundle(1,"c"); }
  92.     |  _IF CRS BLEV '(' re ')' stat
  93.         ={    conout( $7, $2 );
  94.             bundle(3, $5, $2, " " );
  95.             }
  96.     |  _WHILE CRS '(' re ')' stat BLEV
  97.         ={    bundle(3, $6, $4, $2 );
  98.             conout( $$, $2 );
  99.             bundle(3, $4, $2, " " );
  100.             }
  101.     |  fprefix CRS re ';' e ')' stat BLEV
  102.         ={    bundle(5, $7, $5, "s.", $3, $2 );
  103.             conout( $$, $2 );
  104.             bundle(5, $1, "s.", $3, $2, " " );
  105.             }
  106.     |  '~' LETTER '=' e
  107.         ={    bundle(3,$4,"S",$2); }
  108.     ;
  109.  
  110. EQOP    :  EQPL
  111.         ={ $$ = "+"; }
  112.     |  EQMI
  113.         ={ $$ = "-"; }
  114.     |  EQMUL
  115.         ={ $$ = "*"; }
  116.     |  EQDIV
  117.         ={ $$ = "/"; }
  118.     |  EQREM
  119.         ={ $$ = "%%"; }
  120.     |  EQEXP
  121.         ={ $$ = "^"; }
  122.     ;
  123.  
  124. fprefix    :  _FOR '(' e ';'
  125.         ={ $$ = $3; }
  126.     ;
  127.  
  128. BLEV    :
  129.         ={ --bindx; }
  130.     ;
  131.  
  132. slist    :  stat
  133.     |  slist tail stat
  134.         ={ bundle(2, $1, $3 ); }
  135.     ;
  136.  
  137. tail    :  '\n'
  138.         ={ln++;}
  139.     |  ';'
  140.     ;
  141.  
  142. re    :  e EQ e
  143.         = bundle(3, $1, $3, "=" );
  144.     |  e '<' e
  145.         = bundle(3, $1, $3, ">" );
  146.     |  e '>' e
  147.         = bundle(3, $1, $3, "<" );
  148.     |  e NE e
  149.         = bundle(3, $1, $3, "!=" );
  150.     |  e GE e
  151.         = bundle(3, $1, $3, "!>" );
  152.     |  e LE e
  153.         = bundle(3, $1, $3, "!<" );
  154.     |  e
  155.         = bundle(2, $1, " 0!=" );
  156.     ;
  157.  
  158. e    :  e '+' e
  159.         = bundle(3, $1, $3, "+" );
  160.     |  e '-' e
  161.         = bundle(3, $1, $3, "-" );
  162.     | '-' e        %prec UMINUS
  163.         = bundle(3, " 0", $2, "-" );
  164.     |  e '*' e
  165.         = bundle(3, $1, $3, "*" );
  166.     |  e '/' e
  167.         = bundle(3, $1, $3, "/" );
  168.     |  e '%' e
  169.         = bundle(3, $1, $3, "%%" );
  170.     |  e '^' e
  171.         = bundle(3, $1, $3, "^" );
  172.     |  LETTER '[' e ']'
  173.         ={ bundle(3,$3, ";", geta($1)); }
  174.     |  LETTER INCR
  175.         = bundle(4, "l", $1, "d1+s", $1 );
  176.     |  INCR LETTER
  177.         = bundle(4, "l", $2, "1+ds", $2 );
  178.     |  DECR LETTER
  179.         = bundle(4, "l", $2, "1-ds", $2 );
  180.     |  LETTER DECR
  181.         = bundle(4, "l", $1, "d1-s", $1 );
  182.     | LETTER '[' e ']' INCR
  183.         = bundle(7,$3,";",geta($1),"d1+",$3,":",geta($1));
  184.     | INCR LETTER '[' e ']'
  185.         = bundle(7,$4,";",geta($2),"1+d",$4,":",geta($2));
  186.     | LETTER '[' e ']' DECR
  187.         = bundle(7,$3,";",geta($1),"d1-",$3,":",geta($1));
  188.     | DECR LETTER '[' e ']'
  189.         = bundle(7,$4,";",geta($2),"1-d",$4,":",geta($2));
  190.     | SCALE INCR
  191.         = bundle(1,"Kd1+k");
  192.     | INCR SCALE
  193.         = bundle(1,"K1+dk");
  194.     | SCALE DECR
  195.         = bundle(1,"Kd1-k");
  196.     | DECR SCALE
  197.         = bundle(1,"K1-dk");
  198.     | BASE INCR
  199.         = bundle(1,"Id1+i");
  200.     | INCR BASE
  201.         = bundle(1,"I1+di");
  202.     | BASE DECR
  203.         = bundle(1,"Id1-i");
  204.     | DECR BASE
  205.         = bundle(1,"I1-di");
  206.     | OBASE INCR
  207.         = bundle(1,"Od1+o");
  208.     | INCR OBASE
  209.         = bundle(1,"O1+do");
  210.     | OBASE DECR
  211.         = bundle(1,"Od1-o");
  212.     | DECR OBASE
  213.         = bundle(1,"O1-do");
  214.     |  LETTER '(' cargs ')'
  215.         = bundle(4, $3, "l", getf($1), "x" );
  216.     |  LETTER '(' ')'
  217.         = bundle(3, "l", getf($1), "x" );
  218.     |  cons
  219.         ={ bundle(2, " ", $1 ); }
  220.     |  DOT cons
  221.         ={ bundle(2, " .", $2 ); }
  222.     |  cons DOT cons
  223.         ={ bundle(4, " ", $1, ".", $3 ); }
  224.     |  cons DOT
  225.         ={ bundle(3, " ", $1, "." ); }
  226.     |  DOT
  227.         ={ $$ = "l."; }
  228.     |  LETTER
  229.         = { bundle(2, "l", $1 ); }
  230.     |  LETTER '=' e
  231.         ={ bundle(3, $3, "ds", $1 ); }
  232.     |  LETTER EQOP e    %prec '='
  233.         ={ bundle(6, "l", $1, $3, $2, "ds", $1 ); }
  234.     | LETTER '[' e ']' '=' e
  235.         = { bundle(5,$6,"d",$3,":",geta($1)); }
  236.     | LETTER '[' e ']' EQOP e
  237.         = { bundle(9,$3,";",geta($1),$6,$5,"d",$3,":",geta($1)); }
  238.     | LENGTH '(' e ')'
  239.         = bundle(2,$3,"Z");
  240.     | SCALE '(' e ')'
  241.         = bundle(2,$3,"X");    /* must be before '(' e ')' */
  242.     |  '(' e ')'
  243.         = { $$ = $2; }
  244.     |  '?'
  245.         ={ bundle(1, "?" ); }
  246.     |  SQRT '(' e ')'
  247.         ={ bundle(2, $3, "v" ); }
  248.     | '~' LETTER
  249.         ={ bundle(2,"L",$2); }
  250.     | SCALE '=' e
  251.         = bundle(2,$3,"dk");
  252.     | SCALE EQOP e        %prec '='
  253.         = bundle(4,"K",$3,$2,"dk");
  254.     | BASE '=' e
  255.         = bundle(2,$3,"di");
  256.     | BASE EQOP e        %prec '='
  257.         = bundle(4,"I",$3,$2,"di");
  258.     | OBASE '=' e
  259.         = bundle(2,$3,"do");
  260.     | OBASE EQOP e        %prec '='
  261.         = bundle(4,"O",$3,$2,"do");
  262.     | SCALE
  263.         = bundle(1,"K");
  264.     | BASE
  265.         = bundle(1,"I");
  266.     | OBASE
  267.         = bundle(1,"O");
  268.     ;
  269.  
  270. cargs    :  eora
  271.     |  cargs ',' eora
  272.         = bundle(2, $1, $3 );
  273.     ;
  274. eora:      e
  275.     | LETTER '[' ']'
  276.         =bundle(2,"l",geta($1));
  277.     ;
  278.  
  279. cons    :  constant
  280.         ={ *cp++ = '\0'; }
  281.  
  282. constant:
  283.       '_'
  284.         ={ $$ = cp; *cp++ = '_'; }
  285.     |  DIGIT
  286.         ={ $$ = cp; *cp++ = $1; }
  287.     |  constant DIGIT
  288.         ={ *cp++ = $2; }
  289.     ;
  290.  
  291. CRS    :
  292.         ={ $$ = cp; *cp++ = crs++; *cp++ = '\0';
  293.             if(crs == '[')crs=+3;
  294.             if(crs == 'a')crs='{';
  295.             if(crs >= 0241){yyerror("program too big");
  296.                 getout();
  297.             }
  298.             bstack[bindx++] = lev++; }
  299.     ;
  300.  
  301. def    :  _DEFINE LETTER '('
  302.         ={    $$ = getf($2);
  303.             pre = "";
  304.             post = "";
  305.             lev = 1;
  306.             bstack[bindx=0] = 0;
  307.             }
  308.     ;
  309.  
  310. dargs    :
  311.     |  lora
  312.         ={ pp( $1 ); }
  313.     |  dargs ',' lora
  314.         ={ pp( $3 ); }
  315.     ;
  316.  
  317. dlets    :  lora
  318.         ={ tp($1); }
  319.     |  dlets ',' lora
  320.         ={ tp($3); }
  321.     ;
  322. lora    :  LETTER
  323.     |  LETTER '[' ']'
  324.         ={ $$ = geta($1); }
  325.     ;
  326.  
  327. %%
  328. # define error 256
  329.  
  330. int peekc = -1;
  331. int sargc;
  332. int ifile;
  333. char **sargv;
  334.  
  335. char funtab[52] = {
  336.     01,0,02,0,03,0,04,0,05,0,06,0,07,0,010,0,011,0,012,0,013,0,014,0,015,0,016,0,017,0,
  337.     020,0,021,0,022,0,023,0,024,0,025,0,026,0,027,0,030,0,031,0,032,0 };
  338. char atab[52] = {
  339.     0241,0,0242,0,0243,0,0244,0,0245,0,0246,0,0247,0,0250,0,0251,0,0252,0,0253,0,
  340.     0254,0,0255,0,0256,0,0257,0,0260,0,0261,0,0262,0,0263,0,0264,0,0265,0,0266,0,
  341.     0267,0,0270,0,0271,0,0272,0};
  342. char *letr[26] = {
  343.   "a","b","c","d","e","f","g","h","i","j",
  344.   "k","l","m","n","o","p","q","r","s","t",
  345.   "u","v","w","x","y","z" } ;
  346. char *dot = { "." };
  347. yylex(){
  348.     int c, ch;
  349. restart:
  350.     c = getch();
  351.     peekc = -1;
  352.     while( c == ' ' || c == '\t' ) c = getch();
  353.     if(c == '\\'){
  354.         getch();
  355.         goto restart;
  356.     }
  357.     if( c<= 'z' && c >= 'a' ) {
  358.         /* look ahead to look for reserved words */
  359.         peekc = getch();
  360.         if( peekc >= 'a' && peekc <= 'z' ){ /* must be reserved word */
  361.             if( c=='i' && peekc=='f' ){ c=_IF; goto skip; }
  362.             if( c=='w' && peekc=='h' ){ c=_WHILE; goto skip; }
  363.             if( c=='f' && peekc=='o' ){ c=_FOR; goto skip; }
  364.             if( c=='s' && peekc=='q' ){ c=SQRT; goto skip; }
  365.             if( c=='r' && peekc=='e' ){ c=_RETURN; goto skip; }
  366.             if( c=='b' && peekc=='r' ){ c=_BREAK; goto skip; }
  367.             if( c=='d' && peekc=='e' ){ c=_DEFINE; goto skip; }
  368.             if( c=='s' && peekc=='c' ){ c= SCALE; goto skip; }
  369.             if( c=='b' && peekc=='a' ){ c=BASE; goto skip; }
  370.             if( c=='i' && peekc == 'b'){ c=BASE; goto skip; }
  371.             if( c=='o' && peekc=='b' ){ c=OBASE; goto skip; }
  372.             if( c=='d' && peekc=='i' ){ c=FFF; goto skip; }
  373.             if( c=='a' && peekc=='u' ){ c=_AUTO; goto skip; }
  374.             if( c == 'l' && peekc=='e'){ c=LENGTH; goto skip; }
  375.             if( c == 'q' && peekc == 'u'){getout();}
  376.             /* could not be found */
  377.             return( error );
  378.         skip:    /* skip over rest of word */
  379.             peekc = -1;
  380.             while( (ch = getch()) >= 'a' && ch <= 'z' );
  381.             peekc = ch;
  382.             return( c );
  383.         }
  384.  
  385.         /* usual case; just one single letter */
  386.  
  387.         yylval = letr[c-'a'];
  388.         return( LETTER );
  389.     }
  390.     if( c>= '0' && c <= '9' || c>= 'A' && c<= 'F' ){
  391.         yylval = c;
  392.         return( DIGIT );
  393.     }
  394.     switch( c ){
  395.     case '.':    return( DOT );
  396.     case '=':
  397.         switch( peekc = getch() ){
  398.         case '=': c=EQ; goto gotit;
  399.         case '+': c=EQPL; goto gotit;
  400.         case '-': c=EQMI; goto gotit;
  401.         case '*': c=EQMUL; goto gotit;
  402.         case '/': c=EQDIV; goto gotit;
  403.         case '%': c=EQREM; goto gotit;
  404.         case '^': c=EQEXP; goto gotit;
  405.         default:   return( '=' );
  406.               gotit:     peekc = -1; return(c);
  407.           }
  408.     case '+':    return( cpeek( '+', INCR, '+' ) );
  409.     case '-':    return( cpeek( '-', DECR, '-' ) );
  410.     case '<':    return( cpeek( '=', LE, '<' ) );
  411.     case '>':    return( cpeek( '=', GE, '>' ) );
  412.     case '!':    return( cpeek( '=', NE, '!' ) );
  413.     case '/':
  414.         if((peekc = getch()) == '*'){
  415.             peekc = -1;
  416.             while((getch() != '*') || ((peekc = getch()) != '/'));
  417.             peekc = -1;
  418.             goto restart;
  419.         }
  420.         else return(c);
  421.     case '"':    
  422.          yylval = str;
  423.          while((c=getch()) != '"'){*str++ = c;
  424.             if(str >= &string[999]){yyerror("string space exceeded");
  425.             getout();
  426.         }
  427.     }
  428.      *str++ = '\0';
  429.     return(QSTR);
  430.     default:     return( c );
  431.     }
  432. }
  433.  
  434. cpeek( c, yes, no ){
  435.     if( (peekc=getch()) != c ) return( no );
  436.     else {
  437.         peekc = -1;
  438.         return( yes );
  439.     }
  440. }
  441.  
  442. getch(){
  443.     int ch;
  444. loop:
  445.     ch = (peekc < 0) ? getc(in) : peekc;
  446.     peekc = -1;
  447.     if(ch != EOF)return(ch);
  448.     if(++ifile > sargc){
  449.         if(ifile >= sargc+2)getout();
  450.         in = stdin;
  451.         ln = 0;
  452.         goto loop;
  453.     }
  454.     fclose(in);
  455.     if((in = fopen(sargv[ifile],"r")) != NULL){
  456.         ln = 0;
  457.         ss = sargv[ifile];
  458.         goto loop;
  459.     }
  460.     yyerror("cannot open input file");
  461. }
  462. # define b_sp_max 3000
  463. int b_space [ b_sp_max ];
  464. int * b_sp_nxt = { b_space };
  465.  
  466. int    bdebug = 0;
  467. bundle(a){
  468.     int i, *p, *q;
  469.  
  470.     p = &a;
  471.     i = *p++;
  472.     q = b_sp_nxt;
  473.     if( bdebug ) printf("bundle %d elements at %o\n",i,  q );
  474.     while(i-- > 0){
  475.         if( b_sp_nxt >= & b_space[b_sp_max] ) yyerror( "bundling space exceeded" );
  476.         * b_sp_nxt++ = *p++;
  477.     }
  478.     * b_sp_nxt++ = 0;
  479.     yyval = q;
  480.     return( q );
  481. }
  482.  
  483. routput(p) int *p; {
  484.     if( bdebug ) printf("routput(%o)\n", p );
  485.     if( p >= &b_space[0] && p < &b_space[b_sp_max]){
  486.         /* part of a bundle */
  487.         while( *p != 0 ) routput( *p++ );
  488.     }
  489.     else printf( p );     /* character string */
  490. }
  491.  
  492. output( p ) int *p; {
  493.     routput( p );
  494.     b_sp_nxt = & b_space[0];
  495.     printf( "\n" );
  496.     fflush(stdout);
  497.     cp = cary;
  498.     crs = rcrs;
  499. }
  500.  
  501. conout( p, s ) int *p; char *s; {
  502.     printf("[");
  503.     routput( p );
  504.     printf("]s%s\n", s );
  505.     fflush(stdout);
  506.     lev--;
  507. }
  508.  
  509. yyerror( s ) char *s; {
  510.     if(ifile > sargc)ss="teletype";
  511.     printf("c[%s on line %d, %s]pc\n", s ,ln+1,ss);
  512.     fflush(stdout);
  513.     cp = cary;
  514.     crs = rcrs;
  515.     bindx = 0;
  516.     lev = 0;
  517.     b_sp_nxt = &b_space[0];
  518. }
  519.  
  520. pp( s ) char *s; {
  521.     /* puts the relevant stuff on pre and post for the letter s */
  522.  
  523.     bundle(3, "S", s, pre );
  524.     pre = yyval;
  525.     bundle(4, post, "L", s, "s." );
  526.     post = yyval;
  527. }
  528.  
  529. tp( s ) char *s; { /* same as pp, but for temps */
  530.     bundle(3, "0S", s, pre );
  531.     pre = yyval;
  532.     bundle(4, post, "L", s, "s." );
  533.     post = yyval;
  534. }
  535.  
  536. yyinit(argc,argv) int argc; char *argv[];{
  537.     signal( 2, (int(*)())1 );    /* ignore all interrupts */
  538.     sargv=argv;
  539.     sargc= -- argc;
  540.     if(sargc == 0)in=stdin;
  541.     else if((in = fopen(sargv[1],"r")) == NULL)
  542.         yyerror("cannot open input file");
  543.     ifile = 1;
  544.     ln = 0;
  545.     ss = sargv[1];
  546. }
  547. int *getout(){
  548.     printf("q");
  549.     fflush(stdout);
  550.     exit();
  551. }
  552.  
  553. int *
  554. getf(p) char *p;{
  555.     return(&funtab[2*(*p -0141)]);
  556. }
  557. int *
  558. geta(p) char *p;{
  559.     return(&atab[2*(*p - 0141)]);
  560. }
  561.  
  562. main(argc, argv)
  563. char **argv;
  564. {
  565.     int p[2];
  566.  
  567.  
  568.     if (argc > 1 && *argv[1] == '-') {
  569.         if((argv[1][1] == 'd')||(argv[1][1] == 'c')){
  570.             yyinit(--argc, ++argv);
  571.             yyparse();
  572.             exit();
  573.         }
  574.         if(argv[1][1] != 'l'){
  575.             printf("unrecognizable argument\n");
  576.             fflush(stdout);
  577.             exit();
  578.         }
  579.         argv[1] = "/usr/lib/lib.b";
  580.     }
  581.     pipe(p);
  582.     if (fork()==0) {
  583.         close(1);
  584.         dup(p[1]);
  585.         close(p[0]);
  586.         close(p[1]);
  587.         yyinit(argc, argv);
  588.         yyparse();
  589.         exit();
  590.     }
  591.     close(0);
  592.     dup(p[0]);
  593.     close(p[0]);
  594.     close(p[1]);
  595.     execl("/bin/dc", "dc", "-", 0);
  596.     execl("/usr/bin/dc", "dc", "-", 0);
  597. }
  598.