Mercurial > hg > jgplsrc
view xf.c @ 0:e0bbaa717f41 draft default tip
lol J
author | Jordi Gutiérrez Hermoso <jordigh@octave.org> |
---|---|
date | Mon, 25 Nov 2013 11:56:30 -0500 |
parents | |
children |
line wrap: on
line source
/* Copyright 1990-2011, Jsoftware Inc. All rights reserved. */ /* License in license.txt. */ /* */ /* Xenos: Files */ /* File functions accept file number or boxed file name or 1 or 2 */ #ifdef _WIN32 #include <windows.h> #include <winbase.h> #endif #include "j.h" #include "x.h" #if !SY_WIN32 && (SYS & SYS_DOS) #include <dos.h> #endif #if (SYS & SYS_UNIX) #include <stdlib.h> typedef long long INT64; #endif #if SY_WIN32 && !SY_WINCE #include <direct.h> #include <io.h> #endif #if SY_64 static I fsize(F f){fpos_t z; RZ(f); #if SY_WIN32 _lseeki64(_fileno(f),0,SEEK_END); #else fseek(f,0L,SEEK_END); #endif fgetpos(f,&z); R *(I*)&z; } #else static I fsize(F f){ RZ(f); if(fseek(f,0L,SEEK_END))R -1; R ftell(f); } #endif static A jtrdns(J jt,F f){A za,z;I n;size_t r,tr=0; GA(za,LIT,n=1024,1,0); clearerr(f); while(!feof(f) && (r=fread(CAV(za)+tr,sizeof(C),n-tr,f))){ tr+=r; if(tr==(U)n){RZ(za=ext(0,za));n*=2;} } if(tr==(U)n)z=za; else {GA(z,LIT,tr,1,0); MC(CAV(z),CAV(za),tr);} R z; } /* read entire file stream (non-seekable) */ A jtrd(J jt,F f,I j,I n){A z;C*x;I p=0;size_t q=1; RZ(f); if(0>n){if(j<0) n=-j; else n=fsize(f)-j;} #if !SY_WINCE {INT64 v; v= j+((0>j)?fsize(f):0); fsetpos(f,(fpos_t*)&v);} #else fseek(f,(long)(0>j?1+j:j),0>j?SEEK_END:SEEK_SET); #endif clearerr(f); GA(z,LIT,n,1,0); x=CAV(z); while(q&&n>p){ p+=q=fread(p+x,sizeof(C),(size_t)(n-p),f); if(ferror(f))R jerrno(); } R z; } /* read file f for n bytes at j */ static B jtwa(J jt,F f,I j,A w){C*x;I n,p=0;size_t q=1; RZ(f&&w); n=AN(w)*(C2T&AT(w)?2:1); x=CAV(w); #if !SY_WINCE {INT64 v; v= j+((0>j)?fsize(f):0); fsetpos(f,(fpos_t*)&v);} #else fseek(f,(long)(0>j?1+j:j),0>j?SEEK_END:SEEK_SET); #endif clearerr(f); while(q&&n>p){ p+=q=fwrite(p+x,sizeof(C),(size_t)(n-p),f); if(ferror(f))R jerrno()?1:0; } R 1; } /* write/append string w to file f at j */ F1(jtjfread){A z;F f; F1RANK(0,jtjfread,0); RE(f=stdf(w)); if(f)R 1==(I)f?jgets("\001"):3==(I)f?rdns(stdin):rd(vfn(f),0L,-1L); RZ(f=jope(w,FREAD)); z=rd(f,0L,-1L); fclose(f); R z; } F2(jtjfwrite){B b;F f; F2RANK(RMAX,0,jtjfwrite,0); if(BOX&AT(w)){ASSERT(1>=AR(a),EVRANK); ASSERT(!AN(a)||AT(a)&LIT+C2T,EVDOMAIN);} RE(f=stdf(w)); if(2==(I)f){b=jt->tostdout; jt->tostdout=1; jt->mtyo=MTYOFILE; jpr(a); jt->mtyo=0; jt->tostdout=b; R a;} if(4==(I)f){R (U)AN(a)!=fwrite(CAV(a),sizeof(C),AN(a),stdout)?jerrno():a;} if(5==(I)f){R (U)AN(a)!=fwrite(CAV(a),sizeof(C),AN(a),stderr)?jerrno():a;} if(b=!f)RZ(f=jope(w,FWRITE)) else RE(vfn(f)); wa(f,0L,a); if(b)fclose(f);else fflush(f); RNE(mtm); } F2(jtjfappend){B b;F f; F2RANK(RMAX,0,jtjfappend,0); RE(f=stdf(w)); if(2==(I)f){B b=jt->tostdout; jt->tostdout=1; jpr(a); jt->tostdout=b; R a;} ASSERT(!AN(a)||AT(a)&LIT+C2T,EVDOMAIN); ASSERT(1>=AR(a),EVRANK); if(b=!f)RZ(f=jope(w,FAPPEND)) else RE(vfn(f)); wa(f,fsize(f),a); if(b)fclose(f);else fflush(f); RNE(mtm); } F1(jtjfsize){B b;F f;I m; F1RANK(0,jtjfsize,0); RE(f=stdf(w)); if(b=!f)RZ(f=jope(w,FREAD)) else RE(vfn(f)); m=fsize(f); if(b)fclose(f);else fflush(f); RNE(sc(m)); } static F jtixf(J jt,A w){F f; ASSERT(2<=AN(w),EVLENGTH); switch(AT(w)){ default: ASSERT(0,EVDOMAIN); case B01: ASSERT(0,EVFNUM); case BOX: ASSERT(2==AN(w),EVLENGTH); f=stdf(head(w)); break; case INT: f=(F)*AV(w); ASSERT(2<(UI)f,EVFNUM); } R f?vfn(f):f; } /* process index file arg for file number; 0 if a file name */ static B jtixin(J jt,A w,I s,I*i,I*n){A in,*wv;I j,k,m,*u,wd; if(AT(w)&BOX){wv=AAV(w); wd=(I)w*ARELATIVE(w); RZ(in=vi(WVR(1))); k=AN(in); u=AV(in);} else{in=w; k=AN(in)-1; u=1+AV(in);} ASSERT(1>=AR(in),EVRANK); ASSERT(k&&k<=(n?2:1),EVLENGTH); j=u[0]; j=0>j?s+j:j; m=1==k?s-j:u[1]; ASSERT(0<=j&&(!n||j<s&&j+m<=s&&0<=m),EVINDEX); *i=j; if(n)*n=m; R 1; } /* process index file arg for index and length */ F1(jtjiread){A z=0;B b;F f;I i,n; F1RANK(1,jtjiread,0); RE(f=ixf(w)); if(b=!f)RZ(f=jope(w,FREAD)); if(ixin(w,fsize(f),&i,&n))z=rd(f,i,n); if(b)fclose(f);else fflush(f); R z; } F2(jtjiwrite){B b;F f;I i; F2RANK(RMAX,1,jtjiwrite,0); ASSERT(!AN(a)||AT(a)&LIT+C2T,EVDOMAIN); ASSERT(1>=AR(a),EVRANK); RE(f=ixf(w)); if(b=!f)RZ(f=jope(w,FUPDATE)); if(ixin(w,fsize(f),&i,0L))wa(f,i,a); if(b)fclose(f);else fflush(f); RNE(mtm); } #if (SYS & SYS_MACINTOSH) static B setparm(C*v,C*ms,HParamBlockRec mp){I n; n=strlen(v); ASSERT(n<=NPATH,EVLIMIT); *ms=n; MC(1+ms,v,n); mp.fileParam.ioNamePtr=ms; mp.fileParam.ioVRefNum=0; mp.fileParam.ioDirID =0; R 1; } #define DIRF(f,fsub) \ B f(J jt,C*v){C ms[256];HParamBlockRec mp; \ RZ(setparm(v,ms,mp)); \ ASSERT(!fsub(&mp,0),EVFACE); \ R 1; \ } static DIRF(jtmkdir1,PBDirCreate) static DIRF(jtrmdir1,PBHDelete ) static B mkdir(C*v){R!mkdir1(v);} static B rmdir(C*v){R!rmdir1(v);} #endif F1(jtjmkdir){A y,z; F1RANK(0,jtjmkdir,0); ASSERT(AT(w)&BOX,EVDOMAIN); RZ(y=str0(vs(AAV0(w)))); #if (SYS & SYS_UNIX) R mkdir(CAV(y),0775)?jerrno():one; #else RZ(z=toutf16x(y)); R _wmkdir((US*)CAV(z))?jerrno():one; #endif } F1(jtjferase){A y,fn;US*s;I h; F1RANK(0,jtjferase,0); RE(h=fnum(w)); if(h) y=str0(fname(sc(h))); else y=AAV0(w); ASSERT(y,EVFNUM); if(h)RZ(jclose(sc(h))); #if (SYS&SYS_UNIX) R !unlink(CAV(y))||!rmdir(CAV(y))?one:jerrno(); #else RZ(fn=toutf16x(y)); s=USAV(fn); R !_wunlink(s)||!_wrmdir(s)?one:jerrno(); #endif } /* erase file or directory */ F1(jtpathcwd){C path[1+NPATH];US wpath[1+NPATH]; ASSERTMTV(w); #if SY_WINCE &path;&wpath; /* avoid compiler warnings */ R cstr("\\"); #else #if (SYS & SYS_UNIX) ASSERT(getcwd(path,NPATH),EVFACE); #else ASSERT(_wgetcwd(wpath,NPATH),EVFACE); jttoutf8x(jt,path,NPATH,wpath); #endif R cstr(path); #endif } F1(jtpathchdir){A z; RZ(w); ASSERT(1>=AR(w),EVRANK); ASSERT(AN(w),EVLENGTH); ASSERT(LIT&AT(w),EVDOMAIN); #if SY_WINCE &z; /* avoid compiler warning */ ASSERT(0,EVFACE); #else #if (SYS & SYS_UNIX) ASSERT(!chdir(CAV(w)),EVFACE); #else RZ(z=toutf16x(w)); _wchdir((US*)CAV(z)); #endif R mtv; #endif } #if SY_WINCE #define _wgetenv(s) (0) #endif F1(jtjgetenv){ F1RANK(1,jtjgetenv,0); ASSERT(LIT&AT(w),EVDOMAIN); #if (SYS & SYS_UNIX) { C*s; R(s=getenv(CAV(w)))?cstr(s):zero; } #else { A z; US* us; RZ(z=toutf16x(w)); us=_wgetenv((US*)CAV(z)); if(!us)R zero; GA(z,C2T,wcslen(us),1,0); memcpy(USAV(z),us,2*wcslen(us)); R toutf8(z); } #endif R zero; } F1(jtjgetpid){ ASSERTMTV(w); #if SY_WIN32 R(sc(GetCurrentProcessId())); #else R(sc(getpid())); #endif } #if (SYS & SYS_UNIX) F1(jtpathdll){ ASSERTMTV(w); R cstr(""); } #else F1(jtpathdll){char p[MAX_PATH]; extern C dllpath[]; ASSERTMTV(w); strcpy(p,dllpath); if('\\'==p[strlen(p)-1]) p[strlen(p)-1]=0; R cstr(p); } #endif