bfd/doc/chew.c

   1 /* chew
   2    Copyright 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1998, 2000, 2001,
   3    2002, 2003
   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 #define NO_PARAMS 1
 498
 499   /* Make sure that it's not already param'd or proto'd.  */
 500   if (NO_PARAMS
 501       || find (tos, "PARAMS") || find (tos, "PROTO") || !find (tos, "("))
 502     {
 503       catstr (&out, tos);
 504     }
 505   else
 506     {
 507       /* Find the open paren.  */
 508       for (openp = 0; at (tos, openp) != '(' && at (tos, openp); openp++)
 509         ;
 510
 511       fname = openp;
 512       /* Step back to the fname.  */
 513       fname--;
 514       while (fname && isspace ((unsigned char) at (tos, fname)))
 515         fname--;
 516       while (fname
 517              && !isspace ((unsigned char) at (tos,fname))
 518              && at (tos,fname) != '*')
 519         fname--;
 520
 521       fname++;
 522
 523       /* Output type, omitting trailing whitespace character(s), if
 524          any.  */
 525       for (len = fname; 0 < len; len--)
 526         {
 527           if (!isspace ((unsigned char) at (tos, len - 1)))
 528             break;
 529         }
 530       for (idx = 0; idx < len; idx++)
 531         catchar (&out, at (tos, idx));
 532
 533       cattext (&out, "\n");     /* Insert a newline between type and fnname */
 534
 535       /* Output function name, omitting trailing whitespace
 536          character(s), if any.  */
 537       for (len = openp; 0 < len; len--)
 538         {
 539           if (!isspace ((unsigned char) at (tos, len - 1)))
 540             break;
 541         }
 542       for (idx = fname; idx < len; idx++)
 543         catchar (&out, at (tos, idx));
 544
 545       cattext (&out, " PARAMS (");
 546
 547       for (idx = openp; at (tos, idx) && at (tos, idx) != ';'; idx++)
 548         catchar (&out, at (tos, idx));
 549
 550       cattext (&out, ");\n\n");
 551     }
 552   overwrite_string (tos, &out);
 553   pc++;
 554
 555 }
 556
 557 /* turn {*
 558    and *} into comments */
 559
 560 static void
 561 translatecomments ()
 562 {
 563   unsigned int idx = 0;
 564   string_type out;
 565   init_string (&out);
 566
 567   while (at (tos, idx))
 568     {
 569       if (at (tos, idx) == '{' && at (tos, idx + 1) == '*')
 570         {
 571           cattext (&out, "/*");
 572           idx += 2;
 573         }
 574       else if (at (tos, idx) == '*' && at (tos, idx + 1) == '}')
 575         {
 576           cattext (&out, "*/");
 577           idx += 2;
 578         }
 579       else
 580         {
 581           catchar (&out, at (tos, idx));
 582           idx++;
 583         }
 584     }
 585
 586   overwrite_string (tos, &out);
 587
 588   pc++;
 589 }
 590
 591 #if 0
 592
 593 /* This is not currently used.  */
 594
 595 /* turn everything not starting with a . into a comment */
 596
 597 static void
 598 manglecomments ()
 599 {
 600   unsigned int idx = 0;
 601   string_type out;
 602   init_string (&out);
 603
 604   while (at (tos, idx))
 605     {
 606       if (at (tos, idx) == '\n' && at (tos, idx + 1) == '*')
 607         {
 608           cattext (&out, "      /*");
 609           idx += 2;
 610         }
 611       else if (at (tos, idx) == '*' && at (tos, idx + 1) == '}')
 612         {
 613           cattext (&out, "*/");
 614           idx += 2;
 615         }
 616       else
 617         {
 618           catchar (&out, at (tos, idx));
 619           idx++;
 620         }
 621     }
 622
 623   overwrite_string (tos, &out);
 624
 625   pc++;
 626 }
 627
 628 #endif
 629
 630 /* Mod tos so that only lines with leading dots remain */
 631 static void
 632 outputdots ()
 633 {
 634   unsigned int idx = 0;
 635   string_type out;
 636   init_string (&out);
 637
 638   while (at (tos, idx))
 639     {
 640       if (at (tos, idx) == '\n' && at (tos, idx + 1) == '.')
 641         {
 642           char c;
 643           idx += 2;
 644
 645           while ((c = at (tos, idx)) && c != '\n')
 646             {
 647               if (c == '{' && at (tos, idx + 1) == '*')
 648                 {
 649                   cattext (&out, "/*");
 650                   idx += 2;
 651                 }
 652               else if (c == '*' && at (tos, idx + 1) == '}')
 653                 {
 654                   cattext (&out, "*/");
 655                   idx += 2;
 656                 }
 657               else
 658                 {
 659                   catchar (&out, c);
 660                   idx++;
 661                 }
 662             }
 663           catchar (&out, '\n');
 664         }
 665       else
 666         {
 667           idx++;
 668         }
 669     }
 670
 671   overwrite_string (tos, &out);
 672   pc++;
 673 }
 674
 675 /* Find lines starting with . and | and put example around them on tos */
 676 static void
 677 courierize ()
 678 {
 679   string_type out;
 680   unsigned int idx = 0;
 681   int command = 0;
 682
 683   init_string (&out);
 684
 685   while (at (tos, idx))
 686     {
 687       if (at (tos, idx) == '\n'
 688           && (at (tos, idx +1 ) == '.'
 689               || at (tos, idx + 1) == '|'))
 690         {
 691           cattext (&out, "\n@example\n");
 692           do
 693             {
 694               idx += 2;
 695
 696               while (at (tos, idx) && at (tos, idx) != '\n')
 697                 {
 698                   if (command > 1)
 699                     {
 700                       /* We are inside {} parameters of some command;
 701                          Just pass through until matching brace.  */
 702                       if (at (tos, idx) == '{')
 703                         ++command;
 704                       else if (at (tos, idx) == '}')
 705                         --command;
 706                     }
 707                   else if (command != 0)
 708                     {
 709                       if (at (tos, idx) == '{')
 710                         ++command;
 711                       else if (!islower ((unsigned char) at (tos, idx)))
 712                         --command;
 713                     }
 714                   else if (at (tos, idx) == '@'
 715                            && islower ((unsigned char) at (tos, idx + 1)))
 716                     {
 717                       ++command;
 718                     }
 719                   else if (at (tos, idx) == '{' && at (tos, idx + 1) == '*')
 720                     {
 721                       cattext (&out, "/*");
 722                       idx += 2;
 723                       continue;
 724                     }
 725                   else if (at (tos, idx) == '*' && at (tos, idx + 1) == '}')
 726                     {
 727                       cattext (&out, "*/");
 728                       idx += 2;
 729                       continue;
 730                     }
 731                   else if (at (tos, idx) == '{'
 732                            || at (tos, idx) == '}')
 733                     {
 734                       catchar (&out, '@');
 735                     }
 736
 737                   catchar (&out, at (tos, idx));
 738                   idx++;
 739                 }
 740               catchar (&out, '\n');
 741             }
 742           while (at (tos, idx) == '\n'
 743                  && ((at (tos, idx + 1) == '.')
 744                      || (at (tos, idx + 1) == '|')))
 745             ;
 746           cattext (&out, "@end example");
 747         }
 748       else
 749         {
 750           catchar (&out, at (tos, idx));
 751           idx++;
 752         }
 753     }
 754
 755   overwrite_string (tos, &out);
 756   pc++;
 757 }
 758
 759 /* Finds any lines starting with "o ", if there are any, then turns
 760    on @itemize @bullet, and @items each of them. Then ends with @end
 761    itemize, inplace at TOS*/
 762
 763 static void
 764 bulletize ()
 765 {
 766   unsigned int idx = 0;
 767   int on = 0;
 768   string_type out;
 769   init_string (&out);
 770
 771   while (at (tos, idx))
 772     {
 773       if (at (tos, idx) == '@'
 774           && at (tos, idx + 1) == '*')
 775         {
 776           cattext (&out, "*");
 777           idx += 2;
 778         }
 779       else if (at (tos, idx) == '\n'
 780                && at (tos, idx + 1) == 'o'
 781                && isspace ((unsigned char) at (tos, idx + 2)))
 782         {
 783           if (!on)
 784             {
 785               cattext (&out, "\n@itemize @bullet\n");
 786               on = 1;
 787
 788             }
 789           cattext (&out, "\n@item\n");
 790           idx += 3;
 791         }
 792       else
 793         {
 794           catchar (&out, at (tos, idx));
 795           if (on && at (tos, idx) == '\n'
 796               && at (tos, idx + 1) == '\n'
 797               && at (tos, idx + 2) != 'o')
 798             {
 799               cattext (&out, "@end itemize");
 800               on = 0;
 801             }
 802           idx++;
 803
 804         }
 805     }
 806   if (on)
 807     {
 808       cattext (&out, "@end itemize\n");
 809     }
 810
 811   delete_string (tos);
 812   *tos = out;
 813   pc++;
 814 }
 815
 816 /* Turn <<foo>> into @code{foo} in place at TOS*/
 817
 818 static void
 819 do_fancy_stuff ()
 820 {
 821   unsigned int idx = 0;
 822   string_type out;
 823   init_string (&out);
 824   while (at (tos, idx))
 825     {
 826       if (at (tos, idx) == '<'
 827           && at (tos, idx + 1) == '<'
 828           && !isspace ((unsigned char) at (tos, idx + 2)))
 829         {
 830           /* This qualifies as a << startup.  */
 831           idx += 2;
 832           cattext (&out, "@code{");
 833           while (at (tos, idx)
 834                  && at (tos, idx) != '>' )
 835             {
 836               catchar (&out, at (tos, idx));
 837               idx++;
 838
 839             }
 840           cattext (&out, "}");
 841           idx += 2;
 842         }
 843       else
 844         {
 845           catchar (&out, at (tos, idx));
 846           idx++;
 847         }
 848     }
 849   delete_string (tos);
 850   *tos = out;
 851   pc++;
 852
 853 }
 854
 855 /* A command is all upper case,and alone on a line.  */
 856
 857 static int
 858 iscommand (ptr, idx)
 859      string_type *ptr;
 860      unsigned int idx;
 861 {
 862   unsigned int len = 0;
 863   while (at (ptr, idx))
 864     {
 865       if (isupper ((unsigned char) at (ptr, idx))
 866           || at (ptr, idx) == ' ' || at (ptr, idx) == '_')
 867         {
 868           len++;
 869           idx++;
 870         }
 871       else if (at (ptr, idx) == '\n')
 872         {
 873           if (len > 3)
 874             return 1;
 875           return 0;
 876         }
 877       else
 878         return 0;
 879     }
 880   return 0;
 881 }
 882
 883 static int
 884 copy_past_newline (ptr, idx, dst)
 885      string_type *ptr;
 886      unsigned int idx;
 887      string_type *dst;
 888 {
 889   int column = 0;
 890
 891   while (at (ptr, idx) && at (ptr, idx) != '\n')
 892     {
 893       if (at (ptr, idx) == '\t')
 894         {
 895           /* Expand tabs.  Neither makeinfo nor TeX can cope well with
 896              them.  */
 897           do
 898             catchar (dst, ' ');
 899           while (++column & 7);
 900         }
 901       else
 902         {
 903           catchar (dst, at (ptr, idx));
 904           column++;
 905         }
 906       idx++;
 907
 908     }
 909   catchar (dst, at (ptr, idx));
 910   idx++;
 911   return idx;
 912
 913 }
 914
 915 static void
 916 icopy_past_newline ()
 917 {
 918   tos++;
 919   check_range ();
 920   init_string (tos);
 921   idx = copy_past_newline (ptr, idx, tos);
 922   pc++;
 923 }
 924
 925 /* indent
 926    Take the string at the top of the stack, do some prettying.  */
 927
 928 static void
 929 kill_bogus_lines ()
 930 {
 931   int sl;
 932
 933   int idx = 0;
 934   int c;
 935   int dot = 0;
 936
 937   string_type out;
 938   init_string (&out);
 939   /* Drop leading nl.  */
 940   while (at (tos, idx) == '\n')
 941     {
 942       idx++;
 943     }
 944   c = idx;
 945
 946   /* If the first char is a '.' prepend a newline so that it is
 947      recognized properly later.  */
 948   if (at (tos, idx) == '.')
 949     catchar (&out, '\n');
 950
 951   /* Find the last char.  */
 952   while (at (tos, idx))
 953     {
 954       idx++;
 955     }
 956
 957   /* Find the last non white before the nl.  */
 958   idx--;
 959
 960   while (idx && isspace ((unsigned char) at (tos, idx)))
 961     idx--;
 962   idx++;
 963
 964   /* Copy buffer upto last char, but blank lines before and after
 965      dots don't count.  */
 966   sl = 1;
 967
 968   while (c < idx)
 969     {
 970       if (at (tos, c) == '\n'
 971           && at (tos, c + 1) == '\n'
 972           && at (tos, c + 2) == '.')
 973         {
 974           /* Ignore two newlines before a dot.  */
 975           c++;
 976         }
 977       else if (at (tos, c) == '.' && sl)
 978         {
 979           /* remember that this line started with a dot.  */
 980           dot = 2;
 981         }
 982       else if (at (tos, c) == '\n'
 983                && at (tos, c + 1) == '\n'
 984                && dot)
 985         {
 986           c++;
 987           /* Ignore two newlines when last line was dot.  */
 988         }
 989
 990       catchar (&out, at (tos, c));
 991       if (at (tos, c) == '\n')
 992         {
 993           sl = 1;
 994
 995           if (dot == 2)
 996             dot = 1;
 997           else
 998             dot = 0;
 999         }
1000       else
1001         sl = 0;
1002
1003       c++;
1004
1005     }
1006
1007   /* Append nl.  */
1008   catchar (&out, '\n');
1009   pc++;
1010   delete_string (tos);
1011   *tos = out;
1012
1013 }
1014
1015 static void
1016 indent ()
1017 {
1018   string_type out;
1019   int tab = 0;
1020   int idx = 0;
1021   int ol = 0;
1022   init_string (&out);
1023   while (at (tos, idx))
1024     {
1025       switch (at (tos, idx))
1026         {
1027         case '\n':
1028           cattext (&out, "\n");
1029           idx++;
1030           if (tab && at (tos, idx))
1031             {
1032               cattext (&out, "    ");
1033             }
1034           ol = 0;
1035           break;
1036         case '(':
1037           tab++;
1038           if (ol == 0)
1039             cattext (&out, "   ");
1040           idx++;
1041           cattext (&out, "(");
1042           ol = 1;
1043           break;
1044         case ')':
1045           tab--;
1046           cattext (&out, ")");
1047           idx++;
1048           ol = 1;
1049
1050           break;
1051         default:
1052           catchar (&out, at (tos, idx));
1053           ol = 1;
1054
1055           idx++;
1056           break;
1057         }
1058     }
1059
1060   pc++;
1061   delete_string (tos);
1062   *tos = out;
1063
1064 }
1065
1066 static void
1067 get_stuff_in_command ()
1068 {
1069   tos++;
1070   check_range ();
1071   init_string (tos);
1072
1073   while (at (ptr, idx))
1074     {
1075       if (iscommand (ptr, idx))
1076         break;
1077       idx = copy_past_newline (ptr, idx, tos);
1078     }
1079   pc++;
1080 }
1081
1082 static void
1083 swap ()
1084 {
1085   string_type t;
1086
1087   t = tos[0];
1088   tos[0] = tos[-1];
1089   tos[-1] = t;
1090   pc++;
1091 }
1092
1093 static void
1094 other_dup ()
1095 {
1096   tos++;
1097   check_range ();
1098   init_string (tos);
1099   catstr (tos, tos - 1);
1100   pc++;
1101 }
1102
1103 static void
1104 drop ()
1105 {
1106   tos--;
1107   check_range ();
1108   pc++;
1109 }
1110
1111 static void
1112 idrop ()
1113 {
1114   isp--;
1115   icheck_range ();
1116   pc++;
1117 }
1118
1119 static void
1120 icatstr ()
1121 {
1122   tos--;
1123   check_range ();
1124   catstr (tos, tos + 1);
1125   delete_string (tos + 1);
1126   pc++;
1127 }
1128
1129 static void
1130 skip_past_newline ()
1131 {
1132   while (at (ptr, idx)
1133          && at (ptr, idx) != '\n')
1134     idx++;
1135   idx++;
1136   pc++;
1137 }
1138
1139 static void
1140 internalmode ()
1141 {
1142   internal_mode = *(isp);
1143   isp--;
1144   icheck_range ();
1145   pc++;
1146 }
1147
1148 static void
1149 maybecatstr ()
1150 {
1151   if (internal_wanted == internal_mode)
1152     {
1153       catstr (tos - 1, tos);
1154     }
1155   delete_string (tos);
1156   tos--;
1157   check_range ();
1158   pc++;
1159 }
1160
1161 char *
1162 nextword (string, word)
1163      char *string;
1164      char **word;
1165 {
1166   char *word_start;
1167   int idx;
1168   char *dst;
1169   char *src;
1170
1171   int length = 0;
1172
1173   while (isspace ((unsigned char) *string) || *string == '-')
1174     {
1175       if (*string == '-')
1176         {
1177           while (*string && *string != '\n')
1178             string++;
1179
1180         }
1181       else
1182         {
1183           string++;
1184         }
1185     }
1186   if (!*string)
1187     return 0;
1188
1189   word_start = string;
1190   if (*string == '"')
1191     {
1192       do
1193         {
1194           string++;
1195           length++;
1196           if (*string == '\\')
1197             {
1198               string += 2;
1199               length += 2;
1200             }
1201         }
1202       while (*string != '"');
1203     }
1204   else
1205     {
1206       while (!isspace ((unsigned char) *string))
1207         {
1208           string++;
1209           length++;
1210
1211         }
1212     }
1213
1214   *word = malloc (length + 1);
1215
1216   dst = *word;
1217   src = word_start;
1218
1219   for (idx = 0; idx < length; idx++)
1220     {
1221       if (src[idx] == '\\')
1222         switch (src[idx + 1])
1223           {
1224           case 'n':
1225             *dst++ = '\n';
1226             idx++;
1227             break;
1228           case '"':
1229           case '\\':
1230             *dst++ = src[idx + 1];
1231             idx++;
1232             break;
1233           default:
1234             *dst++ = '\\';
1235             break;
1236           }
1237       else
1238         *dst++ = src[idx];
1239     }
1240   *dst++ = 0;
1241
1242   if (*string)
1243     return string + 1;
1244   else
1245     return 0;
1246 }
1247
1248 dict_type *root;
1249
1250 dict_type *
1251 lookup_word (word)
1252      char *word;
1253 {
1254   dict_type *ptr = root;
1255   while (ptr)
1256     {
1257       if (strcmp (ptr->word, word) == 0)
1258         return ptr;
1259       ptr = ptr->next;
1260     }
1261   if (warning)
1262     fprintf (stderr, "Can't find %s\n", word);
1263   return 0;
1264 }
1265
1266 static void
1267 perform ()
1268 {
1269   tos = stack;
1270
1271   while (at (ptr, idx))
1272     {
1273       /* It's worth looking through the command list.  */
1274       if (iscommand (ptr, idx))
1275         {
1276           char *next;
1277           dict_type *word;
1278
1279           (void) nextword (addr (ptr, idx), &next);
1280
1281           word = lookup_word (next);
1282
1283           if (word)
1284             {
1285               exec (word);
1286             }
1287           else
1288             {
1289               if (warning)
1290                 fprintf (stderr, "warning, %s is not recognised\n", next);
1291               skip_past_newline ();
1292             }
1293
1294         }
1295       else
1296         skip_past_newline ();
1297     }
1298 }
1299
1300 dict_type *
1301 newentry (word)
1302      char *word;
1303 {
1304   dict_type *new = (dict_type *) malloc (sizeof (dict_type));
1305   new->word = word;
1306   new->next = root;
1307   root = new;
1308   new->code = (stinst_type *) malloc (sizeof (stinst_type));
1309   new->code_length = 1;
1310   new->code_end = 0;
1311   return new;
1312 }
1313
1314 unsigned int
1315 add_to_definition (entry, word)
1316      dict_type *entry;
1317      stinst_type word;
1318 {
1319   if (entry->code_end == entry->code_length)
1320     {
1321       entry->code_length += 2;
1322       entry->code =
1323         (stinst_type *) realloc ((char *) (entry->code),
1324                                  entry->code_length * sizeof (word_type));
1325     }
1326   entry->code[entry->code_end] = word;
1327
1328   return entry->code_end++;
1329 }
1330
1331 void
1332 add_intrinsic (name, func)
1333      char *name;
1334      void (*func) ();
1335 {
1336   dict_type *new = newentry (name);
1337   add_to_definition (new, func);
1338   add_to_definition (new, 0);
1339 }
1340
1341 void
1342 add_var (name)
1343      char *name;
1344 {
1345   dict_type *new = newentry (name);
1346   add_to_definition (new, push_number);
1347   add_to_definition (new, (stinst_type) (&(new->var)));
1348   add_to_definition (new, 0);
1349 }
1350
1351 void
1352 compile (string)
1353      char *string;
1354 {
1355   /* Add words to the dictionary.  */
1356   char *word;
1357   string = nextword (string, &word);
1358   while (string && *string && word[0])
1359     {
1360       if (strcmp (word, "var") == 0)
1361         {
1362           string = nextword (string, &word);
1363
1364           add_var (word);
1365           string = nextword (string, &word);
1366         }
1367       else if (word[0] == ':')
1368         {
1369           dict_type *ptr;
1370           /* Compile a word and add to dictionary.  */
1371           string = nextword (string, &word);
1372
1373           ptr = newentry (word);
1374           string = nextword (string, &word);
1375           while (word[0] != ';')
1376             {
1377               switch (word[0])
1378                 {
1379                 case '"':
1380                   /* got a string, embed magic push string
1381                      function */
1382                   add_to_definition (ptr, push_text);
1383                   add_to_definition (ptr, (stinst_type) (word + 1));
1384                   break;
1385                 case '0':
1386                 case '1':
1387                 case '2':
1388                 case '3':
1389                 case '4':
1390                 case '5':
1391                 case '6':
1392                 case '7':
1393                 case '8':
1394                 case '9':
1395                   /* Got a number, embedd the magic push number
1396                      function */
1397                   add_to_definition (ptr, push_number);
1398                   add_to_definition (ptr, (stinst_type) atol (word));
1399                   break;
1400                 default:
1401                   add_to_definition (ptr, call);
1402                   add_to_definition (ptr, (stinst_type) lookup_word (word));
1403                 }
1404
1405               string = nextword (string, &word);
1406             }
1407           add_to_definition (ptr, 0);
1408           string = nextword (string, &word);
1409         }
1410       else
1411         {
1412           fprintf (stderr, "syntax error at %s\n", string - 1);
1413         }
1414     }
1415 }
1416
1417 static void
1418 bang ()
1419 {
1420   *(long *) ((isp[0])) = isp[-1];
1421   isp -= 2;
1422   icheck_range ();
1423   pc++;
1424 }
1425
1426 static void
1427 atsign ()
1428 {
1429   isp[0] = *(long *) (isp[0]);
1430   pc++;
1431 }
1432
1433 static void
1434 hello ()
1435 {
1436   printf ("hello\n");
1437   pc++;
1438 }
1439
1440 static void
1441 stdout_ ()
1442 {
1443   isp++;
1444   icheck_range ();
1445   *isp = 1;
1446   pc++;
1447 }
1448
1449 static void
1450 stderr_ ()
1451 {
1452   isp++;
1453   icheck_range ();
1454   *isp = 2;
1455   pc++;
1456 }
1457
1458 static void
1459 print ()
1460 {
1461   if (*isp == 1)
1462     write_buffer (tos, stdout);
1463   else if (*isp == 2)
1464     write_buffer (tos, stderr);
1465   else
1466     fprintf (stderr, "print: illegal print destination `%ld'\n", *isp);
1467   isp--;
1468   tos--;
1469   icheck_range ();
1470   check_range ();
1471   pc++;
1472 }
1473
1474 static void
1475 read_in (str, file)
1476      string_type *str;
1477      FILE *file;
1478 {
1479   char buff[10000];
1480   unsigned int r;
1481   do
1482     {
1483       r = fread (buff, 1, sizeof (buff), file);
1484       catbuf (str, buff, r);
1485     }
1486   while (r);
1487   buff[0] = 0;
1488
1489   catbuf (str, buff, 1);
1490 }
1491
1492 static void
1493 usage ()
1494 {
1495   fprintf (stderr, "usage: -[d|i|g] <file >file\n");
1496   exit (33);
1497 }
1498
1499 /* There is no reliable way to declare exit.  Sometimes it returns
1500    int, and sometimes it returns void.  Sometimes it changes between
1501    OS releases.  Trying to get it declared correctly in the hosts file
1502    is a pointless waste of time.  */
1503
1504 static void
1505 chew_exit ()
1506 {
1507   exit (0);
1508 }
1509
1510 int
1511 main (ac, av)
1512      int ac;
1513      char *av[];
1514 {
1515   unsigned int i;
1516   string_type buffer;
1517   string_type pptr;
1518
1519   init_string (&buffer);
1520   init_string (&pptr);
1521   init_string (stack + 0);
1522   tos = stack + 1;
1523   ptr = &pptr;
1524
1525   add_intrinsic ("push_text", push_text);
1526   add_intrinsic ("!", bang);
1527   add_intrinsic ("@", atsign);
1528   add_intrinsic ("hello", hello);
1529   add_intrinsic ("stdout", stdout_);
1530   add_intrinsic ("stderr", stderr_);
1531   add_intrinsic ("print", print);
1532   add_intrinsic ("skip_past_newline", skip_past_newline);
1533   add_intrinsic ("catstr", icatstr);
1534   add_intrinsic ("copy_past_newline", icopy_past_newline);
1535   add_intrinsic ("dup", other_dup);
1536   add_intrinsic ("drop", drop);
1537   add_intrinsic ("idrop", idrop);
1538   add_intrinsic ("remchar", remchar);
1539   add_intrinsic ("get_stuff_in_command", get_stuff_in_command);
1540   add_intrinsic ("do_fancy_stuff", do_fancy_stuff);
1541   add_intrinsic ("bulletize", bulletize);
1542   add_intrinsic ("courierize", courierize);
1543   /* If the following line gives an error, exit() is not declared in the
1544      ../hosts/foo.h file for this host.  Fix it there, not here!  */
1545   /* No, don't fix it anywhere; see comment on chew_exit--Ian Taylor.  */
1546   add_intrinsic ("exit", chew_exit);
1547   add_intrinsic ("swap", swap);
1548   add_intrinsic ("outputdots", outputdots);
1549   add_intrinsic ("paramstuff", paramstuff);
1550   add_intrinsic ("maybecatstr", maybecatstr);
1551   add_intrinsic ("translatecomments", translatecomments);
1552   add_intrinsic ("kill_bogus_lines", kill_bogus_lines);
1553   add_intrinsic ("indent", indent);
1554   add_intrinsic ("internalmode", internalmode);
1555   add_intrinsic ("print_stack_level", print_stack_level);
1556   add_intrinsic ("strip_trailing_newlines", strip_trailing_newlines);
1557
1558   /* Put a nl at the start.  */
1559   catchar (&buffer, '\n');
1560
1561   read_in (&buffer, stdin);
1562   remove_noncomments (&buffer, ptr);
1563   for (i = 1; i < (unsigned int) ac; i++)
1564     {
1565       if (av[i][0] == '-')
1566         {
1567           if (av[i][1] == 'f')
1568             {
1569               string_type b;
1570               FILE *f;
1571               init_string (&b);
1572
1573               f = fopen (av[i + 1], "r");
1574               if (!f)
1575                 {
1576                   fprintf (stderr, "Can't open the input file %s\n",
1577                            av[i + 1]);
1578                   return 33;
1579                 }
1580
1581               read_in (&b, f);
1582               compile (b.ptr);
1583               perform ();
1584             }
1585           else if (av[i][1] == 'i')
1586             {
1587               internal_wanted = 1;
1588             }
1589           else if (av[i][1] == 'w')
1590             {
1591               warning = 1;
1592             }
1593           else
1594             usage ();
1595         }
1596     }
1597   write_buffer (stack + 0, stdout);
1598   if (tos != stack)
1599     {
1600       fprintf (stderr, "finishing with current stack level %d\n",
1601                tos - stack);
1602       return 1;
1603     }
1604   return 0;
1605 }