utils.c - enscript - GNU Enscript
 (HTM) git clone git://thinkerwim.org/enscript.git
 (DIR) Log
 (DIR) Files
 (DIR) Refs
 (DIR) README
 (DIR) LICENSE
       ---
       utils.c (28413B)
       ---
            1 /*
            2  * General helper utilities.
            3  * Copyright (c) 1997-1999 Markku Rossi.
            4  *
            5  * Author: Markku Rossi <mtr@iki.fi>
            6  */
            7 
            8 /*
            9  * This file is part of GNU Enscript.
           10  *
           11  * Enscript is free software: you can redistribute it and/or modify
           12  * it under the terms of the GNU General Public License as published by
           13  * the Free Software Foundation, either version 3 of the License, or
           14  * (at your option) any later version.
           15  *
           16  * Enscript is distributed in the hope that it will be useful,
           17  * but WITHOUT ANY WARRANTY; without even the implied warranty of
           18  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
           19  * GNU General Public License for more details.
           20  *
           21  * You should have received a copy of the GNU General Public License
           22  * along with Enscript.  If not, see <http://www.gnu.org/licenses/>.
           23  */
           24 
           25 #include "defs.h"
           26 
           27 /*
           28  * Static variables.
           29  */
           30 
           31 static RE_TRANSLATE_TYPE case_insensitive_translate = NULL;
           32 
           33 
           34 /*
           35  * Global functions.
           36  */
           37 
           38 /* Generic linked list. */
           39 
           40 List *
           41 list ()
           42 {
           43   return (List *) xcalloc (1, sizeof (List));
           44 }
           45 
           46 
           47 void
           48 list_prepend (list, data)
           49      List *list;
           50      void *data;
           51 {
           52   ListItem *item;
           53 
           54   item = (ListItem *) xmalloc (sizeof (*item));
           55   item->data = data;
           56 
           57   item->next = list->head;
           58   list->head = item;
           59 
           60   if (list->tail == NULL)
           61     list->tail = item;
           62 }
           63 
           64 
           65 void
           66 list_append (list, data)
           67      List *list;
           68      void *data;
           69 {
           70   ListItem *item;
           71 
           72   item = (ListItem *) xcalloc (1, sizeof (*item));
           73   item->data = data;
           74 
           75   if (list->tail)
           76     list->tail->next = item;
           77   else
           78     list->head = item;
           79   list->tail = item;
           80 }
           81 
           82 /*
           83  * Node manipulators.
           84  */
           85 
           86 Node *
           87 node_alloc (type)
           88      NodeType type;
           89 {
           90   Node *n;
           91 
           92   n = (Node *) xcalloc (1, sizeof (*n));
           93   n->type = type;
           94   n->refcount = 1;
           95   n->linenum = linenum;
           96   n->filename = yyin_name;
           97 
           98   if (type == nREGEXP)
           99     n->u.re.compiled.fastmap = xmalloc (256);
          100 
          101   return n;
          102 }
          103 
          104 
          105 Node *
          106 node_copy (n)
          107      Node *n;
          108 {
          109   Node *n2;
          110   int i;
          111 
          112   n2 = node_alloc (n->type);
          113   n2->linenum = n->linenum;
          114   n2->filename = n->filename;
          115 
          116   switch (n->type)
          117     {
          118     case nVOID:
          119       /* All done. */
          120       break;
          121 
          122     case nSTRING:
          123       n2->u.str.len = n->u.str.len;
          124       /* +1 to avoid zero allocation. */
          125       n2->u.str.data = (char *) xmalloc (n2->u.str.len + 1);
          126       memcpy (n2->u.str.data, n->u.str.data, n->u.str.len);
          127       break;
          128 
          129     case nREGEXP:
          130       n2->u.re.data = xstrdup (n->u.re.data);
          131       n2->u.re.len = n->u.re.len;
          132       break;
          133 
          134     case nINTEGER:
          135       n2->u.integer = n->u.integer;
          136       break;
          137 
          138     case nREAL:
          139       n2->u.real = n->u.real;
          140       break;
          141 
          142     case nSYMBOL:
          143       n2->u.sym = xstrdup (n->u.sym);
          144       break;
          145 
          146     case nARRAY:
          147       n2->u.array.len = n->u.array.len;
          148       n2->u.array.allocated = n2->u.array.len + 1;
          149       n2->u.array.array = (Node **) xcalloc (n2->u.array.allocated,
          150                                              sizeof (Node *));
          151       for (i = 0; i < n->u.array.len; i++)
          152         n2->u.array.array[i] = node_copy (n->u.array.array[i]);
          153       break;
          154     }
          155 
          156   return n2;
          157 }
          158 
          159 
          160 void
          161 node_reference (node)
          162      Node *node;
          163 {
          164   node->refcount++;
          165 }
          166 
          167 
          168 void
          169 node_free (node)
          170      Node *node;
          171 {
          172   unsigned int i;
          173 
          174   if (node == NULL)
          175     return;
          176 
          177   if (--node->refcount > 0)
          178     return;
          179 
          180   /* This was the last reference, free the node. */
          181   switch (node->type)
          182     {
          183     case nVOID:
          184       /* There is only nVOID node, do not free it. */
          185       return;
          186       break;
          187 
          188     case nSTRING:
          189       xfree (node->u.str.data);
          190       break;
          191 
          192     case nREGEXP:
          193       free (node->u.re.data);
          194       xfree (node->u.re.compiled.fastmap);
          195       break;
          196 
          197     case nINTEGER:
          198     case nREAL:
          199     case nSYMBOL:
          200       /* Nothing here. */
          201       break;
          202 
          203     case nARRAY:
          204       for (i = 0; i < node->u.array.len; i++)
          205         node_free (node->u.array.array[i]);
          206 
          207       xfree (node->u.array.array);
          208       break;
          209     }
          210 
          211   xfree (node);
          212 }
          213 
          214 
          215 void
          216 enter_system_variable (name, value)
          217      char *name;
          218      char *value;
          219 {
          220   Node *n, *old_val;
          221 
          222   n = node_alloc (nSTRING);
          223   n->u.str.len = strlen (value);
          224   n->u.str.data = xstrdup (value);
          225   if (!strhash_put (ns_vars, name, strlen (name), n, (void **) &old_val))
          226     {
          227       fprintf (stderr, _("%s: out of memory\n"), program);
          228       exit (1);
          229     }
          230   node_free (old_val);
          231 }
          232 
          233 
          234 void
          235 compile_regexp (re)
          236      Node *re;
          237 {
          238   const char *msg;
          239 
          240   if (case_insensitive_translate == NULL)
          241     {
          242       int i;
          243 
          244       case_insensitive_translate = xmalloc (256);
          245 
          246       for (i = 0; i < 256; i++)
          247         if (isupper (i))
          248           case_insensitive_translate[i] = tolower (i);
          249         else
          250           case_insensitive_translate[i] = i;
          251     }
          252 
          253   if (re->u.re.flags & fRE_CASE_INSENSITIVE)
          254     re->u.re.compiled.translate = case_insensitive_translate;
          255 
          256   msg = re_compile_pattern (re->u.re.data, re->u.re.len, &re->u.re.compiled);
          257   if (msg)
          258     {
          259       fprintf (stderr,
          260                _("%s:%d: couldn't compile regular expression \"%s\": %s\n"),
          261                re->filename, re->linenum, re->u.re.data, msg);
          262       exit (1);
          263     }
          264 
          265   re_compile_fastmap (&re->u.re.compiled);
          266 }
          267 
          268 
          269 /*
          270  * Grammar constructors.
          271  */
          272 
          273 Stmt *
          274 mk_stmt (type, arg1, arg2, arg3, arg4)
          275      StmtType type;
          276      void *arg1;
          277      void *arg2;
          278      void *arg3;
          279      void *arg4;
          280 {
          281   Stmt *stmt;
          282 
          283   stmt = (Stmt *) xcalloc (1, sizeof (*stmt));
          284   stmt->type = type;
          285   stmt->linenum = linenum;
          286   stmt->filename = yyin_name;
          287 
          288   switch (type)
          289     {
          290     case sEXPR:
          291     case sRETURN:
          292       stmt->u.expr = arg1;
          293       break;
          294 
          295     case sDEFSUB:
          296       stmt->u.defsub.name = arg1;
          297       stmt->u.defsub.closure = arg2;
          298       break;
          299 
          300     case sBLOCK:
          301       stmt->u.block = arg1;        /* Statement list. */
          302       break;
          303 
          304     case sIF:
          305       stmt->u.stmt_if.expr = arg1;
          306       stmt->u.stmt_if.then_stmt = arg2;
          307       stmt->u.stmt_if.else_stmt = arg3;
          308       break;
          309 
          310     case sWHILE:
          311       stmt->u.stmt_while.expr = arg1;
          312       stmt->u.stmt_while.body = arg2;
          313       break;
          314 
          315     case sFOR:
          316       stmt->u.stmt_for.init = arg1;
          317       stmt->u.stmt_for.cond = arg2;
          318       stmt->u.stmt_for.incr = arg3;
          319       stmt->u.stmt_for.body = arg4;
          320       break;
          321     }
          322 
          323   return stmt;
          324 }
          325 
          326 
          327 Expr *
          328 mk_expr (type, arg1, arg2, arg3)
          329      ExprType type;
          330      void *arg1;
          331      void *arg2;
          332      void *arg3;
          333 {
          334   Expr *expr;
          335 
          336   expr = (Expr *) xcalloc (1, sizeof (*expr));
          337   expr->type = type;
          338   expr->linenum = linenum;
          339   expr->filename = yyin_name;
          340 
          341   switch (type)
          342     {
          343     case eSTRING:
          344     case eREGEXP:
          345     case eINTEGER:
          346     case eREAL:
          347     case eSYMBOL:
          348       expr->u.node = arg1;
          349       break;
          350 
          351     case eNOT:
          352       expr->u.not = arg1;
          353       break;
          354 
          355     case eFCALL:
          356       expr->u.fcall.name = arg1;
          357       expr->u.fcall.args = arg2;
          358       break;
          359 
          360     case eASSIGN:
          361     case eADDASSIGN:
          362     case eSUBASSIGN:
          363     case eMULASSIGN:
          364     case eDIVASSIGN:
          365       expr->u.assign.sym = arg1;
          366       expr->u.assign.expr = arg2;
          367       break;
          368 
          369     case ePOSTFIXADD:
          370     case ePOSTFIXSUB:
          371     case ePREFIXADD:
          372     case ePREFIXSUB:
          373       expr->u.node = arg1;
          374       break;
          375 
          376     case eARRAYASSIGN:
          377       expr->u.arrayassign.expr1 = arg1;
          378       expr->u.arrayassign.expr2 = arg2;
          379       expr->u.arrayassign.expr3 = arg3;
          380       break;
          381 
          382     case eARRAYREF:
          383       expr->u.arrayref.expr1 = arg1;
          384       expr->u.arrayref.expr2 = arg2;
          385       break;
          386 
          387     case eQUESTCOLON:
          388       expr->u.questcolon.cond = arg1;
          389       expr->u.questcolon.expr1 = arg2;
          390       expr->u.questcolon.expr2 = arg3;
          391       break;
          392 
          393     case eMULT:
          394     case eDIV:
          395     case ePLUS:
          396     case eMINUS:
          397     case eLT:
          398     case eGT:
          399     case eEQ:
          400     case eNE:
          401     case eGE:
          402     case eLE:
          403     case eAND:
          404     case eOR:
          405       expr->u.op.left = arg1;
          406       expr->u.op.right = arg2;
          407       break;
          408     }
          409 
          410   return expr;
          411 }
          412 
          413 
          414 Cons *
          415 cons (car, cdr)
          416      void *car;
          417      void *cdr;
          418 {
          419   Cons *c;
          420 
          421   c = (Cons *) xmalloc (sizeof (*c));
          422   c->car = car;
          423   c->cdr = cdr;
          424 
          425   return c;
          426 }
          427 
          428 
          429 void
          430 define_state (sym, super, rules)
          431      Node *sym;
          432      Node *super;
          433      List *rules;
          434 {
          435   void *old_state;
          436   char msg[512];
          437   State *state;
          438 
          439   state = (State *) xcalloc (1, sizeof (*state));
          440   state->name = xstrdup (sym->u.sym);
          441   state->rules = rules;
          442 
          443   if (super)
          444     state->super_name = xstrdup (super->u.sym);
          445 
          446   if (!strhash_put (ns_states, sym->u.sym, strlen (sym->u.sym), state,
          447                     &old_state))
          448     {
          449       fprintf (stderr, _("%s: ouf of memory"), program);
          450       exit (1);
          451     }
          452   if (old_state)
          453     {
          454       sprintf (msg, _("warning: redefining state `%s'"), sym->u.sym);
          455       yyerror (msg);
          456       /* Yes, we leak memory here. */
          457     }
          458 }
          459 
          460 
          461 /*
          462  * Expression evaluation.
          463  */
          464 
          465 static void
          466 define_sub (sym, args_body, filename, linenum)
          467      Node *sym;
          468      Cons *args_body;
          469      char *filename;
          470      unsigned int linenum;
          471 {
          472   void *old_data;
          473 
          474   if (!strhash_put (ns_subs, sym->u.sym, strlen (sym->u.sym), args_body,
          475                     &old_data))
          476     {
          477       fprintf (stderr, _("%s: ouf of memory"), program);
          478       exit (1);
          479     }
          480   if (old_data && warning_level >= WARN_ALL)
          481     fprintf (stderr, _("%s:%d: warning: redefining subroutine `%s'\n"),
          482              filename, linenum, sym->u.sym);
          483 }
          484 
          485 extern unsigned int current_linenum;
          486 
          487 static Node *
          488 lookup_var (env, ns, sym, filename, linenum)
          489      Environment *env;
          490      StringHashPtr ns;
          491      Node *sym;
          492      char *filename;
          493      unsigned int linenum;
          494 {
          495   Node *n;
          496   Environment *e;
          497 
          498   /* Special variables. */
          499   if (sym->u.sym[0] == '$' && sym->u.sym[1] && sym->u.sym[2] == '\0')
          500     {
          501       /* Regexp sub expression reference. */
          502       if (sym->u.sym[1] >= '0' && sym->u.sym[1] <= '9')
          503         {
          504           int i;
          505           int len;
          506 
          507           /* Matched text. */
          508           i = sym->u.sym[1] - '0';
          509 
          510           n = node_alloc (nSTRING);
          511           if (current_match == NULL || current_match->start[i] < 0
          512               || current_match_buf == NULL)
          513             {
          514               n->u.str.data = (char *) xmalloc (1);
          515               n->u.str.len = 0;
          516             }
          517           else
          518             {
          519               len = current_match->end[i] - current_match->start[i];
          520               n->u.str.data = (char *) xmalloc (len + 1);
          521               memcpy (n->u.str.data,
          522                       current_match_buf + current_match->start[i], len);
          523               n->u.str.len = len;
          524             }
          525 
          526           /* Must set the refcount to 0 so that the user will free it
          527              it when it is not needed anymore.  We will never touch
          528              this node after this pointer. */
          529           n->refcount = 0;
          530 
          531           return n;
          532         }
          533 
          534       /* Everything before the matched expression. */
          535       if (sym->u.sym[1] == '`' || sym->u.sym[1] == 'B')
          536         {
          537           n = node_alloc (nSTRING);
          538           if (current_match == NULL || current_match->start[0] < 0
          539               || current_match_buf == NULL)
          540             {
          541               n->u.str.data = (char *) xmalloc (1);
          542               n->u.str.len = 0;
          543             }
          544           else
          545             {
          546               n->u.str.len = current_match->start[0];
          547               n->u.str.data = (char *) xmalloc (n->u.str.len + 1);
          548               memcpy (n->u.str.data, current_match_buf, n->u.str.len);
          549             }
          550 
          551           /* Set the refcount to 0.  See above. */
          552           n->refcount = 0;
          553           return n;
          554         }
          555 
          556       /* Current input line number. */
          557       if (sym->u.sym[1] == '.')
          558         {
          559           n = node_alloc (nINTEGER);
          560           n->u.integer = current_linenum;
          561 
          562           /* Set the refcount to 0.  See above. */
          563           n->refcount = 0;
          564           return n;
          565         }
          566     }
          567 
          568   /* Local variables. */
          569   for (e = env; e; e = e->next)
          570     if (strcmp (e->name, sym->u.sym) == 0)
          571       return e->val;
          572 
          573   /* Global variables. */
          574   if (strhash_get (ns, sym->u.sym, strlen (sym->u.sym), (void **) &n))
          575     return n;
          576 
          577   /* Undefined variable. */
          578   fprintf (stderr, _("%s:%d: error: undefined variable `%s'\n"),
          579            filename, linenum, sym->u.sym);
          580   exit (1);
          581 
          582   /* NOTREACHED */
          583   return NULL;
          584 }
          585 
          586 
          587 static void
          588 set_var (env, ns, sym, val, filename, linenum)
          589      Environment *env;
          590      StringHashPtr ns;
          591      Node *sym;
          592      Node *val;
          593      char *filename;
          594      unsigned int linenum;
          595 {
          596   Node *n;
          597   Environment *e;
          598 
          599   /* Local variables. */
          600   for (e = env; e; e = e->next)
          601     if (strcmp (e->name, sym->u.sym) == 0)
          602       {
          603         node_free (e->val);
          604         e->val = val;
          605         return;
          606       }
          607 
          608   /* Global variables. */
          609   if (strhash_put (ns, sym->u.sym, strlen (sym->u.sym), val, (void **) &n))
          610     {
          611       node_free (n);
          612       return;
          613     }
          614 
          615   /* Couldn't set value for variable. */
          616   fprintf (stderr, _("%s:%d: error: couldn't set variable `%s'\n"),
          617            filename, linenum, sym->u.sym);
          618   exit (1);
          619   /* NOTREACHED */
          620 }
          621 
          622 
          623 static Node *
          624 calculate_binary (l, r, type, filename, linenum)
          625      Node *l;
          626      Node *r;
          627      ExprType type;
          628      char *filename;
          629      unsigned int linenum;
          630 {
          631   Node *n = NULL;
          632 
          633   switch (type)
          634     {
          635     case eMULT:
          636     case eDIV:
          637     case ePLUS:
          638     case eMINUS:
          639     case eLT:
          640     case eGT:
          641     case eEQ:
          642     case eNE:
          643     case eGE:
          644     case eLE:
          645       if (l->type == r->type && l->type == nINTEGER)
          646         {
          647           n = node_alloc (nINTEGER);
          648           switch (type)
          649             {
          650             case eMULT:
          651               n->u.integer = (l->u.integer * r->u.integer);
          652               break;
          653 
          654             case eDIV:
          655               n->u.integer = (l->u.integer / r->u.integer);
          656               break;
          657 
          658             case ePLUS:
          659               n->u.integer = (l->u.integer + r->u.integer);
          660               break;
          661 
          662             case eMINUS:
          663               n->u.integer = (l->u.integer - r->u.integer);
          664               break;
          665 
          666             case eLT:
          667               n->u.integer = (l->u.integer < r->u.integer);
          668               break;
          669 
          670             case eGT:
          671               n->u.integer = (l->u.integer > r->u.integer);
          672               break;
          673 
          674             case eEQ:
          675               n->u.integer = (l->u.integer == r->u.integer);
          676               break;
          677 
          678             case eNE:
          679               n->u.integer = (l->u.integer != r->u.integer);
          680               break;
          681 
          682             case eGE:
          683               n->u.integer = (l->u.integer >= r->u.integer);
          684               break;
          685 
          686             case eLE:
          687               n->u.integer = (l->u.integer <= r->u.integer);
          688               break;
          689 
          690             default:
          691               /* NOTREACHED */
          692               break;
          693             }
          694         }
          695       else if ((l->type == nINTEGER || l->type == nREAL)
          696                && (r->type == nINTEGER || r->type == nREAL))
          697         {
          698           double dl, dr;
          699 
          700           if (l->type == nINTEGER)
          701             dl = (double) l->u.integer;
          702           else
          703             dl = l->u.real;
          704 
          705           if (r->type == nINTEGER)
          706             dr = (double) r->u.integer;
          707           else
          708             dr = r->u.real;
          709 
          710           n = node_alloc (nREAL);
          711           switch (type)
          712             {
          713             case eMULT:
          714               n->u.real = (dl * dr);
          715               break;
          716 
          717             case eDIV:
          718               n->u.real = (dl / dr);
          719               break;
          720 
          721             case ePLUS:
          722               n->u.real = (dl + dr);
          723               break;
          724 
          725             case eMINUS:
          726               n->u.real = (dl - dr);
          727               break;
          728 
          729             case eLT:
          730               n->type = nINTEGER;
          731               n->u.integer = (dl < dr);
          732               break;
          733 
          734             case eGT:
          735               n->type = nINTEGER;
          736               n->u.integer = (dl > dr);
          737               break;
          738 
          739             case eEQ:
          740               n->type = nINTEGER;
          741               n->u.integer = (dl == dr);
          742               break;
          743 
          744             case eNE:
          745               n->type = nINTEGER;
          746               n->u.integer = (dl != dr);
          747               break;
          748 
          749             case eGE:
          750               n->type = nINTEGER;
          751               n->u.integer = (dl >= dr);
          752               break;
          753 
          754             case eLE:
          755               n->type = nINTEGER;
          756               n->u.integer = (dl <= dr);
          757               break;
          758 
          759             default:
          760               /* NOTREACHED */
          761               break;
          762             }
          763         }
          764       else
          765         {
          766           fprintf (stderr,
          767                    _("%s:%d: error: expression between illegal types\n"),
          768                    filename, linenum);
          769           exit (1);
          770         }
          771       break;
          772 
          773     default:
          774       /* This is definitely a bug. */
          775       abort ();
          776       break;
          777     }
          778 
          779   return n;
          780 }
          781 
          782 
          783 Node *
          784 eval_expr (expr, env)
          785      Expr *expr;
          786      Environment *env;
          787 {
          788   Node *n = nvoid;
          789   Node *n2;
          790   Node *l, *r;
          791   Cons *c;
          792   Primitive prim;
          793   int return_seen;
          794   Environment *ei, *ei2;
          795   int i;
          796   Node sn;
          797 
          798   if (expr == NULL)
          799     return nvoid;
          800 
          801   switch (expr->type)
          802     {
          803     case eSTRING:
          804     case eREGEXP:
          805     case eINTEGER:
          806     case eREAL:
          807       node_reference (expr->u.node);
          808       return expr->u.node;
          809       break;
          810 
          811     case eSYMBOL:
          812       n = lookup_var (env, ns_vars, expr->u.node, expr->filename,
          813                       expr->linenum);
          814       node_reference (n);
          815       return n;
          816       break;
          817 
          818     case eNOT:
          819       n = eval_expr (expr->u.not, env);
          820       i = !IS_TRUE (n);
          821       node_free (n);
          822 
          823       n = node_alloc (nINTEGER);
          824       n->u.integer = i;
          825       return n;
          826       break;
          827 
          828     case eFCALL:
          829       n = expr->u.fcall.name;
          830       /* User-defined subroutine? */
          831       if (strhash_get (ns_subs, n->u.sym, strlen (n->u.sym),
          832                        (void **) &c))
          833         {
          834           Environment *nenv = NULL;
          835           ListItem *i, *e;
          836           List *stmts __attribute__ ((__unused__));
          837           List *lst;
          838           Cons *args_locals;
          839 
          840           /* Found it, now bind arguments. */
          841           args_locals = (Cons *) c->car;
          842           stmts = (List *) c->cdr;
          843 
          844           lst = (List *) args_locals->car;
          845 
          846           for (i = lst->head, e = expr->u.fcall.args->head; i && e;
          847                i = i->next, e = e->next)
          848             {
          849               Node *sym;
          850 
          851               sym = (Node *) i->data;
          852 
          853               n = eval_expr ((Expr *) e->data, env);
          854 
          855               ei = (Environment *) xcalloc (1, sizeof (*ei));
          856               ei->name = sym->u.sym;
          857               ei->val = n;
          858               ei->next = nenv;
          859               nenv = ei;
          860             }
          861           /* Check that we had correct amount of arguments. */
          862           if (i)
          863             {
          864               fprintf (stderr,
          865                        _("%s:%d: error: too few arguments for subroutine\n"),
          866                        expr->filename, expr->linenum);
          867               exit (1);
          868             }
          869           if (e)
          870             {
          871               fprintf (stderr,
          872                        _("%s:%d: error: too many arguments for subroutine\n"),
          873                        expr->filename, expr->linenum);
          874               exit (1);
          875             }
          876 
          877           /* Enter local variables. */
          878           lst = (List *) args_locals->cdr;
          879           for (i = lst->head; i; i = i->next)
          880             {
          881               Cons *c;
          882               Node *sym;
          883               Expr *init;
          884 
          885               c = (Cons *) i->data;
          886               sym = (Node *) c->car;
          887               init = (Expr *) c->cdr;
          888 
          889               ei = (Environment *) xcalloc (1, sizeof (*ei));
          890               ei->name = sym->u.sym;
          891 
          892               if (init)
          893                 ei->val = eval_expr (init, nenv);
          894               else
          895                 ei->val = nvoid;
          896 
          897               ei->next = nenv;
          898               nenv = ei;
          899             }
          900 
          901           /* Eval statement list. */
          902           return_seen = 0;
          903           n = eval_statement_list ((List *) c->cdr, nenv, &return_seen);
          904 
          905           /* Cleanup env. */
          906           for (ei = nenv; ei; ei = ei2)
          907             {
          908               ei2 = ei->next;
          909               node_free (ei->val);
          910               xfree (ei);
          911             }
          912 
          913           return n;
          914         }
          915       /* Primitives. */
          916       else if (strhash_get (ns_prims, n->u.sym, strlen (n->u.sym),
          917                             (void **) &prim))
          918         {
          919           n = (*prim) (n->u.sym, expr->u.fcall.args, env, expr->filename,
          920                        expr->linenum);
          921           return n;
          922         }
          923       else
          924         {
          925           fprintf (stderr,
          926                    _("%s:%d: error: undefined procedure `%s'\n"),
          927                    expr->filename, expr->linenum, n->u.sym);
          928           exit (1);
          929         }
          930       break;
          931 
          932     case eASSIGN:
          933       n = eval_expr (expr->u.assign.expr, env);
          934       set_var (env, ns_vars, expr->u.assign.sym, n, expr->filename,
          935                expr->linenum);
          936 
          937       node_reference (n);
          938       return n;
          939       break;
          940 
          941     case eADDASSIGN:
          942     case eSUBASSIGN:
          943     case eMULASSIGN:
          944     case eDIVASSIGN:
          945       n = eval_expr (expr->u.assign.expr, env);
          946       n2 = lookup_var (env, ns_vars, expr->u.assign.sym, expr->filename,
          947                        expr->linenum);
          948 
          949       switch (expr->type)
          950         {
          951         case eADDASSIGN:
          952           n2 = calculate_binary (n2, n, ePLUS, expr->filename, expr->linenum);
          953           break;
          954 
          955         case eSUBASSIGN:
          956           n2 = calculate_binary (n2, n, eMINUS, expr->filename, expr->linenum);
          957           break;
          958 
          959         case eMULASSIGN:
          960           n2 = calculate_binary (n2, n, eMULT, expr->filename, expr->linenum);
          961           break;
          962 
          963         case eDIVASSIGN:
          964           n2 = calculate_binary (n2, n, eDIV, expr->filename, expr->linenum);
          965           break;
          966 
          967         default:
          968           /* NOTREACHED */
          969           abort ();
          970           break;
          971         }
          972       set_var (env, ns_vars, expr->u.assign.sym, n2, expr->filename,
          973                expr->linenum);
          974 
          975       node_free (n);
          976       node_reference (n2);
          977       return n2;
          978       break;
          979 
          980     case ePOSTFIXADD:
          981     case ePOSTFIXSUB:
          982       sn.type = nINTEGER;
          983       sn.u.integer = 1;
          984 
          985       n2 = lookup_var (env, ns_vars, expr->u.node, expr->filename,
          986                        expr->linenum);
          987       node_reference (n2);
          988 
          989       n = calculate_binary (n2, &sn,
          990                             expr->type == ePOSTFIXADD ? ePLUS : eMINUS,
          991                             expr->filename, expr->linenum);
          992       set_var (env, ns_vars, expr->u.node, n, expr->filename, expr->linenum);
          993 
          994       return n2;
          995       break;
          996 
          997     case ePREFIXADD:
          998     case ePREFIXSUB:
          999       sn.type = nINTEGER;
         1000       sn.u.integer = 1;
         1001 
         1002       n = lookup_var (env, ns_vars, expr->u.node, expr->filename,
         1003                       expr->linenum);
         1004       n = calculate_binary (n, &sn,
         1005                             expr->type == ePREFIXADD ? ePLUS : eMINUS,
         1006                             expr->filename, expr->linenum);
         1007       set_var (env, ns_vars, expr->u.node, n, expr->filename, expr->linenum);
         1008 
         1009       node_reference (n);
         1010       return n;
         1011       break;
         1012 
         1013     case eARRAYASSIGN:
         1014       n = eval_expr (expr->u.arrayassign.expr1, env);
         1015       if (n->type != nARRAY && n->type != nSTRING)
         1016         {
         1017           fprintf (stderr,
         1018                    _("%s:%d: error: illegal lvalue for assignment\n"),
         1019                    expr->filename, expr->linenum);
         1020           exit (1);
         1021         }
         1022       n2 = eval_expr (expr->u.arrayassign.expr2, env);
         1023       if (n2->type != nINTEGER)
         1024         {
         1025           fprintf (stderr,
         1026                    _("%s:%d: error: array reference index is not integer\n"),
         1027                    expr->filename, expr->linenum);
         1028           exit (1);
         1029         }
         1030       if (n2->u.integer < 0)
         1031         {
         1032           fprintf (stderr, _("%s:%d: error: negative array reference index\n"),
         1033                    expr->filename, expr->linenum);
         1034           exit (1);
         1035         }
         1036 
         1037       /* Do the assignment. */
         1038       if (n->type == nARRAY)
         1039         {
         1040           if (n2->u.integer >= n->u.array.len)
         1041             {
         1042               if (n2->u.integer >= n->u.array.allocated)
         1043                 {
         1044                   /* Allocate more space. */
         1045                   n->u.array.allocated = n2->u.integer + 100;
         1046                   n->u.array.array = (Node **) xrealloc (n->u.array.array,
         1047                                                          n->u.array.allocated
         1048                                                          * sizeof (Node *));
         1049                 }
         1050               /* Fill the possible gap. */
         1051               for (i = n->u.array.len; i <= n2->u.integer; i++)
         1052                 n->u.array.array[i] = nvoid;
         1053 
         1054               /* Updated expanded array length. */
         1055               n->u.array.len = n2->u.integer + 1;
         1056             }
         1057           node_free (n->u.array.array[n2->u.integer]);
         1058 
         1059           l = eval_expr (expr->u.arrayassign.expr3, env);
         1060 
         1061           /* +1 for the return value. */
         1062           node_reference (l);
         1063 
         1064           n->u.array.array[n2->u.integer] = l;
         1065         }
         1066       else
         1067         {
         1068           if (n2->u.integer >= n->u.str.len)
         1069             {
         1070               i = n->u.str.len;
         1071               n->u.str.len = n2->u.integer + 1;
         1072               n->u.str.data = (char *) xrealloc (n->u.str.data,
         1073                                                  n->u.str.len);
         1074 
         1075               /* Init the expanded string with ' ' character. */
         1076               for (; i < n->u.str.len; i++)
         1077                 n->u.str.data[i] = ' ';
         1078             }
         1079           l = eval_expr (expr->u.arrayassign.expr3, env);
         1080           if (l->type != nINTEGER)
         1081             {
         1082               fprintf (stderr,
         1083                        _("%s:%d: error: illegal rvalue for string assignment\n"),
         1084                        expr->filename, expr->linenum);
         1085               exit (1);
         1086             }
         1087 
         1088           n->u.str.data[n2->u.integer] = l->u.integer;
         1089         }
         1090 
         1091       node_free (n);
         1092       node_free (n2);
         1093 
         1094       return l;
         1095       break;
         1096 
         1097     case eARRAYREF:
         1098       n = eval_expr (expr->u.arrayref.expr1, env);
         1099       if (n->type != nARRAY && n->type != nSTRING)
         1100         {
         1101           fprintf (stderr,
         1102                    _("%s:%d: error: illegal type for array reference\n"),
         1103                    expr->filename, expr->linenum);
         1104           exit (1);
         1105         }
         1106       n2 = eval_expr (expr->u.arrayref.expr2, env);
         1107       if (n2->type != nINTEGER)
         1108         {
         1109           fprintf (stderr,
         1110                    _("%s:%d: error: array reference index is not integer\n"),
         1111                    expr->filename, expr->linenum);
         1112           exit (1);
         1113         }
         1114       if (n2->u.integer < 0
         1115           || (n->type == nARRAY && n2->u.integer >= n->u.array.len)
         1116           || (n->type == nSTRING && n2->u.integer >= n->u.str.len))
         1117         {
         1118           fprintf (stderr,
         1119                    _("%s:%d: error: array reference index out of range\n"),
         1120                    expr->filename, expr->linenum);
         1121           exit (1);
         1122         }
         1123 
         1124       /* Do the reference. */
         1125       if (n->type == nARRAY)
         1126         {
         1127           l = n->u.array.array[n2->u.integer];
         1128           node_reference (l);
         1129         }
         1130       else
         1131         {
         1132           l = node_alloc (nINTEGER);
         1133           l->u.integer
         1134             = (int) ((unsigned char *) n->u.str.data)[n2->u.integer];
         1135         }
         1136       node_free (n);
         1137       node_free (n2);
         1138       return l;
         1139       break;
         1140 
         1141     case eQUESTCOLON:
         1142       n = eval_expr (expr->u.questcolon.cond, env);
         1143       i = IS_TRUE (n);
         1144       node_free (n);
         1145 
         1146       if (i)
         1147         n = eval_expr (expr->u.questcolon.expr1, env);
         1148       else
         1149         n = eval_expr (expr->u.questcolon.expr2, env);
         1150 
         1151       return n;
         1152       break;
         1153 
         1154     case eAND:
         1155       n = eval_expr (expr->u.op.left, env);
         1156       if (!IS_TRUE (n))
         1157         return n;
         1158       node_free (n);
         1159       return eval_expr (expr->u.op.right, env);
         1160       break;
         1161 
         1162     case eOR:
         1163       n = eval_expr (expr->u.op.left, env);
         1164       if (IS_TRUE (n))
         1165         return n;
         1166       node_free (n);
         1167       return eval_expr (expr->u.op.right, env);
         1168       break;
         1169 
         1170       /* Arithmetics. */
         1171     case eMULT:
         1172     case eDIV:
         1173     case ePLUS:
         1174     case eMINUS:
         1175     case eLT:
         1176     case eGT:
         1177     case eEQ:
         1178     case eNE:
         1179     case eGE:
         1180     case eLE:
         1181       /* Eval sub-expressions. */
         1182       l = eval_expr (expr->u.op.left, env);
         1183       r = eval_expr (expr->u.op.right, env);
         1184 
         1185       n = calculate_binary (l, r, expr->type, expr->filename, expr->linenum);
         1186 
         1187       node_free (l);
         1188       node_free (r);
         1189       return n;
         1190       break;
         1191     }
         1192 
         1193   /* NOTREACHED */
         1194   return n;
         1195 }
         1196 
         1197 
         1198 Node *
         1199 eval_statement (stmt, env, return_seen)
         1200      Stmt *stmt;
         1201      Environment *env;
         1202      int *return_seen;
         1203 {
         1204   Node *n = nvoid;
         1205   Node *n2;
         1206   int i;
         1207 
         1208   switch (stmt->type)
         1209     {
         1210     case sRETURN:
         1211       n = eval_expr (stmt->u.expr, env);
         1212       *return_seen = 1;
         1213       break;
         1214 
         1215     case sDEFSUB:
         1216       define_sub (stmt->u.defsub.name, stmt->u.defsub.closure,
         1217                   stmt->filename, stmt->linenum);
         1218       break;
         1219 
         1220     case sBLOCK:
         1221       n = eval_statement_list (stmt->u.block, env, return_seen);
         1222       break;
         1223 
         1224     case sIF:
         1225       n = eval_expr (stmt->u.stmt_if.expr, env);
         1226       i = IS_TRUE (n);
         1227       node_free (n);
         1228 
         1229       if (i)
         1230         /* Then branch. */
         1231         n = eval_statement (stmt->u.stmt_if.then_stmt, env, return_seen);
         1232       else
         1233         {
         1234           /* Optional else branch.  */
         1235           if (stmt->u.stmt_if.else_stmt)
         1236             n = eval_statement (stmt->u.stmt_if.else_stmt, env, return_seen);
         1237           else
         1238             n = nvoid;
         1239         }
         1240       break;
         1241 
         1242     case sWHILE:
         1243       while (1)
         1244         {
         1245           n2 = eval_expr (stmt->u.stmt_while.expr, env);
         1246           i = IS_TRUE (n2);
         1247           node_free (n2);
         1248 
         1249           if (!i)
         1250             break;
         1251 
         1252           node_free (n);
         1253 
         1254           /* Eval body. */
         1255           n = eval_statement (stmt->u.stmt_while.body, env, return_seen);
         1256           if (*return_seen)
         1257             break;
         1258         }
         1259       break;
         1260 
         1261     case sFOR:
         1262       /* Init. */
         1263       if (stmt->u.stmt_for.init)
         1264         {
         1265           n2 = eval_expr (stmt->u.stmt_for.init, env);
         1266           node_free (n2);
         1267         }
         1268 
         1269       /* Body. */
         1270       while (1)
         1271         {
         1272           n2 = eval_expr (stmt->u.stmt_for.cond, env);
         1273           i = IS_TRUE (n2);
         1274           node_free (n2);
         1275 
         1276           if (!i)
         1277             break;
         1278 
         1279           node_free (n);
         1280 
         1281           /* Eval body. */
         1282           n = eval_statement (stmt->u.stmt_for.body, env, return_seen);
         1283           if (*return_seen)
         1284             break;
         1285 
         1286           /* Increment. */
         1287           if (stmt->u.stmt_for.incr)
         1288             {
         1289               n2 = eval_expr (stmt->u.stmt_for.incr, env);
         1290               node_free (n2);
         1291             }
         1292         }
         1293       break;
         1294 
         1295     case sEXPR:
         1296       n = eval_expr (stmt->u.expr, env);
         1297       break;
         1298     }
         1299 
         1300   return n;
         1301 }
         1302 
         1303 
         1304 Node *
         1305 eval_statement_list (lst, env, return_seen)
         1306      List *lst;
         1307      Environment *env;
         1308      int *return_seen;
         1309 {
         1310   ListItem *i;
         1311   Stmt *stmt;
         1312   Node *n = nvoid;
         1313 
         1314   if (lst == NULL)
         1315     return nvoid;
         1316 
         1317   for (i = lst->head; i; i = i->next)
         1318     {
         1319       node_free (n);
         1320 
         1321       stmt = (Stmt *) i->data;
         1322 
         1323       n = eval_statement (stmt, env, return_seen);
         1324       if (*return_seen)
         1325         return n;
         1326     }
         1327 
         1328   return n;
         1329 }
         1330 
         1331 
         1332 void
         1333 load_states_file (name)
         1334      char *name;
         1335 {
         1336   Node *n;
         1337   int return_seen = 0;
         1338 
         1339   yyin_name = xstrdup (name);
         1340   linenum = 1;
         1341 
         1342   yyin = fopen (yyin_name, "r");
         1343   if (yyin == NULL)
         1344     {
         1345       fprintf (stderr, _("%s: couldn't open definition file `%s': %s\n"),
         1346                program, yyin_name, strerror (errno));
         1347       exit (1);
         1348     }
         1349 
         1350 
         1351   yyparse ();
         1352   fclose (yyin);
         1353 
         1354   /* Evaluate all top-level statements. */
         1355   n = eval_statement_list (global_stmts, NULL, &return_seen);
         1356   node_free (n);
         1357 
         1358   /* Reset the global statements to an empty list. */
         1359   global_stmts = list ();
         1360 }
         1361 
         1362 
         1363 int
         1364 autoload_file (name)
         1365      char *name;
         1366 {
         1367   char *start;
         1368   unsigned int len;
         1369   char *cp;
         1370   char *buf = NULL;
         1371   unsigned int buflen = 1024;
         1372   unsigned int name_len;
         1373   struct stat stat_st;
         1374   int result = 0;
         1375 
         1376   name_len = strlen (name);
         1377   buf = xmalloc (buflen);
         1378 
         1379   for (start = path; start; start = cp)
         1380     {
         1381       cp = strchr (start, PATH_SEPARATOR);
         1382       if (cp)
         1383         {
         1384           len = cp - start;
         1385           cp++;
         1386         }
         1387       else
         1388         len = strlen (start);
         1389 
         1390       if (len + 1 + name_len + 3 + 1 >= buflen)
         1391         {
         1392           buflen = len + 1 + name_len + 3 + 1 + 1024;
         1393           buf = xrealloc (buf, buflen);
         1394         }
         1395       sprintf (buf, "%.*s/%s.st", len, start, name);
         1396 
         1397       if (stat (buf, &stat_st) == 0)
         1398         {
         1399           if (verbose)
         1400             fprintf (stderr,
         1401                      _("%s: autoloading `%s' from `%s'\n"),
         1402                      program, name, buf);
         1403           load_states_file (buf);
         1404           result = 1;
         1405           break;
         1406         }
         1407     }
         1408 
         1409   xfree (buf);
         1410 
         1411   return result;
         1412 }
         1413 
         1414 
         1415 State *
         1416 lookup_state (name)
         1417      char *name;
         1418 {
         1419   State *state;
         1420   int retry_count = 0;
         1421 
         1422   while (1)
         1423     {
         1424       if (strhash_get (ns_states, name, strlen (name), (void **) &state))
         1425         return state;
         1426 
         1427       if (retry_count > 0)
         1428         break;
         1429 
         1430       /* Try to autoload the state. */
         1431       autoload_file (name);
         1432       retry_count++;
         1433     }
         1434 
         1435   /* No luck. */
         1436   return NULL;
         1437 }