home *** CD-ROM | disk | FTP | other *** search
/ RISC DISC 1 / RISC_DISC_1.iso / pd_share / games / inform / compiler / source / c / express < prev    next >
Encoding:
Text File  |  1994-09-23  |  44.4 KB  |  1,134 lines
  1. /* ------------------------------------------------------------------------- */
  2. /*   "express" :  The expression evaluator                                   */
  3. /*                                                                           */
  4. /*   Part of Inform release 5                                                */
  5. /*                                                                           */
  6. /* ------------------------------------------------------------------------- */
  7.  
  8. #include "header.h"
  9.  
  10. /* ------------------------------------------------------------------------- */
  11. /*   Definition of expression tree branch                                    */
  12. /* ------------------------------------------------------------------------- */
  13.  
  14. typedef struct treenode {
  15.     int up;                     /* Node above                                */
  16.     int word;                   /* Token number in source line               */
  17.     int type;                   /* Type of node (there are eight: see above) */
  18.     int priority;               /* Eg, + has a low priority, * a higher one  */
  19.     int label_number;           /* For code blocks in && and || expressions  */
  20.     int yes_label;              /* Condition true                            */
  21.     int no_label;               /* Condition false                           */
  22.     int arity;                  /* Number of branches expected               */
  23.     int b[MAX_ARITY];           /* Nodes below (the branches)...             */
  24.     int branches_made;          /* ...from 0 up to this-1                    */
  25.     char *op;                   /* Name of opcode to achieve this operation  */
  26. } treenode;
  27.  
  28. #ifndef ALLOCATE_BIG_ARRAYS
  29.   static treenode   tree[MAX_EXPRESSION_NODES];
  30. #else
  31.   static treenode   *tree;
  32. #endif
  33.  
  34. extern void express_allocate_arrays(void)
  35. {
  36. #ifdef ALLOCATE_BIG_ARRAYS
  37.     tree      = my_calloc(sizeof(treenode),   MAX_EXPRESSION_NODES,
  38.                 "expression tree");
  39. #endif
  40. }
  41.  
  42. extern void express_free_arrays(void)
  43. {   
  44. #ifdef ALLOCATE_BIG_ARRAYS
  45.     my_free(tree, "expression tree");
  46. #endif
  47. }
  48.  
  49. /* ------------------------------------------------------------------------- */
  50. /*   Compiler expression and assignment evaluator                            */
  51. /* ------------------------------------------------------------------------- */
  52. /*                                                                           */
  53. /*   This is easily the most complicated algorithm in Inform, for two        */
  54. /*   reasons - firstly, because I invented it in a hurry and know absolutely */
  55. /*   nothing about compiler theory, and second, because it tries to avoid    */
  56. /*   recursion which uses the C stack.  (Some machines to which Inform has   */
  57. /*   been ported have had problems with the size of the C stack.)            */
  58. /*                                                                           */
  59. /*   The code generator is also complicated by some awkward features of the  */
  60. /*   Z-machine: for instance, the safe way to extract property lengths is    */
  61. /*   tricky to get right.  Anyway, enough excuses:                           */
  62. /*                                                                           */
  63. /*   The algorithm first makes a tree out of the expression and then         */
  64. /*   clears it off again by clipping off nodes and stacking up corresponding */
  65. /*   assembly lines.  This needs to be in the right order, since the stack   */
  66. /*   can't very conveniently be re-ordered.                                  */
  67. /*                                                                           */
  68. /*   The algorithm is iterative rather than recursive.  In the first phase,  */
  69. /*   we imagine a tree gradually growing as a dryad scampers over it.  She   */
  70. /*   is either resting on a leaf already grown, or else hovering in midair   */
  71. /*   over the space where one will grow.  Every so often she casts an easy   */
  72. /*   spell to grow a leaf where she is, or a more powerful one to grow her   */
  73. /*   leaf into a branch, and she then clambers along or down.                */
  74. /*                                                                           */
  75. /*   The dryad is also sometimes awaiting a comma, since she knows that the  */
  76. /*   line 45+1, ... ends with the comma, whereas i=fn(j,k) does not.  Sadly  */
  77. /*   she can get distracted while waiting, for instance in the expression    */
  78. /*   (after reading j) i=fn(j+5*(l+1),2), but being conscientious she ties   */
  79. /*   her veil where she was so as to be able to find the place again later.  */
  80. /*                                                                           */
  81. /*   To follow her movements, try Informing with full expression tracing on  */
  82. /*   (using "etrace full"): to look simply at the tree she grows, and the    */
  83. /*   code it results in, try just "etrace".                                  */
  84. /*                                                                           */
  85. /*   The main data structure (treenode) is commented at the top of the file. */
  86. /*   (Most of the variables have been more sensibly named since early        */
  87. /*   releases: in particular now you can't see the woods[] for the tree[].)  */
  88. /* ------------------------------------------------------------------------- */
  89.  
  90. #define ROOT_NODE    -4
  91. #define BLANK_NODE   -3
  92. #define CDONE_NODE   -2
  93. #define SP_NODE      -1
  94. #define LEAF_NODE     0
  95. #define STORE_NODE    1
  96. #define ARITH_NODE    2
  97. #define FCALL_NODE    3
  98. #define COND_NODE     4
  99. #define NCOND_NODE    5
  100. #define LOGICAND_NODE 6
  101. #define LOGICOR_NODE  7
  102. #define OR_NODE       8
  103. #define ALTERA_NODE   9
  104. #define ALTERB_NODE  10
  105.  
  106. static int tree_size, dryad, resting, comma_mode, dryad_veil=-1,
  107.            sofar_empty;
  108.  
  109. /* ------------------------------------------------------------------------- */
  110. /*   Pretty printing (for diagnostics)                                       */
  111. /* ------------------------------------------------------------------------- */
  112.  
  113. static void show_leaf(int ln, int depth)
  114. {   char sl_buffer[100];
  115.     int j;
  116.     for (j=0; j<2*depth+2; j++) printf(" ");
  117.     if (ln==-1) { printf("..\n"); return; }
  118.     else if (etrace_mode==1) printf("%02d ",ln);
  119.     switch(tree[ln].type)
  120.     {   case ROOT_NODE:  printf("<root>"); break;
  121.         case BLANK_NODE: printf("<blank>"); break;
  122.         case CDONE_NODE: printf("<condition done>"); break;
  123.         case SP_NODE:    printf("<sp>"); break;
  124.         case LEAF_NODE:  word(sl_buffer,tree[ln].word);
  125.                          printf("%s",sl_buffer); break;
  126.         default:         printf("%s",tree[ln].op); break;
  127.     }
  128.     if (etrace_mode==1)
  129.     {   if (tree[ln].priority!=0)
  130.         { printf(" (%d)",tree[ln].priority); }
  131.         if (tree[ln].type>=STORE_NODE)
  132.         {   switch(tree[ln].type)
  133.             {   case STORE_NODE:    printf(" [assignment] ");        break;
  134.                 case ARITH_NODE:    printf(" [arithmetic] ");        break;
  135.                 case FCALL_NODE:    printf(" [function call] ");     break;
  136.                 case COND_NODE:     printf(" [condition] ");         break;
  137.                 case NCOND_NODE:    printf(" [negated condition] "); break;
  138.                 case LOGICAND_NODE: printf(" [conjunction] ");       break;
  139.                 case LOGICOR_NODE:  printf(" [disjunction] ");       break;
  140.                 case OR_NODE:       printf(" [or] ");                break;
  141.                 case ALTERA_NODE:    printf(" [read then alter] ");  break;
  142.                 case ALTERB_NODE:    printf(" [alter then read] ");  break;
  143.             }
  144.         }
  145.         printf(" ^%d ",tree[ln].up);
  146.         if (ln==dryad) printf("(dryad here) ");
  147.     }
  148.     if ((tree[ln].type==LOGICAND_NODE)
  149.         ||(tree[ln].type==LOGICOR_NODE))
  150.         printf(" {%d/%d/%d} ",tree[ln].label_number,
  151.             tree[ln].yes_label, tree[ln].no_label);
  152.     printf("\n");
  153.     for (j=0; j<tree[ln].arity; j++)
  154.     {   if (j<tree[ln].branches_made) show_leaf(tree[ln].b[j],depth+1);
  155.         else show_leaf(-1,depth+1);
  156.     }
  157. }
  158.  
  159. static void show_tree(char *c)
  160. {   printf("%s\n",c); show_leaf(tree[0].b[0],0);
  161.     if (etrace_mode==1)
  162.     {   printf("The dryad is at %d and is %s%s\n",
  163.             dryad,(resting==1)?"resting":"hovering in midair",
  164.             (comma_mode==0)?"":"\nwhile waiting for a comma");
  165.         if (dryad_veil!=-1)
  166.             printf("with her veil tied to %d\n",dryad_veil);
  167.     }
  168. }
  169.  
  170. /* ------------------------------------------------------------------------- */
  171. /*   Growing the tree                                                        */
  172. /* ------------------------------------------------------------------------- */
  173.  
  174. static void grow_branch(int a, int wn, int type, char *opcde, int prio)
  175. {   int i, above_dryad, rflag, prefix=0, postfix=0;
  176.  
  177.     if (a>=MAX_ARITY)
  178.     {   error("A function may be called with at most 3 arguments");
  179.         return;
  180.     }
  181.  
  182.     above_dryad=tree[dryad].up;
  183.  
  184.     if ((a==1)&&(type!=FCALL_NODE)&&(sofar_empty==1))
  185.     {   prefix=1;
  186.         if (type==ALTERA_NODE) type=ALTERB_NODE;
  187.     }
  188.     if (type==ALTERA_NODE) postfix=1;
  189.     if ((a==1)&&(type==FCALL_NODE)) postfix=1;
  190.  
  191.     if (etrace_mode==1) printf("%s%s%s operator '%s'\n",
  192.         (prefix==1)?"prefix":"",(postfix==1)?"postfix":"",
  193.         ((prefix==0)&&(postfix==0))?"infix":"",opcde);
  194.     sofar_empty=1;
  195.  
  196.     if ((resting==0)&&(comma_mode==0)&&(prefix==0))
  197.     {   error("Operator has too few arguments"); return;
  198.     }
  199.  
  200.     if (    ((type==LOGICAND_NODE)
  201.              && (tree[tree[above_dryad].up].type==LOGICAND_NODE))
  202.          || ((type==LOGICOR_NODE)
  203.              && (tree[tree[above_dryad].up].type==LOGICOR_NODE))
  204.          || ((type==OR_NODE) && (strcmp(tree[above_dryad].op,"je")==0))
  205.          || ((type==OR_NODE) && (strcmp(tree[above_dryad].op,"vje")==0)) )
  206.     {   if ((type==LOGICAND_NODE) || (type==LOGICOR_NODE))
  207.             above_dryad=tree[above_dryad].up;
  208.         if (tree[above_dryad].arity < MAX_ARITY)
  209.         { tree[above_dryad].arity++; rflag=1; }
  210.         if (type==OR_NODE)
  211.         {   tree[above_dryad].op="vje";
  212.             if (tree[above_dryad].arity==5)
  213.             {   error("At most three values can be separated by 'or'");
  214.                 rflag=0;
  215.             }
  216.         }
  217.         if (rflag==1)
  218.         {   dryad=tree_size++;
  219.             tree[dryad].up=above_dryad;
  220.             tree[dryad].type=BLANK_NODE;
  221.             tree[above_dryad].b[tree[above_dryad].arity-1]=dryad;
  222.             resting=0;
  223.             return;
  224.         }
  225.     }
  226.  
  227.     if (type==OR_NODE)
  228.         error("'or' can only be used with the conditions '==' and '~='");
  229.  
  230.     if (comma_mode==1)
  231.     {   comma_mode=0;
  232.         if (prefix==0) dryad_veil=dryad;
  233.     }
  234.  
  235.     while (tree[above_dryad].priority>prio)
  236.     {   dryad=above_dryad; above_dryad=tree[dryad].up;
  237.     }
  238.  
  239.     if (prefix==0)
  240.     {   while (tree[dryad].type== BLANK_NODE)
  241.         {   for (i=1; i<tree[above_dryad].arity; i++)
  242.                 if (tree[above_dryad].b[i]==dryad)
  243.                 { dryad=tree[above_dryad].b[i-1]; break; }
  244.         }
  245.     }
  246.  
  247.     if (prefix==1) tree[above_dryad].branches_made++;
  248.  
  249.     for (i=0; i<tree[above_dryad].arity; i++)
  250.         if (tree[above_dryad].b[i]==dryad)
  251.             tree[above_dryad].b[i]=tree_size;
  252.  
  253.     tree[dryad].up=tree_size;
  254.     tree[tree_size].b[0]=dryad;
  255.     tree[tree_size].up=above_dryad; 
  256.  
  257.     dryad=tree_size++;
  258.  
  259.     tree[dryad].arity=a;
  260.     tree[dryad].word=wn;
  261.     tree[dryad].branches_made=1;
  262.     if (prefix==1) tree[dryad].branches_made=0;
  263.     tree[dryad].type=type;
  264.     tree[dryad].op=opcde;
  265.     tree[dryad].priority=prio;
  266.     tree[dryad].no_label=-2;
  267.     tree[dryad].yes_label=-2;
  268.     if ((type==LOGICAND_NODE) || (type==LOGICOR_NODE))
  269.         tree[dryad].label_number=no_dummy_labels++;
  270.  
  271.     for (i=1; i<a; i++)
  272.     {   tree[dryad].b[i]=tree_size;
  273.         tree[tree_size].type= BLANK_NODE;
  274.         tree[tree_size].arity=0;
  275.         tree[tree_size].branches_made=0;
  276.         tree[tree_size].priority=0;
  277.         tree[tree_size++].up=dryad;
  278.     }
  279.     if ((prefix==0)&&(postfix==0))
  280.     {       if (etrace_mode==1) printf("Magic = %d\n",dryad);
  281.         dryad=tree[dryad].b[1]; resting=0; }
  282.     if (prefix==1)
  283.     {   dryad=tree[dryad].b[0]; resting=0; }
  284.     if (postfix==1)
  285.     {   dryad=tree[dryad].b[0]; resting=1; }
  286.  
  287.     if (etrace_mode==1) show_tree("grow_branch to");
  288. }
  289.  
  290. static void grow_leaf(int wn)
  291. {   int above_dryad;
  292.  
  293.     above_dryad=tree[dryad].up;
  294.  
  295.     tree[dryad].arity=0;
  296.     tree[dryad].word=wn;
  297.     tree[dryad].branches_made=0;
  298.     tree[dryad].type=LEAF_NODE;
  299.     tree[dryad].priority=0;
  300.  
  301.     tree[above_dryad].branches_made++;
  302.     if (tree[above_dryad].branches_made<tree[above_dryad].arity)
  303.     { dryad=tree[above_dryad].b[tree[above_dryad].branches_made];
  304.       resting=0;
  305.     }
  306.     else resting=1;
  307.  
  308.     if (etrace_mode==1) show_tree("grow_leaf to");
  309.     return;
  310. }
  311.  
  312. static void fix_yesno_labels(int n, int flag)
  313. {   int i;
  314.     if ((tree[n].type!=LOGICOR_NODE)&&(tree[n].type!=LOGICAND_NODE))
  315.         return;
  316.     if (flag==1)
  317.     {   
  318.             tree[n].yes_label = tree[tree[n].up].yes_label;
  319.             tree[n].no_label  = tree[tree[n].up].no_label;
  320.     }
  321.     else
  322.     switch(tree[tree[n].up].type)
  323.     {   case ROOT_NODE:
  324.             tree[n].yes_label = no_dummy_labels-1;
  325.             tree[n].no_label  = -1;
  326.             break;
  327.         case LOGICAND_NODE:
  328.             tree[n].yes_label = tree[n].label_number;
  329.             tree[n].no_label  = tree[tree[n].up].no_label;
  330.             break;
  331.         case LOGICOR_NODE:
  332.             tree[n].yes_label = tree[tree[n].up].yes_label;
  333.             tree[n].no_label  = tree[n].label_number;
  334.             break;
  335.     }
  336.     for (i=0; i<tree[n].branches_made; i++)
  337.         fix_yesno_labels(tree[n].b[i], (i==tree[n].branches_made-1)?1:0);
  338. }
  339.  
  340. /* ------------------------------------------------------------------------- */
  341. /*   Main expression (and assignment) evaluator routine:                     */
  342. /*                                                                           */
  343. /*   expression(from) compiles code to evaluate the expression starting at   */
  344. /*     token from, leaves next_token at the first not part of the expression */
  345. /*     (or -1 if the line was all used up); and returns                      */
  346. /*                                                                           */
  347. /*     -3  if the result was thrown away (eg. a void context function call)  */
  348. /*     -2  if there is no result (eg, from "i=4" there is none)              */
  349. /*     -1  if the result is on the stack                                     */
  350. /*     n   if the result is the constant term in token n                     */
  351. /* ------------------------------------------------------------------------- */
  352.  
  353. static void eword(char *b, int bn)
  354. {   if (tree[bn].type==SP_NODE) strcpy(b,"sp");
  355.     else word(b,tree[bn].word);
  356.     /* printf("Eword %d -> %d <%s>\n",bn,tree[bn].word,b);  */
  357. }
  358.  
  359. #define Op_(type,name,priority) grow_branch(2,token-1,type,name,\
  360. priority+current_priority)
  361. #define Op1_(type,name,priority) grow_branch(1,token-1,type,name,\
  362. priority+current_priority)
  363. #define OnCS_(x) if ((condition_context==1)&&(strcmp(sub_buffer,x)==0))
  364. #define OnBS_(x) if ((bracket_level>0)&&(strcmp(sub_buffer,x)==0))
  365.  
  366. int next_token, void_context, condition_context=0,
  367.            assign_context=0, lines_compiled;
  368. char condition_label[64];
  369. static int brackets[MAX_EXPRESSION_BRACKETS], bracket_level;
  370.  
  371. static void estack_line(char *rewrite)
  372. {   if (etrace_mode>=1) printf("%2d  %s\n",++lines_compiled,rewrite+1);
  373.     stack_line(rewrite);
  374. }
  375.  
  376. extern int expression(int fromword)
  377. {   int c, i, j, k, t, token, current_priority=0, wd_tk,
  378.         sysfun_arity, dummy_branch_flag,
  379.         call_level, call_flag, call_args, call_i, tosp_flag,
  380.         revise_flag, last_was_leaf,
  381.         its_void=0, thrown_away_flag=0, indirect_flag=0,
  382.         last_was_comma=0, last_was_openb=0;
  383.  
  384.     /* --------------------------------------------------------------------- */
  385.     /*  1. A little optimisation: can we tell at once this will not be a     */
  386.     /*     full-blown expression, but just a single constant term?           */
  387.     /* --------------------------------------------------------------------- */
  388.  
  389.     t=word_token(fromword);
  390.     if ((t!=OPENB_SEP) && (t!=MINUS_SEP) && (condition_context==0)
  391.         && (t!=DEC_SEP) && (t!=INC_SEP))
  392.     {   word(sub_buffer,fromword+1); c=sub_buffer[0];
  393.         if ((c==0) || (isalpha(c)) || (isdigit(c)) || (c=='#') || (c==','))
  394.         {   next_token=fromword+1; if (c==0) next_token=-1;
  395.             return(fromword);
  396.         }
  397.     }
  398.  
  399.     /* --------------------------------------------------------------------- */
  400.     /*  2. Initially the tree is just a root node plus one blank branch      */
  401.     /* --------------------------------------------------------------------- */
  402.  
  403.     tree[0].up= -1;  tree[0].type= ROOT_NODE;   tree[0].b[0]=1;
  404.     tree[0].arity=1; tree[0].branches_made=0;   tree[0].priority=0;
  405.  
  406.     tree[1].up=0;    tree[1].type= BLANK_NODE;  tree[1].priority=0;
  407.  
  408.     tree_size=2; comma_mode=0;
  409.     dryad=1; resting=0; sofar_empty=1; last_was_leaf=0;
  410.  
  411.     bracket_level=0;
  412.     token=fromword;
  413.     revise_flag=0;
  414.  
  415.     if (etrace_mode==1) printf("\n++++++++++++++++++++++++++++++\n");
  416.     if (etrace_mode>=1)
  417.     {   printf("\nEvaluating expression %s%s%sat:\n  ",
  418.             (void_context==1)?"(in void context) ":"",
  419.             (condition_context==1)?"(in condition context) ":"",
  420.             (assign_context==1)?"(in assignment context) ":"");
  421.         for (i=0; (i==0)||(sub_buffer[0]!=0); i++)
  422.         {   word(sub_buffer,fromword+i); printf("%s ",sub_buffer);
  423.         }
  424.         printf("\n");
  425.     }
  426.  
  427.     lines_compiled=0;
  428.  
  429.     /* --------------------------------------------------------------------- */
  430.     /*  3. Grow the tree                                                     */
  431.     /* --------------------------------------------------------------------- */
  432.  
  433.     do
  434.     {   token++;
  435.         wd_tk = word_token(token-1); sub_buffer[0]=0;
  436.         if (wd_tk==-1) { word(sub_buffer,token-1);
  437.                          if (sub_buffer[0]==0) break;
  438.                        }
  439.  
  440.         if (last_was_comma>0) last_was_comma--;
  441.         if (last_was_openb>0) last_was_openb--;
  442.  
  443.         if (etrace_mode==1)
  444.           printf("Dryad reads '%s'\nSofar_empty=%d\n",sub_buffer,sofar_empty);
  445.  
  446.         switch(wd_tk)
  447.         {
  448.              case SETEQUALS_SEP:
  449.                                    Op_(STORE_NODE,  "store",         3);
  450.                  revise_flag=1; its_void=1; last_was_openb=2; break;
  451.  
  452.              case PLUS_SEP:        Op_(ARITH_NODE,  "add",           4); break;
  453.  
  454.              case MINUS_SEP:
  455.                  if (sofar_empty==0)
  456.                                    Op_(ARITH_NODE,  "sub",           4);
  457.                  else
  458.                                   Op1_(ARITH_NODE,  "sub 0",         8);
  459.                  break;
  460.  
  461.              case TIMES_SEP:       Op_(ARITH_NODE,  "mul",           5); break;
  462.  
  463.              case DIVIDE_SEP:      Op_(ARITH_NODE,  "div",           5); break;
  464.  
  465.              case REMAINDER_SEP:   Op_(ARITH_NODE,  "mod",           5); break;
  466.  
  467.              case ARTAND_SEP:      Op_(ARITH_NODE,  "and",           5); break;
  468.  
  469.              case ARTOR_SEP:       Op_(ARITH_NODE,  "or",            5); break;
  470.  
  471.              case ARROW_SEP:       Op_(ARITH_NODE,  "loadb",         6); break;
  472.  
  473.              case DARROW_SEP:      Op_(ARITH_NODE,  "loadw",         6); break;
  474.  
  475.              case PROPERTY_SEP:    Op_(ARITH_NODE,  "get_prop",      7); break;
  476.  
  477.              case PROPADD_SEP:     Op_(ARITH_NODE,  "get_prop_addr", 7); break;
  478.  
  479.              case PROPNUM_SEP:     Op_(ARITH_NODE,  "_get_prop_len", 7);
  480.                  revise_flag=1; break;
  481.  
  482.              case INC_SEP:        Op1_(ALTERA_NODE, "inc",           9); break;
  483.  
  484.              case DEC_SEP:        Op1_(ALTERA_NODE, "dec",           9); break;
  485.  
  486.              case OPENB_SEP:
  487.                  current_priority+=10;
  488.                  last_was_openb=2;
  489.                  if (last_was_leaf==0)
  490.                  {   if (bracket_level==MAX_EXPRESSION_BRACKETS)
  491.                      {   error("Brackets '(' too deeply nested");
  492.                          goto BigBreak; }
  493.                      brackets[bracket_level++]=1;
  494.                  }
  495.                  else
  496.                  {   sofar_empty=1; brackets[bracket_level++]=0;
  497.                      j=token; call_args=2; call_level=bracket_level;
  498.                      word(sub_buffer,token);
  499.                      OnS_(")") call_args=1;
  500.                      else
  501.                      do { word(sub_buffer,j++);
  502.                           if (sub_buffer[0]==0)
  503.                           {   error("Missing bracket ')' in function call");
  504.                               goto BigBreak;
  505.                           }
  506.                           if ((strcmp(sub_buffer,",")==0)
  507.                               &&(bracket_level==call_level))
  508.                               call_args++;
  509.                           OnS_("(") call_level++;
  510.                           OnS_(")") call_level--;
  511.                         } while (call_level>=bracket_level);
  512.                      grow_branch(call_args,token-1,FCALL_NODE,"call",
  513.                                  1+current_priority);
  514.                      comma_mode=1;
  515.                  }
  516.                  sofar_empty=1;
  517.                  break;
  518.  
  519.              case CLOSEB_SEP:
  520.                  if (bracket_level--==0) goto BigBreak;
  521.                  current_priority-=10;
  522.                  break;
  523.  
  524.              case COMMA_SEP:
  525.                  if (bracket_level<=0) goto DefaultCase;
  526.                  if (brackets[bracket_level-1]==1)
  527.                      error("Spurious comma ','");
  528.                  comma_mode=1; sofar_empty=1; last_was_comma=2;
  529.                  if (tree[dryad].type!=BLANK_NODE)
  530.                  {   while (tree[dryad].type!=ROOT_NODE)
  531.                      {   while (tree[dryad].type!=FCALL_NODE)
  532.                              dryad=tree[dryad].up;
  533.                          if (tree[dryad].branches_made<tree[dryad].arity)
  534.                          {   dryad=tree[dryad].b[tree[dryad].branches_made];
  535.                              goto FoundNewPlace;
  536.                          }
  537.                          dryad=tree[dryad].up;
  538.                      }
  539.                      error("Misplaced comma ','"); return(-2);
  540.                      FoundNewPlace: resting=0;
  541.                  }
  542.                  if (etrace_mode==1) show_tree("Comma to");
  543.                  break;
  544.  
  545.              default:
  546.                  DefaultCase:
  547.                      goto TryFurther;
  548.         }
  549.         goto AtomDone;
  550.  
  551.         TryFurther:
  552.  
  553.         if (condition_context==1)
  554.         {   switch(wd_tk)
  555.             {   case GREATER_SEP:  Op_(COND_NODE,   "jg",            3); break;
  556.                 case LESS_SEP:     Op_(COND_NODE,   "jl",            3); break;
  557.                 case CONDEQUALS_SEP:
  558.                                    Op_(COND_NODE,   "je",            3); break;
  559.                 case NOTEQUAL_SEP: Op_(NCOND_NODE,  "je",            3); break;
  560.                 case GE_SEP:       Op_(NCOND_NODE,  "jl",            3); break;
  561.                 case LE_SEP:       Op_(NCOND_NODE,  "jg",            3); break;
  562.                 case LOGAND_SEP:   Op_(LOGICAND_NODE, "&&",          2); break;
  563.                 case LOGOR_SEP:    Op_(LOGICOR_NODE, "||",           2); break;
  564.                 default:
  565.  
  566.                      OnS_("or")    Op_(OR_NODE,     "or",            2);
  567.                 else OnS_("far")   Op_(NCOND_NODE,  "same_parent",   3);
  568.                 else OnS_("hasnt") Op_(NCOND_NODE,  "test_attr",     3);
  569.                 else OnS_("near")  Op_(COND_NODE,   "same_parent",   3);
  570.                 else OnS_("has")   Op_(COND_NODE,   "test_attr",     3);
  571.                 else OnS_("in")  { Op_(COND_NODE,   "in",            3);
  572.                                    revise_flag=1; }
  573.                 else OnS_("notin"){Op_(NCOND_NODE,  "in",            3);
  574.                                    revise_flag=1; }
  575.                 else goto TryYetFurther;
  576.             }
  577.             last_was_openb=2;
  578.             goto AtomDone;
  579.         }
  580.  
  581.         TryYetFurther:
  582.  
  583.         if (resting==1)
  584.         {   if (sub_buffer[0]=='-')
  585.             {   Op_(ARITH_NODE,"add",4);
  586.                 grow_leaf(token-1); sofar_empty=0;
  587.             }
  588.             else
  589.             {   if (bracket_level>0)
  590.                 error("Operator has too many arguments");
  591.                 goto BigBreak;
  592.             }
  593.         }
  594.         else if (tree[dryad].type==BLANK_NODE)
  595.              {   
  596.                  if ((sub_buffer[0]=='-')&&(last_was_openb==0)&&(last_was_comma==0))
  597.                  {   Op_(ARITH_NODE,"add",4);
  598.                      grow_leaf(token-1); sofar_empty=0;
  599.                      goto AtomDone;
  600.                  }
  601.  
  602.                  sofar_empty=0; grow_leaf(token-1); last_was_leaf=1;
  603.                  goto UnlessItWas;
  604.              }
  605.              else
  606.              if (sub_buffer[0]=='-')
  607.                   {   Op_(ARITH_NODE,"add",4);
  608.                       grow_leaf(token-1); sofar_empty=0;
  609.                   }
  610.                   else goto BigBreak;
  611.  
  612.  
  613.         AtomDone:
  614.         last_was_leaf=0;
  615.         UnlessItWas: ;
  616.     } while (1==1);
  617.  
  618.     BigBreak:
  619.     if ((wd_tk==-1)&&(sub_buffer[0]==0)) next_token= -1;
  620.     else next_token=token-1;
  621.  
  622.     if (bracket_level>0) error("Too many brackets '(' in expression");
  623.  
  624.     /* --------------------------------------------------------------------- */
  625.     /*  4. If necessary, revise the tree to allow for get_prop_len and the   */
  626.     /*     different contexts of the "=" assignment                          */
  627.     /* --------------------------------------------------------------------- */
  628.  
  629.     if (revise_flag==1)
  630.     {
  631.         for (i=0; i<tree_size; i++)
  632.         {   j=tree[i].b[0];
  633.             if ((tree[i].type==STORE_NODE)&&(tree[j].type==ARITH_NODE)
  634.                 &&(tree[i].op!=NULL)&&(strcmp(tree[i].op,"store")==0))
  635.             {   k=0;
  636.                 if (tree[j].op!=NULL)
  637.                 {   if (strcmp(tree[j].op,"get_prop")==0) k=1;
  638.                     if (strcmp(tree[j].op,"loadb")==0) k=2;
  639.                     if (strcmp(tree[j].op,"loadw")==0) k=3;
  640.                 }
  641.                 if (k!=0)
  642.                 {   
  643.                     if (etrace_mode==1)
  644.                         printf("Sub type %d nodes %d and %d\n",k,i,j);
  645.                     if (etrace_mode==1) show_tree("Substituting from");
  646.                     tree[j].b[tree[j].arity++] = tree[i].b[1];
  647.                     tree[j].branches_made++;
  648.                     tree[j].type=STORE_NODE;
  649.                     tree[j].up=tree[i].up;
  650.                     tree[i]=tree[j];
  651.                     switch(k)
  652.                     {   case 1: tree[i].op="put_prop"; break;
  653.                         case 2: tree[i].op="storeb"; break;
  654.                         case 3: tree[i].op="storew"; break;
  655.                     }
  656.                     if (etrace_mode==1) show_tree("Substituting to");
  657.                 }
  658.             }
  659.             if ((tree[i].op!=NULL)&&(strcmp(tree[i].op,"_get_prop_len")==0))
  660.             {
  661.                 tree[i].op="get_prop_addr";
  662.                 tree[tree_size]=tree[i];
  663.                 tree[tree_size].up=i;
  664.                 tree[i].b[0]=tree_size;
  665.                 tree[i].arity=1;
  666.                 tree[i].branches_made=1;
  667.                 tree[i].op="get_prop_len";
  668.                 tree_size++;
  669.                 if (etrace_mode==1) show_tree("Fixing a _get_prop_len to");
  670.             }
  671.  
  672.             if (((tree[i].type==COND_NODE)||(tree[i].type==NCOND_NODE))
  673.                 &&(tree[i].op!=NULL)&&(strcmp(tree[i].op,"in")==0))
  674.             {   if (etrace_mode==1) show_tree("Substituting 'in' from");
  675.                 j=tree[i].b[0];
  676.                 tree[i].op="je";
  677.                 tree[tree_size]=tree[j];
  678.                 tree[tree_size].up=j;
  679.                 tree[j].b[0]=tree_size;
  680.                 tree[j].arity=1;
  681.                 tree[j].type=ARITH_NODE;
  682.                 tree[j].branches_made=1;
  683.                 tree[j].op="get_parent";
  684.                 tree_size++;
  685.                 if (etrace_mode==1) show_tree("Substituting to");
  686.             }
  687.         }
  688.     }
  689.  
  690.     if (condition_context==1)
  691.     {   fix_yesno_labels(tree[0].b[0],0);
  692.     }
  693.  
  694.     if (etrace_mode>=1) show_tree("Made the tree:");
  695.  
  696.     /* --------------------------------------------------------------------- */
  697.     /*  5. Recursively cut off branches into assembly language               */
  698.     /* --------------------------------------------------------------------- */
  699.  
  700.     if (etrace_mode==2) printf("Compiling code:\n");
  701.  
  702.     do
  703.     {   i=0;
  704.         DownDown:
  705.         if ((tree[i].type!=LOGICAND_NODE)&&(tree[i].type!=LOGICOR_NODE))
  706.         {   for (j=tree[i].branches_made-1; j>=0; j--)
  707.             {   t=tree[tree[i].b[j]].type;
  708.                 if ((t!=LEAF_NODE)&&(t!=SP_NODE)&&(t!=CDONE_NODE))
  709.                 {   i=tree[i].b[j]; goto DownDown;
  710.                 }
  711.             }
  712.         }
  713.         else
  714.         {   for (j=0; j<tree[i].branches_made; j++)
  715.             {   t=tree[tree[i].b[j]].type;
  716.                 if ((t!=LEAF_NODE)&&(t!=SP_NODE)&&(t!=CDONE_NODE))
  717.                 {   i=tree[i].b[j]; goto DownDown;
  718.                 }
  719.             }
  720.         }
  721.  
  722.         if (etrace_mode==1) printf("Detaching %d\n",i);
  723.  
  724.         if (i==0)
  725.         {   if (tree[tree[0].b[0]].type==SP_NODE) j=-1;
  726.             else if (tree[tree[0].b[0]].type==CDONE_NODE) j=-3;
  727.             else j=tree[tree[0].b[0]].word;
  728.             if (its_void==1) j=-2;
  729.  
  730.             if ((condition_context==0)&&(j==-3))
  731.             {   error("Unexpected condition"); return(-2); }
  732.  
  733.             if ((condition_context==1)&&(j!=-3))
  734.             {   printf("Expected condition but found expression\n");
  735.                 error("Expected condition but found expression");
  736.                 return(-2);
  737.             }
  738.  
  739.             if (etrace_mode>=1)
  740.             {   word(sub_buffer,next_token);
  741.                 if (next_token==-1) printf("Completed: line used up: ");
  742.                 else printf("Completed: next word '%s': ",sub_buffer);
  743.                 if (j>=0) word(sub_buffer,j);
  744.                 if (thrown_away_flag==1) printf("result thrown away\n");
  745.                 else if (j==-1) printf("result on stack\n");
  746.                 else if (j==-2) printf("no resulting value\n");
  747.                 else if (j==-3) printf("a condition\n");
  748.                 else printf("result in %s\n",sub_buffer);
  749.             }
  750.             if (thrown_away_flag==1) return(-3);
  751.             return(j);
  752.         }
  753.  
  754.         if (tree[i].branches_made<tree[i].arity)
  755.             error("Operator has too few arguments");
  756.  
  757.         sysfun_arity=0; dummy_branch_flag=0;
  758.         if (tree[i].type==FCALL_NODE)
  759.         {   indirect_flag=0;
  760.             InV5
  761.             {   tree[i].op="call_**";
  762.                 call_args=tree[i].branches_made-1;
  763.             }
  764.             call_i=i; call_flag=1;
  765.             eword(sub_buffer,tree[i].b[0]);
  766.             OnS_("parent")    { sysfun_arity=1; tree[i].op="get_parent";    }
  767.             OnS_("sibling")   { sysfun_arity=1; tree[i].op="get_sibling";
  768.                                 dummy_branch_flag=1; }
  769.             OnS_("younger")   { sysfun_arity=1; tree[i].op="get_sibling";
  770.                                 dummy_branch_flag=1; }
  771.             OnS_("child")     { sysfun_arity=1; tree[i].op="get_child";
  772.                                 dummy_branch_flag=1; }
  773.             OnS_("eldest")    { sysfun_arity=1; tree[i].op="get_child";
  774.                                 dummy_branch_flag=1; }
  775.             OnS_("random")    { sysfun_arity=1; tree[i].op="random";        }
  776.             OnS_("prop_len")  { sysfun_arity=1; tree[i].op="get_prop_len";  }
  777.             OnS_("prop_addr") { sysfun_arity=2; tree[i].op="get_prop_addr"; }
  778.             OnS_("prop")      { sysfun_arity=2; tree[i].op="get_prop";      }
  779.             OnS_("children")
  780.             {   if (2!=tree[i].branches_made)
  781.                     error("'children' takes a single argument");
  782.                 estack_line(         "@store temp_global 0");
  783.                 eword(sub_buffer,
  784.                   tree[i].b[1]);
  785.                 sprintf(rewrite,     "@get_child %s sp ~_x%d",
  786.                   sub_buffer,
  787.                   no_dummy_labels+1);
  788.                 estack_line(rewrite);
  789.                 sprintf(rewrite,     "@._x%d",
  790.                   no_dummy_labels++);
  791.                 estack_line(rewrite);
  792.                 estack_line(         "@inc temp_global");
  793.                 sprintf(rewrite,     "@get_sibling sp sp _x%d",
  794.                   no_dummy_labels-1);
  795.                 estack_line(rewrite);
  796.                 sprintf(rewrite,     "@._x%d",
  797.                   no_dummy_labels++);
  798.                 estack_line(rewrite);
  799.                 sprintf(rewrite,     "@add sp temp_global sp");
  800.                 estack_line(rewrite);
  801.                 tree[i].type=SP_NODE;
  802.                 tree[i].word=-1;
  803.                 goto Detached;
  804.             }
  805.             OnS_("youngest")
  806.             {   if (2!=tree[i].branches_made)
  807.                     error("'youngest' takes a single argument");
  808.                 eword(sub_buffer,tree[i].b[1]);
  809.                 sprintf(rewrite,     "@get_child %s temp_global ~_x%d",
  810.                   sub_buffer,
  811.                   no_dummy_labels+1);
  812.                 estack_line(rewrite);
  813.                 estack_line(         "@push temp_global");
  814.                 sprintf(rewrite,     "@._x%d",
  815.                   no_dummy_labels++);
  816.                 estack_line(rewrite);
  817.                 estack_line(         "@store temp_global sp");
  818.                 sprintf(rewrite,     "@get_sibling temp_global sp _x%d",
  819.                     no_dummy_labels-1);
  820.                 estack_line(rewrite);
  821.                 sprintf(rewrite,     "@._x%d",no_dummy_labels++);
  822.                 estack_line(rewrite);
  823.                 sprintf(rewrite,     "@push temp_global");
  824.                 estack_line(rewrite);
  825.                 tree[i].type=SP_NODE;
  826.                 tree[i].word=-1;
  827.                 goto Detached;
  828.             }
  829.             OnS_("elder")
  830.             {   if (2!=tree[i].branches_made)
  831.                     error("'elder' takes a single argument");
  832.                 eword(sub_buffer,tree[i].b[1]);
  833.                 sprintf(rewrite,     "@store temp_global %s",
  834.                   sub_buffer);
  835.                 estack_line(rewrite);
  836.                 estack_line(         "@store temp_global3 0");
  837.                 estack_line(         "@get_parent temp_global sp");
  838.                 sprintf(rewrite,     "@get_child sp temp_global2 _x%d",
  839.                   no_dummy_labels);
  840.                 estack_line(rewrite);
  841.                 sprintf(rewrite,     "@._x%d",no_dummy_labels++);
  842.                 estack_line(rewrite);
  843.                 sprintf(rewrite,     "@je temp_global temp_global2 _x%d",
  844.                   no_dummy_labels);
  845.                 estack_line(rewrite);
  846.                 estack_line(         "@store temp_global3 temp_global2");
  847.                 sprintf(rewrite, "@get_sibling temp_global2 temp_global2 _x%d",
  848.                   no_dummy_labels-1);
  849.                 estack_line(rewrite);
  850.                 sprintf(rewrite,     "@._x%d",
  851.                   no_dummy_labels++);
  852.                 estack_line(rewrite);
  853.                 sprintf(rewrite,     "@push temp_global3");
  854.                 estack_line(rewrite);
  855.                 tree[i].type=SP_NODE;
  856.                 tree[i].word=-1;
  857.                 goto Detached;
  858.             }
  859.  
  860.             OnS_("indirect")
  861.             {   if (tree[i].branches_made<2)
  862.                 { error("'indirect' takes at least one argument"); }
  863.                 sysfun_arity=1; tree[i].op="icall"; indirect_flag=1;
  864.             }
  865.             else
  866.             if (sysfun_arity!=0)
  867.             {   if (sysfun_arity+1!=tree[i].branches_made)
  868.                 {   error("Wrong number of arguments to system function");
  869.                 }
  870.             }
  871.         }
  872.         else call_flag=0;
  873.  
  874.         t=tree[i].type;
  875.  
  876.         if ((t==LOGICAND_NODE)||(t==LOGICOR_NODE))
  877.         {   for (j=0; j<tree[i].branches_made; j++)
  878.             {   if (tree[tree[i].b[j]].type != CDONE_NODE)
  879.                 {   error("Expected condition but found expression");
  880.                     return(-2);
  881.                 }
  882.             }
  883.             sprintf(rewrite,"@._x%d",tree[i].label_number);
  884.             estack_line(rewrite);
  885.             tree[i].type=CDONE_NODE;
  886.             goto Detached;
  887.         }
  888.  
  889.         if (t==ALTERB_NODE)
  890.         {   if (tree[tree[i].b[0]].type!=LEAF_NODE)
  891.             {   error("'++' and '--' can only apply directly to variables");
  892.                 return(-2);
  893.             }
  894.             eword(sub_buffer,tree[i].b[0]);
  895.             sprintf(rewrite,"@%s %s",tree[i].op,sub_buffer);
  896.             estack_line(rewrite);
  897.             tree[i].type=LEAF_NODE;
  898.             tree[i].word=tree[tree[i].b[0]].word;
  899.             tree[i].arity=0;
  900.             tree[i].branches_made=0;
  901.             if (tree[i].up==0)
  902.                 if (assign_context==1) its_void=1;
  903.             goto Detached;
  904.         }
  905.         if (t==ALTERA_NODE)
  906.         {   if (tree[tree[i].b[0]].type!=LEAF_NODE)
  907.             {   error("'++' and '--' can only apply directly to variables");
  908.                 return(-2);
  909.             }
  910.             if ((tree[i].up==0)&&(assign_context==1))
  911.             {   eword(sub_buffer,tree[i].b[0]);
  912.                 sprintf(rewrite,"@%s %s",tree[i].op,sub_buffer);
  913.                 estack_line(rewrite);
  914.                 tree[i].type=LEAF_NODE;
  915.                 tree[i].word=tree[tree[i].b[0]].word;
  916.                 tree[i].arity=0;
  917.                 tree[i].branches_made=0;
  918.                 if (assign_context==1) its_void=1;
  919.                 goto Detached;
  920.             }
  921.             eword(sub_buffer,tree[i].b[0]);
  922.             sprintf(rewrite,"@push %s",sub_buffer);
  923.             estack_line(rewrite);
  924.             sprintf(rewrite,"@%s %s",tree[i].op,sub_buffer);
  925.             estack_line(rewrite);
  926.             tree[i].type=SP_NODE;
  927.             tree[i].arity=0;
  928.             tree[i].branches_made=0;
  929.             goto Detached;
  930.         }
  931.  
  932.         if (strcmp(tree[i].op,"get_prop_len")==0)
  933.         {   eword(sub_buffer,tree[i].b[0]);
  934.             sprintf(rewrite,"@store temp_global %s",sub_buffer);
  935.             estack_line(rewrite);
  936.             sprintf(rewrite,"@jz temp_global _x%d",no_dummy_labels);
  937.             estack_line(rewrite);
  938.             sprintf(rewrite,"@get_prop_len temp_global temp_global");
  939.             estack_line(rewrite);
  940.             sprintf(rewrite,"@._x%d",no_dummy_labels++);
  941.             estack_line(rewrite);
  942.  
  943.             if ((tree[tree[i].up].op!=NULL) &&
  944.                 (strcmp(tree[tree[i].up].op,"store")==0))
  945.             {   word(sub_buffer,tree[tree[tree[i].up].b[0]].word);
  946.                 i=tree[i].up; t=STORE_NODE;
  947.                 sprintf(rewrite,"@store %s temp_global",sub_buffer);
  948.             }
  949.             else sprintf(rewrite,"@push temp_global");
  950.  
  951.         }
  952.         else
  953.         {
  954.             sprintf(rewrite,"@%s ",tree[i].op);
  955.  
  956.             for (j=(sysfun_arity>0)?1:0; j<tree[i].branches_made; j++)
  957.             {   eword(sub_buffer,tree[i].b[j]);
  958.                 sprintf(rewrite+strlen(rewrite),"%s ",sub_buffer);
  959.             }
  960.  
  961.             if ((sub_buffer[0]=='-') && (tree[i].op!=NULL)
  962.                 && (strcmp(tree[i].op,"add")==0))
  963.             {   eword(sub_buffer,tree[i].b[0]);
  964.                 sprintf(rewrite,"@sub %s ",sub_buffer);
  965.                 eword(sub_buffer,tree[i].b[1]);
  966.                 sprintf(rewrite+strlen(rewrite),"%s ",sub_buffer+1);
  967.             }
  968.  
  969.             if ((t==ARITH_NODE)||(t==FCALL_NODE))
  970.             {   if ((tree[tree[i].up].op!=NULL) &&
  971.                     (strcmp(tree[tree[i].up].op,"store")==0))
  972.                 {   word(sub_buffer,tree[tree[tree[i].up].b[0]].word);
  973.                     i=tree[i].up; t=STORE_NODE;
  974.                 }
  975.                 else sprintf(sub_buffer,"sp");
  976.                 sprintf(rewrite+strlen(rewrite),"%s",sub_buffer);
  977.             }
  978.         }
  979.  
  980.         if (dummy_branch_flag==1)
  981.         {   sprintf(rewrite+strlen(rewrite)," _x%d",no_dummy_labels);
  982.         }
  983.         if ((t==COND_NODE)||(t==NCOND_NODE))
  984.         {   int pflag, lnumber, lat, tup;
  985.             tup=tree[i].up; lat=tree[tup].label_number;
  986.             switch(tree[tup].type)
  987.             {   case ROOT_NODE: lnumber=-1; pflag=0; break;
  988.                 case LOGICAND_NODE:
  989.                          if (tree[tup].b[tree[tup].branches_made-1]!=i)
  990.                          {   lnumber=tree[tup].no_label; pflag=0;  }
  991.                          else
  992.                          {   if (lat==tree[tup].yes_label)
  993.                              {   lnumber=tree[tup].no_label; pflag=0;  }
  994.                              else
  995.                              {   lnumber=tree[tup].yes_label; pflag=1; }
  996.                          }
  997.                          break;
  998.                 case LOGICOR_NODE:
  999.                          if (tree[tup].b[tree[tup].branches_made-1]!=i)
  1000.                          {   lnumber=tree[tup].yes_label; pflag=1;  }
  1001.                          else
  1002.                          {   if (lat==tree[tup].no_label)
  1003.                              {   lnumber=tree[tup].yes_label; pflag=1;  }
  1004.                              else
  1005.                              {   lnumber=tree[tup].no_label; pflag=0; }
  1006.                          }
  1007.                          break;
  1008.                 default:
  1009.                     error("Attempt to use a condition as a value");
  1010.                     return(-2);
  1011.             }
  1012.             if (pflag==0)
  1013.                 sprintf(rewrite+strlen(rewrite),"?%s",
  1014.                     (t==COND_NODE)?"~":"");
  1015.             else
  1016.                 sprintf(rewrite+strlen(rewrite),"?%s",
  1017.                     (t!=COND_NODE)?"~":"");
  1018.             if (lnumber==-1)
  1019.                 sprintf(rewrite+strlen(rewrite),"%s",
  1020.                     condition_label);
  1021.             else
  1022.                 sprintf(rewrite+strlen(rewrite),"_x%d",
  1023.                     lnumber);
  1024.         }
  1025.  
  1026.         if (call_flag==1)
  1027.         {   tosp_flag=0;
  1028.             if (strcmp(sub_buffer,"sp")==0) tosp_flag=1;
  1029.  
  1030.             InV3
  1031.             {
  1032.                 if ((tosp_flag==1)&&(void_context==1)&&(tree[call_i].up==0))
  1033.                 {   sprintf(rewrite+(strlen(rewrite)-2), "temp_global");
  1034.                     thrown_away_flag=1;
  1035.                 }
  1036.             }
  1037.  
  1038.             if (actual_version == 4)
  1039.             {
  1040.                 if (sysfun_arity==0)
  1041.                 {   rewrite[7]='s';
  1042.                     switch(call_args)
  1043.                     {   case 0: rewrite[6]='1'; break;
  1044.                         case 1: rewrite[6]='2'; break;
  1045.                         default: rewrite[6]='v'; break;
  1046.                     }
  1047.                     if ((tosp_flag==1)&&(void_context==1)&&(tree[call_i].up==0))
  1048.                     {   sprintf(rewrite+(strlen(rewrite)-2), "temp_global");
  1049.                         thrown_away_flag=1;
  1050.                     }
  1051.                 }
  1052.                 if (indirect_flag==1)
  1053.                     if ((tosp_flag==1)&&(void_context==1)&&(tree[call_i].up==0))
  1054.                     {   sprintf(rewrite+(strlen(rewrite)-2), "temp_global");
  1055.                         thrown_away_flag=1;
  1056.                     }
  1057.             }
  1058.  
  1059.             if (actual_version >= 5)
  1060.             {
  1061.                 if (sysfun_arity==0)
  1062.                 {   rewrite[7]='s';
  1063.                     switch(call_args)
  1064.                     {   case 0: rewrite[6]='1'; break;
  1065.                         case 1: rewrite[6]='2'; break;
  1066.                         default: rewrite[6]='v'; break;
  1067.                     }
  1068.                     if ((tosp_flag==1)&&(void_context==1)&&(tree[call_i].up==0))
  1069.                     {   rewrite[7]='n';
  1070.                         rewrite[strlen(rewrite)-3]=0;
  1071.                         thrown_away_flag=1;
  1072.                     }
  1073.                 }
  1074.                 if (indirect_flag==1)
  1075.                     if ((tosp_flag==1)&&(void_context==1)&&(tree[call_i].up==0))
  1076.                     {   sprintf(rewrite+(strlen(rewrite)-2), "temp_global");
  1077.                         thrown_away_flag=1;
  1078.                     }
  1079.             }
  1080.         }
  1081.  
  1082.         estack_line(rewrite);
  1083.  
  1084.         if (dummy_branch_flag==1)
  1085.         {   sprintf(rewrite,"@._x%d",no_dummy_labels++);
  1086.             estack_line(rewrite);
  1087.         }
  1088.  
  1089.         if (t==STORE_NODE) tree[i]=tree[tree[i].b[0]];
  1090.         else
  1091.         {   tree[i].arity=0;
  1092.             tree[i].type= SP_NODE;
  1093.             tree[i].branches_made=0;
  1094.         }
  1095.         switch(t)
  1096.         {   default: tree[i].type = SP_NODE; break;
  1097.             case COND_NODE:
  1098.             case NCOND_NODE:
  1099.             case LOGICOR_NODE:
  1100.             case LOGICAND_NODE: tree[i].type = CDONE_NODE; break;
  1101.         }
  1102.  
  1103.         Detached:
  1104.         if (etrace_mode==1) show_tree("to");
  1105.     } while (1==1);
  1106.     return(1);
  1107. }
  1108.  
  1109. extern void assignment(int from, int flag)
  1110. {   int i;
  1111.     next_token=from;
  1112.     do
  1113.     {   assign_context=1; i=expression(next_token); assign_context=0;
  1114.         if ((i!=-2)&&(i!=from))
  1115.         {   error("Expected an assignment but found an expression");
  1116.             return;
  1117.         }
  1118.         if (i==from)
  1119.         {   word(sub_buffer,from);
  1120.             if (flag==1)
  1121.                 error_named("Expected an assignment, command, directive \
  1122. or opcode but found",sub_buffer);
  1123.             else
  1124.                 error_named("Expected an assignment but found",sub_buffer);
  1125.             return;
  1126.         }
  1127.         if (next_token==-1) return;
  1128.         word(sub_buffer,next_token);
  1129.         if (strcmp(sub_buffer,",")!=0) return;
  1130.         next_token++;
  1131.     } while (1==1);
  1132. }
  1133.  
  1134.