version 1.1, 2001/10/02 11:17:10 |
version 1.2, 2002/09/11 07:27:03 |
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" |
extern GEN confrac(GEN x); /* should be static here, but use hiremainder */ |
extern GEN confrac(GEN x); /* should be static here, but use hiremainder */ |
extern GEN convi(GEN x); |
extern GEN convi(GEN x); |
static void bruti(GEN g, long n); |
|
static void texi(GEN g, long nosign); |
|
static void sori(GEN g); |
|
char * type_name(long t); |
char * type_name(long t); |
static char format; |
|
static long decimals, chmp, initial; |
|
|
|
/* output a space or do nothing depending on original caller */ |
|
static void (*sp)(); |
|
|
|
void |
void |
hit_return() |
hit_return(void) |
{ |
{ |
int c; |
int c; |
if (under_texmacs || under_emacs) return; |
if (GP_DATA && (GP_DATA->flags & (EMACS|TEXMACS))) return; |
pariputs("---- (type RETURN to continue) ----"); |
pariputs("---- (type RETURN to continue) ----"); |
/* if called from a readline callback, may be in a funny TTY mode, */ |
/* if called from a readline callback, may be in a funny TTY mode, */ |
do c = fgetc(stdin); while (c >= 0 && c != '\n' && c != '\r' && c != ' '); |
do c = fgetc(stdin); while (c >= 0 && c != '\n' && c != '\r' && c != ' '); |
|
|
/** INPUT FILTER **/ |
/** INPUT FILTER **/ |
/** **/ |
/** **/ |
/********************************************************************/ |
/********************************************************************/ |
|
|
#define ONE_LINE_COMMENT 2 |
#define ONE_LINE_COMMENT 2 |
#define MULTI_LINE_COMMENT 1 |
#define MULTI_LINE_COMMENT 1 |
/* Filter s into t. If flag is a query, return s (yes) / NULL (no) |
/* Filter F->s into F->t */ |
* Otherwise, if t == NULL, allocate enough room, filter then return t. |
|
* if not return pointer to ending '\0' in t. |
|
*/ |
|
char * |
char * |
filtre(char *s0, char *t0, int flag) |
filtre0(filtre_t *F) |
{ |
{ |
static int in_string, in_comment = 0; |
const int downcase = F->downcase; |
char c, *s, *t; |
char c, *s = F->s, *t; |
int downcase, return_end; |
|
|
|
if (flag & f_INIT) in_string = 0; |
if (!F->t) F->t = gpmalloc(strlen(s)+1); |
switch(flag) |
t = F->t; |
|
|
|
if (F->more_input == 1) F->more_input = 0; |
|
|
|
if (! F->in_comment) |
{ |
{ |
case f_ENDFILE: |
while (isspace((int)*s)) s++; /* Skip space */ |
if (in_string) |
if (*s == LBRACE) { s++; F->more_input = 2; F->wait_for_brace = 1; } |
{ |
|
err(warner,"run-away string. Closing it"); |
|
in_string = 0; |
|
} |
|
if (in_comment) |
|
{ |
|
err(warner,"run-away comment. Closing it"); |
|
in_comment = 0; |
|
} /* fall through */ |
|
case f_INIT: case f_COMMENT: |
|
return in_comment? s0: NULL; |
|
} |
} |
|
|
downcase = ((flag & f_KEEPCASE) == 0 && compatible == OLDALL); |
|
s = s0; return_end = (t0 != NULL); |
|
if (!t0) t0 = gpmalloc(strlen(s)+1); |
|
t = t0; |
|
|
|
while ((c = *s++)) |
while ((c = *s++)) |
{ |
{ |
if (in_string) *t++ = c; /* copy verbatim */ |
if (F->in_string) |
else if (in_comment) |
|
{ |
{ |
if (in_comment == MULTI_LINE_COMMENT) |
*t++ = c; /* copy verbatim */ |
|
switch(c) |
{ |
{ |
|
case '\\': /* in strings, \ is the escape character */ |
|
if (*s) *t++ = *s++; |
|
break; |
|
|
|
case '"': F->in_string = 0; |
|
} |
|
continue; |
|
} |
|
|
|
if (F->in_comment) |
|
{ /* look for comment's end */ |
|
if (F->in_comment == MULTI_LINE_COMMENT) |
|
{ |
while (c != '*' || *s != '/') |
while (c != '*' || *s != '/') |
{ |
{ |
if (!*s) goto END; |
if (!*s) |
|
{ |
|
if (!F->more_input) F->more_input = 1; |
|
goto END; |
|
} |
c = *s++; |
c = *s++; |
} |
} |
s++; |
s++; |
} |
} |
else |
else |
while (c != '\n') |
while (c != '\n' && *s) c = *s++; |
{ |
F->in_comment = 0; |
if (!*s) { in_comment=0; goto END; } |
continue; |
c = *s++; |
|
} |
|
in_comment=0; continue; |
|
} |
} |
else |
|
{ /* weed out comments and spaces */ |
/* weed out comments and spaces */ |
if (c=='\\' && *s=='\\') { in_comment = ONE_LINE_COMMENT; continue; } |
if (c=='\\' && *s=='\\') { F->in_comment = ONE_LINE_COMMENT; continue; } |
if (isspace((int)c)) continue; |
if (isspace((int)c)) continue; |
*t++ = downcase? tolower(c): c; |
*t++ = downcase? tolower(c): c; |
} |
|
switch(c) |
switch(c) |
{ |
{ |
case '/': |
case '/': |
if (*s != '*' || in_string) break; |
if (*s == '*') { t--; F->in_comment = MULTI_LINE_COMMENT; } |
/* start multi-line comment */ |
break; |
t--; in_comment = MULTI_LINE_COMMENT; break; |
|
|
|
case '\\': |
case '\\': |
if (!in_string) break; |
if (!*s) { |
if (!*s) goto END; /* this will result in an error */ |
if (t[-2] == '?') break; /* '?\' */ |
*t++ = *s++; break; /* in strings, \ is the escape character */ |
t--; |
/* \" does not end a string. But \\" does */ |
if (!F->more_input) F->more_input = 1; |
|
goto END; |
|
} |
|
if (*s == '\n') { |
|
if (t[-2] == '?') break; /* '?\' */ |
|
t--; s++; |
|
if (!*s) |
|
{ |
|
if (!F->more_input) F->more_input = 1; |
|
goto END; |
|
} |
|
} /* skip \<CR> */ |
|
break; |
|
|
case '"': |
case '"': F->in_string = 1; |
in_string = !in_string; |
|
} |
} |
} |
} |
|
|
|
if (t != F->t) /* non empty input */ |
|
{ |
|
c = t[-1]; /* = last input char */ |
|
if (c == '=') F->more_input = 2; |
|
else if (! F->wait_for_brace) F->more_input = 0; |
|
else if (c == RBRACE) { F->more_input = 0; t--; } |
|
} |
|
|
END: |
END: |
*t = 0; return return_end? t: t0; |
F->end = t; *t = 0; return F->t; |
} |
} |
#undef ONE_LINE_COMMENT |
#undef ONE_LINE_COMMENT |
#undef MULTI_LINE_COMMENT |
#undef MULTI_LINE_COMMENT |
|
|
|
char * |
|
filtre(char *s, int downcase) |
|
{ |
|
filtre_t T; |
|
T.s = s; T.in_string = 0; T.more_input = 0; |
|
T.t = NULL; T.in_comment= 0; T.wait_for_brace = 0; |
|
T.downcase = downcase; |
|
return filtre0(&T); |
|
} |
|
|
GEN |
GEN |
lisGEN(FILE *fi) |
lisGEN(FILE *fi) |
{ |
{ |
Line 149 lisGEN(FILE *fi) |
|
Line 167 lisGEN(FILE *fi) |
|
GEN x = flisexpr(buf); |
GEN x = flisexpr(buf); |
free(buf); return x; |
free(buf); return x; |
} |
} |
buf = gprealloc(buf, size<<1, size); |
buf = gprealloc(buf, size<<1); |
s = buf + (size-1); n = size+1; size <<= 1; |
s = buf + (size-1); n = size+1; size <<= 1; |
} |
} |
#if defined(UNIX) || defined(__EMX__) |
#if defined(UNIX) || defined(__EMX__) |
Line 227 pariflush(void) { pariOut->flush(); } |
|
Line 245 pariflush(void) { pariOut->flush(); } |
|
void |
void |
flusherr(void) { pariErr->flush(); } |
flusherr(void) { pariErr->flush(); } |
|
|
/* format is standard printf format, except %Z is a GEN (cast to long) */ |
/* format is standard printf format, except %Z is a GEN */ |
void |
void |
vpariputs(char* format, va_list args) |
vpariputs(char* format, va_list args) |
{ |
{ |
char buf[1024], str[1024], *f = format, *s = str; |
long nb = 0, bufsize = 1023; |
long nb = 0; |
char *buf, *str, *s, *f = format; |
|
|
|
/* replace each %Z (2 chars) by braced address format (8 chars) */ |
|
s = str = gpmalloc(strlen(format)*4 + 1); |
while (*f) |
while (*f) |
{ |
{ |
if (*f != '%') *s++ = *f++; |
if (*f != '%') *s++ = *f++; |
Line 247 vpariputs(char* format, va_list args) |
|
Line 267 vpariputs(char* format, va_list args) |
|
} |
} |
} |
} |
} |
} |
*s = 0; vsprintf(buf,str,args); s = buf; |
*s = 0; |
|
#ifdef HAS_VSNPRINTF |
|
for(;;) |
|
{ |
|
int l; |
|
buf = gpmalloc(bufsize); |
|
l = vsnprintf(buf,bufsize,str,args); |
|
if (l < 0) l = bufsize<<1; else if (l < bufsize) break; |
|
free(buf); bufsize++; |
|
} |
|
buf[bufsize] = 0; /* just in case */ |
|
#else |
|
buf = gpmalloc(bufsize); |
|
(void)vsprintf(buf,str,args); /* pray it does fit */ |
|
#endif |
|
f = s = buf; |
if (nb) |
if (nb) |
for (f=s; *f; f++) |
while ( *f ) |
|
{ |
if (*f == '\003' && f[21] == '\003') |
if (*f == '\003' && f[21] == '\003') |
{ |
{ |
*f = 0; f[21] = 0; /* remove the bracing chars */ |
*f = 0; f[21] = 0; /* remove the bracing chars */ |
pariOut->puts(s); bruteall((GEN)atol(f+1),'g',-1,1); |
pariOut->puts(s); bruteall((GEN)atol(f+1),'g',-1,1); |
f += 22; s = f; |
f += 22; s = f; |
nb--; if (!nb) break; |
if (!--nb) break; |
} |
} |
pariOut->puts(s); |
else |
|
f++; |
|
} |
|
pariOut->puts(s); free(buf); free(str); |
} |
} |
|
|
void |
void |
Line 326 static int col_index, lin_index, max_width, max_lin; |
|
Line 365 static int col_index, lin_index, max_width, max_lin; |
|
#endif |
#endif |
|
|
static int |
static int |
term_width_intern() |
term_width_intern(void) |
{ |
{ |
#ifdef HAS_TIOCGWINSZ |
#ifdef HAS_TIOCGWINSZ |
{ |
{ |
struct winsize s; |
struct winsize s; |
if (!under_emacs && !under_texmacs && !ioctl(0, TIOCGWINSZ, &s)) |
if (!(GP_DATA && (GP_DATA->flags & (EMACS|TEXMACS))) |
return s.ws_col; |
&& !ioctl(0, TIOCGWINSZ, &s)) return s.ws_col; |
} |
} |
#endif |
#endif |
#ifdef UNIX |
#ifdef UNIX |
Line 351 term_width_intern() |
|
Line 390 term_width_intern() |
|
} |
} |
|
|
static int |
static int |
term_height_intern() |
term_height_intern(void) |
{ |
{ |
#ifdef HAS_TIOCGWINSZ |
#ifdef HAS_TIOCGWINSZ |
{ |
{ |
struct winsize s; |
struct winsize s; |
if (!under_emacs && !under_texmacs && !ioctl(0, TIOCGWINSZ, &s)) |
if (!(GP_DATA && (GP_DATA->flags & (EMACS|TEXMACS))) |
return s.ws_row; |
&& !ioctl(0, TIOCGWINSZ, &s)) return s.ws_row; |
} |
} |
#endif |
#endif |
#ifdef UNIX |
#ifdef UNIX |
Line 379 term_height_intern() |
|
Line 418 term_height_intern() |
|
#define DFT_TERM_HEIGHT 20 |
#define DFT_TERM_HEIGHT 20 |
|
|
int |
int |
term_width() |
term_width(void) |
{ |
{ |
int n = term_width_intern(); |
int n = term_width_intern(); |
return (n>1)? n: DFT_TERM_WIDTH; |
return (n>1)? n: DFT_TERM_WIDTH; |
} |
} |
|
|
int |
int |
term_height() |
term_height(void) |
{ |
{ |
int n = term_height_intern(); |
int n = term_height_intern(); |
return (n>1)? n: DFT_TERM_HEIGHT; |
return (n>1)? n: DFT_TERM_HEIGHT; |
|
|
} |
} |
PariOUT pariOut80= {putc80, puts80, normalOutF, NULL}; |
PariOUT pariOut80= {putc80, puts80, normalOutF, NULL}; |
|
|
void |
static void |
init80(long n) |
init80(long n) |
{ |
{ |
col_index = n; pariOut = &pariOut80; |
col_index = n; pariOut = &pariOut80; |
Line 448 puts_lim_lines(char *s) |
|
Line 487 puts_lim_lines(char *s) |
|
|
|
PariOUT pariOut_lim_lines= {putc_lim_lines, puts_lim_lines, normalOutF, NULL}; |
PariOUT pariOut_lim_lines= {putc_lim_lines, puts_lim_lines, normalOutF, NULL}; |
|
|
/* s = prefix already printed (print up to max lines) */ |
/* n = length of prefix already printed (print up to max lines) */ |
void |
void |
init_lim_lines(char *s, long max) |
lim_lines_output(GEN z, pariout_t *fmt, long n, long max) |
{ |
{ |
if (!max) return; |
PariOUT *tmp = pariOut; |
if (!s) { pariOut = &defaultOut; return; } |
|
max_width = term_width(); |
max_width = term_width(); |
max_lin = max; |
max_lin = max; |
lin_index = 1; col_index = strlen(s); |
lin_index = 1; |
|
col_index = n; |
pariOut = &pariOut_lim_lines; |
pariOut = &pariOut_lim_lines; |
|
gen_output(z, fmt); |
|
pariOut = tmp; |
} |
} |
|
|
#define is_blank_or_null(c) (!(c) || is_blank(c)) |
#define is_blank_or_null(c) (!(c) || is_blank(c)) |
Line 566 static outString *OutStr, *ErrStr = NULL; |
|
Line 607 static outString *OutStr, *ErrStr = NULL; |
|
#define check_output_length(str,l) { \ |
#define check_output_length(str,l) { \ |
const ulong s = str->size; \ |
const ulong s = str->size; \ |
if (str->len + l >= s) { \ |
if (str->len + l >= s) { \ |
ulong t = s + l + STEPSIZE; \ |
str->size = s + l + STEPSIZE; \ |
str->string = gprealloc(str->string, t, s); \ |
str->string = gprealloc(str->string, str->size); \ |
str->size = t; \ |
|
} \ |
} \ |
} |
} |
|
|
Line 608 pari_strdup(char *s) |
|
Line 648 pari_strdup(char *s) |
|
|
|
/* returns a malloc-ed string, which should be freed after usage */ |
/* returns a malloc-ed string, which should be freed after usage */ |
char * |
char * |
GENtostr0(GEN x, void(*do_out)(GEN)) |
GENtostr0(GEN x, pariout_t *T, void (*do_out)(GEN, pariout_t*)) |
{ |
{ |
PariOUT *tmp = pariOut; |
PariOUT *tmp = pariOut; |
outString *tmps = OutStr, newStr; |
outString *tmps = OutStr, newStr; |
|
|
if (typ(x) == t_STR) return pari_strdup(GSTR(x)); |
if (typ(x) == t_STR) return pari_strdup(GSTR(x)); |
pariOut = &pariOut2Str; OutStr = &newStr; |
pariOut = &pariOut2Str; |
OutStr->len = 0; OutStr->size=0; OutStr->string=NULL; |
newStr.len = 0; |
do_out(x); OutStr->string[OutStr->len] = 0; |
newStr.size = 0; |
|
newStr.string= NULL; OutStr = &newStr; |
|
do_out(x, T); |
|
OutStr->string[OutStr->len] = 0; |
|
|
pariOut = tmp; OutStr = tmps; return newStr.string; |
pariOut = tmp; OutStr = tmps; return newStr.string; |
} |
} |
|
|
char * |
char * |
GENtostr(GEN x) { return GENtostr0(x,outbrute); } |
GENtostr(GEN x) { return GENtostr0(x, NULL, &gen_output); } |
|
|
/********************************************************************/ |
/********************************************************************/ |
/** **/ |
/** **/ |
/** WRITE AN INTEGER **/ |
/** WRITE AN INTEGER **/ |
/** **/ |
/** **/ |
/********************************************************************/ |
/********************************************************************/ |
|
#define putsigne_nosp(x) pariputc((x>0)? '+' : '-') |
#define putsigne(x) pariputs((x>0)? " + " : " - ") |
#define putsigne(x) pariputs((x>0)? " + " : " - ") |
#define sp_sign_sp(x) sp(), pariputc(x>0? '+': '-'), sp() |
#define sp_sign_sp(T,x) ((T)->sp? putsigne(x): putsigne_nosp(x)) |
#define sp_plus_sp() sp(), pariputc('+'), sp() |
#define sp(T) do { if ((T)->sp) pariputc(' '); } while(0); |
#define comma_sp() pariputc(','), sp() |
#define comma_sp(T) ((T)->sp? pariputs(", "): pariputc(',')) |
|
|
static void wr_space() {pariputc(' ');} |
|
static void no_space() {} |
|
|
|
static void |
static void |
blancs(long nb) { while (nb-- > 0) pariputc(' '); } |
blancs(long nb) { while (nb-- > 0) pariputc(' '); } |
|
|
|
|
pariputs(p); return 9 - (p - cha); |
pariputs(p); return 9 - (p - cha); |
} |
} |
|
|
/* as above, printing leading 0s, return # significant digits printed */ |
/* as above, printing leading 0s, return # significant digits printed |
|
* print at most dec significant digits */ |
static long |
static long |
coinit2(long x) |
coinit2(long x, long dec) |
{ |
{ |
char cha[10], *p = cha + 9; |
char cha[10], *p = cha + 9; |
int i = 0; |
int i = 0; |
|
|
for (*p = 0; p > cha; x /= 10) *--p = x%10 + '0'; |
for (*p = 0; p > cha; x /= 10) *--p = x%10 + '0'; |
while (cha[i] == '0') i++; |
while (cha[i] == '0') i++; |
pariputs(cha); return 9 - i; |
i = 9-i; /* # significant digits to print */ |
|
if (i > dec) { i = dec; cha[dec] = 0; } |
|
pariputs(cha); return i; |
} |
} |
|
|
|
|
static void |
static void |
comilieu(long x) |
comilieu(long x) |
{ |
{ |
|
|
return 10; /* not reached */ |
return 10; /* not reached */ |
} |
} |
|
|
/* write an int. fw = field width (pad with ' ') */ |
/* write int x > 0 */ |
static void |
static void |
wr_int(GEN x, long fw, long nosign) |
wr_intpos(GEN x) |
{ |
{ |
long *res,*re,i, sx=signe(x); |
long *res = convi(x); |
|
(void)coinit(*--res); while (*--res >= 0) comilieu(*res); |
|
} |
|
|
if (!sx) { blancs(fw-1); pariputc('0'); return; } |
/* write int. T->fieldw: field width (pad with ' ') */ |
setsigne(x,1); re = res = convi(x); |
static void |
setsigne(x,sx); |
wr_int(pariout_t *T, GEN x, int nosign) |
|
{ |
|
long *res,*re,i, sx = signe(x); |
|
int minus; |
|
|
|
if (!sx) { blancs(T->fieldw - 1); pariputc('0'); return; } |
|
re = res = convi(x); |
i = nbdch(*--re); while (*--re >= 0) i+=9; |
i = nbdch(*--re); while (*--re >= 0) i+=9; |
if (nosign || sx>0) blancs(fw-i); |
minus = (sx < 0 && !nosign); |
else |
if (minus) i++; |
{ i++; blancs(fw-i); pariputc('-'); } |
|
coinit(*--res); while (*--res >= 0) comilieu(*res); |
blancs(T->fieldw - i); |
|
if (minus) pariputc('-'); |
|
(void)coinit(*--res); while (*--res >= 0) comilieu(*res); |
} |
} |
|
|
static void |
static void |
wr_vecsmall(GEN g) |
wr_vecsmall(pariout_t *T, GEN g) |
{ |
{ |
long i,l; |
long i,l; |
pariputc('['); l = lg(g); |
pariputs("Vecsmall(["); l = lg(g); |
for (i=1; i<l; i++) |
for (i=1; i<l; i++) |
{ |
{ |
pariputsf("%ld", g[i]); |
pariputsf("%ld", g[i]); |
if (i<l-1) comma_sp(); |
if (i<l-1) comma_sp(T); |
} |
} |
pariputc(']'); |
pariputs("])"); |
} |
} |
/********************************************************************/ |
/********************************************************************/ |
/** **/ |
/** **/ |
/** WRITE A REAL NUMBER **/ |
/** WRITE A REAL NUMBER **/ |
/** **/ |
/** **/ |
/********************************************************************/ |
/********************************************************************/ |
static void wr_exp(GEN x); |
static void wr_exp(pariout_t *T, GEN x); |
|
|
/* assume x != 0 and print |x| in floating point format */ |
/* assume x != 0 and print |x| in floating point format */ |
static void |
static void |
wr_float(GEN x) |
wr_float(pariout_t *T, GEN x) |
{ |
{ |
long *res, ex,s,d,e,decmax, dec = decimals; |
long *res, ex,s,d,e,decmax, dec = T->sigd; |
GEN p1; |
GEN p1; |
|
|
if (dec>0) /* round if needed */ |
if (dec>0) /* round if needed */ |
{ |
{ |
GEN arrondi = cgetr(3); |
GEN arrondi = cgetr(3); |
arrondi[1] = (long) (x[1]-((double)BITS_IN_LONG/pariK)*dec-2); |
ex = expo(x) - (long)((((double)BITS_IN_LONG)/pariK)*dec+2); |
|
arrondi[1] = evalsigne(1)|evalexpo(ex); |
arrondi[2] = x[2]; x = addrr(x,arrondi); |
arrondi[2] = x[2]; x = addrr(x,arrondi); |
} |
} |
ex = expo(x); e = bit_accuracy(lg(x)); /* significant bits */ |
ex = expo(x); e = bit_accuracy(lg(x)); /* significant bits */ |
if (ex >= e) { wr_exp(x); return; } |
if (ex >= e) { wr_exp(T,x); return; } |
decmax = (long) (e * L2SL10); /* significant digits */ |
decmax = (long) (e * L2SL10); /* significant digits */ |
if ((ulong)decmax < (ulong)dec) dec = decmax; /* Hack: includes dec < 0 */ |
if ((ulong)decmax < (ulong)dec) dec = decmax; /* Hack: includes dec < 0 */ |
|
|
|
|
if (!s) |
if (!s) |
{ |
{ |
while (!*res) { res++; pariputs("000000000"); } |
while (!*res) { res++; pariputs("000000000"); } |
d = coinit2(*res++); |
d = coinit2(*res++, dec); |
} |
} |
|
|
/* d = # significant digits already printed */ |
/* d = # significant digits already printed */ |
|
|
|
|
/* as above in exponential format */ |
/* as above in exponential format */ |
static void |
static void |
wr_exp(GEN x) |
wr_exp(pariout_t *T, GEN x) |
{ |
{ |
GEN dix = cgetr(lg(x)+1); |
GEN dix = stor(10, lg(x)+1); |
long ex = expo(x); |
long e = expo(x); |
|
|
ex = (ex>=0)? (long)(ex*L2SL10): (long)(-(-ex*L2SL10)-1); |
e = (e>=0)? (long)(e*L2SL10): (long)(-(-e*L2SL10)-1); |
affsr(10,dix); if (ex) x = mulrr(x,gpuigs(dix,-ex)); |
if (e) x = mulrr(x, gpowgs(dix,-e)); |
if (absr_cmp(x, dix) >= 0) { x=divrr(x,dix); ex++; } |
if (absr_cmp(x, dix) >= 0) { x = divrr(x,dix); e++; } |
wr_float(x); sp(); pariputsf("E%ld",ex); |
wr_float(T,x); sp(T); pariputsf("E%ld",e); |
} |
} |
|
|
/* Write real number x. |
/* Write real number x. |
* format: e (exponential), f (floating point), g (as f unless x too small) |
* format: e (exponential), f (floating point), g (as f unless x too small) |
* if format isn't correct (one of the above) act as e. |
* if format isn't correct (one of the above) act as e. |
* decimals: number of decimals to print (all if <0). |
* sigd: number of sigd to print (all if <0). |
*/ |
*/ |
static void |
static void |
wr_real(GEN x, long nosign) |
wr_real(pariout_t *T, GEN x, int nosign) |
{ |
{ |
long ltop, sx = signe(x), ex = expo(x); |
gpmem_t ltop; |
|
long sx = signe(x), ex = expo(x); |
|
|
if (!sx) /* real 0 */ |
if (!sx) /* real 0 */ |
{ |
{ |
if (format == 'f') |
if (T->format == 'f') |
{ |
{ |
if (decimals<0) |
long d, dec = T->sigd; |
|
if (dec < 0) |
{ |
{ |
long d = 1+((-ex)>>TWOPOTBITS_IN_LONG); |
d = 1+((-ex)>>TWOPOTBITS_IN_LONG); |
if (d < 0) d = 0; |
if (d < 0) d = 0; |
decimals=(long)(pariK*d); |
dec = (long)(pariK*d); |
} |
} |
pariputs("0."); zeros(decimals); |
pariputs("0."); zeros(dec); |
} |
} |
else |
else |
{ |
{ |
Line 831 wr_real(GEN x, long nosign) |
|
Line 887 wr_real(GEN x, long nosign) |
|
} |
} |
if (!nosign && sx < 0) pariputc('-'); /* print sign if needed */ |
if (!nosign && sx < 0) pariputc('-'); /* print sign if needed */ |
ltop = avma; |
ltop = avma; |
if ((format == 'g' && ex>=-32) || format == 'f') wr_float(x); else wr_exp(x); |
if ((T->format == 'g' && ex>=-32) |
|
|| T->format == 'f') wr_float(T,x); else wr_exp(T,x); |
avma = ltop; |
avma = ltop; |
} |
} |
|
|
void |
|
ecrire(GEN x, char f, long d, long fw) |
|
{ |
|
if (typ(x)==t_INT) |
|
wr_int(x,fw,0); |
|
else |
|
{ |
|
sp = &wr_space; format = f; decimals = d; |
|
wr_real(x,0); |
|
} |
|
} |
|
|
|
/********************************************************************/ |
/********************************************************************/ |
/** **/ |
/** **/ |
/** HEXADECIMAL OUTPUT **/ |
/** HEXADECIMAL OUTPUT **/ |
|
|
static void |
static void |
voir2(GEN x, long nb, long bl) |
voir2(GEN x, long nb, long bl) |
{ |
{ |
long tx=typ(x),i,j,e,dx,lx=lg(x); |
long tx,i,j,e,dx,lx; |
|
|
|
if (!x) { pariputs("NULL\n"); return; } |
|
tx = typ(x); |
if (tx == t_INT && x == gzero) { pariputs("gzero\n"); return; } |
if (tx == t_INT && x == gzero) { pariputs("gzero\n"); return; } |
if (tx == t_SMALL) { |
if (tx == t_SMALL) { |
pariputs("[SMALL "); |
pariputs("[SMALL "); |
Line 906 voir2(GEN x, long nb, long bl) |
|
Line 953 voir2(GEN x, long nb, long bl) |
|
} |
} |
sorstring(VOIR_STRING1,(ulong)x); |
sorstring(VOIR_STRING1,(ulong)x); |
|
|
|
lx = lg(x); |
pariputsf("%s(lg=%ld%s):",type_name(tx)+2,lx,isclone(x)? ",CLONE" : ""); |
pariputsf("%s(lg=%ld%s):",type_name(tx)+2,lx,isclone(x)? ",CLONE" : ""); |
sorstring(VOIR_STRING2,x[0]); |
sorstring(VOIR_STRING2,x[0]); |
if (! is_recursive_t(tx)) /* t_SMALL, t_INT, t_REAL, t_STR, t_VECSMALL */ |
if (! is_recursive_t(tx)) /* t_SMALL, t_INT, t_REAL, t_STR, t_VECSMALL */ |
{ |
{ |
if (tx == t_STR) |
if (tx == t_STR) |
pariputs("chars:"); |
pariputs("chars:"); |
else if (tx == t_INT) |
else if (tx == t_INT) |
pariputsf("(%c,lgef=%ld):", vsigne(x), lgefint(x)); |
pariputsf("(%c,lgef=%ld):", vsigne(x), lgefint(x)); |
else if (tx == t_REAL) |
else if (tx == t_REAL) |
pariputsf("(%c,expo=%ld):", vsigne(x), expo(x)); |
pariputsf("(%c,expo=%ld):", vsigne(x), expo(x)); |
if (nb<0) nb = (tx==t_INT)? lgefint(x): lx; |
if (nb<0) nb = (tx==t_INT)? lgefint(x): lx; |
if (tx == t_VECSMALL) nb = lx; |
if (tx == t_VECSMALL) nb = lx; |
for (i=1; i < nb; i++) sorstring(VOIR_STRING2,x[i]); |
for (i=1; i < nb; i++) sorstring(VOIR_STRING2,x[i]); |
Line 1095 texnome(char *v, long deg) |
|
Line 1143 texnome(char *v, long deg) |
|
void |
void |
etatpile(unsigned int n) |
etatpile(unsigned int n) |
{ |
{ |
long av=avma,nu,i,l,m; |
long nu, i, l, m; |
|
gpmem_t av=avma; |
GEN adr,adr1; |
GEN adr,adr1; |
double r; |
double r; |
|
|
|
|
|
|
/* write a * v^d */ |
/* write a * v^d */ |
static void |
static void |
wr_monome(GEN a, char *v, long d) |
wr_monome(pariout_t *T, GEN a, char *v, long d) |
{ |
{ |
long sig = isone(a); |
long sig = isone(a); |
|
|
if (sig) { sp_sign_sp(sig); monome(v,d); } |
if (sig) { sp_sign_sp(T,sig); monome(v,d); } |
else |
else |
{ |
{ |
sig = isfactor(a); |
sig = isfactor(a); |
if (sig) { sp_sign_sp(sig); bruti(a,sig); } |
if (sig) { sp_sign_sp(T,sig); bruti(a,T,sig); } |
else |
else |
{ |
{ |
sp_plus_sp(); pariputc('('); bruti(a,sig); pariputc(')'); |
sp_sign_sp(T,1); pariputc('('); bruti(a,T,sig); pariputc(')'); |
} |
} |
if (d) { pariputc('*'); monome(v,d); } |
if (d) { pariputc('*'); monome(v,d); } |
} |
} |
} |
} |
|
|
static void |
static void |
wr_texnome(GEN a, char *v, long d) |
wr_texnome(pariout_t *T, GEN a, char *v, long d) |
{ |
{ |
long sig = isone(a); |
long sig = isone(a); |
|
|
Line 1292 wr_texnome(GEN a, char *v, long d) |
|
Line 1341 wr_texnome(GEN a, char *v, long d) |
|
else |
else |
{ |
{ |
sig = isfactor(a); |
sig = isfactor(a); |
if (sig) { putsigne(sig); texi(a,sig); } |
if (sig) { putsigne(sig); texi(a,T,sig); } |
else |
else |
{ |
{ |
pariputs(" + \\left("); texi(a,sig); pariputs("\\right) "); |
pariputs(" + \\left("); texi(a,T,sig); pariputs("\\right) "); |
} |
} |
if (d) |
if (d) |
{ |
{ |
if (under_texmacs) pariputs("\\*"); |
if (GP_DATA && (GP_DATA->flags & TEXMACS)) pariputs("\\*"); |
texnome(v,d); |
texnome(v,d); |
} |
} |
} |
} |
} |
} |
|
|
static void |
static void |
wr_lead_monome(GEN a, char *v, long d, long nosign) |
wr_lead_monome(pariout_t *T, GEN a, char *v, long d, int nosign) |
{ |
{ |
long sig = isone(a); |
long sig = isone(a); |
if (sig) |
if (sig) |
Line 1316 wr_lead_monome(GEN a, char *v, long d, long nosign) |
|
Line 1365 wr_lead_monome(GEN a, char *v, long d, long nosign) |
|
} |
} |
else |
else |
{ |
{ |
if (isfactor(a)) bruti(a,nosign); |
if (isfactor(a)) bruti(a,T,nosign); |
else |
else |
{ |
{ |
pariputc('('); bruti(a,0); pariputc(')'); |
pariputc('('); bruti(a,T,0); pariputc(')'); |
} |
} |
if (d) { pariputc('*'); monome(v,d); } |
if (d) { pariputc('*'); monome(v,d); } |
} |
} |
} |
} |
|
|
static void |
static void |
wr_lead_texnome(GEN a, char *v, long d, long nosign) |
wr_lead_texnome(pariout_t *T, GEN a, char *v, long d, int nosign) |
{ |
{ |
long sig = isone(a); |
long sig = isone(a); |
if (sig) |
if (sig) |
Line 1336 wr_lead_texnome(GEN a, char *v, long d, long nosign) |
|
Line 1385 wr_lead_texnome(GEN a, char *v, long d, long nosign) |
|
} |
} |
else |
else |
{ |
{ |
if (isfactor(a)) texi(a,nosign); |
if (isfactor(a)) texi(a,T,nosign); |
else |
else |
{ |
{ |
pariputs(" \\left("); texi(a,0); pariputs("\\right) "); |
pariputs(" \\left("); texi(a,T,0); pariputs("\\right) "); |
} |
} |
if (d) |
if (d) |
{ |
{ |
if (under_texmacs) pariputs("\\*"); |
if (GP_DATA && (GP_DATA->flags & TEXMACS)) pariputs("\\*"); |
texnome(v,d); |
texnome(v,d); |
} |
} |
} |
} |
} |
} |
|
|
static void |
void |
bruti(GEN g, long nosign) |
bruti(GEN g, pariout_t *T, int nosign) |
{ |
{ |
long tg,l,i,j,r; |
long tg,l,i,j,r; |
GEN a,b; |
GEN a,b; |
Line 1369 bruti(GEN g, long nosign) |
|
Line 1418 bruti(GEN g, long nosign) |
|
switch(tg) |
switch(tg) |
{ |
{ |
case t_SMALL: pariputsf("%ld",smalltos(g)); break; |
case t_SMALL: pariputsf("%ld",smalltos(g)); break; |
case t_INT: wr_int(g,0,nosign); break; |
case t_INT: |
case t_REAL: wr_real(g,nosign); break; |
if (!nosign && signe(g) < 0) pariputc('-'); |
|
wr_intpos(g); break; |
|
case t_REAL: wr_real(T,g,nosign); break; |
|
|
case t_INTMOD: case t_POLMOD: |
case t_INTMOD: case t_POLMOD: |
pariputs(new_fun_set? "Mod(": "mod("); |
pariputs(new_fun_set? "Mod(": "mod("); |
bruti((GEN)g[2],0); comma_sp(); |
bruti((GEN)g[2],T,0); comma_sp(T); |
bruti((GEN)g[1],0); pariputc(')'); break; |
bruti((GEN)g[1],T,0); pariputc(')'); break; |
|
|
case t_FRAC: case t_FRACN: case t_RFRAC: case t_RFRACN: |
case t_FRAC: case t_FRACN: case t_RFRAC: case t_RFRACN: |
r = isfactor((GEN)g[1]); if (!r) pariputc('('); |
r = isfactor((GEN)g[1]); if (!r) pariputc('('); |
bruti((GEN)g[1],nosign); |
bruti((GEN)g[1],T,nosign); |
if (!r) pariputc(')'); |
if (!r) pariputc(')'); |
pariputc('/'); |
pariputc('/'); |
r = isdenom((GEN)g[2]); if (!r) pariputc('('); |
r = isdenom((GEN)g[2]); if (!r) pariputc('('); |
bruti((GEN)g[2],0); |
bruti((GEN)g[2],T,0); |
if (!r) pariputc(')'); |
if (!r) pariputc(')'); |
break; |
break; |
|
|
Line 1391 bruti(GEN g, long nosign) |
|
Line 1442 bruti(GEN g, long nosign) |
|
a = (GEN)g[r+1]; b = (GEN)g[r+2]; v = r? "w": "I"; |
a = (GEN)g[r+1]; b = (GEN)g[r+2]; v = r? "w": "I"; |
if (isnull(a)) |
if (isnull(a)) |
{ |
{ |
wr_lead_monome(b,v,1,nosign); |
wr_lead_monome(T,b,v,1,nosign); |
return; |
return; |
} |
} |
bruti(a,nosign); |
bruti(a,T,nosign); |
if (!isnull(b)) wr_monome(b,v,1); |
if (!isnull(b)) wr_monome(T,b,v,1); |
break; |
break; |
|
|
case t_POL: v = get_var(ordvar[varn(g)], buf); |
case t_POL: v = get_var(ordvar[varn(g)], buf); |
/* hack: we want g[i] = coeff of degree i. */ |
/* hack: we want g[i] = coeff of degree i. */ |
i = degpol(g); g += 2; while (isnull((GEN)g[i])) i--; |
i = degpol(g); g += 2; while (isnull((GEN)g[i])) i--; |
wr_lead_monome((GEN)g[i],v,i,nosign); |
wr_lead_monome(T,(GEN)g[i],v,i,nosign); |
while (i--) |
while (i--) |
{ |
{ |
a = (GEN)g[i]; |
a = (GEN)g[i]; |
if (!isnull_for_pol(a)) wr_monome(a,v,i); |
if (!isnull_for_pol(a)) wr_monome(T,a,v,i); |
} |
} |
break; |
break; |
|
|
Line 1414 bruti(GEN g, long nosign) |
|
Line 1465 bruti(GEN g, long nosign) |
|
if (signe(g)) |
if (signe(g)) |
{ /* hack: we want g[i] = coeff of degree i. */ |
{ /* hack: we want g[i] = coeff of degree i. */ |
l = i + lg(g)-2; g += (2-i); |
l = i + lg(g)-2; g += (2-i); |
wr_lead_monome((GEN)g[i],v,i,nosign); |
wr_lead_monome(T,(GEN)g[i],v,i,nosign); |
while (++i < l) |
while (++i < l) |
{ |
{ |
a = (GEN)g[i]; |
a = (GEN)g[i]; |
if (!isnull_for_pol(a)) wr_monome(a,v,i); |
if (!isnull_for_pol(a)) wr_monome(T,a,v,i); |
} |
} |
sp_plus_sp(); |
sp_sign_sp(T,1); |
} |
} |
pariputs("O("); monome(v,i); pariputc(')'); break; |
pariputs("O("); monome(v,i); pariputc(')'); break; |
|
|
case t_PADIC: |
case t_PADIC: |
{ |
{ |
GEN p = (GEN)g[2]; |
GEN p = (GEN)g[2]; |
|
gpmem_t av = avma; |
i = valp(g); l = precp(g)+i; |
i = valp(g); l = precp(g)+i; |
g = (GEN)g[4]; v = GENtostr(p); |
g = (GEN)g[4]; v = GENtostr(p); |
for (; i<l; i++) |
for (; i<l; i++) |
Line 1436 bruti(GEN g, long nosign) |
|
Line 1488 bruti(GEN g, long nosign) |
|
{ |
{ |
if (!i || !is_pm1(a)) |
if (!i || !is_pm1(a)) |
{ |
{ |
wr_int(a,0,1); if (i) pariputc('*'); |
wr_intpos(a); if (i) pariputc('*'); |
} |
} |
if (i) padic_nome(v,i); |
if (i) padic_nome(v,i); |
sp_plus_sp(); |
sp_sign_sp(T,1); |
} |
} |
|
if ((i & 0xff) == 0) g = gerepileuptoint(av,g); |
} |
} |
pariputs("O("); padic_nome(v,i); pariputc(')'); |
pariputs("O("); padic_nome(v,i); pariputc(')'); |
free(v); break; |
free(v); break; |
Line 1448 bruti(GEN g, long nosign) |
|
Line 1501 bruti(GEN g, long nosign) |
|
|
|
case t_QFR: case t_QFI: r = (tg == t_QFR); |
case t_QFR: case t_QFI: r = (tg == t_QFR); |
if (new_fun_set) pariputs("Qfb("); else pariputs(r? "qfr(": "qfi("); |
if (new_fun_set) pariputs("Qfb("); else pariputs(r? "qfr(": "qfi("); |
bruti((GEN)g[1],0); comma_sp(); |
bruti((GEN)g[1],T,0); comma_sp(T); |
bruti((GEN)g[2],0); comma_sp(); |
bruti((GEN)g[2],T,0); comma_sp(T); |
bruti((GEN)g[3],0); |
bruti((GEN)g[3],T,0); |
if (r) { comma_sp(); bruti((GEN)g[4],0); } |
if (r) { comma_sp(T); bruti((GEN)g[4],T,0); } |
pariputc(')'); break; |
pariputc(')'); break; |
|
|
case t_VEC: case t_COL: |
case t_VEC: case t_COL: |
pariputc('['); l = lg(g); |
pariputc('['); l = lg(g); |
for (i=1; i<l; i++) |
for (i=1; i<l; i++) |
{ |
{ |
bruti((GEN)g[i],0); |
bruti((GEN)g[i],T,0); |
if (i<l-1) comma_sp(); |
if (i<l-1) comma_sp(T); |
} |
} |
pariputc(']'); if (tg==t_COL) pariputc('~'); |
pariputc(']'); if (tg==t_COL) pariputc('~'); |
break; |
break; |
case t_VECSMALL: wr_vecsmall(g); break; |
case t_VECSMALL: wr_vecsmall(T,g); break; |
|
|
case t_LIST: |
case t_LIST: |
pariputs("List(["); l = lgef(g); |
pariputs("List(["); l = lgef(g); |
for (i=2; i<l; i++) |
for (i=2; i<l; i++) |
{ |
{ |
bruti((GEN)g[i],0); |
bruti((GEN)g[i],T,0); |
if (i<l-1) comma_sp(); |
if (i<l-1) comma_sp(T); |
} |
} |
pariputs("])"); break; |
pariputs("])"); break; |
|
|
Line 1489 bruti(GEN g, long nosign) |
|
Line 1542 bruti(GEN g, long nosign) |
|
if (l==2) |
if (l==2) |
{ |
{ |
pariputs(new_fun_set? "Mat(": "mat("); |
pariputs(new_fun_set? "Mat(": "mat("); |
if (r == 2) { bruti(gcoeff(g,1,1),0); pariputc(')'); return; } |
if (r == 2) { bruti(gcoeff(g,1,1),T,0); pariputc(')'); return; } |
} |
} |
pariputc('['); |
pariputc('['); |
for (i=1; i<l; i++) |
for (i=1; i<l; i++) |
{ |
{ |
for (j=1; j<r; j++) |
for (j=1; j<r; j++) |
{ |
{ |
bruti(gcoeff(g,i,j),0); |
bruti(gcoeff(g,i,j),T,0); |
if (j<r-1) comma_sp(); |
if (j<r-1) comma_sp(T); |
} |
} |
if (i<l-1) { pariputc(';'); sp(); } |
if (i<l-1) { pariputc(';'); sp(T); } |
} |
} |
pariputc(']'); if (l==2) pariputc(')'); |
pariputc(']'); if (l==2) pariputc(')'); |
break; |
break; |
Line 1508 bruti(GEN g, long nosign) |
|
Line 1561 bruti(GEN g, long nosign) |
|
} |
} |
} |
} |
|
|
static void |
void |
matbruti(GEN g, long flag) |
matbruti(GEN g, pariout_t *T) |
{ |
{ |
long i,j,r,l; |
long i,j,r,l; |
|
|
if (typ(g) != t_MAT) { bruti(g,flag); return; } |
if (typ(g) != t_MAT) { bruti(g,T,0); return; } |
|
|
r=lg(g); if (r==1 || lg(g[1])==1) { pariputs("[;]\n"); return; } |
r=lg(g); if (r==1 || lg(g[1])==1) { pariputs("[;]\n"); return; } |
pariputc('\n'); l = lg(g[1]); |
pariputc('\n'); l = lg(g[1]); |
Line 1522 matbruti(GEN g, long flag) |
|
Line 1575 matbruti(GEN g, long flag) |
|
pariputc('['); |
pariputc('['); |
for (j=1; j<r; j++) |
for (j=1; j<r; j++) |
{ |
{ |
bruti(gcoeff(g,i,j),0); if (j<r-1) pariputc(' '); |
bruti(gcoeff(g,i,j),T,0); if (j<r-1) pariputc(' '); |
} |
} |
if (i<l-1) pariputs("]\n\n"); else pariputs("]\n"); |
if (i<l-1) pariputs("]\n\n"); else pariputs("]\n"); |
} |
} |
} |
} |
|
|
static void |
static void |
sor_monome(GEN a, char *v, long d) |
sor_monome(pariout_t *T, GEN a, char *v, long d) |
{ |
{ |
long sig = isone(a); |
long sig = isone(a); |
if (sig) { putsigne(sig); monome(v,d); } |
if (sig) { putsigne(sig); monome(v,d); } |
Line 1538 sor_monome(GEN a, char *v, long d) |
|
Line 1591 sor_monome(GEN a, char *v, long d) |
|
sig = isfactor(a); |
sig = isfactor(a); |
if (sig) { putsigne(sig); if (sig < 0) a = gneg(a); } |
if (sig) { putsigne(sig); if (sig < 0) a = gneg(a); } |
else pariputs(" + "); |
else pariputs(" + "); |
sori(a); if (d) { pariputc(' '); monome(v,d);} |
sori(a,T); if (d) { pariputc(' '); monome(v,d);} |
} |
} |
} |
} |
|
|
static void |
static void |
sor_lead_monome(GEN a, char *v, long d) |
sor_lead_monome(pariout_t *T, GEN a, char *v, long d) |
{ |
{ |
long sig = isone(a); |
long sig = isone(a); |
if (sig) |
if (sig) |
Line 1553 sor_lead_monome(GEN a, char *v, long d) |
|
Line 1606 sor_lead_monome(GEN a, char *v, long d) |
|
} |
} |
else |
else |
{ |
{ |
sori(a); |
sori(a,T); |
if (d) { pariputc(' '); monome(v,d); } |
if (d) { pariputc(' '); monome(v,d); } |
} |
} |
} |
} |
|
|
static void |
void |
sori(GEN g) |
sori(GEN g, pariout_t *T) |
{ |
{ |
long tg=typ(g), i,j,r,l,close_paren; |
long tg=typ(g), i,j,r,l,close_paren; |
GEN a,b; |
GEN a,b; |
char *v, buf[32]; |
char *v, buf[32]; |
|
|
|
if (tg == t_INT) { wr_int(T,g,0); return; } |
|
if (tg != t_MAT && tg != t_COL) T->fieldw = 0; |
switch (tg) |
switch (tg) |
{ |
{ |
case t_SMALL: pariputsf("%ld",smalltos(g)); return; |
case t_SMALL: pariputsf("%ld",smalltos(g)); return; |
case t_INT: wr_int(g,chmp,0); return; |
case t_REAL: wr_real(T,g,0); return; |
case t_REAL: wr_real(g,0); return; |
|
case t_STR: |
case t_STR: |
pariputc('"'); pariputs(GSTR(g)); pariputc('"'); return; |
pariputc('"'); pariputs(GSTR(g)); pariputc('"'); return; |
case t_LIST: |
case t_LIST: |
chmp=0; pariputs("List("); |
pariputs("List("); |
for (i=2; i<lgef(g); i++) |
for (i=2; i<lgef(g); i++) |
{ |
{ |
sori((GEN)g[i]); if (i<lgef(g)-1) pariputs(", "); |
sori((GEN)g[i], T); if (i<lgef(g)-1) pariputs(", "); |
} |
} |
pariputs(")\n"); return; |
pariputs(")\n"); return; |
} |
} |
close_paren=0; |
close_paren=0; |
if (!is_matvec_t(tg)) chmp = 0; |
|
if (!is_graphicvec_t(tg)) |
if (!is_graphicvec_t(tg)) |
{ |
{ |
if (is_frac_t(tg) && gsigne(g) < 0) pariputc('-'); |
if (is_frac_t(tg) && gsigne(g) < 0) pariputc('-'); |
|
|
case t_INTMOD: case t_POLMOD: |
case t_INTMOD: case t_POLMOD: |
a = (GEN)g[2]; b = (GEN)g[1]; |
a = (GEN)g[2]; b = (GEN)g[1]; |
if (tg == t_INTMOD && signe(a) < 0) a = addii(a,b); |
if (tg == t_INTMOD && signe(a) < 0) a = addii(a,b); |
sori(a); pariputs(" mod "); sori(b); break; |
sori(a,T); pariputs(" mod "); sori(b,T); break; |
|
|
case t_FRAC: case t_FRACN: |
case t_FRAC: case t_FRACN: |
a=(GEN)g[1]; wr_int(a,chmp,1); pariputs(" /"); |
a=(GEN)g[1]; wr_int(T,a,1); pariputs(" /"); |
b=(GEN)g[2]; wr_int(b,chmp,1); break; |
b=(GEN)g[2]; wr_int(T,b,1); break; |
|
|
case t_COMPLEX: case t_QUAD: r = (tg==t_QUAD); |
case t_COMPLEX: case t_QUAD: r = (tg==t_QUAD); |
a = (GEN)g[r+1]; b = (GEN)g[r+2]; v = r? "w": "I"; |
a = (GEN)g[r+1]; b = (GEN)g[r+2]; v = r? "w": "I"; |
if (isnull(a)) { sor_lead_monome(b,v,1); break; } |
if (isnull(a)) { sor_lead_monome(T,b,v,1); break; } |
sori(a); if (!isnull(b)) sor_monome(b,v,1); |
sori(a,T); if (!isnull(b)) sor_monome(T,b,v,1); |
break; |
break; |
|
|
case t_PADIC: |
case t_PADIC: |
|
|
{ |
{ |
if (!i || !is_pm1(a)) |
if (!i || !is_pm1(a)) |
{ |
{ |
wr_int(a,chmp,1); pariputc(i? '*': ' '); |
wr_int(T,a,1); pariputc(i? '*': ' '); |
} |
} |
if (i) { padic_nome(v,i); pariputc(' '); } |
if (i) { padic_nome(v,i); pariputc(' '); } |
pariputs("+ "); |
pariputs("+ "); |
|
|
if (!signe(g)) { pariputc('0'); break; } |
if (!signe(g)) { pariputc('0'); break; } |
v = get_var(ordvar[varn(g)],buf); |
v = get_var(ordvar[varn(g)],buf); |
i = degpol(g); g += 2; while (isnull((GEN)g[i])) i--; |
i = degpol(g); g += 2; while (isnull((GEN)g[i])) i--; |
sor_lead_monome((GEN)g[i],v,i); |
sor_lead_monome(T,(GEN)g[i],v,i); |
while (i--) |
while (i--) |
{ |
{ |
a = (GEN)g[i]; if (!isnull_for_pol(a)) sor_monome(a,v,i); |
a = (GEN)g[i]; if (!isnull_for_pol(a)) sor_monome(T,a,v,i); |
} |
} |
break; |
break; |
|
|
|
|
if (signe(g)) |
if (signe(g)) |
{ /* hack: we want g[i] = coeff of degree i. */ |
{ /* hack: we want g[i] = coeff of degree i. */ |
l = i + lg(g)-2; g += (2-i); |
l = i + lg(g)-2; g += (2-i); |
sor_lead_monome((GEN)g[i],v,i); |
sor_lead_monome(T,(GEN)g[i],v,i); |
while (++i < l) |
while (++i < l) |
{ |
{ |
a = (GEN)g[i]; if (!isnull_for_pol(a)) sor_monome(a,v,i); |
a = (GEN)g[i]; if (!isnull_for_pol(a)) sor_monome(T,a,v,i); |
} |
} |
pariputs(" + "); |
pariputs(" + "); |
} |
} |
|
|
pariputc(')'); break; |
pariputc(')'); break; |
|
|
case t_RFRAC: case t_RFRACN: |
case t_RFRAC: case t_RFRACN: |
if (initial) |
if (T->initial) |
{ |
{ |
char *v1, *v2; |
char *v1, *v2; |
long sd = 0, sn = 0, d,n; |
long sd = 0, sn = 0, d,n; |
long wd = term_width(); |
long wd = term_width(); |
|
|
initial = 0; |
T->initial = 0; |
v1 = GENtostr0((GEN)g[1], &sori); n = strlen(v1); |
v1 = GENtostr0((GEN)g[1], T, &sori); n = strlen(v1); |
v2 = GENtostr0((GEN)g[2], &sori); d = strlen(v2); |
v2 = GENtostr0((GEN)g[2], T, &sori); d = strlen(v2); |
|
|
pariputc('\n'); |
pariputc('\n'); |
i = max(n,d)+2; |
i = max(n,d)+2; |
|
|
blancs(sd+1); pariputs(v2); |
blancs(sd+1); pariputs(v2); |
pariputc('\n'); return; |
pariputc('\n'); return; |
} |
} |
pariputc('('); sori((GEN)g[1]); pariputs(" / "); sori((GEN)g[2]); |
pariputc('('); sori((GEN)g[1],T); pariputs(" / "); sori((GEN)g[2],T); |
pariputc(')'); return; |
pariputc(')'); return; |
|
|
case t_QFR: case t_QFI: pariputc('{'); |
case t_QFR: case t_QFI: pariputc('{'); |
sori((GEN)g[1]); pariputs(", "); |
sori((GEN)g[1],T); pariputs(", "); |
sori((GEN)g[2]); pariputs(", "); |
sori((GEN)g[2],T); pariputs(", "); |
sori((GEN)g[3]); |
sori((GEN)g[3],T); |
if (tg == t_QFR) { pariputs(", "); sori((GEN)g[4]); } |
if (tg == t_QFR) { pariputs(", "); sori((GEN)g[4],T); } |
pariputs("}\n"); break; |
pariputs("}\n"); break; |
|
|
case t_VEC: |
case t_VEC: pariputc('['); |
chmp=0; pariputc('['); |
|
for (i=1; i<lg(g); i++) |
for (i=1; i<lg(g); i++) |
{ |
{ |
sori((GEN)g[i]); if (i<lg(g)-1) pariputs(", "); |
sori((GEN)g[i],T); if (i<lg(g)-1) pariputs(", "); |
} |
} |
pariputc(']'); break; |
pariputc(']'); break; |
case t_VECSMALL: wr_vecsmall(g); break; |
case t_VECSMALL: wr_vecsmall(T,g); break; |
|
|
case t_COL: |
case t_COL: |
if (lg(g)==1) { pariputs("[]\n"); return; } |
if (lg(g)==1) { pariputs("[]\n"); return; } |
pariputc('\n'); |
pariputc('\n'); |
for (i=1; i<lg(g); i++) |
for (i=1; i<lg(g); i++) |
{ |
{ |
pariputc('['); sori((GEN)g[i]); pariputs("]\n"); |
pariputc('['); sori((GEN)g[i],T); pariputs("]\n"); |
} |
} |
break; |
break; |
|
|
|
|
pariputc('['); |
pariputc('['); |
for (j=1; j<lx; j++) |
for (j=1; j<lx; j++) |
{ |
{ |
sori(gcoeff(g,i,j)); if (j<lx-1) pariputc(' '); |
sori(gcoeff(g,i,j),T); if (j<lx-1) pariputc(' '); |
} |
} |
pariputs("]\n"); if (i<l-1) pariputc('\n'); |
pariputs("]\n"); if (i<l-1) pariputc('\n'); |
} |
} |
|
|
/********************************************************************/ |
/********************************************************************/ |
|
|
/* this follows bruti exactly */ |
/* this follows bruti exactly */ |
static void |
void |
texi(GEN g, long nosign) |
texi(GEN g, pariout_t *T, int nosign) |
{ |
{ |
long tg,i,j,l,r; |
long tg,i,j,l,r; |
GEN a,b; |
GEN a,b; |
Line 1757 texi(GEN g, long nosign) |
|
Line 1809 texi(GEN g, long nosign) |
|
tg = typ(g); |
tg = typ(g); |
switch(tg) |
switch(tg) |
{ |
{ |
case t_INT: wr_int(g,0,nosign); break; |
case t_SMALL: pariputsf("%ld",smalltos(g)); break; |
case t_REAL: wr_real(g,nosign); break; |
case t_INT: |
|
if (!nosign && signe(g) < 0) pariputc('-'); |
|
wr_intpos(g); break; |
|
case t_REAL: wr_real(T,g,nosign); break; |
|
|
case t_INTMOD: case t_POLMOD: |
case t_INTMOD: case t_POLMOD: |
texi((GEN)g[2],0); pariputs(" mod "); |
texi((GEN)g[2],T,0); pariputs(" mod "); |
texi((GEN)g[1],0); break; |
texi((GEN)g[1],T,0); break; |
|
|
case t_FRAC: case t_FRACN: case t_RFRAC: case t_RFRACN: |
case t_FRAC: case t_FRACN: case t_RFRAC: case t_RFRACN: |
texi((GEN)g[1],nosign); pariputs("\\over"); |
texi((GEN)g[1],T,nosign); pariputs("\\over"); |
texi((GEN)g[2],0); break; |
texi((GEN)g[2],T,0); break; |
|
|
case t_COMPLEX: case t_QUAD: r = (tg==t_QUAD); |
case t_COMPLEX: case t_QUAD: r = (tg==t_QUAD); |
a = (GEN)g[r+1]; b = (GEN)g[r+2]; v = r? "w": "I"; |
a = (GEN)g[r+1]; b = (GEN)g[r+2]; v = r? "w": "I"; |
if (isnull(a)) |
if (isnull(a)) |
{ |
{ |
wr_lead_texnome(b,v,1,nosign); |
wr_lead_texnome(T,b,v,1,nosign); |
break; |
break; |
} |
} |
texi(a,nosign); |
texi(a,T,nosign); |
if (!isnull(b)) wr_texnome(b,v,1); |
if (!isnull(b)) wr_texnome(T,b,v,1); |
break; |
break; |
|
|
case t_POL: v = get_texvar(ordvar[varn(g)],buf); |
case t_POL: v = get_texvar(ordvar[varn(g)],buf); |
/* hack: we want g[i] = coeff of degree i. */ |
/* hack: we want g[i] = coeff of degree i. */ |
i = degpol(g); g += 2; while (isnull((GEN)g[i])) i--; |
i = degpol(g); g += 2; while (isnull((GEN)g[i])) i--; |
wr_lead_texnome((GEN)g[i],v,i,nosign); |
wr_lead_texnome(T,(GEN)g[i],v,i,nosign); |
while (i--) |
while (i--) |
{ |
{ |
a = (GEN)g[i]; |
a = (GEN)g[i]; |
if (!isnull_for_pol(a)) wr_texnome(a,v,i); |
if (!isnull_for_pol(a)) wr_texnome(T,a,v,i); |
} |
} |
break; |
break; |
|
|
Line 1795 texi(GEN g, long nosign) |
|
Line 1850 texi(GEN g, long nosign) |
|
if (signe(g)) |
if (signe(g)) |
{ /* hack: we want g[i] = coeff of degree i. */ |
{ /* hack: we want g[i] = coeff of degree i. */ |
l = i + lg(g)-2; g += (2-i); |
l = i + lg(g)-2; g += (2-i); |
wr_lead_texnome((GEN)g[i],v,i,nosign); |
wr_lead_texnome(T,(GEN)g[i],v,i,nosign); |
while (++i < l) |
while (++i < l) |
{ |
{ |
a = (GEN)g[i]; |
a = (GEN)g[i]; |
if (!isnull_for_pol(a)) wr_texnome(a,v,i); |
if (!isnull_for_pol(a)) wr_texnome(T,a,v,i); |
} |
} |
pariputs("+ "); |
pariputs("+ "); |
} |
} |
Line 1817 texi(GEN g, long nosign) |
|
Line 1872 texi(GEN g, long nosign) |
|
{ |
{ |
if (!i || !is_pm1(a)) |
if (!i || !is_pm1(a)) |
{ |
{ |
wr_int(a,0,1); if (i) pariputs("\\cdot"); |
wr_intpos(a); if (i) pariputs("\\cdot"); |
} |
} |
if (i) padic_texnome(v,i); |
if (i) padic_texnome(v,i); |
pariputc('+'); |
pariputc('+'); |
Line 1828 texi(GEN g, long nosign) |
|
Line 1883 texi(GEN g, long nosign) |
|
} |
} |
case t_QFR: case t_QFI: r = (tg == t_QFR); |
case t_QFR: case t_QFI: r = (tg == t_QFR); |
if (new_fun_set) pariputs("Qfb("); else pariputs(r? "qfr(": "qfi("); |
if (new_fun_set) pariputs("Qfb("); else pariputs(r? "qfr(": "qfi("); |
texi((GEN)g[1],0); pariputs(", "); |
texi((GEN)g[1],T,0); pariputs(", "); |
texi((GEN)g[2],0); pariputs(", "); |
texi((GEN)g[2],T,0); pariputs(", "); |
texi((GEN)g[3],0); |
texi((GEN)g[3],T,0); |
if (r) { pariputs(", "); texi((GEN)g[4],0); } |
if (r) { pariputs(", "); texi((GEN)g[4],T,0); } |
pariputc(')'); break; |
pariputc(')'); break; |
|
|
case t_VEC: |
case t_VEC: |
pariputs("\\pmatrix{ "); l = lg(g); |
pariputs("\\pmatrix{ "); l = lg(g); |
for (i=1; i<l; i++) |
for (i=1; i<l; i++) |
{ |
{ |
texi((GEN)g[i],0); if (i<lg(g)-1) pariputc('&'); |
texi((GEN)g[i],T,0); if (i<lg(g)-1) pariputc('&'); |
} |
} |
pariputs("\\cr}\n"); break; |
pariputs("\\cr}\n"); break; |
|
|
Line 1846 texi(GEN g, long nosign) |
|
Line 1901 texi(GEN g, long nosign) |
|
pariputs("\\pmatrix{ "); l = lgef(g); |
pariputs("\\pmatrix{ "); l = lgef(g); |
for (i=2; i<l; i++) |
for (i=2; i<l; i++) |
{ |
{ |
texi((GEN)g[i],0); if (i<lgef(g)-1) pariputc('&'); |
texi((GEN)g[i],T,0); if (i<lgef(g)-1) pariputc('&'); |
} |
} |
pariputs("\\cr}\n"); break; |
pariputs("\\cr}\n"); break; |
|
|
Line 1854 texi(GEN g, long nosign) |
|
Line 1909 texi(GEN g, long nosign) |
|
pariputs("\\pmatrix{ "); l = lg(g); |
pariputs("\\pmatrix{ "); l = lg(g); |
for (i=1; i<l; i++) |
for (i=1; i<l; i++) |
{ |
{ |
texi((GEN)g[i],0); pariputs("\\cr\n"); |
texi((GEN)g[i],T,0); pariputs("\\cr\n"); |
} |
} |
pariputc('}'); break; |
pariputc('}'); break; |
|
|
Line 1871 texi(GEN g, long nosign) |
|
Line 1926 texi(GEN g, long nosign) |
|
{ |
{ |
for (j=1; j<r; j++) |
for (j=1; j<r; j++) |
{ |
{ |
texi(gcoeff(g,i,j),0); if (j<r-1) pariputc('&'); |
texi(gcoeff(g,i,j),T,0); if (j<r-1) pariputc('&'); |
} |
} |
pariputs("\\cr\n "); |
pariputs("\\cr\n "); |
} |
} |
Line 1883 texi(GEN g, long nosign) |
|
Line 1938 texi(GEN g, long nosign) |
|
|
|
/*******************************************************************/ |
/*******************************************************************/ |
/** **/ |
/** **/ |
|
/** GP OUTPUT **/ |
|
/** **/ |
|
/*******************************************************************/ |
|
|
|
/* EXTERNAL PRETTYPRINTER */ |
|
|
|
/* Wait for prettinprinter to finish, to prevent new prompt from overwriting |
|
* the output. Fill the output buffer, wait until it is read. |
|
* Better than sleep(2): give possibility to print */ |
|
static void |
|
prettyp_wait(void) |
|
{ |
|
char *s = " \n"; |
|
int i = 400; |
|
|
|
pariputs("\n\n"); pariflush(); /* start translation */ |
|
while (--i) pariputs(s); |
|
pariputs("\n"); pariflush(); |
|
} |
|
|
|
/* initialise external prettyprinter (tex2mail) */ |
|
static int |
|
prettyp_init(void) |
|
{ |
|
gp_pp *pp = GP_DATA->pp; |
|
if (!pp->cmd) return 0; |
|
if (!pp->file) |
|
pp->file = try_pipe(pp->cmd, mf_OUT | mf_TEST); |
|
if (pp->file) return 1; |
|
|
|
err(warner,"broken prettyprinter: '%s'",pp->cmd); |
|
free(pp->cmd); pp->cmd = NULL; return 0; |
|
} |
|
|
|
/* n = history number. if n = 0 no history */ |
|
static int |
|
tex2mail_output(GEN z, long n) |
|
{ |
|
pariout_t T = *(GP_DATA->fmt); /* copy */ |
|
FILE *o_out; |
|
|
|
if (!prettyp_init()) return 0; |
|
o_out = pari_outfile; /* save state */ |
|
|
|
/* Emit first: there may be lines before the prompt */ |
|
if (n) term_color(c_OUTPUT); |
|
pariflush(); |
|
pari_outfile = GP_DATA->pp->file->file; |
|
T.prettyp = f_TEX; |
|
|
|
/* history number */ |
|
if (n) |
|
{ |
|
char s[128]; |
|
if (*term_get_color(c_HIST) || *term_get_color(c_OUTPUT)) |
|
{ |
|
char col1[80]; |
|
strcpy(col1, term_get_color(c_HIST)); |
|
sprintf(s, "\\LITERALnoLENGTH{%s}\\%%%ld =\\LITERALnoLENGTH{%s} ", |
|
col1, n, term_get_color(c_OUTPUT)); |
|
} |
|
else |
|
sprintf(s, "\\%%%ld = ", n); |
|
pariputs_opt(s); |
|
} |
|
/* output */ |
|
gen_output(z, &T); |
|
|
|
/* flush and restore */ |
|
prettyp_wait(); |
|
pari_outfile = o_out; |
|
if (n) term_color(c_NONE); |
|
return 1; |
|
} |
|
|
|
/* TEXMACS */ |
|
|
|
static void |
|
texmacs_output(GEN z, long n) |
|
{ |
|
pariout_t T = *(GP_DATA->fmt); /* copy */ |
|
char *sz; |
|
|
|
T.prettyp = f_TEX; |
|
T.fieldw = 0; |
|
sz = GENtostr0(z, &T, &gen_output); |
|
printf("%clatex:", DATA_BEGIN); |
|
if (n) |
|
printf("\\magenta\\%%%ld = $\\blue ", n); |
|
else |
|
printf("$\\blue "); |
|
printf("%s$%c", sz,DATA_END); free(sz); |
|
fflush(stdout); |
|
} |
|
|
|
/* REGULAR */ |
|
|
|
static void |
|
normal_output(GEN z, long n) |
|
{ |
|
long l = 0; |
|
/* history number */ |
|
if (n) |
|
{ |
|
char s[64]; |
|
term_color(c_HIST); |
|
sprintf(s, "%%%ld = ", n); |
|
pariputs_opt(s); |
|
l = strlen(s); |
|
} |
|
/* output */ |
|
term_color(c_OUTPUT); |
|
if (GP_DATA->lim_lines) |
|
lim_lines_output(z, GP_DATA->fmt, l, GP_DATA->lim_lines); |
|
else |
|
gen_output(z, GP_DATA->fmt); |
|
term_color(c_NONE); pariputc('\n'); |
|
} |
|
|
|
void |
|
gp_output(GEN z, gp_data *G) |
|
{ |
|
if (G->flags & TEST) { |
|
init80(0); |
|
gen_output(z, G->fmt); pariputc('\n'); |
|
} |
|
else if (G->flags & TEXMACS) |
|
texmacs_output(z, G->hist->total); |
|
else if (G->fmt->prettyp != f_PRETTY || !tex2mail_output(z, G->hist->total)) |
|
normal_output(z, G->hist->total); |
|
pariflush(); |
|
} |
|
|
|
/*******************************************************************/ |
|
/** **/ |
/** USER OUTPUT FUNCTIONS **/ |
/** USER OUTPUT FUNCTIONS **/ |
/** **/ |
/** **/ |
/*******************************************************************/ |
/*******************************************************************/ |
|
|
void |
void |
bruteall(GEN g, char f, long d, long flag) |
gen_output(GEN x, pariout_t *T) |
{ |
{ |
long av = avma; |
gpmem_t av = avma; |
void (*oldsp)() = sp; |
GEN y = changevar(x, polvar); |
|
if (!T) T = &DFLT_OUTPUT; |
|
T->initial = 1; |
|
switch(T->prettyp) |
|
{ |
|
case f_PRETTYMAT: matbruti(y, T); break; |
|
case f_PRETTY: |
|
case f_PRETTYOLD: sori (y, T); break; |
|
case f_RAW : bruti(y, T, 0); break; |
|
case f_TEX : texi (y, T, 0); break; |
|
} |
|
avma = av; |
|
} |
|
|
sp = flag? &wr_space: &no_space; |
static void |
format = f; decimals = d; |
_initout(pariout_t *T, char f, long sigd, long sp, long fieldw, int prettyp) |
bruti(changevar(g,polvar),0); |
{ |
sp = oldsp; avma = av; |
T->format = f; |
|
T->sigd = sigd; |
|
T->sp = sp; |
|
T->fieldw = fieldw; |
|
T->initial = 1; |
|
T->prettyp = prettyp; |
} |
} |
|
|
void |
void |
|
bruteall(GEN g, char f, long d, long sp) |
|
{ |
|
pariout_t T; _initout(&T,f,d,sp,0, f_RAW); |
|
gen_output(g, &T); |
|
} |
|
|
|
void |
matbrute(GEN g, char f, long d) |
matbrute(GEN g, char f, long d) |
{ |
{ |
long av=avma; sp = &wr_space; |
pariout_t T; _initout(&T,f,d,1,0, f_PRETTYMAT); |
format = f; decimals = d; |
gen_output(g, &T); |
matbruti(changevar(g,polvar),0); avma=av; |
|
} |
} |
|
|
void |
void |
sor(GEN g, char f, long d, long c) |
sor(GEN g, char f, long d, long c) |
{ |
{ |
long av=avma; sp = &wr_space; |
pariout_t T; _initout(&T,f,d,1,c, f_PRETTYOLD); |
format = f; decimals = d; chmp = c; initial = 1; |
gen_output(g, &T); |
sori(changevar(g,polvar)); avma = av; |
|
} |
} |
|
|
void |
void |
texe(GEN g, char f, long d) |
texe(GEN g, char f, long d) |
{ |
{ |
long av=avma; sp = &no_space; |
pariout_t T; _initout(&T,f,d,0,0, f_TEX); |
format = f; decimals = d; |
gen_output(g, &T); |
texi(changevar(g,polvar),0); avma=av; |
|
} |
} |
|
|
void |
void |
brute(GEN g, char format, long decimals) { bruteall(g,format,decimals,1); } |
brute(GEN g, char f, long d) { bruteall(g,f,d,1); } |
|
|
void |
void |
outbrute(GEN g) { bruteall(g,'g',-1,1); } |
outbrute(GEN g) { bruteall(g,'g',-1,1); } |
Line 1968 outbeauterr(GEN x) |
|
Line 2179 outbeauterr(GEN x) |
|
} |
} |
|
|
void |
void |
bruterr(GEN x,char format,long decimals) |
bruterr(GEN x,char format,long sigd) |
{ |
{ |
PariOUT *out = pariOut; pariOut = pariErr; |
PariOUT *out = pariOut; pariOut = pariErr; |
bruteall(x,format,decimals,1); pariOut = out; |
bruteall(x,format,sigd,1); pariOut = out; |
} |
} |
|
|
void |
void |
Line 2103 pari_unlink(char *s) |
|
Line 2314 pari_unlink(char *s) |
|
fprintferr("I/O: removed file %s\n", s); |
fprintferr("I/O: removed file %s\n", s); |
} |
} |
|
|
|
void |
|
check_filtre(filtre_t *T) |
|
{ |
|
if (T && T->in_string) |
|
{ |
|
err(warner,"run-away string. Closing it"); |
|
T->in_string = 0; |
|
} |
|
if (T && T->in_comment) |
|
{ |
|
err(warner,"run-away comment. Closing it"); |
|
T->in_comment = 0; |
|
} |
|
} |
|
|
/* Remove one INFILE from the stack. Reset infile (to the most recent infile) |
/* Remove one INFILE from the stack. Reset infile (to the most recent infile) |
* Return -1, if we're trying to pop out stdin itself; 0 otherwise |
* Return -1, if we're trying to pop out stdin itself; 0 otherwise |
* Check for leaked file handlers (temporary files) |
* Check for leaked file handlers (temporary files) |
|
|
popinfile() |
popinfile() |
{ |
{ |
pariFILE *f; |
pariFILE *f; |
|
|
filtre(NULL,NULL, f_ENDFILE); |
|
for (f = last_tmp_file; f; f = f->prev) |
for (f = last_tmp_file; f; f = f->prev) |
{ |
{ |
if (f->type & mf_IN) break; |
if (f->type & mf_IN) break; |
Line 2159 try_pipe(char *cmd, int fl) |
|
Line 2383 try_pipe(char *cmd, int fl) |
|
#else |
#else |
FILE *file; |
FILE *file; |
char *f; |
char *f; |
VOLATILE int flag = fl; |
int flag = fl; |
|
|
# ifdef __EMX__ |
# ifdef __EMX__ |
if (_osmode == DOS_MODE) /* no pipes under DOS */ |
if (_osmode == DOS_MODE) /* no pipes under DOS */ |
Line 2179 try_pipe(char *cmd, int fl) |
|
Line 2403 try_pipe(char *cmd, int fl) |
|
if (flag & mf_OUT) flag |= mf_PERM; |
if (flag & mf_OUT) flag |= mf_PERM; |
if (flag & (mf_TEST | mf_OUT)) |
if (flag & (mf_TEST | mf_OUT)) |
{ |
{ |
jmp_buf env; |
|
void *c; |
|
int i; |
|
if (DEBUGFILES) fprintferr("I/O: checking output pipe...\n"); |
if (DEBUGFILES) fprintferr("I/O: checking output pipe...\n"); |
if (setjmp(env)) return NULL; |
CATCH(-1) { file = NULL; } |
|
TRY { |
c = err_catch(-1, env, NULL); |
int i; |
fprintf(file,"\n\n"); fflush(file); |
fprintf(file,"\n\n"); fflush(file); |
for (i=1; i<1000; i++) fprintf(file," \n"); |
for (i=1; i<1000; i++) fprintf(file," \n"); |
fprintf(file,"\n"); fflush(file); |
fprintf(file,"\n"); fflush(file); |
err_leave(&c); |
} ENDCATCH; |
|
if (!file) return NULL; |
} |
} |
f = cmd; |
f = cmd; |
} |
} |
Line 2225 os_read(long fd, char ch[], long s) |
|
Line 2447 os_read(long fd, char ch[], long s) |
|
DWORD chRead; |
DWORD chRead; |
ReadFile((HANDLE)fd, ch, s, &chRead, NULL); |
ReadFile((HANDLE)fd, ch, s, &chRead, NULL); |
#else |
#else |
read(fd,ch,s); |
(void)read(fd,ch,s); |
#endif |
#endif |
} |
} |
|
|
Line 2262 os_getenv(char *s) |
|
Line 2484 os_getenv(char *s) |
|
/** **/ |
/** **/ |
/*******************************************************************/ |
/*******************************************************************/ |
static char *last_filename = NULL; |
static char *last_filename = NULL; |
static char **dir_list = NULL; |
|
|
|
#ifdef HAS_OPENDIR |
#ifdef HAS_OPENDIR |
# include <dirent.h> |
# include <dirent.h> |
Line 2339 _expand_env(char *str) |
|
Line 2560 _expand_env(char *str) |
|
} |
} |
if (xnum > xlen - 3) /* need room for possibly two more elts */ |
if (xnum > xlen - 3) /* need room for possibly two more elts */ |
{ |
{ |
long xnew = xlen << 1; |
xlen <<= 1; |
x = (char **)gprealloc((void*)x, xlen * sizeof(char*), |
x = (char **)gprealloc((void*)x, xlen * sizeof(char*)); |
xnew * sizeof(char*)); |
|
xlen = xnew; |
|
} |
} |
|
|
s0 = ++s; /* skip $ */ |
s0 = ++s; /* skip $ */ |
Line 2382 expand_tilde(char *s) |
|
Line 2601 expand_tilde(char *s) |
|
return _expand_env(_expand_tilde(s)); |
return _expand_env(_expand_tilde(s)); |
} |
} |
|
|
|
void |
|
delete_dirs(gp_path *p) |
|
{ |
|
char **v = p->dirs, **dirs; |
|
if (v) |
|
{ |
|
p->dirs = NULL; /* in case of error */ |
|
for (dirs = v; *dirs; dirs++) free(*dirs); |
|
free(v); |
|
} |
|
} |
|
|
#if defined __EMX__ || defined _WIN32 |
#if defined __EMX__ || defined _WIN32 |
# define PATH_SEPARATOR ';' |
# define PATH_SEPARATOR ';' |
#else |
#else |
Line 2389 expand_tilde(char *s) |
|
Line 2620 expand_tilde(char *s) |
|
#endif |
#endif |
|
|
void |
void |
gp_expand_path(char *v) |
gp_expand_path(gp_path *p) |
{ |
{ |
char **path, **old, *s; |
char **dirs, *s, *v = p->PATH; |
int i, n = 0; |
int i, n = 0; |
|
|
|
delete_dirs(p); |
v = pari_strdup(v); |
v = pari_strdup(v); |
for (s=v; *s; s++) |
for (s=v; *s; s++) |
if (*s == PATH_SEPARATOR) { *s = 0; n++; } |
if (*s == PATH_SEPARATOR) { *s = 0; n++; } |
path = (char**) gpmalloc((n + 2)*sizeof(char *)); |
dirs = (char**) gpmalloc((n + 2)*sizeof(char *)); |
|
|
for (s=v, i=0; i<=n; i++) |
for (s=v, i=0; i<=n; i++) |
{ |
{ |
char *end = s + strlen(s), *f = end; |
char *end = s + strlen(s), *f = end; |
while (f > s && *--f == '/') *f = 0; |
while (f > s && *--f == '/') *f = 0; |
path[i] = expand_tilde(s); |
dirs[i] = expand_tilde(s); |
s = end + 1; /* next path component */ |
s = end + 1; /* next path component */ |
} |
} |
path[i] = NULL; old = dir_list; dir_list = path; |
free((void*)v); |
if (old) |
dirs[i] = NULL; p->dirs = dirs; |
{ |
|
for (path=old; *path; path++) free(*path); |
|
free(old); |
|
} |
|
} |
} |
|
|
/* name is a malloc'ed (existing) filename. Accept it as new infile |
/* name is a malloc'ed (existing) filename. Accept it as new infile |
Line 2488 switchin(char *name0) |
|
Line 2716 switchin(char *name0) |
|
/* if name contains '/', don't use dir_list */ |
/* if name contains '/', don't use dir_list */ |
s=name; while (*s && *s != '/' && *s != '\\') s++; |
s=name; while (*s && *s != '/' && *s != '\\') s++; |
if (*s) { if (try_name(name)) return; } |
if (*s) { if (try_name(name)) return; } |
else |
else if (GP_DATA) |
{ |
{ |
char **tmp = dir_list; |
char **tmp = GP_DATA->path->dirs; |
for ( ; *tmp; tmp++) |
for ( ; *tmp; tmp++) |
{ /* make room for '/' and '\0', try_name frees it */ |
{ /* make room for '/' and '\0', try_name frees it */ |
s = gpmalloc(2 + strlen(*tmp) + strlen(name)); |
s = gpmalloc(2 + strlen(*tmp) + strlen(name)); |
Line 2501 switchin(char *name0) |
|
Line 2729 switchin(char *name0) |
|
err(openfiler,"input",name0); |
err(openfiler,"input",name0); |
} |
} |
|
|
|
static int is_magic_ok(FILE *f); |
|
|
void |
void |
switchout(char *name) |
switchout(char *name) |
{ |
{ |
if (name) |
if (name) |
{ |
{ |
FILE *f = fopen(name, "a"); |
FILE *f = fopen(name, "r"); |
|
if (f) |
|
{ |
|
if (is_magic_ok(f)) |
|
err(talker,"%s is a GP binary file. Please use writebin", name); |
|
fclose(f); |
|
} |
|
f = fopen(name, "a"); |
if (!f) err(openfiler,"output",name); |
if (!f) err(openfiler,"output",name); |
pari_outfile = f; |
pari_outfile = f; |
} |
} |
Line 2532 switchout(char *name) |
|
Line 2769 switchout(char *name) |
|
#define _cfwrite(a,b,c) _fwrite((a),sizeof(char),(b),(c)) |
#define _cfwrite(a,b,c) _fwrite((a),sizeof(char),(b),(c)) |
|
|
#define BIN_GEN 0 |
#define BIN_GEN 0 |
#define NAM_GEN 1 |
#define NAM_GEN 1 |
|
|
static long |
static long |
rd_long(FILE *f) |
rd_long(FILE *f) |
|
|
} |
} |
|
|
GEN |
GEN |
readobj(FILE *f) |
readobj(FILE *f, int *ptc) |
{ |
{ |
int c = fgetc(f); |
int c = fgetc(f); |
GEN x = NULL; |
GEN x = NULL; |
Line 2633 readobj(FILE *f) |
|
Line 2870 readobj(FILE *f) |
|
case EOF: break; |
case EOF: break; |
default: err(talker,"unknown code in readobj"); |
default: err(talker,"unknown code in readobj"); |
} |
} |
return x; |
*ptc = c; return x; |
} |
} |
|
|
#define MAGIC "\020\001\022\011-\007\020" /* ^P^A^R^I-^G^P */ |
#define MAGIC "\020\001\022\011-\007\020" /* ^P^A^R^I-^G^P */ |
|
|
is_sizeoflong_ok(FILE *f) |
is_sizeoflong_ok(FILE *f) |
{ |
{ |
char c; |
char c; |
return (fread(&c,1,1, f) == 1 && c == sizeof(long)); |
return (fread(&c,1,1, f) == 1 && c == (char)sizeof(long)); |
} |
} |
|
|
static int |
static int |
|
|
write_magic(FILE *f) |
write_magic(FILE *f) |
{ |
{ |
fprintf(f, MAGIC); |
fprintf(f, MAGIC); |
fprintf(f, "%c", sizeof(long)); |
fprintf(f, "%c", (char)sizeof(long)); |
wr_long(ENDIAN_CHECK, f); |
wr_long(ENDIAN_CHECK, f); |
wr_long(BINARY_VERSION, f); |
wr_long(BINARY_VERSION, f); |
} |
} |
Line 2693 write_magic(FILE *f) |
|
Line 2930 write_magic(FILE *f) |
|
int |
int |
file_is_binary(FILE *f) |
file_is_binary(FILE *f) |
{ |
{ |
int c = fgetc(f), r = isprint(c); |
int c = fgetc(f); ungetc(c,f); |
ungetc(c,f); return (r == 0); |
return (isprint(c) == 0 && isspace(c) == 0); |
} |
} |
|
|
void |
void |
Line 2716 writebin(char *name, GEN x) |
|
Line 2953 writebin(char *name, GEN x) |
|
{ |
{ |
entree *ep = varentries[v]; |
entree *ep = varentries[v]; |
if (!ep) continue; |
if (!ep) continue; |
writenamedGEN(ep->value,ep->name,f); |
writenamedGEN((GEN)ep->value,ep->name,f); |
} |
} |
} |
} |
fclose(f); |
fclose(f); |
} |
} |
|
|
/* read all objects in file and return last one */ |
/* read all objects in f. If f contains BIN_GEN that would be silently ignored |
|
* [i.e f contains more than one objet, not all of them 'named GENs'], return |
|
* them all in a vector with clone bit set (special marker). */ |
GEN |
GEN |
readbin(char *name, FILE *f) |
readbin(char *name, FILE *f) |
{ |
{ |
GEN y, x = NULL; |
gpmem_t av = avma; |
check_magic(name,f); |
GEN x,y,z; |
while ((y = readobj(f))) x = y; |
int cx,cy; |
|
check_magic(name,f); x = y = z = NULL; |
|
cx = 0; /* gcc -Wall */ |
|
while ((y = readobj(f, &cy))) |
|
{ |
|
if (x && cx == BIN_GEN) z = z? concatsp(z, _vec(x)): _vec(x); |
|
x = y; cx = cy; |
|
} |
|
if (z) |
|
{ |
|
if (x && cx == BIN_GEN) z = z? concatsp(z, _vec(x)): _vec(x); |
|
if (DEBUGLEVEL) |
|
err(warner,"%ld unnamed objects read. Returning then in a vector", |
|
lg(z)-1); |
|
x = gerepilecopy(av, z); |
|
setisclone(x); /* HACK */ |
|
} |
return x; |
return x; |
} |
} |
|
|
/*******************************************************************/ |
/*******************************************************************/ |
/** **/ |
/** **/ |
|
/** GP I/O **/ |
|
/** **/ |
|
/*******************************************************************/ |
|
/* print a sequence of (NULL terminated) GEN */ |
|
void |
|
print0(GEN *g, long flag) |
|
{ |
|
pariout_t T = GP_DATA? *(GP_DATA->fmt): DFLT_OUTPUT; /* copy */ |
|
T.prettyp = flag; |
|
for( ; *g; g++) |
|
if (typ(*g)==t_STR) |
|
pariputs(GSTR(*g)); /* text surrounded by "" otherwise */ |
|
else |
|
gen_output(*g, &T); |
|
} |
|
|
|
#define PR_NL() {added_newline = 1; pariputc('\n'); pariflush(); } |
|
#define PR_NO() {added_newline = 0; pariflush(); } |
|
void print (GEN *g) { print0(g, f_RAW); PR_NL(); } |
|
void printp (GEN *g) { print0(g, f_PRETTYOLD); PR_NL(); } |
|
void printtex(GEN *g) { print0(g, f_TEX); PR_NL(); } |
|
void print1 (GEN *g) { print0(g, f_RAW); PR_NO(); } |
|
void printp1 (GEN *g) { print0(g, f_PRETTYOLD); PR_NO(); } |
|
|
|
void error0(GEN *g) { err(user, g); } |
|
|
|
static char * |
|
wr_check(char *s) { |
|
char *t = expand_tilde(s); |
|
if (GP_DATA && GP_DATA->flags & SECURE) |
|
{ |
|
fprintferr("[secure mode]: about to write to '%s'. OK ? (^C if not)\n",t); |
|
hit_return(); |
|
} |
|
return t; |
|
} |
|
|
|
static void wr_init(char *s) { char *t=wr_check(s); switchout(t); free(t);} |
|
void gpwritebin(char *s, GEN x) { char *t=wr_check(s); writebin(t, x); free(t);} |
|
|
|
#define WR_NL() {pariputc('\n'); pariflush(); switchout(NULL); } |
|
#define WR_NO() {pariflush(); switchout(NULL); } |
|
void write0 (char *s, GEN *g) { wr_init(s); print0(g, f_RAW); WR_NL(); } |
|
void writetex(char *s, GEN *g) { wr_init(s); print0(g, f_TEX); WR_NL(); } |
|
void write1 (char *s, GEN *g) { wr_init(s); print0(g, f_RAW); WR_NO(); } |
|
|
|
/*******************************************************************/ |
|
/** **/ |
|
/** HISTORY HANDLING **/ |
|
/** **/ |
|
/*******************************************************************/ |
|
/* history management function: |
|
* p > 0, called from %p |
|
* p <= 0, called from %` (p backquotes, possibly 0) */ |
|
GEN |
|
gp_history(gp_hist *H, long p, char *old, char *entry) |
|
{ |
|
GEN z; |
|
|
|
if (p <= 0) p += H->total; /* count |p| entries starting from last */ |
|
if ((ulong)p > H->total) |
|
err(talker2, "I can't see into the future", old, entry); |
|
|
|
z = H->res[ (p-1) % H->size ]; |
|
if (!z || p <= 0 || p <= (long)(H->total - H->size)) |
|
err(talker2, "I can't remember before the big bang", old, entry); |
|
return z; |
|
} |
|
|
|
GEN |
|
set_hist_entry(gp_hist *H, GEN x) |
|
{ |
|
int i = H->total % H->size; |
|
H->total++; |
|
if (H->res[i]) gunclone(H->res[i]); |
|
return H->res[i] = gclone(x); |
|
} |
|
|
|
/*******************************************************************/ |
|
/** **/ |
/** TEMPORARY FILES **/ |
/** TEMPORARY FILES **/ |
/** **/ |
/** **/ |
/*******************************************************************/ |
/*******************************************************************/ |
Line 2804 env_ok(char *s) |
|
Line 3139 env_ok(char *s) |
|
} |
} |
|
|
static char* |
static char* |
pari_tmp_dir() |
pari_tmp_dir(void) |
{ |
{ |
char *s; |
char *s; |
#ifdef WINCE |
#ifdef WINCE |