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