| /* chew |
| Copyright (C) 1990, 91, 92, 93, 94, 95, 96, 1998 |
| Free Software Foundation, Inc. |
| Contributed by steve chamberlain @cygnus |
| |
| This file is part of BFD, the Binary File Descriptor library. |
| |
| This program is free software; you can redistribute it and/or modify |
| it under the terms of the GNU General Public License as published by |
| the Free Software Foundation; either version 2 of the License, or |
| (at your option) any later version. |
| |
| This program is distributed in the hope that it will be useful, |
| but WITHOUT ANY WARRANTY; without even the implied warranty of |
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| GNU General Public License for more details. |
| |
| You should have received a copy of the GNU General Public License |
| along with this program; if not, write to the Free Software |
| Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ |
| |
| /* Yet another way of extracting documentation from source. |
| No, I haven't finished it yet, but I hope you people like it better |
| than the old way |
| |
| sac |
| |
| Basically, this is a sort of string forth, maybe we should call it |
| struth? |
| |
| You define new words thus: |
| : <newword> <oldwords> ; |
| |
| */ |
| |
| /* Primitives provided by the program: |
| |
| Two stacks are provided, a string stack and an integer stack. |
| |
| Internal state variables: |
| internal_wanted - indicates whether `-i' was passed |
| internal_mode - user-settable |
| |
| Commands: |
| push_text |
| ! - pop top of integer stack for address, pop next for value; store |
| @ - treat value on integer stack as the address of an integer; push |
| that integer on the integer stack after popping the "address" |
| hello - print "hello\n" to stdout |
| stdout - put stdout marker on TOS |
| stderr - put stderr marker on TOS |
| print - print TOS-1 on TOS (eg: "hello\n" stdout print) |
| skip_past_newline |
| catstr - fn icatstr |
| copy_past_newline - append input, up to and including newline into TOS |
| dup - fn other_dup |
| drop - discard TOS |
| idrop - ditto |
| remchar - delete last character from TOS |
| get_stuff_in_command |
| do_fancy_stuff - translate <<foo>> to @code{foo} in TOS |
| bulletize - if "o" lines found, prepend @itemize @bullet to TOS |
| and @item to each "o" line; append @end itemize |
| courierize - put @example around . and | lines, translate {* *} { } |
| exit - fn chew_exit |
| swap |
| outputdots - strip out lines without leading dots |
| paramstuff - convert full declaration into "PARAMS" form if not already |
| maybecatstr - do catstr if internal_mode == internal_wanted, discard |
| value in any case |
| translatecomments - turn {* and *} into comment delimiters |
| kill_bogus_lines - get rid of extra newlines |
| indent |
| internalmode - pop from integer stack, set `internalmode' to that value |
| print_stack_level - print current stack depth to stderr |
| strip_trailing_newlines - go ahead, guess... |
| [quoted string] - push string onto string stack |
| [word starting with digit] - push atol(str) onto integer stack |
| |
| A command must be all upper-case, and alone on a line. |
| |
| Foo. */ |
| |
| |
| #include <ansidecl.h> |
| #include "sysdep.h" |
| #include <assert.h> |
| #include <stdio.h> |
| #include <ctype.h> |
| |
| #define DEF_SIZE 5000 |
| #define STACK 50 |
| |
| int internal_wanted; |
| int internal_mode; |
| |
| int warning; |
| |
| /* Here is a string type ... */ |
| |
| typedef struct buffer |
| { |
| char *ptr; |
| unsigned long write_idx; |
| unsigned long size; |
| } string_type; |
| |
| |
| #ifdef __STDC__ |
| static void init_string_with_size (string_type *, unsigned int); |
| static void init_string (string_type *); |
| static int find (string_type *, char *); |
| static void write_buffer (string_type *, FILE *); |
| static void delete_string (string_type *); |
| static char *addr (string_type *, unsigned int); |
| static char at (string_type *, unsigned int); |
| static void catchar (string_type *, int); |
| static void overwrite_string (string_type *, string_type *); |
| static void catbuf (string_type *, char *, unsigned int); |
| static void cattext (string_type *, char *); |
| static void catstr (string_type *, string_type *); |
| #endif |
| |
| |
| static void DEFUN(init_string_with_size,(buffer, size), |
| string_type *buffer AND |
| unsigned int size ) |
| { |
| buffer->write_idx = 0; |
| buffer->size = size; |
| buffer->ptr = malloc(size); |
| } |
| |
| static void DEFUN(init_string,(buffer), |
| string_type *buffer) |
| { |
| init_string_with_size(buffer, DEF_SIZE); |
| |
| } |
| |
| static int DEFUN(find, (str, what), |
| string_type *str AND |
| char *what) |
| { |
| unsigned int i; |
| char *p; |
| p = what; |
| for (i = 0; i < str->write_idx && *p; i++) |
| { |
| if (*p == str->ptr[i]) |
| p++; |
| else |
| p = what; |
| } |
| return (*p == 0); |
| |
| } |
| |
| static void DEFUN(write_buffer,(buffer, f), |
| string_type *buffer AND |
| FILE *f) |
| { |
| fwrite(buffer->ptr, buffer->write_idx, 1, f); |
| } |
| |
| |
| static void DEFUN(delete_string,(buffer), |
| string_type *buffer) |
| { |
| free(buffer->ptr); |
| } |
| |
| |
| static char *DEFUN(addr, (buffer, idx), |
| string_type *buffer AND |
| unsigned int idx) |
| { |
| return buffer->ptr + idx; |
| } |
| |
| static char DEFUN(at,(buffer, pos), |
| string_type *buffer AND |
| unsigned int pos) |
| { |
| if (pos >= buffer->write_idx) |
| return 0; |
| return buffer->ptr[pos]; |
| } |
| |
| static void DEFUN(catchar,(buffer, ch), |
| string_type *buffer AND |
| int ch) |
| { |
| if (buffer->write_idx == buffer->size) |
| { |
| buffer->size *=2; |
| buffer->ptr = realloc(buffer->ptr, buffer->size); |
| } |
| |
| buffer->ptr[buffer->write_idx ++ ] = ch; |
| } |
| |
| |
| static void DEFUN(overwrite_string,(dst, src), |
| string_type *dst AND |
| string_type *src) |
| { |
| free(dst->ptr); |
| dst->size = src->size; |
| dst->write_idx = src->write_idx; |
| dst->ptr = src->ptr; |
| } |
| |
| static void DEFUN(catbuf,(buffer, buf, len), |
| string_type *buffer AND |
| char *buf AND |
| unsigned int len) |
| { |
| if (buffer->write_idx + len >= buffer->size) |
| { |
| while (buffer->write_idx + len >= buffer->size) |
| buffer->size *= 2; |
| buffer->ptr = realloc (buffer->ptr, buffer->size); |
| } |
| memcpy (buffer->ptr + buffer->write_idx, buf, len); |
| buffer->write_idx += len; |
| } |
| |
| static void DEFUN(cattext,(buffer, string), |
| string_type *buffer AND |
| char *string) |
| { |
| catbuf (buffer, string, (unsigned int) strlen (string)); |
| } |
| |
| static void DEFUN(catstr,(dst, src), |
| string_type *dst AND |
| string_type *src) |
| { |
| catbuf (dst, src->ptr, src->write_idx); |
| } |
| |
| |
| static unsigned int |
| DEFUN(skip_white_and_stars,(src, idx), |
| string_type *src AND |
| unsigned int idx) |
| { |
| char c; |
| while ((c = at(src,idx)), |
| isspace ((unsigned char) c) |
| || (c == '*' |
| /* Don't skip past end-of-comment or star as first |
| character on its line. */ |
| && at(src,idx +1) != '/' |
| && at(src,idx -1) != '\n')) |
| idx++; |
| return idx; |
| } |
| |
| /***********************************************************************/ |
| |
| |
| string_type stack[STACK]; |
| string_type *tos; |
| |
| unsigned int idx = 0; /* Pos in input buffer */ |
| string_type *ptr; /* and the buffer */ |
| typedef void (*stinst_type)(); |
| stinst_type *pc; |
| stinst_type sstack[STACK]; |
| stinst_type *ssp = &sstack[0]; |
| long istack[STACK]; |
| long *isp = &istack[0]; |
| |
| typedef int *word_type; |
| |
| |
| |
| struct dict_struct |
| { |
| char *word; |
| struct dict_struct *next; |
| stinst_type *code; |
| int code_length; |
| int code_end; |
| int var; |
| |
| }; |
| typedef struct dict_struct dict_type; |
| #define WORD(x) static void x() |
| |
| static void |
| die (msg) |
| char *msg; |
| { |
| fprintf (stderr, "%s\n", msg); |
| exit (1); |
| } |
| |
| static void |
| check_range () |
| { |
| if (tos < stack) |
| die ("underflow in string stack"); |
| if (tos >= stack + STACK) |
| die ("overflow in string stack"); |
| } |
| |
| static void |
| icheck_range () |
| { |
| if (isp < istack) |
| die ("underflow in integer stack"); |
| if (isp >= istack + STACK) |
| die ("overflow in integer stack"); |
| } |
| |
| #ifdef __STDC__ |
| static void exec (dict_type *); |
| static void call (void); |
| static void remchar (void), strip_trailing_newlines (void), push_number (void); |
| static void push_text (void); |
| static void remove_noncomments (string_type *, string_type *); |
| static void print_stack_level (void); |
| static void paramstuff (void), translatecomments (void); |
| static void outputdots (void), courierize (void), bulletize (void); |
| static void do_fancy_stuff (void); |
| static int iscommand (string_type *, unsigned int); |
| static int copy_past_newline (string_type *, unsigned int, string_type *); |
| static void icopy_past_newline (void), kill_bogus_lines (void), indent (void); |
| static void get_stuff_in_command (void), swap (void), other_dup (void); |
| static void drop (void), idrop (void); |
| static void icatstr (void), skip_past_newline (void), internalmode (void); |
| static void maybecatstr (void); |
| static char *nextword (char *, char **); |
| dict_type *lookup_word (char *); |
| static void perform (void); |
| dict_type *newentry (char *); |
| unsigned int add_to_definition (dict_type *, stinst_type); |
| void add_intrinsic (char *, void (*)()); |
| void add_var (char *); |
| void compile (char *); |
| static void bang (void); |
| static void atsign (void); |
| static void hello (void); |
| static void stdout_ (void); |
| static void stderr_ (void); |
| static void print (void); |
| static void read_in (string_type *, FILE *); |
| static void usage (void); |
| static void chew_exit (void); |
| #endif |
| |
| static void DEFUN(exec,(word), |
| dict_type *word) |
| { |
| pc = word->code; |
| while (*pc) |
| (*pc)(); |
| } |
| WORD(call) |
| { |
| stinst_type *oldpc = pc; |
| dict_type *e; |
| e = (dict_type *)(pc [1]); |
| exec(e); |
| pc = oldpc + 2; |
| |
| } |
| |
| WORD(remchar) |
| { |
| if (tos->write_idx) |
| tos->write_idx--; |
| pc++; |
| } |
| |
| static void |
| strip_trailing_newlines () |
| { |
| while ((isspace ((unsigned char) at (tos, tos->write_idx - 1)) |
| || at (tos, tos->write_idx - 1) == '\n') |
| && tos->write_idx > 0) |
| tos->write_idx--; |
| pc++; |
| } |
| |
| WORD(push_number) |
| { |
| isp++; |
| icheck_range (); |
| pc++; |
| *isp = (long)(*pc); |
| pc++; |
| } |
| |
| WORD(push_text) |
| { |
| tos++; |
| check_range (); |
| init_string(tos); |
| pc++; |
| cattext(tos,*((char **)pc)); |
| pc++; |
| |
| } |
| |
| |
| /* This function removes everything not inside comments starting on |
| the first char of the line from the string, also when copying |
| comments, removes blank space and leading *'s. |
| Blank lines are turned into one blank line. */ |
| |
| static void |
| DEFUN(remove_noncomments,(src,dst), |
| string_type *src AND |
| string_type *dst) |
| { |
| unsigned int idx = 0; |
| |
| while (at(src,idx)) |
| { |
| /* Now see if we have a comment at the start of the line */ |
| if (at(src,idx) == '\n' |
| && at(src,idx+1) == '/' |
| && at(src,idx+2) == '*') |
| { |
| idx+=3; |
| |
| idx = skip_white_and_stars(src,idx); |
| |
| /* Remove leading dot */ |
| if (at(src, idx) == '.') |
| idx++; |
| |
| /* Copy to the end of the line, or till the end of the |
| comment */ |
| while (at(src, idx)) |
| { |
| if (at(src, idx) == '\n') |
| { |
| /* end of line, echo and scrape of leading blanks */ |
| if (at(src,idx +1) == '\n') |
| catchar(dst,'\n'); |
| catchar(dst,'\n'); |
| idx++; |
| idx = skip_white_and_stars(src, idx); |
| } |
| else if (at(src, idx) == '*' && at(src,idx+1) == '/') |
| { |
| idx +=2 ; |
| cattext(dst,"\nENDDD\n"); |
| break; |
| } |
| else |
| { |
| catchar(dst, at(src, idx)); |
| idx++; |
| } |
| } |
| } |
| else idx++; |
| } |
| } |
| |
| static void |
| print_stack_level () |
| { |
| fprintf (stderr, "current string stack depth = %d, ", tos - stack); |
| fprintf (stderr, "current integer stack depth = %d\n", isp - istack); |
| pc++; |
| } |
| |
| /* turn: |
| foobar name(stuff); |
| into: |
| foobar |
| name PARAMS ((stuff)); |
| and a blank line. |
| */ |
| |
| static void |
| DEFUN_VOID(paramstuff) |
| { |
| unsigned int openp; |
| unsigned int fname; |
| unsigned int idx; |
| string_type out; |
| init_string(&out); |
| |
| |
| /* make sure that it's not already param'd or proto'd */ |
| if(find(tos,"PARAMS") || find(tos,"PROTO") || !find(tos,"(")) { |
| catstr(&out,tos); |
| } |
| else |
| { |
| /* Find the open paren */ |
| for (openp = 0; at(tos, openp) != '(' && at(tos,openp); openp++) |
| ; |
| |
| fname = openp; |
| /* Step back to the fname */ |
| fname--; |
| while (fname && isspace((unsigned char) at(tos, fname))) |
| fname --; |
| while (fname |
| && !isspace((unsigned char) at(tos,fname)) |
| && at(tos,fname) != '*') |
| fname--; |
| |
| fname++; |
| |
| for (idx = 0; idx < fname; idx++) /* Output type */ |
| { |
| catchar(&out, at(tos,idx)); |
| } |
| |
| cattext(&out, "\n"); /* Insert a newline between type and fnname */ |
| |
| for (idx = fname; idx < openp; idx++) /* Output fnname */ |
| { |
| catchar(&out, at(tos,idx)); |
| } |
| |
| cattext(&out," PARAMS ("); |
| |
| while (at(tos,idx) && at(tos,idx) !=';') |
| { |
| catchar(&out, at(tos, idx)); |
| idx++; |
| } |
| cattext(&out,");\n\n"); |
| } |
| overwrite_string(tos, &out); |
| pc++; |
| |
| } |
| |
| |
| |
| /* turn {* |
| and *} into comments */ |
| |
| WORD(translatecomments) |
| { |
| unsigned int idx = 0; |
| string_type out; |
| init_string(&out); |
| |
| while (at(tos, idx)) |
| { |
| if (at(tos,idx) == '{' && at(tos,idx+1) =='*') |
| { |
| cattext(&out,"/*"); |
| idx+=2; |
| } |
| else if (at(tos,idx) == '*' && at(tos,idx+1) =='}') |
| { |
| cattext(&out,"*/"); |
| idx+=2; |
| } |
| else |
| { |
| catchar(&out, at(tos, idx)); |
| idx++; |
| } |
| } |
| |
| |
| overwrite_string(tos, &out); |
| |
| pc++; |
| |
| } |
| |
| #if 0 |
| |
| /* This is not currently used. */ |
| |
| /* turn everything not starting with a . into a comment */ |
| |
| WORD(manglecomments) |
| { |
| unsigned int idx = 0; |
| string_type out; |
| init_string(&out); |
| |
| while (at(tos, idx)) |
| { |
| if (at(tos,idx) == '\n' && at(tos,idx+1) =='*') |
| { |
| cattext(&out," /*"); |
| idx+=2; |
| } |
| else if (at(tos,idx) == '*' && at(tos,idx+1) =='}') |
| { |
| cattext(&out,"*/"); |
| idx+=2; |
| } |
| else |
| { |
| catchar(&out, at(tos, idx)); |
| idx++; |
| } |
| } |
| |
| |
| overwrite_string(tos, &out); |
| |
| pc++; |
| |
| } |
| |
| #endif |
| |
| /* Mod tos so that only lines with leading dots remain */ |
| static void |
| DEFUN_VOID(outputdots) |
| { |
| unsigned int idx = 0; |
| string_type out; |
| init_string(&out); |
| |
| while (at(tos, idx)) |
| { |
| if (at(tos, idx) == '\n' && at(tos, idx+1) == '.') |
| { |
| char c; |
| idx += 2; |
| |
| while ((c = at(tos, idx)) && c != '\n') |
| { |
| if (c == '{' && at(tos,idx+1) =='*') |
| { |
| cattext(&out," /*"); |
| idx+=2; |
| } |
| else if (c == '*' && at(tos,idx+1) =='}') |
| { |
| cattext(&out,"*/"); |
| idx+=2; |
| } |
| else |
| { |
| catchar(&out, c); |
| idx++; |
| } |
| } |
| catchar(&out,'\n'); |
| } |
| else |
| { |
| idx++; |
| } |
| } |
| |
| overwrite_string(tos, &out); |
| pc++; |
| |
| } |
| |
| /* Find lines starting with . and | and put example around them on tos */ |
| WORD(courierize) |
| { |
| string_type out; |
| unsigned int idx = 0; |
| int command = 0; |
| |
| init_string(&out); |
| |
| while (at(tos, idx)) |
| { |
| if (at(tos, idx) == '\n' |
| && (at(tos, idx +1 ) == '.' |
| || at(tos,idx+1) == '|')) |
| { |
| cattext(&out,"\n@example\n"); |
| do |
| { |
| idx += 2; |
| |
| while (at(tos, idx) && at(tos, idx)!='\n') |
| { |
| if (at(tos,idx)=='{' && at(tos,idx+1) =='*') |
| { |
| cattext(&out," /*"); |
| idx+=2; |
| } |
| else if (at(tos,idx)=='*' && at(tos,idx+1) =='}') |
| { |
| cattext(&out,"*/"); |
| idx+=2; |
| } |
| else if (at(tos,idx) == '{' && !command) |
| { |
| cattext(&out,"@{"); |
| idx++; |
| } |
| else if (at(tos,idx) == '}' && !command) |
| { |
| cattext(&out,"@}"); |
| idx++; |
| } |
| else |
| { |
| if (at(tos,idx) == '@') |
| command = 1; |
| else if (isspace((unsigned char) at(tos,idx)) |
| || at(tos,idx) == '}') |
| command = 0; |
| catchar(&out, at(tos, idx)); |
| idx++; |
| } |
| |
| } |
| catchar(&out,'\n'); |
| } |
| while (at(tos, idx) == '\n' |
| && ((at(tos, idx+1) == '.') |
| || (at(tos,idx+1) == '|'))) |
| ; |
| cattext(&out,"@end example"); |
| } |
| else |
| { |
| catchar(&out, at(tos, idx)); |
| idx++; |
| } |
| } |
| |
| overwrite_string(tos, &out); |
| pc++; |
| |
| |
| } |
| |
| /* Finds any lines starting with "o ", if there are any, then turns |
| on @itemize @bullet, and @items each of them. Then ends with @end |
| itemize, inplace at TOS*/ |
| |
| |
| WORD(bulletize) |
| { |
| unsigned int idx = 0; |
| int on = 0; |
| string_type out; |
| init_string(&out); |
| |
| while (at(tos, idx)) { |
| if (at(tos, idx) == '@' && |
| at(tos, idx+1) == '*') |
| { |
| cattext(&out,"*"); |
| idx+=2; |
| } |
| |
| else |
| if (at(tos, idx) == '\n' && |
| at(tos, idx+1) == 'o' && |
| isspace((unsigned char) at(tos, idx +2))) |
| { |
| if (!on) |
| { |
| cattext(&out,"\n@itemize @bullet\n"); |
| on = 1; |
| |
| } |
| cattext(&out,"\n@item\n"); |
| idx+=3; |
| } |
| else |
| { |
| catchar(&out, at(tos, idx)); |
| if (on && at(tos, idx) == '\n' && |
| at(tos, idx+1) == '\n' && |
| at(tos, idx+2) != 'o') |
| { |
| cattext(&out, "@end itemize"); |
| on = 0; |
| } |
| idx++; |
| |
| } |
| } |
| if (on) |
| { |
| cattext(&out,"@end itemize\n"); |
| } |
| |
| delete_string(tos); |
| *tos = out; |
| pc++; |
| |
| } |
| |
| /* Turn <<foo>> into @code{foo} in place at TOS*/ |
| |
| |
| WORD(do_fancy_stuff) |
| { |
| unsigned int idx = 0; |
| string_type out; |
| init_string(&out); |
| while (at(tos, idx)) |
| { |
| if (at(tos, idx) == '<' |
| && at(tos, idx+1) == '<' |
| && !isspace((unsigned char) at(tos,idx + 2))) |
| { |
| /* This qualifies as a << startup */ |
| idx +=2; |
| cattext(&out,"@code{"); |
| while(at(tos,idx) && |
| at(tos,idx) != '>' ) |
| { |
| catchar(&out, at(tos, idx)); |
| idx++; |
| |
| } |
| cattext(&out,"}"); |
| idx+=2; |
| } |
| else |
| { |
| catchar(&out, at(tos, idx)); |
| idx++; |
| } |
| } |
| delete_string(tos); |
| *tos = out; |
| pc++; |
| |
| } |
| /* A command is all upper case,and alone on a line */ |
| static int |
| DEFUN( iscommand,(ptr, idx), |
| string_type *ptr AND |
| unsigned int idx) |
| { |
| unsigned int len = 0; |
| while (at(ptr,idx)) { |
| if (isupper((unsigned char) at(ptr,idx)) || at(ptr,idx) == ' ' || |
| at(ptr,idx) == '_') |
| { |
| len++; |
| idx++; |
| } |
| else if(at(ptr,idx) == '\n') |
| { |
| if (len > 3) return 1; |
| return 0; |
| } |
| else return 0; |
| } |
| return 0; |
| |
| } |
| |
| |
| static int |
| DEFUN(copy_past_newline,(ptr, idx, dst), |
| string_type *ptr AND |
| unsigned int idx AND |
| string_type *dst) |
| { |
| int column = 0; |
| |
| while (at(ptr, idx) && at(ptr, idx) != '\n') |
| { |
| if (at (ptr, idx) == '\t') |
| { |
| /* Expand tabs. Neither makeinfo nor TeX can cope well with |
| them. */ |
| do |
| catchar (dst, ' '); |
| while (++column & 7); |
| } |
| else |
| { |
| catchar(dst, at(ptr, idx)); |
| column++; |
| } |
| idx++; |
| |
| } |
| catchar(dst, at(ptr, idx)); |
| idx++; |
| return idx; |
| |
| } |
| |
| WORD(icopy_past_newline) |
| { |
| tos++; |
| check_range (); |
| init_string(tos); |
| idx = copy_past_newline(ptr, idx, tos); |
| pc++; |
| } |
| |
| /* indent |
| Take the string at the top of the stack, do some prettying */ |
| |
| |
| WORD(kill_bogus_lines) |
| { |
| int sl ; |
| |
| int idx = 0; |
| int c; |
| int dot = 0 ; |
| |
| string_type out; |
| init_string(&out); |
| /* Drop leading nl */ |
| while (at(tos,idx) == '\n') |
| { |
| idx++; |
| } |
| c = idx; |
| |
| /* If the first char is a '.' prepend a newline so that it is |
| recognized properly later. */ |
| if (at (tos, idx) == '.') |
| catchar (&out, '\n'); |
| |
| /* Find the last char */ |
| while (at(tos,idx)) |
| { |
| idx++; |
| } |
| |
| /* find the last non white before the nl */ |
| idx--; |
| |
| while (idx && isspace((unsigned char) at(tos,idx))) |
| idx--; |
| idx++; |
| |
| /* Copy buffer upto last char, but blank lines before and after |
| dots don't count */ |
| sl = 1; |
| |
| while (c < idx) |
| { |
| if (at(tos,c) == '\n' |
| && at(tos,c+1) == '\n' |
| && at(tos,c+2) == '.') |
| { |
| /* Ignore two newlines before a dot*/ |
| c++; |
| } |
| else if (at(tos,c) == '.' && sl) |
| { |
| /* remember that this line started with a dot */ |
| dot=2; |
| } |
| else if (at(tos,c) == '\n' |
| && at(tos,c+1) == '\n' |
| && dot) |
| { |
| c++; |
| /* Ignore two newlines when last line was dot */ |
| } |
| |
| catchar(&out, at(tos,c)); |
| if (at(tos,c) == '\n') |
| { |
| sl = 1; |
| |
| if (dot == 2)dot=1;else dot = 0; |
| } |
| else |
| sl = 0; |
| |
| c++; |
| |
| } |
| |
| /* Append nl*/ |
| catchar(&out, '\n'); |
| pc++; |
| delete_string(tos); |
| *tos = out; |
| |
| |
| } |
| |
| WORD(indent) |
| { |
| string_type out; |
| int tab = 0; |
| int idx = 0; |
| int ol =0; |
| init_string(&out); |
| while (at(tos,idx)) { |
| switch (at(tos,idx)) |
| { |
| case '\n': |
| cattext(&out,"\n"); |
| idx++; |
| if (tab && at(tos,idx)) |
| { |
| cattext(&out," "); |
| } |
| ol = 0; |
| break; |
| case '(': |
| tab++; |
| if (ol == 0) |
| cattext(&out," "); |
| idx++; |
| cattext(&out,"("); |
| ol = 1; |
| break; |
| case ')': |
| tab--; |
| cattext(&out,")"); |
| idx++; |
| ol=1; |
| |
| break; |
| default: |
| catchar(&out,at(tos,idx)); |
| ol=1; |
| |
| idx++; |
| break; |
| } |
| } |
| |
| pc++; |
| delete_string(tos); |
| *tos = out; |
| |
| } |
| |
| |
| WORD(get_stuff_in_command) |
| { |
| tos++; |
| check_range (); |
| init_string(tos); |
| |
| while (at(ptr, idx)) { |
| if (iscommand(ptr, idx)) break; |
| idx = copy_past_newline(ptr, idx, tos); |
| } |
| pc++; |
| } |
| |
| WORD(swap) |
| { |
| string_type t; |
| |
| t = tos[0]; |
| tos[0] = tos[-1]; |
| tos[-1] =t; |
| pc++; |
| |
| } |
| |
| WORD(other_dup) |
| { |
| tos++; |
| check_range (); |
| init_string(tos); |
| catstr(tos, tos-1); |
| pc++; |
| } |
| |
| WORD(drop) |
| { |
| tos--; |
| check_range (); |
| pc++; |
| } |
| |
| WORD(idrop) |
| { |
| isp--; |
| icheck_range (); |
| pc++; |
| } |
| |
| WORD(icatstr) |
| { |
| tos--; |
| check_range (); |
| catstr(tos, tos+1); |
| delete_string(tos+1); |
| pc++; |
| } |
| |
| WORD(skip_past_newline) |
| { |
| while (at(ptr,idx) |
| && at(ptr,idx) != '\n') |
| idx++; |
| idx++; |
| pc++; |
| } |
| |
| |
| WORD(internalmode) |
| { |
| internal_mode = *(isp); |
| isp--; |
| icheck_range (); |
| pc++; |
| } |
| |
| WORD(maybecatstr) |
| { |
| if (internal_wanted == internal_mode) |
| { |
| catstr(tos-1, tos); |
| } |
| delete_string(tos); |
| tos--; |
| check_range (); |
| pc++; |
| } |
| |
| char * |
| DEFUN(nextword,(string, word), |
| char *string AND |
| char **word) |
| { |
| char *word_start; |
| int idx; |
| char *dst; |
| char *src; |
| |
| int length = 0; |
| |
| while (isspace((unsigned char) *string) || *string == '-') { |
| if (*string == '-') |
| { |
| while (*string && *string != '\n') |
| string++; |
| |
| } |
| else { |
| string++; |
| } |
| } |
| if (!*string) return 0; |
| |
| word_start = string; |
| if (*string == '"') |
| { |
| do |
| { |
| string++; |
| length++; |
| if (*string == '\\') |
| { |
| string += 2; |
| length += 2; |
| } |
| } |
| while (*string != '"'); |
| } |
| else |
| { |
| while (!isspace((unsigned char) *string)) |
| { |
| string++; |
| length++; |
| |
| } |
| } |
| |
| *word = malloc(length + 1); |
| |
| dst = *word; |
| src = word_start; |
| |
| |
| for (idx= 0; idx < length; idx++) |
| { |
| if (src[idx] == '\\') |
| switch (src[idx+1]) |
| { |
| case 'n': |
| *dst++ = '\n'; |
| idx++; |
| break; |
| case '"': |
| case '\\': |
| *dst++ = src[idx+1]; |
| idx++; |
| break; |
| default: |
| *dst++ = '\\'; |
| break; |
| } |
| else |
| *dst++ = src[idx]; |
| } |
| *dst++ = 0; |
| |
| |
| |
| |
| |
| if(*string) |
| return string + 1; |
| else |
| return 0; |
| |
| } |
| dict_type *root; |
| dict_type * |
| DEFUN(lookup_word,(word), |
| char *word) |
| { |
| dict_type *ptr = root; |
| while (ptr) { |
| if (strcmp(ptr->word, word) == 0) return ptr; |
| ptr = ptr->next; |
| |
| } |
| if (warning) |
| fprintf(stderr,"Can't find %s\n",word); |
| return 0; |
| |
| |
| } |
| |
| static void DEFUN_VOID(perform) |
| { |
| tos = stack; |
| |
| while (at(ptr, idx)) { |
| /* It's worth looking through the command list */ |
| if (iscommand(ptr, idx)) |
| { |
| char *next; |
| dict_type *word ; |
| |
| (void) nextword(addr(ptr, idx), &next); |
| |
| |
| word = lookup_word(next); |
| |
| |
| |
| |
| if (word) |
| { |
| exec(word); |
| } |
| else |
| { |
| if (warning) |
| fprintf(stderr,"warning, %s is not recognised\n", next); |
| skip_past_newline(); |
| } |
| |
| } |
| else skip_past_newline(); |
| |
| } |
| } |
| |
| dict_type * |
| DEFUN(newentry,(word), |
| char *word) |
| { |
| dict_type *new = (dict_type *)malloc(sizeof(dict_type)); |
| new->word = word; |
| new->next = root; |
| root = new; |
| new->code = (stinst_type *)malloc(sizeof(stinst_type )); |
| new->code_length = 1; |
| new->code_end = 0; |
| return new; |
| |
| } |
| |
| |
| unsigned int |
| DEFUN(add_to_definition,(entry, word), |
| dict_type *entry AND |
| stinst_type word) |
| { |
| if (entry->code_end == entry->code_length) |
| { |
| entry->code_length += 2; |
| entry->code = |
| (stinst_type *) realloc((char *)(entry->code), |
| entry->code_length *sizeof(word_type)); |
| } |
| entry->code[entry->code_end] = word; |
| |
| return entry->code_end++; |
| } |
| |
| |
| |
| |
| |
| |
| |
| void |
| DEFUN(add_intrinsic,(name, func), |
| char *name AND |
| void (*func)()) |
| { |
| dict_type *new = newentry(name); |
| add_to_definition(new, func); |
| add_to_definition(new, 0); |
| } |
| |
| void |
| DEFUN(add_var,(name), |
| char *name) |
| { |
| dict_type *new = newentry(name); |
| add_to_definition(new, push_number); |
| add_to_definition(new, (stinst_type)(&(new->var))); |
| add_to_definition(new,0); |
| } |
| |
| |
| void |
| DEFUN(compile, (string), |
| char *string) |
| { |
| /* add words to the dictionary */ |
| char *word; |
| string = nextword(string, &word); |
| while (string && *string && word[0]) |
| { |
| if (strcmp(word,"var")==0) |
| { |
| string=nextword(string, &word); |
| |
| add_var(word); |
| string=nextword(string, &word); |
| } |
| else |
| |
| if (word[0] == ':') |
| { |
| dict_type *ptr; |
| /* Compile a word and add to dictionary */ |
| string = nextword(string, &word); |
| |
| ptr = newentry(word); |
| string = nextword(string, &word); |
| while (word[0] != ';' ) |
| { |
| switch (word[0]) |
| { |
| case '"': |
| /* got a string, embed magic push string |
| function */ |
| add_to_definition(ptr, push_text); |
| add_to_definition(ptr, (stinst_type)(word+1)); |
| break; |
| case '0': |
| case '1': |
| case '2': |
| case '3': |
| case '4': |
| case '5': |
| case '6': |
| case '7': |
| case '8': |
| case '9': |
| /* Got a number, embedd the magic push number |
| function */ |
| add_to_definition(ptr, push_number); |
| add_to_definition(ptr, (stinst_type)atol(word)); |
| break; |
| default: |
| add_to_definition(ptr, call); |
| add_to_definition(ptr, (stinst_type)lookup_word(word)); |
| } |
| |
| string = nextword(string, &word); |
| } |
| add_to_definition(ptr,0); |
| string = nextword(string, &word); |
| } |
| else |
| { |
| fprintf(stderr,"syntax error at %s\n",string-1); |
| } |
| } |
| |
| } |
| |
| |
| static void DEFUN_VOID(bang) |
| { |
| *(long *)((isp[0])) = isp[-1]; |
| isp-=2; |
| icheck_range (); |
| pc++; |
| } |
| |
| WORD(atsign) |
| { |
| isp[0] = *(long *)(isp[0]); |
| pc++; |
| } |
| |
| WORD(hello) |
| { |
| printf("hello\n"); |
| pc++; |
| } |
| |
| WORD(stdout_) |
| { |
| isp++; |
| icheck_range (); |
| *isp = 1; |
| pc++; |
| } |
| |
| WORD(stderr_) |
| { |
| isp++; |
| icheck_range (); |
| *isp = 2; |
| pc++; |
| } |
| |
| WORD(print) |
| { |
| if (*isp == 1) |
| write_buffer (tos, stdout); |
| else if (*isp == 2) |
| write_buffer (tos, stderr); |
| else |
| fprintf (stderr, "print: illegal print destination `%ld'\n", *isp); |
| isp--; |
| tos--; |
| icheck_range (); |
| check_range (); |
| pc++; |
| } |
| |
| |
| static void DEFUN(read_in, (str, file), |
| string_type *str AND |
| FILE *file) |
| { |
| char buff[10000]; |
| unsigned int r; |
| do |
| { |
| r = fread(buff, 1, sizeof(buff), file); |
| catbuf(str, buff, r); |
| } |
| while (r); |
| buff[0] = 0; |
| |
| catbuf(str, buff,1); |
| } |
| |
| |
| static void DEFUN_VOID(usage) |
| { |
| fprintf(stderr,"usage: -[d|i|g] <file >file\n"); |
| exit(33); |
| } |
| |
| /* There is no reliable way to declare exit. Sometimes it returns |
| int, and sometimes it returns void. Sometimes it changes between |
| OS releases. Trying to get it declared correctly in the hosts file |
| is a pointless waste of time. */ |
| |
| static void |
| chew_exit () |
| { |
| exit (0); |
| } |
| |
| int DEFUN(main,(ac,av), |
| int ac AND |
| char *av[]) |
| { |
| unsigned int i; |
| string_type buffer; |
| string_type pptr; |
| |
| init_string(&buffer); |
| init_string(&pptr); |
| init_string(stack+0); |
| tos=stack+1; |
| ptr = &pptr; |
| |
| add_intrinsic("push_text", push_text); |
| add_intrinsic("!", bang); |
| add_intrinsic("@", atsign); |
| add_intrinsic("hello",hello); |
| add_intrinsic("stdout",stdout_); |
| add_intrinsic("stderr",stderr_); |
| add_intrinsic("print",print); |
| add_intrinsic("skip_past_newline", skip_past_newline ); |
| add_intrinsic("catstr", icatstr ); |
| add_intrinsic("copy_past_newline", icopy_past_newline ); |
| add_intrinsic("dup", other_dup ); |
| add_intrinsic("drop", drop); |
| add_intrinsic("idrop", idrop); |
| add_intrinsic("remchar", remchar ); |
| add_intrinsic("get_stuff_in_command", get_stuff_in_command ); |
| add_intrinsic("do_fancy_stuff", do_fancy_stuff ); |
| add_intrinsic("bulletize", bulletize ); |
| add_intrinsic("courierize", courierize ); |
| /* If the following line gives an error, exit() is not declared in the |
| ../hosts/foo.h file for this host. Fix it there, not here! */ |
| /* No, don't fix it anywhere; see comment on chew_exit--Ian Taylor. */ |
| add_intrinsic("exit", chew_exit ); |
| add_intrinsic("swap", swap ); |
| add_intrinsic("outputdots", outputdots ); |
| add_intrinsic("paramstuff", paramstuff ); |
| add_intrinsic("maybecatstr", maybecatstr ); |
| add_intrinsic("translatecomments", translatecomments ); |
| add_intrinsic("kill_bogus_lines", kill_bogus_lines); |
| add_intrinsic("indent", indent); |
| add_intrinsic("internalmode", internalmode); |
| add_intrinsic("print_stack_level", print_stack_level); |
| add_intrinsic("strip_trailing_newlines", strip_trailing_newlines); |
| |
| /* Put a nl at the start */ |
| catchar(&buffer,'\n'); |
| |
| read_in(&buffer, stdin); |
| remove_noncomments(&buffer, ptr); |
| for (i= 1; i < (unsigned int) ac; i++) |
| { |
| if (av[i][0] == '-') |
| { |
| if (av[i][1] == 'f') |
| { |
| string_type b; |
| FILE *f; |
| init_string(&b); |
| |
| f = fopen(av[i+1],"r"); |
| if (!f) |
| { |
| fprintf(stderr,"Can't open the input file %s\n",av[i+1]); |
| return 33; |
| } |
| |
| read_in(&b, f); |
| compile(b.ptr); |
| perform(); |
| } |
| else if (av[i][1] == 'i') |
| { |
| internal_wanted = 1; |
| } |
| else if (av[i][1] == 'w') |
| { |
| warning = 1; |
| } |
| else |
| usage (); |
| } |
| } |
| write_buffer(stack+0, stdout); |
| if (tos != stack) |
| { |
| fprintf (stderr, "finishing with current stack level %d\n", tos - stack); |
| return 1; |
| } |
| return 0; |
| } |