chicken-motorhome added by mario-goulart on Sun Jan 21 15:07:25 2024

diff --git a/chicken-install.scm b/chicken-install.scm
index 36482755..850d4b5a 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -287,14 +287,23 @@
 
 
 ;; load defaults file ("setup.defaults")
-
-(define (load-defaults)
+(define (locate-defaults-file)
   (let* ((cfg-dir (system-config-directory))
          (user-file (and cfg-dir (make-pathname (list cfg-dir "chicken")
-                                                +defaults-file+)))
-         (deff (or user-defaults
-                   (and user-file (file-exists? user-file))
-                   (make-pathname host-sharedir +defaults-file+))))
+                                                +defaults-file+))))
+    (if (and user-file (file-exists? user-file))
+        user-file
+        (let loop ((search-dirs (chicken-home #t)))
+          (if (null? search-dirs)
+              (error 'locate-defaults-file "Defaults file not found")
+              (let ((cur-file (make-pathname (car search-dirs) +defaults-file+)))
+                (if (file-exists? cur-file)
+                    cur-file
+                    (loop (cdr search-dirs)))))))))
+
+(define (load-defaults)
+  (let* ((deff (locate-defaults-file)))
+    (d "using ~a as defaults file" deff)
     (define (broken x)
       (error "invalid entry in defaults file" deff x))
     (cond ((not (file-exists? deff)) '())
diff --git a/egg-compile.scm b/egg-compile.scm
index dd7c429e..f47d419a 100644
--- a/egg-compile.scm
+++ b/egg-compile.scm
@@ -300,7 +300,8 @@
             (let* ((dest (or (and dest (normalize-destination dest mode))
                              (if (eq? mode 'target)
                                  default-sharedir
-                                 (override-prefix "/share" host-sharedir))))
+                                 ;; FIXME: share/chicken must match the suffix of C_TARGET_SHARE_HOME
+                                 (override-prefix "/share/chicken" host-sharedir))))
                    (dest (normalize-pathname (conc dest "/"))))
               (addfiles (map (cut conc dest <>) files)))
             (set! data
@@ -1054,7 +1055,8 @@
   (install-random-files (or destination
                             (if (eq? mode 'target)
                                 default-sharedir
-                                (override-prefix "/share"
+                                ;; FIXME: share/chicken must match the suffix of C_TARGET_SHARE_HOME
+                                (override-prefix "/share/chicken"
                                                  host-sharedir)))
                         files mode srcdir platform))
 
diff --git a/eval.scm b/eval.scm
index e760aad0..c75dd7c1 100644
--- a/eval.scm
+++ b/eval.scm
@@ -1283,7 +1283,7 @@
 
 ;;; Find included file:
 
-(define ##sys#include-pathnames (list (chicken-home)))
+(define ##sys#include-pathnames (chicken-home #t))
 
 (define ##sys#resolve-include-filename
   (let ((string-append string-append) )
diff --git a/library.scm b/library.scm
index 3ec87a74..3e54969b 100644
--- a/library.scm
+++ b/library.scm
@@ -6628,7 +6628,18 @@ static C_word C_fcall C_setenv(C_word x, C_word y) {
 (define-foreign-variable installation-home c-string "C_INSTALL_SHARE_HOME")
 (define-foreign-variable install-egg-home c-string "C_INSTALL_EGG_HOME")
 
-(define (chicken-home) installation-home)
+(define (chicken-home #!optional all?)
+  (let* ((prefix (get-environment-variable "CHICKEN_INSTALL_PREFIX"))
+         (homes
+          (if prefix
+              ;; FIXME: share/chicken must match the suffix of C_TARGET_SHARE_HOME
+              (list (string-append prefix "/share/chicken")
+                    installation-home)
+              (list installation-home))))
+    ;; The car of homes has higher precedence than its cdr.
+    (if all?
+        homes
+        (car homes))))
 
 (define path-list-separator
   (if ##sys#windows-platform #\; #\:))
diff --git a/types.db b/types.db
index ad4f547f..0fde7328 100644
--- a/types.db
+++ b/types.db
@@ -1356,7 +1356,7 @@
 
 (chicken.platform#build-platform (#(procedure #:pure) chicken.platform#build-platform () symbol))
 (chicken.platform#chicken-version (#(procedure #:pure) chicken.platform#chicken-version (#!optional *) string))
-(chicken.platform#chicken-home (#(procedure #:clean) chicken.platform#chicken-home () string))
+(chicken.platform#chicken-home (#(procedure #:clean) chicken.platform#chicken-home (#!optional *) (or string list)))
 (chicken.platform#feature? (#(procedure #:clean) chicken.platform#feature? (#!rest (or keyword symbol string)) boolean))
 (chicken.platform#features (#(procedure #:clean) chicken.platform#features () (list-of keyword)))
 (chicken.platform#software-type (#(procedure #:pure) chicken.platform#software-type () symbol))