bfd/doc/chew.c

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