scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

GC_PROTECT'ed the necessary variables (specifically, where >1 arg to 

a function 'may GC')
This commit is contained in:
steven-jenkins 2002-02-12 15:49:39 +00:00
parent 0025ee598b
commit 94d5ae9f71
5 changed files with 91 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
scsh/dirstuff1.c
View File

@ -19,10 +19,11 @@ s48_value open_dir(s48_value sch_dirname)
struct dirent *dirent;
DIR *d;
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))) )
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))
continue;
dirlist = s48_cons (s48_enter_string (dirent->d_name),
dirlist);
sch_d_name = s48_enter_string(dirent->d_name);
dirlist = s48_cons (sch_d_name, dirlist);
}
if (closedir(d) == -1)

37
scsh/flock1.c
View File

@ -34,21 +34,40 @@ s48_value get_lock(s48_value fd, s48_value cmd, s48_value type,
{
struct flock lock;
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_whence = s48_extract_integer (whence);
lock.l_start = s48_extract_integer (start);
lock.l_len = s48_extract_integer (len);
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);
return
s48_cons (s48_enter_integer (lock.l_type),
s48_cons (s48_enter_integer (lock.l_whence),
s48_cons (s48_enter_integer (lock.l_start),
s48_cons (s48_enter_integer (lock.l_len),
s48_cons
(s48_enter_integer (lock.l_pid),
S48_NULL)))));
} else {
sch_type = s48_enter_integer (lock.l_type);
sch_whence = s48_enter_integer (lock.l_whence);
sch_start = s48_enter_integer (lock.l_start);
sch_len = s48_enter_integer (lock.l_len);
sch_pid = s48_enter_integer (lock.l_pid);
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)

47
scsh/network1.c
View File

@ -523,9 +523,11 @@ s48_value host_ent2host_info (struct hostent * host)
{
s48_value host_info = S48_FALSE;
s48_value list = S48_FALSE;
s48_value sch_h_aliases = S48_UNSPECIFIC;
s48_value sch_h_addr_elt = S48_UNSPECIFIC;
long * ptr;
int i;
S48_DECLARE_GC_PROTECT (2);
S48_DECLARE_GC_PROTECT (4);
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");
}
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);
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;
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++;
i ++;
}
@ -560,9 +563,11 @@ s48_value host_ent2host_info (struct hostent * host)
i = 0;
while (*ptr)
{
sch_h_addr_elt =
s48_enter_unsigned_integer (ntohl ((unsigned long) *(long *)(host->h_addr_list[i])));
list =
s48_cons (s48_enter_unsigned_integer (ntohl ((unsigned long) *(long *)(host->h_addr_list[i]))),
list);
s48_cons (sch_h_addr_elt, list);
ptr++;
i++;
}
@ -609,9 +614,10 @@ s48_value netent2net_info(struct netent *net)
{
s48_value network_info = S48_FALSE;
s48_value list = S48_FALSE;
s48_value sch_n_alias = S48_UNSPECIFIC;
long * ptr;
int i;
S48_DECLARE_GC_PROTECT (2);
S48_DECLARE_GC_PROTECT (3);
if (net==NULL) return S48_FALSE;
@ -621,7 +627,7 @@ s48_value netent2net_info(struct netent *net)
network_info_type_binding =
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);
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;
i = 0;
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++;
i++;
}
@ -670,9 +677,10 @@ s48_value servent2service_info(struct servent *serv)
{
s48_value service_info = S48_FALSE;
s48_value list = S48_FALSE;
s48_value sch_s_alias = S48_UNSPECIFIC;
long * ptr;
int i;
S48_DECLARE_GC_PROTECT (2);
S48_DECLARE_GC_PROTECT (3);
if (serv==NULL) return S48_FALSE;
@ -682,7 +690,7 @@ s48_value servent2service_info(struct servent *serv)
service_info_type_binding =
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);
@ -693,9 +701,10 @@ s48_value servent2service_info(struct servent *serv)
i = 0;
while (*ptr)
{
list = s48_cons (s48_enter_string (serv->s_aliases[i]), list);
ptr++;
i++;
sch_s_alias = s48_enter_string (serv->s_aliases[i]);
list = s48_cons (sch_s_alias, list);
ptr++;
i++;
}
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 list = S48_FALSE;
s48_value sch_p_alias = S48_UNSPECIFIC;
long * ptr;
int i;
S48_DECLARE_GC_PROTECT (2);
@ -758,7 +768,7 @@ s48_value protoent2protocol_info(struct protoent *proto)
protocol_info_type_binding =
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);
@ -769,9 +779,10 @@ s48_value protoent2protocol_info(struct protoent *proto)
i = 0;
while (*ptr)
{
list = s48_cons (s48_enter_string (proto->p_aliases[i]), list);
ptr++;
i++;
sch_p_alias = s48_enter_string (proto->p_aliases[i]);
list = s48_cons (sch_p_alias, list);
ptr++;
i++;
}
S48_RECORD_SET (protocol_info, 1, list);

13
scsh/time1.c
View File

@ -113,19 +113,6 @@ s48_value scheme_time()
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:
** #f Local time
** int Offset from GMT in seconds.

46
scsh/tty1.c
View File

@ -29,14 +29,6 @@
#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)
/* int *iflag,
@ -48,19 +40,39 @@ s48_value scheme_tcgetattr(s48_value sch_fd, s48_value sch_control_chars)
struct termios t;
int result = tcgetattr(s48_extract_fixnum (sch_fd), &t);
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);
}
for (i = 0; i < NCCS; i++)
S48_STRING_SET(sch_control_chars, i, t.c_cc[i]);
return
s48_list_6 (s48_enter_integer (t.c_iflag),
s48_enter_integer (t.c_oflag),
s48_enter_integer (t.c_cflag),
s48_enter_integer (t.c_lflag),
s48_enter_integer (cfgetispeed(&t)),
s48_enter_integer (cfgetospeed(&t)));
{
sch_iflag = s48_enter_integer(t.c_iflag);
sch_oflag = s48_enter_integer(t.c_oflag);
sch_cflag = s48_enter_integer(t.c_cflag);
sch_lflag = s48_enter_integer(t.c_lflag);
sch_ispeed = cfgetispeed(&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...*/