static void susp(void){I old=tbase+ttop;C*sp; suspend=debugb; scad=0; while(suspend){ immex(jgets(" ")); jerr=0; tpop(old); } suspend=debugb; }
int jget(J jt, C* name, VARIANT* v, int dobstr) { A a; char gn[256]; I old; int er; if(strlen(name) >= sizeof(gn)) return EVILNAME; if(valid(name, gn)) return EVILNAME; RZ(a=symbrd(nfs(strlen(gn),gn))); old = jt->tnextpushx; er = a2v (jt, a, v, dobstr); tpop (old); return er; }
static DF2(xd){PROLOG;DECLFG;A f,*line,loc=local,name,seq,z=0;B b;DC dv; I i=0,n,old; b=a&&w; f=*(b+AAV(sv->h)); line=AAV(f); n=nline=AN(f); ASSERT(n,EVDOMAIN); GA(local,SYMB,twprimes[0],1,0); symbis(scnm(CALPHA),a,local); symbis(scnm(COMEGA),w,local); RZ(dv=debadd(DCDEFN)); dv->p=sv->s; drun=0; old=tbase+ttop; ra(self); for(;0<=i&&i<n;i++){ tpop(old); dv->ln=i; dv->n=1+(0!=a); z=parse(ca(line[i])); if(!debugb&&!z) break; } if(debugb&&!z){z=tpush(qpopres); qpopres=0;} z=car(z); ++AC(local); fa(local); local=loc; asgn=0; fa(self); debz(); if(!z) jsignal(EVRESULT); EPILOG(z); }
//! 64 bit problems - com and dll interface is 32 bit - needs test and thought static int a2v (J jt, A a, VARIANT *v, int dobstrs) { SAFEARRAY FAR* psa; SAFEARRAYBOUND rgsabound[MAXRANK]; int er; I i,r,k,kw,t,cb,*pi; VARTYPE vt; k=AN(a); pi=AV(a); r=AR(a); t=NOUN&AT(a); if(r>MAXRANK) return EVRANK; if(dobstrs && r<2 && (t&LIT+C2T+C4T)) // char scalar or vector returned as BSTR { WCHAR *wstr; BSTR bstr; if (LIT&t) { wstr = malloc(sizeof(WCHAR)*k); kw=tounin((C*)pi, k, wstr, k); bstr = SysAllocStringLen(wstr, (UINT)kw); } else if (C4T&t) { kw=utowsize((C4*)pi, k); kw=(kw<0)?(-kw):kw; wstr = malloc(sizeof(WCHAR)*kw); utow((C4*)pi, k, wstr); bstr = SysAllocStringLen(wstr, (UINT)kw); } else bstr = SysAllocStringLen((WCHAR*)pi, (UINT)k); v->vt=VT_BSTR; v->bstrVal=bstr; if (t&LIT+C4T) free(wstr); R 0; } switch(t) { case LIT: if(!r) {v->vt=VT_UI1; v->bVal = *(C*)pi; return 0;} vt=VT_UI1; cb=k*sizeof(char); break; case C2T: if(!r) {v->vt=VT_UI2; v->iVal = *(WCHAR*)pi; return 0;} vt=VT_UI2; cb=k*sizeof(WCHAR); break; case C4T: if(!r) {v->vt=VT_UI4; v->iVal = *(UI4*)pi; return 0;} vt=VT_UI4; cb=k*sizeof(C4); break; case B01: if(!r) { v->vt=VT_BOOL; v->boolVal = *(B*)pi ? VARIANT_TRUE : VARIANT_FALSE; return 0; } vt=VT_BOOL; break; case INT: #if SY_64 if(jt->int64flag) { if(!r) {v->vt=VT_I8; v->llVal = (I)(*pi); return 0;} vt=VT_I8; cb=k*sizeof(long long); } else { if(!r) {v->vt=VT_I4; v->lVal = (int)(*pi); return 0;} vt=VT_I4; cb=k*sizeof(int); } #else if(!r) {v->vt=VT_I4; v->lVal = (I)(*pi); return 0;} vt=VT_I4; cb=k*sizeof(int); #endif break; case FL: if(!r) {v->vt=VT_R8; v->dblVal = *(D*)pi; return 0;} vt=VT_R8; cb=k*sizeof(double); break; case BOX: if(!r) { // Pass a scalar box as a 1-elem VARIANT VT_ARRAY. // It's marked as such by a lower bound set at -1. // (All "true" boxed arrays will have the usual lb 0.) rgsabound[0].lLbound = -1; rgsabound[0].cElements = 1; if ( ! (psa = SafeArrayCreate (VT_VARIANT, 1, rgsabound))) return EVWSFULL; if (0!= (er = a2v (jt, *(A*)pi, (VARIANT*)psa->pvData, dobstrs))) { SafeArrayDestroy (psa); return er; } v->vt=VT_ARRAY|VT_VARIANT; v->parray = psa; return 0; } vt=VT_VARIANT; cb=k*sizeof(A); break; default: return EVDOMAIN; } if(1<r && jt->transposeflag) RE(a=cant1(a)); // undo shape reversal later! for(i=0; i<r; ++i) { rgsabound[i].lLbound = 0; // undo shape reversal from cant1() here. // In case of Transpose(0), the shape is // still passed in Column-major notation. rgsabound[i].cElements = (ULONG)AS(a)[r-1-i]; } psa = SafeArrayCreate(vt, (UINT)r, rgsabound); if(!psa) { return EVWSFULL; } switch (NOUN&AT(a)) { case B01: { VARIANT_BOOL *pv = (VARIANT_BOOL*) psa->pvData; B *ap = BAV(a); while (k--) *pv++ = *ap++ ? VARIANT_TRUE : VARIANT_FALSE; break; } case BOX: { A* ap; VARIANT *v; for (ap=AAV(a), SafeArrayAccessData(psa, &v); ap<AAV(a)+k; ++ap, ++v) { PROLOG(0118); er=a2v (jt, *ap, v, dobstrs); tpop(_ttop); if (er!=0) { SafeArrayUnaccessData (psa); SafeArrayDestroy (psa); return er; } } SafeArrayUnaccessData (psa); break; } #if SY_64 case INT: { if (!jt->int64flag) { long *p1=psa->pvData; I *p2=AV(a); while (k--) *p1++=(long)*p2++; } break; } #endif default: memcpy(psa->pvData, AV(a), cb); } v->vt=VT_ARRAY|vt; v->parray = psa; return 0; }