1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
/*
* COPYRIGHT (c) 1988-1994 BY *
* PARADIGM ASSOCIATES INCORPORATED, CAMBRIDGE, MASSACHUSETTS. *
* See the source file SLIB.C for more information. *
* Reorganization of files (Mar 1999) by Alan W Black <awb@cstr.ed.ac.uk>
* System functions
*/
#include <cstdio>
#include "siod.h"
#include "siodp.h"
#ifdef unix
#include <sys/time.h>
#include <unistd.h>
static long siod_time_base;
#endif
static LISP lgetenv(LISP name)
{
return rintern(getenv(get_c_string(name)));
}
static LISP lsetenv(LISP name,LISP value)
{
char *entry=walloc(char,strlen(get_c_string(name))+
strlen(get_c_string(value))+16);
sprintf(entry,"%s=%s",get_c_string(name),get_c_string(value));
putenv(entry);
return name;
}
static LISP lsystem(LISP name)
{
(void)system(get_c_string(name));
return NIL;
}
static LISP lpwd(void)
{
char *cwd;
cwd = getcwd(NULL,1024);
return cintern(cwd);
}
static LISP lchdir(LISP args, LISP env)
{
(void)env;
char *home;
if (siod_llength(args) == 0)
{
home = getenv("HOME");
chdir(home);
return rintern(home);
}
else
{
chdir(get_c_string(leval(car(args),env)));
return (car(args));
}
}
static LISP lgetpid(void)
{
return flocons((float)getpid());
}
LISP siod_time()
{
#ifdef unix
struct timeval tv;
struct timezone tz;
gettimeofday(&tv,&tz);
return flocons(((double)(tv.tv_sec-siod_time_base))+
((double)tv.tv_usec/1000000));
#else
return flocons(0);
#endif
}
void init_subrs_sys(void)
{
#ifdef unix
struct timeval tv;
struct timezone tz;
gettimeofday(&tv,&tz);
siod_time_base = tv.tv_sec;
#endif
init_subr_0("getpid",lgetpid,
"(getpid)\n\
Return process id.");
init_fsubr("cd",lchdir,
"(cd DIRNAME)\n\
Change directory to DIRNAME, if DIRNAME is nil or not specified \n\
change directory to user's HOME directory.");
init_subr_0("pwd",lpwd,
"(pwd)\n\
Returns current directory as a string.");
init_subr_1("getenv",lgetenv,
"(getenv VARNAME)\n\
Returns value of UNIX environment variable VARNAME, or nil if VARNAME\n\
is unset.");
init_subr_2("setenv",lsetenv,
"(setenv VARNAME VALUE)\n\
Set the UNIX environment variable VARNAME to VALUE.");
init_subr_1("system",lsystem,
"(system COMMAND)\n\
Execute COMMAND (a string) with the UNIX shell.");
init_subr_0("time", siod_time,
"(time)\n\
Returns number of seconds since start of epoch (if OS permits it\n\
countable).");
}
|
