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

Annotation of OpenXM_contrib2/asir2000/builtin/file.c, Revision 1.28

1.4       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.5       noro       26:  * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
1.4       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.28    ! noro       48:  * $OpenXM: OpenXM_contrib2/asir2000/builtin/file.c,v 1.27 2009/03/13 04:45:15 ohara Exp $
1.4       noro       49: */
1.1       noro       50: #include "ca.h"
                     51: #include "parse.h"
1.15      noro       52: #include "ox.h"
1.1       noro       53: #include "base.h"
1.16      noro       54: #if !defined(VISUAL)
1.2       noro       55: #include "unistd.h"
1.16      noro       56: #endif
1.17      ohara      57: #if defined(PARI)
1.1       noro       58: #include "genpari.h"
1.2       noro       59: #endif
1.1       noro       60:
                     61: #if defined(VISUAL)
                     62: #include <windows.h>
1.9       noro       63: #include <process.h>
1.15      noro       64: #include <io.h>
1.1       noro       65: /* #define ECGEN_KEYNAME "SoftWare\\Fujitsu\\WinECgen\\1.00.000" */
                     66: #define ECGEN_KEYNAME "SoftWare\\Fujitsu\\FSEcParamGen\\V1.0L10"
                     67: #define ASIR_KEYNAME "SoftWare\\Fujitsu\\Asir\\1999.03.31"
1.27      ohara      68: #define R_OK 0x04
1.1       noro       69: #endif
                     70:
                     71: void Pget_rootdir();
                     72: void Paccess(),Premove_file();
                     73: void Pbsave_enc(), Pbload_enc();
                     74:
                     75: void Pload(), Pwhich(), Ploadfiles(), Poutput();
                     76: void Pbsave(), Pbload(), Pbload27();
                     77: void Pbsave_compat(), Pbload_compat();
                     78: void Pbsave_cmo(), Pbload_cmo();
1.13      noro       79: void Popen_file(), Pclose_file(), Pget_line(), Pget_byte(), Pput_byte();
1.24      noro       80: void Pput_word(), Pget_word();
1.10      noro       81: void Ppurge_stdin();
1.25      ohara      82: void Pfprintf();
1.22      noro       83: void Pimport();
1.28    ! noro       84: void Pgetpid();
1.1       noro       85:
                     86: extern int des_encryption;
                     87: extern char *asir_libdir;
                     88:
                     89: struct ftab file_tab[] = {
1.25      ohara      90:        {"fprintf",Pfprintf,-99999999},
1.10      noro       91:        {"purge_stdin",Ppurge_stdin,0},
1.13      noro       92:        {"open_file",Popen_file,-2},
1.3       noro       93:        {"close_file",Pclose_file,1},
1.8       noro       94:        {"get_byte",Pget_byte,1},
1.13      noro       95:        {"put_byte",Pput_byte,2},
1.24      noro       96:        {"get_word",Pget_word,1},
                     97:        {"put_word",Pput_word,2},
1.10      noro       98:        {"get_line",Pget_line,-1},
1.1       noro       99:        {"remove_file",Premove_file,1},
                    100:        {"access",Paccess,1},
                    101:        {"load",Pload,-1},
1.22      noro      102:        {"import",Pimport,-1},
1.1       noro      103:        {"which",Pwhich,1},
                    104:        {"loadfiles",Ploadfiles,1},
                    105:        {"output",Poutput,-1},
                    106:        {"bsave",Pbsave,2},
                    107:        {"bload",Pbload,1},
                    108:        {"get_rootdir",Pget_rootdir,0},
1.27      ohara     109: #if defined(DES_ENC)
1.1       noro      110:        {"bsave_enc",Pbsave_enc,2},
                    111:        {"bload_enc",Pbload_enc,1},
1.6       noro      112: #endif
1.1       noro      113:        {"bload27",Pbload27,1},
                    114:        {"bsave_compat",Pbsave_compat,2},
                    115:        {"bload_compat",Pbload_compat,1},
                    116:        {"bsave_cmo",Pbsave_cmo,2},
                    117:        {"bload_cmo",Pbload_cmo,1},
1.28    ! noro      118:        {"getpid",Pgetpid,0},
1.1       noro      119:        {0,0,0},
                    120: };
1.3       noro      121:
                    122: static FILE *file_ptrs[BUFSIZ];
                    123:
1.25      ohara     124: void Pfprintf(NODE arg,pointer *rp)
                    125: {
                    126:        FILE *fp;
                    127:        STRING s;
                    128:        asir_assert(ARG0(arg),O_N,"fprintf");
                    129:        fp = file_ptrs[QTOS((Q)ARG0(arg))];
                    130:        if ( !fp ) {
                    131:                error("fprintf : invalid argument");
                    132:        }
                    133:        arg = NEXT(arg);
                    134:        if ( arg ) {
                    135:                Psprintf(arg,&s);
                    136:                fputs(BDY(s),fp);
1.26      ohara     137:                /* fflush(fp); */
1.25      ohara     138:        }
                    139:        *rp = 0;
                    140:        return;
                    141: }
                    142:
1.15      noro      143: void Ppurge_stdin(Q *rp)
1.10      noro      144: {
                    145:        purge_stdin(stdin);
                    146:        *rp = 0;
                    147: }
                    148:
1.15      noro      149: void Popen_file(NODE arg,Q *rp)
1.3       noro      150: {
                    151:        char *name;
                    152:        FILE *fp;
                    153:        char errbuf[BUFSIZ];
                    154:        int i;
                    155:
                    156:        asir_assert(ARG0(arg),O_STR,"open_file");
                    157:        for ( i = 0; i < BUFSIZ && file_ptrs[i]; i++ );
                    158:        if ( i == BUFSIZ )
                    159:                error("open_file : too many open files");
                    160:        name = BDY((STRING)ARG0(arg));
1.18      takayama  161:        if (strcmp(name,"unix://stdin") == 0) {
                    162:          fp = stdin;
                    163:        }else if (strcmp(name,"unix://stdout") == 0) {
                    164:          fp = stdout;
                    165:     }else if (strcmp(name,"unix://stderr") == 0) {
                    166:          fp = stderr;
                    167:     }else{
                    168:          if ( argc(arg) == 2 ) {
1.13      noro      169:                asir_assert(ARG1(arg),O_STR,"open_file");
                    170:                fp = fopen(name,BDY((STRING)ARG1(arg)));
1.18      takayama  171:          } else
1.13      noro      172:                fp = fopen(name,"r");
1.18      takayama  173:     }
1.3       noro      174:        if ( !fp ) {
1.13      noro      175:                sprintf(errbuf,"open_file : cannot open \"%s\"",name);
1.3       noro      176:                error(errbuf);
                    177:        }
                    178:        file_ptrs[i] = fp;
                    179:        STOQ(i,*rp);
                    180: }
                    181:
1.15      noro      182: void Pclose_file(NODE arg,Q *rp)
1.3       noro      183: {
                    184:        int i;
                    185:
1.8       noro      186:        asir_assert(ARG0(arg),O_N,"close_file");
1.3       noro      187:        i = QTOS((Q)ARG0(arg));
                    188:        if ( file_ptrs[i] ) {
                    189:                fclose(file_ptrs[i]);
                    190:                file_ptrs[i] = 0;
                    191:        } else
                    192:                error("close_file : invalid argument");
                    193:        *rp = ONE;
                    194: }
                    195:
1.15      noro      196: void Pget_line(NODE arg,STRING *rp)
1.3       noro      197: {
                    198:        int i,j,c;
                    199:        FILE *fp;
                    200:        fpos_t head;
                    201:        char *str;
1.10      noro      202:        char buf[BUFSIZ];
                    203:
                    204:        if ( !arg ) {
                    205: #if defined(VISUAL_LIB)
                    206:                get_string(buf,sizeof(buf));
                    207: #else
                    208:                fgets(buf,sizeof(buf),stdin);
                    209: #endif
                    210:                i = strlen(buf);
                    211:                str = (char *)MALLOC_ATOMIC(i+1);
                    212:                strcpy(str,buf);
                    213:                MKSTR(*rp,str);
                    214:                return;
                    215:        }
1.3       noro      216:
1.8       noro      217:        asir_assert(ARG0(arg),O_N,"get_line");
1.3       noro      218:        i = QTOS((Q)ARG0(arg));
                    219:        if ( fp = file_ptrs[i] ) {
                    220:                if ( feof(fp) ) {
                    221:                        *rp = 0;
                    222:                        return;
                    223:                }
                    224:                fgetpos(fp,&head);
                    225:                j = 0;
                    226:                while ( 1 ) {
                    227:                        c = getc(fp);
                    228:                        if ( c == EOF ) {
                    229:                                if ( !j ) {
                    230:                                        *rp = 0;
                    231:                                        return;
                    232:                                } else
                    233:                                        break;
                    234:                        }
                    235:                        j++;
                    236:                        if ( c == '\n' )
                    237:                                break;
                    238:                }
                    239:                fsetpos(fp,&head);
                    240:                str = (char *)MALLOC_ATOMIC(j+1);
                    241:                fgets(str,j+1,fp);
                    242:                MKSTR(*rp,str);
                    243:        } else
                    244:                error("get_line : invalid argument");
1.8       noro      245: }
                    246:
1.15      noro      247: void Pget_byte(NODE arg,Q *rp)
1.8       noro      248: {
                    249:        int i,c;
                    250:        FILE *fp;
                    251:
                    252:        asir_assert(ARG0(arg),O_N,"get_byte");
                    253:        i = QTOS((Q)ARG0(arg));
                    254:        if ( fp = file_ptrs[i] ) {
                    255:                if ( feof(fp) ) {
                    256:                        STOQ(-1,*rp);
                    257:                        return;
                    258:                }
                    259:                c = getc(fp);
                    260:                STOQ(c,*rp);
                    261:        } else
                    262:                error("get_byte : invalid argument");
1.13      noro      263: }
                    264:
1.24      noro      265: void Pget_word(NODE arg,Q *rp)
                    266: {
                    267:        int i,c;
                    268:        FILE *fp;
                    269:
                    270:        asir_assert(ARG0(arg),O_N,"get_word");
                    271:        i = QTOS((Q)ARG0(arg));
                    272:        if ( fp = file_ptrs[i] ) {
                    273:                if ( feof(fp) ) {
                    274:                        error("get_word : end of file");
                    275:                        return;
                    276:                }
                    277:                read_int(fp,&c);
                    278:                STOQ(c,*rp);
                    279:        } else
                    280:                error("get_word : invalid argument");
                    281: }
                    282:
1.20      noro      283: void Pput_byte(NODE arg,Obj *rp)
1.13      noro      284: {
1.20      noro      285:        int i,j,c;
1.13      noro      286:        FILE *fp;
1.20      noro      287:        Obj obj;
                    288:        TB tb;
1.13      noro      289:
                    290:        asir_assert(ARG0(arg),O_N,"put_byte");
                    291:        i = QTOS((Q)ARG0(arg));
1.20      noro      292:        if ( !(fp = file_ptrs[i]) )
                    293:                error("put_byte : invalid argument");
                    294:
                    295:        obj = (Obj)ARG1(arg);
                    296:        if ( !obj || OID(obj) == O_N ) {
                    297:                c = QTOS((Q)obj);
1.13      noro      298:                putc(c,fp);
1.20      noro      299:        } else if ( OID(obj) == O_STR )
                    300:                fputs(BDY((STRING)obj),fp);
                    301:        else if ( OID(obj) == O_TB ) {
                    302:                tb = (TB)obj;
                    303:                for ( j = 0; j < tb->next; j++ )
                    304:                        fputs(tb->body[j],fp);
                    305:        }
                    306:        *rp = obj;
1.3       noro      307: }
1.1       noro      308:
1.24      noro      309: void Pput_word(NODE arg,Obj *rp)
                    310: {
                    311:        int i,c;
                    312:        FILE *fp;
                    313:        Obj obj;
                    314:
                    315:        asir_assert(ARG0(arg),O_N,"put_word");
                    316:        asir_assert(ARG1(arg),O_N,"put_word");
                    317:        i = QTOS((Q)ARG0(arg));
                    318:        if ( !(fp = file_ptrs[i]) )
                    319:                error("put_word : invalid argument");
                    320:
                    321:        obj = (Q)ARG1(arg);
                    322:        c = QTOS((Q)obj);
                    323:        write_int(fp,&c);
                    324:        *rp = obj;
                    325: }
                    326:
1.15      noro      327: void Pload(NODE arg,Q *rp)
1.1       noro      328: {
                    329:        int ret = 0;
                    330:        char *name,*name0;
                    331:        char errbuf[BUFSIZ];
                    332:
1.23      noro      333:        if ( !arg ) error("load : invalid argument");
1.1       noro      334:        if ( ARG0(arg) ) {
                    335:                switch (OID(ARG0(arg))) {
                    336:                        case O_STR:
                    337:                                name0 = BDY((STRING)ARG0(arg));
                    338:                                searchasirpath(name0,&name);
                    339:                                if ( !name ) {
                    340:                                        sprintf(errbuf,"load : \"%s\" not found in the search path",name0);
                    341:                                        error(errbuf);
                    342:                                }
1.22      noro      343:                                execasirfile(name);
1.1       noro      344:                                break;
                    345:                        default:
                    346:                                error("load : invalid argument");
                    347:                                break;
                    348:                }
                    349:        }
1.14      noro      350:        STOQ(ret,*rp);
                    351: }
                    352:
1.21      noro      353: NODE imported_files;
                    354:
                    355: void Pimport(NODE arg,Q *rp)
                    356: {
1.22      noro      357:        char *name;
                    358:        NODE t,p,opt;
                    359:
                    360:        name = BDY((STRING)ARG0(arg));
                    361:        for ( t = imported_files; t; t = NEXT(t) )
                    362:                if ( !strcmp((char *)BDY(t),name) ) break;
                    363:        if ( !t ) {
                    364:                Pload(arg,rp);
                    365:                MKNODE(t,name,imported_files);
                    366:                imported_files = t;
                    367:                return;
                    368:        } else if ( current_option ) {
                    369:                for ( opt = current_option; opt; opt = NEXT(opt) ) {
                    370:                        p = BDY((LIST)BDY(opt));
                    371:                        if ( !strcmp(BDY((STRING)BDY(p)),"reimport") && BDY(NEXT(p)) ) {
                    372:                                Pload(arg,rp);
                    373:                                return;
1.21      noro      374:                        }
                    375:                }
1.15      noro      376:        }
1.22      noro      377:        *rp = 0;
1.1       noro      378: }
                    379:
1.15      noro      380: void Pwhich(NODE arg,STRING *rp)
1.1       noro      381: {
                    382:        char *name;
                    383:        STRING str;
                    384:
                    385:        switch (OID(ARG0(arg))) {
                    386:                case O_STR:
                    387:                        searchasirpath(BDY((STRING)ARG0(arg)),&name);
                    388:                        break;
                    389:                default:
                    390:                        name = 0;
                    391:                        break;
                    392:        }
                    393:        if ( name ) {
                    394:                MKSTR(str,name); *rp = str;
                    395:        } else
                    396:                *rp = 0;
                    397: }
                    398:
1.15      noro      399: void Ploadfiles(NODE arg,Q *rp)
1.1       noro      400: {
                    401:        int ret;
                    402:
                    403:        if ( ARG0(arg) )
                    404:                if ( OID(ARG0(arg)) != O_LIST )
                    405:                        ret = 0;
                    406:                else
                    407:                        ret = loadfiles(BDY((LIST)ARG0(arg)));
                    408:        else
                    409:                ret = 0;
                    410:        STOQ(ret,*rp);
                    411: }
                    412:
1.15      noro      413: void Poutput(NODE arg,Q *rp)
1.1       noro      414: {
1.17      ohara     415: #if defined(PARI)
1.1       noro      416:        extern FILE *outfile;
                    417: #endif
                    418:        FILE *fp;
                    419:
                    420:        fflush(asir_out);
                    421:        if ( asir_out != stdout )
                    422:                fclose(asir_out);
                    423:        switch ( argc(arg) ) {
                    424:                case 0:
                    425:                        fp = stdout; break;
                    426:                case 1:
                    427:                        asir_assert(ARG0(arg),O_STR,"output");
                    428:                        fp = fopen(((STRING)ARG0(arg))->body,"a+");
                    429:                        if ( !fp )
                    430:                                error("output : invalid filename");
                    431:                        break;
                    432:        }
1.17      ohara     433: #if defined(PARI)
1.1       noro      434:        pari_outfile =
                    435: #endif
                    436:        asir_out = fp;
                    437:        *rp = ONE;
                    438: }
                    439:
                    440: extern int ox_file_io;
                    441:
1.15      noro      442: void Pbsave(NODE arg,Q *rp)
1.1       noro      443: {
                    444:        FILE *fp;
                    445:        VL vl,t;
                    446:
                    447:        asir_assert(ARG1(arg),O_STR,"bsave");
                    448:        get_vars_recursive(ARG0(arg),&vl);
                    449:        for ( t = vl; t; t = NEXT(t) )
                    450:                if ( t->v->attr == (pointer)V_UC )
                    451:                        error("bsave : not implemented");
                    452:        fp = fopen(BDY((STRING)ARG1(arg)),"wb");
                    453:        if ( !fp )
                    454:                error("bsave : invalid filename");
                    455:        ox_file_io = 1; /* network byte order is used */
                    456:        savevl(fp,vl);
                    457:        saveobj(fp,ARG0(arg));
                    458:        fclose(fp);
                    459:        ox_file_io = 0;
                    460:        *rp = ONE;
                    461: }
                    462:
1.15      noro      463: void Pbload(NODE arg,Obj *rp)
1.1       noro      464: {
                    465:        FILE *fp;
                    466:
                    467:        asir_assert(ARG0(arg),O_STR,"bload");
                    468:        fp = fopen(BDY((STRING)ARG0(arg)),"rb");
                    469:        if ( !fp )
                    470:                error("bload : invalid filename");
                    471:        ox_file_io = 1; /* network byte order is used */
                    472:        loadvl(fp);
                    473:        loadobj(fp,rp);
                    474:        fclose(fp);
                    475:        ox_file_io = 0;
                    476: }
                    477:
1.15      noro      478: void Pbsave_cmo(NODE arg,Q *rp)
1.1       noro      479: {
                    480:        FILE *fp;
                    481:
                    482:        asir_assert(ARG1(arg),O_STR,"bsave_cmo");
                    483:        fp = fopen(BDY((STRING)ARG1(arg)),"wb");
                    484:        if ( !fp )
                    485:                error("bsave_cmo : invalid filename");
                    486:        ox_file_io = 1; /* network byte order is used */
                    487:        write_cmo(fp,ARG0(arg));
                    488:        fclose(fp);
                    489:        ox_file_io = 0;
                    490:        *rp = ONE;
                    491: }
                    492:
1.15      noro      493: void Pbload_cmo(NODE arg,Obj *rp)
1.1       noro      494: {
                    495:        FILE *fp;
                    496:
                    497:        asir_assert(ARG0(arg),O_STR,"bload_cmo");
                    498:        fp = fopen(BDY((STRING)ARG0(arg)),"rb");
                    499:        if ( !fp )
                    500:                error("bload_cmo : invalid filename");
                    501:        ox_file_io = 1; /* network byte order is used */
                    502:        read_cmo(fp,rp);
                    503:        fclose(fp);
                    504:        ox_file_io = 0;
                    505: }
                    506:
1.7       noro      507: static struct oSTRING rootdir;
                    508:
1.1       noro      509: #if defined(VISUAL)
1.15      noro      510: void get_rootdir(char *name,int len)
1.1       noro      511: {
                    512:        LONG    ret;
                    513:        HKEY    hOpenKey;
                    514:        DWORD   Type;
1.7       noro      515:        char    *slash;
1.12      noro      516:
1.7       noro      517:        if ( rootdir.body ) {
                    518:                strcpy(name,rootdir.body);
1.12      noro      519:                return;
                    520:        }
                    521:
                    522:        if ( access("UseCurrentDir",0) >= 0 ) {
                    523:                GetCurrentDirectory(BUFSIZ,name);
                    524:                slash = strrchr(name,'\\');
                    525:                if ( slash )
                    526:                        *slash = 0;
1.7       noro      527:                return;
                    528:        }
1.1       noro      529:        name[0] = 0;
                    530:        ret = RegOpenKeyEx(HKEY_LOCAL_MACHINE, ECGEN_KEYNAME, 0,
                    531:                KEY_QUERY_VALUE, &hOpenKey);
                    532:        if ( ret != ERROR_SUCCESS )
                    533:                ret = RegOpenKeyEx(HKEY_LOCAL_MACHINE, ASIR_KEYNAME, 0,
                    534:                        KEY_QUERY_VALUE, &hOpenKey);
                    535:        if( ret == ERROR_SUCCESS ) {
                    536:                RegQueryValueEx(hOpenKey, "Directory", NULL, &Type, name, &len);
                    537:                RegCloseKey(hOpenKey);
1.7       noro      538:        } else {
                    539:                GetCurrentDirectory(len,name);
                    540:                slash = strrchr(name,'\\');
                    541:                if ( slash )
                    542:                        *slash = 0;
1.1       noro      543:        }
                    544: }
1.7       noro      545:
1.15      noro      546: void set_rootdir(char *name)
1.7       noro      547: {
                    548:        static char DirName[BUFSIZ];
                    549:
                    550:        strcpy(DirName,name);
                    551:        rootdir.id = O_STR;
                    552:        rootdir.body = DirName;
                    553:        asir_libdir = DirName;
                    554:        /* XXX */
                    555:        env_init();
                    556: }
                    557:
1.1       noro      558: #else
1.15      noro      559: void get_rootdir(char *name,int len)
1.1       noro      560: {
                    561:        strcpy(name,asir_libdir);
                    562: }
1.7       noro      563:
1.15      noro      564: void set_rootdir(char *name)
1.7       noro      565: {
                    566:        static char DirName[BUFSIZ];
                    567:
                    568:        strcpy(DirName,name);
                    569:        asir_libdir = DirName;
                    570:        /* XXX */
                    571:        env_init();
                    572: }
                    573:
1.1       noro      574: #endif
                    575:
1.15      noro      576: void Pget_rootdir(STRING *rp)
1.1       noro      577: {
                    578:        static char DirName[BUFSIZ];
                    579:
                    580:        if ( !rootdir.body ) {
                    581:                get_rootdir(DirName,sizeof(DirName));
                    582:                rootdir.id = O_STR;
                    583:                rootdir.body = DirName;
                    584:        }
                    585:        *rp = &rootdir;
                    586: }
                    587:
1.28    ! noro      588: void Pgetpid(Q *rp)
        !           589: {
        !           590:        int id;
        !           591:
        !           592: #if defined(VISUAL)
        !           593:        id = GetCurrentProcessId();
        !           594: #else
        !           595:        id = getpid();
        !           596: #endif
        !           597:        STOQ(id,*rp);
        !           598: }
        !           599:
1.27      ohara     600: #if defined(DES_ENC)
1.15      noro      601: void Pbsave_enc(NODE arg,Obj *rp)
1.1       noro      602: {
                    603:        init_deskey();
                    604:        des_encryption = 1;
                    605:        Pbsave(arg,rp);
                    606:        des_encryption = 0;
                    607: }
                    608:
1.15      noro      609: void Pbload_enc(NODE arg,Obj *rp)
1.1       noro      610: {
                    611:        init_deskey();
                    612:        des_encryption = 1;
                    613:        Pbload(arg,rp);
                    614:        des_encryption = 0;
                    615: }
1.6       noro      616: #endif
1.1       noro      617:
1.15      noro      618: void Pbload27(NODE arg,Obj *rp)
1.1       noro      619: {
                    620:        FILE *fp;
                    621:        Obj r;
                    622:
                    623:        asir_assert(ARG0(arg),O_STR,"bload27");
                    624:        fp = fopen(BDY((STRING)ARG0(arg)),"rb");
                    625:        if ( !fp )
                    626:                error("bload : invalid filename");
                    627:        loadvl(fp);
                    628:        loadobj(fp,&r);
                    629:        fclose(fp);
                    630:        bobjtoobj(BASE27,r,rp);
                    631: }
                    632:
1.15      noro      633: void Pbsave_compat(NODE arg,Q *rp)
1.1       noro      634: {
                    635:        FILE *fp;
                    636:        VL vl,t;
                    637:
                    638:        asir_assert(ARG1(arg),O_STR,"bsave_compat");
                    639:        get_vars_recursive(ARG0(arg),&vl);
                    640:        for ( t = vl; t; t = NEXT(t) )
                    641:                if ( t->v->attr == (pointer)V_UC )
                    642:                        error("bsave : not implemented");
                    643:        fp = fopen(BDY((STRING)ARG1(arg)),"wb");
                    644:        if ( !fp )
                    645:                error("bsave : invalid filename");
                    646:        /* indicator of an asir32 file */
                    647:        putw(0,fp); putw(0,fp);
                    648:        savevl(fp,vl);
                    649:        saveobj(fp,ARG0(arg));
                    650:        fclose(fp);
                    651:        *rp = ONE;
                    652: }
                    653:
1.15      noro      654: void Pbload_compat(NODE arg,Obj *rp)
1.1       noro      655: {
                    656:        FILE *fp;
                    657:        unsigned int hdr[2];
                    658:        Obj r;
                    659:        int c;
                    660:
                    661:        asir_assert(ARG0(arg),O_STR,"bload_compat");
                    662:        fp = fopen(BDY((STRING)ARG0(arg)),"rb");
                    663:        if ( !fp )
                    664:                error("bload : invalid filename");
                    665:        fread(hdr,sizeof(unsigned int),2,fp);
                    666:        if ( !hdr[0] && !hdr[1] ) {
                    667:                /* asir32 file or asir27 0 */
                    668:                c = fgetc(fp);
                    669:                if ( c == EOF ) {
                    670:                        /* asir27 0 */
                    671:                        *rp = 0;
                    672:                } else {
                    673:                        /* asir32 file */
                    674:                        ungetc(c,fp);
                    675:                        loadvl(fp);
                    676:                        loadobj(fp,rp);
                    677:                }
                    678:        } else {
                    679:                /* asir27 file */
                    680:                rewind(fp);
                    681:                loadvl(fp);
                    682:                loadobj(fp,&r);
                    683:                bobjtoobj(BASE27,r,rp);
                    684:        }
                    685:        fclose(fp);
                    686: }
                    687:
1.15      noro      688: void Premove_file(NODE arg,Q *rp)
1.1       noro      689: {
                    690:        unlink((char *)BDY((STRING)ARG0(arg)));
                    691:        *rp = ONE;
                    692: }
                    693:
1.15      noro      694: void Paccess(NODE arg,Q *rp)
1.1       noro      695: {
                    696:        if ( access(BDY((STRING)ARG0(arg)),R_OK) >= 0 )
                    697:                *rp = ONE;
                    698:        else
                    699:                *rp = 0;
                    700: }
1.9       noro      701:
                    702: #if defined(VISUAL)
                    703: int process_id()
                    704: {
                    705:        return GetCurrentProcessId();
                    706: }
                    707:
1.15      noro      708: void call_exe(char *name,char **av)
1.9       noro      709: {
                    710:        _spawnv(_P_WAIT,name,av);
                    711: }
                    712: #endif

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