cs: avoid Chez Scheme fasl of immutable hash table
Change the ".zo" format to convert a linklet bundle hash table to a list, which avoids probblems with stencil-vector encodings and cross cimpilation between 32-bit and 64-bit platforms. Avoiding records, stencil values, and hash code should make the fasled form simpler.
This commit is contained in:
parent
b164f16681
commit
80ad628eef
|
@ -12,7 +12,7 @@
|
|||
|
||||
(define collection 'multi)
|
||||
|
||||
(define version "7.8.0.8")
|
||||
(define version "7.8.0.9")
|
||||
|
||||
(define deps `("racket-lib"
|
||||
["racket" #:version ,version]))
|
||||
|
|
|
@ -80,7 +80,7 @@
|
|||
(vm-eval
|
||||
`(let ([code ',code]
|
||||
[memcpy ',(lambda (to from len)
|
||||
(memcpy to (cast from _intptr _pointer) len))])
|
||||
(memcpy to (cast from _uintptr _pointer) len))])
|
||||
(lock-object code)
|
||||
(let* ([code-p (($primitive $object-address) code ,code-pointer-adjust)]
|
||||
[length (foreign-ref 'uptr code-p (foreign-sizeof 'uptr))]
|
||||
|
|
|
@ -18,18 +18,20 @@
|
|||
v)
|
||||
'read-on-demand-source))
|
||||
|
||||
(define (adjust-linklet-bundle-laziness-and-paths ht)
|
||||
(let loop ([i (hash-iterate-first ht)])
|
||||
(define (adjust-linklet-bundle-laziness-and-paths ls)
|
||||
(let loop ([ls ls] [ht (hasheq)])
|
||||
(cond
|
||||
[(not i) (hasheq)]
|
||||
[(null? ls) ht]
|
||||
[else
|
||||
(let-values ([(key val) (hash-iterate-key+value ht i)])
|
||||
(hash-set (loop (hash-iterate-next ht i))
|
||||
key
|
||||
(if (linklet? val)
|
||||
(adjust-linklet-laziness
|
||||
(decode-linklet-paths val))
|
||||
val)))])))
|
||||
(let ([key (car ls)]
|
||||
[val (cadr ls)])
|
||||
(loop (cddr ls)
|
||||
(hash-set ht
|
||||
key
|
||||
(if (linklet? val)
|
||||
(adjust-linklet-laziness
|
||||
(decode-linklet-paths val))
|
||||
val))))])))
|
||||
|
||||
(define (adjust-linklet-laziness linklet)
|
||||
(set-linklet-code linklet
|
||||
|
|
|
@ -4,22 +4,22 @@
|
|||
#vu8(99 104 101 122 45 115 99 104 101 109 101))
|
||||
|
||||
(define (write-linklet-bundle-hash ht dest-o)
|
||||
(let-values ([(ht cross-machine) (encode-linklet-paths ht)])
|
||||
(let-values ([(ls cross-machine) (encode-linklet-paths ht)])
|
||||
(let ([bstr (if cross-machine
|
||||
(let-values ([(bstr sfd-paths) (cross-fasl-to-string cross-machine ht)])
|
||||
(let-values ([(bstr sfd-paths) (cross-fasl-to-string cross-machine ls)])
|
||||
;; sfd-paths should be empty
|
||||
bstr)
|
||||
(let-values ([(o get) (open-bytevector-output-port)])
|
||||
(fasl-write* ht o)
|
||||
(fasl-write* ls o)
|
||||
(get)))])
|
||||
(write-bytes (integer->integer-bytes (bytes-length bstr) 4 #f #f) dest-o)
|
||||
(write-bytes bstr dest-o))))
|
||||
|
||||
(define (encode-linklet-paths orig-ht)
|
||||
(let ([path->compiled-path (make-path->compiled-path 'write-linklet)])
|
||||
(let loop ([i (hash-iterate-first orig-ht)] [ht orig-ht] [cross-machine #f])
|
||||
(let loop ([i (hash-iterate-first orig-ht)] [accum '()] [cross-machine #f])
|
||||
(cond
|
||||
[(not i) (values ht cross-machine)]
|
||||
[(not i) (values accum cross-machine)]
|
||||
[else
|
||||
(let-values ([(key v) (hash-iterate-key+value orig-ht i)])
|
||||
(when (linklet? v) (check-fasl-preparation v))
|
||||
|
@ -39,11 +39,9 @@
|
|||
[else v])])
|
||||
(when (linklet? new-v)
|
||||
(linklet-pack-exports-info! new-v))
|
||||
(let ([new-ht (if (eq? v new-v)
|
||||
ht
|
||||
(hash-set ht key new-v))])
|
||||
(let ([accum (cons* key new-v accum)])
|
||||
(loop (hash-iterate-next orig-ht i)
|
||||
new-ht
|
||||
accum
|
||||
(or cross-machine
|
||||
(and (linklet? v)
|
||||
(let ([prep (linklet-preparation v)])
|
||||
|
|
|
@ -16,7 +16,7 @@
|
|||
#define MZSCHEME_VERSION_X 7
|
||||
#define MZSCHEME_VERSION_Y 8
|
||||
#define MZSCHEME_VERSION_Z 0
|
||||
#define MZSCHEME_VERSION_W 8
|
||||
#define MZSCHEME_VERSION_W 9
|
||||
|
||||
/* A level of indirection makes `#` work as needed: */
|
||||
#define AS_a_STR_HELPER(x) #x
|
||||
|
|
Loading…
Reference in New Issue
Block a user