summaryrefslogtreecommitdiff
path: root/module
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2016-05-22 18:16:19 +0200
committerAndy Wingo <wingo@pobox.com>2016-05-22 18:16:19 +0200
commitfd17cf9f72bcfc1832775c848e678e695d05dbd8 (patch)
treee5e5decb36b46cfa5e436bfb8882b2de9fd5bf91 /module
parenta4b06357f644c41188d4e3c555ff60c71631493f (diff)
downloadguile-fd17cf9f72bcfc1832775c848e678e695d05dbd8.tar.gz
Speed up port position access from Scheme
* libguile/ports-internal.h (scm_port_buffer_position): (scm_port_position_line, scm_port_position_set_line): (scm_port_position_column, scm_port_position_set_column): New helpers. (scm_t_port): Ports now hold position as a pair, so that Scheme can access it easily. (SCM_LINUM, SCM_COL, SCM_INCLINE, SCM_ZEROCOL, SCM_INCCOL) (SCM_DECCOL, SCM_TABCOL): Remove. * libguile/ports.c (make_port_buffer): Rename from scm_c_make_port_buffer, make static, and take port as an argument so we can initialize the position field. (initialize_port_buffers): Adapt make_port_buffer change. (scm_c_make_port_with_encoding): Initialize position. (update_port_position): Rename from update_port_lf, and operate on port position objects. (scm_ungetc): Operate on port position objects. (scm_setvbuf, scm_expand_port_read_buffer_x): Adapt to make_port_buffer change. (scm_lfwrite): Adapt to call update_port_position. (scm_port_line, scm_set_port_line_x, scm_port_column) (scm_set_port_column_x): Adapt to use port positions. * libguile/ports.h (scm_c_make_port_buffer): Remove internal decl. * libguile/read.c: Adapt to use scm_port_line / scm_port_column instead of SCM_LINUM et al. * module/ice-9/ports.scm (port-buffer-position, port-position-line) (port-position-column, set-port-position-line!) (set-port-position-column!): New accessors for the internals module. * module/ice-9/sports.scm (advance-port-position!): Rename from port-advance-position! and use the new accessors. (read-char, port-fold-chars/iso-8859-1): Adapt to use advance-port-position!.
Diffstat (limited to 'module')
-rw-r--r--module/ice-9/ports.scm15
-rw-r--r--module/ice-9/sports.scm32
2 files changed, 31 insertions, 16 deletions
diff --git a/module/ice-9/ports.scm b/module/ice-9/ports.scm
index 4330ebedf..4b7462585 100644
--- a/module/ice-9/ports.scm
+++ b/module/ice-9/ports.scm
@@ -169,9 +169,14 @@ interpret its input and output."
port-buffer-cur
port-buffer-end
port-buffer-has-eof?
+ port-buffer-position
set-port-buffer-cur!
set-port-buffer-end!
set-port-buffer-has-eof?!
+ port-position-line
+ port-position-column
+ set-port-position-line!
+ set-port-position-column!
port-read
port-write
port-clear-stream-start-for-bom-read
@@ -188,6 +193,7 @@ interpret its input and output."
(define-syntax-rule (port-buffer-cur buf) (vector-ref buf 1))
(define-syntax-rule (port-buffer-end buf) (vector-ref buf 2))
(define-syntax-rule (port-buffer-has-eof? buf) (vector-ref buf 3))
+(define-syntax-rule (port-buffer-position buf) (vector-ref buf 4))
(define-syntax-rule (set-port-buffer-cur! buf cur)
(vector-set! buf 1 cur))
@@ -196,6 +202,15 @@ interpret its input and output."
(define-syntax-rule (set-port-buffer-has-eof?! buf has-eof?)
(vector-set! buf 3 has-eof?))
+(define-syntax-rule (port-position-line position)
+ (car position))
+(define-syntax-rule (port-position-column position)
+ (cdr position))
+(define-syntax-rule (set-port-position-line! position line)
+ (set-car! position line))
+(define-syntax-rule (set-port-position-column! position column)
+ (set-cdr! position column))
+
(eval-when (expand)
(define-syntax-rule (private-port-bindings binding ...)
(begin
diff --git a/module/ice-9/sports.scm b/module/ice-9/sports.scm
index 265b70557..2ee97340b 100644
--- a/module/ice-9/sports.scm
+++ b/module/ice-9/sports.scm
@@ -384,34 +384,34 @@
(peek-bytes port 1 fast-path
(lambda (buf bv cur buffered) (slow-path))))
-(define-inlinable (port-advance-position! port char)
+(define-inlinable (advance-port-position! pos char)
;; FIXME: this cond is a speed hack; really we should just compile
;; `case' better.
(cond
;; FIXME: char>? et al should compile well.
((<= (char->integer #\space) (char->integer char))
- (set-port-column! port (1+ (port-column port))))
+ (set-port-position-column! pos (1+ (port-position-column pos))))
(else
(case char
((#\alarm) #t) ; No change.
((#\backspace)
- (let ((col (port-column port)))
+ (let ((col (port-position-column pos)))
(when (> col 0)
- (set-port-column! port (1- col)))))
+ (set-port-position-column! pos (1- col)))))
((#\newline)
- (set-port-line! port (1+ (port-line port)))
- (set-port-column! port 0))
+ (set-port-position-line! pos (1+ (port-position-line pos)))
+ (set-port-position-column! pos 0))
((#\return)
- (set-port-column! port 0))
+ (set-port-position-column! pos 0))
((#\tab)
- (let ((col (port-column port)))
- (set-port-column! port (- (+ col 8) (remainder col 8)))))
+ (let ((col (port-position-column pos)))
+ (set-port-position-column! pos (- (+ col 8) (remainder col 8)))))
(else
- (set-port-column! port (1+ (port-column port))))))))
+ (set-port-position-column! pos (1+ (port-position-column pos))))))))
(define* (read-char #:optional (port (current-input-port)))
- (define (finish char)
- (port-advance-position! port char)
+ (define (finish buf char)
+ (advance-port-position! (port-buffer-position buf) char)
char)
(define (slow-path)
(call-with-values (lambda () (peek-char-and-len port))
@@ -422,7 +422,7 @@
(begin
(set-port-buffer-has-eof?! buf #f)
char)
- (finish char))))))
+ (finish buf char))))))
(define (fast-path buf bv cur buffered)
(let ((u8 (bytevector-u8-ref bv cur))
(enc (%port-encoding port)))
@@ -431,11 +431,11 @@
(decode-utf8 bv cur buffered u8
(lambda (char len)
(set-port-buffer-cur! buf (+ cur len))
- (finish char))
+ (finish buf char))
slow-path))
((ISO-8859-1)
(set-port-buffer-cur! buf (+ cur 1))
- (finish (integer->char u8)))
+ (finish buf (integer->char u8)))
(else (slow-path)))))
(peek-bytes port 1 fast-path
(lambda (buf bv cur buffered) (slow-path))))
@@ -460,7 +460,7 @@
(let ((ch (integer->char (bytevector-u8-ref bv cur)))
(cur (1+ cur)))
(set-port-buffer-cur! buf cur)
- (port-advance-position! port ch)
+ (advance-port-position! (port-buffer-position buf) ch)
(call-with-values (lambda () (proc ch seed))
(lambda (seed done?)
(if done? seed (fold-chars cur seed)))))))))))