Better type annotations. Moved char_pp_2_sting_list to cstuff.c.

scsh/cstuff.c

@@ -0,0 +1,15 @@
+/* build a list from  a null-terminated char* vector. */
+#include "cstuff.h"
+s48_value char_pp_2_string_list(char **vec){
+    char ** ptr = vec;
+    s48_value list = S48_NULL;
+
+    S48_DECLARE_GC_PROTECT(1);
+    S48_GC_PROTECT_1(list);
+
+    while (*(++ptr)){
+      list = s48_cons (s48_enter_string (*ptr), list);
+    }
+    S48_GC_UNPROTECT();
+    return list;
+}

scsh/cstuff.h

@@ -7,3 +7,4 @@
 /* String equality predicate. */
 #define streq(a,b) (!strcmp((a),(b)))
 
+s48_value char_pp_2_string_list(char **);

scsh/network1.c

@@ -20,7 +20,7 @@
 /* Make sure our exports match up w/the implementation: */
 #include "network1.h"
 
-extern int h_errno;
+//extern int h_errno;
 
 /* to extract a 4 byte long value from a scheme string */
 
@@ -114,7 +114,7 @@ int scheme_accept(int sockfd, int family, s48_value scheme_name)
     case AF_UNIX: 
       {
 	struct sockaddr_un name;
-	int namelen=sizeof(name);
+	size_t namelen=sizeof(name);
 	int newsockfd=accept(sockfd,(struct sockaddr *)&name,&namelen);
 
 	if (newsockfd < 0)
@@ -239,7 +239,7 @@ ssize_t recv_substring(int s,
 }
       
 /*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/
-int send_substring(int s,
+ssize_t send_substring(int s,
 		   int flags,
 		   s48_value buf, 
 		   size_t start, 
@@ -328,7 +328,7 @@ int scheme_getsockopt_timeout (int s,
 			       int *out_usec)
 {
   struct timeval optval;
-  int optlen=sizeof(optval);
+  size_t optlen=sizeof(optval);
   
   if (getsockopt(s,level,optname,(char *)&optval,&optlen) == -1) {
     out_usec = 0;

scsh/network1.h

@@ -12,10 +12,10 @@ int scheme_socket_name(int sockfd, int family, s48_value scheme_name);
 
 int scheme_socket_pair(int type, int *s1, int *s2);
 
-int recv_substring(int s, int flags, s48_value buf, 
+ssize_t recv_substring(int s, int flags, s48_value buf, 
 		   size_t start, size_t end, s48_value scheme_name);
 
-int send_substring(int s, int flags, s48_value buf, size_t start, size_t end,
+ssize_t send_substring(int s, int flags, s48_value buf, size_t start, size_t end,
 		   int family, s48_value scheme_name);
 
 int scheme_getsockopt (int s, int level, int optname);

scsh/scsh.scm

@@ -267,37 +267,17 @@
 	    #f))			; AFTER doesn't appear in LIST.
       (cons elt list))) 
 
-
-;(define (with-env* alist-delta thunk)
-;  (let* ((old-env #f)
-;	 (new-env (fold (lambda (key/val alist)
-;			  (alist-update (car key/val) (cdr key/val) alist))
-;			(env->alist)
-;			alist-delta)))
-;    (dynamic-wind
-;      (lambda ()
-;	(set! old-env (env->alist))
-;	(alist->env new-env))
-;      thunk
-;      (lambda ()
-;	(set! new-env (env->alist))
-;	(alist->env old-env)))))
-
-;(define (with-total-env* alist thunk)
-;  (let ((old-env (env->alist)))
-;    (dynamic-wind
-;      (lambda ()
-;	(set! old-env (env->alist))
-;	(alist->env alist))
-;      thunk
-;      (lambda ()
-;	(set! alist (env->alist))
-;	(alist->env old-env)))))
-
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; working directory per thread
-(define unix-cwd "")   ; Initialise the cache to an impossible filename.
+(define-record cache
+  cwd)
+
+(define-record-resumer type/cache
+  (lambda (cache)
+    (set-cache:cwd cache "")))  ; set the cache to an impossible filename.  
+
+(define unix-cwd 
+  (make-cache "")) ; Initialise the cache to an impossible filename.
 
 (define cwd-lock (make-lock))
 (define (obtain-cwd-lock) (obtain-lock cwd-lock))	; Thunks for
@@ -316,9 +296,9 @@
 
 (define (align-cwd!)
   (let ((dir (cwd)))
-    (if (not (string=? (cwd) unix-cwd))
+    (if (not (string=? (cwd) (cache:cwd unix-cwd)))
 	(begin (process-chdir dir)
-	       (set! unix-cwd dir)))))
+	       (set-cache:cwd unix-cwd dir)))))
 
 (define (chdir dir)
   (dynamic-wind obtain-cwd-lock

scsh/syscalls.scm

@@ -660,7 +660,7 @@
 		       (size_t start)
 		       (size_t end)
 		       (fixnum fd))
-  (multi-rep (to-scheme fixnum errno_or_false)
+  (multi-rep (to-scheme ssize_t errno_or_false)
 	     ssize_t))
 
 (define-foreign write-fdes-substring/errno
@@ -668,7 +668,7 @@
 			(size_t start)
 			(size_t end)
 			(fixnum fd))
-  (multi-rep (to-scheme fixnum errno_or_false)
+  (multi-rep (to-scheme ssize_t errno_or_false)
 	     ssize_t))
 
 
@@ -885,12 +885,10 @@
 ;;; ENV->ALIST
 
 (define-foreign %load-env (scm_envvec)
-  (C char**)	; char **environ
+  desc))
-  fixnum)	; & its length.
 
 (define (env->list)
-  (receive (C-env nelts) (%load-env)
+  (%load-env))
-    (vector->list (C-string-vec->Scheme C-env nelts))))
 
 (define (environ-env->alist) 
   (env-list->alist (env->list)))

scsh/syscalls1.h

@@ -41,7 +41,7 @@ int get_groups(s48_value gvec);
 
 int put_env(const char *s);
 
-char** scm_envvec(int *len);
+s48_value scm_envvec(void);
 
 int install_env(s48_value vec);
 

scsh/userinfo1.c

@@ -19,23 +19,7 @@
 
 #include <unistd.h>
 #include "scheme48.h"
-/* build a list from  a null-terminated char* vector. */
+#include "cstuff.h"
-static s48_value char_pp_2_string_list(char **vec){
-    char ** ptr = vec;
-    s48_value list;
-    S48_DECLARE_GC_PROTECT(1);
-    S48_GC_PROTECT_1(list);
-    if (!ptr) {
-      S48_GC_UNPROTECT();
-      return S48_NULL;
-    }
-    list = s48_cons (s48_enter_string (*ptr), S48_NULL);
-    while (*(++ptr)){
-      list = s48_cons (s48_enter_string (*ptr), list);
-    }
-    S48_GC_UNPROTECT();
-    return list;
-}
 
 /* User db access routines
 *******************************************************************************