after sommerfelds fixes

now added error arg printing
for mor readable errors

scsh/network.scm

@@ -37,13 +37,16 @@
 					  (service-info:port 
 					   (service-info (cadr args) "tcp")))
 					 (else
-					  (error "socket-connect: bad arg")))))
+					  (error
+					   "socket-connect: bad arg ~s"
+					   args)))))
 			(internet-address->socket-address host port)))
 		     ((= protocol-family
 			 protocol-family/unix)
 		      (unix-address->socket-address (car args)))
 		     (else 
-		      (error "socket-connect: unsupported protocol-family")))))
+		      (error "socket-connect: unsupported protocol-family ~s"
+			     protocol-family)))))
     (connect-socket sock addr)
     sock))
 
@@ -56,14 +59,16 @@
 					 (service-info:port 
 					  (service-info arg "tcp")))
 					(else
-					 (error "socket-connect: bad arg")))))
+					 (error "socket-connect: bad arg ~s"
+						arg)))))
 			(internet-address->socket-address internet-address/any
 							  arg)))
 		     ((= protocol-family
 			 protocol-family/unix)
 		      (unix-address->socket-address arg))
 		     (else 
-      (error "bind-listen-accept-loop: unsupported protocol-family")))))
+      (error "bind-listen-accept-loop: unsupported protocol-family ~s"
+	     protocol-family)))))
     (set-socket-option sock level/socket socket/reuse-address #t)
     (bind-socket sock addr)
     (listen-socket sock 5)
@@ -95,9 +100,11 @@
 ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
 (define (internet-address->socket-address address32 port16)
   (cond ((not (<= 0 address32 #xffffffff))
-	 (error "internet-address->socket-address: address out of range"))
+	 (error "internet-address->socket-address: address out of range ~s"
+		address32))
 	((not (<= 0 port16 #xffff))
-	 (error "internet-address->socket-address: port out of range"))
+	 (error "internet-address->socket-address: port out of range ~s"
+		port16))
 	(else 
 	 (make-socket-address address-family/internet
 			      (string-append (integer->string address32) 
@@ -107,7 +114,8 @@
   (if (or (not (socket-address? sockaddr))
 	  (not (= (socket-address:family sockaddr) 
 		  address-family/internet)))
-      (error "socket-address->internet-address: internet socket expected")
+      (error "socket-address->internet-address: internet socket expected ~s"
+	     sockaddr)
       (values (string->integer (substring (socket-address:address sockaddr) 
 					  0 4))
 	      (string->integer (substring (socket-address:address sockaddr)
@@ -115,20 +123,21 @@
 
 (define (unix-address->socket-address path)
   (if (> (string-length path) 108)
-      (error "unix-address->socket-address: path too long")
+      (error "unix-address->socket-address: path too long ~s" path)
       (make-socket-address address-family/unix path)))
 
 (define (socket-address->unix-address sockaddr)
   (if (or (not (socket-address? sockaddr))
 	  (not (= (socket-address:family sockaddr) 
 		  address-family/unix)))
-      (error "socket-address->unix-address expects an unix socket")
+      (error "socket-address->unix-address expects an unix socket ~s" sockaddr)
       socket-address:address))
 
 (define (make-addr af)
   (make-string (cond ((= af address-family/unix) 108)
 		     ((= af address-family/internet) 8)
-		     (else (error "make-addr: unknown address-family")))))
+		     (else 
+		      (error "make-addr: unknown address-family ~s" af)))))
 
 ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
 ;;; socket syscall
@@ -139,7 +148,8 @@
     (if (not (and (integer? pf)
 		  (integer? type)
 		  (integer? protocol)))
-	(error "create-socket: integer arguments expected")
+	(error "create-socket: integer arguments expected ~s ~s ~s" 
+	       pf type protocol)
 	(let* ((fd  (%socket pf type protocol))
 	       (in  (make-input-fdport fd))
 	       (out (dup->outport in)))
@@ -168,14 +178,15 @@
 ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
 (define (bind-socket sock name)
   (cond ((not (socket? sock))
-	 (error "bind-socket: socket expected"))
+	 (error "bind-socket: socket expected ~s" sock))
 	((not (socket-address? name))
-	 (error "bind-socket: socket-address expected"))
+	 (error "bind-socket: socket-address expected ~s" name))
 	(else
 	 (let ((family (socket:family sock)))
 	   (if (not (= family (socket-address:family name)))
 	       (error 
-		"bind-socket: trying to bind incompatible address to socket")
+		"bind-socket: trying to bind incompatible address to socket ~s"
+		name)
 	       (%bind (socket->fdes sock)
 		      family
 		      (socket-address:address name)))))))
@@ -193,14 +204,15 @@
 ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
 (define (connect-socket sock name)
   (cond ((not (socket? sock))
-	 (error "connect-socket: socket expected"))
+	 (error "connect-socket: socket expected ~s" sock))
 	((not (socket-address? name))
-	 (error "connect-socket: socket-address expected"))
+	 (error "connect-socket: socket-address expected ~s" name))
 	(else
 	 (let ((family (socket:family sock)))
 	   (cond ((not (= family (socket-address:family name)))
 		  (error 
-	   "connect: trying to connect socket to incompatible address"))
+	   "connect: trying to connect socket to incompatible address ~s"
+	   name))
 		 (else
 		  (%connect (socket->fdes sock)
 			    (socket:family sock)
@@ -219,9 +231,9 @@
 ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
 (define (listen-socket sock backlog)
   (cond ((not (socket? sock))
-	 (error "listen-socket: socket expected"))
+	 (error "listen-socket: socket expected ~s" sock))
 	((not (integer? backlog))
-	 (error "listen-socket: integer expected"))
+	 (error "listen-socket: integer expected ~s" backlog))
 	(else
 	 (%listen (socket->fdes sock) backlog))))
 	 
@@ -237,7 +249,7 @@
 ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
 (define (accept-connection sock)
   (if (not (socket? sock))
-      (error "accept-connection: socket expected")
+      (error "accept-connection: socket expected ~s" sock)
       (let* ((family (socket:family sock))
 	     (name   (make-addr family))
 	     (fd     (%accept (socket->fdes sock) family name))
@@ -263,7 +275,7 @@
 (define (socket-remote-address sock)
   (if (or (not (socket? sock))
 	  (not (= (socket:family sock) address-family/internet)))
-      (error "socket-remote-address: internet socket expected")
+      (error "socket-remote-address: internet socket expected ~s" sock)
       (let* ((family (socket:family sock))
 	     (name   (make-addr family)))
 	(%peer-name (socket->fdes sock)
@@ -285,7 +297,7 @@
 (define (socket-local-address sock)
   (if (or (not (socket? sock))
 	  (not (= (socket:family sock) address-family/internet)))
-      (error "socket-local-address: internet socket expected")
+      (error "socket-local-address: internet socket expected ~s" sock)
       (let* ((family (socket:family sock))
 	     (name   (make-addr family)))
 	(%socket-name (socket->fdes sock)
@@ -307,9 +319,9 @@
 ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
 (define (shutdown-socket sock how)
   (cond ((not (socket? sock))
-	 (error "shutdown-socket: socket expected"))
+	 (error "shutdown-socket: socket expected ~s" sock))
 	((not (integer? how))
-	 (error "shutdown-socket: integer expected"))
+	 (error "shutdown-socket: integer expected ~s" how))
 	(else
 	 (%shutdown (socket->fdes sock) how))))
 
@@ -326,7 +338,7 @@
 ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
 (define (create-socket-pair type)
   (if (not (integer? type))
-      (error "create-socket-pair: integer argument expected")
+      (error "create-socket-pair: integer argument expected ~s" type)
       (receive (s1 s2)
 	       (%socket-pair type)
         (let* ((in1  (make-input-fdport s1))
@@ -357,10 +369,10 @@
   (receive (flags)
 	   (parse-optionals maybe-flags 0)
     (cond ((not (socket? socket))
-	   (error "receive-message: socket expected"))
+	   (error "receive-message: socket expected ~s" socket))
 	  ((or (not (integer? flags))
 	       (not (integer? len)))
-	   (error "receive-message: integer expected"))
+	   (error "receive-message: integer expected ~s ~s" flags len))
 	  (else 
 	   (let ((s (make-string len)))
 	     (receive (nread from)
@@ -373,15 +385,16 @@
 
 (define (receive-message! socket s . maybe-args)
   (if (not (string? s))
-      (error "receive-message!: string expected")
+      (error "receive-message!: string expected ~s" s)
       (receive (start end flags)
 	       (parse-optionals maybe-args 0 (string-length s) 0)
 	       (cond ((not (socket? socket))
-		      (error "receive-message!: socket expected"))
+		      (error "receive-message!: socket expected ~s" socket))
 		     ((not (or (integer? flags)
 			       (integer? start)
 			       (integer? end)))
-		      (error "receive-message!: integer expected"))
+		      (error "receive-message!: integer expected ~s ~s ~s"
+			     flags start end))
 		     (else 
 		      (generic-receive-message! (socket->fdes socket) flags
 						s start end 
@@ -414,10 +427,10 @@
   (receive (flags)
 	   (parse-optionals maybe-flags 0)
     (cond ((not (socket? socket))
-	   (error "receive-message/partial: socket expected"))
+	   (error "receive-message/partial: socket expected ~s" socket))
 	  ((or (not (integer? flags))
 	       (not (integer? len)))
-	   (error "receive-message/partial: integer expected"))
+	   (error "receive-message/partial: integer expected ~s ~s" flags len))
 	  (else 
 	   (let ((s (make-string len)))
 	     (receive (nread addr)
@@ -430,13 +443,15 @@
 
 (define (receive-message!/partial socket s . maybe-args)
   (if (not (string? s))
-      (error "receive-message!/partial: string expected")
+      (error "receive-message!/partial: string expected ~s" s)
       (receive (start end flags)
 	       (parse-optionals maybe-args 0 (string-length s) 0)
 	       (cond ((not (socket? socket))
-		      (error "receive-message!/partial: socket expected"))
+		      (error "receive-message!/partial: socket expected ~s"
+			     socket))
 		     ((not (integer? flags))
-		      (error "receive-message!/partial: integer expected"))
+		      (error "receive-message!/partial: integer expected ~s"
+			     flags))
 		     (else 
 		      (generic-receive-message!/partial (socket->fdes socket)
 							flags 
@@ -483,11 +498,11 @@
 	   (parse-optionals maybe-args
 			    0 (string-length s) 0 #f)
     (cond ((not (socket? socket))
-	   (error "send-message: socket expected"))
+	   (error "send-message: socket expected ~s" socket))
 	  ((not (integer? flags))
-	   (error "send-message: integer expected"))
+	   (error "send-message: integer expected ~s" flags))
 	  ((not (string? s))
-	   (error "send-message: string expected"))
+	   (error "send-message: string expected ~s" s))
 	  (else 
 	   (generic-send-message (socket->fdes socket) flags
 				 s start end
@@ -517,11 +532,11 @@
 	   (parse-optionals maybe-args
 			    0 (string-length s) 0 #f)
     (cond ((not (socket? socket))
-	   (error "send-message/partial: socket expected"))
+	   (error "send-message/partial: socket expected ~s" socket))
 	  ((not (integer? flags))
-	   (error "send-message/partial: integer expected"))
+	   (error "send-message/partial: integer expected ~s" flags))
 	  ((not (string? s))
-	   (error "send-message/partial: string expected"))
+	   (error "send-message/partial: string expected ~s" s))
 	  (else 
            (generic-send-message/partial (socket->fdes socket) flags
 					 s start end
@@ -564,29 +579,33 @@
 
 (define (socket-option sock level option)
   (cond ((not (socket? sock))
-	 (error "socket-option: socket expected"))
+	 (error "socket-option: socket expected ~s" sock))
 	((or (not (integer? level))(not (integer? option)))
-	 (error "socket-option: integer expected"))
+	 (error "socket-option: integer expected ~s ~s" level option))
 	((boolean-option? option)
 	 (let ((result (%getsockopt (socket->fdes sock) level option)))
-	   (cond ((= result -1) (error "socket-option"))
+	   (cond ((= result -1) 
+		  (error "socket-option ~s ~s ~s" sock level option))
 		 (else (not (= result 0))))))
 	((value-option? option)
 	 (let ((result (%getsockopt (socket->fdes sock) level option)))
-	   (cond ((= result -1) (error "socket-option"))
+	   (cond ((= result -1) 
+		  (error "socket-option ~s ~s ~s" sock level option))
 		 (else result))))
 	((linger-option? option)
 	 (receive (result/on-off time)
 		  (%getsockopt-linger (socket->fdes sock) level option)
-	    (cond ((= result/on-off -1) (error "socket-option"))
+	    (cond ((= result/on-off -1) 
+		   (error "socket-option ~s ~s ~s" sock level option))
 		  (else (if (= result/on-off 0) #f time)))))
 	((timeout-option? option)
 	 (receive (result/secs usecs)
 		  (%getsockopt-linger (socket->fdes sock) level option)
-	    (cond ((= result/secs -1) (error "socket-option"))
+	   (cond ((= result/secs -1) 
-		  (else (+ result/secs (/ usecs 1000))))))
+		  (error "socket-option ~s ~s ~s" sock level option))
+		 (else (+ result/secs (/ usecs 1000))))))
 	(else
-	 "socket-option: unknown option type")))
+	 "socket-option: unknown option type ~s" option)))
 
 (define-foreign %getsockopt/errno
   (scheme_getsockopt (integer sockfd)
@@ -630,9 +649,9 @@
 
 (define (set-socket-option sock level option value)
   (cond ((not (socket? sock))
-	 (error "set-socket-option: socket expected"))
+	 (error "set-socket-option: socket expected ~s" sock))
 	((or (not (integer? level)) (not (integer? option)))
-	 (error "set-socket-option: integer expected"))
+	 (error "set-socket-option: integer expected ~s ~s" level option))
 	((boolean-option? option)
 	 (%setsockopt (socket->fdes sock) level option (if value 1 0)))
 	((value-option? option)
@@ -713,17 +732,17 @@
 (define (host-info arg)
   (cond ((string? arg) (name->host-info arg))
 	((socket-address? arg) (address->host-info arg))
-	(else (error "host-info: string or socket-address expected"))))
+	(else (error "host-info: string or socket-address expected ~s" arg))))
 
 (define (address->host-info name)
   (if (or (not (socket-address? name)) 
 	  (not (= (socket-address:family name) address-family/internet)))
-      (error "address->host-info: internet address expected")
+      (error "address->host-info: internet address expected ~s" name)
       (receive (herrno name aliases addresses)
 		  (%host-address->host-info/h-errno 
 		   (socket-address:address name))
 	 (if herrno
-	     (error "address->host-info: non-zero herrno" herrno)
+	     (error "address->host-info: non-zero herrno ~s ~s" name herrno)
 	     (make-host-info name 
 			     (vector->list
 			      (C-string-vec->Scheme aliases   #f))
@@ -739,11 +758,11 @@
   
 (define (name->host-info name)
   (if (not (string? name))
-      (error "name->host-info: string expected")
+      (error "name->host-info: string expected ~s" name)
       (receive (herrno name aliases addresses)
 	       (%host-name->host-info/h-errno name)
 	 (if herrno
-	     (error "name->host-info: non-zero herrno" herrno)
+	     (error "name->host-info: non-zero herrno ~s ~s" herrno name)
 	     (make-host-info name
 			     (vector->list
 			      (C-string-vec->Scheme aliases   #f))
@@ -769,11 +788,12 @@
 (define (network-info arg)
   (cond ((string? arg) (name->network-info arg))
 	((socket-address? arg) (address->network-info arg))
-	(else (error "network-info: string or socket-address expected"))))
+	(else 
+	 (error "network-info: string or socket-address expected ~s" arg))))
 
 (define (address->network-info name)
   (if (not (integer? name))
-      (error "address->network-info: integer expected")
+      (error "address->network-info: integer expected ~s" name)
       (let ((name (integer->string name))
 	    (net (make-string 4)))
 	(receive (result name aliases)
@@ -792,7 +812,7 @@
   
 (define (name->network-info name)
   (if (not (string? name))
-      (error "name->network-info: string expected")
+      (error "name->network-info: string expected ~s" name)
       (let ((net (make-string 4)))
 	(receive (result name aliases)
 		 (%net-name->network-info name net)
@@ -819,15 +839,15 @@
 (define (service-info . args)
   (cond ((string? (car args))  (apply name->service-info args))
 	((integer? (car args)) (apply port->service-info args))
-	(else (error "service-info: string or integer expected"))))
+	(else (error "service-info: string or integer expected ~s" args))))
 
 (define (port->service-info name . maybe-proto)
   (receive (proto)
 	   (parse-optionals maybe-proto "")
     (cond ((not (integer? name))
-	   (error "port->service-info: integer expected"))
+	   (error "port->service-info: integer expected ~s" name))
 	  ((not (string? proto))
-	   (error "port->service-info: string expected"))
+	   (error "port->service-info: string expected ~s" proto))
 	  (else
 	   (receive (result name aliases port protocol)
 		    (%service-port->service-info name proto)
@@ -851,7 +871,7 @@
 	   (parse-optionals maybe-proto "")
     (if (or (not (string? name))
 	    (not (string? name)))
-	(error "name->service-info: string expected")
+	(error "name->service-info: string expected ~s" name)
 	(receive (result name aliases port protocol)
 		 (%service-name->service-info name proto)
 	   (make-service-info name
@@ -879,11 +899,11 @@
 (define (protocol-info arg)
   (cond ((string? arg)  (name->protocol-info arg))
 	((integer? arg) (number->protocol-info arg))
-	(else (error "protocol-info: string or integer expected"))))
+	(else (error "protocol-info: string or integer expected ~s" arg))))
 
 (define (number->protocol-info name) 
   (if (not (integer? name))
-      (error "number->protocol-info: integer expected")
+      (error "number->protocol-info: integer expected ~s" name)
       (receive (result name aliases protocol)
 	       (%protocol-port->protocol-info name)
 	 (make-protocol-info name 
@@ -900,7 +920,7 @@
   
 (define (name->protocol-info name)
   (if (not (string? name))
-      (error "name->protocol-info: string expected")
+      (error "name->protocol-info: string expected ~s" name)
       (receive (result name aliases protocol)
 	       (%protocol-name->protocol-info name)
 	 (make-protocol-info name