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