]> CyberLeo.Net >> Repos - FreeBSD/releng/10.0.git/blob - contrib/binutils/bfd/doc/chew.c
- Copy stable/10 (r259064) to releng/10.0 as part of the
[FreeBSD/releng/10.0.git] / contrib / binutils / bfd / doc / chew.c
1 /* chew
2    Copyright 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1998, 2000, 2001,
3    2002, 2003, 2005
4    Free Software Foundation, Inc.
5    Contributed by steve chamberlain @cygnus
6
7 This file is part of BFD, the Binary File Descriptor library.
8
9 This program is free software; you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation; either version 2 of the License, or
12 (at your option) any later version.
13
14 This program is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17 GNU General Public License for more details.
18
19 You should have received a copy of the GNU General Public License
20 along with this program; if not, write to the Free Software
21 Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.  */
22
23 /* Yet another way of extracting documentation from source.
24    No, I haven't finished it yet, but I hope you people like it better
25    than the old way
26
27    sac
28
29    Basically, this is a sort of string forth, maybe we should call it
30    struth?
31
32    You define new words thus:
33    : <newword> <oldwords> ;
34
35 */
36
37 /* Primitives provided by the program:
38
39    Two stacks are provided, a string stack and an integer stack.
40
41    Internal state variables:
42         internal_wanted - indicates whether `-i' was passed
43         internal_mode - user-settable
44
45    Commands:
46         push_text
47         ! - pop top of integer stack for address, pop next for value; store
48         @ - treat value on integer stack as the address of an integer; push
49                 that integer on the integer stack after popping the "address"
50         hello - print "hello\n" to stdout
51         stdout - put stdout marker on TOS
52         stderr - put stderr marker on TOS
53         print - print TOS-1 on TOS (eg: "hello\n" stdout print)
54         skip_past_newline
55         catstr - fn icatstr
56         copy_past_newline - append input, up to and including newline into TOS
57         dup - fn other_dup
58         drop - discard TOS
59         idrop - ditto
60         remchar - delete last character from TOS
61         get_stuff_in_command
62         do_fancy_stuff - translate <<foo>> to @code{foo} in TOS
63         bulletize - if "o" lines found, prepend @itemize @bullet to TOS
64                 and @item to each "o" line; append @end itemize
65         courierize - put @example around . and | lines, translate {* *} { }
66         exit - fn chew_exit
67         swap
68         outputdots - strip out lines without leading dots
69         paramstuff - convert full declaration into "PARAMS" form if not already
70         maybecatstr - do catstr if internal_mode == internal_wanted, discard
71                 value in any case
72         translatecomments - turn {* and *} into comment delimiters
73         kill_bogus_lines - get rid of extra newlines
74         indent
75         internalmode - pop from integer stack, set `internalmode' to that value
76         print_stack_level - print current stack depth to stderr
77         strip_trailing_newlines - go ahead, guess...
78         [quoted string] - push string onto string stack
79         [word starting with digit] - push atol(str) onto integer stack
80
81    A command must be all upper-case, and alone on a line.
82
83    Foo.  */
84
85 #include "ansidecl.h"
86 #include <assert.h>
87 #include <stdio.h>
88 #include <ctype.h>
89 #include <stdlib.h>
90 #include <string.h>
91
92 #define DEF_SIZE 5000
93 #define STACK 50
94
95 int internal_wanted;
96 int internal_mode;
97
98 int warning;
99
100 /* Here is a string type ...  */
101
102 typedef struct buffer
103 {
104   char *ptr;
105   unsigned long write_idx;
106   unsigned long size;
107 } string_type;
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 static void
125 init_string_with_size (buffer, size)
126      string_type *buffer;
127      unsigned int size;
128 {
129   buffer->write_idx = 0;
130   buffer->size = size;
131   buffer->ptr = malloc (size);
132 }
133
134 static void
135 init_string (buffer)
136      string_type *buffer;
137 {
138   init_string_with_size (buffer, DEF_SIZE);
139 }
140
141 static int
142 find (str, what)
143      string_type *str;
144      char *what;
145 {
146   unsigned int i;
147   char *p;
148   p = what;
149   for (i = 0; i < str->write_idx && *p; i++)
150     {
151       if (*p == str->ptr[i])
152         p++;
153       else
154         p = what;
155     }
156   return (*p == 0);
157 }
158
159 static void
160 write_buffer (buffer, f)
161      string_type *buffer;
162      FILE *f;
163 {
164   fwrite (buffer->ptr, buffer->write_idx, 1, f);
165 }
166
167 static void
168 delete_string (buffer)
169      string_type *buffer;
170 {
171   free (buffer->ptr);
172 }
173
174 static char *
175 addr (buffer, idx)
176      string_type *buffer;
177      unsigned int idx;
178 {
179   return buffer->ptr + idx;
180 }
181
182 static char
183 at (buffer, pos)
184      string_type *buffer;
185      unsigned int pos;
186 {
187   if (pos >= buffer->write_idx)
188     return 0;
189   return buffer->ptr[pos];
190 }
191
192 static void
193 catchar (buffer, ch)
194      string_type *buffer;
195      int ch;
196 {
197   if (buffer->write_idx == buffer->size)
198     {
199       buffer->size *= 2;
200       buffer->ptr = realloc (buffer->ptr, buffer->size);
201     }
202
203   buffer->ptr[buffer->write_idx++] = ch;
204 }
205
206 static void
207 overwrite_string (dst, src)
208      string_type *dst;
209      string_type *src;
210 {
211   free (dst->ptr);
212   dst->size = src->size;
213   dst->write_idx = src->write_idx;
214   dst->ptr = src->ptr;
215 }
216
217 static void
218 catbuf (buffer, buf, len)
219      string_type *buffer;
220      char *buf;
221      unsigned int len;
222 {
223   if (buffer->write_idx + len >= buffer->size)
224     {
225       while (buffer->write_idx + len >= buffer->size)
226         buffer->size *= 2;
227       buffer->ptr = realloc (buffer->ptr, buffer->size);
228     }
229   memcpy (buffer->ptr + buffer->write_idx, buf, len);
230   buffer->write_idx += len;
231 }
232
233 static void
234 cattext (buffer, string)
235      string_type *buffer;
236      char *string;
237 {
238   catbuf (buffer, string, (unsigned int) strlen (string));
239 }
240
241 static void
242 catstr (dst, src)
243      string_type *dst;
244      string_type *src;
245 {
246   catbuf (dst, src->ptr, src->write_idx);
247 }
248
249 static unsigned int
250 skip_white_and_stars (src, idx)
251      string_type *src;
252      unsigned int idx;
253 {
254   char c;
255   while ((c = at (src, idx)),
256          isspace ((unsigned char) c)
257          || (c == '*'
258              /* Don't skip past end-of-comment or star as first
259                 character on its line.  */
260              && at (src, idx +1) != '/'
261              && at (src, idx -1) != '\n'))
262     idx++;
263   return idx;
264 }
265
266 /***********************************************************************/
267
268 string_type stack[STACK];
269 string_type *tos;
270
271 unsigned int idx = 0; /* Pos in input buffer */
272 string_type *ptr; /* and the buffer */
273 typedef void (*stinst_type)();
274 stinst_type *pc;
275 stinst_type sstack[STACK];
276 stinst_type *ssp = &sstack[0];
277 long istack[STACK];
278 long *isp = &istack[0];
279
280 typedef int *word_type;
281
282 struct dict_struct
283 {
284   char *word;
285   struct dict_struct *next;
286   stinst_type *code;
287   int code_length;
288   int code_end;
289   int var;
290 };
291
292 typedef struct dict_struct dict_type;
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 static void
366 call ()
367 {
368   stinst_type *oldpc = pc;
369   dict_type *e;
370   e = (dict_type *) (pc[1]);
371   exec (e);
372   pc = oldpc + 2;
373 }
374
375 static void
376 remchar ()
377 {
378   if (tos->write_idx)
379     tos->write_idx--;
380   pc++;
381 }
382
383 static void
384 strip_trailing_newlines ()
385 {
386   while ((isspace ((unsigned char) at (tos, tos->write_idx - 1))
387           || at (tos, tos->write_idx - 1) == '\n')
388          && tos->write_idx > 0)
389     tos->write_idx--;
390   pc++;
391 }
392
393 static void
394 push_number ()
395 {
396   isp++;
397   icheck_range ();
398   pc++;
399   *isp = (long) (*pc);
400   pc++;
401 }
402
403 static void
404 push_text ()
405 {
406   tos++;
407   check_range ();
408   init_string (tos);
409   pc++;
410   cattext (tos, *((char **) pc));
411   pc++;
412 }
413
414 /* This function removes everything not inside comments starting on
415    the first char of the line from the  string, also when copying
416    comments, removes blank space and leading *'s.
417    Blank lines are turned into one blank line.  */
418
419 static void
420 remove_noncomments (src, dst)
421      string_type *src;
422      string_type *dst;
423 {
424   unsigned int idx = 0;
425
426   while (at (src, idx))
427     {
428       /* Now see if we have a comment at the start of the line.  */
429       if (at (src, idx) == '\n'
430           && at (src, idx + 1) == '/'
431           && at (src, idx + 2) == '*')
432         {
433           idx += 3;
434
435           idx = skip_white_and_stars (src, idx);
436
437           /* Remove leading dot */
438           if (at (src, idx) == '.')
439             idx++;
440
441           /* Copy to the end of the line, or till the end of the
442              comment.  */
443           while (at (src, idx))
444             {
445               if (at (src, idx) == '\n')
446                 {
447                   /* end of line, echo and scrape of leading blanks  */
448                   if (at (src, idx + 1) == '\n')
449                     catchar (dst, '\n');
450                   catchar (dst, '\n');
451                   idx++;
452                   idx = skip_white_and_stars (src, idx);
453                 }
454               else if (at (src, idx) == '*' && at (src, idx + 1) == '/')
455                 {
456                   idx += 2;
457                   cattext (dst, "\nENDDD\n");
458                   break;
459                 }
460               else
461                 {
462                   catchar (dst, at (src, idx));
463                   idx++;
464                 }
465             }
466         }
467       else
468         idx++;
469     }
470 }
471
472 static void
473 print_stack_level ()
474 {
475   fprintf (stderr, "current string stack depth = %d, ", tos - stack);
476   fprintf (stderr, "current integer stack depth = %d\n", isp - istack);
477   pc++;
478 }
479
480 /* turn:
481      foobar name(stuff);
482    into:
483      foobar
484      name PARAMS ((stuff));
485    and a blank line.
486  */
487
488 static void
489 paramstuff ()
490 {
491   unsigned int openp;
492   unsigned int fname;
493   unsigned int idx;
494   unsigned int len;
495   string_type out;
496   init_string (&out);
497
498 #define NO_PARAMS 1
499
500   /* Make sure that it's not already param'd or proto'd.  */
501   if (NO_PARAMS
502       || find (tos, "PARAMS") || find (tos, "PROTO") || !find (tos, "("))
503     {
504       catstr (&out, tos);
505     }
506   else
507     {
508       /* Find the open paren.  */
509       for (openp = 0; at (tos, openp) != '(' && at (tos, openp); openp++)
510         ;
511
512       fname = openp;
513       /* Step back to the fname.  */
514       fname--;
515       while (fname && isspace ((unsigned char) at (tos, fname)))
516         fname--;
517       while (fname
518              && !isspace ((unsigned char) at (tos,fname))
519              && at (tos,fname) != '*')
520         fname--;
521
522       fname++;
523
524       /* Output type, omitting trailing whitespace character(s), if
525          any.  */
526       for (len = fname; 0 < len; len--)
527         {
528           if (!isspace ((unsigned char) at (tos, len - 1)))
529             break;
530         }
531       for (idx = 0; idx < len; idx++)
532         catchar (&out, at (tos, idx));
533
534       cattext (&out, "\n");     /* Insert a newline between type and fnname */
535
536       /* Output function name, omitting trailing whitespace
537          character(s), if any.  */
538       for (len = openp; 0 < len; len--)
539         {
540           if (!isspace ((unsigned char) at (tos, len - 1)))
541             break;
542         }
543       for (idx = fname; idx < len; idx++)
544         catchar (&out, at (tos, idx));
545
546       cattext (&out, " PARAMS (");
547
548       for (idx = openp; at (tos, idx) && at (tos, idx) != ';'; idx++)
549         catchar (&out, at (tos, idx));
550
551       cattext (&out, ");\n\n");
552     }
553   overwrite_string (tos, &out);
554   pc++;
555
556 }
557
558 /* turn {*
559    and *} into comments */
560
561 static void
562 translatecomments ()
563 {
564   unsigned int idx = 0;
565   string_type out;
566   init_string (&out);
567
568   while (at (tos, idx))
569     {
570       if (at (tos, idx) == '{' && at (tos, idx + 1) == '*')
571         {
572           cattext (&out, "/*");
573           idx += 2;
574         }
575       else if (at (tos, idx) == '*' && at (tos, idx + 1) == '}')
576         {
577           cattext (&out, "*/");
578           idx += 2;
579         }
580       else
581         {
582           catchar (&out, at (tos, idx));
583           idx++;
584         }
585     }
586
587   overwrite_string (tos, &out);
588
589   pc++;
590 }
591
592 /* Mod tos so that only lines with leading dots remain */
593 static void
594 outputdots ()
595 {
596   unsigned int idx = 0;
597   string_type out;
598   init_string (&out);
599
600   while (at (tos, idx))
601     {
602       if (at (tos, idx) == '\n' && at (tos, idx + 1) == '.')
603         {
604           char c;
605           idx += 2;
606
607           while ((c = at (tos, idx)) && c != '\n')
608             {
609               if (c == '{' && at (tos, idx + 1) == '*')
610                 {
611                   cattext (&out, "/*");
612                   idx += 2;
613                 }
614               else if (c == '*' && at (tos, idx + 1) == '}')
615                 {
616                   cattext (&out, "*/");
617                   idx += 2;
618                 }
619               else
620                 {
621                   catchar (&out, c);
622                   idx++;
623                 }
624             }
625           catchar (&out, '\n');
626         }
627       else
628         {
629           idx++;
630         }
631     }
632
633   overwrite_string (tos, &out);
634   pc++;
635 }
636
637 /* Find lines starting with . and | and put example around them on tos */
638 static void
639 courierize ()
640 {
641   string_type out;
642   unsigned int idx = 0;
643   int command = 0;
644
645   init_string (&out);
646
647   while (at (tos, idx))
648     {
649       if (at (tos, idx) == '\n'
650           && (at (tos, idx +1 ) == '.'
651               || at (tos, idx + 1) == '|'))
652         {
653           cattext (&out, "\n@example\n");
654           do
655             {
656               idx += 2;
657
658               while (at (tos, idx) && at (tos, idx) != '\n')
659                 {
660                   if (command > 1)
661                     {
662                       /* We are inside {} parameters of some command;
663                          Just pass through until matching brace.  */
664                       if (at (tos, idx) == '{')
665                         ++command;
666                       else if (at (tos, idx) == '}')
667                         --command;
668                     }
669                   else if (command != 0)
670                     {
671                       if (at (tos, idx) == '{')
672                         ++command;
673                       else if (!islower ((unsigned char) at (tos, idx)))
674                         --command;
675                     }
676                   else if (at (tos, idx) == '@'
677                            && islower ((unsigned char) at (tos, idx + 1)))
678                     {
679                       ++command;
680                     }
681                   else if (at (tos, idx) == '{' && at (tos, idx + 1) == '*')
682                     {
683                       cattext (&out, "/*");
684                       idx += 2;
685                       continue;
686                     }
687                   else if (at (tos, idx) == '*' && at (tos, idx + 1) == '}')
688                     {
689                       cattext (&out, "*/");
690                       idx += 2;
691                       continue;
692                     }
693                   else if (at (tos, idx) == '{'
694                            || at (tos, idx) == '}')
695                     {
696                       catchar (&out, '@');
697                     }
698
699                   catchar (&out, at (tos, idx));
700                   idx++;
701                 }
702               catchar (&out, '\n');
703             }
704           while (at (tos, idx) == '\n'
705                  && ((at (tos, idx + 1) == '.')
706                      || (at (tos, idx + 1) == '|')))
707             ;
708           cattext (&out, "@end example");
709         }
710       else
711         {
712           catchar (&out, at (tos, idx));
713           idx++;
714         }
715     }
716
717   overwrite_string (tos, &out);
718   pc++;
719 }
720
721 /* Finds any lines starting with "o ", if there are any, then turns
722    on @itemize @bullet, and @items each of them. Then ends with @end
723    itemize, inplace at TOS*/
724
725 static void
726 bulletize ()
727 {
728   unsigned int idx = 0;
729   int on = 0;
730   string_type out;
731   init_string (&out);
732
733   while (at (tos, idx))
734     {
735       if (at (tos, idx) == '@'
736           && at (tos, idx + 1) == '*')
737         {
738           cattext (&out, "*");
739           idx += 2;
740         }
741       else if (at (tos, idx) == '\n'
742                && at (tos, idx + 1) == 'o'
743                && isspace ((unsigned char) at (tos, idx + 2)))
744         {
745           if (!on)
746             {
747               cattext (&out, "\n@itemize @bullet\n");
748               on = 1;
749
750             }
751           cattext (&out, "\n@item\n");
752           idx += 3;
753         }
754       else
755         {
756           catchar (&out, at (tos, idx));
757           if (on && at (tos, idx) == '\n'
758               && at (tos, idx + 1) == '\n'
759               && at (tos, idx + 2) != 'o')
760             {
761               cattext (&out, "@end itemize");
762               on = 0;
763             }
764           idx++;
765
766         }
767     }
768   if (on)
769     {
770       cattext (&out, "@end itemize\n");
771     }
772
773   delete_string (tos);
774   *tos = out;
775   pc++;
776 }
777
778 /* Turn <<foo>> into @code{foo} in place at TOS*/
779
780 static void
781 do_fancy_stuff ()
782 {
783   unsigned int idx = 0;
784   string_type out;
785   init_string (&out);
786   while (at (tos, idx))
787     {
788       if (at (tos, idx) == '<'
789           && at (tos, idx + 1) == '<'
790           && !isspace ((unsigned char) at (tos, idx + 2)))
791         {
792           /* This qualifies as a << startup.  */
793           idx += 2;
794           cattext (&out, "@code{");
795           while (at (tos, idx)
796                  && at (tos, idx) != '>' )
797             {
798               catchar (&out, at (tos, idx));
799               idx++;
800
801             }
802           cattext (&out, "}");
803           idx += 2;
804         }
805       else
806         {
807           catchar (&out, at (tos, idx));
808           idx++;
809         }
810     }
811   delete_string (tos);
812   *tos = out;
813   pc++;
814
815 }
816
817 /* A command is all upper case,and alone on a line.  */
818
819 static int
820 iscommand (ptr, idx)
821      string_type *ptr;
822      unsigned int idx;
823 {
824   unsigned int len = 0;
825   while (at (ptr, idx))
826     {
827       if (isupper ((unsigned char) at (ptr, idx))
828           || at (ptr, idx) == ' ' || at (ptr, idx) == '_')
829         {
830           len++;
831           idx++;
832         }
833       else if (at (ptr, idx) == '\n')
834         {
835           if (len > 3)
836             return 1;
837           return 0;
838         }
839       else
840         return 0;
841     }
842   return 0;
843 }
844
845 static int
846 copy_past_newline (ptr, idx, dst)
847      string_type *ptr;
848      unsigned int idx;
849      string_type *dst;
850 {
851   int column = 0;
852
853   while (at (ptr, idx) && at (ptr, idx) != '\n')
854     {
855       if (at (ptr, idx) == '\t')
856         {
857           /* Expand tabs.  Neither makeinfo nor TeX can cope well with
858              them.  */
859           do
860             catchar (dst, ' ');
861           while (++column & 7);
862         }
863       else
864         {
865           catchar (dst, at (ptr, idx));
866           column++;
867         }
868       idx++;
869
870     }
871   catchar (dst, at (ptr, idx));
872   idx++;
873   return idx;
874
875 }
876
877 static void
878 icopy_past_newline ()
879 {
880   tos++;
881   check_range ();
882   init_string (tos);
883   idx = copy_past_newline (ptr, idx, tos);
884   pc++;
885 }
886
887 /* indent
888    Take the string at the top of the stack, do some prettying.  */
889
890 static void
891 kill_bogus_lines ()
892 {
893   int sl;
894
895   int idx = 0;
896   int c;
897   int dot = 0;
898
899   string_type out;
900   init_string (&out);
901   /* Drop leading nl.  */
902   while (at (tos, idx) == '\n')
903     {
904       idx++;
905     }
906   c = idx;
907
908   /* If the first char is a '.' prepend a newline so that it is
909      recognized properly later.  */
910   if (at (tos, idx) == '.')
911     catchar (&out, '\n');
912
913   /* Find the last char.  */
914   while (at (tos, idx))
915     {
916       idx++;
917     }
918
919   /* Find the last non white before the nl.  */
920   idx--;
921
922   while (idx && isspace ((unsigned char) at (tos, idx)))
923     idx--;
924   idx++;
925
926   /* Copy buffer upto last char, but blank lines before and after
927      dots don't count.  */
928   sl = 1;
929
930   while (c < idx)
931     {
932       if (at (tos, c) == '\n'
933           && at (tos, c + 1) == '\n'
934           && at (tos, c + 2) == '.')
935         {
936           /* Ignore two newlines before a dot.  */
937           c++;
938         }
939       else if (at (tos, c) == '.' && sl)
940         {
941           /* remember that this line started with a dot.  */
942           dot = 2;
943         }
944       else if (at (tos, c) == '\n'
945                && at (tos, c + 1) == '\n'
946                && dot)
947         {
948           c++;
949           /* Ignore two newlines when last line was dot.  */
950         }
951
952       catchar (&out, at (tos, c));
953       if (at (tos, c) == '\n')
954         {
955           sl = 1;
956
957           if (dot == 2)
958             dot = 1;
959           else
960             dot = 0;
961         }
962       else
963         sl = 0;
964
965       c++;
966
967     }
968
969   /* Append nl.  */
970   catchar (&out, '\n');
971   pc++;
972   delete_string (tos);
973   *tos = out;
974
975 }
976
977 static void
978 indent ()
979 {
980   string_type out;
981   int tab = 0;
982   int idx = 0;
983   int ol = 0;
984   init_string (&out);
985   while (at (tos, idx))
986     {
987       switch (at (tos, idx))
988         {
989         case '\n':
990           cattext (&out, "\n");
991           idx++;
992           if (tab && at (tos, idx))
993             {
994               cattext (&out, "    ");
995             }
996           ol = 0;
997           break;
998         case '(':
999           tab++;
1000           if (ol == 0)
1001             cattext (&out, "   ");
1002           idx++;
1003           cattext (&out, "(");
1004           ol = 1;
1005           break;
1006         case ')':
1007           tab--;
1008           cattext (&out, ")");
1009           idx++;
1010           ol = 1;
1011
1012           break;
1013         default:
1014           catchar (&out, at (tos, idx));
1015           ol = 1;
1016
1017           idx++;
1018           break;
1019         }
1020     }
1021
1022   pc++;
1023   delete_string (tos);
1024   *tos = out;
1025
1026 }
1027
1028 static void
1029 get_stuff_in_command ()
1030 {
1031   tos++;
1032   check_range ();
1033   init_string (tos);
1034
1035   while (at (ptr, idx))
1036     {
1037       if (iscommand (ptr, idx))
1038         break;
1039       idx = copy_past_newline (ptr, idx, tos);
1040     }
1041   pc++;
1042 }
1043
1044 static void
1045 swap ()
1046 {
1047   string_type t;
1048
1049   t = tos[0];
1050   tos[0] = tos[-1];
1051   tos[-1] = t;
1052   pc++;
1053 }
1054
1055 static void
1056 other_dup ()
1057 {
1058   tos++;
1059   check_range ();
1060   init_string (tos);
1061   catstr (tos, tos - 1);
1062   pc++;
1063 }
1064
1065 static void
1066 drop ()
1067 {
1068   tos--;
1069   check_range ();
1070   pc++;
1071 }
1072
1073 static void
1074 idrop ()
1075 {
1076   isp--;
1077   icheck_range ();
1078   pc++;
1079 }
1080
1081 static void
1082 icatstr ()
1083 {
1084   tos--;
1085   check_range ();
1086   catstr (tos, tos + 1);
1087   delete_string (tos + 1);
1088   pc++;
1089 }
1090
1091 static void
1092 skip_past_newline ()
1093 {
1094   while (at (ptr, idx)
1095          && at (ptr, idx) != '\n')
1096     idx++;
1097   idx++;
1098   pc++;
1099 }
1100
1101 static void
1102 internalmode ()
1103 {
1104   internal_mode = *(isp);
1105   isp--;
1106   icheck_range ();
1107   pc++;
1108 }
1109
1110 static void
1111 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 ()
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 ()
1381 {
1382   *(long *) ((isp[0])) = isp[-1];
1383   isp -= 2;
1384   icheck_range ();
1385   pc++;
1386 }
1387
1388 static void
1389 atsign ()
1390 {
1391   isp[0] = *(long *) (isp[0]);
1392   pc++;
1393 }
1394
1395 static void
1396 hello ()
1397 {
1398   printf ("hello\n");
1399   pc++;
1400 }
1401
1402 static void
1403 stdout_ ()
1404 {
1405   isp++;
1406   icheck_range ();
1407   *isp = 1;
1408   pc++;
1409 }
1410
1411 static void
1412 stderr_ ()
1413 {
1414   isp++;
1415   icheck_range ();
1416   *isp = 2;
1417   pc++;
1418 }
1419
1420 static void
1421 print ()
1422 {
1423   if (*isp == 1)
1424     write_buffer (tos, stdout);
1425   else if (*isp == 2)
1426     write_buffer (tos, stderr);
1427   else
1428     fprintf (stderr, "print: illegal print destination `%ld'\n", *isp);
1429   isp--;
1430   tos--;
1431   icheck_range ();
1432   check_range ();
1433   pc++;
1434 }
1435
1436 static void
1437 read_in (str, file)
1438      string_type *str;
1439      FILE *file;
1440 {
1441   char buff[10000];
1442   unsigned int r;
1443   do
1444     {
1445       r = fread (buff, 1, sizeof (buff), file);
1446       catbuf (str, buff, r);
1447     }
1448   while (r);
1449   buff[0] = 0;
1450
1451   catbuf (str, buff, 1);
1452 }
1453
1454 static void
1455 usage ()
1456 {
1457   fprintf (stderr, "usage: -[d|i|g] <file >file\n");
1458   exit (33);
1459 }
1460
1461 /* There is no reliable way to declare exit.  Sometimes it returns
1462    int, and sometimes it returns void.  Sometimes it changes between
1463    OS releases.  Trying to get it declared correctly in the hosts file
1464    is a pointless waste of time.  */
1465
1466 static void
1467 chew_exit ()
1468 {
1469   exit (0);
1470 }
1471
1472 int
1473 main (ac, av)
1474      int ac;
1475      char *av[];
1476 {
1477   unsigned int i;
1478   string_type buffer;
1479   string_type pptr;
1480
1481   init_string (&buffer);
1482   init_string (&pptr);
1483   init_string (stack + 0);
1484   tos = stack + 1;
1485   ptr = &pptr;
1486
1487   add_intrinsic ("push_text", push_text);
1488   add_intrinsic ("!", bang);
1489   add_intrinsic ("@", atsign);
1490   add_intrinsic ("hello", hello);
1491   add_intrinsic ("stdout", stdout_);
1492   add_intrinsic ("stderr", stderr_);
1493   add_intrinsic ("print", print);
1494   add_intrinsic ("skip_past_newline", skip_past_newline);
1495   add_intrinsic ("catstr", icatstr);
1496   add_intrinsic ("copy_past_newline", icopy_past_newline);
1497   add_intrinsic ("dup", other_dup);
1498   add_intrinsic ("drop", drop);
1499   add_intrinsic ("idrop", idrop);
1500   add_intrinsic ("remchar", remchar);
1501   add_intrinsic ("get_stuff_in_command", get_stuff_in_command);
1502   add_intrinsic ("do_fancy_stuff", do_fancy_stuff);
1503   add_intrinsic ("bulletize", bulletize);
1504   add_intrinsic ("courierize", courierize);
1505   /* If the following line gives an error, exit() is not declared in the
1506      ../hosts/foo.h file for this host.  Fix it there, not here!  */
1507   /* No, don't fix it anywhere; see comment on chew_exit--Ian Taylor.  */
1508   add_intrinsic ("exit", chew_exit);
1509   add_intrinsic ("swap", swap);
1510   add_intrinsic ("outputdots", outputdots);
1511   add_intrinsic ("paramstuff", paramstuff);
1512   add_intrinsic ("maybecatstr", maybecatstr);
1513   add_intrinsic ("translatecomments", translatecomments);
1514   add_intrinsic ("kill_bogus_lines", kill_bogus_lines);
1515   add_intrinsic ("indent", indent);
1516   add_intrinsic ("internalmode", internalmode);
1517   add_intrinsic ("print_stack_level", print_stack_level);
1518   add_intrinsic ("strip_trailing_newlines", strip_trailing_newlines);
1519
1520   /* Put a nl at the start.  */
1521   catchar (&buffer, '\n');
1522
1523   read_in (&buffer, stdin);
1524   remove_noncomments (&buffer, ptr);
1525   for (i = 1; i < (unsigned int) ac; i++)
1526     {
1527       if (av[i][0] == '-')
1528         {
1529           if (av[i][1] == 'f')
1530             {
1531               string_type b;
1532               FILE *f;
1533               init_string (&b);
1534
1535               f = fopen (av[i + 1], "r");
1536               if (!f)
1537                 {
1538                   fprintf (stderr, "Can't open the input file %s\n",
1539                            av[i + 1]);
1540                   return 33;
1541                 }
1542
1543               read_in (&b, f);
1544               compile (b.ptr);
1545               perform ();
1546             }
1547           else if (av[i][1] == 'i')
1548             {
1549               internal_wanted = 1;
1550             }
1551           else if (av[i][1] == 'w')
1552             {
1553               warning = 1;
1554             }
1555           else
1556             usage ();
1557         }
1558     }
1559   write_buffer (stack + 0, stdout);
1560   if (tos != stack)
1561     {
1562       fprintf (stderr, "finishing with current stack level %d\n",
1563                tos - stack);
1564       return 1;
1565     }
1566   return 0;
1567 }