bfd/doc/chew.c

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