From a1195b7f7e2e85a138e7f9b945be08a67a963d74 Mon Sep 17 00:00:00 2001 From: dyb Date: Wed, 6 Feb 2019 22:22:21 -0800 Subject: [PATCH] addressed foreign-callable / boot file invalid memory reference: - fixed a bug in which instantiating a static foreign-callable code object fails with an invalid memory reference because the collector has discarded its relocation information. foreign-callable code objects are now flagged as "templates", and the collector now refuses to discard relocation information for code objects marked as templates when copying them to the static generation. cmacros.ss, cpnanopass.ss, gc.c, 7.ms - committing updated boot/*/equates.h (without the boot files, which are still usable for bootstrapping) boot/*/*.h - updated release notes release_notes.stex original commit: 71d3abba684e04b134720ea1bd9a8c847c38ac5f --- LOG | 9 ++++++++- c/gc.c | 2 +- mats/7.ms | 27 +++++++++++++++++++++++++++ release_notes/release_notes.stex | 7 +++++++ s/cmacros.ss | 1 + s/cpnanopass.ss | 2 +- 6 files changed, 45 insertions(+), 3 deletions(-) diff --git a/LOG b/LOG index d0e0c97385..b9cb5aae14 100644 --- a/LOG +++ b/LOG @@ -1048,4 +1048,11 @@ cp0.ss, cp0.ms - fix allocation of string/bytevector for a foreign-callable argument or foreign-call return - cpnanopass.ss, foreign.ms, foreign2.c \ No newline at end of file + cpnanopass.ss, foreign.ms, foreign2.c +- foreign-callable code objects are now flagged as "templates", and + the collector now refuses to discard relocation information for + code objects marked as templates when copying them to the static + generation. + cmacros.ss, cpnanopass.ss, + gc.c, + 7.ms diff --git a/c/gc.c b/c/gc.c index c65215d16a..be750f8ba3 100644 --- a/c/gc.c +++ b/c/gc.c @@ -1700,7 +1700,7 @@ static void sweep_code_object(tc, co) ptr tc, co; { S_set_code_obj("gc", RELOC_TYPE(entry), co, a, obj, item_off); } - if (target_generation == static_generation && !S_G.retain_static_relocation) { + if (target_generation == static_generation && !S_G.retain_static_relocation && (CODETYPE(co) & (code_flag_template << code_flags_offset)) == 0) { CODERELOC(co) = (ptr)0; } else { /* Don't copy non-oldspace relocation tables, since we may be diff --git a/mats/7.ms b/mats/7.ms index 2e5795620f..3bc215b259 100644 --- a/mats/7.ms +++ b/mats/7.ms @@ -984,6 +984,33 @@ (unless (eof-object? err) (error 'bootfile-test2 err)) out))) "hello 1\nhello 2\nhello 3\nhello 4\nhello 5\n") + ; regression test to verify that we can evaluate a foreign-callable form inside the procedure to + ; which scheme-start is set, which was failing because its relocation information was discarded + ; by the static-generation collection. + (equal? + (begin + (unless (or (embedded?) (equal? *scheme* (format "../bin/~a/scheme~a" (machine-type) (if (windows?) ".exe" "")))) + (errorf #f "not testing boot file based on ../boot/~a/petite.boot, since *scheme* isn't ../bin/~a/scheme~a" + (machine-type) (machine-type) (if (windows?) ".exe" ""))) + (mkfile "testfile.ss" + '(scheme-start + (lambda () + (let ([x 0]) + (printf "~s\n" (foreign-callable (lambda () (set! x (+ x 1)) x) () void)))))) + (make-boot-file "testfile.boot" '("petite") "testfile.ss") + (let-values ([(to-stdin from-stdout from-stderr pid) + (open-process-ports + (format "~a -b ./testfile.boot -q" (patch-exec-path *scheme*)) + (buffer-mode block) + (native-transcoder))]) + (close-output-port to-stdin) + (let ([out (get-string-all from-stdout)] + [err (get-string-all from-stderr)]) + (close-input-port from-stdout) + (close-input-port from-stderr) + (unless (eof-object? err) (error 'bootfile-test2 err)) + out))) + "#\n") ) (mat hostop diff --git a/release_notes/release_notes.stex b/release_notes/release_notes.stex index 909e803174..b24872b4fe 100644 --- a/release_notes/release_notes.stex +++ b/release_notes/release_notes.stex @@ -1605,6 +1605,13 @@ in fasl files does not generally make sense. %----------------------------------------------------------------------------- \section{Bug Fixes}\label{section:bugfixes} +\subsection{Invalid memory reference instantiating \protect\scheme{foreign-callable} code object (9.5.1)} + +A bug that caused evaluation of a \scheme{foreign-callable} expression in +code that has been collected into the static generation (e.g., when the +\scheme{foreign-callable} form appears in code compiled to a boot file) +to result in an invalid memory reference has been fixed. + \subsection{Invalid constant-folding of some calls to \protect\scheme{apply} (9.5.1)} A bug in the source optimizer (cp0) allowed constant-folding of some calls to diff --git a/s/cmacros.ss b/s/cmacros.ss index bd188e982a..d72bea8c68 100644 --- a/s/cmacros.ss +++ b/s/cmacros.ss @@ -749,6 +749,7 @@ (define-constant code-flag-system #b0001) (define-constant code-flag-continuation #b0010) +(define-constant code-flag-template #b0100) (define-constant fixnum-bits (case (constant ptr-bits) diff --git a/s/cpnanopass.ss b/s/cpnanopass.ss index 4d0a3869f4..ef62973de9 100644 --- a/s/cpnanopass.ss +++ b/s/cpnanopass.ss @@ -11076,7 +11076,7 @@ `(lambda ,info ,max-fv (,local* ...) ,tlbody))))] [(fcallable ,info ,l) (let ([lambda-info (make-info-lambda #f #f #f (list (length (info-foreign-arg-type* info))) - (info-foreign-name info))]) + (info-foreign-name info) (constant code-flag-template))]) (fluid-let ([max-fv 0] [local* '()]) (let ([tlbody (build-fcallable info l)]) `(lambda ,lambda-info ,max-fv (,local* ...) ,tlbody))))]