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