contrib/gdb/bfd/doc/chew.c

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