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:
		
							parent
							
								
									bd33154d9a
								
							
						
					
					
						commit
						7c90829350
					
				|  | @ -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; | ||||
| 
 | ||||
|  |  | |||
|  | @ -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); | ||||
|  | @ -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); | ||||
|  |  | |||
|  | @ -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); | ||||
|  | @ -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) | ||||
|  |  | |||
|  | @ -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)" | ||||
|   "" "") | ||||
| 
 | ||||
|  |  | |||
|  | @ -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; | ||||
|  |  | |||
|  | @ -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); | ||||
|  | @ -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; | ||||
|     } | ||||
| 
 | ||||
|  |  | |||
|  | @ -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 | ||||
|  |  | |||
|  | @ -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); | ||||
|  |  | |||
|  | @ -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); | ||||
|  | @ -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, '='); | ||||
|  |  | |||
|  | @ -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 *); | ||||
|  |  | |||
|  | @ -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?) | ||||
|  |  | |||
							
								
								
									
										18
									
								
								scsh/re.c
								
								
								
								
							
							
						
						
									
										18
									
								
								scsh/re.c
								
								
								
								
							|  | @ -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; | ||||
|     } | ||||
| 
 | ||||
|  |  | |||
							
								
								
									
										15
									
								
								scsh/re.scm
								
								
								
								
							
							
						
						
									
										15
									
								
								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. | ||||
|  |  | |||
|  | @ -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); | ||||
|  | @ -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 | ||||
|  |  | |||
|  | @ -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 *); | ||||
|  |  | |||
|  | @ -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. | ||||
|  |  | |||
|  | @ -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); | ||||
|     } | ||||
| 
 | ||||
|  |  | |||
|  | @ -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); | ||||
|  | @ -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 *); | ||||
|  |  | |||
|  | @ -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)))))) | ||||
|  |  | |||
|  | @ -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()
 | ||||
| ****************** | ||||
|  |  | |||
|  | @ -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); | ||||
|  | @ -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; | ||||
|  |  | |||
|  | @ -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 | ||||
|  |  | |||
|  | @ -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, | ||||
|  |  | |||
|  | @ -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); | ||||
|  | @ -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); | ||||
		Loading…
	
		Reference in New Issue
	
	 shivers
						shivers