home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 5 / DATAFILE_PDCD5.iso / utilities / m / makedrawf / Source / c / mouth < prev    next >
Encoding:
Text File  |  1997-04-09  |  50.4 KB  |  1,549 lines
  1. /* mouth.c
  2.  *
  3.  * That portion of mkdrawf 3 dealing with macro expansion rather than
  4.  * with what happens once things are expanded.
  5.  *
  6.  * The mouth/stomach terminology is, I believe, due to Knuth.
  7.  */
  8.  
  9. /* Main differences from mkdrawf 2:
  10.  *
  11.  * 1. There is a single global hash table, which contains every
  12.  *    keyword and every macro definition seen so far.
  13.  *    Of course that means it's rather bigger than the
  14.  *    pathetic 677-entry one used in mkdrawf 2.
  15.  *
  16.  * 2. Token lists (for macros, loops etc) are refcounted,
  17.  *    and discarded when they're finished with. (NOT DONE YET)
  18.  */
  19.  
  20. #include <ctype.h>
  21. #include <math.h>
  22. #include <stdio.h>
  23. #include <stdlib.h>
  24. #include <string.h>
  25.  
  26. #include "mkdrawf.h"
  27.  
  28.  
  29. /* -------------------------- tokens -------------------------- */
  30.  
  31.  
  32. /* We use a null token to denote "no value".
  33.  * This is the default value for hash table entries because
  34.  * static arrays are initialised to be full of zeros.
  35.  */
  36. static Token null_token={0,0};
  37.  
  38. /* For debugging we need the following, which displays the current
  39.  * token in a fairly sane form.
  40.  * If |x!=0| this is coming from |get_x_token()| rather than |get_token()|,
  41.  * and we indicate the fact.
  42.  */
  43. #if defined(DEBUG_TOKENS) || defined(DEBUG_XTOKENS)
  44. static char *name();
  45. static void show_token(int x) {
  46.   if (x) printf("\nX: ");
  47.   switch(curr_token.type) {
  48.     case t_NoValue: printf("<no value>"); break;
  49.     case t_keyword: printf("keyword:#%d",curr_token.value.I); break;
  50.     case t_real:    printf("%lg",curr_token.value.D); break;
  51.     case t_string:  printf("\"%s\"",curr_token.value.CP); break;
  52.     case t_colour:  printf("colour:0x%08X",curr_token.value.I); break;
  53.     case t_toklist: printf("<token list>"); break;
  54.     case t_special: printf("special:#%d",curr_token.value.I); break;
  55.     case t_macro:   printf("macro:??"); break;
  56.     case t_global:  printf("global:%s",name(curr_token.value.HP)); break;
  57.     case t_local:   printf("local:%s",name(curr_token.value.HP)); break;
  58.     case t_localP:  printf("pospar:%%%d",curr_token.value.I); break;
  59.     case t_openbr:  printf("{"); break;
  60.     case t_closebr: printf("}"); break;
  61.     case t_unready: printf("unready:%s",name(curr_token.value.HP)); break;
  62.     case t_magicEOM:   printf("EOM"); break;
  63.     case t_magicNEXT:  printf("NEXT"); break;
  64.     default: printf("illegal:%d",curr_token.type);
  65.   }
  66.   putchar(x?'\n':' ');
  67. }
  68. #endif
  69.  
  70.  
  71. /* -------------------------- forward declarations -------------------------- */
  72.  
  73.  
  74. static int toklists_on_stack;
  75. static TwoWords *next_token;
  76.  
  77. static int get_token(void);
  78.  
  79.  
  80. /* -------------------------- memory management -------------------------- */
  81.  
  82.  
  83. /* We allocate new |Token| and |TwoWords| objects using a simple-minded
  84.  * but fast method: we have a freelist, and grab a block of space using
  85.  * |malloc()| when necessary. We never return freed stuff to the system;
  86.  * only to the free list.
  87.  */
  88.  
  89. /* We do something similar for saved-variable records too, but that's
  90.  * dealt with later.
  91.  */
  92.  
  93. #define alloc_unit 4096    /* number of lumps to claim from system */
  94.  
  95. static int *free_list_2=0;    /* for |TwoWords| objects (2 words) */
  96. static int *free_list_3=0;    /* for |Token| objects (3 words) */
  97.  
  98. static TwoWords *new_two(void) {
  99.   int *t=free_list_2;
  100. #ifdef DEBUG_MEMORY
  101.   fprintf(stderr,"[+2]");
  102. #endif
  103.   if (!t) {
  104.     int i;
  105.     t=free_list_2=(int*)xmalloc(alloc_unit*8,"2-word objects");
  106.     for (i=0;i<alloc_unit;++i) {
  107.       *free_list_2=(int)(free_list_2+2); free_list_2+=2; }
  108.     free_list_2[-2]=0;
  109.   }
  110.   free_list_2=(int*)t[0]; return (TwoWords*)t;
  111. }
  112.  
  113. static Token *new_three(void) {
  114.   int *t=free_list_3;
  115. #ifdef DEBUG_MEMORY
  116.   fprintf(stderr,"[+3]");
  117. #endif
  118.   if (!t) {
  119.     int i;
  120.     t=free_list_3=(int*)xmalloc(alloc_unit*12,"3-word objects");
  121.     for (i=0;i<alloc_unit;++i) {
  122.       *free_list_3=(int)(free_list_3+3); free_list_3+=3; }
  123.     free_list_3[-3]=0;
  124.   }
  125.   free_list_3=(int*)t[0]; return (Token*)t;
  126. }
  127.  
  128. /* To free an object, just stick it back on the free-list it came from.
  129.  * NOTE: At the moment, nothing is *ever* freed. I'll work on this.
  130.  */
  131.  
  132. #if 0    /* we never use these, see */
  133.  
  134. static void free_two(TwoWords *p) {
  135. #ifdef DEBUG_MEMORY
  136.   fprintf(stderr,"[-2]");
  137. #endif
  138.   *((int*)p)=(int)free_list_2;
  139.   free_list_2=(int*)p;
  140. }
  141.  
  142. static void free_three(Token *p) {
  143. #ifdef DEBUG_MEMORY
  144.   fprintf(stderr,"[-3]");
  145. #endif
  146.   *((int*)p)=(int)free_list_3;
  147.   free_list_3=(int*)p;
  148. }
  149.  
  150. #endif
  151.  
  152. #define new_pair new_two
  153. #define free_pair free_two
  154. #define new_token new_three
  155. #define free_token free_three
  156.  
  157.  
  158. /* -------------------------- the hash table -------------------------- */
  159.  
  160.  
  161. /* We use the method of coalescing lists.
  162.  * The way this works is that the table is larger than the number of
  163.  * possible hash values; the list heads go in the low bit of the table,
  164.  * and extra entries, when they get chained onto lists, are allocated
  165.  * starting at the high end.
  166.  * It's called the "method of coalescing lists" because once allocation
  167.  * of non-head items reaches the low part of the hash table we just allow
  168.  * them to occupy "list-head" positions; this means that from then on, the
  169.  * corresponding list starts in the middle of the earlier one.
  170.  * Making the low part occupy about 85% of the whole table results in
  171.  * very little degradation from this coalescing; on average a full table
  172.  * will require <2 probes per lookup.
  173.  *
  174.  * It's hard to delete tokens from this sort of hash table without
  175.  * disaster, because doing that disconnects lists. It can be done,
  176.  * but it's painful. It's easier just to leave things in the table
  177.  * for ever, so we do that.
  178.  *
  179.  * This is the same algorithm used in TeX and METAFONT, by Don Knuth
  180.  * (although I'm pretty sure he didn't invent it.) I have used the
  181.  * same values of |hash_size| and |hash_prime| as he did; this should
  182.  * be very much more than enough.
  183.  */
  184.  
  185. #define hash_size 2100        /* size of whole table */
  186. #define hash_prime 1777        /* amount available to list heads */
  187.  
  188. static uint next_free=hash_size-1;
  189.  
  190. /* A hash table entry contains a key (a string, the name of the variable
  191.  * or keyword or whatever), a value (a token) and a "next entry in list"
  192.  * field. Unfortunately this is 5 words, which isn't going to make things
  193.  * very efficient. And with 2000-odd entries, we really want each entry
  194.  * to be small.
  195.  *
  196.  * Well, we only need 16 bits for the "next" field. We can squeeze the
  197.  * "key" field into 16 bits too, by putting variable names etc into a
  198.  * special-purpose array of characters. With about 2000 items, we can
  199.  * allow 32k (say) of string space without any fear of overflow.
  200.  *
  201.  * There's a little problem: we want to start with all entries zero,
  202.  * and use |next==0| to mean end-of-list. But 0 is a valid offset into
  203.  * the hash table. The solution I've adopted, with regret, is to
  204.  * refrain from ever linking to the 0th element of the hash table.
  205.  * This would only happen one insertion before it overflows anyway.
  206.  */
  207.  
  208. #define string_table_size 16384
  209. static char string_table[string_table_size];
  210. static uint next_free_char=0;
  211.  
  212. /* OK, so this is now what a hash table entry looks like:
  213.  */
  214. typedef struct hashent {
  215.   uint both;    /* high bits contain |key|; low bits contain |next| */
  216.   struct token value;
  217. } HashEntry;
  218.  
  219. /* |name(v)| is the name of the variable whose hash address is |v|.
  220.  * If speed is important, it's better to write this out explicitly.
  221.  */
  222. static char *name(HashEntry *v) {
  223.   return string_table+(v->both>>16);
  224. }
  225.  
  226. /* And here's the hash table itself:
  227.  */
  228. static HashEntry hash_table[hash_size];
  229.  
  230. /* When we look up an entry and it's not there, we *always* want to
  231.  * create an entry for it.
  232.  * If there wasn't one before, the new entry will contain a null token,
  233.  * because |static| arrays are initialised to all-zeros.
  234.  */
  235. static HashEntry *hashloc(const char *key) {
  236.   uint h=0,i,l=0;
  237.   /* Put hash value into h, and length of string into l: */
  238.   while ((i=key[l++])!=0) { h=(h<<1)+i; while (h>=hash_prime) h-=hash_prime; }
  239.   /* Search table: */
  240.   while ((i=hash_table[h].both)!=0) {
  241.     int j=i>>16;
  242.     if (!strcmp(string_table+j,key)) return hash_table+h;    /* found */
  243.     j=i-(j<<16); if (!j) break;    /* end of list */
  244.     h=j;
  245.   }
  246.   /* Not found. */
  247.   if (i) {
  248.     while (next_free>0 && hash_table[next_free].both) --next_free;
  249.     if (!next_free) error("Hash table overflow");
  250.     hash_table[h].both=(i&0xFFFF0000)+next_free; h=next_free--;
  251.   }
  252.   /* Now we need to install |key| in the string table, and make
  253.    * "h.key" point to it.
  254.    */
  255.   if (next_free_char+l>=string_table_size) error("String table overflow");
  256.   memcpy(string_table+next_free_char,key,l);
  257.   hash_table[h].both=next_free_char<<16;    /* key=n_f_c, next=0 */
  258.   next_free_char+=l;
  259.   return hash_table+h;
  260. }
  261.  
  262.  
  263. /* -------------------------- positional parameters ------------------------ */
  264.  
  265.  
  266. /* NB: Read the next section before this one! */
  267.  
  268. /* It's possible to refer in a macro to the tokens that follow the macro
  269.  * invocation, by using "positional parameters" looking like %1 .. %9.
  270.  * As many are read as are needed.
  271.  * Bear in mind that they are read *with* expansion, so if they include
  272.  * <Set> or similar tokens they may cause funny things to happen at
  273.  * funny times... (Also, such things will refer to the variable bindings
  274.  * extant when they're expanded.)
  275.  */
  276.  
  277. #define max_pos_param 9
  278.  
  279. /* We need to stack these, just as we do with ordinary local variables.
  280.  * We also need to remember, for each macro invocation, how many pp's
  281.  * have been used so far.
  282.  * Most macros don't use *any* positional parameters; those that do
  283.  * tend not to use very many. So it makes sense to use the same
  284.  * mechanism as that for ordinary variables, rather than storing
  285.  * all 9 pp values every time.
  286.  */
  287.  
  288. #define max_macro_level 256
  289. static char n_pps_[max_macro_level];
  290. static char *n_pps=n_pps_-1;    /* because 0 means no macros used... */
  291.  
  292. /* So that we *can* treat these sort of as like ordinary locals,
  293.  * we need |HashEntry|s for them. So here we are.
  294.  * I'm afraid |pp_val[0]| is the entry for %1. Sorry.
  295.  */
  296.  
  297. static HashEntry pp_val[max_pos_param];
  298.  
  299. /* When we are reading tokens so as to set a positional parameter,
  300.  * we need to be sure of reading them from the right place.
  301.  * So when we enter a macro, we remember what our token-list state
  302.  * was just before the invocation got started.
  303.  * Reading pp's may cause some of these token-lists to end, but that's
  304.  * OK; it will just result in some 0s in the array of token-lists.
  305.  */
  306.  
  307. typedef struct {
  308.   int toks_depth;
  309.   TwoWords *next_tok;
  310. } MacroContext;
  311.  
  312. static MacroContext macro_context_[max_macro_level];
  313. static MacroContext *macro_context=macro_context_-1;
  314.  
  315.  
  316. /* -------------------------- local variables -------------------------- */
  317.  
  318.  
  319. /* When we set a local variable while expanding a macro call,
  320.  * we need to make sure we can restore its value later.
  321.  * But it's only the first time it's referred to that we need
  322.  * to bother saving the old value. How can we make sure that
  323.  * the value gets saved the first time a variable is changed,
  324.  * but not other times?
  325.  *
  326.  * Answer: maintain a count of how deeply nested macros are at
  327.  *         any given moment. When a local variable is changed,
  328.  *         check whether it's been changed before at this level;
  329.  *         if it has, leave it alone. When a variable's value
  330.  *         is restored, we need to restore the level too.
  331.  *
  332.  * This unfortunately requires yet another field in each hash
  333.  * table entry.
  334.  * We use the top byte of the |type| field of the token for this.
  335.  * This is pretty unpleasant, but it seems to be the best way
  336.  * to deal with the problem. Note that this implies a maximum
  337.  * nesting depth of 256.
  338.  *
  339.  * Of course, we must remember to clear those bits any time we
  340.  * reference a variable...
  341.  */
  342.  
  343. static uint macro_level=0;
  344.  
  345. /* A saved value is described by saying where in the hash table it
  346.  * belongs, what its value was and when it was saved.
  347.  * The |next| field is used to hold the save stack together.
  348.  */
  349. typedef struct saved {
  350.   HashEntry *loc;
  351.   Token value;
  352.   int level;
  353.   struct saved *next;
  354. } Saved;
  355.  
  356. /* We allocate and free saved-variable records in the same sort of
  357.  * straightforward way as we used for tokens and such.
  358.  */
  359. static Saved *free_list_Saved=0;
  360. #ifdef DEBUG_MEMORY
  361. static Saved *new_saved_(void) {
  362.   Saved *t=free_list_Saved;
  363.   fprintf(stderr,"[+S]");
  364.   if (!t) {
  365.     int i;
  366.     t=free_list_Saved=(Saved *)xmalloc(256*sizeof(Saved),
  367.                                        "saved-local records");
  368.     for (i=0;i<256;++i) {
  369.       *(Saved**)free_list_Saved=free_list_Saved+1; ++free_list_Saved; }
  370.     *(int*)(free_list_Saved-1)=0;
  371.   }
  372.   free_list_Saved=*(Saved**)t;
  373.   return t;
  374. }
  375. #define New_saved(x) (x)=new_saved()
  376. static void free_saved(Saved *p) {
  377.   fprintf(stderr,"[-S]");
  378.   *(Saved**)p=free_list_Saved;
  379.   free_list_Saved=p;
  380. }
  381. #else
  382. static Saved *new_saved_(void) {
  383.   int i;
  384.   { Saved *t=free_list_Saved=(Saved *)xmalloc(256*sizeof(Saved),
  385.                                               "saved-local records");
  386.     for (i=0;i<256;++i) { *(Saved**)t=t+1; ++t; }
  387.     *(int*)(t-1)=0;
  388.   }
  389.   { Saved *u=free_list_Saved;
  390.     free_list_Saved=*(Saved**)u;
  391.     return u;
  392.   }
  393. }
  394. #define New_saved(x) { if (free_list_Saved) { x=free_list_Saved;\
  395.  free_list_Saved=*(Saved**)free_list_Saved; }\
  396.  else x=new_saved_(); }
  397. #define free_saved(p) { *(Saved**)(p)=free_list_Saved; free_list_Saved=p; }
  398. #endif
  399.  
  400. /* Saved values are held on a linked list. (This means that there
  401.  * is no restriction on the number of variables we can save in each
  402.  * macro invocation.)
  403.  */
  404.  
  405. static Saved *last_saved;    /* most recently saved thing */
  406.  
  407. /* |set_local| sets the value of the local variable whose hash address
  408.  * is |var| to be |value|.
  409.  */
  410. static void set_local(HashEntry *var, Token *value) {
  411.   int l=var->value.type>>24;
  412.   if (l!=macro_level) {
  413.     /* Need to save the old value */
  414.     Saved *s;
  415.     New_saved(s);
  416.     s->loc=var; s->value=var->value; s->level=macro_level;
  417.     s->next=last_saved; last_saved=s;
  418.   }
  419.   var->value.type=value->type | (macro_level<<24);
  420.   var->value.value=value->value;
  421. }
  422.  
  423. /* Decrement |macro_level|, restoring any saved locals.
  424.  */
  425. static void pop_level(void) {
  426.   if (!macro_level) minor("Misplaced |pop_level()|");
  427.   else {
  428.     Saved *s=last_saved;
  429.     while (s && s->level==macro_level) {
  430.       s->loc->value=s->value;
  431.       { Saved *t=s; s=s->next; free_saved(t); }
  432.     }
  433.     last_saved=s;
  434.     /* Next two lines explained in next section */
  435.     toklists_on_stack=macro_context[macro_level].toks_depth;
  436.     next_token=macro_context[macro_level].next_tok;
  437.     --macro_level;
  438.   }
  439. }
  440.  
  441.  
  442. /* -------------------------- input and output -------------------------- */
  443.  
  444.  
  445. /* We read data from an input file, and write it to an output file.
  446.  */
  447.  
  448. FILE *input_file=0;
  449. char *input_file_name=0;
  450.  
  451. /* With the |Include| command we may have several input files
  452.  * open at once. We hold the names and FILE *'s of the inactive
  453.  * ones in a stack. Highest number = most recently opened.
  454.  */
  455.  
  456. #define max_files_on_stack 16    /* so can have 17 open at once */
  457.  
  458. static int files_on_stack=0;
  459. static struct {
  460.   char *name;
  461.   FILE *file;
  462.   int line;
  463. } file_stack[max_files_on_stack];
  464.  
  465. /* Note: |get_line| and |line_tail| below are NOT |static| because they
  466.  * are accessed directly by |do_textarea()| in stomach.c. This is ugly,
  467.  * but necessitated by the syntax used; avoiding it would make using
  468.  * text areas even more unpleasant than it already is.
  469.  */
  470.  
  471. /* The currently-being-processed line of input is contained in
  472.  * |curr_line|. The first character in it that hasn't been
  473.  * processed is in |line_tail|.
  474.  */
  475.  
  476. static char curr_line[max_line_length]="";
  477. char *line_tail=curr_line;
  478.  
  479. /* |get_line()| reads a new line of input into |curr_line|. It deals
  480.  * with closing finished input files, etc.
  481.  * It returns 1 if there are no more lines available, else 0.
  482.  */
  483. int get_line(void) {
  484.   while (!fgets(curr_line,max_line_length,input_file)) {
  485.     if (ferror(input_file))
  486.       minor("Read error for input file `%s'",input_file_name);
  487.     if (!files_on_stack) return 1;
  488.     fclose(input_file);
  489.     input_file=file_stack[--files_on_stack].file;
  490.     input_file_name=file_stack[files_on_stack].name;
  491.     line_number=file_stack[files_on_stack].line;
  492.   }
  493.   line_tail=curr_line;
  494.   ++line_number;
  495.   return 0;
  496. }
  497.  
  498. /* |open_new_file(s)| checks that we aren't nesting files too deeply,
  499.  * then tries to open the file whose name is |s|. If it succeeds, it
  500.  * pushes the current input file onto the stack and replaces it with
  501.  * the new file.
  502.  */
  503. static void open_new_file(char *s) {
  504.   FILE *f;
  505.   if (files_on_stack>=max_files_on_stack) {
  506.     minor("Files nested too deeply (maximum=%d)",max_files_on_stack);
  507.     return;
  508.   }
  509.   f=fopen(s,"r");
  510.   if (!f) error("Couldn't open file `%s' for inclusion",s);
  511.   file_stack[files_on_stack].name=input_file_name;
  512.   file_stack[files_on_stack].file=input_file;
  513.   file_stack[files_on_stack++].line=line_number;
  514.   input_file_name=s;
  515.   input_file=f;
  516.   line_number=0;
  517. }
  518.  
  519.  
  520. /* -------------------------- conditionals -------------------------- */
  521.  
  522.  
  523. /* To keep track of If/Else/EndIf constructs we have a stack of
  524.  * "pending" <If>s. Let's be more precise about how this works...
  525.  *
  526.  * If we encounter an <If> with a *false* condition, we skip tokens
  527.  * until reaching an <Else> or an <EndIf>; if it's an <EndIf> we're done;
  528.  * if it's an <Else> we stack the fact that we are waiting for an <EndIf>.
  529.  *
  530.  * If we encounter an <If> with a *true* condition, we stack the fact
  531.  * that we're waiting for an <Else>.
  532.  *
  533.  * If we encounter an <Else>, we look at the top of the If-stack. If
  534.  * it says "waiting for an <Else>", we skip until finding an <EndIf>.
  535.  * If it says "waiting for an <EndIf>", we complain "two Elses".
  536.  *
  537.  * If we encounter an <EndIf>, we check that the If-stack isn't empty,
  538.  * and pop off its top element.
  539.  *
  540.  * Thus we only really need one *bit* per entry in this stack. Mucking
  541.  * about with bit-arrays is a pain, though. We use an array of |char|s.
  542.  * An entry of 0 means "looking for an <EndIf>"; 1 means "looking for an
  543.  * <Else> (or an <EndIf>)".
  544.  */
  545.  
  546. #define max_ifs_on_stack 256
  547. static char if_stack[max_ifs_on_stack];
  548. static int ifs_on_stack=0;
  549.  
  550. /* |skip_tokens()| does just what it says: skips past tokens looking
  551.  * for an |Else| or an |EndIf|, taking care over the matching of Ifs.
  552.  * (We don't worry about the matching of braces, because we might want
  553.  * code like
  554.  *   If blah { ..... EndIf
  555.  *   ...
  556.  *   If blah } EndIf
  557.  * ... maybe.)
  558.  *
  559.  * |skip_tokens()| returns 0 if it finds an <EndIf>, a <1> if it finds
  560.  * an <Else>, a 99 if it hits EOF or a file error. So we're happy iff
  561.  * the number this returns is <= the appropriate number from the stack.
  562.  */
  563. static int skip_tokens(void) {
  564.   int depth=0;
  565.   while (1) {
  566.     if (get_token()) return 99;
  567.     if (curr_token.type==t_special) {
  568.     /* What follows is naughty, yes. I guarantee to keep the relevant
  569.      * values <32. */
  570.       int q=1<<curr_token.value.U;
  571.       if (q & ((1<<s_IfExists) | (1<<s_IfLess) | (1<<s_IfEqual)
  572.                | (1<<s_EndIf) | (1<<s_Else))) {
  573.         if (q==1<<s_EndIf) { if (depth) --depth; else return 0; }
  574.         else if (q==1<<s_Else) { if (!depth) return 1; }
  575.         else ++depth;
  576.       }
  577.     }
  578.   }
  579.   /* This point is never reached. */
  580.   return 99;
  581. }
  582.  
  583. /* Purely for convenience, macros for stacking things on the
  584.  * If-stack.
  585.  * |stack_else| means "remember that we're waiting for an <Else>";
  586.  * |stack_endif| means "remember that we're waiting for an <EndIf>".
  587.  */
  588. #define stack_else {\
  589.  if (ifs_on_stack>=max_ifs_on_stack) error("Too many nested Ifs");\
  590.  if_stack[ifs_on_stack++]=1; }
  591. #define stack_endif {\
  592.  if (ifs_on_stack>=max_ifs_on_stack) error("Too many nested Ifs");\
  593.  if_stack[ifs_on_stack++]=0; }
  594.  
  595.  
  596. /* -------------------------- loops -------------------------- */
  597.  
  598.  
  599. /* When we encounter a <For> token, we create a token list
  600.  * which ends with a special token. This special token has
  601.  * type |t_magicNEXT|, and its |value| field points to a
  602.  * record describing the loop. It needs to record the variable
  603.  * being used, its limit value, and a pointer to the start of
  604.  * the token list.
  605.  *
  606.  * The final `next-pointer' in the loop token list -- the one
  607.  * associated with the special token -- points to the value
  608.  * of |next_token| to use for continuing after the end of the
  609.  * loop.
  610.  */
  611.  
  612. typedef struct looprec {
  613.   HashEntry *var;    /* variable being used */
  614.   double limit;        /* max. value for loop variable */
  615.   TwoWords *start;    /* start of token list */
  616. } LoopRecord;
  617.  
  618.  
  619. /* -------------------------- lexing -------------------------- */
  620.  
  621.  
  622. /* The token we have just read is in |curr_token|.
  623.  */
  624. Token curr_token;
  625.  
  626. /* When we are reading tokens from a token list, the address
  627.  * of the next token to be read is in |*(next_token->P.first.TP)|,
  628.  * and the next value for |next_token| is in |next_token->P.rest.PP|.
  629.  * When we are not reading from a token list, this contains 0.
  630.  * It always contains either 0 or a pointer to a genuine token.
  631.  */
  632. static TwoWords *next_token;
  633.  
  634. /* There may be tokens waiting from several different token-lists.
  635.  * We have a stack of waiting token-lists, the top element of which
  636.  * is in effect cached in |next_token|.
  637.  * Each item on this stack is ready to be put into |next_token| when
  638.  * it's time to use it.
  639.  */
  640.  
  641. #define max_toklists_on_stack 256
  642. static int toklists_on_stack=0;
  643. static TwoWords *tok_stack[max_toklists_on_stack];
  644.  
  645. /* |get_token()| returns 1 when there are no more tokens available,
  646.  * which signals the end of input; or else returns 0 having put
  647.  * a token in |curr_token|.
  648.  */
  649. #ifdef DEBUG_TOKENS
  650. static int get_token_(void);
  651. static int get_token(void) {
  652.   int i=get_token_();
  653.   show_token(0);
  654.   return i;
  655. }
  656. static int get_token_(void) {
  657. #else
  658. static int get_token(void) {
  659. #endif
  660.   /* Reading from a token list? */
  661. again:
  662.   if (next_token) {
  663.     curr_token=*(next_token->P.first.TP);
  664.     next_token=next_token->P.rest.PP;
  665.     if (curr_token.type>=t_magicEOM) {
  666.       /* end of token list. Need to do clever things */
  667.       /* At the end of this block we should read another token */
  668.       switch(curr_token.type) {
  669.       case t_magicEOM:
  670.         /* end of macro. Restore variables. */
  671.         pop_level();
  672.         break;
  673.       case t_magicNEXT: {
  674.         /* end of loop. Update variable, & do the right thing. */
  675.         LoopRecord *l=curr_token.value.LP;
  676.         HashEntry *v=l->var;
  677.         double x;
  678.         if ((v->value.type&0xFF)!=t_real) {
  679.           minor("Abuse of loop variable `%s'",name(v));
  680.           x=l->limit+1; }
  681.         else x=v->value.value.D+1;
  682.         if (x<l->limit) { v->value.value.D=x; next_token=l->start; }
  683.         break; }
  684.       default: minor("Mysterious token, type=%d (magicEOM=%d)",
  685.                      curr_token.type,t_magicEOM);
  686.       }
  687.       goto again;
  688.     }
  689.     /* here: not a magic token. Just use it */
  690.     return 0;
  691.   }
  692.   /* No tokens waiting in |next_token|... Any on stack? */
  693.   if (toklists_on_stack) {
  694.     next_token=tok_stack[--toklists_on_stack];
  695.     goto again; }
  696.   /* No tokens waiting at all. Extract next token from current line. */
  697. lex:
  698.   while (isspace(*line_tail)) ++line_tail;
  699.   if (!*line_tail) { if (get_line()) return 1; else goto lex; }
  700.   /* OK, now we can actually get to work. */
  701.   { char tok[max_line_length];
  702.     char *cp;
  703.     char *olt;
  704.     olt=line_tail; cp=tok;
  705.     while (*line_tail && !isspace(*line_tail)) *cp++=tolower(*line_tail++);
  706.     *cp=0;
  707.     /* There's now a token at |tok|. */
  708.     if (cp==tok+1) {
  709.       if (*tok=='{') { curr_token.type=t_openbr; return 0; }
  710.       if (*tok=='}') { curr_token.type=t_closebr; return 0; }
  711.     }
  712.     /* A variable? */
  713.     if (*tok=='%') {
  714.       if (cp==tok+2 && isdigit(tok[1])) {
  715.         curr_token.type=t_localP;
  716.         curr_token.value.U=tok[1]-'0'; }
  717.       else {
  718.         curr_token.type=t_local;
  719.         curr_token.value.HP=hashloc(tok); }
  720.       return 0; }
  721.     if (*tok=='$') {
  722.       curr_token.type=t_global;
  723.       curr_token.value.HP=hashloc(tok);
  724.       return 0; }
  725.     /* No. A string? */
  726.     if (*tok=='"') {
  727.       char *s=xmalloc(max_line_length,"a string");
  728.       char *sp=s;
  729.       int bs=0;
  730.       for (cp=olt+1;*cp&&(bs||*cp!='"');) {
  731.         if (!bs) {
  732.           if (*cp=='\\') { bs=1; cp++; continue; }
  733.         }
  734.         else bs=0;
  735.         *sp++=*cp++;
  736.       }
  737.       line_tail=cp+1;
  738.       do *sp++=0; while ((sp-s)&3);    /* pad to word boundary */
  739.       if (!*cp) warn("Unterminated string");
  740.       curr_token.type=t_string;
  741.       curr_token.value.CP=s;
  742.       return 0; }
  743.     /* No. A comment? */
  744.     if (*tok=='#') { if (get_line()) return 1; else goto lex; }
  745.     /* No. A number? */
  746.     { double d;
  747.       char *cp2;
  748.       d=strtod(tok,&cp2);
  749.       /* If |strtod()| fails, try for a hex number */
  750.       if (cp2!=cp && *tok=='0' && tok[1]=='x')
  751.         d=(double)strtoul(tok+2,&cp2,16);
  752.       if (cp2==cp) {
  753.         curr_token.type=t_real;
  754.         curr_token.value.D=d;
  755.         return 0;
  756.       }
  757.     }
  758.     /* No. A colour? */
  759.     if (*tok=='r') {
  760.       int r,g,b;
  761.       if (sscanf(tok,"r%dg%db%d",&r,&g,&b)==3) {
  762.         curr_token.type=t_colour;
  763.         curr_token.value.U=(r<<8)+(g<<16)+(b<<24);
  764.         return 0;
  765.       }
  766.     }
  767.     if (!strcmp(tok,"none") || !strcmp(tok,"transparent")) {
  768.       curr_token.type=t_colour;
  769.       curr_token.value.I=-1;
  770.       return 0;
  771.     }
  772.     /* No. Presumably a macro, then. Or perhaps a keyword or special. */
  773.     { HashEntry *h=hashloc(tok);
  774.       if (h->value.type)
  775.         /* Must be a keyword or special */
  776.         curr_token=h->value;
  777.       else {
  778.         curr_token.type=t_unready;
  779.         curr_token.value.HP=h;
  780.       }
  781.       return 0;
  782.     }
  783.   }
  784. }
  785.  
  786.  
  787. /* -------------------------- expanding -------------------------- */
  788.  
  789.  
  790. /* In a sense, this is the heart of the program. The function
  791.  * |get_x_token()| expands things until it's found a `primitive'
  792.  * token, and then returns with |curr_token| set.
  793.  *
  794.  * Primitive tokens are numbers, colours, keywords, strings, open/close
  795.  * braces (usually) and sometimes token-lists (which are, indeed, much
  796.  * less primitive than the rest).
  797.  *
  798.  * If |seq!=0| and the first primitive token found is a <{>, we
  799.  * collect together all tokens between that and the matching <}>
  800.  * into a token-list.
  801.  */
  802.  
  803. #define EOFerr(x) { minor("EOF or error in " x " construct"); return 1; }
  804.  
  805. #ifdef DEBUG_XTOKENS
  806. static int get_x_token_(int);
  807. int get_x_token(int seq) {
  808.   int i=get_x_token_(seq);
  809.   show_token(1);
  810.   return i;
  811. }
  812. static int get_x_token_(int seq) {
  813. #else
  814. int get_x_token(int seq) {
  815. #endif
  816. next:
  817.   if (get_token()) return 1;
  818. again:
  819.   switch(curr_token.type) {
  820.     case t_NoValue: {
  821.       minor("Null token (illegal)");
  822.       goto next; }
  823.     case t_real:
  824.     case t_string:
  825.     case t_colour:
  826.     case t_keyword:
  827.       return 0;
  828.     case t_toklist:
  829.       if (seq) return 0;
  830.       if (toklists_on_stack>=max_toklists_on_stack)
  831.         error("Too many nested token lists");
  832.       tok_stack[toklists_on_stack++]=curr_token.value.PP;
  833.       goto next;
  834.     case t_special:
  835.       /* Warning: this is long. */
  836.       switch(curr_token.value.I) {
  837.         case s_Define: {
  838.           HashEntry *h;
  839.           TwoWords *p=0,*q;
  840.           int depth=0;
  841.           if (get_token()) EOFerr("Define");
  842.           if (curr_token.type!=t_unready)
  843.             error("Illegal Define");
  844.           h=curr_token.value.HP;
  845.           if (get_token()) error("EOF or error in Define construct");
  846.           if (curr_token.type!=t_openbr) error("Illegal Define");
  847.           while (1) {
  848.             if (get_token()) EOFerr("Define");
  849.             if (curr_token.type==t_openbr) ++depth;
  850.             if (curr_token.type==t_closebr && !depth--) break;
  851.             { Token *t=new_token(); TwoWords *u=new_pair();
  852.               *t=curr_token; u->P.first.TP=t;
  853.               if (p) q=(q->P.rest.PP=u); else q=p=u;
  854.             }
  855.           }
  856.           /* add end-of-macro token */
  857.           { Token *t=new_token(); TwoWords *u=new_pair();
  858.             t->type=t_magicEOM;
  859.             u->P.first.TP=t; u->P.rest.PP=0;
  860.             if (p) q->P.rest.PP=u; else p=u; }
  861.           /* now p points to text of macro expansion */
  862.           h->value.type=t_macro;
  863.           h->value.value.PP=p;
  864.           goto next; }    /* definition expands to nothing */
  865.         case s_Set: {
  866.           if (get_token()) EOFerr("Set");
  867.           if (curr_token.type==t_local) {
  868.             HashEntry *h=curr_token.value.HP;
  869.             if (!macro_level) { minor("Local variable reference outside macro");
  870.                                 goto next; }
  871.             if (get_x_token(1)) EOFerr("Set");
  872.             set_local(h,&curr_token);
  873.             goto next; }
  874.           if (curr_token.type==t_global) {
  875.             HashEntry *h=curr_token.value.HP;
  876.             if (get_x_token(1)) EOFerr("Set");
  877.             h->value=curr_token;
  878.             goto next; }
  879.           minor("Attempt to Set a non-variable");
  880.           goto next; }
  881.         case s_IfExists:
  882.           if (get_token()) EOFerr("If");
  883.           if (curr_token.type==t_global || curr_token.type==t_local) {
  884.             if (curr_token.value.HP->value.type) { stack_else; goto next; }
  885. iffalse:    { int i=skip_tokens();
  886.               if (i==99) EOFerr("If");
  887.               if (i==1) stack_endif;   }
  888.             goto next;
  889.           }
  890.           else {
  891.             minor("IfExists with non-variable");
  892.             goto iffalse;
  893.           }
  894.         case s_IfLess: {
  895.           double x,y;
  896.           if (get_x_token(0)) EOFerr("If");
  897.           if (curr_token.type!=t_real) { minor("Non-number in IfLess"); x=0; }
  898.           else x=curr_token.value.D;
  899.           if (get_x_token(0)) EOFerr("If");
  900.           if (curr_token.type!=t_real) { minor("Non-number in IfLess"); y=0; }
  901.           else y=curr_token.value.D;
  902.           if (x<y) { stack_else; goto next; }
  903.           else goto iffalse; }
  904.         case s_IfEqual: {
  905.           Token the_other_token;
  906.           int yes;
  907.           if (get_x_token(0)) EOFerr("If");
  908.           the_other_token=curr_token;
  909.           if (get_x_token(0)) EOFerr("If");
  910.           if (curr_token.type!=the_other_token.type) goto iffalse;
  911.           switch(the_other_token.type) {
  912.             case t_keyword:
  913.             case t_colour:
  914.               yes=(curr_token.value.I==the_other_token.value.I); break;
  915.             case t_real:
  916.               yes=(curr_token.value.D==the_other_token.value.D); break;
  917.             case t_string:
  918.               yes=!strcmp(curr_token.value.CP,the_other_token.value.CP); break;
  919.             default:
  920.               minor("Illegal type in IfEqual"); goto iffalse;
  921.           }
  922.           if (yes) { stack_else; goto next; } else goto iffalse; }
  923.         case s_Else:
  924.           if (ifs_on_stack<=0) { minor("Else with no If"); goto next; }
  925.           if (if_stack[--ifs_on_stack]) {
  926.             /* We were waiting for an Else. Skip. */
  927.             while (skip_tokens()) minor("One If has two Elses");
  928.             goto next; }
  929.           /* We were waiting for an EndIf. Moan. */
  930.           minor("One If has two Elses"); ++ifs_on_stack;
  931.           goto next;
  932.         case s_EndIf:
  933.           if (--ifs_on_stack<0) { ++ifs_on_stack; minor("EndIf with no If"); }
  934.           goto next;
  935.         case s_For: {
  936.           HashEntry *h;
  937.           double limit;
  938.           int local;
  939.           if (get_token()) EOFerr("For");
  940.           if (curr_token.type!=t_global && curr_token.type!=t_local) {
  941.             minor("For with non-variable"); goto again; }
  942.           h=curr_token.value.HP;
  943.           if (curr_token.type==t_local) {
  944.             if (!macro_level) {
  945.               minor("Local variable reference outside macro");
  946.               get_x_token(0); get_x_token(0); /* skip numbers */
  947.               goto next; }
  948.             local=1;
  949.           } else local=0;
  950.           if (get_x_token(0)) EOFerr("For");
  951.           if (curr_token.type!=t_real) {
  952.             minor("Non-numeric initial value in For");
  953.             curr_token.type=t_real;
  954.             curr_token.value.D=0; }
  955.           if (local) set_local(h,&curr_token);
  956.           else h->value=curr_token;
  957.           if (get_x_token(0)) EOFerr("For");
  958.           if (curr_token.type!=t_real) {
  959.             minor("Non-numeric limit in For"); limit=0; }
  960.           else limit=curr_token.value.D;
  961.           /* Now make a token list ending with a magicNEXT token. */
  962.           if (get_token()) EOFerr("For");
  963.           if (curr_token.type!=t_openbr) {
  964.             minor("Non-tokenlist as body of For"); goto again; }
  965.           { int depth=0;
  966.             TwoWords *p=0,*q;
  967.             while (1) {
  968.               if (get_token()) EOFerr("For");
  969.               if (curr_token.type==t_openbr) ++depth;
  970.               if (curr_token.type==t_closebr && !depth--) break;
  971.               { Token *t=new_token(); TwoWords *u=new_pair();
  972.                 *t=curr_token; u->P.first.TP=t;
  973.                 if (p) q=(q->P.rest.PP=u); else q=p=u;
  974.               }
  975.             }
  976.             { Token *t=new_token();
  977.               LoopRecord *l=xmalloc(sizeof(LoopRecord),"a loop record");
  978.               TwoWords *u=new_pair();
  979.               l->var=h; l->limit=limit;
  980.               l->start=p;
  981.               t->type=t_magicNEXT; t->value.LP=l;
  982.               u->P.first.TP=t; u->P.rest.PP=next_token;
  983.               if (p) q->P.rest.PP=u; else p=u;
  984.             }
  985.             next_token=p;
  986.             goto next;
  987.           }
  988.         }
  989.         /* That's the end of the control-structure specials.
  990.          * Now we have the more boring ones that might have been
  991.          * better called operators.
  992.          * Actually there are a few weirdies yet.
  993.          */
  994.         case s_Plus:
  995.           curr_token.value.D=read_double()+read_double();
  996.           curr_token.type=t_real;
  997.           return 0;
  998.         case s_Minus: {
  999.           double x=read_double();
  1000.           curr_token.value.D=x-read_double();
  1001.           curr_token.type=t_real;
  1002.           return 0; }
  1003.         case s_Times:
  1004.           curr_token.value.D=read_double()*read_double();
  1005.           curr_token.type=t_real;
  1006.           return 0;
  1007.         case s_Over: {
  1008.           double x=read_double();
  1009.           double y=read_double();
  1010.           if (y==0) { minor("Division by zero"); y=1; }
  1011.           curr_token.type=t_real;
  1012.           curr_token.value.D=x/y;
  1013.           return 0; }
  1014.         case s_Sqrt: {
  1015.           double x=read_double();
  1016.           if (x<0) { minor("Negative square root"); x=-x; }
  1017.           curr_token.type=t_real;
  1018.           curr_token.value.D=sqrt(x);
  1019.           return 0; }
  1020.         case s_Sin:
  1021.           curr_token.value.D=sin(read_double());
  1022.           curr_token.type=t_real;
  1023.           return 0;
  1024.         case s_Cos:
  1025.           curr_token.value.D=cos(read_double());
  1026.           curr_token.type=t_real;
  1027.           return 0;
  1028.         case s_Tan:
  1029.           curr_token.value.D=tan(read_double());
  1030.           curr_token.type=t_real;
  1031.           return 0;
  1032.         case s_Arcsin:
  1033.           curr_token.value.D=asin(read_double());
  1034.           curr_token.type=t_real;
  1035.           return 0;
  1036.         case s_Arccos:
  1037.           curr_token.value.D=acos(read_double());
  1038.           curr_token.type=t_real;
  1039.           return 0;
  1040.         case s_Arctan:
  1041.           curr_token.value.D=atan(read_double());
  1042.           curr_token.type=t_real;
  1043.           return 0;
  1044.         case s_Arctan2: {
  1045.           double x=read_double();
  1046.           double y=read_double();
  1047.           /* NOTE: the Shared C Library headers and the Shared C Library
  1048.            * itself do not agree about what atan2() does.
  1049.            * The following is correct given what the function actually does.
  1050.            */
  1051.           curr_token.value.D=atan2(y,x);
  1052.           curr_token.type=t_real;
  1053.           return 0; }
  1054.         case s_Floor:
  1055.           curr_token.value.D=floor(read_double());
  1056.           curr_token.type=t_real;
  1057.           return 0;
  1058.         case s_Include:
  1059.           open_new_file(read_string());
  1060.           goto next;
  1061. #ifdef TAGS
  1062.         case s_TagOpen:
  1063.           tag_open(read_string());
  1064.           goto next;
  1065.         case s_TagLookup: {
  1066.           char *s=tag_lookup(read_string());
  1067.           if (!s) { minor("Non-existent tag"); s=""; }    /* copy_string("")? */
  1068.           curr_token.type=t_string;
  1069.           curr_token.value.CP=s;
  1070.           return 0; }
  1071.         case s_TagClose:
  1072.           if (!tags) warn("There isn't an open tagfile");
  1073.           tag_close();
  1074.           goto next;
  1075. #endif
  1076.         case s_Append: {
  1077.           /* This code is inefficient. Tough. */
  1078.           int i,n; char **s; int l=0;
  1079.           n=read_int();
  1080.           if (n<0) { minor("Negative number of strings"); n=0; }
  1081.           s=(char**)xmalloc(n*4,"strings to append");
  1082.           for (i=0;i<n;++i)
  1083.             l+=strlen(s[i]=read_string());
  1084.           curr_token.type=t_string;
  1085.           curr_token.value.CP=(char*)xmalloc(l+1,"appended string");
  1086.           *curr_token.value.CP=0;
  1087.           for (i=0;i<n;++i) strcat(curr_token.value.CP,s[i]);
  1088.           xfree(s);
  1089.           return 0; }
  1090.         case s_GSTrans: {
  1091.           char *s=read_string();
  1092.           int len=2*strlen(s);
  1093.           int t;
  1094.           char *buf=xmalloc(len,"GSTrans-ed string");
  1095.           while ((t=gstrans(s,buf,len))==1) {
  1096.             xfree(buf);
  1097.             buf=xmalloc(len<<=1,"GSTrans-ed string"); }
  1098.           if (t) { minor("Bad string passed to GSTrans"); *buf=0; }
  1099.           curr_token.type=t_string;
  1100.           curr_token.value.CP=copy_string(buf);
  1101.           xfree(buf);
  1102.           return 0; }
  1103.         case s_Font: {
  1104.           char *s=read_string();
  1105.           curr_token.type=t_real;
  1106.           curr_token.value.D=(double)font_number(s);
  1107.           return 0; }
  1108.         case s_Str2Num: {
  1109.           /* this code should be essentially the same as that in
  1110.            * |get_token()|:
  1111.            */
  1112.           char *s=read_string();
  1113.           double d; char *cp;
  1114.           d=strtod(s,&cp);
  1115.           if (*cp && *s=='0' && (s[1]=='x'||s[1]=='X'))
  1116.             d=(double)strtoul(s+2,&cp,16);
  1117.           /* now |*cp==0| iff it was a number */
  1118.           curr_token.type=t_real;
  1119.           if (*cp) minor("Str2Num requires a number");
  1120.           curr_token.value.D=(*cp) ? 0 : d;
  1121.           return 0; }
  1122.         case s_Num2Str: {
  1123.           double d=read_double();
  1124.           char s[40];    /* way more than we need */
  1125.           sprintf(s,"%.10lg",d);
  1126.           /* '-' is not a minus sign; char 153 is */
  1127.           { char *cp=s; while (*cp) { if (*cp=='-') *cp=153; ++cp; } }
  1128.           curr_token.type=t_string;
  1129.           curr_token.value.CP=copy_string(s);
  1130.           return 0; }
  1131.         case s_Random:
  1132.           curr_token.type=t_real;
  1133.           curr_token.value.D=rand()/(((double)RAND_MAX)+1);
  1134.           return 0;
  1135.         case s_Units:
  1136.           unit=read_double();
  1137.           scaling = (unit!=1.0);
  1138.           goto next;
  1139.         case s_Unit:
  1140.           curr_token.type=t_real;
  1141.           curr_token.value.D=unit;
  1142.           return 0;
  1143.         default:
  1144.           error("Unknown `special' token, number=%d",curr_token.value.I);
  1145.       }
  1146.     /* End of the specials. Back to other token types. */
  1147. #undef EOFerr
  1148. #define EOFerr(x) { minor("EOF or error in " x); return 1; }
  1149.     case t_macro: {
  1150.       TwoWords *hh=curr_token.value.PP;
  1151.       if (macro_level>=max_macro_level)
  1152.         error("Too many nested macros");
  1153.       if (get_token()) EOFerr("macro invocation");
  1154.       if (curr_token.type!=t_openbr) {
  1155.         warn("Macro invocation without params");
  1156.         goto again; }
  1157.       while (1) {
  1158.         HashEntry *h;
  1159.         if (get_token()) EOFerr("macro invocation");
  1160.         if (curr_token.type==t_closebr) break;
  1161.         if (curr_token.type!=t_local) {
  1162.           minor("Invalid macro parameter");
  1163.           continue; }
  1164.         h=curr_token.value.HP;
  1165.         if (get_x_token(1)) EOFerr("macro invocation");
  1166.         if (curr_token.type==t_closebr) curr_token=null_token;
  1167.         ++macro_level;
  1168.         set_local(h,&curr_token);
  1169.         --macro_level;
  1170.       }
  1171.       ++macro_level;
  1172.       macro_context[macro_level].toks_depth=toklists_on_stack;
  1173.       macro_context[macro_level].next_tok=next_token;
  1174.       next_token=hh;
  1175.       n_pps[macro_level]=0;
  1176.       goto next; }
  1177.     case t_global:
  1178.       curr_token=curr_token.value.HP->value;
  1179.       goto again;
  1180.     case t_local:
  1181.       if (!macro_level) {
  1182.         minor("Local variable reference outside macro");
  1183.         goto next; }
  1184.       curr_token=curr_token.value.HP->value;
  1185.       curr_token.type&=~0xFF000000;    /* remove level indicator */
  1186.       goto again;
  1187.     case t_localP: {
  1188.       int n,m;
  1189.       if (!macro_level) {
  1190.         minor("Positional parameter reference outside macro");
  1191.         goto next; }
  1192.       n=curr_token.value.U;
  1193.       if (n>(m=n_pps[macro_level])) {
  1194.         int od=toklists_on_stack;
  1195.         TwoWords *on=next_token;
  1196.         toklists_on_stack=macro_context[macro_level].toks_depth;
  1197.         next_token=macro_context[macro_level].next_tok;
  1198.         do {
  1199.           if (get_x_token(1))
  1200.             EOFerr("macro invocation (reading pos. param.)");
  1201.           set_local(pp_val+m++,&curr_token);
  1202.         } while (m<n);
  1203.         n_pps[macro_level]=m;
  1204.         macro_context[macro_level].toks_depth=toklists_on_stack;
  1205.         macro_context[macro_level].next_tok=next_token;
  1206.         toklists_on_stack=od;
  1207.         next_token=on;
  1208.       }
  1209.       curr_token=pp_val[n-1].value;
  1210.       curr_token.type&=~0xFF000000;
  1211.       return 0; }
  1212.     case t_openbr:
  1213.       if (seq) {
  1214.         TwoWords *p=0,*q;
  1215.         int depth=0;
  1216.         while (1) {
  1217.           if (get_token()) EOFerr("token list");
  1218.           if (curr_token.type==t_openbr) ++depth;
  1219.           if (curr_token.type==t_closebr && !depth--) break;
  1220.           { Token *t=new_token(); TwoWords *u=new_pair();
  1221.             *t=curr_token; u->P.first.TP=t;
  1222.             if (p) q=(q->P.rest.PP=u); else q=p=u;
  1223.           }
  1224.         }
  1225.         if (p) q->P.rest.PP=0;
  1226.         curr_token.type=t_toklist;
  1227.         curr_token.value.PP=p;
  1228.       }
  1229.       return 0;
  1230.     case t_closebr:
  1231.       return 0;
  1232.     case t_unready:
  1233.       curr_token.type=t_macro;
  1234.       curr_token.value.PP=curr_token.value.HP->value.value.PP;
  1235.       goto again;
  1236.     default:
  1237.       minor("Impossible token (type=%d) found during expansion",
  1238.             curr_token.type);
  1239.       goto next;
  1240.   }
  1241.   error("This can't happen: fall-through in |get_x_token()|");
  1242.   return 1;    /* pacify compiler */
  1243. }
  1244. #undef EOFerr
  1245.  
  1246.  
  1247. /* -------------------------- scaling -------------------------- */
  1248.  
  1249.  
  1250. /* Unfortunately, the following need to be visible everywhere because
  1251.  * some scaling happens at one place in stomach.c.
  1252.  */
  1253.  
  1254. extern int scaling=0;    /* non-zero iff we are using units other than points */
  1255. extern double unit=1;    /* size of 1 unit, in points */
  1256.  
  1257.  
  1258. /* -------------------------- automatic variables -------------------------- */
  1259.  
  1260.  
  1261. /* Not "automatic" as in C. We set some variables at the very start
  1262.  * of the program, because they might be useful.
  1263.  * |set_variable()| is not static, because it's used to set text bbox
  1264.  * variables for Text and XfText objects.
  1265.  */
  1266.  
  1267. void set_variable(const char *name, double value) {
  1268.   Token *t=&(hashloc(name)->value);
  1269.   t->type=t_real;
  1270.   t->value.D=value;
  1271. }
  1272.  
  1273.  
  1274. void init_vars(void) {
  1275.   set_variable("$points",1);
  1276.   set_variable("$inches",72);
  1277.   set_variable("$centimetres",28.3464566929134);
  1278.   set_variable("$millimetres",2.83464566929134);
  1279.   set_variable("$scaledpoints",1.0/640);
  1280.   set_variable("$osunits",72.0/180);
  1281. }
  1282.  
  1283.  
  1284. /* -------------------------- special readers -------------------------- */
  1285.  
  1286.  
  1287. /* Each of these functions just reads a single token (with expansion)
  1288.  * and makes sure it's of a suitable type.
  1289.  */
  1290.  
  1291. double read_double(void) {
  1292.   if (get_x_token(0)) {
  1293.     minor("EOF or error occurred, looking for a number"); return 0; }
  1294.   if (curr_token.type!=t_real) {
  1295.     curr_token.type=t_real;
  1296.     minor("Wrong type; number expected"); return 0; }
  1297.   return curr_token.value.D;
  1298. }
  1299.  
  1300. int read_int(void) {
  1301.   if (get_x_token(0)) {
  1302.     minor("EOF or error occurred, looking for an integer"); return 0; }
  1303.   if (curr_token.type!=t_real) {
  1304.     curr_token.type=t_real;
  1305.     minor("Wrong type; integer expected"); return 0; }
  1306.   { double x=curr_token.value.D;
  1307.     if (x!=floor(x)) minor("Non-integer occurred when integer expected");
  1308.     return (int)x;
  1309.   }
  1310. }
  1311.  
  1312. char *read_string(void) {
  1313.   if (get_x_token(0)) {
  1314.     minor("EOF or error occurred, looking for a string"); return ""; }
  1315.   if (curr_token.type!=t_string) {
  1316.     minor("Wrong type; string expected"); return ""; }
  1317.   return curr_token.value.CP;
  1318. }
  1319.  
  1320. /* |read_real640()| and |read_real1000()| read real numbers and interpret
  1321.  * them as dimensions, with units of either 1/640pt or 1/1000pt.
  1322.  * |cvt_real640()| and |cvt_real1000()| do the same, but don't actually
  1323.  * read a new token first.
  1324.  */
  1325.  
  1326. static int cvt_real640(void) {
  1327.   if (curr_token.type!=t_real) {
  1328.     curr_token.type=t_real;
  1329.     minor("Wrong type; dimension expected"); return 0; }
  1330.   return (int)floor(curr_token.value.D*(scaling?640*unit:640)+.5);
  1331. }
  1332.  
  1333. static int cvt_real1000(void) {
  1334.   if (curr_token.type!=t_real) {
  1335.     curr_token.type=t_real;
  1336.     minor("Wrong type; dimension expected"); return 0; }
  1337.   return (int)floor(curr_token.value.D*(scaling?1000*unit:1000)+.5);
  1338. }
  1339.  
  1340. int read_real640(void) {
  1341.   if (get_x_token(0)) {
  1342.     minor("EOF or error occurred, looking for a dimension"); return 0; }
  1343.   return cvt_real640();
  1344. }
  1345.  
  1346. int read_real1000(void) {
  1347.   if (get_x_token(0)) {
  1348.     minor("EOF or error occurred, looking for a dimension"); return 0; }
  1349.   return cvt_real1000();
  1350. }
  1351.  
  1352. /* |read_kwd()| returns the number of the keyword.
  1353.  * |read_kwd_or_cbr()| returns -1 for close-brace (or EOF, with error)
  1354.  */
  1355.  
  1356. int read_kwd(void) {
  1357.   if (get_x_token(0)) {
  1358.     minor("EOF or error occurred when keyword expected"); return k_Illegal; }
  1359.   if (curr_token.type!=t_keyword) {
  1360.     minor("Wrong type; keyword expected"); return k_Illegal; }
  1361.   return curr_token.value.U;
  1362. }
  1363.  
  1364. int read_kwd_or_cbr(void) {
  1365.   if (get_x_token(0)) {
  1366.     minor("EOF or error occurred when keyword or `}' expected");
  1367.     return -1; }    /* so loops terminate on EOF */
  1368.   /* } */
  1369.   if (curr_token.type==t_closebr) return -1;
  1370.   if (curr_token.type!=t_keyword) {
  1371.     minor("Wrong type: keyword expected"); return k_Illegal; }
  1372.   return curr_token.value.I;
  1373. }
  1374.  
  1375. /* |read_openbr()| and |read_closebr()| do just what you might
  1376.  * expect.
  1377.  */
  1378.  
  1379. void read_openbr(void) {
  1380.   if (get_x_token(0)) minor("EOF or error occurred when `{' expected");
  1381.   if (curr_token.type!=t_openbr) minor("Wrong type; `{' expected");
  1382.   /* }} */
  1383. }
  1384.  
  1385. void read_closebr(void) {
  1386.   /* {{ */
  1387.   if (get_x_token(0)) minor("EOF or error occurred when `}' expected");
  1388.   if (curr_token.type!=t_closebr) minor("Wrong type; `}' expected");
  1389. }
  1390.  
  1391. /* |read_colour()| returns an integer representing a colour in the usual
  1392.  * RISC OS way, namely 0xBBGGRR00 or -1 for transparent.
  1393.  */
  1394. int read_colour(void) {
  1395.   if (get_x_token(0)) {
  1396.     minor("EOF or error occurred when colour expected"); return -1; }
  1397.   if (curr_token.type!=t_colour) {
  1398.     int i;
  1399.     if (curr_token.type==t_real
  1400.         && (double)(i=(int)floor(curr_token.value.D))==curr_token.value.D
  1401.         && i>=0 && i<256) {
  1402.       int j,k;
  1403.       if ((j=read_int())>=0 && j<256 &&
  1404.           (k=read_int())>=0 && k<256) return (i<<8)+(j<<16)+(k<<24);
  1405.       minor("Malformed 3-component colour"); return -1; }
  1406.     minor("Wrong type; colour expected"); return -1; }
  1407.   return curr_token.value.U;
  1408. }
  1409.  
  1410.  
  1411. /* -------------------------- initialising htable -------------------------- */
  1412.  
  1413.  
  1414. #define insert_key(str,num) { HashEntry *h=hashloc(str);\
  1415.   h->value.type=t_keyword; h->value.value.I=num; }
  1416.  
  1417. #define insert_spec(str,num) { HashEntry *h=hashloc(str);\
  1418.   h->value.type=t_special; h->value.value.I=num; }
  1419.  
  1420. void init_global_hash(void) {
  1421.   insert_key("header",k_Header);
  1422.   insert_key("fonttable",k_FontTable);
  1423.   insert_key("text",k_Text);
  1424.   insert_key("path",k_Path);
  1425.   insert_key("sprite",k_Sprite);
  1426.   insert_key("group",k_Group);
  1427.   insert_key("tagged",k_Tagged);
  1428.   insert_key("textarea",k_TextArea);
  1429.   insert_key("column",k_Column);
  1430.   insert_key("options",k_Options);
  1431.   insert_key("xftext",k_XfText);
  1432.   insert_key("xfsprite",k_XfSprite);
  1433.   insert_key("version",k_Version);
  1434.   insert_key("creator",k_Creator);
  1435.   insert_key("boundingbox",k_BoundingBox);
  1436.   insert_key("colour",k_Colour);
  1437.   insert_key("background",k_Background);
  1438.   insert_key("style",k_Style);
  1439.   insert_key("size",k_Size);
  1440.   insert_key("startat",k_StartAt);
  1441.   insert_key("fillcolour",k_FillColour);
  1442.   insert_key("outlinecolour",k_OutlineColour);
  1443.   insert_key("width",k_Width);
  1444.   insert_key("move",k_Move);
  1445.   insert_key("close",k_Close);
  1446.   insert_key("line",k_Line);
  1447.   insert_key("curve",k_Curve);
  1448.   insert_key("rmove",k_RMove);
  1449.   insert_key("rline",k_RLine);
  1450.   insert_key("rcurve",k_RCurve);
  1451.   insert_key("mitred",k_Mitred);
  1452.   insert_key("round",k_Round);
  1453.   insert_key("bevelled",k_Bevelled);
  1454.   insert_key("endcap",k_EndCap);
  1455.   insert_key("startcap",k_StartCap);
  1456.   insert_key("butt",k_Butt);
  1457.   insert_key("square",k_Square);
  1458.   insert_key("triangular",k_Triangular);
  1459.   insert_key("windingrule",k_WindingRule);
  1460.   insert_key("dash",k_Dash);
  1461.   insert_key("capwidth",k_CapWidth);
  1462.   insert_key("caplength",k_CapLength);
  1463.   insert_key("nonzero",k_NonZero);
  1464.   insert_key("evenodd",k_EvenOdd);
  1465.   insert_key("offset",k_Offset);
  1466.   insert_key("pattern",k_Pattern);
  1467.   insert_key("name",k_Name);
  1468.   insert_key("identifier",k_Identifier);
  1469.   insert_key("otherdata",k_OtherData);
  1470.   insert_key("matrix",k_Matrix);
  1471.   insert_key("kerned",k_Kerned);
  1472.   insert_key("righttoleft",k_RightToLeft);
  1473.   insert_key("papersize",k_PaperSize);
  1474.   insert_key("limits",k_Limits);
  1475.   insert_key("grid",k_Grid);
  1476.   insert_key("zoom",k_Zoom);
  1477.   insert_key("notoolbox",k_NoToolbox);
  1478.   insert_key("mode",k_Mode);
  1479.   insert_key("undosize",k_UndoSize);
  1480.   insert_key("shown",k_Shown);
  1481.   insert_key("landscape",k_Landscape);
  1482.   insert_key("nondefault",k_NonDefault);
  1483.   insert_key("spacing",k_Spacing);
  1484.   insert_key("divisions",k_Divisions);
  1485.   insert_key("isometric",k_Isometric);
  1486.   insert_key("autoadjust",k_AutoAdjust);
  1487.   insert_key("lock",k_Lock);
  1488.   insert_key("inches",k_Inches);
  1489.   insert_key("ratio",k_Ratio);
  1490.   insert_key("closedline",k_ClosedLine);
  1491.   insert_key("closedcurve",k_ClosedCurve);
  1492.   insert_key("rectangle",k_Rectangle);
  1493.   insert_key("ellipse",k_Ellipse);
  1494.   insert_key("select",k_Select);
  1495.   insert_key("fromfile",k_FromFile);
  1496.   insert_key("hcentrein",k_HCentreIn);
  1497.   insert_key("centrein",k_CentreIn);
  1498.   insert_key("hcentreon",k_HCentreOn);
  1499.   insert_key("centreat",k_CentreAt);
  1500.   insert_key("virtual",k_Virtual);
  1501. #ifndef NO_JPEG
  1502.   insert_key("jpeg",k_JPEG);
  1503.   insert_key("dpi",k_DPI);
  1504.   insert_key("length",k_Length);
  1505. #endif
  1506.   insert_spec("define",s_Define);
  1507.   insert_spec("set",s_Set);
  1508.   insert_spec("ifexists",s_IfExists);
  1509.   insert_spec("ifless",s_IfLess);
  1510.   insert_spec("ifequal",s_IfEqual);
  1511.   insert_spec("else",s_Else);
  1512.   insert_spec("endif",s_EndIf);
  1513.   insert_spec("for",s_For);
  1514.   insert_spec("plus",s_Plus);
  1515.   insert_spec("minus",s_Minus);
  1516.   insert_spec("times",s_Times);
  1517.   insert_spec("over",s_Over);
  1518.   insert_spec("sqrt",s_Sqrt);
  1519.   insert_spec("sin",s_Sin);
  1520.   insert_spec("cos",s_Cos);
  1521.   insert_spec("tan",s_Tan);
  1522.   insert_spec("arcsin",s_Arcsin);
  1523.   insert_spec("arccos",s_Arccos);
  1524.   insert_spec("arctan",s_Arctan);
  1525.   insert_spec("arctan2",s_Arctan2);
  1526.   insert_spec("floor",s_Floor);
  1527.   insert_spec("include",s_Include);
  1528. #ifdef TAGS
  1529.   insert_spec("tagopen",s_TagOpen);
  1530.   insert_spec("taglookup",s_TagLookup);
  1531.   insert_spec("tagclose",s_TagClose);
  1532. #endif
  1533.   insert_spec("append",s_Append);
  1534.   insert_spec("gstrans",s_GSTrans);
  1535.   insert_spec("font",s_Font);
  1536.   insert_spec("str2num",s_Str2Num);
  1537.   insert_spec("num2str",s_Num2Str);
  1538.   insert_spec("random",s_Random);
  1539.   insert_spec("units",s_Units);
  1540. }
  1541.  
  1542.  
  1543. /* --------------------------  -------------------------- */
  1544. /* --------------------------  -------------------------- */
  1545. /* --------------------------  -------------------------- */
  1546. /* --------------------------  -------------------------- */
  1547. /* --------------------------  -------------------------- */
  1548. /* --------------------------  -------------------------- */
  1549.