/* ------------------ L2int ------------------- */
void __CDECL
L2int( const PLstr s )
{
if (LTYPE(*s)==LREAL_TY) {
if ((double)((long)LREAL(*s)) == LREAL(*s))
LINT(*s) = (long)LREAL(*s);
else
Lerror(ERR_INVALID_INTEGER,0);
} else { /* LSTRING_TY */
LASCIIZ(*s);
switch (_Lisnum(s)) {
case LINTEGER_TY:
LINT(*s) = (long)lLastScannedNumber;
break;
case LREAL_TY:
LREAL(*s) = lLastScannedNumber;
if ((double)((long)LREAL(*s)) == LREAL(*s))
LINT(*s) = (long)LREAL(*s);
else
Lerror(ERR_INVALID_INTEGER,0);
break;
default:
Lerror(ERR_INVALID_INTEGER,0);
}
}
LTYPE(*s) = LINTEGER_TY;
LLEN(*s) = sizeof(long);
} /* L2int */
/* ----------------- Lrdint ------------------ */
long __CDECL
Lrdint( const PLstr s )
{
if (LTYPE(*s)==LINTEGER_TY) return LINT(*s);
if (LTYPE(*s)==LREAL_TY) {
if ((double)((long)LREAL(*s)) == LREAL(*s))
return (long)LREAL(*s);
else
Lerror(ERR_INVALID_INTEGER,0);
} else { /* LSTRING_TY */
LASCIIZ(*s);
switch (_Lisnum(s)) {
case LINTEGER_TY:
/*///return atol( LSTR(*s) ); */
return (long)lLastScannedNumber;
case LREAL_TY:
/*///d = strtod( LSTR(*s), NULL );
//////if ((double)((long)d) == d)
////// return (long)d; */
if ((double)((long)lLastScannedNumber) == lLastScannedNumber)
return (long)lLastScannedNumber;
else
Lerror(ERR_INVALID_INTEGER,0);
break;
default:
Lerror(ERR_INVALID_INTEGER,0);
}
}
return 0; /* never gets here but keeps compiler happy */
} /* Lrdint */
/* --------------------------------------------------------------- */
void R_sqlreset( const int func )
{
if (ARGN!=0) Lerror(ERR_INCORRECT_CALL,0);
if (!sqldb) Lerror(ERR_DATABASE,1);
if (!sqlstmt) Lerror(ERR_DATABASE,0);
Licpy(ARGR, sqlite3_reset(sqlstmt));
} /* R_sqlreset */
/* --------------------------------------------------------------- */
void R_sql( const int func )
{
int rc;
const char *tail;
if (ARGN!=1) Lerror(ERR_INCORRECT_CALL,0);
get_s(1);
if (!sqldb) Lerror(ERR_DATABASE,1);
if (sqlstmt) {
sqlite3_finalize(sqlstmt);
sqlstmt = NULL;
}
Licpy(ARGR, sqlite3_prepare_v2(sqldb, LSTR(*ARG1), LLEN(*ARG1), &sqlstmt, &tail));
if (LINT(*ARGR) == SQLITE_OK) {
if (sqlite3_bind_parameter_count(sqlstmt)==0) {
rc = sqlite3_step(sqlstmt);
if (rc == SQLITE_ROW)
Lscpy(ARGR, "ROW");
else
if (rc == SQLITE_DONE)
Licpy(ARGR, SQLITE_OK);
else
Licpy(ARGR, rc);
}
}
} /* R_sql */
/* --------------------------------------------------------------- */
void R_sqlstep( const int func )
{
int rc;
if (ARGN!=0) Lerror(ERR_INCORRECT_CALL,0);
if (!sqldb) Lerror(ERR_DATABASE,1);
if (!sqlstmt) Lerror(ERR_DATABASE,0);
rc = sqlite3_step(sqlstmt);
if (rc == SQLITE_ROW)
Lscpy(ARGR, "ROW");
else
if (rc == SQLITE_DONE)
Lscpy(ARGR, "DONE");
else
Licpy(ARGR, rc);
} /* R_sqlstep */
/* we should change the string */
void __CDECL
_L2num( const PLstr s, const int type )
{
LASCIIZ(*s);
switch (type) {
case LINTEGER_TY:
/*////LINT(*s) = atol( LSTR(*s) ); */
LINT(*s) = (long)lLastScannedNumber;
LTYPE(*s) = LINTEGER_TY;
LLEN(*s) = sizeof(long);
break;
case LREAL_TY:
/*////LREAL(*s) = strtod( LSTR(*s), NULL ); */
LREAL(*s) = lLastScannedNumber;
if ((double)((long)LREAL(*s)) == LREAL(*s)) {
LINT(*s) = (long)LREAL(*s);
LTYPE(*s) = LINTEGER_TY;
LLEN(*s) = sizeof(long);
} else {
LTYPE(*s) = LREAL_TY;
LLEN(*s) = sizeof(double);
}
break;
default:
Lerror(ERR_BAD_ARITHMETIC,0);
}
} /* _L2num */
/* ------------------ L2num ------------------- */
void __CDECL
L2num( const PLstr s )
{
switch (_Lisnum(s)) {
case LINTEGER_TY:
/*//LINT(*s) = atol( LSTR(*s) ); */
LINT(*s) = (long)lLastScannedNumber;
LTYPE(*s) = LINTEGER_TY;
LLEN(*s) = sizeof(long);
break;
case LREAL_TY:
/*///LREAL(*s) = strtod( LSTR(*s), NULL ); */
LREAL(*s) = lLastScannedNumber;
/*
//// Numbers like 2.0 should be treated as real and not as integer
//// because in cases like factorial while give an error result
//// if ((double)((long)LREAL(*s)) == LREAL(*s)) {
//// LINT(*s) = (long)LREAL(*s);
//// LTYPE(*s) = LINTEGER_TY;
//// LLEN(*s) = sizeof(long);
//// } else {
*/
LTYPE(*s) = LREAL_TY;
LLEN(*s) = sizeof(double);
/*
//// }
*/
break;
default:
Lerror(ERR_BAD_ARITHMETIC,0);
}
} /* L2num */
/* --------------------------------------------------------------- */
void R_sqlclose( const int func )
{
if (ARGN) Lerror(ERR_INCORRECT_CALL,0);
Licpy(ARGR,0);
if (sqlstmt) Licpy(ARGR, sqlite3_finalize(sqlstmt));
if (sqldb) Licpy(ARGR, sqlite3_close(sqldb));
sqldb = NULL;
sqlstmt = NULL;
} /* R_sqlclose */
/* ------------------ Lmod ----------------- */
void __CDECL
Lmod( const PLstr to, const PLstr A, const PLstr B )
{
L2REAL(A);
L2REAL(B);
if (LREAL(*B) == 0) Lerror(ERR_ARITH_OVERFLOW,0);
LREAL(*to) = (double) (LREAL(*A) - (long)(LREAL(*A) / LREAL(*B)) * LREAL(*B));
LTYPE(*to) = LREAL_TY;
LLEN(*to) = sizeof(double);
} /* Lmod */
/* ---------------- Lintdiv ---------------- */
void __CDECL
Lintdiv( const PLstr to, const PLstr A, const PLstr B )
{
double b;
b = Lrdreal(B);
if (b == 0) Lerror(ERR_ARITH_OVERFLOW,0);
LINT(*to) = (long) (Lrdreal(A) / b);
LTYPE(*to) = LINTEGER_TY;
LLEN(*to) = sizeof(long);
} /* Lintdiv */
/* --------------------------------------------------------------- */
void R_sqlopen( const int func )
{
const char *filename;
if (ARGN!=1) Lerror(ERR_INCORRECT_CALL,0);
get_s(1); LASCIIZ(*ARG1);
filename = LSTR(*ARG1);
if (sqldb!=NULL) sqlite3_close(sqldb);
Licpy(ARGR, sqlite3_open(LSTR(*ARG1), &sqldb));
sqlstmt = NULL;
} /* R_sqliteopen */
/* ------------------ L2real ------------------- */
void __CDECL
L2real( const PLstr s )
{
if (LTYPE(*s)==LINTEGER_TY)
LREAL(*s) = (double)LINT(*s);
else { /* LSTRING_TY */
LASCIIZ(*s);
if (_Lisnum(s)!=LSTRING_TY)
/*/////LREAL(*s) = strtod( LSTR(*s), NULL ); */
LREAL(*s) = lLastScannedNumber;
else
Lerror(ERR_BAD_ARITHMETIC,0);
}
LTYPE(*s) = LREAL_TY;
LLEN(*s) = sizeof(double);
} /* L2real */
/* --------------------------------------------------------------- */
void R_sqlget( const int func )
{
int col, bytes;
if (ARGN==0) {
Licpy(ARGR, sqlite3_column_count(sqlstmt));
return;
}
if (ARGN>1) Lerror(ERR_INCORRECT_CALL,0);
get_i0(1,col);
col--;
switch (sqlite3_column_type(sqlstmt, col)) {
case SQLITE_INTEGER:
Licpy(ARGR, sqlite3_column_int(sqlstmt, col));
break;
case SQLITE_FLOAT:
Lrcpy(ARGR, sqlite3_column_double(sqlstmt, col));
break;
case SQLITE_TEXT:
Lscpy(ARGR, (char*)sqlite3_column_text(sqlstmt, col));
break;
case SQLITE_BLOB:
bytes = sqlite3_column_bytes(sqlstmt, col);
Lfx(ARGR, bytes);
LLEN(*ARGR) = bytes;
LTYPE(*ARGR) = LSTRING_TY;
MEMCPY(LSTR(*ARGR), sqlite3_column_blob(sqlstmt, col), bytes);
break;
case SQLITE_NULL:
Lfx(ARGR,1);
LTYPE(*ARGR) = LSTRING_TY;
LLEN(*ARGR) = 1;
LSTR(*ARGR)[0] = 0;
break;
default:
Lfx(ARGR,0);
LTYPE(*ARGR) = LSTRING_TY;
LLEN(*ARGR) = 0;
}
} /* R_sqlget */
/* ----------------- Lrdreal ------------------ */
double __CDECL
Lrdreal( const PLstr s )
{
if (LTYPE(*s)==LREAL_TY) return LREAL(*s);
if (LTYPE(*s)==LINTEGER_TY)
return (double)LINT(*s);
else { /* LSTRING_TY */
LASCIIZ(*s);
if (_Lisnum(s)!=LSTRING_TY)
/*///// return strtod( LSTR(*s), NULL ); */
return lLastScannedNumber;
else
Lerror(ERR_BAD_ARITHMETIC,0);
}
return 0.0;
} /* Lrdreal */
dynamic *b_get_()
#endif
#define LRoutine "Lvarget"
{
#ifdef Debug
Ldebug -= 1; /* Diminish Debug Level */
if (Ldebug >= 0) printf("\n Entering Routine %s",LRoutine);
#endif
#ifdef Debug
if (Ldebug >= 0) {
printf("\n (Lvarget 78) assigning : %d\n",next);
}
#endif
if (next >= numvar-1) {
Lerror(ALLOC); /* Error Message */
}
else {
next++;
EXIT(&(LhV[next])); /* Return address of next free variable */
}
EXIT(NULL); /* Return NULL if no variable available */
}
/* ---------------- TraceSet -------------------- */
void __CDECL
TraceSet( PLstr trstr )
{
unsigned char *ch;
L2STR(trstr);
Lupper(trstr);
LASCIIZ(*trstr);
ch = LSTR(*trstr);
if (*ch=='!') {
ch++;
} else
if (*ch=='?') {
_proc[_rx_proc].interactive_trace
= 1 - _proc[_rx_proc].interactive_trace;
if (_proc[_rx_proc].interactive_trace)
#ifndef WIN
fprintf(STDERR," +++ %s +++\n",errortext[2].errormsg);
#else
PUTS(" +++ ");
PUTS(errortext[0].errormsg);
PUTS(" +++\n");
#endif
ch++;
}
switch (*ch) {
case 'A':
_proc[_rx_proc].trace = all_trace;
break;
case 'C':
_proc[_rx_proc].trace = commands_trace;
break;
case 'E':
_proc[_rx_proc].trace = error_trace;
break;
/*
/// case 'F':
/// _proc[_rx_proc].trace = ;
/// break;
*/
case 'I':
_proc[_rx_proc].trace = intermediates_trace;
break;
case 'L':
_proc[_rx_proc].trace = labels_trace;
break;
case 'N':
_proc[_rx_proc].trace = normal_trace;
break;
case 'O':
_proc[_rx_proc].trace = off_trace;
_proc[_rx_proc].interactive_trace = FALSE;
break;
case 'R':
_proc[_rx_proc].trace = results_trace;
break;
case 'S':
_proc[_rx_proc].trace = scan_trace;
break;
#ifdef __DEBUG__
case 'D':
__debug__ = 1-__debug__;
if (__debug__)
printf("\n\nInternal DEBUG starting...\n");
else
printf("\n\nInternal DEBUG ended\n");
break;
#endif
default:
Lerror(ERR_INVALID_TRACE,1,trstr);
}
} /* TraceSet */
/* --------------------------------------------------------------- */
void R_sqlbind( const int func )
{
int col, i;
double d;
char type;
if (!sqldb) Lerror(ERR_DATABASE,1);
if (!sqlstmt) Lerror(ERR_DATABASE,0);
if (ARGN==0) {
Licpy(ARGR, sqlite3_bind_parameter_count(sqlstmt));
return;
}
if (ARGN!=3) Lerror(ERR_INCORRECT_CALL,0);
if (Ldatatype(ARG1,'N'))
col = Lrdint(ARG1);
else {
LASCIIZ(*ARG1);
col = sqlite3_bind_parameter_index(sqlstmt, LSTR(*ARG1));
}
get_pad(2, type);
switch (type) {
case 'b': case 'B': /* blob */
Licpy(ARGR, sqlite3_bind_blob(sqlstmt, col,
LSTR(*ARG3), LLEN(*ARG3), SQLITE_TRANSIENT));
break;
case 'i': case 'I': /* integer */
get_i(3, i);
Licpy(ARGR, sqlite3_bind_int(sqlstmt, col, i));
break;
case 'd': case 'D': /* double */
case 'f': case 'F':
L2REAL(ARG3);
Licpy(ARGR, sqlite3_bind_double(sqlstmt, col, LREAL(*ARG3)));
break;
case 's': case 'S': /* double */
case 't': case 'T':
L2STR(ARG3);
Licpy(ARGR, sqlite3_bind_text(sqlstmt, col,
LSTR(*ARG3), LLEN(*ARG3), SQLITE_TRANSIENT));
break;
case 'n': case 'N': /* null */
Licpy(ARGR, sqlite3_bind_null(sqlstmt, col));
break;
case 'z': case 'Z': /* zero blob */
get_i(3, i);
Licpy(ARGR, sqlite3_bind_zeroblob(sqlstmt, col, i));
break;
default:
Lerror(ERR_INCORRECT_CALL,0);
}
} /* R_sqlbind */