hbase

heirloom base
git clone git://git.2f30.org/hbase
Log | Files | Refs | README

bc.y (17205B)


      1 %{
      2 /*	from 4.4BSD /usr/src/usr.bin/bc/bc.y	*/
      3 /*-
      4  * Copyright (c) 1991, 1993
      5  *	The Regents of the University of California.  All rights reserved.
      6  *
      7  * This module is believed to contain source code proprietary to AT&T.
      8  * Use and redistribution is subject to the Berkeley Software License
      9  * Agreement and your Software Agreement with AT&T (Western Electric).
     10  *
     11  *	from bc.y	8.1 (Berkeley) 6/6/93
     12  */
     13 /*
     14  * Copyright(C) Caldera International Inc. 2001-2002. All rights reserved.
     15  *
     16  * Redistribution and use in source and binary forms, with or without
     17  * modification, are permitted provided that the following conditions
     18  * are met:
     19  *   Redistributions of source code and documentation must retain the
     20  *    above copyright notice, this list of conditions and the following
     21  *    disclaimer.
     22  *   Redistributions in binary form must reproduce the above copyright
     23  *    notice, this list of conditions and the following disclaimer in the
     24  *    documentation and/or other materials provided with the distribution.
     25  *   All advertising materials mentioning features or use of this software
     26  *    must display the following acknowledgement:
     27  *      This product includes software developed or owned by Caldera
     28  *      International, Inc.
     29  *   Neither the name of Caldera International, Inc. nor the names of
     30  *    other contributors may be used to endorse or promote products
     31  *    derived from this software without specific prior written permission.
     32  *
     33  * USE OF THE SOFTWARE PROVIDED FOR UNDER THIS LICENSE BY CALDERA
     34  * INTERNATIONAL, INC. AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR
     35  * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
     36  * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
     37  * ARE DISCLAIMED. IN NO EVENT SHALL CALDERA INTERNATIONAL, INC. BE
     38  * LIABLE FOR ANY DIRECT, INDIRECT INCIDENTAL, SPECIAL, EXEMPLARY, OR
     39  * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
     40  * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
     41  * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
     42  * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
     43  * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
     44  * EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
     45  */
     46 #if __GNUC__ >= 3 && __GNUC_MINOR__ >= 4 || __GNUC__ >= 4
     47 #define	USED	__attribute__ ((used))
     48 #elif defined __GNUC__
     49 #define	USED	__attribute__ ((unused))
     50 #else
     51 #define	USED
     52 #endif
     53 static const char sccsid[] USED = "@(#)bc.sl	1.24 (gritter) 7/3/05";
     54 #include <unistd.h>
     55 #include <signal.h>
     56 #include <limits.h>
     57 #include <inttypes.h>
     58 #include <stdarg.h>
     59 #include <stdio.h>
     60 #include <stdlib.h>
     61 typedef	intptr_t	YYSTYPE;
     62 #define	YYSTYPE	YYSTYPE
     63 	static int cpeek(int c, int yes, int no);
     64 	static int getch(void);
     65 	static intptr_t bundle(int a, ...);
     66 	static void routput(intptr_t *p);
     67 	static void output(intptr_t *p);
     68 	static void conout(intptr_t p, intptr_t s);
     69 	static void pp(intptr_t);
     70 	static void tp(intptr_t);
     71 	static void yyinit(int argc, char *argv[]);
     72 	static intptr_t *getout(void);
     73 	static intptr_t *getf(intptr_t);
     74 	static intptr_t *geta(intptr_t);
     75 	static void yyerror(const char *);
     76 	static void cantopen(const char *);
     77 	extern int yylex(void);
     78 
     79 #if defined (__GLIBC__) && defined (_IO_getc_unlocked)
     80 #undef	getc
     81 #define	getc(f)		_IO_getc_unlocked(f)
     82 #endif
     83 %}
     84 %right '='
     85 %left '+' '-'
     86 %left '*' '/' '%'
     87 %right '^'
     88 %left UMINUS
     89 
     90 %term LETTER DIGIT SQRT LENGTH _IF  FFF EQ
     91 %term _WHILE _FOR NE LE GE INCR DECR
     92 %term _RETURN _BREAK _DEFINE BASE OBASE SCALE
     93 %term EQPL EQMI EQMUL EQDIV EQREM EQEXP
     94 %term _AUTO DOT
     95 %term QSTR
     96 
     97 %{
     98 #define	THIS_BC_STRING_MAX	1000
     99 static FILE *in;
    100 static char cary[LINE_MAX + 1], *cp = { cary };
    101 static char string[THIS_BC_STRING_MAX + 3], *str = {string};
    102 static int crs = '0';
    103 static int rcrs = '0';  /* reset crs */
    104 static int bindx = 0;
    105 static int lev = 0;
    106 static int ln;
    107 static char *ss;
    108 static int bstack[10] = { 0 };
    109 static char *numb[15] = {
    110   " 0", " 1", " 2", " 3", " 4", " 5",
    111   " 6", " 7", " 8", " 9", " 10", " 11",
    112   " 12", " 13", " 14" };
    113 static intptr_t *pre, *post;
    114 %}
    115 %%
    116 start	: 
    117 	|  start stat tail
    118 		{ output( (intptr_t *)$2 );}
    119 	|  start def dargs ')' '{' dlist slist '}'
    120 		{	bundle( 6,pre, $7, post ,"0",numb[lev],"Q");
    121 			conout( $$, $2 );
    122 			rcrs = crs;
    123 			output( (intptr_t *)"" );
    124 			lev = bindx = 0;
    125 			}
    126 	;
    127 
    128 dlist	:  tail
    129 	| dlist _AUTO dlets tail
    130 	;
    131 
    132 stat	:  e 
    133 		{ bundle(2, $1, "ps." ); }
    134 	| 
    135 		{ bundle(1, "" ); }
    136 	|  QSTR
    137 		{ bundle(3,"[",$1,"]P");}
    138 	|  LETTER '=' e
    139 		{ bundle(3, $3, "s", $1 ); }
    140 	|  LETTER '[' e ']' '=' e
    141 		{ bundle(4, $6, $3, ":", geta($1)); }
    142 	|  LETTER EQOP e
    143 		{ bundle(6, "l", $1, $3, $2, "s", $1 ); }
    144 	|  LETTER '[' e ']' EQOP e
    145 		{ bundle(8,$3, ";", geta($1), $6, $5, $3, ":", geta($1));}
    146 	|  _BREAK
    147 		{ bundle(2, numb[lev-bstack[bindx-1]], "Q" ); }
    148 	|  _RETURN '(' e ')'
    149 		{ bundle(4, $3, post, numb[lev], "Q" ); }
    150 	|  _RETURN '(' ')'
    151 		{ bundle(4, "0", post, numb[lev], "Q" ); }
    152 	| _RETURN
    153 		{ bundle(4,"0",post,numb[lev],"Q"); }
    154 	| SCALE '=' e
    155 		{ bundle(2, $3, "k"); }
    156 	| SCALE EQOP e
    157 		{ bundle(4,"K",$3,$2,"k"); }
    158 	| BASE '=' e
    159 		{ bundle(2,$3, "i"); }
    160 	| BASE EQOP e
    161 		{ bundle(4,"I",$3,$2,"i"); }
    162 	| OBASE '=' e
    163 		{ bundle(2,$3,"o"); }
    164 	| OBASE EQOP e
    165 		{ bundle(4,"O",$3,$2,"o"); }
    166 	|  '{' slist '}'
    167 		{ $$ = $2; }
    168 	|  FFF
    169 		{ bundle(1,"fY"); }
    170 	|  error
    171 		{ bundle(1,"c"); }
    172 	|  _IF CRS BLEV '(' re ')' stat
    173 		{	conout( $7, $2 );
    174 			bundle(3, $5, $2, " " );
    175 			}
    176 	|  _WHILE CRS '(' re ')' stat BLEV
    177 		{	bundle(3, $6, $4, $2 );
    178 			conout( $$, $2 );
    179 			bundle(3, $4, $2, " " );
    180 			}
    181 	|  fprefix CRS re ';' e ')' stat BLEV
    182 		{	bundle(5, $7, $5, "s.", $3, $2 );
    183 			conout( $$, $2 );
    184 			bundle(5, $1, "s.", $3, $2, " " );
    185 			}
    186 	|  '~' LETTER '=' e
    187 		{	bundle(3,$4,"S",$2); }
    188 	;
    189 
    190 EQOP	:  EQPL
    191 		{ $$ = (intptr_t)"+"; }
    192 	|  EQMI
    193 		{ $$ = (intptr_t)"-"; }
    194 	|  EQMUL
    195 		{ $$ = (intptr_t)"*"; }
    196 	|  EQDIV
    197 		{ $$ = (intptr_t)"/"; }
    198 	|  EQREM
    199 		{ $$ = (intptr_t)"%%"; }
    200 	|  EQEXP
    201 		{ $$ = (intptr_t)"^"; }
    202 	;
    203 
    204 fprefix	:  _FOR '(' e ';'
    205 		{ $$ = $3; }
    206 	;
    207 
    208 BLEV	:
    209 		{ --bindx; }
    210 	;
    211 
    212 slist	:  stat
    213 	|  slist tail stat
    214 		{ bundle(2, $1, $3 ); }
    215 	;
    216 
    217 tail	:  '\n'
    218 		{ln++;}
    219 	|  ';'
    220 	;
    221 
    222 re	:  e EQ e
    223 		{ bundle(3, $1, $3, "=" ); }
    224 	|  e '<' e
    225 		{ bundle(3, $1, $3, ">" ); }
    226 	|  e '>' e
    227 		{ bundle(3, $1, $3, "<" ); }
    228 	|  e NE e
    229 		{ bundle(3, $1, $3, "!=" ); }
    230 	|  e GE e
    231 		{ bundle(3, $1, $3, "!>" ); }
    232 	|  e LE e
    233 		{ bundle(3, $1, $3, "!<" ); }
    234 	|  e
    235 		{ bundle(2, $1, " 0!=" ); }
    236 	;
    237 
    238 e	:  e '+' e
    239 		{ bundle(3, $1, $3, "+" ); }
    240 	|  e '-' e
    241 		{ bundle(3, $1, $3, "-" ); }
    242 	| '-' e		%prec UMINUS
    243 		{ bundle(3, " 0", $2, "-" ); }
    244 	|  e '*' e
    245 		{ bundle(3, $1, $3, "*" ); }
    246 	|  e '/' e
    247 		{ bundle(3, $1, $3, "/" ); }
    248 	|  e '%' e
    249 		{ bundle(3, $1, $3, "%%" ); }
    250 	|  e '^' e
    251 		{ bundle(3, $1, $3, "^" ); }
    252 	|  LETTER '[' e ']'
    253 		{ bundle(3,$3, ";", geta($1)); }
    254 	|  LETTER INCR
    255 		{ bundle(4, "l", $1, "d1+s", $1 ); }
    256 	|  INCR LETTER
    257 		{ bundle(4, "l", $2, "1+ds", $2 ); }
    258 	|  DECR LETTER
    259 		{ bundle(4, "l", $2, "1-ds", $2 ); }
    260 	|  LETTER DECR
    261 		{ bundle(4, "l", $1, "d1-s", $1 ); }
    262 	| LETTER '[' e ']' INCR
    263 		{ bundle(7,$3,";",geta($1),"d1+",$3,":",geta($1)); }
    264 	| INCR LETTER '[' e ']'
    265 		{ bundle(7,$4,";",geta($2),"1+d",$4,":",geta($2)); }
    266 	| LETTER '[' e ']' DECR
    267 		{ bundle(7,$3,";",geta($1),"d1-",$3,":",geta($1)); }
    268 	| DECR LETTER '[' e ']'
    269 		{ bundle(7,$4,";",geta($2),"1-d",$4,":",geta($2)); }
    270 	| SCALE INCR
    271 		{ bundle(1,"Kd1+k"); }
    272 	| INCR SCALE
    273 		{ bundle(1,"K1+dk"); }
    274 	| SCALE DECR
    275 		{ bundle(1,"Kd1-k"); }
    276 	| DECR SCALE
    277 		{ bundle(1,"K1-dk"); }
    278 	| BASE INCR
    279 		{ bundle(1,"Id1+i"); }
    280 	| INCR BASE
    281 		{ bundle(1,"I1+di"); }
    282 	| BASE DECR
    283 		{ bundle(1,"Id1-i"); }
    284 	| DECR BASE
    285 		{ bundle(1,"I1-di"); }
    286 	| OBASE INCR
    287 		{ bundle(1,"Od1+o"); }
    288 	| INCR OBASE
    289 		{ bundle(1,"O1+do"); }
    290 	| OBASE DECR
    291 		{ bundle(1,"Od1-o"); }
    292 	| DECR OBASE
    293 		{ bundle(1,"O1-do"); }
    294 	|  LETTER '(' cargs ')'
    295 		{ bundle(4, $3, "l", getf($1), "x" ); }
    296 	|  LETTER '(' ')'
    297 		{ bundle(3, "l", getf($1), "x" ); }
    298 	|  cons
    299 		{ bundle(2, " ", $1 ); }
    300 	|  DOT cons
    301 		{ bundle(2, " .", $2 ); }
    302 	|  cons DOT cons
    303 		{ bundle(4, " ", $1, ".", $3 ); }
    304 	|  cons DOT
    305 		{ bundle(3, " ", $1, "." ); }
    306 	|  DOT
    307 		{ $$ = (intptr_t)"l."; }
    308 	|  LETTER
    309 		{ bundle(2, "l", $1 ); }
    310 	|  LETTER '=' e
    311 		{ bundle(3, $3, "ds", $1 ); }
    312 	|  LETTER EQOP e	%prec '='
    313 		{ bundle(6, "l", $1, $3, $2, "ds", $1 ); }
    314 	| LETTER '[' e ']' '=' e
    315 		{ bundle(5,$6,"d",$3,":",geta($1)); }
    316 	| LETTER '[' e ']' EQOP e
    317 		{ bundle(9,$3,";",geta($1),$6,$5,"d",$3,":",geta($1)); }
    318 	| LENGTH '(' e ')'
    319 		{ bundle(2,$3,"Z"); }
    320 	| SCALE '(' e ')'
    321 		{ bundle(2,$3,"X"); }	/* must be before '(' e ')' */
    322 	|  '(' e ')'
    323 		{ $$ = $2; }
    324 	|  '?'
    325 		{ bundle(1, "?" ); }
    326 	|  SQRT '(' e ')'
    327 		{ bundle(2, $3, "v" ); }
    328 	| '~' LETTER
    329 		{ bundle(2,"L",$2); }
    330 	| SCALE '=' e
    331 		{ bundle(2,$3,"dk"); }
    332 	| SCALE EQOP e		%prec '='
    333 		{ bundle(4,"K",$3,$2,"dk"); }
    334 	| BASE '=' e
    335 		{ bundle(2,$3,"di"); }
    336 	| BASE EQOP e		%prec '='
    337 		{ bundle(4,"I",$3,$2,"di"); }
    338 	| OBASE '=' e
    339 		{ bundle(2,$3,"do"); }
    340 	| OBASE EQOP e		%prec '='
    341 		{ bundle(4,"O",$3,$2,"do"); }
    342 	| SCALE
    343 		{ bundle(1,"K"); }
    344 	| BASE
    345 		{ bundle(1,"I"); }
    346 	| OBASE
    347 		{ bundle(1,"O"); }
    348 	;
    349 
    350 cargs	:  eora
    351 	|  cargs ',' eora
    352 		{ bundle(2, $1, $3 ); }
    353 	;
    354 eora:	  e
    355 	| LETTER '[' ']'
    356 		{bundle(2,"l",geta($1)); }
    357 	;
    358 
    359 cons	:  constant
    360 		{ *cp++ = '\0'; }
    361 
    362 constant:
    363 	  '_'
    364 		{ $$ = (intptr_t)cp; *cp++ = '_'; }
    365 	|  DIGIT
    366 		{ $$ = (intptr_t)cp; *cp++ = $1; }
    367 	|  constant DIGIT
    368 		{ *cp++ = $2; }
    369 	;
    370 
    371 CRS	:
    372 		{ $$ = (intptr_t)cp; *cp++ = crs++; *cp++ = '\0';
    373 			if(crs == '[')crs+=3;
    374 			if(crs == 'a')crs='{';
    375 			if(crs >= 0241){yyerror("program too big");
    376 				getout();
    377 			}
    378 			bstack[bindx++] = lev++; }
    379 	;
    380 
    381 def	:  _DEFINE LETTER '('
    382 		{	$$ = (intptr_t)getf($2);
    383 			pre = (intptr_t *)"";
    384 			post = (intptr_t *)"";
    385 			lev = 1;
    386 			bstack[bindx=0] = 0;
    387 			}
    388 	;
    389 
    390 dargs	:
    391 	|  lora
    392 		{ pp( $1 ); }
    393 	|  dargs ',' lora
    394 		{ pp( $3 ); }
    395 	;
    396 
    397 dlets	:  lora
    398 		{ tp($1); }
    399 	|  dlets ',' lora
    400 		{ tp($3); }
    401 	;
    402 lora	:  LETTER
    403 	|  LETTER '[' ']'
    404 		{ $$ = (intptr_t)geta($1); }
    405 	;
    406 
    407 %%
    408 # define error 256
    409 
    410 static int peekc = -1;
    411 static int sargc;
    412 static int ifile;
    413 static char **sargv;
    414 
    415 static char funtab[52] = {
    416 	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,
    417 	020,0,021,0,022,0,023,0,024,0,025,0,026,0,027,0,030,0,031,0,032,0 };
    418 static char atab[52] = {
    419 	0241,0,0242,0,0243,0,0244,0,0245,0,0246,0,0247,0,0250,0,0251,0,0252,0,0253,0,
    420 	0254,0,0255,0,0256,0,0257,0,0260,0,0261,0,0262,0,0263,0,0264,0,0265,0,0266,0,
    421 	0267,0,0270,0,0271,0,0272,0};
    422 static char *letr[26] = {
    423   "a","b","c","d","e","f","g","h","i","j",
    424   "k","l","m","n","o","p","q","r","s","t",
    425   "u","v","w","x","y","z" } ;
    426 /*static char *dot = { "." };*/
    427 
    428 int
    429 yylex(void){
    430 	int c, ch;
    431 restart:
    432 	c = getch();
    433 	peekc = -1;
    434 	while( c == ' ' || c == '\t' ) c = getch();
    435 	if(c == '\\'){
    436 		getch();
    437 		goto restart;
    438 	}
    439 	if( c<= 'z' && c >= 'a' ) {
    440 		/* look ahead to look for reserved words */
    441 		peekc = getch();
    442 		if( peekc >= 'a' && peekc <= 'z' ){ /* must be reserved word */
    443 			if( c=='i' && peekc=='f' ){ c=_IF; goto skip; }
    444 			if( c=='w' && peekc=='h' ){ c=_WHILE; goto skip; }
    445 			if( c=='f' && peekc=='o' ){ c=_FOR; goto skip; }
    446 			if( c=='s' && peekc=='q' ){ c=SQRT; goto skip; }
    447 			if( c=='r' && peekc=='e' ){ c=_RETURN; goto skip; }
    448 			if( c=='b' && peekc=='r' ){ c=_BREAK; goto skip; }
    449 			if( c=='d' && peekc=='e' ){ c=_DEFINE; goto skip; }
    450 			if( c=='s' && peekc=='c' ){ c= SCALE; goto skip; }
    451 			if( c=='b' && peekc=='a' ){ c=BASE; goto skip; }
    452 			if( c=='i' && peekc == 'b'){ c=BASE; goto skip; }
    453 			if( c=='o' && peekc=='b' ){ c=OBASE; goto skip; }
    454 			if( c=='d' && peekc=='i' ){ c=FFF; goto skip; }
    455 			if( c=='a' && peekc=='u' ){ c=_AUTO; goto skip; }
    456 			if( c == 'l' && peekc=='e'){ c=LENGTH; goto skip; }
    457 			if( c == 'q' && peekc == 'u'){getout();}
    458 			/* could not be found */
    459 			return( error );
    460 		skip:	/* skip over rest of word */
    461 			peekc = -1;
    462 			while( (ch = getch()) >= 'a' && ch <= 'z' );
    463 			peekc = ch;
    464 			return( c );
    465 		}
    466 
    467 		/* usual case; just one single letter */
    468 
    469 		yylval = (intptr_t)letr[c-'a'];
    470 		return( LETTER );
    471 	}
    472 	if( c>= '0' && c <= '9' || c>= 'A' && c<= 'F' ){
    473 		yylval = c;
    474 		return( DIGIT );
    475 	}
    476 	switch( c ){
    477 	case '.':	return( DOT );
    478 	case '=':
    479 		switch( peekc = getch() ){
    480 		case '=': c=EQ; goto gotit;
    481 		case '+': c=EQPL; goto gotit;
    482 		case '-': c=EQMI; goto gotit;
    483 		case '*': c=EQMUL; goto gotit;
    484 		case '/': c=EQDIV; goto gotit;
    485 		case '%': c=EQREM; goto gotit;
    486 		case '^': c=EQEXP; goto gotit;
    487 		default:   return( '=' );
    488 			  gotit:     peekc = -1; return(c);
    489 		  }
    490 	case '+':	return( cpeek( '+', INCR, cpeek( '=', EQPL, '+') ) );
    491 	case '-':	return( cpeek( '-', DECR, cpeek( '=', EQMI, '-') ) ) ;
    492 	case '<':	return( cpeek( '=', LE, '<' ) );
    493 	case '>':	return( cpeek( '=', GE, '>' ) );
    494 	case '!':	return( cpeek( '=', NE, '!' ) );
    495 	case '/':
    496 		if((peekc = getch()) == '*'){
    497 			peekc = -1;
    498 			while((getch() != '*') || ((peekc = getch()) != '/'));
    499 			peekc = -1;
    500 			goto restart;
    501 		}
    502 		else if (peekc == '=') {
    503 			c=EQDIV;
    504 			goto gotit;
    505 		}
    506 		else return(c);
    507 	case '*':
    508 		return( cpeek( '=', EQMUL, '*' ) );
    509 	case '%':
    510 		return( cpeek( '=', EQREM, '%' ) );
    511 	case '^':
    512 		return( cpeek( '=', EQEXP, '^' ) );
    513 	case '"':	
    514 		 yylval = (intptr_t)str;
    515 		 while((c=getch()) != '"'){*str++ = c;
    516 			if(str >= &string[sizeof string - 1]){yyerror("string space exceeded");
    517 			getout();
    518 		}
    519 	}
    520 	 *str++ = '\0';
    521 	return(QSTR);
    522 	default:	 return( c );
    523 	}
    524 }
    525 
    526 static int
    527 cpeek(int c, int yes, int no){
    528 	if( (peekc=getch()) != c ) return( no );
    529 	else {
    530 		peekc = -1;
    531 		return( yes );
    532 	}
    533 }
    534 
    535 static int
    536 getch(void){
    537 	int ch;
    538 loop:
    539 	ch = (peekc < 0) ? getc(in) : peekc;
    540 	peekc = -1;
    541 	if(ch != EOF)return(ch);
    542 	if(++ifile > sargc){
    543 		if(ifile >= sargc+2)getout();
    544 		in = stdin;
    545 		ln = 0;
    546 		goto loop;
    547 	}
    548 	fclose(in);
    549 	if((in = fopen(sargv[ifile],"r")) != NULL){
    550 		ln = 0;
    551 		ss = sargv[ifile];
    552 		goto loop;
    553 	}
    554 	cantopen(sargv[ifile]);
    555 	return EOF;
    556 }
    557 # define b_sp_max 3000
    558 static intptr_t b_space [ b_sp_max ];
    559 static intptr_t * b_sp_nxt = { b_space };
    560 
    561 static int	bdebug = 0;
    562 
    563 static intptr_t
    564 bundle(int a, ...){
    565 	intptr_t i, *q;
    566 	va_list ap;
    567 
    568 	i = a;
    569 	q = b_sp_nxt;
    570 	if( bdebug ) printf("bundle %ld elements at %lo\n",(long)i,  (long)q );
    571 	va_start(ap, a);
    572 	while(i-- > 0){
    573 		if( b_sp_nxt >= & b_space[b_sp_max] ) yyerror( "bundling space exceeded" );
    574 		* b_sp_nxt++ = va_arg(ap, intptr_t);
    575 	}
    576 	va_end(ap);
    577 	* b_sp_nxt++ = 0;
    578 	yyval = (intptr_t)q;
    579 	return( (intptr_t)q );
    580 }
    581 
    582 static void
    583 routput(intptr_t *p) {
    584 	if( bdebug ) printf("routput(%lo)\n", (long)p );
    585 	if( p >= &b_space[0] && p < &b_space[b_sp_max]){
    586 		/* part of a bundle */
    587 		while( *p != 0 ) routput( (intptr_t *)*p++ );
    588 	}
    589 	else printf( (char *)p );	 /* character string */
    590 }
    591 
    592 static void
    593 output(intptr_t *p) {
    594 	routput( p );
    595 	b_sp_nxt = & b_space[0];
    596 	printf( "\n" );
    597 	fflush(stdout);
    598 	cp = cary;
    599 	crs = rcrs;
    600 }
    601 
    602 static void
    603 conout(intptr_t p, intptr_t s) {
    604 	printf("[");
    605 	routput( (intptr_t *)p );
    606 	printf("]s%s\n", (char *)s );
    607 	fflush(stdout);
    608 	lev--;
    609 }
    610 
    611 static void
    612 yyerror(const char *s) {
    613 	if(ifile > sargc)ss="teletype";
    614 	fprintf(stderr, "%s on line %d, %s\n",
    615 		s ,ss?ln+1:0,ss?ss:"command line");
    616 	cp = cary;
    617 	crs = rcrs;
    618 	bindx = 0;
    619 	lev = 0;
    620 	b_sp_nxt = &b_space[0];
    621 }
    622 
    623 static void
    624 cantopen(const char *fn)
    625 {
    626 	char	spc[280];
    627 	char	*oss = ss;
    628 
    629 	ss = 0;
    630 	snprintf(spc, sizeof spc, "can't open input file %s", fn);
    631 	yyerror(spc);
    632 	ss = oss;
    633 }
    634 
    635 static void
    636 pp(intptr_t s) {
    637 	/* puts the relevant stuff on pre and post for the letter s */
    638 
    639 	bundle(3, "S", s, pre );
    640 	pre = (intptr_t *)yyval;
    641 	bundle(4, post, "L", s, "s." );
    642 	post = (intptr_t *)yyval;
    643 }
    644 
    645 static void
    646 tp(intptr_t s) { /* same as pp, but for temps */
    647 	bundle(3, "0S", s, pre );
    648 	pre = (intptr_t *)yyval;
    649 	bundle(4, post, "L", s, "s." );
    650 	post = (intptr_t *)yyval;
    651 }
    652 
    653 static void
    654 yyinit(int argc,char **argv) {
    655 	signal(SIGINT, SIG_IGN);
    656 	sargv=argv;
    657 	sargc= -- argc;
    658 	if(sargc == 0)in=stdin;
    659 	else if((in = fopen(sargv[1],"r")) == NULL) {
    660 		cantopen(sargv[1]);
    661 		exit(0);
    662 	}
    663 	ifile = 1;
    664 	ln = 0;
    665 	ss = sargv[1];
    666 }
    667 
    668 static intptr_t *
    669 getout(void){
    670 	printf("q");
    671 	fflush(stdout);
    672 	exit(0);
    673 	/*NOTREACHED*/
    674 	return(NULL);
    675 }
    676 
    677 static intptr_t *
    678 getf(intptr_t p) {
    679 	return(intptr_t *)(&funtab[2*(*((char *)p) -0141)]);
    680 }
    681 
    682 static intptr_t *
    683 geta(intptr_t p) {
    684 	return(intptr_t *)(&atab[2*(*((char *)p) - 0141)]);
    685 }
    686 
    687 int
    688 main(int argc, char **argv)
    689 {
    690 	extern int yyparse(void);
    691 	const char optstring[] = "cdl";
    692 	int p[2];
    693 	int i;
    694 	int cflag = 0, lflag = 0;
    695 
    696 
    697 #ifdef	__GLIBC__
    698 	putenv("POSIXLY_CORRECT=1");
    699 #endif
    700 	while ((i = getopt(argc, argv, optstring)) != EOF) {
    701 		switch (i) {
    702 		case 'd':
    703 		case 'c':
    704 			cflag = 1;
    705 			break;
    706 		case 'l':
    707 			lflag = 1;
    708 			break;
    709 		default:
    710 			exit(2);
    711 		}
    712 	}
    713 	argv += optind - 1, argc -= optind - 1;
    714 	if (cflag) {
    715 		yyinit(argc, argv);
    716 		yyparse();
    717 		exit(0);
    718 	}
    719 	if (lflag) {
    720 		*argv-- = LIBB;
    721 		argc++;
    722 	}
    723 	pipe(p);
    724 	if (fork()==0) {
    725 		close(1);
    726 		dup(p[1]);
    727 		close(p[0]);
    728 		close(p[1]);
    729 		yyinit(argc, argv);
    730 		yyparse();
    731 		exit(0);
    732 	}
    733 	close(0);
    734 	dup(p[0]);
    735 	close(p[0]);
    736 	close(p[1]);
    737 	execl(DC, "dc", "-", NULL);
    738 	execl("/usr/5bin/dc", "dc", "-", NULL);
    739 	execl("/usr/local/bin/dc", "dc", "-", NULL);
    740 	execl("/usr/contrib/bin/dc", "dc", "-", NULL);
    741 	execl("/usr/bin/dc", "dc", "-", NULL);
    742 	return(1);
    743 }