The R Project SVN R

Rev

Rev 5245 | Rev 5458 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 5245 Rev 5251
Line 17... Line 17...
17 
 *  You should have received a copy of the GNU General Public License
 17 
 *  You should have received a copy of the GNU General Public License
18 
 *  along with this program; if not, write to the Free Software
 18 
 *  along with this program; if not, write to the Free Software
19 
 *  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 19 
 *  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
20 
 */
 20 
 */
21 
 
 21 
 
22 
         /* See ../unix/system.txt for a description of functions */
 - 
 
23 
 
 - 
 
24 
#ifdef HAVE_CONFIG_H
 - 
 
25 
#include <Rconfig.h>
 - 
 
26 
#endif
 - 
 
27 
 
 - 
 
28 
#include "Defn.h"
 - 
 
29 
#include "Fileio.h"
 22 
#include "../unix/sys-common.c"
30 
 
 - 
 
31 
extern int SaveAction;
 - 
 
32 
extern int RestoreAction;
 - 
 
33 
extern int LoadSiteFile;
 - 
 
34 
extern int LoadInitFile;
 - 
 
35 
extern int DebugInitFile;
 - 
 
36 
 
 - 
 
37 
 
 - 
 
38 
/*
 - 
 
39 
 *  4) INITIALIZATION AND TERMINATION ACTIONS
 - 
 
40 
 */
 - 
 
41 
 
 - 
 
42 
void R_InitialData(void)
 - 
 
43 
{
 - 
 
44 
    R_RestoreGlobalEnv();
 - 
 
45 
}
 - 
 
46 
 
 - 
 
47 
 
 - 
 
48 
FILE *R_OpenLibraryFile(char *file)
 - 
 
49 
{
 - 
 
50 
    char buf[256];
 - 
 
51 
    FILE *fp;
 - 
 
52 
 
 - 
 
53 
    sprintf(buf, "%s/library/base/R/%s", R_Home, file);
 - 
 
54 
    fp = R_fopen(buf, "r");
 - 
 
55 
    return fp;
 - 
 
56 
}
 - 
 
57 
 
 - 
 
58 
FILE *R_OpenSysInitFile(void)
 - 
 
59 
{
 - 
 
60 
    char buf[256];
 - 
 
61 
    FILE *fp;
 - 
 
62 
 
 - 
 
63 
    sprintf(buf, "%s/library/base/R/Rprofile", R_Home);
 - 
 
64 
    fp = R_fopen(buf, "r");
 - 
 
65 
    return fp;
 - 
 
66 
}
 - 
 
67 
 
 - 
 
68 
FILE *R_OpenSiteFile(void)
 - 
 
69 
{
 - 
 
70 
    char buf[256];
 - 
 
71 
    FILE *fp;
 - 
 
72 
 
 - 
 
73 
    fp = NULL;
 - 
 
74 
    if (LoadSiteFile) {
 - 
 
75 
	if ((fp = R_fopen(getenv("R_PROFILE"), "r")))
 - 
 
76 
	    return fp;
 - 
 
77 
	if ((fp = R_fopen(getenv("RPROFILE"), "r")))
 - 
 
78 
	    return fp;
 - 
 
79 
	sprintf(buf, "%s/etc/Rprofile", R_Home);
 - 
 
80 
	if ((fp = R_fopen(buf, "r")))
 - 
 
81 
	    return fp;
 - 
 
82 
    }
 - 
 
83 
    return fp;
 - 
 
84 
}
 - 
 
85 
 
 - 
 
86 
	/* Saving and Restoring the Global Environment */
 - 
 
87 
 
 - 
 
88 
void R_RestoreGlobalEnv(void)
 - 
 
89 
{
 - 
 
90 
    FILE *fp;
 - 
 
91 
    if(RestoreAction == SA_RESTORE) {
 - 
 
92 
	if(!(fp = R_fopen(".RData", "rb"))) { /* binary file */
 - 
 
93 
	    /* warning here perhaps */
 - 
 
94 
	    return;
 - 
 
95 
	}
 - 
 
96 
	FRAME(R_GlobalEnv) = R_LoadFromFile(fp, 1);
 - 
 
97 
	if(!R_Quiet)
 - 
 
98 
	    Rprintf("[Previously saved workspace restored]\n\n");
 - 
 
99 
        fclose(fp);
 - 
 
100 
    }
 - 
 
101 
}
 - 
 
102 
 
 - 
 
103 
void R_SaveGlobalEnv(void)
 - 
 
104 
{
 - 
 
105 
    FILE *fp = R_fopen(".RData", "wb"); /* binary file */
 - 
 
106 
    if (!fp)
 - 
 
107 
	error("can't save data -- unable to open ./.RData\n");
 - 
 
108 
    R_SaveToFile(FRAME(R_GlobalEnv), fp, 0);
 - 
 
109 
    fclose(fp);
 - 
 
110 
}
 - 
 
111 
 
 - 
 
112 
/*
 - 
 
113 
 *  5) FILESYSTEM INTERACTION
 - 
 
114 
 */
 - 
 
115 
 
 - 
 
116 
    /*
 - 
 
117 
     *  This call provides a simple interface to the "stat" system call.
 - 
 
118 
     */
 - 
 
119 
 
 - 
 
120 
#include <sys/types.h>
 - 
 
121 
#include <sys/stat.h>
 - 
 
122 
 
 - 
 
123 
int R_FileExists(char *path)
 - 
 
124 
{
 - 
 
125 
    struct stat sb;
 - 
 
126 
    return stat(R_ExpandFileName(path), &sb) == 0;
 - 
 
127 
}
 - 
 
128 
 
 - 
 
129 
    /*
 - 
 
130 
     *  Unix file names which begin with "." are invisible.
 - 
 
131 
     */
 - 
 
132 
 
 - 
 
133 
int R_HiddenFile(char *name)
 - 
 
134 
{
 - 
 
135 
    if (name && name[0] != '.') return 0;
 - 
 
136 
    else return 1;
 - 
 
137 
}
 - 
 
138 
 
 - 
 
139 
 
 - 
 
140 
FILE *R_fopen(const char *filename, const char *mode)
 - 
 
141 
{
 - 
 
142 
    return( fopen(filename, mode) );
 - 
 
143 
}
 - 
 
144 
 
 - 
 
145 
/*
 - 
 
146 
 *  6) SYSTEM INFORMATION
 - 
 
147 
 */
 - 
 
148 
 
 - 
 
149 
          /* The location of the R system files */
 - 
 
150 
 
 - 
 
151 
char *R_HomeDir()
 - 
 
152 
{
 - 
 
153 
    return getenv("R_HOME");
 - 
 
154 
}
 - 
 
155 
 
 - 
 
156 
 
 - 
 
157 
/*
 - 
 
158 
 *  INITIALIZATION HELPER CODE
 - 
 
159 
 */
 - 
 
160 
 
 - 
 
161 
#include "Startup.h"
 - 
 
162 
extern void R_ShowMessage(char *);
 - 
 
163 
 
 - 
 
164 
void R_DefParams(Rstart Rp)
 - 
 
165 
{
 - 
 
166 
    Rp->R_Quiet = False;
 - 
 
167 
    Rp->R_Slave = False;
 - 
 
168 
    Rp->R_Interactive = True;
 - 
 
169 
    Rp->R_Verbose = False;
 - 
 
170 
    Rp->RestoreAction = SA_RESTORE;
 - 
 
171 
    Rp->SaveAction = SA_SAVEASK;
 - 
 
172 
    Rp->LoadSiteFile = True;
 - 
 
173 
    Rp->LoadInitFile = True;
 - 
 
174 
    Rp->DebugInitFile = False;
 - 
 
175 
    Rp->vsize = R_VSIZE;
 - 
 
176 
    Rp->nsize = R_NSIZE;
 - 
 
177 
#ifdef Win32
 - 
 
178 
    Rp->NoRenviron = False;
 - 
 
179 
#endif
 - 
 
180 
}
 - 
 
181 
 
 - 
 
182 
#define Max_Nsize 20000000	/* must be < LONG_MAX (= 2^32 - 1 =)
 - 
 
183 
				   2147483647 = 2.1e9 */
 - 
 
184 
#define Max_Vsize (2048*Mega)	/* must be < LONG_MAX */
 - 
 
185 
 
 - 
 
186 
#define Min_Nsize 200000
 - 
 
187 
#define Min_Vsize (2*Mega)
 - 
 
188 
 
 - 
 
189 
void R_SizeFromEnv(Rstart Rp)
 - 
 
190 
{
 - 
 
191 
    int value, ierr;
 - 
 
192 
    char *p;
 - 
 
193 
    if((p = getenv("R_VSIZE"))) {
 - 
 
194 
	value = Decode2Long(p, &ierr);
 - 
 
195 
	if(ierr != 0 || value > Max_Vsize || value < Min_Vsize)
 - 
 
196 
	    R_ShowMessage("WARNING: invalid R_VSIZE ignored;");
 - 
 
197 
	else
 - 
 
198 
	    Rp->vsize = value;
 - 
 
199 
    }
 - 
 
200 
    if((p = getenv("R_NSIZE"))) {
 - 
 
201 
	value = Decode2Long(p, &ierr);
 - 
 
202 
	if(ierr != 0 || value > Max_Nsize || value < Min_Nsize)
 - 
 
203 
	    R_ShowMessage("WARNING: invalid R_NSIZE ignored;");
 - 
 
204 
	else
 - 
 
205 
	    Rp->nsize = value;
 - 
 
206 
    }
 - 
 
207 
}
 - 
 
208 
 
 - 
 
209 
static void SetSize(int vsize, int nsize)
 - 
 
210 
{
 - 
 
211 
    if (vsize < 1000) {
 - 
 
212 
	REprintf("WARNING: vsize ridiculously low, Megabytes assumed\n");
 - 
 
213 
	vsize *= Mega;
 - 
 
214 
    }
 - 
 
215 
    if(vsize < Min_Vsize || vsize > Max_Vsize) {
 - 
 
216 
	REprintf("WARNING: invalid v(ector heap)size '%d' ignored;"
 - 
 
217 
		 "using default = %gM\n", vsize, R_VSIZE / Mega);
 - 
 
218 
	R_VSize = R_VSIZE;
 - 
 
219 
    } else
 - 
 
220 
	R_VSize = vsize;
 - 
 
221 
    if(nsize < Min_Nsize || nsize > Max_Nsize) {
 - 
 
222 
	REprintf("WARNING: invalid language heap (n)size '%d' ignored,"
 - 
 
223 
		 " using default = %d\n", nsize, R_NSIZE);
 - 
 
224 
	R_NSize = R_NSIZE;
 - 
 
225 
    } else
 - 
 
226 
	R_NSize = nsize;
 - 
 
227 
}
 - 
 
228 
 
 - 
 
229 
 
 - 
 
230 
void R_SetParams(Rstart Rp)
 - 
 
231 
{
 - 
 
232 
    R_Quiet = Rp->R_Quiet;
 - 
 
233 
    R_Slave = Rp->R_Slave;
 - 
 
234 
    R_Interactive = Rp->R_Interactive;
 - 
 
235 
    R_Verbose = Rp->R_Verbose;
 - 
 
236 
    RestoreAction = Rp->RestoreAction;
 - 
 
237 
    SaveAction = Rp->SaveAction;
 - 
 
238 
    LoadSiteFile = Rp->LoadSiteFile;
 - 
 
239 
    LoadInitFile = Rp->LoadInitFile;
 - 
 
240 
    DebugInitFile = Rp->DebugInitFile;
 - 
 
241 
    SetSize(Rp->vsize, Rp-> nsize);
 - 
 
242 
#ifdef Win32
 - 
 
243 
    R_SetWin32(Rp);
 - 
 
244 
#endif
 - 
 
245 
}
 - 
 
246 
 
 - 
 
247 
 
 - 
 
248 
/* Remove and process common command-line arguments */
 - 
 
249 
 
 - 
 
250 
void R_common_command_line(int *pac, char **argv, Rstart Rp)
 - 
 
251 
{
 - 
 
252 
    int ac = *pac, newac = 1; /* argv[0] is process name */
 - 
 
253 
    int ierr;
 - 
 
254 
    long value;
 - 
 
255 
    char *p, **av = argv, msg[1024];
 - 
 
256 
 
 - 
 
257 
    while(--ac) {
 - 
 
258 
	if(**++av == '-') {
 - 
 
259 
	    if (!strcmp(*av, "--version")) {
 - 
 
260 
		PrintVersion(msg);
 - 
 
261 
		R_ShowMessage(msg);
 - 
 
262 
		exit(0);
 - 
 
263 
	    }
 - 
 
264 
	    else if(!strcmp(*av, "--save")) {
 - 
 
265 
		Rp->SaveAction = SA_SAVE;
 - 
 
266 
	    }
 - 
 
267 
	    else if(!strcmp(*av, "--no-save")) {
 - 
 
268 
		Rp->SaveAction = SA_NOSAVE;
 - 
 
269 
	    }
 - 
 
270 
	    else if(!strcmp(*av, "--restore")) {
 - 
 
271 
		Rp->RestoreAction = SA_RESTORE;
 - 
 
272 
	    }
 - 
 
273 
	    else if(!strcmp(*av, "--no-restore")) {
 - 
 
274 
		Rp->RestoreAction = SA_NORESTORE;
 - 
 
275 
	    }
 - 
 
276 
	    else if (!strcmp(*av, "--silent") ||
 - 
 
277 
		     !strcmp(*av, "--quiet") ||
 - 
 
278 
		     !strcmp(*av, "-q")) {
 - 
 
279 
		Rp->R_Quiet = True;
 - 
 
280 
	    }
 - 
 
281 
	    else if (!strcmp(*av, "--vanilla")) {
 - 
 
282 
		Rp->SaveAction = SA_NOSAVE; /* --no-save */
 - 
 
283 
		Rp->RestoreAction = SA_NORESTORE; /* --no-restore */
 - 
 
284 
		Rp->LoadSiteFile = False; /* --no-site-file */
 - 
 
285 
		Rp->LoadInitFile = False; /* --no-init-file */
 - 
 
286 
	    }
 - 
 
287 
	    else if (!strcmp(*av, "--verbose")) {
 - 
 
288 
		Rp->R_Verbose = True;
 - 
 
289 
	    }
 - 
 
290 
	    else if (!strcmp(*av, "--slave") ||
 - 
 
291 
		     !strcmp(*av, "-s")) {
 - 
 
292 
		Rp->R_Quiet = True;
 - 
 
293 
		Rp->R_Slave = True;
 - 
 
294 
		Rp->SaveAction = SA_NOSAVE;
 - 
 
295 
	    }
 - 
 
296 
	    else if (!strcmp(*av, "--no-site-file")) {
 - 
 
297 
		Rp->LoadSiteFile = False;
 - 
 
298 
	    }
 - 
 
299 
	    else if (!strcmp(*av, "--no-init-file")) {
 - 
 
300 
		Rp->LoadInitFile = False;
 - 
 
301 
	    }
 - 
 
302 
	    else if (!strcmp(*av, "--debug-init")) {
 - 
 
303 
	        Rp->DebugInitFile = True;
 - 
 
304 
	    }
 - 
 
305 
	    else if (!strcmp(*av, "-save") ||
 - 
 
306 
		     !strcmp(*av, "-nosave") ||
 - 
 
307 
		     !strcmp(*av, "-restore") ||
 - 
 
308 
		     !strcmp(*av, "-norestore") ||
 - 
 
309 
		     !strcmp(*av, "-noreadline") ||
 - 
 
310 
		     !strcmp(*av, "-quiet") ||
 - 
 
311 
		     !strcmp(*av, "-V")) {
 - 
 
312 
		sprintf(msg, "WARNING: option %s no longer supported\n", *av);
 - 
 
313 
		R_ShowMessage(msg);
 - 
 
314 
	    }
 - 
 
315 
	    else if((value = (*av)[1] == 'v') || !strcmp(*av, "--vsize")) {
 - 
 
316 
		if(value)
 - 
 
317 
		    R_ShowMessage("WARNING: option `-v' is deprecated.  Use `--vsize' instead.\n");
 - 
 
318 
		if(!value || (*av)[2] == '\0') {
 - 
 
319 
		    ac--; av++; p = *av;
 - 
 
320 
		}
 - 
 
321 
		else p = &(*av)[2];
 - 
 
322 
		if (p == NULL) {
 - 
 
323 
		    R_ShowMessage("WARNING: no vsize given");
 - 
 
324 
		    break;
 - 
 
325 
		}
 - 
 
326 
		value = Decode2Long(p, &ierr);
 - 
 
327 
		if(ierr) {
 - 
 
328 
		    if(ierr < 0) goto badargs; /* if(*p) goto badargs; */
 - 
 
329 
		    sprintf(msg, "--vsize %ld'%c': too large", value,
 - 
 
330 
			     (ierr == 1) ? 'M': ((ierr == 2) ? 'K' : 'k'));
 - 
 
331 
		    R_ShowMessage(msg);
 - 
 
332 
		} else
 - 
 
333 
		    Rp->vsize = value;
 - 
 
334 
	    }
 - 
 
335 
	    else if((value = (*av)[1] == 'n') || !strcmp(*av, "--nsize")) {
 - 
 
336 
		if(value)
 - 
 
337 
		    R_ShowMessage("WARNING: option `-n' is deprecated.  "
 - 
 
338 
			     "Use `--nsize' instead.\n");
 - 
 
339 
		if(!value || (*av)[2] == '\0') {
 - 
 
340 
		    ac--; av++; p = *av;
 - 
 
341 
		}
 - 
 
342 
		else p = &(*av)[2];
 - 
 
343 
		if (p == NULL) {
 - 
 
344 
		    R_ShowMessage("WARNING: no nsize given");
 - 
 
345 
		    break;
 - 
 
346 
		}
 - 
 
347 
		value = Decode2Long(p, &ierr);
 - 
 
348 
		if(ierr) {
 - 
 
349 
		    if(ierr < 0) goto badargs;
 - 
 
350 
		    sprintf(msg, "--nsize %ld'%c': too large", value,
 - 
 
351 
			     (ierr == 1)?'M':((ierr == 2)?'K':'k'));
 - 
 
352 
		    R_ShowMessage(msg);
 - 
 
353 
		} else
 - 
 
354 
		    Rp->nsize = value;
 - 
 
355 
	    }
 - 
 
356 
	    else {
 - 
 
357 
		argv[newac++] = *av;
 - 
 
358 
		break;
 - 
 
359 
	    }
 - 
 
360 
	}
 - 
 
361 
	else {
 - 
 
362 
	    argv[newac++] = *av;
 - 
 
363 
	}
 - 
 
364 
    }
 - 
 
365 
    *pac = newac;
 - 
 
366 
    return;
 - 
 
367 
 
 - 
 
368 
badargs:
 - 
 
369 
    R_ShowMessage("invalid argument passed to R\n");
 - 
 
370 
    exit(1);
 - 
 
371 
}
 -