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