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