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