bfd/doc/chew.c

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