1/* chew
2   Copyright (C) 1990-2017 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
94int internal_wanted;
95int internal_mode;
96
97int warning;
98
99/* Here is a string type ...  */
100
101typedef struct buffer
102{
103  char *ptr;
104  unsigned long write_idx;
105  unsigned long size;
106} string_type;
107
108#ifdef __STDC__
109static void init_string_with_size (string_type *, unsigned int);
110static void init_string (string_type *);
111static int find (string_type *, char *);
112static void write_buffer (string_type *, FILE *);
113static void delete_string (string_type *);
114static char *addr (string_type *, unsigned int);
115static char at (string_type *, unsigned int);
116static void catchar (string_type *, int);
117static void overwrite_string (string_type *, string_type *);
118static void catbuf (string_type *, char *, unsigned int);
119static void cattext (string_type *, char *);
120static void catstr (string_type *, string_type *);
121static void die (char *);
122#endif
123
124static void
125init_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
134static void
135init_string (buffer)
136     string_type *buffer;
137{
138  init_string_with_size (buffer, DEF_SIZE);
139}
140
141static int
142find (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
159static void
160write_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
169static void
170delete_string (buffer)
171     string_type *buffer;
172{
173  if (buffer->ptr)
174    free (buffer->ptr);
175  buffer->ptr = NULL;
176}
177
178static char *
179addr (buffer, idx)
180     string_type *buffer;
181     unsigned int idx;
182{
183  return buffer->ptr + idx;
184}
185
186static char
187at (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
196static void
197catchar (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
210static void
211overwrite_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
221static void
222catbuf (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
237static void
238cattext (buffer, string)
239     string_type *buffer;
240     char *string;
241{
242  catbuf (buffer, string, (unsigned int) strlen (string));
243}
244
245static void
246catstr (dst, src)
247     string_type *dst;
248     string_type *src;
249{
250  catbuf (dst, src->ptr, src->write_idx);
251}
252
253static unsigned int
254skip_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
270static unsigned int
271skip_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
285string_type stack[STACK];
286string_type *tos;
287
288unsigned int idx = 0; /* Pos in input buffer */
289string_type *ptr; /* and the buffer */
290typedef void (*stinst_type)();
291stinst_type *pc;
292stinst_type sstack[STACK];
293stinst_type *ssp = &sstack[0];
294long istack[STACK];
295long *isp = &istack[0];
296
297typedef int *word_type;
298
299struct 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
309typedef struct dict_struct dict_type;
310
311static void
312die (msg)
313     char *msg;
314{
315  fprintf (stderr, "%s\n", msg);
316  exit (1);
317}
318
319static void
320check_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
328static void
329icheck_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__
338static void exec (dict_type *);
339static void call (void);
340static void remchar (void), strip_trailing_newlines (void), push_number (void);
341static void push_text (void);
342static void remove_noncomments (string_type *, string_type *);
343static void print_stack_level (void);
344static void paramstuff (void), translatecomments (void);
345static void outputdots (void), courierize (void), bulletize (void);
346static void do_fancy_stuff (void);
347static int iscommand (string_type *, unsigned int);
348static int copy_past_newline (string_type *, unsigned int, string_type *);
349static void icopy_past_newline (void), kill_bogus_lines (void), indent (void);
350static void get_stuff_in_command (void), swap (void), other_dup (void);
351static void drop (void), idrop (void);
352static void icatstr (void), skip_past_newline (void), internalmode (void);
353static void maybecatstr (void);
354static char *nextword (char *, char **);
355dict_type *lookup_word (char *);
356static void perform (void);
357dict_type *newentry (char *);
358unsigned int add_to_definition (dict_type *, stinst_type);
359void add_intrinsic (char *, void (*)());
360void add_var (char *);
361void compile (char *);
362static void bang (void);
363static void atsign (void);
364static void hello (void);
365static void stdout_ (void);
366static void stderr_ (void);
367static void print (void);
368static void read_in (string_type *, FILE *);
369static void usage (void);
370static void chew_exit (void);
371#endif
372
373static void
374exec (word)
375     dict_type *word;
376{
377  pc = word->code;
378  while (*pc)
379    (*pc) ();
380}
381
382static void
383call ()
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
392static void
393remchar ()
394{
395  if (tos->write_idx)
396    tos->write_idx--;
397  pc++;
398}
399
400static void
401strip_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
410static void
411push_number ()
412{
413  isp++;
414  icheck_range ();
415  pc++;
416  *isp = (long) (*pc);
417  pc++;
418}
419
420static void
421push_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
436static void
437remove_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
489static void
490print_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
507static void
508paramstuff ()
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
580static void
581translatecomments ()
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 */
612static void
613outputdots ()
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 */
661static void
662courierize ()
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
748static void
749bulletize ()
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
803static void
804do_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
842static int
843iscommand (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
868static int
869copy_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
900static void
901icopy_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
913static void
914kill_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
1000static void
1001indent ()
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
1051static void
1052get_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
1067static void
1068swap ()
1069{
1070  string_type t;
1071
1072  t = tos[0];
1073  tos[0] = tos[-1];
1074  tos[-1] = t;
1075  pc++;
1076}
1077
1078static void
1079other_dup ()
1080{
1081  tos++;
1082  check_range ();
1083  init_string (tos);
1084  catstr (tos, tos - 1);
1085  pc++;
1086}
1087
1088static void
1089drop ()
1090{
1091  tos--;
1092  check_range ();
1093  delete_string (tos + 1);
1094  pc++;
1095}
1096
1097static void
1098idrop ()
1099{
1100  isp--;
1101  icheck_range ();
1102  pc++;
1103}
1104
1105static void
1106icatstr ()
1107{
1108  tos--;
1109  check_range ();
1110  catstr (tos, tos + 1);
1111  delete_string (tos + 1);
1112  pc++;
1113}
1114
1115static void
1116skip_past_newline ()
1117{
1118  idx = skip_past_newline_1 (ptr, idx);
1119  pc++;
1120}
1121
1122static void
1123internalmode ()
1124{
1125  internal_mode = *(isp);
1126  isp--;
1127  icheck_range ();
1128  pc++;
1129}
1130
1131static void
1132maybecatstr ()
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
1144char *
1145nextword (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
1231dict_type *root;
1232
1233dict_type *
1234lookup_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
1249static void
1250free_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_length; i ++)
1264	    if (ptr->code[i] == push_text
1265		&& ptr->code[i + 1])
1266	      {
1267		free (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
1278static void
1279perform ()
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
1312dict_type *
1313newentry (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
1326unsigned int
1327add_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
1343void
1344add_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
1353void
1354add_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
1363void
1364compile (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
1438static void
1439bang ()
1440{
1441  *(long *) ((isp[0])) = isp[-1];
1442  isp -= 2;
1443  icheck_range ();
1444  pc++;
1445}
1446
1447static void
1448atsign ()
1449{
1450  isp[0] = *(long *) (isp[0]);
1451  pc++;
1452}
1453
1454static void
1455hello ()
1456{
1457  printf ("hello\n");
1458  pc++;
1459}
1460
1461static void
1462stdout_ ()
1463{
1464  isp++;
1465  icheck_range ();
1466  *isp = 1;
1467  pc++;
1468}
1469
1470static void
1471stderr_ ()
1472{
1473  isp++;
1474  icheck_range ();
1475  *isp = 2;
1476  pc++;
1477}
1478
1479static void
1480print ()
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
1495static void
1496read_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
1513static void
1514usage ()
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
1525static void
1526chew_exit ()
1527{
1528  exit (0);
1529}
1530
1531int
1532main (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}
1631