[functional-tests/regex] stop thread-set from allocating

We now allocate 0 bytes when matching.  But it makes practically no
difference to the execution time.
This commit is contained in:
Joe Thornber 2017-08-18 21:24:38 +01:00
parent ecd616a28c
commit c2bfcf7899

View File

@ -6,6 +6,7 @@
opt opt
star star
plus plus
get-thread-count
compile-rx) compile-rx)
(import (chezscheme) (import (chezscheme)
(fmt fmt) (fmt fmt)
@ -150,29 +151,36 @@
;; so a bundle is represented as a bitvector the same length as the ;; so a bundle is represented as a bitvector the same length as the
;; instructions. Threads are run in lock step, all taking the same input. ;; instructions. Threads are run in lock step, all taking the same input.
(define-record-type thread-set (fields (mutable stack) (mutable seen))) (define-record-type thread-set (fields (mutable size) (mutable stack) (mutable seen)))
(define (mk-thread-set count) (define (mk-thread-set count)
(make-thread-set '() (make-vector count #f))) (make-thread-set 0 (make-vector count) (make-vector count #f)))
(define (clear-thread-set! ts) (define (clear-thread-set! ts)
(thread-set-stack-set! ts '()) (thread-set-size-set! ts 0)
(vector-fill! (thread-set-seen ts) #f)) (vector-fill! (thread-set-seen ts) #f))
(define thread-count 0)
(define (get-thread-count)
thread-count)
(define (add-thread! ts i) (define (add-thread! ts i)
(unless (vector-ref (thread-set-seen ts) i) (unless (vector-ref (thread-set-seen ts) i)
;(fmt #t (dsp "adding thread ") (num i) nl)
(set! thread-count (+ 1 thread-count))
(vector-set! (thread-set-seen ts) i #t) (vector-set! (thread-set-seen ts) i #t)
(thread-set-stack-set! ts (cons i (thread-set-stack ts))))) (vector-set! (thread-set-stack ts) (thread-set-size ts) i)
(thread-set-size-set! ts (+ 1 (thread-set-size ts)))))
(define (pop-thread! ts) (define (pop-thread! ts)
(if (null? (thread-set-stack ts)) (if (zero? (thread-set-size ts))
#f #f
(let ((t (car (thread-set-stack ts)))) (begin
(thread-set-stack-set! ts (cdr (thread-set-stack ts))) (thread-set-size-set! ts (- (thread-set-size ts) 1))
t))) (vector-ref (thread-set-stack ts) (thread-set-size ts)))))
(define (no-threads? ts) (define (no-threads? ts)
(null? (thread-set-stack ts))) (zero? (thread-set-size ts)))
(define (any-matches? ts code) (define (any-matches? ts code)
(call/cc (call/cc
@ -182,16 +190,6 @@
(k #t))) (k #t)))
#f))) #f)))
(define (mk-init-thread-set count)
(let ((ts (mk-thread-set count)))
(add-thread! ts 0)
ts))
(define-syntax string-iter
(syntax-rules ()
((_ (var str) body ...)
(string-for-each (lambda (var) body ...) str))))
(define-syntax swap (define-syntax swap
(syntax-rules () (syntax-rules ()
((_ x y) ((_ x y)
@ -200,8 +198,8 @@
(set! y tmp))))) (set! y tmp)))))
(define (compile-rx rx) (define (compile-rx rx)
; (fmt #t (dsp "running ") (pretty code) nl)
(let ((code (compile-rx% rx))) (let ((code (compile-rx% rx)))
;(fmt #t (dsp "running ") (pretty code) nl)
(let ((code-len (vector-length code))) (let ((code-len (vector-length code)))
(let ((threads (mk-thread-set code-len)) (let ((threads (mk-thread-set code-len))
(next-threads (mk-thread-set code-len))) (next-threads (mk-thread-set code-len)))