a few fixups to primitive functions

ice-9/ChangeLog

@@ -1,3 +1,13 @@
+Sat Aug  3 06:16:35 1996  Gary Houston  <ghouston@actrix.gen.nz>
+
+	* boot-9.scm (*null-device*): global constant from goonix.
+	(move->fdes): adjusted for boolean primitive-move->fdes.  return
+	the modified port, always set revealed count to 1 (SCSH compatible).
+	(release-port-handle port): from goonix (SCSH compatible).
+	(%open-file): removed.
+	(open-input-file, open-output-file, file-exists?, file-is-directory?):
+	modified for open-file change (does not return #f).
+
 Thu Aug  1 02:52:42 1996  Jim Blandy  <jimb@totoro.cyclic.com>
 
 	* Makefile.in (dist-dir): New target for new dist system.

ice-9/boot-9.scm

@@ -90,7 +90,6 @@
 ;;; {Silly Naming Cleanups and Trivial Functions}
 ;;;
 
-(define %open-file open-file)
 (define (id x) x)
 (define < <?)
 (define <= <=?)
@@ -156,13 +155,13 @@
 		    ((MS-DOS WINDOWS ATARIST) "r+b")
 		    (else "r+")))
 
+(define *null-device* "/dev/null")
+
 (define (open-input-file str)
-  (or (open-file str OPEN_READ)
-      (error "OPEN-INPUT-FILE couldn't find file " str)))
+  (open-file str OPEN_READ))
 
 (define (open-output-file str)
-  (or (open-file str OPEN_WRITE)
-      (error "OPEN-OUTPUT-FILE couldn't find file " str)))
+  (open-file str OPEN_WRITE))
 
 (define (open-io-file str) (open-file str OPEN_BOTH))
 (define close-input-port close-port)
@@ -553,12 +552,16 @@
 ;;;
 
 (define (file-exists? str)
-  (let ((port (open-file str OPEN_READ)))
+  ;; we don't have false-if-exception (or defmacro) yet.
+  (let ((port (catch #t (lambda () (open-file str OPEN_READ))
+		     (lambda args #f))))
     (if port (begin (close-port port) #t)
 	#f)))
 
 (define (file-is-directory? str)
-  (let ((port (open-file (string-append str "/.") OPEN_READ)))
+  (let ((port (catch #t (lambda () (open-file (string-append str "/.")
+					      OPEN_READ))
+		     (lambda args #f))))
     (if port (begin (close-port port) #t)
 	#f)))
 
@@ -742,9 +745,16 @@
 (define (setprotoent arg) (setproto arg))
 (define (setpwent arg) (setpw arg))
 (define (setservent arg) (setserv arg))
+
 (define (move->fdes port fd)
-  (if (= 1 (primitive-move->fdes port fd))
-      (set-port-revealed! port 1)))
+  (primitive-move->fdes port fd)
+  (set-port-revealed! port 1)
+  port)
+
+(define (release-port-handle port)
+  (let ((revealed (port-revealed port)))
+    (if (> revealed 0)
+	(set-port-revealed! port (- revealed 1)))))
 
 
 ;;; {Load Paths}

libguile/ChangeLog

@@ -1,5 +1,18 @@
 Sat Aug  3 01:27:14 1996  Gary Houston  <ghouston@actrix.gen.nz>
 
+	* ioext.c (scm_sys_fdopen): fix the port-table assignment.
+
+	* fports.c (scm_open_file): don't return #f, throw error.
+
+	* ioext.c (fileno): renamed from %fileno.
+	(soft-fileno): deleted.
+
+	* ports.c (scm_port_revealed): don't need to check for -1 from
+	scm_revealed_count.
+	(scm_set_port_revealed_x): return unspecified, not #f.
+
+	* ioext.c (primitive-move->fdes): return #t or #f, not 1 or 0.
+
 	* fdsocket.c: getsockopt, setsockopt: use HAVE_STRUCT_LINGER.
 
 	* scmconfig.h.in: add HAVE_STRUCT_LINGER.

libguile/fports.c

@@ -193,10 +193,12 @@ scm_open_file (filename, modes)
   if (SCM_SUBSTRP (modes))
     modes = scm_makfromstr (SCM_ROCHARS (modes), SCM_ROLENGTH (modes), 0);
   port = scm_mkfile (SCM_ROCHARS (filename), SCM_ROCHARS (modes));
-  /* Force the compiler to keep filename and modes alive:
-   */
-  if (port == SCM_BOOL_F)
+
+  if (port == SCM_BOOL_F) {
+    SCM_SYSERROR (s_open_file);
+    /* Force the compiler to keep filename and modes alive.  */
     scm_cons (filename, modes);
+  }
   return port;
 }
 

libguile/ioext.c

@@ -210,7 +210,7 @@ scm_sys_redirect_port (into_pt, from_pt)
   return SCM_UNSPECIFIED;
 }
 
-SCM_PROC (s_sys_fileno, "%fileno", 1, 0, 0, scm_sys_fileno);
+SCM_PROC (s_sys_fileno, "fileno", 1, 0, 0, scm_sys_fileno);
 #ifdef __STDC__
 SCM 
 scm_sys_fileno (SCM port)
@@ -228,27 +228,6 @@ scm_sys_fileno (port)
   return SCM_MAKINUM (fd);
 }
 
-SCM_PROC (s_sys_soft_fileno, "soft-fileno", 1, 0, 0, scm_sys_soft_fileno);
-#ifdef __STDC__
-SCM 
-scm_sys_soft_fileno (SCM port)
-#else
-SCM 
-scm_sys_soft_fileno (port)
-     SCM port;
-#endif
-{
-  int fd;
-  SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_sys_fileno);
-
-  fd = fileno ((FILE *)SCM_STREAM (port));
-  if (fd == -1)
-    SCM_SYSERROR (s_sys_soft_fileno);
-  return SCM_MAKINUM (fd);
-}
-
-
-
 SCM_PROC (s_sys_isatty, "isatty?", 1, 0, 0, scm_sys_isatty_p);
 #ifdef __STDC__
 SCM 
@@ -283,17 +262,21 @@ scm_sys_fdopen (fdes, modes)
 {
   FILE *f;
   SCM port;
+  struct scm_port_table * pt;
 
   SCM_ASSERT (SCM_INUMP (fdes), fdes, SCM_ARG1, s_sys_fdopen);
   SCM_ASSERT (SCM_NIMP (modes) && SCM_STRINGP (modes), modes, SCM_ARG2, s_sys_fdopen);
+  SCM_NEWCELL (port);
   SCM_DEFER_INTS;
   f = fdopen (SCM_INUM (fdes), SCM_CHARS (modes));
   if (f == NULL)
     SCM_SYSERROR (s_sys_fdopen);
-  SCM_NEWCELL (port);
-  SCM_CAR (port) = scm_tc16_fport | scm_mode_bits (SCM_CHARS (modes));
-  SCM_SETSTREAM (port,(SCM)f);
-  scm_add_to_port_table (port);
+  pt = scm_add_to_port_table (port);
+  SCM_SETPTAB_ENTRY (port, pt);
+  if (SCM_BUF0 & (SCM_CAR (port) = scm_tc16_fport
+		  | scm_mode_bits (SCM_CHARS (modes))))
+    scm_setbuf0 (port);
+  SCM_SETSTREAM (port, (SCM)f);
   SCM_ALLOW_INTS;
   return port;
 }
@@ -301,8 +284,8 @@ scm_sys_fdopen (fdes, modes)
 
 
 /* Move a port's underlying file descriptor to a given value.
- * Returns  0 if fdes is already the given value.
- *          1 if fdes moved. 
+ * Returns  #f if fdes is already the given value.
+ *          #t if fdes moved. 
  * MOVE->FDES is implemented in Scheme and calls this primitive.
  */
 SCM_PROC (s_sys_primitive_move_to_fdes, "primitive-move->fdes", 2, 0, 0, scm_sys_primitive_move_to_fdes);
@@ -330,7 +313,7 @@ scm_sys_primitive_move_to_fdes (port, fd)
   if  (old_fd == new_fd)
     {
       SCM_ALLOW_INTS;
-      return SCM_MAKINUM (0);
+      return SCM_BOOL_F;
     }
   scm_evict_ports (new_fd);
   rv = dup2 (old_fd, new_fd);
@@ -339,7 +322,7 @@ scm_sys_primitive_move_to_fdes (port, fd)
   scm_setfileno (stream, new_fd);
   SCM_SYSCALL (close (old_fd));  
   SCM_ALLOW_INTS;
-  return SCM_MAKINUM (1);
+  return SCM_BOOL_T;
 }
 
 #ifdef __STDC__

libguile/ports.c

@@ -438,9 +438,8 @@ scm_pt_member (member)
 #endif
 
 
-/* Find a port in the table and return its revealed count.  Return -1
- * if the port isn't in the table (should not happen).  Also used by
- * the garbage collector.
+/* Find a port in the table and return its revealed count.
+   Also used by the garbage collector.
  */
 #ifdef __STDC__
 int
@@ -468,14 +467,8 @@ scm_port_revealed (port)
      SCM port;
 #endif
 {
-  int result;
-
   SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port), port, SCM_ARG1, s_port_revealed);
-
-  if ((result = scm_revealed_count (port)) == -1)
-    return SCM_BOOL_F;
-  else
-    return SCM_MAKINUM (result);
+  return SCM_MAKINUM (scm_revealed_count (port));
 }
 
 /* Set the revealed count for a port.  */
@@ -495,7 +488,7 @@ scm_set_port_revealed_x (port, rcount)
   SCM_DEFER_INTS;
   SCM_REVEALED (port) = SCM_INUM (rcount);
   SCM_ALLOW_INTS;
-  return SCM_BOOL_F;
+  return SCM_UNSPECIFIED;
 }
 
 /* scm_close_port