Mercurial > hg > jgplsrc
diff i.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/i.c @@ -0,0 +1,169 @@ +/* Copyright 1990-2011, Jsoftware Inc. All rights reserved. */ +/* License in license.txt. */ +/* */ +/* Initializations */ + +#include "j.h" +#include "w.h" + +#if SYS & SYS_FREEBSD +#include <floatingpoint.h> +#endif + +J gjt=0; // JPF debug + +void startup(void); + +static A jtmakename(J jt,C*s){A z;I m;NM*zv; + m=strlen(s); + GA(z,NAME,m,1,0); zv=NAV(z); + memcpy(zv->s,s,m); *(m+zv->s)=0; + zv->m =(UC)m; + zv->sn =0; + zv->e =0; + zv->flag=NMDOT; + zv->hash=NMHASH(m,s); + ACX(z); + R z; +} + +B jtglobinit(J jt){A x,y;C*s;D*d;I j;UC c,k; + liln=1&&SYS&SYS_LILENDIAN; + jt->adbreak=&breakdata; /* required for ma to work */ + meminit(); /* required for ma to work */ + jt->parsercalls=0; + s=bitdisp; + DO(256, c=(UC)i; DO(BB, *s++=c&(UC)128?'1':'0'; *s++=' '; c<<=1;); ); + DO(16, c=(UC)i; k=0; DO(BB, if(c&(UC)1)++k; c>>=1;); bitc[i]=k;); + DO(15, j=1+i; DO(16, bitc[16*j+i]=bitc[j]+bitc[i];);); + MC(&inf, XINF,SZD); + MC(&jnan,XNAN,SZD); + infm=-inf; + memset(testb,C0,256); + testb[CIF]=testb[CELSEIF]=testb[CSELECT]=testb[CWHILE]=testb[CWHILST]=testb[CFOR]=testb[CCASE]=testb[CFCASE]=1; + num=9+numv; + DO(9, GA(x,INT,1,0,0); ACX(x); * AV(x)=i-9; num[i-9] =x;); + DO(8, GA(x,INT,1,0,0); ACX(x); * AV(x)=i+2; num[i+2] =x;); + GA(x,B01, 1,0,0 ); ACX(x); *BAV(x)=0; num[0]=zero=x; + GA(x,B01, 1,0,0 ); ACX(x); *BAV(x)=1; num[1]=one =x; + memset(chr,C0,256*SZI); + GA(x,LIT, 1,0,0 ); ACX(x); *CAV(x)=' '; chr[' ' ]=x; + GA(x,LIT, 1,0,0 ); ACX(x); *CAV(x)=':'; chr[':' ]=x; + GA(x,LIT, 1,0,0 ); ACX(x); *CAV(x)='/'; chr['/' ]=x; + GA(x,LIT, 1,0,0 ); ACX(x); *CAV(x)='\\'; chr['\\' ]=x; + GA(x,LIT, 1,0,0 ); ACX(x); *CAV(x)=CQUOTE; chr[CQUOTE]=x; + GA(x,B01, 0,1,0 ); ACX(x); mtv =x; + GA(x,LIT, 0,1,0 ); ACX(x); aqq =x; + GA(x,INT, 1,1,0 ); ACX(x); * AV(x)=0; iv0=xzero =x; + GA(x,INT, 1,1,0 ); ACX(x); * AV(x)=1; iv1=xone =x; + GA(x,FL, 1,0,0 ); ACX(x); *DAV(x)=inf; ainf =x; + GA(x,FL, 1,0,0 ); ACX(x); *DAV(x)=PI; pie =x; + GA(x,MARK,1,0,0 ); ACX(x); * AV(x)=0; mark =x; + GA(x,B01, 0,2,&zeroZ); ACX(x); mtm =x; + GA(x,CMPX,1,0,0 ); ACX(x); d=DAV(x); *d=0; *(1+d)=1; a0j1 =x; + RZ(y=str(1L,"z")); ACX(y); + GA(x,BOX, 1,1,0 ); ACX(x); *AAV(x)=y; zpath =x; + RZ(mnam=makename("m")); RZ(mdot=makename("m.")); + RZ(nnam=makename("n")); RZ(ndot=makename("n.")); + RZ(unam=makename("u")); RZ(udot=makename("u.")); + RZ(vnam=makename("v")); RZ(vdot=makename("v.")); + RZ(xnam=makename("x")); RZ(xdot=makename("x.")); + RZ(ynam=makename("y")); RZ(ydot=makename("y.")); + zeroQ.n =xzero; zeroQ.d =xone; + zeroDX.e=0; zeroDX.x=xzero; + memset(minus0,C0,8L); minus0[SYS&SYS_LILENDIAN?7:0]='\200'; + pf=qpf(); + pinit(); + R 1; +} /* called once when dll is loaded to create global constants */ + +static B jtevinit(J jt){A q,*v; + GA(q,BOX,1+NEVM,1,0); v=AAV(q); + DO(AN(q), v[i]=mtv;); + v[EVALLOC ]=cstr("allocation error" ); + v[EVASSERT ]=cstr("assertion failure" ); + v[EVATTN ]=cstr("attention interrupt" ); + v[EVBREAK ]=cstr("break" ); + v[EVCTRL ]=cstr("control error" ); + v[EVDOMAIN ]=cstr("domain error" ); + v[EVFACCESS]=cstr("file access error" ); + v[EVFNAME ]=cstr("file name error" ); + v[EVFNUM ]=cstr("file number error" ); + v[EVILNAME ]=cstr("ill-formed name" ); + v[EVILNUM ]=cstr("ill-formed number" ); + v[EVINDEX ]=cstr("index error" ); + v[EVINPRUPT]=cstr("input interrupt" ); + v[EVFACE ]=cstr("interface error" ); + v[EVLENGTH ]=cstr("length error" ); + v[EVLIMIT ]=cstr("limit error" ); + v[EVLOCALE ]=cstr("locale error" ); + v[EVNAN ]=cstr("NaN error" ); + v[EVNONCE ]=cstr("nonce error" ); + v[EVSPARSE ]=cstr("non-unique sparse elements" ); + v[EVOPENQ ]=cstr("open quote" ); + v[EVWSFULL ]=cstr("out of memory" ); + v[EVRANK ]=cstr("rank error" ); + v[EVRO ]=cstr("read-only data" ); + v[EVSECURE ]=cstr("security violation" ); + v[EVSPELL ]=cstr("spelling error" ); + v[EVSTACK ]=cstr("stack error" ); + v[EVSTOP ]=cstr("stop" ); + v[EVSYNTAX ]=cstr("syntax error" ); + v[EVSYSTEM ]=cstr("system error" ); + v[EVTIME ]=cstr("time limit" ); + v[EVVALUE ]=cstr("value error" ); + ra(q); jt->evm=q; + if(jt->jerr){printf("evinit failed; error %hhi\n", jt->jerr); R 0;} else R 1; +} + +/* static void sigflpe(int k){jsignal(EVDOMAIN); signal(SIGFPE,sigflpe);} */ + +static B jtconsinit(J jt){D y; + jt->assert=1; + RZ(jt->bxa=cstr("+++++++++|-")); jt->bx=CAV(jt->bxa); + y=1.0; DO(44, y*=0.5;); jt->ct=jt->fuzz=y; + jt->disp[0]=1; jt->disp[1]=5; + jt->fcalln=NFCALL; + jt->fdepn=NFDEP; + jt->outmaxafter=222; + jt->outmaxlen=256; + strcpy(jt->outseq,"\x0a"); + strcpy(jt->pp,"%0.6g"); + jt->retcomm=1; + jt->tostdout=1; + jt->transposeflag=1; + jt->xmode=XMEXACT; + R 1; +} + +static C jtjinit3(J jt){S t; +/* required for jdll and doesn't hurt others */ + gjt=jt; // global jt for JPF debug +#if (SYS & SYS_DOS) + t=EM_ZERODIVIDE+EM_INVALID; _controlfp(t,t); +#endif +#if (SYS & SYS_OS2) + t=EM_ZERODIVIDE+EM_INVALID+EM_OVERFLOW+EM_UNDERFLOW; _control87(t,t); +#endif +#if (SYS & SYS_FREEBSD) + fpsetmask(0); +#endif + jt->tssbase=tod(); + meminit(); + sesminit(); + evinit(); + consinit(); + symbinit(); + parseinit(); + xoinit(); + xsinit(); + sbtypeinit(); + rnginit(); +#if (SYS & SYS_DOS+SYS_MACINTOSH) + xlinit(); +#endif + jtecvtinit(jt); + R !jt->jerr; +} + +C jtjinit2(J jt,int dummy0,C**dummy1){jt->sesm=1; R jinit3();}