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>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to file.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / asir2000 / builtin