diff --git a/LOG b/LOG index becef0bcb7..16d21c12f1 100644 --- a/LOG +++ b/LOG @@ -985,3 +985,7 @@ x86_64.ss x86.ss, ppc32.ss, arm32.ss, 5_6.ms, 5_8.ms, root-experr*, objects.stex, release_notes.stex +- add generate-procedure-source-information + cmacros.ss, compile.ss, cpnanopass.ss, inspect.ss, + primdata.ss, prims.ss, misc.ms, + system.stex, release_notes.tex diff --git a/csug/system.stex b/csug/system.stex index 5696121b88..f177381d34 100644 --- a/csug/system.stex +++ b/csug/system.stex @@ -1126,6 +1126,7 @@ cp0-effort-limit cp0-score-limit cp0-outer-unroll-limit generate-inspector-information +generate-procedure-source-information compile-profile generate-interrupt-trap enable-cross-library-optimization @@ -2411,6 +2412,21 @@ For example, if: is included in a file, generation of inspector information will be disabled only for the remainder of that particular file. +%---------------------------------------------------------------------------- +\entryheader\label{desc:generate-procedure-source-information} +\formdef{generate-procedure-source-information}{\categorythreadparameter}{generate-procedure-source-information} +\listlibraries +\endentryheader + +\noindent +When \scheme{generate-inspector-information} is set to \scheme{#f} and +this parameter is set to \scheme{#t}, then a source location is preserved +for a procedure, even though other inspector information is not preserved. +Source information provides a small amount of debugging support at a +much lower cost in memory and object-file size than full inspector information. +If this parameter is changed during the compilation of a file, the +original value will be restored. + %---------------------------------------------------------------------------- \entryheader \formdef{enable-cross-library-optimization}{\categorythreadparameter}{enable-cross-library-optimization} diff --git a/mats/misc.ms b/mats/misc.ms index a9dff694c6..bdee118006 100644 --- a/mats/misc.ms +++ b/mats/misc.ms @@ -2015,6 +2015,30 @@ (eqv? (profile-clear) (void)) ) +(mat generate-procedure-source-information + (begin + (define the-source + (let ([sfd (make-source-file-descriptor "the-source.ss" (open-bytevector-input-port '#vu8()))]) + (make-source-object sfd 10 20))) + (define (make-proc full-inspect?) + (parameterize ([generate-inspector-information full-inspect?] + [generate-procedure-source-information #t]) + (let ([e '(lambda (x) x)]) + (compile (make-annotation e the-source e))))) + (define proc-i (make-proc #t)) + (define proc-n (make-proc #f)) + (and (procedure? proc-i) + (procedure? proc-n))) + (equal? (((inspect/object proc-i) 'code) 'source-object) + the-source) + (equal? (((inspect/object proc-n) 'code) 'source-object) + the-source) + (equal? ((((inspect/object proc-i) 'code) 'source) 'value) + '(lambda (x) x)) + (equal? (((inspect/object proc-n) 'code) 'source) + #f) +) + (mat strip-fasl-file (error? (fasl-strip-options ratfink profile-source)) diff --git a/release_notes/release_notes.stex b/release_notes/release_notes.stex index 9e04e17f73..533c0e9f82 100644 --- a/release_notes/release_notes.stex +++ b/release_notes/release_notes.stex @@ -58,6 +58,13 @@ Online versions of both books can be found at %----------------------------------------------------------------------------- \section{Functionality Changes}\label{section:functionality} +\subsection{Procedure source location without inspector information (9.5.1)} + +When \scheme{generate-inspector-information} is set to \scheme{#f} and +\scheme{generate-procedure-source-information} is set to \scheme{#t}, +source location information is preserved for a procedure, even though +other inspector information is not preserved. + \subsection{Atomic compare-and-set (9.5.1)} The new procedures \scheme{box-cas!} and \scheme{vector-cas!} diff --git a/s/cmacros.ss b/s/cmacros.ss index bf59b20d42..bd188e982a 100644 --- a/s/cmacros.ss +++ b/s/cmacros.ss @@ -1362,6 +1362,7 @@ [ptr meta-level] [ptr compile-profile] [ptr generate-inspector-information] + [ptr generate-procedure-source-information] [ptr generate-profile-forms] [ptr optimize-level] [ptr subset-mode] diff --git a/s/compile.ss b/s/compile.ss index ee4a24bff7..c526bae7fe 100644 --- a/s/compile.ss +++ b/s/compile.ss @@ -564,6 +564,7 @@ [cp0-score-limit (cp0-score-limit)] [cp0-outer-unroll-limit (cp0-outer-unroll-limit)] [generate-inspector-information (generate-inspector-information)] + [generate-procedure-source-information (generate-procedure-source-information)] [$compile-profile ($compile-profile)] [generate-interrupt-trap (generate-interrupt-trap)] [$optimize-closures ($optimize-closures)] diff --git a/s/cpnanopass.ss b/s/cpnanopass.ss index bc05dc1cd1..35c6cee331 100644 --- a/s/cpnanopass.ss +++ b/s/cpnanopass.ss @@ -5358,6 +5358,7 @@ (define-tc-parameter current-output-port current-output) (define-tc-parameter current-error-port current-error) (define-tc-parameter generate-inspector-information generate-inspector-information) + (define-tc-parameter generate-procedure-source-information generate-procedure-source-information) (define-tc-parameter generate-profile-forms generate-profile-forms) (define-tc-parameter $compile-profile compile-profile) (define-tc-parameter optimize-level optimize-level) @@ -13952,6 +13953,11 @@ (list->vector (ctci-rpi* ctci)))]) (vector-sort! (lambda (x y) (fx< (rp-info-offset x) (rp-info-offset y))) v) v)))] + [(and (generate-procedure-source-information) + (info-lambda-src info)) => + (lambda (src) + (include "types.ss") + (make-code-info src #f #f #f #f))] [else #f]) (info-lambda-pinfo* info)) (lambda (p) (c-trace (info-lambda-name info) code-size trace* p)))]) diff --git a/s/inspect.ss b/s/inspect.ss index 242c41fb0f..bd54c87116 100644 --- a/s/inspect.ss +++ b/s/inspect.ss @@ -2187,7 +2187,7 @@ [len ($continuation-stack-length x)] [lpm ($continuation-return-livemask x)]) (cond - [(and (code-info? info) (find-rpi offset (code-info-rpis info))) => + [(and (code-info? info) (code-info-rpis info) (find-rpi offset (code-info-rpis info))) => (lambda (rpi) (let ([cookie '(chocolate . chip)]) (let ([vals (make-vector len cookie)] [vars (make-vector len '())] [live (code-info-live info)]) diff --git a/s/patch.ss b/s/patch.ss index 5bf1f9a39b..5193d9ce7a 100644 --- a/s/patch.ss +++ b/s/patch.ss @@ -13,6 +13,11 @@ ;;; See the License for the specific language governing permissions and ;;; limitations under the License. +(define generate-procedure-source-information + (case-lambda + [() #f] + [(v) (void)])) + (printf "loading ~s cross compiler~%" (constant machine-type-name)) ; (current-expand (lambda args (apply sc-expand args))) diff --git a/s/primdata.ss b/s/primdata.ss index 06bbec9055..244c957bd3 100644 --- a/s/primdata.ss +++ b/s/primdata.ss @@ -957,6 +957,7 @@ (generate-inspector-information [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted]) (generate-instruction-counts [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted]) (generate-interrupt-trap [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted]) + (generate-procedure-source-information [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted]) (generate-profile-forms [sig [() -> (boolean)] [(ptr) -> (void)]] [flags unrestricted]) (generate-wpo-files [sig [() -> (boolean)] [(ptr) -> (void)]] [flags]) (gensym-count [sig [() -> (uint)] [(uint) -> (void)]] [flags]) diff --git a/s/prims.ss b/s/prims.ss index 79b66bece4..a56fde1174 100644 --- a/s/prims.ss +++ b/s/prims.ss @@ -1684,6 +1684,7 @@ [(x) (name (and x #t))])) (name init))]))) (define-boolean-tc-parameter generate-inspector-information #t) + (define-boolean-tc-parameter generate-procedure-source-information #f) (define-boolean-tc-parameter generate-profile-forms #t) (define-boolean-tc-parameter $suppress-primitive-inlining #f) )