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