BSD 4_4_Lite2 development
authorCSRG <csrg@ucbvax.Berkeley.EDU>
Wed, 7 Apr 1993 21:35:39 +0000 (13:35 -0800)
committerCSRG <csrg@ucbvax.Berkeley.EDU>
Wed, 7 Apr 1993 21:35:39 +0000 (13:35 -0800)
Work on file usr/src/contrib/groff-1.08/pic/pic.y

Synthesized-from: CSRG/cd3/4.4BSD-Lite2

usr/src/contrib/groff-1.08/pic/pic.y [new file with mode: 0644]

diff --git a/usr/src/contrib/groff-1.08/pic/pic.y b/usr/src/contrib/groff-1.08/pic/pic.y
new file mode 100644 (file)
index 0000000..8c0405f
--- /dev/null
@@ -0,0 +1,1780 @@
+/* Copyright (C) 1989, 1990, 1991, 1992 Free Software Foundation, Inc.
+     Written by James Clark (jjc@jclark.com)
+
+This file is part of groff.
+
+groff is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 2, or (at your option) any later
+version.
+
+groff is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with groff; see the file COPYING.  If not, write to the Free Software
+Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+%{
+#include "pic.h"
+#include "ptable.h"
+#include "object.h"
+
+extern int delim_flag;
+extern void do_copy(const char *);
+extern void copy_rest_thru(const char *, const char *);
+extern void copy_file_thru(const char *, const char *, const char *);
+extern void push_body(const char *);
+extern void do_for(char *var, double from, double to,
+                  int by_is_multiplicative, double by, char *body);
+extern void do_lookahead();
+
+#undef fmod
+#undef rand
+
+extern "C" {
+  double fmod(double, double);
+  int rand();
+}
+
+/* Maximum number of characters produced by printf("%g") */
+#define GDIGITS 14
+
+int yylex();
+void yyerror(const char *);
+
+void reset(const char *nm);
+void reset_all();
+
+place *lookup_label(const char *);
+void define_label(const char *label, const place *pl);
+
+direction current_direction;
+position current_position;
+
+implement_ptable(place)
+
+PTABLE(place) top_table;
+
+PTABLE(place) *current_table = &top_table;
+saved_state *current_saved_state = 0;
+
+object_list olist;
+
+const char *ordinal_postfix(int n);
+const char *object_type_name(object_type type);
+char *format_number(const char *form, double n);
+char *do_sprintf(const char *form, const double *v, int nv);
+
+%}
+
+
+%union {
+       char *str;
+       int n;
+       double x;
+       struct { double x, y; } pair;
+       struct { double x; char *body; } if_data;
+       struct { char *str; const char *filename; int lineno; } lstr;
+       struct { double *v; int nv; int maxv; } dv;
+       struct { double val; int is_multiplicative; } by;
+       place pl;
+       object *obj;
+       corner crn;
+       path *pth;
+       object_spec *spec;
+       saved_state *pstate;
+       graphics_state state;
+       object_type obtype;
+}
+
+%token <str> LABEL
+%token <str> VARIABLE
+%token <x> NUMBER
+%token <lstr> TEXT
+%token <lstr> COMMAND_LINE
+%token <str> DELIMITED
+%token <n> ORDINAL
+%token TH
+%token LEFT_ARROW_HEAD
+%token RIGHT_ARROW_HEAD
+%token DOUBLE_ARROW_HEAD
+%token LAST
+%token UP
+%token DOWN
+%token LEFT
+%token RIGHT
+%token BOX
+%token CIRCLE
+%token ELLIPSE
+%token ARC
+%token LINE
+%token ARROW
+%token MOVE
+%token SPLINE
+%token HEIGHT
+%token RADIUS
+%token WIDTH
+%token DIAMETER
+%token UP
+%token DOWN
+%token RIGHT
+%token LEFT
+%token FROM
+%token TO
+%token AT
+%token WITH
+%token BY
+%token THEN
+%token DOTTED
+%token DASHED
+%token CHOP
+%token SAME
+%token INVISIBLE
+%token LJUST
+%token RJUST
+%token ABOVE
+%token BELOW
+%token OF
+%token THE
+%token WAY
+%token BETWEEN
+%token AND
+%token HERE
+%token DOT_N
+%token DOT_E   
+%token DOT_W
+%token DOT_S
+%token DOT_NE
+%token DOT_SE
+%token DOT_NW
+%token DOT_SW
+%token DOT_C
+%token DOT_START
+%token DOT_END
+%token DOT_X
+%token DOT_Y
+%token DOT_HT
+%token DOT_WID
+%token DOT_RAD
+%token SIN
+%token COS
+%token ATAN2
+%token LOG
+%token EXP
+%token SQRT
+%token K_MAX
+%token K_MIN
+%token INT
+%token RAND
+%token COPY
+%token THRU
+%token TOP
+%token BOTTOM
+%token UPPER
+%token LOWER
+%token SH
+%token PRINT
+%token CW
+%token CCW
+%token FOR
+%token DO
+%token IF
+%token ELSE
+%token ANDAND
+%token OROR
+%token NOTEQUAL
+%token EQUALEQUAL
+%token LESSEQUAL
+%token GREATEREQUAL
+%token LEFT_CORNER
+%token RIGHT_CORNER
+%token CENTER
+%token END
+%token START
+%token RESET
+%token UNTIL
+%token PLOT
+%token THICKNESS
+%token FILL
+%token ALIGNED
+%token SPRINTF
+%token COMMAND
+
+%token DEFINE
+%token UNDEF
+
+/* this ensures that plot 17 "%g" parses as (plot 17 "%g") */
+%left PLOT
+%left TEXT SPRINTF
+
+/* give text adjustments higher precedence than TEXT, so that
+box "foo" above ljust == box ("foo" above ljust)
+*/
+
+%left LJUST RJUST ABOVE BELOW
+
+%left LEFT RIGHT
+/* Give attributes that take an optional expression a higher
+precedence than left and right, so that eg `line chop left'
+parses properly. */
+%left CHOP DASHED DOTTED UP DOWN FILL
+%left LABEL
+
+%left VARIABLE NUMBER '(' SIN COS ATAN2 LOG EXP SQRT K_MAX K_MIN INT RAND LAST 
+%left ORDINAL HERE '`'
+
+/* these need to be lower than '-' */
+%left HEIGHT RADIUS WIDTH DIAMETER FROM TO AT THICKNESS
+
+/* these must have higher precedence than CHOP so that `label %prec CHOP'
+works */
+%left DOT_N DOT_E DOT_W DOT_S DOT_NE DOT_SE DOT_NW DOT_SW DOT_C
+%left DOT_START DOT_END TOP BOTTOM LEFT_CORNER RIGHT_CORNER
+%left UPPER LOWER CENTER START END
+
+%left ','
+%left OROR
+%left ANDAND
+%left EQUALEQUAL NOTEQUAL
+%left '<' '>' LESSEQUAL GREATEREQUAL
+
+%left BETWEEN OF
+%left AND
+
+%left '+' '-'
+%left '*' '/' '%'
+%right '!'
+%right '^'
+
+%type <x> expr any_expr text_expr
+%type <by> optional_by
+%type <pair> expr_pair position_not_place
+%type <if_data> simple_if
+%type <obj> nth_primitive
+%type <crn> corner
+%type <pth> path label_path relative_path
+%type <pl> place label element element_list middle_element_list
+%type <spec> object_spec
+%type <pair> position
+%type <obtype> object_type
+%type <n> optional_ordinal_last ordinal
+%type <str> until
+%type <dv> sprintf_args
+%type <lstr> text print_args print_arg
+
+%%
+
+top:
+       optional_separator
+       | element_list
+               {
+                 if (olist.head)
+                   print_picture(olist.head);
+               }
+       ;
+
+
+element_list:
+       optional_separator middle_element_list optional_separator
+               { $$ = $2; }
+       ;
+
+middle_element_list:
+       element
+               { $$ = $1; }
+       | middle_element_list separator element
+               { $$ = $1; }
+       ;
+
+optional_separator:
+       /* empty */
+       | separator
+       ;
+
+separator:
+       ';'
+       | separator ';'
+       ;
+
+placeless_element:
+       VARIABLE '=' any_expr
+               {
+                 define_variable($1, $3);
+                 a_delete $1;
+               }
+       | VARIABLE ':' '=' any_expr
+               {
+                 place *p = lookup_label($1);
+                 if (!p) {
+                   lex_error("variable `%1' not defined", $1);
+                   YYABORT;
+                 }
+                 p->obj = 0;
+                 p->x = $4;
+                 p->y = 0.0;
+                 a_delete $1;
+               }
+       | UP
+               { current_direction = UP_DIRECTION; }
+       | DOWN
+               { current_direction = DOWN_DIRECTION; }
+       | LEFT
+               { current_direction = LEFT_DIRECTION; }
+       | RIGHT
+               { current_direction = RIGHT_DIRECTION; }
+       | COMMAND_LINE
+               {
+                 olist.append(make_command_object($1.str, $1.filename,
+                                                  $1.lineno));
+               }
+       | COMMAND print_args
+               {
+                 olist.append(make_command_object($2.str, $2.filename,
+                                                  $2.lineno));
+               }
+       | PRINT print_args
+               {
+                 fprintf(stderr, "%s\n", $2.str);
+                 a_delete $2.str;
+                 fflush(stderr);
+               }
+       | SH
+               { delim_flag = 1; }
+         DELIMITED
+               {
+                 delim_flag = 0;
+                 system($3);
+                 a_delete $3;
+               }
+       | COPY TEXT
+               {
+                 if (yychar < 0)
+                   do_lookahead();
+                 do_copy($2.str);
+                 // do not delete the filename
+               }
+       | COPY TEXT THRU
+               { delim_flag = 2; }
+         DELIMITED 
+               { delim_flag = 0; }
+         until
+               {
+                 if (yychar < 0)
+                   do_lookahead();
+                 copy_file_thru($2.str, $5, $7);
+                 // do not delete the filename
+                 a_delete $5;
+                 a_delete $7;
+               }
+       | COPY THRU
+               { delim_flag = 2; }
+         DELIMITED
+               { delim_flag = 0; }
+         until
+               {
+                 if (yychar < 0)
+                   do_lookahead();
+                 copy_rest_thru($4, $6);
+                 a_delete $4;
+                 a_delete $6;
+               }
+       | FOR VARIABLE '=' expr TO expr optional_by DO
+               { delim_flag = 1; }
+         DELIMITED
+               {
+                 delim_flag = 0;
+                 if (yychar < 0)
+                   do_lookahead();
+                 do_for($2, $4, $6, $7.is_multiplicative, $7.val, $10); 
+               }
+       | simple_if
+               {
+                 if (yychar < 0)
+                   do_lookahead();
+                 if ($1.x != 0.0)
+                   push_body($1.body);
+                 a_delete $1.body;
+               }
+       | simple_if ELSE
+               { delim_flag = 1; }
+         DELIMITED
+               {
+                 delim_flag = 0;
+                 if (yychar < 0)
+                   do_lookahead();
+                 if ($1.x != 0.0)
+                   push_body($1.body);
+                 else
+                   push_body($4);
+                 a_delete $1.body;
+                 a_delete $4;
+               }
+       | reset_variables
+       | RESET
+               { define_variable("scale", 1.0); }
+       ;
+
+reset_variables:
+       RESET VARIABLE
+               { reset($2); a_delete $2; }
+       | reset_variables VARIABLE
+               { reset($2); a_delete $2; }
+       | reset_variables ',' VARIABLE
+               { reset($3); a_delete $3; }
+       ;
+
+print_args:
+       print_arg
+               { $$ = $1; }
+       | print_args print_arg
+               {
+                 $$.str = new char[strlen($1.str) + strlen($2.str) + 1];
+                 strcpy($$.str, $1.str);
+                 strcat($$.str, $2.str);
+                 a_delete $1.str;
+                 a_delete $2.str;
+                 if ($1.filename) {
+                   $$.filename = $1.filename;
+                   $$.lineno = $1.lineno;
+                 }
+                 else if ($2.filename) {
+                   $$.filename = $2.filename;
+                   $$.lineno = $2.lineno;
+                 }
+               }
+       ;
+
+print_arg:
+       expr               %prec ','
+               {
+                 $$.str = new char[GDIGITS + 1];
+                 sprintf($$.str, "%g", $1);
+                 $$.filename = 0;
+                 $$.lineno = 0;
+               }
+       | text
+               { $$ = $1; }
+       | position          %prec ','
+               {
+                 $$.str = new char[GDIGITS + 2 + GDIGITS + 1];
+                 sprintf($$.str, "%g, %g", $1.x, $1.y);
+                 $$.filename = 0;
+                 $$.lineno = 0;
+               }
+
+simple_if:
+       IF any_expr THEN
+               { delim_flag = 1; }
+       DELIMITED
+               { delim_flag = 0; $$.x = $2; $$.body = $5; }
+       ;
+
+until:
+       /* empty */
+               { $$ = 0; }
+       | UNTIL TEXT
+               { $$ = $2.str; }
+       ;
+       
+any_expr:
+       expr
+               { $$ = $1; }
+       | text_expr
+               { $$ = $1; }
+       ;
+       
+text_expr:
+       text EQUALEQUAL text
+               {
+                 $$ = strcmp($1.str, $3.str) == 0;
+                 a_delete $1.str;
+                 a_delete $3.str;
+               }
+       | text NOTEQUAL text
+               {
+                 $$ = strcmp($1.str, $3.str) != 0;
+                 a_delete $1.str;
+                 a_delete $3.str;
+               }
+       | text_expr ANDAND text_expr
+               { $$ = ($1 != 0.0 && $3 != 0.0); }
+       | text_expr ANDAND expr
+               { $$ = ($1 != 0.0 && $3 != 0.0); }
+       | expr ANDAND text_expr
+               { $$ = ($1 != 0.0 && $3 != 0.0); }
+       | text_expr OROR text_expr
+               { $$ = ($1 != 0.0 || $3 != 0.0); }
+       | text_expr OROR expr
+               { $$ = ($1 != 0.0 || $3 != 0.0); }
+       | expr OROR text_expr
+               { $$ = ($1 != 0.0 || $3 != 0.0); }
+       | '!' text_expr
+               { $$ = ($2 == 0.0); }
+       ;
+
+
+optional_by:
+       /* empty */
+               { $$.val = 1.0; $$.is_multiplicative = 0; }
+       | BY expr
+               { $$.val = $2; $$.is_multiplicative = 0; }
+       | BY '*' expr
+               { $$.val = $3; $$.is_multiplicative = 1; }
+       ;
+
+element:
+       object_spec
+               {
+                 $$.obj = $1->make_object(&current_position,
+                                          &current_direction);
+                 if ($$.obj == 0)
+                   YYABORT;
+                 delete $1;
+                 if ($$.obj)
+                   olist.append($$.obj);
+                 else {
+                   $$.x = current_position.x;
+                   $$.y = current_position.y;
+                 }
+               }
+       | LABEL ':' optional_separator element
+               { $$ = $4; define_label($1, & $$); a_delete $1; }
+       | LABEL ':' optional_separator position_not_place
+               {
+                 $$.obj = 0;
+                 $$.x = $4.x;
+                 $$.y = $4.y;
+                 define_label($1, & $$);
+                 a_delete $1;
+               }
+       | LABEL ':' optional_separator place
+               {
+                 $$ = $4;
+                 define_label($1, & $$);
+                 a_delete $1;
+               }
+       | '{'
+               {
+                 $<state>$.x = current_position.x;
+                 $<state>$.y = current_position.y;
+                 $<state>$.dir = current_direction;
+               }
+         element_list '}'
+               {
+                 current_position.x = $<state>2.x;
+                 current_position.y = $<state>2.y;
+                 current_direction = $<state>2.dir;
+               }
+         optional_element
+               {
+                 $$ = $3;
+               }
+       | placeless_element
+               {
+                 $$.obj = 0;
+                 $$.x = current_position.x;
+                 $$.y = current_position.y;
+               }
+       ;
+
+optional_element:
+       /* empty */
+               {}
+       | element
+               {}
+       ;
+
+object_spec:
+       BOX
+               {
+                 $$ = new object_spec(BOX_OBJECT);
+               }
+       | CIRCLE
+               {
+                 $$ = new object_spec(CIRCLE_OBJECT);
+               }
+       | ELLIPSE
+               {
+                 $$ = new object_spec(ELLIPSE_OBJECT);
+               }
+       | ARC
+               {
+                 $$ = new object_spec(ARC_OBJECT);
+                 $$->dir = current_direction;
+               }
+       | LINE
+               {
+                 $$ = new object_spec(LINE_OBJECT);
+                 lookup_variable("lineht", & $$->segment_height);
+                 lookup_variable("linewid", & $$->segment_width);
+                 $$->dir = current_direction;
+               }
+       | ARROW
+               {
+                 $$ = new object_spec(ARROW_OBJECT);
+                 lookup_variable("lineht", & $$->segment_height);
+                 lookup_variable("linewid", & $$->segment_width);
+                 $$->dir = current_direction;
+               }
+       | MOVE
+               {
+                 $$ = new object_spec(MOVE_OBJECT);
+                 lookup_variable("moveht", & $$->segment_height);
+                 lookup_variable("movewid", & $$->segment_width);
+                 $$->dir = current_direction;
+               }
+       | SPLINE
+               {
+                 $$ = new object_spec(SPLINE_OBJECT);
+                 lookup_variable("lineht", & $$->segment_height);
+                 lookup_variable("linewid", & $$->segment_width);
+                 $$->dir = current_direction;
+               }
+       | text   %prec TEXT
+               {
+                 $$ = new object_spec(TEXT_OBJECT);
+                 $$->text = new text_item($1.str, $1.filename, $1.lineno);
+               }
+       | PLOT expr
+               {
+                 $$ = new object_spec(TEXT_OBJECT);
+                 $$->text = new text_item(format_number(0, $2), 0, -1);
+               }
+       | PLOT expr text
+               {
+                 $$ = new object_spec(TEXT_OBJECT);
+                 $$->text = new text_item(format_number($3.str, $2),
+                                          $3.filename, $3.lineno);
+                 a_delete $3.str;
+               }
+       | '[' 
+               {
+                 saved_state *p = new saved_state;
+                 $<pstate>$ = p;
+                 p->x = current_position.x;
+                 p->y = current_position.y;
+                 p->dir = current_direction;
+                 p->tbl = current_table;
+                 p->prev = current_saved_state;
+                 current_position.x = 0.0;
+                 current_position.y = 0.0;
+                 current_table = new PTABLE(place);
+                 current_saved_state = p;
+                 olist.append(make_mark_object());
+               }
+         element_list ']'
+               {
+                 current_position.x = $<pstate>2->x;
+                 current_position.y = $<pstate>2->y;
+                 current_direction = $<pstate>2->dir;
+                 $$ = new object_spec(BLOCK_OBJECT);
+                 olist.wrap_up_block(& $$->oblist);
+                 $$->tbl = current_table;
+                 current_table = $<pstate>2->tbl;
+                 current_saved_state = $<pstate>2->prev;
+                 delete $<pstate>2;
+               }
+       | object_spec HEIGHT expr
+               {
+                 $$ = $1;
+                 $$->height = $3;
+                 $$->flags |= HAS_HEIGHT;
+               }
+       | object_spec RADIUS expr
+               {
+                 $$ = $1;
+                 $$->radius = $3;
+                 $$->flags |= HAS_RADIUS;
+               }
+       | object_spec WIDTH expr
+               {
+                 $$ = $1;
+                 $$->width = $3;
+                 $$->flags |= HAS_WIDTH;
+               }
+       | object_spec DIAMETER expr
+               {
+                 $$ = $1;
+                 $$->radius = $3/2.0;
+                 $$->flags |= HAS_RADIUS;
+               }
+       | object_spec expr %prec HEIGHT
+               {
+                 $$ = $1;
+                 $$->flags |= HAS_SEGMENT;
+                 switch ($$->dir) {
+                 case UP_DIRECTION:
+                   $$->segment_pos.y += $2;
+                   break;
+                 case DOWN_DIRECTION:
+                   $$->segment_pos.y -= $2;
+                   break;
+                 case RIGHT_DIRECTION:
+                   $$->segment_pos.x += $2;
+                   break;
+                 case LEFT_DIRECTION:
+                   $$->segment_pos.x -= $2;
+                   break;
+                 }
+               }
+       | object_spec UP
+               {
+                 $$ = $1;
+                 $$->dir = UP_DIRECTION;
+                 $$->flags |= HAS_SEGMENT;
+                 $$->segment_pos.y += $$->segment_height;
+               }
+       | object_spec UP expr
+               {
+                 $$ = $1;
+                 $$->dir = UP_DIRECTION;
+                 $$->flags |= HAS_SEGMENT;
+                 $$->segment_pos.y += $3;
+               }
+       | object_spec DOWN
+               {
+                 $$ = $1;
+                 $$->dir = DOWN_DIRECTION;
+                 $$->flags |= HAS_SEGMENT;
+                 $$->segment_pos.y -= $$->segment_height;
+               }
+       | object_spec DOWN expr
+               {
+                 $$ = $1;
+                 $$->dir = DOWN_DIRECTION;
+                 $$->flags |= HAS_SEGMENT;
+                 $$->segment_pos.y -= $3;
+               }
+       | object_spec RIGHT
+               {
+                 $$ = $1;
+                 $$->dir = RIGHT_DIRECTION;
+                 $$->flags |= HAS_SEGMENT;
+                 $$->segment_pos.x += $$->segment_width;
+               }
+       | object_spec RIGHT expr
+               {
+                 $$ = $1;
+                 $$->dir = RIGHT_DIRECTION;
+                 $$->flags |= HAS_SEGMENT;
+                 $$->segment_pos.x += $3;
+               }
+       | object_spec LEFT
+               {
+                 $$ = $1;
+                 $$->dir = LEFT_DIRECTION;
+                 $$->flags |= HAS_SEGMENT;
+                 $$->segment_pos.x -= $$->segment_width;
+               }
+       | object_spec LEFT expr
+               {
+                 $$ = $1;
+                 $$->dir = LEFT_DIRECTION;
+                 $$->flags |= HAS_SEGMENT;
+                 $$->segment_pos.x -= $3;
+               }
+       | object_spec FROM position
+               {
+                 $$ = $1;
+                 $$->flags |= HAS_FROM;
+                 $$->from.x = $3.x;
+                 $$->from.y = $3.y;
+               }
+       | object_spec TO position
+               {
+                 $$ = $1;
+                 if ($$->flags & HAS_SEGMENT)
+                   $$->segment_list = new segment($$->segment_pos,
+                                                  $$->segment_is_absolute,
+                                                  $$->segment_list);
+                 $$->flags |= HAS_SEGMENT;
+                 $$->segment_pos.x = $3.x;
+                 $$->segment_pos.y = $3.y;
+                 $$->segment_is_absolute = 1;
+                 $$->flags |= HAS_TO;
+                 $$->to.x = $3.x;
+                 $$->to.y = $3.y;
+               }
+       | object_spec AT position
+               {
+                 $$ = $1;
+                 $$->flags |= HAS_AT;
+                 $$->at.x = $3.x;
+                 $$->at.y = $3.y;
+                 if ($$->type != ARC_OBJECT) {
+                   $$->flags |= HAS_FROM;
+                   $$->from.x = $3.x;
+                   $$->from.y = $3.y;
+                 }
+               }
+       | object_spec WITH path
+               {
+                 $$ = $1;
+                 $$->flags |= HAS_WITH;
+                 $$->with = $3;
+               }
+       | object_spec BY expr_pair
+               {
+                 $$ = $1;
+                 $$->flags |= HAS_SEGMENT;
+                 $$->segment_pos.x += $3.x;
+                 $$->segment_pos.y += $3.y;
+               }
+       | object_spec THEN
+               {
+                 $$ = $1;
+                 if ($$->flags & HAS_SEGMENT) {
+                   $$->segment_list = new segment($$->segment_pos,
+                                                  $$->segment_is_absolute,
+                                                  $$->segment_list);
+                   $$->flags &= ~HAS_SEGMENT;
+                   $$->segment_pos.x = $$->segment_pos.y = 0.0;
+                   $$->segment_is_absolute = 0;
+                 }
+               }
+       | object_spec DOTTED
+               {
+                 $$ = $1;
+                 $$->flags |= IS_DOTTED;
+                 lookup_variable("dashwid", & $$->dash_width);
+               }
+       | object_spec DOTTED expr
+               {
+                 $$ = $1;
+                 $$->flags |= IS_DOTTED;
+                 $$->dash_width = $3;
+               }
+       | object_spec DASHED
+               {
+                 $$ = $1;
+                 $$->flags |= IS_DASHED;
+                 lookup_variable("dashwid", & $$->dash_width);
+               }
+       | object_spec DASHED expr
+               {
+                 $$ = $1;
+                 $$->flags |= IS_DASHED;
+                 $$->dash_width = $3;
+               }
+       | object_spec FILL
+               {
+                 $$ = $1;
+                 $$->flags |= IS_DEFAULT_FILLED;
+               }
+       | object_spec FILL expr
+               {
+                 $$ = $1;
+                 $$->flags |= IS_FILLED;
+                 $$->fill = $3;
+               }
+       | object_spec CHOP
+               {
+                 $$ = $1;
+                 // line chop chop means line chop 0 chop 0
+                 if ($$->flags & IS_DEFAULT_CHOPPED) {
+                   $$->flags |= IS_CHOPPED;
+                   $$->flags &= ~IS_DEFAULT_CHOPPED;
+                   $$->start_chop = $$->end_chop = 0.0;
+                 }
+                 else if ($$->flags & IS_CHOPPED) {
+                   $$->end_chop = 0.0;
+                 }
+                 else {
+                   $$->flags |= IS_DEFAULT_CHOPPED;
+                 }
+               }
+       | object_spec CHOP expr
+               {
+                 $$ = $1;
+                 if ($$->flags & IS_DEFAULT_CHOPPED) {
+                   $$->flags |= IS_CHOPPED;
+                   $$->flags &= ~IS_DEFAULT_CHOPPED;
+                   $$->start_chop = 0.0;
+                   $$->end_chop = $3;
+                 }
+                 else if ($$->flags & IS_CHOPPED) {
+                   $$->end_chop = $3;
+                 }
+                 else {
+                   $$->start_chop = $$->end_chop = $3;
+                   $$->flags |= IS_CHOPPED;
+                 }
+               }
+       | object_spec SAME
+               {
+                 $$ = $1;
+                 $$->flags |= IS_SAME;
+               }
+       | object_spec INVISIBLE
+               {
+                 $$ = $1;
+                 $$->flags |= IS_INVISIBLE;
+               }
+       | object_spec LEFT_ARROW_HEAD
+               {
+                 $$ = $1;
+                 $$->flags |= HAS_LEFT_ARROW_HEAD;
+               }
+       | object_spec RIGHT_ARROW_HEAD
+               {
+                 $$ = $1;
+                 $$->flags |= HAS_RIGHT_ARROW_HEAD;
+               }
+       | object_spec DOUBLE_ARROW_HEAD
+               {
+                 $$ = $1;
+                 $$->flags |= (HAS_LEFT_ARROW_HEAD|HAS_RIGHT_ARROW_HEAD);
+               }
+       | object_spec CW
+               {
+                 $$ = $1;
+                 $$->flags |= IS_CLOCKWISE;
+               }
+       | object_spec CCW
+               {
+                 $$ = $1;
+                 $$->flags &= ~IS_CLOCKWISE;
+               }
+       | object_spec text   %prec TEXT
+               {
+                 $$ = $1;
+                 for (text_item **p = & $$->text; *p; p = &(*p)->next)
+                   ;
+                 *p = new text_item($2.str, $2.filename, $2.lineno);
+               }
+       | object_spec LJUST
+               {
+                 $$ = $1;
+                 if ($$->text) {
+                   for (text_item *p = $$->text; p->next; p = p->next)
+                     ;
+                   p->adj.h = LEFT_ADJUST;
+                 }
+               }
+       | object_spec RJUST
+               {
+                 $$ = $1;
+                 if ($$->text) {
+                   for (text_item *p = $$->text; p->next; p = p->next)
+                     ;
+                   p->adj.h = RIGHT_ADJUST;
+                 }
+               }
+       | object_spec ABOVE
+               {
+                 $$ = $1;
+                 if ($$->text) {
+                   for (text_item *p = $$->text; p->next; p = p->next)
+                     ;
+                   p->adj.v = ABOVE_ADJUST;
+                 }
+               }
+       | object_spec BELOW
+               {
+                 $$ = $1;
+                 if ($$->text) {
+                   for (text_item *p = $$->text; p->next; p = p->next)
+                     ;
+                   p->adj.v = BELOW_ADJUST;
+                 }
+               }
+       | object_spec THICKNESS expr
+               {
+                 $$ = $1;
+                 $$->flags |= HAS_THICKNESS;
+                 $$->thickness = $3;
+               }
+       | object_spec ALIGNED
+               {
+                 $$ = $1;
+                 $$->flags |= IS_ALIGNED;
+               }
+       ;
+
+text:
+       TEXT
+               {
+                 $$ = $1;
+               }
+       | SPRINTF '(' TEXT sprintf_args ')'
+               {
+                 $$.filename = $3.filename;
+                 $$.lineno = $3.lineno;
+                 $$.str = do_sprintf($3.str, $4.v, $4.nv);
+                 a_delete $4.v;
+                 a_delete $3.str;
+               }
+       ;
+
+sprintf_args:
+       /* empty */
+               {
+                 $$.v = 0;
+                 $$.nv = 0;
+                 $$.maxv = 0;
+               }
+       | sprintf_args ',' expr
+               {
+                 $$ = $1;
+                 if ($$.nv >= $$.maxv) {
+                   if ($$.nv == 0) {
+                     $$.v = new double[4];
+                     $$.maxv = 4;
+                   }
+                   else {
+                     double *oldv = $$.v;
+                     $$.maxv *= 2;
+                     $$.v = new double[$$.maxv];
+                     memcpy($$.v, oldv, $$.nv*sizeof(double));
+                     a_delete oldv;
+                   }
+                 }
+                 $$.v[$$.nv] = $3;
+                 $$.nv += 1;
+               }
+       ;
+
+position:
+       position_not_place
+               { $$ = $1; }
+       | place
+               {
+                 position pos = $1;
+                 $$.x = pos.x;
+                 $$.y = pos.y;
+               }
+       ;
+
+position_not_place:
+       expr_pair
+               { $$ = $1; }
+       | position '+' expr_pair
+               {
+                 $$.x = $1.x + $3.x;
+                 $$.y = $1.y + $3.y;
+               }
+       | position '-' expr_pair
+               {
+                 $$.x = $1.x - $3.x;
+                 $$.y = $1.y - $3.y;
+               }
+       | '(' position ',' position ')'
+               {
+                 $$.x = $2.x;
+                 $$.y = $4.y;
+               }
+       | expr between position AND position
+               {
+                 $$.x = (1.0 - $1)*$3.x + $1*$5.x;
+                 $$.y = (1.0 - $1)*$3.y + $1*$5.y;
+               }
+       | expr '<' position ',' position '>'
+               {
+                 $$.x = (1.0 - $1)*$3.x + $1*$5.x;
+                 $$.y = (1.0 - $1)*$3.y + $1*$5.y;
+               }
+       ;
+
+between:
+       BETWEEN
+       | OF THE WAY BETWEEN
+       ;
+
+expr_pair:
+       expr ',' expr
+               { $$.x = $1; $$.y = $3; }
+       | '(' expr_pair ')'
+               { $$ = $2; }
+       ;
+
+place:
+       label  %prec CHOP /* line at A left == line (at A) left */
+               { $$ = $1; }
+       | label corner
+               {
+                 path pth($2);
+                 if (!pth.follow($1, & $$))
+                   YYABORT;
+               }
+       | corner label
+               {
+                 path pth($1);
+                 if (!pth.follow($2, & $$))
+                   YYABORT;
+               }
+       | corner OF label
+               {
+                 path pth($1);
+                 if (!pth.follow($3, & $$))
+                   YYABORT;
+               }
+       | HERE
+               {
+                 $$.x = current_position.x;
+                 $$.y = current_position.y;
+                 $$.obj = 0;
+               }
+       ;
+
+label:
+       LABEL
+               {
+                 place *p = lookup_label($1);
+                 if (!p) {
+                   lex_error("there is no place `%1'", $1);
+                   YYABORT;
+                 }
+                 $$ = *p;
+                 a_delete $1;
+               }
+       | nth_primitive
+               {
+                 $$.obj = $1;
+               }
+       | label '.' LABEL
+               {
+                 path pth($3);
+                 if (!pth.follow($1, & $$))
+                   YYABORT;
+               }
+       ;
+
+ordinal:
+       ORDINAL
+               { $$ = $1; }
+       | '`' any_expr TH
+               {
+                 // XXX Check for overflow (and non-integers?).
+                 $$ = (int)$2;
+               }
+       ;
+
+optional_ordinal_last:
+        LAST
+               { $$ = 1; }
+       | ordinal LAST
+               { $$ = $1; }
+       ;
+
+nth_primitive:
+       ordinal object_type
+               {
+                 int count = 0;
+                 for (object *p = olist.head; p != 0; p = p->next)
+                   if (p->type() == $2 && ++count == $1) {
+                     $$ = p;
+                     break;
+                   }
+                 if (p == 0) {
+                   lex_error("there is no %1%2 %3", $1, ordinal_postfix($1),
+                             object_type_name($2));
+                   YYABORT;
+                 }
+               }
+       | optional_ordinal_last object_type
+               {
+                 int count = 0;
+                 for (object *p = olist.tail; p != 0; p = p->prev)
+                   if (p->type() == $2 && ++count == $1) {
+                     $$ = p;
+                     break;
+                   }
+                 if (p == 0) {
+                   lex_error("there is no %1%2 last %3", $1,
+                             ordinal_postfix($1), object_type_name($2));
+                   YYABORT;
+                 }
+               }
+       ;
+
+object_type:
+       BOX
+               { $$ = BOX_OBJECT; }
+       | CIRCLE
+               { $$ = CIRCLE_OBJECT; }
+       | ELLIPSE
+               { $$ = ELLIPSE_OBJECT; }
+       | ARC
+               { $$ = ARC_OBJECT; }
+       | LINE
+               { $$ = LINE_OBJECT; }
+       | ARROW
+               { $$ = ARROW_OBJECT; }
+       | SPLINE
+               { $$ = SPLINE_OBJECT; }
+       | '[' ']'
+               { $$ = BLOCK_OBJECT; }
+       | TEXT
+               { $$ = TEXT_OBJECT; }
+       ;
+
+label_path:
+       '.' LABEL
+               {
+                 $$ = new path($2);
+               }
+       | label_path '.' LABEL
+               {
+                 $$ = $1;
+                 $$->append($3);
+               }
+       ;
+
+relative_path:
+       corner
+               {
+                 $$ = new path($1);
+               }
+       /* give this a lower precedence than LEFT and RIGHT so that
+          [A: box] with .A left == [A: box] with (.A left) */
+
+       | label_path %prec TEXT
+               {
+                 $$ = $1;
+               }
+       | label_path corner
+               {
+                 $$ = $1;
+                 $$->append($2);
+               }
+       ;
+
+path:
+       relative_path
+               {
+                 $$ = $1;
+               }
+       /* The rest of these rules are a compatibility sop. */
+       | ORDINAL LAST object_type relative_path
+               {
+                 lex_warning("`%1%2 last %3' in `with' argument ignored",
+                             $1, ordinal_postfix($1), object_type_name($3));
+                 $$ = $4;
+               }
+       | LAST object_type relative_path
+               {
+                 lex_warning("`last %1' in `with' argument ignored",
+                             object_type_name($2));
+                 $$ = $3;
+               }
+       | ORDINAL object_type relative_path
+               {
+                 lex_warning("`%1%2 %3' in `with' argument ignored",
+                             $1, ordinal_postfix($1), object_type_name($2));
+                 $$ = $3;
+               }
+       | LABEL relative_path
+               {
+                 lex_warning("initial `%1' in `with' argument ignored", $1);
+                 a_delete $1;
+                 $$ = $2;
+               }
+       ;
+
+corner:
+       DOT_N
+               { $$ = &object::north; }
+       | DOT_E 
+               { $$ = &object::east; }
+       | DOT_W
+               { $$ = &object::west; }
+       | DOT_S
+               { $$ = &object::south; }
+       | DOT_NE
+               { $$ = &object::north_east; }
+       | DOT_SE
+               { $$ = &object:: south_east; }
+       | DOT_NW
+               { $$ = &object::north_west; }
+       | DOT_SW
+               { $$ = &object::south_west; }
+       | DOT_C
+               { $$ = &object::center; }
+       | DOT_START
+               { $$ = &object::start; }
+       | DOT_END
+               { $$ = &object::end; }
+       | TOP
+               { $$ = &object::north; }
+       | BOTTOM
+               { $$ = &object::south; }
+       | LEFT
+               { $$ = &object::west; }
+       | RIGHT
+               { $$ = &object::east; }
+       | UPPER LEFT
+               { $$ = &object::north_west; }
+       | LOWER LEFT
+               { $$ = &object::south_west; }
+       | UPPER RIGHT
+               { $$ = &object::north_east; }
+       | LOWER RIGHT
+               { $$ = &object::south_east; }
+       | LEFT_CORNER
+               { $$ = &object::west; }
+       | RIGHT_CORNER
+               { $$ = &object::east; }
+       | UPPER LEFT_CORNER
+               { $$ = &object::north_west; }
+       | LOWER LEFT_CORNER
+               { $$ = &object::south_west; }
+       | UPPER RIGHT_CORNER
+               { $$ = &object::north_east; }
+       | LOWER RIGHT_CORNER
+               { $$ = &object::south_east; }
+       | CENTER
+               { $$ = &object::center; }
+       | START
+               { $$ = &object::start; }
+       | END
+               { $$ = &object::end; }
+       ;
+
+expr:
+       VARIABLE
+               {
+                 if (!lookup_variable($1, & $$)) {
+                   lex_error("there is no variable `%1'", $1);
+                   YYABORT;
+                 }
+                 a_delete $1;
+               }
+       | NUMBER
+               { $$ = $1; }
+       | place DOT_X
+               {
+                 if ($1.obj != 0)
+                   $$ = $1.obj->origin().x;
+                 else
+                   $$ = $1.x;
+               }                       
+       | place DOT_Y
+               {
+                 if ($1.obj != 0)
+                   $$ = $1.obj->origin().y;
+                 else
+                   $$ = $1.y;
+               }
+       | place DOT_HT
+               {
+                 if ($1.obj != 0)
+                   $$ = $1.obj->height();
+                 else
+                   $$ = 0.0;
+               }
+       | place DOT_WID
+               {
+                 if ($1.obj != 0)
+                   $$ = $1.obj->width();
+                 else
+                   $$ = 0.0;
+               }
+       | place DOT_RAD
+               {
+                 if ($1.obj != 0)
+                   $$ = $1.obj->radius();
+                 else
+                   $$ = 0.0;
+               }
+       | expr '+' expr
+               { $$ = $1 + $3; }
+       | expr '-' expr
+               { $$ = $1 - $3; }
+       | expr '*' expr
+               { $$ = $1 * $3; }
+       | expr '/' expr
+               {
+                 if ($3 == 0.0) {
+                   lex_error("division by zero");
+                   YYABORT;
+                 }
+                 $$ = $1/$3;
+               }
+       | expr '%' expr
+               {
+                 if ($3 == 0.0) {
+                   lex_error("modulus by zero");
+                   YYABORT;
+                 }
+                 $$ = fmod($1, $3);
+               }
+       | expr '^' expr
+               {
+                 errno = 0;
+                 $$ = pow($1, $3);
+                 if (errno == EDOM) {
+                   lex_error("arguments to `^' operator out of domain");
+                   YYABORT;
+                 }
+                 if (errno == ERANGE) {
+                   lex_error("result of `^' operator out of range");
+                   YYABORT;
+                 }
+               }
+       | '-' expr    %prec '!'
+               { $$ = -$2; }
+       | '(' any_expr ')'
+               { $$ = $2; }
+       | SIN '(' any_expr ')'
+               {
+                 errno = 0;
+                 $$ = sin($3);
+                 if (errno == ERANGE) {
+                   lex_error("sin result out of range");
+                   YYABORT;
+                 }
+               }
+       | COS '(' any_expr ')'
+               {
+                 errno = 0;
+                 $$ = cos($3);
+                 if (errno == ERANGE) {
+                   lex_error("cos result out of range");
+                   YYABORT;
+                 }
+               }
+       | ATAN2 '(' any_expr ',' any_expr ')'
+               {
+                 errno = 0;
+                 $$ = atan2($3, $5);
+                 if (errno == EDOM) {
+                   lex_error("atan2 argument out of domain");
+                   YYABORT;
+                 }
+                 if (errno == ERANGE) {
+                   lex_error("atan2 result out of range");
+                   YYABORT;
+                 }
+               }
+       | LOG '(' any_expr ')'
+               {
+                 errno = 0;
+                 $$ = log10($3);
+                 if (errno == ERANGE) {
+                   lex_error("log result out of range");
+                   YYABORT;
+                 }
+               }
+       | EXP '(' any_expr ')'
+               {
+                 errno = 0;
+                 $$ = pow(10.0, $3);
+                 if (errno == ERANGE) {
+                   lex_error("exp result out of range");
+                   YYABORT;
+                 }
+               }
+       | SQRT '(' any_expr ')'
+               {
+                 errno = 0;
+                 $$ = sqrt($3);
+                 if (errno == EDOM) {
+                   lex_error("sqrt argument out of domain");
+                   YYABORT;
+                 }
+               }
+       | K_MAX '(' any_expr ',' any_expr ')'
+               { $$ = $3 > $5 ? $3 : $5; }
+       | K_MIN '(' any_expr ',' any_expr ')'
+               { $$ = $3 < $5 ? $3 : $5; }
+       | INT '(' any_expr ')'
+               { $$ = floor($3); }
+       | RAND '(' any_expr ')'
+               { $$ = 1.0 + floor(((rand()&0x7fff)/double(0x7fff))*$3); }
+       | RAND '(' ')'
+               {
+                 /* return a random number in the range [0,1) */
+                 /* portable, but not very random */
+                 $$ = (rand() & 0x7fff) / double(0x8000);
+               }
+       | expr '<' expr
+               { $$ = ($1 < $3); }
+       | expr LESSEQUAL expr
+               { $$ = ($1 <= $3); }
+       | expr '>' expr
+               { $$ = ($1 > $3); }
+       | expr GREATEREQUAL expr
+               { $$ = ($1 >= $3); }
+       | expr EQUALEQUAL expr
+               { $$ = ($1 == $3); }
+       | expr NOTEQUAL expr
+               { $$ = ($1 != $3); }
+       | expr ANDAND expr
+               { $$ = ($1 != 0.0 && $3 != 0.0); }
+       | expr OROR expr
+               { $$ = ($1 != 0.0 || $3 != 0.0); }
+       | '!' expr
+               { $$ = ($2 == 0.0); }
+
+       ;
+
+%%
+
+/* bison defines const to be empty unless __STDC__ is defined, which it
+isn't under cfront */
+
+#ifdef const
+#undef const
+#endif
+
+static struct {
+  const char *name;
+  double val;
+  int scaled;               // non-zero if val should be multiplied by scale
+} defaults_table[] = {
+  "arcrad", .25, 1,
+  "arrowht", .1, 1,
+  "arrowwid", .05, 1,
+  "circlerad", .25, 1,
+  "boxht", .5, 1,
+  "boxwid", .75, 1,
+  "boxrad", 0.0, 1,
+  "dashwid", .05, 1,
+  "ellipseht", .5, 1,
+  "ellipsewid", .75, 1,
+  "moveht", .5, 1,
+  "movewid", .5, 1,
+  "lineht", .5, 1,
+  "linewid", .5, 1,
+  "textht", 0.0, 1,
+  "textwid", 0.0, 1,
+  "scale", 1.0, 0,
+  "linethick", -1.0, 0,                // in points
+  "fillval", .5, 0,
+  "arrowhead", 1.0, 0,
+  "maxpswid", 8.5, 0,
+  "maxpsht", 11.0, 0,
+};
+
+place *lookup_label(const char *label)
+{
+  saved_state *state = current_saved_state;
+  PTABLE(place) *tbl = current_table;
+  for (;;) {
+    place *pl = tbl->lookup(label);
+    if (pl)
+      return pl;
+    if (!state)
+      return 0;
+    tbl = state->tbl;
+    state = state->prev;
+  }
+}
+
+void define_label(const char *label, const place *pl)
+{
+  place *p = new place;
+  *p = *pl;
+  current_table->define(label, p);
+}
+
+int lookup_variable(const char *name, double *val)
+{
+  place *pl = lookup_label(name);
+  if (pl) {
+    *val = pl->x;
+    return 1;
+  }
+  return 0;
+}
+
+void define_variable(const char *name, double val)
+{
+  place *p = new place;
+  p->obj = 0;
+  p->x = val;
+  p->y = 0.0;
+  current_table->define(name, p);
+  if (strcmp(name, "scale") == 0) {
+    // When the scale changes, reset all scaled pre-defined variables to
+    // their default values.
+    for (int i = 0; i < sizeof(defaults_table)/sizeof(defaults_table[0]); i++) 
+      if (defaults_table[i].scaled)
+       define_variable(defaults_table[i].name, val*defaults_table[i].val);
+  }
+}
+
+// called once only (not once per parse)
+
+void parse_init()
+{
+  current_direction = RIGHT_DIRECTION;
+  current_position.x = 0.0;
+  current_position.y = 0.0;
+  // This resets everything to its default value.
+  reset_all();
+}
+
+void reset(const char *nm)
+{
+  for (int i = 0; i < sizeof(defaults_table)/sizeof(defaults_table[0]); i++)
+    if (strcmp(nm, defaults_table[i].name) == 0) {
+      double val = defaults_table[i].val;
+      if (defaults_table[i].scaled) {
+       double scale;
+       lookup_variable("scale", &scale);
+       val *= scale;
+      }
+      define_variable(defaults_table[i].name, val);
+      return;
+    }
+  lex_error("`%1' is not a predefined variable", nm);
+}
+
+void reset_all()
+{
+  // We only have to explicitly reset the pre-defined variables that
+  // aren't scaled because `scale' is not scaled, and changing the
+  // value of `scale' will reset all the pre-defined variables that
+  // are scaled.
+  for (int i = 0; i < sizeof(defaults_table)/sizeof(defaults_table[0]); i++)
+    if (!defaults_table[i].scaled)
+      define_variable(defaults_table[i].name, defaults_table[i].val);
+}
+
+// called after each parse
+
+void parse_cleanup()
+{
+  while (current_saved_state != 0) {
+    delete current_table;
+    current_table = current_saved_state->tbl;
+    saved_state *tem = current_saved_state;
+    current_saved_state = current_saved_state->prev;
+    delete tem;
+  }
+  assert(current_table == &top_table);
+  PTABLE_ITERATOR(place) iter(current_table);
+  const char *key;
+  place *pl;
+  while (iter.next(&key, &pl))
+    if (pl->obj != 0) {
+      position pos = pl->obj->origin();
+      pl->obj = 0;
+      pl->x = pos.x;
+      pl->y = pos.y;
+    }
+  while (olist.head != 0) {
+    object *tem = olist.head;
+    olist.head = olist.head->next;
+    delete tem;
+  }
+  olist.tail = 0;
+  current_direction = RIGHT_DIRECTION;
+  current_position.x = 0.0;
+  current_position.y = 0.0;
+}
+
+const char *ordinal_postfix(int n)
+{
+  if (n < 10 || n > 20)
+    switch (n % 10) {
+    case 1:
+      return "st";
+    case 2:
+      return "nd";
+    case 3:
+      return "rd";
+    }
+  return "th";
+}
+
+const char *object_type_name(object_type type)
+{
+  switch (type) {
+  case BOX_OBJECT:
+    return "box";
+  case CIRCLE_OBJECT:
+    return "circle";
+  case ELLIPSE_OBJECT:
+    return "ellipse";
+  case ARC_OBJECT:
+    return "arc";
+  case SPLINE_OBJECT:
+    return "spline";
+  case LINE_OBJECT:
+    return "line";
+  case ARROW_OBJECT:
+    return "arrow";
+  case MOVE_OBJECT:
+    return "move";
+  case TEXT_OBJECT:
+    return "\"\"";
+  case BLOCK_OBJECT:
+    return "[]";
+  case OTHER_OBJECT:
+  case MARK_OBJECT:
+  default:
+    break;
+  }
+  return "object";
+}
+
+static char sprintf_buf[1024];
+
+char *format_number(const char *form, double n)
+{
+  if (form == 0)
+    form = "%g";
+  else {
+    // this is a fairly feeble attempt at validation of the format
+    int nspecs = 0;
+    for (const char *p = form; *p != '\0'; p++)
+      if (*p == '%') {
+       if (p[1] == '%')
+         p++;
+       else
+         nspecs++;
+      }
+    if (nspecs > 1) {
+      lex_error("bad format `%1'", form);
+      return strsave(form);
+    }
+  }
+  sprintf(sprintf_buf, form, n);
+  return strsave(sprintf_buf);
+}
+
+char *do_sprintf(const char *form, const double *v, int nv)
+{
+  string result;
+  int i = 0;
+  string one_format;
+  while (*form) {
+    if (*form == '%') {
+      one_format += *form++;
+      for (; *form != '\0' && strchr("#-+ 0123456789.", *form) != 0; form++)
+       one_format += *form;
+      if (*form == '\0' || strchr("eEfgG%", *form) == 0) {
+       lex_error("bad sprintf format");
+       result += one_format;
+       result += form;
+       break;
+      }
+      if (*form == '%') {
+       one_format += *form++;
+       one_format += '\0';
+       sprintf(sprintf_buf, one_format.contents());
+      }
+      else {
+       if (i >= nv) {
+         lex_error("too few arguments to sprintf");
+         result += one_format;
+         result += form;
+         break;
+       }
+       one_format += *form++;
+       one_format += '\0';
+       sprintf(sprintf_buf, one_format.contents(), v[i++]);
+      }
+      one_format.clear();
+      result += sprintf_buf;
+    }
+    else
+      result += *form++;
+  }
+  result += '\0';
+  return strsave(result.contents());
+}