Added a whole bunch of .h files describing the module structure of the C

files. These files mostly mediate between the C source (export) and
the corresponding C stub files (import) generated by the Scheme files
calling the C routines.

This provided much better argument type checking that before; lots of
small bugs were caught.

Also added const keywords wherever I could find a reasonable place
to improve error detection and efficiency.

Tuned up the makefile to reflect all of this structure. Its dependencies
were pretty out-of-date as it was. It could probably use further work.
This commit is contained in:
shivers 1995-10-22 12:34:53 +00:00
parent bd33154d9a
commit 7c90829350
32 changed files with 455 additions and 128 deletions

View File

@ -11,6 +11,9 @@
#include "libcig.h"
#include "scsh_aux.h"
/* Make sure our exports match up w/the implementation: */
#include "dirstuff1.h"
extern int errno;
/* Linked list of malloc'd entries. */
@ -33,7 +36,7 @@ void free_dirent_list(scm_dirent_t *entry)
** fnames is a vector of strings (filenames), null terminated.
** len is the length of fnames.
*/
int open_dir(char *dirname, char ***fnames, int *len)
int open_dir(const char *dirname, char ***fnames, int *len)
{
scm_dirent_t *dep, *entries;
struct dirent *dirent;
@ -91,14 +94,15 @@ int open_dir(char *dirname, char ***fnames, int *len)
static int compare_fname(const void *aptr, const void *bptr)
{
char *a= *(char**)aptr, *b = *(char**)bptr;
char const *a = * (char const * *) aptr;
char const *b = * (char const * *) bptr;
if( DOTFILE(a) )
return DOTFILE(b) ? strcmp(a+1,b+1) : -1;
return DOTFILE(b) ? 1 : strcmp(a,b);
}
void scm_sort_filevec(char **dirvec, int nelts)
void scm_sort_filevec(const char **dirvec, int nelts)
{
qsort((char *) dirvec, nelts, sizeof(char*), compare_fname);
}
@ -119,7 +123,8 @@ void scm_sort_filevec(char **dirvec, int nelts)
static int comp1(const void *aptr, const void* bptr)
{
char *a = *(char**)aptr, *b = *(char**)bptr;
char const *a = *(char const **)aptr;
char const *b = *(char const **)bptr;
if(streq(a,b)) return 0;

4
scsh/dirstuff1.h Normal file
View File

@ -0,0 +1,4 @@
/* Exports from dirstuff1.c. */
int open_dir(const char *dirname, char ***fnames, int *len);
void scm_sort_filevec(const char **dirvec, int nelts);

View File

@ -29,6 +29,9 @@
#define NUM_FDPORTS 256
#include "fdports.h"
/* Make sure our exports match up w/the implementation: */
#include "fdports1.h"
extern int errno;
/* Maps fd's to FILE*'s. */
@ -62,7 +65,7 @@ scheme_value maybe_fdes2port(int fd)
#if 0
/* Bogus old code. We now compute the mode string from the actual fd. */
static char *mode2string(int mode)
static char const *mode2string(int mode)
{
if( mode == 0 ) return "r";
else if( mode == 1 ) return "w";
@ -71,7 +74,7 @@ static char *mode2string(int mode)
}
#endif
static char *fdes_modestr(int fd)
static char const *fdes_modestr(int fd)
{
int flags = fcntl(fd,F_GETFL);
@ -141,7 +144,7 @@ int flush_all_ports(void)
/* return fflush(NULL) ? errno : 0; THE REAL SOLUTION.*/
}
int seek_fdport(scheme_value data, int offset, int whence, int *newpos)
int seek_fdport(scheme_value data, off_t offset, int whence, int *newpos)
{
FILE *f = fstar_cache[EXTRACT_FIXNUM(*PortData_Fd(data))];
*PortData_Peek(data) = SCHFALSE; /* Flush buffered data. */
@ -185,6 +188,15 @@ int close_fdport(scheme_value port_data)
else return EBADF; /* Already closed. */
}
static int cloexec_fdport(scheme_value port_data)
{
int fd = EXTRACT_FIXNUM(*PortData_Fd(port_data));
return fcntl(fd, F_SETFD, FD_CLOEXEC) ? errno : 0;
}
/* Set all the unrevealed ports to close-on-exec.
This is called right before an exec, which is sleazy;
we should have the port-revealing machinery set and reset
@ -202,18 +214,11 @@ void cloexec_unrevealed(void)
}
}
int cloexec_fdport(scheme_value port_data)
{
int fd = EXTRACT_FIXNUM(*PortData_Fd(port_data));
return fcntl(fd, F_SETFD, FD_CLOEXEC) ? errno : 0;
}
int install_port(int fd, scheme_value port)
{
FILE *stream;
char *modestr;
const char *modestr;
if( fd < 0 || fd >= NUM_FDPORTS ) return -1;
if( fdports[fd] != SCHFALSE ) return -2;
@ -225,20 +230,19 @@ int install_port(int fd, scheme_value port)
if( fstar_cache[fd] ) return 0; /* A hack mainly for stdio. */
fstar_cache[fd] = stream = fdopen(fd, modestr);
return stream == NULL ? errno : 0;
return stream ? 0 : errno;
}
FILE *fdes2fstar(int fd)
{
char *modestr;
if( fstar_cache[fd] ) return fstar_cache[fd];
if( !(modestr=fdes_modestr(fd)) ) return NULL;
return fdopen(fd, modestr);
else {
const char *modestr = fdes_modestr(fd);
return modestr ? fdopen(fd, modestr) : NULL;
}
}
/* fd_from's FILE* structure is changed to be fd_to's FILE* structure.
** So buffered data isn't lost. Return 0 on failure.
** Rather non-portable.
@ -392,8 +396,9 @@ int write_fdport_substring(scheme_value buf, int start, int end, scheme_value da
** termination.
*/
int read_delim(const char *delims, char *buf, int gobble, scheme_value port,
int start, int end, int *nread)
scheme_value read_delim(const char *delims, char *buf, int gobble,
scheme_value port, int start, int end,
int *nread)
{
scheme_value data = *Port_PortData(port);

41
scsh/fdports1.h Normal file
View File

@ -0,0 +1,41 @@
/* Exports from fdports1.c. */
void init_fdports(void);
scheme_value maybe_fdes2port(int fd);
scheme_value fdport_getchar(scheme_value data);
int fdport_putchar(scheme_value data, char c);
scheme_value fdport_char_readyp(scheme_value data);
int flush_fdport(scheme_value data);
int flush_all_ports(void);
int seek_fdport(scheme_value data, off_t offset, int whence, int *newpos);
int tell_fdport( scheme_value data, int *newpos );
int set_fdbuf( scheme_value data, int policy, int bufsize );
int close_fdport(scheme_value port_data);
void cloexec_unrevealed(void);
int install_port(int fd, scheme_value port);
FILE *fdes2fstar(int fd);
int move_fdport(int fd, scheme_value port, int new_revealed);
void post_gc_fdports(void);
int read_fdport_substring(scheme_value buf, int start, int end, scheme_value data);
int write_fdport_substring(scheme_value buf, int start, int end, scheme_value data);
scheme_value read_delim(const char *delims, char *buf, int gobble,
scheme_value port, int start, int end,
int *nread);

View File

@ -12,6 +12,9 @@
extern int errno;
/* Make sure foreign-function stubs interface to the C funs correctly: */
#include "flock1.h"
#define errno_or_false(x) (((x) == -1) ? ENTER_FIXNUM(errno) : SCHFALSE)
scheme_value df_set_lock(long nargs, scheme_value *args)

View File

@ -15,6 +15,9 @@
""
"extern int errno;"
""
"/* Make sure foreign-function stubs interface to the C funs correctly: */"
"#include \"flock1.h\""
""
"#define errno_or_false(x) (((x) == -1) ? ENTER_FIXNUM(errno) : SCHFALSE)"
"" "")

View File

@ -9,6 +9,9 @@
#include <unistd.h>
#include <fcntl.h>
/* Make sure our exports match up w/the implementation: */
#include "flock1.h"
int set_lock(int fd, int cmd, int type, int whence, int start, int len)
{
struct flock lock;

5
scsh/flock1.h Normal file
View File

@ -0,0 +1,5 @@
/* Exports from flock1.c. */
int set_lock(int fd, int cmd, int type, int whence, int start, int len);
int get_lock(int fd, int cmd, int type, int whence, int start, int len,
int *rtype, int *rwhence, int *rstart, int *rlen, int *rpid);

View File

@ -9,6 +9,8 @@
#include <sys/types.h>
#include <sys/socket.h>
/* Make sure foreign-function stubs interface to the C funs correctly: */
#include "network1.h"
extern int errno;
extern int h_errno;
@ -289,14 +291,14 @@ scheme_value df_scheme_net_address2net_info(long nargs, scheme_value *args)
scheme_value df_scheme_net_name2net_info(long nargs, scheme_value *args)
{
extern int scheme_net_name2net_info(const char *, const char *, char **, char** *);
extern int scheme_net_name2net_info(const char *, scheme_value , char **, char** *);
scheme_value ret1;
int r1;
char *r2;
char** r3;
cig_check_nargs(3, nargs, "scheme_net_name2net_info");
r1 = scheme_net_name2net_info(cig_string_body(args[2]), cig_string_body(args[1]), &r2, &r3);
r1 = scheme_net_name2net_info(cig_string_body(args[2]), args[1], &r2, &r3);
ret1 = False_on_zero(r1);
{AlienVal(CAR(VECTOR_REF(*args,0))) = (long) r2; CDR(VECTOR_REF(*args,0)) = strlen_or_false(r2);}
AlienVal(VECTOR_REF(*args,1)) = (long) r3;
@ -381,22 +383,22 @@ scheme_value df_scheme_proto_name2proto_info(long nargs, scheme_value *args)
scheme_value df_veclen(long nargs, scheme_value *args)
{
extern scheme_value veclen(long* );
extern scheme_value veclen(const long * );
scheme_value ret1;
scheme_value r1;
cig_check_nargs(1, nargs, "veclen");
r1 = veclen((long* )AlienVal(args[0]));
r1 = veclen((const long * )AlienVal(args[0]));
ret1 = r1;
return ret1;
}
scheme_value df_set_longvec_carriers(long nargs, scheme_value *args)
{
extern void set_longvec_carriers(scheme_value , char** );
extern void set_longvec_carriers(scheme_value , long const * const * );
cig_check_nargs(2, nargs, "set_longvec_carriers");
set_longvec_carriers(args[1], (char** )AlienVal(args[0]));
set_longvec_carriers(args[1], (long const * const * )AlienVal(args[0]));
return SCHFALSE;
}

View File

@ -8,6 +8,8 @@
"#include <sys/types.h>"
"#include <sys/socket.h>"
""
"/* Make sure foreign-function stubs interface to the C funs correctly: */"
"#include \"network1.h\""
""
"extern int errno;"
"extern int h_errno;"
@ -781,9 +783,7 @@
(string->integer net))))))
(define-foreign %net-address->network-info
(scheme_net_address2net_info
(string-desc name)
(string-desc net))
(scheme_net_address2net_info (string-desc name) (string-desc net))
(to-scheme integer "False_on_zero")
static-string ; net name
(C char**)) ; alias list
@ -801,9 +801,7 @@
(string->integer net))))))
(define-foreign %net-name->network-info
(scheme_net_name2net_info
(string name)
(string net))
(scheme_net_name2net_info (string name) (string-desc net))
(to-scheme integer "False_on_zero")
static-string ; net name
(C char**)) ; alias list
@ -839,9 +837,7 @@
protocol))))))
(define-foreign %service-port->service-info
(scheme_serv_port2serv_info
(integer name)
(string proto))
(scheme_serv_port2serv_info (integer name) (string proto))
(to-scheme integer "False_on_zero")
static-string ; service name
(C char**) ; alias list
@ -864,9 +860,7 @@
protocol)))))
(define-foreign %service-name->service-info
(scheme_serv_name2serv_info
(string name)
(string proto))
(scheme_serv_name2serv_info (string name) (string proto))
(to-scheme integer "False_on_zero")
static-string ; service name
(C char**) ; alias list
@ -954,12 +948,13 @@
;; also from cig/libcig.scm
(define-foreign %c-veclen-or-false
(veclen ((C long*) c-vec)) ; redefining can we open cig-aux?
(veclen ((C "const long * ~a") c-vec)); redefining can we open cig-aux?
desc) ; integer or #f if arg is NULL.
;; also from cig/libcig.scm
(define-foreign %set-long-vector-carriers!
(set_longvec_carriers (vector-desc svec) ((C char**) cvec))
(set_longvec_carriers (vector-desc svec)
((C "long const * const * ~a") cvec))
ignore)
;; also from cig/libcig.scm

View File

@ -17,6 +17,9 @@
#include <string.h>
#include <stdio.h>
/* Make sure our exports match up w/the implementation: */
#include "network1.h"
extern int h_errno;
/* to extract a 4 byte long value from a scheme string */
@ -396,7 +399,7 @@ int scheme_host_address2host_info(scheme_value scheme_name,
return(0);
}
int scheme_host_name2host_info(char* scheme_name,
int scheme_host_name2host_info(const char* scheme_name,
char** hostname,
char*** aliases,
char*** addresses)
@ -448,8 +451,8 @@ int scheme_net_address2net_info(scheme_value scheme_name,
return(0);
}
int scheme_net_name2net_info(char* scheme_name,
char* scheme_net,
int scheme_net_name2net_info(const char* scheme_name,
scheme_value scheme_net,
char** netname,
char*** aliases)
{
@ -464,19 +467,21 @@ int scheme_net_name2net_info(char* scheme_name,
*netname=net->n_name;
*aliases=net->n_aliases;
SET_LONG(scheme_net,0,net->n_net);
SET_LONG(scheme_net,0,net->n_net); /* ??? -Olin */
return(0);
}
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
/* Routines for looking up services */
/*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
int scheme_serv_port2serv_info(u_short in_port,
char* in_proto,
char** out_servname,
char*** out_aliases,
int* out_port,
char** out_protocol)
/* in_port should be declared u_short, but cig doesn't know about them. */
int scheme_serv_port2serv_info(int in_port,
const char* in_proto,
char** out_servname,
char*** out_aliases,
int* out_port,
char** out_protocol)
{
struct servent *serv;
@ -498,8 +503,8 @@ int scheme_serv_port2serv_info(u_short in_port,
return(0);
}
int scheme_serv_name2serv_info(char* in_name,
char* in_proto,
int scheme_serv_name2serv_info(const char* in_name,
const char* in_proto,
char** out_servname,
char*** out_aliases,
int* out_port,
@ -549,7 +554,7 @@ int scheme_proto_num2proto_info(int in_proto,
return(0);
}
int scheme_proto_name2proto_info(char* in_name,
int scheme_proto_name2proto_info(const char* in_name,
char** out_protoname,
char*** out_aliases,
int* out_protocol)
@ -595,9 +600,9 @@ void set_longvec_carriers(scheme_value svec, long const * const * cvec)
** The terminating null is not counted. Returns #f on NULL.
*/
scheme_value veclen(long *vec)
scheme_value veclen(const long *vec)
{
long *vptr = vec;
const long *vptr = vec;
if( !vptr ) return SCHFALSE;
while( *vptr ) vptr++;
return ENTER_FIXNUM(vptr - vec);

99
scsh/network1.h Normal file
View File

@ -0,0 +1,99 @@
/* Exports from network1.c. */
int scheme_bind(int sockfd, int family, scheme_value scheme_name);
int scheme_connect(int sockfd, int family, scheme_value scheme_name);
int scheme_accept(int sockfd, int family, scheme_value scheme_name);
int scheme_peer_name(int sockfd, int family, scheme_value scheme_name);
int scheme_socket_name(int sockfd, int family, scheme_value scheme_name);
int scheme_socket_pair(int type, int *s1, int *s2);
int recv_substring(int s, int flags, scheme_value buf,
int start, int end, scheme_value scheme_name);
int send_substring(int s, int flags, scheme_value buf, int start, int end,
int family, scheme_value scheme_name);
int scheme_getsockopt (int s, int level, int optname);
int scheme_getsockopt_linger (int s,
int level,
int optname,
int *out_time);
int scheme_getsockopt_timeout (int s,
int level,
int optname,
int *out_usec);
int scheme_setsockopt (int s,
int level,
int optname,
int optval);
int scheme_setsockopt_linger (int s,
int level,
int optname,
int onoff,
int linger);
int scheme_setsockopt_timeout (int s,
int level,
int optname,
int sec,
int usec);
int scheme_host_address2host_info(scheme_value scheme_name,
char** hostname,
char*** aliases,
char*** addresses);
int scheme_host_name2host_info(const char* scheme_name,
char** hostname,
char*** aliases,
char*** addresses);
int scheme_net_address2net_info(scheme_value scheme_name,
scheme_value scheme_net,
char** netname,
char*** aliases);
int scheme_net_name2net_info(const char* scheme_name,
scheme_value scheme_net,
char** netname,
char*** aliases);
/* in_port should be declared u_short, but cig doesn't know about them. */
int scheme_serv_port2serv_info(int in_port,
const char* in_proto,
char** out_servname,
char*** out_aliases,
int* out_port,
char** out_protocol);
int scheme_serv_name2serv_info(const char* in_name,
const char* in_proto,
char** out_servname,
char*** out_aliases,
int* out_port,
char** out_protocol);
int scheme_proto_num2proto_info(int in_proto,
char** out_protoname,
char*** out_aliases,
int* out_protocol);
int scheme_proto_name2proto_info(const char* in_name,
char** out_protoname,
char*** out_aliases,
int* out_protocol);
void set_longvec_carriers(scheme_value svec, long const * const * cvec);
scheme_value veclen(const long *vec);

View File

@ -25,10 +25,11 @@ extern char **environ;
/* Internal utility.
** Copy the entire env to a new block, and add the new definition.
** Drop the old block on the floor; can't free() it.
** Return 0 if win
** non-zero if the malloc fails.
*/
static int append_envvar(const char *str, int old_envsize)
static int append_envvar(char *str, int old_envsize)
{
char **envp, **nenvp;
char **newenv = Malloc(char*, 1+old_envsize);
@ -56,12 +57,14 @@ static int append_envvar(const char *str, int old_envsize)
** another putenv() call), so altering str changes the environment.
**
** Malloc is used to allocate new environ vectors.
** In neither replacement strategy are we able to free() the unused
** storage; it is simply dropped on the floor.
** Putenv returns
** 0 if it wins;
** non-zero if str doesn't contain an '=' char or if the malloc fails.
*/
int putenv(const char *str)
int putenv(char *str)
{
char **envp = environ;
char *equalsign = strchr(str, '=');

View File

@ -6,6 +6,11 @@
#include <stdlib.h> /* For malloc. */
#include "libcig.h"
#include <sys/types.h>
/* Make sure foreign-function stubs interface to the C funs correctly: */
#include "fdports1.h"
scheme_value df_read_delim(long nargs, scheme_value *args)
{
extern scheme_value read_delim(const char *, char *, int , scheme_value , int , int , int *);

View File

@ -195,6 +195,13 @@
(lp (+ i 1))))))))))
(foreign-source
"#include <sys/types.h>"
""
"/* Make sure foreign-function stubs interface to the C funs correctly: */"
"#include \"fdports1.h\""
"" "")
(define-foreign %read-delimited-fdport!/errno (read_delim (string delims)
(var-string buf)
(bool gobble?)

View File

@ -6,6 +6,9 @@
#include <stdlib.h> /* For malloc. */
#include "libcig.h"
/* Make sure foreign-function stubs interface to the C funs correctly: */
#include "re1.h"
scheme_value df_reg_match(long nargs, scheme_value *args)
{
extern char *reg_match(const char *, const char *, int , scheme_value , scheme_value , int *);
@ -21,3 +24,18 @@ scheme_value df_reg_match(long nargs, scheme_value *args)
return ret1;
}
scheme_value df_filter_stringvec(long nargs, scheme_value *args)
{
extern char *filter_stringvec(const char *, char const ** , int *);
scheme_value ret1;
char *r1;
int r2;
cig_check_nargs(3, nargs, "filter_stringvec");
r1 = filter_stringvec(cig_string_body(args[2]), (char const ** )AlienVal(args[1]), &r2);
ret1 = VECTOR_REF(*args,0);
{AlienVal(CAR(ret1)) = (long) r1; CDR(ret1) = strlen_or_false(r1);}
VECTOR_REF(*args,1) = ENTER_FIXNUM(r2);
return ret1;
}

View File

@ -1,6 +1,12 @@
;;; Regular expression matching for scsh
;;; Copyright (c) 1994 by Olin Shivers.
(foreign-source
"/* Make sure foreign-function stubs interface to the C funs correctly: */"
"#include \"re1.h\""
"" ""
)
(define-record regexp-match
string
start ; 10 elt vec
@ -65,3 +71,12 @@
start-vec end-vec)
(if (not (equal? err "")) (error err %regexp-match)
match?)))
;;; I do this one in C, I'm not sure why:
;;; Used by MATCH-FILES.
(define-foreign %filter-C-strings!
(filter_stringvec (string regexp) ((C "char const ** ~a") cvec))
static-string ; error message -- #f if no error.
integer) ; number of files that pass the filter.

6
scsh/re1.h Normal file
View File

@ -0,0 +1,6 @@
char *reg_match(const char *re, const char *string, int start,
scheme_value start_vec, scheme_value end_vec,
int *hit);
char *filter_stringvec(const char *re, char const **stringvec,
int *nummatch);

View File

@ -48,7 +48,8 @@
(open defenum-package scheme)
(files (machine bufpol)))
(define-structure scsh-regexp-package scsh-regexp-interface
(define-structures ((scsh-regexp-package scsh-regexp-interface)
(scsh-regexp-internals (export %filter-C-strings!)))
(open defrec-package
scsh-utilities
define-foreign-syntax
@ -169,6 +170,7 @@
weak
scsh-regexp-package
scsh-regexp-internals
char-set-package
scsh-version
tty-flags

View File

@ -6,6 +6,9 @@
#include <stdlib.h> /* For malloc. */
#include "libcig.h"
/* Make sure foreign-function stubs interface to the C funs correctly: */
#include "select1.h"
scheme_value df_scm_select(long nargs, scheme_value *args)
{
extern scheme_value scm_select(scheme_value , scheme_value , scheme_value , scheme_value , int *, int *, int *);

View File

@ -1,6 +1,11 @@
;;; select(2) syscall for scsh. -*- Scheme -*-
;;; Copyright (c) 1995 by Olin Shivers.
(foreign-source
"/* Make sure foreign-function stubs interface to the C funs correctly: */"
"#include \"select1.h\""
"" "")
;;; TIMEOUT is 0 for immediate, >0 for timeout, #f for infinite;
;;; default is #f.
;;; The sets are vectors of file descriptors & fd ports.

View File

@ -2,12 +2,6 @@
** Copyright (c) 1995 by Olin Shivers.
*/
/* To do:
** - Documentation.
** - Check Posix timeval defn.
** - What is proper include for error vals?
*/
#include "sysdep.h"
#include <sys/types.h>
@ -19,8 +13,12 @@
#include <errno.h>
#include <stdio.h>
#include "fdports.h" /* Accessors for Scheme I/O port internals. */
#include "cstuff.h"
#include "fdports.h" /* Accessors for Scheme I/O port internals. */
#include "fdports1.h" /* Import fdes2fstar(). */
/* Make sure our exports match up w/the implementation: */
#include "select1.h"
/* the traditional sleazy max non-function. */
#define max(a,b) (((a) > (b)) ? (a) : (b))
@ -33,7 +31,7 @@ static int copyback_fdvec(scheme_value portvec, fd_set *fdset);
/* RVEC, WVEC, and EVEC are Scheme vectors of integer file descriptors
** and I/O ports. NSECS is an integer timeout value, or #f for infinite wait.
** Do the select() call. Move every element of we hit on to the front of
** Do the select() call. Move every element we hit on to the front of
** its vector. The number of hits are returned in R_NUMRDY, W_NUMRDY, and
** E_NUMRDY. The principle return value is #f if we win, and a fixnum errno
** value if we error out.
@ -193,4 +191,3 @@ static void or2_fdset(fd_set *x, fd_set *y, int max_elt)
for(i=max_elt+1; --i >= 0;)
if( FD_ISSET(i,y) ) FD_SET(i,x);
}

5
scsh/select1.h Normal file
View File

@ -0,0 +1,5 @@
/* Exports from select1.c. */
scheme_value scm_select(scheme_value rvec, scheme_value wvec,
scheme_value evec, scheme_value nsecs,
int *r_numrdy, int *w_numrdy, int *e_numrdy);

View File

@ -16,6 +16,13 @@
#include <pwd.h>
#include <unistd.h>
/* Make sure foreign-function stubs interface to the C funs correctly: */
#include "dirstuff1.h"
#include "fdports1.h"
#include "select1.h"
#include "syscalls1.h"
#include "userinfo1.h"
extern int errno;
#define errno_on_zero_or_false(x) ((x) ? SCHFALSE : ENTER_FIXNUM(errno))
@ -829,28 +836,13 @@ scheme_value df_open_dir(long nargs, scheme_value *args)
scheme_value df_scm_sort_filevec(long nargs, scheme_value *args)
{
extern void scm_sort_filevec(char** , int );
extern void scm_sort_filevec(const char** , int );
cig_check_nargs(2, nargs, "scm_sort_filevec");
scm_sort_filevec((char** )AlienVal(args[1]), EXTRACT_FIXNUM(args[0]));
scm_sort_filevec((const char** )AlienVal(args[1]), EXTRACT_FIXNUM(args[0]));
return SCHFALSE;
}
scheme_value df_filter_stringvec(long nargs, scheme_value *args)
{
extern char *filter_stringvec(const char *, char** , int *);
scheme_value ret1;
char *r1;
int r2;
cig_check_nargs(3, nargs, "filter_stringvec");
r1 = filter_stringvec(cig_string_body(args[2]), (char** )AlienVal(args[1]), &r2);
ret1 = VECTOR_REF(*args,0);
{AlienVal(CAR(ret1)) = (long) r1; CDR(ret1) = strlen_or_false(r1);}
VECTOR_REF(*args,1) = ENTER_FIXNUM(r2);
return ret1;
}
scheme_value df_scm_envvec(long nargs, scheme_value *args)
{
extern char** scm_envvec(int *);

View File

@ -16,6 +16,13 @@
"#include <pwd.h>"
"#include <unistd.h>"
""
"/* Make sure foreign-function stubs interface to the C funs correctly: */"
"#include \"dirstuff1.h\""
"#include \"fdports1.h\""
"#include \"select1.h\""
"#include \"syscalls1.h\""
"#include \"userinfo1.h\""
""
"extern int errno;"
""
"#define errno_on_zero_or_false(x) ((x) ? SCHFALSE : ENTER_FIXNUM(errno))"
@ -233,6 +240,7 @@
;;; PROCESS TIMES
;;; OOPS: The POSIX times() has a mildly useful ret value we are throwing away.
;;; OOPS: The ret values should be clock_t, not int, but cig can't handle it.
(define-foreign process-times/errno (process_times)
(to-scheme integer errno_or_false)
@ -814,7 +822,7 @@
;;; Sorts them in place by the Unix filename order: ., .., dotfiles, others.
(define-foreign %sort-file-vector
(scm_sort_filevec ((C char**) cvec)
(scm_sort_filevec ((C "const char** ~a") cvec)
(integer veclen))
ignore)
@ -831,13 +839,6 @@
(filter (lambda (f) (not (char=? (string-ref f 0) #\.)))
files))))))
;;; I do this one in C, I'm not sure why:
(define-foreign %filter-C-strings!
(filter_stringvec (string regexp) ((C char**) cvec))
static-string ; error message -- "" if no error.
integer) ; number of files that pass the filter.
(define (match-files regexp . maybe-dir)
(let ((dir (optional-arg maybe-dir ".")))
(check-arg string? dir match-files)
@ -845,7 +846,7 @@
(%open-dir (ensure-file-name-is-nondirectory dir))
(if err (errno-error err match-files regexp dir))
(receive (err numfiles) (%filter-C-strings! regexp cvec)
(if (not (equal? err "")) (error err match-files))
(if err (error err match-files))
(%sort-file-vector cvec numfiles)
(let ((files (C-string-vec->Scheme&free cvec numfiles)))
(vector->list files))))))

View File

@ -23,6 +23,9 @@
#include "cstuff.h"
/* Make sure our exports match up w/the implementation: */
#include "syscalls1.h"
extern int errno;
extern char **environ;
@ -54,7 +57,7 @@ scheme_value wait_pid(int pid, int flags, int *result_pid, int *status)
** on the Scheme side.
*/
int scheme_exec(char *prog, scheme_value argv, scheme_value env)
int scheme_exec(const char *prog, scheme_value argv, scheme_value env)
{
int i, j, e;
int argc = VECTOR_LENGTH(argv);
@ -118,13 +121,12 @@ int scheme_pipe(int *r, int *w)
static char linkpath[MAXPATHLEN+1]; /* Maybe unaligned. Not reentrant. */
char *scm_readlink(char *path)
char const *scm_readlink(const char *path)
{
int retval = readlink(path, linkpath, MAXPATHLEN);
return (retval == -1)
? NULL
: ( linkpath[retval] = '\0', linkpath );
return (char const *)
(retval == -1) ? NULL : ( linkpath[retval] = '\0', linkpath );
}
@ -149,7 +151,7 @@ int scm_utime_now(char const *path) {return utime(path, 0);}
*/
/* Simple-minded POSIX version. */
int scheme_cwd(char **dirp)
int scheme_cwd(const char **dirp)
{
char *buf;
int size = 100;
@ -166,7 +168,7 @@ int scheme_cwd(char **dirp)
buf = nbuf;
}
*dirp = buf; /* win */
*dirp = (const char*) buf; /* win */
return 0;
lose:
@ -181,13 +183,13 @@ int scheme_cwd(char **dirp)
/* Faster SUNOS version. */
/* We have to use malloc, because the stub is going to free the string. */
int scheme_cwd(char **dirp)
int scheme_cwd(const char **dirp)
{
char *buf = Malloc(char,MAXPATHLEN);
int e;
if( buf && getwd(buf) ) {
*dirp = buf;
*dirp = (const char*) buf;
return 0;
}
@ -204,8 +206,11 @@ int scheme_cwd(char **dirp)
*******************************************************************************
*/
long process_times(clock_t *utime, clock_t *stime,
clock_t *cutime, clock_t *cstime)
/* Sleazing on the types here -- the ret values should be clock_t, not int,
** but cig can't handle it.
*/
int process_times(int *utime, int *stime, int *cutime, int *cstime)
{
struct tms tms;
clock_t t = times(&tms);
@ -217,7 +222,7 @@ long process_times(clock_t *utime, clock_t *stime,
return t;
}
long cpu_clock_ticks_per_sec()
int cpu_clock_ticks_per_sec()
{
#ifdef _SC_CLK_TCK
static long clock_tick = 0;
@ -257,9 +262,7 @@ int read_fdes_substring(scheme_value buf, int start, int end, int fd)
#define Min(a,b) (((a) < (b)) ? (a) : (b)) /* Not a function. */
/* Warning -- This fun is not very portable, since we use _iobuf internals.
**
** Also, note the clearerr() call. This is so a ^D on a tty input stream
/* Note the clearerr() call. This is so a ^D on a tty input stream
** doesn't shut the stream down forever. SunOS doesn't handle this according
** to POSIX spec, so we have to explicitly hack this case.
*/
@ -365,7 +368,7 @@ static int really_stat(int retval, struct stat *s, scheme_value vec)
return 0;
}
int scheme_stat(char *path, scheme_value vec, int chase_p)
int scheme_stat(const char *path, scheme_value vec, int chase_p)
{
struct stat s;
return really_stat(chase_p ? stat(path, &s) : lstat(path, &s), &s, vec);
@ -465,7 +468,7 @@ int install_env(scheme_value vec)
/* Delete the env var. */
void delete_env(char *var)
void delete_env(const char *var)
{
int varlen = strlen(var);
char **ptr = environ-1;
@ -484,17 +487,17 @@ void delete_env(char *var)
*/
static char hostname[MAXHOSTNAMELEN+1];
scheme_value scm_gethostname(void)
char *scm_gethostname(void)
{
/* different OS's declare differently, so punt the prototype. */
int gethostname();
gethostname(hostname, MAXHOSTNAMELEN);
return (scheme_value) hostname;
}
/* different OS's declare differently, so punt the prototype. */
int gethostname();
gethostname(hostname, MAXHOSTNAMELEN);
return hostname;
}
#include <errno.h>
const char *errno_msg(int i)
char *errno_msg(int i)
{
/* temp hack until we figure out what to do about losing sys_errlist's */
#ifdef HAVE_CONST_SYS_ERRLIST
@ -502,10 +505,9 @@ const char *errno_msg(int i)
#endif
extern char *sys_errlist[];
extern int sys_nerr;
return ( i < 0 || i > sys_nerr )
? (char*) NULL /* i.e., #f */
: sys_errlist[i];
}
return ( i < 0 || i > sys_nerr ) ? NULL /* i.e., #f */
: (char*) sys_errlist[i];
}
/* Some of fcntl()
******************

55
scsh/syscalls1.h Normal file
View File

@ -0,0 +1,55 @@
/* Exports from syscalls1.c. */
scheme_value wait_pid(int pid, int flags, int *result_pid, int *status);
int scheme_exec(const char *prog, scheme_value argv, scheme_value env);
int scheme_pipe(int *r, int *w);
char const *scm_readlink(const char *path);
int scm_utime(char const *path, int ac_hi, int ac_lo, int mod_hi, int mod_lo);
int scm_utime_now(char const *path);
int scheme_cwd(const char **dirp);
int process_times(int *utime, int *stime, int *cutime, int *cstime);
int cpu_clock_ticks_per_sec();
scheme_value read_fdes_char(int fd);
int write_fdes_char(char c, int fd);
int read_fdes_substring(scheme_value buf, int start, int end, int fd);
int read_stream_substring(scheme_value buf, int start, int end, FILE *f);
int write_fdes_substring(scheme_value buf, int start, int end, int fd);
int write_stream_substring(scheme_value buf, int start, int end, FILE *f);
int scheme_stat(const char *path, scheme_value vec, int chase_p);
int scheme_fstat(int fd, scheme_value vec);
int num_supp_groups(void);
int get_groups(scheme_value gvec);
int put_env(const char *s);
char** scm_envvec(int *len);
int install_env(scheme_value vec);
void delete_env(const char *var);
char *scm_gethostname(void);
char *errno_msg(int i);
int fcntl_read(int fd, int command);
int fcntl_write(int fd, int command, int value);

View File

@ -8,12 +8,15 @@
#include <termios.h>
/* Make sure foreign-function stubs interface to the C funs correctly: */
#include "tty1.h"
extern int errno;
#define errno_or_false(x) (((x) == -1) ? ENTER_FIXNUM(errno) : SCHFALSE)
scheme_value df_scheme_tcgetattr(long nargs, scheme_value *args)
{
extern int scheme_tcgetattr(int , const char *, int *, int *, int *, int *, int *, int *, int *, int *, int *, int *);
extern int scheme_tcgetattr(int , char *, int *, int *, int *, int *, int *, int *, int *, int *, int *, int *);
scheme_value ret1;
int r1;
int r2;

View File

@ -16,6 +16,9 @@
(foreign-source
"#include <termios.h>"
""
"/* Make sure foreign-function stubs interface to the C funs correctly: */"
"#include \"tty1.h\""
""
"extern int errno;"
""
"#define errno_or_false(x) (((x) == -1) ? ENTER_FIXNUM(errno) : SCHFALSE)"
@ -107,7 +110,7 @@
(define-foreign %tty-info/errno
(scheme_tcgetattr (integer fdes)
(string control-chars))
(var-string control-chars))
(to-scheme integer errno_or_false)
integer integer
integer integer

View File

@ -1,5 +1,7 @@
/* To do:
* - Replace explicit 8/24 splits with macros.
* - We need to pass the control-chars vecs in as Scheme
* strings, and test the length before doing the memcpy.
*/
/*
@ -12,7 +14,9 @@
#include <termios.h>
#include <string.h>
int scheme_tcgetattr(int fd, char control_chars[NCCS],
#include "tty1.h" /* Make sure the .h interface agrees with the code. */
int scheme_tcgetattr(int fd, char *control_chars,
int *iflag_hi8, int *iflag_lo24,
int *oflag_hi8, int *oflag_lo24,
int *cflag_hi8, int *cflag_lo24,
@ -37,7 +41,7 @@ int scheme_tcgetattr(int fd, char control_chars[NCCS],
int scheme_tcsetattr(int fd, int option,
char *control_chars,
const char *control_chars,
int iflag_hi8, int iflag_lo24,
int oflag_hi8, int oflag_lo24,
int cflag_hi8, int cflag_lo24,

17
scsh/tty1.h Normal file
View File

@ -0,0 +1,17 @@
/* Exports from tty1.c. */
int scheme_tcgetattr(int fd, char *control_chars,
int *iflag_hi8, int *iflag_lo24,
int *oflag_hi8, int *oflag_lo24,
int *cflag_hi8, int *cflag_lo24,
int *lflag_hi8, int *lflag_lo24,
int *ispeed, int *ospeed);
int scheme_tcsetattr(int fd, int option,
const char *control_chars,
int iflag_hi8, int iflag_lo24,
int oflag_hi8, int oflag_lo24,
int cflag_hi8, int cflag_lo24,
int lflag_hi8, int lflag_lo24,
int ispeed, int ospeed,
int min, int time);

14
scsh/userinfo1.h Normal file
View File

@ -0,0 +1,14 @@
/* Exports from userinfo1.c. */
char *my_username(void);
int user_info_uid(uid_t uid,
char **name, gid_t *gid, char **dir, char **shell);
int user_info_name(const char *name,
uid_t *uid, gid_t *gid, char **dir, char **shell);
int group_info_gid (int gid, char **name, char ***members, int *nmembers);
int group_info_name (const char *name,
int *gid, char ***members, int *nmembers);