コード例 #1
0
ファイル: d.c プロジェクト: zeotrope/j7-src
static void susp(void){I old=tbase+ttop;C*sp;
 suspend=debugb;
 scad=0;
 while(suspend){
  immex(jgets("      ")); jerr=0;
  tpop(old);
 }
 suspend=debugb;
}
コード例 #2
0
ファイル: jdll.c プロジェクト: PlanetAPL/j-language
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;
}
コード例 #3
0
ファイル: cx.c プロジェクト: zeotrope/j7-src
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);
}
コード例 #4
0
ファイル: jdll.c プロジェクト: PlanetAPL/j-language
//! 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;
}