scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

added raw-C support for read-delim and skip-chars. The port-buffer is drained in Scheme and after this a call to a read-loop in C follows. The last char is returned, so Scheme may push it back into the buffer

This commit is contained in:
marting 1999-11-04 16:21:30 +00:00
parent ae648e1c59
commit b1d298a3f5
2 changed files with 108 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
scsh/fdports1.c
View File

@ -55,8 +55,8 @@ s48_value read_delim(const char *delims, char *buf,
int fd, int start, int end,
int *nread)
{
char *cptr = buf+start-1, /* Location of last char deposited. */
*bufend = buf+end-1; /* Last writeable position. */
char *cptr = buf+start, /* Location of last char deposited. */
*bufend = buf+end -1; /* Last writeable position. */
int retval;
@ -67,29 +67,35 @@ s48_value read_delim(const char *delims, char *buf,
retval = read( fd, &c, 1 );
if( retval == 0 ) { /* Terminal case: EOF. */
*nread = 1 + cptr - buf - start;
*nread = cptr - buf - start;
return S48_EOF;
}
else if( retval == -1 ) { /* Terminal case: error. */
*nread = 1 + cptr - buf - start;
*nread = cptr - buf - start;
return s48_enter_fixnum(errno);
}
else if( delims[c] ) { /* Terminal case: delimiter char. */
s48_value ch = s48_enter_char(c);
*nread = 1 + cptr - buf - start;
return ch;
*nread = cptr - buf - start;
return s48_enter_char(c);
}
else if( cptr >= bufend ) { /* Terminal case: buffer overflow. */
*nread = end-start;
return S48_FALSE;
}
else *++cptr = c;
else if( cptr == bufend ) { /* Terminal case: buffer overflow. */
*cptr = c;
*nread = end-start;
return S48_FALSE;
}
else if ( cptr > bufend ){
fputs("cptr > bufend.\n", stderr);
abort();
_exit(-1);
}
else {
*cptr++ = c;
}
}
}
s48_value skip_chars(const char *skipchars, int fd, int *nread)
@ -115,7 +121,7 @@ s48_value skip_chars(const char *skipchars, int fd, int *nread)
else if( !skipchars[c] ) { /* Terminal case: non-skip char. */
*nread = nr;
return S48_FALSE;
return s48_enter_char(c);
}
nr++;
}

108
scsh/rdelim.scm
View File

@ -30,12 +30,11 @@
(define (read-delimited delims . args)
(let-optionals args ((port (current-input-port))
(delim-action 'trim))
(let ((substr (lambda (s end) ; Smart substring.
(if (= end (string-length s)) s
(substring s 0 end))))
(delims (->char-set delims))
(gobble? (not (eq? delim-action 'peek))))
(let ((substr (lambda (s end) ; Smart substring.
(if (= end (string-length s)) s
(substring s 0 end))))
(delims (->char-set delims))
(gobble? (not (eq? delim-action 'peek))))
;; BUFLEN is total amount of buffer space allocated to date.
(let lp ((strs '()) (buflen 80) (buf (make-string 80)))
(receive (terminator num-read)
@ -154,6 +153,35 @@
;;; the input stream. Otherwise, it is left in place for a following input
;;; operation.
(define (port-buffer-read-delimited delims buf gobble? port start end)
(let ((the-port-limit (port-limit port)))
(let lp ((i start) (lp-port-index (port-index port)))
(cond ((port-pending-eof? port)
(set-port-index! port lp-port-index)
(values (eof-object) i))
((>= i end)
(set-port-index! port lp-port-index)
(values #f (- i start)))
((< lp-port-index the-port-limit)
(let ((the-read-char
(ascii->char (byte-vector-ref
(port-buffer port) lp-port-index))))
(if (char-set-contains? delims the-read-char)
(begin
(if gobble?
(set-port-index! port (+ lp-port-index 1))
(set-port-index! port lp-port-index))
(values the-read-char (- i start)))
(begin
(string-set! buf i the-read-char)
(lp (+ i 1) (+ lp-port-index 1))))))
(else (set-port-index! port 0)
(set-port-limit! port 0)
(values 'port-buffer-exhausted i))))))
(define (%read-delimited! delims buf gobble? . args)
(let-optionals args ((port (current-input-port))
(start 0)
@ -167,18 +195,26 @@
(let* ((delims (->char-set delims))
(sdelims (char-set:s delims)))
(if (and (fdport? port) (not gobble?))
(receive (terminator num-read)
(port-buffer-read-delimited delims buf gobble? port start end)
(if (not (eq? terminator 'port-buffer-exhausted))
(values terminator num-read)
(begin (set! start (+ start num-read))
(if (fdport? port)
;; Direct C support for Unix file ports -- zippy quick.
(let lp ((start start) (total 0))
(let lp ((start start) (total num-read))
(let ((fd (fdport-data:fd (fdport-data port))))
(receive (terminator num-read)
(%read-delimited-fd!/errno sdelims buf
(%read-delimited-fd!/errno sdelims buf
fd start end)
(let ((total (+ num-read total)))
(cond ((not (integer? terminator)) (values terminator total))
((= terminator errno/intr) (lp (+ start num-read) total))
(cond ((char? terminator)
(if (not gobble?) (push-back port terminator))
(values terminator total))
((not (integer? terminator)) (values terminator total))
((= terminator errno/intr)
(lp (+ start num-read) total))
(else (errno-error terminator %read-delimited!
num-read total
delims buf gobble? port start end)))))))
@ -186,6 +222,7 @@
;; This is the code for other kinds of ports.
;; Mighty slow -- we read each char twice (peek first, then read).
(let lp ((i start))
(warn "use of read-delim lp")
(let ((c (peek-char port)))
(cond ((or (eof-object? c) ; Found terminating char or eof
(char-set-contains? delims c))
@ -197,7 +234,13 @@
(values #f (- i start)))
(else (string-set! buf i (read-char port))
(lp (+ i 1))))))))))
(lp (+ i 1)))))))))))))
; overwrites port-index :-(
(define (push-back port char)
(byte-vector-set! (port-buffer port) (port-index port) (char->ascii char))
(set-port-limit! port (+ (port-limit port) 1)))
(foreign-init-name "rdelim")
@ -219,11 +262,11 @@
(define-foreign %skip-char-set-fd/errno (skip_chars (string skip-set)
(fixnum fd))
desc ; int => errno; #f => win.
desc ; int => errno; char => win, pushback; #f => win w/eof.
fixnum) ; number of chars skipped.
;;; JMG: I added scset here without knowing, what I do !!
(define (skip-char-set skip-chars . maybe-port)
(let* ((port (:optional maybe-port (current-input-port)))
(cset (->char-set skip-chars))
@ -234,13 +277,21 @@
;; Direct C support for Unix file ports -- zippy quick.
((fdport? port)
(let lp ((total 0))
(receive (succ num-read) (buffer-skip-char-set cset port)
(if (not succ)
num-read
(let lp ((total num-read))
(receive (err num-read) (%skip-char-set-fd/errno
scset (fdport-data:fd (fdport-data port)))
(let ((total (+ total num-read)))
(cond ((not err) total)
(cond ((not err)
(set-port-pending-eof?! port #t)
total)
((char? err)
(push-back port err)
total)
((= errno/intr err) (lp total))
(errno-error err skip-char-set cset port total))))))
(errno-error err skip-char-set cset port total))))))))
;; This is the code for other kinds of ports.
;; Mighty slow -- we read each char twice (peek first, then read).
@ -252,7 +303,24 @@
(else i))))))))
(define (buffer-skip-char-set cset port)
(let ((the-port-limit (port-limit port)))
(let lp ((lp-port-index (port-index port)) (i 0))
(cond ((port-pending-eof? port)
(set-port-index! port lp-port-index)
(values #f i))
((< lp-port-index the-port-limit)
(let ((the-read-char
(ascii->char (byte-vector-ref
(port-buffer port) lp-port-index))))
(cond ((char-set-contains? cset the-read-char)
(lp (+ lp-port-index 1) (+ i 1)))
(else
(set-port-index! port lp-port-index)
(values #f i)))))
(else (set-port-index! port 0)
(set-port-limit! port 0)
(values 'port-buffer-exhausted i))))))
;;; (read-line [port delim-action])
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;