add virtual-machine identifier to bytecode and ".dep" files
So far, bytecode for traditional Racket has been kept separate from RacketCS bytecode by using a different "compiled" subdirectory for RacketCS. That makes sense for development work to allow the implementations to coexist, but it creates trouble for packaging and distributions, and it (hopefully) won't seem necessary in the long run. Treating the different virtual machines like different versions seems more generally in line with our current infrastructure.
This commit is contained in:
parent
e3f25a6159
commit
8bed64f44f
|
@ -14,8 +14,9 @@
|
||||||
(call-with-input-file* dep-path read)))
|
(call-with-input-file* dep-path read)))
|
||||||
(for/fold ([all-deps all-deps]) ([dep (in-list (if (and (list? deps)
|
(for/fold ([all-deps all-deps]) ([dep (in-list (if (and (list? deps)
|
||||||
(pair? deps)
|
(pair? deps)
|
||||||
(pair? (cdr deps)))
|
(pair? (cdr deps))
|
||||||
(cddr deps)
|
(pair? (cddr deps)))
|
||||||
|
(cdddr deps)
|
||||||
'()))])
|
'()))])
|
||||||
(define p (collects-relative*->path (dep->encoded-path dep) collection-cache))
|
(define p (collects-relative*->path (dep->encoded-path dep) collection-cache))
|
||||||
(cond
|
(cond
|
||||||
|
|
|
@ -234,6 +234,7 @@
|
||||||
(cons 'ext d)))
|
(cons 'ext d)))
|
||||||
external-deps))])
|
external-deps))])
|
||||||
(write (list* (version)
|
(write (list* (version)
|
||||||
|
(system-type 'vm)
|
||||||
(cons (or src-sha1 (get-source-sha1 path))
|
(cons (or src-sha1 (get-source-sha1 path))
|
||||||
(get-dep-sha1s deps up-to-date collection-cache read-src-syntax path->mode roots #t #hash()))
|
(get-dep-sha1s deps up-to-date collection-cache read-src-syntax path->mode roots #t #hash()))
|
||||||
(sort deps s-exp<?))
|
(sort deps s-exp<?))
|
||||||
|
@ -413,13 +414,14 @@
|
||||||
|
|
||||||
(define (install-module-hashes! s [start 0] [len (bytes-length s)])
|
(define (install-module-hashes! s [start 0] [len (bytes-length s)])
|
||||||
(define vlen (bytes-ref s (+ start 2)))
|
(define vlen (bytes-ref s (+ start 2)))
|
||||||
(define mode (integer->char (bytes-ref s (+ start 3 vlen))))
|
(define vmlen (bytes-ref s (+ start 3 vlen)))
|
||||||
|
(define mode (integer->char (bytes-ref s (+ start 4 vlen vmlen))))
|
||||||
(case mode
|
(case mode
|
||||||
[(#\B)
|
[(#\B)
|
||||||
;; A linklet bundle:
|
;; A linklet bundle:
|
||||||
(define h (sha1-bytes s start (+ start len)))
|
(define h (sha1-bytes s start (+ start len)))
|
||||||
;; Write sha1 for bundle hash:
|
;; Write sha1 for bundle hash:
|
||||||
(bytes-copy! s (+ start 4 vlen) h)]
|
(bytes-copy! s (+ start 5 vlen vmlen) h)]
|
||||||
[(#\D)
|
[(#\D)
|
||||||
;; A linklet directory. The format starts with <count>,
|
;; A linklet directory. The format starts with <count>,
|
||||||
;; and then it's <count> records of the format:
|
;; and then it's <count> records of the format:
|
||||||
|
@ -427,8 +429,8 @@
|
||||||
(define (read-num rel-pos)
|
(define (read-num rel-pos)
|
||||||
(define pos (+ start rel-pos))
|
(define pos (+ start rel-pos))
|
||||||
(integer-bytes->integer s #t #f pos (+ pos 4)))
|
(integer-bytes->integer s #t #f pos (+ pos 4)))
|
||||||
(define count (read-num (+ 4 vlen)))
|
(define count (read-num (+ 5 vlen vmlen)))
|
||||||
(for/fold ([pos (+ 8 vlen)]) ([i (in-range count)])
|
(for/fold ([pos (+ 9 vlen vmlen)]) ([i (in-range count)])
|
||||||
(define pos-pos (+ pos 4 (read-num pos)))
|
(define pos-pos (+ pos 4 (read-num pos)))
|
||||||
(define bund-start (read-num pos-pos))
|
(define bund-start (read-num pos-pos))
|
||||||
(define bund-len (read-num (+ pos-pos 4)))
|
(define bund-len (read-num (+ pos-pos 4)))
|
||||||
|
@ -463,14 +465,14 @@
|
||||||
#f)
|
#f)
|
||||||
(let ([src-sha1 (and zo-exists?
|
(let ([src-sha1 (and zo-exists?
|
||||||
deps
|
deps
|
||||||
(cadr deps)
|
(caddr deps)
|
||||||
(get-source-sha1 path))])
|
(get-source-sha1 path))])
|
||||||
(if (and zo-exists?
|
(if (and zo-exists?
|
||||||
src-sha1
|
src-sha1
|
||||||
(equal? src-sha1 (and (pair? (cadr deps))
|
(equal? src-sha1 (and (pair? (caddr deps))
|
||||||
(caadr deps)))
|
(caaddr deps)))
|
||||||
(equal? (get-dep-sha1s (cddr deps) up-to-date collection-cache read-src-syntax path->mode roots #f seen)
|
(equal? (get-dep-sha1s (cdddr deps) up-to-date collection-cache read-src-syntax path->mode roots #f seen)
|
||||||
(cdadr deps)))
|
(cdaddr deps)))
|
||||||
(begin
|
(begin
|
||||||
(trace-printf "hash-equivalent: ~a" zo-name)
|
(trace-printf "hash-equivalent: ~a" zo-name)
|
||||||
(touch zo-name)
|
(touch zo-name)
|
||||||
|
@ -519,7 +521,7 @@
|
||||||
(string-append
|
(string-append
|
||||||
(call-with-input-file* path sha1)
|
(call-with-input-file* path sha1)
|
||||||
(with-handlers ([exn:fail:filesystem? (lambda (exn) "")])
|
(with-handlers ([exn:fail:filesystem? (lambda (exn) "")])
|
||||||
(call-with-input-file* dep-path (lambda (p) (cdadr (read p))))))))))
|
(call-with-input-file* dep-path (lambda (p) (cdaddr (read p))))))))))
|
||||||
|
|
||||||
(define (get-compiled-sha1 path->mode roots path)
|
(define (get-compiled-sha1 path->mode roots path)
|
||||||
(define-values (dir name) (get-compilation-dir+name path #:modes (list (path->mode path)) #:roots roots))
|
(define-values (dir name) (get-compilation-dir+name path #:modes (list (path->mode path)) #:roots roots))
|
||||||
|
@ -534,8 +536,8 @@
|
||||||
|
|
||||||
(define (different-source-sha1-and-dep-recorded path deps)
|
(define (different-source-sha1-and-dep-recorded path deps)
|
||||||
(define src-hash (get-source-sha1 path))
|
(define src-hash (get-source-sha1 path))
|
||||||
(define recorded-hash (and (pair? (cadr deps))
|
(define recorded-hash (and (pair? (caddr deps))
|
||||||
(caadr deps)))
|
(caaddr deps)))
|
||||||
(if (equal? src-hash recorded-hash)
|
(if (equal? src-hash recorded-hash)
|
||||||
#f
|
#f
|
||||||
(list src-hash recorded-hash)))
|
(list src-hash recorded-hash)))
|
||||||
|
@ -548,7 +550,7 @@
|
||||||
(define (compile-root path->mode roots path0 up-to-date collection-cache read-src-syntax sha1-only? seen)
|
(define (compile-root path->mode roots path0 up-to-date collection-cache read-src-syntax sha1-only? seen)
|
||||||
(define orig-path (simple-form-path path0))
|
(define orig-path (simple-form-path path0))
|
||||||
(define (read-deps path)
|
(define (read-deps path)
|
||||||
(with-handlers ([exn:fail:filesystem? (lambda (ex) (list (version) '#f))])
|
(with-handlers ([exn:fail:filesystem? (lambda (ex) (list (version) (system-type 'vm) '#f))])
|
||||||
(with-module-reading-parameterization
|
(with-module-reading-parameterization
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(call-with-input-file*
|
(call-with-input-file*
|
||||||
|
@ -584,7 +586,10 @@
|
||||||
[new-seen (hash-set seen path #t)])
|
[new-seen (hash-set seen path #t)])
|
||||||
(define build
|
(define build
|
||||||
(cond
|
(cond
|
||||||
[(not (and (pair? deps) (equal? (version) (car deps))))
|
[(not (and (pair? deps)
|
||||||
|
(equal? (version) (car deps))
|
||||||
|
(pair? (cdr deps))
|
||||||
|
(equal? (system-type 'vm) (cadr deps))))
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(trace-printf "newer version...")
|
(trace-printf "newer version...")
|
||||||
(maybe-compile-zo #f #f path->mode roots path orig-path read-src-syntax up-to-date collection-cache new-seen))]
|
(maybe-compile-zo #f #f path->mode roots path orig-path read-src-syntax up-to-date collection-cache new-seen))]
|
||||||
|
@ -611,7 +616,7 @@
|
||||||
(begin (trace-printf "newer: ~a (~a > ~a)..."
|
(begin (trace-printf "newer: ~a (~a > ~a)..."
|
||||||
d (car t) path-zo-time)
|
d (car t) path-zo-time)
|
||||||
#t)))
|
#t)))
|
||||||
(cddr deps))
|
(cdddr deps))
|
||||||
;; If `sha1-only?', then `maybe-compile-zo' returns a #f or thunk:
|
;; If `sha1-only?', then `maybe-compile-zo' returns a #f or thunk:
|
||||||
(maybe-compile-zo sha1-only? deps path->mode roots path orig-path read-src-syntax up-to-date collection-cache new-seen)]
|
(maybe-compile-zo sha1-only? deps path->mode roots path orig-path read-src-syntax up-to-date collection-cache new-seen)]
|
||||||
[else #f]))
|
[else #f]))
|
||||||
|
|
|
@ -275,7 +275,7 @@
|
||||||
(eq? (car dep) 'ext))
|
(eq? (car dep) 'ext))
|
||||||
(void)
|
(void)
|
||||||
(dynamic-require (main-collects-relative->path dep) #f))))
|
(dynamic-require (main-collects-relative->path dep) #f))))
|
||||||
(cddr deps))))
|
(cdddr deps))))
|
||||||
;; Not a .zo! Don't use .zo files at all...
|
;; Not a .zo! Don't use .zo files at all...
|
||||||
(escape (lambda ()
|
(escape (lambda ()
|
||||||
;; Try again without .zo
|
;; Try again without .zo
|
||||||
|
|
|
@ -490,7 +490,7 @@
|
||||||
;; This is the slowest part, because we have to read the module ".zo"
|
;; This is the slowest part, because we have to read the module ".zo"
|
||||||
(check-bytecode-deps f dir coll-path pkg))
|
(check-bytecode-deps f dir coll-path pkg))
|
||||||
;; Treat everything in ".dep" as 'build mode...
|
;; Treat everything in ".dep" as 'build mode...
|
||||||
(define deps (cddr (call-with-input-file* (build-path dir f) read)))
|
(define deps (cdddr (call-with-input-file* (build-path dir f) read)))
|
||||||
(for ([dep (in-list deps)])
|
(for ([dep (in-list deps)])
|
||||||
(when (and (not (external-dep? dep))
|
(when (and (not (external-dep? dep))
|
||||||
(not (indirect-dep? dep))
|
(not (indirect-dep? dep))
|
||||||
|
|
|
@ -743,7 +743,7 @@
|
||||||
(with-handlers ([exn:fail? (lambda (x) null)])
|
(with-handlers ([exn:fail? (lambda (x) null)])
|
||||||
(with-input-from-file path read)))
|
(with-input-from-file path read)))
|
||||||
(when (and (pair? deps) (list? deps))
|
(when (and (pair? deps) (list? deps))
|
||||||
(for ([s (in-list (cddr deps))])
|
(for ([s (in-list (cdddr deps))])
|
||||||
(unless (external-dep? s)
|
(unless (external-dep? s)
|
||||||
(define new-s (dep->path s))
|
(define new-s (dep->path s))
|
||||||
(when (path-string? new-s) (hash-set! dependencies new-s #t))))))
|
(when (path-string? new-s) (hash-set! dependencies new-s #t))))))
|
||||||
|
|
|
@ -168,6 +168,7 @@
|
||||||
(correlated->annotation v))))))))
|
(correlated->annotation v))))))))
|
||||||
v]))
|
v]))
|
||||||
|
|
||||||
|
(include "linklet/version.ss")
|
||||||
(include "linklet/write.ss")
|
(include "linklet/write.ss")
|
||||||
(include "linklet/read.ss")
|
(include "linklet/read.ss")
|
||||||
(include "linklet/annotation.ss")
|
(include "linklet/annotation.ss")
|
||||||
|
|
|
@ -5,19 +5,31 @@
|
||||||
|
|
||||||
(define (read-compiled-linklet-or-directory in initial?)
|
(define (read-compiled-linklet-or-directory in initial?)
|
||||||
;; `#~` has already been read
|
;; `#~` has already been read
|
||||||
(let* ([start-pos (- (file-position in) 2)]
|
(let ([start-pos (- (file-position in) 2)])
|
||||||
[vers-len (min 63 (read-byte in))]
|
(let* ([vers-len (min 63 (read-byte in))]
|
||||||
[vers (read-bytes vers-len in)])
|
[vers (read-bytes vers-len in)])
|
||||||
(unless (equal? vers (string->bytes/utf-8 (version)))
|
(unless (equal? vers version-bytes)
|
||||||
(raise-arguments-error 'read-compiled-linklet
|
(raise-arguments-error 'read-compiled-linklet
|
||||||
"version mismatch"
|
"version mismatch"
|
||||||
"expected" (version)
|
"expected" (version)
|
||||||
"found" (bytes->string/utf-8 vers #\?)
|
"found" (bytes->string/utf-8 vers #\?)
|
||||||
"in" (let ([n (object-name in)])
|
"in" (let ([n (object-name in)])
|
||||||
(if (path? n)
|
(if (path? n)
|
||||||
(unquoted-printing-string
|
(unquoted-printing-string
|
||||||
(path->string n))
|
(path->string n))
|
||||||
in))))
|
in)))))
|
||||||
|
(let* ([vm-len (min 63 (read-byte in))]
|
||||||
|
[vm (read-bytes vm-len in)])
|
||||||
|
(unless (equal? vm vm-bytes)
|
||||||
|
(raise-arguments-error 'read-compiled-linklet
|
||||||
|
"virtual-machine mismatch"
|
||||||
|
"expected" (symbol->string (system-type 'vm))
|
||||||
|
"found" (bytes->string/utf-8 vm #\?)
|
||||||
|
"in" (let ([n (object-name in)])
|
||||||
|
(if (path? n)
|
||||||
|
(unquoted-printing-string
|
||||||
|
(path->string n))
|
||||||
|
in)))))
|
||||||
(let ([tag (read-byte in)])
|
(let ([tag (read-byte in)])
|
||||||
(cond
|
(cond
|
||||||
[(equal? tag (char->integer #\B))
|
[(equal? tag (char->integer #\B))
|
||||||
|
|
2
racket/src/cs/linklet/version.ss
Normal file
2
racket/src/cs/linklet/version.ss
Normal file
|
@ -0,0 +1,2 @@
|
||||||
|
(define version-bytes (string->bytes/utf-8 (version)))
|
||||||
|
(define vm-bytes (string->bytes/utf-8 (symbol->string (system-type 'vm))))
|
|
@ -6,9 +6,10 @@
|
||||||
;; "B"
|
;; "B"
|
||||||
;; 20 bytes of SHA-1 hash
|
;; 20 bytes of SHA-1 hash
|
||||||
(write-bytes '#vu8(35 126) port)
|
(write-bytes '#vu8(35 126) port)
|
||||||
(let ([vers (string->bytes/utf-8 (version))])
|
(write-bytes (bytes (bytes-length version-bytes)) port)
|
||||||
(write-bytes (bytes (bytes-length vers)) port)
|
(write-bytes version-bytes port)
|
||||||
(write-bytes vers port))
|
(write-bytes (bytes (bytes-length vm-bytes)) port)
|
||||||
|
(write-bytes vm-bytes port)
|
||||||
(write-bytes '#vu8(66) port)
|
(write-bytes '#vu8(66) port)
|
||||||
(write-bytes (make-bytes 20 0) port)
|
(write-bytes (make-bytes 20 0) port)
|
||||||
;; The rest is whatever we want. We'll simply fasl the bundle.
|
;; The rest is whatever we want. We'll simply fasl the bundle.
|
||||||
|
@ -28,6 +29,8 @@
|
||||||
;; "#~"
|
;; "#~"
|
||||||
;; length of version byte string (< 64) as one byte
|
;; length of version byte string (< 64) as one byte
|
||||||
;; version byte string
|
;; version byte string
|
||||||
|
;; length of virtual machine byte string (< 64) as one byte
|
||||||
|
;; virtual machine byte string
|
||||||
;; "D"
|
;; "D"
|
||||||
;; bundle count as 4-byte integer
|
;; bundle count as 4-byte integer
|
||||||
;; binary tree:
|
;; binary tree:
|
||||||
|
@ -41,31 +44,34 @@
|
||||||
;; prefixed with either: its length as a byte if less than 255; 255 followed by
|
;; prefixed with either: its length as a byte if less than 255; 255 followed by
|
||||||
;; a 4-byte integer for the length.
|
;; a 4-byte integer for the length.
|
||||||
(write-bytes '#vu8(35 126) port)
|
(write-bytes '#vu8(35 126) port)
|
||||||
(let ([vers (string->bytes/utf-8 (version))])
|
(write-bytes (bytes (bytes-length version-bytes)) port)
|
||||||
(write-bytes (bytes (bytes-length vers)) port)
|
(write-bytes version-bytes port)
|
||||||
(write-bytes vers port)
|
(write-bytes (bytes (bytes-length vm-bytes)) port)
|
||||||
(write-bytes '#vu8(68) port)
|
(write-bytes vm-bytes port)
|
||||||
;; Flatten a directory of bundles into a vector of pairs, where
|
(write-bytes '#vu8(68) port)
|
||||||
;; each pair has the encoded bundle name and the bundle bytes
|
;; Flatten a directory of bundles into a vector of pairs, where
|
||||||
(let* ([bundles (list->vector (flatten-linklet-directory ld '() '()))]
|
;; each pair has the encoded bundle name and the bundle bytes
|
||||||
[len (vector-length bundles)]
|
(let* ([bundles (list->vector (flatten-linklet-directory ld '() '()))]
|
||||||
[initial-offset (+ 2 ; "#~"
|
[len (vector-length bundles)]
|
||||||
1 ; version length
|
[initial-offset (+ 2 ; "#~"
|
||||||
(bytes-length vers)
|
1 ; version length
|
||||||
1 ; D
|
(bytes-length version-bytes)
|
||||||
4)]) ; bundle count
|
1 ; vm length
|
||||||
(write-int len port) ; bundle count
|
(bytes-length vm-bytes)
|
||||||
(chez:vector-sort! (lambda (a b) (bytes<? (car a) (car b))) bundles)
|
1 ; D
|
||||||
;; Compute bundle offsets
|
4)]) ; bundle count
|
||||||
(let* ([btree-size (compute-btree-size bundles len)]
|
(write-int len port) ; bundle count
|
||||||
[node-offsets (compute-btree-node-offsets bundles len initial-offset)]
|
(chez:vector-sort! (lambda (a b) (bytes<? (car a) (car b))) bundles)
|
||||||
[bundle-offsets (compute-bundle-offsets bundles len (+ initial-offset btree-size))])
|
;; Compute bundle offsets
|
||||||
(write-directory-btree bundles node-offsets bundle-offsets len port)
|
(let* ([btree-size (compute-btree-size bundles len)]
|
||||||
;; Write the bundles
|
[node-offsets (compute-btree-node-offsets bundles len initial-offset)]
|
||||||
(let loop ([i 0])
|
[bundle-offsets (compute-bundle-offsets bundles len (+ initial-offset btree-size))])
|
||||||
(unless (fx= i len)
|
(write-directory-btree bundles node-offsets bundle-offsets len port)
|
||||||
(write-bytes (cdr (vector-ref bundles i)) port)
|
;; Write the bundles
|
||||||
(loop (fx1+ i))))))))
|
(let loop ([i 0])
|
||||||
|
(unless (fx= i len)
|
||||||
|
(write-bytes (cdr (vector-ref bundles i)) port)
|
||||||
|
(loop (fx1+ i)))))))
|
||||||
|
|
||||||
;; Flatten a tree into a list of `(cons _name-bstr _bundle-bstr)`
|
;; Flatten a tree into a list of `(cons _name-bstr _bundle-bstr)`
|
||||||
(define (flatten-linklet-directory ld rev-name-prefix accum)
|
(define (flatten-linklet-directory ld rev-name-prefix accum)
|
||||||
|
|
|
@ -118,16 +118,25 @@
|
||||||
(lambda args
|
(lambda args
|
||||||
(apply abort-current-continuation (default-continuation-prompt-tag) args))))))))])))
|
(apply abort-current-continuation (default-continuation-prompt-tag) args))))))))])))
|
||||||
|
|
||||||
|
(define version-bytes (string->bytes/utf-8 (version)))
|
||||||
|
(define version-length (bytes-length version-bytes))
|
||||||
|
(define vm-bytes (string->bytes/utf-8 (symbol->string (system-type 'vm))))
|
||||||
|
(define vm-length (bytes-length vm-bytes))
|
||||||
|
|
||||||
(define (linklet-bundle-or-directory-start i tag)
|
(define (linklet-bundle-or-directory-start i tag)
|
||||||
(define version-length (string-length (version)))
|
(define version-length (string-length (version)))
|
||||||
|
(define vm-length (string-length (symbol->string (system-type 'vm))))
|
||||||
(and (equal? (peek-byte i) (char->integer #\#))
|
(and (equal? (peek-byte i) (char->integer #\#))
|
||||||
(equal? (peek-byte i 1) (char->integer #\~))
|
(equal? (peek-byte i 1) (char->integer #\~))
|
||||||
(equal? (peek-byte i 2) version-length)
|
(equal? (peek-byte i 2) version-length)
|
||||||
(equal? (peek-bytes version-length 3 i) (string->bytes/utf-8 (version)))
|
(equal? (peek-bytes version-length 3 i) version-bytes)
|
||||||
(equal? (peek-byte i (+ 3 version-length)) (char->integer tag))
|
(equal? (peek-byte i (+ 3 version-length)) vm-length)
|
||||||
|
(equal? (peek-bytes vm-length (+ 4 version-length) i) vm-bytes)
|
||||||
|
(equal? (peek-byte i (+ 4 version-length vm-length)) (char->integer tag))
|
||||||
(+ version-length
|
(+ version-length
|
||||||
;; "#~" and tag and length byte:
|
vm-length
|
||||||
4)))
|
;; "#~" and tag and version length byte and vm length byte:
|
||||||
|
5)))
|
||||||
|
|
||||||
(define (linklet-directory-start i)
|
(define (linklet-directory-start i)
|
||||||
(define pos (linklet-bundle-or-directory-start i #\D))
|
(define pos (linklet-bundle-or-directory-start i #\D))
|
||||||
|
|
|
@ -3310,7 +3310,7 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
|
||||||
intptr_t *subtrees, offset, init_offset;
|
intptr_t *subtrees, offset, init_offset;
|
||||||
int count, i;
|
int count, i;
|
||||||
|
|
||||||
init_offset = 2 + 1 + strlen(MZSCHEME_VERSION) + 1 + 4;
|
init_offset = 2 + 1 + strlen(MZSCHEME_VERSION) + 1 + strlen(MZSCHEME_VM) + 1 + 4;
|
||||||
|
|
||||||
accum_l = write_bundles_to_strings(scheme_null, obj, scheme_null);
|
accum_l = write_bundles_to_strings(scheme_null, obj, scheme_null);
|
||||||
|
|
||||||
|
@ -3338,6 +3338,8 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
|
||||||
print_this_string(pp, "#~", 0, 2);
|
print_this_string(pp, "#~", 0, 2);
|
||||||
print_one_byte(pp, strlen(MZSCHEME_VERSION));
|
print_one_byte(pp, strlen(MZSCHEME_VERSION));
|
||||||
print_this_string(pp, MZSCHEME_VERSION, 0, -1);
|
print_this_string(pp, MZSCHEME_VERSION, 0, -1);
|
||||||
|
print_one_byte(pp, strlen(MZSCHEME_VM));
|
||||||
|
print_this_string(pp, MZSCHEME_VM, 0, -1);
|
||||||
|
|
||||||
/* "D" means "linklet directory": */
|
/* "D" means "linklet directory": */
|
||||||
print_this_string(pp, "D", 0, 1);
|
print_this_string(pp, "D", 0, 1);
|
||||||
|
@ -3436,6 +3438,8 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht,
|
||||||
/* Remember version: */
|
/* Remember version: */
|
||||||
print_one_byte(pp, strlen(MZSCHEME_VERSION));
|
print_one_byte(pp, strlen(MZSCHEME_VERSION));
|
||||||
print_this_string(pp, MZSCHEME_VERSION, 0, -1);
|
print_this_string(pp, MZSCHEME_VERSION, 0, -1);
|
||||||
|
print_one_byte(pp, strlen(MZSCHEME_VM));
|
||||||
|
print_this_string(pp, MZSCHEME_VM, 0, -1);
|
||||||
|
|
||||||
print_this_string(pp, "B", 0, 1); /* "B" means "bundle" */
|
print_this_string(pp, "B", 0, 1); /* "B" means "bundle" */
|
||||||
|
|
||||||
|
|
|
@ -3881,6 +3881,26 @@ static Scheme_Object *read_compiled(Scheme_Object *port,
|
||||||
(buf[0] ? buf : "???"), MZSCHEME_VERSION);
|
(buf[0] ? buf : "???"), MZSCHEME_VERSION);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Check vm: */
|
||||||
|
size = scheme_get_byte(port);
|
||||||
|
{
|
||||||
|
char buf[64];
|
||||||
|
|
||||||
|
if (size < 0) size = 0;
|
||||||
|
if (size > 63) size = 63;
|
||||||
|
|
||||||
|
got = scheme_get_bytes(port, size, buf, 0);
|
||||||
|
buf[got] = 0;
|
||||||
|
|
||||||
|
if (!params->skip_zo_vers_check)
|
||||||
|
if (strcmp(buf, MZSCHEME_VM))
|
||||||
|
scheme_read_err(port,
|
||||||
|
"read (compiled): wrong virtusal machine for compiled code\n"
|
||||||
|
" compiled version: %s\n"
|
||||||
|
" expected version: %s",
|
||||||
|
(buf[0] ? buf : "???"), MZSCHEME_VM);
|
||||||
|
}
|
||||||
|
|
||||||
mode = scheme_get_byte(port);
|
mode = scheme_get_byte(port);
|
||||||
if (mode == 'D') {
|
if (mode == 'D') {
|
||||||
/* a linklet directory */
|
/* a linklet directory */
|
||||||
|
|
|
@ -13,12 +13,14 @@
|
||||||
consistently.)
|
consistently.)
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#define MZSCHEME_VERSION "7.1.0.1"
|
#define MZSCHEME_VERSION "7.1.0.2"
|
||||||
|
|
||||||
#define MZSCHEME_VERSION_X 7
|
#define MZSCHEME_VERSION_X 7
|
||||||
#define MZSCHEME_VERSION_Y 1
|
#define MZSCHEME_VERSION_Y 1
|
||||||
#define MZSCHEME_VERSION_Z 0
|
#define MZSCHEME_VERSION_Z 0
|
||||||
#define MZSCHEME_VERSION_W 1
|
#define MZSCHEME_VERSION_W 2
|
||||||
|
|
||||||
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
|
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
|
||||||
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)
|
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)
|
||||||
|
|
||||||
|
#define MZSCHEME_VM "racket"
|
||||||
|
|
|
@ -60004,20 +60004,31 @@ static const char *startup_source =
|
||||||
" loop_0)"
|
" loop_0)"
|
||||||
"(list(void))))))))"
|
"(list(void))))))))"
|
||||||
"(call-with-input-file*61.1 'binary path1_0 temp2_0)))))))))))"
|
"(call-with-input-file*61.1 'binary path1_0 temp2_0)))))))))))"
|
||||||
|
"(define-values(version-bytes)(string->bytes/utf-8(version)))"
|
||||||
|
"(define-values(version-length)(bytes-length version-bytes))"
|
||||||
|
"(define-values(vm-bytes)(string->bytes/utf-8(symbol->string(system-type 'vm))))"
|
||||||
|
"(define-values(vm-length)(bytes-length vm-bytes))"
|
||||||
"(define-values"
|
"(define-values"
|
||||||
"(linklet-bundle-or-directory-start)"
|
"(linklet-bundle-or-directory-start)"
|
||||||
"(lambda(i_0 tag_0)"
|
"(lambda(i_0 tag_0)"
|
||||||
"(begin"
|
"(begin"
|
||||||
"(let-values(((version-length_0)(string-length(version))))"
|
"(let-values(((version-length_0)(string-length(version))))"
|
||||||
|
"(let-values(((vm-length_0)(string-length(symbol->string(system-type 'vm)))))"
|
||||||
"(if(equal?(peek-byte i_0)(char->integer '#\\#))"
|
"(if(equal?(peek-byte i_0)(char->integer '#\\#))"
|
||||||
"(if(equal?(peek-byte i_0 1)(char->integer '#\\~))"
|
"(if(equal?(peek-byte i_0 1)(char->integer '#\\~))"
|
||||||
"(if(equal?(peek-byte i_0 2) version-length_0)"
|
"(if(equal?(peek-byte i_0 2) version-length_0)"
|
||||||
"(if(equal?(peek-bytes version-length_0 3 i_0)(string->bytes/utf-8(version)))"
|
"(if(equal?(peek-bytes version-length_0 3 i_0) version-bytes)"
|
||||||
"(if(equal?(peek-byte i_0(+ 3 version-length_0))(char->integer tag_0))(+ version-length_0 4) #f)"
|
"(if(equal?(peek-byte i_0(+ 3 version-length_0)) vm-length_0)"
|
||||||
|
"(if(equal?(peek-bytes vm-length_0(+ 4 version-length_0) i_0) vm-bytes)"
|
||||||
|
"(if(equal?(peek-byte i_0(+ 4 version-length_0 vm-length_0))(char->integer tag_0))"
|
||||||
|
"(+ version-length_0 vm-length_0 5)"
|
||||||
" #f)"
|
" #f)"
|
||||||
" #f)"
|
" #f)"
|
||||||
" #f)"
|
" #f)"
|
||||||
" #f)))))"
|
" #f)"
|
||||||
|
" #f)"
|
||||||
|
" #f)"
|
||||||
|
" #f))))))"
|
||||||
"(define-values"
|
"(define-values"
|
||||||
"(linklet-directory-start)"
|
"(linklet-directory-start)"
|
||||||
"(lambda(i_0)"
|
"(lambda(i_0)"
|
||||||
|
|
Loading…
Reference in New Issue
Block a user