GC_PROTECT'ed the necessary variables (specifically, where >1 arg to
a function 'may GC')
This commit is contained in:
parent
0025ee598b
commit
94d5ae9f71
|
@ -19,10 +19,11 @@ s48_value open_dir(s48_value sch_dirname)
|
||||||
struct dirent *dirent;
|
struct dirent *dirent;
|
||||||
DIR *d;
|
DIR *d;
|
||||||
s48_value dirlist = S48_NULL;
|
s48_value dirlist = S48_NULL;
|
||||||
|
s48_value sch_d_name = S48_UNSPECIFIC;
|
||||||
|
|
||||||
S48_DECLARE_GC_PROTECT(1);
|
S48_DECLARE_GC_PROTECT(2);
|
||||||
|
|
||||||
S48_GC_PROTECT_1(dirlist);
|
S48_GC_PROTECT_2(dirlist, sch_d_name);
|
||||||
|
|
||||||
if( NULL == (d = opendir(s48_extract_string (sch_dirname))) )
|
if( NULL == (d = opendir(s48_extract_string (sch_dirname))) )
|
||||||
s48_raise_os_error_1 (errno, sch_dirname);
|
s48_raise_os_error_1 (errno, sch_dirname);
|
||||||
|
@ -31,8 +32,8 @@ s48_value open_dir(s48_value sch_dirname)
|
||||||
if((strcmp(dirent->d_name,".") == 0) || (strcmp(dirent->d_name,"..") == 0))
|
if((strcmp(dirent->d_name,".") == 0) || (strcmp(dirent->d_name,"..") == 0))
|
||||||
continue;
|
continue;
|
||||||
|
|
||||||
dirlist = s48_cons (s48_enter_string (dirent->d_name),
|
sch_d_name = s48_enter_string(dirent->d_name);
|
||||||
dirlist);
|
dirlist = s48_cons (sch_d_name, dirlist);
|
||||||
|
|
||||||
}
|
}
|
||||||
if (closedir(d) == -1)
|
if (closedir(d) == -1)
|
||||||
|
|
|
@ -34,21 +34,40 @@ s48_value get_lock(s48_value fd, s48_value cmd, s48_value type,
|
||||||
{
|
{
|
||||||
struct flock lock;
|
struct flock lock;
|
||||||
int ret;
|
int ret;
|
||||||
|
s48_value sch_type = S48_UNSPECIFIC;
|
||||||
|
s48_value sch_whence = S48_UNSPECIFIC;
|
||||||
|
s48_value sch_start = S48_UNSPECIFIC;
|
||||||
|
s48_value sch_len = S48_UNSPECIFIC;
|
||||||
|
s48_value sch_pid = S48_UNSPECIFIC;
|
||||||
|
s48_value sch_retval = S48_UNSPECIFIC;
|
||||||
|
|
||||||
|
S48_DECLARE_GC_PROTECT(6);
|
||||||
|
|
||||||
|
S48_GC_PROTECT_6(sch_type, sch_whence, sch_start, sch_len,
|
||||||
|
sch_pid, sch_retval);
|
||||||
|
|
||||||
lock.l_type = s48_extract_integer (type);
|
lock.l_type = s48_extract_integer (type);
|
||||||
lock.l_whence = s48_extract_integer (whence);
|
lock.l_whence = s48_extract_integer (whence);
|
||||||
lock.l_start = s48_extract_integer (start);
|
lock.l_start = s48_extract_integer (start);
|
||||||
lock.l_len = s48_extract_integer (len);
|
lock.l_len = s48_extract_integer (len);
|
||||||
ret = fcntl(s48_extract_fixnum (fd), F_GETLK, &lock);
|
ret = fcntl(s48_extract_fixnum (fd), F_GETLK, &lock);
|
||||||
if (ret == -1)
|
if (ret == -1) {
|
||||||
|
S48_GC_UNPROTECT();
|
||||||
s48_raise_os_error_6 (errno, fd, cmd, type, whence, start, len);
|
s48_raise_os_error_6 (errno, fd, cmd, type, whence, start, len);
|
||||||
return
|
} else {
|
||||||
s48_cons (s48_enter_integer (lock.l_type),
|
|
||||||
s48_cons (s48_enter_integer (lock.l_whence),
|
sch_type = s48_enter_integer (lock.l_type);
|
||||||
s48_cons (s48_enter_integer (lock.l_start),
|
sch_whence = s48_enter_integer (lock.l_whence);
|
||||||
s48_cons (s48_enter_integer (lock.l_len),
|
sch_start = s48_enter_integer (lock.l_start);
|
||||||
s48_cons
|
sch_len = s48_enter_integer (lock.l_len);
|
||||||
(s48_enter_integer (lock.l_pid),
|
sch_pid = s48_enter_integer (lock.l_pid);
|
||||||
S48_NULL)))));
|
|
||||||
|
sch_retval = s48_list_5(sch_type, sch_whence, sch_start, sch_len,
|
||||||
|
sch_pid);
|
||||||
|
S48_GC_UNPROTECT();
|
||||||
|
|
||||||
|
return sch_retval;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
void s48_init_flock(void)
|
void s48_init_flock(void)
|
||||||
|
|
|
@ -523,9 +523,11 @@ s48_value host_ent2host_info (struct hostent * host)
|
||||||
{
|
{
|
||||||
s48_value host_info = S48_FALSE;
|
s48_value host_info = S48_FALSE;
|
||||||
s48_value list = S48_FALSE;
|
s48_value list = S48_FALSE;
|
||||||
|
s48_value sch_h_aliases = S48_UNSPECIFIC;
|
||||||
|
s48_value sch_h_addr_elt = S48_UNSPECIFIC;
|
||||||
long * ptr;
|
long * ptr;
|
||||||
int i;
|
int i;
|
||||||
S48_DECLARE_GC_PROTECT (2);
|
S48_DECLARE_GC_PROTECT (4);
|
||||||
|
|
||||||
if(host==NULL)
|
if(host==NULL)
|
||||||
{
|
{
|
||||||
|
@ -538,7 +540,7 @@ s48_value host_ent2host_info (struct hostent * host)
|
||||||
host_info_type_binding = s48_get_imported_binding ("host-info-type");
|
host_info_type_binding = s48_get_imported_binding ("host-info-type");
|
||||||
}
|
}
|
||||||
|
|
||||||
S48_GC_PROTECT_2 (host_info, list);
|
S48_GC_PROTECT_4 (host_info, list, sch_h_aliases, sch_h_addr_elt);
|
||||||
|
|
||||||
host_info = s48_make_record (host_info_type_binding);
|
host_info = s48_make_record (host_info_type_binding);
|
||||||
S48_RECORD_SET (host_info, 0, s48_enter_string (host->h_name));
|
S48_RECORD_SET (host_info, 0, s48_enter_string (host->h_name));
|
||||||
|
@ -548,7 +550,8 @@ s48_value host_ent2host_info (struct hostent * host)
|
||||||
i = 0;
|
i = 0;
|
||||||
while (*ptr)
|
while (*ptr)
|
||||||
{
|
{
|
||||||
list = s48_cons (s48_enter_string (host->h_aliases[i]), list);
|
sch_h_aliases = s48_enter_string (host->h_aliases[i]);
|
||||||
|
list = s48_cons (sch_h_aliases, list);
|
||||||
ptr++;
|
ptr++;
|
||||||
i ++;
|
i ++;
|
||||||
}
|
}
|
||||||
|
@ -560,9 +563,11 @@ s48_value host_ent2host_info (struct hostent * host)
|
||||||
i = 0;
|
i = 0;
|
||||||
while (*ptr)
|
while (*ptr)
|
||||||
{
|
{
|
||||||
|
sch_h_addr_elt =
|
||||||
|
s48_enter_unsigned_integer (ntohl ((unsigned long) *(long *)(host->h_addr_list[i])));
|
||||||
|
|
||||||
list =
|
list =
|
||||||
s48_cons (s48_enter_unsigned_integer (ntohl ((unsigned long) *(long *)(host->h_addr_list[i]))),
|
s48_cons (sch_h_addr_elt, list);
|
||||||
list);
|
|
||||||
ptr++;
|
ptr++;
|
||||||
i++;
|
i++;
|
||||||
}
|
}
|
||||||
|
@ -609,9 +614,10 @@ s48_value netent2net_info(struct netent *net)
|
||||||
{
|
{
|
||||||
s48_value network_info = S48_FALSE;
|
s48_value network_info = S48_FALSE;
|
||||||
s48_value list = S48_FALSE;
|
s48_value list = S48_FALSE;
|
||||||
|
s48_value sch_n_alias = S48_UNSPECIFIC;
|
||||||
long * ptr;
|
long * ptr;
|
||||||
int i;
|
int i;
|
||||||
S48_DECLARE_GC_PROTECT (2);
|
S48_DECLARE_GC_PROTECT (3);
|
||||||
|
|
||||||
if (net==NULL) return S48_FALSE;
|
if (net==NULL) return S48_FALSE;
|
||||||
|
|
||||||
|
@ -621,7 +627,7 @@ s48_value netent2net_info(struct netent *net)
|
||||||
network_info_type_binding =
|
network_info_type_binding =
|
||||||
s48_get_imported_binding ("network-info-type");
|
s48_get_imported_binding ("network-info-type");
|
||||||
}
|
}
|
||||||
S48_GC_PROTECT_2 (network_info, list);
|
S48_GC_PROTECT_3 (network_info, list, sch_n_alias);
|
||||||
|
|
||||||
network_info = s48_make_record (network_info_type_binding);
|
network_info = s48_make_record (network_info_type_binding);
|
||||||
S48_RECORD_SET (network_info, 0, s48_enter_string (net->n_name));
|
S48_RECORD_SET (network_info, 0, s48_enter_string (net->n_name));
|
||||||
|
@ -630,8 +636,9 @@ s48_value netent2net_info(struct netent *net)
|
||||||
list = S48_NULL;
|
list = S48_NULL;
|
||||||
i = 0;
|
i = 0;
|
||||||
while (*ptr)
|
while (*ptr)
|
||||||
{
|
{
|
||||||
list = s48_cons (s48_enter_string (net->n_aliases[i]), list);
|
sch_n_alias = s48_enter_string (net->n_aliases[i]);
|
||||||
|
list = s48_cons (sch_n_alias, list);
|
||||||
ptr++;
|
ptr++;
|
||||||
i++;
|
i++;
|
||||||
}
|
}
|
||||||
|
@ -670,9 +677,10 @@ s48_value servent2service_info(struct servent *serv)
|
||||||
{
|
{
|
||||||
s48_value service_info = S48_FALSE;
|
s48_value service_info = S48_FALSE;
|
||||||
s48_value list = S48_FALSE;
|
s48_value list = S48_FALSE;
|
||||||
|
s48_value sch_s_alias = S48_UNSPECIFIC;
|
||||||
long * ptr;
|
long * ptr;
|
||||||
int i;
|
int i;
|
||||||
S48_DECLARE_GC_PROTECT (2);
|
S48_DECLARE_GC_PROTECT (3);
|
||||||
|
|
||||||
if (serv==NULL) return S48_FALSE;
|
if (serv==NULL) return S48_FALSE;
|
||||||
|
|
||||||
|
@ -682,7 +690,7 @@ s48_value servent2service_info(struct servent *serv)
|
||||||
service_info_type_binding =
|
service_info_type_binding =
|
||||||
s48_get_imported_binding ("service-info-type");
|
s48_get_imported_binding ("service-info-type");
|
||||||
}
|
}
|
||||||
S48_GC_PROTECT_2 (service_info, list);
|
S48_GC_PROTECT_3 (service_info, list, sch_s_alias);
|
||||||
|
|
||||||
service_info = s48_make_record (service_info_type_binding);
|
service_info = s48_make_record (service_info_type_binding);
|
||||||
|
|
||||||
|
@ -693,9 +701,10 @@ s48_value servent2service_info(struct servent *serv)
|
||||||
i = 0;
|
i = 0;
|
||||||
while (*ptr)
|
while (*ptr)
|
||||||
{
|
{
|
||||||
list = s48_cons (s48_enter_string (serv->s_aliases[i]), list);
|
sch_s_alias = s48_enter_string (serv->s_aliases[i]);
|
||||||
ptr++;
|
list = s48_cons (sch_s_alias, list);
|
||||||
i++;
|
ptr++;
|
||||||
|
i++;
|
||||||
}
|
}
|
||||||
|
|
||||||
S48_RECORD_SET (service_info, 1, list);
|
S48_RECORD_SET (service_info, 1, list);
|
||||||
|
@ -746,6 +755,7 @@ s48_value protoent2protocol_info(struct protoent *proto)
|
||||||
{
|
{
|
||||||
s48_value protocol_info = S48_FALSE;
|
s48_value protocol_info = S48_FALSE;
|
||||||
s48_value list = S48_FALSE;
|
s48_value list = S48_FALSE;
|
||||||
|
s48_value sch_p_alias = S48_UNSPECIFIC;
|
||||||
long * ptr;
|
long * ptr;
|
||||||
int i;
|
int i;
|
||||||
S48_DECLARE_GC_PROTECT (2);
|
S48_DECLARE_GC_PROTECT (2);
|
||||||
|
@ -758,7 +768,7 @@ s48_value protoent2protocol_info(struct protoent *proto)
|
||||||
protocol_info_type_binding =
|
protocol_info_type_binding =
|
||||||
s48_get_imported_binding ("protocol-info-type");
|
s48_get_imported_binding ("protocol-info-type");
|
||||||
}
|
}
|
||||||
S48_GC_PROTECT_2 (protocol_info, list);
|
S48_GC_PROTECT_3 (protocol_info, list, sch_p_alias);
|
||||||
|
|
||||||
protocol_info = s48_make_record (protocol_info_type_binding);
|
protocol_info = s48_make_record (protocol_info_type_binding);
|
||||||
|
|
||||||
|
@ -769,9 +779,10 @@ s48_value protoent2protocol_info(struct protoent *proto)
|
||||||
i = 0;
|
i = 0;
|
||||||
while (*ptr)
|
while (*ptr)
|
||||||
{
|
{
|
||||||
list = s48_cons (s48_enter_string (proto->p_aliases[i]), list);
|
sch_p_alias = s48_enter_string (proto->p_aliases[i]);
|
||||||
ptr++;
|
list = s48_cons (sch_p_alias, list);
|
||||||
i++;
|
ptr++;
|
||||||
|
i++;
|
||||||
}
|
}
|
||||||
|
|
||||||
S48_RECORD_SET (protocol_info, 1, list);
|
S48_RECORD_SET (protocol_info, 1, list);
|
||||||
|
|
13
scsh/time1.c
13
scsh/time1.c
|
@ -113,19 +113,6 @@ s48_value scheme_time()
|
||||||
return s48_enter_integer (t);
|
return s48_enter_integer (t);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* should be part of the FFI interface */
|
|
||||||
s48_value s48_list_11 (s48_value e1, s48_value e2, s48_value e3,
|
|
||||||
s48_value e4, s48_value e5, s48_value e6,
|
|
||||||
s48_value e7, s48_value e8, s48_value e9,
|
|
||||||
s48_value e10, s48_value e11)
|
|
||||||
{
|
|
||||||
return
|
|
||||||
s48_cons (e1, s48_cons (e2, s48_cons (e3, s48_cons (e4, s48_cons
|
|
||||||
(e5, s48_cons (e6, s48_cons (e7, s48_cons (e8, s48_cons (e9,
|
|
||||||
s48_cons (e10, s48_cons (e11, S48_NULL)))))))))));
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
/* Zone:
|
/* Zone:
|
||||||
** #f Local time
|
** #f Local time
|
||||||
** int Offset from GMT in seconds.
|
** int Offset from GMT in seconds.
|
||||||
|
|
46
scsh/tty1.c
46
scsh/tty1.c
|
@ -29,14 +29,6 @@
|
||||||
#include "tty1.h" /* Make sure the .h interface agrees with the code. */
|
#include "tty1.h" /* Make sure the .h interface agrees with the code. */
|
||||||
|
|
||||||
/*****************************************************************************/
|
/*****************************************************************************/
|
||||||
/* should be part of the FFI interface */
|
|
||||||
s48_value s48_list_6 (s48_value e1, s48_value e2, s48_value e3,
|
|
||||||
s48_value e4, s48_value e5, s48_value e6)
|
|
||||||
{
|
|
||||||
return
|
|
||||||
s48_cons (e1, s48_cons (e2, s48_cons (e3, s48_cons (e4, s48_cons
|
|
||||||
(e5, s48_cons (e6, S48_NULL))))));
|
|
||||||
}
|
|
||||||
|
|
||||||
s48_value scheme_tcgetattr(s48_value sch_fd, s48_value sch_control_chars)
|
s48_value scheme_tcgetattr(s48_value sch_fd, s48_value sch_control_chars)
|
||||||
/* int *iflag,
|
/* int *iflag,
|
||||||
|
@ -48,19 +40,39 @@ s48_value scheme_tcgetattr(s48_value sch_fd, s48_value sch_control_chars)
|
||||||
struct termios t;
|
struct termios t;
|
||||||
int result = tcgetattr(s48_extract_fixnum (sch_fd), &t);
|
int result = tcgetattr(s48_extract_fixnum (sch_fd), &t);
|
||||||
int i;
|
int i;
|
||||||
|
s48_value sch_iflag = S48_UNSPECIFIC;
|
||||||
|
s48_value sch_oflag = S48_UNSPECIFIC;
|
||||||
|
s48_value sch_cflag = S48_UNSPECIFIC;
|
||||||
|
s48_value sch_lflag = S48_UNSPECIFIC;
|
||||||
|
s48_value sch_ispeed = S48_UNSPECIFIC;
|
||||||
|
s48_value sch_ospeed = S48_UNSPECIFIC;
|
||||||
|
s48_value sch_retval = S48_UNSPECIFIC;
|
||||||
|
S48_DECLARE_GC_PROTECT(6);
|
||||||
|
|
||||||
if (result == -1)
|
S48_GC_PROTECT_6(sch_iflag, sch_oflag, sch_cflag, sch_lflag, sch_ispeed,
|
||||||
|
sch_ospeed);
|
||||||
|
|
||||||
|
if (result == -1) {
|
||||||
|
S48_GC_UNPROTECT();
|
||||||
s48_raise_os_error_2 (errno, sch_fd, sch_control_chars);
|
s48_raise_os_error_2 (errno, sch_fd, sch_control_chars);
|
||||||
|
}
|
||||||
|
|
||||||
for (i = 0; i < NCCS; i++)
|
for (i = 0; i < NCCS; i++)
|
||||||
S48_STRING_SET(sch_control_chars, i, t.c_cc[i]);
|
S48_STRING_SET(sch_control_chars, i, t.c_cc[i]);
|
||||||
return
|
{
|
||||||
s48_list_6 (s48_enter_integer (t.c_iflag),
|
sch_iflag = s48_enter_integer(t.c_iflag);
|
||||||
s48_enter_integer (t.c_oflag),
|
sch_oflag = s48_enter_integer(t.c_oflag);
|
||||||
s48_enter_integer (t.c_cflag),
|
sch_cflag = s48_enter_integer(t.c_cflag);
|
||||||
s48_enter_integer (t.c_lflag),
|
sch_lflag = s48_enter_integer(t.c_lflag);
|
||||||
s48_enter_integer (cfgetispeed(&t)),
|
sch_ispeed = cfgetispeed(&t);
|
||||||
s48_enter_integer (cfgetospeed(&t)));
|
sch_ospeed = cfgetospeed(&t);
|
||||||
|
|
||||||
|
sch_retval = s48_list_6 (sch_iflag, sch_oflag, sch_cflag, sch_lflag,
|
||||||
|
sch_ispeed, sch_ospeed);
|
||||||
|
S48_GC_UNPROTECT();
|
||||||
|
|
||||||
|
return sch_retval;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/* The Scheme caller of this is commented out...*/
|
/* The Scheme caller of this is commented out...*/
|
||||||
|
|
Loading…
Reference in New Issue