wip

src/c/all_symbols.d

@@ -206,7 +206,7 @@ mangle_name(cl_object output, unsigned char *source, int l)
   @(return found output minarg maxarg);
 @)
 
-#ifndef ECL_FINAL
+/* #ifndef ECL_FINAL */
 /* Fletcher's checksum is curbed from Wikipedia[1]. We use it to compute the
    checksum of the symbol table. We account only for symbol names in sequence,
    because we want to allow loading FASL's from different ECL builds (possibly
@@ -229,7 +229,7 @@ update_symbols_checksum(const char *data) {
   }
   cl_core_symbols_checksum = (sum2 << 8) | sum1;
 }
-#endif /* ECL_FINAL */
+/* #endif /\* ECL_FINAL *\/ */
 
 static void
 make_this_symbol(int i, cl_object s, int code,
@@ -309,9 +309,9 @@ make_this_symbol(int i, cl_object s, int code,
   si_set_symbol_plist(s, cl_list(2,
                                  @'call-arguments-limit',
                                  ecl_make_fixnum(narg)));
+#endif
   /* Update the symbols checksum. -- jd 2020-09-15 */
   update_symbols_checksum(name);
-#endif
   cl_num_symbols_in_core = i + 1;
 }
 
@@ -334,7 +334,7 @@ init_all_symbols(void)
     cname = cl_symbols[i].init.translation;
     make_this_symbol(i, s, code, name, cname, fun, narg, value);
   }
-#ifndef ECL_FINAL
+/* #ifndef ECL_FINAL */
   ECL_SET(@'SI::LISP-CORE-CHECKSUM', ecl_make_fixnum(cl_core_symbols_checksum));
-#endif
+/* #endif */
 }

src/c/ffi/libraries.d

@@ -91,6 +91,7 @@ ecl_make_codeblock()
   block->cblock.source = ECL_NIL;
   block->cblock.error = ECL_NIL;
   block->cblock.refs = ecl_make_fixnum(0);
+  block->cblock.checksum = ECL_NIL;
   si_set_finalizer(block, ECL_T);
   return block;
 }

src/c/read.d

@@ -2316,6 +2316,20 @@ make_data_stream(const cl_object *data)
   }
 }
 
+static void
+verify_module_checksum(cl_object block) {
+  cl_object name = block->cblock.name;
+  cl_object checksum = block->cblock.checksum;
+  cl_object core_checksum = ecl_make_fixnum(cl_core_symbols_checksum);
+  printf("XXX checksum %d vs %u\n",
+         ecl_fixnum(block->cblock.checksum),
+         cl_core_symbols_checksum);
+  if (checksum != core_checksum) {
+    FEerror("Module's ~s checksum is invalid ~a (should be ~a).",
+            3, name, checksum, core_checksum);
+  }
+}
+
 cl_object
 ecl_init_module(cl_object block, void (*entry_point)(cl_object))
 {
@@ -2325,9 +2339,11 @@ ecl_init_module(cl_object block, void (*entry_point)(cl_object))
   cl_index i, len, perm_len, temp_len;
   cl_object in;
   cl_object *VV = NULL, *VVtemp = NULL;
-
+  bool checkp = 1;
-  if (block == NULL)
+  if (block == NULL) {
+    checkp = 0;
     block = ecl_make_codeblock();
+  }
   block->cblock.entry = entry_point;
 
   in = OBJNULL;
@@ -2341,7 +2357,14 @@ ecl_init_module(cl_object block, void (*entry_point)(cl_object))
     /* Communicate the library which Cblock we are using, and get
      * back the amount of data to be processed.
      */
+    printf("XXX about to call entry block\n");
     (*entry_point)(block);
+    if(checkp) {
+      printf("XXX about to call verify module checksum\n");
+      verify_module_checksum(block);
+    } else {
+      printf("XXX skipping verify module checksum\n");
+    }
     perm_len = block->cblock.data_size;
     temp_len = block->cblock.temp_data_size;
     len = perm_len + temp_len;

src/cmp/cmpmain.lsp

@@ -252,12 +252,14 @@ void ~A(cl_object cblock)
          * it is invoked with OBJNULL, to force initialization.
          */
         static cl_object Cblock = OBJNULL;
+        cl_object checksum = ecl_make_fixnum(~A);
         if (cblock != OBJNULL) {
                 Cblock = cblock;
 #ifndef ECL_DYNAMIC_VV
                 cblock->cblock.data = NULL;
 #endif
                 cblock->cblock.data_size = 0;
+                cblock->cblock.checksum = checksum;
                 return;
         }
         Cblock->cblock.data_text = (const cl_object *)\"~A\";
@@ -272,6 +274,7 @@ void ~A(cl_object cblock)
         cl_object current = OBJNULL, next = Cblock;
 ~:{
         current = ecl_make_codeblock();
+        current->cblock.checksum = checksum;
         current->cblock.next = next;
         next = current;
         ecl_init_module(current, ~A);
@@ -526,7 +529,8 @@ output = si_safe_eval(2, ecl_read_from_cstring(lisp_code), ECL_NIL);
     (let ((init-tag (init-name-tag init-name :kind target)))
       (ecase target
         (:program
-         (format c-file +lisp-program-init+ init-name init-tag "" submodules "")
+         (format c-file +lisp-program-init+
+                 init-name (si::lisp-core-checksum) init-tag "" submodules "")
          ;; we don't need wrapper in the program, we have main for that
          ;(format c-file +lisp-init-wrapper+ wrap-name init-name)
          (format c-file
@@ -540,7 +544,8 @@ output = si_safe_eval(2, ecl_read_from_cstring(lisp_code), ECL_NIL);
          (linker-cc output-name (list* (namestring o-name) ld-flags)))
         (:static-library
          (format c-file +lisp-program-init+
-                 init-name init-tag prologue-code submodules epilogue-code)
+                 init-name (si::lisp-core-checksum) init-tag
+                 prologue-code submodules epilogue-code)
          (when wrap-name
            (format c-file +lisp-init-wrapper+ wrap-name init-name))
          (format c-file +lisp-library-main+
@@ -552,7 +557,8 @@ output = si_safe_eval(2, ecl_read_from_cstring(lisp_code), ECL_NIL);
         #+dlopen
         (:shared-library
          (format c-file +lisp-program-init+
-                 init-name init-tag prologue-code submodules epilogue-code)
+                 init-name (si::lisp-core-checksum) init-tag
+                 prologue-code submodules epilogue-code)
          (when wrap-name
            (format c-file +lisp-init-wrapper+ wrap-name init-name))
          (format c-file +lisp-library-main+
@@ -562,8 +568,9 @@ output = si_safe_eval(2, ecl_read_from_cstring(lisp_code), ECL_NIL);
          (shared-cc output-name (list* o-name ld-flags)))
         #+dlopen
         (:fasl
-         (format c-file +lisp-program-init+ init-name init-tag prologue-code
+         (format c-file +lisp-program-init+
-                 submodules epilogue-code)
+                 init-name (si::lisp-core-checksum) init-tag
+                 prologue-code submodules epilogue-code)
          ;; we don't need wrapper in the fasl, we scan for init function name
          ;(format c-file +lisp-init-wrapper+ wrap-name init-name)
          (close c-file)

src/h/external.h

@@ -320,6 +320,7 @@ typedef union {
 } cl_symbol_initializer;
 extern ECL_API cl_symbol_initializer cl_symbols[];
 extern ECL_API cl_index cl_num_symbols_in_core;
+extern ECL_API uint16_t cl_core_symbols_checksum;
 
 #define ECL_SYM(name,code) ((cl_object)(cl_symbols+(code)))
 

src/h/object.h

@@ -740,6 +740,7 @@ struct ecl_codeblock {
         const struct ecl_cfunfixed *cfuns;
         cl_object source;               /*  common debug information for this block  */
         cl_object refs;                 /*  reference counter for the library  */
+        cl_object checksum;             /*  the symbol table checksum */
         cl_object error;                /*  error message when loading */
 };