1 %{
2 /* This file is part of GNU Radius.
3    Copyright (C) 2000,2001,2002,2003,2004,2005,
4    2006,2007,2008 Free Software Foundation, Inc.
5 
6    Written by Sergey Poznyakoff
7 
8    GNU Radius is free software; you can redistribute it and/or modify
9    it under the terms of the GNU General Public License as published by
10    the Free Software Foundation; either version 3 of the License, or
11    (at your option) any later version.
12 
13    GNU Radius is distributed in the hope that it will be useful,
14    but WITHOUT ANY WARRANTY; without even the implied warranty of
15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16    GNU General Public License for more details.
17 
18    You should have received a copy of the GNU General Public License
19    along with GNU Radius; if not, write to the Free Software Foundation,
20    Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
21 
22 #if defined(HAVE_CONFIG_H)
23 # include <config.h>
24 #endif
25 #include <sys/types.h>
26 #include <stdio.h>
27 #include <string.h>
28 #include <ctype.h>
29 #include <errno.h>
30 
31 #include <radiusd.h>
32 #include <setjmp.h>
33 #include <rewrite.h>
34 #ifdef USE_SERVER_GUILE
35 # include <libguile.h>
36 # include <radius/radscm.h>
37 #endif
38 
39 typedef long RWSTYPE;
40 #define RW_MIN(a,b) ((a)<(b)) ? (a) : (b)
41 
42 /*
43  * Generalized list structure
44  */
45 typedef struct rw_list RWLIST;
46 #define RWLIST(type) \
47         type     *next;\
48         type     *prev
49 
50 struct rw_list {
51         RWLIST(RWLIST);
52 };
53 
54 /*
55  * Generalized object
56  */
57 typedef struct object_t OBJECT ;
58 
59 #define OBJ(type) \
60         RWLIST(type);\
61         type    *alloc
62 
63 struct object_t {
64         OBJ(OBJECT);
65 };
66 
67 typedef struct {
68         size_t   size;        /* Size of an element */
69         void     (*free)();   /* deallocator */
70         OBJECT   *alloc_list; /* list of allocated elements */
71 } OBUCKET;
72 
73 
74 
75 /* ************************************************************
76  * Basic data types
77  */
78 
79 typedef int stkoff_t;             /* Offset on stack */
80 typedef unsigned int pctr_t;      /* Program counter */
81 
82 #define RW_REG ('z'-'a'+1)
83 
84 typedef struct {
85         RWSTYPE    reg[RW_REG];       /* Registers */
86         #define rA reg[0]
87         char       *sA;               /* String accumulator */
88         pctr_t     pc;                /* Program counter */
89 
90         RWSTYPE    *stack;            /* Stack+heap space */
91         int        stacksize;         /* Size of stack */
92         int        st;                /* Top of stack */
93         int        sb;                /* Stack base */
94         int        ht;                /* Top of heap */
95 
96         int        nmatch;
97         regmatch_t *pmatch;
98 
99         grad_request_t *req;
100 
101         jmp_buf    jmp;
102 } RWMACH;
103 
104 typedef void (*INSTR)();       /* program instruction */
105 
106 /* Compiled regular expression
107  */
108 typedef struct comp_regex COMP_REGEX;
109 struct comp_regex {
110         OBJ(COMP_REGEX);
111         regex_t      regex;    /* compiled regex itself */
112         int          nmatch;   /* number of \( ... \) groups */
113 };
114 
115 /*
116  * Binary Operations
117  */
118 typedef enum {
119         Eq,
120         Ne,
121         Lt,
122         Le,
123         Gt,
124         Ge,
125         BAnd,
126         BXor,
127         BOr,
128         And,
129         Or,
130         Shl,
131         Shr,
132         Add,
133         Sub,
134         Mul,
135         Div,
136         Rem,
137         Max_opcode
138 } Bopcode;
139 
140 /*
141  * Unary operations
142  */
143 typedef enum {
144         Neg,
145         Not,
146         Max_unary
147 } Uopcode;
148 
149 /*
150  * Matrix types
151  */
152 typedef enum {
153         Generic,
154         Nop,
155         Enter,
156         Leave,
157         Stop,
158         Constant,
159         Matchref,
160         Variable,
161         Unary,
162         Binary,
163         Cond,
164         Asgn,
165         Match,
166         Coercion,
167         Expression,
168         Return,
169         Jump,
170         Branch,
171         Target,
172         Call,
173         Builtin,
174         Pop,
175         Pusha,
176         Popa,
177         Attr,
178         Attr_asgn,
179         Attr_check,
180 	Attr_delete,
181         Max_mtxtype
182 } Mtxtype;
183 
184 /*
185  * Function parameter
186  */
187 typedef struct parm_t PARAMETER;
188 struct parm_t {
189         PARAMETER   *prev;     /* Previous parameter */
190         PARAMETER   *next;     /* Next parameter */
191         grad_data_type_t    datatype;  /* type */
192         stkoff_t    offset;    /* Offset on stack */
193 };
194 
195 /*
196  * Local variable
197  */
198 typedef struct variable VAR;
199 struct variable {
200         OBJ(VAR);
201         VAR       *dcllink;  /* Link to the next variable vithin the
202                               * same declaration
203                               */
204         char      *name;     /* name of the variable */
205         int       level;     /* nesting level */
206         int       offset;    /* offset on stack */
207         grad_data_type_t  datatype;  /* type */
208         int       constant;  /* true if assigned a constant value */
209         grad_datum_t     datum;     /* constant value itself */
210 };
211 
212 /*
213  * Function definition
214  */
215 typedef struct function_def {
216         struct function_def *next;
217         char       *name;        /* Function name */
218         grad_data_type_t   rettype;      /* Return type */
219         pctr_t     entry;        /* Code entry */
220         COMP_REGEX *rx_list;     /* List of compiled regexps */
221         int        nparm;        /* Number of parameters */
222         PARAMETER  *parm;        /* List of parameters */
223         stkoff_t   stack_alloc;  /* required stack allocation */
224         grad_locus_t      loc;   /* source location where the function
225                                   * was declared
226                                   */
227 } FUNCTION;
228 
229 #define STACK_BASE 2
230 
231 /*
232  * Built-in function
233  */
234 typedef struct  {
235         INSTR    handler;        /* Function itself */
236         char     *name;          /* Function name */
237         grad_data_type_t rettype;        /* Return type */
238         char     *parms;         /* coded parameter types */
239 } builtin_t;
240 
241 /*
242  * Operation matrices
243  */
244 typedef union mtx MTX;
245 /*
246  * All matrices contain the following common fields:
247  *    alloc- link to the previously allocated matrix.
248  *           It is used at the end of code generation
249  *           pass to free all allocated matrices.
250  *    next - link to the next matrix in the subexpression
251  *    prev - link to the previous matrix in the subexpression
252  * Additionally, all expression matrices contain the field
253  * `datatype' which contains the data type for this matrix.
254  */
255 #if defined(MAINTAINER_MODE)
256 # define COMMON_MTX \
257         OBJ(MTX);\
258         int      id;\
259         grad_locus_t    loc;\
260         Mtxtype  type;
261 #else
262 # define COMMON_MTX \
263         OBJ(MTX);\
264         grad_locus_t    loc;\
265         Mtxtype  type;
266 #endif
267 
268 #define COMMON_EXPR_MTX \
269         COMMON_MTX\
270         grad_data_type_t datatype;\
271         MTX      *uplink;\
272         MTX      *arglink;
273 
274 /*
275  * Generic matrix: nothing special
276  * Type: Generic
277  */
278 typedef struct {
279         COMMON_EXPR_MTX
280 } GEN_MTX;
281 /*
282  * Constant matrix
283  * Type: Constant
284  */
285 typedef struct {
286         COMMON_EXPR_MTX
287         grad_datum_t    datum;     /* Constant value */
288 } CONST_MTX;
289 /*
290  * Reference to a previous regexp: corresponds to a \N construct
291  * Type: Matchref
292  */
293 typedef struct {
294         COMMON_EXPR_MTX
295         int      num;       /* Number of \( ... \) to be referenced */
296 } MATCHREF_MTX;
297 /*
298  * Reference to a variable
299  * Type: Variable
300  */
301 typedef struct {
302         COMMON_EXPR_MTX
303         VAR      *var;      /* Variable being referenced */
304 } VAR_MTX;
305 /*
306  * Unary operation matrix
307  * Type: Unary
308  */
309 typedef struct {
310         COMMON_EXPR_MTX
311         Uopcode  opcode;    /* Operation code */
312         MTX      *arg;      /* Argument */
313 } UN_MTX;
314 /*
315  * Binary operation matrix
316  * Type: Binary
317  */
318 typedef struct {
319         COMMON_EXPR_MTX
320         Bopcode   opcode;   /* Operation code */
321         MTX      *arg[2];   /* Arguments */
322 } BIN_MTX;
323 /*
324  * Assignment matrix
325  * Type: Asgn
326  */
327 typedef struct {
328         COMMON_EXPR_MTX
329         VAR      *lval;     /* Lvalue */
330         MTX      *arg;      /* Rvalue */
331 } ASGN_MTX;
332 /*
333  * Conditional expression matrix
334  * Type: Cond
335  */
336 typedef struct {
337         COMMON_MTX
338         MTX      *expr;     /* Conditional expression */
339         MTX      *if_true;  /* Branch if true */
340         MTX      *if_false; /* Branch if false */
341 } COND_MTX;
342 /*
343  * Regexp match
344  * Type: Match
345  */
346 typedef struct {
347         COMMON_EXPR_MTX
348         int        negated; /* Is the match negated ? */
349         MTX        *arg;    /* Argument (lhs) */
350         COMP_REGEX *rx;     /* Regexp (rhs) */
351 } MATCH_MTX;
352 /*
353  * Type coercion
354  * Type: Coerce
355  */
356 typedef struct {
357         COMMON_EXPR_MTX
358         MTX      *arg;      /* Argument of the coercion */
359 } COERCE_MTX;
360 /*
361  * Expression
362  * Type: Expression
363  */
364 typedef struct {
365         COMMON_EXPR_MTX
366         MTX      *expr;
367 } EXPR_MTX;
368 /*
369  * Return from function
370  * Type: Return
371  */
372 typedef struct {
373         COMMON_EXPR_MTX
374         MTX      *expr;     /* Return value */
375 } RET_MTX;
376 /*
377  * Unconditional branch (jump)
378  * Type: Jump
379  */
380 typedef struct {
381         COMMON_MTX
382         MTX *link;          /* Link to the next jump matrix
383                              * (for break and continue matrices)
384                              */
385         MTX      *dest;     /* Jump destination (usually a NOP matrix) */
386 } JUMP_MTX;
387 /*
388  * Conditional branch
389  * Type: Branch
390  */
391 typedef struct {
392         COMMON_MTX
393         int      cond;      /* Condition: 1 - equal, 0 - not equal */
394         MTX      *dest;     /* Jump destination (usually a NOP matrix) */
395 } BRANCH_MTX;
396 /*
397  * Stack frame matrix
398  * Type: Enter, Leave
399  */
400 typedef struct {
401         COMMON_MTX
402         stkoff_t  stacksize;/* Required stack size */
403 } FRAME_MTX;
404 /*
405  * Jump target
406  * Type: Target
407  */
408 typedef struct {
409         COMMON_MTX
410         pctr_t  pc;         /* Target's program counter */
411 } TGT_MTX;
412 /*
413  * No-op matrix. It is always inserted at the branch destination
414  * points. Its purpose is to keep a singly-linked list of jump
415  * locations for fixing up jump statements.
416  * Type: Nop
417  */
418 typedef struct {
419         COMMON_MTX
420         TGT_MTX   *tgt;     /* Target list */
421         pctr_t     pc;      /* Program counter for backward
422                                references */
423 } NOP_MTX;
424 /*
425  * Function call
426  * Type: Call
427  */
428 typedef struct {
429         COMMON_EXPR_MTX
430         FUNCTION  *fun;     /* Called function */
431         int       nargs;    /* Number of arguments */
432         MTX       *args;    /* Arguments */
433 } CALL_MTX;
434 /*
435  * Builtin function call
436  * Type: Builtin
437  */
438 typedef struct {
439         COMMON_EXPR_MTX
440         INSTR     fun;      /* Handler function */
441         int       nargs;    /* Number of arguments */
442         MTX       *args;    /* Arguments */
443 } BTIN_MTX;
444 /*
445  * Attribute matrix
446  * Type: Attr, Attr_asgn, Attr_check
447  */
448 typedef struct {
449         COMMON_EXPR_MTX
450         int       attrno;   /* Attribute number */
451 	MTX       *index;   /* Index expression */
452         MTX       *rval;    /* Rvalue */
453 } ATTR_MTX;
454 
455 union mtx {
456         GEN_MTX    gen;
457         NOP_MTX    nop;
458         FRAME_MTX  frame;
459         CONST_MTX  cnst;
460         MATCHREF_MTX    ref;
461         VAR_MTX    var;
462         UN_MTX     un;
463         BIN_MTX    bin;
464         COND_MTX   cond;
465         ASGN_MTX   asgn;
466         MATCH_MTX  match;
467         COERCE_MTX coerce;
468         RET_MTX    ret;
469         JUMP_MTX   jump;
470         BRANCH_MTX branch;
471         TGT_MTX    tgt;
472         CALL_MTX   call;
473         BTIN_MTX   btin;
474         ATTR_MTX   attr;
475 };
476 
477 /*
478  * Stack frame
479  */
480 typedef struct frame_t FRAME;
481 
482 struct frame_t {
483         OBJ(FRAME);
484         int       level;        /* nesting level */
485         stkoff_t  stack_offset; /* offset in the stack */
486 };
487 
488 
489 /* *****************************************************************
490  * Static data
491  */
492 /*
493  * Stack Frame list
494  */
495 static OBUCKET frame_bkt = { sizeof(FRAME), NULL };
496 static FRAME *frame_first, *frame_last;
497 #define curframe frame_last
498 
499 static int errcnt;         /* Number of errors detected */
500 static FUNCTION *function; /* Function being compiled */
501 static grad_symtab_t *rewrite_tab;/* Function table */
502 
503 static MTX *mtx_first, *mtx_last;  /* Matrix list */
504 static VAR *var_first, *var_last;  /* Variable list */
505 
506 /*
507  * Loops
508  */
509 typedef struct loop_t LOOP;
510 struct loop_t {
511         OBJ(LOOP);
512         JUMP_MTX *lp_break;
513         JUMP_MTX *lp_cont;
514 };
515 static OBUCKET loop_bkt = { sizeof(LOOP), NULL };
516 static LOOP *loop_first, *loop_last;
517 
518 void loop_push(MTX *mtx);
519 void loop_pop();
520 void loop_fixup(JUMP_MTX *list, MTX *target);
521 void loop_init();
522 void loop_free_all();
523 void loop_unwind_all();
524 
525 /*
526  * Lexical analyzer stuff
527  */
528 static FILE *infile;               /* Input file */
529 static grad_locus_t locus;         /* Input location */
530 
531 static char *inbuf;                /* Input string */
532 static char *curp;                 /* Current pointer */
533 
534 static int   yyeof;                /* rised when EOF is encountered */
535 static struct obstack input_stk;   /* Symbol stack */
536 
537 static grad_data_type_t return_type = Undefined;
538                                    /* Data type of the topmost expression. */
539 
540 static int regcomp_flags = 0;      /* Flags to be used with regcomps */
541 
542 #define regex_init() regcomp_flags = 0
543 
544 /* Runtime */
545 static size_t rewrite_stack_size = 4096;  /* Size of stack+heap */
546 static RWSTYPE *runtime_stack;
547 static RWMACH mach;
548 
549 /* Default domain for gettext functions. It is initialized to PACKAGE
550    by default */
551 static char *default_gettext_domain;
552 
553 
554 /* ***************************************************************
555  * Function declarations
556  */
557 
558 /*
559  * Lexical analyzer
560  */
561 static int yylex();
562 static void yysync();
563 static int yyerror(char *s);
564 
565 /*
566  * Frames
567  */
568 static void frame_init();
569 static void frame_push();
570 static void frame_pop();
571 static void frame_unwind_all();
572 static void frame_free_all();
573 /*
574  * Variables
575  */
576 static void var_init();
577 static VAR * var_alloc(grad_data_type_t type, char *name, int grow);
578 static void var_unwind_level();
579 static void var_unwind_all();
580 static void var_type(grad_data_type_t type, VAR *var);
581 static void var_free_all();
582 static VAR *var_lookup(char *name);
583 /*
584  * Matrices
585  */
586 static void mtx_init();
587 static void mtx_free_all();
588 static void mtx_unwind_all();
589 static MTX * mtx_cur();
590 static MTX * mtx_nop();
591 static MTX * mtx_jump();
592 static MTX * mtx_frame(Mtxtype type, stkoff_t stksize);
593 static MTX * mtx_stop();
594 static MTX * mtx_pop();
595 static MTX * mtx_return();
596 static MTX * mtx_alloc(Mtxtype type);
597 static MTX * mtx_const(grad_value_t *val);
598 static MTX * mtx_ref(int num);
599 static MTX * mtx_var(VAR *var);
600 static MTX * mtx_asgn(VAR *var, MTX *arg);
601 static MTX * mtx_bin(Bopcode opcode, MTX *arg1, MTX *arg2);
602 static MTX * mtx_un(Uopcode opcode, MTX *arg);
603 static MTX * mtx_match(int negated, MTX *mtx, COMP_REGEX *);
604 static MTX * mtx_cond(MTX *cond, MTX *if_true, MTX *if_false);
605 static MTX * mtx_coerce(grad_data_type_t type, MTX *arg);
606 static MTX * mtx_call(FUNCTION *fun, MTX *args);
607 static MTX * mtx_builtin(builtin_t *bin, MTX *args);
608 static MTX * mtx_attr(grad_dict_attr_t *attr, MTX *index);
609 static MTX * mtx_attr_asgn(grad_dict_attr_t *attr, MTX *index, MTX *rval);
610 static MTX * mtx_attr_check(grad_dict_attr_t *attr, MTX *index);
611 static MTX * mtx_attr_delete(grad_dict_attr_t *attr, MTX *index);
612 
613 static MTX * coerce(MTX  *arg, grad_data_type_t type);
614 /*
615  * Regular expressions
616  */
617 static COMP_REGEX * rx_alloc(regex_t  *regex, int nmatch);
618 static void rx_free(COMP_REGEX *rx);
619 static COMP_REGEX * compile_regexp(char *str);
620 /*
621  * Functions
622  */
623 static FUNCTION * function_install(FUNCTION *fun);
624 static int  function_free(FUNCTION *fun);
625 static void function_delete();
626 static void function_cleanup();
627 /*
628  * Built-in functions
629  */
630 static builtin_t * builtin_lookup(char *name);
631 
632 /*
633  * Code optimizer and generator
634  */
635 static int optimize();
636 static pctr_t codegen();
637 static void code_init();
638 static void code_check();
639 
640 /*
641  * Auxiliary and debugging functions
642  */
643 static void debug_dump_code();
644 static const char * datatype_str_nom(grad_data_type_t type);
645 static const char * datatype_str_acc(grad_data_type_t type);
646 static const char * datatype_str_abl(grad_data_type_t type);
647 static grad_data_type_t attr_datatype(grad_dict_attr_t *);
648 
649 /*
650  * Run-Time
651  */
652 static void gc();
653 static void run(pctr_t pc);
654 static int run_init(pctr_t pc, grad_request_t *req);
655 static int rw_error(const char *msg);
656 static int rw_error_free(char *msg);
657 
658 /* These used to lock/unlock access to rw_code array. Now this is
659    not needed. However, I left the placeholders for a while... */
660 #define rw_code_lock()
661 #define rw_code_unlock()
662 
663 #define AVPLIST(m) ((m)->req ? (m)->req->avlist : NULL)
664 
665 static FUNCTION fmain;
666 %}
667 
668 
669 %union {
670         int   number;
671         int   type;
672         VAR   *var;
673         MTX   *mtx;
674         FUNCTION  *fun;
675         builtin_t *btin;
676         grad_dict_attr_t *attr;
677         struct {
678                 MTX *arg_first;
679                 MTX *arg_last;
680         } arg;
681         struct {
682                 int nmatch;
683                 regex_t regex;
684         } rx;
685         char  *string;
686 };
687 
688 %token <type>   TYPE
689 %token IF ELSE RETURN WHILE FOR DO BREAK CONTINUE DELETE
690 %token <string> STRING IDENT
691 %token <number> NUMBER REFERENCE
692 %token <var> VARIABLE
693 %token <fun> FUN
694 %token <btin> BUILTIN
695 %token <attr> ATTR
696 %token BOGUS
697 
698 %type <arg> arglist
699 %type <mtx> stmt expr list cond else while do arg args
700 %type <var> varlist parmlist parm dclparm
701 
702 
703 %right '='
704 %left OR
705 %left AND
706 %nonassoc MT NM
707 %left '|'
708 %left '^'
709 %left '&'
710 %left EQ NE
711 %left LT LE GT GE
712 %left SHL SHR
713 %left '+' '-'
714 %left '*' '/' '%'
715 %left UMINUS NOT TYPECAST
716 
717 %%
718 
719 program : input
720           {
721                   var_free_all();
722                   loop_free_all();
723                   frame_free_all();
724                   mtx_free_all();
725           }
726         ;
727 
728 input   : dcllist
729           {
730 		  return_type = Undefined;
731 	  }
732         | expr
733           {
734                   if (errcnt) {
735                           YYERROR;
736                   }
737 
738 		  mtx_return($1);
739 
740 		  memset(&fmain, 0, sizeof(fmain));
741 		  fmain.name = "main";
742 		  fmain.rettype = return_type = $1->gen.datatype;
743 		  function = &fmain;
744 
745                   if (optimize() == 0) {
746                           codegen();
747                           if (errcnt) {
748                                   YYERROR;
749                           }
750                   }
751           }
752         ;
753 
754 dcllist : decl
755         | dcllist decl
756         | dcllist error
757           {
758                   /* Roll back all changes done so far */
759                   var_unwind_all();
760                   loop_unwind_all();
761                   frame_unwind_all();
762                   mtx_unwind_all();
763                   function_delete();
764                   /* Synchronize input after error */
765                   yysync();
766                   /* Clear input and error condition */
767                   yyclearin;
768                   yyerrok;
769                   errcnt = 0;
770           }
771         ;
772 
773 decl    : fundecl begin list end
774           {
775                   if (errcnt) {
776                           function_delete();
777                           YYERROR;
778                   }
779 
780                   if (optimize() == 0) {
781                           codegen();
782                           if (errcnt) {
783                                   function_delete();
784                                   YYERROR;
785                           }
786                   } else {
787                           function_delete();
788                   }
789 
790                   /* clean up things */
791                   var_unwind_all();
792                   loop_unwind_all();
793                   frame_unwind_all();
794                   mtx_unwind_all();
795                   function_cleanup();
796           }
797         ;
798 
799 fundecl : TYPE IDENT dclparm
800           {
801                   VAR *var;
802                   PARAMETER *last, *parm;
803                   FUNCTION f;
804 
805                   if (errcnt)
806                           YYERROR;
807 
808                   memset(&f, 0, sizeof(f));
809                   f.name    = $2;
810                   f.rettype = $1;
811                   f.entry   = 0;
812                   f.loc     = locus;
813 
814                   f.nparm   = 0;
815                   f.parm    = NULL;
816 
817                   /* Count number of parameters */
818                   for (var = $3; var; var = var->next)
819                           f.nparm++;
820 
821                   f.parm = last = NULL;
822                   for (var = $3; var; var = var->next) {
823                           parm = grad_emalloc(sizeof(*parm));
824                           parm->datatype = var->datatype;
825                           var->offset = -(STACK_BASE+
826                                           f.nparm - var->offset);
827                           parm->offset   = var->offset;
828                           parm->prev     = last;
829                           parm->next     = NULL;
830                           if (f.parm == NULL)
831                                   f.parm = parm;
832                           else
833                                   last->next = parm;
834                           last = parm;
835                   }
836                   function = function_install(&f);
837           }
838         | TYPE FUN dclparm
839           {
840 		  grad_log_loc(GRAD_LOG_ERR, &locus,
841 			       _("redefinition of function `%s'"), $2->name);
842 		  grad_log_loc(GRAD_LOG_ERR, &$2->loc,
843 			       _("previously defined here"));
844 		  errcnt++;
845 		  YYERROR;
846           }
847         ;
848 
849 begin   : obrace
850         | obrace autodcl
851         ;
852 
853 end     : cbrace
854         ;
855 
856 obrace  : '{'
857           {
858                   frame_push();
859           }
860         ;
861 
862 cbrace  : '}'
863           {
864                   var_unwind_level();
865                   frame_pop();
866           }
867         ;
868 
869 /*
870  * Automatic variables
871  */
872 
873 autodcl : autovar
874         | autodcl autovar
875         ;
876 
877 autovar : TYPE varlist ';'
878           {
879                   var_type($1, $2);
880           }
881         ;
882 
883 varlist : IDENT
884           {
885                   $$ = var_alloc(Undefined, $1, +1);
886                   $$->dcllink = NULL;
887           }
888         | varlist ',' IDENT
889           {
890                   VAR *var = var_alloc(Undefined, $3, +1);
891                   var->dcllink = $1;
892                   $$ = var;
893           }
894         ;
895 
896 /*
897  * Function Parameters
898  */
899 dclparm : '(' ')'
900           {
901                   $$ = NULL;
902           }
903         | '(' parmlist ')'
904           {
905                   $$ = $2;
906           }
907         ;
908 
909 parmlist: parm
910           {
911                   /*FIXME*/
912                   /*$$->dcllink = NULL;*/
913           }
914         | parmlist ',' parm
915           {
916                   /*$1->dcllink = $3;*/
917                   $$ = $1;
918           }
919         ;
920 
921 parm    : TYPE IDENT
922           {
923                   $$ = var_alloc($1, $2, +1);
924           }
925         ;
926 
927 /* Argument lists
928  */
929 
930 args    : /* empty */
931           {
932                   $$ = NULL;
933           }
934         | arglist
935           {
936                   $$ = $1.arg_first;
937           }
938         ;
939 
940 arglist : arg
941           {
942                   $1->gen.arglink = NULL;
943                   $$.arg_first = $$.arg_last = $1;
944           }
945         | arglist ',' arg
946           {
947                   $1.arg_last->gen.arglink = $3;
948                   $1.arg_last = $3;
949                   $$ = $1;
950           }
951         ;
952 
953 arg     : expr
954         ;
955 
956 /*
957  * Statement list and individual statements
958  */
959 list    : stmt
960         | list stmt
961         ;
962 
963 stmt    : begin list end
964           {
965                   $$ = $2;
966           }
967         | expr ';'
968           {
969                   mtx_stop();
970                   mtx_pop();
971           }
972         | IF cond stmt
973           {
974                   $2->cond.if_false = mtx_nop();
975                   $$ = mtx_cur();
976           }
977         | IF cond stmt else stmt
978           {
979                   mtx_stop();
980                   $2->cond.if_false = $4;
981                   $4->nop.prev->jump.dest = mtx_nop();
982                   $$ = mtx_cur();
983           }
984         | RETURN expr ';'
985           {
986                   /*mtx_stop();*/
987                   $$ = mtx_return($2);
988           }
989         | while cond stmt
990           {
991                   MTX *mtx;
992 
993                   mtx_stop();
994                   mtx = mtx_jump();
995                   mtx->jump.dest = $1;
996                   $2->cond.if_false = mtx_nop();
997                   $$ = mtx_cur();
998 
999                   /* Fixup possible breaks */
1000                   loop_fixup(loop_last->lp_break, $$);
1001                   /* Fixup possible continues */
1002                   loop_fixup(loop_last->lp_cont, $1);
1003                   loop_pop();
1004           }
1005         | do stmt { $<mtx>$ = mtx_nop(); } WHILE cond ';'
1006           {
1007                   /* Default cond rule sets if_true to the next NOP matrix
1008                    * Invert this behaviour.
1009                    */
1010                   $5->cond.if_false = $5->cond.if_true;
1011                   $5->cond.if_true = $1;
1012                   $$ = mtx_cur();
1013 
1014                   /* Fixup possible breaks */
1015                   loop_fixup(loop_last->lp_break, $$);
1016                   /* Fixup possible continues */
1017                   loop_fixup(loop_last->lp_cont, $<mtx>3);
1018                   loop_pop();
1019           }
1020 /* ***********************
1021    For future use:
1022         | FOR '(' for_expr for_expr for_expr ')' stmt
1023    *********************** */
1024         | BREAK ';'
1025           {
1026                   if (!loop_last) {
1027                           grad_log_loc(GRAD_LOG_ERR, &locus,
1028 				       "%s",
1029 				       _("nothing to break from"));
1030                           errcnt++;
1031                           YYERROR;
1032                   }
1033 
1034                   $$ = mtx_jump();
1035                   $$->jump.link = (MTX*)loop_last->lp_break;
1036                   loop_last->lp_break = (JUMP_MTX*)$$;
1037           }
1038         | CONTINUE ';'
1039           {
1040                   if (!loop_last) {
1041                           grad_log_loc(GRAD_LOG_ERR, &locus,
1042 				       "%s",
1043 				       _("nothing to continue"));
1044                           errcnt++;
1045                           YYERROR;
1046                   }
1047                   $$ = mtx_jump();
1048                   $$->jump.link = (MTX*)loop_last->lp_cont;
1049                   loop_last->lp_cont = (JUMP_MTX*)$$;
1050           }
1051         | DELETE ATTR ';'
1052           {
1053 		  $$ = mtx_attr_delete($2, NULL);
1054 	  }
1055 	| DELETE ATTR '(' expr ')' ';'
1056           {
1057 		  $$ = mtx_attr_delete($2, $4);
1058 	  }
1059         ;
1060 
1061 while   : WHILE
1062           {
1063                   $$ = mtx_nop();
1064                   loop_push($$);
1065           }
1066         ;
1067 
1068 do      : DO
1069           {
1070                   $$ = mtx_nop();
1071                   loop_push($$);
1072           }
1073         ;
1074 
1075 else    : ELSE
1076           {
1077                   mtx_stop();
1078                   mtx_jump();
1079                   $$ = mtx_nop();
1080           }
1081         ;
1082 
1083 cond    : '(' expr ')'
1084           {
1085                   mtx_stop();
1086                   $$ = mtx_cond($2, NULL, NULL);
1087                   $$->cond.if_true = mtx_nop();
1088           }
1089         ;
1090 
1091 /*
1092  * Expressions
1093  */
1094 expr    : NUMBER
1095           {
1096 		  grad_value_t val;
1097 		  val.type = Integer;
1098 		  val.datum.ival = $1;
1099                   $$ = mtx_const(&val);
1100           }
1101         | STRING
1102           {
1103 		  grad_value_t val;
1104 		  val.type = String;
1105 		  val.datum.sval.size = strlen($1);
1106 		  val.datum.sval.data = $1;
1107                   $$ = mtx_const(&val);
1108           }
1109         | REFERENCE
1110           {
1111                   $$ = mtx_ref($1);
1112           }
1113         | VARIABLE
1114           {
1115                   $$ = mtx_var($1);
1116           }
1117         | IDENT
1118           {
1119                   grad_log_loc(GRAD_LOG_ERR, &locus, _("undefined variable: %s"), $1);
1120                   errcnt++;
1121                   YYERROR;
1122           }
1123         | VARIABLE '=' expr
1124           {
1125                   $$ = mtx_asgn($1, $3);
1126           }
1127         | ATTR
1128           {
1129                   $$ = mtx_attr($1, NULL);
1130           }
1131         | ATTR '(' expr ')'
1132           {
1133                   $$ = mtx_attr($1, $3);
1134           }
1135         | '*' ATTR
1136           {
1137                   $$ = mtx_attr_check($2, NULL);
1138           }
1139         | '*' ATTR '(' expr ')'
1140           {
1141 		  $$ = mtx_attr_check($2, $4);
1142 	  }
1143         | ATTR '=' expr
1144           {
1145                   $$ = mtx_attr_asgn($1, NULL, $3);
1146           }
1147         | ATTR '(' expr ')' '=' expr
1148           {
1149                   $$ = mtx_attr_asgn($1, $3, $6);
1150           }
1151         | FUN '(' args ')'
1152           {
1153                   $$ = mtx_call($1, $3);
1154           }
1155         | BUILTIN '(' args ')'
1156           {
1157                   $$ = mtx_builtin($1, $3);
1158           }
1159         | expr '+' expr
1160           {
1161                   $$ = mtx_bin(Add, $1, $3);
1162           }
1163         | expr '-' expr
1164           {
1165                   $$ = mtx_bin(Sub, $1, $3);
1166           }
1167         | expr '*' expr
1168           {
1169                   $$ = mtx_bin(Mul, $1, $3);
1170           }
1171         | expr '/' expr
1172           {
1173                   $$ = mtx_bin(Div, $1, $3);
1174           }
1175         | expr '%' expr
1176           {
1177                   $$ = mtx_bin(Rem, $1, $3);
1178           }
1179         | expr '|' expr
1180           {
1181                   $$ = mtx_bin(BOr, $1, $3);
1182           }
1183         | expr '&' expr
1184           {
1185                   $$ = mtx_bin(BAnd, $1, $3);
1186           }
1187         | expr '^' expr
1188           {
1189                   $$ = mtx_bin(BXor, $1, $3);
1190           }
1191         | expr SHL expr
1192           {
1193                   $$ = mtx_bin(Shl, $1, $3);
1194           }
1195         | expr SHR expr
1196           {
1197                   $$ = mtx_bin(Shr, $1, $3);
1198           }
1199         | expr AND expr
1200           {
1201                   $$ = mtx_bin(And, $1, $3);
1202           }
1203         | expr OR expr
1204           {
1205                   $$ = mtx_bin(Or, $1, $3);
1206           }
1207         | '-' expr %prec UMINUS
1208           {
1209                   $$ = mtx_un(Neg, $2);
1210           }
1211         | '+' expr %prec UMINUS
1212           {
1213                   $$ = $2;
1214           }
1215         | NOT expr
1216           {
1217                   $$ = mtx_un(Not, $2);
1218           }
1219         | '(' expr ')'
1220           {
1221                   $$ = $2;
1222           }
1223         | '(' TYPE ')' expr %prec TYPECAST
1224           {
1225                   $$ = mtx_coerce($2, $4);
1226           }
1227         | expr EQ expr
1228           {
1229                   $$ = mtx_bin(Eq, $1, $3);
1230           }
1231         | expr NE expr
1232           {
1233                   $$ = mtx_bin(Ne, $1, $3);
1234           }
1235         | expr LT expr
1236           {
1237                   $$ = mtx_bin(Lt, $1, $3);
1238           }
1239         | expr LE expr
1240           {
1241                   $$ = mtx_bin(Le, $1, $3);
1242           }
1243         | expr GT expr
1244           {
1245                   $$ = mtx_bin(Gt, $1, $3);
1246           }
1247         | expr GE expr
1248           {
1249                   $$ = mtx_bin(Ge, $1, $3);
1250           }
1251         | expr MT STRING
1252           {
1253                   COMP_REGEX *rx;
1254                   if ((rx = compile_regexp($3)) == NULL) {
1255                           errcnt++;
1256                           YYERROR;
1257                   }
1258                   $$ = mtx_match(0, $1, rx);
1259           }
1260         | expr NM STRING
1261           {
1262                   COMP_REGEX *rx;
1263                   if ((rx = compile_regexp($3)) == NULL) {
1264                           errcnt++;
1265                           YYERROR;
1266                   }
1267                   $$ = mtx_match(1, $1, rx);
1268           }
1269         ;
1270 
1271 %%
1272 
1273 int
1274 yyerror(char *s)
1275 {
1276         grad_log_loc(GRAD_LOG_ERR, &locus, "%s", s);
1277         errcnt++;
1278 	return 0;
1279 }
1280 
1281 
1282 /* **************************************************************************
1283  * Interface functions
1284  */
1285 int
1286 parse_rewrite(char *path)
1287 {
1288         locus.file = path;
1289         infile = fopen(locus.file, "r");
1290         if (!infile) {
1291                 if (errno != ENOENT) {
1292                         grad_log(GRAD_LOG_ERR|GRAD_LOG_PERROR,
1293                                  _("can't open file `%s'"),
1294                                  locus.file);
1295 			return -1;
1296                 }
1297                 return -2;
1298         }
1299 
1300 	GRAD_DEBUG1(1, "Loading file %s", locus.file);
1301         rw_code_lock();
1302         yyeof = 0;
1303         locus.line = 1;
1304 	errcnt = 0;
1305         regex_init();
1306         obstack_init(&input_stk);
1307 
1308         mtx_init();
1309         var_init();
1310         loop_init();
1311         frame_init();
1312 
1313         frame_push();
1314 
1315         yyparse();
1316 
1317         var_free_all();
1318         frame_free_all();
1319         mtx_free_all();
1320 
1321         fclose(infile);
1322         obstack_free(&input_stk, NULL);
1323         rw_code_unlock();
1324         return errcnt;
1325 }
1326 
1327 static int
1328 parse_rewrite_string(char *str)
1329 {
1330         rw_code_lock();
1331 	code_check();
1332         yyeof = 0;
1333 	locus.file = "<string>";
1334 	locus.line = 1;
1335 	errcnt = 0;
1336         regex_init();
1337         obstack_init(&input_stk);
1338 
1339         mtx_init();
1340         var_init();
1341         loop_init();
1342         frame_init();
1343 
1344         frame_push();
1345 
1346         if (GRAD_DEBUG_LEVEL(50))
1347                 yydebug++;
1348 
1349 	infile = 0;
1350 	inbuf = curp = str;
1351 
1352         yyparse();
1353 
1354 #if defined(MAINTAINER_MODE)
1355         if (GRAD_DEBUG_LEVEL(100))
1356                 debug_dump_code();
1357 #endif
1358 
1359         var_free_all();
1360         frame_free_all();
1361         mtx_free_all();
1362 
1363         obstack_free(&input_stk, NULL);
1364         rw_code_unlock();
1365         return errcnt;
1366 }
1367 
1368 
1369 /* **************************************************************************
1370  * Lexical analyzer stuff: too simple to be written in lex.
1371  */
1372 static int
1373 unput(int c)
1374 {
1375 	if (!c)
1376 		return 0;
1377 	if (infile)
1378 		ungetc(c, infile);
1379 	else if (curp > inbuf)
1380 		*--curp = c;
1381 	return c;
1382 }
1383 
1384 static int
1385 input()
1386 {
1387         if (yyeof)
1388                 yychar = 0;
1389 	else if (infile) {
1390 		if ((yychar = getc(infile)) <= 0) {
1391 			yyeof++;
1392 			yychar = 0;
1393 		}
1394 	} else if (curp) {
1395 		yychar = *curp++;
1396 		if (!yychar)
1397 			yyeof++;
1398 	}
1399         return yychar;
1400 }
1401 
1402 static int  rw_backslash();
1403 static int  c2d(int c);
1404 static int  read_number();
1405 static int  read_num(int n, int base);
1406 static char *read_string();
1407 static char *read_ident(int c);
1408 static char *read_to_delim(int c);
1409 static int  skip_to_nl();
1410 static int c_comment();
1411 
1412 /*
1413  * Convert a character to digit. Only octal, decimal and hex digits are
1414  * allowed. If any other character is input, c2d() returns 100, which is
1415  * greater than any number base allowed.
1416  */
1417 int
1418 c2d(int c)
1419 {
1420         switch (c) {
1421         case '0':
1422         case '1':
1423         case '2':
1424         case '3':
1425         case '4':
1426         case '5':
1427         case '6':
1428         case '7':
1429         case '8':
1430         case '9':
1431                 return c - '0';
1432         case 'A':
1433         case 'B':
1434         case 'C':
1435         case 'D':
1436         case 'E':
1437         case 'F':
1438                 return c - 'A' + 16;
1439         case 'a':
1440         case 'b':
1441         case 'c':
1442         case 'd':
1443         case 'e':
1444         case 'f':
1445                 return c - 'a' + 10;
1446         }
1447         return 100;
1448 }
1449 
1450 /*
1451  * Read a number. Usual C conventions apply.
1452  */
1453 int
1454 read_number()
1455 {
1456         int c;
1457         int base;
1458 	int res;
1459 
1460         c = yychar;
1461         if (c == '0') {
1462                 if (input() == 'x' || yychar == 'X') {
1463                         base = 16;
1464                 } else {
1465                         base = 8;
1466                         unput(yychar);
1467                 }
1468         } else
1469                 base = 10;
1470 
1471 	res = read_num(c2d(c), base);
1472 	if (base == 10 && yychar == '.') {
1473 		int n;
1474 
1475 		for (n = 0; n < 3 && yychar == '.'; n++) {
1476 			int val;
1477 
1478 			input();
1479 			val = read_num(0, base);
1480 			res = (res << 8) + val;
1481 		}
1482 		if (n != 3)
1483 			res <<= 8 * (3-n);
1484 	}
1485 	return res;
1486 }
1487 
1488 int
1489 read_num(int n, int base)
1490 {
1491         int d;
1492 
1493         while (input() && (d = c2d(yychar)) < 16)
1494                 n = n*base + d;
1495         unput(yychar);
1496         return n;
1497 }
1498 
1499 int
1500 rw_backslash()
1501 {
1502         switch (input()) {
1503         case '\\':
1504                 return '\\';
1505         case 'a':
1506                 return '\a';
1507         case 'b':
1508                 return '\b';
1509         case 'f':
1510                 return '\f';
1511         case 'n':
1512                 return '\n';
1513         case 'r':
1514                 return '\r';
1515         case 't':
1516                 return '\t';
1517         case 'e':
1518                 return '\033';
1519         case '0':
1520                 return read_number();
1521         case 'x':
1522         case 'X':
1523                 return read_num(0, 16);
1524         case '(':
1525         case ')':
1526                 /* Preserve regular expressions */
1527                 unput(yychar);
1528                 yychar = '\\';
1529         }
1530         return yychar;
1531 }
1532 
1533 /*
1534  * Read a string up to the closing doublequote
1535  */
1536 char *
1537 read_string()
1538 {
1539         while (input() && yychar != '"') {
1540                 if (yychar == '\\')
1541                         yychar = rw_backslash();
1542                 obstack_1grow(&input_stk, yychar);
1543         }
1544         obstack_1grow(&input_stk, 0);
1545         return obstack_finish(&input_stk);
1546 }
1547 
1548 /*
1549  * Read everything up to the given delimiter
1550  */
1551 char *
1552 read_to_delim(int c)
1553 {
1554         while (input() && yychar != c)
1555                 obstack_1grow(&input_stk, yychar);
1556         obstack_1grow(&input_stk, 0);
1557         return obstack_finish(&input_stk);
1558 }
1559 
1560 /*
1561  * Is `c' a part of the word?
1562  */
1563 #define isword(c) (isalnum(c) || c == '_' || c == '$')
1564 
1565 /*
1566  * Is `c' a whitespace character?
1567  */
1568 #define isws(c) ((c) == ' ' || (c) == '\t')
1569 
1570 /*
1571  * Read identifier
1572  */
1573 char *
1574 read_ident(int c)
1575 {
1576         obstack_1grow(&input_stk, c);
1577         while (input() && isword(yychar))
1578                 obstack_1grow(&input_stk, yychar);
1579         obstack_1grow(&input_stk, 0);
1580         unput(yychar);
1581         return obstack_finish(&input_stk);
1582 }
1583 
1584 /*
1585  * Skip input up to the next newline
1586  */
1587 int
1588 skip_to_nl()
1589 {
1590         while (input() && yychar != '\n')
1591                 ;
1592         return unput(yychar);
1593 }
1594 
1595 /*
1596  * Skip a C-style comment
1597  */
1598 int
1599 c_comment()
1600 {
1601         if (yychar != '/')
1602                 return 0;
1603         if (input() == '*') {
1604                 size_t keep_line = locus.line;
1605 
1606                 do {
1607                         while (input() != '*') {
1608                                 if (yychar == 0) {
1609                                         grad_log_loc(GRAD_LOG_ERR, &locus,
1610 		       _("unexpected EOF in comment started at line %lu"),
1611 						     (unsigned long) keep_line);
1612                                         return 0;
1613                                 } else if (yychar == '\n')
1614                                         locus.line++;
1615                         }
1616                 } while (input() != '/');
1617                 return 1;
1618         }
1619         unput(yychar);
1620         yychar = '/';
1621         return 0;
1622 }
1623 
1624 
1625 /* Pragmatic comments */
1626 enum pragma_handler_phase {
1627 	pragma_begin,
1628 	pragma_cont,
1629 	pragma_error,
1630 	pragma_end
1631 };
1632 
1633 typedef int (*pragma_handler_fp) (enum pragma_handler_phase);
1634 
1635 static int
1636 regex_pragma (enum pragma_handler_phase phase)
1637 {
1638 	int disable = 0;
1639 	int bit;
1640 	char *s;
1641 	static int regexp_accum;
1642 
1643 	switch (phase) {
1644 	case pragma_begin:
1645 		regexp_accum = 0;
1646 		return 0;
1647 
1648 	case pragma_end:
1649 		regcomp_flags = regexp_accum;
1650 		return 0;
1651 
1652 	case pragma_error:
1653 		return 0;
1654 
1655 	case pragma_cont:
1656 		break;
1657 	}
1658 
1659 	switch (yychar) {
1660 	case '+':
1661 		disable = 0;
1662 		input();
1663 		break;
1664 
1665 	case '-':
1666 		disable = 1;
1667 		input();
1668 		break;
1669 	}
1670 	if (!isword(yychar)) {
1671 		grad_log_loc(GRAD_LOG_ERR, &locus, _("Malformed pragma"));
1672 		return 1;
1673 	}
1674 
1675 	s = read_ident(yychar);
1676 
1677 	if (strcmp (s, "extended") == 0)
1678 		bit = REG_EXTENDED;
1679 	else if (strcmp (s, "icase") == 0)
1680 		bit = REG_ICASE;
1681 	else if (strcmp (s, "newline") == 0)
1682 		bit = REG_NEWLINE;
1683 	else {
1684 		grad_log_loc(GRAD_LOG_ERR, &locus,
1685 			     _("Unknown regexp flag: %s"), s);
1686 		return 1;
1687 	}
1688 
1689 	if (disable)
1690 		regexp_accum &= ~bit;
1691 	else
1692 		regexp_accum |= bit;
1693 	return 0;
1694 }
1695 
1696 static pragma_handler_fp
1697 find_pragma_handler(char *s)
1698 {
1699 	if (strcmp(s, "regex") == 0)
1700 		return regex_pragma;
1701 	return NULL;
1702 }
1703 
1704 static void
1705 handle_pragma()
1706 {
1707 	int rc;
1708 	pragma_handler_fp pragma_handler;
1709 
1710 	while (input() && isws(yychar))
1711 		;
1712 	if (yychar == 0)
1713 		return;
1714 
1715 	pragma_handler = find_pragma_handler (read_ident(yychar));
1716 
1717 	if (pragma_handler) {
1718 		pragma_handler(pragma_begin);
1719 
1720 		do {
1721 			while (input() && isws(yychar))
1722 				;
1723 			if (yychar == 0 || yychar == '\n')
1724 				break;
1725 			rc = pragma_handler(pragma_cont);
1726 		} while (rc == 0 && yychar != '\n' && yychar != 0);
1727 
1728 		pragma_handler(rc ? pragma_error : pragma_end);
1729 	}
1730 }
1731 
1732 
1733 
1734 
1735 /* Parse a 'sharp' (single-line) comment */
1736 void
1737 sharp_comment()
1738 {
1739 	while (input() && isws(yychar))
1740 		;
1741 	if (yychar == 0)
1742 		return;
1743 	else if (yychar == '\n') {
1744 		locus.line++;
1745 		return;
1746 	} else if (isword(yychar)) {
1747 		if (strcmp(read_ident(yychar), "pragma") == 0)
1748 			handle_pragma();
1749 	}
1750 
1751 	skip_to_nl();
1752 }
1753 
1754 
1755 #if defined(MAINTAINER_MODE)
1756 # define DEBUG_LEX1(s) if (GRAD_DEBUG_LEVEL(60)) printf("yylex: " s "\n")
1757 # define DEBUG_LEX2(s,v) if (GRAD_DEBUG_LEVEL(60)) printf("yylex: " s "\n", v)
1758 #else
1759 # define DEBUG_LEX1(s)
1760 # define DEBUG_LEX2(s,v)
1761 #endif
1762 
1763 static grad_keyword_t rw_kw[] = {
1764         { "if",       IF },
1765         { "else",     ELSE },
1766         { "return",   RETURN },
1767         { "for",      FOR },
1768         { "do",       DO },
1769         { "while",    WHILE },
1770         { "break",    BREAK },
1771         { "continue", CONTINUE },
1772 	{ "delete",   DELETE },
1773         { NULL }
1774 };
1775 
1776 int
1777 yylex()
1778 {
1779         int nl;
1780         int c;
1781         VAR *var;
1782         FUNCTION *fun;
1783         builtin_t *btin;
1784 
1785         /* Skip whitespace and comment lines */
1786         do {
1787                 nl = 0;
1788                 while (input() && isspace(yychar))
1789                         if (yychar == '\n')
1790                                 locus.line++;
1791 
1792                 if (!yychar)
1793                         return 0;
1794 
1795                 if (yychar == '#') {
1796                         sharp_comment();
1797                         nl = 1;
1798                 }
1799         } while (nl || c_comment());
1800 
1801         /*
1802          * A regexp reference
1803          */
1804         if (yychar == '\\') {
1805                 input();
1806                 yylval.number = read_number();
1807                 DEBUG_LEX2("REFERENCE %d", yylval.number);
1808                 return REFERENCE;
1809         }
1810 
1811         /*
1812          * A character
1813          */
1814         if (yychar == '\'') {
1815                 if (input() == '\\')
1816                         c = rw_backslash();
1817                 else
1818                         c = yychar;
1819                 if (input() != '\'') {
1820                         grad_log_loc(GRAD_LOG_ERR, &locus,
1821 				     "%s",
1822 				     _("unterminated character constant"));
1823                         errcnt++;
1824                 }
1825                 yylval.number = c;
1826                 DEBUG_LEX2("CHAR %d", c);
1827                 return NUMBER;
1828         }
1829 
1830         /*
1831          * A number
1832          */
1833         if (isdigit(yychar)) {
1834                 yylval.number = read_number();
1835                 DEBUG_LEX2("NUMBER %d", yylval.number);
1836                 return NUMBER;
1837         }
1838 
1839         /*
1840          * Quoted string
1841          */
1842         if (yychar == '"') {
1843                 yylval.string = read_string();
1844                 DEBUG_LEX2("STRING %s", yylval.string);
1845                 return STRING;
1846         }
1847 
1848         /* A/V  pair reference.
1849            We do not allow %<number> sequences, since it would result
1850            in conflict with binary '%' operator.
1851            Thanks to Clement Gerouville for noticing.  */
1852         if (yychar == '%') {
1853                 grad_dict_attr_t *attr = 0;
1854                 char *attr_name;
1855 
1856                 input();
1857                 if (yychar == '[' || yychar == '{') {
1858                         attr_name = read_to_delim(yychar == '[' ? ']' : '}');
1859                         attr = grad_attr_name_to_dict(attr_name);
1860                 } else {
1861                         unput(yychar);
1862                         return '%';
1863                 }
1864                 if (!attr) {
1865                         grad_log_loc(GRAD_LOG_ERR, &locus,
1866 				     _("unknown attribute `%s'"),
1867 				     attr_name);
1868                         errcnt++;
1869                         return BOGUS;
1870                 }
1871                 yylval.attr = attr;
1872                 DEBUG_LEX2("ATTR: %s", attr->name);
1873                 return ATTR;
1874         }
1875 
1876 
1877         /*
1878          * Data type or identifier
1879          */
1880         if (isword(yychar)) {
1881                 yylval.string = read_ident(yychar);
1882 
1883                 if (strcmp(yylval.string, "integer") == 0) {
1884                         DEBUG_LEX1("TYPE(Integer)");
1885                         yylval.type = Integer;
1886                         return TYPE;
1887                 } else if (strcmp(yylval.string, "string") == 0) {
1888                         DEBUG_LEX1("TYPE(String)");
1889                         yylval.type = String;
1890                         return TYPE;
1891 		}
1892 
1893                 if ((c = grad_xlat_keyword(rw_kw, yylval.string, 0)) != 0) {
1894                         DEBUG_LEX2("KW: %s", yylval.string);
1895                         return c;
1896                 }
1897 
1898                 if (var = var_lookup(yylval.string)) {
1899                         DEBUG_LEX2("VARIABLE: %s", yylval.string);
1900                         yylval.var = var;
1901                         return VARIABLE;
1902                 }
1903 
1904                 if (fun = (FUNCTION*) grad_sym_lookup(rewrite_tab, yylval.string)) {
1905                         DEBUG_LEX2("FUN %s", yylval.string);
1906                         yylval.fun = fun;
1907                         return FUN;
1908                 }
1909 
1910                 if (btin = builtin_lookup(yylval.string)) {
1911                         DEBUG_LEX2("BUILTIN %s", yylval.string);
1912                         yylval.btin = btin;
1913                         return BUILTIN;
1914                 }
1915                 DEBUG_LEX2("IDENT: %s", yylval.string);
1916                 return IDENT;
1917         }
1918 
1919         /*
1920          * Boolean expressions
1921          */
1922         if (yychar == '&' || yychar == '|') {
1923                 int c = yychar;
1924 
1925                 if (input() == c) {
1926                         DEBUG_LEX2("%s", yychar == '&' ? "AND" : "OR");
1927                         return yychar == '&' ? AND : OR;
1928                 }
1929                 unput(yychar);
1930 
1931                 DEBUG_LEX2("%c", c);
1932                 return c;
1933         }
1934 
1935         /*
1936          * Comparison operator
1937          */
1938         if (strchr("<>=!", yychar)) {
1939                 int c = yychar;
1940                 if (input() == '=') {
1941                         switch (c) {
1942                         case '<':
1943                                 DEBUG_LEX1("LE");
1944                                 return LE;
1945                         case '>':
1946                                 DEBUG_LEX1("GE");
1947                                 return GE;
1948                         case '=':
1949                                 DEBUG_LEX1("EQ");
1950                                 return EQ;
1951                         case '!':
1952                                 DEBUG_LEX1("NE");
1953                                 return NE;
1954                         }
1955                 } else if (c == yychar) {
1956                         if (c == '<') {
1957                                 DEBUG_LEX1("SHL");
1958                                 return SHL;
1959                         }
1960                         if (c == '>') {
1961                                 DEBUG_LEX1("SHR");
1962                                 return SHR;
1963                         }
1964                         unput(yychar);
1965                         DEBUG_LEX2("%c", yychar);
1966                         return yychar;
1967                 } else if (yychar == '~') {
1968                         if (c == '=') {
1969                                 DEBUG_LEX1("MT");
1970                                 return MT;
1971                         }
1972                         if (c == '!') {
1973                                 DEBUG_LEX1("NM");
1974                                 return NM;
1975                         }
1976                 }
1977                 unput(yychar);
1978                 switch (c) {
1979                 case '<':
1980                         DEBUG_LEX1("LT");
1981                         return LT;
1982                 case '>':
1983                         DEBUG_LEX1("GT");
1984                         return GT;
1985                 case '!':
1986                         DEBUG_LEX1("NOT");
1987                         return NOT;
1988                 default:
1989                         return c;
1990                 }
1991         }
1992 
1993         DEBUG_LEX2("%c", yychar);
1994         return yychar;
1995 }
1996 
1997 void
1998 yysync()
1999 {
2000         while (skip_to_nl() == '\n' && !isalpha(input()))
2001                 locus.line++;
2002         unput(yychar);
2003 }
2004 
2005 
2006 /* ****************************************************************************
2007  * Generalized list functions
2008  */
2009 static RWLIST *_list_insert(RWLIST **first, RWLIST **last, RWLIST *prev,
2010 			    RWLIST *obj, int before);
2011 static RWLIST *_list_remove(RWLIST **first, RWLIST **last, RWLIST *obj);
2012 static RWLIST *_list_append(RWLIST **first, RWLIST **last, RWLIST *obj);
2013 
2014 #define rw_list_insert(first, last, prev, obj, before) \
2015  _list_insert((RWLIST**)first,(RWLIST**)last,(RWLIST*)prev,(RWLIST*)obj, before)
2016 #define rw_list_remove(first, last, obj) \
2017  _list_remove((RWLIST**)first,(RWLIST**)last,(RWLIST *)obj)
2018 #define rw_list_append(first, last, obj) \
2019  _list_append((RWLIST**)first, (RWLIST**)last, (RWLIST*)obj)
2020 
2021 RWLIST *
2022 _list_append(RWLIST **first, RWLIST **last, RWLIST *obj)
2023 {
2024         return rw_list_insert(first, last, *last, obj, 0);
2025 }
2026 
2027 RWLIST *
2028 _list_insert(RWLIST **first, RWLIST **last, RWLIST *prev, RWLIST *obj,
2029 	     int before)
2030 {
2031         RWLIST   *next;
2032 
2033         /*
2034          * No first element: initialize whole list
2035          */
2036         if (!*first) {
2037                 *first = obj;
2038                 if (last)
2039                         *last = obj;
2040                 obj->prev = obj->next = NULL;
2041                 return obj;
2042         }
2043 
2044         /*
2045          * Insert before `prev'
2046          */
2047         if (before) {
2048                 _list_insert(first, last, prev, obj, 0);
2049                 _list_remove(first, last, prev);
2050                 _list_insert(first, last, obj, prev, 0);
2051                 return obj;
2052         }
2053 
2054         /*
2055          * Default: insert after prev
2056          */
2057         obj->prev = prev;
2058         obj->next = prev->next;
2059 
2060         if (next = prev->next)
2061                 next->prev = obj;
2062 
2063         prev->next = obj;
2064         if (last && prev == *last)
2065                 *last = obj;
2066 
2067 
2068         return obj;
2069 }
2070 
2071 RWLIST *
2072 _list_remove(RWLIST **first, RWLIST **last, RWLIST *obj)
2073 {
2074         RWLIST *temp;
2075 
2076         if (temp = obj->prev)
2077                 temp->next = obj->next;
2078         else
2079                 *first = obj->next;
2080 
2081         if (temp = obj->next)
2082                 temp->prev = obj->prev;
2083         else if (last)
2084                 *last = obj->prev;
2085 
2086         obj->prev = obj->next = NULL;
2087 
2088         return obj;
2089 }
2090 
2091 
2092 /* ****************************************************************************
2093  * Generalized object handling
2094  */
2095 
2096 void *obj_alloc(OBUCKET *bucket);
2097 void obj_free_all(OBUCKET *bucket);
2098 
2099 
2100 void *
2101 obj_alloc(OBUCKET *bucket)
2102 {
2103         OBJECT *optr;
2104 
2105         optr = grad_emalloc(bucket->size);
2106 
2107         optr->alloc        = bucket->alloc_list;
2108         bucket->alloc_list = optr;
2109 
2110         return optr;
2111 }
2112 
2113 void
2114 obj_free_all(OBUCKET *bucket)
2115 {
2116         OBJECT *obj, *next;
2117 
2118         obj = bucket->alloc_list;
2119 
2120         while (obj) {
2121                 next = obj->alloc;
2122                 if (bucket->free)
2123                         bucket->free(obj);
2124                 grad_free(obj);
2125                 obj = next;
2126         }
2127         bucket->alloc_list = NULL;
2128 }
2129 
2130 
2131 /* **************************************************************************
2132  * Frames
2133  */
2134 
2135 void
2136 frame_init()
2137 {
2138         frame_bkt.alloc_list = NULL;
2139         frame_first = frame_last = NULL;
2140 }
2141 
2142 void
2143 frame_push()
2144 {
2145         FRAME *this_frame = obj_alloc(&frame_bkt);
2146 
2147         if (!frame_last) {
2148                 this_frame->level = 0;
2149                 this_frame->stack_offset = 0;
2150         } else {
2151                 if (frame_last->level == 0)
2152                         this_frame->stack_offset = 1;
2153                 else
2154                         this_frame->stack_offset = frame_last->stack_offset;
2155                 this_frame->level = frame_last->level + 1;
2156         }
2157         rw_list_append(&frame_first, &frame_last, this_frame);
2158 }
2159 
2160 void
2161 frame_pop()
2162 {
2163         rw_list_remove(&frame_first, &frame_last, frame_last);
2164 }
2165 
2166 void
2167 frame_update_alloc()
2168 {
2169         FRAME *this_frame = frame_last;
2170 
2171         if (this_frame->stack_offset > function->stack_alloc)
2172                 function->stack_alloc = this_frame->stack_offset;
2173 }
2174 
2175 void
2176 frame_free_all()
2177 {
2178         obj_free_all(&frame_bkt);
2179         frame_first = frame_last = NULL;
2180 }
2181 
2182 void
2183 frame_unwind_all()
2184 {
2185         while (frame_last)
2186                 rw_list_remove(&frame_first, &frame_last, frame_last);
2187         frame_push();
2188 }
2189 
2190 
2191 /* **************************************************************************
2192  * Loops
2193  */
2194 
2195 void
2196 loop_init()
2197 {
2198         loop_bkt.alloc_list = NULL;
2199         loop_first = loop_last = NULL;
2200 }
2201 
2202 void
2203 loop_free_all()
2204 {
2205         obj_free_all(&loop_bkt);
2206         loop_first = loop_last = NULL;
2207 }
2208 
2209 void
2210 loop_unwind_all()
2211 {
2212         loop_first = loop_last = NULL;
2213 }
2214 
2215 /*ARGSUSED*/
2216 void
2217 loop_push(MTX *mtx)
2218 {
2219         LOOP *this_loop = obj_alloc(&loop_bkt);
2220         rw_list_append(&loop_first, &loop_last, this_loop);
2221 }
2222 
2223 void
2224 loop_pop()
2225 {
2226         rw_list_remove(&loop_first, &loop_last, loop_last);
2227 }
2228 
2229 void
2230 loop_fixup(JUMP_MTX *list, MTX *target)
2231 {
2232         JUMP_MTX *jp;
2233 
2234         for (jp = list; jp; jp = (JUMP_MTX*)jp->link)
2235                 jp->dest = target;
2236 }
2237 
2238 
2239 /* **************************************************************************
2240  * Variables
2241  */
2242 OBUCKET var_bucket = { sizeof(VAR), NULL };
2243 
2244 void
2245 var_init()
2246 {
2247         var_bucket.alloc_list = NULL;
2248         var_first = var_last = NULL;
2249 }
2250 
2251 VAR *
2252 var_alloc(grad_data_type_t type, char *name, int grow)
2253 {
2254         VAR *var;
2255 
2256         var = (VAR*) obj_alloc(&var_bucket);
2257         rw_list_append(&var_first, &var_last, var);
2258 
2259         /* Initialize fields */
2260         var->name     = name;
2261         var->datatype = type;
2262         var->level    = curframe->level;
2263         var->offset   = curframe->stack_offset;
2264         curframe->stack_offset += grow;
2265 
2266         return var;
2267 }
2268 
2269 void
2270 var_unwind_level()
2271 {
2272         int cnt = 0;
2273 
2274         while (var_last && var_last->level == curframe->level) {
2275                 rw_list_remove(&var_first, &var_last, var_last);
2276                 cnt++;
2277         }
2278 
2279         if (cnt)
2280                 frame_update_alloc();
2281 }
2282 
2283 void
2284 var_unwind_all()
2285 {
2286         while (var_last)
2287                 rw_list_remove(&var_first, &var_last, var_last);
2288 }
2289 
2290 void
2291 var_type(grad_data_type_t type, VAR *var)
2292 {
2293         for (; var; var = var->dcllink)
2294                 var->datatype = type;
2295 }
2296 
2297 void
2298 var_free_all()
2299 {
2300         obj_free_all(&var_bucket);
2301         var_first = var_last = NULL;
2302 }
2303 
2304 VAR *
2305 var_lookup(char *name)
2306 {
2307         VAR *var;
2308 
2309         var = var_last;
2310         while (var && strcmp(var->name, name))
2311                 var = var->prev;
2312         return var;
2313 }
2314 
2315 
2316 /* **************************************************************************
2317  * Matrix generation
2318  */
2319 OBUCKET mtx_bucket = { sizeof(MTX), NULL };
2320 #if defined(MAINTAINER_MODE)
2321 int mtx_current_id ;
2322 #endif
2323 
2324 /*
2325  * Insert a matrix into list
2326  */
2327 #define mtx_remove(mtx) rw_list_remove(&mtx_first, &mtx_last, mtx)
2328 #define mtx_append(mtx) rw_list_append(&mtx_first, &mtx_last, mtx)
2329 
2330 void
2331 mtx_insert(MTX *prev, MTX *mtx)
2332 {
2333         MTX *up;
2334 
2335         rw_list_insert(&mtx_first, &mtx_last, prev, mtx, 0);
2336         if (up = prev->gen.uplink) {
2337                 switch (up->gen.type) {
2338                 case Unary:
2339                         up->un.arg = mtx;
2340                         break;
2341                 case Binary:
2342                         if (up->bin.arg[0] == prev)
2343                                 up->bin.arg[0] = mtx;
2344                         else
2345                                 up->bin.arg[1] = mtx;
2346                         break;
2347                 case Return:
2348                         up->ret.expr = mtx;
2349                         break;
2350                 default:
2351                         /*should not happen*/
2352                         break;
2353                 }
2354         }
2355 }
2356 
2357 void
2358 mtx_init()
2359 {
2360         mtx_bucket.alloc_list = NULL;
2361         mtx_first = mtx_last = NULL;
2362 }
2363 
2364 void
2365 mtx_unwind_all()
2366 {
2367         while (mtx_last)
2368                 rw_list_remove(&mtx_first, &mtx_last, mtx_last);
2369 }
2370 
2371 void
2372 mtx_free_all()
2373 {
2374         obj_free_all(&mtx_bucket);
2375         mtx_first = mtx_last = NULL;
2376 }
2377 
2378 MTX *
2379 mtx_cur()
2380 {
2381         return mtx_last;
2382 }
2383 
2384 MTX *
2385 mtx_frame(Mtxtype type, stkoff_t stksize)
2386 {
2387         FRAME_MTX *mtx = (FRAME_MTX *)mtx_alloc(type);
2388         mtx_append(mtx);
2389         mtx->stacksize = stksize;
2390         return (MTX*)mtx;
2391 }
2392 
2393 MTX *
2394 mtx_nop()
2395 {
2396         MTX *mtx = mtx_alloc(Nop);
2397         mtx_append(mtx);
2398         return mtx;
2399 }
2400 
2401 MTX *
2402 mtx_jump()
2403 {
2404         MTX *mtx = mtx_alloc(Jump);
2405         mtx_append(mtx);
2406         return mtx;
2407 }
2408 
2409 MTX *
2410 mtx_stop()
2411 {
2412         MTX *mtx = mtx_alloc(Stop);
2413         mtx_append(mtx);
2414         return mtx;
2415 }
2416 
2417 MTX *
2418 mtx_pop()
2419 {
2420         MTX *mtx = mtx_alloc(Pop);
2421         mtx_append(mtx);
2422         return mtx;
2423 }
2424 
2425 
2426 MTX *
2427 mtx_return(MTX *arg)
2428 {
2429         MTX *mtx = mtx_alloc(Return);
2430 
2431         mtx_append(mtx);
2432         mtx->ret.expr = arg;
2433         arg->gen.uplink = (MTX*)mtx;
2434         return (MTX*)mtx;
2435 }
2436 
2437 /*
2438  * Allocate a matrix of given type and append it to the list
2439  */
2440 MTX *
2441 mtx_alloc(Mtxtype type)
2442 {
2443         MTX *mtx = obj_alloc(&mtx_bucket);
2444 
2445         mtx->gen.type  = type;
2446         mtx->gen.loc   = locus;
2447 #if defined(MAINTAINER_MODE)
2448         mtx->gen.id    = mtx_current_id++;
2449 #endif
2450         return mtx;
2451 }
2452 
2453 /*
2454  * Create a Constant matrix
2455  */
2456 MTX *
2457 mtx_const(grad_value_t *val)
2458 {
2459         CONST_MTX *mtx = (CONST_MTX *)mtx_alloc(Constant);
2460 
2461         mtx_append(mtx);
2462         mtx->datatype = val->type;
2463 	mtx->datum = val->datum;
2464         return (MTX*)mtx;
2465 }
2466 
2467 /*
2468  * Create a Reference matrix
2469  */
2470 MTX *
2471 mtx_ref(int num)
2472 {
2473         MATCHREF_MTX *mtx = (MATCHREF_MTX*)mtx_alloc(Matchref);
2474         mtx_append(mtx);
2475         mtx->datatype = String;
2476         mtx->num = num;
2477         return (MTX*)mtx;
2478 }
2479 
2480 MTX *
2481 mtx_var(VAR *var)
2482 {
2483         VAR_MTX *mtx = (VAR_MTX*)mtx_alloc(Variable);
2484         mtx_append(mtx);
2485         mtx->datatype = var->datatype;
2486         mtx->var = var;
2487         return (MTX*)mtx;
2488 }
2489 
2490 MTX *
2491 mtx_asgn(VAR *var, MTX *arg)
2492 {
2493         ASGN_MTX *mtx = (ASGN_MTX*)mtx_alloc(Asgn);
2494 
2495         mtx_append(mtx);
2496         if (var->datatype != arg->gen.datatype)
2497                 coerce(arg, var->datatype);
2498         mtx->datatype = var->datatype;
2499         mtx->lval = var;
2500         mtx->arg  = arg;
2501         return (MTX*)mtx;
2502 }
2503 
2504 
2505 grad_data_type_t
2506 attr_datatype(grad_dict_attr_t *attr)
2507 {
2508         switch (attr->type) {
2509         case GRAD_TYPE_STRING:
2510 		/* FIXME: It could be a nice move to do
2511 
2512 		     (attr->prop & GRAD_AP_BINARY_STRING) ? Binstr : String;
2513 
2514 	           instead... */
2515 		return String;
2516         case GRAD_TYPE_DATE:
2517                 return String;
2518         case GRAD_TYPE_INTEGER:
2519         case GRAD_TYPE_IPADDR:
2520                 return Integer;
2521         default:
2522                 grad_insist_fail("unknown attribute type");
2523         }
2524         /*NOTREACHED*/
2525 }
2526 
2527 MTX *
2528 mtx_attr(grad_dict_attr_t *attr, MTX *index)
2529 {
2530         ATTR_MTX *mtx = (ATTR_MTX*)mtx_alloc(Attr);
2531         mtx_append(mtx);
2532         mtx->attrno   = attr->value;
2533         mtx->datatype = attr_datatype(attr);
2534 	mtx->index = index;
2535         return (MTX*)mtx;
2536 }
2537 
2538 MTX *
2539 mtx_attr_check(grad_dict_attr_t *attr,	MTX *index)
2540 {
2541         ATTR_MTX *mtx = (ATTR_MTX*)mtx_alloc(Attr_check);
2542         mtx_append(mtx);
2543         mtx->attrno   = attr->value;
2544         mtx->datatype = Integer;
2545 	mtx->index = index;
2546         return (MTX*)mtx;
2547 }
2548 
2549 
2550 void
2551 rw_coercion_warning(grad_data_type_t from, grad_data_type_t to, char *pref)
2552 {
2553 	grad_log_loc(GRAD_LOG_WARN, &locus,
2554 		     _("%s implicit coercion %s %s"),
2555 		     pref ? pref : "",
2556 		     datatype_str_abl(from),
2557 		     datatype_str_acc(to));
2558 }
2559 
2560 
2561 MTX *
2562 mtx_attr_asgn(grad_dict_attr_t *attr, MTX *index, MTX *rval)
2563 {
2564         ATTR_MTX *mtx = (ATTR_MTX*)mtx_alloc(Attr_asgn);
2565         mtx_append(mtx);
2566         mtx->attrno   = attr->value;
2567         mtx->datatype = attr_datatype(attr);
2568         if (rval->gen.datatype != mtx->datatype) {
2569 		rw_coercion_warning(rval->gen.datatype, mtx->datatype, NULL);
2570                 rval = coerce(rval, mtx->datatype);
2571         }
2572 	mtx->index = index;
2573         mtx->rval = rval;
2574         return (MTX*)mtx;
2575 }
2576 
2577 MTX *
2578 mtx_attr_delete(grad_dict_attr_t *attr, MTX *index)
2579 {
2580         ATTR_MTX *mtx = (ATTR_MTX*)mtx_alloc(Attr_delete);
2581         mtx_append(mtx);
2582         mtx->attrno   = attr->value;
2583         mtx->datatype = attr_datatype(attr);
2584 	mtx->index = index;
2585         return (MTX*)mtx;
2586 }
2587 
2588 MTX *
2589 mtx_bin(Bopcode opcode, MTX *arg1, MTX *arg2)
2590 {
2591         BIN_MTX *mtx = (BIN_MTX*)mtx_alloc(Binary);
2592 
2593         mtx_append(mtx);
2594         if (arg1->gen.datatype != arg2->gen.datatype) {
2595 		rw_coercion_warning(String, Integer, NULL);
2596                 if (arg1->gen.datatype == String)
2597                         arg1 = coerce(arg1, Integer);
2598                 else
2599                         arg2 = coerce(arg2, Integer);
2600         }
2601 
2602         switch (arg1->gen.datatype) {
2603         case String:
2604                 switch (opcode) {
2605                 case Add:
2606                         mtx->datatype = String;
2607                         break;
2608                 case Eq:
2609                 case Ne:
2610                 case Lt:
2611                 case Le:
2612                 case Gt:
2613                 case Ge:
2614                         mtx->datatype = Integer;
2615                         break;
2616                 default:
2617                         grad_log_loc(GRAD_LOG_ERR, &locus,
2618 				     "%s",
2619 				     _("operation not applicable to strings"));
2620                         errcnt++;
2621                         return (MTX*)mtx;
2622                 }
2623                 break;
2624 
2625         case Integer:
2626                 mtx->datatype = Integer;
2627 		break;
2628 
2629 	default:
2630 		grad_insist_fail("unknown data type");
2631         }
2632 
2633         mtx->opcode = opcode;
2634         mtx->arg[0] = arg1;
2635         mtx->arg[1] = arg2;
2636         arg1->gen.uplink = arg2->gen.uplink = (MTX*)mtx;
2637         return (MTX*)mtx;
2638 }
2639 
2640 MTX *
2641 mtx_un(Uopcode opcode, MTX *arg)
2642 {
2643         UN_MTX *mtx = (UN_MTX*)mtx_alloc(Unary);
2644 
2645         mtx_append(mtx);
2646         if (arg->gen.datatype != Integer) {
2647 		rw_coercion_warning(String, Integer, NULL);
2648                 coerce(arg, Integer);
2649         }
2650         mtx->datatype = Integer;
2651         mtx->opcode = opcode;
2652         mtx->arg = arg;
2653         arg->gen.uplink = (MTX*)mtx;
2654         return (MTX*)mtx;
2655 }
2656 
2657 MTX *
2658 mtx_match(int negated, MTX *arg, COMP_REGEX *rx)
2659 {
2660         MATCH_MTX *mtx = (MATCH_MTX*)mtx_alloc(Match);
2661 
2662         mtx_append(mtx);
2663         if (arg->gen.datatype != String) {
2664 		rw_coercion_warning(Integer, String, NULL);
2665                 coerce(arg, String);
2666         }
2667         mtx->datatype = Integer;
2668         mtx->negated = negated;
2669         mtx->arg = arg;
2670         mtx->rx  = rx;
2671         return (MTX*)mtx;
2672 }
2673 
2674 MTX *
2675 mtx_cond(MTX *cond, MTX *if_true, MTX *if_false)
2676 {
2677         COND_MTX *mtx = (COND_MTX*)mtx_alloc(Cond);
2678 
2679         mtx_append(mtx);
2680         mtx->expr = cond;
2681         mtx->if_true   = if_true;
2682         mtx->if_false  = if_false;
2683         return (MTX*)mtx;
2684 }
2685 
2686 MTX *
2687 mtx_coerce(grad_data_type_t type, MTX *arg)
2688 {
2689         if (type == arg->gen.datatype)
2690                 return mtx_cur();
2691         return coerce(arg, type);
2692 }
2693 
2694 MTX *
2695 coerce(MTX *arg, grad_data_type_t type)
2696 {
2697         COERCE_MTX *mtx = (COERCE_MTX*)mtx_alloc(Coercion);
2698 
2699         mtx_insert(arg, (MTX*) mtx);
2700         mtx->datatype = type;
2701         mtx->arg = arg;
2702         return (MTX*)mtx;
2703 }
2704 
2705 MTX *
2706 mtx_call(FUNCTION *fun, MTX *args)
2707 {
2708         MTX       *argp;
2709         CALL_MTX  *call;
2710         PARAMETER *parmp;
2711         int       argn;
2712 
2713         /*
2714          * Test the number and types of arguments. Insert reasonable
2715          * typecasts.
2716          */
2717         argn = 0;
2718         argp = args;
2719         parmp = fun->parm;
2720         while (argp && parmp) {
2721                 if (argp->gen.datatype != parmp->datatype) {
2722 			char buf[24];
2723 			snprintf(buf, sizeof buf, _("(argument %d)"), argn);
2724 			rw_coercion_warning(argp->gen.datatype,
2725 					    parmp->datatype, buf);
2726                         coerce(argp, parmp->datatype);
2727                 }
2728                 argn++;
2729                 argp  = argp->gen.arglink;
2730                 parmp = parmp->next;
2731         }
2732 
2733         /*
2734          * Note that the argument count mismatch is not an error!
2735          */
2736         if (argp) {
2737                 grad_log_loc(GRAD_LOG_ERR, &locus,
2738 			     _("too many arguments in call to %s"),
2739 			     fun->name);
2740 		errcnt++;
2741         } else if (parmp) {
2742                 grad_log_loc(GRAD_LOG_ERR, &locus,
2743 			     _("too few arguments in call to %s"),
2744 			     fun->name);
2745 		errcnt++;
2746         }
2747 
2748         call = (CALL_MTX*) mtx_alloc(Call);
2749         mtx_append((MTX*)call);
2750 
2751         call->datatype = fun->rettype;
2752         call->fun  = fun;
2753         call->args = args;
2754         call->nargs = argn;
2755 
2756         return (MTX*) call;
2757 }
2758 
2759 MTX *
2760 mtx_builtin(builtin_t *bin, MTX *args)
2761 {
2762         MTX          *argp;
2763         BTIN_MTX     *call;
2764         int          argn;
2765         char         *parmp;
2766         grad_data_type_t     type;
2767         /*
2768          * Test the number and types of arguments. Insert reasonable
2769          * typecasts.
2770          */
2771         argn = 0;
2772         argp = args;
2773         parmp = bin->parms;
2774 
2775         while (argp && parmp) {
2776                 switch (parmp[0]) {
2777                 case 'i':
2778                         type = Integer;
2779                         break;
2780                 case 's':
2781                         type = String;
2782                         break;
2783                 default:
2784                         grad_insist_fail("malformed builtin");
2785                 }
2786 
2787                 if (argp->gen.datatype != type) {
2788 			char buf[24];
2789 			snprintf(buf, sizeof buf, _("(argument %d)"), argn);
2790 			rw_coercion_warning(argp->gen.datatype, type, buf);
2791                         coerce(argp, type);
2792                 }
2793                 argn++;
2794                 argp  = argp->gen.arglink;
2795                 parmp++;
2796         }
2797 
2798         if (argp) {
2799                 grad_log_loc(GRAD_LOG_ERR, &locus,
2800 			     _("too many arguments in call to %s"),
2801 			     bin->name);
2802                 errcnt++;
2803         } else if (*parmp) {
2804                 grad_log_loc(GRAD_LOG_ERR, &locus,
2805 			     _("too few arguments in call to %s"),
2806 			     bin->name);
2807                 errcnt++;
2808         }
2809 
2810         call = (BTIN_MTX*) mtx_alloc(Builtin);
2811         mtx_append((MTX*)call);
2812 
2813         call->datatype = bin->rettype;
2814         call->fun  = bin->handler;
2815         call->args = args;
2816         call->nargs = argn;
2817 
2818         return (MTX*) call;
2819 }
2820 
2821 
2822 /* ****************************************************************************
2823  * Code optimizer (rudimentary)
2824  */
2825 
2826 const char *
2827 datatype_str_nom(grad_data_type_t type)
2828 {
2829         switch (type) {
2830         case Undefined:
2831                 return _("Undefined");
2832         case Integer:
2833                 return _("integer");
2834         case String:
2835                 return _("string");
2836         default:
2837                 return _("UNKNOWN");
2838         }
2839 }
2840 
2841 const char *
2842 datatype_str_abl(grad_data_type_t type)
2843 {
2844         switch (type) {
2845         case Undefined:
2846                 return _("from Undefined");
2847         case Integer:
2848                 return _("from integer");
2849         case String:
2850                 return _("from string");
2851         default:
2852                 return _("from UNKNOWN");
2853         }
2854 }
2855 
2856 const char *
2857 datatype_str_acc(grad_data_type_t type)
2858 {
2859         switch (type) {
2860         case Undefined:
2861                 return _("to Undefined");
2862         case Integer:
2863                 return _("to integer");
2864         case String:
2865                 return _("to string");
2866         default:
2867                 return _("to UNKNOWN");
2868         }
2869 }
2870 
2871 FILE *
2872 debug_open_file()
2873 {
2874         FILE *fp;
2875         char *path;
2876 
2877         path = grad_mkfilename(grad_log_dir, "radius.mtx");
2878         if ((fp = fopen(path, "a")) == NULL) {
2879                 grad_log(GRAD_LOG_ERR|GRAD_LOG_PERROR,
2880                          _("can't open file `%s'"),
2881                          path);
2882         }
2883         grad_free(path);
2884         return fp;
2885 }
2886 
2887 #if defined(MAINTAINER_MODE)
2888 
2889 static void debug_print_datum(FILE *fp, grad_data_type_t type,  grad_datum_t *datum);
2890 static void debug_print_var(FILE *fp, VAR *var);
2891 static void debug_print_unary(FILE *fp, UN_MTX *mtx);
2892 static void debug_print_binary(FILE *fp, BIN_MTX *mtx);
2893 static void debug_print_mtxlist();
2894 
2895 static char *b_opstr[] = {
2896         "Eq",
2897         "Ne",
2898         "Lt",
2899         "Le",
2900         "Gt",
2901         "Ge",
2902         "&",
2903         "^",
2904         "|",
2905         "And",
2906         "Or",
2907         "Shl",
2908         "Shr",
2909         "Add",
2910         "Sub",
2911         "Mul",
2912         "Div",
2913         "Rem",
2914 };
2915 
2916 static char *u_opstr[] = {
2917         "Neg",
2918         "Not"
2919 };
2920 
2921 #define LINK(m) (m ? m->gen.id : 0)
2922 
2923 void
2924 debug_print_datum(FILE *fp, grad_data_type_t type, grad_datum_t *datum)
2925 {
2926         fprintf(fp, "%3.3s ", datatype_str_nom(type));
2927         switch (type) {
2928         case Integer:
2929                 fprintf(fp, "%d", datum->ival);
2930                 break;
2931 
2932         case String:
2933                 fprintf(fp, "%s", datum->sval);
2934 		break;
2935 
2936 	default:
2937 		grad_insist_fail("unknown data type");
2938         }
2939 }
2940 
2941 void
2942 debug_print_var(FILE *fp, VAR *var)
2943 {
2944         fprintf(fp, "%3.3s %s L:%d S:%d",
2945                 datatype_str_nom(var->datatype),
2946                 var->name,
2947                 var->level,
2948                 var->offset);
2949         if (var->constant) {
2950                 fprintf(fp, "CONST ");
2951                 debug_print_datum(fp, var->datatype, &var->datum);
2952         }
2953 }
2954 
2955 void
2956 debug_print_unary(FILE *fp, UN_MTX *mtx)
2957 {
2958         fprintf(fp, "OP:%s M:%d",
2959                 u_opstr[mtx->opcode], LINK(mtx->arg));
2960 }
2961 
2962 void
2963 debug_print_binary(FILE *fp, BIN_MTX *mtx)
2964 {
2965         fprintf(fp, "OP:%s M1:%d M2:%d",
2966                 b_opstr[mtx->opcode],
2967                 LINK(mtx->arg[0]),
2968                 LINK(mtx->arg[1]));
2969 }
2970 
2971 
2972 void
2973 debug_print_mtxlist(char *s)
2974 {
2975         FILE *fp;
2976         MTX  *mtx, *tmp;
2977 
2978         if ((fp = debug_open_file()) == NULL)
2979                 return;
2980 
2981         #define CASE(c) case c: fprintf(fp, "%-10.10s", #c);
2982 
2983         fprintf(fp, "%s\n", s);
2984         for (mtx = mtx_first; mtx; mtx = mtx->gen.next) {
2985                 fprintf(fp, "%4d: %4d %4d ",
2986                         mtx->gen.id,
2987                         LINK(mtx->gen.prev),
2988                         LINK(mtx->gen.next));
2989                 switch (mtx->gen.type) {
2990                 CASE (Generic)
2991                         break;
2992                 CASE (Nop)
2993                         break;
2994                 CASE (Enter)
2995                         fprintf(fp, "%3.3s %d",
2996                                 "",
2997                                 mtx->frame.stacksize);
2998                         break;
2999                 CASE (Leave)
3000                         fprintf(fp, "%3.3s %d",
3001                                 "",
3002                                 mtx->frame.stacksize);
3003                         break;
3004                 CASE (Stop)
3005                         break;
3006                 CASE (Constant)
3007                         debug_print_datum(fp, mtx->cnst.datatype,
3008                                           &mtx->cnst.datum);
3009                         break;
3010                 CASE (Matchref)
3011                         fprintf(fp, "%3.3s %d",
3012                                 datatype_str_nom(String),
3013                                 mtx->ref.num);
3014                         break;
3015                 CASE (Variable)
3016                         debug_print_var(fp, mtx->var.var);
3017                         break;
3018                 CASE (Unary)
3019                         fprintf(fp, "%3.3s ", datatype_str_nom(mtx->gen.datatype));
3020                         debug_print_unary(fp, &mtx->un);
3021                         break;
3022                 CASE (Binary)
3023                         fprintf(fp, "%3.3s ", datatype_str_nom(mtx->gen.datatype));
3024                         debug_print_binary(fp, &mtx->bin);
3025                         break;
3026                 CASE (Cond)
3027                         fprintf(fp, "%3.3s ", "");
3028                         fprintf(fp, "C:%4d T:%4d F:%4d",
3029                                 LINK(mtx->cond.expr),
3030                                 LINK(mtx->cond.if_true),
3031                                 LINK(mtx->cond.if_false));
3032                         break;
3033                 CASE (Asgn)
3034                         fprintf(fp, "%3.3s ",
3035                                 datatype_str_nom(mtx->gen.datatype));
3036                         fprintf(fp, "V:%s,%d,%d M:%4d",
3037                                 mtx->asgn.lval->name,
3038                                 mtx->asgn.lval->level,
3039                                 mtx->asgn.lval->offset,
3040                                 LINK(mtx->asgn.arg));
3041                                 break;
3042                 CASE (Match)
3043                         fprintf(fp, "    N:%1d M:%4d RX:%p",
3044                                 mtx->match.negated,
3045                                 LINK(mtx->match.arg),
3046                                 mtx->match.rx);
3047                         break;
3048                 CASE (Coercion)
3049                         fprintf(fp, "%3.3s M:%4d",
3050                                 datatype_str_nom(mtx->coerce.datatype),
3051                                 LINK(mtx->coerce.arg));
3052                         break;
3053                 CASE (Return)
3054                         fprintf(fp, "%3.3s M:%4d",
3055                                 datatype_str_nom(mtx->ret.expr->gen.datatype),
3056                                 LINK(mtx->ret.expr));
3057                         break;
3058                 CASE (Jump)
3059                         fprintf(fp, "%3.3s M:%4d",
3060                                 "",
3061                                 LINK(mtx->jump.dest));
3062                         break;
3063                 CASE (Branch)
3064                         fprintf(fp, "%3.3s M:%4d",
3065                                 mtx->branch.cond ? "NE" : "EQ",
3066                                 LINK(mtx->branch.dest));
3067                         break;
3068                 CASE (Call)
3069                         fprintf(fp, "%3.3s F:%s, A:%d:",
3070                                 datatype_str_nom(mtx->call.datatype),
3071                                 mtx->call.fun->name,
3072                                 mtx->call.fun->nparm);
3073                         for (tmp = mtx->call.args; tmp; tmp = tmp->gen.arglink)
3074                                 fprintf(fp, "%d,", tmp->gen.id);
3075                         break;
3076 
3077                 CASE(Builtin)
3078                         fprintf(fp, "%3.3s F:%p, A:%d:",
3079                                 datatype_str_nom(mtx->btin.datatype),
3080                                 mtx->btin.fun,
3081                                 mtx->btin.nargs);
3082                         for (tmp = mtx->btin.args; tmp; tmp = tmp->gen.arglink)
3083                                 fprintf(fp, "%d,", tmp->gen.id);
3084                         break;
3085 
3086                 CASE (Pop)
3087                         break;
3088 
3089                 CASE (Pusha)
3090                         break;
3091 
3092                 CASE (Popa)
3093                         break;
3094 
3095                 CASE (Attr)
3096                         fprintf(fp, "%3.3s A:%d I:%d",
3097                                 datatype_str_nom(mtx->gen.datatype),
3098                                 mtx->attr.attrno,
3099 				mtx->attr.index ? mtx->attr.index->gen.id : 0);
3100                         break;
3101 
3102                 CASE (Attr_check)
3103                         fprintf(fp, "%3.3s A:%d I:%d",
3104                                 datatype_str_nom(mtx->gen.datatype),
3105                                 mtx->attr.attrno,
3106 				mtx->attr.index ? mtx->attr.index->gen.id : 0);
3107                         break;
3108 
3109                 CASE (Attr_asgn)
3110                         fprintf(fp, "%3.3s A:%d I:%d M:%d",
3111                                 datatype_str_nom(mtx->gen.datatype),
3112                                 mtx->attr.attrno,
3113 				mtx->attr.index ? mtx->attr.index->gen.id : 0,
3114 				LINK(mtx->attr.rval));
3115                         break;
3116 
3117 		CASE (Attr_delete)
3118 			fprintf(fp, "%3.3s A:%d I:%d",
3119 				datatype_str_nom(mtx->gen.datatype),
3120 				mtx->attr.attrno,
3121 				mtx->attr.index ? mtx->attr.index->gen.id : 0);
3122 		        break;
3123 
3124                 default:
3125                         fprintf(fp, "UNKNOWN: %d", mtx->gen.type);
3126                 }
3127                 fprintf(fp, "\n");
3128         }
3129 
3130         fclose(fp);
3131 }
3132 
3133 void
3134 debug_print_function()
3135 {
3136         FILE      *fp;
3137         PARAMETER *parm;
3138         int        n;
3139 
3140         if ((fp = debug_open_file()) == NULL)
3141                 return;
3142 
3143         fprintf(fp, "FUNCTION: %s\n", function->name);
3144         fprintf(fp, "RETURNS : %s\n", datatype_str_nom(function->rettype));
3145         fprintf(fp, "NPARMS  : %d\n", function->nparm);
3146         fprintf(fp, "PARMS   :\n");
3147 
3148         for (parm = function->parm, n = 0; parm; parm = parm->next, n++)
3149                 fprintf(fp, "    %4d: %s at %4d\n",
3150                         n, datatype_str_nom(parm->datatype),
3151                         parm->offset);
3152 
3153         fclose(fp);
3154 }
3155 
3156 #endif /* MAINTAINER_MODE */
3157 
3158 #if defined(MAINTAINER_MODE)
3159 # define DEBUG_MTX(c) if (GRAD_DEBUG_LEVEL(30)) debug_print_mtxlist(c);
3160 # define DEBUG_FUN()  if (GRAD_DEBUG_LEVEL(25)) debug_print_function();
3161 #else
3162 # define DEBUG_MTX(c)
3163 # define DEBUG_FUN()
3164 #endif
3165 
3166 static void pass1();
3167 static int pass2_unary(MTX *mtx);
3168 static int pass2_binary(MTX *mtx);
3169 
3170 void
3171 pass1()
3172 {
3173         MTX *mtx;
3174         MTX *end;
3175 
3176         /*
3177          * Create an entry matrix
3178          */
3179         mtx = mtx_alloc(Enter);
3180         rw_list_insert(&mtx_first, &mtx_last, mtx_first, mtx, 1);
3181         mtx->frame.stacksize = function->stack_alloc;
3182 
3183         /*
3184          * Provide a default return statement if necessary
3185          */
3186         if (mtx_last->gen.type != Return) {
3187                 grad_value_t val;
3188                 grad_log_loc(GRAD_LOG_WARN, &mtx_last->gen.loc,
3189 			     _("missing return statement"));
3190 
3191 		val.type = function->rettype;
3192                 switch (function->rettype) {
3193                 case Integer:
3194                         val.datum.ival = 0;
3195                         break;
3196 
3197                 case String:
3198                         val.datum.sval.data = "";
3199 			val.datum.sval.size = 0;
3200 			break;
3201 
3202 		default:
3203 			grad_insist_fail("Unknown data type");
3204                 }
3205                 mtx_const(&val);
3206                 mtx_frame(Leave, function->stack_alloc);
3207         } else {
3208                 mtx_last->gen.type = Leave;
3209                 mtx_last->frame.stacksize = function->stack_alloc;
3210         }
3211 
3212         /*
3213          * Insert a no-op matrix before the `leave' one
3214          */
3215         end = mtx_alloc(Nop);
3216         rw_list_insert(&mtx_first, &mtx_last, mtx_last, end, 1);
3217 
3218         for (mtx = mtx_first; mtx; mtx = mtx->gen.next) {
3219                 if (mtx->gen.type == Return) {
3220                         if (mtx->ret.expr->gen.datatype != function->rettype) {
3221 				rw_coercion_warning(
3222 					mtx->ret.expr->gen.datatype,
3223 					function->rettype, NULL);
3224                                 coerce(mtx->ret.expr, function->rettype);
3225                         }
3226                         mtx->gen.type = Jump;
3227                         mtx->jump.dest = end;
3228                 }
3229         }
3230 }
3231 
3232 /*
3233  * Second pass: elimination of constant sub-expressions
3234  */
3235 
3236 /*
3237  * Perform immediate unary calculations
3238  */
3239 int
3240 pass2_unary(MTX *mtx)
3241 {
3242         MTX *arg = mtx->un.arg;
3243 
3244         switch (mtx->un.opcode) {
3245         case Not:
3246                 arg->cnst.datum.ival = !arg->cnst.datum.ival;
3247                 break;
3248 
3249         case Neg:
3250                 arg->cnst.datum.ival = -arg->cnst.datum.ival;
3251                 break;
3252 
3253 	default:
3254 		grad_insist_fail("Unexpected opcode");
3255         }
3256         mtx->gen.type = Constant;
3257         mtx->cnst.datum = arg->cnst.datum;
3258         mtx_remove(arg);
3259         return 0;
3260 }
3261 
3262 /*
3263  * Perform immediate binary computations
3264  */
3265 int
3266 pass2_binary(MTX *mtx)
3267 {
3268         MTX *arg0 = mtx->bin.arg[0];
3269         MTX *arg1 = mtx->bin.arg[1];
3270         grad_datum_t dat;
3271 
3272         switch (mtx->bin.opcode) {
3273         case Eq:
3274                 dat.ival = arg0->cnst.datum.ival == arg1->cnst.datum.ival;
3275                 break;
3276 
3277         case Ne:
3278                 dat.ival = arg0->cnst.datum.ival != arg1->cnst.datum.ival;
3279                 break;
3280 
3281         case Lt:
3282                 dat.ival = arg0->cnst.datum.ival < arg1->cnst.datum.ival;
3283                 break;
3284 
3285         case Le:
3286                 dat.ival = arg0->cnst.datum.ival <= arg1->cnst.datum.ival;
3287                 break;
3288 
3289         case Gt:
3290                 dat.ival = arg0->cnst.datum.ival > arg1->cnst.datum.ival;
3291                 break;
3292 
3293         case Ge:
3294                 dat.ival = arg0->cnst.datum.ival >= arg1->cnst.datum.ival;
3295                 break;
3296 
3297         case BAnd:
3298                 dat.ival = arg0->cnst.datum.ival & arg1->cnst.datum.ival;
3299                 break;
3300 
3301         case BOr:
3302                 dat.ival = arg0->cnst.datum.ival | arg1->cnst.datum.ival;
3303                 break;
3304 
3305         case BXor:
3306                 dat.ival = arg0->cnst.datum.ival ^ arg1->cnst.datum.ival;
3307                 break;
3308 
3309         case And:
3310                 dat.ival = arg0->cnst.datum.ival && arg1->cnst.datum.ival;
3311                 break;
3312 
3313         case Or:
3314                 dat.ival = arg0->cnst.datum.ival || arg1->cnst.datum.ival;
3315                 break;
3316 
3317         case Shl:
3318                 dat.ival = arg0->cnst.datum.ival << arg1->cnst.datum.ival;
3319                 break;
3320 
3321         case Shr:
3322                 dat.ival = arg0->cnst.datum.ival >> arg1->cnst.datum.ival;
3323                 break;
3324 
3325         case Add:
3326                 dat.ival = arg0->cnst.datum.ival + arg1->cnst.datum.ival;
3327                 break;
3328 
3329         case Sub:
3330                 dat.ival = arg0->cnst.datum.ival - arg1->cnst.datum.ival;
3331                 break;
3332 
3333         case Mul:
3334                 dat.ival = arg0->cnst.datum.ival * arg1->cnst.datum.ival;
3335                 break;
3336 
3337         case Div:
3338                 if (arg1->cnst.datum.ival == 0) {
3339                         grad_log_loc(GRAD_LOG_ERR, &arg1->cnst.loc,
3340 				     _("divide by zero"));
3341                         errcnt++;
3342                 } else
3343                         dat.ival =
3344                                 arg0->cnst.datum.ival / arg1->cnst.datum.ival;
3345                 break;
3346 
3347         case Rem:
3348                 if (arg1->cnst.datum.ival == 0) {
3349                         grad_log_loc(GRAD_LOG_ERR, &arg1->cnst.loc,
3350 				     _("divide by zero"));
3351                         errcnt++;
3352                 } else
3353                         dat.ival =
3354                                 arg0->cnst.datum.ival % arg1->cnst.datum.ival;
3355                 break;
3356 
3357 	default:
3358 		grad_insist_fail("Unexpected opcode");
3359         }
3360         mtx->gen.type = Constant;
3361         mtx->cnst.datum = dat;
3362         mtx_remove(arg0);
3363         mtx_remove(arg1);
3364         return 0;
3365 }
3366 
3367 MTX *
3368 mtx_branch(int cond, MTX *target)
3369 {
3370         MTX *nop = mtx_alloc(Nop);
3371         MTX *mtx = mtx_alloc(Branch);
3372         mtx_insert(target, nop);
3373         mtx->branch.cond = cond;
3374         mtx->branch.dest = nop;
3375         return mtx;
3376 }
3377 
3378 void
3379 mtx_bool(MTX *mtx)
3380 {
3381         MTX *j_mtx, *p, *p1;
3382 
3383         /* Insert after first operand:
3384 	   popa
3385 	   pusha
3386 	   pusha      ;; Duplicate tos value
3387 	   j?e   L10
3388 	   popa       ;; Pop up the unneded value */
3389 
3390 	p = mtx_alloc(Popa);
3391 	mtx_insert(mtx->bin.arg[0], p);
3392 	p1 = mtx_alloc(Pusha);
3393 	mtx_insert(p, p1);
3394 	p = mtx_alloc(Pusha);
3395 	mtx_insert(p1, p);
3396         j_mtx = mtx_branch(mtx->bin.opcode == Or, mtx);
3397         mtx_insert(p, j_mtx);
3398 	p1 = mtx_alloc(Popa);
3399 	mtx_insert(j_mtx, p1);
3400         /* Remove the op matrix
3401 	   Note that the mtx->cond.expr is not correct after this
3402 	   operation, but this does not affect the functionality */
3403         mtx_remove(mtx);
3404 }
3405 
3406 /*
3407  * Second optimization pass: immediate computations
3408  */
3409 int
3410 pass2()
3411 {
3412         MTX *mtx, *next;
3413         int optcnt;
3414         int errcnt = 0;
3415 
3416         do {
3417                 optcnt = 0;
3418                 mtx = mtx_first;
3419                 while (mtx) {
3420                         next = mtx->gen.next;
3421                         switch (mtx->gen.type) {
3422                         case Unary:
3423                                 if (mtx->un.arg->gen.type != Constant)
3424                                         break;
3425                                 if (pass2_unary(mtx))
3426                                         errcnt++;
3427                                 else
3428                                         optcnt++;
3429                                 break;
3430 
3431                         case Binary:
3432                                 if (mtx->bin.arg[0]->gen.type == Constant
3433 				    && mtx->bin.arg[1]->gen.type == Constant) {
3434                                         switch (mtx->bin.datatype) {
3435                                         case Integer:
3436                                                 if (pass2_binary(mtx))
3437                                                         errcnt++;
3438                                                 else
3439                                                         optcnt++;
3440                                                 break;
3441 
3442                                         case String:
3443                                                 /*NO STRING OPS SO FAR */;
3444 					        break;
3445 
3446 					default:
3447 						grad_insist_fail("Unknown data type");
3448                                         }
3449                                 } else if (mtx->bin.opcode == And
3450 					   || mtx->bin.opcode == Or) {
3451                                         mtx_bool(mtx);
3452                                 }
3453                                 break;
3454                                 /*FIXME: ADD `if (1)'/`if 0' evaluation */
3455                         case Jump:
3456                                 if (mtx->jump.dest == mtx->jump.next)
3457                                         mtx_remove(mtx);
3458 				break;
3459 
3460 			case Attr:
3461 			case Attr_asgn:
3462 			case Attr_check:
3463 			case Attr_delete:
3464 				/*FIXME: the rw_attr.0 functions should
3465 				  expect an immediate value after the
3466 				  attribute number */
3467 				break;
3468 
3469 			default:
3470 				break;
3471                         }
3472                         mtx = next;
3473                 }
3474         } while (errcnt == 0 && optcnt > 0);
3475         return errcnt;
3476 }
3477 
3478 int
3479 optimize()
3480 {
3481         DEBUG_FUN();
3482         DEBUG_MTX("on entry to optimize");
3483         pass1();
3484         DEBUG_MTX("after first pass");
3485         if (pass2())
3486                 return -1;
3487         DEBUG_MTX("after second pass (immediate computations)");
3488         return 0;
3489 }
3490 
3491 
3492 /* ****************************************************************************
3493  * Code generator
3494  */
3495 
3496 
3497 static INSTR *rw_code;          /* Code segment */
3498 static pctr_t rw_pc;            /* PC when compiling the code */
3499 static size_t rw_codesize;      /* Length of code segment */
3500 
3501 void
3502 code_check()
3503 {
3504         if (rw_code == NULL) {
3505                 rw_codesize  = 4096;
3506                 rw_code  = grad_emalloc(rw_codesize * sizeof(rw_code[0]));
3507         }
3508 }
3509 
3510 void
3511 code_init()
3512 {
3513 	code_check();
3514         /* code cell #0 is the default return address */
3515 	rw_code[0] = 0;
3516 	rw_pc = 1;
3517 }
3518 
3519 #if defined(MAINTAINER_MODE)
3520 void
3521 debug_dump_code()
3522 {
3523         FILE    *fp;
3524         pctr_t  pc;
3525         int     i;
3526 
3527         if ((fp = debug_open_file()) == NULL)
3528                 return;
3529         fprintf(fp, "Code size: %d\n", rw_codesize);
3530         fprintf(fp, "Code dump:\n");
3531 
3532         pc = 0;
3533         do {
3534                 fprintf(fp, "%4d:", pc);
3535                 for (i = 0; i < 8 && pc < rw_codesize; i++, pc++)
3536                         fprintf(fp, " %8x", (u_int) rw_code[pc]);
3537                 fprintf(fp, "\n");
3538         } while (pc < rw_codesize);
3539 
3540         fclose(fp);
3541 }
3542 #endif
3543 /*
3544  * Runtime function prototypes
3545  */
3546 static int pushn(RWSTYPE n);
3547 static int cpopn(RWSTYPE *np);
3548 static RWSTYPE popn();
3549 static void checkpop(int cnt);
3550 static void pushref(char *str, int from, int to);
3551 static RWSTYPE *heap_reserve(int size);
3552 static void pushs(RWSTYPE *sptr, size_t size, int len);
3553 static void pushstr(const char *str, int len);
3554 
3555 static void rw_pushn();
3556 static void rw_pushs();
3557 static void rw_pushref();
3558 static void rw_pushv();
3559 static void rw_i2s();
3560 static void rw_s2i();
3561 static void rw_eq();
3562 static void rw_ne();
3563 static void rw_lt();
3564 static void rw_le();
3565 static void rw_gt();
3566 static void rw_ge();
3567 static void rw_eqs();
3568 static void rw_nes();
3569 static void rw_lts();
3570 static void rw_les();
3571 static void rw_gts();
3572 static void rw_ges();
3573 static void rw_b_xor();
3574 static void rw_b_and();
3575 static void rw_b_or();
3576 static void rw_shl();
3577 static void rw_shr();
3578 static void rw_add();
3579 static void rw_sub();
3580 static void rw_mul();
3581 static void rw_div();
3582 static void rw_rem();
3583 static void rw_not();
3584 static void rw_neg();
3585 static void rw_asgn();
3586 static void rw_enter();
3587 static void rw_leave();
3588 static void rw_match();
3589 static void rw_jmp();
3590 static void rw_jne();
3591 static void rw_je();
3592 static void rw_adds();
3593 static void rw_adjstk();
3594 static void rw_popn();
3595 static void rw_pusha();
3596 static void rw_popa();
3597 static void rw_call();
3598 static void rw_builtin();
3599 static void rw_attrs();
3600 static void rw_attrs0();
3601 static void rw_attrn();
3602 static void rw_attrn0();
3603 static void rw_attrcheck();
3604 static void rw_attrcheck0();
3605 static void rw_attrasgn();
3606 static void rw_attrasgn0();
3607 static void rw_attr_delete();
3608 static void rw_attr_delete0();
3609 
3610 INSTR bin_codetab[] = {
3611         rw_eq,
3612         rw_ne,
3613         rw_lt,
3614         rw_le,
3615         rw_gt,
3616         rw_ge,
3617         rw_b_and,
3618         rw_b_xor,
3619         rw_b_or,
3620         NULL,
3621         NULL,
3622         rw_shl,
3623         rw_shr,
3624         rw_add,
3625         rw_sub,
3626         rw_mul,
3627         rw_div,
3628         rw_rem,
3629 };
3630 
3631 INSTR bin_string_codetab[] = {
3632         rw_eqs,
3633         rw_nes,
3634         rw_lts,
3635         rw_les,
3636         rw_gts,
3637         rw_ges,
3638         NULL,
3639         NULL,
3640         NULL,
3641         NULL,
3642         NULL,
3643         NULL,
3644         NULL,
3645         rw_adds,
3646         NULL,
3647         NULL,
3648         NULL,
3649         NULL
3650 };
3651 
3652 INSTR coerce_tab[Max_datatype][Max_datatype] = {
3653 /*                Undefined  Integer  String */
3654 /* Undefined */ {  NULL,      NULL,    NULL   },
3655 /* Integer */   {  NULL,      NULL,    rw_i2s },
3656 /* String */    {  NULL,      rw_s2i,  NULL   },
3657 };
3658 
3659 static void check_codesize(int delta);
3660 static int  code(INSTR instr);
3661 static int  data(int val);
3662 static int data_str(char *ptr);
3663 static void add_target(NOP_MTX *mtx, pctr_t pc);
3664 
3665 
3666 void
3667 add_target(NOP_MTX *mtx, pctr_t pc)
3668 {
3669         TGT_MTX *tgt = (TGT_MTX *)mtx_alloc(Target);
3670         tgt->next = (MTX*)mtx->tgt;
3671         mtx->tgt = tgt;
3672         tgt->pc = pc;
3673 }
3674 
3675 void
3676 fixup_target(NOP_MTX *mtx, pctr_t pc)
3677 {
3678         TGT_MTX   *tgt;
3679 
3680         for (tgt = (TGT_MTX*)mtx->tgt; tgt; tgt = (TGT_MTX*)tgt->next)
3681                 rw_code[tgt->pc] = (INSTR)pc;
3682         mtx->tgt = NULL;
3683 }
3684 
3685 pctr_t
3686 codegen()
3687 {
3688         MTX       *mtx;
3689 
3690         function->entry = rw_pc;
3691         for (mtx = mtx_first; mtx; mtx = mtx->gen.next) {
3692                 switch (mtx->gen.type) {
3693                 case Generic:
3694                 case Return:
3695                 default:
3696                         grad_log(GRAD_LOG_CRIT,
3697                                  "INTERNAL ERROR: codegen stumbled accross generic matrix!");
3698                         errcnt++;
3699                         return 0;
3700                 case Nop:
3701                         /* Fix-up the references */
3702                         fixup_target(&mtx->nop, rw_pc);
3703                         mtx->nop.pc = rw_pc;
3704                         break;
3705                 case Stop:
3706                         break;
3707                 case Enter:
3708                         code(rw_enter);
3709                         data(mtx->frame.stacksize);
3710                         break;
3711                 case Leave:
3712                         code(rw_leave);
3713                         break;
3714                 case Constant:
3715                         switch (mtx->cnst.datatype) {
3716                         case Integer:
3717                                 code(rw_pushn);
3718                                 data(mtx->cnst.datum.ival);
3719                                 break;
3720 
3721                         case String:
3722                                 code(rw_pushs);
3723                                 data_str(mtx->cnst.datum.sval.data);
3724                                 break;
3725 
3726 			default:
3727 				grad_insist_fail("Unknown data type");
3728                         }
3729                         break;
3730                 case Matchref:
3731                         code(rw_pushref);
3732                         data(mtx->ref.num);
3733                         break;
3734                 case Variable:
3735                         /* Variable dereference.
3736                          */
3737                         code(rw_pushv);
3738                         data(mtx->var.var->offset);
3739                         break;
3740                 case Unary:
3741                         switch (mtx->un.opcode) {
3742                         case Not:
3743                                 code(rw_not);
3744                                 break;
3745 
3746                         case Neg:
3747                                 code(rw_neg);
3748                                 break;
3749 
3750 			default:
3751 				grad_insist_fail("Unexpected opcode");
3752                         }
3753                         break;
3754                 case Binary:
3755                         if (mtx->bin.arg[0]->gen.datatype == String)
3756                                 code(bin_string_codetab[mtx->bin.opcode]);
3757                         else
3758                                 code(bin_codetab[mtx->bin.opcode]);
3759                         break;
3760                 case Cond:
3761                         /*FIXME: this needs optimization */
3762                         code(rw_jne);
3763                         add_target(&mtx->cond.if_true->nop, rw_pc);
3764                         code(NULL);
3765                         if (mtx->cond.if_false) {
3766                                 code(rw_jmp);
3767                                 add_target(&mtx->cond.if_false->nop, rw_pc);
3768                                 code(NULL);
3769                         }
3770                         break;
3771 
3772                 case Asgn:
3773                         code(rw_asgn);
3774                         data(mtx->asgn.lval->offset);
3775                         break;
3776 
3777                 case Match:
3778                         code(rw_match);
3779                         code((INSTR)mtx->match.rx);
3780                         if (mtx->match.negated)
3781                                 code(rw_not);
3782                         break;
3783 
3784                 case Coercion:
3785                         code(coerce_tab[mtx->coerce.arg->gen.datatype][mtx->coerce.datatype]);
3786                         break;
3787 
3788                 case Jump:
3789                         code(rw_jmp);
3790                         add_target(&mtx->jump.dest->nop, rw_pc);
3791                         code(NULL);
3792                         break;
3793 
3794                 case Branch:
3795                         code(mtx->branch.cond ? rw_jne : rw_je);
3796                         add_target(&mtx->branch.dest->nop, rw_pc);
3797                         code(NULL);
3798                         break;
3799 
3800                 case Call:
3801                         code(rw_call);
3802                         code((INSTR) mtx->call.fun->entry);
3803                         code(rw_adjstk);
3804                         data(mtx->call.nargs);
3805                         break;
3806 
3807                 case Builtin:
3808                         code(rw_builtin);
3809                         code(mtx->btin.fun);
3810                         code(rw_adjstk);
3811                         data(mtx->btin.nargs);
3812                         break;
3813 
3814                 case Pop:
3815                         code(rw_popn);
3816                         break;
3817 
3818                 case Popa:
3819                         code(rw_popa);
3820                         break;
3821 
3822                 case Pusha:
3823                         code(rw_pusha);
3824                         break;
3825 
3826                 case Attr:
3827                         switch (mtx->attr.datatype) {
3828                         case Integer:
3829 				if (mtx->attr.index)
3830 					code(rw_attrn);
3831 				else
3832 					code(rw_attrn0);
3833                                 break;
3834 
3835                         case String:
3836 				if (mtx->attr.index)
3837 					code(rw_attrs);
3838 				else
3839 					code(rw_attrs0);
3840                                 break;
3841 
3842 			default:
3843 				grad_insist_fail("Unknown data type");
3844                         }
3845                         data(mtx->attr.attrno);
3846                         break;
3847 
3848                 case Attr_check:
3849 			if (mtx->attr.index)
3850 				code(rw_attrcheck);
3851 			else
3852 				code(rw_attrcheck0);
3853                         data(mtx->attr.attrno);
3854                         break;
3855 
3856                 case Attr_asgn:
3857 			if (mtx->attr.index)
3858 				code(rw_attrasgn);
3859 			else
3860 				code(rw_attrasgn0);
3861                         data(mtx->attr.attrno);
3862                         break;
3863 
3864 		case Attr_delete:
3865 			if (mtx->attr.index)
3866 				code(rw_attr_delete);
3867 			else
3868 				code(rw_attr_delete0);
3869 			data(mtx->attr.attrno);
3870 			break;
3871                 }
3872         }
3873 
3874         /*
3875          * Second pass: fixup backward references
3876          */
3877         for (mtx = mtx_first; mtx; mtx = mtx->gen.next) {
3878                 if (mtx->gen.type == Nop)
3879                         fixup_target(&mtx->nop, mtx->nop.pc);
3880         }
3881 
3882 #if defined(MAINTAINER_MODE)
3883         if (GRAD_DEBUG_LEVEL(25)) {
3884                 FILE *fp = debug_open_file();
3885                 fprintf(fp, "entry: %d, size %d\n",
3886                         function->entry, rw_pc - function->entry);
3887                 fclose(fp);
3888         }
3889 #endif
3890         return function->entry;
3891 }
3892 
3893 void
3894 check_codesize(int delta)
3895 {
3896         if (rw_pc + delta >= rw_codesize) {
3897                 INSTR *p = grad_emalloc((rw_codesize + 4096) * sizeof(rw_code[0]));
3898                 memcpy(p, rw_code, rw_codesize * sizeof(rw_code[0]));
3899                 grad_free(rw_code);
3900                 rw_code = p;
3901                 rw_codesize += 4096;
3902         }
3903 }
3904 
3905 int
3906 code(INSTR instr)
3907 {
3908         check_codesize(1);
3909         rw_code[rw_pc] = instr;
3910         return rw_pc++;
3911 }
3912 
3913 int
3914 data(int val)
3915 {
3916         return code((INSTR)(RWSTYPE)val);
3917 }
3918 
3919 int
3920 data_str(char *ptr)
3921 {
3922         int  len   = strlen(ptr) + 1;
3923         RWSTYPE delta = (len + sizeof(rw_code[0])) / sizeof(rw_code[0]);
3924 
3925         check_codesize(delta+1);
3926         rw_code[rw_pc++] = (INSTR)delta;
3927         memcpy(rw_code + rw_pc, ptr, len);
3928         rw_pc += delta;
3929         return rw_pc;
3930 }
3931 
3932 
3933 /* ****************************************************************************
3934  * Regular expressions
3935  */
3936 
3937 COMP_REGEX *
3938 rx_alloc(regex_t *regex, int nmatch)
3939 {
3940         COMP_REGEX *rx;
3941 
3942         rx = grad_emalloc(sizeof(*rx));
3943         rx->regex  = *regex;
3944         rx->nmatch = nmatch;
3945         rw_list_insert(&function->rx_list, NULL, function->rx_list, rx, 1);
3946         return rx;
3947 }
3948 
3949 void
3950 rx_free(COMP_REGEX *rx)
3951 {
3952         COMP_REGEX *next;
3953 
3954         while (rx) {
3955                 next = rx->next;
3956                 regfree(&rx->regex);
3957                 grad_free(rx);
3958                 rx = next;
3959         }
3960 }
3961 
3962 COMP_REGEX *
3963 compile_regexp(char *str)
3964 {
3965         char     *p;
3966         regex_t  regex;
3967         int      nmatch;
3968 
3969         int rc = regcomp(&regex, str, regcomp_flags);
3970         if (rc) {
3971                 char errbuf[512];
3972                 regerror(rc, &regex, errbuf, sizeof(errbuf));
3973                 grad_log_loc(GRAD_LOG_ERR, &locus,
3974 			     _("regexp error: %s"),
3975 			     errbuf);
3976                 return NULL;
3977         }
3978         /* count the number of matches */
3979         nmatch = 0;
3980         for (p = str; *p; ) {
3981                 if (*p == '\\')
3982                         if (p[1] == '(') {
3983                                 nmatch++;
3984                                 p += 2;
3985                                 continue;
3986                         }
3987                 p++;
3988         }
3989 
3990         return rx_alloc(&regex, nmatch);
3991 }
3992 
3993 void
3994 function_delete()
3995 {
3996         if (function) {
3997                 grad_symtab_delete(rewrite_tab, (grad_symbol_t*)function);
3998                 function_cleanup();
3999         }
4000 }
4001 
4002 void
4003 function_cleanup()
4004 {
4005         function = NULL;
4006 }
4007 
4008 
4009 /* ****************************************************************************
4010  * Runtime functions
4011  */
4012 
4013 /*
4014  * Push a number on stack
4015  */
4016 int
4017 pushn(RWSTYPE n)
4018 {
4019         if (mach.st >= mach.ht) {
4020                 /*FIXME: gc();*/
4021                 GRAD_DEBUG2(1, "st=%d, ht=%d", mach.st, mach.ht);
4022                 rw_error(_("out of pushdown space"));
4023         }
4024         mach.stack[mach.st++] = n;
4025         return 0;
4026 }
4027 
4028 /*
4029  * Push a string on stack
4030  */
4031 void
4032 pushs(RWSTYPE *sptr, size_t size, int len)
4033 {
4034 	if (mach.ht - len - 1 <= mach.st) {
4035                 /* Heap overrun: */
4036                 /*gc(); */
4037                 rw_error(_("heap overrun"));
4038         }
4039 
4040         while (len)
4041                 mach.stack[mach.ht--] = sptr[--len];
4042 	mach.stack[mach.ht--] = size;
4043         pushn((RWSTYPE) (mach.stack + mach.ht + 1));
4044 }
4045 
4046 void
4047 pushstr(const char *str, int len)
4048 {
4049         RWSTYPE *p = heap_reserve(sizeof(RWSTYPE) + len + 1);
4050 	char *s = (char*)(p + 1);
4051         memcpy(s, str, len);
4052         s[len] = 0;
4053 	p[0] = len;
4054         pushn((RWSTYPE)p);
4055 }
4056 
4057 #define B2RW(s) (s + sizeof(mach.stack[0]) - 1) / sizeof(mach.stack[0])
4058 
4059 RWSTYPE *
4060 heap_reserve(int size)
4061 {
4062 	size_t words = B2RW(size);
4063 
4064         if (mach.ht - words <= mach.st) {
4065                 /* Heap overrun: */
4066                 gc();
4067                 if (mach.ht - words <= mach.st)
4068                         rw_error(_("heap overrun"));
4069         }
4070         mach.ht -= words;
4071         return mach.stack + mach.ht--;
4072 }
4073 
4074 
4075 /* Temporary space functions */
4076 char *
4077 temp_space_create()
4078 {
4079 	return (char*)(mach.stack + mach.st);
4080 }
4081 
4082 size_t
4083 temp_space_size()
4084 {
4085 	return (mach.ht - mach.st)*sizeof(mach.stack[0]);
4086 }
4087 
4088 void
4089 temp_space_copy(char **baseptr, char *text, size_t size)
4090 {
4091         size_t len = (size + sizeof(mach.stack[0])) / sizeof(mach.stack[0]);
4092 	if (*baseptr + len >= (char*)(mach.stack + mach.ht))
4093 		rw_error(_("out of heap space"));
4094 	memcpy(*baseptr, text, size);
4095 	*baseptr += size;
4096 }
4097 
4098 RWSTYPE *
4099 temp_space_fix(char *end)
4100 {
4101 	size_t len, size;
4102 	char *base = (char*)(mach.stack + mach.st);
4103 
4104 	temp_space_copy(&end, "", 0);
4105 	size = end - base;
4106 	len = B2RW(size);
4107         mach.ht -= len;
4108 	memmove(mach.stack + mach.ht, base, size);
4109 	mach.stack[--mach.ht] = strlen(base);
4110         return mach.stack + mach.ht--;
4111 }
4112 
4113 
4114 /*
4115  * Pop number from stack and store into NP.
4116  */
4117 int
4118 cpopn(RWSTYPE *np)
4119 {
4120         if (mach.st <= 0) {
4121                 rw_error(_("out of popup"));
4122         }
4123         *np = mach.stack[--mach.st];
4124         return 0;
4125 }
4126 
4127 /*
4128  * Pop the number from stack without error checking. checkpop() function
4129  * should be called before calling this one.
4130  */
4131 RWSTYPE
4132 popn()
4133 {
4134         return mach.stack[--mach.st];
4135 }
4136 
4137 void
4138 mem2string(grad_string_t *p, RWSTYPE *loc)
4139 {
4140 	p->size = loc[0];
4141 	p->data = (unsigned char*) (loc + 1);
4142 }
4143 
4144 void
4145 poparr(grad_string_t *p)
4146 {
4147 	mem2string(p, (RWSTYPE*) popn());
4148 }
4149 
4150 RWSTYPE
4151 tos()
4152 {
4153         return mach.stack[mach.st-1];
4154 }
4155 
4156 /*
4157  * Check if the stack contains at list CNT elements.
4158  */
4159 void
4160 checkpop(int cnt)
4161 {
4162         if (mach.st < cnt)
4163 		rw_error(_("out of popup"));
4164 }
4165 
4166 /*
4167  * Push a backreference value on stack.
4168  * Arguments: str     --    input string
4169  *            from    --    start of reference in string
4170  *            to      --    end of reference in string
4171  */
4172 void
4173 pushref(char *str, int from, int to)
4174 {
4175 	pushstr(str + from, to - from);
4176 }
4177 
4178 /*
4179  * Create a stack frame and enter the function
4180  */
4181 void
4182 enter(int n)
4183 {
4184         pushn(mach.sb);
4185         mach.sb = mach.st;
4186         mach.st += n;
4187 }
4188 
4189 /*
4190  * Destroy the stack frame and leave the function
4191  */
4192 void
4193 leave()
4194 {
4195         /* Save return value */
4196         mach.rA = popn();
4197         /* Restore stack frame */
4198         mach.st = mach.sb;
4199         mach.sb = popn();
4200         mach.pc = (pctr_t) popn();
4201 }
4202 
4203 RWSTYPE
4204 getarg(int num)
4205 {
4206         return mach.stack[mach.sb - (STACK_BASE + num)];
4207 }
4208 
4209 
4210 /* ****************************************************************************
4211  * Instructions
4212  */
4213 
4214 static int
4215 rw_error(const char *msg)
4216 {
4217         grad_log(GRAD_LOG_ERR,
4218 	         "%s: %s",
4219                  _("rewrite runtime error"), msg);
4220         longjmp(mach.jmp, 1);
4221         /*NOTREACHED*/
4222 }
4223 
4224 static int
4225 rw_error_free(char *msg)
4226 {
4227         grad_log(GRAD_LOG_ERR,
4228 	         "%s: %s",
4229                  _("rewrite runtime error"), msg);
4230 	free(msg);
4231         longjmp(mach.jmp, 1);
4232         /*NOTREACHED*/
4233 }
4234 
4235 void
4236 rw_call()
4237 {
4238         pctr_t  pc = (pctr_t) rw_code[mach.pc++];
4239         pushn(mach.pc); /* save return address */
4240         mach.pc = pc;
4241 }
4242 
4243 void
4244 rw_adjstk()
4245 {
4246         int delta = (int) rw_code[mach.pc++];
4247         mach.st -= delta;
4248         pushn(mach.rA);   /* Push the return back on stack */
4249 }
4250 
4251 void
4252 rw_enter()
4253 {
4254         /*FIXME: runtime checking */
4255         int n = (int) rw_code[mach.pc++];
4256         enter(n);
4257 }
4258 
4259 void
4260 rw_leave()
4261 {
4262         leave();
4263 }
4264 
4265 /*
4266  * Push a number on stack
4267  */
4268 void
4269 rw_pushn()
4270 {
4271         RWSTYPE n = (RWSTYPE) rw_code[mach.pc++];
4272         pushn(n);
4273 }
4274 
4275 /*
4276  * Push a reference value on stack
4277  */
4278 void
4279 rw_pushref()
4280 {
4281         int i = (int) rw_code[mach.pc++];
4282 
4283         pushref(mach.sA, mach.pmatch[i].rm_so, mach.pmatch[i].rm_eo);
4284 }
4285 
4286 /*
4287  * Push a variable on stack
4288  */
4289 void
4290 rw_pushv()
4291 {
4292         stkoff_t n = (stkoff_t) rw_code[mach.pc++];
4293 
4294         pushn(mach.stack[mach.sb + n]);
4295 }
4296 
4297 void
4298 rw_pushs()
4299 {
4300         int   len = (int) rw_code[mach.pc++];
4301         RWSTYPE *sptr = (RWSTYPE*) (rw_code + mach.pc);
4302 
4303         mach.pc += len;
4304         pushs(sptr, strlen((char*)sptr), len);
4305 }
4306 
4307 /*
4308  * Assign a value to a variable
4309  */
4310 void
4311 rw_asgn()
4312 {
4313         stkoff_t off = (stkoff_t) rw_code[mach.pc++];
4314         RWSTYPE n;
4315 
4316         cpopn(&n);
4317 
4318         mach.stack[mach.sb + off] = n;
4319         pushn(n);
4320 }
4321 
4322 void
4323 assert_request_presence()
4324 {
4325 	if (!mach.req)
4326 		rw_error(_("no request supplied"));
4327 }
4328 
4329 /* Check if the A/V pair is supplied in the request
4330  */
4331 void
4332 rw_attrcheck0()
4333 {
4334         int attr = (int) rw_code[mach.pc++];
4335 
4336 	pushn(grad_avl_find(AVPLIST(&mach), attr) != NULL);
4337 }
4338 
4339 void
4340 rw_attrcheck()
4341 {
4342         int attr = (int) rw_code[mach.pc++];
4343 	RWSTYPE index;
4344 
4345 	cpopn(&index);
4346 	pushn(grad_avl_find_n(AVPLIST(&mach), attr, index) != NULL);
4347 }
4348 
4349 /*
4350  * Assign a value to an A/V pair
4351  */
4352 void
4353 attrasgn_internal(int attr, grad_avp_t *pair, RWSTYPE val)
4354 {
4355 	grad_string_t str;
4356 
4357 	assert_request_presence();
4358 	if (!pair) {
4359                  pair = grad_avp_create(attr);
4360                  if (!pair)
4361                         rw_error(_("can't create A/V pair"));
4362                  grad_avl_add_pair(&mach.req->avlist, pair);
4363          }
4364 
4365 	switch (pair->type) {
4366 	case GRAD_TYPE_STRING:
4367 	case GRAD_TYPE_DATE:
4368 		mem2string(&str, (RWSTYPE*)val);
4369 		grad_free(pair->avp_strvalue);
4370 		pair->avp_strvalue = grad_malloc(str.size+1);
4371 		memcpy(pair->avp_strvalue, str.data, str.size);
4372 		pair->avp_strvalue[str.size] = 0;
4373 		pair->avp_strlength = str.size;
4374 		break;
4375 
4376 	case GRAD_TYPE_INTEGER:
4377 	case GRAD_TYPE_IPADDR:
4378 		pair->avp_lvalue = val;
4379 		break;
4380 	}
4381 
4382 	pushn(val);
4383 }
4384 
4385 void
4386 rw_attrasgn0()
4387 {
4388         int attr = (int) rw_code[mach.pc++];
4389         RWSTYPE val;
4390 
4391         cpopn(&val);
4392 	attrasgn_internal(attr, grad_avl_find(AVPLIST(&mach), attr), val);
4393 }
4394 
4395 void
4396 rw_attrasgn()
4397 {
4398         int attr = (int) rw_code[mach.pc++];
4399         RWSTYPE val;
4400 	RWSTYPE index;
4401 
4402         cpopn(&val);
4403 	cpopn(&index);
4404 	attrasgn_internal(attr, grad_avl_find_n(AVPLIST(&mach), attr, index),
4405 			  val);
4406 }
4407 
4408 void
4409 rw_attrs0()
4410 {
4411         int attr = (int) rw_code[mach.pc++];
4412         grad_avp_t *pair;
4413 
4414         if ((pair = grad_avl_find(AVPLIST(&mach), attr)) == NULL)
4415                 pushstr("", 0);
4416         else if (pair->prop & GRAD_AP_ENCRYPT) {
4417 		char string[GRAD_STRING_LENGTH+1];
4418 		int len;
4419 		req_decrypt_password(string, mach.req, pair);
4420 		len = strlen(string);
4421 		pushstr(string, len);
4422 	} else
4423                 pushstr(pair->avp_strvalue, pair->avp_strlength);
4424 }
4425 
4426 void
4427 rw_attrn0()
4428 {
4429         int attr = (int) rw_code[mach.pc++];
4430         grad_avp_t *pair;
4431 
4432         if ((pair = grad_avl_find(AVPLIST(&mach), attr)) == NULL)
4433                 pushn(0);
4434         else
4435                 pushn(pair->avp_lvalue);
4436 }
4437 
4438 void
4439 rw_attrs()
4440 {
4441         int attr = (int) rw_code[mach.pc++];
4442         grad_avp_t *pair;
4443 	RWSTYPE index;
4444 
4445 	cpopn(&index);
4446         if ((pair = grad_avl_find_n(AVPLIST(&mach), attr, index)) == NULL)
4447                 pushstr("", 0);
4448         else
4449                 pushstr(pair->avp_strvalue, pair->avp_strlength);
4450 }
4451 
4452 void
4453 rw_attrn()
4454 {
4455         int attr = (int) rw_code[mach.pc++];
4456         grad_avp_t *pair;
4457 	RWSTYPE index;
4458 
4459 	cpopn(&index);
4460         if ((pair = grad_avl_find_n(AVPLIST(&mach), attr, index)) == NULL)
4461                 pushn(0);
4462         else
4463                 pushn(pair->avp_lvalue);
4464 }
4465 
4466 void
4467 rw_attr_delete0()
4468 {
4469         int attr = (int) rw_code[mach.pc++];
4470 	grad_avl_delete(&mach.req->avlist, attr);
4471 }
4472 
4473 void
4474 rw_attr_delete()
4475 {
4476         int attr = (int) rw_code[mach.pc++];
4477 	RWSTYPE index;
4478 
4479 	assert_request_presence();
4480 	cpopn(&index);
4481 	grad_avl_delete_n(&mach.req->avlist, attr, index);
4482 }
4483 
4484 /*
4485  * Pop (and discard) a value from stack
4486  */
4487 void
4488 rw_popn()
4489 {
4490         RWSTYPE n;
4491         cpopn(&n);
4492 }
4493 
4494 /*
4495  * Pop a value from stack into the accumulator
4496  */
4497 void
4498 rw_popa()
4499 {
4500         cpopn(&mach.rA);
4501 }
4502 
4503 /*
4504  * Push accumulator on stack
4505  */
4506 void
4507 rw_pusha()
4508 {
4509         pushn(mach.rA);
4510 }
4511 
4512 /*
4513  * String concatenation
4514  */
4515 void
4516 rw_adds()
4517 {
4518         grad_string_t s1, s2;
4519 	RWSTYPE *p;
4520 	char *s;
4521 
4522         checkpop(2);
4523         poparr(&s2);
4524         poparr(&s1);
4525         p = heap_reserve(sizeof(RWSTYPE) + s1.size + s2.size + 1);
4526 	s = (char*)(p + 1);
4527 	memcpy(s, s1.data, s1.size);
4528 	s += s1.size;
4529 	memcpy(s, s2.data, s2.size);
4530 	s += s2.size;
4531 	*s = 0;
4532 	p[0] = s1.size + s2.size;
4533         pushn((RWSTYPE)p);
4534 }
4535 
4536 /*
4537  * Unary negation
4538  */
4539 void
4540 rw_neg()
4541 {
4542         checkpop(1);
4543         pushn(-popn());
4544 }
4545 
4546 /*
4547  * Bitwise operations
4548  */
4549 void
4550 rw_b_and()
4551 {
4552         int n1, n2;
4553 
4554         checkpop(2);
4555         n2 = popn();
4556         n1 = popn();
4557         pushn(n1 & n2);
4558 }
4559 
4560 void
4561 rw_b_or()
4562 {
4563         int n1, n2;
4564 
4565         checkpop(2);
4566         n2 = popn();
4567         n1 = popn();
4568         pushn(n1 | n2);
4569 }
4570 
4571 void
4572 rw_b_xor()
4573 {
4574         int n1, n2;
4575 
4576         checkpop(2);
4577         n2 = popn();
4578         n1 = popn();
4579         pushn(n1 ^ n2);
4580 }
4581 
4582 void
4583 rw_shl()
4584 {
4585         int n1, n2;
4586 
4587         checkpop(2);
4588         n2 = popn();
4589         n1 = popn();
4590         pushn(n1 << n2);
4591 }
4592 
4593 void
4594 rw_shr()
4595 {
4596         int n1, n2;
4597 
4598         checkpop(2);
4599         n2 = popn();
4600         n1 = popn();
4601         pushn(n1 >> n2);
4602 }
4603 
4604 /*
4605  * Addition
4606  */
4607 void
4608 rw_add()
4609 {
4610         int n1, n2;
4611 
4612         checkpop(2);
4613         n2 = popn();
4614         n1 = popn();
4615         pushn(n1+n2);
4616 }
4617 
4618 /*
4619  * Subtraction
4620  */
4621 void
4622 rw_sub()
4623 {
4624         int n1, n2;
4625 
4626         checkpop(2);
4627         n2 = popn();
4628         n1 = popn();
4629         pushn(n1-n2);
4630 }
4631 
4632 /*
4633  * Multiplication
4634  */
4635 void
4636 rw_mul()
4637 {
4638         int n1, n2;
4639 
4640         checkpop(2);
4641         n2 = popn();
4642         n1 = popn();
4643         pushn(n1*n2);
4644 }
4645 
4646 /*
4647  * Division
4648  */
4649 void
4650 rw_div()
4651 {
4652         int n1, n2;
4653 
4654         checkpop(2);
4655         n2 = popn();
4656         n1 = popn();
4657         if (n2 == 0)
4658                 rw_error(_("division by zero!"));
4659         pushn(n1/n2);
4660 }
4661 
4662 /*
4663  * Remainder
4664  */
4665 void
4666 rw_rem()
4667 {
4668         int n1, n2;
4669 
4670         checkpop(2);
4671         n2 = popn();
4672         n1 = popn();
4673         if (n2 == 0)
4674                 rw_error(_("division by zero!"));
4675         pushn(n1%n2);
4676 }
4677 
4678 
4679 /* Type conversion */
4680 void
4681 rw_i2s()
4682 {
4683         int n = popn();
4684         char buf[64];
4685 
4686         snprintf(buf, sizeof(buf), "%d", n);
4687         pushstr(buf, strlen(buf));
4688 }
4689 
4690 void
4691 rw_s2i()
4692 {
4693 	grad_string_t s;
4694 	mem2string(&s, (RWSTYPE *)popn());
4695         pushn(strtol(s.data, NULL, 0));
4696 }
4697 
4698 
4699 
4700 void
4701 rw_eq()
4702 {
4703         int n1, n2;
4704 
4705         checkpop(2);
4706         n2 = popn();
4707         n1 = popn();
4708         pushn(n1 == n2);
4709 }
4710 
4711 void
4712 rw_ne()
4713 {
4714         int n1, n2;
4715 
4716         checkpop(2);
4717         n2 = popn();
4718         n1 = popn();
4719         pushn(n1 != n2);
4720 }
4721 
4722 void
4723 rw_lt()
4724 {
4725         int n1, n2;
4726 
4727         checkpop(2);
4728         n2 = popn();
4729         n1 = popn();
4730         pushn(n1 < n2);
4731 }
4732 
4733 void
4734 rw_le()
4735 {
4736         int n1, n2;
4737 
4738         checkpop(2);
4739         n2 = popn();
4740         n1 = popn();
4741         pushn(n1 <= n2);
4742 }
4743 
4744 void
4745 rw_gt()
4746 {
4747         int n1, n2;
4748 
4749         checkpop(2);
4750         n2 = popn();
4751         n1 = popn();
4752         pushn(n1 > n2);
4753 }
4754 
4755 void
4756 rw_ge()
4757 {
4758         int n1, n2;
4759 
4760         checkpop(2);
4761         n2 = popn();
4762         n1 = popn();
4763         pushn(n1 >= n2);
4764 }
4765 
4766 void
4767 rw_eqs()
4768 {
4769         grad_string_t s1, s2;
4770 
4771         checkpop(2);
4772 	poparr(&s2);
4773 	poparr(&s1);
4774 
4775         pushn(s1.size == s2.size && memcmp(s1.data, s2.data, s1.size) == 0);
4776 }
4777 
4778 void
4779 rw_nes()
4780 {
4781         grad_string_t s1, s2;
4782 
4783         checkpop(2);
4784 	poparr(&s2);
4785 	poparr(&s1);
4786 
4787         pushn(!(s1.size == s2.size && memcmp(s1.data, s2.data, s1.size) == 0));
4788 }
4789 
4790 void
4791 rw_lts()
4792 {
4793         grad_string_t s1, s2;
4794 	size_t size;
4795 
4796         checkpop(2);
4797 	poparr(&s2);
4798 	poparr(&s1);
4799 	size = RW_MIN(s1.size, s2.size);
4800 	pushn(memcmp(s1.data, s2.data, size < 0) || s1.size < s2.size);
4801 }
4802 
4803 void
4804 rw_les()
4805 {
4806         grad_string_t s1, s2;
4807 	size_t size;
4808 
4809         checkpop(2);
4810 	poparr(&s2);
4811 	poparr(&s1);
4812 	size = RW_MIN(s1.size, s2.size);
4813 	pushn(memcmp(s1.data, s2.data, size <= 0) || s1.size <= s2.size);
4814 }
4815 
4816 void
4817 rw_gts()
4818 {
4819         grad_string_t s1, s2;
4820 	size_t size;
4821 
4822         checkpop(2);
4823 	poparr(&s2);
4824 	poparr(&s1);
4825 	size = RW_MIN(s1.size, s2.size);
4826 	pushn(memcmp(s1.data, s2.data, size > 0) || s1.size > s2.size);
4827 }
4828 
4829 void
4830 rw_ges()
4831 {
4832         grad_string_t s1, s2;
4833 	size_t size;
4834 
4835         checkpop(2);
4836 	poparr(&s2);
4837 	poparr(&s1);
4838 	size = RW_MIN(s1.size, s2.size);
4839 	pushn(memcmp(s1.data, s2.data, size >= 0) || s1.size >= s2.size);
4840 }
4841 
4842 void
4843 rw_not()
4844 {
4845         int n;
4846 
4847         checkpop(1);
4848         n = popn();
4849         pushn(!n);
4850 }
4851 
4852 static void
4853 need_pmatch(size_t n)
4854 {
4855 	n++;
4856         if (mach.nmatch < n) {
4857                 grad_free(mach.pmatch);
4858                 mach.nmatch = n;
4859                 mach.pmatch = grad_emalloc(n * sizeof(mach.pmatch[0]));
4860         }
4861 }
4862 
4863 void
4864 rw_match()
4865 {
4866         COMP_REGEX *rx = (COMP_REGEX *)rw_code[mach.pc++];
4867         grad_string_t s;
4868         int rc;
4869 
4870 	poparr(&s);
4871 	need_pmatch(rx->nmatch);
4872         mach.sA = s.data;
4873 
4874         rc = regexec(&rx->regex, mach.sA,
4875                      rx->nmatch + 1, mach.pmatch, 0);
4876         if (rc && GRAD_DEBUG_LEVEL(1)) {
4877                 char errbuf[512];
4878                 regerror(rc, &rx->regex,
4879                          errbuf, sizeof(errbuf));
4880                 grad_log(GRAD_LOG_DEBUG,
4881 		         _("rewrite regex failure: %s. Input: %s"),
4882                          errbuf, (char*)mach.rA);
4883         }
4884         pushn(rc == 0);
4885 }
4886 
4887 void
4888 rw_jmp()
4889 {
4890         pctr_t pc = (pctr_t) rw_code[mach.pc++];
4891         mach.pc = pc;
4892 }
4893 
4894 void
4895 rw_jne()
4896 {
4897         int n;
4898         pctr_t pc = (pctr_t) rw_code[mach.pc++];
4899 
4900         n = popn();
4901         if (n != 0)
4902                 mach.pc = pc;
4903 }
4904 
4905 void
4906 rw_je()
4907 {
4908         int n;
4909         pctr_t pc = (pctr_t) rw_code[mach.pc++];
4910 
4911         n = popn();
4912         if (n == 0)
4913                 mach.pc = pc;
4914 }
4915 
4916 void
4917 rw_builtin()
4918 {
4919         INSTR fun = (INSTR) rw_code[mach.pc++];
4920         pushn(mach.pc);
4921         enter(0);
4922         fun();
4923         leave();
4924 }
4925 
4926 void
4927 run(pctr_t pc)
4928 {
4929         mach.pc = pc;
4930         while (rw_code[mach.pc]) {
4931                 if (mach.pc >= rw_codesize)
4932                         rw_error(_("pc out of range"));
4933                 (*(rw_code[mach.pc++]))();
4934         }
4935 }
4936 
4937 
4938 /* ****************************************************************************
4939  * A placeholder for the garbage collector
4940  */
4941 
4942 void
4943 gc()
4944 {
4945 }
4946 
4947 
4948 /* ****************************************************************************
4949  * Built-in functions
4950  */
4951 
4952 /*
4953  * integer length(string s)
4954  */
4955 static void
4956 bi_length()
4957 {
4958 	grad_string_t s;
4959 	mem2string(&s, (RWSTYPE*)getarg(1));
4960         pushn(s.size);
4961 }
4962 
4963 /*
4964  * integer index(string s, integer a)
4965  */
4966 static void
4967 bi_index()
4968 {
4969         grad_string_t s;
4970 	char *p;
4971         int   c;
4972 
4973         mem2string(&s, (RWSTYPE*) getarg(2));
4974         c = (int) getarg(1);
4975         p = memchr(s.data, c, s.size);
4976         pushn(p ? p - s.data : -1);
4977 }
4978 
4979 /*
4980  * integer rindex(string s, integer a)
4981  */
4982 static void
4983 bi_rindex()
4984 {
4985         grad_string_t s;
4986 	int i;
4987         int c;
4988 
4989 	mem2string(&s, (RWSTYPE*) getarg(2));
4990 	for (i = s.size - 1; i >= 0; i--)
4991 		if (s.data[i] == c)
4992 			break;
4993         pushn(i);
4994 }
4995 
4996 /*
4997  * string substr(string s, int start, int length)
4998  */
4999 static void
5000 bi_substr()
5001 {
5002         grad_string_t src;
5003 	RWSTYPE *p;
5004 	char *dest;
5005         int   start, length;
5006 
5007         mem2string(&src, (RWSTYPE*)getarg(3));
5008         start  = getarg(2);
5009         length = getarg(1);
5010         if (length < 0)
5011                 length = src.size - start;
5012 
5013         p = heap_reserve(sizeof(RWSTYPE) + length + 1);
5014 	dest = (char *)(p + 1);
5015         if (length > 0)
5016                 memcpy(dest, src.data + start, length);
5017         dest[length] = 0;
5018 	p[0] = length;
5019         pushn((RWSTYPE)p);
5020 }
5021 
5022 static void
5023 bi_field()
5024 {
5025         grad_string_t str;
5026 	char *p, *endp;
5027         int fn = getarg(1);
5028         char *s = "";
5029         int len = 1;
5030 
5031 	mem2string(&str, (RWSTYPE*) getarg(2));
5032 	endp = str.data + str.size;
5033 	for (p = str.data; p < endp && fn--; ) {
5034                 /* skip initial whitespace */
5035                 while (p < endp && isspace(*p))
5036                         p++;
5037 
5038                 s = p;
5039                 len = 0;
5040                 while (p < endp && !isspace(*p)) {
5041                         p++;
5042                         len++;
5043                 }
5044         }
5045 
5046 	if (p == endp && fn)
5047 		pushstr("", 0);
5048 	else
5049 		pushstr(s, len);
5050 }
5051 
5052 static void
5053 bi_logit()
5054 {
5055         grad_string_t msg;
5056 	mem2string(&msg, (RWSTYPE*) getarg(1));
5057         grad_log(GRAD_LOG_INFO, "%s", msg.data);
5058         pushn(0);
5059 }
5060 
5061 static void
5062 bi_htonl()
5063 {
5064 	pushn(htonl(getarg(1)));
5065 }
5066 
5067 static void
5068 bi_ntohl()
5069 {
5070 	pushn(ntohl(getarg(1)));
5071 }
5072 
5073 static void
5074 bi_htons()
5075 {
5076 	pushn(htons(getarg(1) & 0xffff));
5077 }
5078 
5079 static void
5080 bi_ntohs()
5081 {
5082 	pushn(ntohs(getarg(1) & 0xffff));
5083 }
5084 
5085 static void
5086 bi_inet_ntoa()
5087 {
5088 	char buffer[GRAD_IPV4_STRING_LENGTH];
5089 	char *s = grad_ip_iptostr(getarg(1), buffer);
5090 	pushstr(s, strlen(s));
5091 }
5092 
5093 static void
5094 bi_inet_aton()
5095 {
5096 	grad_string_t s;
5097 	mem2string(&s, (RWSTYPE*)getarg(1));
5098 	/* Note: inet_aton is not always present. See lib/iputils.c */
5099 	pushn(grad_ip_strtoip(s.data));
5100 }
5101 
5102 static void
5103 bi_tolower()
5104 {
5105 	grad_string_t src;
5106 	grad_string_t dest;
5107 	int i;
5108 
5109 	mem2string(&src, (RWSTYPE*) getarg(1));
5110 	pushstr(src.data, src.size);
5111 	mem2string(&dest, (RWSTYPE*) tos());
5112 	for (i = 0; i < dest.size; i++)
5113 		dest.data[i] = tolower(dest.data[i]);
5114 }
5115 
5116 static void
5117 bi_toupper()
5118 {
5119 	grad_string_t src;
5120 	grad_string_t dest;
5121 	int i;
5122 
5123 	mem2string(&src, (RWSTYPE*) getarg(1));
5124 	pushstr(src.data, src.size);
5125 	mem2string(&dest, (RWSTYPE*) tos());
5126 	for (i = 0; i < dest.size; i++)
5127 		dest.data[i] = toupper(dest.data[i]);
5128 }
5129 
5130 static void
5131 bi_request_code_string()
5132 {
5133         int code = (int) getarg(1);
5134 	const char *s = grad_request_code_to_name(code);
5135 	pushstr(s, strlen(s));
5136 }
5137 
5138 static void
5139 bi_request_source_ip()
5140 {
5141 	assert_request_presence();
5142 	pushn((RWSTYPE) mach.req->ipaddr);
5143 }
5144 
5145 static void
5146 bi_request_source_port()
5147 {
5148 	assert_request_presence();
5149 	pushn((RWSTYPE) mach.req->udp_port);
5150 }
5151 
5152 static void
5153 bi_request_id()
5154 {
5155 	assert_request_presence();
5156 	pushn((RWSTYPE) mach.req->id);
5157 }
5158 
5159 static void
5160 bi_request_code()
5161 {
5162 	assert_request_presence();
5163 	pushn((RWSTYPE) mach.req->code);
5164 }
5165 
5166 static void
5167 bi_nas_name()
5168 {
5169         grad_nas_t *nas;
5170 	grad_uint32_t ip = (grad_uint32_t) getarg(1);
5171 
5172 	if ((nas = grad_nas_lookup_ip(ip)) != NULL) {
5173 		char *s = nas->shortname[0] ? nas->shortname : nas->longname;
5174 		pushstr(s, strlen(s));
5175         } else {
5176 		char nasname[GRAD_MAX_LONGNAME];
5177 
5178 		grad_ip_gethostname(ip, nasname, sizeof(nasname));
5179 		pushstr(nasname, strlen(nasname));
5180 	}
5181 }
5182 
5183 static void
5184 bi_nas_short_name()
5185 {
5186         grad_nas_t *nas;
5187 	grad_uint32_t ip = (grad_uint32_t) getarg(1);
5188 
5189 	if ((nas = grad_nas_lookup_ip(ip)) && nas->shortname[0]) {
5190 		pushstr(nas->shortname, strlen(nas->shortname));
5191         } else {
5192 		char nasname[GRAD_MAX_LONGNAME];
5193 
5194 		grad_ip_gethostname(ip, nasname, sizeof(nasname));
5195 		pushstr(nasname, strlen(nasname));
5196 	}
5197 }
5198 
5199 static void
5200 bi_nas_full_name()
5201 {
5202         grad_nas_t *nas;
5203 	grad_uint32_t ip = (grad_uint32_t) getarg(1);
5204 
5205 	if ((nas = grad_nas_lookup_ip(ip)) != NULL) {
5206 		pushstr(nas->longname, strlen(nas->longname));
5207         } else {
5208 		char nasname[GRAD_MAX_LONGNAME];
5209 
5210 		grad_ip_gethostname(ip, nasname, sizeof(nasname));
5211 		pushstr(nasname, strlen(nasname));
5212 	}
5213 }
5214 
5215 static void
5216 bi_gethostbyaddr()
5217 {
5218 	grad_uint32_t ip = (grad_uint32_t) getarg(1);
5219 	char nasname[GRAD_MAX_LONGNAME];
5220 
5221 	grad_ip_gethostname(ip, nasname, sizeof(nasname));
5222 	pushstr(nasname, strlen(nasname));
5223 }
5224 
5225 static void
5226 bi_gethostbyname()
5227 {
5228 	grad_string_t s;
5229 	mem2string(&s, (RWSTYPE*)getarg(1));
5230 	pushn((RWSTYPE) grad_ip_gethostaddr(s.data));
5231 }
5232 
5233 static void
5234 bi_time()
5235 {
5236 	pushn((RWSTYPE) time(NULL));
5237 }
5238 
5239 static void
5240 bi_strftime()
5241 {
5242 	struct tm *tm;
5243 	char *base;
5244 	time_t t = (time_t) getarg(1);
5245 	grad_string_t fmt;
5246 	size_t n;
5247 
5248 	mem2string(&fmt, (RWSTYPE*) getarg(2));
5249 	tm = localtime(&t);
5250 	base = temp_space_create();
5251 	n = strftime(base, temp_space_size(), fmt.data, tm);
5252 	pushstr(base, n);
5253 }
5254 
5255 static void
5256 rw_regerror(const char *prefix, regex_t *rx, int rc)
5257 {
5258 	size_t sz = regerror(rc, rx, NULL, 0);
5259 	char *errbuf = malloc(sz + strlen (prefix) + 1);
5260 	if (!errbuf)
5261 		rw_error(prefix);
5262 	else {
5263 		strcpy (errbuf, prefix);
5264 		regerror(rc, rx, errbuf + strlen(prefix), sz);
5265 		rw_error_free(errbuf);
5266 	}
5267 }
5268 
5269 enum subst_segment_type {
5270 	subst_text,       /* pure text */
5271 	subst_ref,        /* back reference (\NN) */
5272 	subst_match       /* substitute whole match (&) */
5273 };
5274 
5275 struct subst_segment {
5276 	enum subst_segment_type type;
5277 	union {
5278 		struct {
5279 			char *ptr;
5280 			size_t len;
5281 		} text;      /* type == subst_text */
5282 		size_t ref;  /* type == subst_ref */
5283 	} v;
5284 };
5285 
5286 static void
5287 add_text_segment(grad_list_t *lst, char *ptr, char *end)
5288 {
5289 	struct subst_segment *seg;
5290 	if (ptr >= end)
5291 		return;
5292 	seg = grad_emalloc(sizeof(*seg));
5293 	seg->type = subst_text;
5294 	seg->v.text.ptr = ptr;
5295 	seg->v.text.len = end - ptr;
5296 	grad_list_append(lst, seg);
5297 }
5298 
5299 static void
5300 add_match_segment(grad_list_t *lst)
5301 {
5302 	struct subst_segment *seg = grad_emalloc(sizeof(*seg));
5303 	seg->type = subst_match;
5304 	grad_list_append(lst, seg);
5305 }
5306 
5307 static void
5308 add_ref_segment(grad_list_t *lst, size_t ref)
5309 {
5310 	struct subst_segment *seg = grad_emalloc(sizeof(*seg));
5311 	seg->type = subst_ref;
5312 	seg->v.ref = ref;
5313 	grad_list_append(lst, seg);
5314 }
5315 
5316 grad_list_t *
5317 subst_create(char *text)
5318 {
5319 	char *p;
5320 	grad_list_t *lst = grad_list_create();
5321 	if (!lst)
5322 		return lst;
5323 
5324 	p = text;
5325 	while (*p) {
5326 		if (*p == '\\' && p[1]) {
5327 			if (p[1] == '&') {
5328 				add_text_segment(lst, text, p);
5329 				text = ++p;
5330 				p++;
5331 			} else if (p[1] == '\\') {
5332 				add_text_segment(lst, text, p+1);
5333 				p += 2;
5334 				text = p;
5335 			} else if (isdigit(p[1])) {
5336 				size_t ref;
5337 				char *q;
5338 
5339 				add_text_segment(lst, text, p);
5340 				ref = strtoul(p+1, &q, 10);
5341 				add_ref_segment(lst, ref);
5342 				text = p = q;
5343 			} else {
5344 				add_text_segment(lst, text, p);
5345 				text = ++p;
5346 			}
5347 		} else if (*p == '&') {
5348 			add_text_segment(lst, text, p);
5349 			add_match_segment(lst);
5350 			text = ++p;
5351 		} else
5352 			p++;
5353 	}
5354 	add_text_segment(lst, text, p);
5355 	return lst;
5356 }
5357 
5358 int
5359 seg_free(void *item, void *data ARG_UNUSED)
5360 {
5361 	grad_free(item);
5362 	return 0;
5363 }
5364 
5365 void
5366 subst_destroy(grad_list_t *lst)
5367 {
5368 	grad_list_destroy(&lst, seg_free, NULL);
5369 }
5370 
5371 void
5372 subst_run(grad_list_t *subst, size_t nsub,
5373 	  char **baseptr, char *arg)
5374 {
5375 	grad_iterator_t *itr = grad_iterator_create(subst);
5376 	struct subst_segment *seg;
5377 
5378 	for (seg = grad_iterator_first(itr); seg; seg = grad_iterator_next(itr)) {
5379 		switch (seg->type) {
5380 		case subst_text:
5381 			temp_space_copy(baseptr,
5382 					seg->v.text.ptr, seg->v.text.len);
5383 			break;
5384 
5385 		case subst_ref:
5386 			if (seg->v.ref >= nsub)
5387 				rw_error(_("Invalid backreference"));
5388 			temp_space_copy(baseptr,
5389 					arg + mach.pmatch[seg->v.ref].rm_so,
5390 					mach.pmatch[seg->v.ref].rm_eo -
5391 					  mach.pmatch[seg->v.ref].rm_so);
5392 			break;
5393 
5394 		case subst_match:
5395 			temp_space_copy(baseptr,
5396 					arg + mach.pmatch[0].rm_so,
5397 					mach.pmatch[0].rm_eo -
5398 					  mach.pmatch[0].rm_so);
5399 		}
5400 	}
5401 	grad_iterator_destroy(&itr);
5402 }
5403 
5404 static void
5405 bi_gsub()
5406 {
5407 	grad_string_t re_str;
5408 	grad_string_t repl;
5409 	grad_string_t arg;
5410 	char *p;
5411 	char *base;
5412 	regex_t rx;
5413 	grad_list_t *subst;
5414 	int rc;
5415 
5416 	mem2string(&re_str, (RWSTYPE*) getarg(3));
5417 	mem2string(&repl, (RWSTYPE*) getarg(2));
5418 	mem2string(&arg, (RWSTYPE*) getarg(1));
5419 	p = arg.data;
5420 
5421         rc = regcomp(&rx, re_str.data, regcomp_flags);
5422         if (rc)
5423 		rw_regerror(_("regexp compile error: "), &rx, rc);
5424 
5425 	need_pmatch(rx.re_nsub);
5426 
5427 	subst = subst_create(repl.data);
5428 	if (!subst)
5429 		rw_error(_("gsub: not enough memory"));
5430 
5431 	base = temp_space_create();
5432 	while (*p
5433 	       && regexec(&rx, p, rx.re_nsub + 1, mach.pmatch, 0) == 0) {
5434 		temp_space_copy(&base, p, mach.pmatch[0].rm_so);
5435 		subst_run(subst, rx.re_nsub + 1, &base, p);
5436 		p += mach.pmatch[0].rm_eo;
5437 		if (mach.pmatch[0].rm_eo == 0)
5438 			p++;
5439 	}
5440 	temp_space_copy(&base, p, strlen(p) + 1);
5441 	subst_destroy(subst);
5442 	regfree(&rx);
5443 
5444 	pushn((RWSTYPE)temp_space_fix(base));
5445 }
5446 
5447 static void
5448 bi_sub()
5449 {
5450 	grad_string_t re_str;
5451 	grad_string_t repl;
5452 	grad_string_t arg;
5453 	char *p;
5454 	char *base;
5455 	regex_t rx;
5456 	grad_list_t *subst;
5457 	int rc;
5458 
5459 	mem2string(&re_str, (RWSTYPE*) getarg(3));
5460 	mem2string(&repl, (RWSTYPE*) getarg(2));
5461 	mem2string(&arg, (RWSTYPE*) getarg(1));
5462 
5463         rc = regcomp(&rx, re_str.data, regcomp_flags);
5464         if (rc)
5465 		rw_regerror(_("regexp compile error: "), &rx, rc);
5466 
5467 	need_pmatch(rx.re_nsub);
5468 
5469 	subst = subst_create(repl.data);
5470 	if (!subst)
5471 		rw_error(_("sub: not enough memory"));
5472 
5473 	base = temp_space_create();
5474 	p = arg.data;
5475 	if (regexec(&rx, p, rx.re_nsub + 1, mach.pmatch, 0) == 0) {
5476 		temp_space_copy(&base, p, mach.pmatch[0].rm_so);
5477 		subst_run(subst, rx.re_nsub + 1, &base, p);
5478 		p += mach.pmatch[0].rm_eo;
5479 	}
5480 	temp_space_copy(&base, p, strlen(p) + 1);
5481 	subst_destroy(subst);
5482 	regfree(&rx);
5483 
5484 	pushn((RWSTYPE)temp_space_fix(base));
5485 }
5486 
5487 #define ISPRINT(c) (((unsigned char)c) < 128 && (isalnum(c) || c == '-'))
5488 
5489 static void
5490 bi_qprn()
5491 {
5492 	grad_string_t arg;
5493 	char *p, *s, *end;
5494 	size_t count;
5495 	RWSTYPE *sp;
5496 
5497 	mem2string(&arg, (RWSTYPE*)getarg(1));
5498 	end = arg.data + arg.size;
5499 	for (count = 0, p = arg.data; p < end; p++)
5500 		if (!ISPRINT(*p))
5501 			count++;
5502 
5503 	/* Each encoded character takes 3 bytes. */
5504 	sp = heap_reserve(sizeof(RWSTYPE) + arg.size + 2*count + 1);
5505 	sp[0] = arg.size + 2*count;
5506 	pushn((RWSTYPE) sp);
5507 
5508 	for (p = (char*)(sp + 1), s = arg.data; s < end; s++) {
5509 		if (ISPRINT(*s))
5510 			*p++ = *s;
5511 		else {
5512 			char buf[3];
5513 			snprintf(buf, sizeof buf, "%02X", *(unsigned char*)s);
5514 			*p++ = '%';
5515 			*p++ = buf[0];
5516 			*p++ = buf[1];
5517 		}
5518 	}
5519 	*p = 0;
5520 }
5521 
5522 static void
5523 bi_quote_string()
5524 {
5525 	int quote;
5526 	grad_string_t arg;
5527 	RWSTYPE *sp;
5528 	char *p;
5529 	size_t size;
5530 
5531 	mem2string(&arg, (RWSTYPE*)getarg(1));
5532 	size = grad_argcv_quoted_length_n(arg.data, arg.size, &quote);
5533 	sp = heap_reserve(sizeof(RWSTYPE) + size + 1);
5534 	sp[0] = size;
5535 	pushn((RWSTYPE)sp);
5536 	p = (char*)(sp + 1);
5537 	grad_argcv_quote_copy_n(p, arg.data, arg.size);
5538 }
5539 
5540 static void
5541 bi_unquote_string()
5542 {
5543 	int quote;
5544 	grad_string_t arg;
5545 	RWSTYPE *sp;
5546 	char *p;
5547 	size_t size;
5548 
5549 	mem2string(&arg, (RWSTYPE*)getarg(1));
5550 	sp = heap_reserve(sizeof(RWSTYPE) +  arg.size + 1);
5551 	p = (char*)(sp + 1);
5552 	grad_argcv_unquote_copy(p, arg.data, arg.size);
5553 	sp[0] = strlen(p);
5554 	pushn((RWSTYPE)sp);
5555 }
5556 
5557 static void
5558 bi_textdomain()
5559 {
5560 	grad_string_t s;
5561 	mem2string(&s, (RWSTYPE*)getarg(1));
5562 	pushstr(default_gettext_domain, strlen (default_gettext_domain));
5563 	grad_string_replace(&default_gettext_domain, s.data);
5564 }
5565 
5566 static void
5567 bi_gettext()
5568 {
5569 	grad_string_t s;
5570 	const char *p;
5571 
5572 	mem2string(&s, (RWSTYPE*)getarg(1));
5573 	p = dgettext(default_gettext_domain, s.data);
5574 	pushstr(p, strlen(p));
5575 }
5576 
5577 static void
5578 bi_dgettext()
5579 {
5580 	grad_string_t domain;
5581 	grad_string_t text;
5582 	const char *p;
5583 
5584 	mem2string(&domain, (RWSTYPE*)getarg(2));
5585 	mem2string(&text, (RWSTYPE*)getarg(1));
5586 	p = dgettext(domain.data, text.data);
5587 	pushstr(p, strlen(p));
5588 }
5589 
5590 
5591 static void
5592 bi_ngettext()
5593 {
5594 	grad_string_t s;
5595 	grad_string_t pl;
5596 	unsigned long n;
5597 	const char *p;
5598 
5599 	mem2string(&s, (RWSTYPE*)getarg(3));
5600 	mem2string(&pl, (RWSTYPE*)getarg(2));
5601 	n = (unsigned long) getarg(1);
5602 	p = dngettext(default_gettext_domain,
5603 		      s.data,
5604 		      pl.data,
5605 		      n);
5606 	pushstr(p, strlen(p));
5607 }
5608 
5609 static void
5610 bi_dngettext()
5611 {
5612 	grad_string_t domain;
5613 	grad_string_t s;
5614 	grad_string_t pl;
5615 	unsigned long n;
5616 	const char *p;
5617 
5618 	mem2string(&domain, (RWSTYPE*)getarg(4));
5619 	mem2string(&s, (RWSTYPE*)getarg(3));
5620 	mem2string(&pl, (RWSTYPE*)getarg(2));
5621 	n = (unsigned long) getarg(1);
5622 
5623         p = dngettext(domain.data, s.data, pl.data, n);
5624 	pushstr(p, strlen(p));
5625 }
5626 
5627 static builtin_t builtin[] = {
5628         { bi_length,  "length", Integer, "s" },
5629 	{ bi_index,   "index",  Integer, "si" },
5630         { bi_rindex,  "rindex", Integer, "si" },
5631         { bi_substr,  "substr", String,  "sii" },
5632         { bi_logit,   "logit",  Integer, "s" },
5633         { bi_field,   "field",  String,  "si" },
5634 	{ bi_ntohl, "ntohl", Integer, "i" },
5635 	{ bi_htonl, "htonl", Integer, "i" },
5636 	{ bi_ntohs, "ntohs", Integer, "i" },
5637 	{ bi_htons, "htons", Integer, "i" },
5638 	{ bi_inet_ntoa, "inet_ntoa", String, "i" },
5639 	{ bi_inet_aton, "inet_aton", Integer, "s" },
5640 	{ bi_sub, "sub", String, "sss" },
5641 	{ bi_gsub, "gsub", String, "sss" },
5642 	{ bi_qprn, "qprn", String, "s" },
5643 	{ bi_tolower, "tolower", String, "s" },
5644 	{ bi_toupper, "toupper", String, "s" },
5645 	{ bi_unquote_string, "unquote_string", String, "s" },
5646 	{ bi_quote_string, "quote_string", String, "s" },
5647 	{ bi_request_code_string, "request_code_string", String, "i" },
5648 	/* i18n support */
5649 	{ bi_gettext, "gettext", String, "s" },
5650 	{ bi_gettext, "_", String, "s" },
5651 	{ bi_dgettext, "dgettext", String, "ss" },
5652 	{ bi_ngettext, "ngettext", String, "ssi" },
5653 	{ bi_dngettext, "dngettext", String, "sssi" },
5654 	{ bi_textdomain, "textdomain", String, "s" },
5655 	/* Request internals */
5656 	{ bi_request_source_ip,   "request_source_ip", Integer, "" },
5657 	{ bi_request_source_port, "request_source_port", Integer, "" },
5658 	{ bi_request_id, "request_id", Integer, "" },
5659 	{ bi_request_code, "request_code", Integer, "" },
5660 	/* Radius database */
5661 	{ bi_nas_name, "nas_name", String, "i" },
5662 	{ bi_nas_short_name, "nas_short_name", String, "i" },
5663 	{ bi_nas_full_name, "nas_full_name", String, "i" },
5664 	/* DNS lookups */
5665 	{ bi_gethostbyaddr, "gethostbyaddr", Integer, "s" },
5666 	{ bi_gethostbyname, "gethostbyname", String, "i" },
5667 	/* Time functions */
5668 	{ bi_time, "time", Integer, "" },
5669 	{ bi_strftime, "strftime", String, "si" },
5670 	{ NULL }
5671 };
5672 
5673 builtin_t *
5674 builtin_lookup(char *name)
5675 {
5676         int i;
5677 
5678         for (i = 0; builtin[i].handler; i++)
5679                 if (strcmp(name, builtin[i].name) == 0)
5680                         return &builtin[i];
5681         return NULL;
5682 }
5683 
5684 
5685 /* ****************************************************************************
5686  * Function registering/unregistering
5687  */
5688 
5689 int
5690 function_free(FUNCTION *f)
5691 {
5692         PARAMETER *parm, *next;
5693 
5694         rx_free(f->rx_list);
5695         parm = f->parm;
5696         while (parm) {
5697                 next = parm->next;
5698                 grad_free(parm);
5699                 parm = next;
5700         }
5701         return 0;
5702 }
5703 
5704 FUNCTION *
5705 function_install(FUNCTION *fun)
5706 {
5707         FUNCTION *fp;
5708 
5709         if (fp = (FUNCTION *)grad_sym_lookup(rewrite_tab, fun->name)) {
5710                 grad_log_loc(GRAD_LOG_ERR, &fun->loc,
5711 			     _("redefinition of function %s"));
5712                 grad_log_loc(GRAD_LOG_ERR, &fp->loc,
5713 			     _("previously defined here"));
5714                 errcnt++;
5715                 return fp;
5716         }
5717         fp = (FUNCTION*)grad_sym_install(rewrite_tab, fun->name);
5718 
5719         fp->rettype = fun->rettype;
5720         fp->entry   = fun->entry;
5721         fp->rx_list = fun->rx_list;
5722         fp->nparm   = fun->nparm;
5723         fp->parm    = fun->parm;
5724         fp->stack_alloc = fun->stack_alloc;
5725 	fp->loc     = fun->loc;
5726         return fp;
5727 }
5728 
5729 
5730 /* ****************************************************************************
5731  * Runtime functions
5732  */
5733 
5734 static char pair_print_prefix[] = "    ";
5735 
5736 static void
5737 rw_mach_init()
5738 {
5739 	memset(&mach, 0, sizeof(mach));
5740 
5741 	if (!runtime_stack)
5742 		runtime_stack = grad_emalloc(rewrite_stack_size *
5743 					     sizeof(runtime_stack[0]));
5744 
5745 	mach.stack = runtime_stack;
5746         mach.st = 0;                      /* Stack top */
5747         mach.ht = rewrite_stack_size - 1; /* Heap top */
5748 
5749 	grad_string_replace(&default_gettext_domain, PACKAGE);
5750 }
5751 
5752 static void
5753 rw_mach_destroy()
5754 {
5755 	grad_free(mach.pmatch);
5756 	mach.pmatch = NULL;
5757 }
5758 
5759 FUNCTION *
5760 rewrite_check_function(const char *name, grad_data_type_t rettype, char *typestr)
5761 {
5762 	int i;
5763 	PARAMETER *p;
5764 
5765 	FUNCTION *fun = (FUNCTION*) grad_sym_lookup(rewrite_tab, name);
5766         if (!fun) {
5767                 grad_log(GRAD_LOG_ERR, _("function %s not defined"), name);
5768                 return NULL;
5769         }
5770 	if (fun->rettype != rettype) {
5771 		grad_log(GRAD_LOG_ERR, _("function %s returns wrong data type"), name);
5772 		return NULL;
5773 	}
5774 
5775 	for (i = 0, p = fun->parm; i < fun->nparm; i++, p = p->next) {
5776                 switch (typestr[i]) {
5777 		case 0:
5778 			grad_log(GRAD_LOG_ERR,
5779 			         _("function %s takes too many arguments"),
5780 			         name);
5781 			return NULL;
5782 
5783                 case 'i':
5784                         if (p->datatype != Integer) {
5785 				grad_log(GRAD_LOG_ERR,
5786 				         _("function %s: argument %d must be integer"),
5787 				         name, i+1);
5788 				return NULL;
5789 			}
5790                         break;
5791 
5792                 case 's':
5793                         if (p->datatype != String) {
5794 				grad_log(GRAD_LOG_ERR,
5795 				         _("function %s: argument %d must be string"),
5796 				         name, i+1);
5797 				return NULL;
5798 			}
5799                         break;
5800 
5801                 default:
5802                         grad_insist_fail("bad datatype");
5803                 }
5804         }
5805 
5806 	if (typestr[i]) {
5807 		grad_log(GRAD_LOG_ERR,
5808 		         _("function %s takes too few arguments"),
5809 		         name);
5810 		return NULL;
5811 	}
5812 
5813 	return fun;
5814 }
5815 
5816 int
5817 run_init(pctr_t pc, grad_request_t *request)
5818 {
5819         FILE *fp;
5820 
5821 	rw_mach_init();
5822         if (setjmp(mach.jmp)) {
5823 		rw_mach_destroy();
5824                 return -1;
5825 	}
5826 
5827         mach.req = request;
5828         if (GRAD_DEBUG_LEVEL(2)) {
5829                 fp = debug_open_file();
5830                 fprintf(fp, "Before rewriting:\n");
5831                 grad_avl_fprint(fp, pair_print_prefix, 1, AVPLIST(&mach));
5832                 fclose(fp);
5833         }
5834 
5835         /* Imitate a function call */
5836         pushn(0);                  /* Return address */
5837         run(pc);                   /* call function */
5838         if (GRAD_DEBUG_LEVEL(2)) {
5839                 fp = debug_open_file();
5840                 fprintf(fp, "After rewriting\n");
5841                 grad_avl_fprint(fp, pair_print_prefix, 1, AVPLIST(&mach));
5842                 fclose(fp);
5843         }
5844 	rw_mach_destroy();
5845 	return 0;
5846 }
5847 
5848 static void
5849 return_value(grad_value_t *val)
5850 {
5851 	u_char *p;
5852 
5853 	switch (val->type) {
5854 	case Integer:
5855 		val->datum.ival = mach.rA;
5856 		break;
5857 
5858 	case String:
5859 		mem2string(&val->datum.sval, (RWSTYPE*) mach.rA);
5860 		p = grad_emalloc (val->datum.sval.size + 1);
5861 		memcpy (p, val->datum.sval.data, val->datum.sval.size);
5862 		p[val->datum.sval.size] = 0;
5863 		val->datum.sval.data = p;
5864 		break;
5865 
5866 	default:
5867 		abort();
5868 	}
5869 }
5870 
5871 static int
5872 evaluate(pctr_t pc, grad_request_t *req, grad_value_t *val)
5873 {
5874         if (run_init(pc, req))
5875 		return -1;
5876 	if (val)
5877 		return_value(val);
5878         return 0;
5879 }
5880 
5881 int
5882 rewrite_invoke(grad_data_type_t rettype, grad_value_t *val,
5883 	       const char *name,
5884 	       grad_request_t *request, char *typestr, ...)
5885 {
5886         FILE *fp;
5887         va_list ap;
5888         FUNCTION *fun;
5889         int nargs;
5890         char *s;
5891 
5892         fun = rewrite_check_function(name, rettype, typestr);
5893 	if (!fun)
5894 		return -1;
5895 
5896 	rw_mach_init();
5897         if (setjmp(mach.jmp)) {
5898                 rw_mach_destroy();
5899                 return -1;
5900         }
5901 
5902         mach.req = request;
5903         if (GRAD_DEBUG_LEVEL(2)) {
5904                 fp = debug_open_file();
5905                 fprintf(fp, "Before rewriting:\n");
5906                 grad_avl_fprint(fp, pair_print_prefix, 1, AVPLIST(&mach));
5907                 fclose(fp);
5908         }
5909 
5910         /* Pass arguments */
5911         nargs = 0;
5912 
5913 	va_start(ap, typestr);
5914         while (*typestr) {
5915                 nargs++;
5916                 switch (*typestr++) {
5917                 case 'i':
5918                         pushn(va_arg(ap, int));
5919                         break;
5920                 case 's':
5921                         s = va_arg(ap, char*);
5922                         pushstr(s, strlen(s));
5923                         break;
5924                 default:
5925                         grad_insist_fail("bad datatype");
5926                 }
5927         }
5928         va_end(ap);
5929 
5930         /* Imitate a function call */
5931         pushn(0);                  /* Return address */
5932         run(fun->entry);           /* call function */
5933         if (GRAD_DEBUG_LEVEL(2)) {
5934                 fp = debug_open_file();
5935                 fprintf(fp, "After rewriting\n");
5936                 grad_avl_fprint(fp, pair_print_prefix, 1, AVPLIST(&mach));
5937                 fclose(fp);
5938         }
5939 	val->type = fun->rettype;
5940 	return_value(val);
5941         rw_mach_destroy();
5942         return 0;
5943 }
5944 
5945 char *
5946 rewrite_compile(char *expr)
5947 {
5948 	int rc;
5949 	FUNCTION *fun;
5950 	char *name = grad_emalloc(strlen(expr) + 3);
5951 
5952 	sprintf(name, "$%s$", expr);
5953         fun = (FUNCTION*) grad_sym_lookup(rewrite_tab, name);
5954         if (!fun) {
5955 		rc = parse_rewrite_string(expr);
5956 		if (rc) {
5957 			grad_free(name);
5958 			return NULL;
5959 		}
5960 		function->name = name;
5961 		function_install(function);
5962 	}
5963 	return name;
5964 }
5965 
5966 int
5967 rewrite_interpret(char *expr, grad_request_t *req, grad_value_t *val)
5968 {
5969 	pctr_t save_pc = rw_pc;
5970 	int rc;
5971 
5972 	rc = parse_rewrite_string(expr);
5973 	rw_pc = save_pc;
5974 	if (rc)
5975 		return rc;
5976 
5977 	val->type = return_type;
5978 	if (return_type == Undefined)
5979 		return -1;
5980 
5981 	return evaluate(rw_pc, req, val);
5982 }
5983 
5984 int
5985 rewrite_eval(char *symname, grad_request_t *req, grad_value_t *val)
5986 {
5987         FUNCTION *fun;
5988 
5989         fun = (FUNCTION*) grad_sym_lookup(rewrite_tab, symname);
5990         if (!fun)
5991 		return -1;
5992 
5993 	if (fun->nparm) {
5994 		grad_log(GRAD_LOG_ERR,
5995 		         ngettext("function %s() requires %d parameter",
5996 				  "function %s() requires %d parameters",
5997 				  fun->nparm),
5998 		         fun->name, fun->nparm);
5999 		return -1;
6000 	}
6001 
6002 	if (val)
6003 		val->type = fun->rettype;
6004 	return evaluate(fun->entry, req, val);
6005 }
6006 
6007 
6008 /* ****************************************************************************
6009  * Configuration
6010  */
6011 
6012 static grad_list_t *source_list;        /* List of loaded source files */
6013 static grad_list_t *rewrite_load_path;  /* Load path list */
6014 
6015 /* Add a path to load path */
6016 static void
6017 rewrite_add_load_path(const char *str)
6018 {
6019 	if (!rewrite_load_path)
6020 		rewrite_load_path = grad_list_create();
6021 	grad_list_append(rewrite_load_path, grad_estrdup(str));
6022 }
6023 
6024 void
6025 register_source_name(char *path)
6026 {
6027 	if (!source_list)
6028 		source_list = grad_list_create();
6029 	grad_list_append(source_list, path);
6030 }
6031 
6032 struct load_data {
6033 	int rc;
6034 	char *name;
6035 };
6036 
6037 /* Try to load a source file.
6038    ITEM is a directory name, DATA is struct load_data.
6039    Return 1 if the file was found (no matter was it loaded or not) */
6040 static int
6041 try_load(void *item, void *data)
6042 {
6043 	int rc = 0;
6044 	struct load_data *lp = data;
6045 	char *path = grad_mkfilename((char*)item, lp->name);
6046 
6047 	lp->rc = parse_rewrite(path);
6048 	if (lp->rc >= 0) {
6049 		register_source_name(path);
6050 		rc = 1;
6051 	} else
6052 		grad_free(path);
6053 	return rc;
6054 }
6055 
6056 /* Load the given rewrite module. */
6057 int
6058 rewrite_load_module(char *name)
6059 {
6060 	int rc;
6061 	if (name[0] == '/') {
6062 		register_source_name(grad_estrdup(name));
6063 		rc = parse_rewrite(name);
6064 	} else {
6065 		struct load_data ld;
6066 		ld.rc = 1;
6067 		ld.name = name;
6068 		grad_list_iterate(rewrite_load_path, try_load, &ld);
6069 		rc = ld.rc;
6070 	}
6071 	return rc;
6072 }
6073 
6074 static int
6075 free_path(void *item, void *data ARG_UNUSED)
6076 {
6077 	grad_free(item);
6078 	return 0;
6079 }
6080 
6081 static grad_list_t *source_candidate_list; /* List of modules that are to
6082 					      be loaded */
6083 
6084 int
6085 rewrite_stmt_term(int finish, void *block_data, void *handler_data)
6086 {
6087 	if (!finish) {
6088 		grad_symtab_clear(rewrite_tab);
6089 
6090 		yydebug = GRAD_DEBUG_LEVEL(50);
6091 		grad_list_destroy(&source_list, free_path, NULL);
6092 		grad_list_destroy(&rewrite_load_path, free_path, NULL);
6093 		rewrite_add_load_path(grad_config_dir);
6094 		rewrite_add_load_path(RADIUS_DATADIR "/rewrite");
6095 
6096 		grad_free(runtime_stack);
6097 		runtime_stack = NULL;
6098 	}
6099 	return 0;
6100 }
6101 
6102 static int
6103 rewrite_cfg_add_load_path(int argc, cfg_value_t *argv,
6104 			  void *block_data, void *handler_data)
6105 {
6106 	if (argc > 2) {
6107 		cfg_argc_error(0);
6108 		return 0;
6109 	}
6110 
6111  	if (argv[1].type != CFG_STRING) {
6112 		cfg_type_error(CFG_STRING);
6113 		return 0;
6114 	}
6115 
6116 	rewrite_add_load_path(argv[1].v.string);
6117 	return 0;
6118 }
6119 
6120 static int
6121 rewrite_cfg_load(int argc, cfg_value_t *argv,
6122 		 void *block_data, void *handler_data)
6123 {
6124 	if (argc > 2) {
6125 		cfg_argc_error(0);
6126 		return 0;
6127 	}
6128 
6129  	if (argv[1].type != CFG_STRING) {
6130 		cfg_type_error(CFG_STRING);
6131 		return 0;
6132 	}
6133 
6134 	grad_list_append(source_candidate_list, grad_estrdup(argv[1].v.string));
6135 	return 0;
6136 }
6137 
6138 /* Configuration hooks and initialization */
6139 
6140 static void
6141 rewrite_before_config_hook(void *a ARG_UNUSED, void *b ARG_UNUSED)
6142 {
6143 	grad_list_destroy(&source_candidate_list, free_path, NULL);
6144 	source_candidate_list = grad_list_create();
6145 	code_init();
6146 }
6147 
6148 static int
6149 _load_module(void *item, void *data ARG_UNUSED)
6150 {
6151 	if (rewrite_load_module(item) == -2)
6152 		grad_log(GRAD_LOG_ERR, _("file not found: %s"), item);
6153 	return 0;
6154 }
6155 
6156 void
6157 rewrite_load_all(void *a ARG_UNUSED, void *b ARG_UNUSED)
6158 {
6159 	if (!source_candidate_list)
6160 		return;
6161 
6162 	/* For compatibility with previous versions load the
6163 	   file $grad_config_dir/rewrite, if no explicit "load" statements
6164 	   were given */
6165 	if (grad_list_count(source_candidate_list) == 0)
6166 		rewrite_load_module("rewrite");
6167 
6168 	grad_list_iterate(source_candidate_list, _load_module, NULL);
6169 #if defined(MAINTAINER_MODE)
6170         if (GRAD_DEBUG_LEVEL(100))
6171                 debug_dump_code();
6172 #endif
6173 }
6174 
6175 void
6176 rewrite_init()
6177 {
6178 	rewrite_tab = grad_symtab_create(sizeof(FUNCTION), function_free);
6179 	radiusd_set_preconfig_hook(rewrite_before_config_hook, NULL, 0);
6180 }
6181 
6182 
6183 struct cfg_stmt rewrite_stmt[] = {
6184 	{ "stack-size", CS_STMT, NULL, cfg_get_number, &rewrite_stack_size,
6185 	  NULL, NULL },
6186 	{ "load-path", CS_STMT, NULL, rewrite_cfg_add_load_path, NULL, NULL, NULL },
6187 	{ "load", CS_STMT, NULL, rewrite_cfg_load, NULL, NULL, NULL },
6188 	{ NULL, }
6189 };
6190 
6191 size_t
6192 rewrite_get_stack_size()
6193 {
6194 	return rewrite_stack_size;
6195 }
6196 
6197 void
6198 rewrite_set_stack_size(size_t s)
6199 {
6200 	if (s == rewrite_stack_size)
6201 		return;
6202 	rewrite_stack_size = s;
6203 	grad_free(runtime_stack);
6204 	runtime_stack = NULL;
6205 }
6206 
6207 void
6208 grad_value_free(grad_value_t *val)
6209 {
6210 	if (val->type == String)
6211 		grad_free(val->datum.sval.data);
6212 }
6213 
6214 
6215 /* ****************************************************************************
6216  * Guile interface
6217  */
6218 #ifdef USE_SERVER_GUILE
6219 
6220 SCM
6221 radscm_datum_to_scm(grad_value_t *val)
6222 {
6223         switch (val->type) {
6224         case Integer:
6225                 return scm_from_long(val->datum.ival);
6226 
6227         case String:
6228 		/* FIXME! */
6229                 return scm_makfrom0str(val->datum.sval.data);
6230 
6231 	default:
6232 		grad_insist_fail("Unknown data type");
6233         }
6234         return SCM_UNSPECIFIED;
6235 }
6236 
6237 int
6238 radscm_scm_to_ival(SCM cell, int *val)
6239 {
6240         if (SCM_IMP(cell)) {
6241                 if (SCM_INUMP(cell))
6242                         *val = SCM_INUM(cell);
6243                 else if (SCM_BIGP(cell))
6244                         *val = (grad_uint32_t) scm_i_big2dbl(cell);
6245                 else if (SCM_CHARP(cell))
6246                         *val = SCM_CHAR(cell);
6247                 else if (cell == SCM_BOOL_F)
6248                         *val = 0;
6249                 else if (cell == SCM_BOOL_T)
6250                         *val = 1;
6251                 else if (cell == SCM_EOL)
6252                         *val =0;
6253                 else
6254                         return -1;
6255         } else {
6256                 if (scm_is_string(cell)) {
6257                         char *p;
6258                         *val = strtol(scm_i_string_chars(cell), &p, 0);
6259                         if (*p)
6260                                 return -1;
6261                 } else
6262                         return -1;
6263         }
6264         return 0;
6265 }
6266 
6267 SCM
6268 radscm_rewrite_execute(const char *func_name, SCM ARGS)
6269 {
6270         const char *name;
6271         FUNCTION *fun;
6272         PARAMETER *parm;
6273         int nargs;
6274         int n, rc;
6275         grad_value_t value;
6276         SCM cell;
6277         SCM FNAME;
6278 	SCM retval;
6279 
6280         FNAME = SCM_CAR(ARGS);
6281         ARGS  = SCM_CDR(ARGS);
6282         SCM_ASSERT(scm_is_string(FNAME), FNAME, SCM_ARG1, func_name);
6283 
6284         name = scm_i_string_chars(FNAME);
6285         fun = (FUNCTION*) grad_sym_lookup(rewrite_tab, name);
6286         if (!fun)
6287                 scm_misc_error(func_name,
6288                                _("function ~S not defined"),
6289                                scm_list_1(FNAME));
6290 
6291         rw_mach_init();
6292 
6293         /* Pass arguments */
6294         nargs = 0;
6295         parm = fun->parm;
6296 
6297         for (cell = ARGS; cell != SCM_EOL;
6298 	     cell = SCM_CDR(cell), parm = parm->next) {
6299                 SCM car = SCM_CAR(cell);
6300 
6301                 if (++nargs > fun->nparm) {
6302                         rw_code_unlock();
6303                         scm_misc_error(func_name,
6304                                        _("too many arguments for ~S"),
6305                                        scm_list_1(FNAME));
6306                 }
6307 
6308                 switch (parm->datatype) {
6309                 case Integer:
6310                         rc = radscm_scm_to_ival(car, &n);
6311                         if (!rc)
6312                                 pushn(n);
6313                         break;
6314 
6315                 case String:
6316                         if (scm_is_string(car)) {
6317                                 const char *p = scm_i_string_chars(car);
6318                                 pushstr(p, strlen(p));
6319                                 rc = 0;
6320                         } else
6321                                 rc = 1;
6322 			break;
6323 
6324 		default:
6325 			grad_insist_fail("Unknown data type");
6326                 }
6327 
6328                 if (rc) {
6329                         rw_mach_destroy();
6330                         scm_misc_error(func_name,
6331 				       _("type mismatch in argument ~S(~S) in call to ~S"),
6332                                        scm_list_3(scm_from_int(nargs),
6333 						  car,
6334 						  FNAME));
6335                 }
6336         }
6337 
6338         if (fun->nparm != nargs) {
6339 		rw_mach_destroy();
6340                 scm_misc_error(func_name,
6341                                _("too few arguments for ~S"),
6342                                scm_list_1(FNAME));
6343         }
6344 
6345         /* Imitate a function call */
6346         if (setjmp(mach.jmp)) {
6347                 rw_mach_destroy();
6348                 return SCM_BOOL_F;
6349         }
6350 
6351         pushn(0);                         /* Return address */
6352         run(fun->entry);                  /* call function */
6353 
6354 	value.type = fun->rettype;
6355 	return_value(&value);
6356 	retval = radscm_datum_to_scm(&value);
6357 	grad_value_free(&value);
6358 	rw_mach_destroy();
6359         return retval;
6360 }
6361 
6362 
6363 #endif
6364 
6365         /*HONY SOIT QUI MAL Y PENSE*/
6366