diff --git a/LOG b/LOG index 0892089895..fa79eae66e 100644 --- a/LOG +++ b/LOG @@ -773,3 +773,11 @@ cmacros.ss, cpnanopass.ss, interpret.ss, library.ss, primdata.ss, prims.ss, gc.c, objects.stex, release_notes.stex misc.ms, mats/patch*, mats/root* +- fix signature of bytevector-[u/s]16-native-set! + primdata.ss +- fix enumerate signature + 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/c/globals.h b/c/globals.h index 25aed73e1d..9006d1a7a3 100644 --- a/c/globals.h +++ b/c/globals.h @@ -15,7 +15,7 @@ */ /* globals that do NOT need to be preserved in a saved heap. - * they must be initalized each time the system is brought up. */ + * they must be initialized each time the system is brought up. */ /* gc.c */ EXTERN IBOOL S_checkheap; 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 b33faa26c4..7a2a1261f9 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 313c08a678..f6db5ae95d 100644 --- a/release_notes/release_notes.stex +++ b/release_notes/release_notes.stex @@ -99,6 +99,13 @@ for triggering just-in-time conversions of a procedure's implementation while imposing a minimal overhead on calls to the procedure before or after conversion. +\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 cfcfe0c366..34bb833644 100644 --- a/s/cmacros.ss +++ b/s/cmacros.ss @@ -1378,6 +1378,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 daa68fa76e..bdc9e05c36 100644 --- a/s/cpnanopass.ss +++ b/s/cpnanopass.ss @@ -5370,6 +5370,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) @@ -14009,6 +14010,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 5a0ab2ec43..5193d9ce7a 100644 --- a/s/patch.ss +++ b/s/patch.ss @@ -13,7 +13,10 @@ ;;; See the License for the specific language governing permissions and ;;; limitations under the License. -(define ($make-arity-wrapper-procedure proc mask) proc) +(define generate-procedure-source-information + (case-lambda + [() #f] + [(v) (void)])) (printf "loading ~s cross compiler~%" (constant machine-type-name)) diff --git a/s/primdata.ss b/s/primdata.ss index 7460fb3c7b..6a36e6a1f4 100644 --- a/s/primdata.ss +++ b/s/primdata.ss @@ -367,7 +367,7 @@ (bytevector-uint-ref [sig [(bytevector sub-index symbol sub-length) -> (uint)]] [flags true mifoldable discard]) (bytevector-sint-ref [sig [(bytevector sub-index symbol sub-length) -> (sint)]] [flags true mifoldable discard]) (bytevector-uint-set! [sig [(bytevector sub-index sub-uint symbol sub-length) -> (void)]] [flags true]) - (bytevector-sint-set! [sig [(bytevector sub-index sub-uint symbol sub-length) -> (void)]] [flags true]) + (bytevector-sint-set! [sig [(bytevector sub-index sub-sint symbol sub-length) -> (void)]] [flags true]) (bytevector->uint-list [sig [(bytevector symbol sub-index) -> (list)]] [flags alloc]) (bytevector->sint-list [sig [(bytevector symbol sub-index) -> (list)]] [flags alloc]) (uint-list->bytevector [sig [(sub-list symbol sub-index) -> (bytevector)]] [flags alloc]) @@ -378,8 +378,8 @@ (bytevector-s16-native-ref [sig [(bytevector sub-index) -> (s16)]] [flags true cp02]) (bytevector-u16-set! [sig [(bytevector sub-index u16 symbol) -> (void)]] [flags true]) (bytevector-s16-set! [sig [(bytevector sub-index s16 symbol) -> (void)]] [flags true]) - (bytevector-u16-native-set! [sig [(bytevector sub-index symbol) -> (void)]] [flags true]) - (bytevector-s16-native-set! [sig [(bytevector sub-index symbol) -> (void)]] [flags true]) + (bytevector-u16-native-set! [sig [(bytevector sub-index u16) -> (void)]] [flags true]) + (bytevector-s16-native-set! [sig [(bytevector sub-index s16) -> (void)]] [flags true]) (bytevector-u32-ref [sig [(bytevector sub-index symbol) -> (u32)]] [flags true mifoldable discard]) (bytevector-s32-ref [sig [(bytevector sub-index symbol) -> (s32)]] [flags true mifoldable discard]) (bytevector-u32-native-ref [sig [(bytevector sub-index) -> (u32)]] [flags true cp02]) @@ -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]) @@ -1247,7 +1248,7 @@ (enable-interrupts [sig [() -> (uint)]] [flags true]) (engine-block [sig [() -> (ptr)]] [flags]) (engine-return [sig [(ptr ...) -> (bottom)]] [flags abort-op]) - (enumerate [sig [(list) -> (ufixnum)]] [flags alloc]) + (enumerate [sig [(list) -> (list)]] [flags alloc]) (enum-set? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard]) (environment? [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard]) (environment-mutable? [sig [(environment) -> (boolean)]] [flags pure mifoldable discard]) @@ -1461,8 +1462,8 @@ (mutex-release [feature pthreads] [sig [(mutex) -> (void)]] [flags true]) (mutex? [feature pthreads] [sig [(ptr) -> (boolean)]] [flags pure unrestricted mifoldable discard]) (new-cafe [sig [() (procedure) -> (ptr ...)]] [flags]) - (nonnegative? [sig [(number) -> (boolean)]] [flags pure mifoldable discard]) - (nonpositive? [sig [(number) -> (boolean)]] [flags pure mifoldable discard]) + (nonnegative? [sig [(real) -> (boolean)]] [flags pure mifoldable discard]) + (nonpositive? [sig [(real) -> (boolean)]] [flags pure mifoldable discard]) (number->string [sig [(number) (number sub-ufixnum) (number sub-ufixnum sub-ufixnum) -> (string)]] [flags alloc]) ; radix not restricted to 2, 4, 8, 16 (object-counts [sig [() -> (ptr)]] [flags alloc]) (oblist [sig [() -> (list)]] [flags alloc]) diff --git a/s/prims.ss b/s/prims.ss index 8f533dd657..936fd84304 100644 --- a/s/prims.ss +++ b/s/prims.ss @@ -1706,6 +1706,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) ) diff --git a/scheme.1.in b/scheme.1.in index 738eff20e9..69191eb21b 100644 --- a/scheme.1.in +++ b/scheme.1.in @@ -14,7 +14,7 @@ \fB{InstallPetiteName}\fP [ \fIoptions\fP ] \fIfile\fP ... .SH DESCRIPTION \*s is a programming language, based on R6RS Scheme, and a -high-performance implementation of that langauge. +high-performance implementation of that language. \*s compiles source expressions \fIincrementally\fP to machine code, providing the speed of compiled code in an interactive system. .LP