Changeset 14618 for branches


Ignore:
Timestamp:
Jan 31, 2011, 10:37:18 PM (9 years ago)
Author:
rme
Message:

merge changes from trunk

Location:
branches/shrink-tcr
Files:
15 edited

Legend:

Unmodified
Added
Removed
  • branches/shrink-tcr

  • branches/shrink-tcr/cocoa-ide/cocoa-application.lisp

    r13572 r14618  
    3232    (declare (ignore os))
    3333    (format nil "Clozure CL-~a~a" (string-downcase cpu) bits)))
    34 (defvar *cocoa-application-frameworks* #+cocotron '("ccl:cocotron;Foundation.framework;" "ccl:cocotron;AppKit.framework;") #-cocotron nil)
    35 (defvar *cocoa-application-libraries* #+cocotron '("ccl:cocotron;Foundation>.1>.0.dll" "ccl:cocotron;AppKit>.1>.0.dll") #-cocotron nil)
     34(defvar *cocoa-application-frameworks* #+cocotron '("ccl:cocotron;Foundation.framework;" "ccl:cocotron;AppKit.framework;" "ccl:cocotron;CoreData.framework;") #-cocotron nil)
     35(defvar *cocoa-application-libraries* #+cocotron '("ccl:cocotron;Foundation>.1>.0.dll" "ccl:cocotron;AppKit>.1>.0.dll" "ccl:cocotron;CoreData>.1>.0.dll") #-cocotron nil)
    3636       
    3737(defvar *cocoa-ide-force-compile* nil)
  • branches/shrink-tcr/cocoa-ide/cocoa.lisp

    r13572 r14618  
    1616    (format nil "temp bundle-~a~a" (string-downcase cpu) bits)))
    1717(defvar *cocoa-ide-force-compile* nil)
    18 (defvar *cocoa-application-frameworks* #+cocotron '("ccl:cocotron;Foundation.framework;" "ccl:cocotron;AppKit.framework;") #-cocotron nil)
    19 (defvar *cocoa-application-libraries* #+cocotron '("ccl:cocotron;Foundation>.1>.0.dll" "ccl:cocotron;AppKit>.1>.0.dll") #-cocotron nil)
     18(defvar *cocoa-application-frameworks* #+cocotron '("ccl:cocotron;Foundation.framework;" "ccl:cocotron;AppKit.framework;" "ccl:cocotron;CoreData.framework;") #-cocotron nil)
     19(defvar *cocoa-application-libraries* #+cocotron '("ccl:cocotron;Foundation>.1>.0.dll" "ccl:cocotron;AppKit>.1>.0.dll" "ccl:cocotron;CoreData>.1>.0.dll") #-cocotron nil)
    2020
    2121(load "ccl:cocoa-ide;defsystem.lisp")
  • branches/shrink-tcr/lib/dumplisp.lisp

    r13225 r14618  
    7575                         (mode #o644)
    7676                         prepend-kernel
    77                          #+windows-target (application-type :console))
     77                         #+windows-target (application-type :console)
     78                         native)
    7879  (declare (ignore toplevel-function error-handler application-class
    7980                   clear-clos-caches init-file impurify))
     
    8990      (cerror "Un-watch them." "There are watched objects.")
    9091      (mapc #'unwatch watched)))
     92  (when (and native prepend-kernel)
     93    (error "~S and ~S can't both be specified (yet)." :native :prepend-kernel))
    9194  (let* ((ip *initial-process*)
    9295         (cp *current-process*))
     
    97100                                     #+windows-target  #+windows-target
    98101                                     :application-type application-type)))
     102        (when native
     103          #+(or darwinx8632-target darwin-x8664-target) (setq fd (- fd))
     104          #-(or darwinx8632-target darwin-x8664-target)
     105          (progn
     106            (warn "native image support not available, ignoring ~s option." :native)))
     107           
    99108        (process-interrupt ip
    100109                           #'(lambda ()
     
    119128                                      (clear-clos-caches t)
    120129                                      prepend-kernel
    121                                       #+windows-target application-type)
    122   (declare (ignore mode prepend-kernel #+windows-target application-type))
     130                                      #+windows-target application-type
     131                                      native)
     132  (declare (ignore mode prepend-kernel #+windows-target application-type native))
    123133  (when (and application-class (neq  (class-of *application*)
    124134                                     (if (symbolp application-class)
  • branches/shrink-tcr/library/chud-metering.lisp

    r13174 r14618  
    1818;;; (and possibly others.)
    1919
    20 ;;; CHUD 4.4.3-5 claims to offer 64-bit support; however, the library
    21 ;;; which provides the API to control CHUD metering functions still
    22 ;;; seems to be 32-bit only.  Conditionalization for x86-64 and
    23 ;;; for 64-bit targets is (so far) just an exercise.
    24 
    2520(defpackage "CHUD"
    2621  (:use "CL" "CCL")
     
    3732(defparameter *shark-session-path* nil)
    3833
    39 (defloadvar *written-spatch-file* nil)
    4034
    4135(defparameter *shark-session-native-namestring* nil)
     
    6660             (native-name (ccl::native-untranslated-namestring dir)))
    6761        (ensure-directories-exist dir)
    68         (setenv "SHARK_SEARCH_PATH_PATCH_FILES" native-name)
    6962        (setq *shark-session-native-namestring*
    7063              native-name
     
    8174
    8275
    83 (defun safe-shark-function-name (function)
    84   (let* ((name (format nil "~s" function)))
    85     (subseq (nsubstitute #\0 #\# (nsubstitute #\. #\Space name)) 1)))
    8676
    87 (defun print-shark-spatch-record (fn &optional (stream t))
    88   (let* ((code-vector #+ppc-target (uvref fn 0) #-ppc-target fn)
    89          (startaddr (+ (ccl::%address-of code-vector)
    90                        #+x8664-target 0
    91                        #+ppc32-target target::misc-data-offset
    92                        #-ppc32-target 0))
    93          (endaddr (+ startaddr
    94                      #+x8664-target
    95                      (1+ (ash (1- (ccl::%function-code-words fn)
    96                                   ) target::word-shift))
    97                      #+ppc-target
    98                      (* 4 (- (uvsize code-vector)
    99                                        #+ppc64-target 2
    100                                        #-ppc64-target 1)))))
    101     ;; i hope all lisp sym characters are allowed... we'll see
    102     (format stream "{~%~@
    103                         ~a~@
    104                         ~@?~@
    105                         ~@?~@
    106                         }~%"
    107             (safe-shark-function-name fn)
    108             #+32-bit-target "0x~8,'0x" #+64-bit-target "0x~16,'0x"
    109             startaddr
    110             #+32-bit-target "0x~8,'0x" #+64-bit-target "0x~16,'0x"
    111             endaddr)))
    112 
    113 #+x8664-target
    114 (ccl::defx86lapfunction dynamic-dnode ((x arg_z))
    115   (movq (% x) (% imm0))
    116   (ref-global x86::heap-start arg_y)
    117   (subq (% arg_y) (% imm0))
    118   (shrq ($ x8664::dnode-shift) (% imm0))
    119   (box-fixnum imm0 arg_z)
    120   (single-value-return))
    121 
    122 #+x8632-target
    123 (ccl::defx8632lapfunction dynamic-dnode ((x arg_z))
    124   (movl (% x) (% imm0))
    125   (ref-global x86::heap-start arg_y)
    126   (subl (% arg_y) (% imm0))
    127   (shrl ($ x8632::dnode-shift) (% imm0))
    128   (box-fixnum imm0 arg_z)
    129   (single-value-return))
    130 
    131 #+x8664-target
    132 (defun identify-functions-with-pure-code ()
    133   (ccl::freeze)
    134   (ccl::collect ((functions))
    135     (block walk
    136       (let* ((frozen-dnodes (ccl::frozen-space-dnodes)))
    137         (ccl::%map-areas (lambda (o)
    138                            (when (>= (dynamic-dnode o) frozen-dnodes)
    139                              (return-from walk nil))
    140                            (when (typep o 'ccl::function-vector)
    141                              (functions (ccl::function-vector-to-function o))))
    142                          ccl::area-dynamic
    143                          )))
    144     (functions)))
    145 
    146 #+x8632-target
    147 (defun identify-functions-with-pure-code ()
    148   (ccl::freeze)
    149   (ccl::collect ((functions))
    150     (block walk
    151       (let* ((frozen-dnodes (ccl::frozen-space-dnodes)))
    152         (ccl::%map-areas (lambda (o)
    153                            (when (>= (dynamic-dnode o) frozen-dnodes)
    154                              (return-from walk nil))
    155                            (when (typep o 'function)
    156                              (functions o)))
    157                          ccl::area-dynamic
    158                          )))
    159     (functions)))
    160 
    161 #+ppc-target
    162 (defun identify-functions-with-pure-code ()
    163   (ccl::purify)
    164   (multiple-value-bind (pure-low pure-high)
    165                                  
    166       (ccl::do-gc-areas (a)
    167         (when (eql(ccl::%fixnum-ref a target::area.code)
    168                   ccl::area-readonly)
    169           (return
    170             (values (ash (ccl::%fixnum-ref a target::area.low) target::fixnumshift)
    171                     (ash (ccl::%fixnum-ref a target::area.active) target::fixnumshift)))))
    172     (let* ((hash (make-hash-table :test #'eq)))
    173       (ccl::%map-lfuns #'(lambda (f)
    174                            (let* ((code-vector  (ccl:uvref f 0))
    175                                   (startaddr (+ (ccl::%address-of code-vector)
    176                                                 target::misc-data-offset)))
    177                              (when (and (>= startaddr pure-low)
    178                                         (< startaddr pure-high))
    179                                (push f (gethash code-vector hash))))))
    180       (let* ((n 0))
    181         (declare (fixnum n))
    182         (maphash #'(lambda (k v)
    183                      (declare (ignore k))
    184                      (if (null (cdr v))
    185                        (incf n)))
    186                  hash)
    187         (let* ((functions ()))
    188           (maphash #'(lambda (k v)
    189                        (declare (ignore k))
    190                        (when (null (cdr v))
    191                          (push (car v) functions)))
    192                    hash)
    193           (sort functions
    194                 #'(lambda (x y)
    195                     (< (ccl::%address-of (uvref x 0) )
    196                        (ccl::%address-of  (uvref y 0))))))))))
    197        
    198                            
    199 
    200 
    201 (defun generate-shark-spatch-file ()
    202   (let* ((functions (identify-functions-with-pure-code)))
    203     (with-open-file (f (make-pathname
    204                         :host nil
    205                         :directory (pathname-directory
    206                                     (ensure-shark-session-path))
    207                         :name (format nil "~a_~D"
    208                                       (pathname-name
    209                                        (car
    210                                         ccl::*command-line-argument-list*))
    211                                       (ccl::getpid))
    212                         :type "spatch")
    213                        :direction :output
    214                        :if-exists :supersede)
    215       (format f "!SHARK_SPATCH_BEGIN~%")
    216       (dolist (fun functions)
    217         (print-shark-spatch-record fun f))
    218       (format f "!SHARK_SPATCH_END~%"))))
    21977
    22078(defun terminate-shark-process ()
     
    22785  (if *shark-process*
    22886    (progn
    229       (signal-external-process *shark-process* #$SIGUSR1)
     87      (signal-external-process *shark-process* (if *sampling* #$SIGUSR2 #$SIGUSR1))
    23088      (setq *sampling* (not *sampling*)))
    23189    (warn "No active shark procsss")))
     
    24098  (when (or (null *shark-process*) reset)
    24199    (terminate-shark-process)
    242     (when (or reset (not *written-spatch-file*))
    243       (generate-shark-spatch-file))
    244     (let* ((args (list "-b" "-1" "-a" (format nil "~d" (ccl::getpid))
    245                              "-d" *shark-session-native-namestring*)))
     100    (let* ((args (list "-r" "-b" "-1" "-a" (format nil "~d" (ccl::getpid))
     101                       "-d" *shark-session-native-namestring*)))
    246102      (when *shark-config-file*
    247103        (push (ccl::native-untranslated-namestring *shark-config-file*)
     
    293149                       *sampling* nil))))
    294150        (let* ((*debug-shark-process-output* ,debug-output))
     151          (ensure-shark-session-path)
    295152          (ensure-shark-process ,reset #',hook)
    296153          (unwind-protect
  • branches/shrink-tcr/lisp-kernel/area.h

    r14295 r14618  
    175175extern area *find_readonly_area(void);
    176176extern BytePtr low_relocatable_address, high_relocatable_address,
    177   low_markable_address, high_markable_address;
     177  low_markable_address, high_markable_address, reserved_region_end;
    178178
    179179#endif /* __AREA_H__ */
  • branches/shrink-tcr/lisp-kernel/arm_print.c

    r14119 r14618  
    270270  } else {
    271271    if (lfbits & lfbits_method_mask) {
    272       LispObj
    273         slot_vector = deref(name,3),
    274         method_name = deref(slot_vector, 6),
    275         method_qualifiers = deref(slot_vector, 2),
    276         method_specializers = deref(slot_vector, 3);
    277       add_c_string("Method-Function ");
    278       sprint_lisp_object(method_name, depth);
    279       add_char(' ');
    280       if (method_qualifiers != lisp_nil) {
    281         if (cdr(method_qualifiers) == lisp_nil) {
    282           sprint_lisp_object(car(method_qualifiers), depth);
    283         } else {
    284           sprint_lisp_object(method_qualifiers, depth);
     272      if (header_subtag(header_of(name)) == subtag_instance) {
     273        LispObj
     274          slot_vector = deref(name,3),
     275          method_name = deref(slot_vector, 6),
     276          method_qualifiers = deref(slot_vector, 2),
     277          method_specializers = deref(slot_vector, 3);
     278        add_c_string("Method-Function ");
     279        sprint_lisp_object(method_name, depth);
     280        add_char(' ');
     281        if (method_qualifiers != lisp_nil) {
     282          if (cdr(method_qualifiers) == lisp_nil) {
     283            sprint_lisp_object(car(method_qualifiers), depth);
     284          } else {
     285            sprint_lisp_object(method_qualifiers, depth);
     286          }
     287        add_char(' ');
    285288        }
    286         add_char(' ');
    287       }
    288       sprint_specializers_list(method_specializers, depth);
     289        sprint_specializers_list(method_specializers, depth);
     290      } else {
     291        sprint_lisp_object(name, depth);
     292      }
    289293      add_char(' ');
    290294    } else {
  • branches/shrink-tcr/lisp-kernel/image.c

    r14329 r14618  
    497497}
    498498
    499 OSErr
    500 save_application(unsigned fd, Boolean egc_was_enabled)
    501 {
    502   openmcl_image_file_header fh;
    503   openmcl_image_section_header sections[NUM_IMAGE_SECTIONS];
    504   openmcl_image_file_trailer trailer;
    505   area *areas[NUM_IMAGE_SECTIONS], *a;
    506   int i, err;
    507   off_t header_pos, eof_pos;
    508 #if WORD_SIZE == 64
    509   off_t image_data_pos;
    510   signed_natural section_data_delta;
    511 #endif
    512 
    513   /*
    514     Coerce macptrs to dead_macptrs.
    515   */
    516  
    517   prepare_to_write_dynamic_space(active_dynamic_area);
    518   prepare_to_write_dynamic_space(managed_static_area);
    519 
    520   /*
    521      If we ever support continuing after saving an image,
    522      undo this .. */
    523 
    524   if (static_cons_area->high > static_cons_area->low) {
    525     active_dynamic_area->low = static_cons_area->high;
    526     tenured_area->static_dnodes -= area_dnode(static_cons_area->high, static_cons_area->low);
    527   }
    528 
    529   areas[0] = nilreg_area;
    530   areas[1] = readonly_area;
    531   areas[2] = active_dynamic_area;
    532   areas[3] = managed_static_area;
    533   areas[4] = static_cons_area;
    534   for (i = 0; i < NUM_IMAGE_SECTIONS; i++) {
    535     a = areas[i];
    536     sections[i].code = a->code;
    537     sections[i].area = NULL;
    538     sections[i].memory_size  = a->active - a->low;
    539     if (a == active_dynamic_area) {
    540       sections[i].static_dnodes = tenured_area->static_dnodes;
    541     } else {
    542       sections[i].static_dnodes = 0;
    543     }
    544   }
    545   fh.sig0 = IMAGE_SIG0;
    546   fh.sig1 = IMAGE_SIG1;
    547   fh.sig2 = IMAGE_SIG2;
    548   fh.sig3 = IMAGE_SIG3;
    549   fh.timestamp = time(NULL);
    550   CANONICAL_IMAGE_BASE(&fh) = IMAGE_BASE_ADDRESS;
    551   ACTUAL_IMAGE_BASE(&fh) = image_base;
    552   fh.nsections = NUM_IMAGE_SECTIONS;
    553   fh.abi_version=ABI_VERSION_CURRENT;
    554 #if WORD_SIZE == 64
    555   fh.section_data_offset_high = 0;
    556   fh.section_data_offset_low = 0;
    557 #else
    558   fh.pad0[0] = fh.pad0[1] = 0;
    559   fh.pad1[0] = fh.pad1[1] = fh.pad1[2] = fh.pad1[3] = 0;
    560 #endif
    561   fh.flags = PLATFORM;
    562 
    563 #if WORD_SIZE == 64
    564   image_data_pos = seek_to_next_page(fd);
    565 #else
    566   err = write_file_and_section_headers(fd, &fh, sections, NUM_IMAGE_SECTIONS, &header_pos);
    567   if (err) {
    568     return err;
    569   }
    570 #endif
    571 
    572 
    573   {
    574     area *g0_area = g1_area->younger;
    575 
    576     /* Save GC config */
    577     lisp_global(LISP_HEAP_THRESHOLD) = lisp_heap_gc_threshold;
    578     lisp_global(G0_THRESHOLD) = g0_area->threshold;
    579     lisp_global(G1_THRESHOLD) = g1_area->threshold;
    580     lisp_global(G2_THRESHOLD) = g2_area->threshold;
    581     lisp_global(EGC_ENABLED) = (LispObj)egc_was_enabled;
    582     lisp_global(GC_NOTIFY_THRESHOLD) = lisp_heap_notify_threshold;
    583   }
     499void
     500prepare_to_write_static_space(Boolean egc_was_enabled)
     501{
     502  area *g0_area = g1_area->younger;
     503  int i;
     504
     505  /* Save GC config */
     506  lisp_global(LISP_HEAP_THRESHOLD) = lisp_heap_gc_threshold;
     507  lisp_global(G0_THRESHOLD) = g0_area->threshold;
     508  lisp_global(G1_THRESHOLD) = g1_area->threshold;
     509  lisp_global(G2_THRESHOLD) = g2_area->threshold;
     510  lisp_global(EGC_ENABLED) = (LispObj)egc_was_enabled;
     511  lisp_global(GC_NOTIFY_THRESHOLD) = lisp_heap_notify_threshold;
    584512  /*
    585513    lisp_global(GC_NUM) and lisp_global(FWDNUM) are persistent,
     
    609537    }
    610538  }
     539}
     540
     541
     542OSErr
     543save_application_internal(unsigned fd, Boolean egc_was_enabled)
     544{
     545  openmcl_image_file_header fh;
     546  openmcl_image_section_header sections[NUM_IMAGE_SECTIONS];
     547  openmcl_image_file_trailer trailer;
     548  area *areas[NUM_IMAGE_SECTIONS], *a;
     549  int i, err;
     550  off_t header_pos, eof_pos;
     551#if WORD_SIZE == 64
     552  off_t image_data_pos;
     553  signed_natural section_data_delta;
     554#endif
     555
     556  /*
     557    Coerce macptrs to dead_macptrs.
     558  */
     559 
     560  prepare_to_write_dynamic_space(active_dynamic_area);
     561  prepare_to_write_dynamic_space(managed_static_area);
     562
     563  /*
     564     If we ever support continuing after saving an image,
     565     undo this .. */
     566
     567  if (static_cons_area->high > static_cons_area->low) {
     568    active_dynamic_area->low = static_cons_area->high;
     569    tenured_area->static_dnodes -= area_dnode(static_cons_area->high, static_cons_area->low);
     570  }
     571
     572  areas[0] = nilreg_area;
     573  areas[1] = readonly_area;
     574  areas[2] = active_dynamic_area;
     575  areas[3] = managed_static_area;
     576  areas[4] = static_cons_area;
     577  for (i = 0; i < NUM_IMAGE_SECTIONS; i++) {
     578    a = areas[i];
     579    sections[i].code = a->code;
     580    sections[i].area = NULL;
     581    sections[i].memory_size  = a->active - a->low;
     582    if (a == active_dynamic_area) {
     583      sections[i].static_dnodes = tenured_area->static_dnodes;
     584    } else {
     585      sections[i].static_dnodes = 0;
     586    }
     587  }
     588  fh.sig0 = IMAGE_SIG0;
     589  fh.sig1 = IMAGE_SIG1;
     590  fh.sig2 = IMAGE_SIG2;
     591  fh.sig3 = IMAGE_SIG3;
     592  fh.timestamp = time(NULL);
     593  CANONICAL_IMAGE_BASE(&fh) = IMAGE_BASE_ADDRESS;
     594  ACTUAL_IMAGE_BASE(&fh) = image_base;
     595  fh.nsections = NUM_IMAGE_SECTIONS;
     596  fh.abi_version=ABI_VERSION_CURRENT;
     597#if WORD_SIZE == 64
     598  fh.section_data_offset_high = 0;
     599  fh.section_data_offset_low = 0;
     600#else
     601  fh.pad0[0] = fh.pad0[1] = 0;
     602  fh.pad1[0] = fh.pad1[1] = fh.pad1[2] = fh.pad1[3] = 0;
     603#endif
     604  fh.flags = PLATFORM;
     605
     606#if WORD_SIZE == 64
     607  image_data_pos = seek_to_next_page(fd);
     608#else
     609  err = write_file_and_section_headers(fd, &fh, sections, NUM_IMAGE_SECTIONS, &header_pos);
     610  if (err) {
     611    return err;
     612  }
     613#endif
     614
     615  prepare_to_write_static_space(egc_was_enabled);
     616
     617
    611618
    612619  for (i = 0; i < NUM_IMAGE_SECTIONS; i++) {
     
    657664  return i;
    658665}
     666
     667OSErr
     668save_application(int fd, Boolean egc_was_enabled)
     669{
     670#ifdef DARWIN
     671#ifdef X86
     672  extern void save_native_library(int, Boolean);
     673 
     674  if (fd < 0) {
     675    save_native_library(-fd, egc_was_enabled);
     676    return 0;
     677  }
     678#endif
     679#endif
     680  return save_application_internal(fd, egc_was_enabled);
     681}
     682
    659683     
    660684
  • branches/shrink-tcr/lisp-kernel/lisp-debug.c

    r14606 r14618  
    889889            (cs_area->low), (cs_area->high));
    890890    fprintf(dbgout, "Value (lisp) stack area: low = 0x" LISP ", high = 0x" LISP "\n",
    891             (u64_t)(natural)(vs_area->low), (u64_t)(natural)vs_area->high);
     891            (natural)(vs_area->low), (natural)vs_area->high);
    892892    if (xp) {
    893893      fprintf(dbgout, "Exception stack pointer = 0x" LISP "\n",
    894894#ifdef PPC
    895               (u64_t) (natural)(xpGPR(xp,1))
     895              (natural)(xpGPR(xp,1))
    896896#endif
    897897#ifdef X86
    898               (u64_t) (natural)(xpGPR(xp,Isp))
     898              (natural)(xpGPR(xp,Isp))
    899899#endif           
    900900#ifdef ARM
    901               (u64_t) (natural)(xpGPR(xp,Rsp))
     901              (natural)(xpGPR(xp,Rsp))
    902902#endif
    903903              );
  • branches/shrink-tcr/lisp-kernel/mach-o-image.c

    r14584 r14618  
    2121#include <stdlib.h>
    2222#include <limits.h>
     23#include <unistd.h>
     24#include <sys/fcntl.h>
     25#include <sys/mman.h>
     26#include <dlfcn.h>
    2327#include "lisp.h"
     28#include "gc.h"
     29#include "lisp_globals.h"
    2430
    2531#if WORD_SIZE==64
    2632typedef struct mach_header_64 macho_header;
    2733#define MACHO_MAGIC MH_MAGIC_64
     34#define MACHO_LC_SEGMENT LC_SEGMENT_64
    2835typedef struct segment_command_64 macho_segment_command;
    2936typedef struct section_64 macho_section;
    3037typedef struct nlist_64 macho_nlist;
     38typedef struct dylib_module_64 macho_module;
    3139#else
    32 typedef struct mach_header_64 macho_header;
     40typedef struct mach_header macho_header;
    3341#define MACHO_MAGIC MH_MAGIC
     42#define MACHO_LC_SEGMENT LC_SEGMENT
    3443typedef struct segment_command macho_segment_command;
    3544typedef struct section macho_section;
    3645typedef struct nlist macho_nlist;
     46typedef struct dylib_module macho_module;
    3747#endif
    3848
     
    5363macho_symbol_table *all_symbols, *local_symbols, *defined_external_symbols, *undefined_external_symbols;
    5464
     65macho_section *
     66nth_section_in_segment(macho_segment_command *segment, int sectno)
     67{
     68  return (macho_section *)(((char *)segment)+sizeof(macho_segment_command)+(sizeof(macho_section) *sectno));
     69}
     70
    5571ssize_t
    5672safe_read(int fd, char *buf, size_t nbytes)
     
    6783    if (n < 0) {
    6884      perror("reading from image");
    69       exit(1);
     85      _exit(1);
    7086    }
    7187    if (n == 0) {
    7288      fprintf(stderr, "unexpected end of file reading image\n");
    73       exit(1);
     89      _exit(1);
     90    }
     91    total += n;
     92    buf += n;
     93  }
     94  return total;
     95}
     96
     97ssize_t
     98safe_write(int fd, char *buf, size_t nbytes)
     99{
     100  size_t total = 0;
     101  ssize_t n;
     102  while (total <  nbytes) {
     103    n = nbytes-total;
     104    if (n > INT_MAX) {
     105      n = INT_MAX;
     106    }
     107    n = write(fd, buf, n);
     108    if (n < 0) {
     109      perror("writing to image");
     110      _exit(1);
    74111    }
    75112    total += n;
     
    104141  char *data = malloc(allocated);
    105142
    106   *data = 0;
     143  data[0] = ' ';
     144  data[1] = 0;
    107145  t->allocated = allocated;
    108146  t->data = data;
    109   t->used = 1;
     147  t->used = 2;
    110148  return t;
    111149}
     
    178216
    179217void
    180 sort_macho_symbol_table(macho_symbol_table *t)
    181 {
    182   qsort(t->symbols,t->used,sizeof(macho_nlist),compare_macho_symbols);
     218sort_macho_symbol_table(macho_symbol_table *t, int first, int n)
     219{
     220  qsort(t->symbols+first,n,sizeof(macho_nlist),compare_macho_symbols);
    183221}
    184222
     
    216254}
    217255
     256void
     257add_lisp_function_stab(LispObj f, natural size_in_bytes, macho_string_table *strings, macho_symbol_table *syms, int section_ordinal)
     258{
     259  macho_nlist symbol;
     260  natural strx = save_string(print_lisp_object(f),strings);
     261 
     262  symbol.n_type = N_BNSYM;
     263  symbol.n_un.n_strx = 1;
     264  symbol.n_sect = section_ordinal;
     265  symbol.n_desc = 0;
     266  symbol.n_value = f;
     267  add_symbol(&symbol, syms);
     268
     269  symbol.n_type = N_FUN;
     270  symbol.n_un.n_strx = strx;
     271  symbol.n_sect = section_ordinal;
     272  symbol.n_desc = 0;
     273  symbol.n_value = f;
     274  add_symbol(&symbol, syms);
     275
     276  symbol.n_type = N_FUN;
     277  symbol.n_un.n_strx = 1;
     278  symbol.n_sect = NO_SECT;
     279  symbol.n_desc = 0;
     280  symbol.n_value = size_in_bytes;
     281  add_symbol(&symbol, syms);
     282
     283  symbol.n_type = N_ENSYM;
     284  symbol.n_un.n_strx = 1;
     285  symbol.n_sect = section_ordinal;
     286  symbol.n_desc = 0;
     287  symbol.n_value = size_in_bytes;
     288  add_symbol(&symbol, syms);
     289
     290  symbol.n_type = N_SECT;
     291  symbol.n_un.n_strx = strx;
     292  symbol.n_sect = section_ordinal;
     293  symbol.n_desc = 0;
     294  symbol.n_value = f;
     295  add_symbol(&symbol, syms);
     296 
     297}
     298
     299#ifdef X86
     300void
     301add_lisp_function_stabs(macho_symbol_table *symbols, macho_string_table *strings, int section_ordinal)
     302{
     303  LispObj
     304    *start = (LispObj *) readonly_area->low,
     305    *end = (LispObj *) readonly_area->active,
     306    header,
     307    f;
     308  int tag;
     309  natural size_in_bytes, code_words;
     310  macho_nlist symbol;
     311
     312  symbol.n_type = N_SO;
     313  symbol.n_un.n_strx = save_string("/pretend/", strings);
     314  symbol.n_sect = NO_SECT;
     315  symbol.n_desc = 0;
     316  symbol.n_value = 0;
     317  add_symbol(&symbol, symbols);
     318 
     319  symbol.n_type = N_SO;
     320  symbol.n_un.n_strx = save_string("pretend.lisp", strings);
     321  symbol.n_sect = NO_SECT;
     322  symbol.n_desc = 0;
     323  symbol.n_value = 0;
     324  add_symbol(&symbol, symbols);
     325
     326  while (start < end) {
     327    header = *start;
     328    tag = header_subtag(header);
     329    if (tag == subtag_function) {
     330#ifdef X8632
     331      f = ((LispObj)start)+fulltag_misc;
     332      code_words = (unsigned short)deref(f,1);
     333      if (code_words & 0x8000) {
     334        code_words = header_element_count(header) - (code_words & 0x7fff);
     335      }
     336      size_in_bytes = (code_words<<node_shift)-tag_misc;
     337#endif
     338#ifdef X8664
     339      f = ((LispObj)start)+fulltag_function;
     340      code_words = (int)deref(f,1);
     341      size_in_bytes = (code_words<<node_shift)-tag_function;
     342#endif
     343
     344      add_lisp_function_stab(f,size_in_bytes,strings,symbols,section_ordinal);
     345      start += ((header_element_count(header)+2)&~1);
     346    } else {
     347      start = (LispObj *)skip_over_ivector((LispObj)start,header);
     348    }
     349  }
     350}
     351#endif
     352
     353typedef struct {
     354  char page[4096];
     355  int used;
     356  int load_command_offsets[16];
     357} macho_prefix;
     358
     359macho_prefix *
     360init_macho_prefix(uint32_t magic, cpu_type_t cputype, cpu_subtype_t cpusubtype, uint32_t filetype, uint32_t flags) {
     361  macho_prefix *p = calloc(1,sizeof(macho_prefix));
     362  macho_header *h = (macho_header *) p;
     363
     364  h->magic = magic;
     365  h->cputype = cputype;
     366  h->cpusubtype = cpusubtype;
     367  h->filetype = filetype;
     368  h->flags = flags;
     369  p->used = sizeof(macho_header);
     370  return p;
     371}
     372
     373struct load_command *
     374add_load_command(macho_prefix *p, uint32_t cmd, uint32_t cmdsize)
     375{
     376  struct load_command *l = (struct load_command *)&(p->page[p->used]);
     377  macho_header *h = (macho_header *)p;
     378
     379  cmdsize = align_to_power_of_2(cmdsize,node_shift);
     380  p->load_command_offsets[h->ncmds] = p->used;
     381  p->used += cmdsize;
     382  l->cmd = cmd;
     383  l->cmdsize += cmdsize;
     384  h->ncmds++;
     385  h->sizeofcmds += cmdsize;
     386  return l;
     387}
     388
     389macho_segment_command *
     390add_macho_segment(macho_prefix *p,
     391                  char *segname,
     392                  natural vmaddr,
     393                  natural vmsize,
     394                  natural fileoff,
     395                  natural filesize,
     396                  vm_prot_t maxprot,
     397                  vm_prot_t initprot,
     398                  int nsections, ...) /* sectnames */
     399{
     400  macho_segment_command *seg = (macho_segment_command *) add_load_command(p, MACHO_LC_SEGMENT, sizeof(macho_segment_command)+(nsections * sizeof(macho_section)));
     401  macho_section *sect = nth_section_in_segment(seg, 0);
     402  va_list sectnames;
     403  char *sectname;
     404
     405  seg->vmaddr = vmaddr;
     406  seg->vmsize = vmsize;
     407  seg->fileoff = fileoff;
     408  seg->filesize = filesize;
     409  seg->maxprot = maxprot;
     410  seg->initprot = initprot; 
     411  seg->nsects = nsections;
     412  strncpy(seg->segname,segname,sizeof(seg->segname));
     413  va_start(sectnames,nsections);
     414  while(nsections--) {
     415    sectname = va_arg(sectnames,char *);
     416    strncpy(sect->sectname,sectname,sizeof(sect->sectname));
     417    strncpy(sect->segname,segname,sizeof(sect->segname));
     418    sect++;
     419  }
     420  return seg;
     421}
     422
     423
     424macho_section *
     425init_macho_section(macho_segment_command *seg,
     426                   int sectno,
     427                   natural addr,
     428                   natural size,
     429                   natural offset,
     430                   uint32_t flags)
     431{
     432  macho_section *sect = nth_section_in_segment(seg,sectno);
     433  sect->addr = addr;
     434  sect->size = size;
     435  sect->offset = offset;
     436  sect->flags = flags;
     437  return sect;
     438}
     439             
     440void
     441save_native_library(int fd, Boolean egc_was_enabled)
     442{
     443  macho_prefix *p = init_macho_prefix(MACHO_MAGIC,
     444#ifdef X8632
     445                                      CPU_TYPE_I386,
     446                                      CPU_SUBTYPE_X86_ALL,
     447#endif
     448#ifdef X8664
     449
     450                                      CPU_TYPE_X86_64,
     451                                      CPU_SUBTYPE_X86_64_ALL,
     452#endif
     453#ifdef PPC32
     454                                      CPU_TYPE_POWERPC,
     455                                      CPU_SUBTYPE_POWERPC_ALL,
     456#endif
     457#ifdef PPC64
     458                                      CPU_TYPE_POWERPC64,
     459                                      CPU_TYPE_POWERPC_ALL,
     460#endif
     461#ifdef ARM
     462                                      CPU_TYPE_ARM,
     463                                      CPU_SUBTYPE_ARM_ALL,
     464#endif
     465                                      MH_DYLIB,
     466                                      MH_NOUNDEFS);
     467  macho_segment_command *seg;
     468  macho_section *sect;
     469  off_t curpos = 4096;
     470  struct dylib_command *dylib;
     471  struct symtab_command *symtab;
     472  struct dysymtab_command *dysymtab;
     473  char *dylib_name = "CCL Heap Image.dylib";
     474  macho_nlist symbol;
     475  macho_module m;
     476  struct dylib_table_of_contents *toc;
     477  struct dylib_reference *refs;
     478  int
     479    readonly_section_ordinal = 0,
     480    managed_static_section_ordinal = 0,
     481    managed_static_refbits_section_ordinal = 0,
     482    dynamic_section_ordinal = 0,
     483    static_section_ordinal = 0,
     484    next_section_ordinal;
     485  natural nrefbytes, first_external_symbol, num_external_symbols, i, j;
     486   
     487  all_symbols = new_macho_symbol_table(100000);
     488  global_string_table = create_string_table();
     489
     490  seg = add_macho_segment(p,
     491                          "__TEXT",
     492                          (natural)(readonly_area->low-4096),
     493                          4096+align_to_power_of_2(readonly_area->active-readonly_area->low,12),
     494                          0,
     495                          4096+align_to_power_of_2(readonly_area->active-readonly_area->low,12),
     496                          VM_PROT_READ|VM_PROT_WRITE|VM_PROT_EXECUTE,
     497                          VM_PROT_READ|VM_PROT_EXECUTE,
     498                          1,
     499                          "text");
     500  init_macho_section(seg,
     501                     0,
     502                     (natural)(readonly_area->low),
     503                     readonly_area->active-readonly_area->low,
     504                     curpos,
     505                     S_ATTR_SOME_INSTRUCTIONS);
     506  readonly_section_ordinal = ++next_section_ordinal;
     507  add_lisp_function_stabs(all_symbols,global_string_table,readonly_section_ordinal);
     508  lseek(fd,curpos,SEEK_SET);
     509  safe_write(fd,readonly_area->low,seg->filesize);
     510  curpos = align_to_power_of_2(lseek(fd,0,SEEK_CUR),12);
     511 
     512  if (managed_static_area->active != managed_static_area->low) {
     513    nrefbytes = ((area_dnode(managed_static_area->active,managed_static_area->low)+7)>>3);
     514
     515    prepare_to_write_dynamic_space(managed_static_area);
     516    seg = add_macho_segment(p,
     517                            "MANAGED-STATIC",
     518                            (natural)(managed_static_area->low),
     519                            align_to_power_of_2((managed_static_area->active-managed_static_area->low)+nrefbytes,12),
     520                            curpos,
     521                            align_to_power_of_2((managed_static_area->active-managed_static_area->low)+nrefbytes,12),
     522                            VM_PROT_READ|VM_PROT_WRITE|VM_PROT_EXECUTE,
     523                            VM_PROT_READ|VM_PROT_WRITE|VM_PROT_EXECUTE,
     524                            2,
     525                            "contents",
     526                            "refbits");
     527    init_macho_section(seg,
     528                       0,
     529                       seg->vmaddr,
     530                       managed_static_area->active-managed_static_area->low,
     531                       curpos,
     532                       S_ATTR_SOME_INSTRUCTIONS);
     533    managed_static_section_ordinal=++next_section_ordinal;
     534    lseek(fd,curpos,SEEK_SET);
     535    safe_write(fd,managed_static_area->low,managed_static_area->active-managed_static_area->low);
     536    curpos = lseek(fd,0,SEEK_CUR);
     537    init_macho_section(seg,
     538                       1,
     539                       seg->vmaddr+(managed_static_area->active-managed_static_area->low),
     540                       nrefbytes,
     541                       curpos,
     542                       S_REGULAR);
     543    managed_static_refbits_section_ordinal=++next_section_ordinal;
     544    safe_write(fd,(char *)managed_static_area->refbits,nrefbytes);
     545    curpos = align_to_power_of_2(lseek(fd,0,SEEK_CUR),12);
     546  }
     547  prepare_to_write_dynamic_space(active_dynamic_area);
     548  seg = add_macho_segment(p,
     549                          "DYNAMIC",
     550                          truncate_to_power_of_2((natural)static_cons_area->low,12),
     551                          align_to_power_of_2(active_dynamic_area->active,12)-truncate_to_power_of_2((natural)static_cons_area->low,12),
     552                          curpos,
     553                          align_to_power_of_2(active_dynamic_area->active,12)-truncate_to_power_of_2((natural)static_cons_area->low,12),
     554
     555                          VM_PROT_READ|VM_PROT_WRITE|VM_PROT_EXECUTE,
     556                          VM_PROT_READ|VM_PROT_WRITE|VM_PROT_EXECUTE,
     557                          1,
     558                          "heap");
     559  init_macho_section(seg,
     560                     0,
     561                     truncate_to_power_of_2((natural)static_cons_area->low,12),
     562                     align_to_power_of_2(active_dynamic_area->active,12)-truncate_to_power_of_2((natural)static_cons_area->low,12),
     563                     curpos,
     564                     S_ATTR_SOME_INSTRUCTIONS);
     565  dynamic_section_ordinal=++next_section_ordinal;
     566  lseek(fd,curpos,SEEK_SET);
     567  safe_write(fd,(char *)truncate_to_power_of_2((natural)static_cons_area->low,12), align_to_power_of_2(active_dynamic_area->active,12)-truncate_to_power_of_2((natural)static_cons_area->low,12));
     568  curpos = align_to_power_of_2(lseek(fd,0,SEEK_CUR),12);
     569
     570  prepare_to_write_static_space(egc_was_enabled);
     571  seg = add_macho_segment(p,
     572                          "STATIC",
     573                          align_to_power_of_2(active_dynamic_area->active,12),
     574                          8192,
     575                          curpos,
     576                          8192,
     577                          VM_PROT_READ|VM_PROT_WRITE|VM_PROT_EXECUTE,
     578                          VM_PROT_READ|VM_PROT_WRITE|VM_PROT_EXECUTE,
     579                          1,
     580                          "copy");
     581  init_macho_section(seg,
     582                     0,
     583                     align_to_power_of_2(active_dynamic_area->active,12),
     584                     8192,
     585                     curpos,
     586                     S_ATTR_SOME_INSTRUCTIONS);
     587  static_section_ordinal=++next_section_ordinal;
     588  lseek(fd,curpos,SEEK_SET);
     589  safe_write(fd,nilreg_area->low,8192);
     590  curpos = align_to_power_of_2(lseek(fd,0,SEEK_CUR),12);
     591  seg = add_macho_segment(p,
     592                          "__LINKEDIT",
     593                          align_to_power_of_2(reserved_region_end,12),
     594                          0,    /* tbd */
     595                          curpos,
     596                          0,    /* tbd */
     597                          VM_PROT_READ|VM_PROT_WRITE|VM_PROT_EXECUTE,
     598                          VM_PROT_READ,
     599                          0);
     600  dylib = (struct dylib_command *)add_load_command(p,LC_ID_DYLIB,sizeof(struct dylib_command)+strlen(dylib_name)+1);
     601  dylib->dylib.name.offset = sizeof(struct dylib_command);
     602  strcpy((char *)dylib+sizeof(struct dylib_command),dylib_name);
     603  symtab = (struct symtab_command *)add_load_command(p,LC_SYMTAB,sizeof(struct symtab_command));
     604  dysymtab = (struct dysymtab_command *)add_load_command(p,LC_DYSYMTAB,sizeof(struct dysymtab_command));
     605  dysymtab->nlocalsym=all_symbols->used;
     606  first_external_symbol = all_symbols->used;
     607
     608  /* Add external symbols describing section boundaries. */
     609  symbol.n_un.n_strx = save_string("_READONLY_START",global_string_table);
     610  symbol.n_type = N_SECT|N_EXT;
     611  symbol.n_sect = readonly_section_ordinal;
     612  symbol.n_desc = 0;
     613  symbol.n_value = (natural)readonly_area->low;
     614  add_symbol(&symbol,all_symbols);
     615
     616  symbol.n_un.n_strx = save_string("_READONLY_END",global_string_table);
     617  symbol.n_value = (natural)readonly_area->active;
     618  add_symbol(&symbol,all_symbols);
     619 
     620  if (managed_static_section_ordinal) {
     621    symbol.n_un.n_strx = save_string("_MANAGED_STATIC_START",global_string_table);
     622    symbol.n_sect = managed_static_section_ordinal;
     623    symbol.n_value = (natural)managed_static_area->low;
     624    add_symbol(&symbol,all_symbols);
     625
     626    symbol.n_un.n_strx = save_string("_MANAGED_STATIC_END",global_string_table);
     627    symbol.n_value = (natural)managed_static_area->active;
     628    add_symbol(&symbol,all_symbols);
     629
     630    symbol.n_un.n_strx = save_string("_MANAGED_STATIC_REFMAP_END",global_string_table);
     631    symbol.n_sect = managed_static_refbits_section_ordinal;
     632    symbol.n_value = (natural)managed_static_area->active+nrefbytes;
     633    add_symbol(&symbol,all_symbols);
     634  }
     635  symbol.n_un.n_strx = save_string("_STATIC_CONS_START",global_string_table);
     636  symbol.n_sect = dynamic_section_ordinal;
     637  symbol.n_value = (natural)static_cons_area->low;
     638  add_symbol(&symbol,all_symbols);
     639
     640  symbol.n_un.n_strx = save_string("_STATIC_CONS_END",global_string_table);
     641  symbol.n_value = (natural)static_cons_area->high;
     642  add_symbol(&symbol,all_symbols);
     643
     644  symbol.n_un.n_strx = save_string("_DYNAMIC_HEAP_END",global_string_table);
     645  symbol.n_value = (natural)active_dynamic_area->active;
     646  add_symbol(&symbol,all_symbols);
     647
     648  num_external_symbols = all_symbols->used - first_external_symbol;
     649  dysymtab->iextdefsym = first_external_symbol;
     650  dysymtab->nextdefsym = num_external_symbols;
     651  sort_macho_symbol_table(all_symbols,first_external_symbol,num_external_symbols);
     652  symtab->symoff = curpos;
     653  symtab->nsyms = all_symbols->used;
     654  safe_write(fd,(char *)all_symbols->symbols,all_symbols->used*sizeof(macho_nlist));
     655  curpos = lseek(fd, 0, SEEK_CUR);
     656  dysymtab->tocoff = curpos;
     657  dysymtab->ntoc = num_external_symbols;
     658  toc = (struct dylib_table_of_contents *)malloc(num_external_symbols*sizeof(struct dylib_table_of_contents));
     659 
     660  for (i=0,j=first_external_symbol;
     661       i<num_external_symbols;
     662       i++,j++) {
     663    toc[i].symbol_index = j;
     664    toc[i].module_index = 0;
     665  }
     666  safe_write(fd,(char *)toc,num_external_symbols*sizeof(struct dylib_table_of_contents));
     667  curpos = lseek(fd, 0, SEEK_CUR);
     668  dysymtab->modtaboff = curpos;
     669  dysymtab->nmodtab = 1;
     670  memset(&m,0,sizeof(macho_module));
     671  m.module_name = save_string("single_module",global_string_table);
     672  m.iextdefsym = first_external_symbol;
     673  m.nextdefsym = num_external_symbols;
     674  m.irefsym = 0;
     675  m.nrefsym = num_external_symbols;
     676  m.ilocalsym = 0;
     677  m.nlocalsym = first_external_symbol;
     678  safe_write(fd,(char *)&m,sizeof(macho_module));
     679  curpos = lseek(fd, 0, SEEK_CUR);
     680  dysymtab->extrefsymoff = curpos;
     681  dysymtab->nextrefsyms = num_external_symbols;
     682  refs = (struct dylib_reference *)malloc(sizeof(struct dylib_reference)*num_external_symbols);
     683  for (i = 0, j = first_external_symbol;
     684       i < num_external_symbols;
     685       i++, j++) {
     686    refs[i].isym = j;
     687    refs[i].flags = REFERENCE_FLAG_DEFINED;
     688  }
     689  safe_write(fd,(char *)refs,sizeof(struct dylib_reference)*num_external_symbols);
     690  curpos = lseek(fd, 0, SEEK_CUR);
     691  symtab->stroff = curpos;
     692  symtab->strsize = global_string_table->used;
     693  safe_write(fd,global_string_table->data,global_string_table->used);
     694  curpos = lseek(fd, 0, SEEK_CUR);
     695  /* 'seg' still refers to the last segment, i.e., the __LINKEDIT segment */
     696  seg->filesize = curpos - seg->fileoff;
     697  seg->vmsize = align_to_power_of_2(seg->filesize,12);
     698 
     699  lseek(fd,0,SEEK_SET);
     700  safe_write(fd,p->page,4096);
     701}               
     702
     703LispObj
     704load_native_library(char *path)
     705{
     706  extern BytePtr allocate_from_reserved_area(natural);
     707  void *lib;
     708  LispObj image_nil = 0;
     709
     710  /* Because of the way that we've reserved memory, we can only
     711     load the image's segments at their preferred address if we
     712     make the pages at those addresses free. */
     713  {
     714    int fd = open(path,O_RDONLY);
     715    Boolean win = false;
     716
     717    if (fd >= 0) {
     718      char * p = mmap(NULL, 4096, PROT_READ, MAP_PRIVATE, fd, 0);   
     719     
     720      if (p != MAP_FAILED) {
     721        macho_header *h = (macho_header *)p;
     722       
     723        if ((h->magic == MH_MAGIC) &&
     724            (h->cputype ==
     725#ifdef X8632
     726             CPU_TYPE_I386
     727#endif
     728#ifdef X8664
     729             CPU_TYPE_X86_64
     730#endif
     731             )) {
     732          struct load_command *lc;
     733          macho_segment_command *seg;
     734         
     735          for (lc = (struct load_command *)(p+sizeof(macho_header));
     736               lc->cmd == MACHO_LC_SEGMENT;
     737               lc = (struct load_command *)(((char *)lc)+lc->cmdsize)) {
     738            seg = (macho_segment_command *) lc;
     739            if (seg->vmaddr && seg->vmsize) {
     740              munmap((void *)seg->vmaddr, seg->vmsize);
     741            }
     742          }
     743          win = true;
     744        }
     745        munmap(p,4096);
     746      }
     747      close(fd);
     748    }
     749    if (! win) {
     750      return 0;
     751    }
     752  }
     753  lib = dlopen(path, RTLD_GLOBAL);
     754  if (lib == NULL) {
     755    return 0;
     756  } else {
     757    area *a;
     758    natural initsize,totalsize,nrefbytes;
     759    char
     760      *ro_start = dlsym(lib,"READONLY_START"),
     761      *ro_end   = dlsym(lib,"READONLY_END"),
     762      *ms_start = dlsym(lib,"MANAGED_STATIC_START"),
     763      *ms_end   = dlsym(lib,"MANAGED_STATIC_END"),
     764      *msr_end  = dlsym(lib,"MANAGED_STATIC_REFMAP_END"),
     765      *sc_start = dlsym(lib,"STATIC_CONS_START"),
     766      *sc_end   = dlsym(lib,"STATIC_CONS_START"),
     767      *dh_end   = dlsym(lib,"DYNAMIC_HEAP_END"),
     768      *p,
     769      *q;
     770
     771    if ((dh_end == NULL) ||
     772        (ro_start != pure_space_active)) {
     773      dlclose(lib);
     774      return 0;
     775    }
     776    p = (BytePtr)align_to_power_of_2(dh_end,12);
     777    q = static_space_active;
     778    mprotect(q,8192,PROT_READ|PROT_WRITE|PROT_EXEC);
     779    memcpy(q,p,8192);
     780    memset(p,0,8192);
     781
     782    a = nilreg_area = new_area(q,q+8192,AREA_STATIC);
     783    nilreg_area->active = nilreg_area->high; /* a little wrong */
     784#ifdef PPC
     785#ifdef PPC64
     786    image_nil = ptr_to_lispobj(a->low + (1024*4) + sizeof(lispsymbol) + fulltag_misc);
     787#else
     788    image_nil = (LispObj)(a->low + 8 + 8 + (1024*4) + fulltag_nil);
     789#endif
     790#endif
     791#ifdef X86
     792#ifdef X8664
     793    image_nil = (LispObj)(a->low) + (1024*4) + fulltag_nil;
     794#else
     795    image_nil = (LispObj)(a->low) + (1024*4) + fulltag_cons;
     796#endif
     797#endif
     798#ifdef ARM
     799    image_nil = (LispObj)(a->low) + (1024*4) + fulltag_nil;
     800#endif
     801    set_nil(image_nil);
     802    add_area_holding_area_lock(a);
     803   
     804    a = new_area(pure_space_active,pure_space_limit,AREA_READONLY);
     805    readonly_area = a;
     806    add_area_holding_area_lock(a);
     807    pure_space_active = a->active = ro_end;
     808   
     809    initsize = dh_end - sc_end;
     810    totalsize = align_to_power_of_2(initsize, log2_heap_segment_size);
     811   
     812    p = allocate_from_reserved_area(totalsize);
     813    q = p+totalsize;
     814    a = new_area(p,q,AREA_DYNAMIC);
     815    a->active = dh_end;
     816    a->h = p;
     817    CommitMemory((char *)(align_to_power_of_2(dh_end,12)),
     818                 q-(char *)align_to_power_of_2(dh_end,12));
     819    map_initial_reloctab(p, q);
     820    map_initial_markbits(p, q);
     821    lisp_global(HEAP_START) = (LispObj)p;
     822    lisp_global(HEAP_END) = (LispObj)q;
     823    add_area_holding_area_lock(a);
     824    resize_dynamic_heap(dh_end, lisp_heap_gc_threshold);
     825    xMakeDataExecutable(a->low, a->active - a->low);
     826
     827    static_cons_area = new_area(sc_start, sc_end, AREA_STATIC_CONS);
     828    static_cons_area->active = sc_start;
     829    lower_heap_start(sc_start,a);
     830    a->static_dnodes = area_dnode(sc_end,sc_start);
     831   
     832    managed_static_area = new_area(ms_start,ms_end,AREA_MANAGED_STATIC);
     833    managed_static_area->active = ms_end;
     834    add_area_holding_area_lock(managed_static_area);
     835    lisp_global(REF_BASE) = (LispObj) ms_start;
     836   
     837    nrefbytes = msr_end - ms_end;
     838    CommitMemory(global_mark_ref_bits,align_to_power_of_2(nrefbytes, 12));
     839    memcpy(global_mark_ref_bits,ms_end,nrefbytes);
     840    memset(ms_end,0,nrefbytes);
     841   
     842    return image_nil;
     843  }
     844}
  • branches/shrink-tcr/lisp-kernel/pmcl-kernel.c

    r14606 r14618  
    379379reserved_area_size = MAXIMUM_MAPPABLE_MEMORY;
    380380
     381BytePtr reserved_region_end = NULL;
     382
    381383area
    382384  *nilreg_area=NULL,
     
    571573  */
    572574  end = lastbyte;
     575  reserved_region_end = lastbyte;
    573576  end = (BytePtr) ((natural)((((natural)end) - ((totalsize+63)>>6)) & ~4095));
    574577
     
    21602163    err = errno;
    21612164  }
     2165#ifdef DARWIN
     2166#ifdef X86
     2167  if (image_nil == 0) {
     2168    extern LispObj load_native_library(char *);
     2169    image_nil = load_native_library(path);
     2170  }
     2171#endif
     2172#endif
    21622173  if (image_nil == 0) {
    21632174#ifdef WINDOWS
  • branches/shrink-tcr/lisp-kernel/ppc_print.c

    r13067 r14618  
    270270  } else {
    271271    if (lfbits & lfbits_method_mask) {
    272       LispObj
    273         slot_vector = deref(name,3),
    274         method_name = deref(slot_vector, 6),
    275         method_qualifiers = deref(slot_vector, 2),
    276         method_specializers = deref(slot_vector, 3);
    277       add_c_string("Method-Function ");
    278       sprint_lisp_object(method_name, depth);
    279       add_char(' ');
    280       if (method_qualifiers != lisp_nil) {
    281         if (cdr(method_qualifiers) == lisp_nil) {
    282           sprint_lisp_object(car(method_qualifiers), depth);
    283         } else {
    284           sprint_lisp_object(method_qualifiers, depth);
     272      if (header_subtag(header_of(name)) == subtag_instance) {
     273        LispObj
     274          slot_vector = deref(name,3),
     275          method_name = deref(slot_vector, 6),
     276          method_qualifiers = deref(slot_vector, 2),
     277          method_specializers = deref(slot_vector, 3);
     278        add_c_string("Method-Function ");
     279        sprint_lisp_object(method_name, depth);
     280        add_char(' ');
     281        if (method_qualifiers != lisp_nil) {
     282          if (cdr(method_qualifiers) == lisp_nil) {
     283            sprint_lisp_object(car(method_qualifiers), depth);
     284          } else {
     285            sprint_lisp_object(method_qualifiers, depth);
     286          }
     287          add_char(' ');
    285288        }
    286         add_char(' ');
    287       }
    288       sprint_specializers_list(method_specializers, depth);
     289        sprint_specializers_list(method_specializers, depth);
     290      } else {
     291        sprint_lisp_object(name, depth);
     292      }
    289293      add_char(' ');
    290294    } else {
  • branches/shrink-tcr/lisp-kernel/x86-exceptions.c

    r14617 r14618  
    303303      if (selector & GC_TRAP_FUNCTION_SAVE_APPLICATION) {
    304304        OSErr err;
    305         extern OSErr save_application(unsigned, Boolean);
     305        extern OSErr save_application(int, Boolean);
    306306        area *vsarea = tcr->vs_area;
    307307
     
    310310#endif
    311311        nrs_TOPLFUNC.vcell = *((LispObj *)(vsarea->high)-1);
    312         err = save_application(arg, egc_was_enabled);
     312        err = save_application((int)arg, egc_was_enabled);
    313313        if (err == noErr) {
    314314          _exit(0);
  • branches/shrink-tcr/lisp-kernel/x86_print.c

    r14295 r14618  
    297297  } else {
    298298    if (lfbits & lfbits_method_mask) {
    299       LispObj
    300         slot_vector = deref(name,3),
    301         method_name = deref(slot_vector, 6),
    302         method_qualifiers = deref(slot_vector, 2),
    303         method_specializers = deref(slot_vector, 3);
    304       add_c_string("Method-Function ");
    305       sprint_lisp_object(method_name, depth);
    306       add_char(' ');
    307       if (method_qualifiers != lisp_nil) {
    308         if (cdr(method_qualifiers) == lisp_nil) {
    309           sprint_lisp_object(car(method_qualifiers), depth);
    310         } else {
    311           sprint_lisp_object(method_qualifiers, depth);
     299      if (header_subtag(header_of(name)) == subtag_instance) {
     300        LispObj
     301          slot_vector = deref(name,3),
     302          method_name = deref(slot_vector, 6),
     303          method_qualifiers = deref(slot_vector, 2),
     304          method_specializers = deref(slot_vector, 3);
     305        add_c_string("Method-Function ");
     306        sprint_lisp_object(method_name, depth);
     307        add_char(' ');
     308        if (method_qualifiers != lisp_nil) {
     309          if (cdr(method_qualifiers) == lisp_nil) {
     310            sprint_lisp_object(car(method_qualifiers), depth);
     311          } else {
     312            sprint_lisp_object(method_qualifiers, depth);
     313          }
     314          add_char(' ');
    312315        }
    313         add_char(' ');
    314       }
    315       sprint_specializers_list(method_specializers, depth);
     316        sprint_specializers_list(method_specializers, depth);
     317      }
     318      else {
     319        sprint_lisp_object(name,depth);
     320      }
    316321      add_char(' ');
    317322    } else if (lfbits & lfbits_gfn_mask) {
  • branches/shrink-tcr/objc-bridge/objc-runtime.lisp

    r14263 r14618  
    372372         (open-shared-library "Foundation.1.0.dll")
    373373         (open-shared-library "AppKit.1.0.dll")
     374         (open-shared-library "CoreData.1.0.dll")
    374375         ;; We may need to call #_NSInitializeProcess
    375376         ;; under Cocotron.  If so, we'd need to do
Note: See TracChangeset for help on using the changeset viewer.