From 425b39da5bedd1aae013f97e79c5edc3f187d10a Mon Sep 17 00:00:00 2001 From: Gustavo Massaccesi Date: Sun, 15 Oct 2017 22:49:43 -0300 Subject: [PATCH 1/4] fix enumerate signature original commit: f28167b985190ebab58a1c58d7693077ee29e96a --- LOG | 2 ++ s/primdata.ss | 6 +++--- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/LOG b/LOG index 788aebebaf..fb0a20257a 100644 --- a/LOG +++ b/LOG @@ -645,4 +645,6 @@ makefiles/Makefile-release_notes.in (renamed from release_notes/Makefile), makefiles/Makefile +- fix enumerate signature + primdata.ss diff --git a/s/primdata.ss b/s/primdata.ss index 5bd0c3411b..6752918baa 100644 --- a/s/primdata.ss +++ b/s/primdata.ss @@ -1244,7 +1244,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]) @@ -1457,8 +1457,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]) From 877bf5e25b0ef40d7453453062afa2be3edc6f12 Mon Sep 17 00:00:00 2001 From: "Barak A. Pearlmutter" Date: Mon, 4 Dec 2017 09:35:31 +0000 Subject: [PATCH 2/4] spelling original commit: bf67725d5538defc7e006b0fb7a2eb95993b6f34 --- c/globals.h | 2 +- scheme.1.in | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) 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/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 From 1ecfb04a58b2bb701d7b2cb53448966db701d34e Mon Sep 17 00:00:00 2001 From: Gustavo Massaccesi Date: Mon, 4 Dec 2017 17:32:28 -0300 Subject: [PATCH 3/4] fix bytevector-[u/s]16-native-set! signature original commit: 5d4e2fa1b2cf1ad7011b94b2b5262f734d5f0530 --- LOG | 2 ++ s/primdata.ss | 6 +++--- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/LOG b/LOG index 2b92305b49..3d96df9b85 100644 --- a/LOG +++ b/LOG @@ -752,3 +752,5 @@ a partial object file. syntax.ss, 7.ms +- fix signature of bytevector-[u/s]16-native-set! + primdata.ss diff --git a/s/primdata.ss b/s/primdata.ss index 60163efd8d..dc8aee9e62 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]) From 9f1f5b793f70888e1721517608e385974d929f02 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 5 Dec 2017 20:40:22 -0700 Subject: [PATCH 4/4] add generate-procedure-source-information original commit: 45df1f3a517c040a45aaea8f0bd4c9d859310187 --- LOG | 6 +++++- csug/system.stex | 16 ++++++++++++++++ mats/misc.ms | 24 ++++++++++++++++++++++++ release_notes/release_notes.stex | 7 +++++++ s/cmacros.ss | 1 + s/compile.ss | 1 + s/cpnanopass.ss | 6 ++++++ s/inspect.ss | 2 +- s/patch.ss | 2 ++ s/primdata.ss | 1 + s/prims.ss | 1 + 11 files changed, 65 insertions(+), 2 deletions(-) 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) )