SEXP jri_getSEXPLArray(JNIEnv *env, jarray o) {
SEXP ar;
int l,i=0;
jlong *ap;
profStart();
_dbg(rjprintf(" jarray %d\n",o));
if (!o) return R_NilValue;
l=(int)(*env)->GetArrayLength(env, o);
_dbg(rjprintf("convert SEXPL array of length %d\n",l));
if (l<1) return R_NilValue;
ap=(jlong*)(*env)->GetLongArrayElements(env, o, 0);
if (!ap) {
jri_error("getSEXPLArray: can't fetch array contents");
return 0;
}
PROTECT(ar=allocVector(VECSXP,l));
while (i<l) {
SET_VECTOR_ELT(ar, i, L2SEXP(ap[i]));
i++;
}
UNPROTECT(1);
(*env)->ReleaseLongArrayElements(env, o, ap, 0);
_prof(profReport("jri_getSEXPLArray[%d]:",o));
return ar;
}
/** get contents of the object array in the form of int* */
SEXP jri_getStringArray(JNIEnv *env, jarray o) {
SEXP ar;
int l, i;
const char *c;
profStart();
_dbg(rjprintf(" jarray %d\n",o));
if (!o) return R_NilValue;
l = (int)(*env)->GetArrayLength(env, o);
_dbg(rjprintf("convert string array of length %d\n",l));
PROTECT(ar = allocVector(STRSXP,l));
for (i = 0; i < l; i++) {
jobject sobj = (*env)->GetObjectArrayElement(env, o, i);
c = 0;
if (sobj) {
/* we could (should?) check the type here ...
if (!(*env)->IsInstanceOf(env, sobj, javaStringClass)) {
printf(" not a String\n");
} else
*/
c = (*env)->GetStringUTFChars(env, sobj, 0);
}
if (!c)
SET_STRING_ELT(ar, i, R_NaString); /* this is probably redundant since the vector is pre-filled with NAs, but just in case ... */
else {
SET_STRING_ELT(ar, i, mkCharUTF8(c));
(*env)->ReleaseStringUTFChars(env, sobj, c);
}
}
UNPROTECT(1);
_prof(profReport("RgetStringArrayCont[%d]:",o));
return ar;
}
/** get contents of the boolean array object into a logical R vector */
SEXP jri_getBoolArray(JNIEnv *env, jarray o) {
SEXP ar;
int l;
jboolean *ap;
profStart();
_dbg(rjprintf(" jarray %d\n",o));
if (!o) return R_NilValue;
l=(int)(*env)->GetArrayLength(env, o);
_dbg(rjprintf("convert boolean array of length %d into R bool\n",l));
if (l<1) return R_NilValue;
ap=(jboolean*)(*env)->GetBooleanArrayElements(env, o, 0);
if (!ap) {
jri_error("RgetBoolArrayCont: can't fetch array contents");
return 0;
}
PROTECT(ar=allocVector(LGLSXP,l));
{
int i=0;
int *lgl = LOGICAL(ar);
while (i<l) { lgl[i]=ap[i]?1:0; i++; }
}
UNPROTECT(1);
(*env)->ReleaseBooleanArrayElements(env, o, ap, 0);
_prof(profReport("RgetBoolArrayCont[%d]:",o));
return ar;
}
/** get contents of the object array in the form of list of ext. pointers */
REPC SEXP RgetObjectArrayCont(SEXP e) {
SEXP ar;
jarray o;
int l,i;
JNIEnv *env=getJNIEnv();
profStart();
if (e==R_NilValue) return R_NilValue;
if (TYPEOF(e)==EXTPTRSXP) {
jverify(e);
o=(jobject)EXTPTR_PTR(e);
} else
error("invalid object parameter");
_dbg(rjprintf("RgetObjectArrayCont: jarray %x\n",o));
if (!o) return R_NilValue;
l=(int)(*env)->GetArrayLength(env, o);
_dbg(rjprintf(" convert object array of length %d\n",l));
if (l<1) return R_NilValue;
PROTECT(ar=allocVector(VECSXP,l));
i=0;
while (i<l) {
jobject ae = (*env)->GetObjectArrayElement(env, o, i);
_mp(MEM_PROF_OUT(" %08x LNEW object array element [%d]\n", (int) ae, i))
SET_VECTOR_ELT(ar, i, j2SEXP(env, ae, 1));
i++;
}
UNPROTECT(1);
_prof(profReport("RgetObjectArrayCont[%d]:",o));
return ar;
}
/** get contents of the boolean array object */
REPC SEXP RgetBoolArrayCont(SEXP e) {
SEXP ar;
jarray o;
int l;
jboolean *ap;
JNIEnv *env=getJNIEnv();
profStart();
if (e==R_NilValue) return e;
if (TYPEOF(e)==EXTPTRSXP) {
jverify(e);
o=(jobject)EXTPTR_PTR(e);
} else
error("invalid object parameter");
_dbg(rjprintf("RgetBoolArrayCont: jarray %x\n",o));
if (!o) return R_NilValue;
l=(int)(*env)->GetArrayLength(env, o);
_dbg(rjprintf(" convert bool array of length %d\n",l));
if (l<0) return R_NilValue;
ap=(jboolean*)(*env)->GetBooleanArrayElements(env, o, 0);
if (!ap)
error("cannot obtain boolean array contents");
PROTECT(ar=allocVector(LGLSXP,l));
{ /* jboolean = byte, logical = int, need to convert */
int i = 0;
while (i < l) {
LOGICAL(ar)[i] = ap[i];
i++;
}
}
UNPROTECT(1);
(*env)->ReleaseBooleanArrayElements(env, o, ap, 0);
_prof(profReport("RgetBoolArrayCont[%d]:",o));
return ar;
}
/** get contents of the integer array object */
REPC SEXP RgetIntArrayCont(SEXP e) {
SEXP ar;
jarray o;
int l;
jint *ap;
JNIEnv *env=getJNIEnv();
profStart();
if (e==R_NilValue) return e;
if (TYPEOF(e)==EXTPTRSXP) {
jverify(e);
o=(jobject)EXTPTR_PTR(e);
} else
error("invalid object parameter");
_dbg(rjprintf("RgetIntArrayCont: jarray %x\n",o));
if (!o) return R_NilValue;
l=(int)(*env)->GetArrayLength(env, o);
_dbg(rjprintf(" convert int array of length %d\n",l));
if (l<0) return R_NilValue;
ap=(jint*)(*env)->GetIntArrayElements(env, o, 0);
if (!ap)
error("cannot obtain integer array contents");
PROTECT(ar=allocVector(INTSXP,l));
if (l>0) memcpy(INTEGER(ar),ap,sizeof(jint)*l);
UNPROTECT(1);
(*env)->ReleaseIntArrayElements(env, o, ap, 0);
_prof(profReport("RgetIntArrayCont[%d]:",o));
return ar;
}
/** get contents of the long array object (int) */
REPC SEXP RgetLongArrayCont(SEXP e) {
SEXP ar;
jarray o;
int l;
jlong *ap;
JNIEnv *env=getJNIEnv();
profStart();
if (e==R_NilValue) return e;
if (TYPEOF(e)==EXTPTRSXP) {
jverify(e);
o=(jobject)EXTPTR_PTR(e);
} else
error("invalid object parameter");
_dbg(rjprintf("RgetLongArrayCont: jarray %d\n",o));
if (!o) return R_NilValue;
l=(int)(*env)->GetArrayLength(env, o);
_dbg(rjprintf(" convert long array of length %d\n",l));
if (l<0) return R_NilValue;
ap=(jlong*)(*env)->GetLongArrayElements(env, o, 0);
if (!ap)
error("cannot obtain long contents");
PROTECT(ar=allocVector(REALSXP,l));
{ /* long must be coerced into double .. we use just a cast for each element, bad idea? */
int i=0;
while (i<l) { REAL(ar)[i]=(double)ap[i]; i++; }
}
UNPROTECT(1);
(*env)->ReleaseLongArrayElements(env, o, ap, 0);
_prof(profReport("RgetLongArrayCont[%d]:",o));
return ar;
}
/**
* Get the list of class names of a java object
* This is a jni wrapper around the RJavaTools.getSimpleClassNames method
*/
HIDE jarray getSimpleClassNames( jobject o, jboolean addConditionClasses ){
JNIEnv *env=getJNIEnv();
jarray a ;
profStart();
a = (jarray) (*env)->CallStaticObjectMethod(env,
rj_RJavaTools_Class, mid_rj_getSimpleClassNames,
o, addConditionClasses ) ;
_prof(profReport("getSimpleClassNames[%d]:",o)) ;
return a ;
}
SEXP jri_installString(JNIEnv *env, jstring s) {
SEXP r;
const char *c;
if (!s) return R_NilValue;
profStart();
c=(*env)->GetStringUTFChars(env, s, 0);
if (!c) {
jri_error("jri_getString: can't retrieve string content");
return R_NilValue;
}
r = install(c);
(*env)->ReleaseStringUTFChars(env, s, c);
_prof(profReport("jri_getString:"));
return r;
}
/** jobjRefInt object : string */
SEXP jri_getString(JNIEnv *env, jstring s) {
SEXP r;
const char *c;
if (!s) return ScalarString(R_NaString);
profStart();
c = (*env)->GetStringUTFChars(env, s, 0);
if (!c) {
jri_error("jri_getString: can't retrieve string content");
return R_NilValue;
}
PROTECT(r = allocVector(STRSXP,1));
SET_STRING_ELT(r, 0, mkCharUTF8(c));
UNPROTECT(1);
(*env)->ReleaseStringUTFChars(env, s, c);
_prof(profReport("jri_getString:"));
return r;
}
/* FIXME: this should never be used as 64-bit platforms can't stuff a
pointer in any R type (save for raw which must be interpreted
accordingly) */
SEXP jri_getObjectArray(JNIEnv *env, jarray o) {
SEXP ar;
int l,i;
profStart();
_dbg(rjprintf(" jarray %d\n",o));
if (!o) return R_NilValue;
l=(int)(*env)->GetArrayLength(env, o);
_dbg(rjprintf("convert object array of length %d\n",l));
if (l<1) return R_NilValue;
PROTECT(ar=allocVector(INTSXP,l));
i=0;
while (i < l) { /* to avoid warnings we cast ptr -> ljong -> int
with loss of precision */
INTEGER(ar)[i] = (int)(jlong)(*env)->GetObjectArrayElement(env, o, i);
i++;
}
UNPROTECT(1);
_prof(profReport("RgetObjectArrayCont[%d]:",o));
return ar;
}
/**
* get contents of the String array in the form of STRSXP vector
*
* @param e a pointer to a String[] object
*
* @return a STRSXP vector mirroring the java array
*/
HIDE SEXP getStringArrayCont(jarray o) {
SEXP ar;
int l,i;
const char *c;
JNIEnv *env=getJNIEnv();
profStart();
_dbg(rjprintf("RgetStringArrayCont: jarray %x\n",o));
if (!o) return R_NilValue;
l=(int)(*env)->GetArrayLength(env, o);
_dbg(rjprintf(" convert string array of length %d\n",l));
if (l<0) return R_NilValue;
PROTECT(ar=allocVector(STRSXP,l));
i=0;
while (i<l) {
jobject sobj=(*env)->GetObjectArrayElement(env, o, i);
_mp(MEM_PROF_OUT(" %08x LNEW object array element [%d]\n", (int) sobj, i))
c=0;
if (sobj) {
/* we could (should?) check the type here ...
if (!(*env)->IsInstanceOf(env, sobj, javaStringClass)) {
printf(" not a String\n");
} else
*/
c=(*env)->GetStringUTFChars(env, sobj, 0);
}
if (!c)
SET_STRING_ELT(ar, i, R_NaString);
else {
SET_STRING_ELT(ar, i, mkCharUTF8(c));
(*env)->ReleaseStringUTFChars(env, sobj, c);
}
if (sobj) releaseObject(env, sobj);
i++;
}
UNPROTECT(1);
_prof(profReport("RgetStringArrayCont[%d]:",o))
return ar;
}
/** get contents of the integer array object (int) */
SEXP jri_getByteArray(JNIEnv *env, jarray o) {
SEXP ar;
int l;
jbyte *ap;
profStart();
_dbg(rjprintf(" jarray %d\n",o));
if (!o) return R_NilValue;
l = (int)(*env)->GetArrayLength(env, o);
_dbg(rjprintf("convert byte array of length %d\n",l));
if (l < 1) return R_NilValue;
ap = (jbyte*)(*env)->GetByteArrayElements(env, o, 0);
if (!ap) {
jri_error("jri_getByteArray: can't fetch array contents");
return 0;
}
ar = allocVector(RAWSXP, l);
memcpy(RAW(ar), ap, l);
(*env)->ReleaseByteArrayElements(env, o, ap, 0);
_prof(profReport("RgetByteArrayCont[%d]:",o));
return ar;
}
/** get contents of the double array object (int) */
SEXP jri_getDoubleArray(JNIEnv *env, jarray o) {
SEXP ar;
int l;
jdouble *ap;
profStart();
_dbg(rjprintf(" jarray %d\n",o));
if (!o) return R_NilValue;
l=(int)(*env)->GetArrayLength(env, o);
_dbg(rjprintf("convert double array of length %d\n",l));
if (l<1) return R_NilValue;
ap=(jdouble*)(*env)->GetDoubleArrayElements(env, o, 0);
if (!ap) {
jri_error("RgetDoubleArrayCont: can't fetch array contents");
return 0;
}
PROTECT(ar=allocVector(REALSXP,l));
memcpy(REAL(ar),ap,sizeof(jdouble)*l);
UNPROTECT(1);
(*env)->ReleaseDoubleArrayElements(env, o, ap, 0);
_prof(profReport("RgetDoubleArrayCont[%d]:",o));
return ar;
}
/** get contents of the integer array object (int) into a logical R vector */
SEXP jri_getBoolArrayI(JNIEnv *env, jarray o) {
SEXP ar;
int l;
jint *ap;
profStart();
_dbg(rjprintf(" jarray %d\n",o));
if (!o) return R_NilValue;
l=(int)(*env)->GetArrayLength(env, o);
_dbg(rjprintf("convert int array of length %d into R bool\n",l));
if (l<1) return R_NilValue;
ap=(jint*)(*env)->GetIntArrayElements(env, o, 0);
if (!ap) {
jri_error("RgetBoolArrayICont: can't fetch array contents");
return 0;
}
PROTECT(ar=allocVector(LGLSXP,l));
memcpy(LOGICAL(ar),ap,sizeof(jint)*l);
UNPROTECT(1);
(*env)->ReleaseIntArrayElements(env, o, ap, 0);
_prof(profReport("RgetBoolArrayICont[%d]:",o));
return ar;
}
void loop() {
#ifdef UPLOAD_FEATURE
uploadWorks();
#endif
if (modeWork == MODE_SERVER) {
#ifdef RTC_FEATURE
rtcWorks();
#endif
//prof works
profStart();
timersWorks();
#ifdef SERVER_FEATURE
serverWorks();
#endif
#ifdef KEYS_FEATURE
keysWorks();
#endif
#ifdef PIRS_FEATURE
pirsWorks();
#endif
#ifdef CONTACTS_FEATURE
contactsWorks();
#endif
#ifdef TEMP_FEATURE
if (cycle5m || (timeSec < startSendTime)) {
tempWorks();
}
#endif
#ifdef ELECTRO_FEATURE
if (modulElectro == 1) {
if (cycle20s || (timeSec < startSendTime)) {
electroWorks();
freqWorks();
}
// network oscilloscope
if (cycle1s && oscill) {
freqWorks();
}
}
#endif
#ifdef MAJORDOMO_FEATURE
majordomoMegaLive();
#endif
#ifdef SD_FILES_FEATURE
if (cycle30s) {
//printSdContent(sdRoot, 0);
//cardInfo();
//Serial.println("Root SD card:");
//printDirectory(sdDir);
//Serial.println("/js/");
//sdDir = SD.open("/js/");
//printDirectory(sdDir);
}
#endif
#ifdef PING_FEATURE
if (cycle30s) {
pingWorks();
}
#endif
#ifdef LAURENT_FEATURE
if (cycle3m) {
sprintf(buf, "$KE");
sendLaurentRequest();
}
#endif
cyclos++;
cyclosInSecWork();
// end loop works
eraseCyclos();
profCalc();
cyclosDelayWork();
} // if (modeWork == MODE_SERVER)
} // loop
