suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cs: store code as uncompressed by default

Browse Source 
Leaving code uncompressed makes it about 5 times as large on disk, but
it loads about twice as fast.
This commit is contained in:
Matthew Flatt 2018-07-02 16:17:01 -06:00
parent ffc5720b51
commit 99cf003d98
11 changed files with 171 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
racket/src/cs/Makefile
View File

@ -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

15
racket/src/cs/c/Makefile.in
View File

@ -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

53
racket/src/cs/c/adjust-compress.rkt Normal file
View File

@ -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)))))))

15
racket/src/cs/c/configure vendored
View File

@ -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=<path> use <path> as Racket to build; or "auto" to create
--enable-scheme=<path> Chez Scheme build directory at <path>
@ -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"

8
racket/src/cs/c/configure.ac
View File

@ -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=<path> use <path> as Racket to build; or "auto" to create])
AC_ARG_ENABLE(scheme, [ --enable-scheme=<path> Chez Scheme build directory at <path>])
@ -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)

32
racket/src/cs/c/embed-boot.rkt
View File

@ -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))))

6
racket/src/cs/compile-file.ss
View File

@ -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)

52
racket/src/cs/linklet.sls
View File

@ -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)

3
racket/src/cs/linklet/compress.ss Normal file
View File

@ -0,0 +1,3 @@
(define (bytevector-compressed? bv)
(and (> (bytevector-length bv) 8)
(zero? (bytevector-u8-ref bv 0))))

2
racket/src/racket/src/env.c
View File

@ -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

8
racket/src/racket/src/linklet.c
View File

@ -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);