diff --git a/LOG b/LOG index a2c1e94447..9362304a98 100644 --- a/LOG +++ b/LOG @@ -755,4 +755,8 @@ - fix signature of bytevector-[u/s]16-native-set! primdata.ss - fix enumerate signature - primdata.ss \ No newline at end of file + primdata.ss +- 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 a21473c8b3..7880aee84d 100644 --- a/csug/system.stex +++ b/csug/system.stex @@ -1108,6 +1108,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 @@ -2393,6 +2394,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 20250b3332..a026cb9a31 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 c03d353554..d320a203ed 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{Record equality and hashing (9.5)} The new procedures \scheme{record-type-equal-procedure} and diff --git a/s/cmacros.ss b/s/cmacros.ss index 822d50d59f..34f6ed93ef 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 e012607bf3..c5ef72e39c 100644 --- a/s/compile.ss +++ b/s/compile.ss @@ -559,6 +559,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 8287a0b002..1f58459bcf 100644 --- a/s/cpnanopass.ss +++ b/s/cpnanopass.ss @@ -5324,6 +5324,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) @@ -13878,6 +13879,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..a88a6c12af 100644 --- a/s/patch.ss +++ b/s/patch.ss @@ -13,6 +13,8 @@ ;;; See the License for the specific language governing permissions and ;;; limitations under the License. +(define (generate-procedure-source-information) #f) + (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 6eb18d228d..70054d0a59 100644 --- a/s/primdata.ss +++ b/s/primdata.ss @@ -954,6 +954,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 04eda43f44..17335255a1 100644 --- a/s/prims.ss +++ b/s/prims.ss @@ -1672,6 +1672,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) )