[PATCH] Skip invalid compiled file found, continue searching path.

[Jan Nieuwenhuizen]

Hi,

As per chat with Ludovic on #guile (thanks!) find attached another
approach to allow switching incrementally from guile-2.0 to guile-2.2:
any invalid compiled files are skipped and we continue searching the
GUILE_LOAD_COMPILED_PATH instead of throwing early.

Greetings,
Jan

>From f4f53b48c1d5ff42ecc66279c3b1cfcfb09d6757 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <address@hidden>
Date: Fri, 11 Mar 2016 14:58:09 +0100
Subject: [PATCH] Skip invalid compiled file found, continue searching path.

* libguile/vm.c (load_compiled_with_vm_catch_handler,
  do_try_scm_call_0): New static function.
  (scm_load_compiled_with_vm): Use them to implement not throwing
  if new argument EXCEPTION_ON_NOT_FOUND_P is not SCM_BOOL_TRUE.
* libguile/load.c (search_path): Take optional output argument
  PATH_REMAINING.
  (scm_primitive_load_path): Use it.  Take optional argument
  LOAD_COMPILED_PATH.  Skip any invalid compiled file found and
  continue searching scm_loc_load_compiled_path.
---
 libguile/load.c | 55 ++++++++++++++++++++++++++++++++++++++++---------------
 libguile/vm.c   | 27 ++++++++++++++++++++++++---
 libguile/vm.h   |  2 +-
 3 files changed, 65 insertions(+), 19 deletions(-)

diff --git a/libguile/load.c b/libguile/load.c
index d26f9fc..a6b87cf 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -582,12 +582,16 @@ compiled_is_fresh (SCM full_filename, SCM 
compiled_filename,
    file name that we find in the path.  Otherwise only return a file if
    it is newer than SOURCE_STAT_BUF, otherwise issuing a warning if we
    see a stale file earlier in the path, setting *FOUND_STALE_FILE to 1.
+
+   If PATH_REMAINING is not NULL, it is set to the part of PATH that was
+   not yet searched.
   */
 static SCM
 search_path (SCM path, SCM filename, SCM extensions, SCM require_exts,
              struct stat *stat_buf,
              SCM source_file_name, struct stat *source_stat_buf,
-             int *found_stale_file)
+             int *found_stale_file,
+             SCM *path_remaining)
 {
   struct stringbuf buf;
   char *filename_chars;
@@ -724,6 +728,8 @@ search_path (SCM path, SCM filename, SCM extensions, SCM 
require_exts,
 
  end:
   scm_dynwind_end ();
+  if (path_remaining)
+    path_remaining = &path;
   return result;
 }
 
@@ -781,7 +787,7 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 0, 1,
     require_exts = SCM_BOOL_F;
 
   return search_path (path, filename, extensions, require_exts, &stat_buf,
-                      SCM_BOOL_F, NULL, NULL);
+                      SCM_BOOL_F, NULL, NULL, NULL);
 }
 #undef FUNC_NAME
 
@@ -806,7 +812,7 @@ SCM_DEFINE (scm_sys_search_load_path, "%search-load-path", 
1, 0, 0,
   SCM_VALIDATE_STRING (1, filename);
 
   return search_path (*scm_loc_load_path, filename, *scm_loc_load_extensions,
-                      SCM_BOOL_F, &stat_buf, SCM_BOOL_F, NULL, NULL);
+                      SCM_BOOL_F, &stat_buf, SCM_BOOL_F, NULL, NULL, NULL);
 }
 #undef FUNC_NAME
 
@@ -969,14 +975,19 @@ SCM_DEFINE (scm_primitive_load_path, 
"primitive-load-path", 0, 0, 1,
             "depending on the optional second argument,\n"
             "@var{exception_on_not_found}.  If it is @code{#f}, @code{#f}\n"
             "will be returned.  If it is a procedure, it will be called\n"
-            "with no arguments.  Otherwise an error is signalled.")
+            "with no arguments.  Otherwise an error is signalled."
+            "If the optional third argument,\n"
+            "@var{load_compiled_path} is given, use it to search for compiled 
files\n"
+            "instead of @var{*scm_loc_load_compiled_path}.")
 #define FUNC_NAME s_scm_primitive_load_path
 {
   SCM filename, exception_on_not_found;
   SCM full_filename, compiled_filename;
   SCM hook = *scm_loc_load_hook;
   struct stat stat_source, stat_compiled;
+  SCM load_compiled_path;
   int found_stale_compiled_file = 0;
+  SCM load_compiled_path_remaining = SCM_EOL;
 
   if (scm_is_true (hook) && scm_is_false (scm_procedure_p (hook)))
     SCM_MISC_ERROR ("value of %load-hook is neither a procedure nor #f",
@@ -988,21 +999,27 @@ SCM_DEFINE (scm_primitive_load_path, 
"primitive-load-path", 0, 0, 1,
         single argument (the file name).  */
       filename = args;
       exception_on_not_found = SCM_UNDEFINED;
+      load_compiled_path = *scm_loc_load_compiled_path;
     }
   else
     {
-      /* Starting from 1.9, this function takes 1 required and 1 optional
-        argument.  */
+      /* Starting from 1.9, this function takes 1 required and 1
+        optional argument.
+
+         Starting from 2.1.2, this function takes 1 required and 2
+        optional arguments.  */
       long len;
 
       SCM_VALIDATE_LIST_COPYLEN (SCM_ARG1, args, len);
-      if (len < 1 || len > 2)
+      if (len < 1 || len > 3)
        scm_error_num_args_subr (FUNC_NAME);
 
       filename = SCM_CAR (args);
       SCM_VALIDATE_STRING (SCM_ARG1, filename);
 
       exception_on_not_found = len > 1 ? SCM_CADR (args) : SCM_UNDEFINED;
+      load_compiled_path = len < 3 ? *scm_loc_load_compiled_path
+        : SCM_CADDR (args);
     }
 
   if (SCM_UNBNDP (exception_on_not_found))
@@ -1010,13 +1027,13 @@ SCM_DEFINE (scm_primitive_load_path, 
"primitive-load-path", 0, 0, 1,
 
   full_filename = search_path (*scm_loc_load_path, filename,
                                *scm_loc_load_extensions, SCM_BOOL_F,
-                               &stat_source, SCM_BOOL_F, NULL, NULL);
+                               &stat_source, SCM_BOOL_F, NULL, NULL, NULL);
 
   compiled_filename =
-    search_path (*scm_loc_load_compiled_path, filename,
+    search_path (load_compiled_path, filename,
                  *scm_loc_load_compiled_extensions, SCM_BOOL_T,
                  &stat_compiled, full_filename, &stat_source,
-                 &found_stale_compiled_file);
+                 &found_stale_compiled_file, &load_compiled_path_remaining);
 
   if (scm_is_false (compiled_filename)
       && scm_is_true (full_filename)
@@ -1066,13 +1083,21 @@ SCM_DEFINE (scm_primitive_load_path, 
"primitive-load-path", 0, 0, 1,
                        ? full_filename : compiled_filename));
 
   if (scm_is_true (compiled_filename))
-    return scm_load_compiled_with_vm (compiled_filename);
+    {
+      SCM module = scm_load_compiled_with_vm (compiled_filename, SCM_BOOL_T);
+      if (module != SCM_BOOL_F || exception_on_not_found != SCM_BOOL_T)
+        return module;
+      return scm_primitive_load_path (scm_list_3
+                                      (filename,
+                                       exception_on_not_found,
+                                       load_compiled_path_remaining));
+    }
   else
     {
       SCM freshly_compiled = scm_try_auto_compile (full_filename);
 
       if (scm_is_true (freshly_compiled))
-        return scm_load_compiled_with_vm (freshly_compiled);
+        return scm_load_compiled_with_vm (freshly_compiled, SCM_BOOL_T);
       else
         return scm_primitive_load (full_filename);
     }
@@ -1095,14 +1120,14 @@ scm_init_eval_in_scheme (void)
   eval_scm = search_path (*scm_loc_load_path,
                           scm_from_locale_string ("ice-9/eval.scm"),
                           SCM_EOL, SCM_BOOL_F, &stat_source,
-                          SCM_BOOL_F, NULL, NULL);
+                          SCM_BOOL_F, NULL, NULL, NULL);
   eval_go = search_path (*scm_loc_load_compiled_path,
                          scm_from_locale_string ("ice-9/eval.go"),
                          SCM_EOL, SCM_BOOL_F, &stat_compiled,
-                         eval_scm, &stat_source, &found_stale_eval_go);
+                         eval_scm, &stat_source, &found_stale_eval_go, NULL);
   
   if (scm_is_true (eval_go))
-    scm_load_compiled_with_vm (eval_go);
+    scm_load_compiled_with_vm (eval_go, SCM_BOOL_T);
   else
     /* If we have no eval.go, we shouldn't load any compiled code at all
        because we can't guarantee that tail calls will work.  */
diff --git a/libguile/vm.c b/libguile/vm.c
index 33f12b4..b560ee5 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -1500,10 +1500,31 @@ SCM_DEFINE (scm_call_with_stack_overflow_handler,
  * Initialize
  */
 
-SCM
-scm_load_compiled_with_vm (SCM file)
+static SCM
+load_compiled_with_vm_catch_handler (void *data, SCM tag, SCM throw_args)
+{
+  return SCM_BOOL_F;
+}
+
+static SCM
+do_try_scm_call_0 (void *data)
 {
-  return scm_call_0 (scm_load_thunk_from_file (file));
+  SCM thunk = SCM_PACK_POINTER (data);
+  return scm_call_0 (thunk);
+}
+
+SCM
+scm_load_compiled_with_vm (SCM file, SCM exception_on_not_found_p)
+{
+  SCM thunk = scm_load_thunk_from_file (file);
+  if (exception_on_not_found_p == SCM_BOOL_F)
+    return scm_c_catch (SCM_BOOL_T,
+                        do_try_scm_call_0,
+                        SCM_UNPACK_POINTER (thunk),
+                        load_compiled_with_vm_catch_handler,
+                        SCM_UNPACK_POINTER (thunk),
+                        NULL, NULL);
+  return scm_call_0 (thunk);
 }
 
   
diff --git a/libguile/vm.h b/libguile/vm.h
index 2ca4f2a..d76ac31 100644
--- a/libguile/vm.h
+++ b/libguile/vm.h
@@ -93,7 +93,7 @@ struct scm_vm_cont {
 #define SCM_VM_CONT_PARTIAL_P(CONT) (SCM_VM_CONT_DATA (CONT)->flags & 
SCM_F_VM_CONT_PARTIAL)
 #define SCM_VM_CONT_REWINDABLE_P(CONT) (SCM_VM_CONT_DATA (CONT)->flags & 
SCM_F_VM_CONT_REWINDABLE)
 
-SCM_API SCM scm_load_compiled_with_vm (SCM file);
+SCM_API SCM scm_load_compiled_with_vm (SCM file, SCM exception_on_not_found_p);
 
 SCM_INTERNAL SCM scm_i_call_with_current_continuation (SCM proc);
 SCM_INTERNAL SCM scm_i_capture_current_stack (void);
-- 
2.6.3

-- 
Jan Nieuwenhuizen <address@hidden> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar®  http://AvatarAcademy.nl