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