suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

db: eliminate some copying from postgresql message reading

Browse Source
This commit is contained in:
Ryan Culpepper 2012-08-25 18:38:32 -04:00
parent 8363db9258
commit c5472fbf3e
3 changed files with 116 additions and 116 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
collects/db/private/postgresql/connection.rkt
View File

@ -370,28 +370,19 @@
[_ (error/internal* fsym "unexpected message from back end" [_ (error/internal* fsym "unexpected message from back end"
'("message" value) r)])) '("message" value) r)]))
(define/private (get-convert-row! fsym field-dvecs)
(let* ([type-reader-v
(list->vector (query1:get-type-readers fsym field-dvecs))])
(lambda (row)
(vector-map! (lambda (value type-reader)
(cond [(sql-null? value) sql-null]
[else (type-reader value)]))
row
type-reader-v))))
(define/private (query1:process-result fsym result) (define/private (query1:process-result fsym result)
(match result (match result
[(vector 'rows field-dvecs rows) [(vector 'rows field-dvecs rows)
(for-each (get-convert-row! fsym field-dvecs) rows) (let ([type-readers (query1:get-type-readers fsym field-dvecs)])
(rows-result (map field-dvec->field-info field-dvecs) rows)] (rows-result (map field-dvec->field-info field-dvecs)
(map (lambda (data) (bytes->row data type-readers))
rows)))]
[(vector 'cursor field-dvecs stmt portal) [(vector 'cursor field-dvecs stmt portal)
(let* ([convert-row! (get-convert-row! fsym field-dvecs)] (let ([pst (statement-binding-pst stmt)]
[pst (statement-binding-pst stmt)]) [type-readers (query1:get-type-readers fsym field-dvecs)])
;; FIXME: register finalizer to close portal?
(cursor-result (map field-dvec->field-info field-dvecs) (cursor-result (map field-dvec->field-info field-dvecs)
pst pst
(list portal convert-row! (box #f))))] (list portal type-readers (box #f))))]
[(vector 'command command) [(vector 'command command)
(simple-result command)])) (simple-result command)]))
@ -408,7 +399,7 @@
[extra (cursor-result-extra cursor)]) [extra (cursor-result-extra cursor)])
(send pst check-owner fsym this pst) (send pst check-owner fsym this pst)
(let ([portal (car extra)] (let ([portal (car extra)]
[convert-row! (cadr extra)] [type-readers (cadr extra)]
[end-box (caddr extra)]) [end-box (caddr extra)])
(let ([rows (let ([rows
(call-with-lock fsym (call-with-lock fsym
@ -423,7 +414,7 @@
(when (unbox end-box) (when (unbox end-box)
(cursor:close fsym pst portal)) (cursor:close fsym pst portal))
rows)])))]) rows)])))])
(and rows (begin (for-each convert-row! rows) rows)))))) (and rows (map (lambda (data) (bytes->row data type-readers)) rows))))))
(define/private (cursor:close fsym pst portal) (define/private (cursor:close fsym pst portal)
(let ([close-on-exec? (send pst get-close-on-exec?)]) (let ([close-on-exec? (send pst get-close-on-exec?)])
@ -561,9 +552,11 @@
((current) ((current)
"table_schema = current_schema")))] "table_schema = current_schema")))]
[result (call-with-lock fsym (lambda () (internal-query1 fsym stmt)))] [result (call-with-lock fsym (lambda () (internal-query1 fsym stmt)))]
[rows (vector-ref result 2)]) [rows (vector-ref result 2)]
[type-readers (list subbytes)])
(for/list ([row (in-list rows)]) (for/list ([row (in-list rows)])
(bytes->string/utf-8 (vector-ref row 0))))) (let ([row (bytes->row row type-readers)])
(bytes->string/utf-8 (vector-ref row 0))))))
)) ))
;; ======================================== ;; ========================================

169
collects/db/private/postgresql/dbsystem.rkt
View File

@ -292,9 +292,9 @@ record = cols:int4 (typeoid:int4 len/-1:int4 data:byte^len)^cols
0)]) 0)])
(sql-interval years months days hours mins secs nsecs))])) (sql-interval years months days hours mins secs nsecs))]))
(define ((c-parse-array parse-elt) x) (define ((c-parse-array parse-elt) buf start end)
;; NOTE: we assume that array enclosed with "{" and "}", and separator is "," ;; NOTE: we assume that array enclosed with "{" and "}", and separator is ","
(let* ([s (bytes->string/utf-8 x)] (let* ([s (bytes->string/utf-8 buf #f start end)]
[vals [vals
(let loop ([s s]) (let loop ([s s])
(cond [(equal? s "{}") '#()] (cond [(equal? s "{}") '#()]
@ -378,53 +378,55 @@ record = cols:int4 (typeoid:int4 len/-1:int4 data:byte^len)^cols
"}")]))])])) "}")]))])]))
;; Binary readers ;; Binary readers
;; Take bytes, start offset, end offset (but most ignore end)
(define (recv-bits x) (define (recv-bits buf start end)
(let* ([len (integer-bytes->integer x #t #t 0 4)]) (let* ([bitslen (integer-bytes->integer buf #t #t start (+ start 4))])
(make-sql-bits/bytes len (subbytes x 4) 0))) (make-sql-bits/bytes bitslen (subbytes buf (+ start 4) end) 0)))
(define (recv-boolean x) (define (recv-boolean buf start end)
(case (bytes-ref x 0) (case (bytes-ref buf start)
((0) #f) ((0) #f)
((1) #t) ((1) #t)
(else (error/internal* 'recv-boolean "bad value" '("value" value) x)))) (else (error/internal* 'recv-boolean "bad value"
'("value" value) (bytes-ref buf start)))))
(define (recv-char1 x) (define (recv-char1 buf start end)
(integer->char (bytes-ref x 0))) (integer->char (bytes-ref buf start)))
(define (recv-bytea x) (define (recv-bytea buf start end)
x) (subbytes buf start end))
(define (recv-string x) (define (recv-string buf start end)
(bytes->string/utf-8 x)) (bytes->string/utf-8 buf #f start end))
(define (recv-integer x) (define (recv-integer buf start end)
(integer-bytes->integer x #t #t)) (integer-bytes->integer buf #t #t start end))
(define (recv-unsigned-integer x) (define (recv-unsigned-integer buf start end)
(integer-bytes->integer x #f #t)) (integer-bytes->integer buf #f #t start end))
(define (recv-float x) (define (recv-float buf start end)
(floating-point-bytes->real x #t)) (floating-point-bytes->real buf #t start end))
(define (get-double bs offset) (define (get-double bs offset)
(floating-point-bytes->real bs #t offset (+ 8 offset))) (floating-point-bytes->real bs #t offset (+ 8 offset)))
(define (recv-point x [offset 0]) (define (recv-point buf start end)
(point (get-double x (+ offset 0)) (get-double x (+ offset 8)))) (point (get-double buf start) (get-double buf (+ start 8))))
(define (recv-box x) (define (recv-box buf start end)
(pg-box (recv-point x 0) (recv-point x 16))) (pg-box (recv-point buf start #f) (recv-point buf (+ start 16) #f)))
(define (recv-circle x) (define (recv-circle buf start end)
(pg-circle (recv-point x 0) (get-double x 16))) (pg-circle (recv-point buf start #f) (get-double buf (+ start 16))))
(define (recv-lseg x) (define (recv-lseg buf start end)
(line-string (list (recv-point x 0) (recv-point x 16)))) (line-string (list (recv-point buf start #f) (recv-point buf (+ start 16) #f))))
(define (recv-path x) (define (recv-path buf start end)
(pg-path (not (zero? (bytes-ref x 0))) (pg-path (not (zero? (bytes-ref buf start)))
(for/list ([i (integer-bytes->integer x #t #t 1 5)]) (for/list ([i (integer-bytes->integer buf #t #t (+ start 1) (+ start 5))])
(recv-point x (+ 5 (* 16 i)))))) (recv-point buf (+ start 5 (* 16 i)) #f))))
(define (recv-polygon x) (define (recv-polygon buf start end)
(let* ([points0 (let* ([points0
(for/list ([i (in-range (integer-bytes->integer x #t #t 0 4))]) (for/list ([i (in-range (integer-bytes->integer buf #t #t start (+ start 4)))])
(recv-point x (+ 4 (* 16 i))))] (recv-point buf (+ start 4 (* 16 i)) #f))]
[points (append points0 (list (car points0)))]) [points (append points0 (list (car points0)))])
(polygon (line-string points) (polygon (line-string points)
null))) null)))
@ -453,56 +455,53 @@ record = cols:int4 (typeoid:int4 len/-1:int4 data:byte^len)^cols
(values recv-time recv-timetz))) (values recv-time recv-timetz)))
|# |#
(define (recv-record x) (define (recv-record buf start end)
(let ([start 0]) (define (get-int signed?)
(define (get-int signed?) (begin0 (integer-bytes->integer buf signed? #t start (+ start 4))
(begin0 (integer-bytes->integer x signed? #t start (+ start 4)) (set! start (+ start 4))))
(set! start (+ start 4)))) (define (recv-col)
(define (get-bytes len) (let* ([typeid (get-int #t)]
(begin0 (subbytes x start (+ start len)) [len (get-int #t)])
(set! start (+ start len)))) (if (= len -1)
(define (recv-col) sql-null
(let* ([typeid (get-int #t)] (let* ([bin? (= (typeid->format typeid) 1)] ;; binary reader available
[len (get-int #t)]) [reader (and bin? (typeid->type-reader 'recv-record typeid))])
(if (= len -1) (if reader
sql-null (reader buf start (+ start (max 0 len)))
(let* ([bin? (= (typeid->format typeid) 1)] ;; binary reader available 'unreadable)))))
[reader (and bin? (typeid->type-reader 'recv-record typeid))]) (let* ([columns (get-int #t)]
(if reader [result (make-vector columns #f)])
(reader (get-bytes len)) (for ([i (in-range columns)])
'unreadable))))) (vector-set! result i (recv-col)))
(let ([columns (get-int #t)]) result))
(build-vector columns (lambda (i) (recv-col))))))
(define (recv-array x) (define (recv-array buf start end)
(let ([start 0]) (define (get-int signed?)
(define (get-int signed?) (begin0 (integer-bytes->integer buf signed? #t start (+ start 4))
(begin0 (integer-bytes->integer x signed? #t start (+ start 4)) (set! start (+ start 4))))
(set! start (+ start 4)))) (let* ([ndim (get-int #t)]
(define (get-bytes len) [flags (get-int #f)]
(begin0 (subbytes x start (+ start len)) [elttype (get-int #f)]
(set! start (+ start len)))) [reader (typeid->type-reader 'recv-array elttype)]
(let* ([ndim (get-int #t)] [bounds
[flags (get-int #f)] (for/list ([i (in-range ndim)])
[elttype (get-int #f)] (let* ([dim (get-int #t)]
[reader (typeid->type-reader 'recv-array elttype)] [lbound (get-int #t)])
[bounds (cons dim lbound)))]
(for/list ([i (in-range ndim)]) [vals ;; (vector^ndim X)
(let* ([dim (get-int #t)] (cond [(zero? ndim) '#()]
[lbound (get-int #t)]) [else
(cons dim lbound)))] (let loop ([bounds bounds])
[vals ;; (vector^ndim X) (cond [(pair? bounds)
(cond [(zero? ndim) '#()] (for/vector ([i (in-range (car (car bounds)))])
[else (loop (cdr bounds)))]
(let loop ([bounds bounds]) [else
(cond [(pair? bounds) (let* ([len (get-int #t)])
(for/vector ([i (in-range (car (car bounds)))]) (cond [(= len -1) sql-null]
(loop (cdr bounds)))] [else
[else (begin0 (reader buf start (+ start len))
(let* ([len (get-int #t)]) (set! start (+ start len)))]))]))])])
(cond [(= len -1) sql-null] (pg-array ndim (map car bounds) (map cdr bounds) vals)))
[else (reader (get-bytes len))]))]))])])
(pg-array ndim (map car bounds) (map cdr bounds) vals))))
#| #|
(define (recv-numeric x) (define (recv-numeric x)
@ -538,7 +537,7 @@ record = cols:int4 (typeoid:int4 len/-1:int4 data:byte^len)^cols
c-parse-timestamp-tz c-parse-timestamp-tz
c-parse-interval c-parse-interval
c-parse-decimal) c-parse-decimal)
(let ([c (lambda (f) (lambda (x) (f (bytes->string/utf-8 x))))]) (let ([c (lambda (f) (lambda (buf start end) (f (bytes->string/utf-8 buf #f start end))))])
(values (c parse-date) (values (c parse-date)
(c parse-time) (c parse-time)
(c parse-time-tz) (c parse-time-tz)

30
collects/db/private/postgresql/message.rkt
View File

@ -44,7 +44,7 @@
(struct-out RowDescription) (struct-out RowDescription)
(struct-out Sync) (struct-out Sync)
(struct-out Terminate) (struct-out Terminate)
bytes->row
field-dvec->typeid field-dvec->typeid
field-dvec->field-info) field-dvec->field-info)
@ -288,17 +288,25 @@
(io:read-int16 p))]) (io:read-int16 p))])
(make-CopyOutResponse format column-formats)))) (make-CopyOutResponse format column-formats))))
(define-struct DataRow (values) #:transparent) (define-struct DataRow (data) #:transparent)
(define (parse:DataRow p) (define (parse:DataRow p)
(with-length-in p #\D (let ([len (io:read-int32 p)])
(let* ([values (make-DataRow (read-bytes (- len 4) p))))
(build-vector (io:read-int16 p)
(lambda (i) (define (bytes->row buf type-readers)
(let ([len (io:read-int32 p)]) (let* ([columns (integer-bytes->integer buf #t #t 0 2)]
(if (= len -1) [row (make-vector columns)])
sql-null (let loop ([i 0] [type-readers type-readers] [start 2])
(io:read-bytes-as-bytes p len)))))]) (when (< i columns)
(make-DataRow values)))) (let ([len (integer-bytes->integer buf #t #t start (+ start 4))]
[start* (+ start 4)])
(vector-set! row i
(if (= len -1)
sql-null
((car type-readers) buf start* (+ start* len))))
(let ([next (+ start* (max 0 len))])
(loop (add1 i) (cdr type-readers) next)))))
row))
(define-struct Describe (type name) #:transparent) (define-struct Describe (type name) #:transparent)
(define (write:Describe p v) (define (write:Describe p v)