bfd/doc/chew.c

   1 /* chew
   2    Copyright 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1998, 2000, 2001,
   3    2002
   4    Free Software Foundation, Inc.
   5    Contributed by steve chamberlain @cygnus
   6
   7 This file is part of BFD, the Binary File Descriptor library.
   8
   9 This program is free software; you can redistribute it and/or modify
  10 it under the terms of the GNU General Public License as published by
  11 the Free Software Foundation; either version 2 of the License, or
  12 (at your option) any later version.
  13
  14 This program is distributed in the hope that it will be useful,
  15 but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 GNU General Public License for more details.
  18
  19 You should have received a copy of the GNU General Public License
  20 along with this program; if not, write to the Free Software
  21 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */
  22
  23 /* Yet another way of extracting documentation from source.
  24    No, I haven't finished it yet, but I hope you people like it better
  25    than the old way
  26
  27    sac
  28
  29    Basically, this is a sort of string forth, maybe we should call it
  30    struth?
  31
  32    You define new words thus:
  33    : <newword> <oldwords> ;
  34
  35 */
  36
  37 /* Primitives provided by the program:
  38
  39    Two stacks are provided, a string stack and an integer stack.
  40
  41    Internal state variables:
  42         internal_wanted - indicates whether `-i' was passed
  43         internal_mode - user-settable
  44
  45    Commands:
  46         push_text
  47         ! - pop top of integer stack for address, pop next for value; store
  48         @ - treat value on integer stack as the address of an integer; push
  49                 that integer on the integer stack after popping the "address"
  50         hello - print "hello\n" to stdout
  51         stdout - put stdout marker on TOS
  52         stderr - put stderr marker on TOS
  53         print - print TOS-1 on TOS (eg: "hello\n" stdout print)
  54         skip_past_newline
  55         catstr - fn icatstr
  56         copy_past_newline - append input, up to and including newline into TOS
  57         dup - fn other_dup
  58         drop - discard TOS
  59         idrop - ditto
  60         remchar - delete last character from TOS
  61         get_stuff_in_command
  62         do_fancy_stuff - translate <<foo>> to @code{foo} in TOS
  63         bulletize - if "o" lines found, prepend @itemize @bullet to TOS
  64                 and @item to each "o" line; append @end itemize
  65         courierize - put @example around . and | lines, translate {* *} { }
  66         exit - fn chew_exit
  67         swap
  68         outputdots - strip out lines without leading dots
  69         paramstuff - convert full declaration into "PARAMS" form if not already
  70         maybecatstr - do catstr if internal_mode == internal_wanted, discard
  71                 value in any case
  72         translatecomments - turn {* and *} into comment delimiters
  73         kill_bogus_lines - get rid of extra newlines
  74         indent
  75         internalmode - pop from integer stack, set `internalmode' to that value
  76         print_stack_level - print current stack depth to stderr
  77         strip_trailing_newlines - go ahead, guess...
  78         [quoted string] - push string onto string stack
  79         [word starting with digit] - push atol(str) onto integer stack
  80
  81    A command must be all upper-case, and alone on a line.
  82
  83    Foo.  */
  84
  85 #include "ansidecl.h"
  86 #include "sysdep.h"
  87 #include <assert.h>
  88 #include <stdio.h>
  89 #include <ctype.h>
  90
  91 #define DEF_SIZE 5000
  92 #define STACK 50
  93
  94 int internal_wanted;
  95 int internal_mode;
  96
  97 int warning;
  98
  99 /* Here is a string type ...  */
 100
 101 typedef struct buffer
 102 {
 103   char *ptr;
 104   unsigned long write_idx;
 105   unsigned long size;
 106 } string_type;
 107
 108 #ifdef __STDC__
 109 static void init_string_with_size (string_type *, unsigned int);
 110 static void init_string (string_type *);
 111 static int find (string_type *, char *);
 112 static void write_buffer (string_type *, FILE *);
 113 static void delete_string (string_type *);
 114 static char *addr (string_type *, unsigned int);
 115 static char at (string_type *, unsigned int);
 116 static void catchar (string_type *, int);
 117 static void overwrite_string (string_type *, string_type *);
 118 static void catbuf (string_type *, char *, unsigned int);
 119 static void cattext (string_type *, char *);
 120 static void catstr (string_type *, string_type *);
 121 #endif
 122
 123 static void
 124 init_string_with_size (buffer, size)
 125      string_type *buffer;
 126      unsigned int size;
 127 {
 128   buffer->write_idx = 0;
 129   buffer->size = size;
 130   buffer->ptr = malloc (size);
 131 }
 132
 133 static void
 134 init_string (buffer)
 135      string_type *buffer;
 136 {
 137   init_string_with_size (buffer, DEF_SIZE);
 138 }
 139
 140 static int
 141 find (str, what)
 142      string_type *str;
 143      char *what;
 144 {
 145   unsigned int i;
 146   char *p;
 147   p = what;
 148   for (i = 0; i < str->write_idx && *p; i++)
 149     {
 150       if (*p == str->ptr[i])
 151         p++;
 152       else
 153         p = what;
 154     }
 155   return (*p == 0);
 156 }
 157
 158 static void
 159 write_buffer (buffer, f)
 160      string_type *buffer;
 161      FILE *f;
 162 {
 163   fwrite (buffer->ptr, buffer->write_idx, 1, f);
 164 }
 165
 166 static void
 167 delete_string (buffer)
 168      string_type *buffer;
 169 {
 170   free (buffer->ptr);
 171 }
 172
 173 static char *
 174 addr (buffer, idx)
 175      string_type *buffer;
 176      unsigned int idx;
 177 {
 178   return buffer->ptr + idx;
 179 }
 180
 181 static char
 182 at (buffer, pos)
 183      string_type *buffer;
 184      unsigned int pos;
 185 {
 186   if (pos >= buffer->write_idx)
 187     return 0;
 188   return buffer->ptr[pos];
 189 }
 190
 191 static void
 192 catchar (buffer, ch)
 193      string_type *buffer;
 194      int ch;
 195 {
 196   if (buffer->write_idx == buffer->size)
 197     {
 198       buffer->size *= 2;
 199       buffer->ptr = realloc (buffer->ptr, buffer->size);
 200     }
 201
 202   buffer->ptr[buffer->write_idx++] = ch;
 203 }
 204
 205 static void
 206 overwrite_string (dst, src)
 207      string_type *dst;
 208      string_type *src;
 209 {
 210   free (dst->ptr);
 211   dst->size = src->size;
 212   dst->write_idx = src->write_idx;
 213   dst->ptr = src->ptr;
 214 }
 215
 216 static void
 217 catbuf (buffer, buf, len)
 218      string_type *buffer;
 219      char *buf;
 220      unsigned int len;
 221 {
 222   if (buffer->write_idx + len >= buffer->size)
 223     {
 224       while (buffer->write_idx + len >= buffer->size)
 225         buffer->size *= 2;
 226       buffer->ptr = realloc (buffer->ptr, buffer->size);
 227     }
 228   memcpy (buffer->ptr + buffer->write_idx, buf, len);
 229   buffer->write_idx += len;
 230 }
 231
 232 static void
 233 cattext (buffer, string)
 234      string_type *buffer;
 235      char *string;
 236 {
 237   catbuf (buffer, string, (unsigned int) strlen (string));
 238 }
 239
 240 static void
 241 catstr (dst, src)
 242      string_type *dst;
 243      string_type *src;
 244 {
 245   catbuf (dst, src->ptr, src->write_idx);
 246 }
 247
 248 static unsigned int
 249 skip_white_and_stars (src, idx)
 250      string_type *src;
 251      unsigned int idx;
 252 {
 253   char c;
 254   while ((c = at (src, idx)),
 255          isspace ((unsigned char) c)
 256          || (c == '*'
 257              /* Don't skip past end-of-comment or star as first
 258                 character on its line.  */
 259              && at (src, idx +1) != '/'
 260              && at (src, idx -1) != '\n'))
 261     idx++;
 262   return idx;
 263 }
 264
 265 /***********************************************************************/
 266
 267 string_type stack[STACK];
 268 string_type *tos;
 269
 270 unsigned int idx = 0; /* Pos in input buffer */
 271 string_type *ptr; /* and the buffer */
 272 typedef void (*stinst_type)();
 273 stinst_type *pc;
 274 stinst_type sstack[STACK];
 275 stinst_type *ssp = &sstack[0];
 276 long istack[STACK];
 277 long *isp = &istack[0];
 278
 279 typedef int *word_type;
 280
 281 struct dict_struct
 282 {
 283   char *word;
 284   struct dict_struct *next;
 285   stinst_type *code;
 286   int code_length;
 287   int code_end;
 288   int var;
 289 };
 290
 291 typedef struct dict_struct dict_type;
 292
 293 static void
 294 die (msg)
 295      char *msg;
 296 {
 297   fprintf (stderr, "%s\n", msg);
 298   exit (1);
 299 }
 300
 301 static void
 302 check_range ()
 303 {
 304   if (tos < stack)
 305     die ("underflow in string stack");
 306   if (tos >= stack + STACK)
 307     die ("overflow in string stack");
 308 }
 309
 310 static void
 311 icheck_range ()
 312 {
 313   if (isp < istack)
 314     die ("underflow in integer stack");
 315   if (isp >= istack + STACK)
 316     die ("overflow in integer stack");
 317 }
 318
 319 #ifdef __STDC__
 320 static void exec (dict_type *);
 321 static void call (void);
 322 static void remchar (void), strip_trailing_newlines (void), push_number (void);
 323 static void push_text (void);
 324 static void remove_noncomments (string_type *, string_type *);
 325 static void print_stack_level (void);
 326 static void paramstuff (void), translatecomments (void);
 327 static void outputdots (void), courierize (void), bulletize (void);
 328 static void do_fancy_stuff (void);
 329 static int iscommand (string_type *, unsigned int);
 330 static int copy_past_newline (string_type *, unsigned int, string_type *);
 331 static void icopy_past_newline (void), kill_bogus_lines (void), indent (void);
 332 static void get_stuff_in_command (void), swap (void), other_dup (void);
 333 static void drop (void), idrop (void);
 334 static void icatstr (void), skip_past_newline (void), internalmode (void);
 335 static void maybecatstr (void);
 336 static char *nextword (char *, char **);
 337 dict_type *lookup_word (char *);
 338 static void perform (void);
 339 dict_type *newentry (char *);
 340 unsigned int add_to_definition (dict_type *, stinst_type);
 341 void add_intrinsic (char *, void (*)());
 342 void add_var (char *);
 343 void compile (char *);
 344 static void bang (void);
 345 static void atsign (void);
 346 static void hello (void);
 347 static void stdout_ (void);
 348 static void stderr_ (void);
 349 static void print (void);
 350 static void read_in (string_type *, FILE *);
 351 static void usage (void);
 352 static void chew_exit (void);
 353 #endif
 354
 355 static void
 356 exec (word)
 357      dict_type *word;
 358 {
 359   pc = word->code;
 360   while (*pc)
 361     (*pc) ();
 362 }
 363
 364 static void
 365 call ()
 366 {
 367   stinst_type *oldpc = pc;
 368   dict_type *e;
 369   e = (dict_type *) (pc[1]);
 370   exec (e);
 371   pc = oldpc + 2;
 372 }
 373
 374 static void
 375 remchar ()
 376 {
 377   if (tos->write_idx)
 378     tos->write_idx--;
 379   pc++;
 380 }
 381
 382 static void
 383 strip_trailing_newlines ()
 384 {
 385   while ((isspace ((unsigned char) at (tos, tos->write_idx - 1))
 386           || at (tos, tos->write_idx - 1) == '\n')
 387          && tos->write_idx > 0)
 388     tos->write_idx--;
 389   pc++;
 390 }
 391
 392 static void
 393 push_number ()
 394 {
 395   isp++;
 396   icheck_range ();
 397   pc++;
 398   *isp = (long) (*pc);
 399   pc++;
 400 }
 401
 402 static void
 403 push_text ()
 404 {
 405   tos++;
 406   check_range ();
 407   init_string (tos);
 408   pc++;
 409   cattext (tos, *((char **) pc));
 410   pc++;
 411 }
 412
 413 /* This function removes everything not inside comments starting on
 414    the first char of the line from the  string, also when copying
 415    comments, removes blank space and leading *'s.
 416    Blank lines are turned into one blank line.  */
 417
 418 static void
 419 remove_noncomments (src, dst)
 420      string_type *src;
 421      string_type *dst;
 422 {
 423   unsigned int idx = 0;
 424
 425   while (at (src, idx))
 426     {
 427       /* Now see if we have a comment at the start of the line.  */
 428       if (at (src, idx) == '\n'
 429           && at (src, idx + 1) == '/'
 430           && at (src, idx + 2) == '*')
 431         {
 432           idx += 3;
 433
 434           idx = skip_white_and_stars (src, idx);
 435
 436           /* Remove leading dot */
 437           if (at (src, idx) == '.')
 438             idx++;
 439
 440           /* Copy to the end of the line, or till the end of the
 441              comment.  */
 442           while (at (src, idx))
 443             {
 444               if (at (src, idx) == '\n')
 445                 {
 446                   /* end of line, echo and scrape of leading blanks  */
 447                   if (at (src, idx + 1) == '\n')
 448                     catchar (dst, '\n');
 449                   catchar (dst, '\n');
 450                   idx++;
 451                   idx = skip_white_and_stars (src, idx);
 452                 }
 453               else if (at (src, idx) == '*' && at (src, idx + 1) == '/')
 454                 {
 455                   idx += 2;
 456                   cattext (dst, "\nENDDD\n");
 457                   break;
 458                 }
 459               else
 460                 {
 461                   catchar (dst, at (src, idx));
 462                   idx++;
 463                 }
 464             }
 465         }
 466       else
 467         idx++;
 468     }
 469 }
 470
 471 static void
 472 print_stack_level ()
 473 {
 474   fprintf (stderr, "current string stack depth = %d, ", tos - stack);
 475   fprintf (stderr, "current integer stack depth = %d\n", isp - istack);
 476   pc++;
 477 }
 478
 479 /* turn:
 480      foobar name(stuff);
 481    into:
 482      foobar
 483      name PARAMS ((stuff));
 484    and a blank line.
 485  */
 486
 487 static void
 488 paramstuff ()
 489 {
 490   unsigned int openp;
 491   unsigned int fname;
 492   unsigned int idx;
 493   unsigned int len;
 494   string_type out;
 495   init_string (&out);
 496
 497   /* Make sure that it's not already param'd or proto'd.  */
 498   if (find (tos, "PARAMS") || find (tos, "PROTO") || !find (tos, "("))
 499     {
 500       catstr (&out, tos);
 501     }
 502   else
 503     {
 504       /* Find the open paren.  */
 505       for (openp = 0; at (tos, openp) != '(' && at (tos, openp); openp++)
 506         ;
 507
 508       fname = openp;
 509       /* Step back to the fname.  */
 510       fname--;
 511       while (fname && isspace ((unsigned char) at (tos, fname)))
 512         fname--;
 513       while (fname
 514              && !isspace ((unsigned char) at (tos,fname))
 515              && at (tos,fname) != '*')
 516         fname--;
 517
 518       fname++;
 519
 520       /* Output type, omitting trailing whitespace character(s), if
 521          any.  */
 522       for (len = fname; 0 < len; len--)
 523         {
 524           if (!isspace ((unsigned char) at (tos, len - 1)))
 525             break;
 526         }
 527       for (idx = 0; idx < len; idx++)
 528         catchar (&out, at (tos, idx));
 529
 530       cattext (&out, "\n");     /* Insert a newline between type and fnname */
 531
 532       /* Output function name, omitting trailing whitespace
 533          character(s), if any.  */
 534       for (len = openp; 0 < len; len--)
 535         {
 536           if (!isspace ((unsigned char) at (tos, len - 1)))
 537             break;
 538         }
 539       for (idx = fname; idx < len; idx++)
 540         catchar (&out, at (tos, idx));
 541
 542       cattext (&out, " PARAMS (");
 543
 544       for (idx = openp; at (tos, idx) && at (tos, idx) != ';'; idx++)
 545         catchar (&out, at (tos, idx));
 546
 547       cattext (&out, ");\n\n");
 548     }
 549   overwrite_string (tos, &out);
 550   pc++;
 551
 552 }
 553
 554 /* turn {*
 555    and *} into comments */
 556
 557 static void
 558 translatecomments ()
 559 {
 560   unsigned int idx = 0;
 561   string_type out;
 562   init_string (&out);
 563
 564   while (at (tos, idx))
 565     {
 566       if (at (tos, idx) == '{' && at (tos, idx + 1) == '*')
 567         {
 568           cattext (&out, "/*");
 569           idx += 2;
 570         }
 571       else if (at (tos, idx) == '*' && at (tos, idx + 1) == '}')
 572         {
 573           cattext (&out, "*/");
 574           idx += 2;
 575         }
 576       else
 577         {
 578           catchar (&out, at (tos, idx));
 579           idx++;
 580         }
 581     }
 582
 583   overwrite_string (tos, &out);
 584
 585   pc++;
 586 }
 587
 588 #if 0
 589
 590 /* This is not currently used.  */
 591
 592 /* turn everything not starting with a . into a comment */
 593
 594 static void
 595 manglecomments ()
 596 {
 597   unsigned int idx = 0;
 598   string_type out;
 599   init_string (&out);
 600
 601   while (at (tos, idx))
 602     {
 603       if (at (tos, idx) == '\n' && at (tos, idx + 1) == '*')
 604         {
 605           cattext (&out, "      /*");
 606           idx += 2;
 607         }
 608       else if (at (tos, idx) == '*' && at (tos, idx + 1) == '}')
 609         {
 610           cattext (&out, "*/");
 611           idx += 2;
 612         }
 613       else
 614         {
 615           catchar (&out, at (tos, idx));
 616           idx++;
 617         }
 618     }
 619
 620   overwrite_string (tos, &out);
 621
 622   pc++;
 623 }
 624
 625 #endif
 626
 627 /* Mod tos so that only lines with leading dots remain */
 628 static void
 629 outputdots ()
 630 {
 631   unsigned int idx = 0;
 632   string_type out;
 633   init_string (&out);
 634
 635   while (at (tos, idx))
 636     {
 637       if (at (tos, idx) == '\n' && at (tos, idx + 1) == '.')
 638         {
 639           char c;
 640           idx += 2;
 641
 642           while ((c = at (tos, idx)) && c != '\n')
 643             {
 644               if (c == '{' && at (tos, idx + 1) == '*')
 645                 {
 646                   cattext (&out, "/*");
 647                   idx += 2;
 648                 }
 649               else if (c == '*' && at (tos, idx + 1) == '}')
 650                 {
 651                   cattext (&out, "*/");
 652                   idx += 2;
 653                 }
 654               else
 655                 {
 656                   catchar (&out, c);
 657                   idx++;
 658                 }
 659             }
 660           catchar (&out, '\n');
 661         }
 662       else
 663         {
 664           idx++;
 665         }
 666     }
 667
 668   overwrite_string (tos, &out);
 669   pc++;
 670 }
 671
 672 /* Find lines starting with . and | and put example around them on tos */
 673 static void
 674 courierize ()
 675 {
 676   string_type out;
 677   unsigned int idx = 0;
 678   int command = 0;
 679
 680   init_string (&out);
 681
 682   while (at (tos, idx))
 683     {
 684       if (at (tos, idx) == '\n'
 685           && (at (tos, idx +1 ) == '.'
 686               || at (tos, idx + 1) == '|'))
 687         {
 688           cattext (&out, "\n@example\n");
 689           do
 690             {
 691               idx += 2;
 692
 693               while (at (tos, idx) && at (tos, idx) != '\n')
 694                 {
 695                   if (command > 1)
 696                     {
 697                       /* We are inside {} parameters of some command;
 698                          Just pass through until matching brace.  */
 699                       if (at (tos, idx) == '{')
 700                         ++command;
 701                       else if (at (tos, idx) == '}')
 702                         --command;
 703                     }
 704                   else if (command != 0)
 705                     {
 706                       if (at (tos, idx) == '{')
 707                         ++command;
 708                       else if (!islower ((unsigned char) at (tos, idx)))
 709                         --command;
 710                     }
 711                   else if (at (tos, idx) == '@'
 712                            && islower ((unsigned char) at (tos, idx + 1)))
 713                     {
 714                       ++command;
 715                     }
 716                   else if (at (tos, idx) == '{' && at (tos, idx + 1) == '*')
 717                     {
 718                       cattext (&out, "/*");
 719                       idx += 2;
 720                       continue;
 721                     }
 722                   else if (at (tos, idx) == '*' && at (tos, idx + 1) == '}')
 723                     {
 724                       cattext (&out, "*/");
 725                       idx += 2;
 726                       continue;
 727                     }
 728                   else if (at (tos, idx) == '{'
 729                            || at (tos, idx) == '}')
 730                     {
 731                       catchar (&out, '@');
 732                     }
 733
 734                   catchar (&out, at (tos, idx));
 735                   idx++;
 736                 }
 737               catchar (&out, '\n');
 738             }
 739           while (at (tos, idx) == '\n'
 740                  && ((at (tos, idx + 1) == '.')
 741                      || (at (tos, idx + 1) == '|')))
 742             ;
 743           cattext (&out, "@end example");
 744         }
 745       else
 746         {
 747           catchar (&out, at (tos, idx));
 748           idx++;
 749         }
 750     }
 751
 752   overwrite_string (tos, &out);
 753   pc++;
 754 }
 755
 756 /* Finds any lines starting with "o ", if there are any, then turns
 757    on @itemize @bullet, and @items each of them. Then ends with @end
 758    itemize, inplace at TOS*/
 759
 760 static void
 761 bulletize ()
 762 {
 763   unsigned int idx = 0;
 764   int on = 0;
 765   string_type out;
 766   init_string (&out);
 767
 768   while (at (tos, idx))
 769     {
 770       if (at (tos, idx) == '@'
 771           && at (tos, idx + 1) == '*')
 772         {
 773           cattext (&out, "*");
 774           idx += 2;
 775         }
 776       else if (at (tos, idx) == '\n'
 777                && at (tos, idx + 1) == 'o'
 778                && isspace ((unsigned char) at (tos, idx + 2)))
 779         {
 780           if (!on)
 781             {
 782               cattext (&out, "\n@itemize @bullet\n");
 783               on = 1;
 784
 785             }
 786           cattext (&out, "\n@item\n");
 787           idx += 3;
 788         }
 789       else
 790         {
 791           catchar (&out, at (tos, idx));
 792           if (on && at (tos, idx) == '\n'
 793               && at (tos, idx + 1) == '\n'
 794               && at (tos, idx + 2) != 'o')
 795             {
 796               cattext (&out, "@end itemize");
 797               on = 0;
 798             }
 799           idx++;
 800
 801         }
 802     }
 803   if (on)
 804     {
 805       cattext (&out, "@end itemize\n");
 806     }
 807
 808   delete_string (tos);
 809   *tos = out;
 810   pc++;
 811 }
 812
 813 /* Turn <<foo>> into @code{foo} in place at TOS*/
 814
 815 static void
 816 do_fancy_stuff ()
 817 {
 818   unsigned int idx = 0;
 819   string_type out;
 820   init_string (&out);
 821   while (at (tos, idx))
 822     {
 823       if (at (tos, idx) == '<'
 824           && at (tos, idx + 1) == '<'
 825           && !isspace ((unsigned char) at (tos, idx + 2)))
 826         {
 827           /* This qualifies as a << startup.  */
 828           idx += 2;
 829           cattext (&out, "@code{");
 830           while (at (tos, idx)
 831                  && at (tos, idx) != '>' )
 832             {
 833               catchar (&out, at (tos, idx));
 834               idx++;
 835
 836             }
 837           cattext (&out, "}");
 838           idx += 2;
 839         }
 840       else
 841         {
 842           catchar (&out, at (tos, idx));
 843           idx++;
 844         }
 845     }
 846   delete_string (tos);
 847   *tos = out;
 848   pc++;
 849
 850 }
 851
 852 /* A command is all upper case,and alone on a line.  */
 853
 854 static int
 855 iscommand (ptr, idx)
 856      string_type *ptr;
 857      unsigned int idx;
 858 {
 859   unsigned int len = 0;
 860   while (at (ptr, idx))
 861     {
 862       if (isupper ((unsigned char) at (ptr, idx))
 863           || at (ptr, idx) == ' ' || at (ptr, idx) == '_')
 864         {
 865           len++;
 866           idx++;
 867         }
 868       else if (at (ptr, idx) == '\n')
 869         {
 870           if (len > 3)
 871             return 1;
 872           return 0;
 873         }
 874       else
 875         return 0;
 876     }
 877   return 0;
 878 }
 879
 880 static int
 881 copy_past_newline (ptr, idx, dst)
 882      string_type *ptr;
 883      unsigned int idx;
 884      string_type *dst;
 885 {
 886   int column = 0;
 887
 888   while (at (ptr, idx) && at (ptr, idx) != '\n')
 889     {
 890       if (at (ptr, idx) == '\t')
 891         {
 892           /* Expand tabs.  Neither makeinfo nor TeX can cope well with
 893              them.  */
 894           do
 895             catchar (dst, ' ');
 896           while (++column & 7);
 897         }
 898       else
 899         {
 900           catchar (dst, at (ptr, idx));
 901           column++;
 902         }
 903       idx++;
 904
 905     }
 906   catchar (dst, at (ptr, idx));
 907   idx++;
 908   return idx;
 909
 910 }
 911
 912 static void
 913 icopy_past_newline ()
 914 {
 915   tos++;
 916   check_range ();
 917   init_string (tos);
 918   idx = copy_past_newline (ptr, idx, tos);
 919   pc++;
 920 }
 921
 922 /* indent
 923    Take the string at the top of the stack, do some prettying.  */
 924
 925 static void
 926 kill_bogus_lines ()
 927 {
 928   int sl;
 929
 930   int idx = 0;
 931   int c;
 932   int dot = 0;
 933
 934   string_type out;
 935   init_string (&out);
 936   /* Drop leading nl.  */
 937   while (at (tos, idx) == '\n')
 938     {
 939       idx++;
 940     }
 941   c = idx;
 942
 943   /* If the first char is a '.' prepend a newline so that it is
 944      recognized properly later.  */
 945   if (at (tos, idx) == '.')
 946     catchar (&out, '\n');
 947
 948   /* Find the last char.  */
 949   while (at (tos, idx))
 950     {
 951       idx++;
 952     }
 953
 954   /* Find the last non white before the nl.  */
 955   idx--;
 956
 957   while (idx && isspace ((unsigned char) at (tos, idx)))
 958     idx--;
 959   idx++;
 960
 961   /* Copy buffer upto last char, but blank lines before and after
 962      dots don't count.  */
 963   sl = 1;
 964
 965   while (c < idx)
 966     {
 967       if (at (tos, c) == '\n'
 968           && at (tos, c + 1) == '\n'
 969           && at (tos, c + 2) == '.')
 970         {
 971           /* Ignore two newlines before a dot.  */
 972           c++;
 973         }
 974       else if (at (tos, c) == '.' && sl)
 975         {
 976           /* remember that this line started with a dot.  */
 977           dot = 2;
 978         }
 979       else if (at (tos, c) == '\n'
 980                && at (tos, c + 1) == '\n'
 981                && dot)
 982         {
 983           c++;
 984           /* Ignore two newlines when last line was dot.  */
 985         }
 986
 987       catchar (&out, at (tos, c));
 988       if (at (tos, c) == '\n')
 989         {
 990           sl = 1;
 991
 992           if (dot == 2)
 993             dot = 1;
 994           else
 995             dot = 0;
 996         }
 997       else
 998         sl = 0;
 999
1000       c++;
1001
1002     }
1003
1004   /* Append nl.  */
1005   catchar (&out, '\n');
1006   pc++;
1007   delete_string (tos);
1008   *tos = out;
1009
1010 }
1011
1012 static void
1013 indent ()
1014 {
1015   string_type out;
1016   int tab = 0;
1017   int idx = 0;
1018   int ol = 0;
1019   init_string (&out);
1020   while (at (tos, idx))
1021     {
1022       switch (at (tos, idx))
1023         {
1024         case '\n':
1025           cattext (&out, "\n");
1026           idx++;
1027           if (tab && at (tos, idx))
1028             {
1029               cattext (&out, "    ");
1030             }
1031           ol = 0;
1032           break;
1033         case '(':
1034           tab++;
1035           if (ol == 0)
1036             cattext (&out, "   ");
1037           idx++;
1038           cattext (&out, "(");
1039           ol = 1;
1040           break;
1041         case ')':
1042           tab--;
1043           cattext (&out, ")");
1044           idx++;
1045           ol = 1;
1046
1047           break;
1048         default:
1049           catchar (&out, at (tos, idx));
1050           ol = 1;
1051
1052           idx++;
1053           break;
1054         }
1055     }
1056
1057   pc++;
1058   delete_string (tos);
1059   *tos = out;
1060
1061 }
1062
1063 static void
1064 get_stuff_in_command ()
1065 {
1066   tos++;
1067   check_range ();
1068   init_string (tos);
1069
1070   while (at (ptr, idx))
1071     {
1072       if (iscommand (ptr, idx))
1073         break;
1074       idx = copy_past_newline (ptr, idx, tos);
1075     }
1076   pc++;
1077 }
1078
1079 static void
1080 swap ()
1081 {
1082   string_type t;
1083
1084   t = tos[0];
1085   tos[0] = tos[-1];
1086   tos[-1] = t;
1087   pc++;
1088 }
1089
1090 static void
1091 other_dup ()
1092 {
1093   tos++;
1094   check_range ();
1095   init_string (tos);
1096   catstr (tos, tos - 1);
1097   pc++;
1098 }
1099
1100 static void
1101 drop ()
1102 {
1103   tos--;
1104   check_range ();
1105   pc++;
1106 }
1107
1108 static void
1109 idrop ()
1110 {
1111   isp--;
1112   icheck_range ();
1113   pc++;
1114 }
1115
1116 static void
1117 icatstr ()
1118 {
1119   tos--;
1120   check_range ();
1121   catstr (tos, tos + 1);
1122   delete_string (tos + 1);
1123   pc++;
1124 }
1125
1126 static void
1127 skip_past_newline ()
1128 {
1129   while (at (ptr, idx)
1130          && at (ptr, idx) != '\n')
1131     idx++;
1132   idx++;
1133   pc++;
1134 }
1135
1136 static void
1137 internalmode ()
1138 {
1139   internal_mode = *(isp);
1140   isp--;
1141   icheck_range ();
1142   pc++;
1143 }
1144
1145 static void
1146 maybecatstr ()
1147 {
1148   if (internal_wanted == internal_mode)
1149     {
1150       catstr (tos - 1, tos);
1151     }
1152   delete_string (tos);
1153   tos--;
1154   check_range ();
1155   pc++;
1156 }
1157
1158 char *
1159 nextword (string, word)
1160      char *string;
1161      char **word;
1162 {
1163   char *word_start;
1164   int idx;
1165   char *dst;
1166   char *src;
1167
1168   int length = 0;
1169
1170   while (isspace ((unsigned char) *string) || *string == '-')
1171     {
1172       if (*string == '-')
1173         {
1174           while (*string && *string != '\n')
1175             string++;
1176
1177         }
1178       else
1179         {
1180           string++;
1181         }
1182     }
1183   if (!*string)
1184     return 0;
1185
1186   word_start = string;
1187   if (*string == '"')
1188     {
1189       do
1190         {
1191           string++;
1192           length++;
1193           if (*string == '\\')
1194             {
1195               string += 2;
1196               length += 2;
1197             }
1198         }
1199       while (*string != '"');
1200     }
1201   else
1202     {
1203       while (!isspace ((unsigned char) *string))
1204         {
1205           string++;
1206           length++;
1207
1208         }
1209     }
1210
1211   *word = malloc (length + 1);
1212
1213   dst = *word;
1214   src = word_start;
1215
1216   for (idx = 0; idx < length; idx++)
1217     {
1218       if (src[idx] == '\\')
1219         switch (src[idx + 1])
1220           {
1221           case 'n':
1222             *dst++ = '\n';
1223             idx++;
1224             break;
1225           case '"':
1226           case '\\':
1227             *dst++ = src[idx + 1];
1228             idx++;
1229             break;
1230           default:
1231             *dst++ = '\\';
1232             break;
1233           }
1234       else
1235         *dst++ = src[idx];
1236     }
1237   *dst++ = 0;
1238
1239   if (*string)
1240     return string + 1;
1241   else
1242     return 0;
1243 }
1244
1245 dict_type *root;
1246
1247 dict_type *
1248 lookup_word (word)
1249      char *word;
1250 {
1251   dict_type *ptr = root;
1252   while (ptr)
1253     {
1254       if (strcmp (ptr->word, word) == 0)
1255         return ptr;
1256       ptr = ptr->next;
1257     }
1258   if (warning)
1259     fprintf (stderr, "Can't find %s\n", word);
1260   return 0;
1261 }
1262
1263 static void
1264 perform ()
1265 {
1266   tos = stack;
1267
1268   while (at (ptr, idx))
1269     {
1270       /* It's worth looking through the command list.  */
1271       if (iscommand (ptr, idx))
1272         {
1273           char *next;
1274           dict_type *word;
1275
1276           (void) nextword (addr (ptr, idx), &next);
1277
1278           word = lookup_word (next);
1279
1280           if (word)
1281             {
1282               exec (word);
1283             }
1284           else
1285             {
1286               if (warning)
1287                 fprintf (stderr, "warning, %s is not recognised\n", next);
1288               skip_past_newline ();
1289             }
1290
1291         }
1292       else
1293         skip_past_newline ();
1294     }
1295 }
1296
1297 dict_type *
1298 newentry (word)
1299      char *word;
1300 {
1301   dict_type *new = (dict_type *) malloc (sizeof (dict_type));
1302   new->word = word;
1303   new->next = root;
1304   root = new;
1305   new->code = (stinst_type *) malloc (sizeof (stinst_type));
1306   new->code_length = 1;
1307   new->code_end = 0;
1308   return new;
1309 }
1310
1311 unsigned int
1312 add_to_definition (entry, word)
1313      dict_type *entry;
1314      stinst_type word;
1315 {
1316   if (entry->code_end == entry->code_length)
1317     {
1318       entry->code_length += 2;
1319       entry->code =
1320         (stinst_type *) realloc ((char *) (entry->code),
1321                                  entry->code_length * sizeof (word_type));
1322     }
1323   entry->code[entry->code_end] = word;
1324
1325   return entry->code_end++;
1326 }
1327
1328 void
1329 add_intrinsic (name, func)
1330      char *name;
1331      void (*func) ();
1332 {
1333   dict_type *new = newentry (name);
1334   add_to_definition (new, func);
1335   add_to_definition (new, 0);
1336 }
1337
1338 void
1339 add_var (name)
1340      char *name;
1341 {
1342   dict_type *new = newentry (name);
1343   add_to_definition (new, push_number);
1344   add_to_definition (new, (stinst_type) (&(new->var)));
1345   add_to_definition (new, 0);
1346 }
1347
1348 void
1349 compile (string)
1350      char *string;
1351 {
1352   /* Add words to the dictionary.  */
1353   char *word;
1354   string = nextword (string, &word);
1355   while (string && *string && word[0])
1356     {
1357       if (strcmp (word, "var") == 0)
1358         {
1359           string = nextword (string, &word);
1360
1361           add_var (word);
1362           string = nextword (string, &word);
1363         }
1364       else if (word[0] == ':')
1365         {
1366           dict_type *ptr;
1367           /* Compile a word and add to dictionary.  */
1368           string = nextword (string, &word);
1369
1370           ptr = newentry (word);
1371           string = nextword (string, &word);
1372           while (word[0] != ';')
1373             {
1374               switch (word[0])
1375                 {
1376                 case '"':
1377                   /* got a string, embed magic push string
1378                      function */
1379                   add_to_definition (ptr, push_text);
1380                   add_to_definition (ptr, (stinst_type) (word + 1));
1381                   break;
1382                 case '0':
1383                 case '1':
1384                 case '2':
1385                 case '3':
1386                 case '4':
1387                 case '5':
1388                 case '6':
1389                 case '7':
1390                 case '8':
1391                 case '9':
1392                   /* Got a number, embedd the magic push number
1393                      function */
1394                   add_to_definition (ptr, push_number);
1395                   add_to_definition (ptr, (stinst_type) atol (word));
1396                   break;
1397                 default:
1398                   add_to_definition (ptr, call);
1399                   add_to_definition (ptr, (stinst_type) lookup_word (word));
1400                 }
1401
1402               string = nextword (string, &word);
1403             }
1404           add_to_definition (ptr, 0);
1405           string = nextword (string, &word);
1406         }
1407       else
1408         {
1409           fprintf (stderr, "syntax error at %s\n", string - 1);
1410         }
1411     }
1412 }
1413
1414 static void
1415 bang ()
1416 {
1417   *(long *) ((isp[0])) = isp[-1];
1418   isp -= 2;
1419   icheck_range ();
1420   pc++;
1421 }
1422
1423 static void
1424 atsign ()
1425 {
1426   isp[0] = *(long *) (isp[0]);
1427   pc++;
1428 }
1429
1430 static void
1431 hello ()
1432 {
1433   printf ("hello\n");
1434   pc++;
1435 }
1436
1437 static void
1438 stdout_ ()
1439 {
1440   isp++;
1441   icheck_range ();
1442   *isp = 1;
1443   pc++;
1444 }
1445
1446 static void
1447 stderr_ ()
1448 {
1449   isp++;
1450   icheck_range ();
1451   *isp = 2;
1452   pc++;
1453 }
1454
1455 static void
1456 print ()
1457 {
1458   if (*isp == 1)
1459     write_buffer (tos, stdout);
1460   else if (*isp == 2)
1461     write_buffer (tos, stderr);
1462   else
1463     fprintf (stderr, "print: illegal print destination `%ld'\n", *isp);
1464   isp--;
1465   tos--;
1466   icheck_range ();
1467   check_range ();
1468   pc++;
1469 }
1470
1471 static void
1472 read_in (str, file)
1473      string_type *str;
1474      FILE *file;
1475 {
1476   char buff[10000];
1477   unsigned int r;
1478   do
1479     {
1480       r = fread (buff, 1, sizeof (buff), file);
1481       catbuf (str, buff, r);
1482     }
1483   while (r);
1484   buff[0] = 0;
1485
1486   catbuf (str, buff, 1);
1487 }
1488
1489 static void
1490 usage ()
1491 {
1492   fprintf (stderr, "usage: -[d|i|g] <file >file\n");
1493   exit (33);
1494 }
1495
1496 /* There is no reliable way to declare exit.  Sometimes it returns
1497    int, and sometimes it returns void.  Sometimes it changes between
1498    OS releases.  Trying to get it declared correctly in the hosts file
1499    is a pointless waste of time.  */
1500
1501 static void
1502 chew_exit ()
1503 {
1504   exit (0);
1505 }
1506
1507 int
1508 main (ac, av)
1509      int ac;
1510      char *av[];
1511 {
1512   unsigned int i;
1513   string_type buffer;
1514   string_type pptr;
1515
1516   init_string (&buffer);
1517   init_string (&pptr);
1518   init_string (stack + 0);
1519   tos = stack + 1;
1520   ptr = &pptr;
1521
1522   add_intrinsic ("push_text", push_text);
1523   add_intrinsic ("!", bang);
1524   add_intrinsic ("@", atsign);
1525   add_intrinsic ("hello", hello);
1526   add_intrinsic ("stdout", stdout_);
1527   add_intrinsic ("stderr", stderr_);
1528   add_intrinsic ("print", print);
1529   add_intrinsic ("skip_past_newline", skip_past_newline);
1530   add_intrinsic ("catstr", icatstr);
1531   add_intrinsic ("copy_past_newline", icopy_past_newline);
1532   add_intrinsic ("dup", other_dup);
1533   add_intrinsic ("drop", drop);
1534   add_intrinsic ("idrop", idrop);
1535   add_intrinsic ("remchar", remchar);
1536   add_intrinsic ("get_stuff_in_command", get_stuff_in_command);
1537   add_intrinsic ("do_fancy_stuff", do_fancy_stuff);
1538   add_intrinsic ("bulletize", bulletize);
1539   add_intrinsic ("courierize", courierize);
1540   /* If the following line gives an error, exit() is not declared in the
1541      ../hosts/foo.h file for this host.  Fix it there, not here!  */
1542   /* No, don't fix it anywhere; see comment on chew_exit--Ian Taylor.  */
1543   add_intrinsic ("exit", chew_exit);
1544   add_intrinsic ("swap", swap);
1545   add_intrinsic ("outputdots", outputdots);
1546   add_intrinsic ("paramstuff", paramstuff);
1547   add_intrinsic ("maybecatstr", maybecatstr);
1548   add_intrinsic ("translatecomments", translatecomments);
1549   add_intrinsic ("kill_bogus_lines", kill_bogus_lines);
1550   add_intrinsic ("indent", indent);
1551   add_intrinsic ("internalmode", internalmode);
1552   add_intrinsic ("print_stack_level", print_stack_level);
1553   add_intrinsic ("strip_trailing_newlines", strip_trailing_newlines);
1554
1555   /* Put a nl at the start.  */
1556   catchar (&buffer, '\n');
1557
1558   read_in (&buffer, stdin);
1559   remove_noncomments (&buffer, ptr);
1560   for (i = 1; i < (unsigned int) ac; i++)
1561     {
1562       if (av[i][0] == '-')
1563         {
1564           if (av[i][1] == 'f')
1565             {
1566               string_type b;
1567               FILE *f;
1568               init_string (&b);
1569
1570               f = fopen (av[i + 1], "r");
1571               if (!f)
1572                 {
1573                   fprintf (stderr, "Can't open the input file %s\n",
1574                            av[i + 1]);
1575                   return 33;
1576                 }
1577
1578               read_in (&b, f);
1579               compile (b.ptr);
1580               perform ();
1581             }
1582           else if (av[i][1] == 'i')
1583             {
1584               internal_wanted = 1;
1585             }
1586           else if (av[i][1] == 'w')
1587             {
1588               warning = 1;
1589             }
1590           else
1591             usage ();
1592         }
1593     }
1594   write_buffer (stack + 0, stdout);
1595   if (tos != stack)
1596     {
1597       fprintf (stderr, "finishing with current stack level %d\n",
1598                tos - stack);
1599       return 1;
1600     }
1601   return 0;
1602 }