>From a10afa948f68efc5bfa6c7d054c09de078991823 Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Sat, 16 Aug 2014 17:45:00 +0200 Subject: [PATCH 11/19] compiler-modules: Convert compiler to a module. In eval.scm, there is a hack that invokes ##compiler#process-declaration when it runs inside the compiler. This has been rewritten to compiler#process-declaration, which is the modularised new name. A similar thing was happening for ##sys#do-the-right-thing, where the hash table ##compiler#file-requirements was updated when running in the compiler. This has been rewritten to compiler#file-requirements. Some things have been moved around: - broken-constant-nodes is moved into optimizer, and not exported because nobody else is using it. - compute-database-statistics was moved out of support into compiler, because it uses a few variables that are internal to compiler and there's no need to export them. Exporting them would also create a cyclic dependency between support and compiler, which is not good. - print-program-statistics was moved out of support into batch-driver to avoid the cyclic dependency between support and compiler. It was only used by batch-driver anyway. - profile-lambda-index has been moved to support, which is the only place it is used (it's a counter for expand-profile-lambda) - unlikely-variables has moved from c-platform to compiler, which is the only place it was used, and it has nothing to do with the target (C) platform. - The definition of real-name-table was moved from compiler to support to avoid cyclic dependencies. To make initialization cleaner, clear-real-name-table! has been added. Instead of directly looking up names in the hash-table, compiler now calls get-real-name (which mirrors the set-real-name! naming convention). A few obsolete things that were no longer used have been removed: - csc-control-file - data-declarations - require-imports-flag - postponed-initforms (always empty list, because it is never assigned) - default-target-heap-size (and the corresponding, no longer used, C_DEFAULT_TARGET_HEAP_SIZE definition) Several names were in compiler-namespace that no longer existed, which were probably dropped somewhere along the line (not in this set of patches): - debug-info-index - debug-info-vector-name - debug-lambda-list - debug-variable-list - debugging-executable - default-default-target-heap-size (typo for default-target-heap-size?) - default-optimization-iterations (typo for default-optimization-passes?) - default-output-filename - dependency-list - emit-control-file-item - expand-debug-assignment - expand-debug-call - expand-debug-lambda - expand-foreign-callback-lambda - expand-foreign-callback-lambda* - export-dump-hook - file-io-only - find-early-refs - find-inlining-candidates - foreign-callback-stub-body - foreign-callback-stub-callback - foreign-callback-stub-cps - foreign-string-result-reserve - foreign-stub-qualifiers - inlining - nonwinding-call/cc - optimization-iterations - perform-inlining! - register-unboxed-op - rest-argument-mode (typo for lambda-literal-rest-argument-mode?) - rest-parameters-promoted-to-vector - update-line-number-database (it was probably renamed to have a trailing bang) --- batch-driver.scm | 22 ++++++-- c-backend.scm | 2 +- c-platform.scm | 2 - compiler-namespace.scm | 133 +----------------------------------------------- compiler.scm | 108 ++++++++++++++++++++++++++++++++++----- defaults.make | 3 -- eval.scm | 6 ++- optimizer.scm | 1 + rules.make | 8 +-- support.scm | 75 +++++++-------------------- 10 files changed, 142 insertions(+), 218 deletions(-) diff --git a/batch-driver.scm b/batch-driver.scm index b71d016..0dfd640 100644 --- a/batch-driver.scm +++ b/batch-driver.scm @@ -30,8 +30,9 @@ (declare (unit batch-driver) (uses extras data-structures files srfi-1 + support compiler-syntax compiler optimizer ;; TODO: Backend should be configurable - support lfa2 compiler-syntax optimizer scrutinizer c-platform c-backend) ) + scrutinizer lfa2 c-platform c-backend) ) ;; TODO: Remove these once everything's converted to modules (include "private-namespace") @@ -44,7 +45,8 @@ user-post-analysis-pass) (import chicken scheme extras data-structures files srfi-1 - support lfa2 compiler-syntax optimizer scrutinizer c-platform c-backend) + support compiler-syntax compiler optimizer scrutinizer lfa2 + c-platform c-backend) (include "tweaks") @@ -56,6 +58,18 @@ (define user-pass (make-parameter #f)) (define user-post-analysis-pass (make-parameter #f)) +;;; Emit collected information from various statistics about the program + +(define (print-program-statistics db) + (receive + (size osize kvars kprocs globs sites entries) (compute-database-statistics db) + (when (debugging 's "program statistics:") + (printf "; program size: \t~s \toriginal program size: \t~s\n" size osize) + (printf "; variables with known values: \t~s\n" kvars) + (printf "; known procedures: \t~s\n" kprocs) + (printf "; global variables: \t~s\n" globs) + (printf "; known call sites: \t~s\n" sites) + (printf "; database entries: \t~s\n" entries) ) ) ) ;;; Compile a complete source file: @@ -340,9 +354,6 @@ (set! ##sys#features (cons '#:compiling ##sys#features)) (set! upap (user-post-analysis-pass)) - ;; Insert postponed initforms: - (set! initforms (append initforms postponed-initforms)) - ;; Append required extensions to initforms: (set! initforms (append @@ -583,6 +594,7 @@ (print-node "specialization" '|P| node0)) (set! first-analysis #t) ) ) + ;; TODO: Move this so that we don't need to export these (set! ##sys#line-number-database #f) (set! constant-table #f) (set! inline-table #f) diff --git a/c-backend.scm b/c-backend.scm index f91077b..9e217ea 100644 --- a/c-backend.scm +++ b/c-backend.scm @@ -43,7 +43,7 @@ foreign-type-declaration) (import chicken scheme foreign srfi-1 data-structures - c-platform support) + compiler c-platform support) ;;; Write atoms to output-port: diff --git a/c-platform.scm b/c-platform.scm index bde46db..afebbbb 100644 --- a/c-platform.scm +++ b/c-platform.scm @@ -81,8 +81,6 @@ (define words-per-flonum 4) (define parameter-limit 1024) (define small-parameter-limit 128) -;; TODO: export this and remove it from compiler-namespace -(define unlikely-variables '(unquote unquote-splicing)) (eq-inline-operator "C_eqp") (membership-test-operators diff --git a/compiler-namespace.scm b/compiler-namespace.scm index c0210b8..d8609f4 100644 --- a/compiler-namespace.scm +++ b/compiler-namespace.scm @@ -26,160 +26,29 @@ (private compiler - analyze-expression - all-import-libraries block-compilation - bootstrap-mode - broken-constant-nodes - callback-names - canonicalize-expression - compile-format-string compiler-arguments - compiler-source-file - compiler-syntax-enabled - constant-table - constants-used - create-foreign-stub - csc-control-file - current-program-size - data-declarations - debug-info-index - debug-info-vector-name - debug-lambda-list - debug-variable-list - debugging-executable - default-default-target-heap-size default-extended-bindings - default-optimization-iterations - default-output-filename default-standard-bindings - defconstant-bindings - dependency-list - direct-call-ids - disable-stack-overflow-checking - emit-closure-info - emit-control-file-item - emit-profile - emit-trace-info - enable-inline-files enable-specialization - expand-debug-assignment - expand-debug-call - expand-debug-lambda - expand-foreign-callback-lambda - expand-foreign-callback-lambda* - expand-foreign-lambda - expand-foreign-lambda* - expand-foreign-primitive - explicit-use-flag - export-dump-hook extended-bindings - external-protos-first - external-to-pointer - external-variables - file-io-only - file-requirements - find-early-refs - find-inlining-candidates - first-analysis foldable-bindings foreign-callback-stubs foreign-callback-stub-argument-types - foreign-callback-stub-body - foreign-callback-stub-callback - foreign-callback-stub-cps foreign-callback-stub-id foreign-callback-stub-name foreign-callback-stub-qualifiers foreign-callback-stub-return-type - foreign-declarations - foreign-lambda-stubs - foreign-string-result-reserve - foreign-stub-argument-types - foreign-stub-argument-names - foreign-stub-body - foreign-stub-callback - foreign-stub-cps - foreign-stub-id - foreign-stub-name - foreign-stub-qualifiers - foreign-stub-return-type foreign-type-table - foreign-variables - immutable-constants - import-libraries - initialize-compiler inline-locally inline-max-size inline-substitutions-enabled - inline-table - inline-table-used - inlining - insert-timer-checks - installation-home internal-bindings - line-number-database-2 - line-number-database-size - lambda-literal-id - lambda-literal-external - lambda-literal-arguments - lambda-literal-argument-count - lambda-literal-rest-argument - lambda-literal-rest-argument-mode - lambda-literal-temporaries - lambda-literal-unboxed-temporaries - lambda-literal-callee-signatures - lambda-literal-allocated - lambda-literal-directly-called - lambda-literal-closure-size - lambda-literal-looping - lambda-literal-customizable - rest-argument-mode - lambda-literal-body - lambda-literal-direct - local-definitions - location-pointer-map - no-argc-checks - no-bound-checks - no-global-procedure-checks - enable-module-registration - no-procedure-checks - nonwinding-call/cc number-type - optimization-iterations - optimize-leaf-routines - original-program-size parenthesis-synonyms - pending-canonicalizations - perform-closure-conversion - perform-cps-conversion - perform-inlining! - postponed-initforms - prepare-for-code-generation - process-command-line - process-declaration profile-info-vector-name - profile-lambda-index profile-lambda-list - profiled-procedures - real-name-table - register-unboxed-op - require-imports-flag - rest-parameters-promoted-to-vector - safe-globals-flag source-filename - standalone-executable standard-bindings strict-variable-types - target-heap-size - target-stack-size - toplevel-lambda-id - toplevel-scope - undefine-shadowed-macros - unit-name - unlikely-variables - unsafe - update-line-number-database - update-line-number-database! - used-units - verbose-mode) + unsafe) diff --git a/compiler.scm b/compiler.scm index 8c1013e..351590c 100644 --- a/compiler.scm +++ b/compiler.scm @@ -264,12 +264,60 @@ (declare (unit compiler) - (uses scrutinizer support) ) + (uses srfi-1 extras data-structures + scrutinizer support) ) (import scrutinizer support) +;; TODO: Remove these once everything's converted to modules +(include "private-namespace") (include "compiler-namespace") +(module compiler + (analyze-expression canonicalize-expression compute-database-statistics + initialize-compiler perform-closure-conversion perform-cps-conversion + prepare-for-code-generation + + ;; These are both exported for use in eval.scm (which is a bit of + ;; a hack). file-requirements is also used by batch-driver + process-declaration file-requirements + + ;; Various ugly global boolean flags that get set by the (batch) driver + all-import-libraries bootstrap-mode compiler-syntax-enabled + emit-closure-info emit-profile enable-inline-files explicit-use-flag + first-analysis no-bound-checks enable-module-registration + optimize-leaf-routines standalone-executable undefine-shadowed-macros + verbose-mode local-definitions + + ;; These are set by the (batch) driver, and read by the (c) backend + disable-stack-overflow-checking emit-trace-info external-protos-first + external-variables insert-timer-checks no-argc-checks + no-global-procedure-checks no-procedure-checks + + ;; Other, non-boolean, flags set by (batch) driver + profiled-procedures import-libraries + + ;; non-booleans set by the (batch) driver, and read by the (c) backend + target-heap-size target-stack-size unit-name used-units + + ;; Only read or called by the (c) backend + foreign-declarations foreign-lambda-stubs foreign-stub-argument-types + foreign-stub-argument-names foreign-stub-body foreign-stub-callback + foreign-stub-cps foreign-stub-id foreign-stub-name foreign-stub-return-type + lambda-literal-id lambda-literal-external lambda-literal-argument-count + lambda-literal-rest-argument lambda-literal-rest-argument-mode + lambda-literal-temporaries lambda-literal-unboxed-temporaries + lambda-literal-callee-signatures lambda-literal-allocated + lambda-literal-closure-size lambda-literal-looping + lambda-literal-customizable lambda-literal-body lambda-literal-direct + + ;; Tables and databases that really should not be exported + constant-table immutable-constants inline-table line-number-database-2 + line-number-database-size) + +(import chicken scheme foreign srfi-1 extras data-structures + scrutinizer support) + (define (d arg1 . more) (when (##sys#fudge 13) ; debug mode? (if (null? more) @@ -284,7 +332,6 @@ (define-inline (gensym-f-id) (gensym 'f_)) (define-foreign-variable installation-home c-string "C_INSTALL_SHARE_HOME") -(define-foreign-variable default-target-heap-size int "C_DEFAULT_TARGET_HEAP_SIZE") (define-constant foreign-type-table-size 301) (define-constant initial-analysis-database-size 3001) @@ -292,7 +339,6 @@ (define-constant inline-table-size 301) (define-constant constant-table-size 301) (define-constant file-requirements-size 301) -(define-constant real-name-table-size 997) (define-constant default-inline-max-size 20) @@ -321,7 +367,6 @@ (define safe-globals-flag #f) (define explicit-use-flag #f) (define disable-stack-overflow-checking #f) -(define require-imports-flag #f) (define external-protos-first #f) (define inline-max-size default-inline-max-size) (define emit-closure-info #t) @@ -351,7 +396,6 @@ (define inline-table-used #f) (define constant-table #f) (define constants-used #f) -(define broken-constant-nodes '()) (define inline-substitutions-enabled #f) (define direct-call-ids '()) (define first-analysis #t) @@ -361,21 +405,17 @@ (define foreign-callback-stubs '()) (define external-variables '()) (define profile-lambda-list '()) -(define profile-lambda-index 0) (define profile-info-vector-name #f) (define external-to-pointer '()) -(define real-name-table #f) (define location-pointer-map '()) (define pending-canonicalizations '()) (define defconstant-bindings '()) (define callback-names '()) (define toplevel-scope #t) (define toplevel-lambda-id #f) -(define csc-control-file #f) -(define data-declarations '()) (define file-requirements #f) -(define postponed-initforms '()) +(define unlikely-variables '(unquote unquote-splicing)) ;;; Initialize globals: @@ -390,7 +430,7 @@ (vector-fill! constant-table '()) (set! constant-table (make-vector constant-table-size '())) ) (set! profile-info-vector-name (make-random-name 'profile-info)) - (set! real-name-table (make-vector real-name-table-size '())) + (clear-real-name-table!) (if file-requirements (vector-fill! file-requirements '()) (set! file-requirements (make-vector file-requirements-size '())) ) @@ -399,6 +439,47 @@ (set! foreign-type-table (make-vector foreign-type-table-size '())) ) ) +;;; Compute general statistics from analysis database: +; +; - Returns: +; +; current-program-size +; original-program-size +; number of known variables +; number of known procedures +; number of global variables +; number of known call-sites +; number of database entries +; average bucket load + +(define (compute-database-statistics db) + (let ((nprocs 0) + (nvars 0) + (nglobs 0) + (entries 0) + (nsites 0) ) + (##sys#hash-table-for-each + (lambda (sym plist) + (for-each + (lambda (prop) + (set! entries (+ entries 1)) + (case (car prop) + ((global) (set! nglobs (+ nglobs 1))) + ((value) + (set! nvars (+ nvars 1)) + (if (eq? '##core#lambda (node-class (cdr prop))) + (set! nprocs (+ nprocs 1)) ) ) + ((call-sites) (set! nsites (+ nsites (length (cdr prop))))) ) ) + plist) ) + db) + (values current-program-size + original-program-size + nvars + nprocs + nglobs + nsites + entries) ) ) + ;;; Expand macros and canonicalize expressions: (define (canonicalize-expression exp) @@ -1952,7 +2033,7 @@ ((##core#primitive ##core#inline) (let ((id (first params))) - (when (and first-analysis here (symbol? id) (##sys#hash-table-ref real-name-table id)) + (when (and first-analysis here (symbol? id) (get-real-name id)) (set-real-name! id here) ) (walkeach subs env localenv fullenv here #f) ) ) @@ -2497,6 +2578,7 @@ lambda-literal? (id lambda-literal-id) ; symbol (external lambda-literal-external) ; boolean + ;; lambda-literal-arguments is used nowhere (arguments lambda-literal-arguments) ; (symbol ...) (argument-count lambda-literal-argument-count) ; integer (rest-argument lambda-literal-rest-argument) ; symbol | #f @@ -2504,6 +2586,7 @@ (unboxed-temporaries lambda-literal-unboxed-temporaries) ; ((sym . utype) ...) (callee-signatures lambda-literal-callee-signatures) ; (integer ...) (allocated lambda-literal-allocated) ; integer + ;; lambda-literal-directly-called is used nowhere (directly-called lambda-literal-directly-called) ; boolean (closure-size lambda-literal-closure-size) ; integer (looping lambda-literal-looping) ; boolean @@ -2824,3 +2907,4 @@ (debugging 'o "fast global assignments" fastsets)) (values node2 (##sys#fast-reverse literals) (##sys#fast-reverse lambda-info-literals) lambda-table) ) ) ) +) \ No newline at end of file diff --git a/defaults.make b/defaults.make index 6c1794f..dfce023 100644 --- a/defaults.make +++ b/defaults.make @@ -371,9 +371,6 @@ endif $(call echo, >>, $@,#ifndef C_INSTALL_MORE_STATIC_LIBS) $(call echo, >>, $@,# define C_INSTALL_MORE_STATIC_LIBS "$(LIBRARIES)") $(call echo, >>, $@,#endif) - $(call echo, >>, $@,#ifndef C_DEFAULT_TARGET_HEAP_SIZE) - $(call echo, >>, $@,# define C_DEFAULT_TARGET_HEAP_SIZE 0) - $(call echo, >>, $@,#endif) $(call echo, >>, $@,#ifndef C_STACK_GROWS_DOWNWARD) $(call echo, >>, $@,# define C_STACK_GROWS_DOWNWARD $(STACKDIRECTION)) $(call echo, >>, $@,#endif) diff --git a/eval.scm b/eval.scm index befdc29..54461fa 100644 --- a/eval.scm +++ b/eval.scm @@ -720,7 +720,8 @@ [(##core#declare) (if (memq #:compiling ##sys#features) - (for-each (lambda (d) (##compiler#process-declaration d se)) (cdr x)) + ;; XXX FIXME: This is a bit of a hack. Why is it needed at all? + (for-each (lambda (d) (compiler#process-declaration d se)) (cdr x)) (##sys#notice "declarations are ignored in interpreted code" x) ) @@ -1286,7 +1287,8 @@ (define (add-req id syntax?) (when comp? (##sys#hash-table-update! - ##compiler#file-requirements + ;; XXX FIXME: This is a bit of a hack. Why is it needed at all? + compiler#file-requirements (if syntax? 'dynamic/syntax 'dynamic) (cut lset-adjoin eq? <> id) ;XXX assumes compiler has srfi-1 loaded (lambda () (list id))))) diff --git a/optimizer.scm b/optimizer.scm index c4aa8f3..7f8baae 100644 --- a/optimizer.scm +++ b/optimizer.scm @@ -147,6 +147,7 @@ (define simplifications (make-vector 301 '())) (define simplified-ops '()) +(define broken-constant-nodes '()) (define (perform-high-level-optimizations node db) (let ((removed-lets 0) diff --git a/rules.make b/rules.make index 3996455..97e4c58 100644 --- a/rules.make +++ b/rules.make @@ -492,22 +492,24 @@ endef $(foreach lib, $(SETUP_API_OBJECTS_1),\ $(eval $(call declare-emitted-import-lib-dependency,$(lib)))) -$(foreach lib, batch-driver lfa2 compiler-syntax optimizer scrutinizer c-platform c-backend support,\ +$(foreach lib, $(filter-out chicken,$(COMPILER_OBJECTS_1)),\ $(eval $(call declare-emitted-import-lib-dependency,$(lib)))) chicken.c: chicken.scm batch-driver.import.scm batch-driver.scm \ c-platform.scm c-platform.import.scm -batch-driver.c: batch-driver.scm lfa2.import.scm lfa2.scm \ +batch-driver.c: batch-driver.scm compiler.scm compiler.import.scm \ compiler-syntax.scm compiler-syntax.import.scm \ optimizer.scm optimizer.import.scm \ scrutinizer.scm scrutinizer.import.scm \ c-platform.scm c-platform.import.scm \ + lfa2.import.scm lfa2.scm \ c-backend.scm c-backend.import.scm \ support.scm support.import.scm c-platform.c: c-platform.scm optimizer.scm optimizer.import.scm \ support.scm support.import.scm c-backend.c: c-backend.scm c-platform.scm c-platform.import.scm \ - support.scm support.import.scm compiler.scm + support.scm support.import.scm \ + compiler.scm compiler.import.scm compiler.c: compiler.scm scrutinizer.scm scrutinizer.import.scm \ support.scm support.import.scm optimizer.c: optimizer.scm support.scm support.import.scm diff --git a/support.scm b/support.scm index b067d70..a6f2d57 100644 --- a/support.scm +++ b/support.scm @@ -52,14 +52,15 @@ tree-copy copy-node! emit-global-inline-file load-inline-file match-node expression-has-side-effects? simple-lambda-node? dump-undefined-globals dump-defined-globals dump-global-refs - print-program-statistics foreign-type-check foreign-type-convert-result + foreign-type-check foreign-type-convert-result foreign-type-convert-argument final-foreign-type estimate-foreign-result-size estimate-foreign-result-location-size finish-foreign-result foreign-type->scrutiny-type scan-used-variables scan-free-variables chop-separator make-block-variable-literal block-variable-literal? block-variable-literal-name make-random-name - set-real-name! real-name real-name2 display-real-name-table + clear-real-name-table! get-real-name set-real-name! + real-name real-name2 display-real-name-table source-info->string source-info->line call-info constant-form-eval dump-nodes read-info-hook read/source-info big-fixnum? hide-variable export-variable variable-visible? @@ -367,6 +368,7 @@ ;;; Profiling instrumentation: +(define profile-lambda-index 0) (define (expand-profile-lambda name llist body) (let ([index profile-lambda-index] @@ -971,60 +973,6 @@ (debugging 'o "hiding nonexported module bindings" sym) (hide-variable sym)))) - -;;; Compute general statistics from analysis database: -; -; - Returns: -; -; current-program-size -; original-program-size -; number of known variables -; number of known procedures -; number of global variables -; number of known call-sites -; number of database entries -; average bucket load - -(define (compute-database-statistics db) - (let ((nprocs 0) - (nvars 0) - (nglobs 0) - (entries 0) - (nsites 0) ) - (##sys#hash-table-for-each - (lambda (sym plist) - (for-each - (lambda (prop) - (set! entries (+ entries 1)) - (case (car prop) - ((global) (set! nglobs (+ nglobs 1))) - ((value) - (set! nvars (+ nvars 1)) - (if (eq? '##core#lambda (node-class (cdr prop))) - (set! nprocs (+ nprocs 1)) ) ) - ((call-sites) (set! nsites (+ nsites (length (cdr prop))))) ) ) - plist) ) - db) - (values current-program-size - original-program-size - nvars - nprocs - nglobs - nsites - entries) ) ) - -(define (print-program-statistics db) ; Used only in batch-driver.scm - (receive - (size osize kvars kprocs globs sites entries) (compute-database-statistics db) - (when (debugging 's "program statistics:") - (printf "; program size: \t~s \toriginal program size: \t~s\n" size osize) - (printf "; variables with known values: \t~s\n" kvars) - (printf "; known procedures: \t~s\n" kprocs) - (printf "; global variables: \t~s\n" globs) - (printf "; known call sites: \t~s\n" sites) - (printf "; database entries: \t~s\n" entries) ) ) ) - - ;;; Create foreign type checking expression: (define foreign-type-check ; Used only in compiler.scm @@ -1433,9 +1381,21 @@ ; -> ; -> or +(define-constant real-name-table-size 997) + +(define real-name-table #f) + +(define (clear-real-name-table!) + (set! real-name-table (make-vector real-name-table-size '()))) + (define (set-real-name! name rname) ; Used only in compiler.scm (##sys#hash-table-set! real-name-table name rname) ) +;; TODO: Find out why there are so many lookup functions for this and +;; reduce them to the minimum. +(define (get-real-name name) + (##sys#hash-table-ref real-name-table name)) + ;; Arbitrary limit to prevent runoff into exponential behavior (define real-name-max-depth 20) @@ -1470,8 +1430,7 @@ (and-let* ([rn (##sys#hash-table-ref real-name-table var)]) (real-name rn db) ) ) -;; TODO: real-name-table is defined in compiler.scm; move it here? -(define (display-real-name-table) ; Used only in batch-driver.scm +(define (display-real-name-table) (##sys#hash-table-for-each (lambda (key val) (printf "~S\t~S~%" key val) ) -- 1.7.10.4