From 99cf003d9870179de06e6c2a71ad453acb0b2ffd Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 2 Jul 2018 16:17:01 -0600 Subject: [PATCH] cs: store code as uncompressed by default Leaving code uncompressed makes it about 5 times as large on disk, but it loads about twice as fast. --- racket/src/cs/Makefile | 5 ++- racket/src/cs/c/Makefile.in | 15 +++++--- racket/src/cs/c/adjust-compress.rkt | 53 +++++++++++++++++++++++++++++ racket/src/cs/c/configure | 15 ++++++++ racket/src/cs/c/configure.ac | 8 +++++ racket/src/cs/c/embed-boot.rkt | 32 +++++++++++------ racket/src/cs/compile-file.ss | 6 ++++ racket/src/cs/linklet.sls | 52 ++++++++++++++++++++++------ racket/src/cs/linklet/compress.ss | 3 ++ racket/src/racket/src/env.c | 2 ++ racket/src/racket/src/linklet.c | 8 ++++- 11 files changed, 171 insertions(+), 28 deletions(-) create mode 100644 racket/src/cs/c/adjust-compress.rkt create mode 100644 racket/src/cs/linklet/compress.ss diff --git a/racket/src/cs/Makefile b/racket/src/cs/Makefile index db44c75d8b..3a42f141ff 100644 --- a/racket/src/cs/Makefile +++ b/racket/src/cs/Makefile @@ -7,13 +7,16 @@ SCHEME = scheme # Controls whether Racket layers are built as unsafe: UNSAFE_COMP = --unsafe +# Controls whether compiled code is compressed: +COMPRESS_COMP = # --compress + # Controls whether Racket layers are built with expression-level debugging: DEBUG_COMP = # --debug # Controls whether Rumble is built as unsafe: RUMBLE_UNSAFE_COMP = --unsafe -COMPILE_FILE = $(SCHEME) --script compile-file.ss $(UNSAFE_COMP) $(DEBUG_COMP) --dest "$(BUILDDIR)" +COMPILE_FILE = $(SCHEME) --script compile-file.ss $(UNSAFE_COMP) $(COMPRESS_COMP) $(DEBUG_COMP) --dest "$(BUILDDIR)" COMPILE_FILE_DEPS = compile-file.ss include.ss RACKET_SETUP_ARGS = ../../bin/racket ../collects ../etc 0 false diff --git a/racket/src/cs/c/Makefile.in b/racket/src/cs/c/Makefile.in index 571a5e6a5c..b047b0bc8a 100644 --- a/racket/src/cs/c/Makefile.in +++ b/racket/src/cs/c/Makefile.in @@ -61,6 +61,9 @@ racket-so: RACKET_SO_ENV = @CONFIGURE_RACKET_SO_COMPILE@ env COMPILED_SCM_DIR="$(builddir)/compiled/" +CS_PROGS = RACKET="$(RACKET)" SCHEME="$(SCHEME)" CONVERT_RACKET="$(CONVERT_RACKET)" +CS_OPTS = COMPRESS_COMP=@COMPRESS_COMP@ + build-racket-so: $(MAKE) expander $(MAKE) thread @@ -68,7 +71,7 @@ build-racket-so: $(MAKE) regexp $(MAKE) schemify $(MAKE) known - cd $(srcdir)/.. && $(RACKET_SO_ENV) $(MAKE) "$(builddir)/racket.so" RACKET="$(RACKET)" SCHEME="$(SCHEME)" BUILDDIR="$(builddir)/" CONVERT_RACKET="$(CONVERT_RACKET)" + cd $(srcdir)/.. && $(RACKET_SO_ENV) $(MAKE) "$(builddir)/racket.so" $(CS_PROGS) $(CS_OPTS) BUILDDIR="$(builddir)/" bounce: $(MAKE) RACKET="$(ABS_RACKET)" SCHEME_SRC="$(ABS_SCHEME_SRC)" srcdir="$(ABS_SRCDIR)" builddir="$(ABS_BUILDDIR)" $(TARGET) @@ -113,10 +116,10 @@ $(SCHEME_BIN): EMBED_DEPS = $(srcdir)/embed-boot.rkt racketcs@NOT_OSX@: raw_racketcs racket.so $(EMBED_DEPS) - $(RACKET) $(srcdir)/embed-boot.rkt raw_racketcs racketcs $(SCHEME_INC) racket.so + $(RACKET) $(srcdir)/embed-boot.rkt @COMPRESS_COMP@ raw_racketcs racketcs $(SCHEME_INC) racket.so gracketcs@NOT_OSX@: raw_gracketcs racket.so $(EMBED_DEPS) - $(RACKET) $(srcdir)/embed-boot.rkt raw_gracketcs gracketcs $(SCHEME_INC) racket.so + $(RACKET) $(srcdir)/embed-boot.rkt @COMPRESS_COMP@ raw_gracketcs gracketcs $(SCHEME_INC) racket.so BOOT_OBJS = boot.o $(SCHEME_INC)/kernel.o rktio/librktio.a @@ -150,6 +153,7 @@ $(GRAPPSKEL): $(srcdir)/../../mac/osx_appl.rkt $(srcdir)/../../racket/src/schve env $(RACKET) $(srcdir)/../../mac/osx_appl.rkt $(srcdir)/../.. "CS" BOOT_FILES = $(SCHEME_INC)/petite.boot $(SCHEME_INC)/scheme.boot racket.so +FW_BOOT_DEST = Racket.framework/Versions/$(FWVERSION)_CS/boot $(RKTFW): $(BOOT_OBJS) $(BOOT_FILES) mkdir -p Racket.framework/Versions/$(FWVERSION)_CS @@ -157,8 +161,9 @@ $(RKTFW): $(BOOT_OBJS) $(BOOT_FILES) rm -f Racket.framework/Racket ln -s Versions/$(FWVERSION)_CS/Racket Racket.framework/Racket mkdir -p Racket.framework/Versions/$(FWVERSION)_CS/boot - cp $(SCHEME_INC)/petite.boot $(SCHEME_INC)/scheme.boot Racket.framework/Versions/$(FWVERSION)_CS/boot - cp racket.so Racket.framework/Versions/$(FWVERSION)_CS/boot + cp $(SCHEME_INC)/petite.boot $(SCHEME_INC)/scheme.boot $(FW_BOOT_DEST) + cp racket.so $(FW_BOOT_DEST) + $(RACKET) $(srcdir)/adjust-compress.rkt @COMPRESS_COMP@ $(FW_BOOT_DEST)/petite.boot $(FW_BOOT_DEST)/scheme.boot $(FW_BOOT_DEST)/racket.so # ---------------------------------------- # Common diff --git a/racket/src/cs/c/adjust-compress.rkt b/racket/src/cs/c/adjust-compress.rkt new file mode 100644 index 0000000000..0a638daa13 --- /dev/null +++ b/racket/src/cs/c/adjust-compress.rkt @@ -0,0 +1,53 @@ +#lang racket/base +(require racket/file + file/gzip + file/gunzip) + +(provide enable-compress! + compress-enabled? + adjust-compress) + +(define compress? #f) + +(define (enable-compress!) + (set! compress? #t)) + +(define (compress-enabled?) + compress?) + +(define (reencode bstr encode) + (let ([o (open-output-bytes)] + [i (open-input-bytes bstr)]) + (let loop () + (unless (eof-object? (peek-byte i)) + (encode i o) + (loop))) + (get-output-bytes o))) + +(define (adjust-compress bstr) + (if (bytes=? #"\0\0\0\0chez" (subbytes bstr 0 8)) + (if compress? + (reencode bstr (lambda (i o) (gzip-through-ports i o #f 0))) + bstr) + (if compress? + bstr + (reencode bstr gunzip-through-ports)))) + +(module+ main + (require racket/cmdline) + + (command-line + #:once-each + [("--compress") "Leave compiled code files as compressed" + (enable-compress!)] + #:args path + (for ([path (in-list path)]) + (define bstr (file->bytes path)) + (define bstr2 (adjust-compress bstr)) + (printf "~s ~s\n" path (equal? bstr bstr2)) + (unless (equal? bstr bstr2) + (call-with-output-file* + path + #:exists 'truncate/replace + (lambda (o) + (write-bytes bstr2 o))))))) diff --git a/racket/src/cs/c/configure b/racket/src/cs/c/configure index 30a11c8f55..d56a401b07 100755 --- a/racket/src/cs/c/configure +++ b/racket/src/cs/c/configure @@ -625,6 +625,7 @@ FRAMEWORK_PREFIX FRAMEWORK_INSTALL_DIR SCHEME_CONFIG_ARGS SCHEME_SRC +COMPRESS_COMP CONFIGURE_RACKET_SO_COMPILE NOT_OSX OSX @@ -705,6 +706,7 @@ enable_shared enable_standalone enable_pthread enable_iconv +enable_compress enable_xonx enable_racket enable_scheme @@ -1335,6 +1337,7 @@ Optional Features: --enable-standalone create a standalone shared library --enable-pthread link with pthreads (usually auto-enabled if needed) --enable-iconv use iconv (usually auto-enabled) + --enable-compress compress compiled code --enable-xonx use Unix style (e.g., use Gtk) for Mac OS --enable-racket= use as Racket to build; or "auto" to create --enable-scheme= Chez Scheme build directory at @@ -2226,6 +2229,11 @@ if test "${enable_iconv+set}" = set; then : enableval=$enable_iconv; fi +# Check whether --enable-compress was given. +if test "${enable_compress+set}" = set; then : + enableval=$enable_compress; +fi + # Check whether --enable-xonx was given. if test "${enable_xonx+set}" = set; then : enableval=$enable_xonx; @@ -2273,6 +2281,7 @@ show_explicitly_set() show_explicitly_enabled "${enable_pthread}" "pthreads" show_explicitly_disabled "${enable_pthread}" "pthreads" +show_explicitly_enabled "${enable_compress}" "Compressed code" show_explicitly_enabled "${enable_xonx}" "Unix style" show_explicitly_set "${enable_racket}" "Racket" show_explicitly_set "${enable_scheme}" "Chez Scheme build directory" @@ -2294,6 +2303,7 @@ INCLUDEDEP="#" OSX="not_osx" NOT_OSX="" CONFIGURE_RACKET_SO_COMPILE="" +COMPRESS_COMP="" FRAMEWORK_INSTALL_DIR='$(srcdir)/../../../lib/' FRAMEWORK_PREFIX='@executable_path/../lib/' @@ -3301,6 +3311,10 @@ fi SCHEME_CONFIG_ARGS="--machine=${MACH} ${thread_config_arg}" +if test "${enable_compress}" = "yes" ; then + COMPRESS_COMP="--compress" +fi + ############## C flags ################ ac_ext=c @@ -3917,6 +3931,7 @@ CPPFLAGS="$CPPFLAGS $PREFLAGS" + makefiles="Makefile" diff --git a/racket/src/cs/c/configure.ac b/racket/src/cs/c/configure.ac index 09350c1282..5ab064dc43 100644 --- a/racket/src/cs/c/configure.ac +++ b/racket/src/cs/c/configure.ac @@ -14,6 +14,7 @@ AC_ARG_ENABLE(shared, [ --enable-shared create shared libraries (ok AC_ARG_ENABLE(standalone, [ --enable-standalone create a standalone shared library]) AC_ARG_ENABLE(pthread, [ --enable-pthread link with pthreads (usually auto-enabled if needed)]) AC_ARG_ENABLE(iconv, [ --enable-iconv use iconv (usually auto-enabled)]) +AC_ARG_ENABLE(compress, [ --enable-compress compress compiled code]) AC_ARG_ENABLE(xonx, [ --enable-xonx use Unix style (e.g., use Gtk) for Mac OS]) AC_ARG_ENABLE(racket, [ --enable-racket= use as Racket to build; or "auto" to create]) AC_ARG_ENABLE(scheme, [ --enable-scheme= Chez Scheme build directory at ]) @@ -45,6 +46,7 @@ show_explicitly_set() show_explicitly_enabled "${enable_pthread}" "pthreads" show_explicitly_disabled "${enable_pthread}" "pthreads" +show_explicitly_enabled "${enable_compress}" "Compressed code" show_explicitly_enabled "${enable_xonx}" "Unix style" show_explicitly_set "${enable_racket}" "Racket" show_explicitly_set "${enable_scheme}" "Chez Scheme build directory" @@ -66,6 +68,7 @@ INCLUDEDEP="#" OSX="not_osx" NOT_OSX="" CONFIGURE_RACKET_SO_COMPILE="" +COMPRESS_COMP="" FRAMEWORK_INSTALL_DIR='$(srcdir)/../../../lib/' FRAMEWORK_PREFIX='@executable_path/../lib/' @@ -196,6 +199,10 @@ fi SCHEME_CONFIG_ARGS="--machine=${MACH} ${thread_config_arg}" +if test "${enable_compress}" = "yes" ; then + COMPRESS_COMP="--compress" +fi + ############## C flags ################ AC_LANG_C @@ -348,6 +355,7 @@ AC_SUBST(MACH) AC_SUBST(OSX) AC_SUBST(NOT_OSX) AC_SUBST(CONFIGURE_RACKET_SO_COMPILE) +AC_SUBST(COMPRESS_COMP) AC_SUBST(SCHEME_SRC) AC_SUBST(SCHEME_CONFIG_ARGS) AC_SUBST(FRAMEWORK_INSTALL_DIR) diff --git a/racket/src/cs/c/embed-boot.rkt b/racket/src/cs/c/embed-boot.rkt index db510a8b82..90eff99c74 100644 --- a/racket/src/cs/c/embed-boot.rkt +++ b/racket/src/cs/c/embed-boot.rkt @@ -2,23 +2,33 @@ (require racket/cmdline racket/file compiler/private/mach-o - compiler/private/elf) + compiler/private/elf + "adjust-compress.rkt") (command-line + #:once-each + [("--compress") "Leave compiled code files as compressed" + (enable-compress!)] #:args (src-file dest-file boot-dir racket.so) - (define bstr1 (file->bytes (build-path boot-dir "petite.boot"))) - (define bstr2 (file->bytes (build-path boot-dir "scheme.boot"))) - (define bstr3 (file->bytes racket.so)) + (define bstr1 (adjust-compress (file->bytes (build-path boot-dir "petite.boot")))) + (define bstr2 (adjust-compress (file->bytes (build-path boot-dir "scheme.boot")))) + (define bstr3 (adjust-compress (file->bytes racket.so))) (with-handlers ([exn? (lambda (x) (when (file-exists? dest-file) (delete-file dest-file)) (raise x))]) + (define terminator + (if (compress-enabled?) + ;; zero byte stops a gzip-read sequence + #"\0" + ;; #!eof encoding stops(!) a fasl-read sequence + #"\26\4\fl")) (define data - (bytes-append bstr1 #"\0" - bstr2 #"\0" - bstr3 #"\0")) + (bytes-append bstr1 terminator + bstr2 terminator + bstr3 terminator)) (define pos (case (path->string (system-library-subpath #f)) [("x86_64-darwin" "i386-darwin" "x86_64-macosx" "i386-macosx") @@ -59,8 +69,10 @@ (define m (regexp-match-positions #rx"BooT FilE OffsetS:" i)) (unless m (error 'embed-boot "cannot file boot-file offset tag")) - + + (define terminator-len (bytes-length terminator)) + (file-position o (cdar m)) (void (write-bytes (integer->integer-bytes pos 4 #t #f) o)) - (void (write-bytes (integer->integer-bytes (+ pos (bytes-length bstr1) 1) 4 #t #f) o)) - (void (write-bytes (integer->integer-bytes (+ pos (bytes-length bstr1) (bytes-length bstr2) 2) 4 #t #f) o)))) + (void (write-bytes (integer->integer-bytes (+ pos (bytes-length bstr1) terminator-len) 4 #t #f) o)) + (void (write-bytes (integer->integer-bytes (+ pos (bytes-length bstr1) (bytes-length bstr2) (* 2 terminator-len)) 4 #t #f) o)))) diff --git a/racket/src/cs/compile-file.ss b/racket/src/cs/compile-file.ss index 70e6399613..d6b861e844 100644 --- a/racket/src/cs/compile-file.ss +++ b/racket/src/cs/compile-file.ss @@ -42,6 +42,7 @@ (define whole-program? #f) (generate-inspector-information #f) (generate-procedure-source-information #t) +(compile-compressed #f) (define build-dir "") (define-values (src deps) @@ -55,6 +56,11 @@ => (lambda (args) (optimize-level 3) (loop args))] + [(get-opt args "--compress" 0) + => (lambda (args) + (compile-compressed #t) + (putenv "PLT_CS_MAKE_COMPRESSED" "y") ; for "linklet.sls" + (loop args))] [(get-opt args "--whole-program" 0) => (lambda (args) (set! whole-program? #t) diff --git a/racket/src/cs/linklet.sls b/racket/src/cs/linklet.sls index 06db3eb4c3..bf29d722e7 100644 --- a/racket/src/cs/linklet.sls +++ b/racket/src/cs/linklet.sls @@ -127,6 +127,16 @@ (define omit-debugging? (not (getenv "PLT_CS_DEBUG"))) (define measure-performance? (getenv "PLT_LINKLET_TIMES")) + (define compress-code? (cond + [(getenv "PLT_LINKLET_COMPRESS") #t] + [(getenv "PLT_LINKLET_NO_COMPRESS") #f] + [else + ;; Default selected at compile time, intended + ;; to be a `configure` option + (meta-cond + [(getenv "PLT_CS_MAKE_COMPRESSED") #t] + [else #f])])) + (define gensym-on? (getenv "PLT_LINKLET_SHOW_GENSYM")) (define pre-lift-on? (getenv "PLT_LINKLET_SHOW_PRE_LIFT")) (define pre-jit-on? (getenv "PLT_LINKLET_SHOW_PRE_JIT")) @@ -200,19 +210,24 @@ (get))) (define (compile-to-bytevector s format) - (bytevector-compress - (cond - [(eq? format 'interpret) - (let-values ([(o get) (open-bytevector-output-port)]) - (fasl-write* s o) - (get))] - [else (compile*-to-bytevector s)]))) + (let ([bv (cond + [(eq? format 'interpret) + (let-values ([(o get) (open-bytevector-output-port)]) + (fasl-write* s o) + (get))] + [else (compile*-to-bytevector s)])]) + (if compress-code? + (bytevector-compress bv) + bv))) (define (eval-from-bytevector c-bv format) - (add-performance-memory! 'uncompress (bytevector-length c-bv)) - (let* ([bv (performance-region - 'uncompress - (bytevector-uncompress c-bv))]) + (let ([bv (if (bytevector-uncompressed-fasl? c-bv) + c-bv + (begin + (add-performance-memory! 'uncompress (bytevector-length c-bv)) + (performance-region + 'uncompress + (bytevector-uncompress c-bv))))]) (add-performance-memory! 'faslin (bytevector-length bv)) (cond [(eq? format 'interpret) @@ -234,6 +249,21 @@ 'outer (r))))) + (define (bytevector-uncompressed-fasl? bv) + ;; There's not actually a way to distinguish a fasl header from a + ;; compression header, but the fasl header as a compression header + ;; would mean a > 1GB uncompressed bytevector, so we can safely + ;; assume that it's a fasl stream in that case. + (and (> (bytevector-length bv) 8) + (fx= 0 (bytevector-u8-ref bv 0)) + (fx= 0 (bytevector-u8-ref bv 1)) + (fx= 0 (bytevector-u8-ref bv 2)) + (fx= 0 (bytevector-u8-ref bv 3)) + (fx= (char->integer #\c) (bytevector-u8-ref bv 4)) + (fx= (char->integer #\h) (bytevector-u8-ref bv 5)) + (fx= (char->integer #\e) (bytevector-u8-ref bv 6)) + (fx= (char->integer #\z) (bytevector-u8-ref bv 7)))) + (define-values (lookup-code insert-code delete-code) (let ([get-procs!-maker (lambda (retry) diff --git a/racket/src/cs/linklet/compress.ss b/racket/src/cs/linklet/compress.ss new file mode 100644 index 0000000000..5f52b1d9c7 --- /dev/null +++ b/racket/src/cs/linklet/compress.ss @@ -0,0 +1,3 @@ +(define (bytevector-compressed? bv) + (and (> (bytevector-length bv) 8) + (zero? (bytevector-u8-ref bv 0)))) diff --git a/racket/src/racket/src/env.c b/racket/src/racket/src/env.c index c61276c54e..7b76871b2e 100644 --- a/racket/src/racket/src/env.c +++ b/racket/src/racket/src/env.c @@ -532,6 +532,8 @@ static Scheme_Env *place_instance_init(void *stack_base, int initial_main_os_thr scheme_starting_up = 0; + scheme_performance_record_end("boot", NULL); + --scheme_current_thread->suspend_break; /* created with breaks suspended */ #ifdef TIME_STARTUP_PROCESS diff --git a/racket/src/racket/src/linklet.c b/racket/src/racket/src/linklet.c index 8f89c6f221..4fcf2099b0 100644 --- a/racket/src/racket/src/linklet.c +++ b/racket/src/racket/src/linklet.c @@ -1876,7 +1876,8 @@ void scheme_performance_record_end(const char *who, GC_CAN_IGNORE Scheme_Perform { int i; intptr_t d, gc_d; - + Scheme_Performance_State zero_perf_state; + #if defined(MZ_USE_PLACES) if (scheme_current_place_id != 0) return; @@ -1896,6 +1897,11 @@ void scheme_performance_record_end(const char *who, GC_CAN_IGNORE Scheme_Perform if (i >= MAX_PERF_ENTRIES) return; + if (!perf_state) { + memset(&zero_perf_state, 0, sizeof(zero_perf_state)); + perf_state = &zero_perf_state; + } + d = (scheme_get_process_milliseconds() - perf_state->start); gc_d = (scheme_total_gc_time - perf_state->gc_start);