add 'compiled-file-roots to "config.rktd"

pkgs/base/info.rkt

@@ -14,7 +14,7 @@
 
 ;; In the Racket source repo, this version should change only when
 ;; "racket_version.h" changes:
-(define version "8.0.0.8")
+(define version "8.0.0.9")
 
 (define deps `("racket-lib"
                ["racket" #:version ,version]))

pkgs/racket-doc/scribblings/raco/config.scrbl

@@ -95,6 +95,14 @@ directory}:
        @history[#:changed "7.0.0.19" @elem{Adapt the package-search path in
                                            a general way for a directory scope.}]}
 
+ @item{@indexed-racket['compiled-file-roots] --- a list of paths
+       and @racket['same] used to initialize @racket[current-compiled-file-roots].
+       A path, which is relative or absolute, can be specified as a string
+       or byte string that is converted to a path with @racket[string->path]
+       or @racket[bytes->path], respectively.
+
+       @history[#:added "8.0.0.9"]}
+
  @item{@indexed-racket['bin-dir] --- a path, string, or byte string for the
        installation's directory containing executables. It defaults to a
        @filepath{bin} sibling directory of the @tech{main collection

pkgs/racket-doc/scribblings/reference/eval.scrbl

@@ -1,5 +1,6 @@
 #lang scribble/doc
-@(require "mz.rkt")
+@(require "mz.rkt"
+          (for-label setup/dirs))
 
 @title[#:tag "eval"]{Evaluation and Compilation}
 
@@ -395,17 +396,34 @@ A list of paths and @racket['same]s that is is used by the default
 @tech{compiled-load handler} (see @racket[current-load/use-compiled]).
 
 The parameter is normally initialized to @racket[(list 'same)], but
-the parameter's initial value can be adjusted by the
+the parameter's initial value can be adjusted by the installation
+configuration as reported by @racket[(find-compiled-file-roots)],
+and it can be further adjusted by the
 @as-index{@envvar{PLTCOMPILEDROOTS}} environment variable or the
 @DFlag{compiled} or @Flag{R} command-line flag for @exec{racket}.  If
 the environment variable is defined and not overridden by a
 command-line flag, it is parsed by first replacing any
 @litchar["@(version)"] with the result of @racket[(version)], then using
-@racket[path-list-string->path-list] with a default path list
+@racket[path-list-string->path-list] with a path list produced by
-@racket[(list (build-path 'same))] to arrive at the parameter's
+@racket[(find-compiled-file-roots)] to arrive at the parameter's
 initial value.}
 
 
+@defproc[(find-compiled-file-roots) 
+         (listof (or/c path? 'same))]{
+
+Produces a list of paths and @racket['same], which is normally used to
+initialize @racket[current-compiled-file-roots]. The list is
+determined by consulting the @filepath{config.rtkd} file in the
+directory reported by @racket[(find-config-dir)], and it defaults to
+@racket[(list (build-path 'same))] if not configured there.
+
+See also @racket['compiled-file-roots] in @secref[#:doc raco-doc
+"config-file"].
+
+@history[#:added "8.0.0.9"]}
+
+
 @defparam[use-compiled-file-check check (or/c 'modify-seconds 'exists)]{
 
 A @tech{parameter} that determines how a compiled file is checked

racket/src/bc/cmdline.inc

@@ -1351,8 +1351,7 @@ static int run_from_cmd_line(int argc, char *_argv[],
 
   if (!skip_coll_dirs)
     scheme_init_collection_paths_post(global_env, collects_paths_l, collects_paths_r);
-  if (compiled_paths)
+  scheme_init_compiled_roots(global_env, compiled_paths);
-    scheme_init_compiled_roots(global_env, compiled_paths);
 
   scheme_seal_parameters();
 

racket/src/bc/src/eval.c

@@ -3831,24 +3831,33 @@ void scheme_init_compiled_roots(Scheme_Env *global_env, const char *paths)
   save = p->error_buf;
   p->error_buf = &newbuf;
   if (!scheme_setjmp(newbuf)) {
-    Scheme_Object *rr, *ccfr, *pls2pl, *a[3];
+    Scheme_Object *rr, *ccfr, *fcfr, *pls2pl, *a[3];
 
-    rr = scheme_builtin_value("regexp-replace*");
+    fcfr = scheme_builtin_value("find-compiled-file-roots");
     ccfr = scheme_builtin_value("current-compiled-file-roots");
-    pls2pl = scheme_builtin_value("path-list-string->path-list");
+    if (paths) {
+      rr = scheme_builtin_value("regexp-replace*");
+      pls2pl = scheme_builtin_value("path-list-string->path-list");
+    } else
+      rr = pls2pl = scheme_false;
 
-    if (rr && ccfr && pls2pl) {
+    if (rr && fcfr && ccfr && pls2pl) {
-      a[0] = scheme_make_utf8_string("@[(]version[)]");
+      if (paths) {
-      a[1] = scheme_make_utf8_string(paths);
+        a[0] = scheme_make_utf8_string("@[(]version[)]");
-      a[2] = scheme_make_utf8_string(scheme_version());
+        a[1] = scheme_make_utf8_string(paths);
-      a[2] = _scheme_apply(rr, 3, a);
+        a[2] = scheme_make_utf8_string(scheme_version());
+        a[2] = _scheme_apply(rr, 3, a);
+      }
+        
+      a[1] = _scheme_apply(fcfr, 0, NULL);
 
-      a[0] = scheme_intern_symbol("same");
+      if (paths) {
-      a[1] = scheme_build_path(1, a);
+        a[0] = a[2];
-
+        a[0] = _scheme_apply(pls2pl, 2, a);
-      a[0] = a[2];
+      } else {
-      a[1] = scheme_make_pair(a[1], scheme_null);
+        a[0] = a[1];
-      a[0] = _scheme_apply(pls2pl, 2, a);
+      }
+      
       _scheme_apply(ccfr, 1, a);
     }
   } else {

racket/src/bc/src/startup.inc

@@ -24,6 +24,7 @@ static const char *startup_source =
 "(eval$1 eval-top-level)"
 "(expand$1 expand)"
 "(expander-place-init! expander-place-init!)"
+"(find-compiled-file-roots find-compiled-file-roots)"
 "(1/find-library-collection-links find-library-collection-links)"
 "(1/find-library-collection-paths find-library-collection-paths)"
 "(find-main-config find-main-config)"
@@ -52940,6 +52941,13 @@ static const char *startup_source =
 "(get-installation-name)"
 "(lambda(config-table_0)(begin(hash-ref config-table_0 'installation-name(version)))))"
 "(define-values"
+"(coerce-to-relative-path)"
+"(lambda(p_0)"
+"(begin"
+"(if(string? p_0)"
+"(let-values()(string->path p_0))"
+"(if(bytes? p_0)(let-values()(bytes->path p_0))(let-values() p_0))))))"
+"(define-values"
 "(coerce-to-path)"
 "(lambda(p_0)"
 "(begin"
@@ -53460,6 +53468,14 @@ static const char *startup_source =
 "((extra-collects-dirs_0 post-collects-dirs2_0)"
 "(find-library-collection-paths_0 extra-collects-dirs_0 post-collects-dirs2_0))"
 "((extra-collects-dirs1_0)(find-library-collection-paths_0 extra-collects-dirs1_0 null)))))"
+"(define-values"
+"(find-compiled-file-roots)"
+"(lambda()"
+"(begin"
+"(let-values(((ht_0)(get-config-table(find-main-config))))"
+"(let-values(((paths_0)(hash-ref ht_0 'compiled-file-roots #f)))"
+"(let-values(((or-part_0)(if(list? paths_0)(map2 coerce-to-relative-path paths_0) #f)))"
+"(if or-part_0 or-part_0(list(build-path 'same)))))))))"
 "(define-values(prop:readtable prop:readtable? prop:readtable-ref)(make-struct-type-property 'readtable))"
 "(define-values"
 "(1/current-readtable)"
@@ -65923,6 +65939,8 @@ static const char *startup_source =
 " 1/find-library-collection-paths"
 " 'find-library-collection-links"
 " 1/find-library-collection-links"
+" 'find-compiled-file-roots"
+" find-compiled-file-roots"
 " 'current-library-collection-paths"
 " 1/current-library-collection-paths"
 " 'current-library-collection-links"

racket/src/cs/main.sps

@@ -13,6 +13,7 @@
                find-library-collection-paths
                use-collection-link-paths
                current-compiled-file-roots
+               find-compiled-file-roots
                find-main-config
                executable-yield-handler
                load-on-demand-enabled
@@ -764,12 +765,14 @@
         (find-library-collection-links))
        (current-library-collection-paths
         (find-library-collection-paths collects-pre-extra (reverse rev-collects-post-extra))))
-     (when compiled-roots-path-list-string
+     (let ([roots (find-compiled-file-roots)])
-       (current-compiled-file-roots
+       (if compiled-roots-path-list-string
-        (let ([s (regexp-replace* "@[(]version[)]"
+           (current-compiled-file-roots
-                                  compiled-roots-path-list-string
+            (let ([s (regexp-replace* "@[(]version[)]"
-                                  (version))])
+                                      compiled-roots-path-list-string
-          (path-list-string->path-list s (list (build-path 'same)))))))
+                                      (version))])
+              (path-list-string->path-list s roots)))
+           (current-compiled-file-roots roots))))
 
    ;; Called when Racket is embedded in a larger application:
    (define (register-embedded-entry-info! escape)

racket/src/cs/schemified/expander.scm

@@ -22,6 +22,7 @@
                 (eval$1 eval-top-level)
                 (expand$1 expand)
                 (expander-place-init! expander-place-init!)
+                (find-compiled-file-roots find-compiled-file-roots)
                 (1/find-library-collection-links find-library-collection-links)
                 (1/find-library-collection-paths find-library-collection-paths)
                 (find-main-config find-main-config)
@@ -59295,6 +59296,11 @@
 (define get-installation-name
   (lambda (config-table_0)
     (hash-ref config-table_0 'installation-name (version))))
+(define coerce-to-relative-path
+  (lambda (p_0)
+    (if (string? p_0)
+      (string->path p_0)
+      (if (bytes? p_0) (bytes->path p_0) p_0))))
 (define coerce-to-path
   (lambda (p_0)
     (if (string? p_0)
@@ -59994,6 +60000,15 @@
         post-collects-dirs2_0))
       ((extra-collects-dirs1_0)
        (find-library-collection-paths_0 extra-collects-dirs1_0 null))))))
+(define find-compiled-file-roots
+  (lambda ()
+    (let ((ht_0 (get-config-table (find-main-config))))
+      (let ((paths_0 (hash-ref ht_0 'compiled-file-roots #f)))
+        (let ((or-part_0
+               (if (list? paths_0)
+                 (map_1346 coerce-to-relative-path paths_0)
+                 #f)))
+          (if or-part_0 or-part_0 (list (build-path 'same))))))))
 (define-values
  (prop:readtable prop:readtable? prop:readtable-ref)
  (make-struct-type-property 'readtable))
@@ -73394,6 +73409,8 @@
    1/find-library-collection-paths
    'find-library-collection-links
    1/find-library-collection-links
+   'find-compiled-file-roots
+   find-compiled-file-roots
    'current-library-collection-paths
    1/current-library-collection-paths
    'current-library-collection-links

racket/src/expander/boot/main-primitive.rkt

@@ -40,6 +40,7 @@
           'collection-file-path collection-file-path
           'find-library-collection-paths find-library-collection-paths
           'find-library-collection-links find-library-collection-links
+          'find-compiled-file-roots find-compiled-file-roots
 
           'current-library-collection-paths current-library-collection-paths
           'current-library-collection-links current-library-collection-links

racket/src/expander/eval/collection.rkt

@@ -12,7 +12,8 @@
          collection-file-path
          find-library-collection-paths
          find-library-collection-links
-
+         find-compiled-file-roots
+         
          find-col-file
 
          collection-place-init!)
@@ -70,6 +71,12 @@
             'installation-name 
             (version)))
 
+(define (coerce-to-relative-path p)
+  (cond
+    [(string? p) (string->path p)]
+    [(bytes? p) (bytes->path p)]
+    [else p]))
+
 (define (coerce-to-path p)
   (cond
     [(string? p) (collects-relative-path->complete-path (string->path p))]
@@ -492,3 +499,10 @@
                    (cons (simplify-path (path->complete-path v (current-directory)))
                          (loop (cdr l)))
                    (loop (cdr l)))))))))))
+
+(define (find-compiled-file-roots)
+  (define ht (get-config-table (find-main-config)))
+  (define paths (hash-ref ht 'compiled-file-roots #f))
+  (or (and (list? paths)
+           (map coerce-to-relative-path paths))
+      (list (build-path 'same))))

racket/src/expander/main.rkt

@@ -69,6 +69,7 @@
 
          find-library-collection-paths
          find-library-collection-links
+         find-compiled-file-roots
          find-main-config
 
          current-library-collection-paths

racket/src/version/racket_version.h

@@ -16,7 +16,7 @@
 #define MZSCHEME_VERSION_X 8
 #define MZSCHEME_VERSION_Y 0
 #define MZSCHEME_VERSION_Z 0
-#define MZSCHEME_VERSION_W 8
+#define MZSCHEME_VERSION_W 9
 
 /* A level of indirection makes `#` work as needed: */
 #define AS_a_STR_HELPER(x) #x