| version 1.42, 2014/05/13 15:02:28 |
version 1.58, 2018/03/28 09:07:54 |
|
|
| * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, |
* DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, |
| * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. |
* PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. |
| * |
* |
| * $OpenXM: OpenXM_contrib2/asir2000/builtin/ctrl.c,v 1.41 2014/05/12 02:35:35 ohara Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/builtin/ctrl.c,v 1.57 2018/03/28 07:58:17 noro Exp $ |
| */ |
*/ |
| #include "ca.h" |
#include "ca.h" |
| #include "parse.h" |
#include "parse.h" |
| #include <string.h> |
#include <string.h> |
| #if defined(VISUAL) |
#if defined(VISUAL) || defined(__MINGW32__) |
| #include <windows.h> |
#include <windows.h> |
| |
#include <winnls.h> |
| #else |
#else |
| |
#include <locale.h> |
| #include <unistd.h> |
#include <unistd.h> |
| #include <sys/types.h> |
#include <sys/types.h> |
| #include <sys/socket.h> |
#include <sys/socket.h> |
| #include <sys/wait.h> |
#include <sys/wait.h> |
| |
#include <sys/utsname.h> |
| #endif |
#endif |
| |
|
| static struct { |
static struct { |
|
|
| char *arch; |
char *arch; |
| char *release; |
char *release; |
| char *full; |
char *full; |
| |
char *lang; |
| } sysinfo; |
} sysinfo; |
| |
|
| void Pctrl(); |
void Pctrl(); |
| Line 80 struct ftab ctrl_tab[] = { |
|
| Line 84 struct ftab ctrl_tab[] = { |
|
| }; |
}; |
| |
|
| extern int error_in_timer; |
extern int error_in_timer; |
| extern int prtime,nez,echoback,bigfloat; |
extern int prtime,nez,echoback,bigfloat,evalef; |
| extern int debug_up; |
extern int debug_up; |
| extern int GC_max_heap_size,Verbose,hideargs,hex_output,do_server_in_X11; |
extern int GC_max_heap_size,Verbose,hideargs,hex_output,do_server_in_X11; |
| extern int do_message,do_terse; |
extern int do_message,do_terse; |
| Line 108 extern int diag_period; |
|
| Line 112 extern int diag_period; |
|
| extern int weight_check; |
extern int weight_check; |
| extern char **ASIRLOADPATH; |
extern char **ASIRLOADPATH; |
| extern int ASIRLOADPATH_LEN; |
extern int ASIRLOADPATH_LEN; |
| |
extern int No_ox_reset; |
| |
extern int plot_by_bigfloat; |
| |
extern int debug_plot; |
| |
|
| static struct { |
static struct keyval { |
| char *key; |
char *key; |
| int *val; |
int *val; |
| |
char *desc; |
| } ctrls[] = { |
} ctrls[] = { |
| {"error_in_timer",&error_in_timer}, |
{"StrassenSize",&StrassenSize,"Determines the parameter in Strassen-Winograd matrix multiplication algorithm."}, |
| {"cputime",&prtime}, |
{"allow_laurent",&allow_laurent,"If set to 1, negative exponents are allowed in monomials."}, |
| {"nez",&nez}, |
{"asir_setenv",&asir_setenv,"Not used."}, |
| {"echo",&echoback}, |
{"bigfloat",&bigfloat,"If set to 1, MPFR bigfloat functions are used for floating point evaluation." }, |
| #if defined(PARI) |
{"cputime",&prtime,"If set to 1, the CPU time at the toplevel is shown." }, |
| {"bigfloat",&bigfloat}, |
{"debug_up",&debug_up,"If set to 1, some debug messages are printed in special functions for univariate polynomials."}, |
| |
{"debug_window",&do_server_in_X11,"If set to 1, an input window for debugging remote server are shown."}, |
| |
{"diag_period",&diag_period,"Determines the frequency of the intermediate inter-reduction in nd_gr()."}, |
| |
{"double_output",&double_output,"If set to 1, floating point numbers are printed in the style ddd.ddd."}, |
| |
{"echo",&echoback,"If set to 1, characters read by the input function are printed." }, |
| |
{"error_in_timer",&error_in_timer,"If set to 1, the usual error handler is executed when the timer is expired."}, |
| |
{"evalef",&evalef,"If set to 1, elementary functions are evaluated immediately."}, |
| |
{"f4_nocheck",&f4_nocheck,"If set to 1, correctness check of the result of modular computation are omitted in nd_f4()."}, |
| |
{"fake_ox_reset",&No_ox_reset,"Determines the treatment of OX reset request for a server which does not implement the reset protocol."}, |
| |
{"fortran_output",&fortran_output,"If set to 1, ** is used instead of ^ for representing the power."}, |
| |
{"hex",&hex_output,"If set to 1, integers are printed by the hexadecimal notation."}, |
| |
{"hideargs",&hideargs,"If set to 1, the arguments of a function call are not printed."}, |
| |
{"message",&do_message,"If set to 1, an opening message is printed in ox_asir and ox_plot."}, |
| |
{"new_hensel",&use_new_hensel,"If set to 1, a function hensel2() is used in the univariate factorizer over Q."}, |
| |
{"nez",&nez,"If set to 1, a new version of EZGCD implementation is used." }, |
| |
{"no_debug_on_error",&no_debug_on_error,"If set to 1, the debug mode is not used."}, |
| |
{"no_ox_reset",&No_ox_reset,"Determines the treatment of OX reset request for a server which does not implement the reset protocol."}, |
| |
{"no_prompt",&do_quiet,"If set to 1, prompts are not shown."}, |
| |
{"outputstyle",&outputstyle,"If set to 1, structured data such as matrices and vectors are printed in the style mat(...), vect(...)."}, |
| |
{"ox_batch",&ox_batch,"If set to 1, the OX stream are not flushed at each sending of an OX data."}, |
| |
{"ox_check",&ox_check,"If set to 1, mathcap check is done for OpenXM date communication."}, |
| |
{"ox_exchange_mathcap",&ox_exchange_mathcap,"If set to 1, mathcaps are exchanged."}, |
| |
{"print_quote",&print_quote,"Determines the behavior of the printed form of a quote."}, |
| |
{"quiet_mode",&do_quiet,"If set to 1, the copyright notices are not printed at the beginning of the session."}, |
| |
{"real_binary",&real_binary,"If set to 1, a floating point number is printed by the binary notation."}, |
| |
{"real_digit",&real_digit,"Determines the number of digits to appear after the decimal point."}, |
| |
{"show_crossref",&show_crossref,"If set to 1, cross-references are shown when a program file is loaded."}, |
| |
{"show_orderspec",&show_orderspec,"If set to 1, the specification of a composite term order is printed upon its creation."}, |
| |
{"terse",&do_terse,"If set to 1, messages are not printed when user-defined callbacks are executed."}, |
| |
{"verbose",&Verbose,"If set to 1, a warning is printed if a function is redefined."}, |
| |
{"weight_check",&weight_check,"If set to 1, an overflow check for the given weight vector is done before starting the Groebner basis computation."}, |
| |
#if defined(DO_PLOT) |
| |
{"plot_by_bigfloat",&plot_by_bigfloat,"If set to 1, computation is done by using MPFR bigfloat functions in ox_plot."}, |
| |
{"debug_plot",&debug_plot,"If set to 1, ox_plot is executed with the message window."}, |
| #endif |
#endif |
| {"verbose",&Verbose}, |
|
| {"quiet_mode",&do_quiet}, |
|
| {"hideargs",&hideargs}, |
|
| {"hex",&hex_output}, |
|
| {"debug_window",&do_server_in_X11}, |
|
| {"message",&do_message}, |
|
| {"terse",&do_terse}, |
|
| {"debug_up",&debug_up}, |
|
| {"no_prompt",&do_quiet}, |
|
| {"asir_setenv",&asir_setenv}, |
|
| {"ox_batch",&ox_batch}, |
|
| {"ox_check",&ox_check}, |
|
| {"ox_exchange_mathcap",&ox_exchange_mathcap}, |
|
| {"f4_nocheck",&f4_nocheck}, |
|
| {"StrassenSize",&StrassenSize}, |
|
| {"outputstyle",&outputstyle}, |
|
| {"double_output",&double_output}, |
|
| {"real_digit",&real_digit}, |
|
| {"real_binary",&real_binary}, |
|
| {"fortran_output",&fortran_output}, |
|
| {"new_hensel",&use_new_hensel}, |
|
| {"print_quote",&print_quote}, |
|
| {"show_crossref",&show_crossref}, |
|
| {"allow_laurent",&allow_laurent}, |
|
| {"show_orderspec",&show_orderspec}, |
|
| {"no_debug_on_error",&no_debug_on_error}, |
|
| {"diag_period",&diag_period}, |
|
| {"weight_check",&weight_check}, |
|
| #if defined(INTERVAL) |
#if defined(INTERVAL) |
| {"zerorewrite",&zerorewrite}, |
{"zerorewrite",&zerorewrite,""}, |
| {"itvplotsize",&Itvplot}, |
{"itvplotsize",&Itvplot,""}, |
| #endif |
#endif |
| {0,0}, |
{0,0}, |
| }; |
}; |
| |
|
| void Pctrl(arg,rp) |
LIST create_control_value(char *keystr,Obj value,char *descstr,int withdesc) |
| NODE arg; |
|
| Q *rp; |
|
| { |
{ |
| int t,i,n; |
STRING key,desc; |
| |
NODE nd; |
| |
LIST list; |
| |
|
| |
MKSTR(key,keystr); |
| |
if ( withdesc ) { |
| |
MKSTR(desc,descstr); |
| |
nd = mknode(3,key,value,desc); |
| |
} else nd = mknode(2,key,value); |
| |
MKLIST(list,nd); |
| |
return list; |
| |
} |
| |
|
| |
extern Q ox_pari_stream; |
| |
extern int ox_pari_stream_initialized; |
| |
extern P ox_pari_starting_function; |
| |
|
| |
LIST create_control_values(int withdesc) |
| |
{ |
| |
int n,i; |
| |
NODE top,top1,nd,node,p; |
| |
LIST list,l; |
| |
STRING s; |
| |
char *descstr; |
| |
Q val,adj; |
| |
int nm,dv; |
| |
N num,den; |
| |
|
| |
n = sizeof(ctrls)/sizeof(struct keyval)-1; |
| |
top = 0; |
| |
for ( i = n-1; i >= 0; i-- ) { |
| |
STOQ(*(ctrls[i].val),val); |
| |
list = create_control_value(ctrls[i].key,val,ctrls[i].desc,withdesc); |
| |
MKNODE(top1,list,top); top = top1; |
| |
} |
| |
/* adj */ |
| |
Risa_GC_get_adj(&nm,&dv); UTON(nm,num); UTON(dv,den); NDTOQ(num,den,1,adj); |
| |
descstr = "Determines the parameter for Boehm's GC."; |
| |
list = create_control_value("adj",adj,descstr,withdesc); |
| |
MKNODE(top1,list,top); top = top1; |
| |
|
| |
/* prompt */ |
| |
descstr = "Determines the user-defined prompt."; |
| |
list = create_control_value("prompt",user_defined_prompt,descstr,withdesc); |
| |
MKNODE(top1,list,top); top = top1; |
| |
|
| |
/* loadpath */ |
| |
node = 0; |
| |
if( ASIRLOADPATH[0] ) { |
| |
for(i=0; ASIRLOADPATH[i]; i++); |
| |
for(i--,p=NULL; i>=0; i--,p=node) { |
| |
MKSTR(s,ASIRLOADPATH[i]); |
| |
MKNODE(node,s,p); |
| |
} |
| |
} |
| |
MKLIST(l,node); |
| |
descstr = "List of paths in ASIRLOADPATHt."; |
| |
list = create_control_value("loadpath",l,descstr,withdesc); |
| |
MKNODE(top1,list,top); top = top1; |
| |
|
| |
/* oxpari_id */ |
| |
if(!ox_pari_stream_initialized) { |
| |
STOQ(-1,val); |
| |
} else val = ox_pari_stream; |
| |
descstr = "Id of ox_pari."; |
| |
list = create_control_value("oxpari_id",val,descstr,withdesc); |
| |
MKNODE(top1,list,top); top = top1; |
| |
|
| |
/* oxpari_start */ |
| |
val = (Q)ox_pari_starting_function; |
| |
descstr = "oxpari starting function."; |
| |
list = create_control_value("oxpari_start",val,descstr,withdesc); |
| |
MKNODE(top1,list,top); top = top1; |
| |
|
| |
MKLIST(list,top); |
| |
return list; |
| |
} |
| |
|
| |
void Pctrl(NODE arg,Q *rp) |
| |
{ |
| |
int t,i,n,desc=0; |
| int nm,dv; |
int nm,dv; |
| N num,den; |
N num,den; |
| Q c; |
Q c; |
|
|
| char buf[BUFSIZ]; |
char buf[BUFSIZ]; |
| char *str; |
char *str; |
| STRING s; |
STRING s; |
| NODE node,p; |
NODE node,p,opt; |
| LIST list; |
LIST list; |
| |
P f; |
| |
Obj value; |
| |
|
| if ( !arg ) { |
if ( !arg ) { |
| *rp = 0; |
if ( current_option ) { |
| |
for ( opt = current_option; opt; opt = NEXT(opt) ) { |
| |
p = BDY((LIST)BDY(opt)); |
| |
key = BDY((STRING)BDY(p)); |
| |
value = (Obj)BDY(NEXT(p)); |
| |
if ( !strcmp(key,"desc") && value ) { |
| |
desc = value ? 1 : 0; |
| |
break; |
| |
} |
| |
} |
| |
} |
| |
*rp = create_control_values(desc); |
| return; |
return; |
| } |
} |
| key = BDY((STRING)ARG0(arg)); |
key = BDY((STRING)ARG0(arg)); |
|
|
| MKNODE(node,s,p); |
MKNODE(node,s,p); |
| } |
} |
| MKLIST(list,node); |
MKLIST(list,node); |
| *rp = list; |
*rp = (Q)list; |
| } |
} |
| } else { |
} else { |
| list = (LIST)ARG1(arg); |
list = (LIST)ARG1(arg); |
|
|
| } |
} |
| } |
} |
| return; |
return; |
| |
} else if ( !strcmp(key,"oxpari_id") ) { |
| |
if ( argc(arg) == 1 ) { |
| |
if(!ox_pari_stream_initialized) { |
| |
t=-1; |
| |
STOQ(t,*rp); |
| |
}else { |
| |
*rp = ox_pari_stream; |
| |
} |
| |
}else { |
| |
c = (Q)ARG1(arg); |
| |
if ( !c || ( NUM(c) && INT(c) && SGN(c)>0 ) ) { |
| |
ox_pari_stream_initialized = 1; |
| |
ox_pari_stream = c; |
| |
*rp = c; |
| |
}else { |
| |
t=-1; |
| |
STOQ(t,*rp); |
| |
} |
| |
} |
| |
return; |
| |
} else if ( !strcmp(key,"oxpari_start") ) { |
| |
if ( argc(arg) == 1 ) { |
| |
*rp = (Q)ox_pari_starting_function; |
| |
} else { |
| |
f = (P)ARG1(arg); |
| |
if ( !f || OID(f) == O_P) { |
| |
ox_pari_starting_function = f; |
| |
*rp = (Q)f; |
| |
}else { |
| |
*rp = 0; |
| |
} |
| |
} |
| |
return; |
| } |
} |
| for ( i = 0; ctrls[i].key; i++ ) |
for ( i = 0; ctrls[i].key; i++ ) |
| if ( !strcmp(key,ctrls[i].key) ) |
if ( !strcmp(key,ctrls[i].key) ) |
| Line 277 void Psysinfo(LIST *rp) |
|
| Line 414 void Psysinfo(LIST *rp) |
|
| { |
{ |
| int i; |
int i; |
| NODE n,p; |
NODE n,p; |
| STRING s[6]; |
STRING s[7]; |
| |
|
| get_sysinfo(); |
get_sysinfo(); |
| MKSTR(s[0],sysinfo.type); MKSTR(s[1],sysinfo.kernel); MKSTR(s[2],sysinfo.name); |
MKSTR(s[0],sysinfo.type); MKSTR(s[1],sysinfo.kernel); MKSTR(s[2],sysinfo.name); |
| MKSTR(s[3],sysinfo.arch); MKSTR(s[4],sysinfo.release); MKSTR(s[5],sysinfo.full); |
MKSTR(s[3],sysinfo.arch); MKSTR(s[4],sysinfo.release); MKSTR(s[5],sysinfo.full); |
| for(i=5,p=NULL; i>=0; i--,p=n) { |
MKSTR(s[6],sysinfo.lang); |
| |
for(i=6,p=NULL; i>=0; i--,p=n) { |
| MKNODE(n,s[i],p); |
MKNODE(n,s[i],p); |
| } |
} |
| MKLIST(*rp,n); |
MKLIST(*rp,n); |
| } |
} |
| |
|
| #if !defined(VISUAL) |
#if !defined(VISUAL) && !defined(__MINGW32__) |
| static char *uname(char *option) |
|
| |
static char *get_lang() |
| { |
{ |
| |
char *c, *p, *q; |
| |
c = setlocale(LC_ALL, NULL); /* saving current locale */ |
| |
p = setlocale(LC_ALL, ""); |
| |
q = (char *)MALLOC(strlen(p)+1); |
| |
strcpy(q,p); |
| |
setlocale(LC_ALL, c); /* restoring current locale */ |
| |
return q; |
| |
} |
| |
|
| |
static char *myuname(char *option) |
| |
{ |
| char buf[BUFSIZ]; |
char buf[BUFSIZ]; |
| char *s; |
char *s; |
| int fd[2], status; |
int fd[2], status, pid; |
| *buf = 0; |
*buf = 0; |
| if (socketpair(AF_UNIX, SOCK_STREAM, 0, fd) < 0) { |
if (socketpair(AF_UNIX, SOCK_STREAM, 0, fd) < 0) { |
| *buf = 0; return ""; |
*buf = 0; return NULL; |
| } |
} |
| if (fork() == 0) { |
pid = fork(); |
| |
if (pid < 0) { |
| |
return NULL; |
| |
}else if (pid == 0) { |
| dup2(fd[1], 1); |
dup2(fd[1], 1); |
| |
close(2); |
| execlp("uname", "uname", option, NULL); |
execlp("uname", "uname", option, NULL); |
| } |
} |
| |
waitpid(pid, &status, 0); |
| |
if (status) { /* error */ |
| |
return NULL; |
| |
} |
| s = buf; |
s = buf; |
| if( !read(fd[0], s, BUFSIZ-1) || (s = strchr(s, '\n')) ) { |
if( !read(fd[0], s, BUFSIZ-1) || (s = strchr(s, '\n')) ) { |
| *s = 0; |
*s = 0; |
| } |
} |
| wait(&status); |
|
| close(fd[0]); |
close(fd[0]); |
| close(fd[1]); |
close(fd[1]); |
| s = (char *)MALLOC(strlen(buf)+1); |
s = (char *)MALLOC(strlen(buf)+1); |
| Line 316 static char *uname(char *option) |
|
| Line 473 static char *uname(char *option) |
|
| |
|
| static void get_sysinfo() |
static void get_sysinfo() |
| { |
{ |
| |
static struct utsname u; |
| static int initialized = 0; |
static int initialized = 0; |
| if (initialized) { |
if (initialized) { |
| return; |
return; |
| } |
} |
| initialized = 1; |
initialized = 1; |
| sysinfo.kernel = uname(NULL); |
uname(&u); |
| |
sysinfo.kernel = u.sysname; |
| #if defined(__DARWIN__) |
#if defined(__DARWIN__) |
| sysinfo.type = "macosx"; |
sysinfo.type = "macosx"; |
| sysinfo.name = sysinfo.kernel; |
sysinfo.name = sysinfo.kernel; |
| #else |
#else |
| sysinfo.type = "unix"; |
sysinfo.type = "unix"; |
| sysinfo.name = uname("-o"); // not work on Darwin |
sysinfo.name = myuname("-o"); // not work on Darwin |
| |
if (!sysinfo.name) { |
| |
sysinfo.name = sysinfo.kernel; |
| |
} |
| #endif |
#endif |
| sysinfo.arch = uname("-m"); |
sysinfo.arch = u.machine; |
| sysinfo.release= uname("-r"); |
sysinfo.release= u.release; |
| sysinfo.full = uname("-a"); |
sysinfo.full = myuname("-a"); |
| |
sysinfo.lang = get_lang(); |
| } |
} |
| |
|
| #else |
#else |
| Line 371 static char *osname95(int major, int minor) |
|
| Line 534 static char *osname95(int major, int minor) |
|
| return "unknown"; |
return "unknown"; |
| } |
} |
| |
|
| |
static char *get_lang() |
| |
{ |
| |
char lang[BUFSIZ]; |
| |
char *s; |
| |
if(GetLocaleInfo(GetUserDefaultLCID(), LOCALE_SISO639LANGNAME, lang, BUFSIZ)) { |
| |
s = (char *)MALLOC(strlen(lang)+1); |
| |
strcpy(s,lang); |
| |
return s; |
| |
} |
| |
return "en"; // English |
| |
} |
| |
|
| static void get_sysinfo() |
static void get_sysinfo() |
| { |
{ |
| int arch64 = 0; |
int arch64 = 0; |
| Line 417 static void get_sysinfo() |
|
| Line 592 static void get_sysinfo() |
|
| s = (char *)MALLOC(strlen(buf)+1); |
s = (char *)MALLOC(strlen(buf)+1); |
| strcpy(s, buf); |
strcpy(s, buf); |
| sysinfo.full = s; |
sysinfo.full = s; |
| |
sysinfo.lang = get_lang(); |
| } |
} |
| |
|
| #endif |
#endif |