The R Project SVN R

Rev

Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
31421 ripley 1 
/*
2 
 *  RProxy: Connector implementation between application and R language
3 
 *  Copyright (C) 1999--2001 Thomas Baier
4 
 *
5 
 *  R_Proxy_init based on rtest.c,  Copyright (C) 1998--2000
6 
 *                                  R Development Core Team
7 
 *
8 
 *
9 
 *  This library is free software; you can redistribute it and/or
10 
 *  modify it under the terms of the GNU Library General Public
11 
 *  License as published by the Free Software Foundation; either
12 
 *  version 2 of the License, or (at your option) any later version.
13 
 *
14 
 *  This library is distributed in the hope that it will be useful,
15 
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
16 
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
17 
 *  Library General Public License for more details.
18 
 *
19 
 *  You should have received a copy of the GNU Library General Public
20 
 *  License along with this library; if not, write to the Free
21 
 *  Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
22 
 *  MA 02111-1307, USA
23 
 *
24 
 *  $Id: rproxy_impl.c,v 1.24 2004/06/09 13:35:32 ripley Exp $
25 
 */
26 
 
27 
#define NONAMELESSUNION
28 
#include <windows.h>
29 
#include <assert.h>
30 
#include <stdio.h>
31 
#include <stdlib.h>
32 
/*#include "globalvar.h"
33 
#undef CharacterMode
34 
#undef R_Interactive*/
35 
#include <config.h>
36 
#include <Rversion.h>
37 
#include <Startup.h>
38 
#include "bdx.h"
39 
#include "SC_proxy.h"
40 
#include "rproxy_impl.h"
41 
#include <IOStuff.h>
42 
#include <Parse.h>
43 
#include <Graphics.h>
44 
 
45 
struct _R_Proxy_init_parameters
46 
{
47 
  int vsize;
48 
  int vsize_valid;
49 
  int nsize;
50 
  int nsize_valid;
51 
};
52 
 
53 
/* 01-12-07 | baier | no more extern for exported variables (crashes!) */
54 
/*#define R_GlobalEnv (*__imp_R_GlobalEnv)
55 
#define R_Visible (*__imp_R_Visible)
56 
#define R_EvalDepth (*__imp_R_EvalDepth)
57 
#define R_DimSymbol (*__imp_R_DimSymbol)*/
58 
 
59 
/*
60 
extern SEXP R_GlobalEnv;
61 
extern int R_Visible;
62 
extern int R_EvalDepth;
63 
extern SEXP R_DimSymbol;
64 
*/
65 
 
66 
/* calls into the R DLL */
67 
extern char *getDLLVersion();
68 
extern void R_DefParams(Rstart);
69 
extern void R_SetParams(Rstart);
70 
extern void setup_term_ui(void);
71 
extern char *getRHOME();
72 
extern void end_Rmainloop(), R_ReplDLLinit();
73 
extern void askok(char *);
74 
 
75 
int R_Proxy_Graphics_Driver (NewDevDesc* pDD,
76 
			     char* pDisplay,
77 
			     double pWidth,
78 
			     double pHeight,
79 
			     double pPointSize);
80 
 
81 
extern SC_CharacterDevice* __output_device;
82 
 
83 
/* trace to DebugView */
84 
int RPROXYTRACE(char const* pFormat,...);
85 
 
86 
int RPROXYTRACE(char const* pFormat,...)
87 
{
88 
  static char __tracebuf[2048];
89 
 
90 
  va_list lArgs;
91 
  va_start(lArgs,pFormat);
92 
  vsprintf(__tracebuf,pFormat,lArgs);
93 
  OutputDebugString(__tracebuf);
94 
  return 0;
95 
}
96 
 
97 
static int s_EvalInProgress = 0;
98 
 
99 
void R_Proxy_askok (char* pMsg)
100 
{
101 
  askok(pMsg);
102 
  return;
103 
}
104 
 
105 
int R_Proxy_askyesnocancel (char* pMsg)
106 
{
107 
  return 1;
108 
}
109 
 
110 
int R_Proxy_ReadConsole(char *prompt, char *buf, int len, int addtohistory)
111 
{
112 
  return 0;
113 
}
114 
 
115 
void R_Proxy_WriteConsole(char *buf, int len)
116 
{
117 
  if (__output_device)
118 
    {
119 
      __output_device->vtbl->write_string (__output_device,buf);
120 
    }
121 
}
122 
 
123 
void R_Proxy_CallBack()
124 
{
125 
    /* called during i/o, eval, graphics in ProcessEvents */
126 
}
127 
 
128 
void R_Proxy_Busy(int which)
129 
{
130 
    /* set a busy cursor ... in which = 1, unset if which = 0 */
131 
}
132 
 
133 
 
134 
int SEXP2BDX_Data (SEXP pExpression,BDX_Data** pData)
135 
{
136 
  BDX_Data* lData = 0;
137 
 
138 
  /* allocate buffer */
139 
  lData = (BDX_Data*) malloc (sizeof (BDX_Data));
140 
  *pData = lData;
141 
  assert (*pData != NULL);
142 
 
143 
  /*
144 
   * we support the following types at the moment
145 
   *
146 
   *  integer (scalar, vectors and arrays)
147 
   *  real (scalars, vectors and arrays)
148 
   *  logical (scalars, vectors and arrays)
149 
   *  string (scalars, vectors and arrays)
150 
   *  null
151 
   *
152 
   * we should support soon
153 
   *
154 
   *  complex vectors
155 
   *  generic vectors
156 
   */
157 
  switch (TYPEOF (pExpression))
158 
    {
159 
    case NILSXP	 :
160 
      lData->type = BDX_NULL;
161 
 
162 
      /* dimensions: 1 */
163 
      lData->dim_count = 1;
164 
      lData->dimensions =
165 
	(BDX_Dimension*) malloc (sizeof (BDX_Dimension));
166 
      lData->dimensions[0] = 0;
167 
 
168 
      /* data: empty (just a dummy data record) */
169 
      lData->raw_data =
170 
	(BDX_RawData*) malloc (sizeof (BDX_RawData));
171 
 
172 
      /*      UNPROTECT (1); */
173 
 
174 
      return SC_PROXY_OK;
175 
 
176 
      break;
177 
    case LGLSXP	 :
178 
      lData->type = BDX_BOOL;
179 
      break;
180 
    case INTSXP	 :
181 
      lData->type = BDX_INT;
182 
      break;
183 
    case REALSXP	 :
184 
      lData->type = BDX_DOUBLE;
185 
      break;
186 
    case STRSXP	 :
187 
      lData->type = BDX_STRING;
188 
      break;
189 
      /*
190 
       case VECSXP	 : printf ("type: generic vectors\n");
191 
       break;
192 
       case CPLXSXP	 : printf ("type: complex variables\n");
193 
       break;
194 
      */
195 
    default:
196 
      /*      UNPROTECT (1); */
197 
      free (lData);
198 
      *pData = NULL;
199 
      return SC_PROXY_ERR_UNSUPPORTEDTYPE;
200 
    }
201 
 
202 
  /* the type is set now. NULL values have already returned */
203 
 
204 
  /* is it a scalar, a vector or an array? */
205 
 
206 
  /* bug: no dimensions stored */
207 
  if (LENGTH (pExpression) == 0)
208 
    {
209 
      free (lData);
210 
      *pData = NULL;
211 
      return SC_PROXY_ERR_UNKNOWN;
212 
    }
213 
 
214 
  /* scalar: length 1 */
215 
  if (LENGTH (pExpression) == 1)
216 
    {
217 
      lData->type |= BDX_SCALAR;
218 
      lData->dim_count = 1;
219 
      lData->dimensions =
220 
	(BDX_Dimension*) malloc (sizeof (BDX_Dimension));
221 
      lData->dimensions[0] = 1;
222 
      lData->raw_data =
223 
	(BDX_RawData*) malloc (sizeof (BDX_RawData));
224 
      switch (lData->type & BDX_SMASK)
225 
	{
226 
	case BDX_BOOL:
227 
	  lData->raw_data[0].bool_value = LOGICAL (pExpression)[0];
228 
	  break;
229 
	case BDX_INT:
230 
	  lData->raw_data[0].int_value = INTEGER (pExpression)[0];
231 
	  break;
232 
	case BDX_DOUBLE:
233 
	  lData->raw_data[0].double_value = REAL (pExpression)[0];
234 
	  break;
235 
	case BDX_STRING:
236 
	  lData->raw_data[0].string_value = strdup (CHAR (STRING_ELT(pExpression, 0)));
237 
	  break;
238 
	}
239 
    }
240 
  else
241 
    {
242 
      /* is it a vector or an array? */
243 
      SEXP lDimension;
244 
 
245 
      lDimension = getAttrib (pExpression,R_DimSymbol);
246 
 
247 
      PROTECT (lDimension);
248 
 
249 
      if (TYPEOF (lDimension) == NILSXP)
250 
	{
251 
	  /* vector */
252 
	  int i;
253 
 
254 
	  lData->type |= BDX_VECTOR;
255 
	  lData->dim_count = 1;
256 
	  lData->dimensions =
257 
	    (BDX_Dimension*) malloc (sizeof (BDX_Dimension));
258 
	  lData->dimensions[0] = LENGTH (pExpression);
259 
	  lData->raw_data =
260 
	    (BDX_RawData*) malloc (sizeof (BDX_RawData)
261 
				   * lData->dimensions[0]);
262 
 
263 
	  /* copy the data */
264 
	  for (i = 0; i < lData->dimensions[0];i++)
265 
	    {
266 
	      switch (lData->type & BDX_SMASK)
267 
		{
268 
		case BDX_BOOL:
269 
		  lData->raw_data[i].bool_value = LOGICAL (pExpression)[i];
270 
		  break;
271 
		case BDX_INT:
272 
		  lData->raw_data[i].int_value = INTEGER (pExpression)[i];
273 
		  break;
274 
		case BDX_DOUBLE:
275 
		  lData->raw_data[i].double_value = REAL (pExpression)[i];
276 
		  break;
277 
		case BDX_STRING:
278 
		  lData->raw_data[i].string_value = strdup (CHAR (STRING_ELT(pExpression, i)));
279 
		  break;
280 
		}
281 
	    }
282 
 
283 
	  UNPROTECT (1); /* dimension */
284 
 
285 
	  return SC_PROXY_OK;
286 
	}
287 
      else
288 
	{
289 
	  /* array with LENGTH(lDimension) dimensions */
290 
	  if (TYPEOF (lDimension) == INTSXP)
291 
	    {
292 
	      int i;
293 
	      int lTotalSize = 1;
294 
 
295 
	      lData->type |= BDX_ARRAY;
296 
	      lData->dim_count = LENGTH (lDimension);
297 
 
298 
	      lData->dimensions =
299 
		(BDX_Dimension*) malloc (sizeof (BDX_Dimension)
300 
					 * lData->dim_count);
301 
 
302 
	      /* compute the total number of data elements */
303 
	      for (i = 0;i < lData->dim_count;i++)
304 
		{
305 
		  lData->dimensions[i] = INTEGER (lDimension)[i];
306 
		  lTotalSize *= lData->dimensions[i];
307 
		}
308 
 
309 
	      lData->raw_data =
310 
		(BDX_RawData*) malloc (sizeof (BDX_RawData)
311 
				       * lTotalSize);
312 
 
313 
	      /* copy the data */
314 
	      for (i = 0; i < lTotalSize;i++)
315 
		{
316 
		  switch (lData->type & BDX_SMASK)
317 
		    {
318 
		    case BDX_BOOL:
319 
		      lData->raw_data[i].bool_value = LOGICAL (pExpression)[i];
320 
		      break;
321 
		    case BDX_INT:
322 
		      lData->raw_data[i].int_value = INTEGER (pExpression)[i];
323 
		      break;
324 
		    case BDX_DOUBLE:
325 
		      lData->raw_data[i].double_value = REAL (pExpression)[i];
326 
		      break;
327 
		    case BDX_STRING:
328 
		      lData->raw_data[i].string_value = strdup (CHAR (STRING_ELT(pExpression, i)));
329 
		      break;
330 
		    }
331 
		}
332 
 
333 
	      UNPROTECT (1); /* dimension */
334 
 
335 
	      return SC_PROXY_OK;
336 
	    }
337 
	  else
338 
	    {
339 
	      /* unknown error */
340 
	      free (lData);
341 
	      *pData = NULL;
342 
 
343 
	      UNPROTECT (1); /* dimension */
344 
 
345 
	      return SC_PROXY_ERR_UNKNOWN;
346 
	    }
347 
	}
348 
    }
349 
 
350 
  return SC_PROXY_OK;
351 
}
352 
 
353 
/* 00-02-18 | baier | parse parameter string and fill parameter structure */
354 
int R_Proxy_parse_parameters (char const* pParameterString,
355 
			      struct _R_Proxy_init_parameters* pParameterStruct)
356 
{
357 
  /*
358 
   * parameter string is of the form name1=value1;name2=value2;...
359 
   *
360 
   * currently recognized parameter names (case-sensitive):
361 
   *
362 
   *   NSIZE ... number of cons cells, (unsigned int) parameter
363 
   *   VSIZE ... size of vector heap, (unsigned int) parameter
364 
   */
365 
  int lDone = 0;
366 
#if 0
367 
  char const* lParameterStart = pParameterString;
368 
  int lIndexOfSemicolon = 0;
369 
  char* lTmpBuffer = NULL;
370 
  char* lPosOfSemicolon = NULL;
371 
#endif
372 
 
373 
  while (!lDone)
374 
    {
375 
#if 0
376 
      /* NSIZE? */
377 
      if (strncmp (lParameterStart,"NSIZE=",6) == 0)
378 
	{
379 
	  lParameterStart += 6;
380 
 
381 
	  lPosOfSemicolon = strchr (lParameterStart,';');
382 
	  lIndexOfSemicolon = lPosOfSemicolon - lParameterStart;
383 
 
384 
	  if (lPosOfSemicolon)
385 
	    {
386 
	      lTmpBuffer = malloc (lIndexOfSemicolon + 1); /* to catch NSIZE=; */
387 
	      strncpy (lTmpBuffer,lParameterStart,lIndexOfSemicolon);
388 
	      *(lTmpBuffer + lIndexOfSemicolon) = 0x0;
389 
	      pParameterStruct->nsize_valid = 1;
390 
	      pParameterStruct->nsize = atoi (lTmpBuffer);
391 
	      free (lTmpBuffer);
392 
	      lParameterStart += lIndexOfSemicolon + 1;
393 
	    }
394 
	  else
395 
	    {
396 
	      pParameterStruct->nsize_valid = 1;
397 
	      pParameterStruct->nsize = atoi (lParameterStart);
398 
	      lDone = 1;
399 
	    }
400 
	}
401 
      else if (strncmp (lParameterStart,"VSIZE=",6) == 0)
402 
	{
403 
	  lParameterStart += 6;
404 
 
405 
	  lPosOfSemicolon = strchr (lParameterStart,';');
406 
	  lIndexOfSemicolon = lPosOfSemicolon - lParameterStart;
407 
 
408 
	  if (lPosOfSemicolon)
409 
	    {
410 
	      lTmpBuffer = malloc (lIndexOfSemicolon + 1); /* to catch VSIZE=; */
411 
	      strncpy (lTmpBuffer,lParameterStart,lIndexOfSemicolon);
412 
	      *(lTmpBuffer + lIndexOfSemicolon) = 0x0;
413 
	      pParameterStruct->vsize_valid = 1;
414 
	      pParameterStruct->vsize = atoi (lTmpBuffer);
415 
	      free (lTmpBuffer);
416 
	      lParameterStart += lIndexOfSemicolon + 1;
417 
	    }
418 
	  else
419 
	    {
420 
	      pParameterStruct->vsize_valid = 1;
421 
	      pParameterStruct->vsize = atoi (lParameterStart);
422 
	      lDone = 1;
423 
	    }
424 
	}
425 
      else
426 
#endif
427 
	{
428 
	  lDone = 1;
429 
	}
430 
    }
431 
 
432 
  return 0;
433 
}
434 
 
435 
#include "../shext.h" /* for ShellGetPersonalDirectory */
436 
 
437 
/* 00-02-18 | baier | R_Proxy_init() now takes parameter string, parse it */
438 
/* 03-06-01 | baier | now we add %R_HOME%\bin to %PATH% */
439 
int R_Proxy_init (char const* pParameterString)
440 
{
441 
  structRstart rp;
442 
  Rstart Rp = &rp;
443 
  char Rversion[25];
444 
  static char RUser[MAX_PATH], RHome[MAX_PATH];
445 
  char *p, *q;
446 
 
447 
  sprintf(Rversion, "%s.%s", R_MAJOR, R_MINOR);
448 
  if(strcmp(getDLLVersion(), Rversion) != 0) {
449 
    fprintf(stderr, "Error: R.DLL version does not match\n");
450 
    return SC_PROXY_ERR_UNKNOWN;
451 
  }
452 
 
453 
  R_DefParams(Rp);
454 
 
455 
  /* first, try process-local environment space (CRT) */
456 
  if (getenv("R_HOME")) {
457 
      strcpy(RHome, getenv("R_HOME"));
458 
  } else {
459 
    /* get variable from process-local environment space (Windows API) */
460 
      if (GetEnvironmentVariable ("R_HOME", RHome, sizeof (RHome)) == 0) {
461 
	/* not found, fall back to getRHOME() */
462 
	strcpy(RHome, getRHOME());
463 
      }
464 
    }
465 
 
466 
  /* now we add %R_HOME%\bin to %PATH% (for dynamically loaded modules there) */
467 
  {
468 
    char buf[2048];
469 
    sprintf(buf,"PATH=%s\\bin;%s",RHome,getenv("PATH"));
470 
    putenv(buf);
471 
  }
472 
 
473 
  Rp->rhome = RHome;
474 
/*
475 
 * try R_USER then HOME then Windows homes then working directory
476 
 */
477 
 
478 
    if ((p = getenv("R_USER"))) {
479 
	if(strlen(p) >= MAX_PATH) R_Suicide("Invalid R_USER");
480 
	strcpy(RUser, p);
481 
    } else if ((p = getenv("HOME"))) {
482 
	if(strlen(p) >= MAX_PATH) R_Suicide("Invalid HOME");
483 
	strcpy(RUser, p);
484 
    } else if (ShellGetPersonalDirectory(RUser)) {
485 
	/* nothing to do */;
486 
    } else if ((p = getenv("HOMEDRIVE")) && (q = getenv("HOMEPATH"))) {
487 
	if(strlen(p) >= MAX_PATH) R_Suicide("Invalid HOMEDRIVE");
488 
	strcpy(RUser, p);
489 
	if(strlen(RUser) + strlen(q) >= MAX_PATH)
490 
	    R_Suicide("Invalid HOMEDRIVE+HOMEPATH");
491 
	strcat(RUser, q);
492 
    } else {
493 
	GetCurrentDirectory(MAX_PATH, RUser);
494 
    }
495 
 
496 
  p = RUser + (strlen(RUser) - 1);
497 
 
498 
  if (*p == '/' || *p == '\\') *p = '\0';
499 
  Rp->home = RUser;
500 
  Rp->CharacterMode = LinkDLL;
501 
  Rp->ReadConsole = R_Proxy_ReadConsole;
502 
  Rp->WriteConsole = R_Proxy_WriteConsole;
503 
  Rp->CallBack = R_Proxy_CallBack;
31698 ripley 504 
  Rp->ShowMessage = R_Proxy_askok;
31421 ripley 505 
 
31698 ripley 506 
  Rp->YesNoCancel = R_Proxy_askyesnocancel;
507 
  Rp->Busy = R_Proxy_Busy;
31421 ripley 508 
  Rp->R_Quiet = 1;
509 
#if 1
510 
  /* run as "interactive", so server won't be killed after an error */
511 
  Rp->R_Slave = Rp->R_Verbose = 0;
512 
  Rp->R_Interactive = 1;
513 
#else
514 
  Rp->R_Slave = Rp->R_Interactive = Rp->R_Verbose = 0;
515 
#endif
516 
  Rp->RestoreAction = 0; /* no restore */
517 
  Rp->SaveAction = 2;    /* no save */
518 
 
519 
/*  Rp->nsize = 300000;
520 
    Rp->vsize = 6e6;*/
521 
  R_SetParams(Rp); /* so R_ShowMessage is set */
522 
  R_SizeFromEnv(Rp);
523 
  R_set_command_line_arguments(0, NULL);
524 
 
525 
  /* parse parameters */
526 
#if 0
527 
  {
528 
    struct _R_Proxy_init_parameters lParameterStruct =
529 
    {
530 
      0,0,0,0
531 
    };
532 
 
533 
    R_Proxy_parse_parameters (pParameterString,&lParameterStruct);
534 
 
535 
    if (lParameterStruct.nsize_valid)
536 
      {
537 
	Rp->nsize = lParameterStruct.nsize;
538 
      }
539 
    if (lParameterStruct.vsize_valid)
540 
      {
541 
	Rp->vsize = lParameterStruct.vsize;
542 
      }
543 
  }
544 
#endif
545 
 
546 
  R_SetParams(Rp);
547 
 
548 
  setup_term_ui();
549 
  setup_Rmainloop();
550 
  R_ReplDLLinit();
551 
 
552 
  return SC_PROXY_OK;
553 
}
554 
 
555 
/* 01-06-05 | baier | SETJMP and fatal error handling around eval() */
556 
/* 04-08-01 | baier | ref-counting in case of error */
557 
/* 04-10-11 | baier | restore original ref-counting */
558 
int R_Proxy_evaluate (char const* pCmd,BDX_Data** pData)
559 
{
560 
  SEXP rho = R_GlobalEnv;
561 
  IoBuffer lBuffer;
562 
  SEXP lSexp;
563 
  int lRc;
564 
  ParseStatus lStatus;
565 
  SEXP lResult;
566 
 
567 
  /* for SETJMP/LONGJMP */
568 
  s_EvalInProgress = 0;
569 
 
570 
  R_IoBufferInit (&lBuffer);
571 
  R_IoBufferPuts ((char*) pCmd,&lBuffer);
572 
  R_IoBufferPuts ("\n",&lBuffer);
573 
 
574 
  /* don't generate code, just a try */
575 
  R_IoBufferReadReset (&lBuffer);
576 
  lSexp = R_Parse1Buffer (&lBuffer,0,&lStatus);
577 
 
578 
  switch (lStatus)
579 
    {
580 
    case PARSE_NULL:
581 
      /* we forget the IoBuffer "lBuffer", so don't do anything here */
582 
      lRc = SC_PROXY_ERR_PARSE_INVALID;
583 
      break;
584 
    case PARSE_OK:
585 
      /* now generate code */
586 
      R_IoBufferReadReset (&lBuffer);
587 
      lSexp = R_Parse1Buffer (&lBuffer,1,&lStatus);
588 
      R_Visible = 0;
589 
      R_EvalDepth = 0;
590 
      PROTECT(lSexp);
591 
      {
592 
	SETJMP (R_Toplevel.cjmpbuf);
593 
	R_GlobalContext = R_ToplevelContext = &R_Toplevel;
594 
 
595 
	if (!s_EvalInProgress)
596 
	  {
597 
	    s_EvalInProgress = 1;
598 
	    lResult = eval (lSexp,rho);
599 
	    s_EvalInProgress = 0;
600 
	  }
601 
	else
602 
	  {
603 
	    return SC_PROXY_ERR_EVALUATE_STOP;
604 
	  }
605 
      }
606 
      lRc = SEXP2BDX_Data (lResult,pData);
607 
      /* no last value */
608 
      UNPROTECT(1);
609 
      break;
610 
    case PARSE_ERROR:
611 
      lRc = SC_PROXY_ERR_PARSE_INVALID;
612 
      break;
613 
    case PARSE_INCOMPLETE:
614 
      lRc = SC_PROXY_ERR_PARSE_INCOMPLETE;
615 
      break;
616 
    case PARSE_EOF:
617 
      lRc = SC_PROXY_ERR_PARSE_INVALID;
618 
      break;
619 
    default:
620 
      /* never reached */
621 
      lRc = SC_PROXY_ERR_UNKNOWN;
622 
      break;
623 
    }
624 
 
625 
  return lRc;
626 
}
627 
 
628 
/* 01-06-05 | baier | SETJMP and fatal error handling around eval() */
629 
/* 04-08-01 | baier | ref-counting in case of error */
630 
/* 04-10-11 | baier | restore original ref-counting */
631 
int R_Proxy_evaluate_noreturn (char const* pCmd)
632 
{
633 
  SEXP rho = R_GlobalEnv;
634 
  IoBuffer lBuffer;
635 
  SEXP lSexp;
636 
  int lRc;
637 
  ParseStatus lStatus;
638 
 
639 
  /* for SETJMP/LONGJMP */
640 
  s_EvalInProgress = 0;
641 
 
642 
  R_IoBufferInit (&lBuffer);
643 
  R_IoBufferPuts ((char*) pCmd,&lBuffer);
644 
  R_IoBufferPuts ("\n",&lBuffer);
645 
 
646 
  /* don't generate code, just a try */
647 
  R_IoBufferReadReset (&lBuffer);
648 
  lSexp = R_Parse1Buffer (&lBuffer,0,&lStatus);
649 
 
650 
  switch (lStatus)
651 
    {
652 
    case PARSE_NULL:
653 
      /* we forget the IoBuffer "lBuffer", so don't do anything here */
654 
      lRc = SC_PROXY_ERR_PARSE_INVALID;
655 
      break;
656 
    case PARSE_OK:
657 
      /* now generate code */
658 
      R_IoBufferReadReset (&lBuffer);
659 
      lSexp = R_Parse1Buffer (&lBuffer,1,&lStatus);
660 
      R_Visible = 0;
661 
      R_EvalDepth = 0;
662 
      PROTECT(lSexp);
663 
      /* at the moment, discard the result of the eval */
664 
      {
665 
	SETJMP (R_Toplevel.cjmpbuf);
666 
	R_GlobalContext = R_ToplevelContext = &R_Toplevel;
667 
 
668 
	if (!s_EvalInProgress)
669 
	  {
670 
	    s_EvalInProgress = 1;
671 
	    eval (lSexp,rho);
672 
	    s_EvalInProgress = 0;
673 
	  }
674 
	else
675 
	  {
676 
	    return SC_PROXY_ERR_EVALUATE_STOP;
677 
	  }
678 
      }
679 
      /* no last value */
680 
      UNPROTECT(1);
681 
      lRc = SC_PROXY_OK;
682 
      break;
683 
    case PARSE_ERROR:
684 
      lRc = SC_PROXY_ERR_PARSE_INVALID;
685 
      break;
686 
    case PARSE_INCOMPLETE:
687 
      lRc = SC_PROXY_ERR_PARSE_INCOMPLETE;
688 
      break;
689 
    case PARSE_EOF:
690 
      lRc = SC_PROXY_ERR_PARSE_INVALID;
691 
      break;
692 
    default:
693 
      /* never reached */
694 
      lRc = SC_PROXY_ERR_UNKNOWN;
695 
      break;
696 
    }
697 
 
698 
  return lRc;
699 
}
700 
 
701 
int R_Proxy_get_symbol (char const* pSymbol,BDX_Data** pData)
702 
{
703 
  IoBuffer lBuffer;
704 
  SEXP lSexp;
705 
  SEXP lVar;
706 
  ParseStatus lStatus;
707 
 
708 
  R_IoBufferInit (&lBuffer);
709 
  R_IoBufferPuts ((char*) pSymbol,&lBuffer);
710 
  R_IoBufferPuts ("\n",&lBuffer);
711 
 
712 
  /* don't generate code, just a try */
713 
  R_IoBufferReadReset (&lBuffer);
714 
  lSexp = R_Parse1Buffer (&lBuffer,0,&lStatus);
715 
 
716 
  if (lStatus == PARSE_OK)
717 
    {
718 
      /* now generate code */
719 
      R_IoBufferReadReset (&lBuffer);
720 
      lSexp = R_Parse1Buffer (&lBuffer,1,&lStatus);
721 
      R_Visible = 0;
722 
      R_EvalDepth = 0;
723 
      PROTECT(lSexp);
724 
 
725 
      /* check for valid symbol... */
726 
      if (TYPEOF (lSexp) != SYMSXP)
727 
	{
728 
	  printf (">> %s is not a symbol\n",pSymbol);
729 
	  UNPROTECT (1);
730 
	  return SC_PROXY_ERR_INVALIDSYMBOL;
731 
	}
732 
 
733 
      lVar = findVar (lSexp,R_GlobalEnv);
734 
 
735 
      if (lVar == R_UnboundValue)
736 
	{
737 
	  printf (">> %s is an unbound value\n",pSymbol);
738 
	  UNPROTECT (1);
739 
	  return SC_PROXY_ERR_INVALIDSYMBOL;
740 
	}
741 
 
742 
      {
743 
	int lRc = SEXP2BDX_Data (lVar,pData);
744 
	UNPROTECT (1);
745 
 
746 
	return lRc;
747 
      }
748 
    }
749 
 
750 
  return SC_PROXY_OK;
751 
}
752 
 
753 
/* 04-02-19 | baier | don't PROTECT strings in a vector */
754 
/* 04-03-02 | baier | removed traces */
755 
int R_Proxy_set_symbol (char const* pSymbol,BDX_Data const* pData)
756 
{
757 
  SEXP lSymbol = 0;
758 
  SEXP lData = 0;
759 
  int lProtectCount = 1;
760 
  int lRet = SC_PROXY_OK;
761 
 
762 
  switch (pData->type & BDX_CMASK)
763 
    {
764 
      /* scalar? */
765 
    case BDX_SCALAR:
766 
      {
767 
	switch (pData->type & BDX_SMASK)
768 
	  {
769 
	  case BDX_BOOL:
770 
	    lData = PROTECT (allocVector (LGLSXP,1));
771 
	    LOGICAL(lData)[0] = pData->raw_data[0].bool_value;
772 
	    break;
773 
	  case BDX_INT:
774 
	    lData = PROTECT (allocVector (INTSXP,1));
775 
	    INTEGER(lData)[0] = pData->raw_data[0].int_value;
776 
	    break;
777 
	  case BDX_DOUBLE:
778 
	    lData = PROTECT (allocVector (REALSXP,1));
779 
	    REAL(lData)[0] = pData->raw_data[0].double_value;
780 
	    break;
781 
	  case BDX_STRING:
782 
	    {
783 
	      SEXP lStringSExp =
784 
		allocString (strlen (pData->raw_data[0].string_value));
785 
	      PROTECT (lStringSExp); lProtectCount++;
786 
	      strcpy (CHAR(lStringSExp),pData->raw_data[0].string_value);
787 
	      lData = PROTECT (allocVector (STRSXP,1));
788 
	      SET_STRING_ELT(lData, 0, lStringSExp);
789 
	    }
790 
	    break;
791 
	  default:
792 
	    lRet = SC_PROXY_ERR_UNSUPPORTEDTYPE;
793 
	  }
794 
      }
795 
 
796 
      break;
797 
      /* vectors or arrays */
798 
    case BDX_VECTOR:
799 
    case BDX_ARRAY:
800 
      {
801 
	/* allocate a dimensions vector */
802 
	SEXP lDimensions;
803 
	unsigned int i;
804 
	unsigned int lTotalSize = 1;
805 
 
806 
	PROTECT (lDimensions = allocVector (INTSXP,pData->dim_count));
807 
	lProtectCount++;
808 
 
809 
	for (i = 0;i < pData->dim_count;i++)
810 
	  {
811 
	    INTEGER (lDimensions)[i] = pData->dimensions[i];
812 
	    lTotalSize *= pData->dimensions[i];
813 
	  }
814 
 
815 
	switch (pData->type & BDX_SMASK)
816 
	  {
817 
	  case BDX_BOOL:
818 
	    lData = PROTECT (allocVector (LGLSXP,lTotalSize));
819 
	    setAttrib (lData,R_DimSymbol,lDimensions);
820 
 
821 
	    for (i = 0;i < lTotalSize;i++)
822 
	      {
823 
		LOGICAL(lData)[i] = pData->raw_data[i].bool_value;
824 
	      }
825 
	    break;
826 
	  case BDX_INT:
827 
	    lData = PROTECT (allocVector (INTSXP,lTotalSize));
828 
	    setAttrib (lData,R_DimSymbol,lDimensions);
829 
 
830 
	    for (i = 0;i < lTotalSize;i++)
831 
	      {
832 
		INTEGER(lData)[i] = pData->raw_data[i].int_value;
833 
	      }
834 
	    break;
835 
	  case BDX_DOUBLE:
836 
	    lData = PROTECT (allocVector (REALSXP,lTotalSize));
837 
	    setAttrib (lData,R_DimSymbol,lDimensions);
838 
 
839 
	    for (i = 0;i < lTotalSize;i++)
840 
	      {
841 
		REAL(lData)[i] = pData->raw_data[i].double_value;
842 
	      }
843 
	    break;
844 
	  case BDX_STRING:
845 
	    {
846 
	      lData = PROTECT (allocVector (STRSXP,lTotalSize));
847 
	      setAttrib (lData,R_DimSymbol,lDimensions);
848 
 
849 
	      for (i = 0;i < lTotalSize;i++)
850 
		{
851 
		  SEXP lStringSExp;
852 
		  lStringSExp =
853 
		    allocString (strlen (pData->raw_data[i].string_value));
854 
		  strcpy (CHAR(lStringSExp),pData->raw_data[i].string_value);
855 
		  SET_STRING_ELT(lData, i, lStringSExp);
856 
		}
857 
	    }
858 
	    break;
859 
	  default:
860 
	    lRet = SC_PROXY_ERR_UNSUPPORTEDTYPE;
861 
	  }
862 
      }
863 
      break;
864 
    default:
865 
      lRet = SC_PROXY_ERR_UNSUPPORTEDTYPE;
866 
    }
867 
 
868 
  if (lRet != SC_PROXY_OK)
869 
    {
870 
      return lRet;
871 
    }
872 
 
873 
  /* install a new symbol or get the existing symbol */
874 
  lSymbol = install ((char*) pSymbol);
875 
 
876 
  /* and set the data to the symbol */
877 
  setVar(lSymbol,lData,R_GlobalEnv);
878 
 
879 
  UNPROTECT (lProtectCount);
880 
 
881 
  return SC_PROXY_OK;
882 
}
883 
 
884 
int R_Proxy_term ()
885 
{
886 
  end_Rmainloop();
887 
 
888 
  return SC_PROXY_OK;
889 
}
890