[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:
parent
ecd616a28c
commit
c2bfcf7899
@ -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)))
|
||||||
|
Loading…
Reference in New Issue
Block a user