1 2;; The vector of place locals is similar to the set of virtual 3;; registers, but the array can be shared by multiple Scheme threads 4;; that are all in the same place. 5 6;; The first slot in the vector holds a hash table for allocated 7;; place-local values, the last is used by "async-callback.ss", and 8;; the rest are used by the thread, io, etc., layers for directly 9;; accessed variables. 10 11(define NUM-PLACE-REGISTERS 128) ; 3 through 126 available for subsystems 12 13(define LOCAL_TABLE-INDEX 0) 14(define ASYNC-CALLBACK-REGISTER-INDEX 1) 15;; index 2 is available 16 17(define-virtual-register place-registers (#%make-vector NUM-PLACE-REGISTERS 0)) 18(define place-register-inits (#%make-vector NUM-PLACE-REGISTERS 0)) 19 20(define (init-place-locals!) 21 (#%vector-set! (place-registers) LOCAL_TABLE-INDEX (make-weak-hasheq))) 22 23(define-record place-local (default-v)) 24 25(define (unsafe-make-place-local v) 26 (make-place-local v)) 27 28(define (unsafe-place-local-ref pl) 29 (let ([v (hash-ref (#%vector-ref (place-registers) LOCAL_TABLE-INDEX) pl none)]) 30 (if (eq? v none) 31 (place-local-default-v pl) 32 v))) 33 34(define (unsafe-place-local-set! pl v) 35 (hash-set! (#%vector-ref (place-registers) LOCAL_TABLE-INDEX) pl v)) 36 37(define (place-local-register-ref i) 38 (#%vector-ref (place-registers) i)) 39 40(define (place-local-register-set! i v) 41 (#%vector-set! (place-registers) i v)) 42 43(define (place-local-register-init! i v) 44 (place-local-register-set! i v) 45 (#%vector-set! place-register-inits i v)) 46 47(define (get-place-registers) 48 (place-registers)) 49 50(define (set-place-registers! vec) 51 (place-registers vec)) 52 53;; ---------------------------------------- 54 55(define place-async-callback-queue 56 (case-lambda 57 [() (let ([v (#%vector-ref (place-registers) ASYNC-CALLBACK-REGISTER-INDEX)]) 58 (if (eqv? v 0) 59 #f 60 v))] 61 [(v) (#%vector-set! (place-registers) ASYNC-CALLBACK-REGISTER-INDEX v)])) 62 63;; ---------------------------------------- 64 65(define place-specific-table (unsafe-make-place-local #f)) 66 67(define (unsafe-get-place-table) 68 (with-interrupts-disabled 69 (or (unsafe-place-local-ref place-specific-table) 70 (let ([ht (make-hasheq)]) 71 (unsafe-place-local-set! place-specific-table ht) 72 ht)))) 73 74;; ---------------------------------------- 75 76(define-thread-local place-esc-box (box #f)) 77 78(meta-cond 79 [(threaded?) 80 (define (place-enabled?) #t) 81 (define (fork-place thunk finish-proc) 82 (do-prepare-for-place) 83 (fork-thread (lambda () 84 (collect-trip-for-allocating-places! +1) 85 (thread-preserve-ownership!) ; encourages parallel GC 86 (init-virtual-registers) 87 (place-registers (vector-copy place-register-inits)) 88 (root-thread-cell-values (make-empty-thread-cell-values)) 89 (init-place-locals!) 90 (register-as-place-main!) 91 (async-callback-place-init!) 92 (let ([result (call/cc 93 (lambda (esc) 94 (set-box! place-esc-box esc) 95 (thunk) 96 0))]) 97 (finish-proc result) 98 (collect-trip-for-allocating-places! -1) 99 (do-destroy-place))))) 100 ;; Must be called within an engine, used for memory accounting: 101 (define (current-place-roots) 102 (list (place-registers) 103 (current-engine-thread-cell-values)))] 104 [else 105 (define (place-enabled?) #f) 106 (define (fork-place thunk finish-proc) #f) 107 (define (current-place-roots) '())]) 108 109(define do-prepare-for-place void) 110(define (set-prepare-for-place! proc) 111 (set! do-prepare-for-place proc)) 112 113(define do-place-get-inherit (lambda () (list))) 114(define (set-place-get-inherit! proc) 115 (set! do-place-get-inherit proc)) 116 117(define do-start-place void) 118(define (set-start-place! proc) 119 (set! do-start-place proc)) 120 121(define do-destroy-place void) 122(define (set-destroy-place! proc) 123 (set! do-destroy-place proc)) 124 125(define (place-get-inherit) 126 (do-place-get-inherit)) 127 128(define (start-place pch path sym in out err cust plumber inh) 129 (let ([finish (do-start-place pch path sym in out err cust plumber inh)]) 130 (reset-async-callback-poll-wakeup!) 131 finish)) 132 133(define (place-exit v) 134 (let ([esc (unbox place-esc-box)]) 135 (if esc 136 (esc v) 137 (#%exit v)))) 138 139(define place-shared (make-weak-eq-hashtable)) 140 141(define (place-shared? v) 142 (with-global-lock 143 (hashtable-ref place-shared v #f))) 144 145(define (register-place-shared v) 146 (with-global-lock 147 (hashtable-set! place-shared v #t)) 148 v) 149