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

cs: fix weak hash table weakness after iteration

Browse Source
This commit is contained in:
Matthew Flatt 2018-08-20 07:16:52 -06:00
parent 70f7cf99ae
commit ae7a64b4ea
3 changed files with 43 additions and 143 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

101
racket/src/cs/demo/io-impl.rkt
View File

@ -1,101 +0,0 @@
#lang racket/base
(require racket/include
racket/unsafe/ops
racket/flonum
racket/fixnum
'#%foreign
(only-in '#%kernel open-input-file)
(only-in '#%paramz
parameterization-key
extend-parameterization
break-enabled-key
check-for-break)
(only-in '#%linklet
primitive-table))
(provide (rename-out
(1/build-path/convention-type build-path/convention-type)
(1/peek-bytes! peek-bytes!)
(1/explode-path explode-path)
(1/peek-byte peek-byte)
(1/write write)
(1/fprintf fprintf)
(1/write-bytes-avail write-bytes-avail)
(1/open-output-bytes open-output-bytes)
(1/open-input-file open-input-file)
(1/write-bytes-avail* write-bytes-avail*)
(1/path-element->string path-element->string)
(1/simplify-path simplify-path)
(1/bytes->string/locale bytes->string/locale)
(1/error error)
(1/current-input-port current-input-port)
(1/path->directory-path path->directory-path)
(1/read-bytes-avail!* read-bytes-avail!*)
(1/make-pipe make-pipe)
(1/write-string write-string)
(1/bytes->path bytes->path)
(1/path<? path<?)
(1/open-input-bytes open-input-bytes)
(1/read-string! read-string!)
(1/string-port? string-port?)
(1/string->bytes/latin-1 string->bytes/latin-1)
(is-path? path?)
(1/bytes->string/utf-8 bytes->string/utf-8)
(1/path->bytes path->bytes)
(1/format format)
(1/newline newline)
(1/string->bytes/utf-8 string->bytes/utf-8)
(1/string->bytes/locale string->bytes/locale)
(1/read-bytes read-bytes)
(pipe-input-port? pipe-input-port?)
(1/string->path-element string->path-element)
(1/peek-char peek-char)
(1/absolute-path? absolute-path?)
(1/path-convention-type path-convention-type)
(1/path->complete-path path->complete-path)
(1/bytes-utf-8-length bytes-utf-8-length)
(1/cleanse-path cleanse-path)
(1/peek-string peek-string)
(1/write-bytes-avail/enable-break write-bytes-avail/enable-break)
(1/display display)
(1/read-char read-char)
(1/make-output-port make-output-port)
(1/bytes->path-element bytes->path-element)
(1/complete-path? complete-path?)
(1/build-path build-path)
(1/relative-path? relative-path?)
(1/path-for-some-system? path-for-some-system?)
(1/open-input-string open-input-string)
(1/string->path string->path)
(1/close-input-port close-input-port)
(1/current-error-port current-error-port)
(1/write-bytes write-bytes)
(1/prop:custom-write prop:custom-write)
(1/read-bytes-avail! read-bytes-avail!)
(1/peek-string! peek-string!)
(1/string-utf-8-length string-utf-8-length)
(pipe-output-port? pipe-output-port?)
(1/print print)
(1/read-byte read-byte)
(1/make-input-port make-input-port)
(1/port-next-location port-next-location)
(1/path-element->bytes path-element->bytes)
(1/split-path split-path)
(1/printf printf)
(1/read-string read-string)
(1/bytes->string/latin-1 bytes->string/latin-1)
(1/port-count-lines! port-count-lines!)
(1/path->string path->string)
(1/current-output-port current-output-port)
(1/peek-bytes-avail! peek-bytes-avail!)
(1/pipe-content-length pipe-content-length)
(1/peek-bytes-avail!* peek-bytes-avail!*)
(1/read-bytes! read-bytes!)
(1/peek-bytes peek-bytes)
(1/close-output-port close-output-port)
(1/open-output-string open-output-string)))
(define-syntax-rule (linklet () (ex ...) body ...)
(begin body ...))
(include "../../io/compiled/io.rktl")

31
racket/src/cs/demo/io.rkt
View File

@ -1,12 +1,4 @@
#lang racket/base
(require "io-impl.rkt"
(only-in racket/base
[open-input-file c:open-input-file]
[port-count-lines! c:port-count-lines!]
[read-string c:read-string]
[close-input-port c:close-input-port]
[bytes->string/utf-8 c:bytes->string/utf-8]
[string->bytes/utf-8 c:string->bytes/utf-8]))
(time
(let loop ([j 10])
@ -21,21 +13,6 @@
(close-input-port p)
(loop (sub1 j))))))
'|Same, but in C....|
(time
(let loop ([j 10])
(unless (zero? j)
(let ()
(define p (c:open-input-file "compiled/io.scm"))
(c:port-count-lines! p)
(let loop ()
(define s (c:read-string 100 p))
(unless (eof-object? s)
(loop)))
(c:close-input-port p)
(loop (sub1 j))))))
(time
(let loop ([j 10])
(unless (zero? j)
@ -54,11 +31,3 @@
v
(loop (sub1 i)
(bytes->string/utf-8 (string->bytes/utf-8 "ap\x3BB;ple"))))))
'|Same, but in C...|
(time
(let loop ([i 1000000] [v #f])
(if (zero? i)
v
(loop (sub1 i)
(c:bytes->string/utf-8 (c:string->bytes/utf-8 "ap\x3BB;ple"))))))

54
racket/src/cs/rumble/hash.ss
View File

@ -438,15 +438,23 @@
(lock-release (locked-iterable-hash-lock ht))
vec]
[else
(let ([new-vec (get-locked-iterable-hash-cells
(let ([weak? (locked-iterable-hash-weak? ht)]
[new-vec (get-locked-iterable-hash-cells
ht
(fxmax (if vec
(fx* 2 (#%vector-length vec))
0)
32))])
(when (= (#%vector-length new-vec) (hash-count ht))
(set-locked-iterable-hash-retry?! ht #f))
(let ([vec (cells-merge vec new-vec)])
(let ([len (#%vector-length new-vec)])
(when (= len (hash-count ht))
(set-locked-iterable-hash-retry?! ht #f))
(when weak?
(let loop ([i 0])
(unless (fx= i len)
(let ([p (#%vector-ref new-vec i)])
(#%vector-set! new-vec i (ephemeron/fl-cons (car p) p)))
(loop (fx+ i 1))))))
(let ([vec (cells-merge vec new-vec weak?)])
(set-locked-iterable-hash-cells! ht vec)
(lock-release (locked-iterable-hash-lock ht))
vec))])))
@ -456,11 +464,16 @@
[(mutable-hash? ht) (hashtable-cells (mutable-hash-ht ht) n)]
[else (weak-equal-hash-cells ht n)]))
(define (locked-iterable-hash-weak? ht)
(cond
[(mutable-hash? ht) (hashtable-weak? (mutable-hash-ht ht))]
[else #t]))
;; Separate calls to `hashtable-cells` may return the
;; cells in a different order, so we have to merge the
;; tables. The resulting vector starts with the same
;; elements as `vec`.
(define (cells-merge vec new-vec)
(define (cells-merge vec new-vec weak?)
(cond
[(not vec)
;; Nothing to merge
@ -470,14 +483,16 @@
(and (fx= len (#%vector-length new-vec))
(let loop ([i 0])
(or (fx= i len)
(and (eq? (#%vector-ref vec i) (#%vector-ref new-vec i))
(and (if weak?
(eq? (cdr (#%vector-ref vec i)) (cdr (#%vector-ref new-vec i)))
(eq? (#%vector-ref vec i) (#%vector-ref new-vec i)))
(loop (fx+ i 1)))))))
new-vec]
[else
;; General case
(let ([new-ht (make-eq-hashtable)])
(vector-for-each (lambda (p) (hashtable-set! new-ht p #t)) new-vec)
(vector-for-each (lambda (p) (hashtable-delete! new-ht p)) vec)
(vector-for-each (lambda (p) (hashtable-set! new-ht (if weak? (cdr p) p) #t)) new-vec)
(vector-for-each (lambda (p) (hashtable-delete! new-ht (if weak? (cdr p) p))) vec)
(let ([merge-vec (make-vector (fx+ (#%vector-length vec) (hashtable-size new-ht)))])
(let loop ([i (#%vector-length vec)])
(unless (fx= i 0)
@ -489,7 +504,7 @@
(unless (fx= i new-len)
(let ([p (#%vector-ref new-vec i)])
(cond
[(hashtable-contains? new-ht p)
[(hashtable-contains? new-ht (if weak? (cdr p) p))
(#%vector-set! merge-vec j p)
(loop (fx+ i 1) (fx+ j 1))]
[else
@ -541,7 +556,13 @@
[(= i len)
#f]
[else
(let* ([p (#%vector-ref vec i)]
(let* ([p (let ([p (#%vector-ref vec i)])
(if (locked-iterable-hash-weak? ht)
(let ([p (cdr p)])
(if (bwp-object? p)
'(#!bwp . #!bwp)
p))
p))]
[key (car p)])
(cond
[(bwp-object? key)
@ -570,7 +591,13 @@
(let* ([vec (prepare-iterate! ht i)]
[len (#%vector-length vec)]
[p (if (fx< i len)
(#%vector-ref vec i)
(let ([p (#%vector-ref vec i)])
(if (locked-iterable-hash-weak? ht)
(let ([p (cdr p)])
(if (bwp-object? p)
'(#!bwp . #!bwp)
p))
p))
'(#!bwp . #!bwp))]
[key (car p)]
[v (if (bwp-object? key)
@ -939,6 +966,11 @@
(cons key d)
(weak-cons key d)))
(define (ephemeron/fl-cons key d)
(if (flonum? key)
(cons key d)
(ephemeron-cons key d)))
;; ----------------------------------------
(define (set-hash-hash!)