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