[Git][cmucl/cmucl][native-image] 4 commits: Make all labels global and assign a section name.

Raymond Toy gitlab at common-lisp.net
Sun Feb 14 20:39:41 UTC 2021



Raymond Toy pushed to branch native-image at cmucl / cmucl


Commits:
62f09401 by Raymond Toy at 2021-02-14T10:07:00-08:00
Make all labels global and assign a section name.

Every label is now a global symbol.

Prepend each output file with a .section to name the section we're
creating.

- - - - -
916ccc3a by Raymond Toy at 2021-02-14T11:47:16-08:00
Emit addresses of assembler routines to internals.h

Create an array that contains the addresses of all the lisp assembler
routines so that when writing out the assembly code, we can create
symbols for the lisp assembler routines.

- - - - -
c6791370 by Raymond Toy at 2021-02-14T11:59:02-08:00
Dump the lisp assembly routines.

For now, we just write out .equ pseudo op for the address of each lisp
assembler routine so that the linker doesn't have any unresolved
values.

This is a workaround for now.  Ideally, these would be real
relocatable symbols at the right address in the read-only space so
that everything can be relocated.

- - - - -
9f3243f4 by Raymond Toy at 2021-02-14T12:39:18-08:00
Print out the initial function addr for reference.

- - - - -


2 changed files:

- src/compiler/generic/new-genesis.lisp
- src/lisp/save.c


Changes:

=====================================
src/compiler/generic/new-genesis.lisp
=====================================
@@ -2448,7 +2448,7 @@
   (and (>= (length string) (length head))
        (string= string head :end1 (length head))))
 
-(defun emit-c-header-aux ()
+(defun emit-c-header-aux (assembler-routines)
   (format t "/*~% * Machine generated header file.  Do not edit.~% */~2%")
   (format t "#ifndef _INTERNALS_H_~%#define _INTERNALS_H_~2%")
   ;; Write out various constants
@@ -2602,6 +2602,17 @@
 			   (remove-if #'(lambda (char)
 					  (member char '(#\% #\* #\.)))
 				      (symbol-name feature))))))
+
+  (format t "~2%#if defined(DEFINE_ASM)~%")
+  (format t "/* Assembly routines */~%")
+  (format t "unsigned long lisp_asm_routines[] = {~%")
+  (dolist (routine (sort (copy-list *cold-assembler-routines*)
+			 #'< :key #'cdr))
+    (format t "  0x~8,'0x, /* ~S */~%"
+	    (cdr routine) (car routine)))
+  (format t "  0x~8,'0x, /* End marker */~%" 0)
+  (format t "};~%")
+  (format t "#endif~%")
   ;;
   (format t "~%#endif~%"))
 
@@ -2622,14 +2633,14 @@
 		      (string/= line1 line2))
 	      (return t)))))))
 
-(defun emit-c-header (name)
+(defun emit-c-header (name assembler-routines)
   (let* ((new-name (concatenate 'string (namestring name) ".NEW"))
 	 (unix-newname (unix-namestring new-name nil)))
     (with-open-file
 	(*standard-output* new-name
 			   :direction :output
 			   :if-exists :supersede)
-      (emit-c-header-aux))
+      (emit-c-header-aux assembler-routines))
     (cond ((not (probe-file name))
 	   (unix:unix-chmod unix-newname #o444)
 	   (rename-file new-name name)
@@ -2755,13 +2766,15 @@
 				     :if-exists :supersede)
 		(write-map-file)))
 	    (when header-name
+	      (format t "cold-assembler ~S~%" *cold-assembler-routines*)
 	      (emit-c-header
 	       (merge-pathnames (if (eq header-name t)
 				    "internals.h"
 				    (merge-pathnames
 				     header-name
 				     (make-pathname :type "h")))
-				core-name))
+				core-name)
+	       *cold-assembler-routines*)
 	      (emit-makefile-header
 	       (merge-pathnames (if (eq header-name t)
 				    "internals.inc"


=====================================
src/lisp/save.c
=====================================
@@ -13,6 +13,8 @@
 #include <limits.h>
 #include <math.h>
 
+/* Get the lisp assembly routines because we need them */
+#define DEFINE_ASM
 #include "lisp.h"
 #include "os.h"
 #include "internals.h"
@@ -394,6 +396,8 @@ save_executable(char *filename, lispobj init_function)
     fflush(stdout);
     
     printf("Linking executable...\n");
+    printf("  init_function 0x%08lx\n", init_function);
+    
     fflush(stdout);
     rc = obj_run_linker(init_function, filename);
     printf("done.\n");
@@ -415,7 +419,8 @@ static char* asmtab_types[256];
 void
 asm_label(lispobj* ptr, lispobj object, FILE* f) 
 {
-    fprintf(f, "L%lx:\n", (unsigned long) ptr);
+    fprintf(f, "\t.global\tL%08lx\n", (unsigned long) ptr);
+    fprintf(f, "L%08lx:\n", (unsigned long) ptr);
 }
 
 void
@@ -1356,6 +1361,7 @@ write_asm_object(const char *dir, int id, os_vm_address_t start, os_vm_address_t
 {
     char asm_file[PATH_MAX];
     FILE* f;
+    int k;
     
     printf("write_asm_object space %d start %p end %p\n",
            id, start, end);
@@ -1365,14 +1371,25 @@ write_asm_object(const char *dir, int id, os_vm_address_t start, os_vm_address_t
 
     lispobj* ptr = (lispobj*) start;
     lispobj* end_ptr = (lispobj*) end;
+
+    /* Set the section name */
+    fprintf(f, "\t.section\t\"space%d\", \"wx\"\n", id);
     
+    /* Print the assembly routines */
+    k = 0;
+    while (lisp_asm_routines[k] != 0) {
+        fprintf(f, "\t.set\tL%08lx, 0x%08lx\n",
+                lisp_asm_routines[k],
+                lisp_asm_routines[k]);
+        ++k;
+    }
+
     /*
      * If the id is the static space, we need special handling for
      * beginning which has NIL in a funny way to make NIL a symbol and
      * list.
      */
     if (id == STATIC_SPACE_ID) {
-        int k;
         
         /* Output the first word */
         asm_header_word(ptr, *ptr, f, NULL);



View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/6072cf3f9f6d5431f241530cf3ec5514a9a83f9e...9f3243f4f682765a2c47c11c547ed0f4565cc81e

-- 
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/6072cf3f9f6d5431f241530cf3ec5514a9a83f9e...9f3243f4f682765a2c47c11c547ed0f4565cc81e
You're receiving this email because of your account on gitlab.common-lisp.net.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20210214/6f8c58e8/attachment-0001.html>


More information about the cmucl-cvs mailing list