Mercurial > hg > jgplsrc
view xo.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: File Open/Close */ #ifdef _WIN32 #include <windows.h> #include <winbase.h> #ifndef UNDER_CE #include <io.h> #include <fcntl.h> #endif #endif #include "j.h" #include "x.h" B jtxoinit(J jt){A x; #if SY_WIN32 && !SY_WINCE _setmode(_fileno(stdin),_O_BINARY); _setmode(_fileno(stdout),_O_BINARY); _setmode(_fileno(stderr),_O_BINARY); #endif GA(x,BOX,8,1,0); memset(AV(x),C0,AN(x)*SZI); ra(x); jt->fopa=x; GA(x,INT,8,1,0); ra(x); jt->fopf=x; R 1; } F jtvfn(J jt,F x){I*v=AV(jt->fopf); DO(jt->fopn,if(x==(F)*v++)R x;); ASSERT(0,EVFNUM);} /* check that x is in table of file#s */ I jtfnum(J jt,A w){A y;I h,j; if(AT(w)&B01+INT){ASSERT(h=i0(w),EVFNUM); R h;} ASSERT(AT(w)&BOX,EVDOMAIN); y=AAV0(w); ASSERT(AN(y),EVLENGTH); if(AT(y)&B01+INT){ASSERT(h=i0(y),EVFNUM); R h;} RE(j=i0(indexof(vec(BOX,jt->fopn,AAV(jt->fopa)),box(fullname(vs(y)))))); R j<jt->fopn?*(j+AV(jt->fopf)):0; } /* file# corresp. to standard argument w */ F1(jtfname){I j; RE(j=i0(indexof(jt->fopf,w))); R j<jt->fopn?ca(*(j+AAV(jt->fopa))):(A)0; } /* string name corresp. to file# w */ F1(jtjfiles){A y; ASSERTMTV(w); RZ(y=vec(INT,jt->fopn,AV(jt->fopf))); R grade2(stitch(box0(y),vec(BOX,jt->fopn,AV(jt->fopa))),y); } /* file (number,name) table */ F jtjope(J jt,A w,C*mode){A t;F f;I n;static I nf=25; A z; RZ(w); ASSERT(BOX&AT(w),EVDOMAIN); RZ(t=str0(vs(AAV0(w)))); n=AN(t)-1; ASSERT(n,EVLENGTH); #if (SYS&SYS_UNIX) { C* cs=CAV(t); f=fopen(cs,mode); if(!f&&errno==ENOENT&&!strcmp(mode,FUPDATE))f=fopen(cs,FUPDATEC); if(!f&&errno==EACCES&& strcmp(mode,FREAD ))f=fopen(cs,FREAD); } #else { US usmode[10]; US*s; I i; RZ(z=jttoutf16x(jt,t)); s=(US*)CAV(z); for(i=0;i<(I)strlen(mode);++i){usmode[i]=(US)mode[i];} usmode[i]=0; #if !SY_WINCE f=_wfopen(s,usmode); if(!f&&errno==ENOENT&&!wcscmp(usmode,FLUPDATE))f=_wfopen(s,FLUPDATEC); if(!f&&errno==EACCES&& wcscmp(usmode,FLREAD ))f=_wfopen(s,FLREAD); #else { f=_wfopen(s,usmode); if(!f&&!wcscmp(usmode,FLUPDATE))f=_wfopen(s,FLUPDATEC); // no errno on wince if(!f&& wcscmp(usmode,FLREAD ))f=_wfopen(s,FLREAD); } #endif } #endif R f?f:(F)jerrno(); } F1(jtjopen){A z;I h; RZ(w); if(!AN(w))R w; if(AR(w))R rank1ex(w,0L,0L,jtjopen); RE(h=fnum(w)); if(h){RZ(z=sc(h)); ASSERT(fname(z),EVFNUM); R z;} else{ if(jt->fopn==AN(jt->fopf)){RZ(jt->fopa=ext(1,jt->fopa)); RZ(jt->fopf=ext(1,jt->fopf));} RZ(*(jt->fopn+IAV(jt->fopf))=h=(I)jope(w,FUPDATE)); RZ(*(jt->fopn+AAV(jt->fopa))=ra(fullname(AAV0(w)))); ++jt->fopn; R sc(h); }} /* open the file named w if necessary; return file# */ B jtadd2(J jt,F f1,F f2,C*cmd){A c; if(f1==NULL) {jt->fopn+=2;R 1;}; GA(c,LIT,1+strlen(cmd),1,0);MC(CAV(c)+1,cmd,AN(c)-1);cmd=CAV(c); if(jt->fopn+1>=AN(jt->fopf)){RZ(jt->fopa=ext(1,jt->fopa)); RZ(jt->fopf=ext(1,jt->fopf));} *cmd='<';RZ(*(jt->fopn+AAV(jt->fopa) )=ra(cstr(cmd))); RZ(*(jt->fopn+IAV(jt->fopf) )=(I)f1); *cmd='>';RZ(*(jt->fopn+AAV(jt->fopa)+1)=ra(cstr(cmd))); RZ(*(jt->fopn+IAV(jt->fopf)+1)=(I)f2); fa(c); R 1; } /* add 2 entries to jt->fopn table (for hostio); null arg commits entries */ F1(jtjclose){A*av;I*iv,j; RZ(w); if(!AN(w))R w; if(AR(w))R rank1ex(w,0L,0L,jtjclose); RE(j=i0(indexof(jt->fopf,sc(fnum(w))))); ASSERT(j<jt->fopn,EVFNUM); av=AAV(jt->fopa); iv=IAV(jt->fopf); #if (SYS & SYS_DOS+SYS_MACINTOSH) RZ(unlk(iv[j])); #endif if(fclose((F)iv[j]))R jerrno(); --jt->fopn; fa(av[j]); if(j<jt->fopn){av[j]=av[jt->fopn]; iv[j]=iv[jt->fopn];} R one; } /* close file# w */ F jtstdf(J jt,A w){A y;F f;I n,r,t; RZ(w); ASSERT(AN(w),EVLENGTH); ASSERT(!AR(w),EVRANK); if(BOX&AT(w)){ y=AAV0(w); t=AT(y); n=AN(y); r=AR(y); if(t&LIT){ASSERT(1>=r,EVRANK); ASSERT(n,EVLENGTH); R 0;} /*! if(t&C2T){ASSERT(1>=r,EVRANK); ASSERT(n,EVLENGTH); ASSERT(vc1(n,(US*)AV(y)),EVDOMAIN); R 0;} vc1 can now be killed off */ if(t&B01+INT)R stdf(y); ASSERT(0,EVDOMAIN); } f=(F)i0(w); ASSERT(f,EVFNUM); R f; } /* 0 if w is a boxed file name; n if w is integer or boxed integer */