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