version 1.1, 2001/10/02 11:17:10 |
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 |
|
|
/* 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) ({match2(analyseur, c); analyseur++;}) |
#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; |
|
|
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"); |
|
|
|
|
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; |
} |
} |
|
|
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(); |
|
|
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 ? */ |
|
|
} |
} |
|
|
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); |
|
|
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) |
{ |
{ |
|
|
} |
} |
|
|
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() |
{ |
{ |
|
|
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; |
|
|
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); |
|
|
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; |
|
|
{ |
{ |
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)) |
{ |
{ |
|
|
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); |
} |
} |
|
|
/********************************************************************/ |
/********************************************************************/ |
|
|
/** 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); |
} |
} |
|
|
|
|
{ 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; |
} |
} |
|
|
|
|
/** 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; |
} |
} |
|
|
} |
} |
|
|
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; |
|
|
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; } |
|
|
} |
} |
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); |
} |
} |
|
|
} |
} |
|
|
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' ) |
{ |
{ |
|
|
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 |
|
|
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); |
|
|
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); |
|
|
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); |
|
|
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; |
|
} |
} |
|
|