Mercurial > hg > jgplsrc
diff 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 (2013-11-25) |
parents | |
children |
line wrap: on
line diff
new file mode 100644 --- /dev/null +++ b/xf.c @@ -0,0 +1,316 @@ +/* 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