GitLab

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.

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.

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.

Print out the initial function addr for reference.

   (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

 			   (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~%"))

 		      (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)

 				     :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"

 #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"

     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");

 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

 {

     char asm_file[PATH_MAX];

     FILE* f;

+    int k;

     printf("write_asm_object space %d start %p end %p\n",

            id, start, end);

     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);

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

Commits:

2 changed files:

Changes: