[BACK]Return to ctrl.c CVS log [TXT][DIR] Up to [local] / OpenXM_contrib2 / asir2000 / builtin

Annotation of OpenXM_contrib2/asir2000/builtin/ctrl.c, Revision 1.45

1.8       noro        1: /*
                      2:  * Copyright (c) 1994-2000 FUJITSU LABORATORIES LIMITED
                      3:  * All rights reserved.
                      4:  *
                      5:  * FUJITSU LABORATORIES LIMITED ("FLL") hereby grants you a limited,
                      6:  * non-exclusive and royalty-free license to use, copy, modify and
                      7:  * redistribute, solely for non-commercial and non-profit purposes, the
                      8:  * computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and
                      9:  * conditions of this Agreement. For the avoidance of doubt, you acquire
                     10:  * only a limited right to use the SOFTWARE hereunder, and FLL or any
                     11:  * third party developer retains all rights, including but not limited to
                     12:  * copyrights, in and to the SOFTWARE.
                     13:  *
                     14:  * (1) FLL does not grant you a license in any way for commercial
                     15:  * purposes. You may use the SOFTWARE only for non-commercial and
                     16:  * non-profit purposes only, such as academic, research and internal
                     17:  * business use.
                     18:  * (2) The SOFTWARE is protected by the Copyright Law of Japan and
                     19:  * international copyright treaties. If you make copies of the SOFTWARE,
                     20:  * with or without modification, as permitted hereunder, you shall affix
                     21:  * to all such copies of the SOFTWARE the above copyright notice.
                     22:  * (3) An explicit reference to this SOFTWARE and its copyright owner
                     23:  * shall be made on your publication or presentation in any form of the
                     24:  * results obtained by use of the SOFTWARE.
                     25:  * (4) In the event that you modify the SOFTWARE, you shall notify FLL by
1.9       noro       26:  * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
1.8       noro       27:  * for such modification or the source code of the modified part of the
                     28:  * SOFTWARE.
                     29:  *
                     30:  * THE SOFTWARE IS PROVIDED AS IS WITHOUT ANY WARRANTY OF ANY KIND. FLL
                     31:  * MAKES ABSOLUTELY NO WARRANTIES, EXPRESSED, IMPLIED OR STATUTORY, AND
                     32:  * EXPRESSLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS
                     33:  * FOR A PARTICULAR PURPOSE OR NONINFRINGEMENT OF THIRD PARTIES'
                     34:  * RIGHTS. NO FLL DEALER, AGENT, EMPLOYEES IS AUTHORIZED TO MAKE ANY
                     35:  * MODIFICATIONS, EXTENSIONS, OR ADDITIONS TO THIS WARRANTY.
                     36:  * UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, TORT, CONTRACT,
                     37:  * OR OTHERWISE, SHALL FLL BE LIABLE TO YOU OR ANY OTHER PERSON FOR ANY
                     38:  * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, PUNITIVE OR CONSEQUENTIAL
                     39:  * DAMAGES OF ANY CHARACTER, INCLUDING, WITHOUT LIMITATION, DAMAGES
                     40:  * ARISING OUT OF OR RELATING TO THE SOFTWARE OR THIS AGREEMENT, DAMAGES
                     41:  * FOR LOSS OF GOODWILL, WORK STOPPAGE, OR LOSS OF DATA, OR FOR ANY
                     42:  * DAMAGES, EVEN IF FLL SHALL HAVE BEEN INFORMED OF THE POSSIBILITY OF
                     43:  * SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. EVEN IF A PART
                     44:  * OF THE SOFTWARE HAS BEEN DEVELOPED BY A THIRD PARTY, THE THIRD PARTY
                     45:  * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
                     46:  * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
                     47:  *
1.45    ! noro       48:  * $OpenXM: OpenXM_contrib2/asir2000/builtin/ctrl.c,v 1.44 2014/05/27 09:53:46 ohara Exp $
1.8       noro       49: */
1.1       noro       50: #include "ca.h"
                     51: #include "parse.h"
1.42      ohara      52: #include <string.h>
                     53: #if defined(VISUAL)
                     54: #include <windows.h>
1.44      ohara      55: #include <winnls.h>
1.42      ohara      56: #else
1.44      ohara      57: #include <locale.h>
1.42      ohara      58: #include <unistd.h>
                     59: #include <sys/types.h>
                     60: #include <sys/socket.h>
                     61: #include <sys/wait.h>
1.43      ohara      62: #include <sys/utsname.h>
1.42      ohara      63: #endif
                     64:
                     65: static struct {
                     66:        char *type;
                     67:        char *kernel;
                     68:        char *name;
                     69:        char *arch;
                     70:        char *release;
                     71:        char *full;
1.44      ohara      72:        char *lang;
1.42      ohara      73: } sysinfo;
1.1       noro       74:
                     75: void Pctrl();
1.42      ohara      76: void Psysinfo(LIST *rp);
                     77: static void get_sysinfo();
1.1       noro       78:
                     79: struct ftab ctrl_tab[] = {
                     80:        {"ctrl",Pctrl,-2},
1.30      noro       81:        {"asir_env",Pctrl,-2},
1.42      ohara      82:        {"sysinfo", Psysinfo, 0},
1.1       noro       83:        {0,0,0},
                     84: };
                     85:
1.33      noro       86: extern int error_in_timer;
1.45    ! noro       87: extern int prtime,nez,echoback,bigfloat,evalef;
1.39      ohara      88: extern int debug_up;
1.1       noro       89: extern int GC_max_heap_size,Verbose,hideargs,hex_output,do_server_in_X11;
1.36      noro       90: extern int do_message,do_terse;
1.4       noro       91: extern int ox_batch,ox_check,ox_exchange_mathcap;
1.1       noro       92: extern int f4_nocheck;
1.16      saito      93: extern int StrassenSize;
1.22      saito      94: extern int outputstyle;
1.3       noro       95: extern int fortran_output;
1.13      noro       96: extern int real_digit;
1.27      noro       97: extern int real_binary;
1.31      noro       98: extern int allow_laurent;
1.12      saito      99: #if defined(INTERVAL)
                    100: extern int zerorewrite;
1.38      saito     101: extern int Itvplot;
1.12      saito     102: #endif
1.11      noro      103: extern int double_output;
1.14      noro      104: extern int use_new_hensel;
1.15      noro      105: extern int print_quote;
1.20      noro      106: extern int show_crossref;
1.24      noro      107: extern Obj user_defined_prompt;
1.28      ohara     108: extern int asir_setenv;
1.32      noro      109: extern int show_orderspec;
1.34      noro      110: extern int no_debug_on_error;
1.37      noro      111: extern int diag_period;
1.40      noro      112: extern int weight_check;
1.41      ohara     113: extern char **ASIRLOADPATH;
                    114: extern int ASIRLOADPATH_LEN;
1.1       noro      115:
                    116: static struct {
                    117:        char *key;
                    118:        int *val;
                    119: } ctrls[] = {
1.33      noro      120:        {"error_in_timer",&error_in_timer},
1.1       noro      121:        {"cputime",&prtime},
                    122:        {"nez",&nez},
                    123:        {"echo",&echoback},
1.35      noro      124: #if defined(PARI)
1.1       noro      125:        {"bigfloat",&bigfloat},
1.6       noro      126: #endif
1.45    ! noro      127:        {"evalef",&evalef},
1.1       noro      128:        {"verbose",&Verbose},
1.23      ohara     129:        {"quiet_mode",&do_quiet},
1.1       noro      130:        {"hideargs",&hideargs},
                    131:        {"hex",&hex_output},
                    132:        {"debug_window",&do_server_in_X11},
                    133:        {"message",&do_message},
1.36      noro      134:        {"terse",&do_terse},
1.1       noro      135:        {"debug_up",&debug_up},
1.24      noro      136:        {"no_prompt",&do_quiet},
1.28      ohara     137:        {"asir_setenv",&asir_setenv},
1.1       noro      138:        {"ox_batch",&ox_batch},
                    139:        {"ox_check",&ox_check},
1.5       noro      140:        {"ox_exchange_mathcap",&ox_exchange_mathcap},
1.1       noro      141:        {"f4_nocheck",&f4_nocheck},
1.16      saito     142:        {"StrassenSize",&StrassenSize},
1.22      saito     143:        {"outputstyle",&outputstyle},
1.11      noro      144:        {"double_output",&double_output},
1.13      noro      145:        {"real_digit",&real_digit},
1.27      noro      146:        {"real_binary",&real_binary},
1.3       noro      147:        {"fortran_output",&fortran_output},
1.14      noro      148:        {"new_hensel",&use_new_hensel},
1.15      noro      149:        {"print_quote",&print_quote},
1.20      noro      150:        {"show_crossref",&show_crossref},
1.31      noro      151:        {"allow_laurent",&allow_laurent},
1.32      noro      152:        {"show_orderspec",&show_orderspec},
1.34      noro      153:        {"no_debug_on_error",&no_debug_on_error},
1.37      noro      154:        {"diag_period",&diag_period},
1.40      noro      155:        {"weight_check",&weight_check},
1.12      saito     156: #if defined(INTERVAL)
                    157:        {"zerorewrite",&zerorewrite},
1.38      saito     158:        {"itvplotsize",&Itvplot},
1.12      saito     159: #endif
1.1       noro      160:        {0,0},
                    161: };
                    162:
                    163: void Pctrl(arg,rp)
                    164: NODE arg;
                    165: Q *rp;
                    166: {
1.24      noro      167:        int t,i,n;
1.39      ohara     168:        int nm,dv;
1.1       noro      169:        N num,den;
                    170:        Q c;
                    171:        char *key;
                    172:        char buf[BUFSIZ];
1.24      noro      173:        char *str;
1.41      ohara     174:        STRING s;
                    175:        NODE node,p;
                    176:        LIST list;
1.1       noro      177:
                    178:        if ( !arg ) {
                    179:                *rp = 0;
                    180:                return;
                    181:        }
                    182:        key = BDY((STRING)ARG0(arg));
                    183:        if ( !strcmp(key,"adj") ) {
                    184:                /* special treatment is necessary for "adj" */
                    185:                if ( argc(arg) == 1 ) {
1.39      ohara     186:                        Risa_GC_get_adj(&nm,&dv);
                    187:                        UTON(dv,num);
                    188:                        UTON(nm,den);
1.1       noro      189:                } else {
                    190:                        c = (Q)ARG1(arg);
                    191:                        if ( !c )
                    192:                                error("ctrl : adj : invalid argument");
                    193:                        num = NM(c);
                    194:                        den = !DN(c)?ONEN:DN(c);
1.39      ohara     195:                        dv = BD(num)[0];
                    196:                        nm = BD(den)[0];
                    197:                        Risa_GC_set_adj(nm,dv);
1.1       noro      198:                }
                    199:                NDTOQ(num,den,1,*rp);
1.24      noro      200:                return;
                    201:        } else if ( !strcmp(key,"prompt") ) {
                    202:                /* special treatment is necessary for "prompt" */
                    203:                if ( argc(arg) == 1 ) {
1.26      takayama  204:                  if ((!do_quiet) && (user_defined_prompt == (Obj)0)) *rp=ONE;
                    205:           else *rp = (Q)user_defined_prompt;
1.24      noro      206:                } else {
                    207:                        c = (Q)ARG1(arg);
1.25      noro      208:                        if ( !c ) {
                    209:                                do_quiet = 1;
                    210:                                user_defined_prompt = 0;
                    211:                                *rp = 0;
                    212:                        } else if ( OID(c) == O_STR ) {
                    213:                                str = BDY((STRING)c);
                    214:                                for ( i = 0, n = 0; str[i]; i++ )
                    215:                                        if ( str[i] == '%' )
                    216:                                                n++;
                    217:                                if ( n >= 2 )
                    218:                                        error("ctrl : prompt : invalid prompt specification");
1.24      noro      219:                                do_quiet = 1;
                    220:                                user_defined_prompt = (Obj)c;
                    221:                                *rp = c;
                    222:                        } else if ( NUM(c) && RATN(c) && UNIQ(c) ) {
                    223:                                user_defined_prompt = 0;
                    224:                                do_quiet = 0;
                    225:                        } else {
                    226:                                error("ctrl : prompt : invalid argument");
                    227:                        }
                    228:                }
1.1       noro      229:                return;
1.41      ohara     230:        } else if ( !strcmp(key,"loadpath") ) {
                    231:                *rp = 0;
                    232:                if ( argc(arg) == 1 ) {
                    233:                        if( ASIRLOADPATH[0] ) {
                    234:                                for(i=0; ASIRLOADPATH[i]; i++) {
                    235:                                }
                    236:                                for(i--,p=NULL; i>=0; i--,p=node) {
                    237:                                        MKSTR(s,ASIRLOADPATH[i]);
                    238:                                        MKNODE(node,s,p);
                    239:                                }
                    240:                                MKLIST(list,node);
                    241:                                *rp = list;
                    242:                        }
                    243:                } else {
                    244:                        list = (LIST)ARG1(arg);
                    245:                        if ( OID(list) == O_LIST ) {
                    246:                                for(i=0,p=BDY(list); p; i++,p=NEXT(p)) {
                    247:                                        s=(STRING)BDY(p);
                    248:                                        if(!s || OID(s)!=O_STR) {
                    249:                                                error("ctrl : loadpath : invalid argument");
                    250:                                        }
                    251:                                }
                    252:                                if(i >= ASIRLOADPATH_LEN) {
                    253:                                        ASIRLOADPATH_LEN = i+1;
                    254:                                        ASIRLOADPATH = (char **)MALLOC(sizeof(char *)*ASIRLOADPATH_LEN);
                    255:                                }
                    256:                                for(i=0,p=BDY(list); p; i++,p=NEXT(p)) {
                    257:                                        ASIRLOADPATH[i] = (char *)BDY((STRING)BDY(p));
                    258:                                }
                    259:                                ASIRLOADPATH[i] = NULL;
                    260:                        }else {
                    261:                                error("ctrl : loadpath : invalid argument");
                    262:                        }
                    263:                }
                    264:                return;
1.1       noro      265:        }
                    266:        for ( i = 0; ctrls[i].key; i++ )
                    267:                if ( !strcmp(key,ctrls[i].key) )
                    268:                        break;
                    269:        if ( ctrls[i].key ) {
                    270:                if ( argc(arg) == 1 )
                    271:                        t = *ctrls[i].val;
                    272:                else
                    273:                        *ctrls[i].val = t = QTOS((Q)ARG1(arg));
                    274:                STOQ(t,*rp);
                    275:        } else {
                    276:                sprintf(buf,"ctrl : %s : no such key",key);
                    277:                error(buf);
                    278:        }
                    279: }
1.42      ohara     280:
                    281: void Psysinfo(LIST *rp)
                    282: {
                    283:     int i;
                    284:     NODE n,p;
1.44      ohara     285:     STRING s[7];
1.42      ohara     286:
                    287:     get_sysinfo();
                    288:     MKSTR(s[0],sysinfo.type);  MKSTR(s[1],sysinfo.kernel);   MKSTR(s[2],sysinfo.name);
                    289:     MKSTR(s[3],sysinfo.arch);  MKSTR(s[4],sysinfo.release);  MKSTR(s[5],sysinfo.full);
1.44      ohara     290:     MKSTR(s[6],sysinfo.lang);
                    291:     for(i=6,p=NULL; i>=0; i--,p=n) {
1.42      ohara     292:         MKNODE(n,s[i],p);
                    293:     }
                    294:     MKLIST(*rp,n);
                    295: }
                    296:
                    297: #if !defined(VISUAL)
1.44      ohara     298:
                    299: static char *get_lang()
                    300: {
                    301:     char *c, *p, *q;
                    302:     c = setlocale(LC_ALL, NULL); /* saving current locale */
                    303:     p = setlocale(LC_ALL, "");
                    304:     q = (char *)MALLOC(strlen(p)+1);
                    305:     strcpy(q,p);
                    306:     setlocale(LC_ALL, c);        /* restoring current locale */
                    307:     return q;
                    308: }
                    309:
1.43      ohara     310: static char *myuname(char *option)
1.42      ohara     311: {
                    312:     char buf[BUFSIZ];
                    313:     char *s;
1.43      ohara     314:     int fd[2], status, pid;
1.42      ohara     315:     *buf = 0;
                    316:     if (socketpair(AF_UNIX, SOCK_STREAM, 0, fd) < 0) {
1.43      ohara     317:         *buf = 0; return NULL;
1.42      ohara     318:     }
1.43      ohara     319:     pid = fork();
                    320:     if (pid < 0) {
                    321:         return NULL;
                    322:     }else if (pid == 0) {
1.42      ohara     323:         dup2(fd[1], 1);
1.43      ohara     324:         close(2);
1.42      ohara     325:         execlp("uname", "uname", option, NULL);
                    326:     }
1.43      ohara     327:     waitpid(pid, &status, 0);
                    328:     if (status) { /* error */
                    329:         return NULL;
                    330:     }
1.42      ohara     331:     s = buf;
                    332:     if( !read(fd[0], s, BUFSIZ-1) || (s = strchr(s, '\n')) ) {
                    333:         *s = 0;
                    334:     }
                    335:     close(fd[0]);
                    336:     close(fd[1]);
                    337:     s = (char *)MALLOC(strlen(buf)+1);
                    338:     strcpy(s, buf);
                    339:     return s;
                    340: }
                    341:
                    342: static void get_sysinfo()
                    343: {
1.43      ohara     344:     static struct utsname u;
1.42      ohara     345:     static int initialized = 0;
                    346:     if (initialized) {
                    347:         return;
                    348:     }
                    349:     initialized = 1;
1.43      ohara     350:     uname(&u);
                    351:     sysinfo.kernel = u.sysname;
1.42      ohara     352: #if defined(__DARWIN__)
                    353:     sysinfo.type   = "macosx";
                    354:     sysinfo.name   = sysinfo.kernel;
                    355: #else
                    356:     sysinfo.type   = "unix";
1.43      ohara     357:     sysinfo.name   = myuname("-o"); // not work on Darwin
                    358:     if (!sysinfo.name) {
                    359:         sysinfo.name = sysinfo.kernel;
                    360:     }
1.42      ohara     361: #endif
1.43      ohara     362:     sysinfo.arch   = u.machine;
                    363:     sysinfo.release= u.release;
                    364:     sysinfo.full   = myuname("-a");
1.44      ohara     365:     sysinfo.lang   = get_lang();
1.42      ohara     366: }
                    367:
                    368: #else
                    369:
                    370: /* http://msdn.microsoft.com/ja-jp/library/windows/desktop/ms724834%28v=vs.85%29.aspx */
                    371: static char *osnameNT(int major, int minor)
                    372: {
                    373:     if ((major == 3 && minor == 51) || (major == 4 && minor == 0)) {
                    374:         return "WindowsNT";
                    375:     }else if (major == 5 && minor == 0) {
                    376:         return "Windows2000";
                    377:     }else if (major == 5 && minor == 1) {
                    378:         return "WindowsXP";
                    379:     }else if (major == 5 && minor == 2) {
                    380:         return "Windows2003 Server";
                    381:     }else if (major == 6 && minor == 0) {
                    382:         return "WindowsVista";
                    383:     }else if (major == 6 && minor == 1) {
                    384:         return "Windows7";
                    385:     }else if (major == 6 && minor == 2) {
                    386:         return "Windows8";
                    387:     }else if (major == 6 && minor == 3) {
                    388:         return "Windows8.1";
                    389:     }
                    390:     return "unknown";
                    391: }
                    392:
                    393: static char *osname95(int major, int minor)
                    394: {
                    395:     if (major == 4 && minor == 0) {
                    396:         return "Windows95";
                    397:     }else if (major == 4 && minor == 10) {
                    398:         return "Windows98";
                    399:     }else if (major == 4 && minor == 90) {
                    400:         return "WindowsMe";
                    401:     }
                    402:     return "unknown";
                    403: }
                    404:
1.44      ohara     405: static char *get_lang()
                    406: {
                    407:     char lang[BUFSIZ];
                    408:     char *s;
                    409:     if(GetLocaleInfo(GetUserDefaultLCID(), LOCALE_SISO639LANGNAME, lang, BUFSIZ)) {
                    410:         s = (char *)MALLOC(strlen(lang)+1);
                    411:         strcpy(s,lang);
                    412:         return s;
                    413:     }
                    414:     return "en"; // English
                    415: }
                    416:
1.42      ohara     417: static void get_sysinfo()
                    418: {
                    419:     int arch64 = 0;
                    420:     char buf[BUFSIZ];
                    421:     OSVERSIONINFO v;
                    422:     char *s;
                    423:     static int initialized = 0;
                    424:
                    425:     if (initialized) {
                    426:         return;
                    427:     }
                    428:     initialized = 1;
                    429:
                    430:     v.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
                    431:     GetVersionEx(&v);
                    432:
                    433:     sysinfo.type = "windows";
                    434:     sysinfo.arch = "x86";
                    435:     sprintf(buf, "%d.%d.%d", v.dwMajorVersion, v.dwMinorVersion, v.dwBuildNumber);
                    436:     s = (char *)MALLOC(strlen(buf)+1);
                    437:     strcpy(s, buf);
                    438:     sysinfo.release = s;
                    439:
                    440:     if (v.dwPlatformId == VER_PLATFORM_WIN32_NT) {
                    441:         sysinfo.kernel = "WindowsNT";
                    442:         sysinfo.name = osnameNT(v.dwMajorVersion, v.dwMinorVersion);
                    443:
                    444: #if defined(_WIN64)
                    445:         sysinfo.arch = "x86_64";
                    446: #else
                    447:         // IsWow64Process exists on WindowsXP SP2 or later
                    448:         if(GetProcAddress(GetModuleHandle("kernel32.dll"), "IsWow64Process")) {
                    449:             IsWow64Process(GetCurrentProcess(),&arch64);
                    450:             if(arch64) {
                    451:                 sysinfo.arch = "x86_64";
                    452:             }
                    453:         }
                    454: #endif
                    455:     }else { /* v.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS */
                    456:         sysinfo.kernel = "Windows95";
                    457:         sysinfo.name = osname95(v.dwMajorVersion, v.dwMinorVersion);
                    458:     }
                    459:     sprintf(buf, "%s %s %s %s %s", sysinfo.kernel, sysinfo.release, sysinfo.name, v.szCSDVersion, sysinfo.arch);
                    460:     s = (char *)MALLOC(strlen(buf)+1);
                    461:     strcpy(s, buf);
                    462:     sysinfo.full = s;
1.44      ohara     463:     sysinfo.lang = get_lang();
1.42      ohara     464: }
                    465:
                    466: #endif

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>