diff --git a/racket/src/cs/demo/io-impl.rkt b/racket/src/cs/demo/io-impl.rkt deleted file mode 100644 index 7a5e4cf040..0000000000 --- a/racket/src/cs/demo/io-impl.rkt +++ /dev/null @@ -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/pathbytes/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") diff --git a/racket/src/cs/demo/io.rkt b/racket/src/cs/demo/io.rkt index d3621c93e0..84390a7a98 100644 --- a/racket/src/cs/demo/io.rkt +++ b/racket/src/cs/demo/io.rkt @@ -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")))))) diff --git a/racket/src/cs/rumble/hash.ss b/racket/src/cs/rumble/hash.ss index a02c7d6ad7..fbe02d09eb 100644 --- a/racket/src/cs/rumble/hash.ss +++ b/racket/src/cs/rumble/hash.ss @@ -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!)