[BACK]Return to anal.c CVS log [TXT][DIR] Up to [local] / OpenXM_contrib / pari-2.2 / src / language

Diff for /OpenXM_contrib/pari-2.2/src/language/Attic/anal.c between version 1.2 and 1.3

version 1.2, 2002/07/25 08:06:08 version 1.3, 2002/09/11 07:27:02
Line 22  Foundation, Inc., 59 Temple Place - Suite 330, Boston,
Line 22  Foundation, Inc., 59 Temple Place - Suite 330, Boston,
 #include "anal.h"  #include "anal.h"
 #include "parinf.h"  #include "parinf.h"
   
   /* slightly more efficient than is_keyword_char. Not worth a static array. */
   #define is_key(c) (isalnum((int)(c)) || (c)=='_')
   
 #define separe(c) ((c)==';' || (c)==':')  #define separe(c) ((c)==';' || (c)==':')
 typedef GEN (*PFGEN)(ANYARG);  typedef GEN (*PFGEN)(ANYARG);
 typedef GEN (*F2GEN)(GEN,GEN);  typedef GEN (*F2GEN)(GEN,GEN);
Line 31  static GEN    constante();
Line 34  static GEN    constante();
 static GEN    expr();  static GEN    expr();
 static GEN    facteur();  static GEN    facteur();
 static GEN    identifier();  static GEN    identifier();
 static GEN    matrix_block(GEN p, entree *ep);  
 static GEN    read_member(GEN x);  static GEN    read_member(GEN x);
 static GEN    seq();  static GEN    seq();
 static GEN    truc();  static GEN    truc();
 static long   number(long *nb);  static long   number(long *nb);
 static void   doskipseq(char *s, int strict);  static void   doskipseq(char *s, int strict);
   static void   skip_matrix_block();
 static void   skipconstante();  static void   skipconstante();
 static void   skipexpr();  static void   skipexpr();
 static void   skipfacteur();  static void   skipfacteur();
Line 50  static entree *installep(void *f,char *name,int l,int 
Line 53  static entree *installep(void *f,char *name,int l,int 
 static entree *skipentry(void);  static entree *skipentry(void);
   
 extern void killbloc0(GEN x, int inspect);  extern void killbloc0(GEN x, int inspect);
 extern char *GENtostr0(GEN x, void(*do_out)(GEN));  extern int term_width(void);
   extern GEN addsmulsi(long a, long b, GEN Y);
   
 /* last time we began parsing an object of specified type */  /* last time we began parsing an object of specified type */
 static struct  static struct
Line 61  static struct
Line 65  static struct
 /* when skipidentifier() detects that user function f() is being redefined,  /* when skipidentifier() detects that user function f() is being redefined,
  * (f()= ... ) this is set pointing to the opening parenthesis. Checked in   * (f()= ... ) this is set pointing to the opening parenthesis. Checked in
  * identifier(). Otherwise definition like f(x=1)= would change the value of   * identifier(). Otherwise definition like f(x=1)= would change the value of
  * global variable x   * global variable x */
  */  
 static char *redefine_fun = NULL;  static char *redefine_fun = NULL;
   
 /* points to the part of the string that remains to be parsed */  /* points to the part of the string that remains to be parsed */
Line 75  static long skipping_fun_def;
Line 78  static long skipping_fun_def;
  * being checked). Used by the compatibility engine in the following way:   * being checked). Used by the compatibility engine in the following way:
  *   when user types in a function whose name has changed, it is understood   *   when user types in a function whose name has changed, it is understood
  *   as EpNEW; first syntax error (missing = after function definition   *   as EpNEW; first syntax error (missing = after function definition
  *   usually) triggers err_new_fun() if check_new_fun is set.   *   usually) triggers err_new_fun() if check_new_fun is set. */
  */  
 static entree *check_new_fun;  static entree *check_new_fun;
   
 /* for control statements (check_break) */  /* for control statements (check_break) */
 static long br_status, br_count;  static long br_status, br_count;
 static GEN br_res = NULL;  static GEN br_res = NULL;
   
   /* Mnemonic codes parser:
    *
    * TEMPLATE is assumed to be ";"-separated list of items.  Each item
    * may have one of the following forms: id=value id==value id|value id&~value.
    * Each id consists of alphanum characters, dashes and underscores.
    * IDs are case-sensitive.
   
    * ARG consists of several IDs separated by punctuation (and optional
    * whitespace).  Each modifies the return value in a "natural" way: an
    * ID from id=value should be the first in the sequence and sets RETVAL to
    * VALUE (and cannot be negated), ID from id|value bit-ORs RETVAL with
    * VALUE (and bit-ANDs RETVAL with ~VALUE if negated), ID from
    * id&~value behaves as if it were noid|value, ID from
    * id==value behaves the same as id=value, but should come alone.
   
    * For items of the form id|value and id&~value negated forms are
    * allowed: either when arg looks like no[-_]id, or when id looks like
    * this, and arg is not-negated. */
   
   enum { A_ACTION_ASSIGN, A_ACTION_SET, A_ACTION_UNSET };
   enum { PARSEMNU_TEMPL_TERM_NL, PARSEMNU_ARG_WHITESP };
   #define IS_ID(c)        (isalnum((int)c) || ((c) == '_') || ((c) == '-'))
   #define ERR(reason)     STMT_START {    \
       if (failure && first) {             \
           *failure = reason; *failure_arg = NULL; return 0;               \
       } else err(talker,reason); } STMT_END
   #define ERR2(reason,s)  STMT_START {    \
       if (failure && first) {             \
           *failure = reason; *failure_arg = s; return 0;          \
       } else err(talker,reason,s); } STMT_END
   
   unsigned long
   parse_option_string(char *arg, char *template, long flag, char **failure, char **failure_arg)
   {
       unsigned long retval = 0;
       char *etemplate = NULL;
   
       if (flag & PARSEMNU_TEMPL_TERM_NL)
           etemplate = strchr(template, '\n');
       if (!etemplate)
           etemplate = template + strlen(template);
   
       if (failure)
           *failure = NULL;
       while (1) {
           long numarg;
           char *e, *id;
           char *negated;                  /* action found with 'no'-ID */
           int negate;                     /* Arg has 'no' prefix removed */
           int l, action = 0, first = 1, singleton = 0;
           char b[80], *buf, *inibuf;
   
           if (flag & PARSEMNU_ARG_WHITESP)
               while (isspace((int)*arg)) arg++;
           if (!*arg)
               break;
           e = arg;
           while (IS_ID(*e))
               e++;
           /* Now the ID is whatever is between arg and e. */
           l = e - arg;
           if (l >= sizeof(b))
               ERR("id too long in a stringified flag");
           if (!l)                         /* Garbage after whitespace? */
               ERR("a stringified flag does not start with an id");
           strncpy(b, arg, l);
           b[l] = 0;
           arg = e;
           e = inibuf = buf = b;
           while (('0' <= *e) && (*e <= '9'))
               e++;
           if (*e == 0)
               ERR("numeric id in a stringified flag");
           negate = 0;
           negated = NULL;
         find:
           id = template;
           while ((id = strstr(id, buf)) && id < etemplate) {
               if (IS_ID(id[l])) {         /* We do not allow abbreviations yet */
                   id = id + l;            /* False positive */
                   continue;
               }
               if ((id >= template + 2) && (IS_ID(id[-1]))) {
                   char *s = id;
   
                   if ( !negate && s >= template+3
                        && ((id[-1] == '_') || (id[-1] == '-')) )
                       s--;
                   /* Check whether we are preceeded by "no" */
                   if ( negate             /* buf initially started with "no" */
                        || (s < template+2) || (s[-1] != 'o') || (s[-2] != 'n')
                        || (s >= template+3 && IS_ID(s[-3]))) {
                       id = id + l;                /* False positive */
                       continue;
                   }
                   /* Found noID in the template! */
                   negated = id + l;
                   id = id + l;
                   continue;               /* Try to find without 'no'. */
               }
               /* Found as is */
               id = id + l;
               break;
           }
           if ( !id && !negated && !negate
                && (l > 2) && buf[0] == 'n' && buf[1] == 'o' ) {
               /* Try to find the flag without the prefix "no". */
               buf += 2; l -= 2;
               if ((buf[0] == '_') || (buf[0] == '-')) { buf++; l--; }
               negate = 1;
               if (buf[0])
                   goto find;
           }
           if (!id && negated) {   /* Negated and AS_IS forms, prefer AS_IS */
               id = negated;       /* Otherwise, use negated form */
               negate = 1;
           }
           if (!id)
               ERR2("Unrecognized id '%s' in a stringified flag", inibuf);
           if (singleton && !first)
               ERR("Singleton id non-single in a stringified flag");
           if (id[0] == '=') {
               if (negate)
                   ERR("Cannot negate id=value in a stringified flag");
               if (!first)
                   ERR("Assign action should be first in a stringified flag");
               action = A_ACTION_ASSIGN;
               id++;
               if (id[0] == '=') {
                   singleton = 1;
                   id++;
               }
           } else if (id[0] == '^') {
               if (id[1] != '~')
                   err(talker, "Unrecognized action in a template");
               id += 2;
               if (negate)
                   action = A_ACTION_SET;
               else
                   action = A_ACTION_UNSET;
           } else if (id[0] == '|') {
               id++;
               if (negate)
                   action = A_ACTION_UNSET;
               else
                   action = A_ACTION_SET;
           }
   
           e = id;
   
           while ((*e >= '0' && *e <= '9')) e++;
           while (isspace((int)*e))
               e++;
           if (*e && (*e != ';') && (*e != ','))
               err(talker, "Non-numeric argument of an action in a template");
           numarg = atol(id);              /* Now it is safe to get it... */
           switch (action) {
           case A_ACTION_SET:
               retval |= numarg;
               break;
           case A_ACTION_UNSET:
               retval &= ~numarg;
               break;
           case A_ACTION_ASSIGN:
               retval = numarg;
               break;
           default:
               ERR("error in parse_option_string");
           }
           first = 0;
           if (flag & PARSEMNU_ARG_WHITESP)
               while (isspace((int)*arg))
                   arg++;
           if (*arg && !(ispunct((int)*arg) && *arg != '-'))
               ERR("Junk after an id in a stringified flag");
           /* Skip punctuation */
           if (*arg)
               arg++;
       }
       return retval;
   }
   
 /*  Special characters:  /*  Special characters:
  *     ' ', '\t', '\n', '\\' are forbidden internally (suppressed by filtre).   *     ' ', '\t', '\n', '\\' are forbidden internally (suppressed by filtre).
  *     { } are forbidden everywhere and will be used to denote optional   *     { } are forbidden everywhere and will be used to denote optional
Line 113  static GEN br_res = NULL;
Line 297  static GEN br_res = NULL;
  *  or    .entry   *  or    .entry
  *   *
  *  truc:   *  truc:
  *      ! truc   *      ! facteur
    *  or  # facteur
  *  or  ' entry   *  or  ' entry
  *  or  identifier   *  or  identifier
  *  or  constante   *  or  constante
Line 168  static GEN br_res = NULL;
Line 353  static GEN br_res = NULL;
  *      [0-9]+   *      [0-9]+
  */   */
 char*  char*
 _analyseur(void)  get_analyseur(void)
 {  {
   return analyseur;    return analyseur;
 }  }
   
 void  void
 _set_analyseur(char *s)  set_analyseur(char *s)
 {  {
   analyseur = s;    analyseur = s;
 }  }
Line 183  _set_analyseur(char *s)
Line 368  _set_analyseur(char *s)
 static GEN  static GEN
 lisseq0(char *t, GEN (*f)(void))  lisseq0(char *t, GEN (*f)(void))
 {  {
   const ulong av = avma;    const gpmem_t av = avma;
   char *olds = analyseur, *olde = mark.start;    char *olds = analyseur, *olde = mark.start;
   GEN res;    GEN res;
   
Line 205  lisseq0(char *t, GEN (*f)(void))
Line 390  lisseq0(char *t, GEN (*f)(void))
     return gerepilecopy(av, br_res);      return gerepilecopy(av, br_res);
   }    }
   if (res == NULL) { avma = av; return polx[fetch_user_var("NULL")]; }    if (res == NULL) { avma = av; return polx[fetch_user_var("NULL")]; }
     /* ep->value, beware: it may be killed anytime.  */
     if (isclone(res)) { avma = av; return forcecopy(res); }
   return gerepileupto(av, res);    return gerepileupto(av, res);
 }  }
   
Line 212  lisseq0(char *t, GEN (*f)(void))
Line 399  lisseq0(char *t, GEN (*f)(void))
 static GEN  static GEN
 flisseq0(char *s, GEN (*f)(void))  flisseq0(char *s, GEN (*f)(void))
 {  {
   char *t = filtre(s,NULL, f_INIT | f_REG);    char *t = filtre(s, (compatible == OLDALL));
   GEN x = lisseq0(t, f);    GEN x = lisseq0(t, f);
   free(t); return x;    free(t); return x;
 }  }
Line 226  GEN flisexpr(char *s){ return flisseq0(s, expr);}
Line 413  GEN flisexpr(char *s){ return flisseq0(s, expr);}
 GEN  GEN
 readseq(char *c, int strict)  readseq(char *c, int strict)
 {  {
     GEN z;
   check_new_fun=NULL; skipping_fun_def=0;    check_new_fun=NULL; skipping_fun_def=0;
   doskipseq(c, strict); return lisseq(c);    added_newline = 1;
     doskipseq(c, strict);
     z = lisseq0(c, seq); /* not lisseq: don't reset redefine_fun */
     if (!added_newline) pariputc('\n'); /* last output was print1() */
     return z;
 }  }
   
 entree *  entree *
Line 359  changevalue(entree *ep, GEN x)
Line 551  changevalue(entree *ep, GEN x)
   if (v == INITIAL) new_val_cell(ep,x, COPY_VAL);    if (v == INITIAL) new_val_cell(ep,x, COPY_VAL);
   else    else
   {    {
       x = gclone(x); /* beware: killbloc may destroy old x */
     if (v->flag == COPY_VAL) killbloc((GEN)ep->value); else v->flag = COPY_VAL;      if (v->flag == COPY_VAL) killbloc((GEN)ep->value); else v->flag = COPY_VAL;
     ep->value = (void*)gclone(x);      ep->value = (void*)x;
   }    }
 }  }
   
Line 440  kill0(entree *ep)
Line 633  kill0(entree *ep)
 static GEN  static GEN
 seq(void)  seq(void)
 {  {
   const ulong av = avma, lim = stack_lim(av,1);    const gpmem_t av = avma, lim = stack_lim(av,1);
   GEN res = gnil;    GEN res = gnil;
   
   for(;;)    for(;;)
Line 470  gshift_r(GEN x, GEN n) { return gshift(x,-itos(n)); }
Line 663  gshift_r(GEN x, GEN n) { return gshift(x,-itos(n)); }
 static GEN  static GEN
 expr(void)  expr(void)
 {  {
   ulong av = avma, lim = stack_lim(av,2);    gpmem_t av = avma, lim = stack_lim(av, 2);
   GEN aux,e,e1,e2,e3;    GEN aux,e,e1,e2,e3;
   F2GEN F1,F2,F3;    F2GEN F1,F2,F3;
   int F0 = 0;    int F0 = 0;
Line 606  err_match(char *s, char c)
Line 799  err_match(char *s, char c)
 }  }
   
 #define match2(s,c) if (*s != c) err_match(s,c);  #define match2(s,c) if (*s != c) err_match(s,c);
 #define match(c) do {match2(analyseur, c); analyseur++;} while (0)  #define match(c) \
     STMT_START { match2(analyseur, c); analyseur++; } STMT_END
   
 static long  static long
 readlong()  readlong()
 {  {
   const ulong av = avma;    const gpmem_t av = avma;
   const char *old = analyseur;    const char *old = analyseur;
   long m;    long m;
   GEN arg = expr();    GEN arg = expr();
Line 670  do_switch(int noparen, int matchcomma)
Line 864  do_switch(int noparen, int matchcomma)
 /**                          READ FUNCTIONS                        **/  /**                          READ FUNCTIONS                        **/
 /**                                                                **/  /**                                                                **/
 /********************************************************************/  /********************************************************************/
   typedef struct matcomp
   {
     GEN *ptcell;
     GEN parent;
     int full_col, full_row;
     void *extra; /* so far used by check_pointers only */
   } matcomp;
   
   /* Return the content of the matrix cell and sets members of corresponding
    * matrix component 'c'.  Assume *analyseur = '[' */
 static GEN  static GEN
   matcell(GEN p, matcomp *C)
   {
     GEN *pt = &p;
     long c,r, tx;
     int full_col, full_row;
     tx = full_col = full_row = 0;
     do {
       analyseur++; p = *pt; tx = typ(p);
       switch(tx)
       {
         case t_LIST:
           c = check_array_index(lgef(p)-1) + 1;
           pt = (GEN*)(p + c); match(']'); break;
   
         case t_VEC: case t_COL:
           c = check_array_index(lg(p));
           pt = (GEN*)(p + c); match(']'); break;
   
         case t_VECSMALL:
           c = check_array_index(lg(p));
           pt = (GEN*)(p + c); match(']');
           if (*analyseur == '[') err(caracer1,analyseur,mark.start);
           break;
   
         case t_MAT:
           if (lg(p)==1) err(talker2,"a 0x0 matrix has no elements",
                                     analyseur,mark.start);
           full_col = full_row = 0;
           if (*analyseur==',') /* whole column */
           {
             analyseur++;
             c = check_array_index(lg(p));
             match(']');
             if (*analyseur == '[')
             { /* collapse [,c][r] into [r,c] */
               analyseur++;
               r = check_array_index(lg(p));
               pt = (GEN*)(((GEN)p[c]) + r); /* &coeff(p,r,c) */
               match(']');
             }
             else
             {
               full_col = 1;
               pt = (GEN*)(p + c);
             }
             break;
           }
   
           r = check_array_index(lg(p[1]));
           match(',');
           if (*analyseur == ']') /* whole row */
           {
             analyseur++;
             if (*analyseur == '[')
             { /* collapse [r,][c] into [r,c] */
               analyseur++;
               c = check_array_index(lg(p));
               pt = (GEN*)(((GEN)p[c]) + r); /* &coeff(p,r,c) */
               match(']');
             }
             else
             {
               GEN p2 = cgetg(lg(p),t_VEC);
               full_row = r; /* record row number */
               for (c=1; c<lg(p); c++) p2[c] = coeff(p,r,c);
               pt = &p2;
             }
           }
           else
           {
             c = check_array_index(lg(p));
             pt = (GEN*)(((GEN)p[c]) + r); /* &coeff(p,r,c) */
             match(']');
           }
           break;
   
         default:
           err(caracer1,analyseur-1,mark.start);
       }
     } while (*analyseur == '[');
     C->full_row = full_row;
     C->full_col = full_col;
     C->parent = p; C->ptcell = pt;
     return (tx == t_VECSMALL)? stoi((long)*pt): *pt;
   }
   
   static GEN
 facteur(void)  facteur(void)
 {  {
   const char *old = analyseur;    const char *old = analyseur;
Line 697  facteur(void)
Line 987  facteur(void)
       case '^':        case '^':
         analyseur++; p1 = facteur();          analyseur++; p1 = facteur();
         if (br_status) err(breaker,"here (after ^)");          if (br_status) err(breaker,"here (after ^)");
         x = gpui(x,p1,prec); break;          x = gpow(x,p1,prec); break;
       case '\'':        case '\'':
         analyseur++; x = deriv(x,gvar9(x)); break;          analyseur++; x = deriv(x,gvar9(x)); break;
       case '~':        case '~':
         analyseur++; x = gtrans(x); break;          analyseur++; x = gtrans(x); break;
       case '[':        case '[':
         x = matrix_block(x,NULL); break;        {
           matcomp c;
           x = matcell(x, &c);
           if (isonstack(x)) x = gcopy(x);
           break;
         }
       case '!':        case '!':
         if (analyseur[1] != '=')          if (analyseur[1] != '=')
         {          {
Line 722  _append(GEN **table, long *n, long *N)
Line 1017  _append(GEN **table, long *n, long *N)
 {  {
   if (++(*n) == *N)    if (++(*n) == *N)
   {    {
     long M = *N; *N <<= 1;      *N <<= 1;
     *table = (GEN*)gprealloc((void*)*table, (M + 1)*sizeof(GEN),      *table = (GEN*)gprealloc((void*)*table,(*N + 1)*sizeof(GEN));
                                            (*N + 1)*sizeof(GEN));  
   }    }
   (*table)[*n] = expr();    (*table)[*n] = expr();
   if (br_status) err(breaker,"array context");    if (br_status) err(breaker,"array context");
Line 742  truc(void)
Line 1036  truc(void)
   
   if (*analyseur == '!') /* NOT */    if (*analyseur == '!') /* NOT */
   {    {
     analyseur++; p1 = truc();      analyseur++; p1 = facteur();
     if (br_status) err(breaker,"here (after !)");      if (br_status) err(breaker,"here (after !)");
     return gcmp0(p1)? gun: gzero;      return gcmp0(p1)? gun: gzero;
   }    }
Line 759  truc(void)
Line 1053  truc(void)
       default: err(varer1,old,mark.start);        default: err(varer1,old,mark.start);
     }      }
   }    }
     if (*analyseur == '#') /* CARD */
     {
       analyseur++; p1 = facteur();
       if (br_status) err(breaker,"here (after #)");
       return stoi(glength(p1));
     }
   if (isalpha((int)*analyseur)) return identifier();    if (isalpha((int)*analyseur)) return identifier();
   
   if (*analyseur == '"') return strtoGENstr_t();    if (*analyseur == '"') return strtoGENstr_t();
Line 805  truc(void)
Line 1105  truc(void)
       free(table); return p1;        free(table); return p1;
   
     case '%':      case '%':
       old = analyseur-1; p = 0;      old = analyseur-1;
       if (!gp_history_fun) err(talker2,"history not available",old,mark.start);      if (!GP_DATA) err(talker2,"history not available", old, mark.start);
       else
       {
         gp_hist *H = GP_DATA->hist;
         p = 0;
       while (*analyseur == '`') { analyseur++; p++; }        while (*analyseur == '`') { analyseur++; p++; }
       return p ? gp_history_fun(p         ,1,old,mark.start)        return p ? gp_history(H, -p        , old, mark.start)
                : gp_history_fun(number(&n),0,old,mark.start);                 : gp_history(H, number(&n), old, mark.start);
       }
   }    }
   err(caracer1,analyseur-1,mark.start);    err(caracer1,analyseur-1,mark.start);
   return NULL; /* not reached */    return NULL; /* not reached */
 }  }
   
 /* valid x opop, e.g x++ */  /* valid x opop, e.g x++ */
 #ifdef INLINE  static GEN
 INLINE  double_op()
 #endif  
 int  
 repeated_op()  
 {  {
     static long mun[] = { evaltyp(t_INT) | _evallg(3),
                           evalsigne(-1)|evallgefint(3), 1 };
   char c = *analyseur;    char c = *analyseur;
   return c == analyseur[1] && (c == '+' || c == '-');    if (c == analyseur[1])
       switch(c)
       {
         case '+': analyseur+=2; return gun; /* ++ */
         case '-': analyseur+=2; return mun; /* -- */
       }
     return NULL;
 }  }
   
 /* return op if op= detected */  /* return op if op= detected */
 static F2GEN  static F2GEN
 get_op_fun()  get_op_fun()
 {  {
   F2GEN f;  
   if (!*analyseur) return (F2GEN)NULL;    if (!*analyseur) return (F2GEN)NULL;
   
   /* op= constructs ? */    /* op= constructs ? */
Line 865  get_op_fun()
Line 1174  get_op_fun()
 }  }
   
 static GEN  static GEN
 matrix_block(GEN p, entree *ep)  expr_ass()
 {  {
   long tx,full_col,full_row,c,r;    GEN res = expr();
   char *old;    if (br_status) err(breaker,"assignment");
   GEN res, *pt, cpt;    return res;
   }
   
   tx = full_col = full_row = 0; pt = &p;  F2GEN
   while (*analyseur == '[')  affect_block(GEN *res)
   {
     F2GEN f;
     GEN r;
     if (*analyseur == '=')
   {    {
     analyseur++; p = *pt; tx = typ(p);      r = NULL; f = NULL;
     switch(tx)      if (analyseur[1] != '=') { analyseur++; r = expr_ass(); }
     {  
       case t_LIST:  
         c = check_array_index(lgef(p)-1) + 1;  
         pt = (GEN*)(p + c); match(']'); break;  
   
       case t_VEC: case t_COL: case t_VECSMALL:  
         c = check_array_index(lg(p));  
         pt = (GEN*)(p + c); match(']'); break;  
   
       case t_MAT:  
         if (lg(p)==1) err(talker2,"a 0x0 matrix has no elements",  
                                   analyseur,mark.start);  
         full_col = full_row = 0;  
         if (*analyseur==',') /* whole column */  
         {  
           analyseur++; full_col = 1;  
           c = check_array_index(lg(p));  
           pt = (GEN*)(p + c); match(']'); break;  
         }  
   
         r = check_array_index(lg(p[1]));  
         match(',');  
         if (*analyseur == ']') /* whole row */  
         {  
           GEN p2 = cgetg(lg(p),t_VEC);  
           analyseur++;  
           if (*analyseur != '[') full_row = r;  
           for (c=1; c<lg(p); c++) p2[c] = coeff(p,r,c);  
           pt = &p2;  
         }  
         else  
         {  
           c = check_array_index(lg(p));  
           pt = (GEN*)(((GEN)p[c]) + r); /* &coeff(p,r,c) */  
           match(']');  
         }  
         break;  
   
       default:  
         err(caracer1,analyseur-1,mark.start);  
     }  
   }    }
   old = analyseur;    else if ((r = double_op()))  f = &gadd;
   cpt = *pt;    else if ((f = get_op_fun())) r = expr_ass();
   if (tx == t_VECSMALL) cpt = stoi((long)cpt);    *res = r; return f;
   }
   
   if (*analyseur == '=') /* assignment or equality test */  /* assign res at *pt in "simple array object" p */
   {  static GEN
     if (analyseur[1] == '=') return cpt; /* == */  change_compo(matcomp *c, GEN res)
     analyseur++; old = analyseur; res = expr();  {
     if (br_status) err(breaker,"assignment");    GEN p = c->parent, *pt = c->ptcell;
   }    long i;
   else if (repeated_op())    int full_row = c->full_row, full_col = c->full_col;
   { /* a++, a-- */    char *old = analyseur;
     res = gadd(cpt, (*analyseur == '+')? gun: negi(gun));  
     analyseur += 2;  
   }  
   else  
   {  
     F2GEN f = get_op_fun();  
     if (!f) return (ep && !full_row)? cpt: gcopy(cpt);  
   
     old = analyseur; res = expr();    if (typ(p) == t_VECSMALL)
     if (br_status) err(breaker,"assignment");  
     res = f(cpt, res);  
   }  
   
   /* assignment */  
   if (!ep) err(caracer1,analyseur,mark.start);  
   
   if (!tx) /* simple variable */  
   {    {
     changevalue(ep,res);      if (typ(res) != t_INT || is_bigint(res))
     return (GEN) ep->value;        err(talker2,"not a suitable VECSMALL component",old,mark.start);
       *pt = (GEN)itos(res); return res;
   }    }
     if (full_row)
   if (full_row) /* whole row (index r) */  
   {    {
     if (typ(res) != t_VEC || lg(res) != lg(p)) err(caseer2,old,mark.start);      if (typ(res) != t_VEC || lg(res) != lg(p)) err(caseer2,old,mark.start);
     for (c=1; c<lg(p); c++)      for (i=1; i<lg(p); i++)
     {      {
       GEN p2 = gcoeff(p,full_row,c); if (isclone(p2)) killbloc(p2);        GEN p1 = gcoeff(p,full_row,i); if (isclone(p1)) killbloc(p1);
       coeff(p,full_row,c) = lclone((GEN)res[c]);        coeff(p,full_row,i) = lclone((GEN)res[i]);
     }      }
     return res;      return res;
   }    }
     if (full_col)
       if (typ(res) != t_COL || lg(res) != lg(*pt)) err(caseer2,old,mark.start);
   
   if (tx == t_VECSMALL)    res = gclone(res);
   {    if (isclone(*pt)) killbloc(*pt);
     if (typ(res) != t_INT || is_bigint(res))    return *pt = res;
       err(talker2,"not a suitable VECSMALL component",old,mark.start);  }
     *pt = (GEN)itos(res); return res;  
   }  
   
   /* sanity check in case v[i] = f(), where f destroys v */  /* extract from p the needed component */
   if (cpt != *pt)  static GEN
     err(talker2,"variable on the left-hand side was affected during this function call. Check whether it is modified as a side effect there", old, mark.start);  matrix_block(GEN p)
   {
     char *end, *ini = analyseur;
     GEN res, cpt;
     matcomp c;
     F2GEN fun;
   
   res = gclone(res);    skip_matrix_block();
   if (full_col) /* whole col */    fun = affect_block(&res);
     end = analyseur;
     analyseur = ini;
     cpt = matcell(p, &c);
     if (res)
   {    {
     if (typ(res) != t_COL || lg(res) != lg(cpt))      if (fun) res = fun(cpt, res);
       err(caseer2,old,mark.start);      res = change_compo(&c,res);
       analyseur = end;
     for (r=1; r<lg(cpt); r++)  
       if (isclone(cpt[r])) killbloc((GEN)cpt[r]);  
   }    }
   /* no need to inspect if full_col (done above) */    else res = isonstack(cpt)? gcopy(cpt): cpt; /* no assignment */
   if (isclone(cpt)) killbloc0(cpt, !full_col);    return res;
   return *pt = res;  
 }  }
   
 static char*  static char*
Line 1010  realloc_buf(char *bp, long len, char **ptbuf,char **pt
Line 1275  realloc_buf(char *bp, long len, char **ptbuf,char **pt
 static char *  static char *
 expand_string(char *bp, char **ptbuf, char **ptlimit)  expand_string(char *bp, char **ptbuf, char **ptlimit)
 {  {
   char *tmp, *s = analyseur;    char *tmp = NULL; /* -Wall */
   long len, alloc;    long len = 0; /* -Wall */
     int alloc = 1;
   
   while (is_keyword_char(*s)) s++;    if (is_keyword_char(*analyseur))
     {
       char *s = analyseur;
       do s++; while (is_keyword_char(*s));
   
   if ((*s == '"' || *s == ',' || *s == ')') && !is_entry(analyseur))      if ((*s == '"' || *s == ',' || *s == ')') && !is_entry(analyseur))
   { /* Do not create new user variable. Consider as a literal */      { /* Do not create new user variable. Consider as a literal */
     tmp = analyseur;        tmp = analyseur;
     len = s - analyseur;        len = s - analyseur;
     analyseur = s;        analyseur = s;
     alloc = 0;        alloc = 0;
       }
   }    }
   else  
     if (alloc)
   {    {
     long av = avma;      gpmem_t av = avma;
     GEN p1 = expr();      GEN p1 = expr();
     if (br_status) err(breaker,"here (expanding string)");      if (br_status) err(breaker,"here (expanding string)");
     tmp = GENtostr0(p1, output_fun);      tmp = GENtostr0(p1, &DFLT_OUTPUT, &gen_output);
     len = strlen(tmp); avma = av;      len = strlen(tmp); avma = av;
     alloc = 1;  
   }    }
   if (ptlimit && bp + len > *ptlimit)    if (ptlimit && bp + len > *ptlimit)
     bp = realloc_buf(bp, len, ptbuf,ptlimit);      bp = realloc_buf(bp, len, ptbuf,ptlimit);
Line 1078  static GEN
Line 1348  static GEN
 any_string()  any_string()
 {  {
   long n = 0, len = 16;    long n = 0, len = 16;
   GEN p1, res = new_chunk(len + 1);    GEN res = new_chunk(len + 1);
   
   while (*analyseur)    while (*analyseur)
   {    {
     if (*analyseur == '"')  
     {  
       res[n++] = (long) strtoGENstr_t();  
       continue;  
     }  
     if (*analyseur == ')' || *analyseur == ';') break;      if (*analyseur == ')' || *analyseur == ';') break;
     if (*analyseur == ',')      if (*analyseur == ',')
       analyseur++;        analyseur++;
     else      else
     {      {
       p1 = expr();        res[n++] = (long)expr();
       if (br_status) err(breaker,"here (print)");        if (br_status) err(breaker,"here (print)");
       res[n++] = (long) p1;  
     }      }
     if (n == len)      if (n == len)
     {      {
       long newlen = len << 1;        long newlen = len << 1;
       p1 = new_chunk(newlen + 1);        GEN p1 = new_chunk(newlen + 1);
       for (n = 0; n < len; n++) p1[n] = res[n];        for (n = 0; n < len; n++) p1[n] = res[n];
       res = p1; len = newlen;        res = p1; len = newlen;
     }      }
Line 1129  strtoGENstr_t()
Line 1393  strtoGENstr_t()
   old++; /* skip '"' */    old++; /* skip '"' */
   n = (n+BYTES_IN_LONG) >> TWOPOTBYTES_IN_LONG;    n = (n+BYTES_IN_LONG) >> TWOPOTBYTES_IN_LONG;
   x = cgetg(n+1, t_STR);    x = cgetg(n+1, t_STR);
   translate(&old, GSTR(x), NULL,NULL);    (void)translate(&old, GSTR(x), NULL,NULL);
   return x;    return x;
 }  }
   
Line 1154  strtoGENstr(char *s, long flag)
Line 1418  strtoGENstr(char *s, long flag)
   return x;    return x;
 }  }
   
   /* x = gzero: no default value, otherwise a t_STR, formal expression for
    * default argument. Evaluate and return. */
 static GEN  static GEN
 make_arg(GEN x)  make_arg(GEN x) { return (x==gzero)? x: geval(x); }
   
   static GEN
   fun_seq(char *p)
 {  {
   return (x==gzero)? x : geval(x);    GEN res = lisseq(p);
     if (br_status != br_NONE)
       br_status = br_NONE;
     else
       if (! is_universal_constant(res)) /* important for gnil */
         res = forcecopy(res); /* make result safe */
     return res;
 }  }
   
 /* p = NULL + array of variable numbers (longs) + function text */  /* p = NULL + array of variable numbers (longs) + function text */
Line 1172  call_fun(GEN p, GEN *arg, GEN *loc, int narg, int nloc
Line 1447  call_fun(GEN p, GEN *arg, GEN *loc, int narg, int nloc
   for (i=0; i<narg; i++) copyvalue(*p++, *arg++);    for (i=0; i<narg; i++) copyvalue(*p++, *arg++);
   for (i=0; i<nloc; i++) pushvalue(*p++, make_arg(*loc++));    for (i=0; i<nloc; i++) pushvalue(*p++, make_arg(*loc++));
   /* dumps arglist from identifier() to the garbage zone */    /* dumps arglist from identifier() to the garbage zone */
   res = lisseq((char *)p);    res = fun_seq((char *)p);
   if (br_status != br_NONE)  
     br_status = br_NONE;  
   else  
     if (! is_universal_constant(res)) /* important for gnil */  
       res = forcecopy(res); /* make result safe */  
   
   /* pop out ancient values of formal parameters */    /* pop out ancient values of formal parameters */
   for (i=0; i<nloc; i++) killvalue(*--p);    for (i=0; i<nloc; i++) killvalue(*--p);
   for (i=0; i<narg; i++) killvalue(*--p);    for (i=0; i<narg; i++) killvalue(*--p);
   return res;    return res;
 }  }
   /* p = NULL + array of variable numbers (longs) + function text */
   static GEN
   call_member(GEN p, GEN x)
   {
     GEN res;
   
     p++; /* skip NULL */
     /* push new values for formal parameters */
     pushvalue(*p++, x);
     res = fun_seq((char *)p);
     /* pop out ancient values of formal parameters */
     killvalue(*--p);
     return res;
   }
   
 entree *  entree *
 do_alias(entree *ep)  do_alias(entree *ep)
 {  {
Line 1212  global0()
Line 1495  global0()
 }  }
   
 static void  static void
 check_pointer(unsigned int ptrs, entree *pointer[])  check_pointers(unsigned int ptrs, matcomp *init[])
 {  {
   unsigned int i;    unsigned int i;
   for (i=0; ptrs; i++,ptrs>>=1)    for (i=0; ptrs; i++,ptrs>>=1)
     if (ptrs & 1)      if (ptrs & 1)
     {      {
       entree *e = pointer[i];        matcomp *c = init[i];
       GEN x = (GEN)e->value;        GEN *pt = c->ptcell, x = gclone(*pt);
       pop_val(e);        if (c->parent == NULL)
       changevalue(e, x);        {
           if (isclone(c->extra)) killbloc((GEN)c->extra);
           *pt = x;
         }
         else
           (void)change_compo(c, x);
         free((void*)c);
     }      }
 }  }
   
 #define match_comma() if (matchcomma) match(','); else matchcomma = 1  #define match_comma() \
     STMT_START { if (matchcomma) match(','); else matchcomma = 1; } STMT_END
   
   static void
   skipdecl(void)
   {
     if (*analyseur == ':') { analyseur++; skipexpr(); }
   }
   
 static long  static long
 check_args()  check_args()
 {  {
Line 1253  check_args()
Line 1549  check_args()
       err(paramer1, old, mark.start);        err(paramer1, old, mark.start);
     }      }
     cell[0] = varn(initial_value(ep));      cell[0] = varn(initial_value(ep));
       skipdecl();
     if (*analyseur == '=')      if (*analyseur == '=')
     {      {
       char *old = ++analyseur;        char *old = ++analyseur;
       ulong av = avma;        gpmem_t av = avma;
       skipexpr();        skipexpr();
       cell[1] = lclone(_strtoGENstr(old, analyseur-old));        cell[1] = lclone(_strtoGENstr(old, analyseur-old));
       avma = av;        avma = av;
Line 1301  static GEN
Line 1598  static GEN
 num_deriv(void *call, GEN argvec[])  num_deriv(void *call, GEN argvec[])
 {  {
   GEN eps,a,b, y, x = argvec[0];    GEN eps,a,b, y, x = argvec[0];
   long fpr,pr,l,e,ex, av = avma;    long fpr, pr, l, e, ex;
     gpmem_t av = avma;
   if (!is_const_t(typ(x)))    if (!is_const_t(typ(x)))
   {    {
     a = do_call(call, x, argvec);      a = do_call(call, x, argvec);
Line 1315  num_deriv(void *call, GEN argvec[])
Line 1613  num_deriv(void *call, GEN argvec[])
   l = 2+pr;    l = 2+pr;
   e = fpr * BITS_IN_HALFULONG; /* 1/2 required prec (in sig. bits) */    e = fpr * BITS_IN_HALFULONG; /* 1/2 required prec (in sig. bits) */
   
   eps = realun(l); setexpo(eps, -e);    eps = real2n(-e, l);
   y = fix(gsub(x, eps), l); a = do_call(call, y, argvec);    y = fix(gsub(x, eps), l); a = do_call(call, y, argvec);
   y = fix(gadd(x, eps), l); b = do_call(call, y, argvec);    y = fix(gadd(x, eps), l); b = do_call(call, y, argvec);
   setexpo(eps, e-1);    setexpo(eps, e-1);
Line 1327  static GEN
Line 1625  static GEN
 num_derivU(GEN p, GEN *arg, GEN *loc, int narg, int nloc)  num_derivU(GEN p, GEN *arg, GEN *loc, int narg, int nloc)
 {  {
   GEN eps,a,b, x = *arg;    GEN eps,a,b, x = *arg;
   long fpr,pr,l,e,ex, av = avma;    long fpr, pr, l, e, ex;
     gpmem_t av = avma;
   
   if (!is_const_t(typ(x)))    if (!is_const_t(typ(x)))
   {    {
Line 1342  num_derivU(GEN p, GEN *arg, GEN *loc, int narg, int nl
Line 1641  num_derivU(GEN p, GEN *arg, GEN *loc, int narg, int nl
   l = 2+pr;    l = 2+pr;
   e = fpr * BITS_IN_HALFULONG; /* 1/2 required prec (in sig. bits) */    e = fpr * BITS_IN_HALFULONG; /* 1/2 required prec (in sig. bits) */
   
   eps = realun(l); setexpo(eps, -e);    eps = real2n(-e, l);
   *arg = fix(gsub(x, eps), l); a = call_fun(p,arg,loc,narg,nloc);    *arg = fix(gsub(x, eps), l); a = call_fun(p,arg,loc,narg,nloc);
   *arg = fix(gadd(x, eps), l); b = call_fun(p,arg,loc,narg,nloc);    *arg = fix(gadd(x, eps), l); b = call_fun(p,arg,loc,narg,nloc);
   setexpo(eps, e-1);    setexpo(eps, e-1);
Line 1357  num_derivU(GEN p, GEN *arg, GEN *loc, int narg, int nl
Line 1656  num_derivU(GEN p, GEN *arg, GEN *loc, int narg, int nl
 static GEN  static GEN
 identifier(void)  identifier(void)
 {  {
   long m,i,av,matchcomma, deriv;    long m, i, matchcomma, deriv;
     gpmem_t av;
   char *ch1;    char *ch1;
   entree *ep;    entree *ep;
   GEN res, newfun, ptr;    GEN res, newfun, ptr;
Line 1373  identifier(void)
Line 1673  identifier(void)
         long len, v;          long len, v;
   
         analyseur++; ch1 = analyseur;          analyseur++; ch1 = analyseur;
         if ((res = read_member((GEN)ep->value))) return res;          if ((res = read_member((GEN)ep->value)))
           {
             if (*analyseur == '[')
             {
               matcomp c;
               res = matcell(res, &c);
             }
             return res;
           }
         /* define a new member function */          /* define a new member function */
         v = varn(initial_value(ep));          v = varn(initial_value(ep));
         len = analyseur - ch1;          len = analyseur - ch1;
Line 1392  identifier(void)
Line 1699  identifier(void)
         ep->value = (void *)ptr; return gnil;          ep->value = (void *)ptr; return gnil;
       }        }
     }      }
     return matrix_block((GEN) ep->value,ep);      if (*analyseur != '[')
       { /* whole variable, no component */
         F2GEN fun = affect_block(&res);
         if (res)
         {
           if (fun) res = fun((GEN)ep->value, res);
           changevalue(ep,res);
         }
         return (GEN)ep->value;
       }
       return matrix_block((GEN)ep->value);
   }    }
   ep = do_alias(ep); matchcomma = 0;    ep = do_alias(ep); matchcomma = 0;
 #ifdef STACK_CHECK  #ifdef STACK_CHECK
Line 1407  identifier(void)
Line 1724  identifier(void)
     long fake;      long fake;
     void *call = ep->value;      void *call = ep->value;
     GEN argvec[9];      GEN argvec[9];
     entree *pointers[9];      matcomp *init[9];
       char *flags = NULL;
   
     deriv = (*analyseur == '\'' && analyseur[1] == '(') && analyseur++;      deriv = (*analyseur == '\'' && analyseur[1] == '(') && analyseur++;
     if (*analyseur == '(')      if (*analyseur == '(')
Line 1437  identifier(void)
Line 1755  identifier(void)
     }      }
     if (*s == 'p') { argvec[i++] = (GEN) prec; s++; }      if (*s == 'p') { argvec[i++] = (GEN) prec; s++; }
   
     while (*s)      while (*s && *s != '\n')
       switch (*s++)        switch (*s++)
       {        {
         case 'G': /* GEN */          case 'G': /* GEN */
Line 1467  identifier(void)
Line 1785  identifier(void)
         case '&': /* *GEN */          case '&': /* *GEN */
           match_comma(); match('&'); mark.symbol=analyseur;            match_comma(); match('&'); mark.symbol=analyseur;
         {          {
           entree *e = entry();            matcomp *c = (matcomp*)malloc(sizeof(matcomp));
           push_val(e, (GEN)e->value);            entree *ep = entry();
   
             if (*analyseur == '[')
               (void)matcell((GEN)ep->value, c);
             else
             {
               c->parent = NULL;
               c->ptcell = (GEN*)&ep->value;
               c->extra = (GEN*)ep->value;
             }
           has_pointer |= (1 << i);            has_pointer |= (1 << i);
           pointers[i] = e;            init[i] = c;
           argvec[i++] = (GEN) &(e->value); break;            argvec[i++] = (GEN)c->ptcell; break;
         }          }
         /* Input position */          /* Input position */
         case 'E': /* expr */          case 'E': /* expr */
Line 1498  identifier(void)
Line 1825  identifier(void)
           *bp++ = 0; argvec[i++] = (GEN) buf;            *bp++ = 0; argvec[i++] = (GEN) buf;
           break;            break;
   
           case 'M': /* Mnemonic flag */
             match_comma(); argvec[i] = expr();
             if (br_status) err(breaker,"here (argument reading)");
             if (typ(argvec[i]) == t_STR) {
                 if (!flags)
                     flags = ep->code;
                 flags = strchr(flags, '\n'); /* Skip to the following '\n' */
                 if (!flags)
                     err(talker, "not enough flags in string function signature");
                 flags++;
                 argvec[i] = (GEN) parse_option_string((char*)(argvec[i] + 1),
                             flags, PARSEMNU_ARG_WHITESP | PARSEMNU_TEMPL_TERM_NL,
                             NULL, NULL);
             } else
                 argvec[i] = (GEN)itos(argvec[i]);
             i++;
             break;
   
         case 's': /* expanded string; empty arg yields "" */          case 's': /* expanded string; empty arg yields "" */
           match_comma();            match_comma();
           if (*s == '*') /* any number of string objects */            if (*s == '*') /* any number of string objects */
Line 1510  identifier(void)
Line 1855  identifier(void)
           while (*analyseur)            while (*analyseur)
           {            {
             if (*analyseur == ',' || *analyseur == ')') break;              if (*analyseur == ',' || *analyseur == ')') break;
             if (*analyseur == '"')              bp = expand_string(bp, &buf,&limit);
               bp = readstring_i(bp, &buf,&limit);  
             else  
               bp = expand_string(bp, &buf,&limit);  
           }            }
           *bp++ = 0; argvec[i++] = (GEN)buf;            *bp++ = 0; argvec[i++] = (GEN)buf;
           break;            break;
Line 1592  identifier(void)
Line 1934  identifier(void)
         ((void (*)(ANYARG))call)(_ARGS_);          ((void (*)(ANYARG))call)(_ARGS_);
         res = gnil; break;          res = gnil; break;
     }      }
     if (has_pointer) check_pointer(has_pointer,pointers);      if (has_pointer) check_pointers(has_pointer,init);
     if (!noparen) match(')');      if (!noparen) match(')');
     return res;      return res;
   }    }
Line 1671  identifier(void)
Line 2013  identifier(void)
           switch(EpVALENCE(ep))            switch(EpVALENCE(ep))
           {            {
             case EpGVAR:              case EpGVAR:
   #if 0
               err(warner,"%s already declared global", ep->name);                err(warner,"%s already declared global", ep->name);
   #endif
               /* fall through */                /* fall through */
             case EpVAR: break;              case EpVAR: break;
             default: err(talker2,"symbol already in use",ch1,mark.start);              default: err(talker2,"symbol already in use",ch1,mark.start);
Line 1679  identifier(void)
Line 2023  identifier(void)
           analyseur=ch1; ep = entry();            analyseur=ch1; ep = entry();
           if (*analyseur == '=')            if (*analyseur == '=')
           {            {
             long av=avma; analyseur++;              gpmem_t av=avma; analyseur++;
             res = expr();              res = expr();
             if (br_status) err(breaker,"here (defining global var)");              if (br_status) err(breaker,"here (defining global var)");
             changevalue(ep, res); avma=av;              changevalue(ep, res); avma=av;
Line 1732  identifier(void)
Line 2076  identifier(void)
           { /* user supplied */            { /* user supplied */
             match_comma();              match_comma();
             arglist[i] = expr();              arglist[i] = expr();
               skipdecl(); /* we'd be redefining fun, but don't know it yet */
             if (br_status) err(breaker,"here (reading function args)");              if (br_status) err(breaker,"here (reading function args)");
           }            }
         }          }
Line 1770  identifier(void)
Line 2115  identifier(void)
       /* checking arguments */        /* checking arguments */
       match('('); ch1 = analyseur;        match('('); ch1 = analyseur;
       narg = check_args(); nloc = 0;        narg = check_args(); nloc = 0;
       match(')'); match('=');        match(')');
       while (strncmp(analyseur,"local(",6) == 0)        /* Dirty, but don't want to define a local() function */
       {        if (*analyseur != '=' && strcmp(ep->name, "local") == 0)
         analyseur += 6;          err(talker2, "local() bloc must appear before any other expression",
         nloc += check_args();                       mark.identifier,mark.start);
         match(')'); while(separe(*analyseur)) analyseur++;        match('=');
       }  
       { /* checking function definition */        { /* checking function definition */
         char *oldredef = redefine_fun;          char *oldredef = redefine_fun;
         skipping_fun_def++;          skipping_fun_def++;
           while (strncmp(analyseur,"local(",6) == 0)
           {
             analyseur += 6;
             nloc += check_args();
             match(')'); while(separe(*analyseur)) analyseur++;
           }
         start = analyseur; skipseq(); len = analyseur-start;          start = analyseur; skipseq(); len = analyseur-start;
         skipping_fun_def--; redefine_fun = oldredef;          skipping_fun_def--; redefine_fun = oldredef;
       }        }
Line 1821  identifier(void)
Line 2171  identifier(void)
       ep->value = (void *)ptr;        ep->value = (void *)ptr;
       ep->valence = EpUSER;        ep->valence = EpUSER;
       check_new_fun=NULL;        check_new_fun=NULL;
       avma = (long)tmpargs; return gnil;        avma = (gpmem_t)tmpargs; return gnil;
     }      }
   }    }
   err(valencer1); return NULL; /* not reached */    err(valencer1); return NULL; /* not reached */
Line 1836  number(long *nb)
Line 2186  number(long *nb)
   return m;    return m;
 }  }
   
 extern GEN addsmulsi(long a, long b, GEN Y);  
   
 static GEN  static GEN
 constante()  constante()
 {  {
   static long pw10[] = { 1, 10, 100, 1000, 10000, 100000, 1000000,    static long pw10[] = { 1, 10, 100, 1000, 10000, 100000, 1000000,
                         10000000, 100000000, 1000000000 };                          10000000, 100000000, 1000000000 };
   long i,l,m,n = 0,nb, av = avma;    long i, l, m, n = 0, nb;
     gpmem_t av = avma;
   GEN z,y;    GEN z,y;
   
   y = stoi(number(&nb)); i = 0;    y = stoi(number(&nb)); i = 0;
Line 1857  constante()
Line 2206  constante()
   {    {
     default: return y; /* integer */      default: return y; /* integer */
     case '.':      case '.':
         if (isalpha((int)analyseur[1])
             && analyseur[1] != 'e' && analyseur[1] != 'E')
           return y; /* member function */
       analyseur++; i = 0;        analyseur++; i = 0;
       while (isdigit((int)*analyseur))        while (isdigit((int)*analyseur))
       {        {
Line 1892  constante()
Line 2244  constante()
   l=lgefint(y); if (l<prec) l=prec;    l=lgefint(y); if (l<prec) l=prec;
   if (n)    if (n)
   {    {
     new_chunk(l); /* hack: mulrr and divrr need exactly l words */      (void)new_chunk(l); /* HACK: mulrr and divrr need exactly l words */
     z=cgetr(l); affir(y,z);      z = itor(y, l);
     y=cgetr(l); affsr(10,y); y = gpuigs(y, labs(n));      y = gpowgs(stor(10,l), labs(n));
     avma = av; /* hidden gerepile */      avma = av; /* hidden gerepile */
     return n > 0 ?  mulrr(z,y) : divrr(z,y);      return n > 0 ?  mulrr(z,y) : divrr(z,y);
   }    }
   z=cgetr(l); affir(y,z); return z;    return itor(y, l);
 }  }
   
 /********************************************************************/  /********************************************************************/
Line 1906  constante()
Line 2258  constante()
 /**                   HASH TABLE MANIPULATIONS                     **/  /**                   HASH TABLE MANIPULATIONS                     **/
 /**                                                                **/  /**                                                                **/
 /********************************************************************/  /********************************************************************/
 /* slightly more efficient than is_keyword_char. Not worth a static array. */  
 #define is_key(c) (isalnum((int)(c)) || (c)=='_')  
   
 long  long
 is_keyword_char(char c) { return is_key(c); }  is_keyword_char(char c) { return is_key(c); }
   
Line 2059  fetch_named_var(char *s, int doerr)
Line 2408  fetch_named_var(char *s, int doerr)
   }    }
   ep = installep(NULL,s,strlen(s),EpVAR, 7*sizeof(long),    ep = installep(NULL,s,strlen(s),EpVAR, 7*sizeof(long),
                  functions_hash + hashvalue(s));                   functions_hash + hashvalue(s));
   manage_var(0,ep); return ep;    (void)manage_var(0,ep); return ep;
 }  }
   
 long  long
 fetch_user_var(char *s)  fetch_user_var(char *s)
 {  {
   entree *ep = is_entry(s);    entree *ep = is_entry(s);
   long av;    gpmem_t av;
   GEN p1;    GEN p1;
   
   if (ep)    if (ep)
Line 2085  fetch_user_var(char *s)
Line 2434  fetch_user_var(char *s)
 void  void
 delete_named_var(entree *ep)  delete_named_var(entree *ep)
 {  {
   manage_var(5, (entree*)varn(initial_value(ep)));    (void)manage_var(5, (entree*)varn(initial_value(ep)));
   kill0(ep);    kill0(ep);
 }  }
   
Line 2137  entry(void)
Line 2486  entry(void)
     { n=7*sizeof(long); val=EpVAR; }      { n=7*sizeof(long); val=EpVAR; }
   ep = installep(NULL,old,len,val,n, functions_hash + hash);    ep = installep(NULL,old,len,val,n, functions_hash + hash);
   
   if (n) manage_var(0,ep); /* Variable */    if (n) (void)manage_var(0,ep); /* Variable */
   return ep;    return ep;
 }  }
   
Line 2146  entry(void)
Line 2495  entry(void)
 /**                          SKIP FUNCTIONS                        **/  /**                          SKIP FUNCTIONS                        **/
 /**                                                                **/  /**                                                                **/
 /********************************************************************/  /********************************************************************/
   
 /* as skipseq without modifying analyseur && al */  /* as skipseq without modifying analyseur && al */
 static void  static void
 doskipseq(char *c, int strict)  doskipseq(char *c, int strict)
Line 2156  doskipseq(char *c, int strict)
Line 2504  doskipseq(char *c, int strict)
   mark.start = c; analyseur = c; skipseq();    mark.start = c; analyseur = c; skipseq();
   if (*analyseur)    if (*analyseur)
   {    {
       char *s;
       long L,n;
     if (strict) err(talker2,"unused characters", analyseur, c);      if (strict) err(talker2,"unused characters", analyseur, c);
     err(warner, "unused characters: %s", analyseur);      L = term_width();
       n = 2 * L - (17+19+1); /* Warning + unused... + . */
       if (strlen(analyseur) > n)
       {
         s = gpmalloc(n + 1);
         n -= 5;
         (void)strncpy(s,analyseur, n);
         s[n] = 0; strcat(s,"[+++]");
       }
       else s = pari_strdup(analyseur);
       err(warner, "unused characters: %s", s);
       free(s);
   }    }
   analyseur = olds;    analyseur = olds;
 }  }
Line 2178  skipstring()
Line 2539  skipstring()
 }  }
   
 static void  static void
 skip_lock(int no_affect)  skip_matrix_block()
 {  {
   while (*analyseur == '[')    while (*analyseur == '[')
   {    {
Line 2192  skip_lock(int no_affect)
Line 2553  skip_lock(int no_affect)
     }      }
     match(']');      match(']');
   }    }
   }
   
   if (*analyseur == '=' && analyseur[1] != '=')  /* return 1 if we would be assigning some value after expansion. 0 otherwise.
    * Skip all chars corresponding to the assignment (and assigned value) */
   static int
   skip_affect_block()
   {
     if (*analyseur == '=')
   {    {
     if (no_affect) err(caracer1,analyseur,mark.start);      if (analyseur[1] != '=') { analyseur++; skipexpr(); return 1; }
     analyseur++; skipexpr(); return;  
   }    }
   if (repeated_op())    else if (double_op()) return 1;
   {    else if (get_op_fun()) { skipexpr(); return 1; }
     if (no_affect) err(caracer1,analyseur,mark.start);    return 0;
     analyseur+=2; return;  
   }  
   if (!*analyseur) return;  
   if (analyseur[1] != '=')  
   {  
     switch(*analyseur)  
     {  
       case '>': case '<':  
         if (analyseur[1] != *analyseur || analyseur[2] != '=') return;  
         if (no_affect) err(caracer1,analyseur,mark.start);  
         analyseur+=3; skipexpr(); return;  
       case '\\':  
         if (analyseur[1] != '/' || analyseur[2] != '=') return;  
         if (no_affect) err(caracer1,analyseur,mark.start);  
         analyseur+=3; skipexpr(); return;  
     }  
     return;  
   }  
   
   switch(*analyseur)  
   {  
     case '+': case '-': case '*': case '/': case '\\': case '%':  
       if (no_affect) err(caracer1,analyseur,mark.start);  
       analyseur+=2; skipexpr(); return;  
   }  
 }  }
   
 static void  static void
Line 2319  skipfacteur(void)
Line 2660  skipfacteur(void)
       case '~': case '\'':        case '~': case '\'':
         analyseur++; break;          analyseur++; break;
       case '[':        case '[':
         skip_lock(1); break;        {
           char *old;
           skip_matrix_block(); old = analyseur;
           if (skip_affect_block()) err(caracer1,old,mark.start);
           break;
         }
       case '!':        case '!':
         if (analyseur[1] != '=') { analyseur++; break; }          if (analyseur[1] != '=') { analyseur++; break; }
       default: return;        default: return;
Line 2336  skiptruc(void)
Line 2682  skiptruc(void)
   switch(*analyseur)    switch(*analyseur)
   {    {
     case '"': skipstring(); return;      case '"': skipstring(); return;
     case '!': analyseur++; skiptruc(); return;      case '!': case '#': analyseur++; skipfacteur(); return;
     case '&': case '\'':      case '&': case '\'':
       analyseur++; check_var_name();        analyseur++; check_var_name();
       skipentry(); return;        (void)skipentry(); return;
   }    }
   if (isalpha((int)*analyseur)) { skipidentifier(); return; }    if (isalpha((int)*analyseur)) { skipidentifier(); return; }
   if (isdigit((int)*analyseur) || *analyseur== '.') { skipconstante(); return; }    if (isdigit((int)*analyseur) || *analyseur== '.') { skipconstante(); return; }
Line 2374  skiptruc(void)
Line 2720  skiptruc(void)
       }        }
     case '%':      case '%':
       if (*analyseur == '`') { while (*++analyseur == '`') /*empty*/; return; }        if (*analyseur == '`') { while (*++analyseur == '`') /*empty*/; return; }
       number(&n); return;        (void)number(&n); return;
   }    }
   err(caracer1,analyseur-1,mark.start);    err(caracer1,analyseur-1,mark.start);
 }  }
Line 2394  check_var()
Line 2740  check_var()
 }  }
   
 static void  static void
   check_matcell()
   {
     char *old = analyseur;
     check_var_name();
     switch(EpVALENCE(skipentry()))
     {
       case EpVAR:
       case EpGVAR: break;
       default: err(varer1,old,mark.start);
     }
     skip_matrix_block();
   }
   
   static void
 skipidentifier(void)  skipidentifier(void)
 {  {
   int matchcomma=0;    int matchcomma=0;
Line 2416  skipidentifier(void)
Line 2776  skipidentifier(void)
     /* Optimized for G and p. */      /* Optimized for G and p. */
     while (*s == 'G') { match_comma(); skipexpr(); s++; }      while (*s == 'G') { match_comma(); skipexpr(); s++; }
     if (*s == 'p') s++;      if (*s == 'p') s++;
     while (*s) switch (*s++)      while (*s && *s != '\n') switch (*s++)
     {      {
       case 'G': case 'n': case 'L':        case 'G': case 'n': case 'L': case 'M':
         match_comma();          match_comma();
         if (*analyseur == ',' || *analyseur == ')') break;          if (*analyseur == ',' || *analyseur == ')') break;
         skipexpr(); break;          skipexpr(); break;
Line 2446  skipidentifier(void)
Line 2806  skipidentifier(void)
             if (*analyseur == ',') analyseur++;              if (*analyseur == ',') analyseur++;
             else skipexpr();              else skipexpr();
           }            }
           s++; if (*s == 'p' || *s == 't') s++;            s++;
           break;            break;
         }          }
   
Line 2459  skipidentifier(void)
Line 2819  skipidentifier(void)
         break;          break;
   
       case 'S': match_comma();        case 'S': match_comma();
         check_var_name(); skipentry(); break;          check_var_name(); (void)skipentry(); break;
       case '&': match_comma(); match('&'); check_var(); break;        case '&': match_comma(); match('&'); check_matcell(); break;
       case 'V': match_comma(); check_var(); break;        case 'V': match_comma(); check_var(); break;
   
       case 'p': case 'P': case 'l': case 'v': case 'f': case 'x':        case 'p': case 'P': case 'l': case 'v': case 'f': case 'x':
Line 2476  skipidentifier(void)
Line 2836  skipidentifier(void)
         match('='); matchcomma = 0; break;          match('='); matchcomma = 0; break;
       case ',':        case ',':
         matchcomma=1; break;          matchcomma=1; break;
         case '\n':                        /* Before the mnemonic */
           break;
       default:        default:
         err(bugparier,"skipidentifier (unknown code)");          err(bugparier,"skipidentifier (unknown code)");
     }      }
Line 2514  skipidentifier(void)
Line 2876  skipidentifier(void)
   {    {
     case EpGVAR:      case EpGVAR:
     case EpVAR: /* variables */      case EpVAR: /* variables */
       skip_lock(0); return;        skip_matrix_block(); (void)skip_affect_block(); return;
   
     case EpUSER: /* fonctions utilisateur */      case EpUSER: /* fonctions utilisateur */
     {      {
Line 2534  skipidentifier(void)
Line 2896  skipidentifier(void)
       {        {
         if (do_switch(0,matchcomma))          if (do_switch(0,matchcomma))
           matchcomma = 1;            matchcomma = 1;
         else          else { match_comma(); skipexpr(); skipdecl(); }
         {  
           match_comma(); skipexpr();  
         }  
       }        }
   
       if (*analyseur == ')')        if (*analyseur == ')')
Line 2566  skipidentifier(void)
Line 2925  skipidentifier(void)
         err(paramer1, mark.identifier, mark.start);          err(paramer1, mark.identifier, mark.start);
       }        }
       check_new_fun = NOT_CREATED_YET; match('(');        check_new_fun = NOT_CREATED_YET; match('(');
       while (*analyseur != ')') { match_comma(); skipexpr(); };        while (*analyseur != ')') { match_comma(); skipexpr(); skipdecl(); };
       match(')');        match(')');
       if (*analyseur == '=' && analyseur[1] != '=')        if (*analyseur == '=' && analyseur[1] != '=')
       {        {
Line 2585  skipconstante(void)
Line 2944  skipconstante(void)
 {  {
   while (isdigit((int)*analyseur)) analyseur++;    while (isdigit((int)*analyseur)) analyseur++;
   if ( *analyseur!='.' && *analyseur!='e' && *analyseur!='E' ) return;    if ( *analyseur!='.' && *analyseur!='e' && *analyseur!='E' ) return;
   if (*analyseur=='.') analyseur++;    if (*analyseur=='.')
     {
       if (isalpha((int)analyseur[1])
           && analyseur[1] != 'e' && analyseur[1] != 'E')
         return; /* member function */
       analyseur++;
     }
   while (isdigit((int)*analyseur)) analyseur++;    while (isdigit((int)*analyseur)) analyseur++;
   if ( *analyseur=='e'  ||  *analyseur=='E' )    if ( *analyseur=='e'  ||  *analyseur=='E' )
   {    {
Line 2643  f(GEN x)
Line 3008  f(GEN x)
 static GEN  static GEN
 p(GEN x)  p(GEN x)
 {  {
   int t; get_nf(x,&t);    int t; (void)get_nf(x,&t);
   if (t == typ_GAL)    if (t == typ_GAL)
     return gmael(x,2,1);      return gmael(x,2,1);
   x = get_primeid(x);    x = get_primeid(x);
Line 2727  pol(GEN x) /* polynomial */
Line 3092  pol(GEN x) /* polynomial */
 static GEN  static GEN
 mod(GEN x) /* modulus */  mod(GEN x) /* modulus */
 {  {
   int t; get_nf(x,&t);    int t; (void)get_nf(x,&t);
   if (t == typ_GAL)    if (t == typ_GAL)
     return gmael(x,2,3);      return gmael(x,2,3);
   switch(typ(x))    switch(typ(x))
Line 2766  t2(GEN x) /* T2 matrix */
Line 3131  t2(GEN x) /* T2 matrix */
 {  {
   int t; x = nfmats(get_nf(x,&t));    int t; x = nfmats(get_nf(x,&t));
   if (!x) err(member,"t2",mark.member,mark.start);    if (!x) err(member,"t2",mark.member,mark.start);
   return (GEN)x[3];    return gram_matrix((GEN)x[2]);
 }  }
   
 static GEN  static GEN
Line 2975  gen(GEN x)
Line 3340  gen(GEN x)
   if (y)    if (y)
   {    {
     x = cgetg(3,t_VEC);      x = cgetg(3,t_VEC);
     x[1] = lcopy((GEN)y[1]);      x[1] = y[1];
     x[2] = lcopy((GEN)y[2]);      x[2] = y[2]; return x;
     return x;  
   }    }
   get_nf(x,&t);    (void)get_nf(x,&t);
   if (t == typ_GAL)    if (t == typ_GAL)
     return (GEN)x[7];      return (GEN)x[7];
   x = clgp(x);    x = clgp(x);
Line 2991  gen(GEN x)
Line 3355  gen(GEN x)
 static GEN  static GEN
 group(GEN x)  group(GEN x)
 {  {
   int t;    int t; (void)get_nf(x,&t);
   get_nf(x,&t);  
   if (t == typ_GAL)    if (t == typ_GAL)
     return (GEN)x[6];      return (GEN)x[6];
   err(member,"group",mark.member,mark.start);    err(member,"group",mark.member,mark.start);
Line 3001  group(GEN x)
Line 3364  group(GEN x)
 static GEN  static GEN
 orders(GEN x)  orders(GEN x)
 {  {
   int t;    int t; (void)get_nf(x,&t);
   get_nf(x,&t);  
   if (t == typ_GAL)    if (t == typ_GAL)
     return (GEN)x[8];      return (GEN)x[8];
   err(member,"orders",mark.member,mark.start);    err(member,"orders",mark.member,mark.start);
Line 3218  read_member(GEN x)
Line 3580  read_member(GEN x)
       gunclone((GEN)ep->value); return NULL;        gunclone((GEN)ep->value); return NULL;
     }      }
     if (EpVALENCE(ep) == EpMEMBER)      if (EpVALENCE(ep) == EpMEMBER)
       return call_fun((GEN)ep->value, NULL, &x, 0, 1);        return call_member((GEN)ep->value, x);
     else      else
       return ((GEN (*)(ANYARG))ep->value)(x);      {
         GEN y = ((F1GEN)ep->value)(x);
         if (isonstack(y)) y = gcopy(y);
         return y;
       }
   }    }
   if (*analyseur != '=' || analyseur[1] == '=')    if (*analyseur != '=' || analyseur[1] == '=')
     err(talker2,"unknown member function",mark.member,mark.start);      err(talker2,"unknown member function",mark.member,mark.start);
Line 3256  GEN
Line 3622  GEN
 return0(GEN x)  return0(GEN x)
 {  {
   GEN y = br_res;    GEN y = br_res;
   br_res = x? gclone(x): NULL;    br_res = (x && x != gnil)? gclone(x): NULL;
   if (y) gunclone(y);    if (y) gunclone(y);
   br_status = br_RETURN; return NULL;    br_status = br_RETURN; return NULL;
 }  }
Line 3309  alias0(char *s, char *old)
Line 3675  alias0(char *s, char *old)
   ep = do_alias(ep); x = newbloc(2);    ep = do_alias(ep); x = newbloc(2);
   x[0] = evaltyp(t_STR)|evallg(2); /* for getheap */    x[0] = evaltyp(t_STR)|evallg(2); /* for getheap */
   x[1] = (long)ep;    x[1] = (long)ep;
   installep(x, s, strlen(s), EpALIAS, 0, functions_hash + hash);    (void)installep(x, s, strlen(s), EpALIAS, 0, functions_hash + hash);
 }  
   
 extern void err_leave_default(long n);  
   
 /* Try f (trapping error e), recover using r (break_loop, if NULL) */  
 GEN  
 trap0(char *e, char *r, char *f)  
 {  
   VOLATILE long av = avma, numerr = -1;  
   VOLATILE GEN x = gnil;  
   char *F;  
        if (!strcmp(e,"errpile")) numerr = errpile;  
   else if (!strcmp(e,"typeer")) numerr = typeer;  
   else if (!strcmp(e,"gdiver2")) numerr = gdiver2;  
   else if (!strcmp(e,"invmoder")) numerr = invmoder;  
   else if (!strcmp(e,"accurer")) numerr = accurer;  
   else if (!strcmp(e,"archer")) numerr = archer;  
   else if (*e) err(impl,"this trap keyword");  
   /* TO BE CONTINUED */  
   
   if (f && r)  
   { /* explicit recovery text */  
     char *a = analyseur;  
     void *catcherr;  
     jmp_buf env;  
   
     if (setjmp(env))  
     {  
       avma = av;  
       err_leave(&catcherr);  
       x = lisseq(r);  
       skipseq();  
     }  
     else  
     {  
       catcherr = err_catch(numerr, env, NULL);  
       x = lisseq(f);  
       err_leave(&catcherr);  
     }  
     analyseur = a;  
     return x;  
   }  
   
   F = f? f: r; /* define a default handler */  
  /* default will execute F (or start a break loop), then jump to  
   * environnement */  
   if (F)  
   {  
     if (!*F || (*F == '"' && F[1] == '"')) /* unset previous handler */  
     {/* TODO: find a better interface  
       * TODO: no leaked handler from the library should have survived  
       */  
       err_leave_default(numerr);  
       return x;  
     }  
     F = pari_strdup(F);  
   }  
   (void)err_catch(numerr, NULL, F);  
   return x;  
 }  }
   
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>