diff --git a/scsh/dirstuff1.c b/scsh/dirstuff1.c index b57dbb0..0adbb02 100644 --- a/scsh/dirstuff1.c +++ b/scsh/dirstuff1.c @@ -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; diff --git a/scsh/dirstuff1.h b/scsh/dirstuff1.h new file mode 100644 index 0000000..c27f91b --- /dev/null +++ b/scsh/dirstuff1.h @@ -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); diff --git a/scsh/fdports1.c b/scsh/fdports1.c index 1b84298..9b73a82 100644 --- a/scsh/fdports1.c +++ b/scsh/fdports1.c @@ -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); diff --git a/scsh/fdports1.h b/scsh/fdports1.h new file mode 100644 index 0000000..5bc22a3 --- /dev/null +++ b/scsh/fdports1.h @@ -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); diff --git a/scsh/flock.c b/scsh/flock.c index 7c8cb26..780760f 100644 --- a/scsh/flock.c +++ b/scsh/flock.c @@ -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) diff --git a/scsh/flock.scm b/scsh/flock.scm index b9383a0..474e4ee 100644 --- a/scsh/flock.scm +++ b/scsh/flock.scm @@ -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)" "" "") diff --git a/scsh/flock1.c b/scsh/flock1.c index 2a29f1d..a1958dc 100644 --- a/scsh/flock1.c +++ b/scsh/flock1.c @@ -9,6 +9,9 @@ #include #include +/* 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; diff --git a/scsh/flock1.h b/scsh/flock1.h new file mode 100644 index 0000000..0dd26a0 --- /dev/null +++ b/scsh/flock1.h @@ -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); diff --git a/scsh/network.c b/scsh/network.c index ac2e055..1046381 100644 --- a/scsh/network.c +++ b/scsh/network.c @@ -9,6 +9,8 @@ #include #include +/* 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; } diff --git a/scsh/network.scm b/scsh/network.scm index dd0fc07..ed95ff5 100644 --- a/scsh/network.scm +++ b/scsh/network.scm @@ -8,6 +8,8 @@ "#include " "#include " "" + "/* 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 diff --git a/scsh/network1.c b/scsh/network1.c index 6f09bf0..02cb5f5 100644 --- a/scsh/network1.c +++ b/scsh/network1.c @@ -17,6 +17,9 @@ #include #include +/* 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); diff --git a/scsh/network1.h b/scsh/network1.h new file mode 100644 index 0000000..88dcfca --- /dev/null +++ b/scsh/network1.h @@ -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); diff --git a/scsh/putenv.c b/scsh/putenv.c index f1e5acf..d1044a4 100644 --- a/scsh/putenv.c +++ b/scsh/putenv.c @@ -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, '='); diff --git a/scsh/rdelim.c b/scsh/rdelim.c index f8b9f77..5fef311 100644 --- a/scsh/rdelim.c +++ b/scsh/rdelim.c @@ -6,6 +6,11 @@ #include /* For malloc. */ #include "libcig.h" +#include + +/* 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 *); diff --git a/scsh/rdelim.scm b/scsh/rdelim.scm index 524e31e..8a73fc7 100644 --- a/scsh/rdelim.scm +++ b/scsh/rdelim.scm @@ -195,6 +195,13 @@ (lp (+ i 1)))))))))) +(foreign-source + "#include " + "" + "/* 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?) diff --git a/scsh/re.c b/scsh/re.c index 82f0645..6bc0661 100644 --- a/scsh/re.c +++ b/scsh/re.c @@ -6,6 +6,9 @@ #include /* 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; + } + diff --git a/scsh/re.scm b/scsh/re.scm index de932fd..e4004f7 100644 --- a/scsh/re.scm +++ b/scsh/re.scm @@ -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. diff --git a/scsh/re1.h b/scsh/re1.h new file mode 100644 index 0000000..7a1762d --- /dev/null +++ b/scsh/re1.h @@ -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); diff --git a/scsh/scsh-package.scm b/scsh/scsh-package.scm index 595d53f..474ada9 100644 --- a/scsh/scsh-package.scm +++ b/scsh/scsh-package.scm @@ -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 diff --git a/scsh/select.c b/scsh/select.c index 17843ec..38ba754 100644 --- a/scsh/select.c +++ b/scsh/select.c @@ -6,6 +6,9 @@ #include /* 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 *); diff --git a/scsh/select.scm b/scsh/select.scm index 8b6f8ca..b4b1c88 100644 --- a/scsh/select.scm +++ b/scsh/select.scm @@ -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. diff --git a/scsh/select1.c b/scsh/select1.c index e4c85ab..0cdeb42 100644 --- a/scsh/select1.c +++ b/scsh/select1.c @@ -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 @@ -19,8 +13,12 @@ #include #include -#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); } - diff --git a/scsh/select1.h b/scsh/select1.h new file mode 100644 index 0000000..43602ad --- /dev/null +++ b/scsh/select1.h @@ -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); diff --git a/scsh/syscalls.c b/scsh/syscalls.c index 89df30f..153f7cb 100644 --- a/scsh/syscalls.c +++ b/scsh/syscalls.c @@ -16,6 +16,13 @@ #include #include +/* 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 *); diff --git a/scsh/syscalls.scm b/scsh/syscalls.scm index 2105d93..a6fdf94 100644 --- a/scsh/syscalls.scm +++ b/scsh/syscalls.scm @@ -16,6 +16,13 @@ "#include " "#include " "" + "/* 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)))))) diff --git a/scsh/syscalls1.c b/scsh/syscalls1.c index 7a3123f..945862c 100644 --- a/scsh/syscalls1.c +++ b/scsh/syscalls1.c @@ -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 -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() ****************** diff --git a/scsh/syscalls1.h b/scsh/syscalls1.h new file mode 100644 index 0000000..e23221c --- /dev/null +++ b/scsh/syscalls1.h @@ -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); diff --git a/scsh/tty.c b/scsh/tty.c index 324b4f9..bab93c9 100644 --- a/scsh/tty.c +++ b/scsh/tty.c @@ -8,12 +8,15 @@ #include +/* 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; diff --git a/scsh/tty.scm b/scsh/tty.scm index 03a600b..218c1fd 100644 --- a/scsh/tty.scm +++ b/scsh/tty.scm @@ -16,6 +16,9 @@ (foreign-source "#include " "" + "/* 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 diff --git a/scsh/tty1.c b/scsh/tty1.c index d27abb4..10b857a 100644 --- a/scsh/tty1.c +++ b/scsh/tty1.c @@ -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 #include -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, diff --git a/scsh/tty1.h b/scsh/tty1.h new file mode 100644 index 0000000..3ad12ba --- /dev/null +++ b/scsh/tty1.h @@ -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); diff --git a/scsh/userinfo1.h b/scsh/userinfo1.h new file mode 100644 index 0000000..eee60f9 --- /dev/null +++ b/scsh/userinfo1.h @@ -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);