Skip to content

Commit

Permalink
thread & cs: fix place bugs
Browse files Browse the repository at this point in the history
  • Loading branch information
mflatt committed Sep 11, 2018
1 parent 30fb62e commit 862c05d
Show file tree
Hide file tree
Showing 6 changed files with 27 additions and 15 deletions.
6 changes: 5 additions & 1 deletion racket/src/cs/main.sps
Expand Up @@ -207,6 +207,8 @@
(let () body ...)
(string-case arg rest ...))]))

(define remaining-command-line-arguments '#())

(seq
(let flags-loop ([args (list-tail the-command-line-arguments 5)]
[saw (hasheq)])
Expand All @@ -220,7 +222,8 @@
(not (saw? saw 'non-config)))
(loop (cons "-u" args))]
[else
(|#%app| current-command-line-arguments (list->vector args))
(set! remaining-command-line-arguments (vector->immutable-vector
(list->vector args)))
(when (and (null? args) (not (saw? saw 'non-config)))
(set! repl? #t)
(unless gracket?
Expand Down Expand Up @@ -459,6 +462,7 @@
'()))))

(define (initialize-place!)
(|#%app| current-command-line-arguments remaining-command-line-arguments)
(|#%app| use-compiled-file-paths compiled-file-paths)
(|#%app| use-user-specific-search-paths user-specific-search-paths?)
(|#%app| load-on-demand-enabled load-on-demand?)
Expand Down
8 changes: 4 additions & 4 deletions racket/src/cs/place-register.ss
Expand Up @@ -5,16 +5,16 @@
;; first index is reserved for Rumble:

(meta chez:define thread-register-start 1)
(meta chez:define thread-register-count 14)
(meta chez:define thread-register-count 31)

(meta chez:define io-register-start (+ thread-register-start thread-register-count))
(meta chez:define io-register-count 16)
(meta chez:define io-register-count 32)

(meta chez:define regexp-register-start (+ io-register-start io-register-count))
(meta chez:define regexp-register-count 3)
(meta chez:define regexp-register-count 32)

(meta chez:define expander-register-start (+ regexp-register-start regexp-register-count))
(meta chez:define expander-register-count 30)
(meta chez:define expander-register-count 32)

;; ----------------------------------------

Expand Down
2 changes: 1 addition & 1 deletion racket/src/cs/rumble/place.ss
Expand Up @@ -7,7 +7,7 @@
;; place-local values, and the rest are used by the thread, io, etc.,
;; layers for directly accessed variables.

(define NUM-PLACE-REGISTERS 64)
(define NUM-PLACE-REGISTERS 128)

(define-virtual-register place-registers (make-vector NUM-PLACE-REGISTERS 0))
(define place-register-inits (make-vector NUM-PLACE-REGISTERS 0))
Expand Down
11 changes: 6 additions & 5 deletions racket/src/thread/place-message.rkt
Expand Up @@ -42,7 +42,7 @@
(or (not direct?)
(and (immutable? v)
(not (impersonator? v))))
(let ([graph (hash-ref graph v #t)])
(let ([graph (hash-set graph v #t)])
(for/and ([e (in-vector v)])
(loop e graph))))
(and (immutable-prefab-struct-key v)
Expand Down Expand Up @@ -128,7 +128,7 @@
(apply make-prefab-struct
k
(for/list ([e (in-vector (struct->vector v) 1)])
(loop v)))))]
(loop e)))))]
[(hash? v)
(define ph (make-placeholder #f))
(hash-set! graph v ph)
Expand Down Expand Up @@ -177,14 +177,15 @@
[(pair? v)
(cons (loop (car v)) (loop (cdr v)))]
[(vector? v)
(for/vector #:length (vector-length v) ([e (in-vector v)])
(loop e))]
(vector->immutable-vector
(for/vector #:length (vector-length v) ([e (in-vector v)])
(loop e)))]
[(immutable-prefab-struct-key v)
=> (lambda (k)
(apply make-prefab-struct
k
(for/list ([e (in-vector (struct->vector v) 1)])
(loop v))))]
(loop e))))]
[(hash? v)
(cond
[(hash-eq? v)
Expand Down
1 change: 1 addition & 0 deletions racket/src/thread/schedule.rkt
Expand Up @@ -36,6 +36,7 @@
(define (call-in-another-main-thread c thunk)
(make-another-initial-thread-group)
(set-root-custodian! c)
(init-system-idle-evt!)
(call-in-main-thread thunk))

;; ----------------------------------------
Expand Down
14 changes: 10 additions & 4 deletions racket/src/thread/system-idle-evt.rkt
@@ -1,14 +1,16 @@
#lang racket/base
(require "evt.rkt"
(require "place-local.rkt"
"evt.rkt"
"semaphore.rkt")

(provide (rename-out [get-system-idle-evt system-idle-evt])

any-idle-waiters?
post-idle)
post-idle
init-system-idle-evt!)

(define idle-sema (make-semaphore))
(define wrapped-idle-sema (wrap-evt idle-sema void))
(define-place-local idle-sema (make-semaphore))
(define-place-local wrapped-idle-sema (wrap-evt idle-sema void))
(struct system-idle-evt ()
#:property prop:evt (lambda (i) wrapped-idle-sema))

Expand All @@ -29,3 +31,7 @@
(begin
(semaphore-post/atomic idle-sema)
#t)))

(define (init-system-idle-evt!)
(set! idle-sema (make-semaphore))
(set! wrapped-idle-sema (wrap-evt idle-sema void)))

0 comments on commit 862c05d

Please sign in to comment.