protobuf

Check-in [2ca2dc01e3]
Login

Check-in [2ca2dc01e3]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Removed hash function bug workaround
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | chicken-5
Files: files | file ages | folders
SHA3-256: 2ca2dc01e3ad6ed3eba23f4b16c7852b89a829bc5b6456c80d03cd29cd46627b
User & Date: murphy 2018-08-27 20:23:23.490
Context
2018-08-27
20:41
Keep srfi-4-comprehensions module private check-in: 240acd7684 user: murphy tags: chicken-5, v1.2.0
20:23
Removed hash function bug workaround check-in: 2ca2dc01e3 user: murphy tags: chicken-5
20:22
Additional source dependency entries in egg file check-in: 7964a1f7ad user: murphy tags: chicken-5
Changes
Unified Diff Ignore Whitespace Patch
Changes to generic.scm.
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
  #f #t
  obj->ref
  ref->obj)

(define current-serialization-context
  (make-parameter #f))

;; FIXME this workaround for crashes in hash functions provided by
;; srfi-69 may interact badly with the garbage collector and should
;; be removed as soon as the implementation of hash tables is fixed.
(define %eq?-hash
  (foreign-lambda* int ([scheme-object v] [int bound])
    "C_return((((intptr_t) v) >> C_FIXNUM_SHIFT) % bound);"))

(define make-serialization-context
  (let ([make-serialization-context* (rtd-constructor serialization-context)])
    (lambda vs
      (let* ([obj->ref (make-hash-table eq? %eq?-hash)]
             [ref->obj (make-hash-table eqv? eqv?-hash)]
             [context (make-serialization-context* obj->ref ref->obj)])
        (do-ec (:list v (index ref) (cons context vs))
          (begin
            (hash-table-set! obj->ref v ref)
            (hash-table-set! ref->obj ref v)))
        context))))







<
<
<
<
<
<
<



|







29
30
31
32
33
34
35







36
37
38
39
40
41
42
43
44
45
46
  #f #t
  obj->ref
  ref->obj)

(define current-serialization-context
  (make-parameter #f))








(define make-serialization-context
  (let ([make-serialization-context* (rtd-constructor serialization-context)])
    (lambda vs
      (let* ([obj->ref (make-hash-table eq? eq?-hash)]
             [ref->obj (make-hash-table eqv? eqv?-hash)]
             [context (make-serialization-context* obj->ref ref->obj)])
        (do-ec (:list v (index ref) (cons context vs))
          (begin
            (hash-table-set! obj->ref v ref)
            (hash-table-set! ref->obj ref v)))
        context))))