Added native-code support for SKIP-CHAR-SET.

scsh/fdports1.c

@@ -431,7 +431,7 @@ scheme_value read_delim(const char *delims, char *buf, int gobble,
 
     clearerr(f);
 
-    do {
+    while( 1 ) {
 	int c = getc(f);
 
 	if( EOF == c ) {		/* Terminal case: EOF or error. */
@@ -454,5 +454,56 @@ scheme_value read_delim(const char *delims, char *buf, int gobble,
 	
 	else *++cptr = c;
 	}
-    while (1);
     }
+
+
+scheme_value skip_chars(const char *skipchars, scheme_value port,  int *nread)
+{
+
+    scheme_value data  = *Port_PortData(port);
+    scheme_value peekc = *PortData_Peek(data);
+    int fd = EXTRACT_FIXNUM(*PortData_Fd(data));
+    FILE *f = fstar_cache[fd];
+    int nr = 0; /* Number of skip chars read. */
+
+    /* This chunk of code is necessary because we have to check
+    ** the port's one-char pushback slot before going to the port's
+    ** stdio FILE*. Yech.
+    */
+    if( IsChar(peekc) ) {
+	char c = EXTRACT_CHAR(peekc);
+	if( skipchars[c]  ) {		/* Is c in cset? */
+	    *PortData_Peek(data) = SCHFALSE;
+	    nr = 1;
+	    }
+	else {
+	    *nread = 0;
+	    return SCHFALSE;
+	    }
+	}
+
+    clearerr(f);
+
+    while( 1 ) {
+	int c = getc(f);
+
+	if( EOF == c ) {		/* Terminal case: EOF or error. */
+	    *nread = nr;
+	    return ferror(f) ? ENTER_FIXNUM(errno) : SCHFALSE;
+	    }
+
+	else if( !skipchars[c] ) {	/* Terminal case: non-skip char. */
+	    *PortData_Peek(data) = ENTER_CHAR(c);
+	    *nread = nr;
+	    return SCHFALSE;
+	    }
+	nr++;
+	}
+    }
+
+/* Why, you might ask, do I push back the final char using the Scheme port
+** instead of using ungetc()? Because ungetc() isn't guaranteed to work for
+** unbuffered ports. This is regrettable, because it causes C stdio clients
+** that are ignorant of the Scheme port machinery to miss this char. No
+** real help for it.
+*/

scsh/fdports1.h

@@ -39,3 +39,5 @@ int write_fdport_substring(scheme_value buf, int start, int end, scheme_value da
 scheme_value read_delim(const char *delims, char *buf, int gobble,
 			scheme_value port, int start, int end,
 			int *nread);
+
+scheme_value skip_chars(const char *skipchars, scheme_value port,  int *nread);

scsh/rdelim.c

@@ -25,3 +25,17 @@ scheme_value df_read_delim(long nargs, scheme_value *args)
     return ret1;
     }
 
+scheme_value df_skip_chars(long nargs, scheme_value *args)
+{
+    extern scheme_value skip_chars(const char *, scheme_value , int *);
+    scheme_value ret1;
+    scheme_value r1;
+    int r2;
+
+    cig_check_nargs(3, nargs, "skip_chars");
+    r1 = skip_chars(cig_string_body(args[2]), args[1], &r2);
+    ret1 = r1;
+    VECTOR_REF(*args,0) = ENTER_FIXNUM(r2);
+    return ret1;
+    }
+

scsh/rdelim.scm

@@ -212,18 +212,35 @@
   fixnum)   ; number of chars read into BUF.
 
 
-;;; This is probably a hell of lot slower than actually reading the string
-;;; into a buffer and throwing it away, due to the painful slowness of
-;;; the current char-at-a-time Scheme input.
+(define-foreign %skip-char-set-fdport/errno (skip_chars (string skip-set)
+							(desc port))
+  desc		; int => errno; #f => win.
+  fixnum)	; number of chars skipped.
+
+
+(define (skip-char-set skip-chars . maybe-port)
+  (let ((port (optional-arg maybe-port (current-input-port)))
+	(cset (->char-set skip-chars)))
+
+      (cond ((not (input-port? port))
+	     (error "Illegal value -- not an input port." port))
+
+	     ;; Direct C support for Unix file ports -- zippy quick.
+	     ((fdport? port)
+	      (receive (err num-read) (%skip-char-set-fdport/errno cset port)
+		(if err (errno-error err skip-char-set cset port num-read)
+		    num-read)))
+
+	     ;; This is the code for other kinds of ports.
+	     ;; Mighty slow -- we read each char twice (peek first, then read).
+	     (else (let lp ((i 0))
+		     (let ((c (peek-char port)))
+		       (cond ((and (char? c) (char-set-contains? cset c))
+			      (read-char port)
+			      (lp (+ i 1)))
+			     (else i))))))))
+
 
-(define (skip-char-set cset . maybe-port)
-  (let ((port (optional-arg maybe-port (current-input-port))))
-    (let lp ()
-      (let ((c (peek-char port)))
-	(cond ((and (char? c) (char-set-contains? cset c))
-	       (read-char port)
-	       (lp))
-	      (else c))))))
 
 
 ;;; (read-line [port delim-action])