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