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